New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 4036 for branches/2013/dev_r4028_CNRS_LIM3 – NEMO

Ignore:
Timestamp:
2013-09-25T15:30:21+02:00 (11 years ago)
Author:
clem
Message:

add glob_max and glob_min

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/lib_fortran.F90

    r3764 r4036  
    55   !!====================================================================== 
    66   !! History :  3.2  !  2010-05  (M. Dunphy, R. Benshila)  Original code 
     7   !!            3.4  !  2013-06  (C. Rousset)  add glob_min, glob_max  
     8   !!                                           + 3d dim. of input is fexible (jpk, jpl...)  
    79   !!---------------------------------------------------------------------- 
    810 
    … …  
    2325 
    2426   PUBLIC   glob_sum   ! used in many places 
     27   PUBLIC   glob_min, glob_max 
    2528   PUBLIC   DDPDD      ! also used in closea module 
    2629#if defined key_nosignedzero 
    … …  
    3134      MODULE PROCEDURE glob_sum_1d, glob_sum_2d, glob_sum_3d, & 
    3235         &             glob_sum_2d_a, glob_sum_3d_a 
     36   END INTERFACE 
     37   INTERFACE glob_min 
     38      MODULE PROCEDURE glob_min_2d, glob_min_3d,glob_min_2d_a, glob_min_3d_a  
     39   END INTERFACE 
     40   INTERFACE glob_max 
     41      MODULE PROCEDURE glob_max_2d, glob_max_3d,glob_max_2d_a, glob_max_3d_a  
    3342   END INTERFACE 
    3443 
    … …  
    4958 
    5059#if ! defined key_mpp_rep 
     60   ! --- SUM --- 
     61 
    5162   FUNCTION glob_sum_1d( ptab, kdim ) 
    5263      !!----------------------------------------------------------------------- 
    … …  
    91102      !! 
    92103      INTEGER :: jk 
    93       !!----------------------------------------------------------------------- 
     104      INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab 
     105      !!----------------------------------------------------------------------- 
     106      ! 
     107      ijpk = SIZE(ptab,3) 
    94108      ! 
    95109      glob_sum_3d = 0.e0 
    96       DO jk = 1, jpk 
     110      DO jk = 1, ijpk 
    97111         glob_sum_3d = glob_sum_3d + SUM( ptab(:,:,jk)*tmask_i(:,:) ) 
    98112      END DO 
    … …  
    129143      !! 
    130144      INTEGER :: jk 
    131       !!----------------------------------------------------------------------- 
     145      INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab 
     146      !!----------------------------------------------------------------------- 
     147      ! 
     148      ijpk = SIZE(ptab1,3) 
    132149      ! 
    133150      glob_sum_3d_a(:) = 0.e0 
    134       DO jk = 1, jpk 
     151      DO jk = 1, ijpk 
    135152         glob_sum_3d_a(1) = glob_sum_3d_a(1) + SUM( ptab1(:,:,jk)*tmask_i(:,:) ) 
    136153         glob_sum_3d_a(2) = glob_sum_3d_a(2) + SUM( ptab2(:,:,jk)*tmask_i(:,:) ) 
    … …  
    140157   END FUNCTION glob_sum_3d_a 
    141158 
    142 #else 
     159   ! --- MIN --- 
     160   FUNCTION glob_min_2d( ptab )  
     161      !!----------------------------------------------------------------------- 
     162      !!                  ***  FUNCTION  glob_min_2D  *** 
     163      !! 
     164      !! ** Purpose : perform a masked min on the inner global domain of a 2D array 
     165      !!----------------------------------------------------------------------- 
     166      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab          ! input 2D array 
     167      REAL(wp)                             ::   glob_min_2d   ! global masked min 
     168      !!----------------------------------------------------------------------- 
     169      ! 
     170      glob_min_2d = MINVAL( ptab(:,:)*tmask_i(:,:) ) 
     171      IF( lk_mpp )   CALL mpp_min( glob_min_2d ) 
     172      ! 
     173   END FUNCTION glob_min_2d 
     174  
     175   FUNCTION glob_min_3d( ptab )  
     176      !!----------------------------------------------------------------------- 
     177      !!                  ***  FUNCTION  glob_min_3D  *** 
     178      !! 
     179      !! ** Purpose : perform a masked min on the inner global domain of a 3D array 
     180      !!----------------------------------------------------------------------- 
     181      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab          ! input 3D array 
     182      REAL(wp)                               ::   glob_min_3d   ! global masked min 
     183      !! 
     184      INTEGER :: jk 
     185      INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab 
     186      !!----------------------------------------------------------------------- 
     187      ! 
     188      ijpk = SIZE(ptab,3) 
     189      ! 
     190      glob_min_3d = 0.e0 
     191      DO jk = 1, ijpk 
     192         glob_min_3d = glob_min_3d + MINVAL( ptab(:,:,jk)*tmask_i(:,:) ) 
     193      END DO 
     194      IF( lk_mpp )   CALL mpp_min( glob_min_3d ) 
     195      ! 
     196   END FUNCTION glob_min_3d 
     197 
     198 
     199   FUNCTION glob_min_2d_a( ptab1, ptab2 )  
     200      !!----------------------------------------------------------------------- 
     201      !!                  ***  FUNCTION  glob_min_2D _a *** 
     202      !! 
     203      !! ** Purpose : perform a masked min on the inner global domain of two 2D array 
     204      !!----------------------------------------------------------------------- 
     205      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab1, ptab2    ! input 2D array 
     206      REAL(wp)            , DIMENSION(2)   ::   glob_min_2d_a   ! global masked min 
     207      !!----------------------------------------------------------------------- 
     208      !              
     209      glob_min_2d_a(1) = MINVAL( ptab1(:,:)*tmask_i(:,:) ) 
     210      glob_min_2d_a(2) = MINVAL( ptab2(:,:)*tmask_i(:,:) ) 
     211      IF( lk_mpp )   CALL mpp_min( glob_min_2d_a, 2 ) 
     212      ! 
     213   END FUNCTION glob_min_2d_a 
     214  
     215  
     216   FUNCTION glob_min_3d_a( ptab1, ptab2 )  
     217      !!----------------------------------------------------------------------- 
     218      !!                  ***  FUNCTION  glob_min_3D_a *** 
     219      !! 
     220      !! ** Purpose : perform a masked min on the inner global domain of two 3D array 
     221      !!----------------------------------------------------------------------- 
     222      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab1, ptab2    ! input 3D array 
     223      REAL(wp)            , DIMENSION(2)     ::   glob_min_3d_a   ! global masked min 
     224      !! 
     225      INTEGER :: jk 
     226      INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab 
     227      !!----------------------------------------------------------------------- 
     228      ! 
     229      ijpk = SIZE(ptab1,3) 
     230      ! 
     231      glob_min_3d_a(:) = 0.e0 
     232      DO jk = 1, ijpk 
     233         glob_min_3d_a(1) = glob_min_3d_a(1) + MINVAL( ptab1(:,:,jk)*tmask_i(:,:) ) 
     234         glob_min_3d_a(2) = glob_min_3d_a(2) + MINVAL( ptab2(:,:,jk)*tmask_i(:,:) ) 
     235      END DO 
     236      IF( lk_mpp )   CALL mpp_min( glob_min_3d_a, 2 ) 
     237      ! 
     238   END FUNCTION glob_min_3d_a 
     239 
     240   ! --- MAX --- 
     241   FUNCTION glob_max_2d( ptab )  
     242      !!----------------------------------------------------------------------- 
     243      !!                  ***  FUNCTION  glob_max_2D  *** 
     244      !! 
     245      !! ** Purpose : perform a masked max on the inner global domain of a 2D array 
     246      !!----------------------------------------------------------------------- 
     247      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab          ! input 2D array 
     248      REAL(wp)                             ::   glob_max_2d   ! global masked max 
     249      !!----------------------------------------------------------------------- 
     250      ! 
     251      glob_max_2d = MAXVAL( ptab(:,:)*tmask_i(:,:) ) 
     252      IF( lk_mpp )   CALL mpp_max( glob_max_2d ) 
     253      ! 
     254   END FUNCTION glob_max_2d 
     255  
     256   FUNCTION glob_max_3d( ptab )  
     257      !!----------------------------------------------------------------------- 
     258      !!                  ***  FUNCTION  glob_max_3D  *** 
     259      !! 
     260      !! ** Purpose : perform a masked max on the inner global domain of a 3D array 
     261      !!----------------------------------------------------------------------- 
     262      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab          ! input 3D array 
     263      REAL(wp)                               ::   glob_max_3d   ! global masked max 
     264      !! 
     265      INTEGER :: jk 
     266      INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab 
     267      !!----------------------------------------------------------------------- 
     268      ! 
     269      ijpk = SIZE(ptab,3) 
     270      ! 
     271      glob_max_3d = 0.e0 
     272      DO jk = 1, ijpk 
     273         glob_max_3d = glob_max_3d + MAXVAL( ptab(:,:,jk)*tmask_i(:,:) ) 
     274      END DO 
     275      IF( lk_mpp )   CALL mpp_max( glob_max_3d ) 
     276      ! 
     277   END FUNCTION glob_max_3d 
     278 
     279 
     280   FUNCTION glob_max_2d_a( ptab1, ptab2 )  
     281      !!----------------------------------------------------------------------- 
     282      !!                  ***  FUNCTION  glob_max_2D _a *** 
     283      !! 
     284      !! ** Purpose : perform a masked max on the inner global domain of two 2D array 
     285      !!----------------------------------------------------------------------- 
     286      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab1, ptab2    ! input 2D array 
     287      REAL(wp)            , DIMENSION(2)   ::   glob_max_2d_a   ! global masked max 
     288      !!----------------------------------------------------------------------- 
     289      !              
     290      glob_max_2d_a(1) = MAXVAL( ptab1(:,:)*tmask_i(:,:) ) 
     291      glob_max_2d_a(2) = MAXVAL( ptab2(:,:)*tmask_i(:,:) ) 
     292      IF( lk_mpp )   CALL mpp_max( glob_max_2d_a, 2 ) 
     293      ! 
     294   END FUNCTION glob_max_2d_a 
     295  
     296  
     297   FUNCTION glob_max_3d_a( ptab1, ptab2 )  
     298      !!----------------------------------------------------------------------- 
     299      !!                  ***  FUNCTION  glob_max_3D_a *** 
     300      !! 
     301      !! ** Purpose : perform a masked max on the inner global domain of two 3D array 
     302      !!----------------------------------------------------------------------- 
     303      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab1, ptab2    ! input 3D array 
     304      REAL(wp)            , DIMENSION(2)     ::   glob_max_3d_a   ! global masked max 
     305      !! 
     306      INTEGER :: jk 
     307      INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab 
     308      !!----------------------------------------------------------------------- 
     309      ! 
     310      ijpk = SIZE(ptab1,3) 
     311      ! 
     312      glob_max_3d_a(:) = 0.e0 
     313      DO jk = 1, ijpk 
     314         glob_max_3d_a(1) = glob_max_3d_a(1) + MAXVAL( ptab1(:,:,jk)*tmask_i(:,:) ) 
     315         glob_max_3d_a(2) = glob_max_3d_a(2) + MAXVAL( ptab2(:,:,jk)*tmask_i(:,:) ) 
     316      END DO 
     317      IF( lk_mpp )   CALL mpp_max( glob_max_3d_a, 2 ) 
     318      ! 
     319   END FUNCTION glob_max_3d_a 
     320 
     321 
     322#else   
    143323   !!---------------------------------------------------------------------- 
    144324   !!   'key_mpp_rep'                                   MPP reproducibility 
    145325   !!---------------------------------------------------------------------- 
    146  
     326    
     327   ! --- SUM --- 
    147328   FUNCTION glob_sum_1d( ptab, kdim ) 
    148329      !!---------------------------------------------------------------------- 
    … …  
    177358      !! ** Purpose : perform a sum in calling DDPDD routine 
    178359      !!---------------------------------------------------------------------- 
    179       REAL(wp), INTENT(in), DIMENSION(jpi,jpj) ::   ptab 
    180       REAL(wp)                                 ::   glob_sum_2d   ! global masked sum 
     360      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab 
     361      REAL(wp)                             ::   glob_sum_2d   ! global masked sum 
    181362      !! 
    182363      COMPLEX(wp)::   ctmp 
    … …  
    205386      !! ** Purpose : perform a sum on a 3D array in calling DDPDD routine 
    206387      !!---------------------------------------------------------------------- 
    207       REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   ptab 
    208       REAL(wp)                                     ::   glob_sum_3d   ! global masked sum 
     388      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab 
     389      REAL(wp)                               ::   glob_sum_3d   ! global masked sum 
    209390      !! 
    210391      COMPLEX(wp)::   ctmp 
    211392      REAL(wp)   ::   ztmp 
    212393      INTEGER    ::   ji, jj, jk   ! dummy loop indices 
    213       !!----------------------------------------------------------------------- 
    214       ! 
    215       ztmp = 0.e0 
    216       ctmp = CMPLX( 0.e0, 0.e0, wp ) 
    217       DO jk = 1, jpk 
     394      INTEGER    ::   ijpk ! local variables: size of ptab 
     395      !!----------------------------------------------------------------------- 
     396      ! 
     397      ijpk = SIZE(ptab,3) 
     398      ! 
     399      ztmp = 0.e0 
     400      ctmp = CMPLX( 0.e0, 0.e0, wp ) 
     401      DO jk = 1, ijpk 
    218402         DO jj = 1, jpj 
    219403            DO ji =1, jpi 
    … …  
    235419      !! ** Purpose : perform a sum on two 2D arrays in calling DDPDD routine 
    236420      !!---------------------------------------------------------------------- 
    237       REAL(wp), INTENT(in), DIMENSION(jpi,jpj) ::   ptab1, ptab2 
    238       REAL(wp)                                 ::   glob_sum_2d_a   ! global masked sum 
     421      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab1, ptab2 
     422      REAL(wp)                             ::   glob_sum_2d_a   ! global masked sum 
    239423      !! 
    240424      COMPLEX(wp)::   ctmp 
    … …  
    265449      !! ** Purpose : perform a sum on two 3D array in calling DDPDD routine 
    266450      !!---------------------------------------------------------------------- 
    267       REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   ptab1, ptab2 
    268       REAL(wp)                                     ::   glob_sum_3d_a   ! global masked sum 
     451      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab1, ptab2 
     452      REAL(wp)                               ::   glob_sum_3d_a   ! global masked sum 
    269453      !! 
    270454      COMPLEX(wp)::   ctmp 
    271455      REAL(wp)   ::   ztmp 
    272456      INTEGER    ::   ji, jj, jk   ! dummy loop indices 
    273       !!----------------------------------------------------------------------- 
    274       ! 
    275       ztmp = 0.e0 
    276       ctmp = CMPLX( 0.e0, 0.e0, wp ) 
    277       DO jk = 1, jpk 
     457      INTEGER    ::   ijpk ! local variables: size of ptab 
     458      !!----------------------------------------------------------------------- 
     459      ! 
     460      ijpk = SIZE(ptab1,3) 
     461      ! 
     462      ztmp = 0.e0 
     463      ctmp = CMPLX( 0.e0, 0.e0, wp ) 
     464      DO jk = 1, ijpk 
    278465         DO jj = 1, jpj 
    279             DO ji =1, jpi 
    280             ztmp =  ptab1(ji,jj,jk) * tmask_i(ji,jj) 
    281             CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
    282             ztmp =  ptab2(ji,jj,jk) * tmask_i(ji,jj) 
    283             CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
     466            DO ji = 1, jpi 
     467               ztmp =  ptab1(ji,jj,jk) * tmask_i(ji,jj) 
     468               CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
     469               ztmp =  ptab2(ji,jj,jk) * tmask_i(ji,jj) 
     470               CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
    284471            END DO 
    285          END DO 
     472         END DO     
    286473      END DO 
    287474      IF( lk_mpp )   CALL mpp_sum( ctmp )   ! sum over the global domain 
    288475      glob_sum_3d_a = REAL(ctmp,wp) 
    289476      ! 
    290    END FUNCTION glob_sum_3d_a 
     477   END FUNCTION glob_sum_3d_a    
     478 
     479 
     480   ! --- MIN --- 
     481   FUNCTION glob_min_2d( ptab )  
     482      !!---------------------------------------------------------------------- 
     483      !!                  ***  FUNCTION  glob_min_2d *** 
     484      !! 
     485      !! ** Purpose : perform a min in calling DDPDD routine 
     486      !!---------------------------------------------------------------------- 
     487      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab 
     488      REAL(wp)                             ::   glob_min_2d   ! global masked min 
     489      !! 
     490      COMPLEX(wp)::   ctmp 
     491      REAL(wp)   ::   ztmp 
     492      INTEGER    ::   ji, jj   ! dummy loop indices 
     493      !!----------------------------------------------------------------------- 
     494      ! 
     495      ztmp = 0.e0 
     496      ctmp = CMPLX( 0.e0, 0.e0, wp ) 
     497      DO jj = 1, jpj 
     498         DO ji = 1, jpi 
     499            ztmp =  ptab(ji,jj) * tmask_i(ji,jj) 
     500            CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
     501         END DO 
     502      END DO 
     503      IF( lk_mpp )   CALL mpp_min( ctmp )   ! min over the global domain 
     504      glob_min_2d = REAL(ctmp,wp) 
     505      ! 
     506   END FUNCTION glob_min_2d    
     507 
     508 
     509   FUNCTION glob_min_3d( ptab )  
     510      !!---------------------------------------------------------------------- 
     511      !!                  ***  FUNCTION  glob_min_3d *** 
     512      !! 
     513      !! ** Purpose : perform a min on a 3D array in calling DDPDD routine 
     514      !!---------------------------------------------------------------------- 
     515      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab 
     516      REAL(wp)                               ::   glob_min_3d   ! global masked min 
     517      !! 
     518      COMPLEX(wp)::   ctmp 
     519      REAL(wp)   ::   ztmp 
     520      INTEGER    ::   ji, jj, jk   ! dummy loop indices 
     521      INTEGER    ::   ijpk ! local variables: size of ptab 
     522      !!----------------------------------------------------------------------- 
     523      ! 
     524      ijpk = SIZE(ptab,3) 
     525      ! 
     526      ztmp = 0.e0 
     527      ctmp = CMPLX( 0.e0, 0.e0, wp ) 
     528      DO jk = 1, ijpk 
     529         DO jj = 1, jpj 
     530            DO ji = 1, jpi 
     531               ztmp =  ptab(ji,jj,jk) * tmask_i(ji,jj) 
     532               CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
     533            END DO 
     534         END DO     
     535      END DO 
     536      IF( lk_mpp )   CALL mpp_min( ctmp )   ! min over the global domain 
     537      glob_min_3d = REAL(ctmp,wp) 
     538      ! 
     539   END FUNCTION glob_min_3d    
     540 
     541 
     542   FUNCTION glob_min_2d_a( ptab1, ptab2 )  
     543      !!---------------------------------------------------------------------- 
     544      !!                  ***  FUNCTION  glob_min_2d_a *** 
     545      !! 
     546      !! ** Purpose : perform a min on two 2D arrays in calling DDPDD routine 
     547      !!---------------------------------------------------------------------- 
     548      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab1, ptab2 
     549      REAL(wp)                             ::   glob_min_2d_a   ! global masked min 
     550      !! 
     551      COMPLEX(wp)::   ctmp 
     552      REAL(wp)   ::   ztmp 
     553      INTEGER    ::   ji, jj   ! dummy loop indices 
     554      !!----------------------------------------------------------------------- 
     555      ! 
     556      ! 
     557      ztmp = 0.e0 
     558      ctmp = CMPLX( 0.e0, 0.e0, wp ) 
     559      DO jj = 1, jpj 
     560         DO ji = 1, jpi 
     561            ztmp =  ptab1(ji,jj) * tmask_i(ji,jj) 
     562            CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
     563            ztmp =  ptab2(ji,jj) * tmask_i(ji,jj) 
     564            CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
     565         END DO 
     566      END DO 
     567      IF( lk_mpp )   CALL mpp_min( ctmp )   ! min over the global domain 
     568      glob_min_2d_a = REAL(ctmp,wp) 
     569      ! 
     570   END FUNCTION glob_min_2d_a    
     571 
     572 
     573   FUNCTION glob_min_3d_a( ptab1, ptab2 )  
     574      !!---------------------------------------------------------------------- 
     575      !!                  ***  FUNCTION  glob_min_3d_a *** 
     576      !! 
     577      !! ** Purpose : perform a min on two 3D array in calling DDPDD routine 
     578      !!---------------------------------------------------------------------- 
     579      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab1, ptab2 
     580      REAL(wp)                               ::   glob_min_3d_a   ! global masked min 
     581      !! 
     582      COMPLEX(wp)::   ctmp 
     583      REAL(wp)   ::   ztmp 
     584      INTEGER    ::   ji, jj, jk   ! dummy loop indices 
     585      INTEGER    ::   ijpk ! local variables: size of ptab 
     586      !!----------------------------------------------------------------------- 
     587      ! 
     588      ijpk = SIZE(ptab1,3) 
     589      ! 
     590      ztmp = 0.e0 
     591      ctmp = CMPLX( 0.e0, 0.e0, wp ) 
     592      DO jk = 1, ijpk 
     593         DO jj = 1, jpj 
     594            DO ji = 1, jpi 
     595               ztmp =  ptab1(ji,jj,jk) * tmask_i(ji,jj) 
     596               CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
     597               ztmp =  ptab2(ji,jj,jk) * tmask_i(ji,jj) 
     598               CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
     599            END DO 
     600         END DO     
     601      END DO 
     602      IF( lk_mpp )   CALL mpp_min( ctmp )   ! min over the global domain 
     603      glob_min_3d_a = REAL(ctmp,wp) 
     604      ! 
     605   END FUNCTION glob_min_3d_a    
     606 
     607  
     608   ! --- MAX --- 
     609   FUNCTION glob_max_2d( ptab )  
     610      !!---------------------------------------------------------------------- 
     611      !!                  ***  FUNCTION  glob_max_2d *** 
     612      !! 
     613      !! ** Purpose : perform a max in calling DDPDD routine 
     614      !!---------------------------------------------------------------------- 
     615      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab 
     616      REAL(wp)                             ::   glob_max_2d   ! global masked max 
     617      !! 
     618      COMPLEX(wp)::   ctmp 
     619      REAL(wp)   ::   ztmp 
     620      INTEGER    ::   ji, jj   ! dummy loop indices 
     621      !!----------------------------------------------------------------------- 
     622      ! 
     623      ztmp = 0.e0 
     624      ctmp = CMPLX( 0.e0, 0.e0, wp ) 
     625      DO jj = 1, jpj 
     626         DO ji = 1, jpi 
     627            ztmp =  ptab(ji,jj) * tmask_i(ji,jj) 
     628            CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
     629         END DO 
     630      END DO 
     631      IF( lk_mpp )   CALL mpp_max( ctmp )   ! max over the global domain 
     632      glob_max_2d = REAL(ctmp,wp) 
     633      ! 
     634   END FUNCTION glob_max_2d    
     635 
     636 
     637   FUNCTION glob_max_3d( ptab )  
     638      !!---------------------------------------------------------------------- 
     639      !!                  ***  FUNCTION  glob_max_3d *** 
     640      !! 
     641      !! ** Purpose : perform a max on a 3D array in calling DDPDD routine 
     642      !!---------------------------------------------------------------------- 
     643      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab 
     644      REAL(wp)                               ::   glob_max_3d   ! global masked max 
     645      !! 
     646      COMPLEX(wp)::   ctmp 
     647      REAL(wp)   ::   ztmp 
     648      INTEGER    ::   ji, jj, jk   ! dummy loop indices 
     649      INTEGER    ::   ijpk ! local variables: size of ptab 
     650      !!----------------------------------------------------------------------- 
     651      ! 
     652      ijpk = SIZE(ptab,3) 
     653      ! 
     654      ztmp = 0.e0 
     655      ctmp = CMPLX( 0.e0, 0.e0, wp ) 
     656      DO jk = 1, ijpk 
     657         DO jj = 1, jpj 
     658            DO ji = 1, jpi 
     659               ztmp =  ptab(ji,jj,jk) * tmask_i(ji,jj) 
     660               CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
     661            END DO 
     662         END DO     
     663      END DO 
     664      IF( lk_mpp )   CALL mpp_max( ctmp )   ! max over the global domain 
     665      glob_max_3d = REAL(ctmp,wp) 
     666      ! 
     667   END FUNCTION glob_max_3d    
     668 
     669 
     670   FUNCTION glob_max_2d_a( ptab1, ptab2 )  
     671      !!---------------------------------------------------------------------- 
     672      !!                  ***  FUNCTION  glob_max_2d_a *** 
     673      !! 
     674      !! ** Purpose : perform a max on two 2D arrays in calling DDPDD routine 
     675      !!---------------------------------------------------------------------- 
     676      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab1, ptab2 
     677      REAL(wp)                             ::   glob_max_2d_a   ! global masked max 
     678      !! 
     679      COMPLEX(wp)::   ctmp 
     680      REAL(wp)   ::   ztmp 
     681      INTEGER    ::   ji, jj   ! dummy loop indices 
     682      !!----------------------------------------------------------------------- 
     683      ! 
     684      ! 
     685      ztmp = 0.e0 
     686      ctmp = CMPLX( 0.e0, 0.e0, wp ) 
     687      DO jj = 1, jpj 
     688         DO ji = 1, jpi 
     689            ztmp =  ptab1(ji,jj) * tmask_i(ji,jj) 
     690            CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
     691            ztmp =  ptab2(ji,jj) * tmask_i(ji,jj) 
     692            CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
     693         END DO 
     694      END DO 
     695      IF( lk_mpp )   CALL mpp_max( ctmp )   ! max over the global domain 
     696      glob_max_2d_a = REAL(ctmp,wp) 
     697      ! 
     698   END FUNCTION glob_max_2d_a    
     699 
     700 
     701   FUNCTION glob_max_3d_a( ptab1, ptab2 )  
     702      !!---------------------------------------------------------------------- 
     703      !!                  ***  FUNCTION  glob_max_3d_a *** 
     704      !! 
     705      !! ** Purpose : perform a max on two 3D array in calling DDPDD routine 
     706      !!---------------------------------------------------------------------- 
     707      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab1, ptab2 
     708      REAL(wp)                               ::   glob_max_3d_a   ! global masked max 
     709      !! 
     710      COMPLEX(wp)::   ctmp 
     711      REAL(wp)   ::   ztmp 
     712      INTEGER    ::   ji, jj, jk   ! dummy loop indices 
     713      INTEGER    ::   ijpk ! local variables: size of ptab 
     714      !!----------------------------------------------------------------------- 
     715      ! 
     716      ijpk = SIZE(ptab1,3) 
     717      ! 
     718      ztmp = 0.e0 
     719      ctmp = CMPLX( 0.e0, 0.e0, wp ) 
     720      DO jk = 1, ijpk 
     721         DO jj = 1, jpj 
     722            DO ji = 1, jpi 
     723               ztmp =  ptab1(ji,jj,jk) * tmask_i(ji,jj) 
     724               CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
     725               ztmp =  ptab2(ji,jj,jk) * tmask_i(ji,jj) 
     726               CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
     727            END DO 
     728         END DO     
     729      END DO 
     730      IF( lk_mpp )   CALL mpp_max( ctmp )   ! max over the global domain 
     731      glob_max_3d_a = REAL(ctmp,wp) 
     732      ! 
     733   END FUNCTION glob_max_3d_a    
    291734 
    292735#endif 
Note: See TracChangeset for help on using the changeset viewer.