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

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

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

Merge of 3.4beta into the trunk

  • Property svn:keywords set to Id
File size: 11.9 KB
RevLine 
[2128]1MODULE asmtrj
2   !!======================================================================
3   !!                       ***  MODULE asmtrj  ***
[2399]4   !! Assimilation trajectory interface: Write to file the background state and the model state trajectory
[2128]5   !!======================================================================
[2399]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   !!----------------------------------------------------------------------
[2128]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
[2399]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
[2128]42#if defined key_traldf_c2d
[2399]43   USE ldfeiv             ! eddy induced velocity coef.      (ldf_eiv routine)
[2128]44#endif
45
46   IMPLICIT NONE
47   PRIVATE
[2399]48   
49   PUBLIC   asm_bkg_wri   !: Write out the background state
50   PUBLIC   asm_trj_wri   !: Write out the background state
[2128]51
[2287]52   !!----------------------------------------------------------------------
53   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
54   !! $Id$
[2399]55   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
[2287]56   !!----------------------------------------------------------------------
[2128]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
[2399]72      !
[2128]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
[2399]78      !!-----------------------------------------------------------------------
[2128]79
[2399]80      !                                !-------------------------------------------
81      IF( kt == nitbkg_r ) THEN        ! Write out background at time step nitbkg_r
82         !                             !-----------------------------------========
83         !
[2128]84         WRITE(cl_asmbkg, FMT='(A,".nc")' ) TRIM( c_asmbkg )
85         cl_asmbkg = TRIM( cl_asmbkg )
86         INQUIRE( FILE = cl_asmbkg, EXIST = llok )
[2399]87         !
[2128]88         IF( .NOT. llok ) THEN
[2399]89            IF(lwp) WRITE(numout,*) ' Setting up assimilation background file '// TRIM( c_asmbkg )
90            !
91            !                                      ! Define the output file       
[2128]92            CALL iom_open( c_asmbkg, inum, ldwrt = .TRUE., kiolib = jprstlib)
[2399]93            !
94            IF( nitbkg_r == nit000 - 1 ) THEN      ! Treat special case when nitbkg = 0
[2128]95               zdate = REAL( ndastp )
96#if defined key_zdftke
[2399]97               ! lk_zdftke=T :   Read turbulent kinetic energy ( en )
[2128]98               IF(lwp) WRITE(numout,*) ' Reading TKE (en) from restart...'
[2399]99               CALL tke_rst( nit000, 'READ' )               ! lk_zdftke=T :   Read turbulent kinetic energy ( en )
100
[2128]101#endif
102            ELSE
103               zdate = REAL( ndastp )
104            ENDIF
[2399]105            !
106            !                                      ! Write the information
[3294]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              )
[2128]113#if defined key_zdftke
[3294]114            CALL iom_rstput( kt, nitbkg_r, inum, 'en'     , en                )
[2128]115#endif
[3294]116            CALL iom_rstput( kt, nitbkg_r, inum, 'gcx'    , gcx               )
[2399]117            !
[2128]118            CALL iom_close( inum )
119         ENDIF
[2399]120         !
[2128]121      ENDIF
122
[2399]123      !                                !-------------------------------------------
124      IF( kt == nitdin_r ) THEN        ! Write out background at time step nitdin_r
125         !                             !-----------------------------------========
126         !
[2128]127         WRITE(cl_asmdin, FMT='(A,".nc")' ) TRIM( c_asmdin )
128         cl_asmdin = TRIM( cl_asmdin )
129         INQUIRE( FILE = cl_asmdin, EXIST = llok )
[2399]130         !
[2128]131         IF( .NOT. llok ) THEN
[2399]132            IF(lwp) WRITE(numout,*) ' Setting up assimilation background file '// TRIM( c_asmdin )
133            !
134            !                                      ! Define the output file       
[2128]135            CALL iom_open( c_asmdin, inum, ldwrt = .TRUE., kiolib = jprstlib)
[2399]136            !
137            IF( nitdin_r == nit000 - 1 ) THEN      ! Treat special case when nitbkg = 0
[2128]138
139               zdate = REAL( ndastp )
140            ELSE
141               zdate = REAL( ndastp )
142            ENDIF
[2399]143            !
144            !                                      ! Write the information
[3294]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              )
[2399]151            !
[2128]152            CALL iom_close( inum )
153         ENDIF
[2399]154         !
[2128]155      ENDIF
[2399]156      !                   
[2128]157   END SUBROUTINE asm_bkg_wri
158
[2399]159
[2128]160   SUBROUTINE asm_trj_wri( kt )
161      !!-----------------------------------------------------------------------
162      !!                  ***  ROUTINE asm_trj_wri ***
163      !!
[2399]164      !! ** Purpose :   Write to file the model state trajectory for use with 4D-Var.
[2128]165      !!-----------------------------------------------------------------------
166      INTEGER, INTENT( IN ) :: kt             ! Current time-step
[2399]167      !
[2128]168      INTEGER :: inum                  ! File unit number
169      INTEGER :: it
170      CHARACTER (LEN=50) :: cl_asmtrj
171      REAL(wp) :: zdate            ! Date
[2399]172      !!-----------------------------------------------------------------------
[2128]173
174      !------------------------------------------------------------------------
175      ! Write a single file for each trajectory time step
176      !------------------------------------------------------------------------
[2399]177      IF( ( MOD( kt - nit000 + 1, nittrjfrq ) == 0 ) .OR. ( kt == nitend ) ) THEN
[2128]178         
[2399]179         IF( kt == nit000 - 1 ) THEN         ! Treat special case when kt = nit000-1
180            !
[2128]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...'
[2239]196            CALL bn2( tsb, rn2 ) 
[2128]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
[2399]204         ENDIF
205         !
[2128]206         it = kt - nit000 + 1
[2399]207         !
208         !                                   ! Define the output file       
[2128]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)
[2399]212         !
213         !                                   ! Output trajectory fields
[2128]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     )
[3294]218         CALL iom_rstput( it, it, inum, 'tn'    , tsn(:,:,:,jp_tem) )
219         CALL iom_rstput( it, it, inum, 'sn'    , tsn(:,:,:,jp_sal) )
[2128]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
[3294]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
[2128]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   )
[2399]243         !
[2128]244         CALL iom_close( inum )
245      ENDIF
[2399]246      !
[2128]247   END SUBROUTINE asm_trj_wri
248
[2399]249   !!======================================================================
[2128]250END MODULE asmtrj
Note: See TracBrowser for help on using the repository browser.