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/trunk/src/OCE/ASM – NEMO

source: NEMO/trunk/src/OCE/ASM/asmbkg.F90

Last change on this file was 15417, checked in by lovato, 2 years ago

fix error introduced in the previous commit in src/OCE/ASM/asmbkg.F90
  • Property svn:keywords set to Id
File size: 8.4 KB
RevLine 
[3764]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
[5836]27   USE ldftra             ! Lateral diffusion: eddy diffusivity coefficients
28   USE ldfslp             ! Lateral diffusion: slopes of neutral surfaces
[3764]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
[15417]33   USE dom_oce     , ONLY : ndastp, l_istiled
[3764]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
[9570]38#if defined key_si3
[3764]39   USE ice
40#endif
[6140]41
[3764]42   IMPLICIT NONE
43   PRIVATE
44   
45   PUBLIC   asm_bkg_wri   !: Write out the background state
46
47   !!----------------------------------------------------------------------
[9598]48   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
[5215]49   !! $Id$
[10068]50   !! Software governed by the CeCILL license (see ./LICENSE)
[3764]51   !!----------------------------------------------------------------------
52CONTAINS
53
[12377]54   SUBROUTINE asm_bkg_wri( kt, Kmm )
[3764]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
[12377]67      INTEGER, INTENT( IN ) :: Kmm              ! time level index
[3764]68      !
69      CHARACTER (LEN=50) :: cl_asmbkg
70      CHARACTER (LEN=50) :: cl_asmdin
71      LOGICAL :: llok          ! Check if file exists
72      INTEGER :: inum          ! File unit number
73      REAL(wp) :: zdate        ! Date
74      !!-----------------------------------------------------------------------
75
76
[15398]77      IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN                       ! Do only on the last tile
78          !                                !-------------------------------------------
79          IF( kt == nitbkg_r ) THEN        ! Write out background at time step nitbkg_r
80             !                             !-----------------------------------========
81             !
82             WRITE(cl_asmbkg, FMT='(A,".nc")' ) TRIM( c_asmbkg )
83             cl_asmbkg = TRIM( cl_asmbkg )
84             INQUIRE( FILE = cl_asmbkg, EXIST = llok )
85             !
86             IF( .NOT. llok ) THEN
87                IF(lwp) WRITE(numout,*) ' Setting up assimilation background file '// TRIM( c_asmbkg )
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) WRITE(numout,*) ' Reading TKE (en) from restart...'
96                      CALL tke_rst( nit000, 'READ' )
97                   ENDIF
98                ELSE
99                   zdate = REAL( ndastp )
100                ENDIF
101                !
102                !                                      ! Write the information
103                CALL iom_rstput( kt, nitbkg_r, inum, 'rdastp' , zdate                )
104                CALL iom_rstput( kt, nitbkg_r, inum, 'un'     , uu(:,:,:,Kmm)        )
105                CALL iom_rstput( kt, nitbkg_r, inum, 'vn'     , vv(:,:,:,Kmm)        )
106                CALL iom_rstput( kt, nitbkg_r, inum, 'tn'     , ts(:,:,:,jp_tem,Kmm) )
107                CALL iom_rstput( kt, nitbkg_r, inum, 'sn'     , ts(:,:,:,jp_sal,Kmm) )
108                CALL iom_rstput( kt, nitbkg_r, inum, 'sshn'   , ssh(:,:,Kmm)         )
109                IF( ln_zdftke )   CALL iom_rstput( kt, nitbkg_r, inum, 'en'     , en )
110                !
111                CALL iom_close( inum )
112             ENDIF
113             !
114          ENDIF
115   
116          !                                !-------------------------------------------
117          IF( kt == nitdin_r ) THEN        ! Write out background at time step nitdin_r
118             !                             !-----------------------------------========
119             !
120             WRITE(cl_asmdin, FMT='(A,".nc")' ) TRIM( c_asmdin )
121             cl_asmdin = TRIM( cl_asmdin )
122             INQUIRE( FILE = cl_asmdin, EXIST = llok )
123             !
124             IF( .NOT. llok ) THEN
125                IF(lwp) WRITE(numout,*) ' Setting up assimilation background file '// TRIM( c_asmdin )
126                !
127                !                                      ! Define the output file       
128                CALL iom_open( c_asmdin, inum, ldwrt = .TRUE. )
129                !
130                IF( nitdin_r == nit000 - 1 ) THEN      ! Treat special case when nitbkg = 0
131   
132                   zdate = REAL( ndastp )
133                ELSE
134                   zdate = REAL( ndastp )
135                ENDIF
136                !
137                !                                      ! Write the information
138                CALL iom_rstput( kt, nitdin_r, inum, 'rdastp' , zdate                )
139                CALL iom_rstput( kt, nitdin_r, inum, 'un'     , uu(:,:,:,Kmm)        )
140                CALL iom_rstput( kt, nitdin_r, inum, 'vn'     , vv(:,:,:,Kmm)        )
141                CALL iom_rstput( kt, nitdin_r, inum, 'tn'     , ts(:,:,:,jp_tem,Kmm) )
142                CALL iom_rstput( kt, nitdin_r, inum, 'sn'     , ts(:,:,:,jp_sal,Kmm) )
143                CALL iom_rstput( kt, nitdin_r, inum, 'sshn'   , ssh(:,:,Kmm)         )
[15417]144#if defined key_si3
[15398]145                IF( nn_ice == 2 ) THEN
146                  IF( ALLOCATED(at_i) ) THEN
147                      CALL iom_rstput( kt, nitdin_r, inum, 'iceconc', at_i(:,:)   )
148                   ELSE
149                     CALL ctl_warn('asm_bkg_wri: Ice concentration not written to background ',   &
150                        &          'as ice variable at_i not allocated on this timestep')
151                  ENDIF
152                ENDIF
[15417]153#endif
[15398]154                !
155                CALL iom_close( inum )
156             ENDIF
157             !
158          ENDIF
159      ENDIF ! check for last tile
[3764]160      !                   
161   END SUBROUTINE asm_bkg_wri
162
163   !!======================================================================
164END MODULE asmbkg
Note: See TracBrowser for help on using the repository browser.