- Timestamp:
- 2020-09-24T20:49:07+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/trabbl.F90
r13295 r13518 26 26 USE oce ! ocean dynamics and active tracers 27 27 USE dom_oce ! ocean space and time domain 28 ! TEMP: This change not necessary after trd_tra is tiled 29 USE domain, ONLY : dom_tile 28 30 USE phycst ! physical constant 29 31 USE eosbn2 ! equation of state … … 106 108 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer equation 107 109 ! 108 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdt, ztrds 110 INTEGER :: ji, jj, jk ! Dummy loop indices 111 ! TEMP: This change not necessary after trd_tra is tiled 112 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ztrdt, ztrds 109 113 !!---------------------------------------------------------------------- 110 114 ! … … 112 116 ! 113 117 IF( l_trdtra ) THEN !* Save the T-S input trends 114 ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) ) 115 ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) 116 ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) 118 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 119 ! TEMP: This can be ST_2D(nn_hls) after trd_tra is tiled 120 ALLOCATE( ztrdt(jpi,jpj,jpk), ztrds(jpi,jpj,jpk) ) 121 ENDIF 122 123 DO_3D( 0, 0, 0, 0, 1, jpk ) 124 ztrdt(ji,jj,jk) = pts(ji,jj,jk,jp_tem,Krhs) 125 ztrds(ji,jj,jk) = pts(ji,jj,jk,jp_sal,Krhs) 126 END_3D 117 127 ENDIF 118 128 … … 125 135 CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' bbl_ldf - Ta: ', mask1=tmask, & 126 136 & tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 127 ! lateral boundary conditions ; just need for outputs 128 CALL lbc_lnk_multi( 'trabbl', ahu_bbl, 'U', 1.0_wp , ahv_bbl, 'V', 1.0_wp ) 129 CALL iom_put( "ahu_bbl", ahu_bbl ) ! bbl diffusive flux i-coef 130 CALL iom_put( "ahv_bbl", ahv_bbl ) ! bbl diffusive flux j-coef 137 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only on the last tile 138 ! lateral boundary conditions ; just need for outputs 139 CALL lbc_lnk_multi( 'trabbl', ahu_bbl, 'U', 1.0_wp , ahv_bbl, 'V', 1.0_wp ) 140 CALL iom_put( "ahu_bbl", ahu_bbl ) ! bbl diffusive flux i-coef 141 CALL iom_put( "ahv_bbl", ahv_bbl ) ! bbl diffusive flux j-coef 142 ENDIF 131 143 ! 132 144 ENDIF … … 136 148 CALL tra_bbl_adv( pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts, Kmm ) 137 149 IF(sn_cfctl%l_prtctl) & 138 CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' bbl_adv - Ta: ', mask1=tmask, 150 CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' bbl_adv - Ta: ', mask1=tmask, & 139 151 & tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 140 ! lateral boundary conditions ; just need for outputs 141 CALL lbc_lnk_multi( 'trabbl', utr_bbl, 'U', 1.0_wp , vtr_bbl, 'V', 1.0_wp ) 142 CALL iom_put( "uoce_bbl", utr_bbl ) ! bbl i-transport 143 CALL iom_put( "voce_bbl", vtr_bbl ) ! bbl j-transport 144 ! 145 ENDIF 146 152 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only on the last tile 153 ! lateral boundary conditions ; just need for outputs 154 CALL lbc_lnk_multi( 'trabbl', utr_bbl, 'U', 1.0_wp , vtr_bbl, 'V', 1.0_wp ) 155 CALL iom_put( "uoce_bbl", utr_bbl ) ! bbl i-transport 156 CALL iom_put( "voce_bbl", vtr_bbl ) ! bbl j-transport 157 ENDIF 158 ! 159 ENDIF 160 161 ! TEMP: These changes not necessary after trd_tra is tiled 147 162 IF( l_trdtra ) THEN ! send the trends for further diagnostics 148 ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:) 149 ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) - ztrds(:,:,:) 150 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_bbl, ztrdt ) 151 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_bbl, ztrds ) 152 DEALLOCATE( ztrdt, ztrds ) 163 DO_3D( 0, 0, 0, 0, 1, jpk ) 164 ztrdt(ji,jj,jk) = pts(ji,jj,jk,jp_tem,Krhs) - ztrdt(ji,jj,jk) 165 ztrds(ji,jj,jk) = pts(ji,jj,jk,jp_sal,Krhs) - ztrds(ji,jj,jk) 166 END_3D 167 168 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only for the full domain 169 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) ! Use full domain 170 171 ! TODO: TO BE TILED- trd_tra 172 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_bbl, ztrdt ) 173 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_bbl, ztrds ) 174 DEALLOCATE( ztrdt, ztrds ) 175 176 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = nijtile ) ! Revert to tile domain 177 ENDIF 153 178 ENDIF 154 179 ! … … 187 212 INTEGER :: ik ! local integers 188 213 REAL(wp) :: zbtr ! local scalars 189 REAL(wp), DIMENSION( jpi,jpj) :: zptb ! workspace214 REAL(wp), DIMENSION(ST_2D(nn_hls)) :: zptb ! workspace 190 215 !!---------------------------------------------------------------------- 191 216 ! … … 242 267 DO jn = 1, kjpt ! tracer loop 243 268 ! ! =========== 244 DO jj = 1, jpjm1 245 DO ji = 1, jpim1 ! CAUTION start from i=1 to update i=2 when cyclic east-west 246 IF( utr_bbl(ji,jj) /= 0.e0 ) THEN ! non-zero i-direction bbl advection 247 ! down-slope i/k-indices (deep) & up-slope i/k indices (shelf) 248 iid = ji + MAX( 0, mgrhu(ji,jj) ) ; iis = ji + 1 - MAX( 0, mgrhu(ji,jj) ) 249 ikud = mbku_d(ji,jj) ; ikus = mbku(ji,jj) 250 zu_bbl = ABS( utr_bbl(ji,jj) ) 251 ! 252 ! ! up -slope T-point (shelf bottom point) 253 zbtr = r1_e1e2t(iis,jj) / e3t(iis,jj,ikus,Kmm) 254 ztra = zu_bbl * ( pt(iid,jj,ikus,jn) - pt(iis,jj,ikus,jn) ) * zbtr 255 pt_rhs(iis,jj,ikus,jn) = pt_rhs(iis,jj,ikus,jn) + ztra 256 ! 257 DO jk = ikus, ikud-1 ! down-slope upper to down T-point (deep column) 258 zbtr = r1_e1e2t(iid,jj) / e3t(iid,jj,jk,Kmm) 259 ztra = zu_bbl * ( pt(iid,jj,jk+1,jn) - pt(iid,jj,jk,jn) ) * zbtr 260 pt_rhs(iid,jj,jk,jn) = pt_rhs(iid,jj,jk,jn) + ztra 261 END DO 262 ! 263 zbtr = r1_e1e2t(iid,jj) / e3t(iid,jj,ikud,Kmm) 264 ztra = zu_bbl * ( pt(iis,jj,ikus,jn) - pt(iid,jj,ikud,jn) ) * zbtr 265 pt_rhs(iid,jj,ikud,jn) = pt_rhs(iid,jj,ikud,jn) + ztra 266 ENDIF 267 ! 268 IF( vtr_bbl(ji,jj) /= 0.e0 ) THEN ! non-zero j-direction bbl advection 269 ! down-slope j/k-indices (deep) & up-slope j/k indices (shelf) 270 ijd = jj + MAX( 0, mgrhv(ji,jj) ) ; ijs = jj + 1 - MAX( 0, mgrhv(ji,jj) ) 271 ikvd = mbkv_d(ji,jj) ; ikvs = mbkv(ji,jj) 272 zv_bbl = ABS( vtr_bbl(ji,jj) ) 273 ! 274 ! up -slope T-point (shelf bottom point) 275 zbtr = r1_e1e2t(ji,ijs) / e3t(ji,ijs,ikvs,Kmm) 276 ztra = zv_bbl * ( pt(ji,ijd,ikvs,jn) - pt(ji,ijs,ikvs,jn) ) * zbtr 277 pt_rhs(ji,ijs,ikvs,jn) = pt_rhs(ji,ijs,ikvs,jn) + ztra 278 ! 279 DO jk = ikvs, ikvd-1 ! down-slope upper to down T-point (deep column) 280 zbtr = r1_e1e2t(ji,ijd) / e3t(ji,ijd,jk,Kmm) 281 ztra = zv_bbl * ( pt(ji,ijd,jk+1,jn) - pt(ji,ijd,jk,jn) ) * zbtr 282 pt_rhs(ji,ijd,jk,jn) = pt_rhs(ji,ijd,jk,jn) + ztra 283 END DO 284 ! ! down-slope T-point (deep bottom point) 285 zbtr = r1_e1e2t(ji,ijd) / e3t(ji,ijd,ikvd,Kmm) 286 ztra = zv_bbl * ( pt(ji,ijs,ikvs,jn) - pt(ji,ijd,ikvd,jn) ) * zbtr 287 pt_rhs(ji,ijd,ikvd,jn) = pt_rhs(ji,ijd,ikvd,jn) + ztra 288 ENDIF 289 END DO 269 DO_2D( 1, 0, 1, 0 ) ! CAUTION start from i=1 to update i=2 when cyclic east-west 270 IF( utr_bbl(ji,jj) /= 0.e0 ) THEN ! non-zero i-direction bbl advection 271 ! down-slope i/k-indices (deep) & up-slope i/k indices (shelf) 272 iid = ji + MAX( 0, mgrhu(ji,jj) ) ; iis = ji + 1 - MAX( 0, mgrhu(ji,jj) ) 273 ikud = mbku_d(ji,jj) ; ikus = mbku(ji,jj) 274 zu_bbl = ABS( utr_bbl(ji,jj) ) 275 ! 276 ! ! up -slope T-point (shelf bottom point) 277 zbtr = r1_e1e2t(iis,jj) / e3t(iis,jj,ikus,Kmm) 278 ztra = zu_bbl * ( pt(iid,jj,ikus,jn) - pt(iis,jj,ikus,jn) ) * zbtr 279 pt_rhs(iis,jj,ikus,jn) = pt_rhs(iis,jj,ikus,jn) + ztra 280 ! 281 DO jk = ikus, ikud-1 ! down-slope upper to down T-point (deep column) 282 zbtr = r1_e1e2t(iid,jj) / e3t(iid,jj,jk,Kmm) 283 ztra = zu_bbl * ( pt(iid,jj,jk+1,jn) - pt(iid,jj,jk,jn) ) * zbtr 284 pt_rhs(iid,jj,jk,jn) = pt_rhs(iid,jj,jk,jn) + ztra 285 END DO 286 ! 287 zbtr = r1_e1e2t(iid,jj) / e3t(iid,jj,ikud,Kmm) 288 ztra = zu_bbl * ( pt(iis,jj,ikus,jn) - pt(iid,jj,ikud,jn) ) * zbtr 289 pt_rhs(iid,jj,ikud,jn) = pt_rhs(iid,jj,ikud,jn) + ztra 290 ENDIF 290 291 ! 291 END DO 292 ! ! =========== 293 END DO ! end tracer 294 ! ! =========== 292 IF( vtr_bbl(ji,jj) /= 0.e0 ) THEN ! non-zero j-direction bbl advection 293 ! down-slope j/k-indices (deep) & up-slope j/k indices (shelf) 294 ijd = jj + MAX( 0, mgrhv(ji,jj) ) ; ijs = jj + 1 - MAX( 0, mgrhv(ji,jj) ) 295 ikvd = mbkv_d(ji,jj) ; ikvs = mbkv(ji,jj) 296 zv_bbl = ABS( vtr_bbl(ji,jj) ) 297 ! 298 ! up -slope T-point (shelf bottom point) 299 zbtr = r1_e1e2t(ji,ijs) / e3t(ji,ijs,ikvs,Kmm) 300 ztra = zv_bbl * ( pt(ji,ijd,ikvs,jn) - pt(ji,ijs,ikvs,jn) ) * zbtr 301 pt_rhs(ji,ijs,ikvs,jn) = pt_rhs(ji,ijs,ikvs,jn) + ztra 302 ! 303 DO jk = ikvs, ikvd-1 ! down-slope upper to down T-point (deep column) 304 zbtr = r1_e1e2t(ji,ijd) / e3t(ji,ijd,jk,Kmm) 305 ztra = zv_bbl * ( pt(ji,ijd,jk+1,jn) - pt(ji,ijd,jk,jn) ) * zbtr 306 pt_rhs(ji,ijd,jk,jn) = pt_rhs(ji,ijd,jk,jn) + ztra 307 END DO 308 ! ! down-slope T-point (deep bottom point) 309 zbtr = r1_e1e2t(ji,ijd) / e3t(ji,ijd,ikvd,Kmm) 310 ztra = zv_bbl * ( pt(ji,ijs,ikvs,jn) - pt(ji,ijd,ikvd,jn) ) * zbtr 311 pt_rhs(ji,ijd,ikvd,jn) = pt_rhs(ji,ijd,ikvd,jn) + ztra 312 ENDIF 313 END_2D 314 ! ! =========== 315 END DO ! end tracer 316 ! ! =========== 295 317 END SUBROUTINE tra_bbl_adv 296 318 … … 333 355 REAL(wp) :: za, zb, zgdrho ! local scalars 334 356 REAL(wp) :: zsign, zsigna, zgbbl ! - - 335 REAL(wp), DIMENSION(jpi,jpj,jpts) :: zts, zab ! 3D workspace 336 REAL(wp), DIMENSION(jpi,jpj) :: zub, zvb, zdep ! 2D workspace 337 !!---------------------------------------------------------------------- 338 ! 339 IF( kt == kit000 ) THEN 340 IF(lwp) WRITE(numout,*) 341 IF(lwp) WRITE(numout,*) 'trabbl:bbl : Compute bbl velocities and diffusive coefficients in ', cdtype 342 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 357 REAL(wp), DIMENSION(ST_2D(nn_hls),jpts) :: zts, zab ! 3D workspace 358 REAL(wp), DIMENSION(ST_2D(nn_hls)) :: zub, zvb, zdep ! 2D workspace 359 !!---------------------------------------------------------------------- 360 ! 361 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 362 IF( kt == kit000 ) THEN 363 IF(lwp) WRITE(numout,*) 364 IF(lwp) WRITE(numout,*) 'trabbl:bbl : Compute bbl velocities and diffusive coefficients in ', cdtype 365 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 366 ENDIF 343 367 ENDIF 344 368 ! !* bottom variables (T, S, alpha, beta, depth, velocity)
Note: See TracChangeset
for help on using the changeset viewer.
