lib_fortran_generic.h90

/**/
/*-----------------------------*/
/*   DEFINE COMMON VARIABLES   */
/*-----------------------------*/
/**/
#   if defined DIM_1d
#      define XD                  1d
#      define ARRAY_IN(i,j,k,l)   ptab(i)
#   endif
#   if defined DIM_2d
#      define XD                  2d
#      define ARRAY_IN(i,j,k,l)   ptab(i,j)
#      define K_SIZE(ptab)        1
#      define L_SIZE(ptab)        1
#      define LAST_SIZE           -1
#   endif
#   if defined DIM_3d
#      define XD                  3d
#      define ARRAY_IN(i,j,k,l)   ptab(i,j,k)
#      define K_SIZE(ptab)        SIZE(ptab,3)
#      define L_SIZE(ptab)        1
#      define LAST_SIZE           SIZE(ptab,3)
#   endif
#   if defined DIM_4d
#      define XD                  4d
#      define ARRAY_IN(i,j,k,l)   ptab(i,j,k,l)
#      define K_SIZE(ptab)        SIZE(ptab,3)
#      define L_SIZE(ptab)        SIZE(ptab,4)
#      define LAST_SIZE           SIZE(ptab,4)
#   endif
#   if defined VEC
#      define ISVEC               _vec
#   else
#      define ISVEC               
#   endif
#   if defined LOCALONLY
#      define TYPENAME           local
#   else
#      define TYPENAME           glob
#   endif
/**/
/*-------------------------------*/
/*   FUNCTION FUNCTION_GLOBSUM   */
/*-------------------------------*/
/**/
#if defined GLOBSUM_CODE
/**/
/*   DEFINE LOCAL VARIABLES   */
/**/
!
#   if defined LOCALONLY
FUNCTION TYPENAME/**/_sum/**/ISVEC/**/_/**/XD/**/(         ptab ) RESULT( ptmp )
      !!----------------------------------------------------------------------
#   else
FUNCTION TYPENAME/**/_sum/**/ISVEC/**/_/**/XD/**/( cdname, ptab ) RESULT( ptmp )
      !!----------------------------------------------------------------------
      CHARACTER(len=*), INTENT(in   ) ::   cdname  ! name of the calling subroutine
#   endif
      REAL(wp)        , INTENT(in   ) ::   ARRAY_IN(:,:,:,:)   ! array on which operation is applied
      !
#   if defined VEC
      REAL(wp)   , DIMENSION(LAST_SIZE) ::   ptmp
      COMPLEX(dp), DIMENSION(LAST_SIZE) ::   ctmp
#   else
      REAL(wp)   ::  ptmp
      COMPLEX(dp)::   ctmp
#   endif
      INTEGER    ::    ji,  jj,  jk,  jl        ! dummy loop indices
      INTEGER    ::   ipi, ipj, ipk, ipl        ! dimensions
      INTEGER    ::   iisht, ijsht
      !!-----------------------------------------------------------------------
      !
#  if defined DIM_1d
      ctmp = CMPLX( 0.e0, 0.e0, dp )   ! warning ctmp is cumulated
      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
      ipl = L_SIZE(ptab)   ! 4th dimension
      !
      iisht = ( jpi - ipi ) / 2
      ijsht = ( jpj - ipj ) / 2   ! should be the same as iisht...
      !
      ctmp = CMPLX( 0.e0, 0.e0, dp )   ! warning ctmp is cumulated
      !
      DO jl = 1, ipl
         DO jk = 1, ipk
            DO_2D( 0, 0, 0, 0 )
               ! warning tmask_i is defined over the full MPI domain but maybe not ptab
#   define ARRAY_LOOP             ARRAY_IN(ji-iisht,jj-ijsht,jk,jl) * tmask_i(ji,jj)
#   if   defined VEC && defined DIM_3d
               CALL DDPDD( CMPLX( ARRAY_LOOP, 0.e0, dp ), ctmp(jk) )
#   endif
#   if   defined VEC && defined DIM_4d
               CALL DDPDD( CMPLX( ARRAY_LOOP, 0.e0, dp ), ctmp(jl) )
