- Timestamp:
- 2015-12-15T10:46:14+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_CMCC_merge_2015/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_fct.F90
r5930 r6051 70 70 INTEGER , INTENT(in ) :: kn_fct_h ! order of the FCT scheme (=2 or 4) 71 71 INTEGER , INTENT(in ) :: kn_fct_v ! order of the FCT scheme (=2 or 4) 72 REAL(wp) , DIMENSION( jpk ), INTENT(in ) :: p2dt ! vertical profile oftracer time-step72 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step 73 73 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pun, pvn, pwn ! 3 ocean velocity components 74 74 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb, ptn ! before and now tracer fields … … 76 76 ! 77 77 INTEGER :: ji, jj, jk, jn ! dummy loop indices 78 REAL(wp) :: z 2dtt, ztra ! local scalar78 REAL(wp) :: ztra ! local scalar 79 79 REAL(wp) :: zfp_ui, zfp_vj, zfp_wk, zC2t_u, zC4t_u ! - - 80 80 REAL(wp) :: zfm_ui, zfm_vj, zfm_wk, zC2t_v, zC4t_v ! - - … … 149 149 ! 150 150 DO jk = 1, jpkm1 !* trend and after field with monotonic scheme 151 z2dtt = p2dt(jk)152 151 DO jj = 2, jpjm1 153 152 DO ji = fs_2, fs_jpim1 ! vector opt. … … 159 158 !!gm why tmask added in the two following lines ??? the mask is done in tranxt ! 160 159 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra * tmask(ji,jj,jk) 161 zwi(ji,jj,jk) = ( ptb(ji,jj,jk,jn) + z2dtt * ztra ) * tmask(ji,jj,jk)160 zwi(ji,jj,jk) = ( ptb(ji,jj,jk,jn) + p2dt * ztra ) * tmask(ji,jj,jk) 162 161 END DO 163 162 END DO … … 348 347 INTEGER , INTENT(in ) :: kjpt ! number of tracers 349 348 INTEGER , INTENT(in ) :: kn_fct_zts ! number of number of vertical sub-timesteps 350 REAL(wp) , DIMENSION( jpk ), INTENT(in ) :: p2dt ! vertical profile oftracer time-step349 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step 351 350 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pun, pvn, pwn ! 3 ocean velocity components 352 351 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb, ptn ! before and now tracer fields … … 354 353 ! 355 354 REAL(wp), DIMENSION( jpk ) :: zts ! length of sub-timestep for vertical advection 356 REAL(wp) , DIMENSION( jpk ):: zr_p2dt ! reciprocal of tracer timestep355 REAL(wp) :: zr_p2dt ! reciprocal of tracer timestep 357 356 INTEGER :: ji, jj, jk, jl, jn ! dummy loop indices 358 357 INTEGER :: jtb, jtn, jta ! sub timestep pointers for leap-frog/euler forward steps 359 358 INTEGER :: jtaken ! toggle for collecting appropriate fluxes from sub timesteps 360 359 REAL(wp) :: z_rzts ! Fractional length of Euler forward sub-timestep for vertical advection 361 REAL(wp) :: z 2dtt, ztra ! local scalar360 REAL(wp) :: ztra ! local scalar 362 361 REAL(wp) :: zfp_ui, zfp_vj, zfp_wk ! - - 363 362 REAL(wp) :: zfm_ui, zfm_vj, zfm_wk ! - - … … 390 389 zwi(:,:,:) = 0._wp 391 390 z_rzts = 1._wp / REAL( kn_fct_zts, wp ) 392 zr_p2dt (:) = 1._wp / p2dt(:)391 zr_p2dt = 1._wp / p2dt 393 392 ! 394 393 ! ! =========== … … 443 442 ! 444 443 DO jk = 1, jpkm1 ! total advective trend 445 z2dtt = p2dt(jk)446 444 DO jj = 2, jpjm1 447 445 DO ji = fs_2, fs_jpim1 ! vector opt. … … 452 450 ! update and guess with monotonic sheme 453 451 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra 454 zwi(ji,jj,jk) = ( ptb(ji,jj,jk,jn) + z2dtt * ztra ) * tmask(ji,jj,jk)452 zwi(ji,jj,jk) = ( ptb(ji,jj,jk,jn) + p2dt * ztra ) * tmask(ji,jj,jk) 455 453 END DO 456 454 END DO … … 508 506 IF( jl == 1 ) THEN ! Euler forward to kick things off 509 507 jtb = 1 ; jtn = 1 ; jta = 2 510 zts(:) = p2dt (:)* z_rzts508 zts(:) = p2dt * z_rzts 511 509 jtaken = MOD( kn_fct_zts + 1 , 2) ! Toggle to collect every second flux 512 510 ! ! starting at jl =1 if kn_fct_zts is odd; … … 514 512 ELSEIF( jl == 2 ) THEN ! First leapfrog step 515 513 jtb = 1 ; jtn = 2 ; jta = 3 516 zts(:) = 2._wp * p2dt (:)* z_rzts514 zts(:) = 2._wp * p2dt * z_rzts 517 515 ELSE ! Shuffle pointers for subsequent leapfrog steps 518 516 jtb = MOD(jtb,3) + 1 … … 557 555 DO jj = 2, jpjm1 558 556 DO ji = fs_2, fs_jpim1 559 zwz(ji,jj,jk) = ( zwzts(ji,jj,jk) * zr_p2dt (jk)- zwz_sav(ji,jj,jk) ) * wmask(ji,jj,jk)557 zwz(ji,jj,jk) = ( zwzts(ji,jj,jk) * zr_p2dt - zwz_sav(ji,jj,jk) ) * wmask(ji,jj,jk) 560 558 END DO 561 559 END DO … … 623 621 !! in-space based differencing for fluid 624 622 !!---------------------------------------------------------------------- 625 REAL(wp) , DIMENSION(jpk) , INTENT(in ) :: p2dt ! vertical profile oftracer time-step623 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step 626 624 REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in ) :: pbef, paft ! before & after field 627 625 REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(inout) :: paa, pbb, pcc ! monotonic fluxes in the 3 directions … … 629 627 INTEGER :: ji, jj, jk ! dummy loop indices 630 628 INTEGER :: ikm1 ! local integer 631 REAL(wp) :: zpos, zneg, zbt, za, zb, zc, zbig, zrtrn , z2dtt! local scalars629 REAL(wp) :: zpos, zneg, zbt, za, zb, zc, zbig, zrtrn ! local scalars 632 630 REAL(wp) :: zau, zbu, zcu, zav, zbv, zcv, zup, zdo ! - - 633 631 REAL(wp), POINTER, DIMENSION(:,:,:) :: zbetup, zbetdo, zbup, zbdo … … 652 650 DO jk = 1, jpkm1 653 651 ikm1 = MAX(jk-1,1) 654 z2dtt = p2dt(jk)655 652 DO jj = 2, jpjm1 656 653 DO ji = fs_2, fs_jpim1 ! vector opt. … … 679 676 680 677 ! up & down beta terms 681 zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) / z2dtt678 zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) / p2dt 682 679 zbetup(ji,jj,jk) = ( zup - paft(ji,jj,jk) ) / ( zpos + zrtrn ) * zbt 683 680 zbetdo(ji,jj,jk) = ( paft(ji,jj,jk) - zdo ) / ( zneg + zrtrn ) * zbt
Note: See TracChangeset
for help on using the changeset viewer.
