Changeset 10880
- Timestamp:
- 2019-04-17T12:02:14+02:00 (5 years ago)
- Location:
- NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src
- Files:
-
- 15 edited
-
OCE/DOM/dom_oce.F90 (modified) (1 diff)
-
OCE/TRA/traadv.F90 (modified) (5 diffs)
-
OCE/TRA/traadv_cen.F90 (modified) (10 diffs)
-
OCE/TRA/traadv_fct.F90 (modified) (19 diffs)
-
OCE/TRA/traadv_mus.F90 (modified) (11 diffs)
-
OCE/TRA/traadv_qck.F90 (modified) (20 diffs)
-
OCE/TRA/traadv_ubs.F90 (modified) (19 diffs)
-
OCE/step.F90 (modified) (2 diffs)
-
OCE/step_oce.F90 (modified) (1 diff)
-
TOP/TRP/trcadv.F90 (modified) (3 diffs)
-
TOP/TRP/trctrp.F90 (modified) (3 diffs)
-
TOP/oce_trc.F90 (modified) (1 diff)
-
TOP/trc.F90 (modified) (3 diffs)
-
TOP/trcini.F90 (modified) (2 diffs)
-
TOP/trcstp.F90 (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/DOM/dom_oce.F90
r10876 r10880 38 38 LOGICAL , PUBLIC :: ln_iscpl !: coupling with ice sheet 39 39 LOGICAL , PUBLIC :: ln_crs !: Apply grid coarsening to dynamical model output or online passive tracers 40 41 !!----------------------------------------------------------------------42 !! time level indices43 !!----------------------------------------------------------------------44 INTEGER, PUBLIC :: Nbb, Nnn, Naa, Nrhs45 40 46 41 !! Free surface parameters -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/traadv.F90
r10874 r10880 75 75 CONTAINS 76 76 77 SUBROUTINE tra_adv( kt )77 SUBROUTINE tra_adv( kt, Kbb, Kmm, pts, Krhs ) 78 78 !!---------------------------------------------------------------------- 79 79 !! *** ROUTINE tra_adv *** … … 81 81 !! ** Purpose : compute the ocean tracer advection trend. 82 82 !! 83 !! ** Method : - Update (ua,va) with the advection term following nadv 84 !!---------------------------------------------------------------------- 85 INTEGER, INTENT(in) :: kt ! ocean time-step index 83 !! ** Method : - Update (uu(:,:,:,Krhs),vv(:,:,:,Krhs)) with the advection term following nadv 84 !!---------------------------------------------------------------------- 85 INTEGER , INTENT(in) :: kt ! ocean time-step index 86 INTEGER , INTENT(in) :: Kbb, Kmm, Krhs ! time level indices 87 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer equation 86 88 ! 87 89 INTEGER :: jk ! dummy loop index 88 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zu n, zvn, zwn! 3D workspace90 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zuu, zvv, zww ! 3D workspace 89 91 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdt, ztrds 90 92 !!---------------------------------------------------------------------- … … 98 100 ! 99 101 ! !== effective transport ==! 100 zu n(:,:,jpk) = 0._wp101 zv n(:,:,jpk) = 0._wp102 zw n(:,:,jpk) = 0._wp102 zuu(:,:,jpk) = 0._wp 103 zvv(:,:,jpk) = 0._wp 104 zww(:,:,jpk) = 0._wp 103 105 IF( ln_wave .AND. ln_sdw ) THEN 104 106 DO jk = 1, jpkm1 ! eulerian transport + Stokes Drift 105 zu n(:,:,jk) = e2u (:,:) * e3u_n(:,:,jk) * ( un(:,:,jk) + usd(:,:,jk) )106 zv n(:,:,jk) = e1v (:,:) * e3v_n(:,:,jk) * ( vn(:,:,jk) + vsd(:,:,jk) )107 zw n(:,:,jk) = e1e2t(:,:) * ( wn(:,:,jk) + wsd(:,:,jk) )107 zuu(:,:,jk) = e2u (:,:) * e3u(:,:,jk,Kmm) * ( uu(:,:,jk,Kmm) + usd(:,:,jk) ) 108 zvv(:,:,jk) = e1v (:,:) * e3v(:,:,jk,Kmm) * ( vv(:,:,jk,Kmm) + vsd(:,:,jk) ) 109 zww(:,:,jk) = e1e2t(:,:) * ( ww(:,:,jk) + wsd(:,:,jk) ) 108 110 END DO 109 111 ELSE 110 112 DO jk = 1, jpkm1 111 zu n(:,:,jk) = e2u (:,:) * e3u_n(:,:,jk) * un(:,:,jk) ! eulerian transport only112 zv n(:,:,jk) = e1v (:,:) * e3v_n(:,:,jk) * vn(:,:,jk)113 zw n(:,:,jk) = e1e2t(:,:) * wn(:,:,jk)113 zuu(:,:,jk) = e2u (:,:) * e3u(:,:,jk,Kmm) * uu(:,:,jk,Kmm) ! eulerian transport only 114 zvv(:,:,jk) = e1v (:,:) * e3v(:,:,jk,Kmm) * vv(:,:,jk,Kmm) 115 zww(:,:,jk) = e1e2t(:,:) * ww(:,:,jk) 114 116 END DO 115 117 ENDIF 116 118 ! 117 119 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! add z-tilde and/or vvl corrections 118 zu n(:,:,:) = zun(:,:,:) + un_td(:,:,:)119 zv n(:,:,:) = zvn(:,:,:) + vn_td(:,:,:)120 ENDIF 121 ! 122 zu n(:,:,jpk) = 0._wp ! no transport trough the bottom123 zv n(:,:,jpk) = 0._wp124 zw n(:,:,jpk) = 0._wp120 zuu(:,:,:) = zuu(:,:,:) + un_td(:,:,:) 121 zvv(:,:,:) = zvv(:,:,:) + vn_td(:,:,:) 122 ENDIF 123 ! 124 zuu(:,:,jpk) = 0._wp ! no transport trough the bottom 125 zvv(:,:,jpk) = 0._wp 126 zww(:,:,jpk) = 0._wp 125 127 ! 126 128 IF( ln_ldfeiv .AND. .NOT. ln_traldf_triad ) & 127 & CALL ldf_eiv_trp( kt, nit000, zu n, zvn, zwn, 'TRA' ) ! add the eiv transport (if necessary)128 ! 129 IF( ln_mle ) CALL tra_mle_trp( kt, nit000, zu n, zvn, zwn, 'TRA' ) ! add the mle transport (if necessary)130 ! 131 CALL iom_put( "uocetr_eff", zu n) ! output effective transport132 CALL iom_put( "vocetr_eff", zv n)133 CALL iom_put( "wocetr_eff", zw n)129 & CALL ldf_eiv_trp( kt, nit000, zuu, zvv, zww, 'TRA' ) ! add the eiv transport (if necessary) 130 ! 131 IF( ln_mle ) CALL tra_mle_trp( kt, nit000, zuu, zvv, zww, 'TRA' ) ! add the mle transport (if necessary) 132 ! 133 CALL iom_put( "uocetr_eff", zuu ) ! output effective transport 134 CALL iom_put( "vocetr_eff", zvv ) 135 CALL iom_put( "wocetr_eff", zww ) 134 136 ! 135 137 !!gm ??? 136 IF( ln_diaptr ) CALL dia_ptr( zv n) ! diagnose the effective MSF138 IF( ln_diaptr ) CALL dia_ptr( zvv ) ! diagnose the effective MSF 137 139 !!gm ??? 138 140 ! 139 141 IF( l_trdtra ) THEN !* Save ta and sa trends 140 142 ALLOCATE( ztrdt(jpi,jpj,jpk), ztrds(jpi,jpj,jpk) ) 141 ztrdt(:,:,:) = tsa(:,:,:,jp_tem)142 ztrds(:,:,:) = tsa(:,:,:,jp_sal)143 ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) 144 ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) 143 145 ENDIF 144 146 ! … … 146 148 ! 147 149 CASE ( np_CEN ) ! Centered scheme : 2nd / 4th order 148 CALL tra_adv_cen ( kt, nit000, 'TRA', zu n, zvn, zwn , tsn, tsa, jpts, nn_cen_h, nn_cen_v )150 CALL tra_adv_cen ( kt, nit000, 'TRA', zuu, zvv, zww, Kmm, pts, jpts, Krhs, nn_cen_h, nn_cen_v ) 149 151 CASE ( np_FCT ) ! FCT scheme : 2nd / 4th order 150 CALL tra_adv_fct ( kt, nit000, 'TRA', r2dt, zu n, zvn, zwn, tsb, tsn, tsa, jpts, nn_fct_h, nn_fct_v )152 CALL tra_adv_fct ( kt, nit000, 'TRA', r2dt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_fct_h, nn_fct_v ) 151 153 CASE ( np_MUS ) ! MUSCL 152 CALL tra_adv_mus ( kt, nit000, 'TRA', r2dt, zu n, zvn, zwn, tsb, tsa, jpts, ln_mus_ups )154 CALL tra_adv_mus ( kt, nit000, 'TRA', r2dt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, ln_mus_ups ) 153 155 CASE ( np_UBS ) ! UBS 154 CALL tra_adv_ubs ( kt, nit000, 'TRA', r2dt, zu n, zvn, zwn, tsb, tsn, tsa, jpts, nn_ubs_v )156 CALL tra_adv_ubs ( kt, nit000, 'TRA', r2dt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_ubs_v ) 155 157 CASE ( np_QCK ) ! QUICKEST 156 CALL tra_adv_qck ( kt, nit000, 'TRA', r2dt, zu n, zvn, zwn, tsb, tsn, tsa, jpts)158 CALL tra_adv_qck ( kt, nit000, 'TRA', r2dt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs ) 157 159 ! 158 160 END SELECT … … 160 162 IF( l_trdtra ) THEN ! save the advective trends for further diagnostics 161 163 DO jk = 1, jpkm1 162 ztrdt(:,:,jk) = tsa(:,:,jk,jp_tem) - ztrdt(:,:,jk)163 ztrds(:,:,jk) = tsa(:,:,jk,jp_sal) - ztrds(:,:,jk)164 ztrdt(:,:,jk) = pts(:,:,jk,jp_tem,Krhs) - ztrdt(:,:,jk) 165 ztrds(:,:,jk) = pts(:,:,jk,jp_sal,Krhs) - ztrds(:,:,jk) 164 166 END DO 165 167 CALL trd_tra( kt, 'TRA', jp_tem, jptra_totad, ztrdt ) -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/traadv_cen.F90
r10874 r10880 44 44 CONTAINS 45 45 46 SUBROUTINE tra_adv_cen( kt, kit000, cdtype, pu n, pvn, pwn, &47 & ptn, pta, kjpt, kn_cen_h, kn_cen_v )46 SUBROUTINE tra_adv_cen( kt, kit000, cdtype, pu_mm, pv_mm, pww, & 47 & Kmm, pt, kjpt, Krhs, kn_cen_h, kn_cen_v ) 48 48 !!---------------------------------------------------------------------- 49 49 !! *** ROUTINE tra_adv_cen *** … … 59 59 !! = 4 ==>> 4th order COMPACT scheme - - 60 60 !! 61 !! ** Action : - update pt awith the now advective tracer trends61 !! ** Action : - update pt(:,:,:,:,Krhs) with the now advective tracer trends 62 62 !! - send trends to trdtra module for further diagnostcs (l_trdtra=T) 63 63 !! - htr_adv, str_adv : poleward advective heat and salt transport (ln_diaptr=T) 64 64 !!---------------------------------------------------------------------- 65 INTEGER , INTENT(in ) :: kt ! ocean time-step index66 INTEGER , INTENT(in ) :: kit000 ! first time step index67 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator)68 INTEGER , INTENT(in ) :: kjpt ! number of tracers69 INTEGER , INTENT(in ) :: kn_cen_h ! =2/4 (2nd or 4th order scheme)70 INTEGER , INTENT(in ) :: kn_cen_v! =2/4 (2nd or 4th order scheme)71 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pun, pvn, pwn ! 3 ocean velocity components72 REAL(wp), DIMENSION(jpi,jpj,jpk ,kjpt), INTENT(in ) :: ptn ! now tracer fields73 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt ), INTENT(inout) :: pta ! tracer trend65 INTEGER , INTENT(in ) :: kt ! ocean time-step index 66 INTEGER , INTENT(in ) :: Kmm, Krhs ! ocean time level indices 67 INTEGER , INTENT(in ) :: kit000 ! first time step index 68 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 69 INTEGER , INTENT(in ) :: kjpt ! number of tracers 70 INTEGER , INTENT(in ) :: kn_cen_h ! =2/4 (2nd or 4th order scheme) 71 INTEGER , INTENT(in ) :: kn_cen_v ! =2/4 (2nd or 4th order scheme) 72 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pu_mm, pv_mm, pww ! 3 ocean velocity components 73 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! active tracers and RHS of tracer equation 74 74 ! 75 75 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 106 106 DO jj = 1, jpjm1 107 107 DO ji = 1, fs_jpim1 ! vector opt. 108 zwx(ji,jj,jk) = 0.5_wp * pu n(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj ,jk,jn) )109 zwy(ji,jj,jk) = 0.5_wp * pv n(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji ,jj+1,jk,jn) )108 zwx(ji,jj,jk) = 0.5_wp * pu_mm(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj ,jk,jn,Kmm) ) 109 zwy(ji,jj,jk) = 0.5_wp * pv_mm(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji ,jj+1,jk,jn,Kmm) ) 110 110 END DO 111 111 END DO … … 118 118 DO jj = 2, jpjm1 119 119 DO ji = fs_2, fs_jpim1 ! vector opt. 120 ztu(ji,jj,jk) = ( pt n(ji+1,jj ,jk,jn) - ptn(ji,jj,jk,jn) ) * umask(ji,jj,jk)121 ztv(ji,jj,jk) = ( pt n(ji ,jj+1,jk,jn) - ptn(ji,jj,jk,jn) ) * vmask(ji,jj,jk)120 ztu(ji,jj,jk) = ( pt(ji+1,jj ,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * umask(ji,jj,jk) 121 ztv(ji,jj,jk) = ( pt(ji ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk) 122 122 END DO 123 123 END DO … … 128 128 DO jj = 2, jpjm1 129 129 DO ji = 1, fs_jpim1 ! vector opt. 130 zC2t_u = pt n(ji,jj,jk,jn) + ptn(ji+1,jj ,jk,jn) ! C2 interpolation of T at u- & v-points (x2)131 zC2t_v = pt n(ji,jj,jk,jn) + ptn(ji ,jj+1,jk,jn)130 zC2t_u = pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj ,jk,jn,Kmm) ! C2 interpolation of T at u- & v-points (x2) 131 zC2t_v = pt(ji,jj,jk,jn,Kmm) + pt(ji ,jj+1,jk,jn,Kmm) 132 132 ! ! C4 interpolation of T at u- & v-points (x2) 133 133 zC4t_u = zC2t_u + r1_6 * ( ztu(ji-1,jj,jk) - ztu(ji+1,jj,jk) ) 134 134 zC4t_v = zC2t_v + r1_6 * ( ztv(ji,jj-1,jk) - ztv(ji,jj+1,jk) ) 135 135 ! ! C4 fluxes 136 zwx(ji,jj,jk) = 0.5_wp * pu n(ji,jj,jk) * zC4t_u137 zwy(ji,jj,jk) = 0.5_wp * pv n(ji,jj,jk) * zC4t_v136 zwx(ji,jj,jk) = 0.5_wp * pu_mm(ji,jj,jk) * zC4t_u 137 zwy(ji,jj,jk) = 0.5_wp * pv_mm(ji,jj,jk) * zC4t_v 138 138 END DO 139 139 END DO … … 150 150 DO jj = 2, jpjm1 151 151 DO ji = fs_2, fs_jpim1 ! vector opt. 152 zwz(ji,jj,jk) = 0.5 * pw n(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj,jk-1,jn) ) * wmask(ji,jj,jk)152 zwz(ji,jj,jk) = 0.5 * pww(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji,jj,jk-1,jn,Kmm) ) * wmask(ji,jj,jk) 153 153 END DO 154 154 END DO … … 156 156 ! 157 157 CASE( 4 ) !* 4th order compact 158 CALL interp_4th_cpt( pt n(:,:,:,jn) , ztw ) ! ztw = interpolated value of T at w-point158 CALL interp_4th_cpt( pt(:,:,:,jn,Kmm) , ztw ) ! ztw = interpolated value of T at w-point 159 159 DO jk = 2, jpkm1 160 160 DO jj = 2, jpjm1 161 161 DO ji = fs_2, fs_jpim1 162 zwz(ji,jj,jk) = pw n(ji,jj,jk) * ztw(ji,jj,jk) * wmask(ji,jj,jk)162 zwz(ji,jj,jk) = pww(ji,jj,jk) * ztw(ji,jj,jk) * wmask(ji,jj,jk) 163 163 END DO 164 164 END DO … … 171 171 DO jj = 1, jpj 172 172 DO ji = 1, jpi 173 zwz(ji,jj, mikt(ji,jj) ) = pw n(ji,jj,mikt(ji,jj)) * ptn(ji,jj,mikt(ji,jj),jn)173 zwz(ji,jj, mikt(ji,jj) ) = pww(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kmm) 174 174 END DO 175 175 END DO 176 176 ELSE ! no ice-shelf cavities (only ocean surface) 177 zwz(:,:,1) = pw n(:,:,1) * ptn(:,:,1,jn)177 zwz(:,:,1) = pww(:,:,1) * pt(:,:,1,jn,Kmm) 178 178 ENDIF 179 179 ENDIF … … 182 182 DO jj = 2, jpjm1 183 183 DO ji = fs_2, fs_jpim1 ! vector opt. 184 pt a(ji,jj,jk,jn) = pta(ji,jj,jk,jn) &184 pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) & 185 185 & - ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) & 186 186 & + zwy(ji,jj,jk) - zwy(ji ,jj-1,jk ) & 187 & + zwz(ji,jj,jk) - zwz(ji ,jj ,jk+1) ) * r1_e1e2t(ji,jj) / e3t _n(ji,jj,jk)187 & + zwz(ji,jj,jk) - zwz(ji ,jj ,jk+1) ) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 188 188 END DO 189 189 END DO … … 191 191 ! ! trend diagnostics 192 192 IF( l_trd ) THEN 193 CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pu n, ptn(:,:,:,jn) )194 CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pv n, ptn(:,:,:,jn) )195 CALL trd_tra( kt, cdtype, jn, jptra_zad, zwz, pw n, ptn(:,:,:,jn) )193 CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pu_mm, pt(:,:,:,jn,Kmm) ) 194 CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pv_mm, pt(:,:,:,jn,Kmm) ) 195 CALL trd_tra( kt, cdtype, jn, jptra_zad, zwz, pww, pt(:,:,:,jn,Kmm) ) 196 196 END IF 197 197 ! ! "Poleward" heat and salt transports -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/traadv_fct.F90
r10874 r10880 52 52 CONTAINS 53 53 54 SUBROUTINE tra_adv_fct( kt, kit000, cdtype, p2dt, pu n, pvn, pwn, &55 & ptb, ptn, pta, kjpt, kn_fct_h, kn_fct_v )54 SUBROUTINE tra_adv_fct( kt, kit000, cdtype, p2dt, pu_mm, pv_mm, pww, & 55 & Kbb, Kmm, pt, kjpt, Krhs, kn_fct_h, kn_fct_v ) 56 56 !!---------------------------------------------------------------------- 57 57 !! *** ROUTINE tra_adv_fct *** … … 65 65 !! - corrected flux (monotonic correction) 66 66 !! 67 !! ** Action : - update pt awith the now advective tracer trends67 !! ** Action : - update pt(:,:,:,:,Krhs) with the now advective tracer trends 68 68 !! - send trends to trdtra module for further diagnostics (l_trdtra=T) 69 69 !! - htr_adv, str_adv : poleward advective heat and salt transport (ln_diaptr=T) 70 70 !!---------------------------------------------------------------------- 71 INTEGER , INTENT(in ) :: kt ! ocean time-step index72 INTEGER , INTENT(in ) :: kit000 ! first time step index73 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator)74 INTEGER , INTENT(in ) :: kjpt ! number of tracers75 INTEGER , INTENT(in ) :: kn_fct_h ! order of the FCT scheme (=2 or 4)76 INTEGER , INTENT(in ) :: kn_fct_v! order of the FCT scheme (=2 or 4)77 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step78 REAL(wp) , DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pun, pvn, pwn ! 3 ocean velocity components79 REAL(wp), DIMENSION(jpi,jpj,jpk ,kjpt), INTENT(in ) :: ptb, ptn ! before and now tracer fields80 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt ), INTENT(inout) :: pta ! tracer trend71 INTEGER , INTENT(in ) :: kt ! ocean time-step index 72 INTEGER , INTENT(in ) :: Kbb, Kmm, Krhs ! ocean time level indices 73 INTEGER , INTENT(in ) :: kit000 ! first time step index 74 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 75 INTEGER , INTENT(in ) :: kjpt ! number of tracers 76 INTEGER , INTENT(in ) :: kn_fct_h ! order of the FCT scheme (=2 or 4) 77 INTEGER , INTENT(in ) :: kn_fct_v ! order of the FCT scheme (=2 or 4) 78 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step 79 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pu_mm, pv_mm, pww ! 3 ocean velocity components 80 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! active tracers and RHS of tracer equation 81 81 ! 82 82 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 125 125 DO ji = 1, fs_jpim1 ! vector opt. 126 126 ! upstream scheme 127 zfp_ui = pu n(ji,jj,jk) + ABS( pun(ji,jj,jk) )128 zfm_ui = pu n(ji,jj,jk) - ABS( pun(ji,jj,jk) )129 zfp_vj = pv n(ji,jj,jk) + ABS( pvn(ji,jj,jk) )130 zfm_vj = pv n(ji,jj,jk) - ABS( pvn(ji,jj,jk) )131 zwx(ji,jj,jk) = 0.5 * ( zfp_ui * pt b(ji,jj,jk,jn) + zfm_ui * ptb(ji+1,jj ,jk,jn) )132 zwy(ji,jj,jk) = 0.5 * ( zfp_vj * pt b(ji,jj,jk,jn) + zfm_vj * ptb(ji ,jj+1,jk,jn) )127 zfp_ui = pu_mm(ji,jj,jk) + ABS( pu_mm(ji,jj,jk) ) 128 zfm_ui = pu_mm(ji,jj,jk) - ABS( pu_mm(ji,jj,jk) ) 129 zfp_vj = pv_mm(ji,jj,jk) + ABS( pv_mm(ji,jj,jk) ) 130 zfm_vj = pv_mm(ji,jj,jk) - ABS( pv_mm(ji,jj,jk) ) 131 zwx(ji,jj,jk) = 0.5 * ( zfp_ui * pt(ji,jj,jk,jn,Kbb) + zfm_ui * pt(ji+1,jj ,jk,jn,Kbb) ) 132 zwy(ji,jj,jk) = 0.5 * ( zfp_vj * pt(ji,jj,jk,jn,Kbb) + zfm_vj * pt(ji ,jj+1,jk,jn,Kbb) ) 133 133 END DO 134 134 END DO … … 138 138 DO jj = 1, jpj 139 139 DO ji = 1, jpi 140 zfp_wk = pw n(ji,jj,jk) + ABS( pwn(ji,jj,jk) )141 zfm_wk = pw n(ji,jj,jk) - ABS( pwn(ji,jj,jk) )142 zwz(ji,jj,jk) = 0.5 * ( zfp_wk * pt b(ji,jj,jk,jn) + zfm_wk * ptb(ji,jj,jk-1,jn) ) * wmask(ji,jj,jk)140 zfp_wk = pww(ji,jj,jk) + ABS( pww(ji,jj,jk) ) 141 zfm_wk = pww(ji,jj,jk) - ABS( pww(ji,jj,jk) ) 142 zwz(ji,jj,jk) = 0.5 * ( zfp_wk * pt(ji,jj,jk,jn,Kbb) + zfm_wk * pt(ji,jj,jk-1,jn,Kbb) ) * wmask(ji,jj,jk) 143 143 END DO 144 144 END DO … … 148 148 DO jj = 1, jpj 149 149 DO ji = 1, jpi 150 zwz(ji,jj, mikt(ji,jj) ) = pw n(ji,jj,mikt(ji,jj)) * ptb(ji,jj,mikt(ji,jj),jn) ! linear free surface150 zwz(ji,jj, mikt(ji,jj) ) = pww(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kbb) ! linear free surface 151 151 END DO 152 152 END DO 153 153 ELSE ! no cavities: only at the ocean surface 154 zwz(:,:,1) = pw n(:,:,1) * ptb(:,:,1,jn)154 zwz(:,:,1) = pww(:,:,1) * pt(:,:,1,jn,Kbb) 155 155 ENDIF 156 156 ENDIF … … 164 164 & + zwz(ji,jj,jk) - zwz(ji ,jj ,jk+1) ) * r1_e1e2t(ji,jj) 165 165 ! ! update and guess with monotonic sheme 166 pt a(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra / e3t_n(ji,jj,jk) * tmask(ji,jj,jk)167 zwi(ji,jj,jk) = ( e3t _b(ji,jj,jk) * ptb(ji,jj,jk,jn) + p2dt * ztra ) / e3t_a(ji,jj,jk) * tmask(ji,jj,jk)166 pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) + ztra / e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) 167 zwi(ji,jj,jk) = ( e3t(ji,jj,jk,Kbb) * pt(ji,jj,jk,jn,Kbb) + p2dt * ztra ) / e3t(ji,jj,jk,Krhs) * tmask(ji,jj,jk) 168 168 END DO 169 169 END DO … … 184 184 DO jj = 1, jpjm1 185 185 DO ji = 1, fs_jpim1 ! vector opt. 186 zwx(ji,jj,jk) = 0.5_wp * pu n(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj,jk,jn) ) - zwx(ji,jj,jk)187 zwy(ji,jj,jk) = 0.5_wp * pv n(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj+1,jk,jn) ) - zwy(ji,jj,jk)186 zwx(ji,jj,jk) = 0.5_wp * pu_mm(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj,jk,jn,Kmm) ) - zwx(ji,jj,jk) 187 zwy(ji,jj,jk) = 0.5_wp * pv_mm(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji,jj+1,jk,jn,Kmm) ) - zwy(ji,jj,jk) 188 188 END DO 189 189 END DO … … 196 196 DO jj = 1, jpjm1 ! 1st derivative (gradient) 197 197 DO ji = 1, fs_jpim1 ! vector opt. 198 ztu(ji,jj,jk) = ( pt n(ji+1,jj ,jk,jn) - ptn(ji,jj,jk,jn) ) * umask(ji,jj,jk)199 ztv(ji,jj,jk) = ( pt n(ji ,jj+1,jk,jn) - ptn(ji,jj,jk,jn) ) * vmask(ji,jj,jk)198 ztu(ji,jj,jk) = ( pt(ji+1,jj ,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * umask(ji,jj,jk) 199 ztv(ji,jj,jk) = ( pt(ji ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk) 200 200 END DO 201 201 END DO … … 212 212 DO jj = 1, jpjm1 213 213 DO ji = 1, fs_jpim1 ! vector opt. 214 zC2t_u = pt n(ji,jj,jk,jn) + ptn(ji+1,jj ,jk,jn) ! 2 x C2 interpolation of T at u- & v-points215 zC2t_v = pt n(ji,jj,jk,jn) + ptn(ji ,jj+1,jk,jn)214 zC2t_u = pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj ,jk,jn,Kmm) ! 2 x C2 interpolation of T at u- & v-points 215 zC2t_v = pt(ji,jj,jk,jn,Kmm) + pt(ji ,jj+1,jk,jn,Kmm) 216 216 ! ! C4 minus upstream advective fluxes 217 zwx(ji,jj,jk) = 0.5_wp * pu n(ji,jj,jk) * ( zC2t_u + zltu(ji,jj,jk) - zltu(ji+1,jj,jk) ) - zwx(ji,jj,jk)218 zwy(ji,jj,jk) = 0.5_wp * pv n(ji,jj,jk) * ( zC2t_v + zltv(ji,jj,jk) - zltv(ji,jj+1,jk) ) - zwy(ji,jj,jk)217 zwx(ji,jj,jk) = 0.5_wp * pu_mm(ji,jj,jk) * ( zC2t_u + zltu(ji,jj,jk) - zltu(ji+1,jj,jk) ) - zwx(ji,jj,jk) 218 zwy(ji,jj,jk) = 0.5_wp * pv_mm(ji,jj,jk) * ( zC2t_v + zltv(ji,jj,jk) - zltv(ji,jj+1,jk) ) - zwy(ji,jj,jk) 219 219 END DO 220 220 END DO … … 227 227 DO jj = 1, jpjm1 228 228 DO ji = 1, fs_jpim1 ! vector opt. 229 ztu(ji,jj,jk) = ( pt n(ji+1,jj ,jk,jn) - ptn(ji,jj,jk,jn) ) * umask(ji,jj,jk)230 ztv(ji,jj,jk) = ( pt n(ji ,jj+1,jk,jn) - ptn(ji,jj,jk,jn) ) * vmask(ji,jj,jk)229 ztu(ji,jj,jk) = ( pt(ji+1,jj ,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * umask(ji,jj,jk) 230 ztv(ji,jj,jk) = ( pt(ji ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk) 231 231 END DO 232 232 END DO … … 237 237 DO jj = 2, jpjm1 238 238 DO ji = 2, fs_jpim1 ! vector opt. 239 zC2t_u = pt n(ji,jj,jk,jn) + ptn(ji+1,jj ,jk,jn) ! 2 x C2 interpolation of T at u- & v-points (x2)240 zC2t_v = pt n(ji,jj,jk,jn) + ptn(ji ,jj+1,jk,jn)239 zC2t_u = pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj ,jk,jn,Kmm) ! 2 x C2 interpolation of T at u- & v-points (x2) 240 zC2t_v = pt(ji,jj,jk,jn,Kmm) + pt(ji ,jj+1,jk,jn,Kmm) 241 241 ! ! C4 interpolation of T at u- & v-points (x2) 242 242 zC4t_u = zC2t_u + r1_6 * ( ztu(ji-1,jj ,jk) - ztu(ji+1,jj ,jk) ) 243 243 zC4t_v = zC2t_v + r1_6 * ( ztv(ji ,jj-1,jk) - ztv(ji ,jj+1,jk) ) 244 244 ! ! C4 minus upstream advective fluxes 245 zwx(ji,jj,jk) = 0.5_wp * pu n(ji,jj,jk) * zC4t_u - zwx(ji,jj,jk)246 zwy(ji,jj,jk) = 0.5_wp * pv n(ji,jj,jk) * zC4t_v - zwy(ji,jj,jk)245 zwx(ji,jj,jk) = 0.5_wp * pu_mm(ji,jj,jk) * zC4t_u - zwx(ji,jj,jk) 246 zwy(ji,jj,jk) = 0.5_wp * pv_mm(ji,jj,jk) * zC4t_v - zwy(ji,jj,jk) 247 247 END DO 248 248 END DO … … 257 257 DO jj = 2, jpjm1 258 258 DO ji = fs_2, fs_jpim1 259 zwz(ji,jj,jk) = ( pw n(ji,jj,jk) * 0.5_wp * ( ptn(ji,jj,jk,jn) + ptn(ji,jj,jk-1,jn) ) &259 zwz(ji,jj,jk) = ( pww(ji,jj,jk) * 0.5_wp * ( pt(ji,jj,jk,jn,Kmm) + pt(ji,jj,jk-1,jn,Kmm) ) & 260 260 & - zwz(ji,jj,jk) ) * wmask(ji,jj,jk) 261 261 END DO … … 264 264 ! 265 265 CASE( 4 ) !- 4th order COMPACT 266 CALL interp_4th_cpt( pt n(:,:,:,jn) , ztw ) ! zwt = COMPACT interpolation of T at w-point266 CALL interp_4th_cpt( pt(:,:,:,jn,Kmm) , ztw ) ! zwt = COMPACT interpolation of T at w-point 267 267 DO jk = 2, jpkm1 268 268 DO jj = 2, jpjm1 269 269 DO ji = fs_2, fs_jpim1 270 zwz(ji,jj,jk) = ( pw n(ji,jj,jk) * ztw(ji,jj,jk) - zwz(ji,jj,jk) ) * wmask(ji,jj,jk)270 zwz(ji,jj,jk) = ( pww(ji,jj,jk) * ztw(ji,jj,jk) - zwz(ji,jj,jk) ) * wmask(ji,jj,jk) 271 271 END DO 272 272 END DO … … 282 282 ! !== monotonicity algorithm ==! 283 283 ! 284 CALL nonosc( ptb(:,:,:,jn), zwx, zwy, zwz, zwi, p2dt )284 CALL nonosc( Kmm, pt(:,:,:,jn,Kbb), zwx, zwy, zwz, zwi, p2dt ) 285 285 ! 286 286 ! !== final trend with corrected fluxes ==! … … 289 289 DO jj = 2, jpjm1 290 290 DO ji = fs_2, fs_jpim1 ! vector opt. 291 pt a(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) &291 pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) & 292 292 & + zwy(ji,jj,jk) - zwy(ji ,jj-1,jk ) & 293 293 & + zwz(ji,jj,jk) - zwz(ji ,jj ,jk+1) ) & 294 & * r1_e1e2t(ji,jj) / e3t _n(ji,jj,jk)294 & * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 295 295 END DO 296 296 END DO … … 303 303 ! 304 304 IF( l_trd ) THEN ! trend diagnostics 305 CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pu n, ptn(:,:,:,jn) )306 CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pv n, ptn(:,:,:,jn) )307 CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pw n, ptn(:,:,:,jn) )305 CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pu_mm, pt(:,:,:,jn,Kmm) ) 306 CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pv_mm, pt(:,:,:,jn,Kmm) ) 307 CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pww, pt(:,:,:,jn,Kmm) ) 308 308 ENDIF 309 309 ! ! heat/salt transport … … 328 328 329 329 330 SUBROUTINE nonosc( pbef, paa, pbb, pcc, paft, p2dt )330 SUBROUTINE nonosc( Kmm, pbef, paa, pbb, pcc, paft, p2dt ) 331 331 !!--------------------------------------------------------------------- 332 332 !! *** ROUTINE nonosc *** … … 341 341 !! in-space based differencing for fluid 342 342 !!---------------------------------------------------------------------- 343 INTEGER , INTENT(in ) :: Kmm ! time level index 343 344 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step 344 345 REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in ) :: pbef, paft ! before & after field … … 392 393 393 394 ! up & down beta terms 394 zbt = e1e2t(ji,jj) * e3t _n(ji,jj,jk) / p2dt395 zbt = e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) / p2dt 395 396 zbetup(ji,jj,jk) = ( zup - paft(ji,jj,jk) ) / ( zpos + zrtrn ) * zbt 396 397 zbetdo(ji,jj,jk) = ( paft(ji,jj,jk) - zdo ) / ( zneg + zrtrn ) * zbt -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/traadv_mus.F90
r10874 r10880 54 54 CONTAINS 55 55 56 SUBROUTINE tra_adv_mus( kt, kit000, cdtype, p2dt, pu n, pvn, pwn, &57 & ptb, pta, kjpt, ld_msc_ups )56 SUBROUTINE tra_adv_mus( kt, kit000, cdtype, p2dt, pu_mm, pv_mm, pww, & 57 & Kbb, Kmm, pt, kjpt, Krhs, ld_msc_ups ) 58 58 !!---------------------------------------------------------------------- 59 59 !! *** ROUTINE tra_adv_mus *** … … 66 66 !! ld_msc_ups=T : 67 67 !! 68 !! ** Action : - update pt awith the now advective tracer trends68 !! ** Action : - update pt(:,:,:,:,Krhs) with the now advective tracer trends 69 69 !! - send trends to trdtra module for further diagnostcs (l_trdtra=T) 70 70 !! - htr_adv, str_adv : poleward advective heat and salt transport (ln_diaptr=T) … … 73 73 !! IPSL, Sept. 2000 (http://www.lodyc.jussieu.fr/opa) 74 74 !!---------------------------------------------------------------------- 75 INTEGER , INTENT(in ) :: kt ! ocean time-step index76 INTEGER , INTENT(in ) :: kit000 ! first time step index77 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator)78 INTEGER , INTENT(in ) :: kjpt ! number of tracers79 LOGICAL , INTENT(in ) :: ld_msc_ups ! use upstream scheme within muscl80 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step81 REAL(wp) , DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pun, pvn, pwn ! 3 ocean velocity components82 REAL(wp), DIMENSION(jpi,jpj,jpk ,kjpt), INTENT(in ) :: ptb ! before tracer field83 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt ), INTENT(inout) :: pta ! tracer trend75 INTEGER , INTENT(in ) :: kt ! ocean time-step index 76 INTEGER , INTENT(in ) :: Kbb, Kmm, Krhs ! ocean time level indices 77 INTEGER , INTENT(in ) :: kit000 ! first time step index 78 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 79 INTEGER , INTENT(in ) :: kjpt ! number of tracers 80 LOGICAL , INTENT(in ) :: ld_msc_ups ! use upstream scheme within muscl 81 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step 82 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pu_mm, pv_mm, pww ! 3 ocean velocity components 83 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! active tracers and RHS of tracer equation 84 84 ! 85 85 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 134 134 DO jj = 1, jpjm1 135 135 DO ji = 1, fs_jpim1 ! vector opt. 136 zwx(ji,jj,jk) = umask(ji,jj,jk) * ( pt b(ji+1,jj,jk,jn) - ptb(ji,jj,jk,jn) )137 zwy(ji,jj,jk) = vmask(ji,jj,jk) * ( pt b(ji,jj+1,jk,jn) - ptb(ji,jj,jk,jn) )136 zwx(ji,jj,jk) = umask(ji,jj,jk) * ( pt(ji+1,jj,jk,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) ) 137 zwy(ji,jj,jk) = vmask(ji,jj,jk) * ( pt(ji,jj+1,jk,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) ) 138 138 END DO 139 139 END DO … … 172 172 DO ji = fs_2, fs_jpim1 ! vector opt. 173 173 ! MUSCL fluxes 174 z0u = SIGN( 0.5, pu n(ji,jj,jk) )174 z0u = SIGN( 0.5, pu_mm(ji,jj,jk) ) 175 175 zalpha = 0.5 - z0u 176 zu = z0u - 0.5 * pu n(ji,jj,jk) * p2dt * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk)177 zzwx = pt b(ji+1,jj,jk,jn) + xind(ji,jj,jk) * zu * zslpx(ji+1,jj,jk)178 zzwy = pt b(ji ,jj,jk,jn) + xind(ji,jj,jk) * zu * zslpx(ji ,jj,jk)179 zwx(ji,jj,jk) = pu n(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy )176 zu = z0u - 0.5 * pu_mm(ji,jj,jk) * p2dt * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm) 177 zzwx = pt(ji+1,jj,jk,jn,Kbb) + xind(ji,jj,jk) * zu * zslpx(ji+1,jj,jk) 178 zzwy = pt(ji ,jj,jk,jn,Kbb) + xind(ji,jj,jk) * zu * zslpx(ji ,jj,jk) 179 zwx(ji,jj,jk) = pu_mm(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) 180 180 ! 181 z0v = SIGN( 0.5, pv n(ji,jj,jk) )181 z0v = SIGN( 0.5, pv_mm(ji,jj,jk) ) 182 182 zalpha = 0.5 - z0v 183 zv = z0v - 0.5 * pv n(ji,jj,jk) * p2dt * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk)184 zzwx = pt b(ji,jj+1,jk,jn) + xind(ji,jj,jk) * zv * zslpy(ji,jj+1,jk)185 zzwy = pt b(ji,jj ,jk,jn) + xind(ji,jj,jk) * zv * zslpy(ji,jj ,jk)186 zwy(ji,jj,jk) = pv n(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy )183 zv = z0v - 0.5 * pv_mm(ji,jj,jk) * p2dt * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,Kmm) 184 zzwx = pt(ji,jj+1,jk,jn,Kbb) + xind(ji,jj,jk) * zv * zslpy(ji,jj+1,jk) 185 zzwy = pt(ji,jj ,jk,jn,Kbb) + xind(ji,jj,jk) * zv * zslpy(ji,jj ,jk) 186 zwy(ji,jj,jk) = pv_mm(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) 187 187 END DO 188 188 END DO … … 193 193 DO jj = 2, jpjm1 194 194 DO ji = fs_2, fs_jpim1 ! vector opt. 195 pt a(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) &195 pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) & 196 196 & + zwy(ji,jj,jk) - zwy(ji ,jj-1,jk ) ) & 197 & * r1_e1e2t(ji,jj) / e3t _n(ji,jj,jk)197 & * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 198 198 END DO 199 199 END DO … … 201 201 ! ! trend diagnostics 202 202 IF( l_trd ) THEN 203 CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pu n, ptb(:,:,:,jn) )204 CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pv n, ptb(:,:,:,jn) )203 CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pu_mm, pt(:,:,:,jn,Kbb) ) 204 CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pv_mm, pt(:,:,:,jn,Kbb) ) 205 205 END IF 206 206 ! ! "Poleward" heat and salt transports … … 215 215 zwx(:,:,jpk) = 0._wp 216 216 DO jk = 2, jpkm1 ! interior values 217 zwx(:,:,jk) = tmask(:,:,jk) * ( pt b(:,:,jk-1,jn) - ptb(:,:,jk,jn) )217 zwx(:,:,jk) = tmask(:,:,jk) * ( pt(:,:,jk-1,jn,Kbb) - pt(:,:,jk,jn,Kbb) ) 218 218 END DO 219 219 ! !-- Slopes of tracer … … 239 239 DO jj = 2, jpjm1 240 240 DO ji = fs_2, fs_jpim1 ! vector opt. 241 z0w = SIGN( 0.5, pw n(ji,jj,jk+1) )241 z0w = SIGN( 0.5, pww(ji,jj,jk+1) ) 242 242 zalpha = 0.5 + z0w 243 zw = z0w - 0.5 * pw n(ji,jj,jk+1) * p2dt * r1_e1e2t(ji,jj) / e3w_n(ji,jj,jk+1)244 zzwx = pt b(ji,jj,jk+1,jn) + xind(ji,jj,jk) * zw * zslpx(ji,jj,jk+1)245 zzwy = pt b(ji,jj,jk ,jn) + xind(ji,jj,jk) * zw * zslpx(ji,jj,jk )246 zwx(ji,jj,jk+1) = pw n(ji,jj,jk+1) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) * wmask(ji,jj,jk)243 zw = z0w - 0.5 * pww(ji,jj,jk+1) * p2dt * r1_e1e2t(ji,jj) / e3w(ji,jj,jk+1,Kmm) 244 zzwx = pt(ji,jj,jk+1,jn,Kbb) + xind(ji,jj,jk) * zw * zslpx(ji,jj,jk+1) 245 zzwy = pt(ji,jj,jk ,jn,Kbb) + xind(ji,jj,jk) * zw * zslpx(ji,jj,jk ) 246 zwx(ji,jj,jk+1) = pww(ji,jj,jk+1) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) * wmask(ji,jj,jk) 247 247 END DO 248 248 END DO … … 252 252 DO jj = 1, jpj 253 253 DO ji = 1, jpi 254 zwx(ji,jj, mikt(ji,jj) ) = pw n(ji,jj,mikt(ji,jj)) * ptb(ji,jj,mikt(ji,jj),jn)254 zwx(ji,jj, mikt(ji,jj) ) = pww(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kbb) 255 255 END DO 256 256 END DO 257 257 ELSE ! no cavities: only at the ocean surface 258 zwx(:,:,1) = pw n(:,:,1) * ptb(:,:,1,jn)258 zwx(:,:,1) = pww(:,:,1) * pt(:,:,1,jn,Kbb) 259 259 ENDIF 260 260 ENDIF … … 263 263 DO jj = 2, jpjm1 264 264 DO ji = fs_2, fs_jpim1 ! vector opt. 265 pt a(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)265 pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 266 266 END DO 267 267 END DO 268 268 END DO 269 269 ! ! send trends for diagnostic 270 IF( l_trd ) CALL trd_tra( kt, cdtype, jn, jptra_zad, zwx, pw n, ptb(:,:,:,jn) )270 IF( l_trd ) CALL trd_tra( kt, cdtype, jn, jptra_zad, zwx, pww, pt(:,:,:,jn,Kbb) ) 271 271 ! 272 272 END DO ! end of tracer loop -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/traadv_qck.F90
r10874 r10880 47 47 CONTAINS 48 48 49 SUBROUTINE tra_adv_qck ( kt, kit000, cdtype, p2dt, pun, pvn, pwn, & 50 & ptb, ptn, pta, kjpt ) 49 SUBROUTINE tra_adv_qck ( kt, kit000, cdtype, p2dt, pu_mm, pv_mm, pww, Kbb, Kmm, pt, kjpt, Krhs ) 51 50 !!---------------------------------------------------------------------- 52 51 !! *** ROUTINE tra_adv_qck *** … … 72 71 !! dt = 2*rdtra and the scalar values are tb and sb 73 72 !! 74 !! On the vertical, the simple centered scheme used pt n73 !! On the vertical, the simple centered scheme used pt(:,:,:,:,Kmm) 75 74 !! 76 75 !! The fluxes are bounded by the ULTIMATE limiter to … … 78 77 !! prevent the appearance of spurious numerical oscillations 79 78 !! 80 !! ** Action : - update pt awith the now advective tracer trends79 !! ** Action : - update pt(:,:,:,:,Krhs) with the now advective tracer trends 81 80 !! - send trends to trdtra module for further diagnostcs (l_trdtra=T) 82 81 !! - htr_adv, str_adv : poleward advective heat and salt transport (ln_diaptr=T) … … 84 83 !! ** Reference : Leonard (1979, 1991) 85 84 !!---------------------------------------------------------------------- 86 INTEGER , INTENT(in ) :: kt ! ocean time-step index87 INTEGER , INTENT(in ) :: kit000 ! first time step index88 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator)89 INTEGER , INTENT(in ) :: kjpt ! number of tracers90 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step91 REAL(wp) , DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pun, pvn, pwn ! 3 ocean velocity components92 REAL(wp), DIMENSION(jpi,jpj,jpk ,kjpt), INTENT(in ) :: ptb, ptn ! before and now tracer fields93 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt ), INTENT(inout) :: pta ! tracer trend85 INTEGER , INTENT(in ) :: kt ! ocean time-step index 86 INTEGER , INTENT(in ) :: Kbb, Kmm, Krhs ! ocean time level indices 87 INTEGER , INTENT(in ) :: kit000 ! first time step index 88 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 89 INTEGER , INTENT(in ) :: kjpt ! number of tracers 90 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step 91 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pu_mm, pv_mm, pww ! 3 ocean velocity components 92 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! active tracers and RHS of tracer equation 94 93 !!---------------------------------------------------------------------- 95 94 ! … … 108 107 ! 109 108 ! ! horizontal fluxes are computed with the QUICKEST + ULTIMATE scheme 110 CALL tra_adv_qck_i( kt, cdtype, p2dt, pu n, ptb, ptn, pta, kjpt)111 CALL tra_adv_qck_j( kt, cdtype, p2dt, pv n, ptb, ptn, pta, kjpt)109 CALL tra_adv_qck_i( kt, cdtype, p2dt, pu_mm, Kbb, Kmm, pt, kjpt, Krhs ) 110 CALL tra_adv_qck_j( kt, cdtype, p2dt, pv_mm, Kbb, Kmm, pt, kjpt, Krhs ) 112 111 113 112 ! ! vertical fluxes are computed with the 2nd order centered scheme 114 CALL tra_adv_cen2_k( kt, cdtype, pw n, ptn, pta, kjpt)113 CALL tra_adv_cen2_k( kt, cdtype, pww, Kmm, pt, kjpt, Krhs ) 115 114 ! 116 115 END SUBROUTINE tra_adv_qck 117 116 118 117 119 SUBROUTINE tra_adv_qck_i( kt, cdtype, p2dt, pun, & 120 & ptb, ptn, pta, kjpt ) 121 !!---------------------------------------------------------------------- 122 !! 123 !!---------------------------------------------------------------------- 124 INTEGER , INTENT(in ) :: kt ! ocean time-step index 125 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 126 INTEGER , INTENT(in ) :: kjpt ! number of tracers 127 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step 128 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pun ! i-velocity components 129 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb, ptn ! before and now tracer fields 130 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 118 SUBROUTINE tra_adv_qck_i( kt, cdtype, p2dt, pu_mm, Kbb, Kmm, pt, kjpt, Krhs ) 119 !!---------------------------------------------------------------------- 120 !! 121 !!---------------------------------------------------------------------- 122 INTEGER , INTENT(in ) :: kt ! ocean time-step index 123 INTEGER , INTENT(in ) :: Kbb, Kmm, Krhs ! ocean time level indices 124 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 125 INTEGER , INTENT(in ) :: kjpt ! number of tracers 126 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step 127 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pu_mm ! i-velocity components 128 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! active tracers and RHS of tracer equation 131 129 !! 132 130 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 145 143 DO jj = 2, jpjm1 146 144 DO ji = fs_2, fs_jpim1 ! vector opt. 147 zfc(ji,jj,jk) = pt b(ji-1,jj,jk,jn) ! Upstream in the x-direction for the tracer148 zfd(ji,jj,jk) = pt b(ji+1,jj,jk,jn) ! Downstream in the x-direction for the tracer145 zfc(ji,jj,jk) = pt(ji-1,jj,jk,jn,Kbb) ! Upstream in the x-direction for the tracer 146 zfd(ji,jj,jk) = pt(ji+1,jj,jk,jn,Kbb) ! Downstream in the x-direction for the tracer 149 147 END DO 150 148 END DO … … 158 156 DO jj = 2, jpjm1 159 157 DO ji = fs_2, fs_jpim1 ! vector opt. 160 zdir = 0.5 + SIGN( 0.5, pu n(ji,jj,jk) ) ! if pun> 0 : zdir = 1 otherwise zdir = 0158 zdir = 0.5 + SIGN( 0.5, pu_mm(ji,jj,jk) ) ! if pu_mm > 0 : zdir = 1 otherwise zdir = 0 161 159 zfu(ji,jj,jk) = zdir * zfc(ji,jj,jk ) + ( 1. - zdir ) * zfd(ji+1,jj,jk) ! FU in the x-direction for T 162 160 END DO … … 167 165 DO jj = 2, jpjm1 168 166 DO ji = fs_2, fs_jpim1 ! vector opt. 169 zdir = 0.5 + SIGN( 0.5, pu n(ji,jj,jk) ) ! if pun> 0 : zdir = 1 otherwise zdir = 0170 zdx = ( zdir * e1t(ji,jj) + ( 1. - zdir ) * e1t(ji+1,jj) ) * e2u(ji,jj) * e3u _n(ji,jj,jk)171 zwx(ji,jj,jk) = ABS( pu n(ji,jj,jk) ) * p2dt / zdx ! (0<zc_cfl<1 : Courant number on x-direction)172 zfc(ji,jj,jk) = zdir * pt b(ji ,jj,jk,jn) + ( 1. - zdir ) * ptb(ji+1,jj,jk,jn) ! FC in the x-direction for T173 zfd(ji,jj,jk) = zdir * pt b(ji+1,jj,jk,jn) + ( 1. - zdir ) * ptb(ji ,jj,jk,jn) ! FD in the x-direction for T167 zdir = 0.5 + SIGN( 0.5, pu_mm(ji,jj,jk) ) ! if pu_mm > 0 : zdir = 1 otherwise zdir = 0 168 zdx = ( zdir * e1t(ji,jj) + ( 1. - zdir ) * e1t(ji+1,jj) ) * e2u(ji,jj) * e3u(ji,jj,jk,Kmm) 169 zwx(ji,jj,jk) = ABS( pu_mm(ji,jj,jk) ) * p2dt / zdx ! (0<zc_cfl<1 : Courant number on x-direction) 170 zfc(ji,jj,jk) = zdir * pt(ji ,jj,jk,jn,Kbb) + ( 1. - zdir ) * pt(ji+1,jj,jk,jn,Kbb) ! FC in the x-direction for T 171 zfd(ji,jj,jk) = zdir * pt(ji+1,jj,jk,jn,Kbb) + ( 1. - zdir ) * pt(ji ,jj,jk,jn,Kbb) ! FD in the x-direction for T 174 172 END DO 175 173 END DO … … 197 195 DO jj = 2, jpjm1 198 196 DO ji = fs_2, fs_jpim1 ! vector opt. 199 zdir = 0.5 + SIGN( 0.5, pu n(ji,jj,jk) ) ! if pun> 0 : zdir = 1 otherwise zdir = 0197 zdir = 0.5 + SIGN( 0.5, pu_mm(ji,jj,jk) ) ! if pu_mm > 0 : zdir = 1 otherwise zdir = 0 200 198 !--- If the second ustream point is a land point 201 199 !--- the flux is computed by the 1st order UPWIND scheme 202 200 zmsk = zdir * zfu(ji,jj,jk) + ( 1. - zdir ) * zfu(ji+1,jj,jk) 203 201 zwx(ji,jj,jk) = zmsk * zwx(ji,jj,jk) + ( 1. - zmsk ) * zfc(ji,jj,jk) 204 zwx(ji,jj,jk) = zwx(ji,jj,jk) * pu n(ji,jj,jk)202 zwx(ji,jj,jk) = zwx(ji,jj,jk) * pu_mm(ji,jj,jk) 205 203 END DO 206 204 END DO … … 213 211 DO jj = 2, jpjm1 214 212 DO ji = fs_2, fs_jpim1 ! vector opt. 215 zbtr = r1_e1e2t(ji,jj) / e3t _n(ji,jj,jk)213 zbtr = r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 216 214 ! horizontal advective trends 217 215 ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj,jk) ) 218 216 !--- add it to the general tracer trends 219 pt a(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra217 pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) + ztra 220 218 END DO 221 219 END DO 222 220 END DO 223 221 ! ! trend diagnostics 224 IF( l_trd ) CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pu n, ptn(:,:,:,jn) )222 IF( l_trd ) CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pu_mm, pt(:,:,:,jn,Kmm) ) 225 223 ! 226 224 END DO … … 229 227 230 228 231 SUBROUTINE tra_adv_qck_j( kt, cdtype, p2dt, pvn, & 232 & ptb, ptn, pta, kjpt ) 233 !!---------------------------------------------------------------------- 234 !! 235 !!---------------------------------------------------------------------- 236 INTEGER , INTENT(in ) :: kt ! ocean time-step index 237 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 238 INTEGER , INTENT(in ) :: kjpt ! number of tracers 239 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step 240 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pvn ! j-velocity components 241 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb, ptn ! before and now tracer fields 242 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 229 SUBROUTINE tra_adv_qck_j( kt, cdtype, p2dt, pv_mm, Kbb, Kmm, pt, kjpt, Krhs ) 230 !!---------------------------------------------------------------------- 231 !! 232 !!---------------------------------------------------------------------- 233 INTEGER , INTENT(in ) :: kt ! ocean time-step index 234 INTEGER , INTENT(in ) :: Kbb, Kmm, Krhs ! ocean time level indices 235 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 236 INTEGER , INTENT(in ) :: kjpt ! number of tracers 237 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step 238 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pv_mm ! j-velocity components 239 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! active tracers and RHS of tracer equation 243 240 !! 244 241 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 259 256 DO ji = fs_2, fs_jpim1 ! vector opt. 260 257 ! Upstream in the x-direction for the tracer 261 zfc(ji,jj,jk) = pt b(ji,jj-1,jk,jn)258 zfc(ji,jj,jk) = pt(ji,jj-1,jk,jn,Kbb) 262 259 ! Downstream in the x-direction for the tracer 263 zfd(ji,jj,jk) = pt b(ji,jj+1,jk,jn)260 zfd(ji,jj,jk) = pt(ji,jj+1,jk,jn,Kbb) 264 261 END DO 265 262 END DO … … 275 272 DO jj = 2, jpjm1 276 273 DO ji = fs_2, fs_jpim1 ! vector opt. 277 zdir = 0.5 + SIGN( 0.5, pv n(ji,jj,jk) ) ! if pun> 0 : zdir = 1 otherwise zdir = 0274 zdir = 0.5 + SIGN( 0.5, pv_mm(ji,jj,jk) ) ! if pu_mm > 0 : zdir = 1 otherwise zdir = 0 278 275 zfu(ji,jj,jk) = zdir * zfc(ji,jj,jk ) + ( 1. - zdir ) * zfd(ji,jj+1,jk) ! FU in the x-direction for T 279 276 END DO … … 284 281 DO jj = 2, jpjm1 285 282 DO ji = fs_2, fs_jpim1 ! vector opt. 286 zdir = 0.5 + SIGN( 0.5, pv n(ji,jj,jk) ) ! if pun> 0 : zdir = 1 otherwise zdir = 0287 zdx = ( zdir * e2t(ji,jj) + ( 1. - zdir ) * e2t(ji,jj+1) ) * e1v(ji,jj) * e3v _n(ji,jj,jk)288 zwy(ji,jj,jk) = ABS( pv n(ji,jj,jk) ) * p2dt / zdx ! (0<zc_cfl<1 : Courant number on x-direction)289 zfc(ji,jj,jk) = zdir * pt b(ji,jj ,jk,jn) + ( 1. - zdir ) * ptb(ji,jj+1,jk,jn) ! FC in the x-direction for T290 zfd(ji,jj,jk) = zdir * pt b(ji,jj+1,jk,jn) + ( 1. - zdir ) * ptb(ji,jj ,jk,jn) ! FD in the x-direction for T283 zdir = 0.5 + SIGN( 0.5, pv_mm(ji,jj,jk) ) ! if pu_mm > 0 : zdir = 1 otherwise zdir = 0 284 zdx = ( zdir * e2t(ji,jj) + ( 1. - zdir ) * e2t(ji,jj+1) ) * e1v(ji,jj) * e3v(ji,jj,jk,Kmm) 285 zwy(ji,jj,jk) = ABS( pv_mm(ji,jj,jk) ) * p2dt / zdx ! (0<zc_cfl<1 : Courant number on x-direction) 286 zfc(ji,jj,jk) = zdir * pt(ji,jj ,jk,jn,Kbb) + ( 1. - zdir ) * pt(ji,jj+1,jk,jn,Kbb) ! FC in the x-direction for T 287 zfd(ji,jj,jk) = zdir * pt(ji,jj+1,jk,jn,Kbb) + ( 1. - zdir ) * pt(ji,jj ,jk,jn,Kbb) ! FD in the x-direction for T 291 288 END DO 292 289 END DO … … 314 311 DO jj = 2, jpjm1 315 312 DO ji = fs_2, fs_jpim1 ! vector opt. 316 zdir = 0.5 + SIGN( 0.5, pv n(ji,jj,jk) ) ! if pun> 0 : zdir = 1 otherwise zdir = 0313 zdir = 0.5 + SIGN( 0.5, pv_mm(ji,jj,jk) ) ! if pu_mm > 0 : zdir = 1 otherwise zdir = 0 317 314 !--- If the second ustream point is a land point 318 315 !--- the flux is computed by the 1st order UPWIND scheme 319 316 zmsk = zdir * zfu(ji,jj,jk) + ( 1. - zdir ) * zfu(ji,jj+1,jk) 320 317 zwy(ji,jj,jk) = zmsk * zwy(ji,jj,jk) + ( 1. - zmsk ) * zfc(ji,jj,jk) 321 zwy(ji,jj,jk) = zwy(ji,jj,jk) * pv n(ji,jj,jk)318 zwy(ji,jj,jk) = zwy(ji,jj,jk) * pv_mm(ji,jj,jk) 322 319 END DO 323 320 END DO … … 330 327 DO jj = 2, jpjm1 331 328 DO ji = fs_2, fs_jpim1 ! vector opt. 332 zbtr = r1_e1e2t(ji,jj) / e3t _n(ji,jj,jk)329 zbtr = r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 333 330 ! horizontal advective trends 334 331 ztra = - zbtr * ( zwy(ji,jj,jk) - zwy(ji,jj-1,jk) ) 335 332 !--- add it to the general tracer trends 336 pt a(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra333 pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) + ztra 337 334 END DO 338 335 END DO 339 336 END DO 340 337 ! ! trend diagnostics 341 IF( l_trd ) CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pv n, ptn(:,:,:,jn) )338 IF( l_trd ) CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pv_mm, pt(:,:,:,jn,Kmm) ) 342 339 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 343 340 IF( l_ptr ) CALL dia_ptr_hst( jn, 'adv', zwy(:,:,:) ) … … 348 345 349 346 350 SUBROUTINE tra_adv_cen2_k( kt, cdtype, pwn, & 351 & ptn, pta, kjpt ) 352 !!---------------------------------------------------------------------- 353 !! 354 !!---------------------------------------------------------------------- 355 INTEGER , INTENT(in ) :: kt ! ocean time-step index 356 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 357 INTEGER , INTENT(in ) :: kjpt ! number of tracers 358 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pwn ! vertical velocity 359 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptn ! before and now tracer fields 360 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 347 SUBROUTINE tra_adv_cen2_k( kt, cdtype, pww, Kmm, pt, kjpt, Krhs ) 348 !!---------------------------------------------------------------------- 349 !! 350 !!---------------------------------------------------------------------- 351 INTEGER , INTENT(in ) :: kt ! ocean time-step index 352 INTEGER , INTENT(in ) :: Kmm, Krhs ! ocean time level indices 353 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 354 INTEGER , INTENT(in ) :: kjpt ! number of tracers 355 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pww ! vertical velocity 356 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! active tracers and RHS of tracer equation 361 357 ! 362 358 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 374 370 DO jj = 2, jpjm1 375 371 DO ji = fs_2, fs_jpim1 ! vector opt. 376 zwz(ji,jj,jk) = 0.5 * pw n(ji,jj,jk) * ( ptn(ji,jj,jk-1,jn) + ptn(ji,jj,jk,jn) ) * wmask(ji,jj,jk)372 zwz(ji,jj,jk) = 0.5 * pww(ji,jj,jk) * ( pt(ji,jj,jk-1,jn,Kmm) + pt(ji,jj,jk,jn,Kmm) ) * wmask(ji,jj,jk) 377 373 END DO 378 374 END DO … … 382 378 DO jj = 1, jpj 383 379 DO ji = 1, jpi 384 zwz(ji,jj, mikt(ji,jj) ) = pw n(ji,jj,mikt(ji,jj)) * ptn(ji,jj,mikt(ji,jj),jn) ! linear free surface380 zwz(ji,jj, mikt(ji,jj) ) = pww(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kmm) ! linear free surface 385 381 END DO 386 382 END DO 387 383 ELSE ! no ocean cavities (only ocean surface) 388 zwz(:,:,1) = pw n(:,:,1) * ptn(:,:,1,jn)384 zwz(:,:,1) = pww(:,:,1) * pt(:,:,1,jn,Kmm) 389 385 ENDIF 390 386 ENDIF … … 393 389 DO jj = 2, jpjm1 394 390 DO ji = fs_2, fs_jpim1 ! vector opt. 395 pt a(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - ( zwz(ji,jj,jk) - zwz(ji,jj,jk+1) ) &396 & * r1_e1e2t(ji,jj) / e3t _n(ji,jj,jk)391 pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( zwz(ji,jj,jk) - zwz(ji,jj,jk+1) ) & 392 & * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 397 393 END DO 398 394 END DO 399 395 END DO 400 396 ! ! Send trends for diagnostic 401 IF( l_trd ) CALL trd_tra( kt, cdtype, jn, jptra_zad, zwz, pw n, ptn(:,:,:,jn) )397 IF( l_trd ) CALL trd_tra( kt, cdtype, jn, jptra_zad, zwz, pww, pt(:,:,:,jn,Kmm) ) 402 398 ! 403 399 END DO -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/traadv_ubs.F90
r10874 r10880 46 46 CONTAINS 47 47 48 SUBROUTINE tra_adv_ubs( kt, kit000, cdtype, p2dt, pu n, pvn, pwn, &49 & ptb, ptn, pta, kjpt, kn_ubs_v )48 SUBROUTINE tra_adv_ubs( kt, kit000, cdtype, p2dt, pu_mm, pv_mm, pww, & 49 & Kbb, Kmm, pt, kjpt, Krhs, kn_ubs_v ) 50 50 !!---------------------------------------------------------------------- 51 51 !! *** ROUTINE tra_adv_ubs *** … … 58 58 !! It is only used in the horizontal direction. 59 59 !! For example the i-component of the advective fluxes are given by : 60 !! ! e2u e3u u n ( mi(Tn) - zltu(i ) ) if un(i) >= 060 !! ! e2u e3u uu ( mi(Tn) - zltu(i ) ,Kmm) if uu(i,Kmm) >= 0 61 61 !! ztu = ! or 62 !! ! e2u e3u u n ( mi(Tn) - zltu(i+1) ) if un(i) < 062 !! ! e2u e3u uu ( mi(Tn) - zltu(i+1) ,Kmm) if uu(i,Kmm) < 0 63 63 !! where zltu is the second derivative of the before temperature field: 64 64 !! zltu = 1/e3t di[ e2u e3u / e1u di[Tb] ] … … 77 77 !! scheme (kn_ubs_v=4). 78 78 !! 79 !! ** Action : - update pt awith the now advective tracer trends79 !! ** Action : - update pt(:,:,:,:,Krhs) with the now advective tracer trends 80 80 !! - send trends to trdtra module for further diagnostcs (l_trdtra=T) 81 81 !! - htr_adv, str_adv : poleward advective heat and salt transport (ln_diaptr=T) … … 84 84 !! Farrow, D.E., Stevens, D.P., 1995, J. Phys. Ocean. 25, 1731Ð1741. 85 85 !!---------------------------------------------------------------------- 86 INTEGER , INTENT(in ) :: kt ! ocean time-step index87 INTEGER , INTENT(in ) :: kit000 ! first time step index88 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator)89 INTEGER , INTENT(in ) :: kjpt ! number of tracers90 INTEGER , INTENT(in ) :: kn_ubs_v! number of tracers91 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step92 REAL(wp) , DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pun, pvn, pwn ! 3 ocean transport components93 REAL(wp), DIMENSION(jpi,jpj,jpk ,kjpt), INTENT(in ) :: ptb, ptn ! before and now tracer fields94 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt ), INTENT(inout) :: pta ! tracer trend86 INTEGER , INTENT(in ) :: kt ! ocean time-step index 87 INTEGER , INTENT(in ) :: Kbb, Kmm, Krhs ! ocean time level indices 88 INTEGER , INTENT(in ) :: kit000 ! first time step index 89 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 90 INTEGER , INTENT(in ) :: kjpt ! number of tracers 91 INTEGER , INTENT(in ) :: kn_ubs_v ! number of tracers 92 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step 93 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pu_mm, pv_mm, pww ! 3 ocean transport components 94 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! active tracers and RHS of tracer equation 95 95 ! 96 96 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 126 126 DO jj = 1, jpjm1 ! First derivative (masked gradient) 127 127 DO ji = 1, fs_jpim1 ! vector opt. 128 zeeu = e2_e1u(ji,jj) * e3u _n(ji,jj,jk) * umask(ji,jj,jk)129 zeev = e1_e2v(ji,jj) * e3v _n(ji,jj,jk) * vmask(ji,jj,jk)130 ztu(ji,jj,jk) = zeeu * ( pt b(ji+1,jj ,jk,jn) - ptb(ji,jj,jk,jn) )131 ztv(ji,jj,jk) = zeev * ( pt b(ji ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) )128 zeeu = e2_e1u(ji,jj) * e3u(ji,jj,jk,Kmm) * umask(ji,jj,jk) 129 zeev = e1_e2v(ji,jj) * e3v(ji,jj,jk,Kmm) * vmask(ji,jj,jk) 130 ztu(ji,jj,jk) = zeeu * ( pt(ji+1,jj ,jk,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) ) 131 ztv(ji,jj,jk) = zeev * ( pt(ji ,jj+1,jk,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) ) 132 132 END DO 133 133 END DO 134 134 DO jj = 2, jpjm1 ! Second derivative (divergence) 135 135 DO ji = fs_2, fs_jpim1 ! vector opt. 136 zcoef = 1._wp / ( 6._wp * e3t _n(ji,jj,jk) )136 zcoef = 1._wp / ( 6._wp * e3t(ji,jj,jk,Kmm) ) 137 137 zltu(ji,jj,jk) = ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) ) * zcoef 138 138 zltv(ji,jj,jk) = ( ztv(ji,jj,jk) - ztv(ji,jj-1,jk) ) * zcoef … … 146 146 DO jj = 1, jpjm1 147 147 DO ji = 1, fs_jpim1 ! vector opt. 148 zfp_ui = pu n(ji,jj,jk) + ABS( pun(ji,jj,jk) ) ! upstream transport (x2)149 zfm_ui = pu n(ji,jj,jk) - ABS( pun(ji,jj,jk) )150 zfp_vj = pv n(ji,jj,jk) + ABS( pvn(ji,jj,jk) )151 zfm_vj = pv n(ji,jj,jk) - ABS( pvn(ji,jj,jk) )148 zfp_ui = pu_mm(ji,jj,jk) + ABS( pu_mm(ji,jj,jk) ) ! upstream transport (x2) 149 zfm_ui = pu_mm(ji,jj,jk) - ABS( pu_mm(ji,jj,jk) ) 150 zfp_vj = pv_mm(ji,jj,jk) + ABS( pv_mm(ji,jj,jk) ) 151 zfm_vj = pv_mm(ji,jj,jk) - ABS( pv_mm(ji,jj,jk) ) 152 152 ! ! 2nd order centered advective fluxes (x2) 153 zcenut = pu n(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj ,jk,jn) )154 zcenvt = pv n(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji ,jj+1,jk,jn) )153 zcenut = pu_mm(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj ,jk,jn,Kmm) ) 154 zcenvt = pv_mm(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji ,jj+1,jk,jn,Kmm) ) 155 155 ! ! UBS advective fluxes 156 156 ztu(ji,jj,jk) = 0.5 * ( zcenut - zfp_ui * zltu(ji,jj,jk) - zfm_ui * zltu(ji+1,jj,jk) ) … … 160 160 END DO 161 161 ! 162 zltu(:,:,:) = pt a(:,:,:,jn) ! store the initial trends before its update162 zltu(:,:,:) = pt(:,:,:,jn,Krhs) ! store the initial trends before its update 163 163 ! 164 164 DO jk = 1, jpkm1 !== add the horizontal advective trend ==! 165 165 DO jj = 2, jpjm1 166 166 DO ji = fs_2, fs_jpim1 ! vector opt. 167 pt a(ji,jj,jk,jn) = pta(ji,jj,jk,jn) &167 pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) & 168 168 & - ( ztu(ji,jj,jk) - ztu(ji-1,jj ,jk) & 169 & + ztv(ji,jj,jk) - ztv(ji ,jj-1,jk) ) * r1_e1e2t(ji,jj) / e3t _n(ji,jj,jk)169 & + ztv(ji,jj,jk) - ztv(ji ,jj-1,jk) ) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 170 170 END DO 171 171 END DO … … 173 173 END DO 174 174 ! 175 zltu(:,:,:) = pt a(:,:,:,jn) - zltu(:,:,:) ! Horizontal advective trend used in vertical 2nd order FCT case175 zltu(:,:,:) = pt(:,:,:,jn,Krhs) - zltu(:,:,:) ! Horizontal advective trend used in vertical 2nd order FCT case 176 176 ! ! and/or in trend diagnostic (l_trd=T) 177 177 ! 178 178 IF( l_trd ) THEN ! trend diagnostics 179 CALL trd_tra( kt, cdtype, jn, jptra_xad, ztu, pu n, ptn(:,:,:,jn) )180 CALL trd_tra( kt, cdtype, jn, jptra_yad, ztv, pv n, ptn(:,:,:,jn) )179 CALL trd_tra( kt, cdtype, jn, jptra_xad, ztu, pu_mm, pt(:,:,:,jn,Kmm) ) 180 CALL trd_tra( kt, cdtype, jn, jptra_yad, ztv, pv_mm, pt(:,:,:,jn,Kmm) ) 181 181 END IF 182 182 ! … … 193 193 CASE( 2 ) ! 2nd order FCT 194 194 ! 195 IF( l_trd ) zltv(:,:,:) = pt a(:,:,:,jn) ! store ptaif trend diag.195 IF( l_trd ) zltv(:,:,:) = pt(:,:,:,jn,Krhs) ! store pt(:,:,:,:,Krhs) if trend diag. 196 196 ! 197 197 ! !* upstream advection with initial mass fluxes & intermediate update ==! … … 199 199 DO jj = 1, jpj 200 200 DO ji = 1, jpi 201 zfp_wk = pw n(ji,jj,jk) + ABS( pwn(ji,jj,jk) )202 zfm_wk = pw n(ji,jj,jk) - ABS( pwn(ji,jj,jk) )203 ztw(ji,jj,jk) = 0.5_wp * ( zfp_wk * pt b(ji,jj,jk,jn) + zfm_wk * ptb(ji,jj,jk-1,jn) ) * wmask(ji,jj,jk)201 zfp_wk = pww(ji,jj,jk) + ABS( pww(ji,jj,jk) ) 202 zfm_wk = pww(ji,jj,jk) - ABS( pww(ji,jj,jk) ) 203 ztw(ji,jj,jk) = 0.5_wp * ( zfp_wk * pt(ji,jj,jk,jn,Kbb) + zfm_wk * pt(ji,jj,jk-1,jn,Kbb) ) * wmask(ji,jj,jk) 204 204 END DO 205 205 END DO … … 209 209 DO jj = 1, jpj 210 210 DO ji = 1, jpi 211 ztw(ji,jj, mikt(ji,jj) ) = pw n(ji,jj,mikt(ji,jj)) * ptb(ji,jj,mikt(ji,jj),jn) ! linear free surface211 ztw(ji,jj, mikt(ji,jj) ) = pww(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kbb) ! linear free surface 212 212 END DO 213 213 END DO 214 214 ELSE ! no cavities: only at the ocean surface 215 ztw(:,:,1) = pw n(:,:,1) * ptb(:,:,1,jn)215 ztw(:,:,1) = pww(:,:,1) * pt(:,:,1,jn,Kbb) 216 216 ENDIF 217 217 ENDIF … … 220 220 DO jj = 2, jpjm1 221 221 DO ji = fs_2, fs_jpim1 ! vector opt. 222 ztak = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) / e3t _n(ji,jj,jk)223 pt a(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztak224 zti(ji,jj,jk) = ( pt b(ji,jj,jk,jn) + p2dt * ( ztak + zltu(ji,jj,jk) ) ) * tmask(ji,jj,jk)222 ztak = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 223 pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) + ztak 224 zti(ji,jj,jk) = ( pt(ji,jj,jk,jn,Kbb) + p2dt * ( ztak + zltu(ji,jj,jk) ) ) * tmask(ji,jj,jk) 225 225 END DO 226 226 END DO … … 232 232 DO jj = 1, jpj 233 233 DO ji = 1, jpi 234 ztw(ji,jj,jk) = ( 0.5_wp * pw n(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj,jk-1,jn) ) &234 ztw(ji,jj,jk) = ( 0.5_wp * pww(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji,jj,jk-1,jn,Kmm) ) & 235 235 & - ztw(ji,jj,jk) ) * wmask(ji,jj,jk) 236 236 END DO … … 240 240 IF( ln_linssh ) ztw(:,:, 1 ) = 0._wp ! only ocean surface as interior zwz values have been w-masked 241 241 ! 242 CALL nonosc_z( ptb(:,:,:,jn), ztw, zti, p2dt ) ! monotonicity algorithm242 CALL nonosc_z( Kmm, pt(:,:,:,jn,Kbb), ztw, zti, p2dt ) ! monotonicity algorithm 243 243 ! 244 244 CASE( 4 ) ! 4th order COMPACT 245 CALL interp_4th_cpt( pt n(:,:,:,jn) , ztw ) ! 4th order compact interpolation of T at w-point245 CALL interp_4th_cpt( pt(:,:,:,jn,Kmm) , ztw ) ! 4th order compact interpolation of T at w-point 246 246 DO jk = 2, jpkm1 247 247 DO jj = 2, jpjm1 248 248 DO ji = fs_2, fs_jpim1 249 ztw(ji,jj,jk) = pw n(ji,jj,jk) * ztw(ji,jj,jk) * wmask(ji,jj,jk)250 END DO 251 END DO 252 END DO 253 IF( ln_linssh ) ztw(:,:, 1 ) = pw n(:,:,1) * ptn(:,:,1,jn) !!gm ISF & 4th COMPACT doesn't work249 ztw(ji,jj,jk) = pww(ji,jj,jk) * ztw(ji,jj,jk) * wmask(ji,jj,jk) 250 END DO 251 END DO 252 END DO 253 IF( ln_linssh ) ztw(:,:, 1 ) = pww(:,:,1) * pt(:,:,1,jn,Kmm) !!gm ISF & 4th COMPACT doesn't work 254 254 ! 255 255 END SELECT … … 258 258 DO jj = 2, jpjm1 259 259 DO ji = fs_2, fs_jpim1 ! vector opt. 260 pt a(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)260 pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 261 261 END DO 262 262 END DO … … 267 267 DO jj = 2, jpjm1 268 268 DO ji = fs_2, fs_jpim1 ! vector opt. 269 zltv(ji,jj,jk) = pt a(ji,jj,jk,jn) - zltv(ji,jj,jk) &270 & + pt n(ji,jj,jk,jn) * ( pwn(ji,jj,jk) - pwn(ji,jj,jk+1) ) &271 & * r1_e1e2t(ji,jj) / e3t _n(ji,jj,jk)269 zltv(ji,jj,jk) = pt(ji,jj,jk,jn,Krhs) - zltv(ji,jj,jk) & 270 & + pt(ji,jj,jk,jn,Kmm) * ( pww(ji,jj,jk) - pww(ji,jj,jk+1) ) & 271 & * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 272 272 END DO 273 273 END DO … … 281 281 282 282 283 SUBROUTINE nonosc_z( pbef, pcc, paft, p2dt )283 SUBROUTINE nonosc_z( Kmm, pbef, pcc, paft, p2dt ) 284 284 !!--------------------------------------------------------------------- 285 285 !! *** ROUTINE nonosc_z *** … … 294 294 !! in-space based differencing for fluid 295 295 !!---------------------------------------------------------------------- 296 INTEGER , INTENT(in ) :: Kmm ! time level index 296 297 REAL(wp), INTENT(in ) :: p2dt ! tracer time-step 297 298 REAL(wp), DIMENSION (jpi,jpj,jpk) :: pbef ! before field … … 352 353 zneg = MAX( 0., pcc(ji ,jj ,jk ) ) - MIN( 0., pcc(ji ,jj ,jk+1) ) 353 354 ! up & down beta terms 354 zbt = e1e2t(ji,jj) * e3t _n(ji,jj,jk) / p2dt355 zbt = e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) / p2dt 355 356 zbetup(ji,jj,jk) = ( zbetup(ji,jj,jk) - paft(ji,jj,jk) ) / (zpos+zrtrn) * zbt 356 357 zbetdo(ji,jj,jk) = ( paft(ji,jj,jk) - zbetdo(ji,jj,jk) ) / (zneg+zrtrn) * zbt -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/step.F90
r10877 r10880 47 47 48 48 !!---------------------------------------------------------------------- 49 !! time level indices 50 !!---------------------------------------------------------------------- 51 INTEGER, PUBLIC :: Nbb, Nnn, Naa, Nrhs !! used by nemo_init 52 53 !!---------------------------------------------------------------------- 49 54 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 50 55 !! $Id$ … … 247 252 & CALL Agrif_Sponge_tra ! tracers sponge 248 253 #endif 249 CALL tra_adv ( kstp ) ! horizontal & vertical advection254 CALL tra_adv( kstp, Nbb, Nnn , ts, Nrhs ) ! hor. + vert. advection ==> RHS 250 255 IF( ln_zdfosm ) CALL tra_osm ( kstp ) ! OSMOSIS non-local tracer fluxes 251 256 IF( lrst_oce .AND. ln_zdfosm ) & -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/step_oce.F90
r10068 r10880 107 107 #endif 108 108 #if defined key_top 109 USE trcstp 109 USE trcstp, ONLY : trc_stp ! passive tracer time-stepping (trc_stp routine) 110 110 #endif 111 111 !!---------------------------------------------------------------------- -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/TRP/trcadv.F90
r10874 r10880 68 68 CONTAINS 69 69 70 SUBROUTINE trc_adv( kt )70 SUBROUTINE trc_adv( kt, Kbb, Kmm, ptr, Krhs ) 71 71 !!---------------------------------------------------------------------- 72 72 !! *** ROUTINE trc_adv *** … … 76 76 !! ** Method : - Update after tracers (tra) with the advection term following nadv 77 77 !!---------------------------------------------------------------------- 78 INTEGER, INTENT(in) :: kt ! ocean time-step index 78 INTEGER , INTENT(in) :: kt ! ocean time-step index 79 INTEGER , INTENT(in) :: Kbb, Kmm, Krhs ! time level indices 80 REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr ! passive tracers and RHS of tracer equation 79 81 ! 80 82 INTEGER :: jk ! dummy loop index … … 123 125 ! 124 126 CASE ( np_CEN ) ! Centered : 2nd / 4th order 125 CALL tra_adv_cen( kt, nittrc000,'TRC', zun, zvn, zwn , trn, tra, jptra, nn_cen_h, nn_cen_v )127 CALL tra_adv_cen( kt, nittrc000,'TRC', zun, zvn, zwn, Kmm, ptr, jptra, Krhs, nn_cen_h, nn_cen_v ) 126 128 CASE ( np_FCT ) ! FCT : 2nd / 4th order 127 CALL tra_adv_fct( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra, nn_fct_h, nn_fct_v )129 CALL tra_adv_fct( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, Kbb, Kmm, ptr, jptra, Krhs, nn_fct_h, nn_fct_v ) 128 130 CASE ( np_MUS ) ! MUSCL 129 CALL tra_adv_mus( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, tra, jptra , ln_mus_ups)131 CALL tra_adv_mus( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, Kbb, Kmm, ptr, jptra, Krhs, ln_mus_ups ) 130 132 CASE ( np_UBS ) ! UBS 131 CALL tra_adv_ubs( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra , nn_ubs_v)133 CALL tra_adv_ubs( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, Kbb, Kmm, ptr, jptra, Krhs, nn_ubs_v ) 132 134 CASE ( np_QCK ) ! QUICKEST 133 CALL tra_adv_qck( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra)135 CALL tra_adv_qck( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, Kbb, Kmm, ptr, jptra, Krhs ) 134 136 ! 135 137 END SELECT -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/TRP/trctrp.F90
r10874 r10880 44 44 CONTAINS 45 45 46 SUBROUTINE trc_trp( kt )46 SUBROUTINE trc_trp( kt, Kbb, Kmm, Krhs, Kaa ) 47 47 !!---------------------------------------------------------------------- 48 48 !! *** ROUTINE trc_trp *** … … 53 53 !! - Update the passive tracers 54 54 !!---------------------------------------------------------------------- 55 INTEGER, INTENT( in ) :: kt ! ocean time-step index 55 INTEGER, INTENT( in ) :: kt ! ocean time-step index 56 INTEGER, INTENT( in ) :: Kbb, Kmm, Krhs, Kaa ! time level indices 56 57 !! --------------------------------------------------------------------- 57 58 ! … … 64 65 IF( ln_trcdmp ) CALL trc_dmp ( kt ) ! internal damping trends 65 66 IF( ln_bdy ) CALL trc_bdy_dmp( kt ) ! BDY damping trends 66 CALL trc_adv ( kt ) ! horizontal & vertical advection67 CALL trc_adv ( kt, Kbb, Kmm, tr, Krhs ) ! horizontal & vertical advection 67 68 ! ! Partial top/bottom cell: GRADh( trb ) 68 69 IF( ln_zps ) THEN -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/oce_trc.F90
r10351 r10880 8 8 !!---------------------------------------------------------------------- 9 9 ! !* Domain size * 10 USE par_oce , ONLY : jpt => jpt !: time dimension 10 11 USE par_oce , ONLY : jpi => jpi !: first dimension of grid --> i 11 12 USE par_oce , ONLY : jpj => jpj !: second dimension of grid --> j -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/trc.F90
r10425 r10880 33 33 REAL(wp), PUBLIC :: areatot !: total volume 34 34 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,: ) :: cvol !: volume correction -degrad option- 35 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: trn !: tracer concentration for now time step 36 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: tra !: tracer concentration for next time step 37 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: trb !: tracer concentration for before time step 35 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:), TARGET :: tr !: tracer concentration 38 36 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,: ) :: sbc_trc_b !: Before sbc fluxes for tracers 39 37 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,: ) :: sbc_trc !: Now sbc fluxes for tracers … … 42 40 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,: ) :: trc_o !: prescribed tracer concentration in ocean for SBC 43 41 INTEGER , PUBLIC :: nn_ice_tr !: handling of sea ice tracers 42 43 !! TEMPORARY POINTERS - TO BE DELETED AFTER IMMERSE DEVELOPMENT COMPLETE 44 REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:,:) :: trn !: tracer concentration for now time step 45 REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:,:) :: tra !: tracer concentration for next time step 46 REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:,:) :: trb !: tracer concentration for before time step 47 !! TEMPORARY POINTERS - TO BE DELETED AFTER IMMERSE DEVELOPMENT COMPLETE 44 48 45 49 !! interpolated gradient … … 147 151 ierr(:) = 0 148 152 ! 149 ALLOCATE( tr n(jpi,jpj,jpk,jptra), trb(jpi,jpj,jpk,jptra), tra(jpi,jpj,jpk,jptra), &153 ALLOCATE( tr(jpi,jpj,jpk,jptra,jpt) , & 150 154 & trc_i(jpi,jpj,jptra) , trc_o(jpi,jpj,jptra) , & 151 155 & gtru (jpi,jpj,jptra) , gtrv (jpi,jpj,jptra) , & -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/trcini.F90
r10570 r10880 26 26 USE trcice ! tracers in sea ice 27 27 USE trcbc, only : trc_bc_ini ! generalized Boundary Conditions 28 USE trcstp ! for time level indices (to be initialised) 28 29 29 30 IMPLICIT NONE … … 61 62 CALL trc_nam ! read passive tracers namelists 62 63 CALL top_alloc() ! allocate TOP arrays 64 65 ! Initialise time level indices 66 Nbb = 1; Nnn = 2; Naa = 3; Nrhs = Naa 67 68 ! Initialisation of temporary pointers (to be deleted after development finished) 69 CALL update_pointers_trc() 63 70 ! 64 71 IF(.NOT.ln_trcdta ) ln_trc_ini(:) = .FALSE. -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/trcstp.F90
r10570 r10880 30 30 31 31 PUBLIC trc_stp ! called by step 32 PUBLIC update_pointers_trc ! called in initialisation 33 34 !!---------------------------------------------------------------------- 35 !! time level indices 36 !!---------------------------------------------------------------------- 37 INTEGER, PUBLIC :: Nbb, Nnn, Naa, Nrhs !! used by trc_init 32 38 33 39 LOGICAL :: llnew ! ??? … … 100 106 CALL trc_wri ( kt ) ! output of passive tracers with iom I/O manager 101 107 CALL trc_sms ( kt ) ! tracers: sinks and sources 102 CALL trc_trp ( kt ) ! transport of passive tracers108 CALL trc_trp ( kt, Nbb, Nnn, Nrhs, Naa ) ! transport of passive tracers 103 109 IF( kt == nittrc000 ) THEN 104 110 CALL iom_close( numrtr ) ! close input tracer restart file … … 125 131 END SUBROUTINE trc_stp 126 132 133 SUBROUTINE update_pointers_trc 134 !!---------------------------------------------------------------------- 135 !! *** ROUTINE update_pointers_trc *** 136 !! 137 !! ** Purpose : Associate temporary pointer arrays. 138 !! For IMMERSE development phase only - to be deleted 139 !! 140 !! ** Method : 141 !!---------------------------------------------------------------------- 142 143 trb => tr(:,:,:,:,Nbb); trn => tr(:,:,:,:,Nnn); tra => tr(:,:,:,:,Naa) 144 145 END SUBROUTINE update_pointers_trc 127 146 128 147 SUBROUTINE trc_mean_qsr( kt )
Note: See TracChangeset
for help on using the changeset viewer.
