- Timestamp:
- 2015-12-07T16:11:45+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_MetOffice_merge_2015/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90
r5836 r6012 112 112 !! 113 113 INTEGER :: ji , jj , jk ! dummy loop indices 114 INTEGER :: ii0, ii1 , iku! temporary integer115 INTEGER :: ij0, ij1 , ikv! temporary integer114 INTEGER :: ii0, ii1 ! temporary integer 115 INTEGER :: ij0, ij1 ! temporary integer 116 116 REAL(wp) :: zeps, zm1_g, zm1_2g, z1_16, zcofw, z1_slpmax ! local scalars 117 117 REAL(wp) :: zci, zfi, zau, zbu, zai, zbi ! - - 118 118 REAL(wp) :: zcj, zfj, zav, zbv, zaj, zbj ! - - 119 119 REAL(wp) :: zck, zfk, zbw ! - - 120 REAL(wp) :: zdepu, zdepv ! - - 121 REAL(wp), POINTER, DIMENSION(:,: ) :: zslpml_hmlpu, zslpml_hmlpv 120 122 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwz, zww 121 123 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdzr … … 126 128 ! 127 129 CALL wrk_alloc( jpi,jpj,jpk, zwz, zww, zdzr, zgru, zgrv ) 130 CALL wrk_alloc( jpi,jpj, zslpml_hmlpu, zslpml_hmlpv ) 128 131 129 132 zeps = 1.e-20_wp !== Local constant initialization ==! … … 149 152 zgru(ji,jj,mbku(ji,jj)) = gru(ji,jj) 150 153 zgrv(ji,jj,mbkv(ji,jj)) = grv(ji,jj) 154 END DO 155 END DO 156 ENDIF 157 IF( ln_zps .AND. ln_isfcav ) THEN ! partial steps correction at the bottom ocean level 158 DO jj = 1, jpjm1 159 DO ji = 1, jpim1 160 IF ( miku(ji,jj) > 1 ) zgru(ji,jj,miku(ji,jj)) = grui(ji,jj) 161 IF ( mikv(ji,jj) > 1 ) zgrv(ji,jj,mikv(ji,jj)) = grvi(ji,jj) 151 162 END DO 152 163 END DO … … 171 182 ! =========================== | vslp = d/dj( prd ) / d/dz( prd ) 172 183 ! 184 IF ( ln_isfcav ) THEN 185 DO jj = 2, jpjm1 186 DO ji = fs_2, fs_jpim1 ! vector opt. 187 zslpml_hmlpu(ji,jj) = uslpml(ji,jj) / ( MAX(hmlpt(ji,jj), hmlpt(ji+1,jj ), 5._wp) & 188 & - 0.5_wp * ( risfdep(ji,jj) + risfdep(ji+1,jj ) ) ) 189 zslpml_hmlpv(ji,jj) = vslpml(ji,jj) / ( MAX(hmlpt(ji,jj), hmlpt(ji ,jj+1), 5._wp) & 190 & - 0.5_wp * ( risfdep(ji,jj) + risfdep(ji ,jj+1) ) ) 191 END DO 192 END DO 193 ELSE 194 DO jj = 2, jpjm1 195 DO ji = fs_2, fs_jpim1 ! vector opt. 196 zslpml_hmlpu(ji,jj) = uslpml(ji,jj) / MAX(hmlpt(ji,jj), hmlpt(ji+1,jj ), 5._wp) 197 zslpml_hmlpv(ji,jj) = vslpml(ji,jj) / MAX(hmlpt(ji,jj), hmlpt(ji ,jj+1), 5._wp) 198 END DO 199 END DO 200 END IF 201 173 202 DO jk = 2, jpkm1 !* Slopes at u and v points 174 203 DO jj = 2, jpjm1 … … 186 215 zfi = MAX( omlmask(ji,jj,jk), omlmask(ji+1,jj,jk) ) 187 216 zfj = MAX( omlmask(ji,jj,jk), omlmask(ji,jj+1,jk) ) 188 zwz(ji,jj,jk) = ( ( 1. - zfi) * zau / ( zbu - zeps ) & 189 & + zfi * uslpml(ji,jj) & 190 & * 0.5_wp * ( fsdept(ji+1,jj,jk)+fsdept(ji,jj,jk)-fse3u(ji,jj,1) ) & 191 & / MAX( hmlpt(ji,jj), hmlpt(ji+1,jj), 5._wp ) ) * umask(ji,jj,jk) 192 zww(ji,jj,jk) = ( ( 1. - zfj) * zav / ( zbv - zeps ) & 193 & + zfj * vslpml(ji,jj) & 194 & * 0.5_wp * ( fsdept(ji,jj+1,jk)+fsdept(ji,jj,jk)-fse3v(ji,jj,1) ) & 195 & / MAX( hmlpt(ji,jj), hmlpt(ji,jj+1), 5. ) ) * vmask(ji,jj,jk) 217 ! thickness of water column between surface and level k at u/v point 218 zdepu = 0.5_wp * ( ( fsdept (ji,jj,jk) + fsdept (ji+1,jj ,jk) ) & 219 - ( risfdep(ji,jj) + risfdep(ji+1,jj) ) - fse3u(ji,jj,miku(ji,jj)) ) 220 zdepv = 0.5_wp * ( ( fsdept (ji,jj,jk) + fsdept (ji,jj+1,jk) ) & 221 - ( risfdep(ji,jj) + risfdep(ji,jj+1) ) - fse3v(ji,jj,mikv(ji,jj)) ) 222 ! 223 zwz(ji,jj,jk) = ( ( 1._wp - zfi) * zau / ( zbu - zeps ) & 224 & + zfi * zdepu * zslpml_hmlpu(ji,jj) ) * umask(ji,jj,jk) 225 zww(ji,jj,jk) = ( ( 1._wp - zfj) * zav / ( zbv - zeps ) & 226 & + zfj * zdepv * zslpml_hmlpv(ji,jj) ) * vmask(ji,jj,jk) 196 227 !!gm modif to suppress omlmask.... (as in Griffies case) 197 228 ! ! ! jk must be >= ML level for zf=1. otherwise zf=0. … … 265 296 & + vmask(ji,jj-1,jk-1) + vmask(ji,jj,jk ) , zeps ) * e2t(ji,jj) 266 297 zai = ( zgru (ji-1,jj,jk ) + zgru (ji,jj,jk-1) & 267 & + zgru (ji-1,jj,jk-1) + zgru (ji,jj,jk ) ) / zci * tmask (ji,jj,jk)298 & + zgru (ji-1,jj,jk-1) + zgru (ji,jj,jk ) ) / zci * wmask (ji,jj,jk) 268 299 zaj = ( zgrv (ji,jj-1,jk ) + zgrv (ji,jj,jk-1) & 269 & + zgrv (ji,jj-1,jk-1) + zgrv (ji,jj,jk ) ) / zcj * tmask (ji,jj,jk)300 & + zgrv (ji,jj-1,jk-1) + zgrv (ji,jj,jk ) ) / zcj * wmask (ji,jj,jk) 270 301 ! ! bound the slopes: abs(zw.)<= 1/100 and zb..<0. 271 302 ! ! + kxz max= ah slope max =< e1 e3 /(pi**2 2 dt) … … 274 305 ! ! wslpi and wslpj with ML flattening (output in zwz and zww, resp.) 275 306 zfk = MAX( omlmask(ji,jj,jk), omlmask(ji,jj,jk-1) ) ! zfk=1 in the ML otherwise zfk=0 276 zck = fsdepw(ji,jj,jk) / MAX( hmlp(ji,jj), 10._wp )277 zwz(ji,jj,jk) = ( zai / ( zbi - zeps ) * ( 1._wp - zfk ) + zck * wslpiml(ji,jj) * zfk ) * tmask(ji,jj,jk)278 zww(ji,jj,jk) = ( zaj / ( zbj - zeps ) * ( 1._wp - zfk ) + zck * wslpjml(ji,jj) * zfk ) * tmask(ji,jj,jk)307 zck = ( fsdepw(ji,jj,jk) - fsdepw(ji,jj,mikt(ji,jj) ) ) / MAX( hmlp(ji,jj) - fsdepw(ji,jj,mikt(ji,jj)), 10._wp ) 308 zwz(ji,jj,jk) = ( zai / ( zbi - zeps ) * ( 1._wp - zfk ) + zck * wslpiml(ji,jj) * zfk ) * wmask(ji,jj,jk) 309 zww(ji,jj,jk) = ( zaj / ( zbj - zeps ) * ( 1._wp - zfk ) + zck * wslpjml(ji,jj) * zfk ) * wmask(ji,jj,jk) 279 310 280 311 !!gm modif to suppress omlmask.... (as in Griffies operator) … … 340 371 CALL lbc_lnk( wslpi, 'W', -1. ) ; CALL lbc_lnk( wslpj, 'W', -1. ) 341 372 342 343 373 IF(ln_ctl) THEN 344 374 CALL prt_ctl(tab3d_1=uslp , clinfo1=' slp - u : ', tab3d_2=vslp, clinfo2=' v : ', kdim=jpk) … … 347 377 ! 348 378 CALL wrk_dealloc( jpi,jpj,jpk, zwz, zww, zdzr, zgru, zgrv ) 379 CALL wrk_dealloc( jpi,jpj, zslpml_hmlpu, zslpml_hmlpv ) 349 380 ! 350 381 IF( nn_timing == 1 ) CALL timing_stop('ldf_slp') … … 486 517 ! 487 518 jk = nmln(ji,jj+jp) + 1 488 IF( jk .GT.mbkt(ji,jj+jp) ) THEN !ML reaches bottom519 IF( jk > mbkt(ji,jj+jp) ) THEN !ML reaches bottom 489 520 ztj_mlb(ji ,jj+jp,1-jp,kp) = 0.0_wp 490 521 ELSE … … 699 730 zcj = MAX( vmask(ji,jj-1,ik ) + vmask(ji,jj,ik ) & 700 731 & + vmask(ji,jj-1,ikm1) + vmask(ji,jj,ikm1) , zeps ) * e2t(ji,jj) 701 zai = ( p_gru(ji-1,jj,ik ) + p_gru(ji,jj,ik) &732 zai = ( p_gru(ji-1,jj,ik ) + p_gru(ji,jj,ik) & 702 733 & + p_gru(ji-1,jj,ikm1) + p_gru(ji,jj,ikm1 ) ) / zci * tmask(ji,jj,ik) 703 734 zaj = ( p_grv(ji,jj-1,ik ) + p_grv(ji,jj,ik ) &
Note: See TracChangeset
for help on using the changeset viewer.
