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 3963 for branches/2013/dev_r3406_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/lib_fortran.F90 – NEMO

Ignore:
Timestamp:
2013-07-09T17:41:20+02:00 (11 years ago)
Author:
clem
Message:

bugs correction + creation of glob_max and glob_min in lib_fortran.F90, see ticket:#1116

File:
1 edited

Legend:

Unmodified
Added
Removed

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

    r3294 r3963  
    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 
     27   PUBLIC glob_min, glob_max 
    2528#if defined key_nosignedzero 
    2629   PUBLIC SIGN 
    … …  
    2932   INTERFACE glob_sum 
    3033      MODULE PROCEDURE glob_sum_2d, glob_sum_3d,glob_sum_2d_a, glob_sum_3d_a  
     34   END INTERFACE 
     35   INTERFACE glob_min 
     36      MODULE PROCEDURE glob_min_2d, glob_min_3d,glob_min_2d_a, glob_min_3d_a  
     37   END INTERFACE 
     38   INTERFACE glob_max 
     39      MODULE PROCEDURE glob_max_2d, glob_max_3d,glob_max_2d_a, glob_max_3d_a  
    3140   END INTERFACE 
    3241 
    … …  
    4756 
    4857#if ! defined key_mpp_rep 
     58 
     59   ! --- SUM --- 
    4960   FUNCTION glob_sum_2d( ptab )  
    5061      !!----------------------------------------------------------------------- 
    … …  
    6172      ! 
    6273   END FUNCTION glob_sum_2d 
    63     
    64     
     74   
    6575   FUNCTION glob_sum_3d( ptab )  
    6676      !!----------------------------------------------------------------------- 
    … …  
    7383      !! 
    7484      INTEGER :: jk 
    75       !!----------------------------------------------------------------------- 
     85      INTEGER :: zjpk ! local variable: size of the 3d dimension of ptab 
     86      !!----------------------------------------------------------------------- 
     87      ! 
     88      zjpk = SIZE(ptab,3) 
    7689      ! 
    7790      glob_sum_3d = 0.e0 
    78       DO jk = 1, jpk 
     91      DO jk = 1, zjpk 
    7992         glob_sum_3d = glob_sum_3d + SUM( ptab(:,:,jk)*tmask_i(:,:) ) 
    8093      END DO 
    … …  
    111124      !! 
    112125      INTEGER :: jk 
    113       !!----------------------------------------------------------------------- 
     126      INTEGER :: zjpk ! local variable: size of the 3d dimension of ptab 
     127      !!----------------------------------------------------------------------- 
     128      ! 
     129      zjpk = SIZE(ptab1,3) 
    114130      ! 
    115131      glob_sum_3d_a(:) = 0.e0 
    116       DO jk = 1, jpk 
     132      DO jk = 1, zjpk 
    117133         glob_sum_3d_a(1) = glob_sum_3d_a(1) + SUM( ptab1(:,:,jk)*tmask_i(:,:) ) 
    118134         glob_sum_3d_a(2) = glob_sum_3d_a(2) + SUM( ptab2(:,:,jk)*tmask_i(:,:) ) 
    … …  
    121137      ! 
    122138   END FUNCTION glob_sum_3d_a 
     139  
     140 
     141   ! --- MIN --- 
     142   FUNCTION glob_min_2d( ptab )  
     143      !!----------------------------------------------------------------------- 
     144      !!                  ***  FUNCTION  glob_min_2D  *** 
     145      !! 
     146      !! ** Purpose : perform a masked min on the inner global domain of a 2D array 
     147      !!----------------------------------------------------------------------- 
     148      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab          ! input 2D array 
     149      REAL(wp)                             ::   glob_min_2d   ! global masked min 
     150      !!----------------------------------------------------------------------- 
     151      ! 
     152      glob_min_2d = MINVAL( ptab(:,:)*tmask_i(:,:) ) 
     153      IF( lk_mpp )   CALL mpp_min( glob_min_2d ) 
     154      ! 
     155   END FUNCTION glob_min_2d 
     156  
     157   FUNCTION glob_min_3d( ptab )  
     158      !!----------------------------------------------------------------------- 
     159      !!                  ***  FUNCTION  glob_min_3D  *** 
     160      !! 
     161      !! ** Purpose : perform a masked min on the inner global domain of a 3D array 
     162      !!----------------------------------------------------------------------- 
     163      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab          ! input 3D array 
     164      REAL(wp)                               ::   glob_min_3d   ! global masked min 
     165      !! 
     166      INTEGER :: jk 
     167      INTEGER :: zjpk ! local variable: size of the 3d dimension of ptab 
     168      !!----------------------------------------------------------------------- 
     169      ! 
     170      zjpk = SIZE(ptab,3) 
     171      ! 
     172      glob_min_3d = 0.e0 
     173      DO jk = 1, zjpk 
     174         glob_min_3d = glob_min_3d + MINVAL( ptab(:,:,jk)*tmask_i(:,:) ) 
     175      END DO 
     176      IF( lk_mpp )   CALL mpp_min( glob_min_3d ) 
     177      ! 
     178   END FUNCTION glob_min_3d 
     179 
     180 
     181   FUNCTION glob_min_2d_a( ptab1, ptab2 )  
     182      !!----------------------------------------------------------------------- 
     183      !!                  ***  FUNCTION  glob_min_2D _a *** 
     184      !! 
     185      !! ** Purpose : perform a masked min on the inner global domain of two 2D array 
     186      !!----------------------------------------------------------------------- 
     187      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab1, ptab2    ! input 2D array 
     188      REAL(wp)            , DIMENSION(2)   ::   glob_min_2d_a   ! global masked min 
     189      !!----------------------------------------------------------------------- 
     190      !              
     191      glob_min_2d_a(1) = MINVAL( ptab1(:,:)*tmask_i(:,:) ) 
     192      glob_min_2d_a(2) = MINVAL( ptab2(:,:)*tmask_i(:,:) ) 
     193      IF( lk_mpp )   CALL mpp_min( glob_min_2d_a, 2 ) 
     194      ! 
     195   END FUNCTION glob_min_2d_a 
     196  
     197  
     198   FUNCTION glob_min_3d_a( ptab1, ptab2 )  
     199      !!----------------------------------------------------------------------- 
     200      !!                  ***  FUNCTION  glob_min_3D_a *** 
     201      !! 
     202      !! ** Purpose : perform a masked min on the inner global domain of two 3D array 
     203      !!----------------------------------------------------------------------- 
     204      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab1, ptab2    ! input 3D array 
     205      REAL(wp)            , DIMENSION(2)     ::   glob_min_3d_a   ! global masked min 
     206      !! 
     207      INTEGER :: jk 
     208      INTEGER :: zjpk ! local variable: size of the 3d dimension of ptab 
     209      !!----------------------------------------------------------------------- 
     210      ! 
     211      zjpk = SIZE(ptab1,3) 
     212      ! 
     213      glob_min_3d_a(:) = 0.e0 
     214      DO jk = 1, zjpk 
     215         glob_min_3d_a(1) = glob_min_3d_a(1) + MINVAL( ptab1(:,:,jk)*tmask_i(:,:) ) 
     216         glob_min_3d_a(2) = glob_min_3d_a(2) + MINVAL( ptab2(:,:,jk)*tmask_i(:,:) ) 
     217      END DO 
     218      IF( lk_mpp )   CALL mpp_min( glob_min_3d_a, 2 ) 
     219      ! 
     220   END FUNCTION glob_min_3d_a 
     221 
     222   ! --- MAX --- 
     223   FUNCTION glob_max_2d( ptab )  
     224      !!----------------------------------------------------------------------- 
     225      !!                  ***  FUNCTION  glob_max_2D  *** 
     226      !! 
     227      !! ** Purpose : perform a masked max on the inner global domain of a 2D array 
     228      !!----------------------------------------------------------------------- 
     229      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab          ! input 2D array 
     230      REAL(wp)                             ::   glob_max_2d   ! global masked max 
     231      !!----------------------------------------------------------------------- 
     232      ! 
     233      glob_max_2d = MAXVAL( ptab(:,:)*tmask_i(:,:) ) 
     234      IF( lk_mpp )   CALL mpp_max( glob_max_2d ) 
     235      ! 
     236   END FUNCTION glob_max_2d 
     237  
     238   FUNCTION glob_max_3d( ptab )  
     239      !!----------------------------------------------------------------------- 
     240      !!                  ***  FUNCTION  glob_max_3D  *** 
     241      !! 
     242      !! ** Purpose : perform a masked max on the inner global domain of a 3D array 
     243      !!----------------------------------------------------------------------- 
     244      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab          ! input 3D array 
     245      REAL(wp)                               ::   glob_max_3d   ! global masked max 
     246      !! 
     247      INTEGER :: jk 
     248      INTEGER :: zjpk ! local variable: size of the 3d dimension of ptab 
     249      !!----------------------------------------------------------------------- 
     250      ! 
     251      zjpk = SIZE(ptab,3) 
     252      ! 
     253      glob_max_3d = 0.e0 
     254      DO jk = 1, zjpk 
     255         glob_max_3d = glob_max_3d + MAXVAL( ptab(:,:,jk)*tmask_i(:,:) ) 
     256      END DO 
     257      IF( lk_mpp )   CALL mpp_max( glob_max_3d ) 
     258      ! 
     259   END FUNCTION glob_max_3d 
     260 
     261 
     262   FUNCTION glob_max_2d_a( ptab1, ptab2 )  
     263      !!----------------------------------------------------------------------- 
     264      !!                  ***  FUNCTION  glob_max_2D _a *** 
     265      !! 
     266      !! ** Purpose : perform a masked max on the inner global domain of two 2D array 
     267      !!----------------------------------------------------------------------- 
     268      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab1, ptab2    ! input 2D array 
     269      REAL(wp)            , DIMENSION(2)   ::   glob_max_2d_a   ! global masked max 
     270      !!----------------------------------------------------------------------- 
     271      !              
     272      glob_max_2d_a(1) = MAXVAL( ptab1(:,:)*tmask_i(:,:) ) 
     273      glob_max_2d_a(2) = MAXVAL( ptab2(:,:)*tmask_i(:,:) ) 
     274      IF( lk_mpp )   CALL mpp_max( glob_max_2d_a, 2 ) 
     275      ! 
     276   END FUNCTION glob_max_2d_a 
     277  
     278  
     279   FUNCTION glob_max_3d_a( ptab1, ptab2 )  
     280      !!----------------------------------------------------------------------- 
     281      !!                  ***  FUNCTION  glob_max_3D_a *** 
     282      !! 
     283      !! ** Purpose : perform a masked max on the inner global domain of two 3D array 
     284      !!----------------------------------------------------------------------- 
     285      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab1, ptab2    ! input 3D array 
     286      REAL(wp)            , DIMENSION(2)     ::   glob_max_3d_a   ! global masked max 
     287      !! 
     288      INTEGER :: jk 
     289      INTEGER :: zjpk ! local variable: size of the 3d dimension of ptab 
     290      !!----------------------------------------------------------------------- 
     291      ! 
     292      zjpk = SIZE(ptab1,3) 
     293      ! 
     294      glob_max_3d_a(:) = 0.e0 
     295      DO jk = 1, zjpk 
     296         glob_max_3d_a(1) = glob_max_3d_a(1) + MAXVAL( ptab1(:,:,jk)*tmask_i(:,:) ) 
     297         glob_max_3d_a(2) = glob_max_3d_a(2) + MAXVAL( ptab2(:,:,jk)*tmask_i(:,:) ) 
     298      END DO 
     299      IF( lk_mpp )   CALL mpp_max( glob_max_3d_a, 2 ) 
     300      ! 
     301   END FUNCTION glob_max_3d_a 
     302 
    123303 
    124304#else   
    … …  
    127307   !!---------------------------------------------------------------------- 
    128308    
     309   ! --- SUM --- 
    129310   FUNCTION glob_sum_2d( ptab )  
    130311      !!---------------------------------------------------------------------- 
    … …  
    133314      !! ** Purpose : perform a sum in calling DDPDD routine 
    134315      !!---------------------------------------------------------------------- 
    135       REAL(wp), INTENT(in), DIMENSION(jpi,jpj) ::   ptab 
    136       REAL(wp)                                 ::   glob_sum_2d   ! global masked sum 
     316      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab 
     317      REAL(wp)                             ::   glob_sum_2d   ! global masked sum 
    137318      !! 
    138319      COMPLEX(wp)::   ctmp 
    139320      REAL(wp)   ::   ztmp 
    140321      INTEGER    ::   ji, jj   ! dummy loop indices 
    141       !!----------------------------------------------------------------------- 
    142       ! 
    143       ztmp = 0.e0 
    144       ctmp = CMPLX( 0.e0, 0.e0, wp ) 
    145       DO jj = 1, jpj 
    146          DO ji =1, jpi 
     322      INTEGER    ::   zjpi, zjpj ! local variables: size of ptab 
     323      !!----------------------------------------------------------------------- 
     324      zjpi = SIZE(ptab,1) 
     325      zjpj = SIZE(ptab,2) 
     326      ! 
     327      ztmp = 0.e0 
     328      ctmp = CMPLX( 0.e0, 0.e0, wp ) 
     329      DO jj = 1, zjpj 
     330         DO ji =1, zjpi 
    147331         ztmp =  ptab(ji,jj) * tmask_i(ji,jj) 
    148332         CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
    … …  
    161345      !! ** Purpose : perform a sum on a 3D array in calling DDPDD routine 
    162346      !!---------------------------------------------------------------------- 
    163       REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   ptab 
    164       REAL(wp)                                     ::   glob_sum_3d   ! global masked sum 
     347      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab 
     348      REAL(wp)                               ::   glob_sum_3d   ! global masked sum 
    165349      !! 
    166350      COMPLEX(wp)::   ctmp 
    167351      REAL(wp)   ::   ztmp 
    168352      INTEGER    ::   ji, jj, jk   ! dummy loop indices 
    169       !!----------------------------------------------------------------------- 
    170       ! 
    171       ztmp = 0.e0 
    172       ctmp = CMPLX( 0.e0, 0.e0, wp ) 
    173       DO jk = 1, jpk 
    174          DO jj = 1, jpj 
    175             DO ji =1, jpi 
     353      INTEGER    ::   zjpi, zjpj, zjpk ! local variables: size of ptab 
     354      !!----------------------------------------------------------------------- 
     355      ! 
     356      zjpi = SIZE(ptab,1) 
     357      zjpj = SIZE(ptab,2) 
     358      zjpk = SIZE(ptab,3) 
     359      ! 
     360      ztmp = 0.e0 
     361      ctmp = CMPLX( 0.e0, 0.e0, wp ) 
     362      DO jk = 1, zjpk 
     363         DO jj = 1, zjpj 
     364            DO ji =1, zjpi 
    176365            ztmp =  ptab(ji,jj,jk) * tmask_i(ji,jj) 
    177366            CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
    … …  
    191380      !! ** Purpose : perform a sum on two 2D arrays in calling DDPDD routine 
    192381      !!---------------------------------------------------------------------- 
    193       REAL(wp), INTENT(in), DIMENSION(jpi,jpj) ::   ptab1, ptab2 
    194       REAL(wp)                                 ::   glob_sum_2d_a   ! global masked sum 
     382      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab1, ptab2 
     383      REAL(wp)                             ::   glob_sum_2d_a   ! global masked sum 
    195384      !! 
    196385      COMPLEX(wp)::   ctmp 
    197386      REAL(wp)   ::   ztmp 
    198387      INTEGER    ::   ji, jj   ! dummy loop indices 
    199       !!----------------------------------------------------------------------- 
    200       ! 
    201       ztmp = 0.e0 
    202       ctmp = CMPLX( 0.e0, 0.e0, wp ) 
    203       DO jj = 1, jpj 
    204          DO ji =1, jpi 
     388      INTEGER    ::   zjpi, zjpj ! local variables: size of ptab 
     389      !!----------------------------------------------------------------------- 
     390      ! 
     391      zjpi = SIZE(ptab1,1) 
     392      zjpj = SIZE(ptab1,2) 
     393      ! 
     394      ztmp = 0.e0 
     395      ctmp = CMPLX( 0.e0, 0.e0, wp ) 
     396      DO jj = 1, zjpj 
     397         DO ji =1, zjpi 
    205398         ztmp =  ptab1(ji,jj) * tmask_i(ji,jj) 
    206399         CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
    … …  
    221414      !! ** Purpose : perform a sum on two 3D array in calling DDPDD routine 
    222415      !!---------------------------------------------------------------------- 
    223       REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   ptab1, ptab2 
    224       REAL(wp)                                     ::   glob_sum_3d_a   ! global masked sum 
     416      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab1, ptab2 
     417      REAL(wp)                               ::   glob_sum_3d_a   ! global masked sum 
    225418      !! 
    226419      COMPLEX(wp)::   ctmp 
    227420      REAL(wp)   ::   ztmp 
    228421      INTEGER    ::   ji, jj, jk   ! dummy loop indices 
    229       !!----------------------------------------------------------------------- 
    230       ! 
    231       ztmp = 0.e0 
    232       ctmp = CMPLX( 0.e0, 0.e0, wp ) 
    233       DO jk = 1, jpk 
    234          DO jj = 1, jpj 
    235             DO ji =1, jpi 
     422      INTEGER    ::   zjpi, zjpj, zjpk ! local variables: size of ptab 
     423      !!----------------------------------------------------------------------- 
     424      ! 
     425      zjpi = SIZE(ptab1,1) 
     426      zjpj = SIZE(ptab1,2) 
     427      zjpk = SIZE(ptab1,3) 
     428      ! 
     429      ztmp = 0.e0 
     430      ctmp = CMPLX( 0.e0, 0.e0, wp ) 
     431      DO jk = 1, zjpk 
     432         DO jj = 1, zjpj 
     433            DO ji =1, zjpi 
    236434            ztmp =  ptab1(ji,jj,jk) * tmask_i(ji,jj) 
    237435            CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
    … …  
    247445 
    248446 
     447   ! --- MIN --- 
     448   FUNCTION glob_min_2d( ptab )  
     449      !!---------------------------------------------------------------------- 
     450      !!                  ***  FUNCTION  glob_min_2d *** 
     451      !! 
     452      !! ** Purpose : perform a min in calling DDPDD routine 
     453      !!---------------------------------------------------------------------- 
     454      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab 
     455      REAL(wp)                             ::   glob_min_2d   ! global masked min 
     456      !! 
     457      COMPLEX(wp)::   ctmp 
     458      REAL(wp)   ::   ztmp 
     459      INTEGER    ::   ji, jj   ! dummy loop indices 
     460      INTEGER    ::   zjpi, zjpj ! local variables: size of ptab 
     461      !!----------------------------------------------------------------------- 
     462      zjpi = SIZE(ptab,1) 
     463      zjpj = SIZE(ptab,2) 
     464      ! 
     465      ztmp = 0.e0 
     466      ctmp = CMPLX( 0.e0, 0.e0, wp ) 
     467      DO jj = 1, zjpj 
     468         DO ji =1, zjpi 
     469         ztmp =  ptab(ji,jj) * tmask_i(ji,jj) 
     470         CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
     471         END DO 
     472      END DO 
     473      IF( lk_mpp )   CALL mpp_min( ctmp )   ! min over the global domain 
     474      glob_min_2d = REAL(ctmp,wp) 
     475      ! 
     476   END FUNCTION glob_min_2d    
     477 
     478 
     479   FUNCTION glob_min_3d( ptab )  
     480      !!---------------------------------------------------------------------- 
     481      !!                  ***  FUNCTION  glob_min_3d *** 
     482      !! 
     483      !! ** Purpose : perform a min on a 3D array in calling DDPDD routine 
     484      !!---------------------------------------------------------------------- 
     485      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab 
     486      REAL(wp)                               ::   glob_min_3d   ! global masked min 
     487      !! 
     488      COMPLEX(wp)::   ctmp 
     489      REAL(wp)   ::   ztmp 
     490      INTEGER    ::   ji, jj, jk   ! dummy loop indices 
     491      INTEGER    ::   zjpi, zjpj, zjpk ! local variables: size of ptab 
     492      !!----------------------------------------------------------------------- 
     493      ! 
     494      zjpi = SIZE(ptab,1) 
     495      zjpj = SIZE(ptab,2) 
     496      zjpk = SIZE(ptab,3) 
     497      ! 
     498      ztmp = 0.e0 
     499      ctmp = CMPLX( 0.e0, 0.e0, wp ) 
     500      DO jk = 1, zjpk 
     501         DO jj = 1, zjpj 
     502            DO ji =1, zjpi 
     503            ztmp =  ptab(ji,jj,jk) * tmask_i(ji,jj) 
     504            CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
     505            END DO 
     506         END DO     
     507      END DO 
     508      IF( lk_mpp )   CALL mpp_min( ctmp )   ! min over the global domain 
     509      glob_min_3d = REAL(ctmp,wp) 
     510      ! 
     511   END FUNCTION glob_min_3d    
     512 
     513 
     514   FUNCTION glob_min_2d_a( ptab1, ptab2 )  
     515      !!---------------------------------------------------------------------- 
     516      !!                  ***  FUNCTION  glob_min_2d_a *** 
     517      !! 
     518      !! ** Purpose : perform a min on two 2D arrays in calling DDPDD routine 
     519      !!---------------------------------------------------------------------- 
     520      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab1, ptab2 
     521      REAL(wp)                             ::   glob_min_2d_a   ! global masked min 
     522      !! 
     523      COMPLEX(wp)::   ctmp 
     524      REAL(wp)   ::   ztmp 
     525      INTEGER    ::   ji, jj   ! dummy loop indices 
     526      INTEGER    ::   zjpi, zjpj ! local variables: size of ptab 
     527      !!----------------------------------------------------------------------- 
     528      ! 
     529      zjpi = SIZE(ptab1,1) 
     530      zjpj = SIZE(ptab1,2) 
     531      ! 
     532      ztmp = 0.e0 
     533      ctmp = CMPLX( 0.e0, 0.e0, wp ) 
     534      DO jj = 1, zjpj 
     535         DO ji =1, zjpi 
     536         ztmp =  ptab1(ji,jj) * tmask_i(ji,jj) 
     537         CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
     538         ztmp =  ptab2(ji,jj) * tmask_i(ji,jj) 
     539         CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
     540         END DO 
     541      END DO 
     542      IF( lk_mpp )   CALL mpp_min( ctmp )   ! min over the global domain 
     543      glob_min_2d_a = REAL(ctmp,wp) 
     544      ! 
     545   END FUNCTION glob_min_2d_a    
     546 
     547 
     548   FUNCTION glob_min_3d_a( ptab1, ptab2 )  
     549      !!---------------------------------------------------------------------- 
     550      !!                  ***  FUNCTION  glob_min_3d_a *** 
     551      !! 
     552      !! ** Purpose : perform a min on two 3D array in calling DDPDD routine 
     553      !!---------------------------------------------------------------------- 
     554      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab1, ptab2 
     555      REAL(wp)                               ::   glob_min_3d_a   ! global masked min 
     556      !! 
     557      COMPLEX(wp)::   ctmp 
     558      REAL(wp)   ::   ztmp 
     559      INTEGER    ::   ji, jj, jk   ! dummy loop indices 
     560      INTEGER    ::   zjpi, zjpj, zjpk ! local variables: size of ptab 
     561      !!----------------------------------------------------------------------- 
     562      ! 
     563      zjpi = SIZE(ptab1,1) 
     564      zjpj = SIZE(ptab1,2) 
     565      zjpk = SIZE(ptab1,3) 
     566      ! 
     567      ztmp = 0.e0 
     568      ctmp = CMPLX( 0.e0, 0.e0, wp ) 
     569      DO jk = 1, zjpk 
     570         DO jj = 1, zjpj 
     571            DO ji =1, zjpi 
     572            ztmp =  ptab1(ji,jj,jk) * tmask_i(ji,jj) 
     573            CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
     574            ztmp =  ptab2(ji,jj,jk) * tmask_i(ji,jj) 
     575            CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
     576            END DO 
     577         END DO     
     578      END DO 
     579      IF( lk_mpp )   CALL mpp_min( ctmp )   ! min over the global domain 
     580      glob_min_3d_a = REAL(ctmp,wp) 
     581      ! 
     582   END FUNCTION glob_min_3d_a    
     583 
     584  
     585   ! --- MAX --- 
     586   FUNCTION glob_max_2d( ptab )  
     587      !!---------------------------------------------------------------------- 
     588      !!                  ***  FUNCTION  glob_max_2d *** 
     589      !! 
     590      !! ** Purpose : perform a max in calling DDPDD routine 
     591      !!---------------------------------------------------------------------- 
     592      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab 
     593      REAL(wp)                             ::   glob_max_2d   ! global masked max 
     594      !! 
     595      COMPLEX(wp)::   ctmp 
     596      REAL(wp)   ::   ztmp 
     597      INTEGER    ::   ji, jj   ! dummy loop indices 
     598      INTEGER    ::   zjpi, zjpj ! local variables: size of ptab 
     599      !!----------------------------------------------------------------------- 
     600      zjpi = SIZE(ptab,1) 
     601      zjpj = SIZE(ptab,2) 
     602      ! 
     603      ztmp = 0.e0 
     604      ctmp = CMPLX( 0.e0, 0.e0, wp ) 
     605      DO jj = 1, zjpj 
     606         DO ji =1, zjpi 
     607         ztmp =  ptab(ji,jj) * tmask_i(ji,jj) 
     608         CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
     609         END DO 
     610      END DO 
     611      IF( lk_mpp )   CALL mpp_max( ctmp )   ! max over the global domain 
     612      glob_max_2d = REAL(ctmp,wp) 
     613      ! 
     614   END FUNCTION glob_max_2d    
     615 
     616 
     617   FUNCTION glob_max_3d( ptab )  
     618      !!---------------------------------------------------------------------- 
     619      !!                  ***  FUNCTION  glob_max_3d *** 
     620      !! 
     621      !! ** Purpose : perform a max on a 3D array in calling DDPDD routine 
     622      !!---------------------------------------------------------------------- 
     623      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab 
     624      REAL(wp)                               ::   glob_max_3d   ! global masked max 
     625      !! 
     626      COMPLEX(wp)::   ctmp 
     627      REAL(wp)   ::   ztmp 
     628      INTEGER    ::   ji, jj, jk   ! dummy loop indices 
     629      INTEGER    ::   zjpi, zjpj, zjpk ! local variables: size of ptab 
     630      !!----------------------------------------------------------------------- 
     631      ! 
     632      zjpi = SIZE(ptab,1) 
     633      zjpj = SIZE(ptab,2) 
     634      zjpk = SIZE(ptab,3) 
     635      ! 
     636      ztmp = 0.e0 
     637      ctmp = CMPLX( 0.e0, 0.e0, wp ) 
     638      DO jk = 1, zjpk 
     639         DO jj = 1, zjpj 
     640            DO ji =1, zjpi 
     641            ztmp =  ptab(ji,jj,jk) * tmask_i(ji,jj) 
     642            CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
     643            END DO 
     644         END DO     
     645      END DO 
     646      IF( lk_mpp )   CALL mpp_max( ctmp )   ! max over the global domain 
     647      glob_max_3d = REAL(ctmp,wp) 
     648      ! 
     649   END FUNCTION glob_max_3d    
     650 
     651 
     652   FUNCTION glob_max_2d_a( ptab1, ptab2 )  
     653      !!---------------------------------------------------------------------- 
     654      !!                  ***  FUNCTION  glob_max_2d_a *** 
     655      !! 
     656      !! ** Purpose : perform a max on two 2D arrays in calling DDPDD routine 
     657      !!---------------------------------------------------------------------- 
     658      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab1, ptab2 
     659      REAL(wp)                             ::   glob_max_2d_a   ! global masked max 
     660      !! 
     661      COMPLEX(wp)::   ctmp 
     662      REAL(wp)   ::   ztmp 
     663      INTEGER    ::   ji, jj   ! dummy loop indices 
     664      INTEGER    ::   zjpi, zjpj ! local variables: size of ptab 
     665      !!----------------------------------------------------------------------- 
     666      ! 
     667      zjpi = SIZE(ptab1,1) 
     668      zjpj = SIZE(ptab1,2) 
     669      ! 
     670      ztmp = 0.e0 
     671      ctmp = CMPLX( 0.e0, 0.e0, wp ) 
     672      DO jj = 1, zjpj 
     673         DO ji =1, zjpi 
     674         ztmp =  ptab1(ji,jj) * tmask_i(ji,jj) 
     675         CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
     676         ztmp =  ptab2(ji,jj) * tmask_i(ji,jj) 
     677         CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
     678         END DO 
     679      END DO 
     680      IF( lk_mpp )   CALL mpp_max( ctmp )   ! max over the global domain 
     681      glob_max_2d_a = REAL(ctmp,wp) 
     682      ! 
     683   END FUNCTION glob_max_2d_a    
     684 
     685 
     686   FUNCTION glob_max_3d_a( ptab1, ptab2 )  
     687      !!---------------------------------------------------------------------- 
     688      !!                  ***  FUNCTION  glob_max_3d_a *** 
     689      !! 
     690      !! ** Purpose : perform a max on two 3D array in calling DDPDD routine 
     691      !!---------------------------------------------------------------------- 
     692      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab1, ptab2 
     693      REAL(wp)                               ::   glob_max_3d_a   ! global masked max 
     694      !! 
     695      COMPLEX(wp)::   ctmp 
     696      REAL(wp)   ::   ztmp 
     697      INTEGER    ::   ji, jj, jk   ! dummy loop indices 
     698      INTEGER    ::   zjpi, zjpj, zjpk ! local variables: size of ptab 
     699      !!----------------------------------------------------------------------- 
     700      ! 
     701      zjpi = SIZE(ptab1,1) 
     702      zjpj = SIZE(ptab1,2) 
     703      zjpk = SIZE(ptab1,3) 
     704      ! 
     705      ztmp = 0.e0 
     706      ctmp = CMPLX( 0.e0, 0.e0, wp ) 
     707      DO jk = 1, zjpk 
     708         DO jj = 1, zjpj 
     709            DO ji =1, zjpi 
     710            ztmp =  ptab1(ji,jj,jk) * tmask_i(ji,jj) 
     711            CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
     712            ztmp =  ptab2(ji,jj,jk) * tmask_i(ji,jj) 
     713            CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
     714            END DO 
     715         END DO     
     716      END DO 
     717      IF( lk_mpp )   CALL mpp_max( ctmp )   ! max over the global domain 
     718      glob_max_3d_a = REAL(ctmp,wp) 
     719      ! 
     720   END FUNCTION glob_max_3d_a    
     721 
     722 
    249723   SUBROUTINE DDPDD( ydda, yddb ) 
    250724      !!---------------------------------------------------------------------- 
Note: See TracChangeset for help on using the changeset viewer.