Changeset 13874 for NEMO/branches/2020
- Timestamp:
- 2020-11-25T14:49:40+01:00 (3 years ago)
- Location:
- NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3
- Files:
-
- 16 edited
-
src/OCE/DOM/domain.F90 (modified) (11 diffs)
-
src/OCE/DOM/domqco.F90 (modified) (6 diffs)
-
src/OCE/DOM/domvvl.F90 (modified) (3 diffs)
-
src/OCE/DOM/istate.F90 (modified) (4 diffs)
-
src/OCE/DYN/sshwzv.F90 (modified) (4 diffs)
-
src/OCE/IOM/restart.F90 (modified) (10 diffs)
-
src/OCE/USR/usrdef_istate.F90 (modified) (7 diffs)
-
tests/BENCH/MY_SRC/usrdef_istate.F90 (modified) (7 diffs)
-
tests/CANAL/MY_SRC/usrdef_istate.F90 (modified) (12 diffs)
-
tests/ISOMIP+/MY_SRC/istate.F90 (modified) (1 diff)
-
tests/ISOMIP/MY_SRC/usrdef_istate.F90 (modified) (7 diffs)
-
tests/LOCK_EXCHANGE/MY_SRC/usrdef_istate.F90 (modified) (7 diffs)
-
tests/OVERFLOW/MY_SRC/usrdef_istate.F90 (modified) (7 diffs)
-
tests/SWG/MY_SRC/usrdef_istate.F90 (modified) (7 diffs)
-
tests/VORTEX/MY_SRC/usrdef_istate.F90 (modified) (9 diffs)
-
tests/WAD/MY_SRC/usrdef_istate.F90 (modified) (10 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 !!====================================================================== -
NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/tests/BENCH/MY_SRC/usrdef_istate.F90
r13762 r13874 26 26 PRIVATE 27 27 28 PUBLIC usr_def_istate ! called by istate.F9029 PUBLIC usr_def_ ssh! called by domqco.F9028 PUBLIC usr_def_istate ! called by istate.F90 29 PUBLIC usr_def_istate_ssh ! called by domqco.F90 30 30 31 31 !! * Substitutions … … 38 38 CONTAINS 39 39 40 SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv , pssh )40 SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv ) !!st, pssh ) 41 41 !!---------------------------------------------------------------------- 42 42 !! *** ROUTINE usr_def_istate *** … … 53 53 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: pu ! i-component of the velocity [m/s] 54 54 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: pv ! j-component of the velocity [m/s] 55 REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: pssh ! sea-surface height55 !!st REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: pssh ! sea-surface height 56 56 ! 57 57 REAL(wp), DIMENSION(jpi,jpj) :: z2d ! 2D workspace … … 80 80 ! 81 81 ! sea level: 82 pssh(:,:) = z2d(:,:) ! +/- 0.05 m82 !!st pssh(:,:) = z2d(:,:) ! +/- 0.05 m 83 83 ! 84 84 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) … … 96 96 pv( :,:,jpk ) = 0._wp 97 97 ! 98 CALL lbc_lnk('usrdef_istate', pssh, 'T', 1. ) ! apply boundary conditions98 !!st CALL lbc_lnk('usrdef_istate', pssh, 'T', 1. ) ! apply boundary conditions 99 99 CALL lbc_lnk('usrdef_istate', pts, 'T', 1. ) ! apply boundary conditions 100 100 CALL lbc_lnk('usrdef_istate', pu, 'U', -1. ) ! apply boundary conditions … … 104 104 105 105 106 SUBROUTINE usr_def_ ssh( ptmask, pssh )106 SUBROUTINE usr_def_istate_ssh( ptmask, pssh ) 107 107 !!---------------------------------------------------------------------- 108 !! *** ROUTINE usr_def_ ssh ***108 !! *** ROUTINE usr_def_istate_ssh *** 109 109 !! 110 110 !! ** Purpose : Initialization of ssh … … 115 115 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: ptmask ! t-point ocean mask [m] 116 116 REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: pssh ! sea-surface height [m] 117 ! 118 INTEGER :: ji, jj 119 INTEGER :: igloi, igloj ! to be removed in the future, see usr_def_istate comment 117 120 !!---------------------------------------------------------------------- 118 121 ! 119 122 IF(lwp) WRITE(numout,*) 120 IF(lwp) WRITE(numout,*) 'usr_def_ ssh : BENCH configuration, analytical definition of initial state'123 IF(lwp) WRITE(numout,*) 'usr_def_istate_ssh : BENCH configuration, analytical definition of initial ssh' 121 124 ! 122 pssh(:,:) = 0._wp 125 igloi = Ni0glo + 2 * COUNT( (/ jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7 /) ) 126 igloj = Nj0glo + 2 * COUNT( (/ jperio == 2 .OR. jperio == 7 /) ) + 1 * COUNT( (/ jperio >= 4 .AND. jperio <= 6 /) ) 127 ! sea level: +/- 0.05 m 128 DO_2D( 0, 0, 0, 0 ) 129 pssh(ji,jj) = 0.1 * ( 0.5 - REAL( mig0_oldcmp(ji) + (mjg0_oldcmp(jj)-1) * igloi, wp ) / REAL( igloi * igloj, wp ) ) 130 END_2D 123 131 ! 124 END SUBROUTINE usr_def_ssh 132 CALL lbc_lnk('usrdef_istate', pssh, 'T', 1. ) ! apply boundary conditions 133 ! 134 END SUBROUTINE usr_def_istate_ssh 125 135 126 136 !!====================================================================== -
NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/tests/CANAL/MY_SRC/usrdef_istate.F90
r13295 r13874 26 26 PRIVATE 27 27 28 PUBLIC usr_def_istate ! called by istate.F90 28 PUBLIC usr_def_istate ! called by istate.F90 29 PUBLIC usr_def_istate_ssh ! called by sshwzv.F90 29 30 30 31 !! * Substitutions … … 37 38 CONTAINS 38 39 39 SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv , pssh)40 SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv ) 40 41 !!---------------------------------------------------------------------- 41 42 !! *** ROUTINE usr_def_istate *** … … 52 53 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: pu ! i-component of the velocity [m/s] 53 54 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: pv ! j-component of the velocity [m/s] 54 REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: pssh ! sea-surface height55 55 ! 56 56 INTEGER :: ji, jj, jk, jl ! dummy loop indices … … 72 72 SELECT CASE(nn_initcase) 73 73 CASE(0) ! rest 74 75 ! sea level: 76 pssh(:,:) = 0. 74 ! 77 75 ! temperature: 78 76 pts(:,:,:,jp_tem) = 10._wp … … 84 82 85 83 CASE(1) ! geostrophic zonal jet from -zjety to +zjety 86 87 ! sea level: 88 SELECT CASE( nn_fcase ) 89 CASE(0) ! f = f0 90 ! sea level: ssh = - fuy / g 91 WHERE( ABS(gphit) <= zjety ) 92 pssh(:,:) = - ff_t(:,:) * rn_uzonal * gphit(:,:) * 1.e3 / grav 93 ELSEWHERE 94 pssh(:,:) = - ff_t(:,:) * rn_uzonal * SIGN(zjety, gphit(:,:)) * 1.e3 / grav 95 END WHERE 96 CASE(1) ! f = f0 + beta*y 97 ! sea level: ssh = - u / g * ( fy + 0.5 * beta * y^2 ) 98 zbeta = 2._wp * omega * COS( rad * rn_ppgphi0 ) / ra 99 WHERE( ABS(gphit) <= zjety ) 100 pssh(:,:) = - rn_uzonal / grav * ( ff_t(:,:) * gphit(:,:) * 1.e3 + 0.5 * zbeta * gphit(:,:) * gphit(:,:) * 1.e6 ) 101 ELSEWHERE 102 pssh(:,:) = - rn_uzonal / grav * ( ff_t(:,:) * SIGN(zjety, gphit(:,:)) * 1.e3 & 103 & + 0.5 * zbeta * zjety * zjety * 1.e6 ) 104 END WHERE 105 END SELECT 84 ! 106 85 ! temperature: 107 86 pts(:,:,:,jp_tem) = 10._wp … … 119 98 ! 120 99 CASE(2) ! geostrophic zonal current shear 121 122 ! sea level: 123 SELECT CASE( nn_fcase ) 124 CASE(0) ! f = f0 125 ! sea level: ssh = - fuy / g 126 WHERE( ABS(gphit) <= zjety ) 127 pssh(:,:) = - ff_t(:,:) * rn_uzonal * ABS(gphit(:,:)) * 1.e3 / grav 128 ELSEWHERE 129 pssh(:,:) = - ff_t(:,:) * rn_uzonal * zjety * 1.e3 / grav 130 END WHERE 131 CASE(1) ! f = f0 + beta*y 132 ! sea level: ssh = - u / g * ( fy + 0.5 * beta * y^2 ) 133 zbeta = 2._wp * omega * COS( rad * rn_ppgphi0 ) / ra 134 WHERE( ABS(gphit) <= zjety ) 135 pssh(:,:) = - SIGN(rn_uzonal, gphit(:,:)) / grav & 136 & * ( ff_t(:,:) * gphit(:,:) * 1.e3 + 0.5 * zbeta * gphit(:,:) * gphit(:,:) * 1.e6 ) 137 ELSEWHERE 138 pssh(:,:) = - SIGN(rn_uzonal, gphit(:,:)) / grav & 139 & * ( ff_t(:,:) * SIGN(zjety, gphit(:,:)) * 1.e3 + 0.5 * zbeta * zjety * zjety * 1.e6 ) 140 END WHERE 141 END SELECT 100 ! 142 101 ! temperature: 143 102 pts(:,:,:,jp_tem) = 10._wp … … 156 115 ! 157 116 CASE(3) ! gaussian zonal currant 158 117 ! 159 118 ! zonal current 160 119 DO jk=1, jpkm1 … … 162 121 pu(:,:,jk) = rn_uzonal * EXP( - 0.5 * gphit(:,:)**2 / rn_lambda**2 ) 163 122 END DO 164 165 ! sea level:166 pssh(:,1) = - ff_t(:,1) / grav * pu(:,1,1) * e2t(:,1)167 DO jl=1, jpnj168 DO_2D( 0, 0, 0, 0 )169 pssh(ji,jj) = pssh(ji,jj-1) - ff_t(ji,jj) / grav * pu(ji,jj,1) * e2t(ji,jj)170 END_2D171 CALL lbc_lnk( 'usrdef_istate', pssh, 'T', 1. )172 END DO173 174 123 ! temperature: 175 124 pts(:,:,:,jp_tem) = 10._wp … … 182 131 ! 183 132 CASE(4) ! geostrophic zonal pulse 184 133 ! 185 134 DO_2D( 1, 1, 1, 1 ) 186 135 IF ( ABS(glamt(ji,jj)) <= zjetx ) THEN … … 190 139 ELSE 191 140 zdu = 0. 192 END 141 ENDIF 193 142 IF ( ABS(gphit(ji,jj)) <= zjety ) THEN 194 pssh(ji,jj) = - ff_t(ji,jj) * zdu * gphit(ji,jj) * 1.e3 / grav195 143 pu(ji,jj,:) = zdu 196 144 pts(ji,jj,:,jp_sal) = zdu / rn_uzonal + 1. 197 145 ELSE 198 pssh(ji,jj) = - ff_t(ji,jj) * zdu * SIGN(zjety,gphit(ji,jj)) * 1.e3 / grav199 146 pu(ji,jj,:) = 0. 200 147 pts(ji,jj,:,jp_sal) = 1. 201 END 202 END_2D 203 148 ENDIF 149 END_2D 150 ! 204 151 ! temperature: 205 152 pts(:,:,:,jp_tem) = 10._wp * ptmask(:,:,:) 206 153 pv(:,:,:) = 0. 207 208 209 154 ! 155 CASE(5) ! vortex 156 ! 210 157 zf0 = 2._wp * omega * SIN( rad * rn_ppgphi0 ) 211 zumax = rn_vtxmax * SIGN(1._wp, zf0) ! Here Anticyclonic: set zumax=-1 for cyclonic158 zumax = rn_vtxmax * SIGN(1._wp, zf0) ! Here Anticyclonic: set zumax=-1 for cyclonic 212 159 zlambda = SQRT(2._wp)*rn_lambda ! Horizontal scale in meters 213 160 zn2 = 3.e-3**2 … … 222 169 ! Surface pressure: P(x,y,z) = F(z) * Psurf(x,y) 223 170 zpsurf = zP0 * EXP(-(zx**2+zy**2)*zr_lambda2) - rho0 * ff_t(ji,jj) * rn_uzonal * zy 224 ! Sea level:225 pssh(ji,jj) = 0.226 DO jl=1,5227 zdt = pssh(ji,jj)228 zdzF = (1._wp - EXP(zdt-zH)) / (zH - 1._wp + EXP(-zH)) ! F'(z)229 zrho1 = rho0 * (1._wp + zn2*zdt/grav) - zdzF * zpsurf / grav ! -1/g Dz(P) = -1/g * F'(z) * Psurf(x,y)230 pssh(ji,jj) = zpsurf / (zrho1*grav) * ptmask(ji,jj,1) ! ssh = Psurf / (Rho*g)231 END DO232 171 ! temperature: 233 172 DO jk=1,jpk … … 279 218 ! 280 219 END SELECT 281 220 ! 221 CALL lbc_lnk( 'usrdef_istate', pts , 'T', 1. ) 222 CALL lbc_lnk_multi( 'usrdef_istate', pu, 'U', -1., pv, 'V', -1. ) 223 224 END SUBROUTINE usr_def_istate 225 226 227 SUBROUTINE usr_def_istate_ssh( ptmask, pssh ) 228 !!---------------------------------------------------------------------- 229 !! *** ROUTINE usr_def_istate_ssh *** 230 !! 231 !! ** Purpose : Initialization of the dynamics and tracers 232 !! Here CANAL configuration 233 !! 234 !! ** Method : Set ssh 235 !!---------------------------------------------------------------------- 236 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: ptmask ! t-point ocean mask [m] 237 REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: pssh ! sea-surface height 238 ! 239 INTEGER :: ji, jj, jk, jl ! dummy loop indices 240 REAL(wp) :: zx, zy, zP0, zumax, zlambda, zr_lambda2, zn2, zf0, zH, zrho1, za, zf, zdzF 241 REAL(wp) :: zpsurf, zdyPs, zdxPs 242 REAL(wp) :: zdt, zdu, zdv 243 REAL(wp) :: zjetx, zjety, zbeta 244 REAL(wp), DIMENSION(jpi,jpj) :: zrandom 245 !!---------------------------------------------------------------------- 246 ! 247 IF(lwp) WRITE(numout,*) 248 IF(lwp) WRITE(numout,*) 'usr_def_istate_ssh : CANAL configuration, analytical definition of initial state' 249 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~ ' 250 ! 251 IF (ln_sshnoise) CALL RANDOM_NUMBER(zrandom) 252 zjetx = ABS(rn_ujetszx)/2. 253 zjety = ABS(rn_ujetszy)/2. 254 ! 255 SELECT CASE(nn_initcase) 256 CASE(0) !== rest ==! 257 ! 258 pssh(:,:) = 0. 259 ! 260 CASE(1) !== geostrophic zonal jet from -zjety to +zjety ==! 261 ! 262 SELECT CASE( nn_fcase ) 263 CASE(0) !* f = f0 : ssh = - fuy / g 264 WHERE( ABS(gphit) <= zjety ) 265 pssh(:,:) = - ff_t(:,:) * rn_uzonal * gphit(:,:) * 1.e3 / grav 266 ELSEWHERE 267 pssh(:,:) = - ff_t(:,:) * rn_uzonal * SIGN(zjety, gphit(:,:)) * 1.e3 / grav 268 END WHERE 269 CASE(1) !* f = f0 + beta*y : ssh = - u / g * ( fy + 0.5 * beta * y^2 ) 270 zbeta = 2._wp * omega * COS( rad * rn_ppgphi0 ) / ra 271 WHERE( ABS(gphit) <= zjety ) 272 pssh(:,:) = - rn_uzonal / grav * ( ff_t(:,:) * gphit(:,:) * 1.e3 + 0.5 * zbeta * gphit(:,:) * gphit(:,:) * 1.e6 ) 273 ELSEWHERE 274 pssh(:,:) = - rn_uzonal / grav * ( ff_t(:,:) * SIGN(zjety, gphit(:,:)) * 1.e3 & 275 & + 0.5 * zbeta * zjety * zjety * 1.e6 ) 276 END WHERE 277 END SELECT 278 ! 279 CASE(2) !== geostrophic zonal current shear ==! 280 ! 281 SELECT CASE( nn_fcase ) 282 CASE(0) !* f = f0 : ssh = - fuy / g 283 WHERE( ABS(gphit) <= zjety ) 284 pssh(:,:) = - ff_t(:,:) * rn_uzonal * ABS(gphit(:,:)) * 1.e3 / grav 285 ELSEWHERE 286 pssh(:,:) = - ff_t(:,:) * rn_uzonal * zjety * 1.e3 / grav 287 END WHERE 288 CASE(1) !* f = f0 + beta*y : ssh = - u / g * ( fy + 0.5 * beta * y^2 ) 289 zbeta = 2._wp * omega * COS( rad * rn_ppgphi0 ) / ra 290 WHERE( ABS(gphit) <= zjety ) 291 pssh(:,:) = - SIGN(rn_uzonal, gphit(:,:)) / grav & 292 & * ( ff_t(:,:) * gphit(:,:) * 1.e3 + 0.5 * zbeta * gphit(:,:) * gphit(:,:) * 1.e6 ) 293 ELSEWHERE 294 pssh(:,:) = - SIGN(rn_uzonal, gphit(:,:)) / grav & 295 & * ( ff_t(:,:) * SIGN(zjety, gphit(:,:)) * 1.e3 + 0.5 * zbeta * zjety * zjety * 1.e6 ) 296 END WHERE 297 END SELECT 298 ! 299 CASE(3) !== gaussian zonal currant ==! 300 ! 301 pssh(:,1) = - ff_t(:,1) / grav * e2t(:,1) * rn_uzonal * EXP( - 0.5 * gphit(:,1)**2 / rn_lambda**2 ) 302 DO jl=1, jpnj 303 DO_2D( 0, 0, 0, 0 ) 304 pssh(ji,jj) = pssh(ji,jj-1) - ff_t(ji,jj) / grav * rn_uzonal * EXP( - 0.5 * gphit(ji,jj)**2 / rn_lambda**2 ) * e2t(ji,jj) 305 END_2D 306 CALL lbc_lnk( 'usrdef_istate_ssh', pssh, 'T', 1. ) 307 END DO 308 ! 309 CASE(4) !== geostrophic zonal pulse !!st need to implement a way to separate ssh properly ==! 310 ! 311 DO_2D( 1, 1, 1, 1 ) 312 IF ( ABS(glamt(ji,jj)) <= zjetx ) THEN 313 zdu = rn_uzonal 314 ELSEIF ( ABS(glamt(ji,jj)) <= zjetx + 100. ) THEN 315 zdu = rn_uzonal * ( ( zjetx-ABS(glamt(ji,jj)) )/100. + 1. ) 316 ELSE 317 zdu = 0. 318 ENDIF 319 IF ( ABS(gphit(ji,jj)) <= zjety ) THEN 320 pssh(ji,jj) = - ff_t(ji,jj) * zdu * gphit(ji,jj) * 1.e3 / grav 321 ELSE 322 pssh(ji,jj) = - ff_t(ji,jj) * zdu * SIGN(zjety,gphit(ji,jj)) * 1.e3 / grav 323 ENDIF 324 END_2D 325 ! 326 CASE(5) !== vortex ==! 327 ! 328 zf0 = 2._wp * omega * SIN( rad * rn_ppgphi0 ) 329 zumax = rn_vtxmax * SIGN(1._wp, zf0) ! Here Anticyclonic: set zumax=-1 for cyclonic 330 zlambda = SQRT(2._wp)*rn_lambda ! Horizontal scale in meters 331 zn2 = 3.e-3**2 332 zH = 0.5_wp * 5000._wp 333 ! 334 zr_lambda2 = 1._wp / zlambda**2 335 zP0 = rho0 * zf0 * zumax * zlambda * SQRT(EXP(1._wp)/2._wp) 336 ! 337 DO_2D( 1, 1, 1, 1 ) 338 zx = glamt(ji,jj) * 1.e3 339 zy = gphit(ji,jj) * 1.e3 340 ! ! Surface pressure: P(x,y,z) = F(z) * Psurf(x,y) 341 zpsurf = zP0 * EXP(-(zx**2+zy**2)*zr_lambda2) - rho0 * ff_t(ji,jj) * rn_uzonal * zy 342 pssh(ji,jj) = 0. 343 DO jl=1,5 344 zdt = pssh(ji,jj) 345 zdzF = (1._wp - EXP(zdt-zH)) / (zH - 1._wp + EXP(-zH)) ! F'(z) 346 zrho1 = rho0 * (1._wp + zn2*zdt/grav) - zdzF * zpsurf / grav ! -1/g Dz(P) = -1/g * F'(z) * Psurf(x,y) 347 pssh(ji,jj) = zpsurf / (zrho1*grav) * ptmask(ji,jj,1) ! ssh = Psurf / (Rho*g) 348 END DO 349 END_2D 350 ! 351 END SELECT 352 ! !== add noise ==! 282 353 IF (ln_sshnoise) THEN 283 354 CALL RANDOM_NUMBER(zrandom) 284 355 pssh(:,:) = pssh(:,:) + ( 0.1 * zrandom(:,:) - 0.05 ) 285 END IF 286 CALL lbc_lnk( 'usrdef_istate', pssh, 'T', 1. ) 287 CALL lbc_lnk( 'usrdef_istate', pts , 'T', 1. ) 288 CALL lbc_lnk_multi( 'usrdef_istate', pu, 'U', -1., pv, 'V', -1. ) 289 290 END SUBROUTINE usr_def_istate 291 356 ENDIF 357 CALL lbc_lnk( 'usrdef_istate_ssh', pssh, 'T', 1. ) 358 ! 359 END SUBROUTINE usr_def_istate_ssh 360 292 361 !!====================================================================== 293 362 END MODULE usrdef_istate -
NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/tests/ISOMIP+/MY_SRC/istate.F90
r13295 r13874 99 99 CALL dta_tsd( nit000, 'ini', ts(:,:,:,:,Kbb) ) ! read 3D T and S data at nit000 100 100 ! 101 ssh(:,:,Kbb) = 0._wp ! set the ocean at rest102 IF( ll_wd ) THEN103 ssh(:,:,Kbb) = -ssh_ref ! Added in 30 here for bathy that adds 30 as Iterative test CEOD104 !105 ! Apply minimum wetdepth criterion106 !107 DO_2D( 1, 1, 1, 1 )108 IF( ht_0(ji,jj) + ssh(ji,jj,Kbb) < rn_wdmin1 ) THEN109 ssh(ji,jj,Kbb) = tmask(ji,jj,1)*( rn_wdmin1 - (ht_0(ji,jj)) )110 ENDIF111 END_2D112 ENDIF101 !!st ssh(:,:,Kbb) = 0._wp ! set the ocean at rest 102 !!st IF( ll_wd ) THEN 103 !!st ssh(:,:,Kbb) = -ssh_ref ! Added in 30 here for bathy that adds 30 as Iterative test CEOD 104 !!st ! 105 !!st ! Apply minimum wetdepth criterion 106 !!st ! 107 !!st DO_2D( 1, 1, 1, 1 ) 108 !!st IF( ht_0(ji,jj) + ssh(ji,jj,Kbb) < rn_wdmin1 ) THEN 109 !!st ssh(ji,jj,Kbb) = tmask(ji,jj,1)*( rn_wdmin1 - (ht_0(ji,jj)) ) 110 !!st ENDIF 111 !!st END_2D 112 !!st ENDIF 113 113 uu (:,:,:,Kbb) = 0._wp 114 114 vv (:,:,:,Kbb) = 0._wp 115 115 ! 116 116 ELSE ! user defined initial T and S 117 CALL usr_def_istate( gdept(:,:,:,Kbb), tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb) ) 117 CALL usr_def_istate( gdept(:,:,:,Kbb), tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb) ) 118 CALL usr_def_istate_ssh(tmask, ssh(:,:,Kbb) ) 118 119 ENDIF 119 120 ts (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb) ! set now values from to before ones 120 ssh (:,:,Kmm) = ssh(:,:,Kbb)121 !!st ssh (:,:,Kmm) = ssh(:,:,Kbb) 121 122 uu (:,:,:,Kmm) = uu (:,:,:,Kbb) 122 123 vv (:,:,:,Kmm) = vv (:,:,:,Kbb) -
NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/tests/ISOMIP/MY_SRC/usrdef_istate.F90
r13762 r13874 9 9 !! History : NEMO ! 2016-11 (S. Flavoni) Original code 10 10 !! ! 2017-02 (P. Mathiot, S. Flavoni) Adapt code to ISOMIP case 11 !! ! 2020-11 (S. Techene, G. Madec) separate tsuv from ssh 11 12 !!---------------------------------------------------------------------- 12 13 … … 24 25 PRIVATE 25 26 26 PUBLIC usr_def_istate ! called by istate.F9027 PUBLIC usr_def_ ssh! called by domqco.F9027 PUBLIC usr_def_istate ! called by istate.F90 28 PUBLIC usr_def_istate_ssh ! called by domqco.F90 28 29 29 30 !!---------------------------------------------------------------------- … … 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 !53 INTEGER :: jk ! dummy loop indices54 52 !!---------------------------------------------------------------------- 55 53 ! … … 59 57 pu (:,:,:) = 0._wp ! ocean at rest 60 58 pv (:,:,:) = 0._wp 61 pssh(:,:) = 0._wp62 !63 59 ! ! T & S profiles 64 60 pts(:,:,:,jp_tem) = - 1.9 * ptmask(:,:,:) ! ISOMIP configuration : start from constant T+S fields … … 68 64 69 65 70 SUBROUTINE usr_def_ ssh( ptmask, pssh )66 SUBROUTINE usr_def_istate_ssh( ptmask, pssh ) 71 67 !!---------------------------------------------------------------------- 72 !! *** ROUTINE usr_def_ ssh ***68 !! *** ROUTINE usr_def_istate_ssh *** 73 69 !! 74 70 !! ** Purpose : Initialization of ssh 75 71 !! Here ISOMIP configuration 76 72 !! 77 !! ** Method : set ssh 73 !! ** Method : set ssh to 0 78 74 !!---------------------------------------------------------------------- 79 75 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: ptmask ! t-point ocean mask [m] … … 82 78 ! 83 79 IF(lwp) WRITE(numout,*) 84 IF(lwp) WRITE(numout,*) 'usr_def_ ssh : ISOMIP configuration, analytical definition of initial state'80 IF(lwp) WRITE(numout,*) 'usr_def_istate_ssh : ISOMIP configuration, analytical definition of initial state' 85 81 ! 86 82 pssh(:,:) = 0._wp 87 83 ! 88 END SUBROUTINE usr_def_ ssh84 END SUBROUTINE usr_def_istate_ssh 89 85 90 86 !!====================================================================== -
NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/tests/LOCK_EXCHANGE/MY_SRC/usrdef_istate.F90
r13762 r13874 8 8 !!====================================================================== 9 9 !! History : NEMO ! 2016-03 (S. Flavoni, G. Madec) Original code 10 !! ! 2020-11 (S. Techene, G. Madec) separate tsuv from ssh 10 11 !!---------------------------------------------------------------------- 11 12 … … 23 24 PRIVATE 24 25 25 PUBLIC usr_def_istate ! called by istate.F9026 PUBLIC usr_def_ ssh! called by domqco.F9026 PUBLIC usr_def_istate ! called by istate.F90 27 PUBLIC usr_def_istate_ssh ! called by domqco.F90 27 28 28 29 !!---------------------------------------------------------------------- … … 33 34 CONTAINS 34 35 35 SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv , pssh)36 SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv ) 36 37 !!---------------------------------------------------------------------- 37 38 !! *** ROUTINE usr_def_istate *** … … 48 49 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: pu ! i-component of the velocity [m/s] 49 50 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: pv ! j-component of the velocity [m/s] 50 REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: pssh ! sea-surface height51 51 ! 52 52 INTEGER :: jk ! dummy loop indices … … 66 66 pu (:,:,:) = 0._wp ! ocean at rest 67 67 pv (:,:,:) = 0._wp 68 pssh(:,:) = 0._wp69 68 ! 70 69 ! ! T & S profiles … … 80 79 81 80 82 SUBROUTINE usr_def_ ssh( ptmask, pssh )81 SUBROUTINE usr_def_istate_ssh( ptmask, pssh ) 83 82 !!---------------------------------------------------------------------- 84 !! *** ROUTINE usr_def_ ssh ***83 !! *** ROUTINE usr_def_istate_ssh *** 85 84 !! 86 85 !! ** Purpose : Initialization of ssh 87 86 !! Here LOCK_EXCHANGE configuration 88 87 !! 89 !! ** Method : set ssh 88 !! ** Method : set ssh to 0 90 89 !!---------------------------------------------------------------------- 91 90 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: ptmask ! t-point ocean mask [m] … … 94 93 ! 95 94 IF(lwp) WRITE(numout,*) 96 IF(lwp) WRITE(numout,*) 'usr_def_ ssh : LOCK_EXCHANGE configuration, analytical definition of initial state'95 IF(lwp) WRITE(numout,*) 'usr_def_istate_ssh : LOCK_EXCHANGE configuration, analytical definition of initial state' 97 96 ! 98 97 pssh(:,:) = 0._wp 99 98 ! 100 END SUBROUTINE usr_def_ ssh99 END SUBROUTINE usr_def_istate_ssh 101 100 102 101 !!====================================================================== -
NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/tests/OVERFLOW/MY_SRC/usrdef_istate.F90
r13762 r13874 8 8 !!============================================================================== 9 9 !! History : NEMO ! 2016-03 (S. Flavoni, G. Madec) Original code 10 !! ! 2020-11 (S. Techene, G. Madec) separate tsuv from ssh 10 11 !!---------------------------------------------------------------------- 11 12 … … 23 24 PRIVATE 24 25 25 PUBLIC usr_def_istate ! called by istate.F9026 PUBLIC usr_def_ ssh! called by domqco.F9026 PUBLIC usr_def_istate ! called by istate.F90 27 PUBLIC usr_def_istate_ssh ! called by domqco.F90 27 28 28 29 !!---------------------------------------------------------------------- … … 33 34 CONTAINS 34 35 35 SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv , pssh)36 SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv ) 36 37 !!---------------------------------------------------------------------- 37 38 !! *** ROUTINE usr_def_istate *** … … 48 49 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: pu ! i-component of the velocity [m/s] 49 50 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: pv ! j-component of the velocity [m/s] 50 REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: pssh ! sea-surface height51 51 ! 52 52 INTEGER :: jk ! dummy loop indices … … 66 66 pu (:,:,:) = 0._wp ! ocean at rest 67 67 pv (:,:,:) = 0._wp 68 pssh(:,:) = 0._wp69 68 ! 70 69 ! ! T & S profiles … … 80 79 81 80 82 SUBROUTINE usr_def_ ssh( ptmask, pssh )81 SUBROUTINE usr_def_istate_ssh( ptmask, pssh ) 83 82 !!---------------------------------------------------------------------- 84 !! *** ROUTINE usr_def_ ssh ***83 !! *** ROUTINE usr_def_istate_ssh *** 85 84 !! 86 85 !! ** Purpose : Initialization of the ssh 87 86 !! Here OVERFLOW configuration 88 87 !! 89 !! ** Method : set ssh 88 !! ** Method : set ssh to 0 90 89 !!---------------------------------------------------------------------- 91 90 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: ptmask ! t-point ocean mask [m] … … 94 93 ! 95 94 IF(lwp) WRITE(numout,*) 96 IF(lwp) WRITE(numout,*) 'usr_def_ ssh : OVERFLOW configuration, analytical definition of initial state'95 IF(lwp) WRITE(numout,*) 'usr_def_istate_ssh : OVERFLOW configuration, analytical definition of initial state' 97 96 ! 98 97 pssh(:,:) = 0._wp 99 98 ! 100 END SUBROUTINE usr_def_ ssh99 END SUBROUTINE usr_def_istate_ssh 101 100 102 101 !!====================================================================== -
NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/tests/SWG/MY_SRC/usrdef_istate.F90
r13762 r13874 9 9 !! History : 4.0 ! 2016-03 (S. Flavoni) Original code 10 10 !! - ! 2020-03 (A. Nasser) Shallow Water Eq. configuration 11 !! ! 2020-11 (S. Techene, G. Madec) separate tsuv from ssh 11 12 !!---------------------------------------------------------------------- 12 13 … … 23 24 PRIVATE 24 25 25 PUBLIC usr_def_istate ! called in istate.F9026 PUBLIC usr_def_ ssh! called by domqco.F9026 PUBLIC usr_def_istate ! called in istate.F90 27 PUBLIC usr_def_istate_ssh ! called by domqco.F90 27 28 28 29 !!---------------------------------------------------------------------- … … 33 34 CONTAINS 34 35 35 SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv , pssh)36 SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv ) 36 37 !!---------------------------------------------------------------------- 37 38 !! *** 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 pts (:,:,:,:) = 0._wp ! not used in SWE 64 63 … … 69 68 70 69 71 SUBROUTINE usr_def_ ssh( ptmask, pssh )70 SUBROUTINE usr_def_istate_ssh( ptmask, pssh ) 72 71 !!---------------------------------------------------------------------- 73 !! *** ROUTINE usr_def_ ssh ***72 !! *** ROUTINE usr_def_istate_ssh *** 74 73 !! 75 74 !! ** Purpose : Initialization of ssh 76 75 !! Here SWG configuration 77 76 !! 78 !! ** Method : set ssh 77 !! ** Method : set ssh to 0 79 78 !!---------------------------------------------------------------------- 80 79 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: ptmask ! t-point ocean mask [m] … … 83 82 ! 84 83 IF(lwp) WRITE(numout,*) 85 IF(lwp) WRITE(numout,*) 'usr_def_ ssh : SWG configuration, analytical definition of initial state'84 IF(lwp) WRITE(numout,*) 'usr_def_istate_ssh : SWG configuration, analytical definition of initial state' 86 85 ! 87 86 pssh(:,:) = 0._wp ! ocean at rest 88 87 ! 89 END SUBROUTINE usr_def_ ssh88 END SUBROUTINE usr_def_istate_ssh 90 89 91 90 !!====================================================================== -
NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/tests/VORTEX/MY_SRC/usrdef_istate.F90
r13757 r13874 8 8 !!====================================================================== 9 9 !! History : NEMO ! 2017-11 (J. Chanut) Original code 10 !! ! 2020-11 (S. Techene, G. Madec) separate tsuv from ssh 10 11 !!---------------------------------------------------------------------- 11 12 … … 26 27 PRIVATE 27 28 28 PUBLIC usr_def_istate ! called by istate.F9029 PUBLIC usr_def_ ssh! called by domqco.F9029 PUBLIC usr_def_istate ! called by istate.F90 30 PUBLIC usr_def_istate_ssh ! called by domqco.F90 30 31 31 32 !! * Substitutions … … 38 39 CONTAINS 39 40 40 SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv , pssh)41 SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv ) 41 42 !!---------------------------------------------------------------------- 42 43 !! *** ROUTINE usr_def_istate *** … … 53 54 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: pu ! i-component of the velocity [m/s] 54 55 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: pv ! j-component of the velocity [m/s] 55 REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: pssh ! sea-surface height56 56 ! 57 57 INTEGER :: ji, jj, jk ! dummy loop indices … … 73 73 ! 74 74 zP0 = rho0 * zf0 * zumax * zlambda * SQRT(EXP(1._wp)/2._wp) 75 !76 ! Sea level:77 za = -zP0 * (1._wp-EXP(-zH)) / (grav*(zH-1._wp + EXP(-zH)))78 DO_2D( 1, 1, 1, 1 )79 zx = glamt(ji,jj) * 1.e380 zy = gphit(ji,jj) * 1.e381 zrho1 = rho0 + za * EXP(-(zx**2+zy**2)/zlambda**2)82 pssh(ji,jj) = zP0 * EXP(-(zx**2+zy**2)/zlambda**2)/(zrho1*grav) * ptmask(ji,jj,1)83 END_2D84 75 ! 85 76 ! temperature: … … 136 127 137 128 138 SUBROUTINE usr_def_ ssh( ptmask, pssh )129 SUBROUTINE usr_def_istate_ssh( ptmask, pssh ) 139 130 !!---------------------------------------------------------------------- 140 131 !! *** ROUTINE usr_def_istate *** … … 143 134 !! Here VORTEX configuration 144 135 !! 145 !! ** Method : Set a gaussian anomaly of pressure and associated136 !! ** Method : Set ssh according to a gaussian anomaly of pressure and associated 146 137 !! geostrophic velocities 147 138 !!---------------------------------------------------------------------- … … 154 145 ! 155 146 IF(lwp) WRITE(numout,*) 156 IF(lwp) WRITE(numout,*) 'usr_def_ ssh : VORTEX configuration, analytical definition of initial state'147 IF(lwp) WRITE(numout,*) 'usr_def_istate_ssh : VORTEX configuration, analytical definition of initial state' 157 148 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~ ' 158 149 ! … … 175 166 END_2D 176 167 177 END SUBROUTINE usr_def_ ssh168 END SUBROUTINE usr_def_istate_ssh 178 169 179 170 !!====================================================================== -
NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/tests/WAD/MY_SRC/usrdef_istate.F90
r13295 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 … … 24 25 PRIVATE 25 26 26 PUBLIC usr_def_istate ! called in istate.F90 27 PUBLIC usr_def_istate ! called in istate.F90 28 PUBLIC usr_def_istate_ssh ! called in sshwzv.F90 27 29 28 30 !! * Substitutions … … 34 36 !!---------------------------------------------------------------------- 35 37 CONTAINS 36 37 SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv, pssh ) 38 39 40 SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv ) 38 41 !!---------------------------------------------------------------------- 39 42 !! *** ROUTINE usr_def_istate *** … … 42 45 !! Here WAD_TEST_CASES configuration 43 46 !! 44 !! ** Method : - set temprature field47 q !! ** Method : - set temprature field 45 48 !! - set salinity field 46 49 !!---------------------------------------------------------------------- … … 50 53 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: pu ! i-component of the velocity [m/s] 51 54 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: pv ! j-component of the velocity [m/s] 52 REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: pssh ! sea-surface height53 55 INTEGER :: ji, jj ! dummy loop indices 54 56 REAL(wp) :: zi, zj … … 66 68 pu (:,:,:) = 0._wp ! ocean at rest 67 69 pv (:,:,:) = 0._wp 68 pssh(:,:) = 0._wp69 !70 70 ! ! T & S profiles 71 71 pts(:,:,:,jp_tem) = 10._wp * ptmask(:,:,:) … … 83 83 CASE ( 1 ) ! WAD 1 configuration 84 84 ! ! ==================== 85 !86 85 IF(lwp) WRITE(numout,*) 87 86 IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Closed box with EW linear bottom slope' 88 87 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 89 !90 do ji = 1,jpi91 pssh(ji,:) = ( -5.5_wp + 7.4_wp*glamt(ji,1)/50._wp)*ptmask(ji,:,1)92 end do93 88 ! ! ==================== 94 89 CASE ( 2, 8 ) ! WAD 2 configuration 95 90 ! ! ==================== 96 !97 91 IF(lwp) WRITE(numout,*) 98 92 IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Parobolic EW channel, mid-range initial ssh slope' 99 93 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 100 !101 do ji = 1,jpi102 pssh(ji,:) = ( -1.5_wp + 5.0_wp*glamt(ji,1)/50._wp)*ptmask(ji,:,1)103 end do104 94 ! ! ==================== 105 95 CASE ( 3 ) ! WAD 3 configuration 106 96 ! ! ==================== 107 !108 97 IF(lwp) WRITE(numout,*) 109 98 IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Parobolic EW channel, extreme initial ssh slope' 110 99 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 111 ! 112 do ji = 1,jpi 113 pssh(ji,:) = ( -4.5_wp + 6.8_wp*glamt(ji,1)/50._wp)*ptmask(ji,:,1) 114 end do 100 ! ! ==================== 101 CASE ( 4 ) ! WAD 4 configuration 102 ! ! ==================== 103 IF(lwp) WRITE(numout,*) 104 IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Parobolic bowl, mid-range initial ssh slope' 105 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 106 ! ! =========================== 107 CASE ( 5, 7 ) ! WAD 5 and 7 configurations 108 ! ! =========================== 109 IF(lwp) WRITE(numout,*) 110 IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Double slope with shelf' 111 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 112 ! ! ==================== 113 CASE ( 6 ) ! WAD 6 configuration 114 ! ! ==================== 115 IF(lwp) WRITE(numout,*) 116 IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Parobolic EW channel with gaussian ridge' 117 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 118 ! 119 DO ji = mi0(jpiglo/2), mi0(jpiglo) 120 pts(ji,:,:,jp_sal) = 30._wp 121 END DO 122 ! 123 ! 124 ! ! =========================== 125 CASE DEFAULT ! NONE existing configuration 126 ! ! =========================== 127 WRITE(ctmp1,*) 'WAD test with a ', nn_cfg,' option is not coded' 128 ! 129 CALL ctl_stop( ctmp1 ) 130 ! 131 END SELECT 132 ! 133 END SUBROUTINE usr_def_istate 134 135 136 SUBROUTINE usr_def_istate_ssh( ptmask, pssh ) 137 !!---------------------------------------------------------------------- 138 !! *** ROUTINE usr_def_istate_ssh *** 139 !! 140 !! ** Purpose : Initialization of the dynamics and tracers 141 !! Here WAD_TEST_CASES configuration 142 !! 143 !! ** Method : - set ssh 144 !!---------------------------------------------------------------------- 145 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: ptmask ! t-point ocean mask [m] 146 REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: pssh ! sea-surface height 147 INTEGER :: ji, jj ! dummy loop indices 148 REAL(wp) :: zi, zj 149 ! 150 INTEGER :: jk ! dummy loop indices 151 REAL(wp) :: zdam ! location of dam [Km] 152 !!---------------------------------------------------------------------- 153 ! 154 ! 155 SELECT CASE ( nn_cfg ) 156 ! ! ==================== 157 CASE ( 1 ) ! WAD 1 configuration 158 ! ! ==================== 159 ! 160 IF(lwp) WRITE(numout,*) 161 IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Closed box with EW linear bottom slope' 162 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 163 ! 164 DO ji = 1,jpi 165 pssh(ji,:) = ( -5.5_wp + 7.4_wp*glamt(ji,1)/50._wp)*ptmask(ji,:,1) 166 END DO 167 ! ! ==================== 168 CASE ( 2, 8 ) ! WAD 2 configuration 169 ! ! ==================== 170 ! 171 IF(lwp) WRITE(numout,*) 172 IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Parobolic EW channel, mid-range initial ssh slope' 173 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 174 ! 175 DO ji = 1,jpi 176 pssh(ji,:) = ( -1.5_wp + 5.0_wp*glamt(ji,1)/50._wp)*ptmask(ji,:,1) 177 END DO 178 ! ! ==================== 179 CASE ( 3 ) ! WAD 3 configuration 180 ! ! ==================== 181 ! 182 IF(lwp) WRITE(numout,*) 183 IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Parobolic EW channel, extreme initial ssh slope' 184 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 185 ! 186 DO ji = 1,jpi 187 pssh(ji,:) = ( -4.5_wp + 6.8_wp*glamt(ji,1)/50._wp)*ptmask(ji,:,1) 188 END DO 115 189 116 190 ! … … 140 214 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 141 215 ! 142 doji = 1,jpi143 pssh(ji,:) = ( -2.5_wp + 5.5_wp*glamt(ji,1)/50._wp)*ptmask(ji,:,1)144 end do216 DO ji = 1,jpi 217 pssh(ji,:) = ( -2.5_wp + 5.5_wp*glamt(ji,1)/50._wp)*ptmask(ji,:,1) 218 END DO 145 219 146 220 ! … … 153 227 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 154 228 ! 155 do ji = 1,jpi 156 pssh(ji,:) = ( -2.5_wp + 5.5_wp*(50._wp-glamt(ji,1))/50._wp)*ptmask(ji,:,1) 157 end do 158 ! 159 do ji = mi0(jpiglo/2), mi0(jpiglo) 160 pts(ji,:,:,jp_sal) = 30._wp 161 pssh(ji,:) = -0.1*ptmask(ji,:,1) 162 end do 229 DO ji = 1,jpi 230 pssh(ji,:) = ( -2.5_wp + 5.5_wp*(50._wp-glamt(ji,1))/50._wp)*ptmask(ji,:,1) 231 END DO 232 ! 233 DO ji = mi0(jpiglo/2), mi0(jpiglo) 234 pssh(ji,:) = -0.1*ptmask(ji,:,1) 235 END DO 163 236 ! 164 237 ! … … 182 255 END_2D 183 256 ! 184 END SUBROUTINE usr_def_istate 257 END SUBROUTINE usr_def_istate_ssh 185 258 186 259 !!======================================================================
Note: See TracChangeset
for help on using the changeset viewer.
