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 @ 14086

Last change on this file since 14086 was 14086, checked in by cetlod, 4 years ago

Adding AGRIF branches into the trunk
  • Property svn:keywords set to Id
File size: 8.8 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 dtatsd         ! data temperature and salinity   (dta_tsd routine)
27   USE dtauvd         ! data: U & V current             (dta_uvd routine)
28   USE domvvl          ! varying vertical mesh
29   USE wet_dry         ! wetting and drying (needed for wad_istate)
30   USE usrdef_istate   ! User defined initial state
31   !
32   USE in_out_manager  ! I/O manager
33   USE iom             ! I/O library
34   USE lib_mpp         ! MPP library
35   USE restart         ! restart
36
37#if defined key_agrif
38   USE agrif_oce       ! initial state interpolation
39   USE agrif_oce_interp
40#endif   
41
42   IMPLICIT NONE
43   PRIVATE
44
45   PUBLIC   istate_init   ! routine called by nemogcm.F90
46
47   !! * Substitutions
48#  include "do_loop_substitute.h90"
49#  include "domzgr_substitute.h90"
50   !!----------------------------------------------------------------------
51   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
52   !! $Id$
53   !! Software governed by the CeCILL license (see ./LICENSE)
54   !!----------------------------------------------------------------------
55CONTAINS
56
57   SUBROUTINE istate_init( Kbb, Kmm, Kaa )
58      !!----------------------------------------------------------------------
59      !!                   ***  ROUTINE istate_init  ***
60      !!
61      !! ** Purpose :   Initialization of the dynamics and tracer fields.
62      !!
63      !! ** Method  :   
64      !!----------------------------------------------------------------------
65      INTEGER, INTENT( in )  ::  Kbb, Kmm, Kaa   ! ocean time level indices
66      !
67      INTEGER ::   ji, jj, jk   ! dummy loop indices
68      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zgdept     ! 3D table for qco substitute
69!!gm see comment further down
70      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::   zuvd    ! U & V data workspace
71!!gm end
72      !!----------------------------------------------------------------------
73      !
74      IF(lwp) WRITE(numout,*)
75      IF(lwp) WRITE(numout,*) 'istate_init : Initialization of the dynamics and tracers'
76      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
77
78       CALL dta_tsd_init        ! Initialisation of T & S input data
79
80!      IF( lk_c1d )   CALL dta_uvd_init        ! Initialization of U & V input data
81
82      rhd  (:,:,:      ) = 0._wp   ;   rhop (:,:,:  ) = 0._wp      ! set one for all to 0 at level jpk
83      rn2b (:,:,:      ) = 0._wp   ;   rn2  (:,:,:  ) = 0._wp      ! set one for all to 0 at levels 1 and jpk
84      ts   (:,:,:,:,Kaa) = 0._wp                                   ! set one for all to 0 at level jpk
85      rab_b(:,:,:,:    ) = 0._wp   ;   rab_n(:,:,:,:) = 0._wp      ! set one for all to 0 at level jpk
86#if defined key_agrif
87      uu   (:,:,:  ,Kaa) = 0._wp   ! used in agrif_oce_sponge at initialization
88      vv   (:,:,:  ,Kaa) = 0._wp   ! used in agrif_oce_sponge at initialization   
89#endif
90
91#if defined key_agrif
92      IF ( (.NOT.Agrif_root()).AND.ln_init_chfrpar ) THEN
93         numror = 0                           ! define numror = 0 -> no restart file to read
94         ln_1st_euler = .true.                ! Set time-step indicator at nit000 (euler forward)
95         CALL day_init 
96         CALL agrif_istate_oce( Kbb, Kmm, Kaa )   ! Interp from parent
97         !
98         ts (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb)
99!!st
100!!st need for a recent agrif version to be displaced toward ssh_init_rst with agrif_istate_ssh
101         ssh(:,:,    Kmm) = ssh(:,:    ,Kbb)
102!!st end
103         uu (:,:,:  ,Kmm) = uu (:,:,:  ,Kbb)
104         vv (:,:,:  ,Kmm) = vv (:,:,:  ,Kbb)
105      ELSE
106#endif
107         IF( ln_rstart ) THEN                    ! Restart from a file
108            !                                    ! -------------------
109            CALL rst_read( Kbb, Kmm )            ! Read the restart file
110            CALL day_init                        ! model calendar (using both namelist and restart infos)
111            !
112         ELSE                                    ! Start from rest
113            !                                    ! ---------------
114            numror = 0                           ! define numror = 0 -> no restart file to read
115            l_1st_euler = .true.                 ! Set time-step indicator at nit000 (euler forward)
116            CALL day_init                        ! model calendar (using both namelist and restart infos)
117            !                                    ! Initialization of ocean to zero
118            IF( ln_tsd_init ) THEN               
119               CALL dta_tsd( nit000, ts(:,:,:,:,Kbb) )       ! read 3D T and S data at nit000
120               !
121               ssh(:,:,Kbb)   = 0._wp               ! set the ocean at rest
122               uu  (:,:,:,Kbb) = 0._wp
123               vv  (:,:,:,Kbb) = 0._wp 
124               !
125               IF( ll_wd ) THEN
126                  ssh(:,:,Kbb) =  -ssh_ref  ! Added in 30 here for bathy that adds 30 as Iterative test CEOD
127                  !
128                  ! Apply minimum wetdepth criterion
129                  !
130                  DO_2D( 1, 1, 1, 1 )
131                     IF( ht_0(ji,jj) + ssh(ji,jj,Kbb)  < rn_wdmin1 ) THEN
132                        ssh(ji,jj,Kbb) = tmask(ji,jj,1)*( rn_wdmin1 - (ht_0(ji,jj)) )
133                     ENDIF
134                  END_2D
135               ENDIF 
136               !
137            ELSE                                 ! user defined initial T and S
138               DO jk = 1, jpk
139                  zgdept(:,:,jk) = gdept(:,:,jk,Kbb)
140               END DO
141               CALL usr_def_istate( zgdept, tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb) )         
142            ENDIF
143            ts  (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb)       ! set now values from to before ones
144            ssh (:,:,Kmm)     = ssh(:,:,Kbb)   
145            uu   (:,:,:,Kmm)   = uu  (:,:,:,Kbb)
146            vv   (:,:,:,Kmm)   = vv  (:,:,:,Kbb)
147
148         !
149!!gm ==>>>  to be moved in usrdef_istate of C1D case
150         IF ( ln_uvd_init .AND. lk_c1d ) THEN ! read 3D U and V data at nit000
151            ALLOCATE( zuvd(jpi,jpj,jpk,2) )
152            CALL dta_uvd( nit000, Kbb, zuvd )
153            uu(:,:,:,Kbb) = zuvd(:,:,:,1)  ;  uu(:,:,:,Kmm) = uu(:,:,:,Kbb)
154            vv(:,:,:,Kbb) = zuvd(:,:,:,2)  ;  vv(:,:,:,Kmm) = vv(:,:,:,Kbb)
155            DEALLOCATE( zuvd )
156         ENDIF
157         !
158         !
159         ENDIF 
160#if defined key_agrif
161      ENDIF
162#endif
163      !
164      ! Initialize "now" and "before" barotropic velocities:
165      ! Do it whatever the free surface method, these arrays being eventually used
166      !
167      uu_b(:,:,Kmm) = 0._wp   ;   vv_b(:,:,Kmm) = 0._wp
168      uu_b(:,:,Kbb) = 0._wp   ;   vv_b(:,:,Kbb) = 0._wp
169      !
170!!gm  the use of umsak & vmask is not necessary below as uu(:,:,:,Kmm), vv(:,:,:,Kmm), uu(:,:,:,Kbb), vv(:,:,:,Kbb) are always masked
171      DO_3D( 1, 1, 1, 1, 1, jpkm1 )
172         uu_b(ji,jj,Kmm) = uu_b(ji,jj,Kmm) + e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm) * umask(ji,jj,jk)
173         vv_b(ji,jj,Kmm) = vv_b(ji,jj,Kmm) + e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm) * vmask(ji,jj,jk)
174         !
175         uu_b(ji,jj,Kbb) = uu_b(ji,jj,Kbb) + e3u(ji,jj,jk,Kbb) * uu(ji,jj,jk,Kbb) * umask(ji,jj,jk)
176         vv_b(ji,jj,Kbb) = vv_b(ji,jj,Kbb) + e3v(ji,jj,jk,Kbb) * vv(ji,jj,jk,Kbb) * vmask(ji,jj,jk)
177      END_3D
178      !
179      uu_b(:,:,Kmm) = uu_b(:,:,Kmm) * r1_hu(:,:,Kmm)
180      vv_b(:,:,Kmm) = vv_b(:,:,Kmm) * r1_hv(:,:,Kmm)
181      !
182      uu_b(:,:,Kbb) = uu_b(:,:,Kbb) * r1_hu(:,:,Kbb)
183      vv_b(:,:,Kbb) = vv_b(:,:,Kbb) * r1_hv(:,:,Kbb)
184      !
185   END SUBROUTINE istate_init
186
187   !!======================================================================
188END MODULE istate
Note: See TracBrowser for help on using the repository browser.