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.
asmbkg.F90 in NEMO/branches/UKMO/NEMO_4.0_mirror_text_diagnostics/src/OCE/ASM – NEMO

source: NEMO/branches/UKMO/NEMO_4.0_mirror_text_diagnostics/src/OCE/ASM/asmbkg.F90 @ 10986

Last change on this file since 10986 was 10986, checked in by andmirek, 5 years ago

GMED 462 add flush
File size: 8.1 KB
Line 
1MODULE asmbkg
2   !!======================================================================
3   !!                       ***  MODULE asmtrj -> asmbkg  ***
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   !!                 ! 2010-01 (A. Vidard) split asm_trj_wri into tam_trj_wri and asm_bkg_wri
17   !!----------------------------------------------------------------------
18
19   !!----------------------------------------------------------------------
20   !!   asm_bkg_wri  : Write out the background state
21   !!   asm_trj_wri  : Write out the model state trajectory (used with 4D-Var)
22   !!----------------------------------------------------------------------
23   USE oce                ! Dynamics and active tracers defined in memory
24   USE sbc_oce            ! Ocean surface boundary conditions
25   USE zdf_oce            ! Vertical mixing variables
26   USE zdfddm             ! Double diffusion mixing parameterization
27   USE ldftra             ! Lateral diffusion: eddy diffusivity coefficients
28   USE ldfslp             ! Lateral diffusion: slopes of neutral surfaces
29   USE tradmp             ! Tracer damping
30   USE zdftke             ! TKE vertical physics
31   USE eosbn2             ! Equation of state (eos_bn2 routine)
32   USE zdfmxl             ! Mixed layer depth
33   USE dom_oce     , ONLY :   ndastp
34   USE in_out_manager     ! I/O manager
35   USE iom                ! I/O module
36   USE asmpar             ! Parameters for the assmilation interface
37   USE zdfmxl             ! mixed layer depth
38#if defined key_si3
39   USE ice
40#endif
41
42   IMPLICIT NONE
43   PRIVATE
44   
45   PUBLIC   asm_bkg_wri   !: Write out the background state
46
47   !!----------------------------------------------------------------------
48   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
49   !! $Id$
50   !! Software governed by the CeCILL license (see ./LICENSE)
51   !!----------------------------------------------------------------------
52CONTAINS
53
54   SUBROUTINE asm_bkg_wri( kt )
55      !!-----------------------------------------------------------------------
56      !!                  ***  ROUTINE asm_bkg_wri ***
57      !!
58      !! ** Purpose : Write to file the background state for later use in the
59      !!              inner loop of data assimilation or for direct initialization
60      !!              in the outer loop.
61      !!
62      !! ** Method  : Write out the background state for use in the Jb term
63      !!              in the cost function and for use with direct initialization
64      !!              at analysis time.
65      !!-----------------------------------------------------------------------
66      INTEGER, INTENT( IN ) :: kt               ! Current time-step
67      !
68      CHARACTER (LEN=50) :: cl_asmbkg
69      CHARACTER (LEN=50) :: cl_asmdin
70      LOGICAL :: llok          ! Check if file exists
71      INTEGER :: inum          ! File unit number
72      REAL(wp) :: zdate        ! Date
73      !!-----------------------------------------------------------------------
74
75      !                                !-------------------------------------------
76      IF( kt == nitbkg_r ) THEN        ! Write out background at time step nitbkg_r
77         !                             !-----------------------------------========
78         !
79         WRITE(cl_asmbkg, FMT='(A,".nc")' ) TRIM( c_asmbkg )
80         cl_asmbkg = TRIM( cl_asmbkg )
81         INQUIRE( FILE = cl_asmbkg, EXIST = llok )
82         !
83         IF( .NOT. llok ) THEN
84            IF(lwp) THEN
85               WRITE(numout,*) ' Setting up assimilation background file '// TRIM( c_asmbkg )
86               IF(lflush) CALL FLUSH(numout)
87            ENDIF
88            !
89            !                                      ! Define the output file       
90            CALL iom_open( c_asmbkg, inum, ldwrt = .TRUE. )
91            !
92            IF( nitbkg_r == nit000 - 1 ) THEN      ! Treat special case when nitbkg = 0
93               zdate = REAL( ndastp )
94               IF( ln_zdftke ) THEN                   ! read turbulent kinetic energy ( en )
95                  IF(lwp) THEN
96                     WRITE(numout,*) ' Reading TKE (en) from restart...'
97                     IF(lflush) CALL FLUSH(numout)
98                  ENDIF
99                  CALL tke_rst( nit000, 'READ' )
100               ENDIF
101            ELSE
102               zdate = REAL( ndastp )
103            ENDIF
104            !
105            !                                      ! Write the information
106            CALL iom_rstput( kt, nitbkg_r, inum, 'rdastp' , zdate             )
107            CALL iom_rstput( kt, nitbkg_r, inum, 'un'     , un                )
108            CALL iom_rstput( kt, nitbkg_r, inum, 'vn'     , vn                )
109            CALL iom_rstput( kt, nitbkg_r, inum, 'tn'     , tsn(:,:,:,jp_tem) )
110            CALL iom_rstput( kt, nitbkg_r, inum, 'sn'     , tsn(:,:,:,jp_sal) )
111            CALL iom_rstput( kt, nitbkg_r, inum, 'sshn'   , sshn              )
112            IF( ln_zdftke )   CALL iom_rstput( kt, nitbkg_r, inum, 'en'     , en                )
113            !
114            CALL iom_close( inum )
115         ENDIF
116         !
117      ENDIF
118
119      !                                !-------------------------------------------
120      IF( kt == nitdin_r ) THEN        ! Write out background at time step nitdin_r
121         !                             !-----------------------------------========
122         !
123         WRITE(cl_asmdin, FMT='(A,".nc")' ) TRIM( c_asmdin )
124         cl_asmdin = TRIM( cl_asmdin )
125         INQUIRE( FILE = cl_asmdin, EXIST = llok )
126         !
127         IF( .NOT. llok ) THEN
128            IF(lwp) THEN
129               WRITE(numout,*) ' Setting up assimilation background file '// TRIM( c_asmdin )
130               IF(lflush) CALL FLUSH(numout)
131            ENDIF
132            !
133            !                                      ! Define the output file       
134            CALL iom_open( c_asmdin, inum, ldwrt = .TRUE. )
135            !
136            IF( nitdin_r == nit000 - 1 ) THEN      ! Treat special case when nitbkg = 0
137
138               zdate = REAL( ndastp )
139            ELSE
140               zdate = REAL( ndastp )
141            ENDIF
142            !
143            !                                      ! Write the information
144            CALL iom_rstput( kt, nitdin_r, inum, 'rdastp' , zdate             )
145            CALL iom_rstput( kt, nitdin_r, inum, 'un'     , un                )
146            CALL iom_rstput( kt, nitdin_r, inum, 'vn'     , vn                )
147            CALL iom_rstput( kt, nitdin_r, inum, 'tn'     , tsn(:,:,:,jp_tem) )
148            CALL iom_rstput( kt, nitdin_r, inum, 'sn'     , tsn(:,:,:,jp_sal) )
149            CALL iom_rstput( kt, nitdin_r, inum, 'sshn'   , sshn              )
150#if defined key_si3
151            IF( nn_ice == 2 ) THEN
152               IF( ALLOCATED(at_i) ) THEN
153                  CALL iom_rstput( kt, nitdin_r, inum, 'iceconc', at_i(:,:)   )
154               ELSE
155                  CALL ctl_warn('asm_bkg_wri: Ice concentration not written to background ',   &
156                     &          'as ice variable at_i not allocated on this timestep')
157               ENDIF
158            ENDIF
159#endif
160            !
161            CALL iom_close( inum )
162         ENDIF
163         !
164      ENDIF
165      !                   
166   END SUBROUTINE asm_bkg_wri
167
168   !!======================================================================
169END MODULE asmbkg
Note: See TracBrowser for help on using the repository browser.