- Timestamp:
- 2015-03-31T19:58:23+02:00 (9 years ago)
- Location:
- branches/2015/dev_r5151_UKMO_ISF/NEMOGCM/NEMO/OPA_SRC/TRA
- Files:
-
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5151_UKMO_ISF/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90
r5147 r5189 851 851 pn2(ji,jj,jk) = grav * ( zaw * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) ) & 852 852 & - zbw * ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) ) ) & 853 & / fse3w(ji,jj,jk) * tmask(ji,jj,jk)853 & / fse3w(ji,jj,jk) * wmask(ji,jj,jk) 854 854 END DO 855 855 END DO -
branches/2015/dev_r5151_UKMO_ISF/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90
r5149 r5189 108 108 REAL(wp) :: zmskv, zabe2, zcof2, zcoef4 ! - - 109 109 REAL(wp) :: zcoef0, zbtr, ztra ! - - 110 REAL(wp), POINTER, DIMENSION(:,: ) :: z 2d111 REAL(wp), POINTER, DIMENSION(:,:,:) :: zd kt, zdk1t, zdit, zdjt, ztfw110 REAL(wp), POINTER, DIMENSION(:,: ) :: zdkt, zdk1t, z2d 111 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdit, zdjt , ztfw 112 112 !!---------------------------------------------------------------------- 113 113 ! 114 114 IF( nn_timing == 1 ) CALL timing_start('tra_ldf_iso') 115 115 ! 116 CALL wrk_alloc( jpi, jpj, z 2d)117 CALL wrk_alloc( jpi, jpj, jpk, zdit, zdjt , ztfw, zdkt, zdk1t)116 CALL wrk_alloc( jpi, jpj, zdkt, zdk1t, z2d ) 117 CALL wrk_alloc( jpi, jpj, jpk, zdit, zdjt , ztfw ) 118 118 ! 119 119 … … 168 168 !! II - horizontal trend (full) 169 169 !!---------------------------------------------------------------------- 170 !!!!!!!!!!CDIR PARALLEL DO PRIVATE( zdk1t ) 170 !CDIR PARALLEL DO PRIVATE( zdk1t ) 171 ! ! =============== 172 DO jk = 1, jpkm1 ! Horizontal slab 173 ! ! =============== 171 174 ! 1. Vertical tracer gradient at level jk and jk+1 172 175 ! ------------------------------------------------ 173 ! 174 ! interior value 175 DO jk = 2, jpkm1 176 DO jj = 1, jpj 177 DO ji = 1, jpi ! vector opt. 178 zdk1t(ji,jj,jk) = ( ptb(ji,jj,jk,jn ) - ptb(ji,jj,jk+1,jn) ) * wmask(ji,jj,jk+1) 179 ! 180 zdkt(ji,jj,jk) = ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn ) ) * wmask(ji,jj,jk) 181 END DO 182 END DO 183 END DO 184 ! surface boundary condition: zdkt(jk=1)=zdkt(jk=2) 185 zdk1t(:,:,1) = ( ptb(:,:,1,jn ) - ptb(:,:,2,jn) ) * wmask(:,:,2) 186 zdkt (:,:,1) = zdk1t(:,:,1) 187 IF ( ln_isfcav ) THEN 188 DO jj = 1, jpj 189 DO ji = 1, jpi ! vector opt. 190 ikt = mikt(ji,jj) ! surface level 191 zdk1t(ji,jj,ikt) = ( ptb(ji,jj,ikt,jn ) - ptb(ji,jj,ikt+1,jn) ) * wmask(ji,jj,ikt+1) 192 zdkt (ji,jj,ikt) = zdk1t(ji,jj,ikt) 193 END DO 194 END DO 195 END IF 196 197 ! 2. Horizontal fluxes 198 ! -------------------- 199 DO jk = 1, jpkm1 176 ! surface boundary condition: zdkt(jk=1)=zdkt(jk=2) 177 zdk1t(:,:) = ( ptb(:,:,jk,jn) - ptb(:,:,jk+1,jn) ) * wmask(:,:,jk+1) 178 ! 179 IF( jk == 1 ) THEN ; zdkt(:,:) = zdk1t(:,:) 180 ELSE ; zdkt(:,:) = ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) ) * wmask(:,:,jk) 181 ENDIF 182 183 ! 2. Horizontal fluxes 184 ! -------------------- 200 185 DO jj = 1 , jpjm1 201 186 DO ji = 1, fs_jpim1 ! vector opt. … … 203 188 zabe2 = ( fsahtv(ji,jj,jk) + pahtb0 ) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,jk) 204 189 ! 205 zmsku = 1. / MAX( tmask(ji+1,jj,jk ) + tmask(ji,jj,jk+1) &206 & + tmask(ji+1,jj,jk+1) + tmask(ji,jj,jk ), 1. )207 ! 208 zmskv = 1. / MAX( tmask(ji,jj+1,jk ) + tmask(ji,jj,jk+1) &209 & + tmask(ji,jj+1,jk+1) + tmask(ji,jj,jk ), 1. )190 zmsku = 1. / MAX( wmask(ji+1,jj,jk ) + wmask(ji,jj,jk+1) & 191 & + wmask(ji+1,jj,jk+1) + wmask(ji,jj,jk ), 1. ) 192 ! 193 zmskv = 1. / MAX( wmask(ji,jj+1,jk ) + wmask(ji,jj,jk+1) & 194 & + wmask(ji,jj+1,jk+1) + wmask(ji,jj,jk ), 1. ) 210 195 ! 211 196 zcof1 = - fsahtu(ji,jj,jk) * e2u(ji,jj) * uslp(ji,jj,jk) * zmsku … … 213 198 ! 214 199 zftu(ji,jj,jk ) = ( zabe1 * zdit(ji,jj,jk) & 215 & + zcof1 * ( zdkt (ji+1,jj ,jk) + zdk1t(ji,jj,jk) &216 & + zdk1t(ji+1,jj ,jk) + zdkt (ji,jj,jk) ) ) * umask(ji,jj,jk)200 & + zcof1 * ( zdkt (ji+1,jj ) + zdk1t(ji,jj) & 201 & + zdk1t(ji+1,jj ) + zdkt (ji,jj) ) ) * umask(ji,jj,jk) 217 202 zftv(ji,jj,jk) = ( zabe2 * zdjt(ji,jj,jk) & 218 & + zcof2 * ( zdkt (ji ,jj+1,jk) + zdk1t(ji,jj,jk) &219 & + zdk1t(ji ,jj+1,jk) + zdkt (ji,jj,jk) ) ) * vmask(ji,jj,jk)203 & + zcof2 * ( zdkt (ji ,jj+1) + zdk1t(ji,jj) & 204 & + zdk1t(ji ,jj+1) + zdkt (ji,jj) ) ) * vmask(ji,jj,jk) 220 205 END DO 221 206 END DO … … 322 307 END DO 323 308 ! 324 CALL wrk_dealloc( jpi, jpj, z2d)325 CALL wrk_dealloc( jpi, jpj, jpk, zdit, zdjt , ztfw, zdkt, zdk1t)309 CALL wrk_dealloc( jpi, jpj, zdkt, zdk1t, z2d ) 310 CALL wrk_dealloc( jpi, jpj, jpk, zdit, zdjt , ztfw ) 326 311 ! 327 312 IF( nn_timing == 1 ) CALL timing_stop('tra_ldf_iso') -
branches/2015/dev_r5151_UKMO_ISF/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90
r5120 r5189 222 222 ! 223 223 IF( nn_isf > 0 ) THEN 224 zfact = 0.5 e0224 zfact = 0.5_wp 225 225 DO jj = 2, jpj 226 226 DO ji = fs_2, fs_jpim1 … … 235 235 ! compute tfreez for the temperature correction (we add water at freezing temperature) 236 236 ! zpress = grav*rau0*fsdept(ji,jj,jk)*1.e-04 237 zt_frz = -1.9 !eos_fzp( tsn(ji,jj,jk,jp_sal), zpress )237 zt_frz = -1.9_wp !eos_fzp( tsn(ji,jj,jk,jp_sal), zpress ) 238 238 ! compute trend 239 tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) &240 & + zfact * ( risf_tsc_b(ji,jj,jp_tem) + risf_tsc(ji,jj,jp_tem)&241 & - rdivisf * (fwfisf(ji,jj) + fwfisf_b(ji,jj)) * zt_frz * r1_rau0) &239 tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) & 240 & + zfact * ( risf_tsc_b(ji,jj,jp_tem) + risf_tsc(ji,jj,jp_tem) & 241 & - rdivisf * (fwfisf(ji,jj) + fwfisf_b(ji,jj)) * zt_frz * r1_rau0) & 242 242 & * r1_hisf_tbl(ji,jj) 243 tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) & 244 & + zfact * (risf_tsc_b(ji,jj,jp_sal) + risf_tsc(ji,jj,jp_sal)) * r1_hisf_tbl(ji,jj) 243 tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) & 244 & + zfact * (risf_tsc_b(ji,jj,jp_sal) + risf_tsc(ji,jj,jp_sal)) & 245 & * r1_hisf_tbl(ji,jj) 245 246 END DO 246 247 … … 248 249 ! compute tfreez for the temperature correction (we add water at freezing temperature) 249 250 ! zpress = grav*rau0*fsdept(ji,jj,ikb)*1.e-04 250 zt_frz = -1.9 !eos_fzp( tsn(ji,jj,ikb,jp_sal), zpress )251 zt_frz = -1.9_wp !eos_fzp( tsn(ji,jj,ikb,jp_sal), zpress ) 251 252 ! compute trend 252 tsa(ji,jj,ikb,jp_tem) = tsa(ji,jj,ikb,jp_tem) &253 & + zfact * ( risf_tsc_b(ji,jj,jp_tem) + risf_tsc(ji,jj,jp_tem)&254 & - rdivisf * (fwfisf(ji,jj) + fwfisf_b(ji,jj)) * zt_frz * r1_rau0) &253 tsa(ji,jj,ikb,jp_tem) = tsa(ji,jj,ikb,jp_tem) & 254 & + zfact * ( risf_tsc_b(ji,jj,jp_tem) + risf_tsc(ji,jj,jp_tem) & 255 & - rdivisf * (fwfisf(ji,jj) + fwfisf_b(ji,jj)) * zt_frz * r1_rau0) & 255 256 & * r1_hisf_tbl(ji,jj) * ralpha(ji,jj) 256 tsa(ji,jj,ikb,jp_sal) = tsa(ji,jj,ikb,jp_sal) & 257 & + zfact * (risf_tsc_b(ji,jj,jp_sal) + risf_tsc(ji,jj,jp_sal)) * r1_hisf_tbl(ji,jj) * ralpha(ji,jj) 257 tsa(ji,jj,ikb,jp_sal) = tsa(ji,jj,ikb,jp_sal) & 258 & + zfact * (risf_tsc_b(ji,jj,jp_sal) + risf_tsc(ji,jj,jp_sal)) & 259 & * r1_hisf_tbl(ji,jj) * ralpha(ji,jj) 260 258 261 END DO 259 262 END DO -
branches/2015/dev_r5151_UKMO_ISF/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90
r5120 r5189 196 196 END SUBROUTINE zps_hde 197 197 ! 198 SUBROUTINE zps_hde_isf( kt, kjpt, pta, pgtu, pgtv, & 199 & prd, pgru, pgrv, pmru, pmrv, pgzu, pgzv, pge3ru, pge3rv, & 200 & pgtui, pgtvi, pgrui, pgrvi, pmrui, pmrvi, pgzui, pgzvi, pge3rui, pge3rvi ) 198 SUBROUTINE zps_hde_isf( kt, kjpt, pta, pgtu, pgtv, pgtui, pgtvi, & 199 & prd, pgru, pgrv, pgrui, pgrvi ) 201 200 !!---------------------------------------------------------------------- 202 201 !! *** ROUTINE zps_hde *** … … 252 251 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ), OPTIONAL :: prd ! 3D density anomaly fields 253 252 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pgru, pgrv ! hor. grad of prd at u- & v-pts (bottom) 254 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pmru, pmrv ! hor. sum of prd at u- & v-pts (bottom)255 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pgzu, pgzv ! hor. grad of z at u- & v-pts (bottom)256 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pge3ru, pge3rv ! hor. grad of prd weighted by local e3w at u- & v-pts (bottom)257 253 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pgrui, pgrvi ! hor. grad of prd at u- & v-pts (top) 258 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pmrui, pmrvi ! hor. sum of prd at u- & v-pts (top)259 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pgzui, pgzvi ! hor. grad of z at u- & v-pts (top)260 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pge3rui, pge3rvi ! hor. grad of prd weighted by local e3w at u- & v-pts (top)261 254 ! 262 255 INTEGER :: ji, jj, jn ! Dummy loop indices … … 269 262 IF( nn_timing == 1 ) CALL timing_start( 'zps_hde_isf') 270 263 ! 271 pgtu (:,:,:)=0.0_wp ; pgtv(:,:,:)=0.0_wp ;264 pgtu (:,:,:)=0.0_wp ; pgtv(:,:,:) =0.0_wp ; 272 265 pgtui(:,:,:)=0.0_wp ; pgtvi(:,:,:)=0.0_wp ; 273 zti (:,:,:)=0.0_wp ; ztj(:,:,:)=0.0_wp ;274 zhi (:,: )=0.0_wp ; zhj(:,: )=0.0_wp ;266 zti (:,:,:)=0.0_wp ; ztj (:,:,:)=0.0_wp ; 267 zhi (:,: )=0.0_wp ; zhj (:,: )=0.0_wp ; 275 268 ! 276 269 DO jn = 1, kjpt !== Interpolation of tracers at the last ocean level ==! … … 280 273 iku = mbku(ji,jj) ; ikum1 = MAX( iku - 1 , 1 ) ! last and before last ocean level at u- & v-points 281 274 ikv = mbkv(ji,jj) ; ikvm1 = MAX( ikv - 1 , 1 ) ! if level first is a p-step, ik.m1=1 275 ze3wu = gdept_0(ji+1,jj,iku) - gdept_0(ji,jj,iku) 276 ze3wv = gdept_0(ji,jj+1,ikv) - gdept_0(ji,jj,ikv) 277 ! 278 ! i- direction 279 IF( ze3wu >= 0._wp ) THEN ! case 1 280 zmaxu = ze3wu / fse3w(ji+1,jj,iku) 281 ! interpolated values of tracers 282 zti (ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) ) 283 ! gradient of tracers 284 pgtu(ji,jj,jn) = umask(ji,jj,1) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) 285 ELSE ! case 2 286 zmaxu = -ze3wu / fse3w(ji,jj,iku) 287 ! interpolated values of tracers 288 zti (ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) ) 289 ! gradient of tracers 290 pgtu(ji,jj,jn) = umask(ji,jj,1) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) ) 291 ENDIF 292 ! 293 ! j- direction 294 IF( ze3wv >= 0._wp ) THEN ! case 1 295 zmaxv = ze3wv / fse3w(ji,jj+1,ikv) 296 ! interpolated values of tracers 297 ztj (ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) ) 298 ! gradient of tracers 299 pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) 300 ELSE ! case 2 301 zmaxv = -ze3wv / fse3w(ji,jj,ikv) 302 ! interpolated values of tracers 303 ztj (ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) ) 304 ! gradient of tracers 305 pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) ) 306 ENDIF 307 END DO 308 END DO 309 CALL lbc_lnk( pgtu(:,:,jn), 'U', -1. ) ; CALL lbc_lnk( pgtv(:,:,jn), 'V', -1. ) ! Lateral boundary cond. 310 ! 311 END DO 312 313 ! horizontal derivative of density anomalies (rd) 314 IF( PRESENT( prd ) ) THEN ! depth of the partial step level 315 pgru(:,:)=0.0_wp ; pgrv(:,:)=0.0_wp ; 316 ! 317 DO jj = 1, jpjm1 318 DO ji = 1, jpim1 319 iku = mbku(ji,jj) 320 ikv = mbkv(ji,jj) 321 ze3wu = gdept_0(ji+1,jj,iku) - gdept_0(ji,jj,iku) 322 ze3wv = gdept_0(ji,jj+1,ikv) - gdept_0(ji,jj,ikv) 323 324 IF( ze3wu >= 0._wp ) THEN ; zhi(ji,jj) = fsdept(ji+1,jj,iku) + ze3wu ! i-direction: case 1 325 ELSE ; zhi(ji,jj) = fsdept(ji ,jj,iku) - ze3wu ! - - case 2 326 ENDIF 327 IF( ze3wv >= 0._wp ) THEN ; zhj(ji,jj) = fsdept(ji,jj+1,ikv) + ze3wv ! j-direction: case 1 328 ELSE ; zhj(ji,jj) = fsdept(ji,jj ,ikv) - ze3wv ! - - case 2 329 ENDIF 330 331 END DO 332 END DO 333 334 ! Compute interpolated rd from zti, ztj for the 2 cases at the depth of the partial 335 ! step and store it in zri, zrj for each case 336 CALL eos( zti, zhi, zri ) 337 CALL eos( ztj, zhj, zrj ) 338 339 ! Gradient of density at the last level 340 DO jj = 1, jpjm1 341 DO ji = 1, jpim1 342 iku = mbku(ji,jj) 343 ikv = mbkv(ji,jj) 344 ze3wu = gdept_0(ji+1,jj,iku) - gdept_0(ji,jj,iku) 345 ze3wv = gdept_0(ji,jj+1,ikv) - gdept_0(ji,jj,ikv) 346 347 IF( ze3wu >= 0._wp ) THEN ; pgru(ji,jj) = umask(ji,jj,1) * ( zri(ji ,jj ) - prd(ji,jj,iku) ) ! i: 1 348 ELSE ; pgru(ji,jj) = umask(ji,jj,1) * ( prd(ji+1,jj,iku) - zri(ji,jj ) ) ! i: 2 349 ENDIF 350 IF( ze3wv >= 0._wp ) THEN ; pgrv(ji,jj) = vmask(ji,jj,1) * ( zrj(ji,jj ) - prd(ji,jj,ikv) ) ! j: 1 351 ELSE ; pgrv(ji,jj) = vmask(ji,jj,1) * ( prd(ji,jj+1,ikv) - zrj(ji,jj ) ) ! j: 2 352 ENDIF 353 END DO 354 END DO 355 CALL lbc_lnk( pgru , 'U', -1. ) ; CALL lbc_lnk( pgrv , 'V', -1. ) ! Lateral boundary conditions 356 ! 357 END IF 358 ! (ISH) compute grui and gruvi 359 DO jn = 1, kjpt !== Interpolation of tracers at the last ocean level ==! ! 360 DO jj = 1, jpjm1 361 DO ji = 1, jpim1 362 iku = miku(ji,jj) ; ikup1 = miku(ji,jj) + 1 363 ikv = mikv(ji,jj) ; ikvp1 = mikv(ji,jj) + 1 364 ! 282 365 ! (ISF) case partial step top and bottom in adjacent cell in vertical 283 366 ! cannot used e3w because if 2 cell water column, we have ps at top and bottom 284 367 ! in this case e3w(i,j) - e3w(i,j+1) is not the distance between Tj~ and Tj 285 368 ! the only common depth between cells (i,j) and (i,j+1) is gdepw_0 286 ze3wu = (gdept_0(ji+1,jj,iku) - gdepw_0(ji+1,jj,iku)) - (gdept_0(ji,jj,iku) - gdepw_0(ji,jj,iku)) 287 ze3wv = (gdept_0(ji,jj+1,ikv) - gdepw_0(ji,jj+1,ikv)) - (gdept_0(ji,jj,ikv) - gdepw_0(ji,jj,ikv)) 288 ! 369 ze3wu = gdept_0(ji,jj,iku) - gdept_0(ji+1,jj,iku) 370 ze3wv = gdept_0(ji,jj,ikv) - gdept_0(ji,jj+1,ikv) 289 371 ! i- direction 290 372 IF( ze3wu >= 0._wp ) THEN ! case 1 291 zmaxu = ze3wu / fse3w(ji+1,jj,iku) 292 ! interpolated values of tracers 293 zti (ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) ) 373 zmaxu = ze3wu / fse3w(ji+1,jj,iku+1) 374 ! interpolated values of tracers 375 zti(ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,iku+1,jn) - pta(ji+1,jj,iku,jn) ) 376 ! gradient of tracers 377 pgtui(ji,jj,jn) = umask(ji,jj,iku) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) 378 ELSE ! case 2 379 zmaxu = - ze3wu / fse3w(ji,jj,iku+1) 380 ! interpolated values of tracers 381 zti(ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,iku+1,jn) - pta(ji,jj,iku,jn) ) 294 382 ! gradient of tracers 295 pgtu(ji,jj,jn) = umask(ji,jj,iku) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) 296 ELSE ! case 2 297 zmaxu = -ze3wu / fse3w(ji,jj,iku) 298 ! interpolated values of tracers 299 zti (ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) ) 300 ! gradient of tracers 301 pgtu(ji,jj,jn) = umask(ji,jj,iku) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) ) 383 pgtui(ji,jj,jn) = umask(ji,jj,iku) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) ) 302 384 ENDIF 303 385 ! 304 386 ! j- direction 305 387 IF( ze3wv >= 0._wp ) THEN ! case 1 306 zmaxv = ze3wv / fse3w(ji,jj+1,ikv )307 ! interpolated values of tracers 308 ztj (ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) )309 ! gradient of tracers 310 pgtv (ji,jj,jn) = vmask(ji,jj,ikv) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) )311 ELSE ! case 2 312 zmaxv = - ze3wv / fse3w(ji,jj,ikv)313 ! interpolated values of tracers 314 ztj (ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) )315 ! gradient of tracers 316 pgtv (ji,jj,jn) = vmask(ji,jj,ikv) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) )317 ENDIF 318 END DO 319 END DO 320 CALL lbc_lnk( pgtu (:,:,jn), 'U', -1. ) ; CALL lbc_lnk( pgtv(:,:,jn), 'V', -1. ) ! Lateral boundary cond.388 zmaxv = ze3wv / fse3w(ji,jj+1,ikv+1) 389 ! interpolated values of tracers 390 ztj(ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikv+1,jn) - pta(ji,jj+1,ikv,jn) ) 391 ! gradient of tracers 392 pgtvi(ji,jj,jn) = vmask(ji,jj,ikv) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) 393 ELSE ! case 2 394 zmaxv = - ze3wv / fse3w(ji,jj,ikv+1) 395 ! interpolated values of tracers 396 ztj(ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikv+1,jn) - pta(ji,jj,ikv,jn) ) 397 ! gradient of tracers 398 pgtvi(ji,jj,jn) = vmask(ji,jj,ikv) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) ) 399 ENDIF 400 END DO!! 401 END DO!! 402 CALL lbc_lnk( pgtui(:,:,jn), 'U', -1. ) ; CALL lbc_lnk( pgtvi(:,:,jn), 'V', -1. ) ! Lateral boundary cond. 321 403 ! 322 404 END DO … … 324 406 ! horizontal derivative of density anomalies (rd) 325 407 IF( PRESENT( prd ) ) THEN ! depth of the partial step level 326 pgru(:,:)=0.0_wp ; pgrv(:,:)=0.0_wp ; 327 pgzu(:,:)=0.0_wp ; pgzv(:,:)=0.0_wp ; 328 pmru(:,:)=0.0_wp ; pmru(:,:)=0.0_wp ; 329 pge3ru(:,:)=0.0_wp ; pge3rv(:,:)=0.0_wp ; 330 DO jj = 1, jpjm1 331 DO ji = 1, jpim1 332 iku = mbku(ji,jj) 333 ikv = mbkv(ji,jj) 334 ze3wu = (gdept_0(ji+1,jj,iku) - gdepw_0(ji+1,jj,iku)) - (gdept_0(ji,jj,iku) - gdepw_0(ji,jj,iku)) 335 ze3wv = (gdept_0(ji,jj+1,ikv) - gdepw_0(ji,jj+1,ikv)) - (gdept_0(ji,jj,ikv) - gdepw_0(ji,jj,ikv)) 336 337 IF( ze3wu >= 0._wp ) THEN ; zhi(ji,jj) = fsdept(ji+1,jj,iku) - ze3wu ! i-direction: case 1 338 ELSE ; zhi(ji,jj) = fsdept(ji ,jj,iku) + ze3wu ! - - case 2 339 ENDIF 340 IF( ze3wv >= 0._wp ) THEN ; zhj(ji,jj) = fsdept(ji,jj+1,ikv) - ze3wv ! j-direction: case 1 341 ELSE ; zhj(ji,jj) = fsdept(ji,jj ,ikv) + ze3wv ! - - case 2 342 ENDIF 343 END DO 344 END DO 345 408 pgrui(:,:) =0.0_wp ; pgrvi(:,:) =0.0_wp ; 409 DO jj = 1, jpjm1 410 DO ji = 1, jpim1 411 iku = miku(ji,jj) 412 ikv = mikv(ji,jj) 413 ze3wu = gdept_0(ji,jj,iku) - gdept_0(ji+1,jj,iku) 414 ze3wv = gdept_0(ji,jj,ikv) - gdept_0(ji,jj+1,ikv) 415 416 IF( ze3wu >= 0._wp ) THEN ; zhi(ji,jj) = fsdept(ji+1,jj,iku) + ze3wu ! i-direction: case 1 417 ELSE ; zhi(ji,jj) = fsdept(ji ,jj,iku) - ze3wu ! - - case 2 418 ENDIF 419 420 IF( ze3wv >= 0._wp ) THEN ; zhj(ji,jj) = fsdept(ji,jj+1,ikv) + ze3wv ! j-direction: case 1 421 ELSE ; zhj(ji,jj) = fsdept(ji,jj ,ikv) - ze3wv ! - - case 2 422 ENDIF 423 424 END DO 425 END DO 426 346 427 ! Compute interpolated rd from zti, ztj for the 2 cases at the depth of the partial 347 428 ! step and store it in zri, zrj for each case … … 352 433 DO jj = 1, jpjm1 353 434 DO ji = 1, jpim1 354 iku = mbku(ji,jj) ; ikum1 = MAX( iku - 1 , 1 ) ! last and before last ocean level at u- & v-points355 ikv = mbkv(ji,jj) ; ikvm1 = MAX( ikv - 1 , 1 ) ! last and before last ocean level at u- & v-points356 ze3wu = (gdept_0(ji+1,jj,iku) - gdepw_0(ji+1,jj,iku)) - (gdept_0(ji,jj,iku) - gdepw_0(ji,jj,iku))357 ze3wv = (gdept_0(ji,jj+1,ikv) - gdepw_0(ji,jj+1,ikv)) - (gdept_0(ji,jj,ikv) - gdepw_0(ji,jj,ikv))358 IF( ze3wu >= 0._wp ) THEN359 pgzu(ji,jj) = (fsde3w(ji+1,jj,iku) - ze3wu) - fsde3w(ji,jj,iku)360 pgru(ji,jj) = umask(ji,jj,iku) * ( zri(ji ,jj) - prd(ji,jj,iku) ) ! i: 1361 pmru(ji,jj) = umask(ji,jj,iku) * ( zri(ji ,jj) + prd(ji,jj,iku) ) ! i: 1362 pge3ru(ji,jj) = umask(ji,jj,iku) &363 * ( (fse3w(ji+1,jj,iku) - ze3wu )* ( zri(ji ,jj ) + prd(ji+1,jj,ikum1) + 2._wp) &364 - fse3w(ji ,jj,iku) * ( prd(ji ,jj,iku) + prd(ji ,jj,ikum1) + 2._wp) ) ! j: 2365 ELSE366 pgzu(ji,jj) = fsde3w(ji+1,jj,iku) - (fsde3w(ji,jj,iku) + ze3wu)367 pgru(ji,jj) = umask(ji,jj,iku) * ( prd(ji+1,jj,iku) - zri(ji,jj) ) ! i: 2368 pmru(ji,jj) = umask(ji,jj,iku) * ( prd(ji+1,jj,iku) + zri(ji,jj) ) ! i: 2369 pge3ru(ji,jj) = umask(ji,jj,iku) &370 * ( fse3w(ji+1,jj,iku) * ( prd(ji+1,jj,iku) + prd(ji+1,jj,ikum1) + 2._wp) &371 -(fse3w(ji ,jj,iku) + ze3wu) * ( zri(ji ,jj ) + prd(ji ,jj,ikum1) + 2._wp) ) ! j: 2372 ENDIF373 IF( ze3wv >= 0._wp ) THEN374 pgzv(ji,jj) = (fsde3w(ji,jj+1,ikv) - ze3wv) - fsde3w(ji,jj,ikv)375 pgrv(ji,jj) = vmask(ji,jj,ikv) * ( zrj(ji,jj ) - prd(ji,jj,ikv) ) ! j: 1376 pmrv(ji,jj) = vmask(ji,jj,ikv) * ( zrj(ji,jj ) + prd(ji,jj,ikv) ) ! j: 1377 pge3rv(ji,jj) = vmask(ji,jj,ikv) &378 * ( (fse3w(ji,jj+1,ikv) - ze3wv )* ( zrj(ji,jj ) + prd(ji,jj+1,ikvm1) + 2._wp) &379 - fse3w(ji,jj ,ikv) * ( prd(ji,jj ,ikv) + prd(ji,jj ,ikvm1) + 2._wp) ) ! j: 2380 ELSE381 pgzv(ji,jj) = fsde3w(ji,jj+1,ikv) - (fsde3w(ji,jj,ikv) + ze3wv)382 pgrv(ji,jj) = vmask(ji,jj,ikv) * ( prd(ji,jj+1,ikv) - zrj(ji,jj) ) ! j: 2383 pmrv(ji,jj) = vmask(ji,jj,ikv) * ( prd(ji,jj+1,ikv) + zrj(ji,jj) ) ! j: 2384 pge3rv(ji,jj) = vmask(ji,jj,ikv) &385 * ( fse3w(ji,jj+1,ikv) * ( prd(ji,jj+1,ikv) + prd(ji,jj+1,ikvm1) + 2._wp) &386 -(fse3w(ji,jj ,ikv) + ze3wv) * ( zrj(ji,jj ) + prd(ji,jj ,ikvm1) + 2._wp) ) ! j: 2387 ENDIF388 END DO389 END DO390 CALL lbc_lnk( pgru , 'U', -1. ) ; CALL lbc_lnk( pgrv , 'V', -1. ) ! Lateral boundary conditions391 CALL lbc_lnk( pmru , 'U', 1. ) ; CALL lbc_lnk( pmrv , 'V', 1. ) ! Lateral boundary conditions392 CALL lbc_lnk( pgzu , 'U', -1. ) ; CALL lbc_lnk( pgzv , 'V', -1. ) ! Lateral boundary conditions393 CALL lbc_lnk( pge3ru , 'U', -1. ) ; CALL lbc_lnk( pge3rv , 'V', -1. ) ! Lateral boundary conditions394 !395 END IF396 ! (ISH) compute grui and gruvi397 DO jn = 1, kjpt !== Interpolation of tracers at the last ocean level ==! !398 DO jj = 1, jpjm1399 DO ji = 1, jpim1400 iku = miku(ji,jj) ; ikup1 = miku(ji,jj) + 1401 ikv = mikv(ji,jj) ; ikvp1 = mikv(ji,jj) + 1402 !403 ! (ISF) case partial step top and bottom in adjacent cell in vertical404 ! cannot used e3w because if 2 cell water column, we have ps at top and bottom405 ! in this case e3w(i,j) - e3w(i,j+1) is not the distance between Tj~ and Tj406 ! the only common depth between cells (i,j) and (i,j+1) is gdepw_0407 ze3wu = (gdepw_0(ji+1,jj,iku+1) - gdept_0(ji+1,jj,iku)) - (gdepw_0(ji,jj,iku+1) - gdept_0(ji,jj,iku))408 ze3wv = (gdepw_0(ji,jj+1,ikv+1) - gdept_0(ji,jj+1,ikv)) - (gdepw_0(ji,jj,ikv+1) - gdept_0(ji,jj,ikv))409 ! i- direction410 IF( ze3wu >= 0._wp ) THEN ! case 1411 zmaxu = ze3wu / fse3w(ji+1,jj,iku+1)412 ! interpolated values of tracers413 zti(ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,iku+1,jn) - pta(ji+1,jj,iku,jn) )414 ! gradient of tracers415 pgtui(ji,jj,jn) = umask(ji,jj,iku) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) )416 ELSE ! case 2417 zmaxu = - ze3wu / fse3w(ji,jj,iku+1)418 ! interpolated values of tracers419 zti(ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,iku+1,jn) - pta(ji,jj,iku,jn) )420 ! gradient of tracers421 pgtui(ji,jj,jn) = umask(ji,jj,iku) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) )422 ENDIF423 !424 ! j- direction425 IF( ze3wv >= 0._wp ) THEN ! case 1426 zmaxv = ze3wv / fse3w(ji,jj+1,ikv+1)427 ! interpolated values of tracers428 ztj(ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikv+1,jn) - pta(ji,jj+1,ikv,jn) )429 ! gradient of tracers430 pgtvi(ji,jj,jn) = vmask(ji,jj,ikv) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) )431 ELSE ! case 2432 zmaxv = - ze3wv / fse3w(ji,jj,ikv+1)433 ! interpolated values of tracers434 ztj(ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikv+1,jn) - pta(ji,jj,ikv,jn) )435 ! gradient of tracers436 pgtvi(ji,jj,jn) = vmask(ji,jj,ikv) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) )437 ENDIF438 END DO!!439 END DO!!440 CALL lbc_lnk( pgtui(:,:,jn), 'U', -1. ) ; CALL lbc_lnk( pgtvi(:,:,jn), 'V', -1. ) ! Lateral boundary cond.441 !442 END DO443 444 ! horizontal derivative of density anomalies (rd)445 IF( PRESENT( prd ) ) THEN ! depth of the partial step level446 pgrui(:,:) =0.0_wp ; pgrvi(:,:) =0.0_wp ;447 pgzui(:,:) =0.0_wp ; pgzvi(:,:) =0.0_wp ;448 pmrui(:,:) =0.0_wp ; pmrui(:,:) =0.0_wp ;449 pge3rui(:,:)=0.0_wp ; pge3rvi(:,:)=0.0_wp ;450 451 DO jj = 1, jpjm1452 DO ji = 1, jpim1453 iku = miku(ji,jj)454 ikv = mikv(ji,jj)455 ze3wu = (gdepw_0(ji+1,jj,iku+1) - gdept_0(ji+1,jj,iku)) - (gdepw_0(ji,jj,iku+1) - gdept_0(ji,jj,iku))456 ze3wv = (gdepw_0(ji,jj+1,ikv+1) - gdept_0(ji,jj+1,ikv)) - (gdepw_0(ji,jj,ikv+1) - gdept_0(ji,jj,ikv))457 458 IF( ze3wu >= 0._wp ) THEN ; zhi(ji,jj) = fsdept(ji+1,jj,iku) + ze3wu ! i-direction: case 1459 ELSE ; zhi(ji,jj) = fsdept(ji ,jj,iku) - ze3wu ! - - case 2460 ENDIF461 IF( ze3wv >= 0._wp ) THEN ; zhj(ji,jj) = fsdept(ji,jj+1,ikv) + ze3wv ! j-direction: case 1462 ELSE ; zhj(ji,jj) = fsdept(ji,jj ,ikv) - ze3wv ! - - case 2463 ENDIF464 END DO465 END DO466 467 ! Compute interpolated rd from zti, ztj for the 2 cases at the depth of the partial468 ! step and store it in zri, zrj for each case469 CALL eos( zti, zhi, zri )470 CALL eos( ztj, zhj, zrj )471 472 ! Gradient of density at the last level473 DO jj = 1, jpjm1474 DO ji = 1, jpim1475 435 iku = miku(ji,jj) ; ikup1 = miku(ji,jj) + 1 476 436 ikv = mikv(ji,jj) ; ikvp1 = mikv(ji,jj) + 1 477 ze3wu = (gdepw_0(ji+1,jj,iku+1) - gdept_0(ji+1,jj,iku)) - (gdepw_0(ji,jj,iku+1) - gdept_0(ji,jj,iku)) 478 ze3wv = (gdepw_0(ji,jj+1,ikv+1) - gdept_0(ji,jj+1,ikv)) - (gdepw_0(ji,jj,ikv+1) - gdept_0(ji,jj,ikv)) 479 IF( ze3wu >= 0._wp ) THEN 480 pgzui (ji,jj) = (fsde3w(ji+1,jj,iku) + ze3wu) - fsde3w(ji,jj,iku) 481 pgrui (ji,jj) = umask(ji,jj,iku) * ( zri(ji,jj) - prd(ji,jj,iku) ) ! i: 1 482 pmrui (ji,jj) = umask(ji,jj,iku) * ( zri(ji,jj) + prd(ji,jj,iku) ) ! i: 1 483 pge3rui(ji,jj) = umask(ji,jj,iku+1) & 484 * ( (fse3w(ji+1,jj,iku+1) - ze3wu) * (zri(ji,jj ) + prd(ji+1,jj,iku+1) + 2._wp) & 485 - fse3w(ji ,jj,iku+1) * (prd(ji,jj,iku) + prd(ji ,jj,iku+1) + 2._wp) ) ! i: 1 486 ELSE 487 pgzui (ji,jj) = fsde3w(ji+1,jj,iku) - (fsde3w(ji,jj,iku) - ze3wu) 488 pgrui (ji,jj) = umask(ji,jj,iku) * ( prd(ji+1,jj,iku) - zri(ji,jj) ) ! i: 2 489 pmrui (ji,jj) = umask(ji,jj,iku) * ( prd(ji+1,jj,iku) + zri(ji,jj) ) ! i: 2 490 pge3rui(ji,jj) = umask(ji,jj,iku+1) & 491 * ( fse3w(ji+1,jj,iku+1) * (prd(ji+1,jj,iku) + prd(ji+1,jj,iku+1) + 2._wp) & 492 -(fse3w(ji ,jj,iku+1) + ze3wu) * (zri(ji,jj ) + prd(ji ,jj,iku+1) + 2._wp) ) ! i: 2 493 ENDIF 494 IF( ze3wv >= 0._wp ) THEN 495 pgzvi (ji,jj) = (fsde3w(ji,jj+1,ikv) + ze3wv) - fsde3w(ji,jj,ikv) 496 pgrvi (ji,jj) = vmask(ji,jj,ikv) * ( zrj(ji,jj ) - prd(ji,jj,ikv) ) ! j: 1 497 pmrvi (ji,jj) = vmask(ji,jj,ikv) * ( zrj(ji,jj ) + prd(ji,jj,ikv) ) ! j: 1 498 pge3rvi(ji,jj) = vmask(ji,jj,ikv+1) & 499 * ( (fse3w(ji,jj+1,ikv+1) - ze3wv) * ( zrj(ji,jj ) + prd(ji,jj+1,ikv+1) + 2._wp) & 500 - fse3w(ji,jj ,ikv+1) * ( prd(ji,jj,ikv) + prd(ji,jj ,ikv+1) + 2._wp) ) ! j: 1 501 ! + 2 due to the formulation in density and not in anomalie in hpg sco 502 ELSE 503 pgzvi (ji,jj) = fsde3w(ji,jj+1,ikv) - (fsde3w(ji,jj,ikv) - ze3wv) 504 pgrvi (ji,jj) = vmask(ji,jj,ikv) * ( prd(ji,jj+1,ikv) - zrj(ji,jj) ) ! j: 2 505 pmrvi (ji,jj) = vmask(ji,jj,ikv) * ( prd(ji,jj+1,ikv) + zrj(ji,jj) ) ! j: 2 506 pge3rvi(ji,jj) = vmask(ji,jj,ikv+1) & 507 * ( fse3w(ji,jj+1,ikv+1) * ( prd(ji,jj+1,ikv) + prd(ji,jj+1,ikv+1) + 2._wp) & 508 -(fse3w(ji,jj ,ikv+1) + ze3wv) * ( zrj(ji,jj ) + prd(ji,jj ,ikv+1) + 2._wp) ) ! j: 2 509 ENDIF 437 ze3wu = gdept_0(ji,jj,iku) - gdept_0(ji+1,jj,iku) 438 ze3wv = gdept_0(ji,jj,ikv) - gdept_0(ji,jj+1,ikv) 439 440 IF( ze3wu >= 0._wp ) THEN ; pgrui(ji,jj) = umask(ji,jj,iku) * ( zri(ji ,jj ) - prd(ji,jj,iku) ) ! i: 1 441 ELSE ; pgrui(ji,jj) = umask(ji,jj,iku) * ( prd(ji+1,jj ,iku) - zri(ji,jj ) ) ! i: 2 442 ENDIF 443 444 IF( ze3wv >= 0._wp ) THEN ; pgrvi(ji,jj) = vmask(ji,jj,ikv) * ( zrj(ji ,jj ) - prd(ji,jj,ikv) ) ! j: 1 445 ELSE ; pgrvi(ji,jj) = vmask(ji,jj,ikv) * ( prd(ji ,jj+1,ikv) - zrj(ji,jj ) ) ! j: 2 446 ENDIF 447 510 448 END DO 511 449 END DO 512 450 CALL lbc_lnk( pgrui , 'U', -1. ) ; CALL lbc_lnk( pgrvi , 'V', -1. ) ! Lateral boundary conditions 513 CALL lbc_lnk( pmrui , 'U', 1. ) ; CALL lbc_lnk( pmrvi , 'V', 1. ) ! Lateral boundary conditions514 CALL lbc_lnk( pgzui , 'U', -1. ) ; CALL lbc_lnk( pgzvi , 'V', -1. ) ! Lateral boundary conditions515 CALL lbc_lnk( pge3rui , 'U', -1. ) ; CALL lbc_lnk( pge3rvi , 'V', -1. ) ! Lateral boundary conditions516 451 ! 517 452 END IF
Note: See TracChangeset
for help on using the changeset viewer.