- Timestamp:
- 2016-11-28T17:04:10+01:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90
r5930 r7351 35 35 36 36 !! * Substitutions 37 # include "domzgr_substitute.h90"38 37 # include "vectopt_loop_substitute.h90" 39 38 !!---------------------------------------------------------------------- … … 71 70 !! On the vertical, the advection is evaluated using a FCT scheme, 72 71 !! as the UBS have been found to be too diffusive. 73 !!gm !! kn_ubs_v argument (not coded for the moment) 74 !! controles whether the FCT is based on a 2nd order centrered scheme (kn_ubs_v=2)75 !! or on a 4th order compactscheme (kn_ubs_v=4).72 !! kn_ubs_v argument controles whether the FCT is based on 73 !! a 2nd order centrered scheme (kn_ubs_v=2) or on a 4th order compact 74 !! scheme (kn_ubs_v=4). 76 75 !! 77 !! ** Action : - update (pta) with the now advective tracer trends 76 !! ** Action : - update pta with the now advective tracer trends 77 !! - send trends to trdtra module for further diagnostcs (l_trdtra=T) 78 !! - htr_adv, str_adv : poleward advective heat and salt transport (ln_diaptr=T) 78 79 !! 79 80 !! Reference : Shchepetkin, A. F., J. C. McWilliams, 2005, Ocean Modelling, 9, 347-404. … … 85 86 INTEGER , INTENT(in ) :: kjpt ! number of tracers 86 87 INTEGER , INTENT(in ) :: kn_ubs_v ! number of tracers 87 REAL(wp) , DIMENSION( jpk ), INTENT(in ) :: p2dt ! vertical profile oftracer time-step88 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step 88 89 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pun, pvn, pwn ! 3 ocean transport components 89 90 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb, ptn ! before and now tracer fields … … 91 92 ! 92 93 INTEGER :: ji, jj, jk, jn ! dummy loop indices 93 REAL(wp) :: ztra, zbtr, zcoef , z2dtt! local scalars94 REAL(wp) :: ztra, zbtr, zcoef ! local scalars 94 95 REAL(wp) :: zfp_ui, zfm_ui, zcenut, ztak, zfp_wk, zfm_wk ! - - 95 96 REAL(wp) :: zfp_vj, zfm_vj, zcenvt, zeeu, zeev, z_hdivn ! - - … … 110 111 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 111 112 ! 112 zltu(:,:,jpk) = 0._wp ; zltv(:,:,jpk) = 0._wp ! Bottom value : set to zero one for all 113 ztw (:,:, 1 ) = 0._wp ! surface & bottom value : set to zero for all tracers 114 zltu(:,:,jpk) = 0._wp ; zltv(:,:,jpk) = 0._wp 113 115 ztw (:,:,jpk) = 0._wp ; zti (:,:,jpk) = 0._wp 114 IF( lk_vvl ) ztw(:,:, 1 ) = 0._wp ! surface value: set to zero only in vvl case115 116 ! 116 117 ! ! =========== … … 121 122 DO jj = 1, jpjm1 ! First derivative (masked gradient) 122 123 DO ji = 1, fs_jpim1 ! vector opt. 123 zeeu = e2_e1u(ji,jj) * fse3u(ji,jj,jk) * umask(ji,jj,jk)124 zeev = e1_e2v(ji,jj) * fse3v(ji,jj,jk) * vmask(ji,jj,jk)124 zeeu = e2_e1u(ji,jj) * e3u_n(ji,jj,jk) * umask(ji,jj,jk) 125 zeev = e1_e2v(ji,jj) * e3v_n(ji,jj,jk) * vmask(ji,jj,jk) 125 126 ztu(ji,jj,jk) = zeeu * ( ptb(ji+1,jj ,jk,jn) - ptb(ji,jj,jk,jn) ) 126 127 ztv(ji,jj,jk) = zeev * ( ptb(ji ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) … … 129 130 DO jj = 2, jpjm1 ! Second derivative (divergence) 130 131 DO ji = fs_2, fs_jpim1 ! vector opt. 131 zcoef = 1._wp / ( 6._wp * fse3t(ji,jj,jk) )132 zcoef = 1._wp / ( 6._wp * e3t_n(ji,jj,jk) ) 132 133 zltu(ji,jj,jk) = ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) ) * zcoef 133 134 zltv(ji,jj,jk) = ( ztv(ji,jj,jk) - ztv(ji,jj-1,jk) ) * zcoef … … 162 163 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) & 163 164 & - ( ztu(ji,jj,jk) - ztu(ji-1,jj ,jk) & 164 & + ztv(ji,jj,jk) - ztv(ji ,jj-1,jk) ) / ( e1e2t(ji,jj) * fse3t(ji,jj,jk))165 & + ztv(ji,jj,jk) - ztv(ji ,jj-1,jk) ) * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 165 166 END DO 166 167 END DO … … 199 200 END DO 200 201 END DO 201 IF( .NOT.lk_vvl ) THEN! top ocean value (only in linear free surface as ztw has been w-masked)202 IF( ln_linssh ) THEN ! top ocean value (only in linear free surface as ztw has been w-masked) 202 203 IF( ln_isfcav ) THEN ! top of the ice-shelf cavities and at the ocean surface 203 204 DO jj = 1, jpj … … 212 213 ! 213 214 DO jk = 1, jpkm1 !* trend and after field with monotonic scheme 214 z2dtt = p2dt(jk)215 215 DO jj = 2, jpjm1 216 216 DO ji = fs_2, fs_jpim1 ! vector opt. 217 ztak = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk))217 ztak = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 218 218 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztak 219 zti(ji,jj,jk) = ( ptb(ji,jj,jk,jn) + z2dtt * ( ztak + zltu(ji,jj,jk) ) ) * tmask(ji,jj,jk)219 zti(ji,jj,jk) = ( ptb(ji,jj,jk,jn) + p2dt * ( ztak + zltu(ji,jj,jk) ) ) * tmask(ji,jj,jk) 220 220 END DO 221 221 END DO … … 233 233 END DO 234 234 ! ! top ocean value: high order == upstream ==>> zwz=0 235 IF( .NOT.lk_vvl ) ztw(:,:, 1 ) = 0._wp! only ocean surface as interior zwz values have been w-masked235 IF( ln_linssh ) ztw(:,:, 1 ) = 0._wp ! only ocean surface as interior zwz values have been w-masked 236 236 ! 237 237 CALL nonosc_z( ptb(:,:,:,jn), ztw, zti, p2dt ) ! monotonicity algorithm … … 246 246 END DO 247 247 END DO 248 IF( .NOT.lk_vvl) ztw(:,:, 1 ) = pwn(:,:,1) * ptn(:,:,1,jn) !!gm ISF & 4th COMPACT doesn't work248 IF( ln_linssh ) ztw(:,:, 1 ) = pwn(:,:,1) * ptn(:,:,1,jn) !!gm ISF & 4th COMPACT doesn't work 249 249 ! 250 250 END SELECT … … 253 253 DO jj = 2, jpjm1 254 254 DO ji = fs_2, fs_jpim1 ! vector opt. 255 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk))255 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 256 256 END DO 257 257 END DO … … 264 264 zltv(ji,jj,jk) = pta(ji,jj,jk,jn) - zltv(ji,jj,jk) & 265 265 & + ptn(ji,jj,jk,jn) * ( pwn(ji,jj,jk) - pwn(ji,jj,jk+1) ) & 266 & / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk))266 & * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 267 267 END DO 268 268 END DO … … 293 293 !! in-space based differencing for fluid 294 294 !!---------------------------------------------------------------------- 295 REAL(wp), INTENT(in ) , DIMENSION(jpk) :: p2dt ! vertical profile oftracer time-step295 REAL(wp), INTENT(in ) :: p2dt ! tracer time-step 296 296 REAL(wp), DIMENSION (jpi,jpj,jpk) :: pbef ! before field 297 297 REAL(wp), INTENT(inout), DIMENSION (jpi,jpj,jpk) :: paft ! after field … … 300 300 INTEGER :: ji, jj, jk ! dummy loop indices 301 301 INTEGER :: ikm1 ! local integer 302 REAL(wp) :: zpos, zneg, zbt, za, zb, zc, zbig, zrtrn , z2dtt! local scalars302 REAL(wp) :: zpos, zneg, zbt, za, zb, zc, zbig, zrtrn ! local scalars 303 303 REAL(wp), POINTER, DIMENSION(:,:,:) :: zbetup, zbetdo 304 304 !!---------------------------------------------------------------------- … … 349 349 ! --------------------------------------------------- 350 350 DO jk = 1, jpkm1 351 z2dtt = p2dt(jk)352 351 DO jj = 2, jpjm1 353 352 DO ji = fs_2, fs_jpim1 ! vector opt. … … 356 355 zneg = MAX( 0., pcc(ji ,jj ,jk ) ) - MIN( 0., pcc(ji ,jj ,jk+1) ) 357 356 ! up & down beta terms 358 zbt = e1e2t(ji,jj) * fse3t(ji,jj,jk) / z2dtt357 zbt = e1e2t(ji,jj) * e3t_n(ji,jj,jk) / p2dt 359 358 zbetup(ji,jj,jk) = ( zbetup(ji,jj,jk) - paft(ji,jj,jk) ) / (zpos+zrtrn) * zbt 360 359 zbetdo(ji,jj,jk) = ( paft(ji,jj,jk) - zbetdo(ji,jj,jk) ) / (zneg+zrtrn) * zbt
Note: See TracChangeset
for help on using the changeset viewer.
