!======================================================================
! CROCO is a branch of ROMS developped at IRD, INRIA, 
! Ifremer, CNRS and Univ. Toulouse III  in France
! The two other branches from UCLA (Shchepetkin et al)
! and Rutgers University (Arango et al) are under MIT/X style license.
! CROCO specific routines (nesting) are under CeCILL-C license.
! 
! CROCO website : http://www.croco-ocean.org
!======================================================================
!
!======================================================================
!
!> @brief Croco interface for Online Analysis (OA=OnlineAnalysis)
!! - Prepares spectral and wavelet analyses outputs.
!!
!! @details called in output_oa.F 
!!  written to support tile-threads and 
!!  possible dual OpenMP-MPI parallelization. 
!!  See Online_spectral_diags called by main.F and step.F
!!  More history/info in source module_interface_oa.F90
!!
!> @authors  
!! - B. Lemieux-Dudon
!!  - Croco Tile-thread compliant version (2021) 
!!    supporting tile-threads and possible dual OpenMP-MPI 
!!    parallelization of the horizontal domain
!!     => output_oa : OA updates global array looping on tiles 
!!        and finally send them to XIOS (out of the loop)
!!     => var2d_oa_out, var3d_oa_out : 
!!        2D using Croco working arrays work2d, work2d2
!!     => module_parameter_oa : allocating var3d_oa, var2d_oa 
!!        to the croco GLOBAL_3D_ARRAY, 2D_ARRAY 
!!  - based on a preliminary Croco-OA interface version : spring 2020.
!! - More history (authors, comments) in source module_interface_oa.F90
!> @todo BLXD TODO test var3d_oa_out with work.h as applied in
!!  var2d_oa_out
!
!  REFERENCE:
!  
!======================================================================

#include "cppdefs.h"
! BLXD includes :
! - cppdefs_dev.h
! - set_global_definitions.h
!   with GLOBAL_2D_ARRAY
!        PRIVATE_SCRATCH_2D_ARRAY... 
#ifdef ONLINE_ANALYSIS

      subroutine var2d_oa_out (tile, ic, iv, var2d_re, var2d_im
     &                             , vnam_oa_r, vnam_oa_i)

      implicit none
# include "param.h"

! "Global" 2D work array (full domain or MPI subdomain)
!  Argt Out calculated over the tile horizontal dimension
      real, intent(inout) :: var2d_re(GLOBAL_2D_ARRAY)
      real, intent(inout) :: var2d_im(GLOBAL_2D_ARRAY)
      integer, intent(in) :: iv, ic
! Cannot work, require that the loop over ic, iv is moved
! outside var3d, var3d_oa_out
      character(len=22), intent(inout) :: vnam_oa_r, vnam_oa_i 

      integer tile
C$    integer trd, omp_get_thread_num
! BLXD private scratch not needed since no A2d, A3d array 
! passed in argument of the _tile subroutine
! # include "private_scratch.h"
! compute_tile_nounds => Istr,Iend,Jstr,Jend assoc. to tile
# include "compute_tile_bounds.h"

C$    trd=omp_get_thread_num()
      call var2d_oa_out_tile (Istr,Iend,Jstr,Jend
     &                        ,var2d_re, var2d_im
     &                        ,vnam_oa_r, vnam_oa_i
     &                        ,ic, iv )


      end subroutine var2d_oa_out

#else /* ONLINE_ANALYSIS */

      subroutine var2d_oa_out_empty
      return
      end subroutine var2d_oa_out_empty

#endif /* ONLINE_ANALYSIS */

!
!----------------------------------------------------------------------
!
!  Processing the outputs of the online spectral analysis module
!  before outputs
!
!----------------------------------------------------------------------
!
#ifdef ONLINE_ANALYSIS

      subroutine var2d_oa_out_tile ( Istr,Iend,Jstr,Jend
     &                              ,var2d_re,  var2d_im
     &                              ,vnam_oa_r, vnam_oa_i
     &                              ,ic, iv )
