Changeset 3289 for branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC
- Timestamp:
- 2012-01-27T15:37:34+01:00 (12 years ago)
- Location:
- branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 2 edited
-
lib_fortran.F90 (modified) (14 diffs)
-
nemogcm.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/lib_fortran.F90
r2528 r3289 47 47 48 48 #if ! defined key_mpp_rep 49 FUNCTION glob_sum_2d( ptab ) RESULT( glob_sum )49 FUNCTION glob_sum_2d( ptab ) 50 50 !!----------------------------------------------------------------------- 51 51 !! *** FUNCTION glob_sum_2D *** … … 53 53 !! ** Purpose : perform a masked sum on the inner global domain of a 2D array 54 54 !!----------------------------------------------------------------------- 55 REAL(wp), INTENT(in), DIMENSION(:,:) :: ptab ! input 2D array56 REAL(wp) :: glob_sum ! global masked sum57 !!----------------------------------------------------------------------- 58 ! 59 glob_sum = SUM( ptab(:,:)*tmask_i(:,:) )60 IF( lk_mpp ) CALL mpp_sum( glob_sum )55 REAL(wp), INTENT(in), DIMENSION(:,:) :: ptab ! input 2D array 56 REAL(wp) :: glob_sum_2d ! global masked sum 57 !!----------------------------------------------------------------------- 58 ! 59 glob_sum_2d = SUM( ptab(:,:)*tmask_i(:,:) ) 60 IF( lk_mpp ) CALL mpp_sum( glob_sum_2d ) 61 61 ! 62 62 END FUNCTION glob_sum_2d 63 63 64 64 65 FUNCTION glob_sum_3d( ptab ) RESULT( glob_sum )65 FUNCTION glob_sum_3d( ptab ) 66 66 !!----------------------------------------------------------------------- 67 67 !! *** FUNCTION glob_sum_3D *** … … 69 69 !! ** Purpose : perform a masked sum on the inner global domain of a 3D array 70 70 !!----------------------------------------------------------------------- 71 REAL(wp), INTENT(in), DIMENSION(:,:,:) :: ptab ! input 3D array72 REAL(wp) :: glob_sum ! global masked sum71 REAL(wp), INTENT(in), DIMENSION(:,:,:) :: ptab ! input 3D array 72 REAL(wp) :: glob_sum_3d ! global masked sum 73 73 !! 74 74 INTEGER :: jk 75 75 !!----------------------------------------------------------------------- 76 76 ! 77 glob_sum = 0.e077 glob_sum_3d = 0.e0 78 78 DO jk = 1, jpk 79 glob_sum = glob_sum+ SUM( ptab(:,:,jk)*tmask_i(:,:) )80 END DO 81 IF( lk_mpp ) CALL mpp_sum( glob_sum )79 glob_sum_3d = glob_sum_3d + SUM( ptab(:,:,jk)*tmask_i(:,:) ) 80 END DO 81 IF( lk_mpp ) CALL mpp_sum( glob_sum_3d ) 82 82 ! 83 83 END FUNCTION glob_sum_3d 84 84 85 85 86 FUNCTION glob_sum_2d_a( ptab1, ptab2 ) RESULT( glob_sum )86 FUNCTION glob_sum_2d_a( ptab1, ptab2 ) 87 87 !!----------------------------------------------------------------------- 88 88 !! *** FUNCTION glob_sum_2D _a *** … … 90 90 !! ** Purpose : perform a masked sum on the inner global domain of two 2D array 91 91 !!----------------------------------------------------------------------- 92 REAL(wp), INTENT(in), DIMENSION(:,:) :: ptab1, ptab2 ! input 2D array93 REAL(wp) , DIMENSION(2) :: glob_sum 92 REAL(wp), INTENT(in), DIMENSION(:,:) :: ptab1, ptab2 ! input 2D array 93 REAL(wp) , DIMENSION(2) :: glob_sum_2d_a ! global masked sum 94 94 !!----------------------------------------------------------------------- 95 95 ! 96 glob_sum (1) = SUM( ptab1(:,:)*tmask_i(:,:) )97 glob_sum (2) = SUM( ptab2(:,:)*tmask_i(:,:) )98 IF( lk_mpp ) CALL mpp_sum( glob_sum , 2 )96 glob_sum_2d_a(1) = SUM( ptab1(:,:)*tmask_i(:,:) ) 97 glob_sum_2d_a(2) = SUM( ptab2(:,:)*tmask_i(:,:) ) 98 IF( lk_mpp ) CALL mpp_sum( glob_sum_2d_a, 2 ) 99 99 ! 100 100 END FUNCTION glob_sum_2d_a 101 101 102 102 103 FUNCTION glob_sum_3d_a( ptab1, ptab2 ) RESULT( glob_sum )103 FUNCTION glob_sum_3d_a( ptab1, ptab2 ) 104 104 !!----------------------------------------------------------------------- 105 105 !! *** FUNCTION glob_sum_3D_a *** … … 107 107 !! ** Purpose : perform a masked sum on the inner global domain of two 3D array 108 108 !!----------------------------------------------------------------------- 109 REAL(wp), INTENT(in), DIMENSION(:,:,:) :: ptab1, ptab2 ! input 3D array110 REAL(wp) , DIMENSION(2) :: glob_sum 109 REAL(wp), INTENT(in), DIMENSION(:,:,:) :: ptab1, ptab2 ! input 3D array 110 REAL(wp) , DIMENSION(2) :: glob_sum_3d_a ! global masked sum 111 111 !! 112 112 INTEGER :: jk 113 113 !!----------------------------------------------------------------------- 114 114 ! 115 glob_sum (:) = 0.e0115 glob_sum_3d_a(:) = 0.e0 116 116 DO jk = 1, jpk 117 glob_sum (1) = glob_sum(1) + SUM( ptab1(:,:,jk)*tmask_i(:,:) )118 glob_sum (2) = glob_sum(2) + SUM( ptab2(:,:,jk)*tmask_i(:,:) )119 END DO 120 IF( lk_mpp ) CALL mpp_sum( glob_sum , 2 )117 glob_sum_3d_a(1) = glob_sum_3d_a(1) + SUM( ptab1(:,:,jk)*tmask_i(:,:) ) 118 glob_sum_3d_a(2) = glob_sum_3d_a(2) + SUM( ptab2(:,:,jk)*tmask_i(:,:) ) 119 END DO 120 IF( lk_mpp ) CALL mpp_sum( glob_sum_3d_a, 2 ) 121 121 ! 122 122 END FUNCTION glob_sum_3d_a … … 127 127 !!---------------------------------------------------------------------- 128 128 129 FUNCTION glob_sum_2d( ptab ) RESULT( glob_sum )129 FUNCTION glob_sum_2d( ptab ) 130 130 !!---------------------------------------------------------------------- 131 131 !! *** FUNCTION glob_sum_2d *** … … 134 134 !!---------------------------------------------------------------------- 135 135 REAL(wp), INTENT(in), DIMENSION(jpi,jpj) :: ptab 136 REAL(wp) :: glob_sum ! global masked sum136 REAL(wp) :: glob_sum_2d ! global masked sum 137 137 !! 138 138 COMPLEX(wp):: ctmp … … 150 150 END DO 151 151 IF( lk_mpp ) CALL mpp_sum( ctmp ) ! sum over the global domain 152 glob_sum = REAL(ctmp,wp)152 glob_sum_2d = REAL(ctmp,wp) 153 153 ! 154 154 END FUNCTION glob_sum_2d 155 155 156 156 157 FUNCTION glob_sum_3d( ptab ) RESULT( glob_sum )157 FUNCTION glob_sum_3d( ptab ) 158 158 !!---------------------------------------------------------------------- 159 159 !! *** FUNCTION glob_sum_3d *** … … 162 162 !!---------------------------------------------------------------------- 163 163 REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) :: ptab 164 REAL(wp) :: glob_sum ! global masked sum164 REAL(wp) :: glob_sum_3d ! global masked sum 165 165 !! 166 166 COMPLEX(wp):: ctmp … … 180 180 END DO 181 181 IF( lk_mpp ) CALL mpp_sum( ctmp ) ! sum over the global domain 182 glob_sum = REAL(ctmp,wp)182 glob_sum_3d = REAL(ctmp,wp) 183 183 ! 184 184 END FUNCTION glob_sum_3d 185 185 186 186 187 FUNCTION glob_sum_2d_a( ptab1, ptab2 ) RESULT( glob_sum )187 FUNCTION glob_sum_2d_a( ptab1, ptab2 ) 188 188 !!---------------------------------------------------------------------- 189 189 !! *** FUNCTION glob_sum_2d_a *** … … 192 192 !!---------------------------------------------------------------------- 193 193 REAL(wp), INTENT(in), DIMENSION(jpi,jpj) :: ptab1, ptab2 194 REAL(wp) :: glob_sum ! global masked sum194 REAL(wp) :: glob_sum_2d_a ! global masked sum 195 195 !! 196 196 COMPLEX(wp):: ctmp … … 210 210 END DO 211 211 IF( lk_mpp ) CALL mpp_sum( ctmp ) ! sum over the global domain 212 glob_sum = REAL(ctmp,wp)212 glob_sum_2d_a = REAL(ctmp,wp) 213 213 ! 214 214 END FUNCTION glob_sum_2d_a 215 215 216 216 217 FUNCTION glob_sum_3d_a( ptab1, ptab2 ) RESULT( glob_sum )217 FUNCTION glob_sum_3d_a( ptab1, ptab2 ) 218 218 !!---------------------------------------------------------------------- 219 219 !! *** FUNCTION glob_sum_3d_a *** … … 222 222 !!---------------------------------------------------------------------- 223 223 REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) :: ptab1, ptab2 224 REAL(wp) :: glob_sum ! global masked sum224 REAL(wp) :: glob_sum_3d_a ! global masked sum 225 225 !! 226 226 COMPLEX(wp):: ctmp … … 242 242 END DO 243 243 IF( lk_mpp ) CALL mpp_sum( ctmp ) ! sum over the global domain 244 glob_sum = REAL(ctmp,wp)244 glob_sum_3d_a = REAL(ctmp,wp) 245 245 ! 246 246 END FUNCTION glob_sum_3d_a -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r3288 r3289 173 173 ENDIF 174 174 ! 175 #if defined key_agrif 176 CALL Agrif_ParentGrid_To_ChildGrid() 177 IF( lk_diaobs ) CALL dia_obs_wri 178 IF( nn_timing == 1 ) CALL timing_finalize 179 CALL Agrif_ChildGrid_To_ParentGrid() 180 #endif 175 181 IF( nn_timing == 1 ) CALL timing_finalize 176 182 !
Note: See TracChangeset
for help on using the changeset viewer.
