Changeset 6676
- Timestamp:
- 2016-06-09T12:55:54+02:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_r6522_SIMPLIF_4/NEMOGCM/NEMO/OPA_SRC/lib_fortran.F90
r6140 r6676 61 61 CONTAINS 62 62 63 #if ! defined key_mpp_rep64 ! --- 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 array71 !!-----------------------------------------------------------------------72 INTEGER :: kdim73 REAL(wp), INTENT(in), DIMENSION(kdim) :: ptab ! input 1D array74 REAL(wp) :: glob_sum_1d ! global sum75 !!-----------------------------------------------------------------------76 !77 glob_sum_1d = SUM( ptab(:) )78 IF( lk_mpp ) CALL mpp_sum( glob_sum_1d )79 !80 END FUNCTION glob_sum_1d81 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 array87 !!-----------------------------------------------------------------------88 REAL(wp), INTENT(in), DIMENSION(:,:) :: ptab ! input 2D array89 REAL(wp) :: glob_sum_2d ! global masked sum90 !!-----------------------------------------------------------------------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_2d96 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 array103 !!-----------------------------------------------------------------------104 REAL(wp), INTENT(in), DIMENSION(:,:,:) :: ptab ! input 3D array105 REAL(wp) :: glob_sum_3d ! global masked sum106 !!107 INTEGER :: jk108 INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab109 !!-----------------------------------------------------------------------110 !111 ijpk = SIZE(ptab,3)112 !113 glob_sum_3d = 0.e0114 DO jk = 1, ijpk115 glob_sum_3d = glob_sum_3d + SUM( ptab(:,:,jk)*tmask_i(:,:) )116 END DO117 IF( lk_mpp ) CALL mpp_sum( glob_sum_3d )118 !119 END FUNCTION glob_sum_3d120 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 array127 !!-----------------------------------------------------------------------128 REAL(wp), INTENT(in), DIMENSION(:,:) :: ptab1, ptab2 ! input 2D array129 REAL(wp) , DIMENSION(2) :: glob_sum_2d_a ! global masked sum130 !!-----------------------------------------------------------------------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_a137 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 array144 !!-----------------------------------------------------------------------145 REAL(wp), INTENT(in), DIMENSION(:,:,:) :: ptab1, ptab2 ! input 3D array146 REAL(wp) , DIMENSION(2) :: glob_sum_3d_a ! global masked sum147 !!148 INTEGER :: jk149 INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab150 !!-----------------------------------------------------------------------151 !152 ijpk = SIZE(ptab1,3)153 !154 glob_sum_3d_a(:) = 0.e0155 DO jk = 1, ijpk156 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 DO159 IF( lk_mpp ) CALL mpp_sum( glob_sum_3d_a, 2 )160 !161 END FUNCTION glob_sum_3d_a162 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(:,:) :: ptab170 REAL(wp) :: glob_sum_full_2d ! global sum171 !!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_2d178 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(:,:,:) :: ptab186 REAL(wp) :: glob_sum_full_3d ! global sum187 !!188 INTEGER :: ji, jj, jk ! dummy loop indices189 INTEGER :: ijpk ! local variables: size of ptab190 !!-----------------------------------------------------------------------191 !192 ijpk = SIZE(ptab,3)193 !194 glob_sum_full_3d = 0.e0195 DO jk = 1, ijpk196 glob_sum_full_3d = glob_sum_full_3d + SUM( ptab(:,:,jk) * tmask_h(:,:) )197 END DO198 IF( lk_mpp ) CALL mpp_sum( glob_sum_full_3d )199 !200 END FUNCTION glob_sum_full_3d201 202 203 #else204 !!----------------------------------------------------------------------205 !! 'key_mpp_rep' MPP reproducibility206 !!----------------------------------------------------------------------207 208 63 ! --- SUM --- 209 64 FUNCTION glob_sum_1d( ptab, kdim ) … … 417 272 END FUNCTION glob_sum_full_3d 418 273 419 420 421 #endif422 423 274 ! --- MIN --- 424 275 FUNCTION glob_min_2d( ptab )
Note: See TracChangeset
for help on using the changeset viewer.
