/**/ /*-----------------------------*/ /* 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