Changeset 7580
- Timestamp:
- 2017-01-19T13:06:16+01:00 (7 years ago)
- Location:
- branches/2016/dev_merge_2016/NEMOGCM
- Files:
-
- 2 edited
-
CONFIG/WAD_TEST_CASES/MY_SRC/usrdef_istate.F90 (modified) (6 diffs)
-
NEMO/OPA_SRC/DYN/wet_dry.F90 (modified) (16 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_merge_2016/NEMOGCM/CONFIG/WAD_TEST_CASES/MY_SRC/usrdef_istate.F90
r7527 r7580 83 83 ! 84 84 IF(lwp) WRITE(numout,*) 85 IF(lwp) WRITE(numout,*) ' istate_wad :Closed box with EW linear bottom slope'85 IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Closed box with EW linear bottom slope' 86 86 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 87 87 ! … … 94 94 ! 95 95 IF(lwp) WRITE(numout,*) 96 IF(lwp) WRITE(numout,*) ' istate_wad :Parobolic EW channel, mid-range initial ssh slope'96 IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Parobolic EW channel, mid-range initial ssh slope' 97 97 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 98 98 ! … … 105 105 ! 106 106 IF(lwp) WRITE(numout,*) 107 IF(lwp) WRITE(numout,*) ' istate_wad :Parobolic EW channel, extreme initial ssh slope'107 IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Parobolic EW channel, extreme initial ssh slope' 108 108 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 109 109 ! … … 118 118 ! 119 119 IF(lwp) WRITE(numout,*) 120 IF(lwp) WRITE(numout,*) ' istate_wad :Parobolic bowl, mid-range initial ssh slope'120 IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Parobolic bowl, mid-range initial ssh slope' 121 121 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 122 122 ! … … 135 135 ! 136 136 IF(lwp) WRITE(numout,*) 137 IF(lwp) WRITE(numout,*) ' istate_wad :Double slope with shelf'137 IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Double slope with shelf' 138 138 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 139 139 ! … … 148 148 ! 149 149 IF(lwp) WRITE(numout,*) 150 IF(lwp) WRITE(numout,*) ' istate_wad :Parobolic EW channel with gaussian ridge'150 IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Parobolic EW channel with gaussian ridge' 151 151 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 152 152 ! -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/DYN/wet_dry.F90
r7514 r7580 45 45 PUBLIC wad_lmt ! routine called by sshwzv.F90 46 46 PUBLIC wad_lmt_bt ! routine called by dynspg_ts.F90 47 PUBLIC wad_istate ! routine called by istate.F90 and domvvl.F9048 47 49 48 !! * Substitutions … … 109 108 ! 110 109 INTEGER :: ji, jj, jk, jk1 ! dummy loop indices 111 INTEGER :: zflag ! local scalar110 INTEGER :: jflag ! local scalar 112 111 REAL(wp) :: zcoef, zdep1, zdep2 ! local scalars 113 112 REAL(wp) :: zzflxp, zzflxn ! local scalars … … 132 131 !IF(lwp) WRITE(numout,*) 'wad_lmt : wetting/drying limiters and velocity limiting' 133 132 134 zflag = 0133 jflag = 0 135 134 zdepwd = 50._wp !maximum depth on which that W/D could possibly happen 136 135 … … 185 184 zflxu1(:,:) = zflxu(:,:) * zwdlmtu(:,:) 186 185 zflxv1(:,:) = zflxv(:,:) * zwdlmtv(:,:) 186 jflag = 0 ! flag indicating if any further iterations are needed 187 187 188 188 DO jj = 2, jpj … … 203 203 204 204 IF(zdep1 > zdep2) THEN 205 zflag = 1205 jflag = 1 206 206 wdmask(ji, jj) = 0 207 !zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zflxp(ji,jj) * z2dt )208 zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zzflxp * z2dt )207 zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zflxp(ji,jj) * z2dt ) 208 !zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zzflxp * z2dt ) 209 209 zcoef = max(zcoef, 0._wp) 210 210 IF(jk1 > nn_wdit) zcoef = 0._wp … … 220 220 CALL lbc_lnk( zwdlmtv, 'V', 1. ) 221 221 222 IF(lk_mpp) CALL mpp_max(zflag) !max over the global domain 223 224 IF(zflag == 0) EXIT 225 226 zflag = 0 ! flag indicating if any further iteration is needed? 222 IF(lk_mpp) CALL mpp_max(jflag) !max over the global domain 223 224 IF(jflag == 0) EXIT 225 227 226 END DO ! jk1 loop 228 227 … … 240 239 CALL lbc_lnk( vn_b, 'V', -1. ) 241 240 242 IF( zflag == 1 .AND. lwp) WRITE(numout,*) 'Need more iterations in wad_lmt!!!'241 IF(jflag == 1 .AND. lwp) WRITE(numout,*) 'Need more iterations in wad_lmt!!!' 243 242 244 243 !IF( ln_rnf ) CALL sbc_rnf_div( hdivn ) ! runoffs (update hdivn field) … … 270 269 ! 271 270 INTEGER :: ji, jj, jk, jk1 ! dummy loop indices 272 INTEGER :: zflag! local scalar271 INTEGER :: jflag ! local scalar 273 272 REAL(wp) :: z2dt 274 273 REAL(wp) :: zcoef, zdep1, zdep2 ! local scalars … … 292 291 !IF(lwp) WRITE(numout,*) 'wad_lmt_bt : wetting/drying limiters and velocity limiting' 293 292 294 zflag = 0293 jflag = 0 295 294 zdepwd = 50._wp !maximum depth that ocean cells can have W/D processes 296 295 … … 299 298 zflxp(:,:) = 0._wp 300 299 zflxn(:,:) = 0._wp 301 !zflxu(:,:) = 0._wp302 !zflxv(:,:) = 0._wp303 300 304 301 zwdlmtu(:,:) = 1._wp … … 319 316 320 317 zdep2 = ht_wd(ji,jj) + sshn_e(ji,jj) - rn_wdmin1 318 IF(zdep2 .le. 0._wp) THEN !add more safty, but not necessary 319 sshn_e(ji,jj) = rn_wdmin1 - ht_wd(ji,jj) 320 END IF 321 321 ENDDO 322 322 END DO … … 329 329 zflxu1(:,:) = zflxu(:,:) * zwdlmtu(:,:) 330 330 zflxv1(:,:) = zflxv(:,:) * zwdlmtv(:,:) 331 jflag = 0 ! flag indicating if any further iterations are needed 331 332 332 333 DO jj = 2, jpj … … 344 345 345 346 zdep1 = (zzflxp + zzflxn) * z2dt / ztmp 346 zdep2 = ht_wd(ji,jj) + sshn_e(ji,jj) - rn_wdmin1 347 zdep2 = zdep2 - z2dt * zssh_frc(ji,jj) 347 zdep2 = ht_wd(ji,jj) + sshn_e(ji,jj) - rn_wdmin1 - z2dt * zssh_frc(ji,jj) 348 348 349 349 IF(zdep1 > zdep2) THEN 350 zflag = 1351 !zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zflxp(ji,jj) * z2dt )352 zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zzflxp * z2dt )350 jflag = 1 351 zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zflxp(ji,jj) * z2dt ) 352 !zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zzflxp * z2dt ) 353 353 zcoef = max(zcoef, 0._wp) 354 354 IF(jk1 > nn_wdit) zcoef = 0._wp … … 364 364 CALL lbc_lnk( zwdlmtv, 'V', 1. ) 365 365 366 IF(lk_mpp) CALL mpp_max(zflag) !max over the global domain 367 368 IF(zflag == 0) EXIT 369 370 zflag = 0 ! flag indicating if any further iteration is needed? 366 IF(lk_mpp) CALL mpp_max(jflag) !max over the global domain 367 368 IF(jflag == 0) EXIT 369 371 370 END DO ! jk1 loop 372 371 … … 377 376 CALL lbc_lnk( zflxv, 'V', -1. ) 378 377 379 IF( zflag == 1 .AND. lwp) WRITE(numout,*) 'Need more iterations in wad_lmt_bt!!!'378 IF(jflag == 1 .AND. lwp) WRITE(numout,*) 'Need more iterations in wad_lmt_bt!!!' 380 379 381 380 !IF( ln_rnf ) CALL sbc_rnf_div( hdivn ) ! runoffs (update hdivn field) … … 391 390 END SUBROUTINE wad_lmt_bt 392 391 393 SUBROUTINE wad_istate394 !!----------------------------------------------------------------------395 !! *** ROUTINE wad_istate ***396 !!397 !! ** Purpose : Initialization of the dynamics and tracers for WAD test398 !! configurations (channels or bowls with initial ssh gradients)399 !!400 !! ** Method : - set temperature field401 !! - set salinity field402 !! - set ssh slope (needs to be repeated in domvvl_rst_init to403 !! set vertical metrics )404 !!----------------------------------------------------------------------405 !406 INTEGER :: ji, jj ! dummy loop indices407 REAL(wp) :: zi, zj408 !!----------------------------------------------------------------------409 !410 ! Uniform T & S in all test cases411 tsn(:,:,:,jp_tem) = 10._wp412 tsb(:,:,:,jp_tem) = 10._wp413 tsn(:,:,:,jp_sal) = 35._wp414 tsb(:,:,:,jp_sal) = 35._wp415 SELECT CASE ( nn_cfg )416 ! ! ====================417 CASE ( 1 ) ! WAD 1 configuration418 ! ! ====================419 !420 IF(lwp) WRITE(numout,*)421 IF(lwp) WRITE(numout,*) 'istate_wad : Closed box with EW linear bottom slope'422 IF(lwp) WRITE(numout,*) '~~~~~~~~~~'423 !424 do ji = 1,jpi425 sshn(ji,:) = ( -5.5_wp + 5.5_wp*FLOAT(mig(ji))/FLOAT(jpiglo-1))*tmask(ji,:,1)426 end do427 ! ! ====================428 CASE ( 2 ) ! WAD 2 configuration429 ! ! ====================430 !431 IF(lwp) WRITE(numout,*)432 IF(lwp) WRITE(numout,*) 'istate_wad : Parobolic EW channel, mid-range initial ssh slope'433 IF(lwp) WRITE(numout,*) '~~~~~~~~~~'434 !435 do ji = 1,jpi436 sshn(ji,:) = ( -5.5_wp + 3.9_wp*FLOAT(jpiglo - mig(ji))/FLOAT(jpiglo-1))*tmask(ji,:,1)437 end do438 ! ! ====================439 CASE ( 3 ) ! WAD 3 configuration440 ! ! ====================441 !442 IF(lwp) WRITE(numout,*)443 IF(lwp) WRITE(numout,*) 'istate_wad : Parobolic EW channel, extreme initial ssh slope'444 IF(lwp) WRITE(numout,*) '~~~~~~~~~~'445 !446 do ji = 1,jpi447 sshn(ji,:) = ( -7.5_wp + 6.9_wp*FLOAT(jpiglo - mig(ji))/FLOAT(jpiglo-1))*tmask(ji,:,1)448 end do449 450 !451 ! ! ====================452 CASE ( 4 ) ! WAD 4 configuration453 ! ! ====================454 !455 IF(lwp) WRITE(numout,*)456 IF(lwp) WRITE(numout,*) 'istate_wad : Parobolic bowl, mid-range initial ssh slope'457 IF(lwp) WRITE(numout,*) '~~~~~~~~~~'458 !459 DO ji = 1, jpi460 zi = MAX(1.0-FLOAT((mig(ji)-25)**2)/400.0, 0.0 )461 DO jj = 1, jpj462 zj = MAX(1.0-FLOAT((mjg(jj)-17)**2)/144.0, 0.0 )463 sshn(ji,jj) = -8.5_wp + 8.5_wp*zi*zj464 END DO465 END DO466 467 !468 ! ! ===========================469 CASE ( 5 ) ! WAD 5 configuration470 ! ! ====================471 !472 IF(lwp) WRITE(numout,*)473 IF(lwp) WRITE(numout,*) 'istate_wad : Double slope with shelf'474 IF(lwp) WRITE(numout,*) '~~~~~~~~~~'475 !476 ! Needed rn_wdmin2 increased to 0.01 for this case?477 do ji = 1,jpi478 sshn(ji,:) = ( -5.5_wp + 9.0_wp*FLOAT(mig(ji))/FLOAT(jpiglo-1))*tmask(ji,:,1)479 end do480 481 !482 ! ! ===========================483 CASE ( 6 ) ! WAD 6 configuration484 ! ! ====================485 !486 IF(lwp) WRITE(numout,*)487 IF(lwp) WRITE(numout,*) 'istate_wad : Parobolic EW channel with gaussian ridge'488 IF(lwp) WRITE(numout,*) '~~~~~~~~~~'489 !490 do ji = 1,jpi491 !6a492 !sshn(ji,:) = ( -5.5_wp + 9.0_wp*FLOAT(jpiglo - mig(ji))/FLOAT(jpiglo-1))*tmask(ji,:,1)493 !Some variations in initial slope that have been tested494 !6b495 !sshn(ji,:) = ( -5.5_wp + 6.5_wp*FLOAT(jpiglo - mig(ji))/FLOAT(jpiglo-1))*tmask(ji,:,1)496 !6c497 !sshn(ji,:) = ( -5.5_wp + 7.5_wp*FLOAT(jpiglo - mig(ji))/FLOAT(jpiglo-1))*tmask(ji,:,1)498 !6d499 !sshn(ji,:) = ( -4.5_wp + 8.0_wp*FLOAT(jpiglo - mig(ji))/FLOAT(jpiglo-1))*tmask(ji,:,1)500 !6e501 sshn(ji,:) = ( -3.5_wp + 7.0_wp*FLOAT(jpiglo - mig(ji))/FLOAT(jpiglo-1))*tmask(ji,:,1)502 !6f503 !sshn(ji,:) = ( 0.5_wp + 3.75_wp*FLOAT(jpiglo - mig(ji))/FLOAT(jpiglo-1))*tmask(ji,:,1)504 end do505 !506 do ji = mi0(jpiglo/2), mi0(jpiglo)507 tsn(ji,:,:,jp_sal) = 30._wp508 tsb(ji,:,:,jp_sal) = 30._wp509 end do510 !511 ! ! ===========================512 CASE DEFAULT ! NONE existing configuration513 ! ! ===========================514 WRITE(ctmp1,*) 'WAD test with a ', nn_cfg,' option is not coded'515 !516 CALL ctl_stop( ctmp1 )517 !518 END SELECT519 !520 ! Apply minimum wetdepth criterion521 !522 do jj = 1,jpj523 do ji = 1,jpi524 IF( ht_wd(ji,jj) + sshn(ji,jj) < rn_wdmin1 ) THEN525 sshn(ji,jj) = tmask(ji,jj,1)*( rn_wdmin1 - ht_wd(ji,jj) )526 ENDIF527 end do528 end do529 sshb = sshn530 ssha = sshn531 !532 END SUBROUTINE wad_istate533 534 392 !!============================================================================== 535 393 END MODULE wet_dry
Note: See TracChangeset
for help on using the changeset viewer.
