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

source: branches/UKMO/dev_r5518_GO6_package_asm_surf_bgc_v2/NEMOGCM/NEMO/OPA_SRC/ASM/asmbkg.F90 @ 8495

Last change on this file since 8495 was 8495, checked in by dford, 7 years ago

Merge in changes from dev_r5518_GO6_package_asm_surf_bgc, and adapt to the updated MEDUSA structure.

File size: 11.7 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   !!   '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 asmpar             ! Parameters for the assmilation interface
42   USE zdfmxl             ! mixed layer depth
43#if defined key_traldf_c2d
44   USE ldfeiv             ! eddy induced velocity coef.      (ldf_eiv routine)
45#endif
46#if defined key_lim2
47   USE ice_2
48#endif
49#if defined key_lim3
50   USE ice
51#endif
[8495]52#if defined key_hadocc
53   USE trc, ONLY: trn, &
54      &     pgrow_avg, &
55      &     ploss_avg, &
56      &     phyt_avg,  &
57      &     mld_max,   &
58      &     HADOCC_CHL
59   USE had_bgc_const, ONLY: cchl_p
60   USE par_hadocc
61#elif defined key_medusa && defined key_foam_medusa
62   USE trc, ONLY: trn
63   USE sms_medusa, ONLY: pgrow_avg, &
64      &                  ploss_avg, &
65      &                  phyt_avg,  &
66      &                  mld_max
67   USE par_medusa
68#endif
[3764]69   IMPLICIT NONE
70   PRIVATE
71   
72   PUBLIC   asm_bkg_wri   !: Write out the background state
73
74   !!----------------------------------------------------------------------
75   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
[5215]76   !! $Id$
[3764]77   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
78   !!----------------------------------------------------------------------
79CONTAINS
80
81   SUBROUTINE asm_bkg_wri( kt )
82      !!-----------------------------------------------------------------------
83      !!                  ***  ROUTINE asm_bkg_wri ***
84      !!
85      !! ** Purpose : Write to file the background state for later use in the
86      !!              inner loop of data assimilation or for direct initialization
87      !!              in the outer loop.
88      !!
89      !! ** Method  : Write out the background state for use in the Jb term
90      !!              in the cost function and for use with direct initialization
91      !!              at analysis time.
92      !!-----------------------------------------------------------------------
93      INTEGER, INTENT( IN ) :: kt               ! Current time-step
94      !
95      CHARACTER (LEN=50) :: cl_asmbkg
96      CHARACTER (LEN=50) :: cl_asmdin
97      LOGICAL :: llok          ! Check if file exists
98      INTEGER :: inum          ! File unit number
99      REAL(wp) :: zdate        ! Date
100      !!-----------------------------------------------------------------------
101
102      !                                !-------------------------------------------
103      IF( kt == nitbkg_r ) THEN        ! Write out background at time step nitbkg_r
104         !                             !-----------------------------------========
105         !
106         WRITE(cl_asmbkg, FMT='(A,".nc")' ) TRIM( c_asmbkg )
107         cl_asmbkg = TRIM( cl_asmbkg )
108         INQUIRE( FILE = cl_asmbkg, EXIST = llok )
109         !
110         IF( .NOT. llok ) THEN
111            IF(lwp) WRITE(numout,*) ' Setting up assimilation background file '// TRIM( c_asmbkg )
112            !
113            !                                      ! Define the output file       
114            CALL iom_open( c_asmbkg, inum, ldwrt = .TRUE., kiolib = jprstlib)
115            !
116            IF( nitbkg_r == nit000 - 1 ) THEN      ! Treat special case when nitbkg = 0
117               zdate = REAL( ndastp )
118#if defined key_zdftke
119               ! lk_zdftke=T :   Read turbulent kinetic energy ( en )
120               IF(lwp) WRITE(numout,*) ' Reading TKE (en) from restart...'
121               CALL tke_rst( nit000, 'READ' )               ! lk_zdftke=T :   Read turbulent kinetic energy ( en )
122
123#endif
124            ELSE
125               zdate = REAL( ndastp )
126            ENDIF
127            !
128            !                                      ! Write the information
129            CALL iom_rstput( kt, nitbkg_r, inum, 'rdastp' , zdate             )
130            CALL iom_rstput( kt, nitbkg_r, inum, 'un'     , un                )
131            CALL iom_rstput( kt, nitbkg_r, inum, 'vn'     , vn                )
132            CALL iom_rstput( kt, nitbkg_r, inum, 'tn'     , tsn(:,:,:,jp_tem) )
133            CALL iom_rstput( kt, nitbkg_r, inum, 'sn'     , tsn(:,:,:,jp_sal) )
134            CALL iom_rstput( kt, nitbkg_r, inum, 'sshn'   , sshn              )
135#if defined key_zdftke
136            CALL iom_rstput( kt, nitbkg_r, inum, 'en'     , en                )
137#endif
[8400]138!            CALL iom_rstput( kt, nitbkg_r, inum, 'gcx'    , gcx               )
139            CALL iom_rstput( kt, nitbkg_r, inum, 'avt'    , avt               )
[8495]140#if defined key_hadocc
141            CALL iom_rstput( kt, nitbkg_r, inum, 'pgrow_avg'   , pgrow_avg             )
142            CALL iom_rstput( kt, nitbkg_r, inum, 'ploss_avg'   , ploss_avg             )
143            CALL iom_rstput( kt, nitbkg_r, inum, 'phyt_avg'    , phyt_avg              )
144            CALL iom_rstput( kt, nitbkg_r, inum, 'mld_max'     , mld_max               )
145            CALL iom_rstput( kt, nitbkg_r, inum, 'hadocc_nut'  , trn(:,:,:,jp_had_nut) )
146            CALL iom_rstput( kt, nitbkg_r, inum, 'hadocc_phy'  , trn(:,:,:,jp_had_phy) )
147            CALL iom_rstput( kt, nitbkg_r, inum, 'hadocc_zoo'  , trn(:,:,:,jp_had_zoo) )
148            CALL iom_rstput( kt, nitbkg_r, inum, 'hadocc_pdn'  , trn(:,:,:,jp_had_pdn) )
149            CALL iom_rstput( kt, nitbkg_r, inum, 'hadocc_dic'  , trn(:,:,:,jp_had_dic) )
150            CALL iom_rstput( kt, nitbkg_r, inum, 'hadocc_alk'  , trn(:,:,:,jp_had_alk) )
151            CALL iom_rstput( kt, nitbkg_r, inum, 'hadocc_chl'  , HADOCC_CHL(:,:,1)     )
152            CALL iom_rstput( kt, nitbkg_r, inum, 'hadocc_cchl' , cchl_p(:,:,1)         )
153#elif defined key_medusa && defined key_foam_medusa
154            CALL iom_rstput( kt, nitbkg_r, inum, 'pgrow_avg'   , pgrow_avg        )
155            CALL iom_rstput( kt, nitbkg_r, inum, 'ploss_avg'   , ploss_avg        )
156            CALL iom_rstput( kt, nitbkg_r, inum, 'phyt_avg'    , phyt_avg         )
157            CALL iom_rstput( kt, nitbkg_r, inum, 'mld_max'     , mld_max          )
158            CALL iom_rstput( kt, nitbkg_r, inum, 'medusa_chn'  , trn(:,:,:,jpchn) )
159            CALL iom_rstput( kt, nitbkg_r, inum, 'medusa_chd'  , trn(:,:,:,jpchd) )
160            CALL iom_rstput( kt, nitbkg_r, inum, 'medusa_phn'  , trn(:,:,:,jpphn) )
161            CALL iom_rstput( kt, nitbkg_r, inum, 'medusa_phd'  , trn(:,:,:,jpphd) )
162            CALL iom_rstput( kt, nitbkg_r, inum, 'medusa_pds'  , trn(:,:,:,jppds) )
163            CALL iom_rstput( kt, nitbkg_r, inum, 'medusa_zmi'  , trn(:,:,:,jpzmi) )
164            CALL iom_rstput( kt, nitbkg_r, inum, 'medusa_zme'  , trn(:,:,:,jpzme) )
165            CALL iom_rstput( kt, nitbkg_r, inum, 'medusa_din'  , trn(:,:,:,jpdin) )
166            CALL iom_rstput( kt, nitbkg_r, inum, 'medusa_sil'  , trn(:,:,:,jpsil) )
167            CALL iom_rstput( kt, nitbkg_r, inum, 'medusa_fer'  , trn(:,:,:,jpfer) )
168            CALL iom_rstput( kt, nitbkg_r, inum, 'medusa_det'  , trn(:,:,:,jpdet) )
169            CALL iom_rstput( kt, nitbkg_r, inum, 'medusa_dtc'  , trn(:,:,:,jpdtc) )
170            CALL iom_rstput( kt, nitbkg_r, inum, 'medusa_dic'  , trn(:,:,:,jpdic) )
171            CALL iom_rstput( kt, nitbkg_r, inum, 'medusa_alk'  , trn(:,:,:,jpalk) )
172            CALL iom_rstput( kt, nitbkg_r, inum, 'medusa_oxy'  , trn(:,:,:,jpoxy) )
173#endif
[3764]174            !
175            CALL iom_close( inum )
176         ENDIF
177         !
178      ENDIF
179
180      !                                !-------------------------------------------
181      IF( kt == nitdin_r ) THEN        ! Write out background at time step nitdin_r
182         !                             !-----------------------------------========
183         !
184         WRITE(cl_asmdin, FMT='(A,".nc")' ) TRIM( c_asmdin )
185         cl_asmdin = TRIM( cl_asmdin )
186         INQUIRE( FILE = cl_asmdin, EXIST = llok )
187         !
188         IF( .NOT. llok ) THEN
189            IF(lwp) WRITE(numout,*) ' Setting up assimilation background file '// TRIM( c_asmdin )
190            !
191            !                                      ! Define the output file       
192            CALL iom_open( c_asmdin, inum, ldwrt = .TRUE., kiolib = jprstlib)
193            !
194            IF( nitdin_r == nit000 - 1 ) THEN      ! Treat special case when nitbkg = 0
195
196               zdate = REAL( ndastp )
197            ELSE
198               zdate = REAL( ndastp )
199            ENDIF
200            !
201            !                                      ! Write the information
202            CALL iom_rstput( kt, nitdin_r, inum, 'rdastp' , zdate             )
203            CALL iom_rstput( kt, nitdin_r, inum, 'un'     , un                )
204            CALL iom_rstput( kt, nitdin_r, inum, 'vn'     , vn                )
205            CALL iom_rstput( kt, nitdin_r, inum, 'tn'     , tsn(:,:,:,jp_tem) )
206            CALL iom_rstput( kt, nitdin_r, inum, 'sn'     , tsn(:,:,:,jp_sal) )
[8400]207            CALL iom_rstput( kt, nitdin_r, inum, 'avt'    , avt     )
[3764]208            CALL iom_rstput( kt, nitdin_r, inum, 'sshn'   , sshn              )
209#if defined key_lim2 || defined key_lim3
210            IF(( nn_ice == 2 ) .OR. ( nn_ice == 3 )) THEN
[4990]211          IF(ALLOCATED(frld)) THEN
212                  CALL iom_rstput( kt, nitdin_r, inum, 'iceconc', 1.0 - frld(:,:)   )
213               ELSE
214        CALL ctl_warn('Ice concentration not written to background as ice variable frld not allocated on this timestep')
215          ENDIF
[3764]216            ENDIF
217#endif
218            !
219            CALL iom_close( inum )
220         ENDIF
221         !
222      ENDIF
223      !                   
224   END SUBROUTINE asm_bkg_wri
225
226   !!======================================================================
227END MODULE asmbkg
Note: See TracBrowser for help on using the repository browser.