source: branches/UKMO/dev_r5518_GO6_package_FOAMv14_phytobal3d/NEMOGCM/NEMO/OPA_SRC/ASM/asmbkg.F90 @ 13045

Last change on this file since 13045 was 13045, checked in by dford, 5 months ago

Merge in latest version of GO6 FOAM package branch.

File size: 9.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   !!   '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 iom_def, ONLY : jp_r4   ! iom variables definitions   
42   USE asmpar             ! Parameters for the assmilation interface
43   USE zdfmxl             ! mixed layer depth
44#if defined key_traldf_c2d
45   USE ldfeiv             ! eddy induced velocity coef.      (ldf_eiv routine)
46#endif
47#if defined key_lim2
48   USE ice_2
49#endif
50#if defined key_lim3
51   USE ice
52#endif
53#if defined key_top
54   USE asmbgc, ONLY: asm_bgc_bkg_wri
55#endif
56   USE timing
57   IMPLICIT NONE
58   PRIVATE
59   
60   PUBLIC   asm_bkg_wri   !: Write out the background state
61
62   !!----------------------------------------------------------------------
63   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
64   !! $Id$
65   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
66   !!----------------------------------------------------------------------
67CONTAINS
68
69   SUBROUTINE asm_bkg_wri( kt )
70      !!-----------------------------------------------------------------------
71      !!                  ***  ROUTINE asm_bkg_wri ***
72      !!
73      !! ** Purpose : Write to file the background state for later use in the
74      !!              inner loop of data assimilation or for direct initialization
75      !!              in the outer loop.
76      !!
77      !! ** Method  : Write out the background state for use in the Jb term
78      !!              in the cost function and for use with direct initialization
79      !!              at analysis time.
80      !!-----------------------------------------------------------------------
81      INTEGER, INTENT( IN ) :: kt               ! Current time-step
82      !
83      CHARACTER (LEN=50) :: cl_asmbkg
84      CHARACTER (LEN=50) :: cl_asmdin
85      LOGICAL :: llok          ! Check if file exists
86      INTEGER :: inum          ! File unit number
87      REAL(wp) :: zdate        ! Date
88      !!-----------------------------------------------------------------------
89
90      !                                !-------------------------------------------
91      IF( kt == nitbkg_r ) THEN        ! Write out background at time step nitbkg_r
92         !                             !-----------------------------------========
93         !
94         WRITE(cl_asmbkg, FMT='(A,".nc")' ) TRIM( c_asmbkg )
95         cl_asmbkg = TRIM( cl_asmbkg )
96         INQUIRE( FILE = cl_asmbkg, EXIST = llok )
97         !
98         IF( .NOT. llok ) THEN
99            IF(lwp) WRITE(numout,*) ' Setting up assimilation background file '// TRIM( c_asmbkg )
100            !
101            !                                      ! Define the output file       
102            CALL iom_open( c_asmbkg, inum, ldwrt = .TRUE., kiolib = jprstlib)
103            !
104            IF( nitbkg_r == nit000 - 1 ) THEN      ! Treat special case when nitbkg = 0
105               zdate = REAL( ndastp )
106#if defined key_zdftke
107               ! lk_zdftke=T :   Read turbulent kinetic energy ( en )
108               IF(lwp) WRITE(numout,*) ' Reading TKE (en) from restart...'
109               CALL tke_rst( nit000, 'READ' )               ! lk_zdftke=T :   Read turbulent kinetic energy ( en )
110
111#endif
112            ELSE
113               zdate = REAL( ndastp )
114            ENDIF
115            !
116            !                                      ! Write the information
117            IF(nn_timing == 2)  CALL timing_start('iom_rstput')
118            CALL iom_rstput( kt, nitbkg_r, inum, 'rdastp' , zdate             )
119            CALL iom_rstput( kt, nitbkg_r, inum, 'un'     , un               , ktype = jp_r4 )
120            CALL iom_rstput( kt, nitbkg_r, inum, 'vn'     , vn               , ktype = jp_r4 )
121            CALL iom_rstput( kt, nitbkg_r, inum, 'tn'     , tsn(:,:,:,jp_tem), ktype = jp_r4 )
122            CALL iom_rstput( kt, nitbkg_r, inum, 'sn'     , tsn(:,:,:,jp_sal), ktype = jp_r4 )
123            CALL iom_rstput( kt, nitbkg_r, inum, 'sshn'   , sshn             , ktype = jp_r4 )
124#if defined key_zdftke
125            CALL iom_rstput( kt, nitbkg_r, inum, 'en'     , en               , ktype = jp_r4 )
126#endif
127!            CALL iom_rstput( kt, nitbkg_r, inum, 'gcx'    , gcx               )
128            CALL iom_rstput( kt, nitbkg_r, inum, 'avt'    , avt              , ktype = jp_r4 )
129            IF(nn_timing == 2)  CALL timing_stop('iom_rstput')
130            !
131#if defined key_top
132            CALL asm_bgc_bkg_wri( kt, inum )
133            !
134#endif
135            CALL iom_close( inum )
136         ENDIF
137         !
138      ENDIF
139
140      !                                !-------------------------------------------
141      IF( kt == nitdin_r ) THEN        ! Write out background at time step nitdin_r
142         !                             !-----------------------------------========
143         !
144         WRITE(cl_asmdin, FMT='(A,".nc")' ) TRIM( c_asmdin )
145         cl_asmdin = TRIM( cl_asmdin )
146         INQUIRE( FILE = cl_asmdin, EXIST = llok )
147         !
148         IF( .NOT. llok ) THEN
149            IF(lwp) WRITE(numout,*) ' Setting up assimilation background file '// TRIM( c_asmdin )
150            !
151            !                                      ! Define the output file       
152            CALL iom_open( c_asmdin, inum, ldwrt = .TRUE., kiolib = jprstlib)
153            !
154            IF( nitdin_r == nit000 - 1 ) THEN      ! Treat special case when nitbkg = 0
155
156               zdate = REAL( ndastp )
157            ELSE
158               zdate = REAL( ndastp )
159            ENDIF
160            !
161            !                                      ! Write the information
162            IF(nn_timing == 2)  CALL timing_start('iom_rstput')
163            CALL iom_rstput( kt, nitdin_r, inum, 'rdastp' , zdate             )
164            CALL iom_rstput( kt, nitdin_r, inum, 'un'     , un                )
165            CALL iom_rstput( kt, nitdin_r, inum, 'vn'     , vn                )
166            CALL iom_rstput( kt, nitdin_r, inum, 'tn'     , tsn(:,:,:,jp_tem) )
167            CALL iom_rstput( kt, nitdin_r, inum, 'sn'     , tsn(:,:,:,jp_sal) )
168            CALL iom_rstput( kt, nitdin_r, inum, 'avt'    , avt     )
169            CALL iom_rstput( kt, nitdin_r, inum, 'sshn'   , sshn              )
170#if defined key_lim2 || defined key_lim3
171            IF(( nn_ice == 2 ) .OR. ( nn_ice == 3 )) THEN
172          IF(ALLOCATED(frld)) THEN
173                  CALL iom_rstput( kt, nitdin_r, inum, 'iceconc', 1.0 - frld(:,:)   )
174               ELSE
175        CALL ctl_warn('Ice concentration not written to background as ice variable frld not allocated on this timestep')
176          ENDIF
177            ENDIF
178#endif
179            IF(nn_timing == 2)  CALL timing_stop('iom_rstput')
180            !
181            CALL iom_close( inum )
182         ENDIF
183         !
184      ENDIF
185      !                   
186   END SUBROUTINE asm_bkg_wri
187
188   !!======================================================================
189END MODULE asmbkg
Note: See TracBrowser for help on using the repository browser.