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 branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/ASM – NEMO

source: branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/ASM/asmbkg.F90 @ 10302

Last change on this file since 10302 was 10302, checked in by dford, 6 years ago

Merge in revisions 8447:10159 of dev_r5518_GO6_package.
File size: 8.9 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   !!   'key_asminc' : Switch on the assimilation increment interface
21   !!----------------------------------------------------------------------
22   !!   asm_bkg_wri  : Write out the background state
23   !!   asm_trj_wri  : Write out the model state trajectory (used with 4D-Var)
24   !!----------------------------------------------------------------------
25   USE oce                ! Dynamics and active tracers defined in memory
26   USE sbc_oce            ! Ocean surface boundary conditions
27   USE zdf_oce            ! Vertical mixing variables
28   USE zdfddm             ! Double diffusion mixing parameterization
29   USE ldftra_oce         ! Lateral tracer mixing coefficient defined in memory
30   USE ldfslp             ! Slopes of neutral surfaces
31   USE tradmp             ! Tracer damping
32#if defined key_zdftke
33   USE zdftke             ! TKE vertical physics
34#endif
35   USE eosbn2             ! Equation of state (eos_bn2 routine)
36   USE zdfmxl             ! Mixed layer depth
37   USE dom_oce, ONLY :   ndastp
38   USE sol_oce, ONLY :   gcx   ! Solver variables defined in memory
39   USE in_out_manager     ! I/O manager
40   USE iom                ! I/O module
41   USE asmpar             ! Parameters for the assmilation interface
42   USE zdfmxl             ! mixed layer depth
43#if defined key_traldf_c2d
44   USE ldfeiv             ! eddy induced velocity coef.      (ldf_eiv routine)
45#endif
46#if defined key_lim2
47   USE ice_2
48#endif
49#if defined key_lim3
50   USE ice
51#endif
52#if defined key_top
53   USE asmbgc, ONLY: asm_bgc_bkg_wri
54#endif
55   USE timing
56   IMPLICIT NONE
57   PRIVATE
58   
59   PUBLIC   asm_bkg_wri   !: Write out the background state
60
61   !!----------------------------------------------------------------------
62   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
63   !! $Id$
64   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
65   !!----------------------------------------------------------------------
66CONTAINS
67
68   SUBROUTINE asm_bkg_wri( kt )
69      !!-----------------------------------------------------------------------
70      !!                  ***  ROUTINE asm_bkg_wri ***
71      !!
72      !! ** Purpose : Write to file the background state for later use in the
73      !!              inner loop of data assimilation or for direct initialization
74      !!              in the outer loop.
75      !!
76      !! ** Method  : Write out the background state for use in the Jb term
77      !!              in the cost function and for use with direct initialization
78      !!              at analysis time.
79      !!-----------------------------------------------------------------------
80      INTEGER, INTENT( IN ) :: kt               ! Current time-step
81      !
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      !                                !-------------------------------------------
90      IF( kt == nitbkg_r ) THEN        ! Write out background at time step nitbkg_r
91         !                             !-----------------------------------========
92         !
93         WRITE(cl_asmbkg, FMT='(A,".nc")' ) TRIM( c_asmbkg )
94         cl_asmbkg = TRIM( cl_asmbkg )
95         INQUIRE( FILE = cl_asmbkg, EXIST = llok )
96         !
97         IF( .NOT. llok ) THEN
98            IF(lwp) WRITE(numout,*) ' Setting up assimilation background file '// TRIM( c_asmbkg )
99            !
100            !                                      ! Define the output file       
101            CALL iom_open( c_asmbkg, inum, ldwrt = .TRUE., kiolib = jprstlib)
102            !
103            IF( nitbkg_r == nit000 - 1 ) THEN      ! Treat special case when nitbkg = 0
104               zdate = REAL( ndastp )
105#if defined key_zdftke
106               ! lk_zdftke=T :   Read turbulent kinetic energy ( en )
107               IF(lwp) WRITE(numout,*) ' Reading TKE (en) from restart...'
108               CALL tke_rst( nit000, 'READ' )               ! lk_zdftke=T :   Read turbulent kinetic energy ( en )
109
110#endif
111            ELSE
112               zdate = REAL( ndastp )
113            ENDIF
114            !
115            !                                      ! Write the information
116            IF(nn_timing == 2)  CALL timing_start('iom_rstput')
117            CALL iom_rstput( kt, nitbkg_r, inum, 'rdastp' , zdate             )
118            CALL iom_rstput( kt, nitbkg_r, inum, 'un'     , un                )
119            CALL iom_rstput( kt, nitbkg_r, inum, 'vn'     , vn                )
120            CALL iom_rstput( kt, nitbkg_r, inum, 'tn'     , tsn(:,:,:,jp_tem) )
121            CALL iom_rstput( kt, nitbkg_r, inum, 'sn'     , tsn(:,:,:,jp_sal) )
122            CALL iom_rstput( kt, nitbkg_r, inum, 'sshn'   , sshn              )
123#if defined key_zdftke
124            CALL iom_rstput( kt, nitbkg_r, inum, 'en'     , en                )
125#endif
126!            CALL iom_rstput( kt, nitbkg_r, inum, 'gcx'    , gcx               )
127            CALL iom_rstput( kt, nitbkg_r, inum, 'avt'    , avt               )
128            IF(nn_timing == 2)  CALL timing_stop('iom_rstput')
129            !
130#if defined key_top
131            CALL asm_bgc_bkg_wri( kt, inum )
132            !
133#endif
134            CALL iom_close( inum )
135         ENDIF
136         !
137      ENDIF
138
139      !                                !-------------------------------------------
140      IF( kt == nitdin_r ) THEN        ! Write out background at time step nitdin_r
141         !                             !-----------------------------------========
142         !
143         WRITE(cl_asmdin, FMT='(A,".nc")' ) TRIM( c_asmdin )
144         cl_asmdin = TRIM( cl_asmdin )
145         INQUIRE( FILE = cl_asmdin, EXIST = llok )
146         !
147         IF( .NOT. llok ) THEN
148            IF(lwp) WRITE(numout,*) ' Setting up assimilation background file '// TRIM( c_asmdin )
149            !
150            !                                      ! Define the output file       
151            CALL iom_open( c_asmdin, inum, ldwrt = .TRUE., kiolib = jprstlib)
152            !
153            IF( nitdin_r == nit000 - 1 ) THEN      ! Treat special case when nitbkg = 0
154
155               zdate = REAL( ndastp )
156            ELSE
157               zdate = REAL( ndastp )
158            ENDIF
159            !
160            !                                      ! Write the information
161            IF(nn_timing == 2)  CALL timing_start('iom_rstput')
162            CALL iom_rstput( kt, nitdin_r, inum, 'rdastp' , zdate             )
163            CALL iom_rstput( kt, nitdin_r, inum, 'un'     , un                )
164            CALL iom_rstput( kt, nitdin_r, inum, 'vn'     , vn                )
165            CALL iom_rstput( kt, nitdin_r, inum, 'tn'     , tsn(:,:,:,jp_tem) )
166            CALL iom_rstput( kt, nitdin_r, inum, 'sn'     , tsn(:,:,:,jp_sal) )
167            CALL iom_rstput( kt, nitdin_r, inum, 'avt'    , avt     )
168            CALL iom_rstput( kt, nitdin_r, inum, 'sshn'   , sshn              )
169#if defined key_lim2 || defined key_lim3
170            IF(( nn_ice == 2 ) .OR. ( nn_ice == 3 )) THEN
171          IF(ALLOCATED(frld)) THEN
172                  CALL iom_rstput( kt, nitdin_r, inum, 'iceconc', 1.0 - frld(:,:)   )
173               ELSE
174        CALL ctl_warn('Ice concentration not written to background as ice variable frld not allocated on this timestep')
175          ENDIF
176            ENDIF
177#endif
178            IF(nn_timing == 2)  CALL timing_stop('iom_rstput')
179            !
180            CALL iom_close( inum )
181         ENDIF
182         !
183      ENDIF
184      !                   
185   END SUBROUTINE asm_bkg_wri
186
187   !!======================================================================
188END MODULE asmbkg
Note: See TracBrowser for help on using the repository browser.