Changeset 10954 for NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/tranxt.F90
- Timestamp:
- 2019-05-09T18:12:29+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/OCE/TRA/tranxt.F90
r10946 r10954 64 64 CONTAINS 65 65 66 SUBROUTINE tra_nxt( kt, K mm, Krhs )66 SUBROUTINE tra_nxt( kt, Kbb, Kmm, Krhs ) 67 67 !!---------------------------------------------------------------------- 68 68 !! *** ROUTINE tranxt *** … … 84 84 !! domains (lk_agrif=T) 85 85 !! 86 !! ** Action : - ts b & tsnready for the next time step86 !! ** Action : - ts(Kbb) & ts(Kmm) ready for the next time step 87 87 !!---------------------------------------------------------------------- 88 88 INTEGER, INTENT(in) :: kt ! ocean time-step index 89 INTEGER, INTENT(in) :: K mm, Krhs ! time level indices89 INTEGER, INTENT(in) :: Kbb, Kmm, Krhs ! time level indices 90 90 !! 91 91 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 108 108 #endif 109 109 ! ! local domain boundaries (T-point, unchanged sign) 110 CALL lbc_lnk_multi( 'tranxt', ts a(:,:,:,jp_tem), 'T', 1., tsa(:,:,:,jp_sal), 'T', 1. )110 CALL lbc_lnk_multi( 'tranxt', ts(:,:,:,jp_tem,Krhs), 'T', 1., ts(:,:,:,jp_sal,Krhs), 'T', 1. ) 111 111 ! 112 112 IF( ln_bdy ) CALL bdy_tra( kt ) ! BDY open boundaries … … 128 128 ! total trend for the non-time-filtered variables. 129 129 zfact = 1.0 / rdt 130 ! G Nurser 23 Mar 2017. Recalculate trend as Delta(e3t*T)/e3tn; e3tn cancel from ts nterms130 ! G Nurser 23 Mar 2017. Recalculate trend as Delta(e3t*T)/e3tn; e3tn cancel from ts(Kmm) terms 131 131 DO jk = 1, jpkm1 132 ztrdt(:,:,jk) = ( ts a(:,:,jk,jp_tem)*e3t_a(:,:,jk) / e3t_n(:,:,jk) - tsn(:,:,jk,jp_tem)) * zfact133 ztrds(:,:,jk) = ( ts a(:,:,jk,jp_sal)*e3t_a(:,:,jk) / e3t_n(:,:,jk) - tsn(:,:,jk,jp_sal)) * zfact132 ztrdt(:,:,jk) = ( ts(:,:,jk,jp_tem,Krhs)*e3t(:,:,jk,Krhs) / e3t(:,:,jk,Kmm) - ts(:,:,jk,jp_tem,Kmm)) * zfact 133 ztrds(:,:,jk) = ( ts(:,:,jk,jp_sal,Krhs)*e3t(:,:,jk,Krhs) / e3t(:,:,jk,Kmm) - ts(:,:,jk,jp_sal,Kmm)) * zfact 134 134 END DO 135 135 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_tot, ztrdt ) … … 138 138 ! Store now fields before applying the Asselin filter 139 139 ! in order to calculate Asselin filter trend later. 140 ztrdt(:,:,:) = ts n(:,:,:,jp_tem)141 ztrds(:,:,:) = ts n(:,:,:,jp_sal)140 ztrdt(:,:,:) = ts(:,:,:,jp_tem,Kmm) 141 ztrds(:,:,:) = ts(:,:,:,jp_sal,Kmm) 142 142 ENDIF 143 143 ENDIF … … 146 146 DO jn = 1, jpts 147 147 DO jk = 1, jpkm1 148 ts n(:,:,jk,jn) = tsa(:,:,jk,jn)148 ts(:,:,jk,jn,Kmm) = ts(:,:,jk,jn,Krhs) 149 149 END DO 150 150 END DO … … 159 159 ELSE ! Leap-Frog + Asselin filter time stepping 160 160 ! 161 IF( ln_linssh ) THEN ; CALL tra_nxt_fix( kt, nit000, 'TRA', tsb, tsn, tsa, jpts ) ! linear free surface 162 ELSE ; CALL tra_nxt_vvl( kt, Kmm, Krhs, nit000, rdt, 'TRA', tsb, tsn, tsa, & 163 & sbc_tsc, sbc_tsc_b, jpts ) ! non-linear free surface 164 ENDIF 165 ! 166 CALL lbc_lnk_multi( 'tranxt', tsb(:,:,:,jp_tem), 'T', 1., tsb(:,:,:,jp_sal), 'T', 1., & 167 & tsn(:,:,:,jp_tem), 'T', 1., tsn(:,:,:,jp_sal), 'T', 1., & 168 & tsa(:,:,:,jp_tem), 'T', 1., tsa(:,:,:,jp_sal), 'T', 1. ) 161 IF( ln_linssh ) THEN ; CALL tra_nxt_fix( kt, Kmm, nit000, 'TRA', & 162 & ts(:,:,:,:,Kbb), ts(:,:,:,:,Kmm), ts(:,:,:,:,Krhs), jpts ) ! linear free surface 163 ELSE ; CALL tra_nxt_vvl( kt, Kbb, Kmm, Krhs, nit000, rdt, 'TRA', & 164 & ts(:,:,:,:,Kbb), ts(:,:,:,:,Kmm), ts(:,:,:,:,Krhs), & 165 & sbc_tsc , sbc_tsc_b , jpts ) ! non-linear free surface 166 ENDIF 167 ! 168 CALL lbc_lnk_multi( 'tranxt', ts(:,:,:,jp_tem,Kbb) , 'T', 1., ts(:,:,:,jp_sal,Kbb) , 'T', 1., & 169 & ts(:,:,:,jp_tem,Kmm) , 'T', 1., ts(:,:,:,jp_sal,Kmm) , 'T', 1., & 170 & ts(:,:,:,jp_tem,Krhs), 'T', 1., ts(:,:,:,jp_sal,Krhs), 'T', 1. ) 169 171 ! 170 172 ENDIF … … 173 175 zfact = 1._wp / r2dt 174 176 DO jk = 1, jpkm1 175 ztrdt(:,:,jk) = ( ts b(:,:,jk,jp_tem) - ztrdt(:,:,jk) ) * zfact176 ztrds(:,:,jk) = ( ts b(:,:,jk,jp_sal) - ztrds(:,:,jk) ) * zfact177 ztrdt(:,:,jk) = ( ts(:,:,jk,jp_tem,Kbb) - ztrdt(:,:,jk) ) * zfact 178 ztrds(:,:,jk) = ( ts(:,:,jk,jp_sal,Kbb) - ztrds(:,:,jk) ) * zfact 177 179 END DO 178 180 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_atf, ztrdt ) … … 182 184 ! 183 185 ! ! control print 184 IF(ln_ctl) CALL prt_ctl( tab3d_1=ts n(:,:,:,jp_tem), clinfo1=' nxt - Tn: ', mask1=tmask, &185 & tab3d_2=ts n(:,:,:,jp_sal), clinfo2= ' Sn: ', mask2=tmask )186 IF(ln_ctl) CALL prt_ctl( tab3d_1=ts(:,:,:,jp_tem,Kmm), clinfo1=' nxt - Tn: ', mask1=tmask, & 187 & tab3d_2=ts(:,:,:,jp_sal,Kmm), clinfo2= ' Sn: ', mask2=tmask ) 186 188 ! 187 189 IF( ln_timing ) CALL timing_stop('tra_nxt') … … 190 192 191 193 192 SUBROUTINE tra_nxt_fix( kt, kit000, cdtype, ptb, ptn, pta, kjpt )194 SUBROUTINE tra_nxt_fix( kt, Kmm, kit000, cdtype, ptb, ptn, pta, kjpt ) 193 195 !!---------------------------------------------------------------------- 194 196 !! *** ROUTINE tra_nxt_fix *** … … 200 202 !! - swap tracer fields to prepare the next time_step. 201 203 !! 202 !! ** Action : - tsb & tsn ready for the next time step204 !! ** Action : - ptb & ptn ready for the next time step 203 205 !!---------------------------------------------------------------------- 204 206 INTEGER , INTENT(in ) :: kt ! ocean time-step index 207 INTEGER , INTENT(in ) :: Kmm ! time level index 205 208 INTEGER , INTENT(in ) :: kit000 ! first time step index 206 209 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) … … 239 242 240 243 241 SUBROUTINE tra_nxt_vvl( kt, K mm, Krhs, kit000, p2dt, cdtype, ptb, ptn, pta, psbc_tc, psbc_tc_b, kjpt )244 SUBROUTINE tra_nxt_vvl( kt, Kbb, Kmm, Krhs, kit000, p2dt, cdtype, ptb, ptn, pta, psbc_tc, psbc_tc_b, kjpt ) 242 245 !!---------------------------------------------------------------------- 243 246 !! *** ROUTINE tra_nxt_vvl *** … … 248 251 !! ** Method : - Apply a thickness weighted Asselin time filter on now fields. 249 252 !! - swap tracer fields to prepare the next time_step. 250 !! tb = ( e3t _n*tn + atfp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] )251 !! /( e3t _n + atfp*[ e3t_b - 2 e3t_n + e3t_a] )253 !! tb = ( e3t(Kmm)*tn + atfp*[ e3t(Kbb)*tb - 2 e3t(Kmm)*tn + e3t_a*ta ] ) 254 !! /( e3t(Kmm) + atfp*[ e3t(Kbb) - 2 e3t(Kmm) + e3t(Krhs) ] ) 252 255 !! tn = ta 253 256 !! 254 !! ** Action : - tsb & tsn ready for the next time step257 !! ** Action : - ptb & ptn ready for the next time step 255 258 !!---------------------------------------------------------------------- 256 259 INTEGER , INTENT(in ) :: kt ! ocean time-step index 257 INTEGER , INTENT(in ) :: K mm, Krhs ! time level indices260 INTEGER , INTENT(in ) :: Kbb, Kmm, Krhs ! time level indices 258 261 INTEGER , INTENT(in ) :: kit000 ! first time step index 259 262 REAL(wp) , INTENT(in ) :: p2dt ! time-step … … 300 303 DO jj = 2, jpjm1 301 304 DO ji = fs_2, fs_jpim1 302 ze3t_b = e3t _b(ji,jj,jk)303 ze3t_n = e3t _n(ji,jj,jk)304 ze3t_a = e3t _a(ji,jj,jk)305 ze3t_b = e3t(ji,jj,jk,Kbb) 306 ze3t_n = e3t(ji,jj,jk,Kmm) 307 ze3t_a = e3t(ji,jj,jk,Krhs) 305 308 ! ! tracer content at Before, now and after 306 309 ztc_b = ptb(ji,jj,jk,jn) * ze3t_b … … 323 326 IF( mikt(ji,jj) <=jk .and. jk <= nk_rnf(ji,jj) ) THEN 324 327 ze3t_f = ze3t_f - zfact2 * ( - (rnf_b(ji,jj) - rnf(ji,jj) ) ) & 325 & * ( e3t _n(ji,jj,jk) / h_rnf(ji,jj) )328 & * ( e3t(ji,jj,jk,Kmm) / h_rnf(ji,jj) ) 326 329 ENDIF 327 330 ELSE … … 339 342 IF( ll_rnf .AND. jk <= nk_rnf(ji,jj) ) & 340 343 & ztc_f = ztc_f - zfact1 * ( rnf_tsc(ji,jj,jn) - rnf_tsc_b(ji,jj,jn) ) & 341 & * e3t _n(ji,jj,jk) / h_rnf(ji,jj)344 & * e3t(ji,jj,jk,Kmm) / h_rnf(ji,jj) 342 345 ! 343 346 ! ice shelf … … 346 349 IF ( jk >= misfkt(ji,jj) .AND. jk < misfkb(ji,jj) ) & 347 350 ztc_f = ztc_f - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) ) & 348 & * e3t _n(ji,jj,jk) * r1_hisf_tbl (ji,jj)351 & * e3t(ji,jj,jk,Kmm) * r1_hisf_tbl (ji,jj) 349 352 ! level partially include in Losch_2008 ice shelf boundary layer 350 353 IF ( jk == misfkb(ji,jj) ) & 351 354 ztc_f = ztc_f - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) ) & 352 & * e3t _n(ji,jj,jk) * r1_hisf_tbl (ji,jj) * ralpha(ji,jj)355 & * e3t(ji,jj,jk,Kmm) * r1_hisf_tbl (ji,jj) * ralpha(ji,jj) 353 356 END IF 354 357 !
Note: See TracChangeset
for help on using the changeset viewer.
