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

source: branches/UKMO/r5518_INGV1_WAVE-coupling/NEMOGCM/NEMO/OPA_SRC/ASM/asmbkg.F90 @ 7152

Last change on this file since 7152 was 7152, checked in by jcastill, 7 years ago

Initial implementation of wave coupling branch - INGV wave branch + UKMO wave coupling branch
File size: 8.0 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 in_out_manager     ! I/O manager
37   USE iom                ! I/O module
38   USE asmpar             ! Parameters for the assmilation interface
39   USE zdfmxl             ! mixed layer depth
40#if defined key_lim2
41   USE ice_2
42#endif
43#if defined key_lim3
44   USE ice
45#endif
46   IMPLICIT NONE
47   PRIVATE
48   
49   PUBLIC   asm_bkg_wri   !: Write out the background state
50
51   !!----------------------------------------------------------------------
52   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
53   !! $Id$
54   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
55   !!----------------------------------------------------------------------
56CONTAINS
57
58   SUBROUTINE asm_bkg_wri( kt )
59      !!-----------------------------------------------------------------------
60      !!                  ***  ROUTINE asm_bkg_wri ***
61      !!
62      !! ** Purpose : Write to file the background state for later use in the
63      !!              inner loop of data assimilation or for direct initialization
64      !!              in the outer loop.
65      !!
66      !! ** Method  : Write out the background state for use in the Jb term
67      !!              in the cost function and for use with direct initialization
68      !!              at analysis time.
69      !!-----------------------------------------------------------------------
70      INTEGER, INTENT( IN ) :: kt               ! Current time-step
71      !
72      CHARACTER (LEN=50) :: cl_asmbkg
73      CHARACTER (LEN=50) :: cl_asmdin
74      LOGICAL :: llok          ! Check if file exists
75      INTEGER :: inum          ! File unit number
76      REAL(wp) :: zdate        ! Date
77      !!-----------------------------------------------------------------------
78
79      !                                !-------------------------------------------
80      IF( kt == nitbkg_r ) THEN        ! Write out background at time step nitbkg_r
81         !                             !-----------------------------------========
82         !
83         WRITE(cl_asmbkg, FMT='(A,".nc")' ) TRIM( c_asmbkg )
84         cl_asmbkg = TRIM( cl_asmbkg )
85         INQUIRE( FILE = cl_asmbkg, EXIST = llok )
86         !
87         IF( .NOT. llok ) THEN
88            IF(lwp) WRITE(numout,*) ' Setting up assimilation background file '// TRIM( c_asmbkg )
89            !
90            !                                      ! Define the output file       
91            CALL iom_open( c_asmbkg, inum, ldwrt = .TRUE., kiolib = jprstlib)
92            !
93            IF( nitbkg_r == nit000 - 1 ) THEN      ! Treat special case when nitbkg = 0
94               zdate = REAL( ndastp )
95#if defined key_zdftke
96               ! lk_zdftke=T :   Read turbulent kinetic energy ( en )
97               IF(lwp) WRITE(numout,*) ' Reading TKE (en) from restart...'
98               CALL tke_rst( nit000, 'READ' )               ! lk_zdftke=T :   Read turbulent kinetic energy ( en )
99
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 defined key_zdftke
113            CALL iom_rstput( kt, nitbkg_r, inum, 'en'     , en                )
114#endif
115            !
116            CALL iom_close( inum )
117         ENDIF
118         !
119      ENDIF
120
121      !                                !-------------------------------------------
122      IF( kt == nitdin_r ) THEN        ! Write out background at time step nitdin_r
123         !                             !-----------------------------------========
124         !
125         WRITE(cl_asmdin, FMT='(A,".nc")' ) TRIM( c_asmdin )
126         cl_asmdin = TRIM( cl_asmdin )
127         INQUIRE( FILE = cl_asmdin, EXIST = llok )
128         !
129         IF( .NOT. llok ) THEN
130            IF(lwp) WRITE(numout,*) ' Setting up assimilation background file '// TRIM( c_asmdin )
131            !
132            !                                      ! Define the output file       
133            CALL iom_open( c_asmdin, inum, ldwrt = .TRUE., kiolib = jprstlib)
134            !
135            IF( nitdin_r == nit000 - 1 ) THEN      ! Treat special case when nitbkg = 0
136
137               zdate = REAL( ndastp )
138            ELSE
139               zdate = REAL( ndastp )
140            ENDIF
141            !
142            !                                      ! Write the information
143            CALL iom_rstput( kt, nitdin_r, inum, 'rdastp' , zdate             )
144            CALL iom_rstput( kt, nitdin_r, inum, 'un'     , un                )
145            CALL iom_rstput( kt, nitdin_r, inum, 'vn'     , vn                )
146            CALL iom_rstput( kt, nitdin_r, inum, 'tn'     , tsn(:,:,:,jp_tem) )
147            CALL iom_rstput( kt, nitdin_r, inum, 'sn'     , tsn(:,:,:,jp_sal) )
148            CALL iom_rstput( kt, nitdin_r, inum, 'sshn'   , sshn              )
149#if defined key_lim2 || defined key_lim3
150            IF( nn_ice == 2  .OR.  nn_ice == 3 ) THEN
151               IF( ALLOCATED(frld) ) THEN
152                  CALL iom_rstput( kt, nitdin_r, inum, 'iceconc', 1._wp - frld(:,:)   )
153               ELSE
154                  CALL ctl_warn('Ice concentration not written to background as ice variable frld not allocated on this timestep')
155               ENDIF
156            ENDIF
157#endif
158            !
159            CALL iom_close( inum )
160         ENDIF
161         !
162      ENDIF
163      !                   
164   END SUBROUTINE asm_bkg_wri
165
166   !!======================================================================
167END MODULE asmbkg
Note: See TracBrowser for help on using the repository browser.