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.
asmtrj.F90 in branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/ASM – NEMO

source: branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/ASM/asmtrj.F90 @ 2359

Last change on this file since 2359 was 2287, checked in by smasson, 14 years ago

update licence of all NEMO files...
  • Property svn:keywords set to Id
File size: 11.2 KB
Line 
1MODULE asmtrj
2   !!======================================================================
3   !!                       ***  MODULE asmtrj  ***
4   !! Assimilation trajectory interface: Write to file the background state
5   !!                                    and the model state trajectory
6   !!======================================================================
7
8   !!----------------------------------------------------------------------
9   !!   'key_asminc' : Switch on the assimilation increment interface
10   !!----------------------------------------------------------------------
11   !!   asm_bkg_wri  : Write out the background state
12   !!   asm_trj_wri  : Write out the model state trajectory (used with 4D-Var)
13   !!----------------------------------------------------------------------
14   !! * Modules used   
15   USE oce                ! Dynamics and active tracers defined in memory
16   USE sbc_oce            ! Ocean surface boundary conditions
17   USE zdf_oce            ! Vertical mixing variables
18   USE zdfddm             ! Double diffusion mixing parameterization
19   USE ldftra_oce         ! Lateral tracer mixing coefficient defined in memory
20   USE ldfslp             ! Slopes of neutral surfaces
21   USE tradmp             ! Tracer damping
22
23#if defined key_zdftke
24   USE zdftke             ! TKE vertical physics
25#endif
26   USE eosbn2             ! Equation of state (eos_bn2 routine)
27   USE zdfmxl             ! Mixed layer depth
28   USE sol_oce, ONLY : &  ! Solver variables defined in memory
29      & gcx
30   USE in_out_manager, ONLY : &  ! I/O manager
31      & lwp,     &
32      & numout
33   USE dom_oce, ONLY : &
34      & ndastp
35   USE iom                 ! I/O module
36   USE asmpar              ! Parameters for the assmilation interface
37   USE zdfmxl, ONLY : &   ! mixed layer depth
38      & hmlp
39#if defined key_traldf_c2d
40   USE ldfeiv          ! eddy induced velocity coef.      (ldf_eiv routine)
41#endif
42
43   IMPLICIT NONE
44
45   !! * Routine accessibility
46   PRIVATE
47   PUBLIC asm_bkg_wri, &  !: Write out the background state
48      &   asm_trj_wri     !: Write out the background state
49
50   !!----------------------------------------------------------------------
51   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
52   !! $Id$
53   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
54   !!----------------------------------------------------------------------
55
56CONTAINS
57
58   SUBROUTINE asm_bkg_wri( kt )
59      !!-----------------------------------------------------------------------
60      !!
61      !!                  ***  ROUTINE asm_bkg_wri ***
62      !!
63      !! ** Purpose : Write to file the background state for later use in the
64      !!              inner loop of data assimilation or for direct initialization
65      !!              in the outer loop.
66      !!
67      !! ** Method  : Write out the background state for use in the Jb term
68      !!              in the cost function and for use with direct initialization
69      !!              at analysis time.
70      !!
71      !! ** Action  :
72      !!                   
73      !! References :
74      !!
75      !! History :
76      !!        ! 07-03 (M. Martin) Met. Office version
77      !!        ! 07-03 (K. Mogensen) Adapt to NEMOVAR and use IOM instead of IOIPSL
78      !!        ! 07-04 (A. Weaver) Name change (formally asmbkg.F90). Distinguish
79      !!                            background states in Jb term and at analysis time.
80      !!                            Include state trajectory routine (currently empty)
81      !!        ! 07-07 (A. Weaver) Add tke_rst and flt_rst for case nitbkg=0
82      !!-----------------------------------------------------------------------
83
84      !! * Arguments
85      INTEGER, INTENT( IN ) :: kt               ! Current time-step
86
87      !! * Local declarations
88      CHARACTER (LEN=50) :: cl_asmbkg
89      CHARACTER (LEN=50) :: cl_asmdin
90      LOGICAL :: llok          ! Check if file exists
91      INTEGER :: inum          ! File unit number
92      REAL(wp) :: zdate        ! Date
93
94      !--------------------------------------------------------------------
95      ! Write out background at time step nitbkg_r or nitdin_r
96      !--------------------------------------------------------------------
97
98      IF ( kt == nitbkg_r ) THEN
99
100         WRITE(cl_asmbkg, FMT='(A,".nc")' ) TRIM( c_asmbkg )
101         cl_asmbkg = TRIM( cl_asmbkg )
102
103         INQUIRE( FILE = cl_asmbkg, EXIST = llok )
104
105         IF( .NOT. llok ) THEN
106            IF(lwp) WRITE(numout,*) ' Setting up assimilation background file '// &
107               &                    TRIM( c_asmbkg )
108
109            ! Define the output file       
110            CALL iom_open( c_asmbkg, inum, ldwrt = .TRUE., kiolib = jprstlib)
111
112            ! Treat special case when nitbkg = 0
113            IF ( nitbkg_r == nit000 - 1 ) THEN
114               zdate = REAL( ndastp )
115#if defined key_zdftke
116               IF(lwp) WRITE(numout,*) ' Reading TKE (en) from restart...'
117               ! Read turbulent kinetic energy ( en )
118               CALL tke_rst( nit000, 'READ' )
119#endif
120            ELSE
121               zdate = REAL( ndastp )
122            ENDIF
123
124            ! Write the information
125            CALL iom_rstput( kt, nitbkg_r, inum, 'rdastp' , zdate   )
126            CALL iom_rstput( kt, nitbkg_r, inum, 'un'     , un      )
127            CALL iom_rstput( kt, nitbkg_r, inum, 'vn'     , vn      )
128            CALL iom_rstput( kt, nitbkg_r, inum, 'tn'     , tn      )
129            CALL iom_rstput( kt, nitbkg_r, inum, 'sn'     , sn      )
130            CALL iom_rstput( kt, nitbkg_r, inum, 'sshn'   , sshn    )
131#if defined key_zdftke
132            CALL iom_rstput( kt, nitbkg_r, inum, 'en'     , en      )
133#endif
134            CALL iom_rstput( kt, nitbkg_r, inum, 'gcx'    , gcx     )
135
136            CALL iom_close( inum )
137
138         ENDIF
139
140      ENDIF
141
142      IF ( kt == nitdin_r ) THEN
143
144         WRITE(cl_asmdin, FMT='(A,".nc")' ) TRIM( c_asmdin )
145         cl_asmdin = TRIM( cl_asmdin )
146
147         INQUIRE( FILE = cl_asmdin, EXIST = llok )
148
149         IF( .NOT. llok ) THEN
150            IF(lwp) WRITE(numout,*) ' Setting up assimilation background file '// &
151               &                    TRIM( c_asmdin )
152
153            ! Define the output file       
154            CALL iom_open( c_asmdin, inum, ldwrt = .TRUE., kiolib = jprstlib)
155
156            ! Treat special case when nitbkg = 0
157            IF ( nitdin_r == nit000 - 1) THEN
158               zdate = REAL( ndastp )
159            ELSE
160               zdate = REAL( ndastp )
161            ENDIF
162
163            ! Write the information
164            CALL iom_rstput( kt, nitdin_r, inum, 'rdastp' , zdate   )
165            CALL iom_rstput( kt, nitdin_r, inum, 'un'     , un      )
166            CALL iom_rstput( kt, nitdin_r, inum, 'vn'     , vn      )
167            CALL iom_rstput( kt, nitdin_r, inum, 'tn'     , tn      )
168            CALL iom_rstput( kt, nitdin_r, inum, 'sn'     , sn      )
169            CALL iom_rstput( kt, nitdin_r, inum, 'sshn'   , sshn    )
170
171            CALL iom_close( inum )
172
173         ENDIF
174
175      ENDIF
176                                 
177   END SUBROUTINE asm_bkg_wri
178
179   SUBROUTINE asm_trj_wri( kt )
180      !!-----------------------------------------------------------------------
181      !!
182      !!                  ***  ROUTINE asm_trj_wri ***
183      !!
184      !! ** Purpose : Write to file the model state trajectory for use with
185      !!              4D-Var.
186      !!
187      !! ** Method  :
188      !!
189      !! ** Action  :
190      !!                   
191      !! References :
192      !!
193      !! History :
194      !!        ! 07-04 (A. Weaver)
195      !!        ! 09-03 (F. Vigilant) Add hmlp (zdfmxl) for no tracer nmldp=2
196      !!        ! 09-06 (F. Vigilant) special case when kt=nit000-1
197      !!        ! 09-07 (F. Vigilant) add computation of eiv at restart
198      !!-----------------------------------------------------------------------
199
200      !! * Arguments
201      INTEGER, INTENT( IN ) :: kt             ! Current time-step
202
203      !! * Local declarations
204      INTEGER :: inum                  ! File unit number
205      INTEGER :: it
206      CHARACTER (LEN=50) :: cl_asmtrj
207      REAL(wp) :: zdate            ! Date
208
209      !------------------------------------------------------------------------
210      ! Write a single file for each trajectory time step
211      !------------------------------------------------------------------------
212      IF ( ( MOD( kt - nit000 + 1, nittrjfrq ) == 0 ) .OR. &
213         & ( kt == nitend ) ) THEN
214         
215         ! Treat special case when kt = nit000-1
216         IF ( kt == nit000 - 1 ) THEN
217#if defined key_zdftke
218            IF(lwp) WRITE(numout,*) ' Computing  zdf_tke coeff. form restart...'
219            ! Compute the vertical eddy viscosity and diffusivity coefficients
220            CALL zdf_tke( nit000 )
221#endif
222#if defined key_zdfddm
223            IF(lwp) WRITE(numout,*) ' Computing zdf_ddm coeff. from restart...'
224            ! Compute the vertical eddy viscosity and diffusivity coefficients (salt effect)
225            CALL zdf_ddm( nit000 )
226#endif
227            IF(lwp) WRITE(numout,*) ' Computing zdf_mxl coeff. from restart...'
228            ! Compute the turbocline depth and the mixed layer depth
229            CALL zdf_mxl( nit000 ) 
230#if defined key_ldfslp
231            IF(lwp) WRITE(numout,*) ' Compute the slopes of neutral surface...'
232            CALL bn2( tsb, rn2 ) 
233            CALL ldf_slp( nit000, rhd, rn2 )
234#endif
235#if defined key_traldf_c2d
236            IF(lwp) WRITE(numout,*) ' Computing ldf_eiv coeff. from restart...'
237            ! Compute eddy induced velocity coefficient
238            IF( lk_traldf_eiv )   CALL ldf_eiv( nit000 )
239#endif
240          ENDIF
241
242
243         it = kt - nit000 + 1
244
245         ! Define the output file       
246         WRITE(cl_asmtrj, FMT='(A,A,I5.5)' ) TRIM( c_asmtrj ), '_', it
247         cl_asmtrj = TRIM( cl_asmtrj )
248         CALL iom_open( cl_asmtrj, inum, ldwrt = .TRUE., kiolib = jprstlib)
249
250         ! Output trajectory fields
251         CALL iom_rstput( it, it, inum, 'emp'   , emp    )
252         CALL iom_rstput( it, it, inum, 'emps'  , emps   )
253         CALL iom_rstput( it, it, inum, 'un'    , un     )
254         CALL iom_rstput( it, it, inum, 'vn'    , vn     )
255         CALL iom_rstput( it, it, inum, 'tn'    , tn     )
256         CALL iom_rstput( it, it, inum, 'sn'    , sn     )
257         CALL iom_rstput( it, it, inum, 'avmu'  , avmu   )
258         CALL iom_rstput( it, it, inum, 'avmv'  , avmv   )
259         CALL iom_rstput( it, it, inum, 'avt'   , avt    )
260#if defined key_ldfslp
261         CALL iom_rstput( it, it, inum, 'uslp'  , uslp   )
262         CALL iom_rstput( it, it, inum, 'vslp'  , vslp   )
263         CALL iom_rstput( it, it, inum, 'wslpi' , wslpi  )
264         CALL iom_rstput( it, it, inum, 'wslpj' , wslpj  )
265#endif
266#if defined key_zdfddm
267         CALL iom_rstput( it, it, inum, 'avs'   , avs    )
268#endif
269         CALL iom_rstput( it, it, inum, 'ta'    , ta     )
270         CALL iom_rstput( it, it, inum, 'sa'    , sa     )
271         CALL iom_rstput( it, it, inum, 'tb'    , tb     )
272         CALL iom_rstput( it, it, inum, 'sb'    , sb     )
273#if defined key_tradmp
274         CALL iom_rstput( it, it, inum, 'strdmp', strdmp )
275         CALL iom_rstput( it, it, inum, 'hmlp'  , hmlp   )
276#endif
277         CALL iom_rstput( it, it, inum, 'aeiu'  , aeiu   )
278         CALL iom_rstput( it, it, inum, 'aeiv'  , aeiv   )
279         CALL iom_rstput( it, it, inum, 'aeiw'  , aeiw   )
280
281         CALL iom_close( inum )
282         
283      ENDIF
284
285   END SUBROUTINE asm_trj_wri
286
287END MODULE asmtrj
Note: See TracBrowser for help on using the repository browser.