Changeset 2715 for trunk/NEMOGCM/NEMO/OPA_SRC/TRD
- Timestamp:
- 2011-03-30T17:58:35+02:00 (13 years ago)
- Location:
- trunk/NEMOGCM/NEMO/OPA_SRC/TRD
- Files:
-
- 9 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdicp.F90
r2528 r2715 45 45 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 46 46 !! $Id$ 47 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 48 !!---------------------------------------------------------------------- 49 47 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 48 !!---------------------------------------------------------------------- 50 49 CONTAINS 51 50 … … 57 56 !! momentum equations at every time step frequency nn_trd. 58 57 !!---------------------------------------------------------------------- 59 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: ptrd2dx 60 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: ptrd2dy 61 INTEGER , INTENT(in ) :: ktrd 62 CHARACTER(len=3) , INTENT(in ) :: ctype 58 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: ptrd2dx ! Temperature or U trend 59 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: ptrd2dy ! Salinity or V trend 60 INTEGER , INTENT(in ) :: ktrd ! tracer trend index 61 CHARACTER(len=3) , INTENT(in ) :: ctype ! momentum ('DYN') or tracers ('TRA') trends 63 62 !! 64 INTEGER :: ji, jj ! loop indices 65 REAL(wp) :: zmsku, zbtu, zbt ! temporary scalars 66 REAL(wp) :: zmskv, zbtv ! " " 67 !!---------------------------------------------------------------------- 68 69 70 ! 1. Mask trends 71 ! -------------- 72 73 SELECT CASE( ctype ) 74 ! 75 CASE( 'DYN' ) ! Momentum 63 INTEGER :: ji, jj ! loop indices 64 !!---------------------------------------------------------------------- 65 66 SELECT CASE( ctype ) !== Mask trends ==! 67 ! 68 CASE( 'DYN' ) ! Momentum 76 69 DO jj = 1, jpjm1 77 70 DO ji = 1, jpim1 78 zmsku = tmask_i(ji+1,jj ) * tmask_i(ji,jj) * umask(ji,jj,1) 79 zmskv = tmask_i(ji ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,1) 80 ptrd2dx(ji,jj) = ptrd2dx(ji,jj) * zmsku 81 ptrd2dy(ji,jj) = ptrd2dy(ji,jj) * zmskv 71 ptrd2dx(ji,jj) = ptrd2dx(ji,jj) * tmask_i(ji+1,jj ) * tmask_i(ji,jj) * umask(ji,jj,1) 72 ptrd2dy(ji,jj) = ptrd2dy(ji,jj) * tmask_i(ji ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,1) 82 73 END DO 83 74 END DO 84 ptrd2dx(jpi, : ) = 0. e0 ; ptrd2dy(jpi, : ) = 0.e085 ptrd2dx( : ,jpj) = 0. e0 ; ptrd2dy( : ,jpj) = 0.e086 ! 87 CASE( 'TRA' ) ! Tracers75 ptrd2dx(jpi, : ) = 0._wp ; ptrd2dy(jpi, : ) = 0._wp 76 ptrd2dx( : ,jpj) = 0._wp ; ptrd2dy( : ,jpj) = 0._wp 77 ! 78 CASE( 'TRA' ) ! Tracers 88 79 ptrd2dx(:,:) = ptrd2dx(:,:) * tmask_i(:,:) 89 80 ptrd2dy(:,:) = ptrd2dy(:,:) * tmask_i(:,:) … … 91 82 END SELECT 92 83 93 ! 2. Basin averaged tracer/momentum trends 94 ! ---------------------------------------- 95 96 SELECT CASE( ctype ) 97 ! 98 CASE( 'DYN' ) ! Momentum 99 umo(ktrd) = 0.e0 100 vmo(ktrd) = 0.e0 84 SELECT CASE( ctype ) !== Basin averaged tracer/momentum trends ==! 85 ! 86 CASE( 'DYN' ) ! Momentum 87 umo(ktrd) = 0._wp 88 vmo(ktrd) = 0._wp 101 89 ! 102 90 SELECT CASE( ktrd ) 103 !104 91 CASE( jpdyn_trd_swf ) ! surface forcing 105 DO jj = 1, jpj 106 DO ji = 1, jpi 107 umo(ktrd) = umo(ktrd) + ptrd2dx(ji,jj) * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,1) 108 vmo(ktrd) = vmo(ktrd) + ptrd2dy(ji,jj) * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,1) 109 END DO 110 END DO 111 ! 92 umo(ktrd) = SUM( ptrd2dx(:,:) * e1u(:,:) * e2u(:,:) * fse3u(:,:,1) ) 93 vmo(ktrd) = SUM( ptrd2dy(:,:) * e1v(:,:) * e2v(:,:) * fse3v(:,:,1) ) 112 94 END SELECT 113 95 ! 114 96 CASE( 'TRA' ) ! Tracers 115 tmo(ktrd) = 0.e0 116 smo(ktrd) = 0.e0 117 DO jj = 1, jpj 118 DO ji = 1, jpi 119 zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,1) 120 tmo(ktrd) = tmo(ktrd) + ptrd2dx(ji,jj) * zbt 121 smo(ktrd) = smo(ktrd) + ptrd2dy(ji,jj) * zbt 122 END DO 123 END DO 124 ! 97 tmo(ktrd) = SUM( ptrd2dx(:,:) * e1e2t(:,:) * fse3t(:,:,1) ) 98 smo(ktrd) = SUM( ptrd2dy(:,:) * e1e2t(:,:) * fse3t(:,:,1) ) 125 99 END SELECT 126 100 127 ! 3. Basin averaged tracer/momentum square trends 128 ! ---------------------------------------------- 129 ! c a u t i o n: field now 130 131 SELECT CASE( ctype ) 101 SELECT CASE( ctype ) !== Basin averaged tracer/momentum square trends ==! (now field) 132 102 ! 133 103 CASE( 'DYN' ) ! Momentum 134 hke(ktrd) = 0.e0 135 DO jj = 1, jpj 136 DO ji = 1, jpi 137 zbtu = e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,1) 138 zbtv = e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,1) 139 hke(ktrd) = hke(ktrd) & 140 & + un(ji,jj,1) * ptrd2dx(ji,jj) * zbtu & 141 & + vn(ji,jj,1) * ptrd2dy(ji,jj) * zbtv 142 END DO 143 END DO 104 hke(ktrd) = SUM( un(:,:,1) * ptrd2dx(:,:) * e1u(:,:) * e2u(:,:) * fse3u(:,:,1) & 105 & + vn(:,:,1) * ptrd2dy(:,:) * e1v(:,:) * e2v(:,:) * fse3v(:,:,1) ) 144 106 ! 145 107 CASE( 'TRA' ) ! Tracers 146 t2(ktrd) = 0.e0 147 s2(ktrd) = 0.e0 148 DO jj = 1, jpj 149 DO ji = 1, jpi 150 zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,1) 151 t2(ktrd) = t2(ktrd) + ptrd2dx(ji,jj) * zbt * tn(ji,jj,1) 152 s2(ktrd) = s2(ktrd) + ptrd2dy(ji,jj) * zbt * sn(ji,jj,1) 153 END DO 154 END DO 108 t2(ktrd) = SUM( ptrd2dx(:,:) * e1e2t(:,:) * fse3t(:,:,1) * tn(:,:,1) ) 109 s2(ktrd) = SUM( ptrd2dy(:,:) * e1e2t(:,:) * fse3t(:,:,1) * sn(:,:,1) ) 155 110 ! 156 111 END SELECT … … 166 121 !! momentum equations at every time step frequency nn_trd. 167 122 !!---------------------------------------------------------------------- 168 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: ptrd3dx 169 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: ptrd3dy 170 INTEGER, INTENT(in ) :: ktrd 171 CHARACTER(len=3), INTENT(in ) :: ctype 123 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: ptrd3dx ! Temperature or U trend 124 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: ptrd3dy ! Salinity or V trend 125 INTEGER, INTENT(in ) :: ktrd ! momentum or tracer trend index 126 CHARACTER(len=3), INTENT(in ) :: ctype ! momentum ('DYN') or tracers ('TRA') trends 172 127 !! 173 INTEGER :: ji, jj, jk 174 REAL(wp) :: zbt, zbtu, zbtv, zmsku, zmskv ! temporary scalars 175 !!---------------------------------------------------------------------- 176 177 ! 1. Mask the trends 178 ! ------------------ 179 180 SELECT CASE( ctype ) 128 INTEGER :: ji, jj, jk ! dummy loop indices 129 !!---------------------------------------------------------------------- 130 131 SELECT CASE( ctype ) !== Mask the trends ==! 181 132 ! 182 133 CASE( 'DYN' ) ! Momentum 183 DO jk = 1, jpk 134 DO jk = 1, jpkm1 184 135 DO jj = 1, jpjm1 185 136 DO ji = 1, jpim1 186 zmsku = tmask_i(ji+1,jj ) * tmask_i(ji,jj) * umask(ji,jj,jk) 187 zmskv = tmask_i(ji ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk) 188 ptrd3dx(ji,jj,jk) = ptrd3dx(ji,jj,jk) * zmsku 189 ptrd3dy(ji,jj,jk) = ptrd3dy(ji,jj,jk) * zmskv 137 ptrd3dx(ji,jj,jk) = ptrd3dx(ji,jj,jk) * tmask_i(ji+1,jj ) * tmask_i(ji,jj) * umask(ji,jj,jk) 138 ptrd3dy(ji,jj,jk) = ptrd3dy(ji,jj,jk) * tmask_i(ji ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk) 190 139 END DO 191 140 END DO 192 141 END DO 193 ptrd3dx(jpi, : ,:) = 0. e0 ; ptrd3dy(jpi, : ,:) = 0.e0194 ptrd3dx( : ,jpj,:) = 0. e0 ; ptrd3dy( : ,jpj,:) = 0.e0142 ptrd3dx(jpi, : ,:) = 0._wp ; ptrd3dy(jpi, : ,:) = 0._wp 143 ptrd3dx( : ,jpj,:) = 0._wp ; ptrd3dy( : ,jpj,:) = 0._wp 195 144 ! 196 145 CASE( 'TRA' ) ! Tracers 197 DO jk = 1, jpk 146 DO jk = 1, jpkm1 198 147 ptrd3dx(:,:,jk) = ptrd3dx(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) 199 148 ptrd3dy(:,:,jk) = ptrd3dy(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) … … 202 151 END SELECT 203 152 204 ! 2. Basin averaged tracer/momentum trends 205 ! ---------------------------------------- 206 207 SELECT CASE( ctype ) 153 SELECT CASE( ctype ) !== Basin averaged tracer/momentum trends ==! 208 154 ! 209 155 CASE( 'DYN' ) ! Momentum 210 umo(ktrd) = 0.e0 211 vmo(ktrd) = 0.e0 212 DO jk = 1, jpk 213 DO jj = 1, jpj 214 DO ji = 1, jpi 215 zbtu = e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) 216 zbtv = e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) 217 umo(ktrd) = umo(ktrd) + ptrd3dx(ji,jj,jk) * zbtu 218 vmo(ktrd) = vmo(ktrd) + ptrd3dy(ji,jj,jk) * zbtv 219 END DO 220 END DO 156 umo(ktrd) = 0._wp 157 vmo(ktrd) = 0._wp 158 DO jk = 1, jpkm1 159 umo(ktrd) = umo(ktrd) + SUM( ptrd3dx(:,:,jk) * e1u(:,:) * e2u(:,:) * fse3u(:,:,jk) ) 160 vmo(ktrd) = vmo(ktrd) + SUM( ptrd3dy(:,:,jk) * e1v(:,:) * e2v(:,:) * fse3v(:,:,jk) ) 221 161 END DO 222 162 ! 223 163 CASE( 'TRA' ) ! Tracers 224 tmo(ktrd) = 0.e0 225 smo(ktrd) = 0.e0 226 DO jk = 1, jpkm1 227 DO jj = 1, jpj 228 DO ji = 1, jpi 229 zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 230 tmo(ktrd) = tmo(ktrd) + ptrd3dx(ji,jj,jk) * zbt 231 smo(ktrd) = smo(ktrd) + ptrd3dy(ji,jj,jk) * zbt 232 END DO 233 END DO 164 tmo(ktrd) = 0._wp 165 smo(ktrd) = 0._wp 166 DO jk = 1, jpkm1 167 tmo(ktrd) = tmo(ktrd) + SUM( ptrd3dx(:,:,jk) * e1e2t(:,:) * fse3t(:,:,jk) ) 168 smo(ktrd) = smo(ktrd) + SUM( ptrd3dy(:,:,jk) * e1e2t(:,:) * fse3t(:,:,jk) ) 234 169 END DO 235 170 ! 236 171 END SELECT 237 172 238 ! 3. Basin averaged tracer/momentum square trends 239 ! ----------------------------------------------- 240 ! c a u t i o n: field now 241 242 SELECT CASE( ctype ) 173 SELECT CASE( ctype ) !== Basin averaged tracer/momentum square trends ==! (now field) 243 174 ! 244 175 CASE( 'DYN' ) ! Momentum 245 hke(ktrd) = 0.e0 246 DO jk = 1, jpk 247 DO jj = 1, jpj 248 DO ji = 1, jpi 249 zbtu = e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) 250 zbtv = e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) 251 hke(ktrd) = hke(ktrd) & 252 & + un(ji,jj,jk) * ptrd3dx(ji,jj,jk) * zbtu & 253 & + vn(ji,jj,jk) * ptrd3dy(ji,jj,jk) * zbtv 254 END DO 255 END DO 176 hke(ktrd) = 0._wp 177 DO jk = 1, jpkm1 178 hke(ktrd) = hke(ktrd) + SUM( un(:,:,jk) * ptrd3dx(:,:,jk) * e1u(:,:) * e2u(:,:) * fse3u(:,:,jk) & 179 & + vn(:,:,jk) * ptrd3dy(:,:,jk) * e1v(:,:) * e2v(:,:) * fse3v(:,:,jk) ) 256 180 END DO 257 181 ! 258 182 CASE( 'TRA' ) ! Tracers 259 t2(ktrd) = 0.e0 260 s2(ktrd) = 0.e0 261 DO jk = 1, jpk 262 DO jj = 1, jpj 263 DO ji = 1, jpi 264 zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 265 t2(ktrd) = t2(ktrd) + ptrd3dx(ji,jj,jk) * zbt * tn(ji,jj,jk) 266 s2(ktrd) = s2(ktrd) + ptrd3dy(ji,jj,jk) * zbt * sn(ji,jj,jk) 267 END DO 268 END DO 183 t2(ktrd) = 0._wp 184 s2(ktrd) = 0._wp 185 DO jk = 1, jpkm1 186 t2(ktrd) = t2(ktrd) + SUM( ptrd3dx(ji,jj,jk) * tn(ji,jj,jk) * e1e2t(:,:) * fse3t(:,:,jk) ) 187 s2(ktrd) = s2(ktrd) + SUM( ptrd3dy(ji,jj,jk) * sn(ji,jj,jk) * e1e2t(:,:) * fse3t(:,:,jk) ) 269 188 END DO 270 189 ! … … 272 191 ! 273 192 END SUBROUTINE trd_3d 274 275 193 276 194 … … 281 199 !! ** Purpose : Read the namtrd namelist 282 200 !!---------------------------------------------------------------------- 283 INTEGER :: ji, jj, jk 284 REAL(wp) :: zmskt 285 #if defined key_trddyn 286 REAL(wp) :: zmsku, zmskv 287 #endif 201 INTEGER :: ji, jj, jk ! dummy loop indices 288 202 !!---------------------------------------------------------------------- 289 203 … … 295 209 296 210 ! Total volume at t-points: 297 tvolt = 0. e0211 tvolt = 0._wp 298 212 DO jk = 1, jpkm1 299 DO jj = 2, jpjm1 300 DO ji = fs_2, fs_jpim1 ! vector opt. 301 zmskt = tmask(ji,jj,jk) * tmask_i(ji,jj) 302 tvolt = tvolt + zmskt * e1t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) 303 END DO 304 END DO 213 tvolt = SUM( e1e2t(:,:) * fse3t(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) ) 305 214 END DO 306 215 IF( lk_mpp ) CALL mpp_sum( tvolt ) ! sum over the global domain … … 310 219 #if defined key_trddyn 311 220 ! Initialization of potential to kinetic energy conversion 312 rpktrd = 0. e0221 rpktrd = 0._wp 313 222 314 223 ! Total volume at u-, v- points: 315 tvolu = 0. e0316 tvolv = 0. e0224 tvolu = 0._wp 225 tvolv = 0._wp 317 226 318 227 DO jk = 1, jpk 319 228 DO jj = 2, jpjm1 320 229 DO ji = fs_2, fs_jpim1 ! vector opt. 321 zmsku = tmask_i(ji+1,jj ) * tmask_i(ji,jj) * umask(ji,jj,jk) 322 zmskv = tmask_i(ji ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk) 323 tvolu = tvolu + zmsku * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) 324 tvolv = tvolv + zmskv * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) 230 tvolu = tvolu + e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) * tmask_i(ji+1,jj ) * tmask_i(ji,jj) * umask(ji,jj,jk) 231 tvolv = tvolv + e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) * tmask_i(ji ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk) 325 232 END DO 326 233 END DO … … 344 251 !! ** Purpose : write dynamic trends in ocean.output 345 252 !!---------------------------------------------------------------------- 346 INTEGER, INTENT(in) :: kt ! ocean time-step index 347 !! 348 INTEGER :: ji, jj, jk 349 REAL(wp) :: ze1e2w, zcof, zbe1ru, zbe2rv, zbtr, ztz, zth ! " scalars 350 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zkepe, zkx, zky, zkz ! temporary arrays 351 !!---------------------------------------------------------------------- 253 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 254 USE wrk_nemo, ONLY: zkepe => wrk_3d_1 , zkx => wrk_3d_2 ! 3D workspace 255 USE wrk_nemo, ONLY: zky => wrk_3d_3 , zkz => wrk_3d_4 ! - - 256 ! 257 INTEGER, INTENT(in) :: kt ! ocean time-step index 258 ! 259 INTEGER :: ji, jj, jk ! dummy loop indices 260 REAL(wp) :: zcof ! local scalar 261 !!---------------------------------------------------------------------- 262 263 IF( wrk_in_use(3, 1,2,3,4) ) THEN 264 CALL ctl_stop('trd_dwr: requested workspace arrays unavailable') ; RETURN 265 ENDIF 352 266 353 267 ! I. Momentum trends … … 359 273 ! -------------------------------------------------- 360 274 ! c a u t i o n here, trends are computed at kt+1 (now , but after the swap) 361 362 zkx(:,:,:) = 0.e0 363 zky(:,:,:) = 0.e0 364 zkz(:,:,:) = 0.e0 365 zkepe(:,:,:) = 0.e0 275 zkx (:,:,:) = 0._wp 276 zky (:,:,:) = 0._wp 277 zkz (:,:,:) = 0._wp 278 zkepe(:,:,:) = 0._wp 366 279 367 280 CALL eos( tsn, rhd, rhop ) ! now potential and in situ densities 368 281 369 ! Density flux at w-point 282 zcof = 0.5_wp / rau0 ! Density flux at w-point 283 zkz(:,:,1) = 0._wp 370 284 DO jk = 2, jpk 371 DO jj = 1, jpj 372 DO ji = 1, jpi 373 ze1e2w = 0.5 * e1t(ji,jj) * e2t(ji,jj) * wn(ji,jj,jk) * tmask_i(ji,jj) 374 zkz(ji,jj,jk) = ze1e2w / rau0 * ( rhop(ji,jj,jk) + rhop(ji,jj,jk-1) ) 285 zkz(:,:,jk) = e1e2t(:,:) * wn(:,:,jk) * ( rhop(:,:,jk) + rhop(:,:,jk-1) ) * tmask_i(:,:) 286 END DO 287 288 zcof = 0.5_wp / rau0 ! Density flux at u and v-points 289 DO jk = 1, jpkm1 290 DO jj = 1, jpjm1 291 DO ji = 1, jpim1 292 zkx(ji,jj,jk) = zcof * e2u(ji,jj) * fse3u(ji,jj,jk) * un(ji,jj,jk) * ( rhop(ji,jj,jk) + rhop(ji+1,jj,jk) ) 293 zky(ji,jj,jk) = zcof * e1v(ji,jj) * fse3v(ji,jj,jk) * vn(ji,jj,jk) * ( rhop(ji,jj,jk) + rhop(ji,jj+1,jk) ) 375 294 END DO 376 295 END DO 377 296 END DO 378 zkz(:,:,1) = 0.e0379 297 380 ! Density flux at u and v-points 381 DO jk = 1, jpk 382 DO jj = 1, jpjm1 383 DO ji = 1, jpim1 384 zcof = 0.5 / rau0 385 zbe1ru = zcof * e2u(ji,jj) * fse3u(ji,jj,jk) * un(ji,jj,jk) 386 zbe2rv = zcof * e1v(ji,jj) * fse3v(ji,jj,jk) * vn(ji,jj,jk) 387 zkx(ji,jj,jk) = zbe1ru * ( rhop(ji,jj,jk) + rhop(ji+1,jj,jk) ) 388 zky(ji,jj,jk) = zbe2rv * ( rhop(ji,jj,jk) + rhop(ji,jj+1,jk) ) 298 DO jk = 1, jpkm1 ! Density flux divergence at t-point 299 DO jj = 2, jpjm1 300 DO ji = 2, jpim1 301 zkepe(ji,jj,jk) = - ( zkz(ji,jj,jk) - zkz(ji ,jj ,jk+1) & 302 & + zkx(ji,jj,jk) - zkx(ji-1,jj ,jk ) & 303 & + zky(ji,jj,jk) - zky(ji ,jj-1,jk ) ) & 304 & / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) * tmask(ji,jj,jk) * tmask_i(ji,jj) 389 305 END DO 390 306 END DO 391 307 END DO 392 393 ! Density flux divergence at t-point394 DO jk = 1, jpkm1395 DO jj = 2, jpjm1396 DO ji = 2, jpim1397 zbtr = 1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) )398 ztz = - zbtr * ( zkz(ji,jj,jk) - zkz(ji,jj,jk+1) )399 zth = - zbtr * ( ( zkx(ji,jj,jk) - zkx(ji-1,jj,jk) ) &400 & + ( zky(ji,jj,jk) - zky(ji,jj-1,jk) ) )401 zkepe(ji,jj,jk) = (zth + ztz) * tmask(ji,jj,jk) * tmask_i(ji,jj)402 END DO403 END DO404 END DO405 zkepe( : , : ,jpk) = 0.e0406 zkepe( : ,jpj, : ) = 0.e0407 zkepe(jpi, : , : ) = 0.e0408 308 409 309 ! I.2 Basin averaged kinetic energy trend 410 310 ! ---------------------------------------- 411 peke = 0.e0 412 DO jk = 1,jpk 413 DO jj = 1, jpj 414 DO ji = 1, jpi 415 peke = peke + zkepe(ji,jj,jk) * grav * fsdept(ji,jj,jk) & 416 & * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 417 END DO 418 END DO 419 END DO 311 peke = 0._wp 312 DO jk = 1, jpkm1 313 peke = peke + SUM( zkepe(:,:,jk) * fsdept(:,:,jk) * e1e2t(:,:) * fse3t(:,:,jk) ) 314 END DO 315 peke = grav * peke 420 316 421 317 ! I.3 Sums over the global domain … … 542 438 ! 543 439 ENDIF 440 ! 441 IF( wrk_not_released(3, 1,2,3,4) ) CALL ctl_stop('trd_dwr: failed to release workspace arrays') 544 442 ! 545 443 END SUBROUTINE trd_dwr -
trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdmld.F90
r2528 r2715 15 15 !! 'key_trdmld' mixed layer trend diagnostics 16 16 !!---------------------------------------------------------------------- 17 !!----------------------------------------------------------------------18 17 !! trd_mld : T and S cumulated trends averaged over the mixed layer 19 18 !! trd_mld_zint : T and S trends vertical integration … … 23 22 USE dom_oce ! ocean space and time domain variables 24 23 USE trdmod_oce ! ocean variables trends 24 USE trdmld_oce ! ocean variables trends 25 25 USE ldftra_oce ! ocean active tracers lateral physics 26 26 USE zdf_oce ! ocean vertical physics … … 37 37 USE prtctl ! Print control 38 38 USE restart ! for lrst_oce 39 USE lib_mpp ! MPP library 39 40 40 41 IMPLICIT NONE … … 47 48 CHARACTER (LEN=40) :: clhstnam ! name of the trends NetCDF file 48 49 INTEGER :: nh_t, nmoymltrd 49 INTEGER :: nidtrd, ndextrd1(jpi*jpj) 50 INTEGER :: nidtrd 51 INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: ndextrd1 50 52 INTEGER :: ndimtrd1 51 53 INTEGER :: ionce, icount … … 58 60 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 59 61 !! $Id$ 60 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)62 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 61 63 !!---------------------------------------------------------------------- 62 63 64 CONTAINS 65 66 INTEGER FUNCTION trd_mld_alloc() 67 !!---------------------------------------------------------------------- 68 !! *** ROUTINE trd_mld_alloc *** 69 !!---------------------------------------------------------------------- 70 ALLOCATE( ndextrd1(jpi*jpj) , STAT=trd_mld_alloc ) 71 ! 72 IF( lk_mpp ) CALL mpp_sum ( trd_mld_alloc ) 73 IF( trd_mld_alloc /= 0 ) CALL ctl_warn('trd_mld_alloc: failed to allocate array ndextrd1') 74 END FUNCTION trd_mld_alloc 75 64 76 65 77 SUBROUTINE trd_mld_zint( pttrdmld, pstrdmld, ktrd, ctype ) … … 81 93 !! surface and the control surface is called "mixed-layer" 82 94 !!---------------------------------------------------------------------- 83 INTEGER, INTENT( in ) :: ktrd ! ocean trend index 84 CHARACTER(len=2), INTENT( in ) :: ctype ! surface/bottom (2D arrays) or 85 ! ! interior (3D arrays) physics 86 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) :: pttrdmld ! temperature trend 87 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) :: pstrdmld ! salinity trend 95 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 96 USE wrk_nemo, ONLY: zvlmsk => wrk_2d_10 ! 2D workspace 97 ! 98 INTEGER , INTENT( in ) :: ktrd ! ocean trend index 99 CHARACTER(len=2) , INTENT( in ) :: ctype ! 2D surface/bottom or 3D interior physics 100 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) :: pttrdmld ! temperature trend 101 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) :: pstrdmld ! salinity trend 102 ! 88 103 INTEGER :: ji, jj, jk, isum 89 REAL(wp), DIMENSION(jpi,jpj) :: zvlmsk 90 !!---------------------------------------------------------------------- 104 !!---------------------------------------------------------------------- 105 106 IF( wrk_in_use(2, 10) ) THEN 107 CALL ctl_stop('trd_mld_zint : requested workspace arrays unavailable') ; RETURN 108 ENDIF 91 109 92 110 ! I. Definition of control surface and associated fields … … 176 194 smltrd(:,:,ktrd) = smltrd(:,:,ktrd) + pstrdmld(:,:,1) * wkx(:,:,1) 177 195 END SELECT 196 ! 197 IF( wrk_not_released(2, 10) ) CALL ctl_stop('trd_mld_zint: failed to release workspace arrays') 178 198 ! 179 199 END SUBROUTINE trd_mld_zint … … 227 247 !! - See NEMO documentation (in preparation) 228 248 !!---------------------------------------------------------------------- 249 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 250 USE wrk_nemo, ONLY: ztmltot => wrk_2d_1, zsmltot => wrk_2d_2 ! dT/dt over the anlysis window (including Asselin) 251 USE wrk_nemo, ONLY: ztmlres => wrk_2d_3, zsmlres => wrk_2d_4 ! residual = dh/dt entrainment term 252 USE wrk_nemo, ONLY: ztmlatf => wrk_2d_5, zsmlatf => wrk_2d_6 ! needed for storage only 253 USE wrk_nemo, ONLY: ztmltot2 => wrk_2d_7, ztmlres2 => wrk_2d_8, ztmltrdm2 => wrk_2d_9 ! \ working arrays to diagnose the trends 254 USE wrk_nemo, ONLY: zsmltot2 => wrk_2d_10, zsmlres2 => wrk_2d_11, zsmltrdm2 => wrk_2d_12 ! > associated with the time meaned ML T & S 255 USE wrk_nemo, ONLY: ztmlatf2 => wrk_2d_13, zsmlatf2 => wrk_2d_14 256 USE wrk_nemo, ONLY: wrk_3d_1, wrk_3d_2 ! / 257 ! 229 258 INTEGER, INTENT( in ) :: kt ! ocean time-step index 230 ! !259 ! 231 260 INTEGER :: ji, jj, jk, jl, ik, it, itmod 232 261 LOGICAL :: lldebug = .TRUE. 233 262 REAL(wp) :: zavt, zfn, zfn2 234 REAL(wp) ,DIMENSION(jpi,jpj) :: & 235 ztmltot, zsmltot, & ! dT/dt over the anlysis window (including Asselin) 236 ztmlres, zsmlres, & ! residual = dh/dt entrainment term 237 ztmlatf, zsmlatf, & ! needed for storage only 238 ztmltot2, ztmlres2, ztmltrdm2, & ! \ working arrays to diagnose the trends 239 zsmltot2, zsmlres2, zsmltrdm2, & ! > associated with the time meaned ML T & S 240 ztmlatf2, zsmlatf2 ! / 241 REAL(wp), DIMENSION(jpi,jpj,jpltrd) :: & 242 ztmltrd2, zsmltrd2 ! only needed for mean diagnostics 263 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztmltrd2, zsmltrd2 ! only needed for mean diagnostics 243 264 #if defined key_dimgout 244 265 INTEGER :: iyear,imon,iday … … 247 268 !!---------------------------------------------------------------------- 248 269 270 ! Check that the workspace arrays are all OK to be used 271 IF( wrk_in_use(2, 1,2,3,4,5,6,7,8,9,10,11,12,13,14) .OR. & 272 wrk_in_use(3, 1,2) ) THEN 273 CALL ctl_stop('trd_mld : requested workspace arrays unavailable') ; RETURN 274 ELSE IF(jpltrd > jpk) THEN 275 ! ARPDBG, is this reasonable or will this cause trouble in the future? 276 CALL ctl_stop('trd_mld : no. of mixed-layer trends (jpltrd) exceeds no. of model levels so cannot use 3D workspaces.') 277 RETURN 278 END IF 279 ! Set-up pointers into sub-arrays of 3d-workspaces 280 ztmltrd2 => wrk_3d_1(1:,:,1:jpltrd) 281 zsmltrd2 => wrk_3d_2(1:,:,1:jpltrd) 249 282 250 283 ! ====================================================================== … … 707 740 IF( lrst_oce ) CALL trd_mld_rst_write( kt ) 708 741 742 IF( wrk_not_released(2, 1,2,3,4,5,6,7,8,9,10,11,12,13,14) .OR. & 743 wrk_not_released(3, 1,2) ) & 744 CALL ctl_stop('trd_mld : failed to release workspace arrays.') 745 ! 709 746 END SUBROUTINE trd_mld 710 747 … … 716 753 !! ** Purpose : computation of vertically integrated T and S budgets 717 754 !! from ocean surface down to control surface (NetCDF output) 718 !! 719 !!---------------------------------------------------------------------- 720 !! * Local declarations 755 !!---------------------------------------------------------------------- 721 756 INTEGER :: jl 722 757 INTEGER :: inum ! logical unit 723 724 758 REAL(wp) :: zjulian, zsto, zout 725 726 759 CHARACTER (LEN=40) :: clop 727 760 CHARACTER (LEN=12) :: clmxl, cltu, clsu 728 729 761 !!---------------------------------------------------------------------- 730 762 … … 763 795 nwarn = nwarn + 1 764 796 END IF 797 798 ! ! allocate trdmld arrays 799 IF( trd_mld_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'trd_mld_init : unable to allocate trdmld arrays' ) 800 IF( trdmld_oce_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'trd_mld_init : unable to allocate trdmld_oce arrays' ) 765 801 766 802 ! I.2 Initialize arrays to zero or read a restart file -
trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdmld_oce.F90
r2528 r2715 4 4 !! Ocean trends : set tracer and momentum trend variables 5 5 !!====================================================================== 6 !! History : 9.0 !04-08 (C. Talandier) New trends organization6 !! History : 1.0 ! 2004-08 (C. Talandier) New trends organization 7 7 !!---------------------------------------------------------------------- 8 USE par_oce 8 USE par_oce ! ocean parameters 9 9 10 10 IMPLICIT NONE 11 11 PRIVATE 12 13 PUBLIC trdmld_oce_alloc ! Called in trdmld.F90 12 14 13 15 #if defined key_trdmld … … 17 19 #endif 18 20 !!* mixed layer trends indices 19 INTEGER, PARAMETER, PUBLIC :: jpltrd = 11 !: number of mixed-layer trends arrays 20 INTEGER, PUBLIC & 21 #if !defined key_agrif 22 , PARAMETER & 23 #endif 24 :: jpktrd = jpk !: max level for mixed-layer trends diag. 21 INTEGER, PARAMETER, PUBLIC :: jpltrd = 11 !: number of mixed-layer trends arrays 22 INTEGER, PUBLIC :: jpktrd !: max level for mixed-layer trends diag. 25 23 ! 26 24 INTEGER, PUBLIC, PARAMETER :: jpmld_xad = 1 !: zonal … … 46 44 CHARACTER(LEN=80) , PUBLIC :: clname, ctrd(jpltrd+1,2) 47 45 48 INTEGER , PUBLIC, DIMENSION(jpi,jpj):: nmld !: mixed layer depth indexes49 INTEGER , PUBLIC, DIMENSION(jpi,jpj):: nbol !: mixed-layer depth indexes when read from file46 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: nmld !: mixed layer depth indexes 47 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: nbol !: mixed-layer depth indexes when read from file 50 48 51 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: wkx !:49 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wkx !: 52 50 53 REAL(wp), PUBLIC, DIMENSION(jpi,jpj):: &51 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: & 54 52 rmld , & !: mld depth (m) corresponding to nmld 55 53 tml , sml , & !: \ "now" mixed layer temperature/salinity … … 66 64 rmld_sum, rmldbn !: needed to compute the leap-frog time mean of the ML depth 67 65 68 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: &66 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: & 69 67 tmlatfb, tmlatfn , & !: "before" Asselin contribution at begining of the averaging 70 68 smlatfb, smlatfn, & !: period (i.e. last contrib. from previous such period) and … … 72 70 tmlatfm, smlatfm !: accumulator for Asselin trends (needed for storage only) 73 71 74 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpltrd) :: &72 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: & 75 73 tmltrd, & !: \ physical contributions to the total trend (for T/S), 76 74 smltrd, & !: / cumulated over the current analysis window … … 83 81 #endif 84 82 !!---------------------------------------------------------------------- 85 !! NEMO/OPA 3.3 , NEMO Consortium (2010)83 !! NEMO/OPA 4.0 , NEMO Consortium (2011) 86 84 !! $Id$ 87 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 85 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 86 !!---------------------------------------------------------------------- 87 CONTAINS 88 89 INTEGER FUNCTION trdmld_oce_alloc() 90 !!---------------------------------------------------------------------- 91 !! *** FUNCTION trdmld_oce_alloc *** 92 !!---------------------------------------------------------------------- 93 USE lib_mpp 94 INTEGER :: ierr(5) 95 !!---------------------------------------------------------------------- 96 97 ! Initialise jpktrd here as can no longer do it in MODULE body since 98 ! jpk is now a variable. 99 jpktrd = jpk !: max level for mixed-layer trends diag. 100 101 ierr(:) = 0 102 103 #if defined key_trdmld || defined key_esopa 104 ALLOCATE( nmld(jpi,jpj), nbol(jpi,jpj), & 105 & wkx(jpi,jpj,jpk), rmld(jpi,jpj), & 106 & tml(jpi,jpj) , sml(jpi,jpj), & 107 & tmlb(jpi,jpj) , smlb(jpi,jpj) , & 108 & tmlbb(jpi,jpj) , smlbb(jpi,jpj), STAT = ierr(1) ) 109 110 ALLOCATE( tmlbn(jpi,jpj) , smlbn(jpi,jpj), & 111 & tmltrdm(jpi,jpj), smltrdm(jpi,jpj), & 112 & tml_sum(jpi,jpj), tml_sumb(jpi,jpj),& 113 & tmltrd_atf_sumb(jpi,jpj) , STAT=ierr(2) ) 114 115 ALLOCATE( sml_sum(jpi,jpj), sml_sumb(jpi,jpj), & 116 & smltrd_atf_sumb(jpi,jpj), & 117 & rmld_sum(jpi,jpj), rmldbn(jpi,jpj), & 118 & tmlatfb(jpi,jpj), tmlatfn(jpi,jpj), STAT = ierr(3) ) 119 120 ALLOCATE( smlatfb(jpi,jpj), smlatfn(jpi,jpj), & 121 & tmlatfm(jpi,jpj), smlatfm(jpi,jpj), & 122 & tmltrd(jpi,jpj,jpltrd), smltrd(jpi,jpj,jpltrd), STAT=ierr(4)) 123 124 ALLOCATE( tmltrd_sum(jpi,jpj,jpltrd),tmltrd_csum_ln(jpi,jpj,jpltrd), & 125 & tmltrd_csum_ub(jpi,jpj,jpltrd), smltrd_sum(jpi,jpj,jpltrd), & 126 & smltrd_csum_ln(jpi,jpj,jpltrd), smltrd_csum_ub(jpi,jpj,jpltrd), STAT=ierr(5) ) 127 #endif 128 ! 129 trdmld_oce_alloc = MAXVAL( ierr ) 130 IF( lk_mpp ) CALL mpp_sum ( trdmld_oce_alloc ) 131 IF( trdmld_oce_alloc /= 0 ) CALL ctl_warn('trdmld_oce_alloc: failed to allocate arrays') 132 ! 133 END FUNCTION trdmld_oce_alloc 134 88 135 !!====================================================================== 89 136 END MODULE trdmld_oce -
trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdmod.F90
r2528 r2715 24 24 USE trdmld ! ocean active mixed layer tracers trends 25 25 USE in_out_manager ! I/O manager 26 USE lib_mpp ! MPP library 26 27 27 28 IMPLICIT NONE … … 39 40 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 40 41 !! $Id$ 41 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)42 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 42 43 !!---------------------------------------------------------------------- 43 44 … … 51 52 !! integral constraints 52 53 !!---------------------------------------------------------------------- 53 INTEGER, INTENT( in ) :: kt ! time step 54 INTEGER, INTENT( in ) :: ktrd ! tracer trend index 55 CHARACTER(len=3), INTENT( in ) :: ctype ! momentum or tracers trends type 'DYN'/'TRA' 56 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) :: ptrdx ! Temperature or U trend 57 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) :: ptrdy ! Salinity or V trend 54 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 55 USE wrk_nemo, ONLY: ztswu => wrk_2d_1, & 56 ztswv => wrk_2d_2, & 57 ztbfu => wrk_2d_3, & 58 ztbfv => wrk_2d_4, & 59 z2dx => wrk_2d_5, & 60 z2dy => wrk_2d_6 61 ! 62 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: ptrdx ! Temperature or U trend 63 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: ptrdy ! Salinity or V trend 64 CHARACTER(len=3) , INTENT(in ) :: ctype ! momentum or tracers trends type 'DYN'/'TRA' 65 INTEGER , INTENT(in ) :: kt ! time step 66 INTEGER , INTENT(in ) :: ktrd ! tracer trend index 58 67 !! 59 INTEGER :: ji, jj 60 REAL(wp), DIMENSION(jpi,jpj) :: ztswu, ztswv ! 2D workspace 61 REAL(wp), DIMENSION(jpi,jpj) :: ztbfu, ztbfv ! 2D workspace 62 REAL(wp), DIMENSION(jpi,jpj) :: z2dx, z2dy ! workspace arrays 63 !!---------------------------------------------------------------------- 64 65 z2dx(:,:) = 0.e0 ; z2dy(:,:) = 0.e0 ! initialization of workspace arrays 66 67 IF( neuler == 0 .AND. kt == nit000 ) THEN ; r2dt = rdt ! = rdtra (restarting with Euler time stepping) 68 ELSEIF( kt <= nit000 + 1) THEN ; r2dt = 2. * rdt ! = 2 rdttra (leapfrog) 68 INTEGER :: ji, jj ! dummy loop indices 69 !!---------------------------------------------------------------------- 70 71 IF(wrk_in_use(2, 1,2,3,4,5,6))THEN 72 CALL ctl_warn('trd_mod: Requested workspace arrays already in use.') ; RETURN 73 END IF 74 75 z2dx(:,:) = 0._wp ; z2dy(:,:) = 0._wp ! initialization of workspace arrays 76 77 IF( neuler == 0 .AND. kt == nit000 ) THEN ; r2dt = rdt ! = rdtra (restart with Euler time stepping) 78 ELSEIF( kt <= nit000 + 1) THEN ; r2dt = 2. * rdt ! = 2 rdttra (leapfrog) 69 79 ENDIF 70 80 … … 84 94 CASE ( jptra_trd_dmp ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_dmp, ctype ) ! damping 85 95 CASE ( jptra_trd_qsr ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_qsr, ctype ) ! penetrative solar radiat. 86 CASE ( jptra_trd_nsr ) 87 z2dx(:,:) = ptrdx(:,:,1) ;z2dy(:,:) = ptrdy(:,:,1)88 CALL trd_icp( z2dx, z2dy, jpicpt_nsr, ctype )! non solar radiation96 CASE ( jptra_trd_nsr ) ; z2dx(:,:) = ptrdx(:,:,1) 97 z2dy(:,:) = ptrdy(:,:,1) 98 CALL trd_icp( z2dx , z2dy , jpicpt_nsr, ctype ) ! non solar radiation 89 99 CASE ( jptra_trd_xad ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_xad, ctype ) ! x- horiz adv 90 100 CASE ( jptra_trd_yad ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_yad, ctype ) ! y- horiz adv 91 CASE ( jptra_trd_zad ) 92 CALL trd_icp( ptrdx, ptrdy, jpicpt_zad, ctype )93 ! compute the surface flux condition wn(:,:,1)*tn(:,:,1)94 z2dx(:,:) = wn(:,:,1)*tn(:,:,1)/fse3t(:,:,1)95 z2dy(:,:) = wn(:,:,1)*sn(:,:,1)/fse3t(:,:,1)96 CALL trd_icp( z2dx , z2dy , jpicpt_zl1, ctype )! 1st z- vertical adv101 CASE ( jptra_trd_zad ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_zad, ctype ) ! z- vertical adv 102 CALL trd_icp( ptrdx, ptrdy, jpicpt_zad, ctype ) 103 ! compute the surface flux condition wn(:,:,1)*tn(:,:,1) 104 z2dx(:,:) = wn(:,:,1)*tn(:,:,1)/fse3t(:,:,1) 105 z2dy(:,:) = wn(:,:,1)*sn(:,:,1)/fse3t(:,:,1) 106 CALL trd_icp( z2dx , z2dy , jpicpt_zl1, ctype ) ! 1st z- vertical adv 97 107 END SELECT 98 108 END IF … … 113 123 ! subtract surface forcing/bottom friction trends 114 124 ! from vertical diffusive momentum trends 115 ztswu(:,:) = 0. e0 ; ztswv(:,:) = 0.e0116 ztbfu(:,:) = 0. e0 ; ztbfv(:,:) = 0.e0125 ztswu(:,:) = 0._wp ; ztswv(:,:) = 0._wp 126 ztbfu(:,:) = 0._wp ; ztbfv(:,:) = 0._wp 117 127 DO jj = 2, jpjm1 118 128 DO ji = fs_2, fs_jpim1 ! vector opt. … … 121 131 ztswv(ji,jj) = vtau(ji,jj) / ( fse3v(ji,jj,1)*rau0 ) 122 132 ! bottom friction contribution now handled explicitly 123 ! 124 ptrdx(ji,jj,1 ) = ptrdx(ji,jj,1 ) - ztswu(ji,jj) 125 ptrdy(ji,jj,1 ) = ptrdy(ji,jj,1 ) - ztswv(ji,jj) 133 ptrdx(ji,jj,1) = ptrdx(ji,jj,1) - ztswu(ji,jj) 134 ptrdy(ji,jj,1) = ptrdy(ji,jj,1) - ztswv(ji,jj) 126 135 END DO 127 136 END DO … … 218 227 ENDIF 219 228 ! 229 IF( wrk_not_released(2, 1,2,3,4,5,6) ) CALL ctl_warn('trd_mod: Failed to release workspace arrays.') 230 ! 220 231 END SUBROUTINE trd_mod 221 232 … … 228 239 USE trdicp ! ocean bassin integral constraints properties 229 240 USE trdmld ! ocean active mixed layer tracers trends 230 241 !!---------------------------------------------------------------------- 231 242 CONTAINS 232 243 SUBROUTINE trd_mod(ptrd3dx, ptrd3dy, ktrd , ctype, kt ) ! Empty routine 233 REAL 234 INTEGER :: ktrd, kt244 REAL(wp) :: ptrd3dx(:,:,:), ptrd3dy(:,:,:) 245 INTEGER :: ktrd, kt 235 246 CHARACTER(len=3) :: ctype 236 247 WRITE(*,*) 'trd_3d: You should not have seen this print! error ?', ptrd3dx(1,1,1), ptrd3dy(1,1,1) -
trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdmod_oce.F90
r2528 r2715 75 75 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 76 76 !! $Id$ 77 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)77 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 78 78 !!====================================================================== 79 79 END MODULE trdmod_oce -
trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdmod_trc.F90
r2528 r2715 4 4 !! Dummy module 5 5 !!====================================================================== 6 !!----------------------------------------------------------------------7 !! NEMO/OPA 3.3 , NEMO Consortium (2010)8 !! $Id$9 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)10 !!----------------------------------------------------------------------11 6 !!---------------------------------------------------------------------- 12 7 !! Dummy module NO TOP use … … 21 16 END SUBROUTINE trd_mod_trc 22 17 18 !!---------------------------------------------------------------------- 19 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 20 !! $Id$ 21 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 23 22 !!====================================================================== 24 23 END MODULE trdmod_trc -
trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90
r2528 r2715 4 4 !! Ocean diagnostics: ocean tracers trends 5 5 !!===================================================================== 6 !! History : 9.0 ! 2004-08 (C. Talandier) Original code7 !! 8 !! NEMO3.3 ! 2010-06 (C. Ethe) merge TRA-TRC6 !! History : 1.0 ! 2004-08 (C. Talandier) Original code 7 !! 2.0 ! 2005-04 (C. Deltel) Add Asselin trend in the ML budget 8 !! 3.3 ! 2010-06 (C. Ethe) merge TRA-TRC 9 9 !!---------------------------------------------------------------------- 10 10 #if defined key_trdtra || defined key_trdmld || defined key_trdmld_trc … … 12 12 !! trd_tra : Call the trend to be computed 13 13 !!---------------------------------------------------------------------- 14 USE dom_oce ! ocean domain 15 USE trdmod_oce ! ocean active mixed layer tracers trends 16 USE trdmod ! ocean active mixed layer tracers trends 17 USE trdmod_trc ! ocean passive mixed layer tracers trends 14 USE dom_oce ! ocean domain 15 USE trdmod_oce ! ocean active mixed layer tracers trends 16 USE trdmod ! ocean active mixed layer tracers trends 17 USE trdmod_trc ! ocean passive mixed layer tracers trends 18 USE in_out_manager ! I/O manager 19 USE lib_mpp ! MPP library 18 20 19 21 IMPLICIT NONE 20 22 PRIVATE 21 23 22 PUBLIC trd_tra ! called by all traXX modules24 PUBLIC trd_tra ! called by all traXX modules 23 25 24 !! * Module declaration 25 REAL(wp), DIMENSION(jpi,jpj,jpk), SAVE :: trdtx, trdty, trdt !: 26 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: trdtx, trdty, trdt !: 26 27 27 28 !! * Substitutions … … 29 30 # include "vectopt_loop_substitute.h90" 30 31 !!---------------------------------------------------------------------- 31 !! NEMO/OPA 3.3 , NEMO Consortium (2010)32 !! NEMO/OPA 4.0 , NEMO Consortium (2011) 32 33 !! $Id$ 33 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 34 !!---------------------------------------------------------------------- 35 34 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 35 !!---------------------------------------------------------------------- 36 36 CONTAINS 37 38 INTEGER FUNCTION trd_tra_alloc() 39 !!---------------------------------------------------------------------------- 40 !! *** FUNCTION trd_tra_alloc *** 41 !!---------------------------------------------------------------------------- 42 ALLOCATE( trdtx(jpi,jpj,jpk) , trdty(jpi,jpj,jpk) , trdt(jpi,jpj,jpk) , STAT= trd_tra_alloc ) 43 ! 44 IF( lk_mpp ) CALL mpp_sum ( trd_tra_alloc ) 45 IF( trd_tra_alloc /= 0 ) CALL ctl_warn('trd_tra_alloc: failed to allocate arrays') 46 END FUNCTION trd_tra_alloc 47 37 48 38 49 SUBROUTINE trd_tra( kt, ctype, ktra, ktrd, ptrd, pun, ptra ) … … 50 61 !! nn_ctls > 1 : use fixed level surface jk = nn_ctls 51 62 !!---------------------------------------------------------------------- 63 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 64 USE wrk_nemo, ONLY: ztrds => wrk_3d_10 ! 3D workspace 65 ! 52 66 INTEGER , INTENT(in) :: kt ! time step 53 67 CHARACTER(len=3) , INTENT(in) :: ctype ! tracers trends type 'TRA'/'TRC' … … 57 71 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: pun ! velocity 58 72 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: ptra ! Tracer variable 59 !! 60 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztrds ! 61 !!---------------------------------------------------------------------- 62 73 !!---------------------------------------------------------------------- 74 75 IF( wrk_in_use(3, 10) ) THEN 76 CALL ctl_stop('trd_tra: requested workspace array unavailable') ; RETURN 77 ENDIF 78 79 IF( .NOT. ALLOCATED( trdtx ) ) THEN ! allocate trdtra arrays 80 IF( trd_tra_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'trd_tra : unable to allocate arrays' ) 81 ENDIF 82 63 83 ! Control of optional arguments 64 84 IF( ctype == 'TRA' .AND. ktra == jp_tem ) THEN … … 118 138 ENDIF 119 139 ! 140 IF( wrk_not_released(3, 10) ) CALL ctl_stop('trd_tra: failed to release workspace array') 141 ! 120 142 END SUBROUTINE trd_tra 143 121 144 122 145 SUBROUTINE trd_tra_adv( pf, pun, ptn, cdir, ptrd ) … … 130 153 !! k-advective trends = -un. di+1[T] = -( dk+1[fi] - tn dk+1[un] ) 131 154 !!---------------------------------------------------------------------- 132 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk) 133 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk) 134 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk) 135 CHARACTER(len=1), INTENT(in ) 136 REAL(wp) , INTENT(out), DIMENSION(jpi,jpj,jpk) 137 ! !138 INTEGER 139 INTEGER 140 REAL(wp) :: zbtr ! temporaryscalar155 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk) :: pf ! advective flux in one direction 156 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk) :: pun ! now velocity in one direction 157 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk) :: ptn ! now or before tracer 158 CHARACTER(len=1), INTENT(in ) :: cdir ! X/Y/Z direction 159 REAL(wp) , INTENT(out), DIMENSION(jpi,jpj,jpk) :: ptrd ! advective trend in one direction 160 ! 161 INTEGER :: ji, jj, jk ! dummy loop indices 162 INTEGER :: ii, ij, ik ! index shift function of the direction 163 REAL(wp) :: zbtr ! local scalar 141 164 !!---------------------------------------------------------------------- 142 165 … … 167 190 # else 168 191 !!---------------------------------------------------------------------- 169 !! Default case : Empty module192 !! Default case : Dummy module No trend diagnostics 170 193 !!---------------------------------------------------------------------- 171 194 USE par_oce ! ocean variables trends 172 173 195 CONTAINS 174 175 196 SUBROUTINE trd_tra( kt, ctype, ktra, ktrd, ptrd, pu, ptra ) 176 197 !!---------------------------------------------------------------------- … … 182 203 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: pu ! velocity 183 204 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: ptra ! Tracer variable 184 WRITE(*,*) 'trd_3d: You should not have seen this print! error ?', ptrd(1,1,1) 185 WRITE(*,*) ' " ": You should not have seen this print! error ?', ptra(1,1,1) 186 WRITE(*,*) ' " ": You should not have seen this print! error ?', pu(1,1,1) 187 WRITE(*,*) ' " ": You should not have seen this print! error ?', ktrd 188 WRITE(*,*) ' " ": You should not have seen this print! error ?', ktra 189 WRITE(*,*) ' " ": You should not have seen this print! error ?', ctype 190 WRITE(*,*) ' " ": You should not have seen this print! error ?', kt 205 WRITE(*,*) 'trd_3d: You should not have seen this print! error ?', ptrd(1,1,1), ptra(1,1,1), pu(1,1,1), & 206 & ktrd, ktra, ctype, kt 191 207 END SUBROUTINE trd_tra 192 208 # endif -
trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor.F90
r2528 r2715 4 4 !! Ocean diagnostics: momentum trends 5 5 !!===================================================================== 6 !! History : 9.0 ! 04-06 (L. Brunier, A-M. Treguier) Original code7 !! ! 04-08 (C. Talandier) New trends organization6 !! History : 1.0 ! 04-2006 (L. Brunier, A-M. Treguier) Original code 7 !! 2.0 ! 04-2008 (C. Talandier) New trends organization 8 8 !!---------------------------------------------------------------------- 9 9 #if defined key_trdvor || defined key_esopa … … 26 26 USE ioipsl ! NetCDF library 27 27 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 28 USE lib_mpp ! MPP library 28 29 29 30 IMPLICIT NONE … … 37 38 PUBLIC trd_vor_zint ! routine called by dynamics routines 38 39 PUBLIC trd_vor_init ! routine called by opa.F90 39 40 INTEGER :: nh_t, nmoydpvor, nidvor, nhoridvor, ndexvor1(jpi*jpj), ndimvor1, icount ! needs for IOIPSL output 40 PUBLIC trd_vor_alloc ! routine called by nemogcm.F90 41 42 INTEGER :: nh_t, nmoydpvor, nidvor, nhoridvor, ndimvor1, icount ! needs for IOIPSL output 43 INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndexvor1 ! needed for IOIPSL output 41 44 INTEGER :: ndebug ! (0/1) set it to 1 in case of problem to have more print 42 45 43 REAL(wp), DIMENSION(jpi,jpj) :: vor_avr ! average 44 REAL(wp), DIMENSION(jpi,jpj) :: vor_avrb ! before vorticity (kt-1) 45 REAL(wp), DIMENSION(jpi,jpj) :: vor_avrbb ! vorticity at begining of the nwrite-1 timestep averaging period 46 REAL(wp), DIMENSION(jpi,jpj) :: vor_avrbn ! after vorticity at time step after the 47 REAL(wp), DIMENSION(jpi,jpj) :: rotot ! begining of the NWRITE-1 timesteps 48 REAL(wp), DIMENSION(jpi,jpj) :: vor_avrtot ! 49 REAL(wp), DIMENSION(jpi,jpj) :: vor_avrres ! 50 51 REAL(wp), DIMENSION(jpi,jpj,jpltot_vor) :: vortrd ! curl of trends 46 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: vor_avr ! average 47 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: vor_avrb ! before vorticity (kt-1) 48 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: vor_avrbb ! vorticity at begining of the nwrite-1 timestep averaging period 49 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: vor_avrbn ! after vorticity at time step after the 50 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: rotot ! begining of the NWRITE-1 timesteps 51 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: vor_avrtot ! 52 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: vor_avrres ! 53 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: vortrd ! curl of trends 52 54 53 55 CHARACTER(len=12) :: cvort … … 63 65 !!---------------------------------------------------------------------- 64 66 CONTAINS 67 68 INTEGER FUNCTION trd_vor_alloc() 69 !!---------------------------------------------------------------------------- 70 !! *** ROUTINE trd_vor_alloc *** 71 !!---------------------------------------------------------------------------- 72 ALLOCATE( vor_avr (jpi,jpj) , vor_avrb(jpi,jpj) , vor_avrbb (jpi,jpj) , & 73 & vor_avrbn (jpi,jpj) , rotot (jpi,jpj) , vor_avrtot(jpi,jpj) , & 74 & vor_avrres(jpi,jpj) , vortrd (jpi,jpj,jpltot_vor) , & 75 & ndexvor1 (jpi*jpj) , STAT= trd_vor_alloc ) 76 ! 77 IF( lk_mpp ) CALL mpp_sum ( trd_vor_alloc ) 78 IF( trd_vor_alloc /= 0 ) CALL ctl_warn('trd_vor_alloc: failed to allocate arrays') 79 END FUNCTION trd_vor_alloc 80 65 81 66 82 SUBROUTINE trd_vor_zint_2d( putrdvor, pvtrdvor, ktrd ) … … 91 107 !! trends output in netCDF format using ioipsl 92 108 !!---------------------------------------------------------------------- 109 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 110 USE wrk_nemo, ONLY: zudpvor => wrk_2d_1 , zvdpvor => wrk_2d_2 ! total cmulative trends 111 ! 93 112 INTEGER , INTENT(in ) :: ktrd ! ocean trend index 94 113 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: putrdvor ! u vorticity trend 95 114 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pvtrdvor ! v vorticity trend 96 ! !115 ! 97 116 INTEGER :: ji, jj ! dummy loop indices 98 117 INTEGER :: ikbu, ikbv ! local integers 99 REAL(wp), DIMENSION(jpi,jpj) :: zudpvor, zvdpvor ! total cmulative trends 100 !!---------------------------------------------------------------------- 118 !!---------------------------------------------------------------------- 119 120 IF( wrk_in_use(2, 1,2) ) THEN 121 CALL ctl_stop('trd_vor_zint_2d: requested workspace arrays unavailable') ; RETURN 122 ENDIF 101 123 102 124 ! Initialization 103 zudpvor(:,:) = 0._wp 104 zvdpvor(:,:) = 0._wp 105 ! 106 CALL lbc_lnk( putrdvor, 'U' , -1. ) ! lateral boundary condition on input momentum trends 107 CALL lbc_lnk( pvtrdvor, 'V' , -1. ) 125 zudpvor(:,:) = 0._wp ; zvdpvor(:,:) = 0._wp 126 CALL lbc_lnk( putrdvor, 'U', -1. ) ; CALL lbc_lnk( pvtrdvor, 'V', -1. ) ! lateral boundary condition 127 108 128 109 129 ! ===================================== … … 147 167 ENDIF 148 168 ! 169 IF( wrk_not_released(2, 1,2) ) CALL ctl_stop('trd_vor_zint_2d : failed to release workspace arrays.') 170 ! 149 171 END SUBROUTINE trd_vor_zint_2d 150 172 … … 177 199 !! trends output in netCDF format using ioipsl 178 200 !!---------------------------------------------------------------------- 201 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 202 USE wrk_nemo, ONLY: zubet => wrk_2d_1, zvbet => wrk_2d_2 ! Beta.V 203 USE wrk_nemo, ONLY: zudpvor => wrk_2d_3, zvdpvor => wrk_2d_4 ! total cmulative trends 204 ! 179 205 INTEGER , INTENT(in ) :: ktrd ! ocean trend index 180 206 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: putrdvor ! u vorticity trend 181 207 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pvtrdvor ! v vorticity trend 182 !! 183 INTEGER :: ji, jj, jk 184 REAL(wp), DIMENSION(jpi,jpj) :: zubet , zvbet ! Beta.V 185 REAL(wp), DIMENSION(jpi,jpj) :: zudpvor, zvdpvor ! total cmulative trends 208 ! 209 INTEGER :: ji, jj, jk ! dummy loop indices 186 210 !!---------------------------------------------------------------------- 187 211 212 IF( wrk_in_use(2, 1,2,3,4) ) THEN 213 CALL ctl_stop('trd_vor_zint_3d: requested workspace arrays unavailable.') ; RETURN 214 ENDIF 215 188 216 ! Initialization 189 217 zubet (:,:) = 0._wp … … 192 220 zvdpvor(:,:) = 0._wp 193 221 ! 194 CALL lbc_lnk( putrdvor, 'U' 195 CALL lbc_lnk( pvtrdvor, 'V' 222 CALL lbc_lnk( putrdvor, 'U', -1. ) ! lateral boundary condition on input momentum trends 223 CALL lbc_lnk( pvtrdvor, 'V', -1. ) 196 224 197 225 ! ===================================== … … 248 276 ENDIF 249 277 ! 278 IF( wrk_not_released(2, 1,2,3,4) ) CALL ctl_stop('trd_vor_zint_3d: failed to release workspace arrays') 279 ! 250 280 END SUBROUTINE trd_vor_zint_3d 251 281 … … 258 288 !! and make outputs (NetCDF or DIMG format) 259 289 !!---------------------------------------------------------------------- 290 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 291 USE wrk_nemo, ONLY: zun => wrk_2d_1 , zvn => wrk_2d_2 ! 2D workspace 292 ! 260 293 INTEGER, INTENT(in) :: kt ! ocean time-step index 261 ! !294 ! 262 295 INTEGER :: ji, jj, jk, jl ! dummy loop indices 263 296 INTEGER :: it, itmod ! local integers 264 297 REAL(wp) :: zmean ! local scalars 265 REAL(wp), DIMENSION(jpi,jpj) :: zun, zvn ! 2D workspace 266 !!---------------------------------------------------------------------- 298 !!---------------------------------------------------------------------- 299 300 IF( wrk_in_use(2, 1,2) ) THEN 301 CALL ctl_stop('trd_vor: requested workspace arrays unavailable.') ; RETURN 302 ENDIF 267 303 268 304 ! ================= … … 431 467 IF( kt == nitend ) CALL histclo( nidvor ) 432 468 ! 469 IF( wrk_not_released(2, 1,2) ) CALL ctl_stop('trd_vor: failed to release workspace arrays') 470 ! 433 471 END SUBROUTINE trd_vor 434 472 … … 466 504 WRITE(numout,*) ' ' 467 505 ENDIF 506 507 IF( trd_vor_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'trd_vor_init : unable to allocate trdvor arrays' ) 508 468 509 469 510 ! cumulated trends array init -
trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor_oce.F90
r2528 r2715 4 4 !! Ocean trends : set vorticity trend variables 5 5 !!====================================================================== 6 !! History : 9.0 ! ???6 !! History : 9.0 ! 04-2006 (L. Brunier, A-M. Treguier) Original code 7 7 !!---------------------------------------------------------------------- 8 8 … … 14 14 15 15 #if defined key_trdvor 16 LOGICAL, PUBLIC, PARAMETER :: lk_trdvor = .TRUE. 16 LOGICAL, PUBLIC, PARAMETER :: lk_trdvor = .TRUE. !: momentum trend flag 17 17 #else 18 LOGICAL, PUBLIC, PARAMETER :: lk_trdvor = .FALSE. 18 LOGICAL, PUBLIC, PARAMETER :: lk_trdvor = .FALSE. !: momentum trend flag 19 19 #endif 20 ! !* vorticity trends index20 ! !!* vorticity trends index 21 21 INTEGER, PUBLIC, PARAMETER :: jpltot_vor = 11 !: Number of vorticity trend terms 22 22 ! … … 36 36 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 37 37 !! $Id$ 38 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)38 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 39 39 !!====================================================================== 40 40 END MODULE trdvor_oce
Note: See TracChangeset
for help on using the changeset viewer.