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 branches/UKMO/ROMS_WAD_7832/NEMOGCM/CONFIG/CS15mini/MY_SRC – NEMO

source: branches/UKMO/ROMS_WAD_7832/NEMOGCM/CONFIG/CS15mini/MY_SRC/usrdef_istate.F90 @ 8403

Last change on this file since 8403 was 8403, checked in by deazer, 7 years ago

Add in ROMS WAD option ln_rwd+changes for implicit Bed Friction for ln_wd option
Note no ramp placed on ROMS bed friction yet
CS15mini case added as a Test CASE
at this revision AMM15 with Pure sigma coords barotorpic runs for 4 days without failure
in with ROMS option with 20cm min deoth and 50 vertical levels
Both run for CS15mini
In real domains nothing done on reference level yet so real domains
must have not negative depth points yet.
But a basic test has been done in WAD channel test cases (WAD7)

No changes in Main line source yet. See the MY_SRC sub dir of CS15 and TEST_CASES/WAD
for actual code changes.

File size: 5.1 KB
Line 
1MODULE usrdef_istate
2   !!======================================================================
3   !!                   ***  MODULE  usrdef_istate   ***
4   !!
5   !!                     ===  GYRE configuration  ===
6   !!
7   !! User defined : set the initial state of a user configuration
8   !!======================================================================
9   !! History :  4.0 ! 2016-03  (S. Flavoni) Original code
10   !!----------------------------------------------------------------------
11
12   !!----------------------------------------------------------------------
13   !!  usr_def_istate : initial state in Temperature and salinity
14   !!----------------------------------------------------------------------
15   USE par_oce        ! ocean space and time domain
16   USE phycst         ! physical constants
17   USE wet_dry        ! Wetting and drying
18   !
19   USE in_out_manager ! I/O manager
20   USE lib_mpp        ! MPP library
21   
22   IMPLICIT NONE
23   PRIVATE
24
25   PUBLIC   usr_def_istate   ! called in istate.F90
26
27   !!----------------------------------------------------------------------
28   !! NEMO/OPA 4.0 , NEMO Consortium (2016)
29   !! $Id$
30   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
31   !!----------------------------------------------------------------------
32CONTAINS
33 
34   SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv, pssh )
35      !!----------------------------------------------------------------------
36      !!                   ***  ROUTINE usr_def_istate  ***
37      !!
38      !! ** Purpose :   Initialization of the dynamics and tracers
39      !!                Here GYRE configuration example : (double gyre with rotated domain)
40      !!
41      !! ** Method  : - set temprature field
42      !!              - set salinity   field
43      !!----------------------------------------------------------------------
44      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   pdept   ! depth of t-point               [m]
45      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   ptmask  ! t-point ocean mask             [m]
46      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(  out) ::   pts     ! T & S fields      [Celsius ; g/kg]
47      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pu      ! i-component of the velocity  [m/s]
48      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pv      ! j-component of the velocity  [m/s]
49      REAL(wp), DIMENSION(jpi,jpj)         , INTENT(  out) ::   pssh    ! sea-surface height
50      !
51      INTEGER :: ji, jj, jk  ! dummy loop indices
52      !!----------------------------------------------------------------------
53      !
54      IF(lwp) WRITE(numout,*)
55      IF(lwp) WRITE(numout,*) 'usr_def_istate : analytical definition of initial state '
56      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~   Ocean at rest, with an horizontally uniform T and S profiles'
57      !
58      pu  (:,:,:) = 0._wp        ! ocean at rest
59      pv  (:,:,:) = 0._wp
60      pssh(:,:)   = 0._wp
61      !
62      DO jk = 1, jpk             ! horizontally uniform T & S profiles
63         DO jj = 1, jpj
64            DO ji = 1, jpi
65               pts(ji,jj,jk,jp_tem) =  (  (  16. - 12. * TANH( (pdept(ji,jj,jk) - 400) / 700 ) )   &
66                    &           * (-TANH( (500. - pdept(ji,jj,jk)) / 150. ) + 1.) / 2.             &
67                    &           + ( 15. * ( 1. - TANH( (pdept(ji,jj,jk)-50.) / 1500.) )            &
68                    &           - 1.4 * TANH((pdept(ji,jj,jk)-100.) / 100.)                        &
69                    &           + 7.  * (1500. - pdept(ji,jj,jk) ) / 1500.)                        &
70                    &           * (-TANH( (pdept(ji,jj,jk) - 500.) / 150.) + 1.) / 2.  ) * ptmask(ji,jj,jk)
71
72               pts(ji,jj,jk,jp_sal) =  (  (  36.25 - 1.13 * TANH( (pdept(ji,jj,jk) - 305) / 460 ) )  &
73                    &         * (-TANH((500. - pdept(ji,jj,jk)) / 150.) + 1.) / 2                  &
74                    &         + ( 35.55 + 1.25 * (5000. - pdept(ji,jj,jk)) / 5000.                 &
75                    &         - 1.62 * TANH( (pdept(ji,jj,jk) - 60.  ) / 650. )                    &
76                    &         + 0.2  * TANH( (pdept(ji,jj,jk) - 35.  ) / 100. )                    &
77                    &         + 0.2  * TANH( (pdept(ji,jj,jk) - 1000.) / 5000.) )                  &
78                    &         * (-TANH( (pdept(ji,jj,jk) - 500.) / 150.) + 1.) / 2  ) * ptmask(ji,jj,jk)
79               pts(ji,jj,jk,jp_tem) = 10. * ptmask(ji,jj,jk) ! slwa constant temperature ic
80               pts(ji,jj,jk,jp_sal) = 35. * ptmask(ji,jj,jk) ! slwa constant salinity ic
81            END DO
82         END DO
83      END DO
84      !   
85
86! subtract the height of z=0 above the geoid (this allows z = 0 to be higher than all points that may become wet)   
87      pssh(:,:) = pssh(:,:) - rn_ssh_ref
88
89      !
90      ! Apply minimum wetdepth criterion
91      !
92      do jj = 1,jpj
93         do ji = 1,jpi
94            IF( ht_wd(ji,jj) + pssh(ji,jj) < rn_wdmin1 ) THEN
95               pssh(ji,jj) = ptmask(ji,jj,1)*( rn_wdmin1 - ht_wd(ji,jj) )
96            ENDIF
97         end do
98      end do
99     !
100   END SUBROUTINE usr_def_istate
101
102   !!======================================================================
103END MODULE usrdef_istate
Note: See TracBrowser for help on using the repository browser.