!
      use module_interface_oa, only : var2d_oa
     & ,itgt_glob, jtgt_glob
     & ,tvar_oa ,tgv3d_oa, tgv_oa, tgvnam_oa, nzvc_oa
     & ,verbose_oa
      use module_oa_variables,  only : tv_oa     
     & ,tupd_oa  ! BLXD added for test
      use module_oa_periode,    only : begc_oa, tvc_oa, tc_oa, nzc_oa
     & ,swt_wfpf_oa
      use scalars
      implicit none
! >> Include with variable declaration
! # include "param.h"
      integer, intent(in) :: Istr, Iend, Jstr, Jend
      ! BLXD each tile will complete the GLOBAL_2D_ARRAY var2d_re, var2d_im
      ! In case of OpenMP threads, it should require and $OMP BARRIER
      ! at the end of the tile loop, shouldn't it ?  
      real, intent(inout) :: var2d_re(GLOBAL_2D_ARRAY)
     &                      ,var2d_im(GLOBAL_2D_ARRAY) 
      integer, intent(in) :: iv, ic
      character(len=22), intent(inout)  :: vnam_oa_r, vnam_oa_i 

! Local variables
      integer :: i, j, ivc
      integer, parameter :: verbl=5
      !integer imin,imax,jmin,jmax
! BLXD not needed :
# include "grid.h"
!# include "ocean3d.h"
!# include "scalars.h"
! >> Include with computation instructions
# include "compute_auxiliary_bounds.h"
! From param.h, MPI subdom., tile 
! From compute_tile_bounds.h with Istr,Iend,Jstr,Jend
! Computes Physical Bdy indices IstrR, IendR, JstrR, JendR
!          Interior U or V points (start) IstrU, JstrV

! TODO BLXD instruction and now computations ?

#  define I_EXT_RANGE Istr-1,Iend+1
#  define J_EXT_RANGE Jstr-1,Jend+1

# ifdef EW_PERIODIC
#  define IU_RANGE Istr,Iend
#  define IV_RANGE Istr,Iend
# else
#  define IU_RANGE Istr,IendR
#  define IV_RANGE IstrR,IendR
# endif

# ifdef NS_PERIODIC
#  define JU_RANGE Jstr,Jend
#  define JV_RANGE Jstr,Jend
# else
#  define JU_RANGE JstrR,JendR
#  define JV_RANGE Jstr,JendR
# endif

# ifdef MASKING
#  define SWITCH *
# else
#  define SWITCH !
# endif

      
! 2Drho-point
        ivc = nzvc_oa( tc_oa(ic) )
        var2d_oa_grid_point : if ( tgv_oa( tv_oa(iv) ) == 1 ) then     

        if_oa_re_im_rho_2D : if ( swt_wfpf_oa(iv)==4 ) then
      ! #BLXD 2020 REAL/DIMAG for real/imag part of dble prec var2d_oa 
      ! Warning mpc.F parser REAL -> REAL real_type
      ! Warning : different gnu, intel standards 
!            do k=1,N
!                do j=Jstr,Jend
!                    do i=Istr,Iend
                do j=JstrR,JendR
                    do i=IstrR,IendR
                        var2d_re(i,j) = 
     & REAL(
     & DBLE( var2d_oa( i,j, tvar_oa( tc_oa(ic), tvc_oa(ic), ivc ))))
     &              SWITCH rmask(i,j)
                       var2d_im(i,j) = 
     & REAL(
     & DIMAG( var2d_oa( i,j, tvar_oa( tc_oa(ic), tvc_oa(ic), ivc ))))
     &              SWITCH rmask(i,j)

#ifdef OA_TRACES
                       if(verbose_oa>verbl) then
                       call traces_oa_i(i,j,itgt_glob)
                       call trace2_oa_i
     &                    (i,j,itgt_glob,var2d_re(i,j)
     &                                  ,var2d_im(i,j) )
                       endif
