Changeset 14017 for NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/TRA/traatf.F90
- Timestamp:
- 2020-12-02T16:32:24+01:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/TRA/traatf.F90
r13295 r14017 26 26 !!---------------------------------------------------------------------- 27 27 USE oce ! ocean dynamics and tracers variables 28 USE dom_oce ! ocean space and time domain variables 28 USE dom_oce ! ocean space and time domain variables 29 29 USE sbc_oce ! surface boundary condition: ocean 30 30 USE sbcrnf ! river runoffs … … 33 33 USE domvvl ! variable volume 34 34 USE trd_oce ! trends: ocean variables 35 USE trdtra ! trends manager: tracers 35 USE trdtra ! trends manager: tracers 36 36 USE traqsr ! penetrative solar radiation (needed for nksr) 37 37 USE phycst ! physical constant … … 70 70 !! *** ROUTINE traatf *** 71 71 !! 72 !! ** Purpose : Apply the boundary condition on the after temperature 72 !! ** Purpose : Apply the boundary condition on the after temperature 73 73 !! and salinity fields and add the Asselin time filter on now fields. 74 !! 75 !! ** Method : At this stage of the computation, ta and sa are the 74 !! 75 !! ** Method : At this stage of the computation, ta and sa are the 76 76 !! after temperature and salinity as the time stepping has 77 77 !! been performed in trazdf_imp or trazdf_exp module. 78 78 !! 79 !! - Apply lateral boundary conditions on (ta,sa) 80 !! at the local domain boundaries through lbc_lnk call, 81 !! at the one-way open boundaries (ln_bdy=T), 79 !! - Apply lateral boundary conditions on (ta,sa) 80 !! at the local domain boundaries through lbc_lnk call, 81 !! at the one-way open boundaries (ln_bdy=T), 82 82 !! at the AGRIF zoom boundaries (lk_agrif=T) 83 83 !! … … 89 89 INTEGER , INTENT(in ) :: kt ! ocean time-step index 90 90 INTEGER , INTENT(in ) :: Kbb, Kmm, Kaa ! time level indices 91 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers 91 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers 92 92 !! 93 93 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 105 105 106 106 ! Update after tracer on domain lateral boundaries 107 ! 107 ! 108 108 #if defined key_agrif 109 109 CALL Agrif_tra ! AGRIF zoom boundaries … … 113 113 ! 114 114 IF( ln_bdy ) CALL bdy_tra( kt, Kbb, pts, Kaa ) ! BDY open boundaries 115 115 116 116 ! trends computation initialisation 117 IF( l_trdtra ) THEN 117 IF( l_trdtra ) THEN 118 118 ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) ) 119 119 ztrdt(:,:,jpk) = 0._wp 120 120 ztrds(:,:,jpk) = 0._wp 121 IF( ln_traldf_iso ) THEN ! diagnose the "pure" Kz diffusive trend 121 IF( ln_traldf_iso ) THEN ! diagnose the "pure" Kz diffusive trend 122 122 CALL trd_tra( kt, Kmm, Kaa, 'TRA', jp_tem, jptra_zdfp, ztrdt ) 123 123 CALL trd_tra( kt, Kmm, Kaa, 'TRA', jp_sal, jptra_zdfp, ztrds ) 124 124 ENDIF 125 ! total trend for the non-time-filtered variables. 125 ! total trend for the non-time-filtered variables. 126 126 zfact = 1.0 / rn_Dt 127 127 ! G Nurser 23 Mar 2017. Recalculate trend as Delta(e3t*T)/e3tn; e3tn cancel from pts(Kmm) terms … … 133 133 CALL trd_tra( kt, Kmm, Kaa, 'TRA', jp_sal, jptra_tot, ztrds ) 134 134 IF( ln_linssh ) THEN ! linear sea surface height only 135 ! Store now fields before applying the Asselin filter 135 ! Store now fields before applying the Asselin filter 136 136 ! in order to calculate Asselin filter trend later. 137 ztrdt(:,:,:) = pts(:,:,:,jp_tem,Kmm) 137 ztrdt(:,:,:) = pts(:,:,:,jp_tem,Kmm) 138 138 ztrds(:,:,:) = pts(:,:,:,jp_sal,Kmm) 139 139 ENDIF 140 140 ENDIF 141 141 142 IF( l_1st_euler ) THEN ! Euler time-stepping 142 IF( l_1st_euler ) THEN ! Euler time-stepping 143 143 ! 144 144 IF (l_trdtra .AND. .NOT. ln_linssh ) THEN ! Zero Asselin filter contribution must be explicitly written out since for vvl … … 152 152 ELSE ! Leap-Frog + Asselin filter time stepping 153 153 ! 154 IF( ln_linssh ) THEN ; CALL tra_atf_fix( kt, Kbb, Kmm, Kaa, nit000, 'TRA', pts, jpts ) ! linear free surface 154 IF( ln_linssh ) THEN ; CALL tra_atf_fix( kt, Kbb, Kmm, Kaa, nit000, 'TRA', pts, jpts ) ! linear free surface 155 155 ELSE ; CALL tra_atf_vvl( kt, Kbb, Kmm, Kaa, nit000, rn_Dt, 'TRA', pts, sbc_tsc, sbc_tsc_b, jpts ) ! non-linear free surface 156 156 ENDIF 157 157 ! 158 CALL lbc_lnk_multi( 'traatf', pts(:,:,:,jp_tem,Kbb) , 'T', 1.0_wp, pts(:,:,:,jp_sal,Kbb) , 'T', 1.0_wp, & 159 & pts(:,:,:,jp_tem,Kmm) , 'T', 1.0_wp, pts(:,:,:,jp_sal,Kmm) , 'T', 1.0_wp, & 160 & pts(:,:,:,jp_tem,Kaa), 'T', 1.0_wp, pts(:,:,:,jp_sal,Kaa), 'T', 1.0_wp ) 161 ! 162 ENDIF 163 ! 164 IF( l_trdtra .AND. ln_linssh ) THEN ! trend of the Asselin filter (tb filtered - tb)/dt 158 CALL lbc_lnk_multi( 'traatf', pts(:,:,:,jp_tem,Kmm) , 'T', 1.0_wp, pts(:,:,:,jp_sal,Kmm) , 'T', 1.0_wp ) 159 160 ENDIF 161 ! 162 IF( l_trdtra .AND. ln_linssh ) THEN ! trend of the Asselin filter (tb filtered - tb)/dt 165 163 DO jk = 1, jpkm1 166 164 ztrdt(:,:,jk) = ( pts(:,:,jk,jp_tem,Kmm) - ztrdt(:,:,jk) ) * r1_Dt … … 186 184 !! 187 185 !! ** Purpose : fixed volume: apply the Asselin time filter to the "now" field 188 !! 186 !! 189 187 !! ** Method : - Apply a Asselin time filter on now fields. 190 188 !! … … 210 208 DO jn = 1, kjpt 211 209 ! 212 DO_3D( 0, 0, 0, 0, 1, jpkm1 )213 ztn = pt(ji,jj,jk,jn,Kmm) 210 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 211 ztn = pt(ji,jj,jk,jn,Kmm) 214 212 ztd = pt(ji,jj,jk,jn,Kaa) - 2._wp * ztn + pt(ji,jj,jk,jn,Kbb) ! time laplacian on tracers 215 213 ! … … 226 224 !! *** ROUTINE tra_atf_vvl *** 227 225 !! 228 !! ** Purpose : Time varying volume: apply the Asselin time filter 229 !! 226 !! ** Purpose : Time varying volume: apply the Asselin time filter 227 !! 230 228 !! ** Method : - Apply a thickness weighted Asselin time filter on now fields. 231 229 !! pt(Kmm) = ( e3t_Kmm*pt(Kmm) + rn_atfp*[ e3t_Kbb*pt(Kbb) - 2 e3t_Kmm*pt(Kmm) + e3t_Kaa*pt(Kaa) ] ) … … 257 255 ENDIF 258 256 ! 259 IF( cdtype == 'TRA' ) THEN 257 IF( cdtype == 'TRA' ) THEN 260 258 ll_traqsr = ln_traqsr ! active tracers case and solar penetration 261 259 ll_rnf = ln_rnf ! active tracers case and river runoffs … … 263 261 ELSE ! passive tracers case 264 262 ll_traqsr = .FALSE. ! NO solar penetration 265 ll_rnf = .FALSE. ! NO river runoffs ???? !!gm BUG ? 266 ll_isf = .FALSE. ! NO ice shelf melting/freezing !!gm BUG ?? 263 ll_rnf = .FALSE. ! NO river runoffs ???? !!gm BUG ? 264 ll_isf = .FALSE. ! NO ice shelf melting/freezing !!gm BUG ?? 267 265 ENDIF 268 266 ! … … 274 272 zfact1 = rn_atfp * p2dt 275 273 zfact2 = zfact1 * r1_rho0 276 DO jn = 1, kjpt 277 DO_3D( 0, 0, 0, 0, 1, jpkm1 )274 DO jn = 1, kjpt 275 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 278 276 ze3t_b = e3t(ji,jj,jk,Kbb) 279 277 ze3t_n = e3t(ji,jj,jk,Kmm) … … 291 289 ! 292 290 ! Add asselin correction on scale factors: 293 zscale = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kmm) / ( ht(ji,jj) + 1._wp - ssmask(ji,jj) ) 294 ze3t_f = ze3t_f - zfact2 * zscale * ( emp_b(ji,jj) - emp(ji,jj) ) 295 IF ( ll_rnf ) ze3t_f = ze3t_f + zfact2 * zscale * ( rnf_b(ji,jj) - rnf(ji,jj) ) 291 zscale = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kmm) / ( ht(ji,jj) + 1._wp - ssmask(ji,jj) ) 292 ze3t_f = ze3t_f - zfact2 * zscale * ( emp_b(ji,jj) - emp(ji,jj) ) 293 IF ( ll_rnf ) ze3t_f = ze3t_f + zfact2 * zscale * ( rnf_b(ji,jj) - rnf(ji,jj) ) 296 294 IF ( ll_isf ) THEN 297 295 IF ( ln_isfcav_mlt ) ze3t_f = ze3t_f - zfact2 * zscale * ( fwfisf_cav_b(ji,jj) - fwfisf_cav(ji,jj) ) … … 299 297 ENDIF 300 298 ! 301 IF( jk == mikt(ji,jj) ) THEN ! first level 299 IF( jk == mikt(ji,jj) ) THEN ! first level 302 300 ztc_f = ztc_f - zfact1 * ( psbc_tc(ji,jj,jn) - psbc_tc_b(ji,jj,jn) ) 303 301 ENDIF 304 302 ! 305 303 ! solar penetration (temperature only) 306 IF( ll_traqsr .AND. jn == jp_tem .AND. jk <= nksr ) & 307 & ztc_f = ztc_f - zfact1 * ( qsr_hc(ji,jj,jk) - qsr_hc_b(ji,jj,jk) ) 304 IF( ll_traqsr .AND. jn == jp_tem .AND. jk <= nksr ) & 305 & ztc_f = ztc_f - zfact1 * ( qsr_hc(ji,jj,jk) - qsr_hc_b(ji,jj,jk) ) 308 306 ! 309 307 ! 310 308 IF( ll_rnf .AND. jk <= nk_rnf(ji,jj) ) & 311 & ztc_f = ztc_f - zfact1 * ( rnf_tsc(ji,jj,jn) - rnf_tsc_b(ji,jj,jn) ) & 309 & ztc_f = ztc_f - zfact1 * ( rnf_tsc(ji,jj,jn) - rnf_tsc_b(ji,jj,jn) ) & 312 310 & * e3t(ji,jj,jk,Kmm) / h_rnf(ji,jj) 313 311 … … 323 321 & * e3t(ji,jj,jk,Kmm) / rhisf_tbl_cav(ji,jj) 324 322 END IF 325 ! level partially include in Losch_2008 ice shelf boundary layer 323 ! level partially include in Losch_2008 ice shelf boundary layer 326 324 IF ( jk == misfkb_cav(ji,jj) ) THEN 327 325 ztc_f = ztc_f - zfact1 * ( risf_cav_tsc(ji,jj,jn) - risf_cav_tsc_b(ji,jj,jn) ) & … … 337 335 & * e3t(ji,jj,jk,Kmm) / rhisf_tbl_par(ji,jj) 338 336 END IF 339 ! level partially include in Losch_2008 ice shelf boundary layer 337 ! level partially include in Losch_2008 ice shelf boundary layer 340 338 IF ( jk == misfkb_par(ji,jj) ) THEN 341 339 ztc_f = ztc_f - zfact1 * ( risf_par_tsc(ji,jj,jn) - risf_par_tsc_b(ji,jj,jn) ) & … … 366 364 ! 367 365 END_3D 368 ! 366 ! 369 367 END DO 370 368 ! 371 369 IF( ( l_trdtra .AND. cdtype == 'TRA' ) .OR. ( l_trdtrc .AND. cdtype == 'TRC' ) ) THEN 372 IF( l_trdtra .AND. cdtype == 'TRA' ) THEN 370 IF( l_trdtra .AND. cdtype == 'TRA' ) THEN 373 371 CALL trd_tra( kt, Kmm, Kaa, cdtype, jp_tem, jptra_atf, ztrd_atf(:,:,:,jp_tem) ) 374 372 CALL trd_tra( kt, Kmm, Kaa, cdtype, jp_sal, jptra_atf, ztrd_atf(:,:,:,jp_sal) )
Note: See TracChangeset
for help on using the changeset viewer.