#   endif
#   if ! defined VEC
               CALL DDPDD( CMPLX( ARRAY_LOOP, 0.e0, dp ), ctmp )
#   endif
            END_2D
         END DO
      END DO
      !
#  endif
#  if defined LOCALONLY
      ptmp = ctmp
#  else       
      CALL mpp_sum( cdname, ctmp )   ! sum over the global domain
      ptmp = REAL(ctmp, wp)
#  endif
      !
   END FUNCTION TYPENAME/**/_sum/**/ISVEC/**/_/**/XD
!
# endif
/**/
/*----------------------------------*/
/*   FUNCTION FUNCTION_GLOBMINMAX   */
/*----------------------------------*/
/**/
#if defined GLOBMINMAX_CODE
/**/
/*   DEFINE LOCAL VARIABLES   */
/**/
#   if defined OPERATION_GLOBMIN
#      define OPER      min
#      define DEFAULT   HUGE(1._wp)
#   endif
#   if defined OPERATION_GLOBMAX
#      define OPER      max
#      define DEFAULT   -HUGE(1._wp)
#   endif
!
#   if defined LOCALONLY
   FUNCTION TYPENAME/**/_/**/OPER/**//**/ISVEC/**/_/**/XD/**/(         ptab ) RESULT( ptmp )
      !!----------------------------------------------------------------------
#   else
   FUNCTION TYPENAME/**/_/**/OPER/**//**/ISVEC/**/_/**/XD/**/( cdname, ptab ) RESULT( ptmp )
      !!----------------------------------------------------------------------
      CHARACTER(len=*), INTENT(in   ) ::   cdname  ! name of the calling subroutine
#   endif
      REAL(wp)        , INTENT(in   ) ::   ARRAY_IN(:,:,:,:)   ! array on which operation is applied
      !
#   if defined VEC
      REAL(wp), DIMENSION(LAST_SIZE) ::   ptmp
#   else
      REAL(wp)   ::  ptmp
#   endif
      INTEGER    ::    ji,  jj,  jk,  jl        ! dummy loop indices
      INTEGER    ::   ipi, ipj, ipk, ipl        ! dimensions
      INTEGER    ::   iisht, ijsht
      !!-----------------------------------------------------------------------
      !
      ipi = SIZE(ptab,1)   ! 1st dimension
      ipj = SIZE(ptab,2)   ! 2nd dimension
      ipk = K_SIZE(ptab)   ! 3rd dimension
      ipl = L_SIZE(ptab)   ! 4th dimension
      !
      iisht = ( jpi - ipi ) / 2
      ijsht = ( jpj - ipj ) / 2   ! should be the same as iisht...
      !
      ptmp = DEFAULT
      !
      DO jl = 1, ipl
         DO jk = 1, ipk
#   define ARRAY_LOOP   ARRAY_IN(Nis0-iisht:Nie0-iisht,Njs0-ijsht:Nje0-ijsht,jk,jl)*tmask_i(Nis0:Nie0,Njs0:Nje0) 
#   if   defined VEC && defined DIM_3d
            ptmp(jk) = OPER/**/( ptmp(jk), OPER/**/val( ARRAY_LOOP ) )
#   endif
#   if   defined VEC && defined DIM_4d
            ptmp(jl) = OPER/**/( ptmp(jl), OPER/**/val( ARRAY_LOOP ) )
#   endif
#   if ! defined VEC
            ptmp     = OPER/**/( ptmp    , OPER/**/val( ARRAY_LOOP ) )
#   endif
         END DO
      END DO
      !
#   if ! defined LOCAL
      CALL mpp_/**/OPER/**/( cdname, ptmp )
#   endif
      !
   END FUNCTION TYPENAME/**/_/**/OPER/**//**/ISVEC/**/_/**/XD
!
#   undef DEFAULT
#   undef OPER
# endif
/**/
/*                               */
/*   UNDEFINE COMMON VARIABLES   */
/*                               */
/**/
#undef XD
#undef ARRAY_IN
#   if ! defined DIM_1d  
#undef K_SIZE
#undef L_SIZE
#undef LAST_SIZE
#   endif
#undef ISVEC
#undef TYPENAME
#undef ARRAY_LOOP