#endif
                    enddo
                enddo
!            enddo
            vnam_oa_r = get_vnam( vnamfmt='(a5,a5,i3.3,a1,i3.3,a5)'
     &              ,vnamdp='2d_r_',vnams='_real',verbose=verbose_oa)
            vnam_oa_i = get_vnam( vnamfmt='(a5,a5,i3.3,a1,i3.3,a5)'
     &              ,vnamdp='2d_r_',vnams='_imag',verbose=verbose_oa)
      
! if_oa_re_im_rho_2D
        else 

!            do k=1,N
!                do j=Jstr,Jend
!                    do i=Istr,Iend
                do j=JstrR,JendR
                    do i=IstrR,IendR
                        var2d_re( i, j ) = 
     & var2d_oa( i,j, tvar_oa( tc_oa(ic), tvc_oa(ic), ivc ))
     &              SWITCH rmask(i,j)

                    enddo
                enddo
!            enddo

            vnam_oa_r = get_vnam( vnamfmt='(a5,a5,i3.3,a1,i3.3)'
     &              ,vnamdp='2d_r_',vnams='',verbose=verbose_oa)

        endif if_oa_re_im_rho_2D
     
! 2Du-point
        else if ( tgv_oa( tv_oa(iv) ) == 2 ) then !u-point
       
        if_oa_re_im_u_2D : if ( swt_wfpf_oa(iv)==4 ) then
! #BLXD REAL/DIMAG for real/imag part of dble prec var2d_oa 
! Warning mpc.F parser REAL -> REAL real_type
! Warning : different gnu, intel standards 
      
!            do k=1,N
!                do j=Jstr,Jend
!                    do i=Istr,Iend
                do j=JU_RANGE
                    do i=IU_RANGE

                        var2d_re( i, j ) = 
     & REAL(
     & REAL( var2d_oa( i,j, tvar_oa( tc_oa(ic), tvc_oa(ic), ivc ))))
     &              SWITCH umask(i,j)
                       var2d_im( i, j ) = 
     & REAL(
     & DIMAG( var2d_oa( i,j, tvar_oa( tc_oa(ic), tvc_oa(ic), ivc ))))
     &              SWITCH umask(i,j)

                    enddo
                enddo
!            enddo
            vnam_oa_r = get_vnam( vnamfmt='(a5,a5,i3.3,a1,i3.3,a5)'
     &              ,vnamdp='2d_u_',vnams='_real',verbose=verbose_oa)
            vnam_oa_i = get_vnam( vnamfmt='(a5,a5,i3.3,a1,i3.3,a5)'
     &              ,vnamdp='2d_u_',vnams='_imag',verbose=verbose_oa)
! if_oa_re_im_u_2D 
        else

!            do k=1,N
!                do j=Jstr,Jend
!                    do i=Istr,Iend
                do j=JU_RANGE
                    do i=IU_RANGE
                        var2d_re( i, j ) = 
     &  var2d_oa( i,j, tvar_oa( tc_oa(ic), tvc_oa(ic), ivc ))
     &              SWITCH umask(i,j)
                    enddo
                enddo
!            enddo
            vnam_oa_r = get_vnam( vnamfmt='(a5,a5,i3.3,a1,i3.3)'
     &              ,vnamdp='2d_u_',vnams='',verbose=verbose_oa)

        endif if_oa_re_im_u_2D

! 2Dv-point
        else if ( tgv_oa( tv_oa(iv) ) == 3 ) then
       
        if_oa_re_im_v_2D : if ( swt_wfpf_oa(iv)==4 ) then
