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.
istate.F90 in NEMO/trunk/src/OCE/DOM – NEMO

source: NEMO/trunk/src/OCE/DOM/istate.F90 @ 12377

Last change on this file since 12377 was 12377, checked in by acc, 4 years ago

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge --ignore-ancestry \

svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The --ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.

  • Property svn:keywords set to Id
File size: 8.6 KB
Line 
1MODULE istate
2   !!======================================================================
3   !!                     ***  MODULE  istate  ***
4   !! Ocean state   :  initial state setting
5   !!=====================================================================
6   !! History :  OPA  !  1989-12  (P. Andrich)  Original code
7   !!            5.0  !  1991-11  (G. Madec)  rewritting
8   !!            6.0  !  1996-01  (G. Madec)  terrain following coordinates
9   !!            8.0  !  2001-09  (M. Levy, M. Ben Jelloul)  istate_eel
10   !!            8.0  !  2001-09  (M. Levy, M. Ben Jelloul)  istate_uvg
11   !!   NEMO     1.0  !  2003-08  (G. Madec, C. Talandier)  F90: Free form, modules + EEL R5
12   !!             -   !  2004-05  (A. Koch-Larrouy)  istate_gyre
13   !!            2.0  !  2006-07  (S. Masson)  distributed restart using iom
14   !!            3.3  !  2010-10  (C. Ethe) merge TRC-TRA
15   !!            3.4  !  2011-04  (G. Madec) Merge of dtatem and dtasal & suppression of tb,tn/sb,sn
16   !!            3.7  !  2016-04  (S. Flavoni) introduce user defined initial state
17   !!----------------------------------------------------------------------
18
19   !!----------------------------------------------------------------------
20   !!   istate_init   : initial state setting
21   !!   istate_uvg    : initial velocity in geostropic balance
22   !!----------------------------------------------------------------------
23   USE oce            ! ocean dynamics and active tracers
24   USE dom_oce        ! ocean space and time domain
25   USE daymod         ! calendar
26   USE divhor         ! horizontal divergence            (div_hor routine)
27   USE dtatsd         ! data temperature and salinity   (dta_tsd routine)
28   USE dtauvd         ! data: U & V current             (dta_uvd routine)
29   USE domvvl          ! varying vertical mesh
30   USE wet_dry         ! wetting and drying (needed for wad_istate)
31   USE usrdef_istate   ! User defined initial state
32   !
33   USE in_out_manager  ! I/O manager
34   USE iom             ! I/O library
35   USE lib_mpp         ! MPP library
36   USE restart         ! restart
37
38   IMPLICIT NONE
39   PRIVATE
40
41   PUBLIC   istate_init   ! routine called by step.F90
42
43   !! * Substitutions
44#  include "do_loop_substitute.h90"
45   !!----------------------------------------------------------------------
46   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
47   !! $Id$
48   !! Software governed by the CeCILL license (see ./LICENSE)
49   !!----------------------------------------------------------------------
50CONTAINS
51
52   SUBROUTINE istate_init( Kbb, Kmm, Kaa )
53      !!----------------------------------------------------------------------
54      !!                   ***  ROUTINE istate_init  ***
55      !!
56      !! ** Purpose :   Initialization of the dynamics and tracer fields.
57      !!----------------------------------------------------------------------
58      INTEGER, INTENT( in )  ::  Kbb, Kmm, Kaa   ! ocean time level indices
59      !
60      INTEGER ::   ji, jj, jk   ! dummy loop indices
61!!gm see comment further down
62      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::   zuvd    ! U & V data workspace
63!!gm end
64      !!----------------------------------------------------------------------
65      !
66      IF(lwp) WRITE(numout,*)
67      IF(lwp) WRITE(numout,*) 'istate_init : Initialization of the dynamics and tracers'
68      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
69
70!!gm  Why not include in the first call of dta_tsd ? 
71!!gm  probably associated with the use of internal damping...
72                     CALL dta_tsd_init        ! Initialisation of T & S input data
73!!gm to be moved in usrdef of C1D case
74!      IF( lk_c1d )   CALL dta_uvd_init        ! Initialization of U & V input data
75!!gm
76
77      rhd  (:,:,:  ) = 0._wp   ;   rhop (:,:,:  ) = 0._wp      ! set one for all to 0 at level jpk
78      rn2b (:,:,:  ) = 0._wp   ;   rn2  (:,:,:  ) = 0._wp      ! set one for all to 0 at levels 1 and jpk
79      ts  (:,:,:,:,Kaa) = 0._wp                                   ! set one for all to 0 at level jpk
80      rab_b(:,:,:,:) = 0._wp   ;   rab_n(:,:,:,:) = 0._wp      ! set one for all to 0 at level jpk
81#if defined key_agrif
82      uu   (:,:,:  ,Kaa) = 0._wp   ! used in agrif_oce_sponge at initialization
83      vv   (:,:,:  ,Kaa) = 0._wp   ! used in agrif_oce_sponge at initialization   
84#endif
85
86      IF( ln_rstart ) THEN                    ! Restart from a file
87         !                                    ! -------------------
88         CALL rst_read( Kbb, Kmm )            ! Read the restart file
89         CALL day_init                        ! model calendar (using both namelist and restart infos)
90         !
91      ELSE                                    ! Start from rest
92         !                                    ! ---------------
93         numror = 0                           ! define numror = 0 -> no restart file to read
94         neuler = 0                           ! Set time-step indicator at nit000 (euler forward)
95         CALL day_init                        ! model calendar (using both namelist and restart infos)
96         !                                    ! Initialization of ocean to zero
97         !
98         IF( ln_tsd_init ) THEN               
99            CALL dta_tsd( nit000, ts(:,:,:,:,Kbb) )       ! read 3D T and S data at nit000
100            !
101            ssh(:,:,Kbb)   = 0._wp               ! set the ocean at rest
102            IF( ll_wd ) THEN
103               ssh(:,:,Kbb) =  -ssh_ref  ! Added in 30 here for bathy that adds 30 as Iterative test CEOD
104               !
105               ! Apply minimum wetdepth criterion
106               !
107               DO_2D_11_11
108                  IF( ht_0(ji,jj) + ssh(ji,jj,Kbb)  < rn_wdmin1 ) THEN
109                     ssh(ji,jj,Kbb) = tmask(ji,jj,1)*( rn_wdmin1 - (ht_0(ji,jj)) )
110                  ENDIF
111               END_2D
112            ENDIF
113            uu  (:,:,:,Kbb) = 0._wp
114            vv  (:,:,:,Kbb) = 0._wp 
115            !
116         ELSE                                 ! user defined initial T and S
117            CALL usr_def_istate( gdept(:,:,:,Kbb), tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb)  )         
118         ENDIF
119         ts  (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb)       ! set now values from to before ones
120         ssh (:,:,Kmm)     = ssh(:,:,Kbb)   
121         uu   (:,:,:,Kmm)   = uu  (:,:,:,Kbb)
122         vv   (:,:,:,Kmm)   = vv  (:,:,:,Kbb)
123         hdiv(:,:,jpk) = 0._wp               ! bottom divergence set one for 0 to zero at jpk level
124         CALL div_hor( 0, Kbb, Kmm )         ! compute interior hdiv value 
125!!gm                                    hdiv(:,:,:) = 0._wp
126
127!!gm POTENTIAL BUG :
128!!gm  ISSUE :  if ssh(:,:,Kbb) /= 0  then, in non linear free surface, the e3._n, e3._b should be recomputed
129!!             as well as gdept and gdepw....   !!!!!
130!!      ===>>>>   probably a call to domvvl initialisation here....
131
132
133         !
134!!gm to be moved in usrdef of C1D case
135!         IF ( ln_uvd_init .AND. lk_c1d ) THEN ! read 3D U and V data at nit000
136!            ALLOCATE( zuvd(jpi,jpj,jpk,2) )
137!            CALL dta_uvd( nit000, zuvd )
138!            uu(:,:,:,Kbb) = zuvd(:,:,:,1) ;  uu(:,:,:,Kmm) = uu(:,:,:,Kbb)
139!            vv(:,:,:,Kbb) = zuvd(:,:,:,2) ;  vv(:,:,:,Kmm) = vv(:,:,:,Kbb)
140!            DEALLOCATE( zuvd )
141!         ENDIF
142         !
143!!gm This is to be changed !!!!
144!         ! - ML - ssh(:,:,Kmm) could be modified by istate_eel, so that initialization of e3t(:,:,:,Kbb) is done here
145!         IF( .NOT.ln_linssh ) THEN
146!            DO jk = 1, jpk
147!               e3t(:,:,jk,Kbb) = e3t(:,:,jk,Kmm)
148!            END DO
149!         ENDIF
150!!gm
151         !
152      ENDIF 
153      !
154      ! Initialize "now" and "before" barotropic velocities:
155      ! Do it whatever the free surface method, these arrays being eventually used
156      !
157      uu_b(:,:,Kmm) = 0._wp   ;   vv_b(:,:,Kmm) = 0._wp
158      uu_b(:,:,Kbb) = 0._wp   ;   vv_b(:,:,Kbb) = 0._wp
159      !
160!!gm  the use of umsak & vmask is not necessary below as uu(:,:,:,Kmm), vv(:,:,:,Kmm), uu(:,:,:,Kbb), vv(:,:,:,Kbb) are always masked
161      DO_3D_11_11( 1, jpkm1 )
162         uu_b(ji,jj,Kmm) = uu_b(ji,jj,Kmm) + e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm) * umask(ji,jj,jk)
163         vv_b(ji,jj,Kmm) = vv_b(ji,jj,Kmm) + e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm) * vmask(ji,jj,jk)
164         !
165         uu_b(ji,jj,Kbb) = uu_b(ji,jj,Kbb) + e3u(ji,jj,jk,Kbb) * uu(ji,jj,jk,Kbb) * umask(ji,jj,jk)
166         vv_b(ji,jj,Kbb) = vv_b(ji,jj,Kbb) + e3v(ji,jj,jk,Kbb) * vv(ji,jj,jk,Kbb) * vmask(ji,jj,jk)
167      END_3D
168      !
169      uu_b(:,:,Kmm) = uu_b(:,:,Kmm) * r1_hu(:,:,Kmm)
170      vv_b(:,:,Kmm) = vv_b(:,:,Kmm) * r1_hv(:,:,Kmm)
171      !
172      uu_b(:,:,Kbb) = uu_b(:,:,Kbb) * r1_hu(:,:,Kbb)
173      vv_b(:,:,Kbb) = vv_b(:,:,Kbb) * r1_hv(:,:,Kbb)
174      !
175   END SUBROUTINE istate_init
176
177   !!======================================================================
178END MODULE istate
Note: See TracBrowser for help on using the repository browser.