- Timestamp:
- 2010-10-13T17:58:28+02:00 (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90
r2240 r2257 57 57 REAL(wp) :: rbcp ! Brown & Campana parameters for semi-implicit hpg 58 58 REAL(wp), DIMENSION(jpk) :: r2dt ! vertical profile time step, =2*rdttra (leapfrog) or =rdttra (Euler) 59 LOGICAL :: l_tra ! active tracers or passive tracers 59 60 60 61 !! * Substitutions … … 94 95 INTEGER, INTENT(in) :: kt ! ocean time-step index 95 96 !! 96 INTEGER :: jk ! dummy loop indices97 REAL(wp) :: zfact ! local scalars97 INTEGER :: jk, jn ! dummy loop indices 98 REAL(wp) :: zfact ! local scalars 98 99 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdt, ztrds 99 100 !!---------------------------------------------------------------------- … … 142 143 143 144 ! Leap-Frog + Asselin filter time stepping 144 IF( lk_vvl ) THEN ; CALL tra_nxt_vvl( kt, 'TRA', tsb, tsn, tsa, jpts ) ! variable volume level (vvl) 145 ELSE ; CALL tra_nxt_fix( kt, 'TRA', tsb, tsn, tsa, jpts ) ! fixed volume level 146 ENDIF 145 IF( neuler == 0 .AND. kt == nit000 ) THEN ! Euler time-stepping at first time-step 146 ! ! (only swap) 147 DO jn = 1, jpts 148 DO jk = 1, jpkm1 149 tsn(:,:,jk,jn) = tsa(:,:,jk,jn) 150 END DO 151 END DO 152 ! 153 ELSE 154 IF( lk_vvl ) THEN ; CALL tra_nxt_vvl( kt, 'TRA', tsb, tsn, tsa, jpts ) ! variable volume level (vvl) 155 ELSE ; CALL tra_nxt_fix( kt, 'TRA', tsb, tsn, tsa, jpts ) ! fixed volume level 156 ENDIF 157 ENDIF 147 158 148 159 #if defined key_agrif … … 202 213 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pta ! tracer trend 203 214 INTEGER :: ji, jj, jk, jn ! dummy loop indices 204 REAL(wp) :: zt d, ztm ! temporary scalars215 REAL(wp) :: ztn, ztd, ztm ! temporary scalars 205 216 !!---------------------------------------------------------------------- 206 217 … … 211 222 ENDIF 212 223 ! 213 ! 214 IF( neuler == 0 .AND. kt == nit000 ) THEN ! Euler time-stepping at first time-step 215 ! ! (only swap) 216 DO jn = 1, kjpt 217 DO jk = 1, jpkm1 218 ptn(:,:,jk,jn) = pta(:,:,jk,jn) ! ptb <-- ptn 219 END DO 224 IF( cdtype == 'TRA' ) THEN ; l_tra = .TRUE. ! active tracers case 225 ELSE ; l_tra = .FALSE. ! passive tracers case 226 ENDIF 227 ! 228 DO jn = 1, kjpt 229 ! 230 DO jk = 1, jpkm1 231 DO jj = 1, jpj 232 DO ji = 1, jpi 233 IF( l_tra .AND. ln_dynhpg_imp ) ztn = ptn(ji,jj,jk,jn) ! implicit hpg: keep tn, sn in memory 234 ! 235 ztd = pta(ji,jj,jk,jn) - 2.* ptn(ji,jj,jk,jn) + ptb(ji,jj,jk,jn) ! time laplacian on tracers 236 ! 237 ptb(ji,jj,jk,jn) = ptn(ji,jj,jk,jn) + atfp * ztd ! ptb <-- filtered ptn 238 ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn) ! ptn <-- pta 239 ! 240 IF( l_tra .AND. ln_dynhpg_imp ) pta(ji,jj,jk,jn) = ztn + rbcp * ztd ! pta <-- Brown & Campana average 241 END DO 242 END DO 220 243 END DO 221 !222 ELSE ! general case (Leapfrog + Asselin filter223 244 ! 224 ! ! ----------------------- ! 225 IF( ln_dynhpg_imp .AND. cdtype == 'TRA' ) THEN ! semi-implicite hpg case ! 226 ! ! ----------------------- ! 227 DO jn = 1, kjpt 228 DO jk = 1, jpkm1 229 DO jj = 1, jpj 230 DO ji = 1, jpi 231 ztd = pta(ji,jj,jk,jn) - 2.* ptn(ji,jj,jk,jn) + ptb(ji,jj,jk,jn) ! time laplacian on tracers 232 ztm = ptn(ji,jj,jk,jn) + rbcp * ztd ! used for both Asselin and Brown & Campana filters 233 ! 234 ptb(ji,jj,jk,jn) = ptn(ji,jj,jk,jn) + atfp * ztd ! ptb <-- filtered ptn 235 ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn) ! ptn <-- pta 236 pta(ji,jj,jk,jn) = ztm ! pta <-- Brown & Campana average 237 END DO 238 END DO 239 END DO 240 END DO 241 ! ! ----------------------- ! 242 ELSE ! explicit hpg case ! 243 ! ! ----------------------- ! 244 DO jn = 1, kjpt 245 DO jk = 1, jpkm1 246 DO jj = 1, jpj 247 DO ji = 1, jpi 248 ztd = pta(ji,jj,jk,jn) - 2.* ptn(ji,jj,jk,jn) + ptb(ji,jj,jk,jn) ! time laplacian on tracers 249 ! 250 ptb(ji,jj,jk,jn) = ptn(ji,jj,jk,jn) + atfp * ztd ! ptb <-- filtered ptn 251 ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn) ! ptn <-- pta 252 END DO 253 END DO 254 END DO 255 END DO 256 ENDIF 257 ! 258 ENDIF 245 END DO 259 246 ! 260 247 END SUBROUTINE tra_nxt_fix … … 306 293 ENDIF 307 294 ! 308 ! 309 IF( neuler == 0 .AND. kt == nit000 ) THEN ! Euler time-stepping at first time-step 310 ! ! (only swap) 311 DO jn = 1, kjpt 312 DO jk = 1, jpkm1 313 ptn(:,:,jk,jn) = pta(:,:,jk,jn) ! ptb <-- ptn 295 IF( cdtype == 'TRA' ) THEN ; l_tra = .TRUE. ! active tracers case 296 ELSE ; l_tra = .FALSE. ! passive tracers case 297 ENDIF 298 ! 299 DO jn = 1, kjpt 300 DO jk = 1, jpkm1 301 zfact1 = atfp * rdttra(jk) 302 zfact2 = zfact1 / rau0 303 DO jj = 1, jpj 304 DO ji = 1, jpi 305 ze3t_b = fse3t_b(ji,jj,jk) 306 ze3t_n = fse3t_n(ji,jj,jk) 307 ze3t_a = fse3t_a(ji,jj,jk) 308 ! ! tracer content at Before, now and after 309 ztc_b = ptb(ji,jj,jk,jn) * ze3t_b 310 ztc_n = ptn(ji,jj,jk,jn) * ze3t_n 311 ztc_a = pta(ji,jj,jk,jn) * ze3t_a 312 ! 313 ze3t_d = ze3t_a - 2. * ze3t_n + ze3t_b 314 ztc_d = ztc_a - 2. * ztc_n + ztc_b 315 ! 316 ze3t_f = ze3t_n + atfp * ze3t_d 317 ztc_f = ztc_n + atfp * ztc_d 318 319 IF( l_tra .AND. jk == 1 ) THEN 320 ze3t_f = ze3t_f - zfact2 * ( emp_b(ji,jj) - emp(ji,jj) ) 321 ztc_f = ztc_f - zfact1 * ( sbc_tsc(ji,jj,jn) - sbc_tsc_b(ji,jj,jn) ) 322 ENDIF 323 IF( l_tra .AND. jn == jp_tem .AND. ln_traqsr .AND. jk <= nksr ) & 324 & ztc_f = ztc_f - zfact1 * ( qsr_hc(ji,jj,jk) - qsr_hc_b(ji,jj,jk) ) 325 326 ze3t_f = 1.e0 / ze3t_f 327 ptb(ji,jj,jk,jn) = ztc_f * ze3t_f ! ptb <-- ptn filtered 328 ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn) ! ptn <-- pta 329 ! 330 IF( l_tra .AND. ln_dynhpg_imp ) THEN 331 ze3t_d = 1.e0 / ( ze3t_n + rbcp * ze3t_d ) 332 pta(ji,jj,jk,jn) = ze3t_d * ( ztc_n + rbcp * ztc_d ) ! ta <-- Brown & Campana average 333 ENDIF 334 END DO 314 335 END DO 315 336 END DO 316 ! 317 ELSE ! general case (Leapfrog + Asselin filter) 318 ! 319 ! ! ----------------------- ! 320 IF( ln_dynhpg_imp .AND. cdtype == 'TRA' ) THEN ! semi-implicite hpg case ! 321 ! ! ----------------------- ! 322 DO jn = 1, kjpt 323 DO jk = 1, jpkm1 324 DO jj = 1, jpj 325 DO ji = 1, jpi 326 ze3t_b = fse3t_b(ji,jj,jk) 327 ze3t_n = fse3t_n(ji,jj,jk) 328 ze3t_a = fse3t_a(ji,jj,jk) 329 ! ! tracer content at Before, now and after 330 ztc_b = ptb(ji,jj,jk,jn) * ze3t_b 331 ztc_n = ptn(ji,jj,jk,jn) * ze3t_n 332 ztc_a = pta(ji,jj,jk,jn) * ze3t_a 333 ! ! Time laplacian on tracer contents 334 ! ! used for both Asselin and Brown & Campana filters 335 ze3t_d = ze3t_b - 2.* ze3t_n + ze3t_a 336 ztc_d = ztc_b - 2.* ztc_n + ztc_a 337 ! ! Asselin Filter on thicknesses and tracer contents 338 ztc_f = ztc_n + atfp * ztc_d 339 ztc_m = ztc_n + rbcp * ztc_d 340 ! 341 ze3t_f = 1.0 / ( ze3t_n + atfp * ze3t_d ) 342 ze3t_m = 1.0 / ( ze3t_n + rbcp * ze3t_d ) 343 ! ! swap of arrays 344 ptb(ji,jj,jk,jn) = ztc_f * ze3t_f ! ptb <-- ptn filtered 345 pta(ji,jj,jk,jn) = ztc_m * ze3t_m ! pta <-- Brown & Campana average 346 ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn) ! ptn <-- pta 347 END DO 348 END DO 349 END DO 350 END DO 351 ! ! ----------------------- ! 352 ELSE ! explicit hpg case ! 353 ! ! ----------------------- ! 354 IF( cdtype == 'TRA' ) THEN 355 ! 356 DO jn = 1, kjpt 357 DO jk = 1, jpkm1 358 zfact1 = atfp * rdttra(jk) 359 zfact2 = zfact1 / rau0 360 DO jj = 1, jpj 361 DO ji = 1, jpi 362 ze3t_b = fse3t_b(ji,jj,jk) 363 ze3t_n = fse3t_n(ji,jj,jk) 364 ze3t_a = fse3t_a(ji,jj,jk) 365 ! ! tracer content at Before, now and after 366 ztc_b = ptb(ji,jj,jk,jn) * ze3t_b 367 ztc_n = ptn(ji,jj,jk,jn) * ze3t_n 368 ztc_a = pta(ji,jj,jk,jn) * ze3t_a 369 ! 370 ze3t_f = ze3t_n + atfp * ( ze3t_b - 2. * ze3t_n + ze3t_a ) 371 ztc_f = ztc_n + atfp * ( ztc_a - 2. * ztc_n + ztc_b ) 372 373 IF( jk == 1 ) THEN 374 ze3t_f = ze3t_f - zfact2 * ( emp_b(ji,jj) - emp(ji,jj) ) 375 IF( jn == jp_tem ) ztc_f = ztc_f - zfact1 * ( sbc_hc_n(ji,jj) - sbc_hc_b(ji,jj) ) 376 IF( jn == jp_sal ) ztc_f = ztc_f - zfact1 * ( sbc_sc_n(ji,jj) - sbc_sc_b(ji,jj) ) 377 ENDIF 378 IF( jn == jp_tem .AND. ln_traqsr .AND. jk <= nksr ) & 379 & ztc_f = ztc_f - zfact1 * ( qsr_hc_n(ji,jj,jk) - qsr_hc_b(ji,jj,jk) ) 380 381 ze3t_f = 1.e0 / ze3t_f 382 ptb(ji,jj,jk,jn) = ztc_f * ze3t_f ! tb <-- tn filtered 383 ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn) ! tn <-- ta 384 END DO 385 END DO 386 END DO 387 END DO 388 ! 389 ELSE IF( cdtype == 'TRC' ) THEN 390 ! 391 DO jn = 1, kjpt 392 DO jk = 1, jpkm1 393 DO jj = 1, jpj 394 DO ji = 1, jpi 395 ze3t_b = fse3t_b(ji,jj,jk) 396 ze3t_n = fse3t_n(ji,jj,jk) 397 ze3t_a = fse3t_a(ji,jj,jk) 398 ! ! tracer content at Before, now and after 399 ztc_b = ptb(ji,jj,jk,jn) * ze3t_b 400 ztc_n = ptn(ji,jj,jk,jn) * ze3t_n 401 ztc_a = pta(ji,jj,jk,jn) * ze3t_a 402 ! 403 ze3t_f = ze3t_n + atfp * ( ze3t_b - 2. * ze3t_n + ze3t_a ) 404 ztc_f = ztc_n + atfp * ( ztc_a - 2. * ztc_n + ztc_b ) 405 406 ze3t_f = 1.e0 / ze3t_f 407 ptb(ji,jj,jk,jn) = ztc_f * ze3t_f ! tb <-- tn filtered 408 ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn) ! tn <-- ta 409 END DO 410 END DO 411 END DO 412 END DO 413 ! 414 END IF 415 ! 416 ENDIF 417 ! 418 ENDIF 337 ! 338 END DO 419 339 ! 420 340 END SUBROUTINE tra_nxt_vvl
Note: See TracChangeset
for help on using the changeset viewer.
