Changeset 12766 for NEMO/branches/UKMO/dev_r12745_HPC-02_Daley_Tiling_trial_structure/src/OCE/TRA/traldf_iso.F90
- Timestamp:
- 2020-04-17T14:54:46+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/UKMO/dev_r12745_HPC-02_Daley_Tiling_trial_structure/src/OCE/TRA/traldf_iso.F90
r12489 r12766 36 36 PUBLIC tra_ldf_iso ! routine called by step.F90 37 37 38 LOGICAL :: l_ptr ! flag to compute poleward transport39 LOGICAL :: l_hst ! flag to compute heat transport40 41 38 !! * Substitutions 42 39 # include "do_loop_substitute.h90" … … 48 45 CONTAINS 49 46 50 SUBROUTINE tra_ldf_iso( kt , Kmm, kit000, cdtype, pahu, pahv, &47 SUBROUTINE tra_ldf_iso( ktile, kt, Kmm, kit000, cdtype, pahu, pahv, & 51 48 & pgu , pgv , pgui, pgvi, & 52 49 & pt , pt2 , pt_rhs , kjpt , kpass ) … … 91 88 !! ** Action : Update pt_rhs arrays with the before rotated diffusion 92 89 !!---------------------------------------------------------------------- 90 TYPE(TILE) , INTENT(in ) :: ktile ! Tile indices 93 91 INTEGER , INTENT(in ) :: kt ! ocean time-step index 94 92 INTEGER , INTENT(in ) :: kit000 ! first time step index … … 104 102 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pt_rhs ! tracer trend 105 103 ! 104 LOGICAL :: l_ptr ! flag to compute poleward transport 105 LOGICAL :: l_hst ! flag to compute heat transport 106 106 INTEGER :: ji, jj, jk, jn ! dummy loop indices 107 107 INTEGER :: ikt … … 110 110 REAL(wp) :: zmskv, zahv_w, zabe2, zcof2, zcoef4 ! - - 111 111 REAL(wp) :: zcoef0, ze3w_2, zsign ! - - 112 REAL(wp), DIMENSION( jpi,jpj) :: zdkt, zdk1t, z2d113 REAL(wp), DIMENSION( jpi,jpj,jpk) :: zdit, zdjt, zftu, zftv, ztfw112 REAL(wp), DIMENSION(IND_2D) :: zdkt, zdk1t, z2d 113 REAL(wp), DIMENSION(IND_2D,jpk) :: zdit, zdjt, zftu, zftv, ztfw 114 114 !!---------------------------------------------------------------------- 115 115 ! 116 116 IF( kpass == 1 .AND. kt == kit000 ) THEN 117 IF(lwp) WRITE(numout,*) 118 IF(lwp) WRITE(numout,*) 'tra_ldf_iso : rotated laplacian diffusion operator on ', cdtype 119 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 120 ! 121 akz (:,:,:) = 0._wp 122 ah_wslp2(:,:,:) = 0._wp 117 IF( ktile % ntile == 1 ) THEN ! Do only on the first tile 118 ! TODO: TO BE TILED 119 IF(lwp) WRITE(numout,*) 120 IF(lwp) WRITE(numout,*) 'tra_ldf_iso : rotated laplacian diffusion operator on ', cdtype 121 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 122 ENDIF 123 ! 124 DO_3D_11_11_T( 1, jpk ) 125 akz (ji,jj,jk) = 0._wp 126 ah_wslp2(ji,jj,jk) = 0._wp 127 END_3D 123 128 ENDIF 124 129 ! … … 140 145 IF( kpass == 1 ) THEN !== first pass only ==! 141 146 ! 142 DO_3D_00_00 ( 2, jpkm1 )147 DO_3D_00_00_T( 2, jpkm1 ) 143 148 ! 144 149 zmsku = wmask(ji,jj,jk) / MAX( umask(ji ,jj,jk-1) + umask(ji-1,jj,jk) & … … 157 162 ! 158 163 IF( ln_traldf_msc ) THEN ! stabilizing vertical diffusivity coefficient 159 DO_3D_00_00 ( 2, jpkm1 )164 DO_3D_00_00_T( 2, jpkm1 ) 160 165 akz(ji,jj,jk) = 0.25_wp * ( & 161 166 & ( pahu(ji ,jj,jk) + pahu(ji ,jj,jk-1) ) / ( e1u(ji ,jj) * e1u(ji ,jj) ) & … … 166 171 ! 167 172 IF( ln_traldf_blp ) THEN ! bilaplacian operator 168 DO_3D_10_10 ( 2, jpkm1 )173 DO_3D_10_10_T( 2, jpkm1 ) 169 174 akz(ji,jj,jk) = 16._wp * ah_wslp2(ji,jj,jk) & 170 175 & * ( akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ( e3w(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm) ) ) 171 176 END_3D 172 177 ELSEIF( ln_traldf_lap ) THEN ! laplacian operator 173 DO_3D_10_10 ( 2, jpkm1 )178 DO_3D_10_10_T( 2, jpkm1 ) 174 179 ze3w_2 = e3w(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm) 175 180 zcoef0 = rDt * ( akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ze3w_2 ) … … 179 184 ! 180 185 ELSE ! 33 flux set to zero with akz=ah_wslp2 ==>> computed in full implicit 181 akz(:,:,:) = ah_wslp2(:,:,:) 186 DO_3D_11_11_T( 1, jpk ) 187 akz(ji,jj,jk) = ah_wslp2(ji,jj,jk) 188 END_3D 182 189 ENDIF 183 190 ENDIF … … 196 203 197 204 ! Horizontal tracer gradient 198 DO_3D_10_10 ( 1, jpkm1 )205 DO_3D_10_10_T( 1, jpkm1 ) 199 206 zdit(ji,jj,jk) = ( pt(ji+1,jj ,jk,jn) - pt(ji,jj,jk,jn) ) * umask(ji,jj,jk) 200 207 zdjt(ji,jj,jk) = ( pt(ji ,jj+1,jk,jn) - pt(ji,jj,jk,jn) ) * vmask(ji,jj,jk) 201 208 END_3D 202 209 IF( ln_zps ) THEN ! botton and surface ocean correction of the horizontal gradient 203 DO_2D_10_10 210 DO_2D_10_10_T 204 211 zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn) 205 212 zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn) 206 213 END_2D 207 214 IF( ln_isfcav ) THEN ! first wet level beneath a cavity 208 DO_2D_10_10 215 DO_2D_10_10_T 209 216 IF( miku(ji,jj) > 1 ) zdit(ji,jj,miku(ji,jj)) = pgui(ji,jj,jn) 210 217 IF( mikv(ji,jj) > 1 ) zdjt(ji,jj,mikv(ji,jj)) = pgvi(ji,jj,jn) … … 219 226 DO jk = 1, jpkm1 ! Horizontal slab 220 227 ! 221 ! !== Vertical tracer gradient 222 zdk1t(:,:) = ( pt(:,:,jk,jn) - pt(:,:,jk+1,jn) ) * wmask(:,:,jk+1) ! level jk+1 223 ! 224 IF( jk == 1 ) THEN ; zdkt(:,:) = zdk1t(:,:) ! surface: zdkt(jk=1)=zdkt(jk=2) 225 ELSE ; zdkt(:,:) = ( pt(:,:,jk-1,jn) - pt(:,:,jk,jn) ) * wmask(:,:,jk) 226 ENDIF 227 DO_2D_10_10 228 DO_2D_11_11_T 229 ! !== Vertical tracer gradient 230 zdk1t(ji,jj) = ( pt(ji,jj,jk,jn) - pt(ji,jj,jk+1,jn) ) * wmask(ji,jj,jk+1) ! level jk+1 231 ! 232 IF( jk == 1 ) THEN ; zdkt(ji,jj) = zdk1t(ji,jj) ! surface: zdkt(jk=1)=zdkt(jk=2) 233 ELSE ; zdkt(ji,jj) = ( pt(ji,jj,jk-1,jn) - pt(ji,jj,jk,jn) ) * wmask(ji,jj,jk) 234 ENDIF 235 END_2D 236 ! 237 DO_2D_10_10_T 228 238 zabe1 = pahu(ji,jj,jk) * e2_e1u(ji,jj) * e3u(ji,jj,jk,Kmm) 229 239 zabe2 = pahv(ji,jj,jk) * e1_e2v(ji,jj) * e3v(ji,jj,jk,Kmm) … … 246 256 END_2D 247 257 ! 248 DO_2D_00_00 258 DO_2D_00_00_T 249 259 pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) + zsign * ( zftu(ji,jj,jk) - zftu(ji-1,jj,jk) & 250 260 & + zftv(ji,jj,jk) - zftv(ji,jj-1,jk) ) & … … 262 272 ztfw(:,:, 1 ) = 0._wp ; ztfw(:,:,jpk) = 0._wp 263 273 264 DO_3D_00_00 ( 2, jpkm1 )274 DO_3D_00_00_T( 2, jpkm1 ) 265 275 ! 266 276 zmsku = wmask(ji,jj,jk) / MAX( umask(ji ,jj,jk-1) + umask(ji-1,jj,jk) & … … 284 294 ! !== add the vertical 33 flux ==! 285 295 IF( ln_traldf_lap ) THEN ! laplacian case: eddy coef = ah_wslp2 - akz 286 DO_3D_00_00 ( 2, jpkm1 )296 DO_3D_00_00_T( 2, jpkm1 ) 287 297 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * wmask(ji,jj,jk) & 288 298 & * ( ah_wslp2(ji,jj,jk) - akz(ji,jj,jk) ) & … … 293 303 SELECT CASE( kpass ) 294 304 CASE( 1 ) ! 1st pass : eddy coef = ah_wslp2 295 DO_3D_00_00 ( 2, jpkm1 )305 DO_3D_00_00_T( 2, jpkm1 ) 296 306 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) & 297 307 & + ah_wslp2(ji,jj,jk) * e1e2t(ji,jj) & … … 299 309 END_3D 300 310 CASE( 2 ) ! 2nd pass : eddy flux = ah_wslp2 and akz applied on pt and pt2 gradients, resp. 301 DO_3D_00_00 ( 2, jpkm1 )311 DO_3D_00_00_T( 2, jpkm1 ) 302 312 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * wmask(ji,jj,jk) & 303 313 & * ( ah_wslp2(ji,jj,jk) * ( pt (ji,jj,jk-1,jn) - pt (ji,jj,jk,jn) ) & … … 307 317 ENDIF 308 318 ! 309 DO_3D_00_00 ( 1, jpkm1 )319 DO_3D_00_00_T( 1, jpkm1 ) 310 320 pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) + zsign * ( ztfw (ji,jj,jk) - ztfw(ji,jj,jk+1) ) & 311 321 & * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 312 322 END_3D 313 323 ! 314 IF( ( kpass == 1 .AND. ln_traldf_lap ) .OR. & !== first pass only ( laplacian) ==! 315 ( kpass == 2 .AND. ln_traldf_blp ) ) THEN !== 2nd pass (bilaplacian) ==! 316 ! 317 ! ! "Poleward" diffusive heat or salt transports (T-S case only) 318 ! note sign is reversed to give down-gradient diffusive transports ) 319 IF( l_ptr ) CALL dia_ptr_hst( jn, 'ldf', -zftv(:,:,:) ) 320 ! ! Diffusive heat transports 321 IF( l_hst ) CALL dia_ar5_hst( jn, 'ldf', -zftu(:,:,:), -zftv(:,:,:) ) 322 ! 323 ENDIF !== end pass selection ==! 324 IF( ktile % ntile == jpnijtile ) THEN ! Do only after all tiles finish 325 IF( ( kpass == 1 .AND. ln_traldf_lap ) .OR. & !== first pass only ( laplacian) ==! 326 ( kpass == 2 .AND. ln_traldf_blp ) ) THEN !== 2nd pass (bilaplacian) ==! 327 ! 328 ! ! "Poleward" diffusive heat or salt transports (T-S case only) 329 ! note sign is reversed to give down-gradient diffusive transports ) 330 ! TODO: TO BE TILED 331 IF( l_ptr ) CALL dia_ptr_hst( jn, 'ldf', -zftv(:,:,:) ) 332 ! ! Diffusive heat transports 333 ! TODO: TO BE TILED 334 IF( l_hst ) CALL dia_ar5_hst( jn, 'ldf', -zftu(:,:,:), -zftv(:,:,:) ) 335 ! 336 ENDIF !== end pass selection ==! 337 ENDIF 324 338 ! 325 339 ! ! ===============
Note: See TracChangeset
for help on using the changeset viewer.
