lib_fortran_generic.h90

#if defined GLOBSUM_CODE
!                          ! FUNCTION FUNCTION_GLOBSUM !
#   if defined DIM_1d
#      define XD                1d
#      define ARRAY_TYPE(i,j,k)    REAL(wp)                 , INTENT(in   ) ::   ARRAY_IN(i,j,k)
#      define ARRAY_IN(i,j,k)   ptab(i)
#      define K_SIZE(ptab)      1
#      define MASK_ARRAY(i,j)   1.
#   endif
#   if defined DIM_2d
#      define XD                2d
#      define ARRAY_TYPE(i,j,k)    REAL(wp)                 , INTENT(in   ) ::   ARRAY_IN(i,j,k)
#      define ARRAY_IN(i,j,k)   ptab(i,j)
#      define K_SIZE(ptab)      1
#      define MASK_ARRAY(i,j)   tmask_i(i,j)
#   endif
#   if defined DIM_3d
#      define XD                3d
#      define ARRAY_TYPE(i,j,k)    REAL(wp)                 , INTENT(in   ) ::   ARRAY_IN(i,j,k)
#      define ARRAY_IN(i,j,k)   ptab(i,j,k)
#      define K_SIZE(ptab)      SIZE(ptab,3)
#      define MASK_ARRAY(i,j)   tmask_i(i,j)
#   endif

   FUNCTION glob_sum_/**/XD/**/( cdname, ptab )
      !!----------------------------------------------------------------------
      CHARACTER(len=*),  INTENT(in   ) ::   cdname  ! name of the calling subroutine
      ARRAY_TYPE(:,:,:)                             ! array on which operation is applied
      REAL(wp)   ::  glob_sum_/**/XD
      !
      !!-----------------------------------------------------------------------
      !
      COMPLEX(dp)::   ctmp
      REAL(wp)   ::   ztmp
      INTEGER    ::   ji, jj, jk           ! dummy loop indices
      INTEGER    ::   ipi, ipj, ipk        ! dimensions
      INTEGER    ::   iisht, ijsht
      !!-----------------------------------------------------------------------
      !
      ctmp = CMPLX( 0.e0, 0.e0, dp )   ! warning ctmp is cumulated
      !
#   if defined DIM_1d
      DO ji = 1, SIZE(ptab,1)
         CALL DDPDD( CMPLX( ptab(ji), 0.e0, dp ), ctmp )
      END DO
#   else
      ipi = SIZE(ptab,1)   ! 1st dimension
      ipj = SIZE(ptab,2)   ! 2nd dimension
      ipk = K_SIZE(ptab)   ! 3rd dimension
      !
      iisht = ( jpi - ipi ) / 2
      ijsht = ( jpj - ipj ) / 2   ! should be the same as iisht...
      !
      DO jk = 1, ipk
         DO_2D( 0, 0, 0, 0 )
            ztmp = ARRAY_IN(ji-iisht,jj-ijsht,jk) * MASK_ARRAY(ji,jj)   ! warning tmask_iis defined over the full MPI domain
            CALL DDPDD( CMPLX( ztmp, 0.e0, dp ), ctmp )
         END_2D
      END DO
#   endif
      CALL mpp_sum( cdname, ctmp )   ! sum over the global domain
      glob_sum_/**/XD = REAL(ctmp,wp)

   END FUNCTION glob_sum_/**/XD

#undef XD
#undef ARRAY_TYPE
#undef ARRAY_IN
#undef K_SIZE
#undef MASK_ARRAY
!
# endif
#if defined GLOBMINMAX_CODE
!                          ! FUNCTION FUNCTION_GLOBMINMAX !
#   if defined DIM_2d
#      define XD                2d
#      define ARRAY_TYPE(i,j,k)    REAL(wp)                 , INTENT(in   ) ::   ARRAY_IN(i,j,k)
#      define ARRAY_IN(i,j,k)   ptab(i,j)
#      define K_SIZE(ptab)      1
#   endif
#   if defined DIM_3d
#      define XD                3d
#      define ARRAY_TYPE(i,j,k)    REAL(wp)                 , INTENT(in   ) ::   ARRAY_IN(i,j,k)
#      define ARRAY_IN(i,j,k)   ptab(i,j,k)
#      define K_SIZE(ptab)      SIZE(ptab,3)
#   endif
#   if defined OPERATION_GLOBMIN
#      define OPER min
#   endif
#   if defined OPERATION_GLOBMAX
#      define OPER max
#   endif

   FUNCTION glob_/**/OPER/**/_/**/XD/**/( cdname, ptab )
      !!----------------------------------------------------------------------
      CHARACTER(len=*),  INTENT(in   ) ::   cdname  ! name of the calling subroutine
      ARRAY_TYPE(:,:,:)                             ! array on which operation is applied
      REAL(wp)   ::  glob_/**/OPER/**/_/**/XD
      !
      !!-----------------------------------------------------------------------
      !
      COMPLEX(dp)::   ctmp
      REAL(wp)   ::   ztmp
      INTEGER    ::   jk       ! dummy loop indices
      INTEGER    ::   ipi, ipj, ipk        ! dimensions
      INTEGER    ::   iisht, ijsht
      !!-----------------------------------------------------------------------
      !
      ipi = SIZE(ptab,1)   ! 1st dimension
      ipj = SIZE(ptab,2)   ! 2nd dimension
      ipk = K_SIZE(ptab)   ! 3rd dimension
      !
      iisht = ( jpi - ipi ) / 2
      ijsht = ( jpj - ipj ) / 2   ! should be the same as iisht...
      !
      ztmp = OPER/**/val( ARRAY_IN(Nis0-iisht:Nie0-iisht,Njs0-ijsht:Nje0-ijsht,1)*tmask_i(Nis0:Nie0,Njs0:Nje0) )
      DO jk = 2, ipk
         ztmp = OPER/**/(ztmp, OPER/**/val( ARRAY_IN(Nis0-iisht:Nie0-iisht,Njs0-ijsht:Nje0-ijsht,jk)*tmask_i(Nis0:Nie0,Njs0:Nje0) ))
      ENDDO

      CALL mpp_/**/OPER/**/( cdname, ztmp)

      glob_/**/OPER/**/_/**/XD = ztmp

   END FUNCTION glob_/**/OPER/**/_/**/XD

#undef XD
#undef ARRAY_TYPE
#undef ARRAY_IN
#undef K_SIZE
#undef OPER
# endif