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 13090 – NEMO

Changeset 13090


Ignore:
Timestamp:
2020-06-10T16:44:43+02:00 (4 years ago)
Author:
andmirek
Message:

Ticket #2482: calculate sums in the same way as in #2197, commit 11069

File:
1 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/UKMO/NEMO_4.0_mirror_SI3_GPU/src/OCE/lib_fortran.F90

    r10888 r13090  
    6969   !!---------------------------------------------------------------------- 
    7070CONTAINS 
    71  
    72 #  define GLOBSUM_CODE 
    73  
    74 #     define DIM_1d 
    75 #     define FUNCTION_GLOBSUM           glob_sum_1d 
    76 #     include "lib_fortran_generic.h90" 
    77 #     undef FUNCTION_GLOBSUM 
    78 #     undef DIM_1d 
    79  
    80 #     define DIM_2d 
    81 #     define OPERATION_GLOBSUM 
    82 #     define FUNCTION_GLOBSUM           glob_sum_2d 
    83 #     include "lib_fortran_generic.h90" 
    84 #     undef FUNCTION_GLOBSUM 
    85 #     undef OPERATION_GLOBSUM 
    86 #     define OPERATION_FULL_GLOBSUM 
    87 #     define FUNCTION_GLOBSUM           glob_sum_full_2d 
    88 #     include "lib_fortran_generic.h90" 
    89 #     undef FUNCTION_GLOBSUM 
    90 #     undef OPERATION_FULL_GLOBSUM 
    91 #     undef DIM_2d 
    92  
    93 #     define DIM_3d 
    94 #     define OPERATION_GLOBSUM 
    95 #     define FUNCTION_GLOBSUM           glob_sum_3d 
    96 #     include "lib_fortran_generic.h90" 
    97 #     undef FUNCTION_GLOBSUM 
    98 #     undef OPERATION_GLOBSUM 
    99 #     define OPERATION_FULL_GLOBSUM 
    100 #     define FUNCTION_GLOBSUM           glob_sum_full_3d 
    101 #     include "lib_fortran_generic.h90" 
    102 #     undef FUNCTION_GLOBSUM 
    103 #     undef OPERATION_FULL_GLOBSUM 
    104 #     undef DIM_3d 
    105  
    106 #  undef GLOBSUM_CODE 
    107  
    108  
    109 #  define GLOBMINMAX_CODE 
    110  
    111 #     define DIM_2d 
    112 #     define OPERATION_GLOBMIN 
    113 #     define FUNCTION_GLOBMINMAX           glob_min_2d 
    114 #     include "lib_fortran_generic.h90" 
    115 #     undef FUNCTION_GLOBMINMAX 
    116 #     undef OPERATION_GLOBMIN 
    117 #     define OPERATION_GLOBMAX 
    118 #     define FUNCTION_GLOBMINMAX           glob_max_2d 
    119 #     include "lib_fortran_generic.h90" 
    120 #     undef FUNCTION_GLOBMINMAX 
    121 #     undef OPERATION_GLOBMAX 
    122 #     undef DIM_2d 
    123  
    124 #     define DIM_3d 
    125 #     define OPERATION_GLOBMIN 
    126 #     define FUNCTION_GLOBMINMAX           glob_min_3d 
    127 #     include "lib_fortran_generic.h90" 
    128 #     undef FUNCTION_GLOBMINMAX 
    129 #     undef OPERATION_GLOBMIN 
    130 #     define OPERATION_GLOBMAX 
    131 #     define FUNCTION_GLOBMINMAX           glob_max_3d 
    132 #     include "lib_fortran_generic.h90" 
    133 #     undef FUNCTION_GLOBMINMAX 
    134 #     undef OPERATION_GLOBMAX 
    135 #     undef DIM_3d 
    136 #  undef GLOBMINMAX_CODE 
    137  
    138 !                          ! FUNCTION local_sum ! 
    139  
    140    FUNCTION local_sum_2d( ptab ) 
    141       !!---------------------------------------------------------------------- 
    142       REAL(wp),  INTENT(in   ) ::   ptab(:,:) ! array on which operation is applied 
    143       COMPLEX(wp)              ::  local_sum_2d 
    144       ! 
    145       !!----------------------------------------------------------------------- 
    146       ! 
    147       COMPLEX(wp)::   ctmp 
    148       REAL(wp)   ::   ztmp 
    149       INTEGER    ::   ji, jj    ! dummy loop indices 
    150       INTEGER    ::   ipi, ipj  ! dimensions 
     71!                          ! FUNCTION glob_sum_1d ! 
     72   FUNCTION glob_sum_c1d(ptab, kdim, ldcom, cdname) 
     73      CHARACTER(len=*),  INTENT(in   ) ::   cdname  ! name of the calling subroutine 
     74      INTEGER, INTENT(IN) :: kdim 
     75      COMPLEX(KIND = wp), INTENT(IN), DIMENSION(kdim) :: ptab 
     76      LOGICAL, INTENT(IN) :: ldcom 
     77      REAL(KIND = wp) :: glob_sum_c1d 
     78 
     79      COMPLEX(KIND = wp) :: ctmp 
     80      INTEGER :: ji 
     81 
     82      ctmp = CMPLX(0.E0, 0.E0, wp) 
     83 
     84      DO ji = 1, kdim 
     85        CALL DDPDD(ptab(ji), ctmp) 
     86      END DO 
     87 
     88      IF (ldcom) CALL mpp_sum(cdname, ctmp) 
     89 
     90      glob_sum_c1d = REAL(ctmp, wp) 
     91 
     92   END FUNCTION glob_sum_c1d 
     93 
     94   FUNCTION glob_sum_1d( cdname, ptab ) 
     95      !!---------------------------------------------------------------------- 
     96      CHARACTER(len=*),  INTENT(in   ) ::   cdname  ! name of the calling subroutine 
     97      REAL(wp)                 , INTENT(in   ) ::   ptab(:)                             ! array on which operation is applied 
     98      REAL(wp)   ::  glob_sum_1d 
     99      ! 
     100      !!----------------------------------------------------------------------- 
     101      ! 
     102      REAL(wp)                              ::   FUNCTION_GLOB_OP   ! global sum 
     103      !! 
     104      COMPLEX(wp)::   ctmp 
     105      REAL(wp)   ::   ztmp 
     106      INTEGER    ::   ji, jj, jk   ! dummy loop indices 
     107      INTEGER    ::   ipi, ipj, ipk    ! dimensions 
     108      !!----------------------------------------------------------------------- 
     109      ! 
     110      ipi = SIZE(ptab,1)   ! 1st dimension 
     111      ipj = 1   ! 2nd dimension 
     112      ipk = 1   ! 3rd dimension 
     113      ! 
     114      ctmp = CMPLX( 0.e0, 0.e0, wp )   ! warning ctmp is cumulated 
     115    
     116      DO jk = 1, ipk 
     117        DO jj = 1, ipj 
     118          DO ji = 1, ipi 
     119             ztmp =  ptab(ji) * 1. 
     120             CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
     121          END DO 
     122        END DO 
     123      END DO 
     124      CALL mpp_sum( cdname, ctmp )   ! sum over the global domain 
     125      glob_sum_1d = REAL(ctmp,wp) 
     126 
     127   END FUNCTION glob_sum_1d 
     128 
     129! 
     130 
     131!                          ! FUNCTION glob_sum_2d ! 
     132 
     133   FUNCTION glob_sum_2d( cdname, ptab ) 
     134      !!---------------------------------------------------------------------- 
     135      CHARACTER(len=*),  INTENT(in   ) ::   cdname  ! name of the calling subroutine 
     136      REAL(wp)                 , INTENT(in   ) ::   ptab(:,:)                             ! array on which operation is applied 
     137      REAL(wp)   ::  glob_sum_2d 
     138      ! 
     139      !!----------------------------------------------------------------------- 
     140      ! 
     141      REAL(wp)                              ::   FUNCTION_GLOB_OP   ! global sum 
     142      !! 
     143      COMPLEX(wp)::   ctmp 
     144      REAL(wp)   ::   ztmp 
     145      INTEGER    ::   ji, jj, jk   ! dummy loop indices 
     146      INTEGER    ::   ipi, ipj, ipk    ! dimensions 
     147      COMPLEX(KIND = wp), allocatable :: hsum(:) 
    151148      !!----------------------------------------------------------------------- 
    152149      ! 
    153150      ipi = SIZE(ptab,1)   ! 1st dimension 
    154151      ipj = SIZE(ptab,2)   ! 2nd dimension 
    155       ! 
    156       ctmp = CMPLX( 0.e0, 0.e0, wp )   ! warning ctmp is cumulated 
    157  
    158       DO jj = 1, ipj 
    159          DO ji = 1, ipi 
    160             ztmp =  ptab(ji,jj) * tmask_i(ji,jj) 
    161             CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
    162          END DO 
    163       END DO 
    164       ! 
    165       local_sum_2d = ctmp 
    166         
    167    END FUNCTION local_sum_2d 
    168  
    169    FUNCTION local_sum_3d( ptab ) 
    170       !!---------------------------------------------------------------------- 
    171       REAL(wp),  INTENT(in   ) ::   ptab(:,:,:) ! array on which operation is applied 
    172       COMPLEX(wp)              ::  local_sum_3d 
    173       ! 
    174       !!----------------------------------------------------------------------- 
    175       ! 
     152      ipk = 1   ! 3rd dimension 
     153       
     154      ALLOCATE(hsum(ipj)) 
     155    
     156      DO jk = 1, ipk 
     157        DO jj = 1, ipj 
     158          ctmp = CMPLX( 0.e0, 0.e0, wp ) 
     159          DO ji = 1, ipi 
     160             ztmp =  ptab(ji,jj) * tmask_i(ji,jj) 
     161             CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
     162          END DO 
     163          hsum(jj) = ctmp 
     164        END DO 
     165      END DO 
     166 
     167      glob_sum_2d = glob_sum_c1d(hsum, ipj, .TRUE..AND.lk_mpp, cdname) 
     168 
     169      DEALLOCATE(hsum) 
     170 
     171   END FUNCTION glob_sum_2d 
     172 
     173! 
     174!                          ! FUNCTION glob_sum_full_2d ! 
     175 
     176   FUNCTION glob_sum_full_2d( cdname, ptab ) 
     177      !!---------------------------------------------------------------------- 
     178      CHARACTER(len=*),  INTENT(in   ) ::   cdname  ! name of the calling subroutine 
     179      REAL(wp)                 , INTENT(in   ) ::   ptab(:,:)                             ! array on which operation is applied 
     180      REAL(wp)   ::  glob_sum_full_2d 
     181      ! 
     182      !!----------------------------------------------------------------------- 
     183      ! 
     184      REAL(wp)                              ::   FUNCTION_GLOB_OP   ! global sum 
     185      !! 
    176186      COMPLEX(wp)::   ctmp 
    177187      REAL(wp)   ::   ztmp 
    178188      INTEGER    ::   ji, jj, jk   ! dummy loop indices 
    179189      INTEGER    ::   ipi, ipj, ipk    ! dimensions 
     190      COMPLEX(KIND = wp), allocatable :: hsum(:) 
     191      !!----------------------------------------------------------------------- 
     192      ! 
     193      ipi = SIZE(ptab,1)   ! 1st dimension 
     194      ipj = SIZE(ptab,2)   ! 2nd dimension 
     195      ipk = 1   ! 3rd dimension 
     196      ALLOCATE(hsum(ipj)) 
     197      ! 
     198      DO jk = 1, ipk 
     199        DO jj = 1, ipj 
     200          ctmp = CMPLX( 0.e0, 0.e0, wp )   ! warning ctmp is cumulated 
     201          DO ji = 1, ipi 
     202             ztmp =  ptab(ji,jj) * tmask_h(ji,jj) 
     203             CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
     204          END DO 
     205          hsum(jj) = ctmp 
     206        END DO 
     207      END DO 
     208 
     209      glob_sum_full_2d = glob_sum_c1d(hsum, ipj, .TRUE..AND.lk_mpp, cdname) 
     210 
     211      DEALLOCATE(hsum) 
     212 
     213   END FUNCTION glob_sum_full_2d 
     214 
     215! 
     216 
     217!                          ! FUNCTION glob_sum_3d ! 
     218 
     219   FUNCTION glob_sum_3d( cdname, ptab ) 
     220      !!---------------------------------------------------------------------- 
     221      CHARACTER(len=*),  INTENT(in   ) ::   cdname  ! name of the calling subroutine 
     222      REAL(wp)                 , INTENT(in   ) ::   ptab(:,:,:)                             ! array on which operation is applied 
     223      REAL(wp)   ::  glob_sum_3d 
     224      ! 
     225      !!----------------------------------------------------------------------- 
     226      ! 
     227      REAL(wp)                              ::   FUNCTION_GLOB_OP   ! global sum 
     228      !! 
     229      COMPLEX(wp)::   ctmp 
     230      REAL(wp)   ::   ztmp 
     231      INTEGER    ::   ji, jj, jk   ! dummy loop indices 
     232      INTEGER    ::   ipi, ipj, ipk    ! dimensions 
     233      COMPLEX(KIND = wp), allocatable :: hsum(:) 
    180234      !!----------------------------------------------------------------------- 
    181235      ! 
    … …  
    184238      ipk = SIZE(ptab,3)   ! 3rd dimension 
    185239      ! 
    186       ctmp = CMPLX( 0.e0, 0.e0, wp )   ! warning ctmp is cumulated 
    187  
     240      ALLOCATE(hsum(ipk)) 
     241    
    188242      DO jk = 1, ipk 
     243        ctmp = CMPLX( 0.e0, 0.e0, wp )   ! warning ctmp is cumulated 
    189244        DO jj = 1, ipj 
    190245          DO ji = 1, ipi 
    … …  
    193248          END DO 
    194249        END DO 
    195       END DO 
    196       ! 
    197       local_sum_3d = ctmp 
     250        hsum(jk) = ctmp 
     251      END DO 
     252 
     253      glob_sum_3d = glob_sum_c1d(hsum, ipk, .TRUE..AND.lk_mpp, cdname) 
     254 
     255      DEALLOCATE(hsum) 
     256 
     257   END FUNCTION glob_sum_3d 
     258 
     259! 
     260!                          ! FUNCTION glob_sum_full_3d ! 
     261 
     262   FUNCTION glob_sum_full_3d( cdname, ptab ) 
     263      !!---------------------------------------------------------------------- 
     264      CHARACTER(len=*),  INTENT(in   ) ::   cdname  ! name of the calling subroutine 
     265      REAL(wp)                 , INTENT(in   ) ::   ptab(:,:,:)                             ! array on which operation is applied 
     266      REAL(wp)   ::  glob_sum_full_3d 
     267      ! 
     268      !!----------------------------------------------------------------------- 
     269      ! 
     270      REAL(wp)                              ::   FUNCTION_GLOB_OP   ! global sum 
     271      !! 
     272      COMPLEX(wp)::   ctmp 
     273      REAL(wp)   ::   ztmp 
     274      INTEGER    ::   ji, jj, jk   ! dummy loop indices 
     275      INTEGER    ::   ipi, ipj, ipk    ! dimensions 
     276      COMPLEX(KIND = wp), allocatable :: hsum(:) 
     277      !!----------------------------------------------------------------------- 
     278      ! 
     279      ipi = SIZE(ptab,1)   ! 1st dimension 
     280      ipj = SIZE(ptab,2)   ! 2nd dimension 
     281      ipk = SIZE(ptab,3)   ! 3rd dimension 
     282      ! 
     283      ALLOCATE(hsum(ipk)) 
     284    
     285      DO jk = 1, ipk 
     286        ctmp = CMPLX( 0.e0, 0.e0, wp ) 
     287        DO jj = 1, ipj 
     288          DO ji = 1, ipi 
     289             ztmp =  ptab(ji,jj,jk) * tmask_h(ji,jj) 
     290             CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
     291          END DO 
     292        END DO 
     293        hsum(jk) = ctmp 
     294      END DO 
     295 
     296      glob_sum_full_3d = glob_sum_c1d(hsum, ipk, .TRUE..AND.lk_mpp, cdname) 
     297 
     298      DEALLOCATE(hsum) 
     299 
     300   END FUNCTION glob_sum_full_3d 
     301 
     302! 
     303 
     304 
     305 
     306 
     307!                          ! FUNCTION glob_min_2d ! 
     308 
     309   FUNCTION glob_min_2d( cdname, ptab ) 
     310      !!---------------------------------------------------------------------- 
     311      CHARACTER(len=*),  INTENT(in   ) ::   cdname  ! name of the calling subroutine 
     312      REAL(wp)                 , INTENT(in   ) ::   ptab(:,:)                             ! array on which operation is applied 
     313      REAL(wp)   ::  glob_min_2d 
     314      ! 
     315      !!----------------------------------------------------------------------- 
     316      ! 
     317      REAL(wp)                              ::   FUNCTION_GLOB_OP   ! global sum 
     318      !! 
     319      COMPLEX(wp)::   ctmp 
     320      REAL(wp)   ::   ztmp 
     321      INTEGER    ::   jk       ! dummy loop indices 
     322      INTEGER    ::   ipk      ! dimensions 
     323      !!----------------------------------------------------------------------- 
     324      ! 
     325      ipk = 1   ! 3rd dimension 
     326      ! 
     327      ztmp = minval( ptab(:,:)*tmask_i(:,:) ) 
     328 
     329      CALL mpp_min( cdname, ztmp) 
     330 
     331      glob_min_2d = ztmp 
     332 
     333 
     334   END FUNCTION glob_min_2d 
     335 
     336!                          ! FUNCTION glob_max_2d ! 
     337 
     338   FUNCTION glob_max_2d( cdname, ptab ) 
     339      !!---------------------------------------------------------------------- 
     340      CHARACTER(len=*),  INTENT(in   ) ::   cdname  ! name of the calling subroutine 
     341      REAL(wp)                 , INTENT(in   ) ::   ptab(:,:)                             ! array on which operation is applied 
     342      REAL(wp)   ::  glob_max_2d 
     343      ! 
     344      !!----------------------------------------------------------------------- 
     345      ! 
     346      REAL(wp)                              ::   FUNCTION_GLOB_OP   ! global sum 
     347      !! 
     348      COMPLEX(wp)::   ctmp 
     349      REAL(wp)   ::   ztmp 
     350      INTEGER    ::   jk       ! dummy loop indices 
     351      INTEGER    ::   ipk      ! dimensions 
     352      !!----------------------------------------------------------------------- 
     353      ! 
     354      ipk = 1   ! 3rd dimension 
     355      ! 
     356      ztmp = maxval( ptab(:,:)*tmask_i(:,:) ) 
     357 
     358      CALL mpp_max( cdname, ztmp) 
     359 
     360      glob_max_2d = ztmp 
     361 
     362 
     363   END FUNCTION glob_max_2d 
     364 
     365 
     366!                          ! FUNCTION glob_min_3d ! 
     367 
     368   FUNCTION glob_min_3d( cdname, ptab ) 
     369      !!---------------------------------------------------------------------- 
     370      CHARACTER(len=*),  INTENT(in   ) ::   cdname  ! name of the calling subroutine 
     371      REAL(wp)                 , INTENT(in   ) ::   ptab(:,:,:)                             ! array on which operation is applied 
     372      REAL(wp)   ::  glob_min_3d 
     373      ! 
     374      !!----------------------------------------------------------------------- 
     375      ! 
     376      REAL(wp)                              ::   FUNCTION_GLOB_OP   ! global sum 
     377      !! 
     378      COMPLEX(wp)::   ctmp 
     379      REAL(wp)   ::   ztmp 
     380      INTEGER    ::   jk       ! dummy loop indices 
     381      INTEGER    ::   ipk      ! dimensions 
     382      !!----------------------------------------------------------------------- 
     383      ! 
     384      ipk = SIZE(ptab,3)   ! 3rd dimension 
     385      ! 
     386      ztmp = minval( ptab(:,:,1)*tmask_i(:,:) ) 
     387      DO jk = 2, ipk 
     388         ztmp = min(ztmp, minval( ptab(:,:,jk)*tmask_i(:,:) )) 
     389      ENDDO 
     390 
     391      CALL mpp_min( cdname, ztmp) 
     392 
     393      glob_min_3d = ztmp 
     394 
     395 
     396   END FUNCTION glob_min_3d 
     397 
     398!                          ! FUNCTION glob_max_3d ! 
     399 
     400   FUNCTION glob_max_3d( cdname, ptab ) 
     401      !!---------------------------------------------------------------------- 
     402      CHARACTER(len=*),  INTENT(in   ) ::   cdname  ! name of the calling subroutine 
     403      REAL(wp)                 , INTENT(in   ) ::   ptab(:,:,:)                             ! array on which operation is applied 
     404      REAL(wp)   ::  glob_max_3d 
     405      ! 
     406      !!----------------------------------------------------------------------- 
     407      ! 
     408      REAL(wp)                              ::   FUNCTION_GLOB_OP   ! global sum 
     409      !! 
     410      COMPLEX(wp)::   ctmp 
     411      REAL(wp)   ::   ztmp 
     412      INTEGER    ::   jk       ! dummy loop indices 
     413      INTEGER    ::   ipk      ! dimensions 
     414      !!----------------------------------------------------------------------- 
     415      ! 
     416      ipk = SIZE(ptab,3)   ! 3rd dimension 
     417      ! 
     418      ztmp = maxval( ptab(:,:,1)*tmask_i(:,:) ) 
     419      DO jk = 2, ipk 
     420         ztmp = max(ztmp, maxval( ptab(:,:,jk)*tmask_i(:,:) )) 
     421      ENDDO 
     422 
     423      CALL mpp_max( cdname, ztmp) 
     424 
     425      glob_max_3d = ztmp 
     426 
     427 
     428   END FUNCTION glob_max_3d 
     429 
     430 
     431!                          ! FUNCTION local_sum ! 
     432 
     433   FUNCTION local_sum_2d( ptab ) 
     434      !!---------------------------------------------------------------------- 
     435      REAL(wp),  INTENT(in   ) ::   ptab(:,:) ! array on which operation is applied 
     436      COMPLEX(wp)              ::  local_sum_2d 
     437      ! 
     438      !!----------------------------------------------------------------------- 
     439      ! 
     440      COMPLEX(wp)::   ctmp 
     441      REAL(wp)   ::   ztmp 
     442      INTEGER    ::   ji, jj    ! dummy loop indices 
     443      INTEGER    ::   ipi, ipj  ! dimensions 
     444      COMPLEX(KIND = wp), allocatable :: hsum(:) 
     445      !!----------------------------------------------------------------------- 
     446      ! 
     447      ipi = SIZE(ptab,1)   ! 1st dimension 
     448      ipj = SIZE(ptab,2)   ! 2nd dimension 
     449      ! 
     450      ALLOCATE(hsum(ipj)) 
     451 
     452      DO jj = 1, ipj 
     453         ctmp = CMPLX( 0.e0, 0.e0, wp ) 
     454         DO ji = 1, ipi 
     455            ztmp =  ptab(ji,jj) * tmask_i(ji,jj) 
     456            CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
     457         END DO 
     458         hsum(jj) = ctmp 
     459      END DO 
     460      ! 
     461      local_sum_2d = glob_sum_c1d(hsum, ipj, .FALSE., 'NONE')   
     462 
     463      DEALLOCATE(hsum) 
    198464        
     465   END FUNCTION local_sum_2d 
     466 
     467   FUNCTION local_sum_3d( ptab ) 
     468      !!---------------------------------------------------------------------- 
     469      REAL(wp),  INTENT(in   ) ::   ptab(:,:,:) ! array on which operation is applied 
     470      COMPLEX(wp)              ::  local_sum_3d 
     471      ! 
     472      !!----------------------------------------------------------------------- 
     473      ! 
     474      COMPLEX(wp)::   ctmp 
     475      REAL(wp)   ::   ztmp 
     476      INTEGER    ::   ji, jj, jk   ! dummy loop indices 
     477      INTEGER    ::   ipi, ipj, ipk    ! dimensions 
     478      COMPLEX(KIND = wp), allocatable :: hsum(:) 
     479      !!----------------------------------------------------------------------- 
     480      ! 
     481      ipi = SIZE(ptab,1)   ! 1st dimension 
     482      ipj = SIZE(ptab,2)   ! 2nd dimension 
     483      ipk = SIZE(ptab,3)   ! 3rd dimension 
     484      ! 
     485      ALLOCATE(hsum(ipk)) 
     486      ctmp = CMPLX( 0.e0, 0.e0, wp )   ! warning ctmp is cumulated 
     487 
     488      DO jk = 1, ipk 
     489        ctmp = CMPLX( 0.e0, 0.e0, wp ) 
     490        DO jj = 1, ipj 
     491          DO ji = 1, ipi 
     492             ztmp =  ptab(ji,jj,jk) * tmask_i(ji,jj) 
     493             CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
     494          END DO 
     495        END DO 
     496        hsum(jk) = ctmp 
     497      END DO 
     498      ! 
     499      local_sum_3d = glob_sum_c1d(hsum, ipk, .FALSE., 'NONE') 
     500       
     501      DEALLOCATE(hsum)  
     502 
    199503   END FUNCTION local_sum_3d 
    200504 
Note: See TracChangeset for help on using the changeset viewer.