Changeset 6676


Ignore:
Timestamp:
2016-06-09T12:55:54+02:00 (4 years ago)
Author:
lovato
Message:

Use MPI safe computation of global sums as default (#1730)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2016/dev_r6522_SIMPLIF_4/NEMOGCM/NEMO/OPA_SRC/lib_fortran.F90

    r6140 r6676  
    6161CONTAINS 
    6262 
    63 #if ! defined key_mpp_rep 
    64    ! --- SUM --- 
    65  
    66    FUNCTION glob_sum_1d( ptab, kdim ) 
    67       !!----------------------------------------------------------------------- 
    68       !!                  ***  FUNCTION  glob_sum_1D  *** 
    69       !! 
    70       !! ** Purpose : perform a masked sum on the inner global domain of a 1D array 
    71       !!----------------------------------------------------------------------- 
    72       INTEGER :: kdim 
    73       REAL(wp), INTENT(in), DIMENSION(kdim) ::   ptab        ! input 1D array 
    74       REAL(wp)                              ::   glob_sum_1d ! global sum 
    75       !!----------------------------------------------------------------------- 
    76       ! 
    77       glob_sum_1d = SUM( ptab(:) ) 
    78       IF( lk_mpp )   CALL mpp_sum( glob_sum_1d ) 
    79       ! 
    80    END FUNCTION glob_sum_1d 
    81  
    82    FUNCTION glob_sum_2d( ptab ) 
    83       !!----------------------------------------------------------------------- 
    84       !!                  ***  FUNCTION  glob_sum_2D  *** 
    85       !! 
    86       !! ** Purpose : perform a masked sum on the inner global domain of a 2D array 
    87       !!----------------------------------------------------------------------- 
    88       REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab          ! input 2D array 
    89       REAL(wp)                             ::   glob_sum_2d   ! global masked sum 
    90       !!----------------------------------------------------------------------- 
    91       ! 
    92       glob_sum_2d = SUM( ptab(:,:)*tmask_i(:,:) ) 
    93       IF( lk_mpp )   CALL mpp_sum( glob_sum_2d ) 
    94       ! 
    95    END FUNCTION glob_sum_2d 
    96  
    97  
    98    FUNCTION glob_sum_3d( ptab ) 
    99       !!----------------------------------------------------------------------- 
    100       !!                  ***  FUNCTION  glob_sum_3D  *** 
    101       !! 
    102       !! ** Purpose : perform a masked sum on the inner global domain of a 3D array 
    103       !!----------------------------------------------------------------------- 
    104       REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab          ! input 3D array 
    105       REAL(wp)                               ::   glob_sum_3d   ! global masked sum 
    106       !! 
    107       INTEGER :: jk 
    108       INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab 
    109       !!----------------------------------------------------------------------- 
    110       ! 
    111       ijpk = SIZE(ptab,3) 
    112       ! 
    113       glob_sum_3d = 0.e0 
    114       DO jk = 1, ijpk 
    115          glob_sum_3d = glob_sum_3d + SUM( ptab(:,:,jk)*tmask_i(:,:) ) 
    116       END DO 
    117       IF( lk_mpp )   CALL mpp_sum( glob_sum_3d ) 
    118       ! 
    119    END FUNCTION glob_sum_3d 
    120  
    121  
    122    FUNCTION glob_sum_2d_a( ptab1, ptab2 ) 
    123       !!----------------------------------------------------------------------- 
    124       !!                  ***  FUNCTION  glob_sum_2D _a *** 
    125       !! 
    126       !! ** Purpose : perform a masked sum on the inner global domain of two 2D array 
    127       !!----------------------------------------------------------------------- 
    128       REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab1, ptab2    ! input 2D array 
    129       REAL(wp)            , DIMENSION(2)   ::   glob_sum_2d_a   ! global masked sum 
    130       !!----------------------------------------------------------------------- 
    131       ! 
    132       glob_sum_2d_a(1) = SUM( ptab1(:,:)*tmask_i(:,:) ) 
    133       glob_sum_2d_a(2) = SUM( ptab2(:,:)*tmask_i(:,:) ) 
    134       IF( lk_mpp )   CALL mpp_sum( glob_sum_2d_a, 2 ) 
    135       ! 
    136    END FUNCTION glob_sum_2d_a 
    137  
    138  
    139    FUNCTION glob_sum_3d_a( ptab1, ptab2 ) 
    140       !!----------------------------------------------------------------------- 
    141       !!                  ***  FUNCTION  glob_sum_3D_a *** 
    142       !! 
    143       !! ** Purpose : perform a masked sum on the inner global domain of two 3D array 
    144       !!----------------------------------------------------------------------- 
    145       REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab1, ptab2    ! input 3D array 
    146       REAL(wp)            , DIMENSION(2)     ::   glob_sum_3d_a   ! global masked sum 
    147       !! 
    148       INTEGER :: jk 
    149       INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab 
    150       !!----------------------------------------------------------------------- 
    151       ! 
    152       ijpk = SIZE(ptab1,3) 
    153       ! 
    154       glob_sum_3d_a(:) = 0.e0 
    155       DO jk = 1, ijpk 
    156          glob_sum_3d_a(1) = glob_sum_3d_a(1) + SUM( ptab1(:,:,jk)*tmask_i(:,:) ) 
    157          glob_sum_3d_a(2) = glob_sum_3d_a(2) + SUM( ptab2(:,:,jk)*tmask_i(:,:) ) 
    158       END DO 
    159       IF( lk_mpp )   CALL mpp_sum( glob_sum_3d_a, 2 ) 
    160       ! 
    161    END FUNCTION glob_sum_3d_a 
    162  
    163    FUNCTION glob_sum_full_2d( ptab ) 
    164       !!---------------------------------------------------------------------- 
    165       !!                  ***  FUNCTION  glob_sum_full_2d *** 
    166       !! 
    167       !! ** Purpose : perform a sum in calling DDPDD routine (nomask) 
    168       !!---------------------------------------------------------------------- 
    169       REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab 
    170       REAL(wp)                             ::   glob_sum_full_2d   ! global sum 
    171       !! 
    172       !!----------------------------------------------------------------------- 
    173       ! 
    174       glob_sum_full_2d = SUM( ptab(:,:) * tmask_h(:,:) ) 
    175       IF( lk_mpp )   CALL mpp_sum( glob_sum_full_2d ) 
    176       ! 
    177    END FUNCTION glob_sum_full_2d 
    178  
    179    FUNCTION glob_sum_full_3d( ptab ) 
    180       !!---------------------------------------------------------------------- 
    181       !!                  ***  FUNCTION  glob_sum_full_3d *** 
    182       !! 
    183       !! ** Purpose : perform a sum on a 3D array in calling DDPDD routine (nomask) 
    184       !!---------------------------------------------------------------------- 
    185       REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab 
    186       REAL(wp)                               ::   glob_sum_full_3d   ! global sum 
    187       !! 
    188       INTEGER    ::   ji, jj, jk   ! dummy loop indices 
    189       INTEGER    ::   ijpk ! local variables: size of ptab 
    190       !!----------------------------------------------------------------------- 
    191       ! 
    192       ijpk = SIZE(ptab,3) 
    193       ! 
    194       glob_sum_full_3d = 0.e0 
    195       DO jk = 1, ijpk 
    196          glob_sum_full_3d = glob_sum_full_3d + SUM( ptab(:,:,jk) * tmask_h(:,:) ) 
    197       END DO 
    198       IF( lk_mpp )   CALL mpp_sum( glob_sum_full_3d ) 
    199       ! 
    200    END FUNCTION glob_sum_full_3d 
    201  
    202  
    203 #else   
    204    !!---------------------------------------------------------------------- 
    205    !!   'key_mpp_rep'                                   MPP reproducibility 
    206    !!---------------------------------------------------------------------- 
    207     
    20863   ! --- SUM --- 
    20964   FUNCTION glob_sum_1d( ptab, kdim ) 
     
    417272   END FUNCTION glob_sum_full_3d 
    418273 
    419  
    420  
    421 #endif 
    422  
    423274   ! --- MIN --- 
    424275   FUNCTION glob_min_2d( ptab )  
Note: See TracChangeset for help on using the changeset viewer.