source: trunk/NEMOGCM/NEMO/OPA_SRC/ASM/asmtrj.F90 @ 3294

Last change on this file since 3294 was 3294, checked in by rblod, 9 years ago

Merge of 3.4beta into the trunk

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