#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