Newer
Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
MODULE asmbkg
!!======================================================================
!! *** MODULE asmtrj -> asmbkg ***
!! Assimilation trajectory interface: Write to file the background state and the model state trajectory
!!======================================================================
!! History : ! 2007-03 (M. Martin) Met. Office version
!! ! 2007-04 (A. Weaver) asm_trj_wri, original code
!! ! 2007-03 (K. Mogensen) Adapt to NEMOVAR and use IOM instead of IOIPSL
!! ! 2007-04 (A. Weaver) Name change (formally asmbkg.F90). Distinguish
!! background states in Jb term and at analysis time.
!! Include state trajectory routine (currently empty)
!! ! 2007-07 (A. Weaver) Add tke_rst and flt_rst for case nitbkg=0
!! ! 2009-03 (F. Vigilant) Add hmlp (zdfmxl) for no tracer nmldp=2
!! ! 2009-06 (F. Vigilant) asm_trj_wri: special case when kt=nit000-1
!! ! 2009-07 (F. Vigilant) asm_trj_wri: add computation of eiv at restart
!! ! 2010-01 (A. Vidard) split asm_trj_wri into tam_trj_wri and asm_bkg_wri
!!----------------------------------------------------------------------
!!----------------------------------------------------------------------
!! asm_bkg_wri : Write out the background state
!! asm_trj_wri : Write out the model state trajectory (used with 4D-Var)
!!----------------------------------------------------------------------
USE oce ! Dynamics and active tracers defined in memory
USE sbc_oce ! Ocean surface boundary conditions
USE zdf_oce ! Vertical mixing variables
USE zdfddm ! Double diffusion mixing parameterization
USE ldftra ! Lateral diffusion: eddy diffusivity coefficients
USE ldfslp ! Lateral diffusion: slopes of neutral surfaces
USE tradmp ! Tracer damping
USE zdftke ! TKE vertical physics
USE eosbn2 ! Equation of state (eos_bn2 routine)
USE zdfmxl ! Mixed layer depth
USE dom_oce , ONLY : ndastp, l_istiled
USE in_out_manager ! I/O manager
USE iom ! I/O module
USE asmpar ! Parameters for the assmilation interface
USE zdfmxl ! mixed layer depth
#if defined key_si3
USE ice
#endif
IMPLICIT NONE
PRIVATE
PUBLIC asm_bkg_wri !: Write out the background state
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
!! $Id: asmbkg.F90 15417 2021-10-20 14:16:29Z lovato $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
SUBROUTINE asm_bkg_wri( kt, Kmm )
!!-----------------------------------------------------------------------
!! *** ROUTINE asm_bkg_wri ***
!!
!! ** Purpose : Write to file the background state for later use in the
!! inner loop of data assimilation or for direct initialization
!! in the outer loop.
!!
!! ** Method : Write out the background state for use in the Jb term
!! in the cost function and for use with direct initialization
!! at analysis time.
!!-----------------------------------------------------------------------
INTEGER, INTENT( IN ) :: kt ! Current time-step
INTEGER, INTENT( IN ) :: Kmm ! time level index
!
CHARACTER (LEN=50) :: cl_asmbkg
CHARACTER (LEN=50) :: cl_asmdin
LOGICAL :: llok ! Check if file exists
INTEGER :: inum ! File unit number
REAL(wp) :: zdate ! Date
!!-----------------------------------------------------------------------
IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN ! Do only on the last tile
! !-------------------------------------------
IF( kt == nitbkg_r ) THEN ! Write out background at time step nitbkg_r
! !-----------------------------------========
!
WRITE(cl_asmbkg, FMT='(A,".nc")' ) TRIM( c_asmbkg )
cl_asmbkg = TRIM( cl_asmbkg )
INQUIRE( FILE = cl_asmbkg, EXIST = llok )
!
IF( .NOT. llok ) THEN
IF(lwp) WRITE(numout,*) ' Setting up assimilation background file '// TRIM( c_asmbkg )
!
! ! Define the output file
CALL iom_open( c_asmbkg, inum, ldwrt = .TRUE. )
!
IF( nitbkg_r == nit000 - 1 ) THEN ! Treat special case when nitbkg = 0
zdate = REAL( ndastp )
IF( ln_zdftke ) THEN ! read turbulent kinetic energy ( en )
IF(lwp) WRITE(numout,*) ' Reading TKE (en) from restart...'
CALL tke_rst( nit000, 'READ' )
ENDIF
ELSE
zdate = REAL( ndastp )
ENDIF
!
! ! Write the information
CALL iom_rstput( kt, nitbkg_r, inum, 'rdastp' , zdate )
CALL iom_rstput( kt, nitbkg_r, inum, 'un' , uu(:,:,:,Kmm) )
CALL iom_rstput( kt, nitbkg_r, inum, 'vn' , vv(:,:,:,Kmm) )
CALL iom_rstput( kt, nitbkg_r, inum, 'tn' , ts(:,:,:,jp_tem,Kmm) )
CALL iom_rstput( kt, nitbkg_r, inum, 'sn' , ts(:,:,:,jp_sal,Kmm) )
CALL iom_rstput( kt, nitbkg_r, inum, 'sshn' , ssh(:,:,Kmm) )
IF( ln_zdftke ) CALL iom_rstput( kt, nitbkg_r, inum, 'en' , en )
!
CALL iom_close( inum )
ENDIF
!
ENDIF
! !-------------------------------------------
IF( kt == nitdin_r ) THEN ! Write out background at time step nitdin_r
! !-----------------------------------========
!
WRITE(cl_asmdin, FMT='(A,".nc")' ) TRIM( c_asmdin )
cl_asmdin = TRIM( cl_asmdin )
INQUIRE( FILE = cl_asmdin, EXIST = llok )
!
IF( .NOT. llok ) THEN
IF(lwp) WRITE(numout,*) ' Setting up assimilation background file '// TRIM( c_asmdin )
!
! ! Define the output file
CALL iom_open( c_asmdin, inum, ldwrt = .TRUE. )
!
IF( nitdin_r == nit000 - 1 ) THEN ! Treat special case when nitbkg = 0
zdate = REAL( ndastp )
ELSE
zdate = REAL( ndastp )
ENDIF
!
! ! Write the information
CALL iom_rstput( kt, nitdin_r, inum, 'rdastp' , zdate )
CALL iom_rstput( kt, nitdin_r, inum, 'un' , uu(:,:,:,Kmm) )
CALL iom_rstput( kt, nitdin_r, inum, 'vn' , vv(:,:,:,Kmm) )
CALL iom_rstput( kt, nitdin_r, inum, 'tn' , ts(:,:,:,jp_tem,Kmm) )
CALL iom_rstput( kt, nitdin_r, inum, 'sn' , ts(:,:,:,jp_sal,Kmm) )
CALL iom_rstput( kt, nitdin_r, inum, 'sshn' , ssh(:,:,Kmm) )
#if defined key_si3
IF( nn_ice == 2 ) THEN
IF( ALLOCATED(at_i) ) THEN
CALL iom_rstput( kt, nitdin_r, inum, 'iceconc', at_i(:,:) )
ELSE
CALL ctl_warn('asm_bkg_wri: Ice concentration not written to background ', &
& 'as ice variable at_i not allocated on this timestep')
ENDIF
ENDIF
#endif
!
CALL iom_close( inum )
ENDIF
!
ENDIF
ENDIF ! check for last tile
!
END SUBROUTINE asm_bkg_wri
!!======================================================================
END MODULE asmbkg