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/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/ASM – NEMO

source: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/ASM/asmtrj.F90 @ 2259

Last change on this file since 2259 was 2239, checked in by rblod, 14 years ago

First commit to compile ORCA2_LIM for next nemo v3.3
File size: 10.9 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
50CONTAINS
51
52   SUBROUTINE asm_bkg_wri( kt )
53      !!-----------------------------------------------------------------------
54      !!
55      !!                  ***  ROUTINE asm_bkg_wri ***
56      !!
57      !! ** Purpose : Write to file the background state for later use in the
58      !!              inner loop of data assimilation or for direct initialization
59      !!              in the outer loop.
60      !!
61      !! ** Method  : Write out the background state for use in the Jb term
62      !!              in the cost function and for use with direct initialization
63      !!              at analysis time.
64      !!
65      !! ** Action  :
66      !!                   
67      !! References :
68      !!
69      !! History :
70      !!        ! 07-03 (M. Martin) Met. Office version
71      !!        ! 07-03 (K. Mogensen) Adapt to NEMOVAR and use IOM instead of IOIPSL
72      !!        ! 07-04 (A. Weaver) Name change (formally asmbkg.F90). Distinguish
73      !!                            background states in Jb term and at analysis time.
74      !!                            Include state trajectory routine (currently empty)
75      !!        ! 07-07 (A. Weaver) Add tke_rst and flt_rst for case nitbkg=0
76      !!-----------------------------------------------------------------------
77
78      !! * Arguments
79      INTEGER, INTENT( IN ) :: kt               ! Current time-step
80
81      !! * Local declarations
82      CHARACTER (LEN=50) :: cl_asmbkg
83      CHARACTER (LEN=50) :: cl_asmdin
84      LOGICAL :: llok          ! Check if file exists
85      INTEGER :: inum          ! File unit number
86      REAL(wp) :: zdate        ! Date
87
88      !--------------------------------------------------------------------
89      ! Write out background at time step nitbkg_r or nitdin_r
90      !--------------------------------------------------------------------
91
92      IF ( kt == nitbkg_r ) THEN
93
94         WRITE(cl_asmbkg, FMT='(A,".nc")' ) TRIM( c_asmbkg )
95         cl_asmbkg = TRIM( cl_asmbkg )
96
97         INQUIRE( FILE = cl_asmbkg, EXIST = llok )
98
99         IF( .NOT. llok ) THEN
100            IF(lwp) WRITE(numout,*) ' Setting up assimilation background file '// &
101               &                    TRIM( c_asmbkg )
102
103            ! Define the output file       
104            CALL iom_open( c_asmbkg, inum, ldwrt = .TRUE., kiolib = jprstlib)
105
106            ! Treat special case when nitbkg = 0
107            IF ( nitbkg_r == nit000 - 1 ) THEN
108               zdate = REAL( ndastp )
109#if defined key_zdftke
110               IF(lwp) WRITE(numout,*) ' Reading TKE (en) from restart...'
111               ! Read turbulent kinetic energy ( en )
112               CALL tke_rst( nit000, 'READ' )
113#endif
114            ELSE
115               zdate = REAL( ndastp )
116            ENDIF
117
118            ! Write the information
119            CALL iom_rstput( kt, nitbkg_r, inum, 'rdastp' , zdate   )
120            CALL iom_rstput( kt, nitbkg_r, inum, 'un'     , un      )
121            CALL iom_rstput( kt, nitbkg_r, inum, 'vn'     , vn      )
122            CALL iom_rstput( kt, nitbkg_r, inum, 'tn'     , tn      )
123            CALL iom_rstput( kt, nitbkg_r, inum, 'sn'     , sn      )
124            CALL iom_rstput( kt, nitbkg_r, inum, 'sshn'   , sshn    )
125#if defined key_zdftke
126            CALL iom_rstput( kt, nitbkg_r, inum, 'en'     , en      )
127#endif
128            CALL iom_rstput( kt, nitbkg_r, inum, 'gcx'    , gcx     )
129
130            CALL iom_close( inum )
131
132         ENDIF
133
134      ENDIF
135
136      IF ( kt == nitdin_r ) THEN
137
138         WRITE(cl_asmdin, FMT='(A,".nc")' ) TRIM( c_asmdin )
139         cl_asmdin = TRIM( cl_asmdin )
140
141         INQUIRE( FILE = cl_asmdin, EXIST = llok )
142
143         IF( .NOT. llok ) THEN
144            IF(lwp) WRITE(numout,*) ' Setting up assimilation background file '// &
145               &                    TRIM( c_asmdin )
146
147            ! Define the output file       
148            CALL iom_open( c_asmdin, inum, ldwrt = .TRUE., kiolib = jprstlib)
149
150            ! Treat special case when nitbkg = 0
151            IF ( nitdin_r == nit000 - 1) THEN
152               zdate = REAL( ndastp )
153            ELSE
154               zdate = REAL( ndastp )
155            ENDIF
156
157            ! Write the information
158            CALL iom_rstput( kt, nitdin_r, inum, 'rdastp' , zdate   )
159            CALL iom_rstput( kt, nitdin_r, inum, 'un'     , un      )
160            CALL iom_rstput( kt, nitdin_r, inum, 'vn'     , vn      )
161            CALL iom_rstput( kt, nitdin_r, inum, 'tn'     , tn      )
162            CALL iom_rstput( kt, nitdin_r, inum, 'sn'     , sn      )
163            CALL iom_rstput( kt, nitdin_r, inum, 'sshn'   , sshn    )
164
165            CALL iom_close( inum )
166
167         ENDIF
168
169      ENDIF
170                                 
171   END SUBROUTINE asm_bkg_wri
172
173   SUBROUTINE asm_trj_wri( kt )
174      !!-----------------------------------------------------------------------
175      !!
176      !!                  ***  ROUTINE asm_trj_wri ***
177      !!
178      !! ** Purpose : Write to file the model state trajectory for use with
179      !!              4D-Var.
180      !!
181      !! ** Method  :
182      !!
183      !! ** Action  :
184      !!                   
185      !! References :
186      !!
187      !! History :
188      !!        ! 07-04 (A. Weaver)
189      !!        ! 09-03 (F. Vigilant) Add hmlp (zdfmxl) for no tracer nmldp=2
190      !!        ! 09-06 (F. Vigilant) special case when kt=nit000-1
191      !!        ! 09-07 (F. Vigilant) add computation of eiv at restart
192      !!-----------------------------------------------------------------------
193
194      !! * Arguments
195      INTEGER, INTENT( IN ) :: kt             ! Current time-step
196
197      !! * Local declarations
198      INTEGER :: inum                  ! File unit number
199      INTEGER :: it
200      CHARACTER (LEN=50) :: cl_asmtrj
201      REAL(wp) :: zdate            ! Date
202
203      !------------------------------------------------------------------------
204      ! Write a single file for each trajectory time step
205      !------------------------------------------------------------------------
206      IF ( ( MOD( kt - nit000 + 1, nittrjfrq ) == 0 ) .OR. &
207         & ( kt == nitend ) ) THEN
208         
209         ! Treat special case when kt = nit000-1
210         IF ( kt == nit000 - 1 ) THEN
211#if defined key_zdftke
212            IF(lwp) WRITE(numout,*) ' Computing  zdf_tke coeff. form restart...'
213            ! Compute the vertical eddy viscosity and diffusivity coefficients
214            CALL zdf_tke( nit000 )
215#endif
216#if defined key_zdfddm
217            IF(lwp) WRITE(numout,*) ' Computing zdf_ddm coeff. from restart...'
218            ! Compute the vertical eddy viscosity and diffusivity coefficients (salt effect)
219            CALL zdf_ddm( nit000 )
220#endif
221            IF(lwp) WRITE(numout,*) ' Computing zdf_mxl coeff. from restart...'
222            ! Compute the turbocline depth and the mixed layer depth
223            CALL zdf_mxl( nit000 ) 
224#if defined key_ldfslp
225            IF(lwp) WRITE(numout,*) ' Compute the slopes of neutral surface...'
226            CALL bn2( tsb, rn2 ) 
227            CALL ldf_slp( nit000, rhd, rn2 )
228#endif
229#if defined key_traldf_c2d
230            IF(lwp) WRITE(numout,*) ' Computing ldf_eiv coeff. from restart...'
231            ! Compute eddy induced velocity coefficient
232            IF( lk_traldf_eiv )   CALL ldf_eiv( nit000 )
233#endif
234          ENDIF
235
236
237         it = kt - nit000 + 1
238
239         ! Define the output file       
240         WRITE(cl_asmtrj, FMT='(A,A,I5.5)' ) TRIM( c_asmtrj ), '_', it
241         cl_asmtrj = TRIM( cl_asmtrj )
242         CALL iom_open( cl_asmtrj, inum, ldwrt = .TRUE., kiolib = jprstlib)
243
244         ! Output trajectory fields
245         CALL iom_rstput( it, it, inum, 'emp'   , emp    )
246         CALL iom_rstput( it, it, inum, 'emps'  , emps   )
247         CALL iom_rstput( it, it, inum, 'un'    , un     )
248         CALL iom_rstput( it, it, inum, 'vn'    , vn     )
249         CALL iom_rstput( it, it, inum, 'tn'    , tn     )
250         CALL iom_rstput( it, it, inum, 'sn'    , sn     )
251         CALL iom_rstput( it, it, inum, 'avmu'  , avmu   )
252         CALL iom_rstput( it, it, inum, 'avmv'  , avmv   )
253         CALL iom_rstput( it, it, inum, 'avt'   , avt    )
254#if defined key_ldfslp
255         CALL iom_rstput( it, it, inum, 'uslp'  , uslp   )
256         CALL iom_rstput( it, it, inum, 'vslp'  , vslp   )
257         CALL iom_rstput( it, it, inum, 'wslpi' , wslpi  )
258         CALL iom_rstput( it, it, inum, 'wslpj' , wslpj  )
259#endif
260#if defined key_zdfddm
261         CALL iom_rstput( it, it, inum, 'avs'   , avs    )
262#endif
263         CALL iom_rstput( it, it, inum, 'ta'    , ta     )
264         CALL iom_rstput( it, it, inum, 'sa'    , sa     )
265         CALL iom_rstput( it, it, inum, 'tb'    , tb     )
266         CALL iom_rstput( it, it, inum, 'sb'    , sb     )
267#if defined key_tradmp
268         CALL iom_rstput( it, it, inum, 'strdmp', strdmp )
269         CALL iom_rstput( it, it, inum, 'hmlp'  , hmlp   )
270#endif
271         CALL iom_rstput( it, it, inum, 'aeiu'  , aeiu   )
272         CALL iom_rstput( it, it, inum, 'aeiv'  , aeiv   )
273         CALL iom_rstput( it, it, inum, 'aeiw'  , aeiw   )
274
275         CALL iom_close( inum )
276         
277      ENDIF
278
279   END SUBROUTINE asm_trj_wri
280
281END MODULE asmtrj
Note: See TracBrowser for help on using the repository browser.