Changeset 10966 for NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/TRP/trcnxt.F90
- Timestamp:
- 2019-05-10T18:43:09+02:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/TRP/trcnxt.F90
r10963 r10966 61 61 !! next time-step from their temporal trends and swap the fields. 62 62 !! 63 !! ** Method : Apply lateral boundary conditions on (u a,va) through63 !! ** Method : Apply lateral boundary conditions on (uu(Krhs),vv(Krhs)) through 64 64 !! call to lbc_lnk routine 65 65 !! default: 66 66 !! arrays swap 67 !! (tr n) = (tra) ; (tra) = (0,0)68 !! (tr b) = (trn)67 !! (tr(Kmm)) = (tr(Krhs)) ; (tr(Krhs)) = (0,0) 68 !! (tr(Kbb)) = (tr(Kmm)) 69 69 !! 70 70 !! For Arakawa or TVD Scheme : 71 !! A Asselin time filter applied on now tracers (tr n) to avoid71 !! A Asselin time filter applied on now tracers (tr(:,:,:,:,Kmm)) to avoid 72 72 !! the divergence of two consecutive time-steps and tr arrays 73 73 !! to prepare the next time_step: 74 !! (tr b) = (trn) + atfp [ (trb) + (tra) - 2 (trn) ]75 !! (tr n) = (tra) ; (tra) = (0,0)76 !! 77 !! 78 !! ** Action : - update tr b, trn74 !! (tr(Kbb)) = (tr(Kmm)) + atfp [ (tr(Kbb)) + (tr(Krhs)) - 2 (tr(Kmm)) ] 75 !! (tr(Kmm)) = (tr(Krhs)) ; (tr(Krhs)) = (0,0) 76 !! 77 !! 78 !! ** Action : - update tr(Kbb), tr(Kmm) 79 79 !!---------------------------------------------------------------------- 80 80 INTEGER, INTENT( in ) :: kt ! ocean time-step index … … 98 98 #endif 99 99 ! Update after tracer on domain lateral boundaries 100 CALL lbc_lnk( 'trcnxt', tr a(:,:,:,:), 'T', 1. )100 CALL lbc_lnk( 'trcnxt', tr(:,:,:,:,Krhs), 'T', 1. ) 101 101 102 102 IF( ln_bdy ) CALL trc_bdy( kt, Kbb, Kmm, Krhs ) … … 113 113 ! total trend for the non-time-filtered variables. 114 114 zfact = 1.0 / rdttrc 115 ! G Nurser 23 Mar 2017. Recalculate trend as Delta(e3t*T)/e3tn; e3tn cancel from ts nterms115 ! G Nurser 23 Mar 2017. Recalculate trend as Delta(e3t*T)/e3tn; e3tn cancel from ts(Kmm) terms 116 116 IF( ln_linssh ) THEN ! linear sea surface height only 117 117 DO jn = 1, jptra 118 118 DO jk = 1, jpkm1 119 ztrdt(:,:,jk,jn) = ( tr a(:,:,jk,jn)*e3t_a(:,:,jk) / e3t_n(:,:,jk) - trn(:,:,jk,jn)) * zfact119 ztrdt(:,:,jk,jn) = ( tr(:,:,jk,jn,Krhs)*e3t(:,:,jk,Krhs) / e3t(:,:,jk,Kmm) - tr(:,:,jk,jn,Kmm)) * zfact 120 120 END DO 121 121 END DO … … 123 123 DO jn = 1, jptra 124 124 DO jk = 1, jpkm1 125 ztrdt(:,:,jk,jn) = ( tr a(:,:,jk,jn) - trn(:,:,jk,jn) ) * zfact125 ztrdt(:,:,jk,jn) = ( tr(:,:,jk,jn,Krhs) - tr(:,:,jk,jn,Kmm) ) * zfact 126 126 END DO 127 127 END DO … … 135 135 ! Store now fields before applying the Asselin filter 136 136 ! in order to calculate Asselin filter trend later. 137 ztrdt(:,:,:,:) = tr n(:,:,:,:)137 ztrdt(:,:,:,:) = tr(:,:,:,:,Kmm) 138 138 ENDIF 139 139 … … 143 143 DO jn = 1, jptra 144 144 DO jk = 1, jpkm1 145 tr n(:,:,jk,jn) = tra(:,:,jk,jn)146 tr b(:,:,jk,jn) = trn(:,:,jk,jn)145 tr(:,:,jk,jn,Kmm) = tr(:,:,jk,jn,Krhs) 146 tr(:,:,jk,jn,Kbb) = tr(:,:,jk,jn,Kmm) 147 147 END DO 148 148 END DO … … 157 157 ELSE 158 158 IF( .NOT. l_offline ) THEN ! Leap-Frog + Asselin filter time stepping 159 IF( ln_linssh ) THEN ; CALL tra_nxt_fix( kt, Kmm, nittrc000, 'TRC', trb, trn, tra, jptra ) ! linear ssh 160 ELSE ; CALL tra_nxt_vvl( kt, Kbb, Kmm, Krhs, nittrc000, rdttrc, 'TRC', trb, trn, tra, & 161 & sbc_trc, sbc_trc_b, jptra ) ! non-linear ssh 159 IF( ln_linssh ) THEN ; CALL tra_nxt_fix( kt, Kmm, nittrc000, 'TRC', & 160 & tr(:,:,:,:,Kbb), tr(:,:,:,:,Kmm), tr(:,:,:,:,Krhs), jptra ) ! linear ssh 161 ELSE ; CALL tra_nxt_vvl( kt, Kbb, Kmm, Krhs, nittrc000, rdttrc, 'TRC', & 162 & tr(:,:,:,:,Kbb), tr(:,:,:,:,Kmm), tr(:,:,:,:,Krhs), & 163 & sbc_trc, sbc_trc_b, jptra ) ! non-linear ssh 162 164 ENDIF 163 165 ELSE 164 CALL trc_nxt_off( kt ) ! offline165 ENDIF 166 ! 167 CALL lbc_lnk_multi( 'trcnxt', tr b(:,:,:,:), 'T', 1._wp, trn(:,:,:,:), 'T', 1._wp, tra(:,:,:,:), 'T', 1._wp )166 CALL trc_nxt_off( kt, Kbb, Kmm, Krhs ) ! offline 167 ENDIF 168 ! 169 CALL lbc_lnk_multi( 'trcnxt', tr(:,:,:,:,Kbb), 'T', 1._wp, tr(:,:,:,:,Kmm), 'T', 1._wp, tr(:,:,:,:,Krhs), 'T', 1._wp ) 168 170 ENDIF 169 171 ! … … 172 174 DO jk = 1, jpkm1 173 175 zfact = 1._wp / r2dttrc 174 ztrdt(:,:,jk,jn) = ( tr b(:,:,jk,jn) - ztrdt(:,:,jk,jn) ) * zfact176 ztrdt(:,:,jk,jn) = ( tr(:,:,jk,jn,Kbb) - ztrdt(:,:,jk,jn) ) * zfact 175 177 END DO 176 178 CALL trd_tra( kt, Kmm, Krhs, 'TRC', jn, jptra_atf, ztrdt(:,:,:,jn) ) … … 182 184 WRITE(charout, FMT="('nxt')") 183 185 CALL prt_ctl_trc_info(charout) 184 CALL prt_ctl_trc(tab4d=tr n, mask=tmask, clinfo=ctrcnm)186 CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Kmm), mask=tmask, clinfo=ctrcnm) 185 187 ENDIF 186 188 ! … … 190 192 191 193 192 SUBROUTINE trc_nxt_off( kt )194 SUBROUTINE trc_nxt_off( kt, Kbb, Kmm, Krhs ) 193 195 !!---------------------------------------------------------------------- 194 196 !! *** ROUTINE tra_nxt_vvl *** … … 204 206 !! This can be summurized for tempearture as: 205 207 !! ztm = ( e3t_n*tn + rbcp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] ) ln_dynhpg_imp = T 206 !! /( e3t _n + rbcp*[ e3t_b - 2 e3t_n + e3t_a] )208 !! /( e3t(:,:,:,Kmm) + rbcp*[ e3t(:,:,:,Kbb) - 2 e3t(:,:,:,Kmm) + e3t(:,:,:,Krhs) ] ) 207 209 !! ztm = 0 otherwise 208 210 !! tb = ( e3t_n*tn + atfp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] ) 209 !! /( e3t _n + atfp*[ e3t_b - 2 e3t_n + e3t_a] )211 !! /( e3t(:,:,:,Kmm) + atfp*[ e3t(:,:,:,Kbb) - 2 e3t(:,:,:,Kmm) + e3t(:,:,:,Krhs) ] ) 210 212 !! tn = ta 211 213 !! ta = zt (NB: reset to 0 after eos_bn2 call) … … 214 216 !! - (ta,sa) time averaged (t,s) (ln_dynhpg_imp = T) 215 217 !!---------------------------------------------------------------------- 216 INTEGER , INTENT(in ) :: kt ! ocean time-step index 218 INTEGER, INTENT(in ) :: kt ! ocean time-step index 219 INTEGER, INTENT(in ) :: Kbb, Kmm, Krhs ! time level indices 217 220 !! 218 221 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 236 239 DO jj = 1, jpj 237 240 DO ji = 1, jpi 238 ze3t_b = e3t _b(ji,jj,jk)239 ze3t_n = e3t _n(ji,jj,jk)240 ze3t_a = e3t _a(ji,jj,jk)241 ze3t_b = e3t(ji,jj,jk,Kbb) 242 ze3t_n = e3t(ji,jj,jk,Kmm) 243 ze3t_a = e3t(ji,jj,jk,Krhs) 241 244 ! ! tracer content at Before, now and after 242 ztc_b = tr b(ji,jj,jk,jn)* ze3t_b243 ztc_n = tr n(ji,jj,jk,jn)* ze3t_n244 ztc_a = tr a(ji,jj,jk,jn) * ze3t_a245 ztc_b = tr(ji,jj,jk,jn,Kbb) * ze3t_b 246 ztc_n = tr(ji,jj,jk,jn,Kmm) * ze3t_n 247 ztc_a = tr(ji,jj,jk,jn,Krhs) * ze3t_a 245 248 ! 246 249 ze3t_d = ze3t_a - 2. * ze3t_n + ze3t_b … … 256 259 257 260 ze3t_f = 1.e0 / ze3t_f 258 tr b(ji,jj,jk,jn) = ztc_f * ze3t_f ! ptb <-- ptnfiltered259 tr n(ji,jj,jk,jn) = tra(ji,jj,jk,jn) ! ptn <-- pta261 tr(ji,jj,jk,jn,Kbb) = ztc_f * ze3t_f ! pt(:,:,:,:,Kbb) <-- pt(:,:,:,:,Kmm) filtered 262 tr(ji,jj,jk,jn,Kmm) = tr(ji,jj,jk,jn,Krhs) ! pt(:,:,:,:,Kmm) <-- pt(:,:,:,:,Krhs) 260 263 ! 261 264 END DO … … 272 275 !!---------------------------------------------------------------------- 273 276 CONTAINS 274 SUBROUTINE trc_nxt( kt )277 SUBROUTINE trc_nxt( kt, Kbb, Kmm, Krhs ) 275 278 INTEGER, INTENT(in) :: kt 279 INTEGER, INTENT(in) :: Kbb, Kmm, Krhs ! time level indices 276 280 WRITE(*,*) 'trc_nxt: You should not have seen this print! error?', kt 277 281 END SUBROUTINE trc_nxt
Note: See TracChangeset
for help on using the changeset viewer.
