Forked from
NEMO Workspace / Nemo
947 commits behind, 56 commits ahead of the upstream repository.
-
Sebastien MASSON authored005ca9c1
Code owners
Assign users and groups as approvers for specific file changes. Learn more.
lib_fortran_generic.h90 6.34 KiB
/**/
/*-----------------------------*/
/* 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