- Timestamp:
- 2019-11-22T15:29:17+01:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r11943_MERGE_2019/src
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11943_MERGE_2019/src
- Property svn:mergeinfo deleted
-
NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/TRA/zpshde.F90
r10425 r11949 39 39 CONTAINS 40 40 41 SUBROUTINE zps_hde( kt, kjpt, pta, pgtu, pgtv, &41 SUBROUTINE zps_hde( kt, Kmm, kjpt, pta, pgtu, pgtv, & 42 42 & prd, pgru, pgrv ) 43 43 !!---------------------------------------------------------------------- … … 85 85 !!---------------------------------------------------------------------- 86 86 INTEGER , INTENT(in ) :: kt ! ocean time-step index 87 INTEGER , INTENT(in ) :: Kmm ! ocean time level index 87 88 INTEGER , INTENT(in ) :: kjpt ! number of tracers 88 89 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pta ! 4D tracers fields … … 109 110 iku = mbku(ji,jj) ; ikum1 = MAX( iku - 1 , 1 ) ! last and before last ocean level at u- & v-points 110 111 ikv = mbkv(ji,jj) ; ikvm1 = MAX( ikv - 1 , 1 ) ! if level first is a p-step, ik.m1=1 111 !!gm BUG ? when applied to before fields, e3w _bshould be used....112 ze3wu = e3w _n(ji+1,jj ,iku) - e3w_n(ji,jj,iku)113 ze3wv = e3w _n(ji ,jj+1,ikv) - e3w_n(ji,jj,ikv)112 !!gm BUG ? when applied to before fields, e3w(:,:,:,Kbb) should be used.... 113 ze3wu = e3w(ji+1,jj ,iku,Kmm) - e3w(ji,jj,iku,Kmm) 114 ze3wv = e3w(ji ,jj+1,ikv,Kmm) - e3w(ji,jj,ikv,Kmm) 114 115 ! 115 116 ! i- direction 116 117 IF( ze3wu >= 0._wp ) THEN ! case 1 117 zmaxu = ze3wu / e3w _n(ji+1,jj,iku)118 zmaxu = ze3wu / e3w(ji+1,jj,iku,Kmm) 118 119 ! interpolated values of tracers 119 120 zti (ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) ) … … 121 122 pgtu(ji,jj,jn) = umask(ji,jj,1) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) 122 123 ELSE ! case 2 123 zmaxu = -ze3wu / e3w _n(ji,jj,iku)124 zmaxu = -ze3wu / e3w(ji,jj,iku,Kmm) 124 125 ! interpolated values of tracers 125 126 zti (ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) ) … … 130 131 ! j- direction 131 132 IF( ze3wv >= 0._wp ) THEN ! case 1 132 zmaxv = ze3wv / e3w _n(ji,jj+1,ikv)133 zmaxv = ze3wv / e3w(ji,jj+1,ikv,Kmm) 133 134 ! interpolated values of tracers 134 135 ztj (ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) ) … … 136 137 pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) 137 138 ELSE ! case 2 138 zmaxv = -ze3wv / e3w _n(ji,jj,ikv)139 zmaxv = -ze3wv / e3w(ji,jj,ikv,Kmm) 139 140 ! interpolated values of tracers 140 141 ztj (ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) ) … … 155 156 iku = mbku(ji,jj) 156 157 ikv = mbkv(ji,jj) 157 ze3wu = e3w _n(ji+1,jj ,iku) - e3w_n(ji,jj,iku)158 ze3wv = e3w _n(ji ,jj+1,ikv) - e3w_n(ji,jj,ikv)159 IF( ze3wu >= 0._wp ) THEN ; zhi(ji,jj) = gdept _n(ji ,jj,iku) ! i-direction: case 1160 ELSE ; zhi(ji,jj) = gdept _n(ji+1,jj,iku) ! - - case 2161 ENDIF 162 IF( ze3wv >= 0._wp ) THEN ; zhj(ji,jj) = gdept _n(ji,jj ,ikv) ! j-direction: case 1163 ELSE ; zhj(ji,jj) = gdept _n(ji,jj+1,ikv) ! - - case 2158 ze3wu = e3w(ji+1,jj ,iku,Kmm) - e3w(ji,jj,iku,Kmm) 159 ze3wv = e3w(ji ,jj+1,ikv,Kmm) - e3w(ji,jj,ikv,Kmm) 160 IF( ze3wu >= 0._wp ) THEN ; zhi(ji,jj) = gdept(ji ,jj,iku,Kmm) ! i-direction: case 1 161 ELSE ; zhi(ji,jj) = gdept(ji+1,jj,iku,Kmm) ! - - case 2 162 ENDIF 163 IF( ze3wv >= 0._wp ) THEN ; zhj(ji,jj) = gdept(ji,jj ,ikv,Kmm) ! j-direction: case 1 164 ELSE ; zhj(ji,jj) = gdept(ji,jj+1,ikv,Kmm) ! - - case 2 164 165 ENDIF 165 166 END DO … … 173 174 iku = mbku(ji,jj) 174 175 ikv = mbkv(ji,jj) 175 ze3wu = e3w _n(ji+1,jj ,iku) - e3w_n(ji,jj,iku)176 ze3wv = e3w _n(ji ,jj+1,ikv) - e3w_n(ji,jj,ikv)176 ze3wu = e3w(ji+1,jj ,iku,Kmm) - e3w(ji,jj,iku,Kmm) 177 ze3wv = e3w(ji ,jj+1,ikv,Kmm) - e3w(ji,jj,ikv,Kmm) 177 178 IF( ze3wu >= 0._wp ) THEN ; pgru(ji,jj) = umask(ji,jj,1) * ( zri(ji ,jj ) - prd(ji,jj,iku) ) ! i: 1 178 179 ELSE ; pgru(ji,jj) = umask(ji,jj,1) * ( prd(ji+1,jj,iku) - zri(ji,jj ) ) ! i: 2 … … 192 193 193 194 194 SUBROUTINE zps_hde_isf( kt, kjpt, pta, pgtu, pgtv, pgtui, pgtvi, &195 SUBROUTINE zps_hde_isf( kt, Kmm, kjpt, pta, pgtu, pgtv, pgtui, pgtvi, & 195 196 & prd, pgru, pgrv, pgrui, pgrvi ) 196 197 !!---------------------------------------------------------------------- … … 241 242 !!---------------------------------------------------------------------- 242 243 INTEGER , INTENT(in ) :: kt ! ocean time-step index 244 INTEGER , INTENT(in ) :: Kmm ! ocean time level index 243 245 INTEGER , INTENT(in ) :: kjpt ! number of tracers 244 246 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pta ! 4D tracers fields … … 270 272 iku = mbku(ji,jj); ikum1 = MAX( iku - 1 , 1 ) ! last and before last ocean level at u- & v-points 271 273 ikv = mbkv(ji,jj); ikvm1 = MAX( ikv - 1 , 1 ) ! if level first is a p-step, ik.m1=1 272 ze3wu = gdept _n(ji+1,jj,iku) - gdept_n(ji,jj,iku)273 ze3wv = gdept _n(ji,jj+1,ikv) - gdept_n(ji,jj,ikv)274 ze3wu = gdept(ji+1,jj,iku,Kmm) - gdept(ji,jj,iku,Kmm) 275 ze3wv = gdept(ji,jj+1,ikv,Kmm) - gdept(ji,jj,ikv,Kmm) 274 276 ! 275 277 ! i- direction 276 278 IF( ze3wu >= 0._wp ) THEN ! case 1 277 zmaxu = ze3wu / e3w _n(ji+1,jj,iku)279 zmaxu = ze3wu / e3w(ji+1,jj,iku,Kmm) 278 280 ! interpolated values of tracers 279 281 zti (ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) ) … … 281 283 pgtu(ji,jj,jn) = ssumask(ji,jj) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) 282 284 ELSE ! case 2 283 zmaxu = -ze3wu / e3w _n(ji,jj,iku)285 zmaxu = -ze3wu / e3w(ji,jj,iku,Kmm) 284 286 ! interpolated values of tracers 285 287 zti (ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) ) … … 290 292 ! j- direction 291 293 IF( ze3wv >= 0._wp ) THEN ! case 1 292 zmaxv = ze3wv / e3w _n(ji,jj+1,ikv)294 zmaxv = ze3wv / e3w(ji,jj+1,ikv,Kmm) 293 295 ! interpolated values of tracers 294 296 ztj (ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) ) … … 296 298 pgtv(ji,jj,jn) = ssvmask(ji,jj) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) 297 299 ELSE ! case 2 298 zmaxv = -ze3wv / e3w _n(ji,jj,ikv)300 zmaxv = -ze3wv / e3w(ji,jj,ikv,Kmm) 299 301 ! interpolated values of tracers 300 302 ztj (ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) ) … … 318 320 iku = mbku(ji,jj) 319 321 ikv = mbkv(ji,jj) 320 ze3wu = gdept _n(ji+1,jj,iku) - gdept_n(ji,jj,iku)321 ze3wv = gdept _n(ji,jj+1,ikv) - gdept_n(ji,jj,ikv)322 ! 323 IF( ze3wu >= 0._wp ) THEN ; zhi(ji,jj) = gdept _n(ji ,jj,iku) ! i-direction: case 1324 ELSE ; zhi(ji,jj) = gdept _n(ji+1,jj,iku) ! - - case 2325 ENDIF 326 IF( ze3wv >= 0._wp ) THEN ; zhj(ji,jj) = gdept _n(ji,jj ,ikv) ! j-direction: case 1327 ELSE ; zhj(ji,jj) = gdept _n(ji,jj+1,ikv) ! - - case 2322 ze3wu = gdept(ji+1,jj,iku,Kmm) - gdept(ji,jj,iku,Kmm) 323 ze3wv = gdept(ji,jj+1,ikv,Kmm) - gdept(ji,jj,ikv,Kmm) 324 ! 325 IF( ze3wu >= 0._wp ) THEN ; zhi(ji,jj) = gdept(ji ,jj,iku,Kmm) ! i-direction: case 1 326 ELSE ; zhi(ji,jj) = gdept(ji+1,jj,iku,Kmm) ! - - case 2 327 ENDIF 328 IF( ze3wv >= 0._wp ) THEN ; zhj(ji,jj) = gdept(ji,jj ,ikv,Kmm) ! j-direction: case 1 329 ELSE ; zhj(ji,jj) = gdept(ji,jj+1,ikv,Kmm) ! - - case 2 328 330 ENDIF 329 331 … … 340 342 iku = mbku(ji,jj) 341 343 ikv = mbkv(ji,jj) 342 ze3wu = gdept _n(ji+1,jj,iku) - gdept_n(ji,jj,iku)343 ze3wv = gdept _n(ji,jj+1,ikv) - gdept_n(ji,jj,ikv)344 ze3wu = gdept(ji+1,jj,iku,Kmm) - gdept(ji,jj,iku,Kmm) 345 ze3wv = gdept(ji,jj+1,ikv,Kmm) - gdept(ji,jj,ikv,Kmm) 344 346 345 347 IF( ze3wu >= 0._wp ) THEN ; pgru(ji,jj) = ssumask(ji,jj) * ( zri(ji ,jj ) - prd(ji,jj,iku) ) ! i: 1 … … 369 371 ! in this case e3w(i,j) - e3w(i,j+1) is not the distance between Tj~ and Tj 370 372 ! the only common depth between cells (i,j) and (i,j+1) is gdepw_0 371 ze3wu = gdept _n(ji,jj,iku) - gdept_n(ji+1,jj,iku)372 ze3wv = gdept _n(ji,jj,ikv) - gdept_n(ji,jj+1,ikv)373 ze3wu = gdept(ji,jj,iku,Kmm) - gdept(ji+1,jj,iku,Kmm) 374 ze3wv = gdept(ji,jj,ikv,Kmm) - gdept(ji,jj+1,ikv,Kmm) 373 375 374 376 ! i- direction 375 377 IF( ze3wu >= 0._wp ) THEN ! case 1 376 zmaxu = ze3wu / e3w _n(ji+1,jj,ikup1)378 zmaxu = ze3wu / e3w(ji+1,jj,ikup1,Kmm) 377 379 ! interpolated values of tracers 378 380 zti(ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikup1,jn) - pta(ji+1,jj,iku,jn) ) … … 380 382 pgtui(ji,jj,jn) = ssumask(ji,jj) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) 381 383 ELSE ! case 2 382 zmaxu = - ze3wu / e3w _n(ji,jj,ikup1)384 zmaxu = - ze3wu / e3w(ji,jj,ikup1,Kmm) 383 385 ! interpolated values of tracers 384 386 zti(ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikup1,jn) - pta(ji,jj,iku,jn) ) … … 389 391 ! j- direction 390 392 IF( ze3wv >= 0._wp ) THEN ! case 1 391 zmaxv = ze3wv / e3w _n(ji,jj+1,ikvp1)393 zmaxv = ze3wv / e3w(ji,jj+1,ikvp1,Kmm) 392 394 ! interpolated values of tracers 393 395 ztj(ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvp1,jn) - pta(ji,jj+1,ikv,jn) ) … … 395 397 pgtvi(ji,jj,jn) = ssvmask(ji,jj) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) 396 398 ELSE ! case 2 397 zmaxv = - ze3wv / e3w _n(ji,jj,ikvp1)399 zmaxv = - ze3wv / e3w(ji,jj,ikvp1,Kmm) 398 400 ! interpolated values of tracers 399 401 ztj(ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvp1,jn) - pta(ji,jj,ikv,jn) ) … … 416 418 iku = miku(ji,jj) 417 419 ikv = mikv(ji,jj) 418 ze3wu = gdept _n(ji,jj,iku) - gdept_n(ji+1,jj,iku)419 ze3wv = gdept _n(ji,jj,ikv) - gdept_n(ji,jj+1,ikv)420 ! 421 IF( ze3wu >= 0._wp ) THEN ; zhi(ji,jj) = gdept _n(ji ,jj,iku) ! i-direction: case 1422 ELSE ; zhi(ji,jj) = gdept _n(ji+1,jj,iku) ! - - case 2423 ENDIF 424 425 IF( ze3wv >= 0._wp ) THEN ; zhj(ji,jj) = gdept _n(ji,jj ,ikv) ! j-direction: case 1426 ELSE ; zhj(ji,jj) = gdept _n(ji,jj+1,ikv) ! - - case 2420 ze3wu = gdept(ji,jj,iku,Kmm) - gdept(ji+1,jj,iku,Kmm) 421 ze3wv = gdept(ji,jj,ikv,Kmm) - gdept(ji,jj+1,ikv,Kmm) 422 ! 423 IF( ze3wu >= 0._wp ) THEN ; zhi(ji,jj) = gdept(ji ,jj,iku,Kmm) ! i-direction: case 1 424 ELSE ; zhi(ji,jj) = gdept(ji+1,jj,iku,Kmm) ! - - case 2 425 ENDIF 426 427 IF( ze3wv >= 0._wp ) THEN ; zhj(ji,jj) = gdept(ji,jj ,ikv,Kmm) ! j-direction: case 1 428 ELSE ; zhj(ji,jj) = gdept(ji,jj+1,ikv,Kmm) ! - - case 2 427 429 ENDIF 428 430 … … 437 439 iku = miku(ji,jj) 438 440 ikv = mikv(ji,jj) 439 ze3wu = gdept _n(ji,jj,iku) - gdept_n(ji+1,jj,iku)440 ze3wv = gdept _n(ji,jj,ikv) - gdept_n(ji,jj+1,ikv)441 ze3wu = gdept(ji,jj,iku,Kmm) - gdept(ji+1,jj,iku,Kmm) 442 ze3wv = gdept(ji,jj,ikv,Kmm) - gdept(ji,jj+1,ikv,Kmm) 441 443 442 444 IF( ze3wu >= 0._wp ) THEN ; pgrui(ji,jj) = ssumask(ji,jj) * ( zri(ji ,jj ) - prd(ji,jj,iku) ) ! i: 1
Note: See TracChangeset
for help on using the changeset viewer.