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 branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/DOM – NEMO

source: branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90 @ 6596

Last change on this file since 6596 was 6596, checked in by gm, 8 years ago

#1692 - branch SIMPLIF_2_usrdef: remove from namcfg and namdom many obsolete variables ; remove izoom/jzoom option

  • Property svn:keywords set to Id
File size: 7.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) change configuration's interface:
17   !!                              read file or CALL usr_def module to compute initial state (example given for GYRE)
18   !!----------------------------------------------------------------------
19
20   !!----------------------------------------------------------------------
21   !!   istate_init   : initial state setting
22   !!   istate_uvg    : initial velocity in geostropic balance
23   !!----------------------------------------------------------------------
24   USE oce             ! ocean dynamics and active tracers
25   USE dom_oce         ! ocean space and time domain
26   USE c1d             ! 1D vertical configuration
27   USE daymod          ! calendar
28   USE eosbn2          ! eq. of state, Brunt Vaisala frequency (eos     routine)
29   USE ldftra          ! lateral physics: ocean active tracers
30   USE zdf_oce         ! ocean vertical physics
31   USE phycst          ! physical constants
32   USE dtatsd          ! data temperature and salinity   (dta_tsd routine)
33   USE dtauvd          ! data: U & V current             (dta_uvd routine)
34   USE domvvl          ! varying vertical mesh
35   USE iscplrst        ! ice sheet coupling
36   USE usrdef          ! User defined routine
37   !
38   USE in_out_manager  ! I/O manager
39   USE iom             ! I/O library
40   USE lib_mpp         ! MPP library
41   USE restart         ! restart
42   USE wrk_nemo        ! Memory allocation
43   USE timing          ! Timing
44
45   IMPLICIT NONE
46   PRIVATE
47
48   PUBLIC   istate_init   ! routine called by step.F90
49   !SF PUBLIC   ini_read      ! subroutine ini_read
50
51   !! * Substitutions
52#  include "vectopt_loop_substitute.h90"
53   !!----------------------------------------------------------------------
54   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
55   !! $Id$
56   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
57   !!----------------------------------------------------------------------
58CONTAINS
59
60   SUBROUTINE istate_init
61      !!----------------------------------------------------------------------
62      !!                   ***  ROUTINE istate_init  ***
63      !!
64      !! ** Purpose :   Initialization of the dynamics and tracer fields.
65      !!----------------------------------------------------------------------
66      INTEGER ::   ji, jj, jk   ! dummy loop indices
67      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zuvd    ! U & V data workspace
68      !!----------------------------------------------------------------------
69      !
70      IF( nn_timing == 1 )   CALL timing_start('istate_init')
71      !
72
73      IF(lwp) WRITE(numout,*)
74      IF(lwp) WRITE(numout,*) 'istate_ini : Initialization of the dynamics and tracers'
75      IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
76
77     !SF initialisation of T & S with data file
78                     CALL dta_tsd_init        ! Initialisation of T & S input data
79      IF( lk_c1d )   CALL dta_uvd_init        ! Initialization of U & V input data
80
81      rhd  (:,:,:  ) = 0._wp   ;   rhop (:,:,:  ) = 0._wp      ! set one for all to 0 at level jpk
82      rn2b (:,:,:  ) = 0._wp   ;   rn2  (:,:,:  ) = 0._wp      ! set one for all to 0 at levels 1 and jpk
83      tsa  (:,:,:,:) = 0._wp                                   ! set one for all to 0 at level jpk
84      rab_b(:,:,:,:) = 0._wp   ;   rab_n(:,:,:,:) = 0._wp      ! set one for all to 0 at level jpk
85
86      IF( ln_rstart ) THEN                    ! Restart from a file
87         !                                    ! -------------------
88         CALL rst_read                        ! Read the restart file
89         IF (ln_iscpl)       CALL iscpl_stp   ! extraloate restart to wet and dry
90         CALL day_init                        ! model calendar (using both namelist and restart infos)
91      ELSE
92         !                                    ! Start from rest
93         !                                    ! ---------------
94         numror = 0                           ! define numror = 0 -> no restart file to read
95         neuler = 0                           ! Set time-step indicator at nit000 (euler forward)
96         CALL day_init                        ! model calendar (using both namelist and restart infos)
97         !                                    ! Initialization of ocean to zero
98         !   before fields      !       now fields     
99         sshb (:,:)   = 0._wp   ;   sshn (:,:)   = 0._wp
100         ub   (:,:,:) = 0._wp   ;   un   (:,:,:) = 0._wp
101         vb   (:,:,:) = 0._wp   ;   vn   (:,:,:) = 0._wp 
102                                    hdivn(:,:,:) = 0._wp
103         !
104         IF( ln_tsd_init ) THEN               ! read 3D T and S data at nit000
105            CALL dta_tsd( nit000, tsb ) 
106         ELSE                                 ! user defined initial T and S
107            CALL usr_def_ini( tsb )               
108         ENDIF
109         tsn(:,:,:,:) = tsb(:,:,:,:)          ! set now to before values
110         !
111         IF ( ln_uvd_init .AND. lk_c1d ) THEN ! read 3D U and V data at nit000
112            CALL wrk_alloc( jpi,jpj,jpk,2,   zuvd )
113            CALL dta_uvd( nit000, zuvd )
114            ub(:,:,:) = zuvd(:,:,:,1) ;  un(:,:,:) = ub(:,:,:)
115            vb(:,:,:) = zuvd(:,:,:,2) ;  vn(:,:,:) = vb(:,:,:)
116            CALL wrk_dealloc( jpi,jpj,jpk,2,   zuvd )
117         ENDIF
118         !
119!!gm This is to be changed !!!!
120         ! - ML - sshn could be modified by istate_eel, so that initialization of e3t_b is done here
121         IF( .NOT.ln_linssh ) THEN
122            DO jk = 1, jpk
123               e3t_b(:,:,jk) = e3t_n(:,:,jk)
124            END DO
125         ENDIF
126!!gm
127         !
128      ENDIF 
129      !
130      ! Initialize "now" and "before" barotropic velocities:
131      ! Do it whatever the free surface method, these arrays being eventually used
132      !
133      un_b(:,:) = 0._wp   ;   vn_b(:,:) = 0._wp
134      ub_b(:,:) = 0._wp   ;   vb_b(:,:) = 0._wp
135      !
136!!gm  the use of umsak & vmask is not necessary below as un, vn, ub, vb are always masked
137      DO jk = 1, jpkm1
138         DO jj = 1, jpj
139            DO ji = 1, jpi
140               un_b(ji,jj) = un_b(ji,jj) + e3u_n(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk)
141               vn_b(ji,jj) = vn_b(ji,jj) + e3v_n(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk)
142               !
143               ub_b(ji,jj) = ub_b(ji,jj) + e3u_b(ji,jj,jk) * ub(ji,jj,jk) * umask(ji,jj,jk)
144               vb_b(ji,jj) = vb_b(ji,jj) + e3v_b(ji,jj,jk) * vb(ji,jj,jk) * vmask(ji,jj,jk)
145            END DO
146         END DO
147      END DO
148      !
149      un_b(:,:) = un_b(:,:) * r1_hu_n(:,:)
150      vn_b(:,:) = vn_b(:,:) * r1_hv_n(:,:)
151      !
152      ub_b(:,:) = ub_b(:,:) * r1_hu_b(:,:)
153      vb_b(:,:) = vb_b(:,:) * r1_hv_b(:,:)
154      !
155      IF( nn_timing == 1 )   CALL timing_stop('istate_init')
156      !
157   END SUBROUTINE istate_init
158
159   !!======================================================================
160END MODULE istate
Note: See TracBrowser for help on using the repository browser.