! #BLXD REAL/DIMAG for real/imag part of dble prec var2d_oa 
! Warning mpc.F parser REAL -> REAL real_type
! Warning : different gnu, intel standards 
!            do k=1,N
!                do j=Jstr,Jend
!                    do i=Istr,Iend
                do j=JV_RANGE
                    do i=IV_RANGE
                         
                        var2d_re( i, j ) =
     & REAL(
     & DBLE( var2d_oa( i,j, tvar_oa( tc_oa(ic), tvc_oa(ic), ivc ))))
     &              SWITCH vmask(i,j)
                       var2d_im( i, j ) = 
     & REAL(
     & DIMAG( var2d_oa( i,j, tvar_oa( tc_oa(ic), tvc_oa(ic), ivc ))))
     &              SWITCH vmask(i,j)

                    enddo
                enddo
!            enddo
            vnam_oa_r = get_vnam( vnamfmt='(a5,a5,i3.3,a1,i3.3,a5)'
     &              ,vnamdp='2d_v_',vnams='_real',verbose=verbose_oa)
            vnam_oa_i = get_vnam( vnamfmt='(a5,a5,i3.3,a1,i3.3,a5)'
     &              ,vnamdp='2d_v_',vnams='_imag',verbose=verbose_oa)

! if_oa_re_im_v_2D
        else

!            do k=1,N
!                do j=Jstr,Jend
!                    do i=Istr,Iend
                do j=JV_RANGE
                    do i=IV_RANGE
                        var2d_re( i, j ) = 
     & var2d_oa( i,j, tvar_oa( tc_oa(ic), tvc_oa(ic), ivc ) )
     &              SWITCH vmask(i,j)
                    enddo
                enddo
!            enddo
            vnam_oa_r = get_vnam( vnamfmt='(a5,a5,i3.3,a1,i3.3)'
     &              ,vnamdp='2d_v_',vnams='',verbose=verbose_oa)

        endif if_oa_re_im_v_2D

! 2Df-point
        else if ( tgv_oa( tv_oa(iv) ) == 4 ) then

        if_oa_re_im_f_2D : if ( swt_wfpf_oa(iv)==4 ) then
! #BLXD REAL/DIMAG for real/imag part of dble prec var2d_oa 
! Warning mpc.F parser REAL -> REAL real_type
! Warning : different gnu, intel standards 
!            do k=1,N
!                do j=Jstr,Jend
!                    do i=Istr,Iend
                do j=JV_RANGE
                    do i=IU_RANGE
                        var2d_re( i, j ) =
! BLD WARNING replacing pmask by pmask2
     & REAL(
     & DBLE( var2d_oa( i,j, tvar_oa( tc_oa(ic), tvc_oa(ic), ivc ) ) ) )
     &              SWITCH pmask2(i,j)
                       var2d_im( i, j ) = 
     & REAL(
     & DIMAG( var2d_oa( i,j, tvar_oa( tc_oa(ic), tvc_oa(ic), ivc ) ) ) )
     &              SWITCH pmask2(i,j)

                    enddo
                enddo
!            enddo
            vnam_oa_r = get_vnam( vnamfmt='(a5,a5,i3.3,a1,i3.3,a5)'
     &              ,vnamdp='2d_p_',vnams='_real',verbose=verbose_oa)
            vnam_oa_i = get_vnam( vnamfmt='(a5,a5,i3.3,a1,i3.3,a5)'
     &              ,vnamdp='2d_p_',vnams='_imag',verbose=verbose_oa)

! if_oa_re_im_f_2D
        else

!            do k=1,N
!                do j=Jstr,Jend
!                    do i=Istr,Iend
                do j=JV_RANGE
                    do i=IU_RANGE
                        var2d_re( i, j ) = 
     & var2d_oa( i,j, tvar_oa( tc_oa(ic), tvc_oa(ic), ivc ) )
     &              SWITCH pmask2(i,j)
 
                    enddo
                enddo
