- Timestamp:
- 2020-11-25T14:49:40+01:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/OCE
- Files:
-
- 7 edited
-
DOM/domain.F90 (modified) (11 diffs)
-
DOM/domqco.F90 (modified) (6 diffs)
-
DOM/domvvl.F90 (modified) (3 diffs)
-
DOM/istate.F90 (modified) (4 diffs)
-
DYN/sshwzv.F90 (modified) (4 diffs)
-
IOM/restart.F90 (modified) (10 diffs)
-
USR/usrdef_istate.F90 (modified) (7 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/OCE/DOM/domain.F90
r13737 r13874 15 15 !! 3.7 ! 2015-11 (G. Madec, A. Coward) time varying zgr by default 16 16 !! 4.0 ! 2016-10 (G. Madec, S. Flavoni) domain configuration / user defined interface 17 !! 4. 0 !2020-02 (G. Madec, S. Techene) introduce ssh to h0 ratio17 !! 4.1 ! 2020-02 (G. Madec, S. Techene) introduce ssh to h0 ratio 18 18 !!---------------------------------------------------------------------- 19 19 … … 28 28 USE oce ! ocean variables 29 29 USE dom_oce ! domain: ocean 30 #if defined key_qco 31 USE domqco ! quasi-eulerian 32 #else 33 USE domvvl ! variable volume 34 #endif 35 USE sshwzv , ONLY : ssh_init_rst ! set initial ssh 30 36 USE sbc_oce ! surface boundary condition: ocean 31 37 USE trc_oce ! shared ocean & passive tracers variab … … 35 41 USE dommsk ! domain: set the mask system 36 42 USE domwri ! domain: write the meshmask file 37 #if ! defined key_qco38 USE domvvl ! variable volume39 #else40 USE domqco ! variable volume41 #endif42 43 USE c1d ! 1D configuration 43 44 USE dyncor_c1d ! 1D configuration: Coriolis term (cor_c1d routine) 44 USE wet_dry , ONLY : ll_wd45 USE closea , ONLY : dom_clo ! closed seas45 USE wet_dry , ONLY : ll_wd ! wet & drying flag 46 USE closea , ONLY : dom_clo ! closed seas routine 46 47 ! 47 48 USE in_out_manager ! I/O manager … … 56 57 PUBLIC domain_cfg ! called by nemogcm.F90 57 58 59 !! * Substitutions 60 # include "do_loop_substitute.h90" 58 61 !!------------------------------------------------------------------------- 59 62 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 173 176 r1_hf_0(:,:) = ssfmask(:,:) / ( hf_0(:,:) + 1._wp - ssfmask(:,:) ) 174 177 ! 178 IF( ll_wd ) THEN ! wet and drying (check ht_0 >= 0) 179 DO_2D( 1, 1, 1, 1 ) 180 IF( ht_0(ji,jj) < 0._wp .AND. ssmask(ji,jj) == 1._wp ) THEN 181 CALL ctl_stop( 'ssh_init_rst : ht_0 must be positive at potentially wet points' ) 182 ENDIF 183 END_2D 184 ENDIF 185 ! 186 ! !== initialisation of time varying coordinate ==! 187 ! 188 ! != ssh initialization 189 IF( cdstr /= 'SAS' ) THEN 190 CALL ssh_init_rst( Kbb, Kmm, Kaa ) 191 ENDIF 192 ! 175 193 #if defined key_qco 176 ! !== initialisation of time varying coordinate ==!Quasi-Euerian coordinate case194 ! != Quasi-Euerian coordinate case 177 195 ! 178 196 IF( .NOT.l_offline ) CALL dom_qco_init( Kbb, Kmm, Kaa ) 179 !180 IF( ln_linssh ) CALL ctl_stop('STOP','domain: key_qco and ln_linssh = T are incompatible')181 !182 197 #else 183 ! !== time varying part of coordinate system ==! 184 ! 185 IF( ln_linssh ) THEN != Fix in time : set to the reference one for all 198 ! 199 IF( ln_linssh ) THEN != Fix in time : set to the reference one for all 186 200 ! 187 201 DO jt = 1, jpt ! depth of t- and w-grid-points … … 209 223 ht (:,:) = ht_0(:,:) 210 224 ! 211 ELSE != time varying : initialize before/now/after variables225 ELSE != Time varying : initialize before/now/after variables 212 226 ! 213 227 IF( .NOT.l_offline ) CALL dom_vvl_init( Kbb, Kmm, Kaa ) … … 325 339 ENDIF 326 340 ! 341 ! !=======================! 342 ! !== namelist namrun ==! 343 ! !=======================! 327 344 ! 328 345 READ ( numnam_ref, namrun, IOSTAT = ios, ERR = 901) … … 423 440 END SELECT 424 441 ENDIF 425 442 ! 443 ! !=======================! 444 ! !== namelist namdom ==! 445 ! !=======================! 446 ! 426 447 READ ( numnam_ref, namdom, IOSTAT = ios, ERR = 903) 427 448 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in reference namelist' ) … … 431 452 ! 432 453 #if defined key_agrif 433 IF( .NOT. Agrif_Root() ) THEN 434 rn_Dt = Agrif_Parent(rn_Dt) / Agrif_Rhot()454 IF( .NOT. Agrif_Root() ) THEN ! AGRIF child, subdivide the Parent timestep 455 rn_Dt = Agrif_Parent (rn_Dt ) / Agrif_Rhot() 435 456 ENDIF 436 457 #endif … … 446 467 ENDIF 447 468 ! 448 ! ! Initialisecurrent model timestep rDt = 2*rn_Dt if MLF or rDt = rn_Dt if RK3449 rDt = 2._wp * rn_Dt469 ! set current model timestep rDt = 2*rn_Dt if MLF or rDt = rn_Dt if RK3 470 rDt = 2._wp * rn_Dt 450 471 r1_Dt = 1._wp / rDt 472 ! 473 #if defined key_qco 474 IF( ln_linssh ) CALL ctl_stop( 'STOP','domain: key_qco and ln_linssh = T are incompatible' ) 475 #endif 451 476 452 477 IF( TRIM(Agrif_CFixed()) == '0' ) THEN 453 lrxios = ln_xios_read.AND.ln_rstart 454 !set output file type for XIOS based on NEMO namelist 455 IF (nn_wxios > 0) lwxios = .TRUE. 478 lrxios = ln_xios_read .AND. ln_rstart 479 IF (nn_wxios > 0) lwxios = .TRUE. ! set output file type for XIOS based on NEMO namelist 456 480 nxioso = nn_wxios 457 481 ENDIF 458 482 459 483 #if defined key_netcdf4 460 ! ! NetCDF 4 case ("key_netcdf4" defined) 484 ! 485 ! !=======================! 486 ! !== namelist namnc4 ==! NetCDF 4 case ("key_netcdf4" defined) 487 ! !=======================! 488 ! 461 489 READ ( numnam_ref, namnc4, IOSTAT = ios, ERR = 907) 462 490 907 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in reference namelist' ) … … 467 495 IF(lwp) THEN ! control print 468 496 WRITE(numout,*) 469 WRITE(numout,*) ' Namelist namnc4 - Netcdf4 chunking parameters '497 WRITE(numout,*) ' Namelist namnc4 - Netcdf4 chunking parameters ("key_netcdf4" defined)' 470 498 WRITE(numout,*) ' number of chunks in i-dimension nn_nchunks_i = ', nn_nchunks_i 471 499 WRITE(numout,*) ' number of chunks in j-dimension nn_nchunks_j = ', nn_nchunks_j -
NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/OCE/DOM/domqco.F90
r13761 r13874 9 9 !! 3.6 ! 2014-11 (P. Mathiot) add ice shelf capability 10 10 !! 4.1 ! 2019-08 (A. Coward, D. Storkey) add time level indices for prognostic variables 11 !! 4.x ! 2020-02 (S. Techene, G. Madec) quasi-eulerian coordinate (z* or s*) from domvvl 12 !!---------------------------------------------------------------------- 13 14 !!---------------------------------------------------------------------- 15 !! dom_qco_init : define initial vertical scale factors, depths and column thickness 16 !! dom_qco_zgr : Set ssh/h_0 ratio at t 17 !! dom_qco_r3c : Compute ssh/h_0 ratio at t-, u-, v-, and optionally f-points 18 !! qco_rst_read : read/write restart file 19 !! qco_ctl : Check the vvl options 11 !! - ! 2020-02 (S. Techene, G. Madec) quasi-eulerian coordinate (z* or s*) 12 !!---------------------------------------------------------------------- 13 14 !!---------------------------------------------------------------------- 15 !! dom_qco_init : define initial vertical scale factors, depths and column thickness 16 !! dom_qco_zgr : Set ssh/h_0 ratio at t 17 !! dom_qco_r3c : Compute ssh/h_0 ratio at t-, u-, v-, and optionally f-points 18 !! qco_ctl : Check the vvl options 20 19 !!---------------------------------------------------------------------- 21 20 USE oce ! ocean dynamics and tracers … … 56 55 LOGICAL , PUBLIC :: ln_vvl_dbg = .FALSE. ! debug control prints 57 56 58 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: un_td, vn_td ! thickness diffusion transport59 60 57 !! * Substitutions 61 58 # include "do_loop_substitute.h90" … … 88 85 ! 89 86 CALL qco_ctl ! choose vertical coordinate (z_star, z_tilde or layer) 90 !91 CALL qco_rst_read( nit000, Kbb, Kmm ) ! Read or initialize ssh_(Kbb/Kmm)92 87 ! 93 88 CALL dom_qco_zgr( Kbb, Kmm ) ! interpolation scale factor, depth and water column … … 113 108 !! *** ROUTINE dom_qco_init *** 114 109 !! 115 !! ** Purpose : Initialization of all ssh./h._0 ratio 116 !! 117 !! ** Method : - call domqco using Kbb and Kmm 118 !! 119 !! ** Action : - r3(t/u/v)_b 120 !! - r3(t/u/v/f)_n 110 !! ** Purpose : Initialization of all r3. = ssh./h._0 ratios 111 !! 112 !! ** Method : Call domqco using Kbb and Kmm 113 !! NB: dom_qco_zgr is called by dom_qco_init it uses ssh from ssh_init 114 !! 115 !! ** Action : - r3(t/u/v)(Kbb) 116 !! - r3(t/u/v/f)(Kmm) 121 117 !!---------------------------------------------------------------------- 122 118 INTEGER, INTENT(in) :: Kbb, Kmm ! time level indices … … 125 121 ! !== Set of all other vertical scale factors ==! (now and before) 126 122 ! ! Horizontal interpolation of e3t 127 CALL dom_qco_r3c( ssh(:,:,Kbb), r3t(:,:,Kbb), r3u(:,:,Kbb), r3v(:,:,Kbb) )123 CALL dom_qco_r3c( ssh(:,:,Kbb), r3t(:,:,Kbb), r3u(:,:,Kbb), r3v(:,:,Kbb) ) 128 124 CALL dom_qco_r3c( ssh(:,:,Kmm), r3t(:,:,Kmm), r3u(:,:,Kmm), r3v(:,:,Kmm), r3f(:,:) ) 129 !130 125 ! 131 126 END SUBROUTINE dom_qco_zgr … … 204 199 ! 205 200 END SUBROUTINE dom_qco_r3c 206 207 208 SUBROUTINE qco_rst_read( kt, Kbb, Kmm )209 !!---------------------------------------------------------------------210 !! *** ROUTINE qco_rst_read ***211 !!212 !! ** Purpose : Read ssh in restart file213 !!214 !! ** Method : use of IOM library215 !! if the restart does not contain ssh,216 !! it is set to the _0 values.217 !!----------------------------------------------------------------------218 INTEGER, INTENT(in) :: kt ! ocean time-step219 INTEGER, INTENT(in) :: Kbb, Kmm ! ocean time level indices220 !221 INTEGER :: ji, jj, jk222 INTEGER :: id1, id2 ! local integers223 !!----------------------------------------------------------------------224 !225 IF( ln_rstart ) THEN !* Read the restart file226 CALL rst_read_open ! open the restart file if necessary227 !228 id1 = iom_varid( numror, 'sshb', ldstop = .FALSE. )229 id2 = iom_varid( numror, 'sshn', ldstop = .FALSE. )230 !231 ! ! --------- !232 ! ! all cases !233 ! ! --------- !234 !235 IF( MIN( id1, id2 ) > 0 ) THEN ! all required arrays exist236 CALL iom_get( numror, jpdom_auto, 'sshb' , ssh(:,:,Kbb), ldxios = lrxios )237 CALL iom_get( numror, jpdom_auto, 'sshn' , ssh(:,:,Kmm), ldxios = lrxios )238 ! needed to restart if land processor not computed239 IF(lwp) write(numout,*) 'qco_rst_read : ssh(:,:,Kbb) and ssh(:,:,Kmm) found in restart files'240 !!WHERE ( ssmask(:,:) == 0.0_wp ) !!gm/st ==> sm should not be necessary on ssh while it was required on e3241 !! ssh(:,:,Kmm) = 0._wp242 !! ssh(:,:,Kbb) = 0._wp243 !!END WHERE244 IF( l_1st_euler ) THEN245 ssh(:,:,Kbb) = ssh(:,:,Kmm)246 ENDIF247 ELSE IF( id1 > 0 ) THEN248 IF(lwp) write(numout,*) 'qco_rst_read WARNING : ssh(:,:,Kmm) not found in restart files'249 IF(lwp) write(numout,*) 'sshn set equal to sshb.'250 IF(lwp) write(numout,*) 'neuler is forced to 0'251 CALL iom_get( numror, jpdom_auto, 'sshb', ssh(:,:,Kbb), ldxios = lrxios )252 ssh(:,:,Kmm) = ssh(:,:,Kbb)253 l_1st_euler = .TRUE.254 ELSE IF( id2 > 0 ) THEN255 IF(lwp) write(numout,*) 'qco_rst_read WARNING : ssh(:,:,Kbb) not found in restart files'256 IF(lwp) write(numout,*) 'sshb set equal to sshn.'257 IF(lwp) write(numout,*) 'neuler is forced to 0'258 CALL iom_get( numror, jpdom_auto, 'sshn', ssh(:,:,Kmm), ldxios = lrxios )259 ssh(:,:,Kbb) = ssh(:,:,Kmm)260 l_1st_euler = .TRUE.261 ELSE262 IF(lwp) write(numout,*) 'qco_rst_read WARNING : ssh(:,:,Kmm) not found in restart file'263 IF(lwp) write(numout,*) 'ssh_b and ssh_n set to zero'264 IF(lwp) write(numout,*) 'neuler is forced to 0'265 ssh(:,:,:) = 0._wp266 l_1st_euler = .TRUE.267 ENDIF268 !269 ELSE !* Initialize at "rest"270 !271 IF( ll_wd ) THEN ! MJB ll_wd edits start here - these are essential272 !273 IF( cn_cfg == 'wad' ) THEN ! Wetting and drying test case274 CALL usr_def_istate( gdept(:,:,:,Kbb), tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb) )275 ts (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb) ! set now values from to before ones276 ssh(:,: ,Kmm) = ssh(:,: ,Kbb)277 uu (:,:,: ,Kmm) = uu (:,:,: ,Kbb)278 vv (:,:,: ,Kmm) = vv (:,:,: ,Kbb)279 ELSE ! if not test case280 ssh(:,:,Kmm) = -ssh_ref281 ssh(:,:,Kbb) = -ssh_ref282 !283 DO_2D( 1, 1, 1, 1 )284 IF( ht_0(ji,jj)-ssh_ref < rn_wdmin1 ) THEN ! if total depth is less than min depth285 ssh(ji,jj,Kbb) = rn_wdmin1 - (ht_0(ji,jj) )286 ssh(ji,jj,Kmm) = rn_wdmin1 - (ht_0(ji,jj) )287 ENDIF288 END_2D289 ENDIF290 !291 DO ji = 1, jpi292 DO jj = 1, jpj293 IF ( ht_0(ji,jj) .LE. 0.0 .AND. NINT( ssmask(ji,jj) ) .EQ. 1) THEN294 CALL ctl_stop( 'qco_rst_read: ht_0 must be positive at potentially wet points' )295 ENDIF296 END DO297 END DO298 !299 ELSE300 !301 ! Just to read set ssh in fact, called latter once vertical grid302 ! is set up:303 ! CALL usr_def_istate( gdept_0, tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb) )304 ! !305 !!st ssh(:,:,:) = 0._wp306 CALL usr_def_ssh( tmask, ssh(:,:,Kbb) )307 !308 ssh(:,:,Kmm) = ssh(:,:,Kbb)309 !310 ENDIF ! end of ll_wd edits311 !312 ENDIF313 !314 END SUBROUTINE qco_rst_read315 201 316 202 -
NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/OCE/DOM/domvvl.F90
r13295 r13874 9 9 !! 3.6 ! 2014-11 (P. Mathiot) add ice shelf capability 10 10 !! 4.1 ! 2019-08 (A. Coward, D. Storkey) rename dom_vvl_sf_swp -> dom_vvl_sf_update for new timestepping 11 !! 4.x !2020-02 (G. Madec, S. Techene) introduce ssh to h0 ratio11 !! - ! 2020-02 (G. Madec, S. Techene) introduce ssh to h0 ratio 12 12 !!---------------------------------------------------------------------- 13 13 … … 805 805 IF( ln_rstart ) THEN !* Read the restart file 806 806 CALL rst_read_open ! open the restart file if necessary 807 CALL iom_get( numror, jpdom_auto, 'sshn' , ssh(:,:,Kmm), ldxios = lrxios )808 807 ! 809 808 id1 = iom_varid( numror, 'e3t_b', ldstop = .FALSE. ) … … 882 881 ENDIF 883 882 ! 884 ELSE !* Initialize at "rest" 883 ELSE !* Initialize at "rest" with ssh 885 884 ! 886 887 IF( ll_wd ) THEN ! MJB ll_wd edits start here - these are essential 888 ! 889 IF( cn_cfg == 'wad' ) THEN 890 ! Wetting and drying test case 891 CALL usr_def_istate( gdept(:,:,:,Kbb), tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb) ) 892 ts (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb) ! set now values from to before ones 893 ssh (:,:,Kmm) = ssh(:,:,Kbb) 894 uu (:,:,:,Kmm) = uu (:,:,:,Kbb) 895 vv (:,:,:,Kmm) = vv (:,:,:,Kbb) 896 ELSE 897 ! if not test case 898 ssh(:,:,Kmm) = -ssh_ref 899 ssh(:,:,Kbb) = -ssh_ref 900 901 DO_2D( 1, 1, 1, 1 ) 902 IF( ht_0(ji,jj)-ssh_ref < rn_wdmin1 ) THEN ! if total depth is less than min depth 903 ssh(ji,jj,Kbb) = rn_wdmin1 - (ht_0(ji,jj) ) 904 ssh(ji,jj,Kmm) = rn_wdmin1 - (ht_0(ji,jj) ) 905 ENDIF 906 END_2D 907 ENDIF !If test case else 908 909 ! Adjust vertical metrics for all wad 910 DO jk = 1, jpk 911 e3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kmm) ) & 912 & / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk) & 913 & + e3t_0(:,:,jk) * ( 1._wp - tmask(:,:,jk) ) 914 END DO 915 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 916 917 DO_2D( 1, 1, 1, 1 ) 918 IF ( ht_0(ji,jj) .LE. 0.0 .AND. NINT( ssmask(ji,jj) ) .EQ. 1) THEN 919 CALL ctl_stop( 'dom_vvl_rst: ht_0 must be positive at potentially wet points' ) 920 ENDIF 921 END_2D 922 ! 923 ELSE 924 ! 925 ! Just to read set ssh in fact, called latter once vertical grid 926 ! is set up: 927 ! CALL usr_def_istate( gdept_0, tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb) ) 928 ! ! 929 ! DO jk=1,jpk 930 ! e3t(:,:,jk,Kbb) = e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kbb) ) & 931 ! & / ( ht_0(:,:) + 1._wp -ssmask(:,:) ) * tmask(:,:,jk) 932 ! END DO 933 ! e3t(:,:,:,Kmm) = e3t(:,:,:,Kbb) 934 ssh(:,:,Kmm)=0._wp 935 e3t(:,:,:,Kmm)=e3t_0(:,:,:) 936 e3t(:,:,:,Kbb)=e3t_0(:,:,:) 937 ! 938 END IF ! end of ll_wd edits 939 885 DO jk = 1, jpk 886 e3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * ( 1._wp + ssh(:,:,Kmm) / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk) ) 887 END DO 888 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 889 ! 940 890 IF( ln_vvl_ztilde .OR. ln_vvl_layer) THEN 941 891 tilde_e3t_b(:,:,:) = 0._wp -
NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/OCE/DOM/istate.F90
r13734 r13874 59 59 !! 60 60 !! ** Purpose : Initialization of the dynamics and tracer fields. 61 !! 62 !! ** Method : 61 63 !!---------------------------------------------------------------------- 62 64 INTEGER, INTENT( in ) :: Kbb, Kmm, Kaa ! ocean time level indices … … 73 75 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 74 76 75 !!gm Why not include in the first call of dta_tsd ?76 !!gm probably associated with the use of internal damping...77 77 CALL dta_tsd_init ! Initialisation of T & S input data 78 !!gm to be moved in usrdef of C1D case 78 79 79 ! IF( lk_c1d ) CALL dta_uvd_init ! Initialization of U & V input data 80 !!gm 80 81 81 rhd (:,:,: ) = 0._wp ; rhop (:,:,: ) = 0._wp ! set one for all to 0 at level jpk 82 82 rn2b (:,:,: ) = 0._wp ; rn2 (:,:,: ) = 0._wp ! set one for all to 0 at levels 1 and jpk … … 95 95 CALL agrif_istate( Kbb, Kmm, Kaa ) ! Interp from parent 96 96 ! 97 ts (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb) 97 ts (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb) 98 !!st 99 !!st need for a recent agrif version to be displaced toward ssh_init_rst with agrif_istate_ssh 98 100 ssh(:,:, Kmm) = ssh(:,: ,Kbb) 101 !!st end 99 102 uu (:,:,: ,Kmm) = uu (:,:,: ,Kbb) 100 103 vv (:,:,: ,Kmm) = vv (:,:,: ,Kbb) … … 116 119 CALL dta_tsd( nit000, ts(:,:,:,:,Kbb) ) ! read 3D T and S data at nit000 117 120 ! 118 ssh(:,: ,Kbb) = 0._wp ! set the ocean at rest119 121 uu (:,:,:,Kbb) = 0._wp 120 122 vv (:,:,:,Kbb) = 0._wp 121 123 ! 122 IF( ll_wd ) THEN123 ssh(:,:,Kbb) = -ssh_ref ! Added in 30 here for bathy that adds 30 as Iterative test CEOD124 !125 ! Apply minimum wetdepth criterion126 !127 DO_2D( 1, 1, 1, 1 )128 IF( ht_0(ji,jj) + ssh(ji,jj,Kbb) < rn_wdmin1 ) THEN129 ssh(ji,jj,Kbb) = tmask(ji,jj,1)*( rn_wdmin1 - (ht_0(ji,jj)) )130 ENDIF131 END_2D132 ENDIF133 !134 124 ELSE ! user defined initial T and S 135 125 DO jk = 1, jpk 136 126 zgdept(:,:,jk) = gdept(:,:,jk,Kbb) 137 127 END DO 138 CALL usr_def_istate( zgdept, tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb) , ssh(:,:,Kbb) )128 CALL usr_def_istate( zgdept, tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb) ) 139 129 ENDIF 140 130 ts (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb) ! set now values from to before ones 141 ssh(:,: ,Kmm) = ssh(:,: ,Kbb)142 131 uu (:,:,: ,Kmm) = uu (:,:,: ,Kbb) 143 132 vv (:,:,: ,Kmm) = vv (:,:,: ,Kbb) 144 133 145 !!gm POTENTIAL BUG :146 !!gm ISSUE : if ssh(:,:,Kbb) /= 0 then, in non linear free surface, the e3._n, e3._b should be recomputed147 !! as well as gdept_ and gdepw_.... !!!!!148 !! ===>>>> probably a call to domvvl initialisation here....149 150 151 134 ! 152 !!gm to be moved in usrdef of C1D case153 !IF ( ln_uvd_init .AND. lk_c1d ) THEN ! read 3D U and V data at nit000154 !ALLOCATE( zuvd(jpi,jpj,jpk,2) )155 ! CALL dta_uvd( nit000, zuvd )156 ! uu(:,:,:,Kbb) = zuvd(:,:,:,1); uu(:,:,:,Kmm) = uu(:,:,:,Kbb)157 ! vv(:,:,:,Kbb) = zuvd(:,:,:,2); vv(:,:,:,Kmm) = vv(:,:,:,Kbb)158 !DEALLOCATE( zuvd )159 !ENDIF135 !!gm ==>>> to be moved in usrdef_istate of C1D case 136 IF ( ln_uvd_init .AND. lk_c1d ) THEN ! read 3D U and V data at nit000 137 ALLOCATE( zuvd(jpi,jpj,jpk,2) ) 138 CALL dta_uvd( nit000, Kbb, zuvd ) 139 uu(:,:,:,Kbb) = zuvd(:,:,:,1) ; uu(:,:,:,Kmm) = uu(:,:,:,Kbb) 140 vv(:,:,:,Kbb) = zuvd(:,:,:,2) ; vv(:,:,:,Kmm) = vv(:,:,:,Kbb) 141 DEALLOCATE( zuvd ) 142 ENDIF 160 143 ! 161 !!gm This is to be changed !!!!162 ! ! - ML - ssh(:,:,Kmm) could be modified by istate_eel, so that initialization of e3t(:,:,:,Kbb) is done here163 ! IF( .NOT.ln_linssh ) THEN164 ! DO jk = 1, jpk165 ! e3t(:,:,jk,Kbb) = e3t(:,:,jk,Kmm)166 ! END DO167 ! ENDIF168 !!gm169 144 ! 170 145 ENDIF -
NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/OCE/DYN/sshwzv.F90
r13427 r13874 6 6 !! History : 3.1 ! 2009-02 (G. Madec, M. Leclair) Original code 7 7 !! 3.3 ! 2010-04 (M. Leclair, G. Madec) modified LF-RA 8 !! - ! 2010-05 (K. Mogensen, A. Weaver, M. Martin, D. Lea) Assimilation interface 9 !! - ! 2010-09 (D.Storkey and E.O'Dea) bug fixes for BDY module 10 !! 3.3 ! 2011-10 (M. Leclair) split former ssh_wzv routine and remove all vvl related work 11 !! 4.0 ! 2018-12 (A. Coward) add mixed implicit/explicit advection 12 !! 4.1 ! 2019-08 (A. Coward, D. Storkey) Rename ssh_nxt -> ssh_atf. Now only does time filtering. 8 !! - ! 2010-05 (K. Mogensen, A. Weaver, M. Martin, D. Lea) Assimilation interface 9 !! - ! 2010-09 (D.Storkey and E.O'Dea) bug fixes for BDY module 10 !! 3.3 ! 2011-10 (M. Leclair) split former ssh_wzv routine and remove all vvl related work 11 !! 4.0 ! 2018-12 (A. Coward) add mixed implicit/explicit advection 12 !! 4.1 ! 2019-08 (A. Coward, D. Storkey) Rename ssh_nxt -> ssh_atf. Now only does time filtering. 13 !! - ! 2020-08 (S. Techene, G. Madec) add here ssh initiatlisation 13 14 !!---------------------------------------------------------------------- 14 15 … … 17 18 !! ssh_atf : time filter the ssh arrays 18 19 !! wzv : compute now vertical velocity 20 !! ssh_init_rst : ssh set from restart or domcfg.nc file or usr_def_istat_ssh 19 21 !!---------------------------------------------------------------------- 20 22 USE oce ! ocean dynamics and tracers variables … … 40 42 USE timing ! Timing 41 43 USE wet_dry ! Wetting/Drying flux limiting 42 44 USE usrdef_istate, ONLY : usr_def_istate_ssh ! user defined ssh initial state 45 43 46 IMPLICIT NONE 44 47 PRIVATE 45 48 46 PUBLIC ssh_nxt ! called by step.F90 47 PUBLIC wzv ! called by step.F90 48 PUBLIC wAimp ! called by step.F90 49 PUBLIC ssh_atf ! called by step.F90 49 PUBLIC ssh_nxt ! called by step.F90 50 PUBLIC wzv ! called by step.F90 51 PUBLIC wAimp ! called by step.F90 52 PUBLIC ssh_atf ! called by step.F90 53 PUBLIC ssh_init_rst ! called by domain.F90 50 54 51 55 !! * Substitutions 52 56 # include "do_loop_substitute.h90" 53 57 # include "domzgr_substitute.h90" 54 55 58 !!---------------------------------------------------------------------- 56 59 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 433 436 ! 434 437 END SUBROUTINE wAimp 438 439 440 SUBROUTINE ssh_init_rst( Kbb, Kmm, Kaa ) 441 !!--------------------------------------------------------------------- 442 !! *** ROUTINE ssh_init_rst *** 443 !! 444 !! ** Purpose : ssh initialization of the sea surface height (ssh) 445 !! 446 !! ** Method : set ssh from restart or read configuration, or user_def 447 !! * ln_rstart = T 448 !! USE of IOM library to read ssh in the restart file 449 !! Leap-Frog: Kbb and Kmm are read except for l_1st_euler=T 450 !! or Kbb not found 451 !! * otherwise 452 !! call user defined ssh or 453 !! set to -ssh_ref in wet and drying case with domcfg.nc 454 !! 455 !! NB: ssh_b/n are written by restart.F90 456 !!---------------------------------------------------------------------- 457 INTEGER, INTENT(in) :: Kbb, Kmm, Kaa ! ocean time level indices 458 ! 459 INTEGER :: ji, jj, jk 460 INTEGER :: id_sshb, id_sshn ! local integers 461 !!---------------------------------------------------------------------- 462 ! 463 ! !=============================! 464 IF( ln_rstart ) THEN !== Read the restart file ==! 465 ! !=============================! 466 ! 467 CALL rst_read_open !* open the restart file 468 ! 469 id_sshb = iom_varid( numror, 'sshb', ldstop = .FALSE. ) 470 id_sshn = iom_varid( numror, 'sshn', ldstop = .FALSE. ) 471 ! 472 IF( id_sshb <= 0 .AND. .NOT.l_1st_euler ) THEN 473 CALL ctl_warn ('ssh_init_rst: ssh at Kbb not found in restart files ', & 474 & 'l_1st_euler forced to .true. and ', & 475 & 'ssh(Kbb) = ssh(Kmm) ' ) 476 l_1st_euler = .TRUE. 477 ENDIF 478 ! 479 IF( id_sshn <= 0 ) THEN ! A restart require sshn present in the restart file 480 CALL ctl_stop('STOP', 'ssh_init_rst: ssh at Kmm not found in the restart file') 481 ! 482 ELSE ! read ssh at Kmm 483 CALL iom_get( numror, jpdom_auto, 'sshn' , ssh(:,:,Kmm), ldxios = lrxios ) 484 ! 485 IF( l_1st_euler ) THEN ! Euler at first time-step: ssh_Kbb = ssh_Kmm 486 ssh(:,:,Kbb) = ssh(:,:,Kmm) 487 ! 488 ELSE ! read ssh at Kbb 489 CALL iom_get( numror, jpdom_auto, 'sshb', ssh(:,:,Kbb), ldxios = lrxios ) 490 ENDIF 491 ENDIF 492 ! !============================! 493 ELSE !== Initialize at "rest" ==! 494 ! !============================! 495 ! 496 IF( ll_wd ) THEN !* wet and dry 497 ! 498 IF( ln_read_cfg ) THEN ! read configuration : ssh_ref is read in domain_cfg file 499 !!st why ssh is not masked : i.e. ssh(:,:,Kmm) = -ssh_ref*ssmask(:,:), 500 !!st since at the 1st time step lbclnk will be applied on ssh at Kaa but not initially at Kbb and Kmm 501 ssh(:,:,Kbb) = -ssh_ref 502 ! 503 DO_2D( 1, 1, 1, 1 ) 504 IF( ht_0(ji,jj)-ssh_ref < rn_wdmin1 ) THEN ! if total depth is less than min depth 505 ssh(ji,jj,Kbb) = rn_wdmin1 - ht_0(ji,jj) 506 ENDIF 507 END_2D 508 ELSE ! user define configuration case 509 CALL usr_def_istate_ssh( tmask, ssh(:,:,Kbb) ) 510 ENDIF 511 ! 512 ELSE !* user defined configuration 513 CALL usr_def_istate_ssh( tmask, ssh(:,:,Kbb) ) 514 ! 515 ENDIF 516 ! 517 ssh(:,:,Kmm) = ssh(:,:,Kbb) !* set now values from to before ones 518 ssh(:,:,Kaa) = 0._wp 519 ENDIF 520 ! 521 END SUBROUTINE ssh_init_rst 522 435 523 !!====================================================================== 436 524 END MODULE sshwzv -
NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/OCE/IOM/restart.F90
r13697 r13874 11 11 !! 3.7 ! 2014-01 (G. Madec) suppression of curl and hdiv from the restart 12 12 !! - ! 2014-12 (G. Madec) remove KPP scheme 13 !! 4.1 ! 2020-11 (S. Techene, G. Madec) move ssh initiatlisation in DYN/sshwzv:ssh_init_rst 13 14 !!---------------------------------------------------------------------- 14 15 … … 139 140 !! ** Method : Write in numrow when kt == nitrst in NetCDF 140 141 !! file, save fields which are necessary for restart 142 !! 143 !! NB: ssh is written here (rst_write) 144 !! but is read or set in DYN/sshwzv:shh_init_rst 141 145 !!---------------------------------------------------------------------- 142 146 INTEGER, INTENT(in) :: kt ! ocean time-step … … 209 213 ! can handle checking if variable is in the restart file (there will be no need to open 210 214 ! restart) 211 IF( .NOT.lxios_set)lrxios = lrxios.AND.lxios_sini212 IF( lrxios ) THEN215 IF( .NOT.lxios_set ) lrxios = lrxios.AND.lxios_sini 216 IF( lrxios ) THEN 213 217 crxios_context = 'nemo_rst' 214 218 IF( .NOT.lxios_set ) THEN … … 218 222 ENDIF 219 223 ENDIF 220 IF( TRIM(Agrif_CFixed()) /= '0' .AND. lrxios ) THEN224 IF( TRIM(Agrif_CFixed()) /= '0' .AND. lrxios ) THEN 221 225 CALL iom_init( crxios_context ) 222 226 IF(lwp) WRITE(numout,*) 'Enable restart reading by XIOS for AGRIF' … … 232 236 !! *** ROUTINE rst_read *** 233 237 !! 234 !! ** Purpose : Read files for NetCDF restart238 !! ** Purpose : Read velocity and T-S fields in the restart file 235 239 !! 236 !! ** Method : Read in restart.nc file fields which are necessary for restart 240 !! ** Method : Read in restart.nc fields which are necessary for restart 241 !! 242 !! NB: ssh is read or set in DYN/sshwzv:shh_init_rst 243 !! but is written in IOM/restart:rst_write 237 244 !!---------------------------------------------------------------------- 238 245 INTEGER, INTENT(in) :: Kbb, Kmm ! ocean time level indices … … 242 249 !!---------------------------------------------------------------------- 243 250 244 CALL rst_read_open ! open restart for reading (if not already opened)245 246 ! Check dynamics and tracertime-step consistency and force Euler restart if changed251 CALL rst_read_open ! open restart for reading (if not already opened) 252 253 ! ! Check time-step consistency and force Euler restart if changed 247 254 IF( iom_varid( numror, 'rdt', ldstop = .FALSE. ) > 0 ) THEN 248 255 CALL iom_get( numror, 'rdt', zrdt, ldxios = lrxios ) … … 258 265 CALL iom_delay_rst( 'READ', 'OCE', numror ) ! read only ocean delayed global communication variables 259 266 260 ! Diurnal DSST261 IF( ln_diurnal ) CALL iom_get( numror, jpdom_auto, 'Dsst' , x_dsst, ldxios = lrxios )267 ! ! Diurnal DSST 268 IF( ln_diurnal ) CALL iom_get( numror, jpdom_auto, 'Dsst' , x_dsst, ldxios = lrxios ) 262 269 IF ( ln_diurnal_only ) THEN 263 270 IF(lwp) WRITE( numout, * ) & … … 275 282 CALL iom_get( numror, jpdom_auto, 'tb' , ts(:,:,:,jp_tem,Kbb), ldxios = lrxios ) 276 283 CALL iom_get( numror, jpdom_auto, 'sb' , ts(:,:,:,jp_sal,Kbb), ldxios = lrxios ) 277 #if ! defined key_qco278 CALL iom_get( numror, jpdom_auto, 'sshb' ,ssh(:,: ,Kbb), ldxios = lrxios )279 #endif280 284 ELSE 281 285 l_1st_euler = .TRUE. ! before field not found, forced euler 1st time-step … … 287 291 CALL iom_get( numror, jpdom_auto, 'tn' , ts(:,:,:,jp_tem,Kmm), ldxios = lrxios ) 288 292 CALL iom_get( numror, jpdom_auto, 'sn' , ts(:,:,:,jp_sal,Kmm), ldxios = lrxios ) 289 #if ! defined key_qco 290 CALL iom_get( numror, jpdom_auto, 'sshn' ,ssh(:,: ,Kmm), ldxios = lrxios ) 291 #endif 293 ! 292 294 IF( iom_varid( numror, 'rhop', ldstop = .FALSE. ) > 0 ) THEN 293 295 CALL iom_get( numror, jpdom_auto, 'rhop' , rhop, ldxios = lrxios ) ! now potential density … … 296 298 ENDIF 297 299 ! 298 IF( l_1st_euler ) THEN ! Euler restart 299 ts (:,:,:,:,Kbb) = ts (:,:,:,:,Kmm) ! all before fields set to now values 300 uu (:,:,: ,Kbb) = uu (:,:,: ,Kmm) 301 vv (:,:,: ,Kbb) = vv (:,:,: ,Kmm) 302 ssh (:,: ,Kbb) = ssh (:,: ,Kmm) 300 IF( l_1st_euler ) THEN ! Euler restart 301 ts(:,:,:,:,Kbb) = ts(:,:,:,:,Kmm) ! all before fields set to now values 302 uu(:,:,: ,Kbb) = uu(:,:,: ,Kmm) 303 vv(:,:,: ,Kbb) = vv(:,:,: ,Kmm) 303 304 ENDIF 304 305 ! -
NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/OCE/USR/usrdef_istate.F90
r13761 r13874 7 7 !! User defined : set the initial state of a user configuration 8 8 !!====================================================================== 9 !! History : 4.0 ! 2016-03 (S. Flavoni) Original code 9 !! History : 4.0 ! 2016-03 (S. Flavoni) Original code 10 !! ! 2020-11 (S. Techene, G. Madec) separate tsuv from ssh 10 11 !!---------------------------------------------------------------------- 11 12 … … 22 23 PRIVATE 23 24 24 PUBLIC usr_def_istate ! called in istate.F9025 PUBLIC usr_def_ ssh! called by domqco.F9025 PUBLIC usr_def_istate ! called in istate.F90 26 PUBLIC usr_def_istate_ssh ! called by domqco.F90 26 27 27 28 !! * Substitutions … … 34 35 CONTAINS 35 36 36 SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv , pssh)37 SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv ) 37 38 !!---------------------------------------------------------------------- 38 39 !! *** ROUTINE usr_def_istate *** … … 49 50 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: pu ! i-component of the velocity [m/s] 50 51 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: pv ! j-component of the velocity [m/s] 51 REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: pssh ! sea-surface height52 52 ! 53 53 INTEGER :: ji, jj, jk ! dummy loop indices … … 60 60 pu (:,:,:) = 0._wp ! ocean at rest 61 61 pv (:,:,:) = 0._wp 62 pssh(:,:) = 0._wp63 62 ! 64 63 DO_3D( 1, 1, 1, 1, 1, jpk ) … … 82 81 83 82 84 SUBROUTINE usr_def_ ssh( ptmask, pssh )83 SUBROUTINE usr_def_istate_ssh( ptmask, pssh ) 85 84 !!---------------------------------------------------------------------- 86 !! *** ROUTINE usr_def_istate ***85 !! *** ROUTINE usr_def_istate_ssh *** 87 86 !! 88 87 !! ** Purpose : Initialization of ssh 89 88 !! 90 !! ** Method : Set as null89 !! ** Method : Set ssh as null, ptmask is required for test cases 91 90 !!---------------------------------------------------------------------- 92 91 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: ptmask ! t-point ocean mask [m] … … 95 94 ! 96 95 IF(lwp) WRITE(numout,*) 97 IF(lwp) WRITE(numout,*) 'usr_def_ ssh : GYRE configuration, analytical definition of initial state'98 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~ 96 IF(lwp) WRITE(numout,*) 'usr_def_istate_ssh : GYRE configuration, analytical definition of initial state' 97 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~~ Ocean at rest, ssh is zero' 99 98 ! 100 99 ! Sea level: 101 100 pssh(:,:) = 0._wp 102 103 END SUBROUTINE usr_def_ ssh101 ! 102 END SUBROUTINE usr_def_istate_ssh 104 103 105 104 !!======================================================================
Note: See TracChangeset
for help on using the changeset viewer.
