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(dp)                 , INTENT(in   ) ::   ARRAY_IN(i,j,k)
#      define ARRAY_IN(i,j,k)   ptab(i)
#      define ARRAY2_IN(i,j,k)  ptab2(i)
#      define J_SIZE(ptab)      1
#      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(dp)                 , INTENT(in   ) ::   ARRAY_IN(i,j,k)
#      define ARRAY_IN(i,j,k)   ptab(i,j)
#      define ARRAY2_IN(i,j,k)  ptab2(i,j)
#      define J_SIZE(ptab)      SIZE(ptab,2)
#      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(dp)                 , INTENT(in   ) ::   ARRAY_IN(i,j,k)
#      define ARRAY_IN(i,j,k)   ptab(i,j,k)
#      define ARRAY2_IN(i,j,k)  ptab2(i,j,k)
#      define J_SIZE(ptab)      SIZE(ptab,2)
#      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    ::   iis, iie, ijs, ije   ! loop start and end
      !!-----------------------------------------------------------------------
      !
      ipi = SIZE(ptab,1)   ! 1st dimension
      ipj = J_SIZE(ptab)   ! 2nd dimension
      ipk = K_SIZE(ptab)   ! 3rd dimension
      !
      IF( ipi == jpi .AND. ipj == jpj ) THEN   ! do 2D loop only over the inner domain (-> avoid to use undefined values)
         iis = Nis0   ;   iie = Nie0
         ijs = Njs0   ;   ije = Nje0
      ELSE
         iis = 1   ;   iie = jpi
         ijs = 1   ;   ije = jpj
      ENDIF
      !
      ctmp = CMPLX( 0._dp, 0._dp, dp )   ! warning ctmp is cumulated
      DO jk = 1, ipk
        DO jj = ijs, ije
          DO ji = iis, iie
             ztmp =  ARRAY_IN(ji,jj,jk) * MASK_ARRAY(ji,jj)
             CALL DDPDD( CMPLX( ztmp, 0._wp, dp ), ctmp )
          END DO
        END DO
      END DO
      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 ARRAY2_TYPE
#undef ARRAY_IN
#undef ARRAY2_IN
#undef J_SIZE
#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(dp)                 , INTENT(in   ) ::   ARRAY_IN(i,j,k)
#      define ARRAY_IN(i,j,k)   ptab(i,j)
#      define ARRAY2_IN(i,j,k)  ptab2(i,j)
#      define K_SIZE(ptab)      1
#   endif
#   if defined DIM_3d
#      define XD                3d
#      define ARRAY_TYPE(i,j,k)    REAL(dp)                 , INTENT(in   ) ::   ARRAY_IN(i,j,k)
#      define ARRAY_IN(i,j,k)   ptab(i,j,k)
#      define ARRAY2_IN(i,j,k)  ptab2(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
      !
      !!-----------------------------------------------------------------------
      !
      REAL(wp)   ::   ztmp
      INTEGER    ::   jk       ! dummy loop indices
      INTEGER    ::   ipk      ! dimensions
      !!-----------------------------------------------------------------------
      !
      ipk = K_SIZE(ptab)   ! 3rd dimension
      !
      ztmp = OPER/**/val( ARRAY_IN(:,:,1)*tmask_i(:,:) )
      DO jk = 2, ipk
         ztmp = OPER/**/(ztmp, OPER/**/val( ARRAY_IN(:,:,jk)*tmask_i(:,:) ))
      ENDDO

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

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

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

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