- Timestamp:
- 2021-03-03T17:04:07+01:00 (3 years ago)
- Location:
- NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/TRA
- Files:
-
- 7 edited
-
traadv.F90 (modified) (4 diffs)
-
traatf.F90 (modified) (2 diffs)
-
traldf.F90 (modified) (1 diff)
-
traldf_iso.F90 (modified) (15 diffs)
-
traldf_lap_blp.F90 (modified) (1 diff)
-
traldf_triad.F90 (modified) (18 diffs)
-
tramle.F90 (modified) (15 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/TRA/traadv.F90
r14574 r14576 61 61 LOGICAL :: ln_traadv_qck ! QUICKEST scheme flag 62 62 63 INTEGER :: nadv ! choice of the type of advection scheme63 INTEGER, PUBLIC :: nadv ! choice of the type of advection scheme 64 64 ! ! associated indices: 65 INTEGER, PARAMETER :: np_NO_adv = 0 ! no T-S advection66 INTEGER, PARAMETER :: np_CEN = 1 ! 2nd/4th order centered scheme67 INTEGER, PARAMETER :: np_FCT = 2 ! 2nd/4th order Flux Corrected Transport scheme68 INTEGER, PARAMETER :: np_MUS = 3 ! MUSCL scheme69 INTEGER, PARAMETER :: np_UBS = 4 ! 3rd order Upstream Biased Scheme70 INTEGER, PARAMETER :: np_QCK = 5 ! QUICK scheme65 INTEGER, PARAMETER, PUBLIC :: np_NO_adv = 0 ! no T-S advection 66 INTEGER, PARAMETER, PUBLIC :: np_CEN = 1 ! 2nd/4th order centered scheme 67 INTEGER, PARAMETER, PUBLIC :: np_FCT = 2 ! 2nd/4th order Flux Corrected Transport scheme 68 INTEGER, PARAMETER, PUBLIC :: np_MUS = 3 ! MUSCL scheme 69 INTEGER, PARAMETER, PUBLIC :: np_UBS = 4 ! 3rd order Upstream Biased Scheme 70 INTEGER, PARAMETER, PUBLIC :: np_QCK = 5 ! QUICK scheme 71 71 72 72 !! * Substitutions … … 178 178 ! 179 179 CASE ( np_CEN ) ! Centered scheme : 2nd / 4th order 180 IF (nn_hls.EQ.2) CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kmm), 'T', 1. ) 180 ! [comm_cleanup] 181 ! IF (nn_hls.EQ.2) CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kmm), 'T', 1. ) 181 182 CALL tra_adv_cen ( kt, nit000, 'TRA', zuu, zvv, zww, Kmm, pts, jpts, Krhs, nn_cen_h, nn_cen_v ) 182 183 CASE ( np_FCT ) ! FCT scheme : 2nd / 4th order 183 184 IF (nn_hls.EQ.2) THEN 184 CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kbb), 'T', 1., pts(:,:,:,:,Kmm), 'T', 1.) 185 CALL lbc_lnk( 'traadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1., zww(:,:,:), 'W', 1.) 185 ! [comm_cleanup] - lbc_lnk shifted into step 186 ! CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kbb), 'T', 1., pts(:,:,:,:,Kmm), 'T', 1.) 187 ! CALL lbc_lnk( 'traadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1., zww(:,:,:), 'W', 1.) 186 188 #if defined key_loop_fusion 187 189 CALL tra_adv_fct_lf ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_fct_h, nn_fct_v ) … … 194 196 CASE ( np_MUS ) ! MUSCL 195 197 IF (nn_hls.EQ.2) THEN 196 CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kbb), 'T', 1.) 198 ! [comm_cleanup] - lbc_lnk shifted into step 199 ! CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kbb), 'T', 1.) 197 200 #if defined key_loop_fusion 198 201 CALL tra_adv_mus_lf ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, ln_mus_ups ) … … 204 207 END IF 205 208 CASE ( np_UBS ) ! UBS 206 IF (nn_hls.EQ.2) CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kbb), 'T', 1.) 209 ! [comm_cleanup] - lbc_lnk shifted into step 210 ! IF (nn_hls.EQ.2) CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kbb), 'T', 1.) 207 211 CALL tra_adv_ubs ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_ubs_v ) 208 212 CASE ( np_QCK ) ! QUICKEST 209 IF (nn_hls.EQ.2) THEN 210 CALL lbc_lnk( 'traadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1.) 211 CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kbb), 'T', 1.) 212 END IF 213 ! [comm_cleanup] - lbc_lnk shifted into step 214 ! IF (nn_hls.EQ.2) THEN 215 ! CALL lbc_lnk( 'traadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1.) 216 ! CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kbb), 'T', 1.) 217 ! END IF 213 218 CALL tra_adv_qck ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs ) 214 219 ! -
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/TRA/traatf.F90
r14574 r14576 110 110 #endif 111 111 ! ! local domain boundaries (T-point, unchanged sign) 112 CALL lbc_lnk( 'traatf', pts(:,:,:,jp_tem,Kaa), 'T', 1.0_wp, pts(:,:,:,jp_sal,Kaa), 'T', 1.0_wp ) 112 ! [comm_cleanup] ! lbc_lnk moved into stp 113 ! CALL lbc_lnk( 'traatf', pts(:,:,:,jp_tem,Kaa), 'T', 1.0_wp, pts(:,:,:,jp_sal,Kaa), 'T', 1.0_wp ) 113 114 ! 114 115 IF( ln_bdy ) CALL bdy_tra( kt, Kbb, pts, Kaa ) ! BDY open boundaries … … 156 157 ENDIF 157 158 ! 158 CALL lbc_lnk( 'traatf', pts(:,:,:,jp_tem,Kmm) , 'T', 1.0_wp, pts(:,:,:,jp_sal,Kmm) , 'T', 1.0_wp ) 159 ! [comm_cleanup] 160 ! CALL lbc_lnk( 'traatf', pts(:,:,:,jp_tem,Kmm) , 'T', 1.0_wp, pts(:,:,:,jp_sal,Kmm) , 'T', 1.0_wp ) 159 161 160 162 ENDIF -
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/TRA/traldf.F90
r14537 r14576 92 92 CALL tra_ldf_triad( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, pts(:,:,:,:,Kbb), pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts, 1 ) 93 93 CASE ( np_blp , np_blp_i , np_blp_it ) ! bilaplacian: iso-level & iso-neutral operators 94 IF(nn_hls.EQ.2) CALL lbc_lnk( 'tra_ldf', pts(:,:,:,:,Kbb), 'T',1.) 94 ! [comm_cleanup] 95 ! IF (nn_hls.EQ.2) CALL lbc_lnk( 'tra_ldf', pts(:,:,:,:,Kbb), 'T',1.) 95 96 CALL tra_ldf_blp ( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts, nldf_tra ) 96 97 END SELECT -
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/TRA/traldf_iso.F90
r14537 r14576 147 147 ENDIF 148 148 ! 149 DO_3D( 0, 0, 0, 0, 1, jpk ) 149 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpk ) 150 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk ) 150 151 akz (ji,jj,jk) = 0._wp 151 152 ah_wslp2(ji,jj,jk) = 0._wp … … 172 173 IF( kpass == 1 ) THEN !== first pass only ==! 173 174 ! 174 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 175 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 176 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 175 177 ! 176 178 zmsku = wmask(ji,jj,jk) / MAX( umask(ji ,jj,jk-1) + umask(ji-1,jj,jk) & … … 189 191 ! 190 192 IF( ln_traldf_msc ) THEN ! stabilizing vertical diffusivity coefficient 191 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 193 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 194 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 192 195 akz(ji,jj,jk) = 0.25_wp * ( & 193 196 & ( pahu(ji ,jj,jk) + pahu(ji ,jj,jk-1) ) / ( e1u(ji ,jj) * e1u(ji ,jj) ) & … … 198 201 ! 199 202 IF( ln_traldf_blp ) THEN ! bilaplacian operator 200 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 203 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 204 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 201 205 akz(ji,jj,jk) = 16._wp & 202 206 & * ah_wslp2 (ji,jj,jk) & … … 206 210 END_3D 207 211 ELSEIF( ln_traldf_lap ) THEN ! laplacian operator 208 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 212 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 213 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 209 214 ze3w_2 = e3w(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm) 210 215 zcoef0 = rDt * ( akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ze3w_2 ) … … 214 219 ! 215 220 ELSE ! 33 flux set to zero with akz=ah_wslp2 ==>> computed in full implicit 216 DO_3D( 0, 0, 0, 0, 1, jpk ) 221 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpk ) 222 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk ) 217 223 akz(ji,jj,jk) = ah_wslp2(ji,jj,jk) 218 224 END_3D … … 233 239 234 240 ! Horizontal tracer gradient 235 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 241 ! [comm_cleanup] ! DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 242 DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) 236 243 zdit(ji,jj,jk) = ( pt(ji+1,jj ,jk,jn) - pt(ji,jj,jk,jn) ) * umask(ji,jj,jk) 237 244 zdjt(ji,jj,jk) = ( pt(ji ,jj+1,jk,jn) - pt(ji,jj,jk,jn) ) * vmask(ji,jj,jk) 238 245 END_3D 239 246 IF( ln_zps ) THEN ! botton and surface ocean correction of the horizontal gradient 240 DO_2D( 1, 0, 1, 0 ) ! bottom correction (partial bottom cell) 247 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) ! bottom correction (partial bottom cell) 248 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) ! bottom correction (partial bottom cell) 241 249 zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn) 242 250 zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn) 243 251 END_2D 244 252 IF( ln_isfcav ) THEN ! first wet level beneath a cavity 245 DO_2D( 1, 0, 1, 0 ) 253 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 254 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 246 255 IF( miku(ji,jj) > 1 ) zdit(ji,jj,miku(ji,jj)) = pgui(ji,jj,jn) 247 256 IF( mikv(ji,jj) > 1 ) zdjt(ji,jj,mikv(ji,jj)) = pgvi(ji,jj,jn) … … 256 265 DO jk = 1, jpkm1 ! Horizontal slab 257 266 ! 258 DO_2D( 1, 1, 1, 1 ) 267 ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) 268 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 259 269 ! !== Vertical tracer gradient 260 270 zdk1t(ji,jj) = ( pt(ji,jj,jk,jn) - pt(ji,jj,jk+1,jn) ) * wmask(ji,jj,jk+1) ! level jk+1 … … 265 275 END_2D 266 276 ! 267 DO_2D( 1, 0, 1, 0 ) !== Horizontal fluxes 277 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) !== Horizontal fluxes 278 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) !== Horizontal fluxes 268 279 zabe1 = pahu(ji,jj,jk) * e2_e1u(ji,jj) * e3u(ji,jj,jk,Kmm) 269 280 zabe2 = pahv(ji,jj,jk) * e1_e2v(ji,jj) * e3v(ji,jj,jk,Kmm) … … 286 297 END_2D 287 298 ! 288 DO_2D( 0, 0, 0, 0 ) !== horizontal divergence and add to pta 299 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) !== horizontal divergence and add to pta 300 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) !== horizontal divergence and add to pta 289 301 pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) & 290 302 & + zsign * ( zftu(ji,jj,jk) - zftu(ji-1,jj,jk) + zftv(ji,jj,jk) - zftv(ji,jj-1,jk) ) & … … 302 314 ztfw(:,:, 1 ) = 0._wp ; ztfw(:,:,jpk) = 0._wp 303 315 304 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! interior (2=<jk=<jpk-1) 316 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! interior (2=<jk=<jpk-1) 317 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! interior (2=<jk=<jpk-1) 305 318 ! 306 319 zmsku = wmask(ji,jj,jk) / MAX( umask(ji ,jj,jk-1) + umask(ji-1,jj,jk) & … … 324 337 ! !== add the vertical 33 flux ==! 325 338 IF( ln_traldf_lap ) THEN ! laplacian case: eddy coef = ah_wslp2 - akz 326 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 339 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 340 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 327 341 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * wmask(ji,jj,jk) & 328 342 & * ( ah_wslp2(ji,jj,jk) - akz(ji,jj,jk) ) & … … 333 347 SELECT CASE( kpass ) 334 348 CASE( 1 ) ! 1st pass : eddy coef = ah_wslp2 335 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 349 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 350 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 336 351 ztfw(ji,jj,jk) = & 337 352 & ztfw(ji,jj,jk) + ah_wslp2(ji,jj,jk) * e1e2t(ji,jj) & … … 339 354 END_3D 340 355 CASE( 2 ) ! 2nd pass : eddy flux = ah_wslp2 and akz applied on pt and pt2 gradients, resp. 341 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 356 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 357 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 342 358 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * wmask(ji,jj,jk) & 343 359 & * ( ah_wslp2(ji,jj,jk) * ( pt (ji,jj,jk-1,jn) - pt (ji,jj,jk,jn) ) & … … 347 363 ENDIF 348 364 ! 349 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !== Divergence of vertical fluxes added to pta ==! 365 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !== Divergence of vertical fluxes added to pta ==! 366 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) !== Divergence of vertical fluxes added to pta ==! 350 367 pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) + zsign * ( ztfw (ji,jj,jk) - ztfw(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) & 351 368 & / e3t(ji,jj,jk,Kmm) -
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/TRA/traldf_lap_blp.F90
r14537 r14576 229 229 END SELECT 230 230 ! 231 CALL lbc_lnk( 'traldf_lap_blp', zlap(:,:,:,:) , 'T', 1.0_wp ) ! Lateral boundary conditions (unchanged sign) 231 ! [comm_cleanup] 232 IF (nn_hls.EQ.1) CALL lbc_lnk( 'traldf_lap_blp', zlap(:,:,:,:) , 'T', 1.0_wp ) ! Lateral boundary conditions (unchanged sign) 232 233 ! ! Partial top/bottom cell: GRADh( zlap ) 233 234 IF( ln_isfcav .AND. ln_zps ) THEN ; CALL zps_hde_isf( kt, Kmm, kjpt, zlap, zglu, zglv, zgui, zgvi ) ! both top & bottom -
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/TRA/traldf_triad.F90
r14537 r14576 152 152 IF( kpass == 1 ) THEN !== first pass only and whatever the tracer is ==! 153 153 ! 154 DO_3D( 0, 0, 0, 0, 1, jpk ) 154 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpk ) 155 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk ) 155 156 akz (ji,jj,jk) = 0._wp 156 157 ah_wslp2(ji,jj,jk) = 0._wp … … 159 160 DO ip = 0, 1 ! i-k triads 160 161 DO kp = 0, 1 161 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 162 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 163 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 162 164 ze3wr = 1._wp / e3w(ji,jj,jk+kp,Kmm) 163 165 zbu = e1e2u(ji-ip,jj) * e3u(ji-ip,jj,jk,Kmm) … … 177 179 DO jp = 0, 1 ! j-k triads 178 180 DO kp = 0, 1 179 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 181 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 182 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 180 183 ze3wr = 1.0_wp / e3w(ji,jj,jk+kp,Kmm) 181 184 zbv = e1e2v(ji,jj-jp) * e3v(ji,jj-jp,jk,Kmm) … … 197 200 ! 198 201 IF( ln_traldf_blp ) THEN ! bilaplacian operator 199 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 202 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 203 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 200 204 akz(ji,jj,jk) = 16._wp & 201 205 & * ah_wslp2 (ji,jj,jk) & … … 205 209 END_3D 206 210 ELSEIF( ln_traldf_lap ) THEN ! laplacian operator 207 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 211 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 212 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 208 213 ze3w_2 = e3w(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm) 209 214 zcoef0 = rDt * ( akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ze3w_2 ) … … 213 218 ! 214 219 ELSE ! 33 flux set to zero with akz=ah_wslp2 ==>> computed in full implicit 215 DO_3D( 0, 0, 0, 0, 1, jpk ) 220 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpk ) 221 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk ) 216 222 akz(ji,jj,jk) = ah_wslp2(ji,jj,jk) 217 223 END_3D … … 228 234 DO jp = 0, 1 229 235 DO kp = 0, 1 230 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 236 ! [comm_cleanup] ! DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 237 DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) 231 238 zpsi_uw(ji,jj,jk+kp) = zpsi_uw(ji,jj,jk+kp) & 232 239 & + 0.25_wp * aeiu(ji,jj,jk) * e2u(ji,jj) * triadi_g(ji+jp,jj,jk,1-jp,kp) … … 253 260 zftv(:,:,:) = 0._wp 254 261 ! 255 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) !== before lateral T & S gradients at T-level jk ==! 262 ! [comm_cleanup] ! DO_3D( 1, 0, 1, 0, 1, jpkm1 ) !== before lateral T & S gradients at T-level jk ==! 263 DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) 256 264 zdit(ji,jj,jk) = ( pt(ji+1,jj ,jk,jn) - pt(ji,jj,jk,jn) ) * umask(ji,jj,jk) 257 265 zdjt(ji,jj,jk) = ( pt(ji ,jj+1,jk,jn) - pt(ji,jj,jk,jn) ) * vmask(ji,jj,jk) 258 266 END_3D 259 267 IF( ln_zps .AND. l_grad_zps ) THEN ! partial steps: correction at top/bottom ocean level 260 DO_2D( 1, 0, 1, 0 ) ! bottom level 268 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) ! bottom level 269 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 261 270 zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn) 262 271 zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn) 263 272 END_2D 264 273 IF( ln_isfcav ) THEN ! top level (ocean cavities only) 265 DO_2D( 1, 0, 1, 0 ) 274 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 275 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 266 276 IF( miku(ji,jj) > 1 ) zdit(ji,jj,miku(ji,jj) ) = pgui(ji,jj,jn) 267 277 IF( mikv(ji,jj) > 1 ) zdjt(ji,jj,mikv(ji,jj) ) = pgvi(ji,jj,jn) … … 276 286 DO jk = 1, jpkm1 277 287 ! !== Vertical tracer gradient at level jk and jk+1 278 DO_2D( 1, 1, 1, 1 ) 288 ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) 289 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 279 290 zdkt3d(ji,jj,1) = ( pt(ji,jj,jk,jn) - pt(ji,jj,jk+1,jn) ) * tmask(ji,jj,jk+1) 280 291 END_2D … … 283 294 IF( jk == 1 ) THEN ; zdkt3d(:,:,0) = zdkt3d(:,:,1) 284 295 ELSE 285 DO_2D( 1, 1, 1, 1 ) 296 ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) 297 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 286 298 zdkt3d(ji,jj,0) = ( pt(ji,jj,jk-1,jn) - pt(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 287 299 END_2D … … 293 305 DO ip = 0, 1 !== Horizontal & vertical fluxes 294 306 DO kp = 0, 1 295 DO_2D( 1, 0, 1, 0 ) 307 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 308 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 296 309 ze1ur = r1_e1u(ji,jj) 297 310 zdxt = zdit(ji,jj,jk) * ze1ur … … 314 327 DO jp = 0, 1 315 328 DO kp = 0, 1 316 DO_2D( 1, 0, 1, 0 ) 329 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 330 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 317 331 ze2vr = r1_e2v(ji,jj) 318 332 zdyt = zdjt(ji,jj,jk) * ze2vr … … 336 350 DO ip = 0, 1 !== Horizontal & vertical fluxes 337 351 DO kp = 0, 1 338 DO_2D( 1, 0, 1, 0 ) 352 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 353 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 339 354 ze1ur = r1_e1u(ji,jj) 340 355 zdxt = zdit(ji,jj,jk) * ze1ur … … 357 372 DO jp = 0, 1 358 373 DO kp = 0, 1 359 DO_2D( 1, 0, 1, 0 ) 374 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 375 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 360 376 ze2vr = r1_e2v(ji,jj) 361 377 zdyt = zdjt(ji,jj,jk) * ze2vr … … 376 392 ENDIF 377 393 ! !== horizontal divergence and add to the general trend ==! 378 DO_2D( 0, 0, 0, 0 ) 394 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 395 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 379 396 pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) & 380 397 & + zsign * ( zftu(ji-1,jj ,jk) - zftu(ji,jj,jk) & … … 387 404 ! !== add the vertical 33 flux ==! 388 405 IF( ln_traldf_lap ) THEN ! laplacian case: eddy coef = ah_wslp2 - akz 389 DO_3D( 0, 0, 1, 0, 2, jpkm1 ) 406 ! [comm_cleanup] ! DO_3D( 0, 0, 1, 0, 2, jpkm1 ) 407 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 390 408 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk) & 391 409 & * ( ah_wslp2(ji,jj,jk) - akz(ji,jj,jk) ) & … … 395 413 SELECT CASE( kpass ) 396 414 CASE( 1 ) ! 1st pass : eddy coef = ah_wslp2 397 DO_3D( 0, 0, 1, 0, 2, jpkm1 ) 415 ! [comm_cleanup] ! DO_3D( 0, 0, 1, 0, 2, jpkm1 ) 416 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 398 417 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk) & 399 418 & * ah_wslp2(ji,jj,jk) * ( pt(ji,jj,jk-1,jn) - pt(ji,jj,jk,jn) ) 400 419 END_3D 401 420 CASE( 2 ) ! 2nd pass : eddy flux = ah_wslp2 and akz applied on pt and pt2 gradients, resp. 402 DO_3D( 0, 0, 1, 0, 2, jpkm1 ) 421 ! [comm_cleanup] ! DO_3D( 0, 0, 1, 0, 2, jpkm1 ) 422 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 403 423 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk) & 404 424 & * ( ah_wslp2(ji,jj,jk) * ( pt (ji,jj,jk-1,jn) - pt (ji,jj,jk,jn) ) & … … 408 428 ENDIF 409 429 ! 410 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !== Divergence of vertical fluxes added to pta ==! 430 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !== Divergence of vertical fluxes added to pta ==! 431 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 411 432 pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) & 412 433 & + zsign * ( ztfw(ji,jj,jk+1) - ztfw(ji,jj,jk) ) & -
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/TRA/tramle.F90
r14574 r14576 110 110 SELECT CASE( nn_mld_uv ) ! MLD at u- & v-pts 111 111 CASE ( 0 ) != min of the 2 neighbour MLDs 112 DO_2D( 1, 0, 1, 0 ) 112 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 113 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 113 114 zhu(ji,jj) = MIN( hmle(ji+1,jj), hmle(ji,jj) ) 114 115 zhv(ji,jj) = MIN( hmle(ji,jj+1), hmle(ji,jj) ) 115 116 END_2D 116 117 CASE ( 1 ) != average of the 2 neighbour MLDs 117 DO_2D( 1, 0, 1, 0 ) 118 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 119 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 118 120 zhu(ji,jj) = MAX( hmle(ji+1,jj), hmle(ji,jj) ) 119 121 zhv(ji,jj) = MAX( hmle(ji,jj+1), hmle(ji,jj) ) 120 122 END_2D 121 123 CASE ( 2 ) != max of the 2 neighbour MLDs 122 DO_2D( 1, 0, 1, 0 ) 124 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 125 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 123 126 zhu(ji,jj) = MAX( hmle(ji+1,jj), hmle(ji,jj) ) 124 127 zhv(ji,jj) = MAX( hmle(ji,jj+1), hmle(ji,jj) ) … … 126 129 END SELECT 127 130 IF( nn_mle == 0 ) THEN ! Fox-Kemper et al. 2010 formulation 128 DO_2D( 1, 0, 1, 0 ) 131 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 132 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 129 133 zpsim_u(ji,jj) = rn_ce * zhu(ji,jj) * zhu(ji,jj) * e2u(ji,jj) & 130 134 & * dbdx_mle(ji,jj) * MIN( 111.e3_wp , e1u(ji,jj) ) & … … 137 141 ! 138 142 ELSEIF( nn_mle == 1 ) THEN ! New formulation (Lf = 5km fo/ff with fo=Coriolis parameter at latitude rn_lat) 139 DO_2D( 1, 0, 1, 0 ) 143 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 144 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 140 145 zpsim_u(ji,jj) = rc_f * zhu(ji,jj) * zhu(ji,jj) * e2u(ji,jj) & 141 146 & * dbdx_mle(ji,jj) * MIN( 111.e3_wp , e1u(ji,jj) ) … … 149 154 ! !== MLD used for MLE ==! 150 155 ! ! compute from the 10m density to deal with the diurnal cycle 151 DO_2D( 1, 1, 1, 1 ) 156 ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) 157 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 152 158 inml_mle(ji,jj) = mbkt(ji,jj) + 1 ! init. to number of ocean w-level (T-level + 1) 153 159 END_2D 154 160 IF ( nla10 > 0 ) THEN ! avoid case where first level is thicker than 10m 155 DO_3DS( 1, 1, 1, 1, jpkm1, nlb10, -1 ) ! from the bottom to nlb10 (10m) 161 ! [comm_cleanup] ! DO_3DS( 1, 1, 1, 1, jpkm1, nlb10, -1 ) ! from the bottom to nlb10 (10m) 162 DO_3DS( nn_hls, nn_hls, nn_hls, nn_hls, jpkm1, nlb10, -1 ) ! from the bottom to nlb10 (10m) 156 163 IF( rhop(ji,jj,jk) > rhop(ji,jj,nla10) + rn_rho_c_mle ) inml_mle(ji,jj) = jk ! Mixed layer 157 164 END_3D … … 163 170 zbm (:,:) = 0._wp 164 171 zn2 (:,:) = 0._wp 165 DO_3D( 1, 1, 1, 1, 1, ikmax ) ! MLD and mean buoyancy and N2 over the mixed layer 172 ! [comm_cleanup] ! DO_3D( 1, 1, 1, 1, 1, ikmax ) ! MLD and mean buoyancy and N2 over the mixed layer 173 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, ikmax ) ! MLD and mean buoyancy and N2 over the mixed layer 166 174 zc = e3t(ji,jj,jk,Kmm) * REAL( MIN( MAX( 0, inml_mle(ji,jj)-jk ) , 1 ) ) ! zc being 0 outside the ML t-points 167 175 zmld(ji,jj) = zmld(ji,jj) + zc … … 172 180 SELECT CASE( nn_mld_uv ) ! MLD at u- & v-pts 173 181 CASE ( 0 ) != min of the 2 neighbour MLDs 174 DO_2D( 1, 0, 1, 0 ) 182 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 183 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 175 184 zhu(ji,jj) = MIN( zmld(ji+1,jj), zmld(ji,jj) ) 176 185 zhv(ji,jj) = MIN( zmld(ji,jj+1), zmld(ji,jj) ) 177 186 END_2D 178 187 CASE ( 1 ) != average of the 2 neighbour MLDs 179 DO_2D( 1, 0, 1, 0 ) 188 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 189 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 180 190 zhu(ji,jj) = ( zmld(ji+1,jj) + zmld(ji,jj) ) * 0.5_wp 181 191 zhv(ji,jj) = ( zmld(ji,jj+1) + zmld(ji,jj) ) * 0.5_wp 182 192 END_2D 183 193 CASE ( 2 ) != max of the 2 neighbour MLDs 184 DO_2D( 1, 0, 1, 0 ) 194 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 195 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 185 196 zhu(ji,jj) = MAX( zmld(ji+1,jj), zmld(ji,jj) ) 186 197 zhv(ji,jj) = MAX( zmld(ji,jj+1), zmld(ji,jj) ) … … 188 199 END SELECT 189 200 ! ! convert density into buoyancy 190 DO_2D( 1, 1, 1, 1 ) 201 ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) 202 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 191 203 zbm(ji,jj) = + grav * zbm(ji,jj) / MAX( e3t(ji,jj,1,Kmm), zmld(ji,jj) ) 192 204 END_2D … … 201 213 ! 202 214 IF( nn_mle == 0 ) THEN ! Fox-Kemper et al. 2010 formulation 203 DO_2D( 1, 0, 1, 0 ) 215 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 216 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 204 217 zpsim_u(ji,jj) = rn_ce * zhu(ji,jj) * zhu(ji,jj) * e2_e1u(ji,jj) & 205 218 & * ( zbm(ji+1,jj) - zbm(ji,jj) ) * MIN( 111.e3_wp , e1u(ji,jj) ) & … … 212 225 ! 213 226 ELSEIF( nn_mle == 1 ) THEN ! New formulation (Lf = 5km fo/ff with fo=Coriolis parameter at latitude rn_lat) 214 DO_2D( 1, 0, 1, 0 ) 227 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 228 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 215 229 zpsim_u(ji,jj) = rc_f * zhu(ji,jj) * zhu(ji,jj) * e2_e1u(ji,jj) & 216 230 & * ( zbm(ji+1,jj) - zbm(ji,jj) ) * MIN( 111.e3_wp , e1u(ji,jj) ) … … 222 236 ! 223 237 IF( nn_conv == 1 ) THEN ! No MLE in case of convection 224 DO_2D( 1, 0, 1, 0 ) 238 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 239 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 225 240 IF( MIN( zn2(ji,jj) , zn2(ji+1,jj) ) < 0._wp ) zpsim_u(ji,jj) = 0._wp 226 241 IF( MIN( zn2(ji,jj) , zn2(ji,jj+1) ) < 0._wp ) zpsim_v(ji,jj) = 0._wp … … 230 245 ENDIF ! end of ln_osm_mle conditional 231 246 ! !== structure function value at uw- and vw-points ==! 232 DO_2D( 1, 0, 1, 0 ) 247 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 248 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 233 249 zhu(ji,jj) = 1._wp / MAX(zhu(ji,jj), rsmall) ! hu --> 1/hu 234 250 zhv(ji,jj) = 1._wp / MAX(zhv(ji,jj), rsmall) … … 238 254 zpsi_vw(:,:,:) = 0._wp 239 255 ! 240 DO_3D( 1, 0, 1, 0, 2, ikmax ) ! start from 2 : surface value = 0 256 ! [comm_cleanup] ! DO_3D( 1, 0, 1, 0, 2, ikmax ) ! start from 2 : surface value = 0 257 DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 2, ikmax ) ! start from 2 : surface value = 0 258 241 259 zcuw = 1._wp - ( gdepw(ji+1,jj,jk,Kmm) + gdepw(ji,jj,jk,Kmm) ) * zhu(ji,jj) 242 260 zcvw = 1._wp - ( gdepw(ji,jj+1,jk,Kmm) + gdepw(ji,jj,jk,Kmm) ) * zhv(ji,jj) … … 252 270 ! !== transport increased by the MLE induced transport ==! 253 271 DO jk = 1, ikmax 254 DO_2D( 1, 0, 1, 0 ) ! CAUTION pu,pv must be defined at row/column i=1 / j=1 272 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) ! CAUTION pu,pv must be defined at row/column i=1 / j=1 273 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 255 274 pu(ji,jj,jk) = pu(ji,jj,jk) + ( zpsi_uw(ji,jj,jk) - zpsi_uw(ji,jj,jk+1) ) 256 275 pv(ji,jj,jk) = pv(ji,jj,jk) + ( zpsi_vw(ji,jj,jk) - zpsi_vw(ji,jj,jk+1) ) 257 276 END_2D 258 DO_2D( 0, 0, 0, 0 ) 277 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 278 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 259 279 pw(ji,jj,jk) = pw(ji,jj,jk) - ( zpsi_uw(ji,jj,jk) - zpsi_uw(ji-1,jj,jk) & 260 280 & + zpsi_vw(ji,jj,jk) - zpsi_vw(ji,jj-1,jk) ) * wmask(ji,jj,1) … … 270 290 ! 271 291 IF (ln_osm_mle.and.ln_zdfosm) THEN 272 DO_2D( 0, 0, 0, 0 ) 292 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 293 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 273 294 zLf_NH(ji,jj) = SQRT( rb_c * hmle(ji,jj) ) * r1_ft(ji,jj) ! Lf = N H / f 274 295 END_2D 275 296 ELSE 276 DO_2D( 0, 0, 0, 0 ) 297 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 298 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 277 299 zLf_NH(ji,jj) = SQRT( rb_c * zmld(ji,jj) ) * r1_ft(ji,jj) ! Lf = N H / f 278 300 END_2D … … 280 302 ! 281 303 ! divide by cross distance to give streamfunction with dimensions m^2/s 282 DO_3D( 0, 0, 0, 0, 1, ikmax+1 ) 304 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, ikmax+1 ) 305 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, ikmax+1 ) 283 306 zpsiu_mle(ji,jj,jk) = zpsi_uw(ji,jj,jk) * r1_e2u(ji,jj) 284 307 zpsiv_mle(ji,jj,jk) = zpsi_vw(ji,jj,jk) * r1_e1v(ji,jj)
Note: See TracChangeset
for help on using the changeset viewer.
