- Timestamp:
- 2016-07-01T18:02:45+02:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp_crs.F90
r6101 r6772 35 35 USE crs 36 36 USE iom 37 USE ieee_arithmetic 37 38 38 39 IMPLICIT NONE … … 168 169 ! ! bound the slopes: abs(zw.)<= 1/100 and zb..<0 169 170 ! ! + kxz max= ah slope max =< e1 e3 /(pi**2 2 dt) 170 zbu = MIN( zbu, -100._wp* ABS( zau ) , -7.e+3_wp/e3u_max_crs(ji,jj,jk)* ABS( zau ) ) 171 zbv = MIN( zbv, -100._wp* ABS( zav ) , -7.e+3_wp/e3v_max_crs(ji,jj,jk)* ABS( zav ) ) 172 !cc zbu = MIN( zbu, -100._wp* ABS( zau ) , -7.e+3_wp/e3u_crs(ji,jj,jk)* ABS( zau ) ) 173 !cc zbv = MIN( zbv, -100._wp* ABS( zav ) , -7.e+3_wp/e3v_crs(ji,jj,jk)* ABS( zav ) ) 171 zbu = MIN( zbu, -100._wp* ABS( zau ) , -7.e+3_wp/fse3u_max_crs(ji,jj,jk)* ABS( zau ) ) 172 zbv = MIN( zbv, -100._wp* ABS( zav ) , -7.e+3_wp/fse3v_max_crs(ji,jj,jk)* ABS( zav ) ) 174 173 ! ! uslp and vslp output in zwz and zww, resp. 175 174 zfi = MAX( omlmask(ji,jj,jk), omlmask(ji+1,jj,jk) ) … … 177 176 zwz(ji,jj,jk) = ( ( 1. - zfi) * zau / ( zbu - zeps ) & 178 177 & + zfi * uslpml(ji,jj) & 179 & * 0.5_wp * ( gdept_crs(ji+1,jj,jk)+gdept_crs(ji,jj,jk) -e3u_max_crs(ji,jj,1) ) &178 & * 0.5_wp * ( fsdept_crs(ji+1,jj,jk)+fsdept_crs(ji,jj,jk) - fse3u_max_crs(ji,jj,1) ) & 180 179 & / MAX( hmlpt_crs(ji,jj), hmlpt_crs(ji+1,jj), 5._wp ) ) * umask_crs(ji,jj,jk) 181 180 zww(ji,jj,jk) = ( ( 1. - zfj) * zav / ( zbv - zeps ) & 182 181 & + zfj * vslpml(ji,jj) & 183 & * 0.5_wp * ( gdept_crs(ji,jj+1,jk)+ gdept_crs(ji,jj,jk)-e3v_max_crs(ji,jj,1) ) &182 & * 0.5_wp * ( fsdept_crs(ji,jj+1,jk)+ fsdept_crs(ji,jj,jk)-fse3v_max_crs(ji,jj,1) ) & 184 183 & / MAX( hmlpt_crs(ji,jj), hmlpt_crs(ji,jj+1), 5. ) ) * vmask_crs(ji,jj,jk) 185 184 !!gm modif to suppress omlmask.... (as in Griffies case) … … 196 195 END DO 197 196 CALL crs_lbc_lnk( zwz, 'U', -1. ) ; CALL crs_lbc_lnk( zww, 'V', -1. ) ! lateral boundary conditions 198 CALL iom_put("zwz_crs",zwz)199 CALL iom_put("zww_crs",zww)200 197 ! 201 198 ! !* horizontal Shapiro filter … … 262 259 ! ! bound the slopes: abs(zw.)<= 1/100 and zb..<0. 263 260 ! ! + kxz max= ah slope max =< e1 e3 /(pi**2 2 dt) 264 zbi = MIN( zbw ,- 100._wp* ABS( zai ) , -7.e+3_wp/ e3w_max_crs(ji,jj,jk)* ABS( zai ) )265 zbj = MIN( zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/ e3w_max_crs(ji,jj,jk)* ABS( zaj ) )261 zbi = MIN( zbw ,- 100._wp* ABS( zai ) , -7.e+3_wp/fse3w_max_crs(ji,jj,jk)* ABS( zai ) ) 262 zbj = MIN( zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/fse3w_max_crs(ji,jj,jk)* ABS( zaj ) ) 266 263 ! ! wslpi and wslpj with ML flattening (output in zwz and zww, resp.) 267 264 zfk = MAX( omlmask(ji,jj,jk), omlmask(ji,jj,jk-1) ) ! zfk=1 in the ML otherwise zfk=0 268 zck = gdepw_crs(ji,jj,jk) / MAX( hmlp_crs(ji,jj), 10._wp )265 zck = fsdepw_crs(ji,jj,jk) / MAX( hmlp_crs(ji,jj), 10._wp ) 269 266 zwz(ji,jj,jk) = ( zai / ( zbi - zeps ) * ( 1._wp - zfk ) + zck * wslpiml(ji,jj) * zfk ) * tmask_crs(ji,jj,jk) 270 267 zww(ji,jj,jk) = ( zaj / ( zbj - zeps ) * ( 1._wp - zfk ) + zck * wslpjml(ji,jj) * zfk ) * tmask_crs(ji,jj,jk) … … 333 330 ! 334 331 CALL iom_swap( "nemo_crs" ) ! swap on the coarse grid 335 CALL iom_put("zgru_crs",zgru)336 CALL iom_put("zgrv_crs",zgrv)337 CALL iom_put("zdzr_crs",zdzr)338 CALL iom_put("zwz_crs",zwz)339 CALL iom_put("zww_crs",zww)340 332 CALL iom_put("uslp_crs",uslp_crs) 341 333 CALL iom_put("vslp_crs",vslp_crs) … … 411 403 !----------------------------------------------------------------------- 412 404 ! 413 DO jj = 2, jpj_crsm1414 DO ji = 2, jpi_crsm1405 DO jj = 2, nldi_crs 406 DO ji = 2, nldj_crs 415 407 ! !== Slope at u- & v-points just below the Mixed Layer ==! 416 408 ! … … 425 417 ! !- bound the slopes: abs(zw.)<= 1/100 and zb..<0 426 418 ! kxz max= ah slope max =< e1 e3 /(pi**2 2 dt) 427 zbu = MIN( zbu , -100._wp* ABS( zau ) , -7.e+3_wp/ e3u_max_crs(ji,jj,iku)* ABS( zau ) )428 zbv = MIN( zbv , -100._wp* ABS( zav ) , -7.e+3_wp/ e3v_max_crs(ji,jj,ikv)* ABS( zav ) )419 zbu = MIN( zbu , -100._wp* ABS( zau ) , -7.e+3_wp/fse3u_max_crs(ji,jj,iku)* ABS( zau ) ) 420 zbv = MIN( zbv , -100._wp* ABS( zav ) , -7.e+3_wp/fse3v_max_crs(ji,jj,ikv)* ABS( zav ) ) 429 421 ! !- Slope at u- & v-points (uslpml, vslpml) 430 422 uslpml(ji,jj) = zau / ( zbu - zeps ) * umask_crs(ji,jj,iku) … … 448 440 ! !- bound the slopes: abs(zw.)<= 1/100 and zb..<0. 449 441 ! kxz max= ah slope max =< e1 e3 /(pi**2 2 dt) 450 zbi = MIN( zbw , -100._wp* ABS( zai ) , -7.e+3_wp/ e3w_max_crs(ji,jj,ik)* ABS( zai ) )451 zbj = MIN( zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/ e3w_max_crs(ji,jj,ik)* ABS( zaj ) )442 zbi = MIN( zbw , -100._wp* ABS( zai ) , -7.e+3_wp/fse3w_max_crs(ji,jj,ik)* ABS( zai ) ) 443 zbj = MIN( zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/fse3w_max_crs(ji,jj,ik)* ABS( zaj ) ) 452 444 ! !- i- & j-slope at w-points (wslpiml, wslpjml) 453 445 wslpiml(ji,jj) = zai / ( zbi - zeps ) * tmask_crs (ji,jj,ik) … … 493 485 ! 494 486 ELSE ! Madec operator : slopes at u-, v-, and w-points 495 ALLOCATE( uslp_crs(jpi_crs,jpj_crs,jpk) , vslp_crs(jpi_crs,jpj_crs,jpk) , & 496 & wslpi_crs(jpi_crs,jpj_crs,jpk) , wslpj_crs(jpi_crs,jpj_crs,jpk) , & 497 & omlmask(jpi_crs,jpj_crs,jpk) , & 498 & uslpml(jpi_crs,jpj_crs) , vslpml(jpi_crs,jpj_crs) , & 499 & wslpiml(jpi_crs,jpj_crs) , wslpjml(jpi_crs,jpj_crs) , STAT=ierr ) 487 ALLOCATE( uslp_crs(jpi_crs,jpj_crs,jpk) , vslp_crs(jpi_crs,jpj_crs,jpk) , wslpi_crs(jpi_crs,jpj_crs,jpk) , wslpj_crs(jpi_crs,jpj_crs,jpk) , & 488 & omlmask(jpi_crs,jpj_crs,jpk) , uslpml(jpi_crs,jpj_crs) , vslpml(jpi_crs,jpj_crs) , wslpiml(jpi_crs,jpj_crs) , wslpjml(jpi_crs,jpj_crs) , STAT=ierr ) 500 489 IF( ierr > 0 ) CALL ctl_stop( 'STOP', 'ldf_slp_init : unable to allocate Madec operator slope ' ) 501 490 … … 520 509 DO jj = 2, jpj_crsm1 521 510 DO ji = 2, jpi_crsm1 ! vector opt. 522 !cbr uslp_crs (ji,jj,jk) = -1./e1u_crs(ji,jj) * ( gdept_crs(ji+1,jj,jk) - gdept_crs(ji ,jj ,jk) ) * umask_crs(ji,jj,jk) 523 !vslp_crs (ji,jj,jk) = -1./e2v_crs(ji,jj) * ( gdept_crs(ji,jj+1,jk) - gdept_crs(ji ,jj ,jk) ) * vmask_crs(ji,jj,jk) 524 !wslpi_crs(ji,jj,jk) = -1./e1t_crs(ji,jj) * ( gdepw_crs(ji+1,jj,jk) - gdepw_crs(ji-1,jj,jk) ) * tmask_crs(ji,jj,jk) * 0.5 525 !wslpj_crs(ji,jj,jk) = -1./e2t_crs(ji,jj) * ( gdepw_crs(ji,jj+1,jk) - gdepw_crs(ji,jj-1,jk) ) * tmask_crs(ji,jj,jk) * 0.5 526 uslp_crs (ji,jj,jk) = -1. * ( gdept_crs(ji+1,jj,jk) - gdept_crs(ji ,jj ,jk) ) * umask_crs(ji,jj,jk) 511 uslp_crs (ji,jj,jk) = -1. * ( fsdept_crs(ji+1,jj,jk) - fsdept_crs(ji ,jj ,jk) ) * umask_crs(ji,jj,jk) 527 512 IF( e1u_crs(ji,jj) .NE. 0._wp ) uslp_crs (ji,jj,jk) = uslp_crs (ji,jj,jk) / e1u_crs(ji,jj) 528 vslp_crs (ji,jj,jk) = -1. * ( gdept_crs(ji,jj+1,jk) - gdept_crs(ji ,jj ,jk) ) * vmask_crs(ji,jj,jk)513 vslp_crs (ji,jj,jk) = -1. * ( fsdept_crs(ji,jj+1,jk) - fsdept_crs(ji ,jj ,jk) ) * vmask_crs(ji,jj,jk) 529 514 IF( e2v_crs(ji,jj) .NE. 0._wp ) vslp_crs (ji,jj,jk) = vslp_crs (ji,jj,jk) / e2v_crs(ji,jj) 530 wslpi_crs(ji,jj,jk) = -1. * ( gdepw_crs(ji+1,jj,jk) - gdepw_crs(ji-1,jj,jk) ) * tmask_crs(ji,jj,jk) * 0.5515 wslpi_crs(ji,jj,jk) = -1. * ( fsdepw_crs(ji+1,jj,jk) - fsdepw_crs(ji-1,jj,jk) ) * tmask_crs(ji,jj,jk) * 0.5 531 516 IF( e1t_crs(ji,jj) .NE. 0._wp ) wslpi_crs(ji,jj,jk) = wslpi_crs(ji,jj,jk) / e1t_crs(ji,jj) 532 wslpj_crs(ji,jj,jk) = -1. * ( gdepw_crs(ji,jj+1,jk) - gdepw_crs(ji,jj-1,jk) ) * tmask_crs(ji,jj,jk) * 0.5517 wslpj_crs(ji,jj,jk) = -1. * ( fsdepw_crs(ji,jj+1,jk) - fsdepw_crs(ji,jj-1,jk) ) * tmask_crs(ji,jj,jk) * 0.5 533 518 IF( e2t_crs(ji,jj) .NE. 0._wp ) wslpj_crs(ji,jj,jk) = wslpj_crs(ji,jj,jk) / e2t_crs(ji,jj) 534 519 END DO
Note: See TracChangeset
for help on using the changeset viewer.