!            enddo

            vnam_oa_r = get_vnam( vnamfmt='(a5,a5,i3.3,a1,i3.3)'
     &              ,vnamdp='2d_p_',vnams='',verbose=verbose_oa)

        endif if_oa_re_im_f_2D

        endif var2d_oa_grid_point


      contains

      subroutine traces_oa_i(i,j,iiglob_tgt)        
        implicit none
        integer, intent(in)    :: i, j
        integer, intent(in)    :: iiglob_tgt
        integer                :: io_node, ii_glob

        ii_glob = i + iminmpi-1 

        if (iiglob_tgt == -999) return 
        if ( (ii_glob == iiglob_tgt) ) then
            if (iv==1) then
            io_node = 5000+mynode
            write (io_node,*) 'var2d_oa iv1 =',j,var2d_oa(i,j,tupd_oa(iv))
            else if (iv==2) then
            io_node = 6000+mynode
            write (io_node,*) 'var2d_oa iv2 =',j,var2d_oa(i,j,tupd_oa(iv))
            end if
        end if

        return
      end subroutine traces_oa_i

      subroutine trace2_oa_i(i,j,iiglob_tgt,tab2d_re,tab2d_im)        
        implicit none
        real, intent(in) :: tab2d_re
        real, intent(in) :: tab2d_im
        integer, intent(in)    :: i, j
        integer, intent(in)    :: iiglob_tgt
        integer                :: io_node, ii_glob

        ii_glob = i + iminmpi-1 
      
        if (iiglob_tgt == -999) return 
        if ( (ii_glob == iiglob_tgt) ) then
            if (iv==1) then
            io_node = 5000+mynode
            write (io_node,*) 'Re/Im var2d_oa iv1 =',j,tab2d_re
     &                                                ,tab2d_im
            else if (iv==2) then
            io_node = 6000+mynode
            write (io_node,*) 'Re/Im var2d_oa iv2 =',j,tab2d_re
     &                                                ,tab2d_im
            end if
        end if
        return
      end subroutine trace2_oa_i

!     function get_vnam( vnamfmt='(a5,a5,i3.3,a1,i3.3,a5)'
!    &                  ,vnamdp='2d_r_',vnams='_real', verbose=6)
      function get_vnam( vnamfmt
     &                  ,vnamdp,vnams,verbose)

        implicit none
        character(len=*), intent(in) :: vnamfmt,vnamdp, vnams
        integer, intent(in)           :: verbose
        !character(len=17)  intent(in) :: vnam_oa 
        !character(len=22)  intent(in) :: vnam_oa_r, vnam_oa_i 
        character(len=22)  :: get_vnam, tmpvnam !, tmpfmt 
        

!            write( vnam_oa_r, fmt='(a5,a5,i3.3,a1,i3.3,a5)') 
!& tgvnam_oa(tv_oa(iv)),'2d_r_',ic,'_',iv,'_real'
!            write( vnam_oa_i, fmt='(a5,a5,i3.3,a1,i3.3,a5)') 
!& tgvnam_oa(tv_oa(iv)),'2d_r_',ic,'_',iv,'_imag'

!            write( vnam_oa, fmt='(a5,a5,i3.3,a1,i3.3)') 
!& tgvnam_oa(tv_oa(iv)),'2d_r_',ic,'_',iv
        !tmpfmt=trim(vnamfmt)
        write( tmpvnam, fmt=trim(vnamfmt)) 
     &         tgvnam_oa(tv_oa(iv)),trim(vnamdp),ic,'_',iv,trim(vnams)
       
        if (verbose >=16 ) then
         MPI_master_only write(stdout,fmt='(a22)') 
     &   tmpvnam
         MPI_master_only write(stdout,fmt='(i3.3)') 
     &   tvar_oa(tc_oa(ic),tvc_oa(ic),ivc)
         MPI_master_only write(stdout,fmt='(3(i3.3,1x))') 
     &   tc_oa(ic), tvc_oa(ic), ivc
        end if

        get_vnam = tmpvnam 

        return
      end function get_vnam



      end subroutine var2d_oa_out_tile

#else /* ONLINE_ANALYSIS */

      subroutine var2d_oa_out_tile_empty
      return
      end subroutine var2d_oa_out_tile_empty

#endif /* ONLINE_ANALYSIS */
