Changeset 13761 for NEMO/branches
- Timestamp:
- 2020-11-09T18:49:23+01:00 (3 years ago)
- Location:
- NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/OCE
- Files:
-
- 2 edited
-
DOM/domqco.F90 (modified) (2 diffs)
-
USR/usrdef_istate.F90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/OCE/DOM/domqco.F90
r13734 r13761 303 303 ! CALL usr_def_istate( gdept_0, tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb) ) 304 304 ! ! 305 ssh(:,:,:) = 0._wp 305 !!st ssh(:,:,:) = 0._wp 306 CALL usr_def_ssh( tmask, ssh(:,:,Kbb) ) 307 ! 308 ssh(:,:,Kmm) = ssh(:,:,Kbb) 306 309 ! 307 310 ENDIF ! end of ll_wd edits … … 310 313 ! 311 314 END SUBROUTINE qco_rst_read 312 313 314 SUBROUTINE qco_rst_read2( kt, Kbb, Kmm )315 !!---------------------------------------------------------------------316 !! *** ROUTINE qco_rst_read ***317 !!318 !! ** Purpose : Read ssh in restart file319 !!320 !! ** Method : use of IOM library321 !! if the restart does not contain ssh,322 !! it is set to the _0 values.323 !!----------------------------------------------------------------------324 INTEGER, INTENT(in) :: kt ! ocean time-step325 INTEGER, INTENT(in) :: Kbb, Kmm ! ocean time level indices326 !327 INTEGER :: ji, jj, jk328 INTEGER :: id1, id2 ! local integers329 !!----------------------------------------------------------------------330 !331 IF( ln_rstart ) THEN !* Read the restart file332 CALL rst_read_open ! open the restart file if necessary333 !334 id1 = iom_varid( numror, 'sshb', ldstop = .FALSE. )335 id2 = iom_varid( numror, 'sshn', ldstop = .FALSE. )336 !337 ! ! --------- !338 ! ! all cases !339 ! ! --------- !340 !341 IF( MIN( id1, id2 ) > 0 ) THEN ! all required arrays exist342 CALL iom_get( numror, jpdom_auto, 'sshb' , ssh(:,:,Kbb), ldxios = lrxios )343 CALL iom_get( numror, jpdom_auto, 'sshn' , ssh(:,:,Kmm), ldxios = lrxios )344 CALL iom_get( numror, jpdom_auto, 'r3tb' , r3t(:,:,Kbb), ldxios = lrxios )345 CALL iom_get( numror, jpdom_auto, 'r3tn' , r3t(:,:,Kmm), ldxios = lrxios )346 CALL iom_get( numror, jpdom_auto, 'r3ub' , r3u(:,:,Kbb), ldxios = lrxios, cd_type = 'U' )347 CALL iom_get( numror, jpdom_auto, 'r3un' , r3u(:,:,Kmm), ldxios = lrxios, cd_type = 'U' )348 CALL iom_get( numror, jpdom_auto, 'r3vb' , r3v(:,:,Kbb), ldxios = lrxios, cd_type = 'V' )349 CALL iom_get( numror, jpdom_auto, 'r3vn' , r3v(:,:,Kmm), ldxios = lrxios, cd_type = 'V' )350 CALL iom_get( numror, jpdom_auto, 'r3f' , r3f(:,:) , ldxios = lrxios, cd_type = 'F' )351 352 ! needed to restart if land processor not computed353 IF(lwp) write(numout,*) 'qco_rst_read : ssh(:,:,Kbb) and ssh(:,:,Kmm) found in restart files'354 !!WHERE ( ssmask(:,:) == 0.0_wp ) !!gm/st ==> sm should not be necessary on ssh while it was required on e3355 !! ssh(:,:,Kmm) = 0._wp356 !! ssh(:,:,Kbb) = 0._wp357 !!END WHERE358 IF( l_1st_euler ) THEN359 ssh(:,:,Kbb) = ssh(:,:,Kmm)360 ENDIF361 ELSE IF( id1 > 0 ) THEN362 IF(lwp) write(numout,*) 'qco_rst_read WARNING : ssh(:,:,Kmm) not found in restart files'363 IF(lwp) write(numout,*) 'sshn set equal to sshb.'364 IF(lwp) write(numout,*) 'neuler is forced to 0'365 CALL iom_get( numror, jpdom_auto, 'sshb', ssh(:,:,Kbb), ldxios = lrxios )366 ssh(:,:,Kmm) = ssh(:,:,Kbb)367 l_1st_euler = .TRUE.368 ELSE IF( id2 > 0 ) THEN369 IF(lwp) write(numout,*) 'qco_rst_read WARNING : ssh(:,:,Kbb) not found in restart files'370 IF(lwp) write(numout,*) 'sshb set equal to sshn.'371 IF(lwp) write(numout,*) 'neuler is forced to 0'372 CALL iom_get( numror, jpdom_auto, 'sshn', ssh(:,:,Kmm), ldxios = lrxios )373 ssh(:,:,Kbb) = ssh(:,:,Kmm)374 l_1st_euler = .TRUE.375 ELSE376 IF(lwp) write(numout,*) 'qco_rst_read WARNING : ssh(:,:,Kmm) not found in restart file'377 IF(lwp) write(numout,*) 'ssh_b and ssh_n set to zero'378 IF(lwp) write(numout,*) 'neuler is forced to 0'379 ssh(:,:,:) = 0._wp380 l_1st_euler = .TRUE.381 ENDIF382 !383 ELSE !* Initialize at "rest"384 !385 IF( ll_wd ) THEN ! MJB ll_wd edits start here - these are essential386 !387 IF( cn_cfg == 'wad' ) THEN ! Wetting and drying test case388 CALL usr_def_istate( gdept(:,:,:,Kbb), tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb) )389 ts (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb) ! set now values from to before ones390 ssh(:,: ,Kmm) = ssh(:,: ,Kbb)391 uu (:,:,: ,Kmm) = uu (:,:,: ,Kbb)392 vv (:,:,: ,Kmm) = vv (:,:,: ,Kbb)393 ELSE ! if not test case394 ssh(:,:,Kmm) = -ssh_ref395 ssh(:,:,Kbb) = -ssh_ref396 !397 DO_2D( 1, 1, 1, 1 )398 IF( ht_0(ji,jj)-ssh_ref < rn_wdmin1 ) THEN ! if total depth is less than min depth399 ssh(ji,jj,Kbb) = rn_wdmin1 - (ht_0(ji,jj) )400 ssh(ji,jj,Kmm) = rn_wdmin1 - (ht_0(ji,jj) )401 ENDIF402 END_2D403 ENDIF404 !405 DO ji = 1, jpi406 DO jj = 1, jpj407 IF ( ht_0(ji,jj) .LE. 0.0 .AND. NINT( ssmask(ji,jj) ) .EQ. 1) THEN408 CALL ctl_stop( 'qco_rst_read: ht_0 must be positive at potentially wet points' )409 ENDIF410 END DO411 END DO412 !413 ELSE414 !415 ! Just to read set ssh in fact, called latter once vertical grid416 ! is set up:417 ! CALL usr_def_istate( gdept_0, tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb) )418 ! !419 ssh(:,:,:) = 0._wp420 r3t(:,:,:) = 0._wp421 r3u(:,:,:) = 0._wp422 r3v(:,:,:) = 0._wp423 r3f(:,: ) = 0._wp424 !425 ENDIF ! end of ll_wd edits426 !427 ENDIF428 !429 END SUBROUTINE qco_rst_read2430 315 431 316 -
NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/OCE/USR/usrdef_istate.F90
r13295 r13761 23 23 24 24 PUBLIC usr_def_istate ! called in istate.F90 25 PUBLIC usr_def_ssh ! called by domqco.F90 25 26 26 27 !! * Substitutions … … 80 81 END SUBROUTINE usr_def_istate 81 82 83 84 SUBROUTINE usr_def_ssh( ptmask, pssh ) 85 !!---------------------------------------------------------------------- 86 !! *** ROUTINE usr_def_istate *** 87 !! 88 !! ** Purpose : Initialization of ssh 89 !! 90 !! ** Method : Set as null 91 !!---------------------------------------------------------------------- 92 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: ptmask ! t-point ocean mask [m] 93 REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: pssh ! sea-surface height [m] 94 !!---------------------------------------------------------------------- 95 ! 96 IF(lwp) WRITE(numout,*) 97 IF(lwp) WRITE(numout,*) 'usr_def_ssh : GYRE configuration, analytical definition of initial state' 98 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~ ' 99 ! 100 ! Sea level: 101 pssh(:,:) = 0._wp 102 103 END SUBROUTINE usr_def_ssh 104 82 105 !!====================================================================== 83 106 END MODULE usrdef_istate
Note: See TracChangeset
for help on using the changeset viewer.
