- Timestamp:
- 2020-05-14T21:46:00+02:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/TRA/zpshde.F90 (modified) (12 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser
- Property svn:externals
-
old new 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 9 # SETTE 10 ^/utils/CI/sette@HEAD sette
-
- Property svn:externals
-
NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/zpshde.F90
r10425 r12928 31 31 32 32 !! * Substitutions 33 # include " vectopt_loop_substitute.h90"33 # include "do_loop_substitute.h90" 34 34 !!---------------------------------------------------------------------- 35 35 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 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 … … 105 106 DO jn = 1, kjpt !== Interpolation of tracers at the last ocean level ==! 106 107 ! 107 DO jj = 1, jpjm1 108 DO ji = 1, jpim1 109 iku = mbku(ji,jj) ; ikum1 = MAX( iku - 1 , 1 ) ! last and before last ocean level at u- & v-points 110 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_b should 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) 114 ! 115 ! i- direction 116 IF( ze3wu >= 0._wp ) THEN ! case 1 117 zmaxu = ze3wu / e3w_n(ji+1,jj,iku) 118 ! interpolated values of tracers 119 zti (ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) ) 120 ! gradient of tracers 121 pgtu(ji,jj,jn) = umask(ji,jj,1) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) 122 ELSE ! case 2 123 zmaxu = -ze3wu / e3w_n(ji,jj,iku) 124 ! interpolated values of tracers 125 zti (ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) ) 126 ! gradient of tracers 127 pgtu(ji,jj,jn) = umask(ji,jj,1) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) ) 128 ENDIF 129 ! 130 ! j- direction 131 IF( ze3wv >= 0._wp ) THEN ! case 1 132 zmaxv = ze3wv / e3w_n(ji,jj+1,ikv) 133 ! interpolated values of tracers 134 ztj (ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) ) 135 ! gradient of tracers 136 pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) 137 ELSE ! case 2 138 zmaxv = -ze3wv / e3w_n(ji,jj,ikv) 139 ! interpolated values of tracers 140 ztj (ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) ) 141 ! gradient of tracers 142 pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) ) 143 ENDIF 144 END DO 145 END DO 108 DO_2D_10_10 109 iku = mbku(ji,jj) ; ikum1 = MAX( iku - 1 , 1 ) ! last and before last ocean level at u- & v-points 110 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(:,:,:,Kbb) should be used.... 112 ze3wu = e3w(ji+1,jj ,iku,Kmm) - e3w(ji,jj,iku,Kmm) 113 ze3wv = e3w(ji ,jj+1,ikv,Kmm) - e3w(ji,jj,ikv,Kmm) 114 ! 115 ! i- direction 116 IF( ze3wu >= 0._wp ) THEN ! case 1 117 zmaxu = ze3wu / e3w(ji+1,jj,iku,Kmm) 118 ! interpolated values of tracers 119 zti (ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) ) 120 ! gradient of tracers 121 pgtu(ji,jj,jn) = umask(ji,jj,1) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) 122 ELSE ! case 2 123 zmaxu = -ze3wu / e3w(ji,jj,iku,Kmm) 124 ! interpolated values of tracers 125 zti (ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) ) 126 ! gradient of tracers 127 pgtu(ji,jj,jn) = umask(ji,jj,1) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) ) 128 ENDIF 129 ! 130 ! j- direction 131 IF( ze3wv >= 0._wp ) THEN ! case 1 132 zmaxv = ze3wv / e3w(ji,jj+1,ikv,Kmm) 133 ! interpolated values of tracers 134 ztj (ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) ) 135 ! gradient of tracers 136 pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) 137 ELSE ! case 2 138 zmaxv = -ze3wv / e3w(ji,jj,ikv,Kmm) 139 ! interpolated values of tracers 140 ztj (ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) ) 141 ! gradient of tracers 142 pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) ) 143 ENDIF 144 END_2D 146 145 END DO 147 146 ! … … 151 150 pgru(:,:) = 0._wp 152 151 pgrv(:,:) = 0._wp ! depth of the partial step level 153 DO jj = 1, jpjm1 154 DO ji = 1, jpim1 155 iku = mbku(ji,jj) 156 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 1 160 ELSE ; zhi(ji,jj) = gdept_n(ji+1,jj,iku) ! - - case 2 161 ENDIF 162 IF( ze3wv >= 0._wp ) THEN ; zhj(ji,jj) = gdept_n(ji,jj ,ikv) ! j-direction: case 1 163 ELSE ; zhj(ji,jj) = gdept_n(ji,jj+1,ikv) ! - - case 2 164 ENDIF 165 END DO 166 END DO 152 DO_2D_10_10 153 iku = mbku(ji,jj) 154 ikv = mbkv(ji,jj) 155 ze3wu = e3w(ji+1,jj ,iku,Kmm) - e3w(ji,jj,iku,Kmm) 156 ze3wv = e3w(ji ,jj+1,ikv,Kmm) - e3w(ji,jj,ikv,Kmm) 157 IF( ze3wu >= 0._wp ) THEN ; zhi(ji,jj) = gdept(ji ,jj,iku,Kmm) ! i-direction: case 1 158 ELSE ; zhi(ji,jj) = gdept(ji+1,jj,iku,Kmm) ! - - case 2 159 ENDIF 160 IF( ze3wv >= 0._wp ) THEN ; zhj(ji,jj) = gdept(ji,jj ,ikv,Kmm) ! j-direction: case 1 161 ELSE ; zhj(ji,jj) = gdept(ji,jj+1,ikv,Kmm) ! - - case 2 162 ENDIF 163 END_2D 167 164 ! 168 165 CALL eos( zti, zhi, zri ) ! interpolated density from zti, ztj 169 166 CALL eos( ztj, zhj, zrj ) ! at the partial step depth output in zri, zrj 170 167 ! 171 DO jj = 1, jpjm1 ! Gradient of density at the last level 172 DO ji = 1, jpim1 173 iku = mbku(ji,jj) 174 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) 177 IF( ze3wu >= 0._wp ) THEN ; pgru(ji,jj) = umask(ji,jj,1) * ( zri(ji ,jj ) - prd(ji,jj,iku) ) ! i: 1 178 ELSE ; pgru(ji,jj) = umask(ji,jj,1) * ( prd(ji+1,jj,iku) - zri(ji,jj ) ) ! i: 2 179 ENDIF 180 IF( ze3wv >= 0._wp ) THEN ; pgrv(ji,jj) = vmask(ji,jj,1) * ( zrj(ji,jj ) - prd(ji,jj,ikv) ) ! j: 1 181 ELSE ; pgrv(ji,jj) = vmask(ji,jj,1) * ( prd(ji,jj+1,ikv) - zrj(ji,jj ) ) ! j: 2 182 ENDIF 183 END DO 184 END DO 168 DO_2D_10_10 169 iku = mbku(ji,jj) 170 ikv = mbkv(ji,jj) 171 ze3wu = e3w(ji+1,jj ,iku,Kmm) - e3w(ji,jj,iku,Kmm) 172 ze3wv = e3w(ji ,jj+1,ikv,Kmm) - e3w(ji,jj,ikv,Kmm) 173 IF( ze3wu >= 0._wp ) THEN ; pgru(ji,jj) = umask(ji,jj,1) * ( zri(ji ,jj ) - prd(ji,jj,iku) ) ! i: 1 174 ELSE ; pgru(ji,jj) = umask(ji,jj,1) * ( prd(ji+1,jj,iku) - zri(ji,jj ) ) ! i: 2 175 ENDIF 176 IF( ze3wv >= 0._wp ) THEN ; pgrv(ji,jj) = vmask(ji,jj,1) * ( zrj(ji,jj ) - prd(ji,jj,ikv) ) ! j: 1 177 ELSE ; pgrv(ji,jj) = vmask(ji,jj,1) * ( prd(ji,jj+1,ikv) - zrj(ji,jj ) ) ! j: 2 178 ENDIF 179 END_2D 185 180 CALL lbc_lnk_multi( 'zpshde', pgru , 'U', -1. , pgrv , 'V', -1. ) ! Lateral boundary conditions 186 181 ! … … 192 187 193 188 194 SUBROUTINE zps_hde_isf( kt, kjpt, pta, pgtu, pgtv, pgtui, pgtvi, &189 SUBROUTINE zps_hde_isf( kt, Kmm, kjpt, pta, pgtu, pgtv, pgtui, pgtvi, & 195 190 & prd, pgru, pgrv, pgrui, pgrvi ) 196 191 !!---------------------------------------------------------------------- … … 241 236 !!---------------------------------------------------------------------- 242 237 INTEGER , INTENT(in ) :: kt ! ocean time-step index 238 INTEGER , INTENT(in ) :: Kmm ! ocean time level index 243 239 INTEGER , INTENT(in ) :: kjpt ! number of tracers 244 240 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pta ! 4D tracers fields … … 265 261 DO jn = 1, kjpt !== Interpolation of tracers at the last ocean level ==! 266 262 ! 267 DO jj = 1, jpjm1 268 DO ji = 1, jpim1 269 270 iku = mbku(ji,jj); ikum1 = MAX( iku - 1 , 1 ) ! last and before last ocean level at u- & v-points 271 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 ! 275 ! i- direction 276 IF( ze3wu >= 0._wp ) THEN ! case 1 277 zmaxu = ze3wu / e3w_n(ji+1,jj,iku) 278 ! interpolated values of tracers 279 zti (ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) ) 280 ! gradient of tracers 281 pgtu(ji,jj,jn) = ssumask(ji,jj) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) 282 ELSE ! case 2 283 zmaxu = -ze3wu / e3w_n(ji,jj,iku) 284 ! interpolated values of tracers 285 zti (ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) ) 286 ! gradient of tracers 287 pgtu(ji,jj,jn) = ssumask(ji,jj) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) ) 288 ENDIF 289 ! 290 ! j- direction 291 IF( ze3wv >= 0._wp ) THEN ! case 1 292 zmaxv = ze3wv / e3w_n(ji,jj+1,ikv) 293 ! interpolated values of tracers 294 ztj (ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) ) 295 ! gradient of tracers 296 pgtv(ji,jj,jn) = ssvmask(ji,jj) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) 297 ELSE ! case 2 298 zmaxv = -ze3wv / e3w_n(ji,jj,ikv) 299 ! interpolated values of tracers 300 ztj (ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) ) 301 ! gradient of tracers 302 pgtv(ji,jj,jn) = ssvmask(ji,jj) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) ) 303 ENDIF 304 305 END DO 306 END DO 263 DO_2D_10_10 264 265 iku = mbku(ji,jj); ikum1 = MAX( iku - 1 , 1 ) ! last and before last ocean level at u- & v-points 266 ikv = mbkv(ji,jj); ikvm1 = MAX( ikv - 1 , 1 ) ! if level first is a p-step, ik.m1=1 267 ze3wu = gdept(ji+1,jj,iku,Kmm) - gdept(ji,jj,iku,Kmm) 268 ze3wv = gdept(ji,jj+1,ikv,Kmm) - gdept(ji,jj,ikv,Kmm) 269 ! 270 ! i- direction 271 IF( ze3wu >= 0._wp ) THEN ! case 1 272 zmaxu = ze3wu / e3w(ji+1,jj,iku,Kmm) 273 ! interpolated values of tracers 274 zti (ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) ) 275 ! gradient of tracers 276 pgtu(ji,jj,jn) = ssumask(ji,jj) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) 277 ELSE ! case 2 278 zmaxu = -ze3wu / e3w(ji,jj,iku,Kmm) 279 ! interpolated values of tracers 280 zti (ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) ) 281 ! gradient of tracers 282 pgtu(ji,jj,jn) = ssumask(ji,jj) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) ) 283 ENDIF 284 ! 285 ! j- direction 286 IF( ze3wv >= 0._wp ) THEN ! case 1 287 zmaxv = ze3wv / e3w(ji,jj+1,ikv,Kmm) 288 ! interpolated values of tracers 289 ztj (ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) ) 290 ! gradient of tracers 291 pgtv(ji,jj,jn) = ssvmask(ji,jj) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) 292 ELSE ! case 2 293 zmaxv = -ze3wv / e3w(ji,jj,ikv,Kmm) 294 ! interpolated values of tracers 295 ztj (ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) ) 296 ! gradient of tracers 297 pgtv(ji,jj,jn) = ssvmask(ji,jj) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) ) 298 ENDIF 299 300 END_2D 307 301 END DO 308 302 ! … … 313 307 pgru(:,:)=0.0_wp ; pgrv(:,:)=0.0_wp ; 314 308 ! 315 DO jj = 1, jpjm1 316 DO ji = 1, jpim1 317 318 iku = mbku(ji,jj) 319 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 1 324 ELSE ; zhi(ji,jj) = gdept_n(ji+1,jj,iku) ! - - case 2 325 ENDIF 326 IF( ze3wv >= 0._wp ) THEN ; zhj(ji,jj) = gdept_n(ji,jj ,ikv) ! j-direction: case 1 327 ELSE ; zhj(ji,jj) = gdept_n(ji,jj+1,ikv) ! - - case 2 328 ENDIF 329 330 END DO 331 END DO 309 DO_2D_10_10 310 311 iku = mbku(ji,jj) 312 ikv = mbkv(ji,jj) 313 ze3wu = gdept(ji+1,jj,iku,Kmm) - gdept(ji,jj,iku,Kmm) 314 ze3wv = gdept(ji,jj+1,ikv,Kmm) - gdept(ji,jj,ikv,Kmm) 315 ! 316 IF( ze3wu >= 0._wp ) THEN ; zhi(ji,jj) = gdept(ji ,jj,iku,Kmm) ! i-direction: case 1 317 ELSE ; zhi(ji,jj) = gdept(ji+1,jj,iku,Kmm) ! - - case 2 318 ENDIF 319 IF( ze3wv >= 0._wp ) THEN ; zhj(ji,jj) = gdept(ji,jj ,ikv,Kmm) ! j-direction: case 1 320 ELSE ; zhj(ji,jj) = gdept(ji,jj+1,ikv,Kmm) ! - - case 2 321 ENDIF 322 323 END_2D 332 324 333 325 ! Compute interpolated rd from zti, ztj for the 2 cases at the depth of the partial … … 336 328 CALL eos( ztj, zhj, zrj ) 337 329 338 DO jj = 1, jpjm1 ! Gradient of density at the last level 339 DO ji = 1, jpim1 340 iku = mbku(ji,jj) 341 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 345 IF( ze3wu >= 0._wp ) THEN ; pgru(ji,jj) = ssumask(ji,jj) * ( zri(ji ,jj ) - prd(ji,jj,iku) ) ! i: 1 346 ELSE ; pgru(ji,jj) = ssumask(ji,jj) * ( prd(ji+1,jj,iku) - zri(ji,jj ) ) ! i: 2 347 ENDIF 348 IF( ze3wv >= 0._wp ) THEN ; pgrv(ji,jj) = ssvmask(ji,jj) * ( zrj(ji,jj ) - prd(ji,jj,ikv) ) ! j: 1 349 ELSE ; pgrv(ji,jj) = ssvmask(ji,jj) * ( prd(ji,jj+1,ikv) - zrj(ji,jj ) ) ! j: 2 350 ENDIF 351 352 END DO 353 END DO 330 DO_2D_10_10 331 iku = mbku(ji,jj) 332 ikv = mbkv(ji,jj) 333 ze3wu = gdept(ji+1,jj,iku,Kmm) - gdept(ji,jj,iku,Kmm) 334 ze3wv = gdept(ji,jj+1,ikv,Kmm) - gdept(ji,jj,ikv,Kmm) 335 336 IF( ze3wu >= 0._wp ) THEN ; pgru(ji,jj) = ssumask(ji,jj) * ( zri(ji ,jj ) - prd(ji,jj,iku) ) ! i: 1 337 ELSE ; pgru(ji,jj) = ssumask(ji,jj) * ( prd(ji+1,jj,iku) - zri(ji,jj ) ) ! i: 2 338 ENDIF 339 IF( ze3wv >= 0._wp ) THEN ; pgrv(ji,jj) = ssvmask(ji,jj) * ( zrj(ji,jj ) - prd(ji,jj,ikv) ) ! j: 1 340 ELSE ; pgrv(ji,jj) = ssvmask(ji,jj) * ( prd(ji,jj+1,ikv) - zrj(ji,jj ) ) ! j: 2 341 ENDIF 342 343 END_2D 354 344 355 345 CALL lbc_lnk_multi( 'zpshde', pgru , 'U', -1. , pgrv , 'V', -1. ) ! Lateral boundary conditions … … 360 350 ! 361 351 DO jn = 1, kjpt !== Interpolation of tracers at the last ocean level ==! ! 362 DO jj = 1, jpjm1 363 DO ji = 1, jpim1 364 iku = miku(ji,jj); ikup1 = miku(ji,jj) + 1 365 ikv = mikv(ji,jj); ikvp1 = mikv(ji,jj) + 1 366 ! 367 ! (ISF) case partial step top and bottom in adjacent cell in vertical 368 ! cannot used e3w because if 2 cell water column, we have ps at top and bottom 369 ! in this case e3w(i,j) - e3w(i,j+1) is not the distance between Tj~ and Tj 370 ! 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 374 ! i- direction 375 IF( ze3wu >= 0._wp ) THEN ! case 1 376 zmaxu = ze3wu / e3w_n(ji+1,jj,ikup1) 377 ! interpolated values of tracers 378 zti(ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikup1,jn) - pta(ji+1,jj,iku,jn) ) 379 ! gradient of tracers 380 pgtui(ji,jj,jn) = ssumask(ji,jj) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) 381 ELSE ! case 2 382 zmaxu = - ze3wu / e3w_n(ji,jj,ikup1) 383 ! interpolated values of tracers 384 zti(ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikup1,jn) - pta(ji,jj,iku,jn) ) 385 ! gradient of tracers 386 pgtui(ji,jj,jn) = ssumask(ji,jj) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) ) 387 ENDIF 388 ! 389 ! j- direction 390 IF( ze3wv >= 0._wp ) THEN ! case 1 391 zmaxv = ze3wv / e3w_n(ji,jj+1,ikvp1) 392 ! interpolated values of tracers 393 ztj(ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvp1,jn) - pta(ji,jj+1,ikv,jn) ) 394 ! gradient of tracers 395 pgtvi(ji,jj,jn) = ssvmask(ji,jj) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) 396 ELSE ! case 2 397 zmaxv = - ze3wv / e3w_n(ji,jj,ikvp1) 398 ! interpolated values of tracers 399 ztj(ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvp1,jn) - pta(ji,jj,ikv,jn) ) 400 ! gradient of tracers 401 pgtvi(ji,jj,jn) = ssvmask(ji,jj) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) ) 402 ENDIF 403 404 END DO 405 END DO 352 DO_2D_10_10 353 iku = miku(ji,jj); ikup1 = miku(ji,jj) + 1 354 ikv = mikv(ji,jj); ikvp1 = mikv(ji,jj) + 1 355 ! 356 ! (ISF) case partial step top and bottom in adjacent cell in vertical 357 ! cannot used e3w because if 2 cell water column, we have ps at top and bottom 358 ! in this case e3w(i,j) - e3w(i,j+1) is not the distance between Tj~ and Tj 359 ! the only common depth between cells (i,j) and (i,j+1) is gdepw_0 360 ze3wu = gdept(ji,jj,iku,Kmm) - gdept(ji+1,jj,iku,Kmm) 361 ze3wv = gdept(ji,jj,ikv,Kmm) - gdept(ji,jj+1,ikv,Kmm) 362 363 ! i- direction 364 IF( ze3wu >= 0._wp ) THEN ! case 1 365 zmaxu = ze3wu / e3w(ji+1,jj,ikup1,Kmm) 366 ! interpolated values of tracers 367 zti(ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikup1,jn) - pta(ji+1,jj,iku,jn) ) 368 ! gradient of tracers 369 pgtui(ji,jj,jn) = ssumask(ji,jj) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) 370 ELSE ! case 2 371 zmaxu = - ze3wu / e3w(ji,jj,ikup1,Kmm) 372 ! interpolated values of tracers 373 zti(ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikup1,jn) - pta(ji,jj,iku,jn) ) 374 ! gradient of tracers 375 pgtui(ji,jj,jn) = ssumask(ji,jj) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) ) 376 ENDIF 377 ! 378 ! j- direction 379 IF( ze3wv >= 0._wp ) THEN ! case 1 380 zmaxv = ze3wv / e3w(ji,jj+1,ikvp1,Kmm) 381 ! interpolated values of tracers 382 ztj(ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvp1,jn) - pta(ji,jj+1,ikv,jn) ) 383 ! gradient of tracers 384 pgtvi(ji,jj,jn) = ssvmask(ji,jj) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) 385 ELSE ! case 2 386 zmaxv = - ze3wv / e3w(ji,jj,ikvp1,Kmm) 387 ! interpolated values of tracers 388 ztj(ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvp1,jn) - pta(ji,jj,ikv,jn) ) 389 ! gradient of tracers 390 pgtvi(ji,jj,jn) = ssvmask(ji,jj) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) ) 391 ENDIF 392 393 END_2D 406 394 ! 407 395 END DO … … 411 399 ! 412 400 pgrui(:,:) =0.0_wp; pgrvi(:,:) =0.0_wp; 413 DO jj = 1, jpjm1 414 DO ji = 1, jpim1 415 416 iku = miku(ji,jj) 417 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 1 422 ELSE ; zhi(ji,jj) = gdept_n(ji+1,jj,iku) ! - - case 2 423 ENDIF 424 425 IF( ze3wv >= 0._wp ) THEN ; zhj(ji,jj) = gdept_n(ji,jj ,ikv) ! j-direction: case 1 426 ELSE ; zhj(ji,jj) = gdept_n(ji,jj+1,ikv) ! - - case 2 427 ENDIF 428 429 END DO 430 END DO 401 DO_2D_10_10 402 403 iku = miku(ji,jj) 404 ikv = mikv(ji,jj) 405 ze3wu = gdept(ji,jj,iku,Kmm) - gdept(ji+1,jj,iku,Kmm) 406 ze3wv = gdept(ji,jj,ikv,Kmm) - gdept(ji,jj+1,ikv,Kmm) 407 ! 408 IF( ze3wu >= 0._wp ) THEN ; zhi(ji,jj) = gdept(ji ,jj,iku,Kmm) ! i-direction: case 1 409 ELSE ; zhi(ji,jj) = gdept(ji+1,jj,iku,Kmm) ! - - case 2 410 ENDIF 411 412 IF( ze3wv >= 0._wp ) THEN ; zhj(ji,jj) = gdept(ji,jj ,ikv,Kmm) ! j-direction: case 1 413 ELSE ; zhj(ji,jj) = gdept(ji,jj+1,ikv,Kmm) ! - - case 2 414 ENDIF 415 416 END_2D 431 417 ! 432 418 CALL eos( zti, zhi, zri ) ! interpolated density from zti, ztj 433 419 CALL eos( ztj, zhj, zrj ) ! at the partial step depth output in zri, zrj 434 420 ! 435 DO jj = 1, jpjm1 ! Gradient of density at the last level 436 DO ji = 1, jpim1 437 iku = miku(ji,jj) 438 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 442 IF( ze3wu >= 0._wp ) THEN ; pgrui(ji,jj) = ssumask(ji,jj) * ( zri(ji ,jj ) - prd(ji,jj,iku) ) ! i: 1 443 ELSE ; pgrui(ji,jj) = ssumask(ji,jj) * ( prd(ji+1,jj ,iku) - zri(ji,jj ) ) ! i: 2 444 ENDIF 445 IF( ze3wv >= 0._wp ) THEN ; pgrvi(ji,jj) = ssvmask(ji,jj) * ( zrj(ji ,jj ) - prd(ji,jj,ikv) ) ! j: 1 446 ELSE ; pgrvi(ji,jj) = ssvmask(ji,jj) * ( prd(ji ,jj+1,ikv) - zrj(ji,jj ) ) ! j: 2 447 ENDIF 448 449 END DO 450 END DO 421 DO_2D_10_10 422 iku = miku(ji,jj) 423 ikv = mikv(ji,jj) 424 ze3wu = gdept(ji,jj,iku,Kmm) - gdept(ji+1,jj,iku,Kmm) 425 ze3wv = gdept(ji,jj,ikv,Kmm) - gdept(ji,jj+1,ikv,Kmm) 426 427 IF( ze3wu >= 0._wp ) THEN ; pgrui(ji,jj) = ssumask(ji,jj) * ( zri(ji ,jj ) - prd(ji,jj,iku) ) ! i: 1 428 ELSE ; pgrui(ji,jj) = ssumask(ji,jj) * ( prd(ji+1,jj ,iku) - zri(ji,jj ) ) ! i: 2 429 ENDIF 430 IF( ze3wv >= 0._wp ) THEN ; pgrvi(ji,jj) = ssvmask(ji,jj) * ( zrj(ji ,jj ) - prd(ji,jj,ikv) ) ! j: 1 431 ELSE ; pgrvi(ji,jj) = ssvmask(ji,jj) * ( prd(ji ,jj+1,ikv) - zrj(ji,jj ) ) ! j: 2 432 ENDIF 433 434 END_2D 451 435 CALL lbc_lnk_multi( 'zpshde', pgrui, 'U', -1. , pgrvi, 'V', -1. ) ! Lateral boundary conditions 452 436 !
Note: See TracChangeset
for help on using the changeset viewer.
