Changeset 11069


Ignore:
Timestamp:
2019-06-03T12:23:43+02:00 (8 months ago)
Author:
andmirek
Message:

ticket #2197 glob sum for parallel architecture

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/UKMO/dev_r10037_GPU/src/OCE/lib_fortran.F90

    r10843 r11069  
    8989   END FUNCTION glob_sum_1d 
    9090 
     91   FUNCTION glob_sum_c1d(ptab, kdim) 
     92      INTEGER, INTENT(IN) :: kdim 
     93      COMPLEX(KIND = wp), INTENT(IN), DIMENSION(kdim) :: ptab 
     94      REAL(KIND = wp) :: glob_sum_c1d 
     95      COMPLEX(KIND = wp) :: ctmp 
     96      INTEGER :: ji 
     97 
     98      ctmp = CMPLX(0.E0, 0.E0, wp) 
     99 
     100      DO ji = 1, kdim 
     101        CALL DDPDD(ptab(ji), ctmp) 
     102      END DO 
     103 
     104      IF (lk_mpp) CALL mpp_sum(ctmp) 
     105 
     106      glob_sum_c1d = REAL(ctmp, wp) 
     107   END FUNCTION glob_sum_c1d 
     108 
    91109   FUNCTION glob_sum_2d( ptab ) 
    92110      !!---------------------------------------------------------------------- 
     
    101119      REAL(wp)   ::   ztmp 
    102120      INTEGER    ::   ji, jj   ! dummy loop indices 
    103       !!----------------------------------------------------------------------- 
    104       ! 
    105       ztmp = 0.e0 
    106       ctmp = CMPLX( 0.e0, 0.e0, wp ) 
     121      COMPLEX(KIND = wp) :: hsum(jpj) 
     122      !!----------------------------------------------------------------------- 
     123      ! 
    107124      DO jj = 1, jpj 
     125         ctmp = CMPLX( 0.e0, 0.e0, wp ) 
    108126         DO ji =1, jpi 
    109          ztmp =  ptab(ji,jj) * tmask_i(ji,jj) 
    110          CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
     127            ztmp =  ptab(ji,jj) * tmask_i(ji,jj) 
     128            CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
    111129         END DO 
    112       END DO 
    113       IF( lk_mpp )   CALL mpp_sum( ctmp )   ! sum over the global domain 
    114       glob_sum_2d = REAL(ctmp,wp) 
     130         hsum(jj) = ctmp 
     131      END DO 
     132      glob_sum_2d = glob_sum_c1d(hsum, jpj) 
    115133      ! 
    116134   END FUNCTION glob_sum_2d 
     
    130148      INTEGER    ::   ji, jj, jk   ! dummy loop indices 
    131149      INTEGER    ::   ijpk ! local variables: size of ptab 
     150      COMPLEX(KIND = wp), allocatable :: hsum(:) 
    132151      !!----------------------------------------------------------------------- 
    133152      ! 
    134153      ijpk = SIZE(ptab,3) 
    135       ! 
    136       ztmp = 0.e0 
    137       ctmp = CMPLX( 0.e0, 0.e0, wp ) 
     154      ALLOCATE(hsum(ijpk)) 
     155      ! 
    138156      DO jk = 1, ijpk 
     157         ctmp = CMPLX( 0.e0, 0.e0, wp ) 
    139158         DO jj = 1, jpj 
    140159            DO ji =1, jpi 
     
    143162            END DO 
    144163         END DO 
    145       END DO 
    146       IF( lk_mpp )   CALL mpp_sum( ctmp )   ! sum over the global domain 
    147       glob_sum_3d = REAL(ctmp,wp) 
     164         hsum(jk) = ctmp 
     165      END DO 
     166      glob_sum_3d = glob_sum_c1d(hsum, ijpk)  
     167      DEALLOCATE(hsum) 
    148168      ! 
    149169   END FUNCTION glob_sum_3d 
     
    162182      REAL(wp)   ::   ztmp 
    163183      INTEGER    ::   ji, jj   ! dummy loop indices 
    164       !!----------------------------------------------------------------------- 
    165       ! 
    166       ztmp = 0.e0 
    167       ctmp = CMPLX( 0.e0, 0.e0, wp ) 
     184      COMPLEX(KIND = wp) :: hsum(jpj) 
     185      !!----------------------------------------------------------------------- 
     186      ! 
    168187      DO jj = 1, jpj 
     188         ctmp = CMPLX( 0.e0, 0.e0, wp ) 
    169189         DO ji =1, jpi 
    170          ztmp =  ptab1(ji,jj) * tmask_i(ji,jj) 
    171          CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
    172          ztmp =  ptab2(ji,jj) * tmask_i(ji,jj) 
    173          CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
     190            ztmp =  ptab1(ji,jj) * tmask_i(ji,jj) 
     191            CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
     192            ztmp =  ptab2(ji,jj) * tmask_i(ji,jj) 
     193            CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
    174194         END DO 
    175       END DO 
    176       IF( lk_mpp )   CALL mpp_sum( ctmp )   ! sum over the global domain 
    177       glob_sum_2d_a = REAL(ctmp,wp) 
     195         hsum(jj) = ctmp 
     196      END DO 
     197      glob_sum_2d_a = glob_sum_c1d(hsum, jpj) 
    178198      ! 
    179199   END FUNCTION glob_sum_2d_a 
     
    193213      INTEGER    ::   ji, jj, jk   ! dummy loop indices 
    194214      INTEGER    ::   ijpk ! local variables: size of ptab 
     215      COMPLEX(KIND = wp), allocatable :: hsum(:) 
    195216      !!----------------------------------------------------------------------- 
    196217      ! 
    197218      ijpk = SIZE(ptab1,3) 
    198       ! 
    199       ztmp = 0.e0 
    200       ctmp = CMPLX( 0.e0, 0.e0, wp ) 
     219      ALLOCATE(hsum(ijpk)) 
     220      ! 
    201221      DO jk = 1, ijpk 
     222         ctmp = CMPLX( 0.e0, 0.e0, wp ) 
    202223         DO jj = 1, jpj 
    203224            DO ji = 1, jpi 
     
    208229            END DO 
    209230         END DO     
    210       END DO 
    211       IF( lk_mpp )   CALL mpp_sum( ctmp )   ! sum over the global domain 
    212       glob_sum_3d_a = REAL(ctmp,wp) 
     231         hsum(jk) = ctmp 
     232      END DO 
     233      glob_sum_3d_a = glob_sum_c1d(hsum, ijpk) 
     234      DEALLOCATE(hsum) 
    213235      ! 
    214236   END FUNCTION glob_sum_3d_a    
     
    226248      REAL(wp)   ::   ztmp 
    227249      INTEGER    ::   ji, jj   ! dummy loop indices 
    228       !!----------------------------------------------------------------------- 
    229       ! 
    230       ztmp = 0.e0 
    231       ctmp = CMPLX( 0.e0, 0.e0, wp ) 
     250      COMPLEX(KIND = wp) :: hsum(jpj) 
     251      !!----------------------------------------------------------------------- 
     252      ! 
    232253      DO jj = 1, jpj 
     254         ctmp = CMPLX( 0.e0, 0.e0, wp ) 
    233255         DO ji =1, jpi 
    234          ztmp =  ptab(ji,jj) * tmask_h(ji,jj)  
    235          CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
     256            ztmp =  ptab(ji,jj) * tmask_h(ji,jj)  
     257            CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
    236258         END DO 
    237       END DO 
    238       IF( lk_mpp )   CALL mpp_sum( ctmp )   ! sum over the global domain 
    239       glob_sum_full_2d = REAL(ctmp,wp) 
     259         hsum(jj) = ctmp 
     260      END DO 
     261      glob_sum_full_2d = glob_sum_c1d(hsum, jpj) 
    240262      ! 
    241263   END FUNCTION glob_sum_full_2d 
     
    254276      INTEGER    ::   ji, jj, jk   ! dummy loop indices 
    255277      INTEGER    ::   ijpk ! local variables: size of ptab 
     278      COMPLEX(KIND = wp), allocatable :: hsum(:) 
    256279      !!----------------------------------------------------------------------- 
    257280      ! 
    258281      ijpk = SIZE(ptab,3) 
    259       ! 
    260       ztmp = 0.e0 
    261       ctmp = CMPLX( 0.e0, 0.e0, wp ) 
     282      ALLOCATE(hsum(ijpk)) 
     283      ! 
    262284      DO jk = 1, ijpk 
     285         ctmp = CMPLX( 0.e0, 0.e0, wp ) 
    263286         DO jj = 1, jpj 
    264287            DO ji =1, jpi 
     
    267290            END DO 
    268291         END DO 
    269       END DO 
    270       IF( lk_mpp )   CALL mpp_sum( ctmp )   ! sum over the global domain 
    271       glob_sum_full_3d = REAL(ctmp,wp) 
     292         hsum(jk) = ctmp 
     293      END DO 
     294      glob_sum_full_3d = glob_sum_c1d(hsum, ijpk) 
     295      DEALLOCATE(hsum) 
    272296      ! 
    273297   END FUNCTION glob_sum_full_3d 
Note: See TracChangeset for help on using the changeset viewer.