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

source: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/ASM/asmbkg.F90 @ 5901

Last change on this file since 5901 was 5901, checked in by jamesharle, 8 years ago

merging branch with head of the trunk
  • Property svn:keywords set to Id
File size: 8.2 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#if defined key_zdftke
31   USE zdftke             ! TKE vertical physics
32#endif
33   USE eosbn2             ! Equation of state (eos_bn2 routine)
34   USE zdfmxl             ! Mixed layer depth
35   USE dom_oce, ONLY :   ndastp
36   USE sol_oce, ONLY :   gcx   ! Solver variables defined in memory
37   USE in_out_manager     ! I/O manager
38   USE iom                ! I/O module
39   USE asmpar             ! Parameters for the assmilation interface
40   USE zdfmxl             ! mixed layer depth
41#if defined key_lim2
42   USE ice_2
43#endif
44#if defined key_lim3
45   USE ice
46#endif
47   IMPLICIT NONE
48   PRIVATE
49   
50   PUBLIC   asm_bkg_wri   !: Write out the background state
51
52   !!----------------------------------------------------------------------
53   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
54   !! $Id$
55   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
56   !!----------------------------------------------------------------------
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
72      !
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
78      !!-----------------------------------------------------------------------
79
80      !                                !-------------------------------------------
81      IF( kt == nitbkg_r ) THEN        ! Write out background at time step nitbkg_r
82         !                             !-----------------------------------========
83         !
84         WRITE(cl_asmbkg, FMT='(A,".nc")' ) TRIM( c_asmbkg )
85         cl_asmbkg = TRIM( cl_asmbkg )
86         INQUIRE( FILE = cl_asmbkg, EXIST = llok )
87         !
88         IF( .NOT. llok ) THEN
89            IF(lwp) WRITE(numout,*) ' Setting up assimilation background file '// TRIM( c_asmbkg )
90            !
91            !                                      ! Define the output file       
92            CALL iom_open( c_asmbkg, inum, ldwrt = .TRUE., kiolib = jprstlib)
93            !
94            IF( nitbkg_r == nit000 - 1 ) THEN      ! Treat special case when nitbkg = 0
95               zdate = REAL( ndastp )
96#if defined key_zdftke
97               ! lk_zdftke=T :   Read turbulent kinetic energy ( en )
98               IF(lwp) WRITE(numout,*) ' Reading TKE (en) from restart...'
99               CALL tke_rst( nit000, 'READ' )               ! lk_zdftke=T :   Read turbulent kinetic energy ( en )
100
101#endif
102            ELSE
103               zdate = REAL( ndastp )
104            ENDIF
105            !
106            !                                      ! Write the information
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              )
113#if defined key_zdftke
114            CALL iom_rstput( kt, nitbkg_r, inum, 'en'     , en                )
115#endif
116            CALL iom_rstput( kt, nitbkg_r, inum, 'gcx'    , gcx               )
117            !
118            CALL iom_close( inum )
119         ENDIF
120         !
121      ENDIF
122
123      !                                !-------------------------------------------
124      IF( kt == nitdin_r ) THEN        ! Write out background at time step nitdin_r
125         !                             !-----------------------------------========
126         !
127         WRITE(cl_asmdin, FMT='(A,".nc")' ) TRIM( c_asmdin )
128         cl_asmdin = TRIM( cl_asmdin )
129         INQUIRE( FILE = cl_asmdin, EXIST = llok )
130         !
131         IF( .NOT. llok ) THEN
132            IF(lwp) WRITE(numout,*) ' Setting up assimilation background file '// TRIM( c_asmdin )
133            !
134            !                                      ! Define the output file       
135            CALL iom_open( c_asmdin, inum, ldwrt = .TRUE., kiolib = jprstlib)
136            !
137            IF( nitdin_r == nit000 - 1 ) THEN      ! Treat special case when nitbkg = 0
138
139               zdate = REAL( ndastp )
140            ELSE
141               zdate = REAL( ndastp )
142            ENDIF
143            !
144            !                                      ! Write the information
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              )
151#if defined key_lim2 || defined key_lim3
152            IF( nn_ice == 2  .OR.  nn_ice == 3 ) THEN
153               IF( ALLOCATED(frld) ) THEN
154                  CALL iom_rstput( kt, nitdin_r, inum, 'iceconc', 1._wp - frld(:,:)   )
155               ELSE
156                  CALL ctl_warn('Ice concentration not written to background as ice variable frld 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.