Changeset 14037 for NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/src/OCE/TRA/zpshde.F90
- Timestamp:
- 2020-12-03T12:20:38+01:00 (3 years ago)
- Location:
- NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/TRA/zpshde.F90 (modified) (19 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG
- Property svn:externals
-
old new 8 8 9 9 # SETTE 10 ^/utils/CI/sette @13292sette10 ^/utils/CI/sette_wave@13990 sette
-
- Property svn:externals
-
NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/src/OCE/TRA/zpshde.F90
r13295 r14037 17 17 USE oce ! ocean: dynamics and tracers variables 18 18 USE dom_oce ! domain: ocean variables 19 USE domutl, ONLY : is_tile 19 20 USE phycst ! physical constants 20 21 USE eosbn2 ! ocean equation of state … … 40 41 CONTAINS 41 42 42 SUBROUTINE zps_hde( kt, Kmm, kjpt, pta, pgtu, pgtv, & 43 & prd, pgru, pgrv ) 43 SUBROUTINE zps_hde( kt, Kmm, kjpt, pta, pgtu, pgtv, & 44 & prd, pgru, pgrv ) 45 !! 46 INTEGER , INTENT(in ) :: kt ! ocean time-step index 47 INTEGER , INTENT(in ) :: Kmm ! ocean time level index 48 INTEGER , INTENT(in ) :: kjpt ! number of tracers 49 REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pta ! 4D tracers fields 50 REAL(wp), DIMENSION(:,:,:) , INTENT( out) :: pgtu, pgtv ! hor. grad. of ptra at u- & v-pts 51 REAL(wp), DIMENSION(:,:,:) , INTENT(inout), OPTIONAL :: prd ! 3D density anomaly fields 52 REAL(wp), DIMENSION(:,:) , INTENT( out), OPTIONAL :: pgru, pgrv ! hor. grad of prd at u- & v-pts (bottom) 53 ! 54 INTEGER :: itrd, itgr 55 !! 56 IF( PRESENT(prd) ) THEN ; itrd = is_tile(prd) ; ELSE ; itrd = 0 ; ENDIF 57 IF( PRESENT(pgru) ) THEN ; itgr = is_tile(pgru) ; ELSE ; itgr = 0 ; ENDIF 58 59 CALL zps_hde_t( kt, Kmm, kjpt, pta, is_tile(pta), pgtu, pgtv, is_tile(pgtu), & 60 & prd, itrd, pgru, pgrv, itgr ) 61 END SUBROUTINE zps_hde 62 63 64 SUBROUTINE zps_hde_t( kt, Kmm, kjpt, pta, ktta, pgtu, pgtv, ktgt, & 65 & prd, ktrd, pgru, pgrv, ktgr ) 44 66 !!---------------------------------------------------------------------- 45 67 !! *** ROUTINE zps_hde *** … … 85 107 !! - pgru, pgrv: horizontal gradient of rho (if present) at u- & v-points 86 108 !!---------------------------------------------------------------------- 87 INTEGER , INTENT(in ) :: kt ! ocean time-step index 88 INTEGER , INTENT(in ) :: Kmm ! ocean time level index 89 INTEGER , INTENT(in ) :: kjpt ! number of tracers 90 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pta ! 4D tracers fields 91 REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT( out) :: pgtu, pgtv ! hor. grad. of ptra at u- & v-pts 92 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ), OPTIONAL :: prd ! 3D density anomaly fields 93 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pgru, pgrv ! hor. grad of prd at u- & v-pts (bottom) 109 INTEGER , INTENT(in ) :: kt ! ocean time-step index 110 INTEGER , INTENT(in ) :: Kmm ! ocean time level index 111 INTEGER , INTENT(in ) :: kjpt ! number of tracers 112 INTEGER , INTENT(in ) :: ktta, ktgt, ktrd, ktgr 113 REAL(wp), DIMENSION(A2D_T(ktta),JPK,KJPT), INTENT(inout) :: pta ! 4D tracers fields 114 REAL(wp), DIMENSION(A2D_T(ktgt) ,KJPT), INTENT( out) :: pgtu, pgtv ! hor. grad. of ptra at u- & v-pts 115 REAL(wp), DIMENSION(A2D_T(ktrd),JPK ), INTENT(inout), OPTIONAL :: prd ! 3D density anomaly fields 116 REAL(wp), DIMENSION(A2D_T(ktgr) ), INTENT( out), OPTIONAL :: pgru, pgrv ! hor. grad of prd at u- & v-pts (bottom) 94 117 ! 95 118 INTEGER :: ji, jj, jn ! Dummy loop indices 96 119 INTEGER :: iku, ikv, ikum1, ikvm1 ! partial step level (ocean bottom level) at u- and v-points 97 120 REAL(wp) :: ze3wu, ze3wv, zmaxu, zmaxv ! local scalars 98 REAL(wp), DIMENSION( jpi,jpj) :: zri, zrj, zhi, zhj ! NB: 3rd dim=1 to use eos99 REAL(wp), DIMENSION( jpi,jpj,kjpt) :: zti, ztj !121 REAL(wp), DIMENSION(A2D(nn_hls)) :: zri, zrj, zhi, zhj ! NB: 3rd dim=1 to use eos 122 REAL(wp), DIMENSION(A2D(nn_hls),kjpt) :: zti, ztj ! 100 123 !!---------------------------------------------------------------------- 101 124 ! 102 125 IF( ln_timing ) CALL timing_start( 'zps_hde') 126 ! NOTE: [tiling-comms-merge] Some lbc_lnks in tra_adv and tra_ldf can be taken out in the zps case, because this lbc_lnk is called when zps_hde is called in the stp routine. In the zco case they are still needed. 127 IF (nn_hls.EQ.2) THEN 128 CALL lbc_lnk( 'zpshde', pta, 'T', 1.0_wp) 129 IF(PRESENT(prd)) CALL lbc_lnk( 'zpshde', prd, 'T', 1.0_wp) 130 END IF 103 131 ! 104 132 pgtu(:,:,:) = 0._wp ; zti (:,:,:) = 0._wp ; zhi (:,:) = 0._wp … … 107 135 DO jn = 1, kjpt !== Interpolation of tracers at the last ocean level ==! 108 136 ! 109 DO_2D( 1, 0, 1, 0 )137 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! Gradient of density at the last level 110 138 iku = mbku(ji,jj) ; ikum1 = MAX( iku - 1 , 1 ) ! last and before last ocean level at u- & v-points 111 139 ikv = mbkv(ji,jj) ; ikvm1 = MAX( ikv - 1 , 1 ) ! if level first is a p-step, ik.m1=1 … … 146 174 END DO 147 175 ! 148 CALL lbc_lnk_multi( 'zpshde', pgtu(:,:,:), 'U', -1.0_wp , pgtv(:,:,:), 'V', -1.0_wp ) ! Lateral boundary cond.176 IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'zpshde', pgtu(:,:,:), 'U', -1.0_wp , pgtv(:,:,:), 'V', -1.0_wp ) ! Lateral boundary cond. 149 177 ! 150 178 IF( PRESENT( prd ) ) THEN !== horizontal derivative of density anomalies (rd) ==! (optional part) 151 179 pgru(:,:) = 0._wp 152 180 pgrv(:,:) = 0._wp ! depth of the partial step level 153 DO_2D( 1, 0, 1, 0)181 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 154 182 iku = mbku(ji,jj) 155 183 ikv = mbkv(ji,jj) … … 167 195 CALL eos( ztj, zhj, zrj ) ! at the partial step depth output in zri, zrj 168 196 ! 169 DO_2D( 1, 0, 1, 0 )197 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! Gradient of density at the last level 170 198 iku = mbku(ji,jj) 171 199 ikv = mbkv(ji,jj) … … 179 207 ENDIF 180 208 END_2D 181 CALL lbc_lnk_multi( 'zpshde', pgru , 'U', -1.0_wp , pgrv , 'V', -1.0_wp ) ! Lateral boundary conditions209 IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'zpshde', pgru , 'U', -1.0_wp , pgrv , 'V', -1.0_wp ) ! Lateral boundary conditions 182 210 ! 183 211 END IF … … 185 213 IF( ln_timing ) CALL timing_stop( 'zps_hde') 186 214 ! 187 END SUBROUTINE zps_hde 215 END SUBROUTINE zps_hde_t 188 216 189 217 190 218 SUBROUTINE zps_hde_isf( kt, Kmm, kjpt, pta, pgtu, pgtv, pgtui, pgtvi, & 191 & prd, pgru, pgrv, pgrui, pgrvi ) 219 & prd, pgru, pgrv, pgrui, pgrvi ) 220 !! 221 INTEGER , INTENT(in ) :: kt ! ocean time-step index 222 INTEGER , INTENT(in ) :: Kmm ! ocean time level index 223 INTEGER , INTENT(in ) :: kjpt ! number of tracers 224 REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pta ! 4D tracers fields 225 REAL(wp), DIMENSION(:,:,:) , INTENT( out) :: pgtu, pgtv ! hor. grad. of ptra at u- & v-pts 226 REAL(wp), DIMENSION(:,:,:) , INTENT( out) :: pgtui, pgtvi ! hor. grad. of stra at u- & v-pts (ISF) 227 REAL(wp), DIMENSION(:,:,:) , INTENT(inout), OPTIONAL :: prd ! 3D density anomaly fields 228 REAL(wp), DIMENSION(:,:) , INTENT( out), OPTIONAL :: pgru, pgrv ! hor. grad of prd at u- & v-pts (bottom) 229 REAL(wp), DIMENSION(:,:) , INTENT( out), OPTIONAL :: pgrui, pgrvi ! hor. grad of prd at u- & v-pts (top) 230 ! 231 INTEGER :: itrd, itgr, itgri 232 !! 233 IF( PRESENT(prd) ) THEN ; itrd = is_tile(prd) ; ELSE ; itrd = 0 ; ENDIF 234 IF( PRESENT(pgru) ) THEN ; itgr = is_tile(pgru) ; ELSE ; itgr = 0 ; ENDIF 235 IF( PRESENT(pgrui) ) THEN ; itgri = is_tile(pgrui) ; ELSE ; itgri = 0 ; ENDIF 236 237 CALL zps_hde_isf_t( kt, Kmm, kjpt, pta, is_tile(pta), pgtu, pgtv, is_tile(pgtu), pgtui, pgtvi, is_tile(pgtui), & 238 & prd, itrd, pgru, pgrv, itgr, pgrui, pgrvi, itgri ) 239 END SUBROUTINE zps_hde_isf 240 241 242 SUBROUTINE zps_hde_isf_t( kt, Kmm, kjpt, pta, ktta, pgtu, pgtv, ktgt, pgtui, pgtvi, ktgti, & 243 & prd, ktrd, pgru, pgrv, ktgr, pgrui, pgrvi, ktgri ) 192 244 !!---------------------------------------------------------------------- 193 245 !! *** ROUTINE zps_hde_isf *** … … 236 288 !! - pgru, pgrv, pgrui, pgtvi: horizontal gradient of rho (if present) at u- & v-points 237 289 !!---------------------------------------------------------------------- 238 INTEGER , INTENT(in ) :: kt ! ocean time-step index 239 INTEGER , INTENT(in ) :: Kmm ! ocean time level index 240 INTEGER , INTENT(in ) :: kjpt ! number of tracers 241 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pta ! 4D tracers fields 242 REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT( out) :: pgtu, pgtv ! hor. grad. of ptra at u- & v-pts 243 REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT( out) :: pgtui, pgtvi ! hor. grad. of stra at u- & v-pts (ISF) 244 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ), OPTIONAL :: prd ! 3D density anomaly fields 245 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pgru, pgrv ! hor. grad of prd at u- & v-pts (bottom) 246 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pgrui, pgrvi ! hor. grad of prd at u- & v-pts (top) 290 INTEGER , INTENT(in ) :: kt ! ocean time-step index 291 INTEGER , INTENT(in ) :: Kmm ! ocean time level index 292 INTEGER , INTENT(in ) :: kjpt ! number of tracers 293 INTEGER , INTENT(in ) :: ktta, ktgt, ktgti, ktrd, ktgr, ktgri 294 REAL(wp), DIMENSION(A2D_T(ktta),JPK,KJPT), INTENT(inout) :: pta ! 4D tracers fields 295 REAL(wp), DIMENSION(A2D_T(ktgt) ,KJPT), INTENT( out) :: pgtu, pgtv ! hor. grad. of ptra at u- & v-pts 296 REAL(wp), DIMENSION(A2D_T(ktgti) ,KJPT), INTENT( out) :: pgtui, pgtvi ! hor. grad. of stra at u- & v-pts (ISF) 297 REAL(wp), DIMENSION(A2D_T(ktrd),JPK ), INTENT(inout), OPTIONAL :: prd ! 3D density anomaly fields 298 REAL(wp), DIMENSION(A2D_T(ktgr) ), INTENT( out), OPTIONAL :: pgru, pgrv ! hor. grad of prd at u- & v-pts (bottom) 299 REAL(wp), DIMENSION(A2D_T(ktgri) ), INTENT( out), OPTIONAL :: pgrui, pgrvi ! hor. grad of prd at u- & v-pts (top) 247 300 ! 248 301 INTEGER :: ji, jj, jn ! Dummy loop indices 249 302 INTEGER :: iku, ikv, ikum1, ikvm1,ikup1, ikvp1 ! partial step level (ocean bottom level) at u- and v-points 250 303 REAL(wp) :: ze3wu, ze3wv, zmaxu, zmaxv ! temporary scalars 251 REAL(wp), DIMENSION( jpi,jpj) :: zri, zrj, zhi, zhj ! NB: 3rd dim=1 to use eos252 REAL(wp), DIMENSION( jpi,jpj,kjpt) :: zti, ztj !304 REAL(wp), DIMENSION(A2D(nn_hls)) :: zri, zrj, zhi, zhj ! NB: 3rd dim=1 to use eos 305 REAL(wp), DIMENSION(A2D(nn_hls),kjpt) :: zti, ztj ! 253 306 !!---------------------------------------------------------------------- 254 307 ! 255 308 IF( ln_timing ) CALL timing_start( 'zps_hde_isf') 256 309 ! 310 IF (nn_hls.EQ.2) THEN 311 CALL lbc_lnk( 'zpshde', pta, 'T', 1.0_wp) 312 IF (PRESENT(prd)) CALL lbc_lnk( 'zpshde', prd, 'T', 1.0_wp) 313 END IF 314 257 315 pgtu (:,:,:) = 0._wp ; pgtv (:,:,:) =0._wp 258 316 pgtui(:,:,:) = 0._wp ; pgtvi(:,:,:) =0._wp … … 262 320 DO jn = 1, kjpt !== Interpolation of tracers at the last ocean level ==! 263 321 ! 264 DO_2D( 1, 0, 1, 0)322 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 265 323 266 324 iku = mbku(ji,jj); ikum1 = MAX( iku - 1 , 1 ) ! last and before last ocean level at u- & v-points … … 302 360 END DO 303 361 ! 304 CALL lbc_lnk_multi( 'zpshde', pgtu(:,:,:), 'U', -1.0_wp , pgtv(:,:,:), 'V', -1.0_wp ) ! Lateral boundary cond.362 IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'zpshde', pgtu(:,:,:), 'U', -1.0_wp , pgtv(:,:,:), 'V', -1.0_wp ) ! Lateral boundary cond. 305 363 306 364 ! horizontal derivative of density anomalies (rd) … … 308 366 pgru(:,:)=0.0_wp ; pgrv(:,:)=0.0_wp ; 309 367 ! 310 DO_2D( 1, 0, 1, 0)368 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 311 369 312 370 iku = mbku(ji,jj) … … 329 387 CALL eos( ztj, zhj, zrj ) 330 388 331 DO_2D( 1, 0, 1, 0)389 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 332 390 iku = mbku(ji,jj) 333 391 ikv = mbkv(ji,jj) … … 344 402 END_2D 345 403 346 CALL lbc_lnk_multi( 'zpshde', pgru , 'U', -1.0_wp , pgrv , 'V', -1.0_wp ) ! Lateral boundary conditions404 IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'zpshde', pgru , 'U', -1.0_wp , pgrv , 'V', -1.0_wp ) ! Lateral boundary conditions 347 405 ! 348 406 END IF … … 351 409 ! 352 410 DO jn = 1, kjpt !== Interpolation of tracers at the last ocean level ==! ! 353 DO_2D( 1, 0, 1, 0)411 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 354 412 iku = miku(ji,jj); ikup1 = miku(ji,jj) + 1 355 413 ikv = mikv(ji,jj); ikvp1 = mikv(ji,jj) + 1 … … 395 453 ! 396 454 END DO 397 CALL lbc_lnk_multi( 'zpshde', pgtui(:,:,:), 'U', -1.0_wp , pgtvi(:,:,:), 'V', -1.0_wp ) ! Lateral boundary cond.455 IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'zpshde', pgtui(:,:,:), 'U', -1.0_wp , pgtvi(:,:,:), 'V', -1.0_wp ) ! Lateral boundary cond. 398 456 399 457 IF( PRESENT( prd ) ) THEN !== horizontal derivative of density anomalies (rd) ==! (optional part) 400 458 ! 401 459 pgrui(:,:) =0.0_wp; pgrvi(:,:) =0.0_wp; 402 DO_2D( 1, 0, 1, 0)460 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 403 461 404 462 iku = miku(ji,jj) … … 420 478 CALL eos( ztj, zhj, zrj ) ! at the partial step depth output in zri, zrj 421 479 ! 422 DO_2D( 1, 0, 1, 0)480 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 423 481 iku = miku(ji,jj) 424 482 ikv = mikv(ji,jj) … … 434 492 435 493 END_2D 436 CALL lbc_lnk_multi( 'zpshde', pgrui, 'U', -1.0_wp , pgrvi, 'V', -1.0_wp ) ! Lateral boundary conditions494 IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'zpshde', pgrui, 'U', -1.0_wp , pgrvi, 'V', -1.0_wp ) ! Lateral boundary conditions 437 495 ! 438 496 END IF … … 440 498 IF( ln_timing ) CALL timing_stop( 'zps_hde_isf') 441 499 ! 442 END SUBROUTINE zps_hde_isf 500 END SUBROUTINE zps_hde_isf_t 443 501 444 502 !!======================================================================
Note: See TracChangeset
for help on using the changeset viewer.
