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/tests/ISOMIP+/MY_SRC – NEMO

source: NEMO/trunk/tests/ISOMIP+/MY_SRC/istate.F90 @ 13295

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

Replace do-loop macros in the trunk with alternative forms with greater flexibility for extra halo applications. This alters a lot of routines but does not change any behaviour or results. do_loop_substitute.h90 is greatly simplified by this change. SETTE results are identical to those with the previous revision

File size: 8.7 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: istate.F90 11423 2019-08-08 14:02:49Z mathiot $
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         l_1st_euler = .true.                 ! 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, 'ini', 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( 1, 1, 1, 1 )
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( 1, 1, 1, 1, 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.