MODULE gridsum !!====================================================================== !! *** MODULE gridsum *** !! NEMOVAR: Horizontal sum values !!====================================================================== !!---------------------------------------------------------------------- !! max_value : Find maximum value of interior points in a 2D/3D field !! min_value : Find minimum value of interior points in a 2D/3D field !! global_sum : Compute the global sum of a 2D/3D field !! global_sum_weig : Compute the global weighted sum of a 2D/3D field !! zonal_sum : Compute the zonal sum of a 2D field !!---------------------------------------------------------------------- !! * Modules used USE par_kind ! Kind variables USE dom_oce ! Domain variables USE lib_mpp ! MPP stuff USE mppsumtam ! Reproducible sum USE mpp_tam ! MPP stuff IMPLICIT NONE !! * Routine accessibility PRIVATE PUBLIC & & max_value, & & min_value, & & global_sum, & & global_sum_weig, & & zonal_sum !! * Interfaces INTERFACE max_value MODULE PROCEDURE max_value_2d MODULE PROCEDURE max_value_3d END INTERFACE INTERFACE min_value MODULE PROCEDURE min_value_2d MODULE PROCEDURE min_value_3d END INTERFACE INTERFACE global_sum MODULE PROCEDURE global_sum_2d MODULE PROCEDURE global_sum_3d END INTERFACE INTERFACE global_sum_weig MODULE PROCEDURE global_sum_weig_2d MODULE PROCEDURE global_sum_weig_3d END INTERFACE CONTAINS FUNCTION max_value_2d( pfld ) !!---------------------------------------------------------------------- !! *** ROUTINE max_value_2d *** !! !! ** Purpose : Find the global maximum of pfld !! !! ** Method : Call the mpp_max routine, The result is !! available on all processors !! !! ** Action : !! !! References : !! !! History : !! ! 07-07 (K. Mogensen) Original code !!---------------------------------------------------------------------- !! * Function return REAL(wp) :: max_value_2d !! * Arguments REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: & & pfld ! Field to be averaged !! * Local declarations real(wp) :: & & ztmp ! Get max with mpp_max ztmp = MAXVAL( pfld(nldi:nlei,nldj:nlej) ) IF( lk_mpp ) CALL mpp_max( ztmp ) max_value_2d = ztmp END FUNCTION max_value_2d FUNCTION max_value_3d( pfld ) !!---------------------------------------------------------------------- !! *** ROUTINE max_value_3d *** !! !! ** Purpose : Find the global maximum of pfld !! !! ** Method : Call the mpp_max routine, The result is !! available on all processors !! !! ** Action : !! !! References : !! !! History : !! ! 07-07 (K. Mogensen) Original code !!---------------------------------------------------------------------- !! * Function return REAL(wp) :: max_value_3d !! * Arguments REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(IN) :: & & pfld ! Field to be averaged !! * Local declarations real(wp) :: & & ztmp ! Get max with mpp_max ztmp = MAXVAL( pfld(nldi:nlei,nldj:nlej,:) ) IF( lk_mpp ) CALL mpp_max( ztmp ) max_value_3d = ztmp END FUNCTION max_value_3d FUNCTION min_value_2d( pfld ) !!---------------------------------------------------------------------- !! *** ROUTINE min_value_2d *** !! !! ** Purpose : Find the global minimum of pfld !! !! ** Method : Call the mpp_min routine, The result is !! available on all processors !! !! ** Action : !! !! References : !! !! History : !! ! 07-07 (K. Mogensen) Original code !!---------------------------------------------------------------------- !! * Function return REAL(wp) :: min_value_2d !! * Arguments REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: & & pfld ! Field to be averaged !! * Local declarations real(wp) :: & & ztmp ! Get min with mpp_min ztmp = MINVAL( pfld(nldi:nlei,nldj:nlej) ) IF( lk_mpp ) CALL mpp_min( ztmp ) min_value_2d = ztmp END FUNCTION min_value_2d FUNCTION min_value_3d( pfld ) !!---------------------------------------------------------------------- !! *** ROUTINE min_value_3d *** !! !! ** Purpose : Find the global minimum of pfld !! !! ** Method : Call the mpp_min_real routine, The result is !! available on all processors !! !! ** Action : !! !! References : !! !! History : !! ! 07-07 (K. Mogensen) Original code !!---------------------------------------------------------------------- !! * Function return REAL(wp) :: min_value_3d !! * Arguments REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(IN) :: & & pfld ! Field to be averaged !! * Local declarations real(wp) :: & & ztmp ! Get min with mpp_min ztmp = MINVAL(pfld(nldi:nlei,nldj:nlej,:)) IF( lk_mpp ) CALL mpp_min( ztmp ) min_value_3d = ztmp END FUNCTION min_value_3d FUNCTION global_sum_2d( pfld ) !!---------------------------------------------------------------------- !! *** ROUTINE global_sum_2d *** !! !! ** Purpose : Compute the global sum of pfld !! !! ** Method : Call the mppsum routine, The result is available !! on all processors !! !! ** Action : !! !! References : !! !! History : !! ! 07-07 (K. Mogensen) Original code !!---------------------------------------------------------------------- !! * Function return REAL(wp) :: global_sum_2d !! * Arguments REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: & & pfld ! Field to be averaged !! * Local declarations ! Compute sum using the mppsum module global_sum_2d = mpp_sum_inter( PACK( pfld(nldi:nlei,nldj:nlej), .TRUE. ), & & ( nlei - nldi + 1 ) * ( nlej - nldj + 1 ) ) END FUNCTION global_sum_2d FUNCTION global_sum_3d( pfld ) !!---------------------------------------------------------------------- !! *** ROUTINE global_sum_3d *** !! !! ** Purpose : Compute the global sum of pfld !! !! ** Method : Call the mppsum routine, The result is available !! on all processors !! !! ** Action : !! !! References : !! !! History : !! ! 07-07 (K. Mogensen) Original code !!---------------------------------------------------------------------- !! * Function return REAL(wp) :: global_sum_3d !! * Arguments REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(IN) :: & & pfld ! Field to be averaged !! * Local declarations ! Compute sum using the mppsum module global_sum_3d = mpp_sum_inter( PACK( pfld(nldi:nlei,nldj:nlej,1:jpk), .TRUE. ), & & ( nlei - nldi + 1 ) * ( nlej - nldj + 1 ) * jpk ) END FUNCTION global_sum_3d FUNCTION global_sum_weig_2d( pfld, pweig ) !!---------------------------------------------------------------------- !! *** ROUTINE global_sum_weig_2d *** !! !! ** Purpose : Compute the global sum of pfld weighted by pweig !! !! ** Method : Call the mppsum routine, The result is available !! on all processors !! !! ** Action : !! !! References : !! !! History : !! ! 07-07 (K. Mogensen) Original code !!---------------------------------------------------------------------- !! * Function return REAL(wp) :: global_sum_weig_2d !! * Arguments REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: & & pfld, & ! Field to be averaged & pweig !! * Local declarations REAL(wp), DIMENSION(jpi,jpj) :: & & zwrk ! Apply wieghts zwrk(:,:) = pfld(:,:) * pweig(:,:) ! Compute sum using the mppsum module global_sum_weig_2d = mpp_sum_inter( PACK( zwrk(nldi:nlei,nldj:nlej), & & .TRUE. ), & & ( nlei - nldi + 1 ) * & & ( nlej - nldj + 1 ) ) END FUNCTION global_sum_weig_2d FUNCTION global_sum_weig_3d( pfld, pweig ) !!---------------------------------------------------------------------- !! *** ROUTINE global_sum_weig_2d *** !! !! ** Purpose : Compute the global sum of pfld weighted by pweig !! !! ** Method : Call the mppsum routine, The result is available !! on all processors !! !! ** Action : !! !! References : !! !! History : !! ! 07-07 (K. Mogensen) Original code !!---------------------------------------------------------------------- !! * Function return REAL(wp) :: global_sum_weig_3d !! * Arguments REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(IN) :: & & pfld, & ! Field to be averaged & pweig !! * Local declarations REAL(wp), DIMENSION(jpi,jpj,jpk) :: & & zwrk ! Apply wieghts zwrk(:,:,:) = pfld(:,:,:) * pweig(:,:,:) ! Compute sum using the mppsum module global_sum_weig_3d = mpp_sum_inter( PACK( zwrk(nldi:nlei,nldj:nlej,1:jpk), & & .TRUE. ), & & ( nlei - nldi + 1 ) * & & ( nlej - nldj + 1 ) * jpk ) END FUNCTION global_sum_weig_3d SUBROUTINE zonal_sum( pfld, pweig, pout ) !!---------------------------------------------------------------------- !! *** ROUTINE zonal_sum *** !! !! ** Purpose : Compute the zonal sum of pfld weighted by pweig !! !! ** Method : Put local data unto a global grid and call the !! mppsum routine for all latitudes. !! !! This should be done in a more optimum way !!! !! !! The result is available on all processors !! !! ** Action : !! !! References : !! !! History : !! ! 07-07 (K. Mogensen) Original code !!---------------------------------------------------------------------- !! * Arguments REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: & & pfld, & ! Field to be averaged & pweig REAL(wp), DIMENSION(jpjglo), INTENT(OUT) :: & & pout !! * Local declarations REAL(wp), DIMENSION(:,:), ALLOCATABLE :: & & zwrk INTEGER :: & & ji, & & jj, & & ii, & & ij ! Allocate and fill global array with local input data ALLOCATE( & & zwrk(jpiglo,jpjglo) & & ) zwrk(:,:) = 0.0 DO jj = nldj, nlej ij = mjg(jj) DO ji = nldi, nlei ii = mig(ji) zwrk(ii,ij) = pfld(ji,jj) * pweig(ji,jj) ENDDO ENDDO ! Sum individual latitudes DO jj = 1, jpjglo pout(jj) = mpp_sum_inter( zwrk(:,jj), jpiglo ) ENDDO ! Deallocate the work array DEALLOCATE(zwrk) END SUBROUTINE zonal_sum END MODULE gridsum