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/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ASM – NEMO

source: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ASM/asmtrj.F90 @ 4416

Last change on this file since 4416 was 3211, checked in by spickles2, 12 years ago

Stephen Pickles, 11 Dec 2011

Commit to bring the rest of the DCSE NEMO development branch
in line with the latest development version. This includes
array index re-ordering of all OPA_SRC/.
  • Property svn:keywords set to Id
File size: 12.0 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   !! * Control permutation of array indices
53#  include "oce_ftrans.h90"
54#  include "sbc_oce_ftrans.h90"
55#  include "zdf_oce_ftrans.h90"
56#  include "zdfddm_ftrans.h90"
57#  include "ldftra_oce_ftrans.h90"
58#  include "ldfslp_ftrans.h90"
59#  include "tradmp_ftrans.h90"
60#if defined key_zdftke
61#  include "zdftke_ftrans.h90"
62#endif
63
64   !!----------------------------------------------------------------------
65   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
66   !! $Id$
67   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
68   !!----------------------------------------------------------------------
69CONTAINS
70
71   SUBROUTINE asm_bkg_wri( kt )
72      !!-----------------------------------------------------------------------
73      !!                  ***  ROUTINE asm_bkg_wri ***
74      !!
75      !! ** Purpose : Write to file the background state for later use in the
76      !!              inner loop of data assimilation or for direct initialization
77      !!              in the outer loop.
78      !!
79      !! ** Method  : Write out the background state for use in the Jb term
80      !!              in the cost function and for use with direct initialization
81      !!              at analysis time.
82      !!-----------------------------------------------------------------------
83      INTEGER, INTENT( IN ) :: kt               ! Current time-step
84      !
85      CHARACTER (LEN=50) :: cl_asmbkg
86      CHARACTER (LEN=50) :: cl_asmdin
87      LOGICAL :: llok          ! Check if file exists
88      INTEGER :: inum          ! File unit number
89      REAL(wp) :: zdate        ! Date
90      !!-----------------------------------------------------------------------
91
92      !                                !-------------------------------------------
93      IF( kt == nitbkg_r ) THEN        ! Write out background at time step nitbkg_r
94         !                             !-----------------------------------========
95         !
96         WRITE(cl_asmbkg, FMT='(A,".nc")' ) TRIM( c_asmbkg )
97         cl_asmbkg = TRIM( cl_asmbkg )
98         INQUIRE( FILE = cl_asmbkg, EXIST = llok )
99         !
100         IF( .NOT. llok ) THEN
101            IF(lwp) WRITE(numout,*) ' Setting up assimilation background file '// TRIM( c_asmbkg )
102            !
103            !                                      ! Define the output file       
104            CALL iom_open( c_asmbkg, inum, ldwrt = .TRUE., kiolib = jprstlib)
105            !
106            IF( nitbkg_r == nit000 - 1 ) THEN      ! Treat special case when nitbkg = 0
107               zdate = REAL( ndastp )
108#if defined key_zdftke
109               ! lk_zdftke=T :   Read turbulent kinetic energy ( en )
110               IF(lwp) WRITE(numout,*) ' Reading TKE (en) from restart...'
111               CALL tke_rst( nit000, 'READ' )               ! lk_zdftke=T :   Read turbulent kinetic energy ( en )
112
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         ENDIF
132         !
133      ENDIF
134
135      !                                !-------------------------------------------
136      IF( kt == nitdin_r ) THEN        ! Write out background at time step nitdin_r
137         !                             !-----------------------------------========
138         !
139         WRITE(cl_asmdin, FMT='(A,".nc")' ) TRIM( c_asmdin )
140         cl_asmdin = TRIM( cl_asmdin )
141         INQUIRE( FILE = cl_asmdin, EXIST = llok )
142         !
143         IF( .NOT. llok ) THEN
144            IF(lwp) WRITE(numout,*) ' Setting up assimilation background file '// TRIM( c_asmdin )
145            !
146            !                                      ! Define the output file       
147            CALL iom_open( c_asmdin, inum, ldwrt = .TRUE., kiolib = jprstlib)
148            !
149            IF( nitdin_r == nit000 - 1 ) THEN      ! Treat special case when nitbkg = 0
150
151               zdate = REAL( ndastp )
152            ELSE
153               zdate = REAL( ndastp )
154            ENDIF
155            !
156            !                                      ! Write the information
157            CALL iom_rstput( kt, nitdin_r, inum, 'rdastp' , zdate   )
158            CALL iom_rstput( kt, nitdin_r, inum, 'un'     , un      )
159            CALL iom_rstput( kt, nitdin_r, inum, 'vn'     , vn      )
160            CALL iom_rstput( kt, nitdin_r, inum, 'tn'     , tn      )
161            CALL iom_rstput( kt, nitdin_r, inum, 'sn'     , sn      )
162            CALL iom_rstput( kt, nitdin_r, inum, 'sshn'   , sshn    )
163            !
164            CALL iom_close( inum )
165         ENDIF
166         !
167      ENDIF
168      !                   
169   END SUBROUTINE asm_bkg_wri
170
171
172   SUBROUTINE asm_trj_wri( kt )
173      !!-----------------------------------------------------------------------
174      !!                  ***  ROUTINE asm_trj_wri ***
175      !!
176      !! ** Purpose :   Write to file the model state trajectory for use with 4D-Var.
177      !!-----------------------------------------------------------------------
178      INTEGER, INTENT( IN ) :: kt             ! Current time-step
179      !
180      INTEGER :: inum                  ! File unit number
181      INTEGER :: it
182      CHARACTER (LEN=50) :: cl_asmtrj
183      REAL(wp) :: zdate            ! Date
184      !!-----------------------------------------------------------------------
185
186      !------------------------------------------------------------------------
187      ! Write a single file for each trajectory time step
188      !------------------------------------------------------------------------
189      IF( ( MOD( kt - nit000 + 1, nittrjfrq ) == 0 ) .OR. ( kt == nitend ) ) THEN
190         
191         IF( kt == nit000 - 1 ) THEN         ! Treat special case when kt = nit000-1
192            !
193#if defined key_zdftke
194            IF(lwp) WRITE(numout,*) ' Computing  zdf_tke coeff. form restart...'
195            ! Compute the vertical eddy viscosity and diffusivity coefficients
196            CALL zdf_tke( nit000 )
197#endif
198#if defined key_zdfddm
199            IF(lwp) WRITE(numout,*) ' Computing zdf_ddm coeff. from restart...'
200            ! Compute the vertical eddy viscosity and diffusivity coefficients (salt effect)
201            CALL zdf_ddm( nit000 )
202#endif
203            IF(lwp) WRITE(numout,*) ' Computing zdf_mxl coeff. from restart...'
204            ! Compute the turbocline depth and the mixed layer depth
205            CALL zdf_mxl( nit000 ) 
206#if defined key_ldfslp
207            IF(lwp) WRITE(numout,*) ' Compute the slopes of neutral surface...'
208            CALL bn2( tsb, rn2 ) 
209            CALL ldf_slp( nit000, rhd, rn2 )
210#endif
211#if defined key_traldf_c2d
212            IF(lwp) WRITE(numout,*) ' Computing ldf_eiv coeff. from restart...'
213            ! Compute eddy induced velocity coefficient
214            IF( lk_traldf_eiv )   CALL ldf_eiv( nit000 )
215#endif
216         ENDIF
217         !
218         it = kt - nit000 + 1
219         !
220         !                                   ! Define the output file       
221         WRITE(cl_asmtrj, FMT='(A,A,I5.5)' ) TRIM( c_asmtrj ), '_', it
222         cl_asmtrj = TRIM( cl_asmtrj )
223         CALL iom_open( cl_asmtrj, inum, ldwrt = .TRUE., kiolib = jprstlib)
224         !
225         !                                   ! Output trajectory fields
226         CALL iom_rstput( it, it, inum, 'emp'   , emp    )
227         CALL iom_rstput( it, it, inum, 'emps'  , emps   )
228         CALL iom_rstput( it, it, inum, 'un'    , un     )
229         CALL iom_rstput( it, it, inum, 'vn'    , vn     )
230         CALL iom_rstput( it, it, inum, 'tn'    , tn     )
231         CALL iom_rstput( it, it, inum, 'sn'    , sn     )
232         CALL iom_rstput( it, it, inum, 'avmu'  , avmu   )
233         CALL iom_rstput( it, it, inum, 'avmv'  , avmv   )
234         CALL iom_rstput( it, it, inum, 'avt'   , avt    )
235#if defined key_ldfslp
236         CALL iom_rstput( it, it, inum, 'uslp'  , uslp   )
237         CALL iom_rstput( it, it, inum, 'vslp'  , vslp   )
238         CALL iom_rstput( it, it, inum, 'wslpi' , wslpi  )
239         CALL iom_rstput( it, it, inum, 'wslpj' , wslpj  )
240#endif
241#if defined key_zdfddm
242         CALL iom_rstput( it, it, inum, 'avs'   , avs    )
243#endif
244         CALL iom_rstput( it, it, inum, 'ta'    , ta     )
245         CALL iom_rstput( it, it, inum, 'sa'    , sa     )
246         CALL iom_rstput( it, it, inum, 'tb'    , tb     )
247         CALL iom_rstput( it, it, inum, 'sb'    , sb     )
248#if defined key_tradmp
249         CALL iom_rstput( it, it, inum, 'strdmp', strdmp )
250         CALL iom_rstput( it, it, inum, 'hmlp'  , hmlp   )
251#endif
252         CALL iom_rstput( it, it, inum, 'aeiu'  , aeiu   )
253         CALL iom_rstput( it, it, inum, 'aeiv'  , aeiv   )
254         CALL iom_rstput( it, it, inum, 'aeiw'  , aeiw   )
255         !
256         CALL iom_close( inum )
257      ENDIF
258      !
259   END SUBROUTINE asm_trj_wri
260
261   !!======================================================================
262END MODULE asmtrj
Note: See TracBrowser for help on using the repository browser.