New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
usrdef_istate.F90 in NEMO/branches/2021/dev_r14318_RK3_stage1_tsplit/tests/SEICHE/MY_SRC – NEMO

source: NEMO/branches/2021/dev_r14318_RK3_stage1_tsplit/tests/SEICHE/MY_SRC/usrdef_istate.F90 @ 14597

Last change on this file since 14597 was 14597, checked in by jchanut, 3 years ago

#2634: Implement Marsaleix (2008) and Demange (2019) test case (an external SEICHE over a 2DV stratified ocean and a seamount). One can optionnaly retrieve a standard external or 2 layer internal Seiche with a flat bottom.
File size: 6.2 KB
Line 
1MODULE usrdef_istate
2   !!==============================================================================
3   !!                       ***  MODULE usrdef_istate  ***
4   !!
5   !!                         === SEICHE configuration  ===
6   !!
7   !! User defined : set the initial state of a user configuration
8   !!==============================================================================
9   !! History :  NEMO ! 2016-03  (S. Flavoni, G. Madec) Original code
10   !!                 ! 2020-11  (S. Techene, G. Madec) separate tsuv from ssh
11   !!                 ! 2021-01  (J. Chanut) SEICHE case
12   !!----------------------------------------------------------------------
13
14   !!----------------------------------------------------------------------
15   !!  usr_def_istate : initial state in Temperature and salinity
16   !!----------------------------------------------------------------------
17   USE par_oce              ! ocean space and time domain
18   USE phycst               ! physical constants
19   USE dom_oce, ONLY: glamt, e1t, r1_e1t ! longitude in km
20   USE eosbn2, ONLY : rn_a0 ! thermal expansion
21   USE usrdef_nam           ! User defined : namelist variables
22   !
23   USE in_out_manager ! I/O manager
24   USE lib_mpp        ! MPP library
25   
26   IMPLICIT NONE
27   PRIVATE
28
29   PUBLIC   usr_def_istate       ! called by istate.F90
30   PUBLIC   usr_def_istate_ssh   ! called by domqco.F90
31
32   !!----------------------------------------------------------------------
33   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
34   !! $Id: usrdef_istate.F90 14053 2020-12-03 13:48:38Z techene $
35   !! Software governed by the CeCILL license (see ./LICENSE)
36   !!----------------------------------------------------------------------
37
38CONTAINS
39 
40   SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv )
41      !!----------------------------------------------------------------------
42      !!                   ***  ROUTINE usr_def_istate  ***
43      !!
44      !! ** Purpose :   Initialization of the dynamics and tracers
45      !!                Here SEICHE configuration
46      !!
47      !! ** Method  : - set temprature field
48      !!              - set salinity   field
49      !!----------------------------------------------------------------------
50      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   pdept   ! depth of t-point               [m]
51      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   ptmask  ! t-point ocean mask             [m]
52      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(  out) ::   pts     ! T & S fields      [Celsius ; g/kg]
53      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pu      ! i-component of the velocity  [m/s]
54      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pv      ! j-component of the velocity  [m/s]
55      !
56      INTEGER :: jk
57      REAL(wp)  :: zn2, zdinc
58      REAL(wp), DIMENSION(jpi,jpj) :: zi 
59      !!----------------------------------------------------------------------
60      !
61      IF(lwp) WRITE(numout,*)
62      IF(lwp) WRITE(numout,*) 'usr_def_istate : SEICHE configuration, analytical definition of initial state'
63      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~   Ocean at rest, with a constant salinity (not used as rho=F(T) '
64      IF(lwp) WRITE(numout,*) '                 and a linear temperature stratification (N=1.4e-3 s-1)'
65      !
66      !
67      pu  (:,:,:) = 0._wp        ! ocean at rest
68      pv  (:,:,:) = 0._wp
69      !
70      !                          ! T & S profiles
71      zn2 =  rn_nn**2            ! N2: brunt vaisala squared
72      !
73      zdinc = rn_dinc
74! trick to recover exact convergence whatever the vertical discretization is
75! (that's a density jaobian issue)
76!      zdinc = rn_dinc*REAL(nn_lev,wp)/REAL(nn_lev-1,wp)
77      !
78      IF     ( nn_test==0 ) THEN
79         pts(:,:,:,jp_tem) = 10._wp
80      ELSEIF ( nn_test==1 ) THEN
81         zi(:,:) = 0.5_wp * rn_H + rn_a * SIN(rpi * glamt(:,:) / rn_L ) 
82         DO jk=1, jpkm1
83            WHERE (pdept (:,:,jk) < zi(:,:)) 
84               pts(:,:,jk,jp_tem) = (10._wp + 0.5_wp*zdinc / rn_a0 ) * ptmask(:,:,jk)
85            ELSEWHERE 
86               pts(:,:,jk,jp_tem) = (10._wp - 0.5_wp*zdinc / rn_a0 ) * ptmask(:,:,jk)
87            ENDWHERE
88         END DO
89         pts(:,:,jpk,jp_tem) = 0._wp
90      ELSEIF ( nn_test==2 ) THEN
91         pts(:,:,:,jp_tem) = (10._wp - zn2 * pdept(:,:,:) * rho0 / grav / rn_a0 ) * ptmask(:,:,:)
92      ENDIF
93      !
94      pts(:,:,:,jp_sal) = 35._wp * ptmask(:,:,:)
95      !   
96   END SUBROUTINE usr_def_istate
97
98
99   SUBROUTINE usr_def_istate_ssh( ptmask, pssh )
100      !!----------------------------------------------------------------------
101      !!                   ***  ROUTINE usr_def_istate_ssh  ***
102      !!
103      !! ** Purpose :   Initialization of the ssh
104      !!                Here  SEICHE configuration
105      !!
106      !! ** Method  :   set ssh to 0
107      !!----------------------------------------------------------------------
108      !
109      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   ptmask  ! t-point ocean mask   [m]
110      REAL(wp), DIMENSION(jpi,jpj)         , INTENT(  out) ::   pssh    ! sea-surface height   [m]
111      !
112      !!----------------------------------------------------------------------
113      !
114      IF(lwp) WRITE(numout,*)
115      IF(lwp) WRITE(numout,*) 'usr_def_istate_ssh : SEICHE configuration, analytical definition of initial state.'
116      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~~~~'
117      !         
118      IF     ( nn_test==2 ) THEN
119         ! Free surface seiche but slightly different initialization in Marsaleix case:
120         pssh(:,:) = rn_a * glamt(:,:) / ( 0.5 * rn_L ) * ptmask(:,:,1)
121!         pssh(:,:) = rn_a * SIN(rpi * glamt(:,:) / rn_L ) * ptmask(:,:,1)
122      ELSEIF ( nn_test==1 ) THEN
123         ! 2 layer seiche:
124         pssh(:,:) = 0.5_wp*rn_dinc*r1_rho0*rn_a * SIN(rpi * glamt(:,:) / rn_L ) * ptmask(:,:,1) 
125
126      ELSEIF ( nn_test==0 ) THEN
127         ! External seiche:
128         pssh(:,:) = rn_a * SIN(rpi * glamt(:,:) / rn_L ) * ptmask(:,:,1)
129!         pssh(:,:) = 2._wp * rn_a * rn_L / rpi  * 1.e3 *  r1_e1t(:,:) * SIN(rpi * glamt(:,:) / rn_L ) &
130!                   &       * SIN(0.5_wp * rpi * e1t(:,:) / 1.e3 / rn_L ) * ptmask(:,:,1)
131      ENDIF
132      !
133   END SUBROUTINE usr_def_istate_ssh
134
135   !!======================================================================
136END MODULE usrdef_istate
Note: See TracBrowser for help on using the repository browser.