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

source: branches/UKMO/dev_r5518_GO6_package_asm_surf_bgc/NEMOGCM/NEMO/OPA_SRC/ASM/asmbkg.F90 @ 8436

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

Implement initial version of surface chlorophyll assimilation for MEDUSA.
File size: 11.3 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
[8436]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               )
[8436]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, 'nutrients'     , trn(:,:,:,jp_had_nut) )
146            CALL iom_rstput( kt, nitbkg_r, inum, 'phytoplankton' , trn(:,:,:,jp_had_phy) )
147            CALL iom_rstput( kt, nitbkg_r, inum, 'zooplankton'   , trn(:,:,:,jp_had_zoo) )
148            CALL iom_rstput( kt, nitbkg_r, inum, 'detritus'      , trn(:,:,:,jp_had_pdn) )
149            CALL iom_rstput( kt, nitbkg_r, inum, 'dic'           , trn(:,:,:,jp_had_dic) )
150            CALL iom_rstput( kt, nitbkg_r, inum, 'alkalinity'    , trn(:,:,:,jp_had_alk) )
151            CALL iom_rstput( kt, nitbkg_r, inum, 'chlorophyll'   , HADOCC_CHL(:,:,1)     )
152            CALL iom_rstput( kt, nitbkg_r, inum, 'c_to_chl'      , 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, 'nutrients'     , trn(:,:,:,jpdin)                    )
159            CALL iom_rstput( kt, nitbkg_r, inum, 'phytoplankton' , trn(:,:,:,jpphn) + trn(:,:,:,jpphd) )
160            CALL iom_rstput( kt, nitbkg_r, inum, 'zooplankton'   , trn(:,:,:,jpzmi) + trn(:,:,:,jpzme) )
161            CALL iom_rstput( kt, nitbkg_r, inum, 'detritus'      , trn(:,:,:,jpdet)                    )
162            CALL iom_rstput( kt, nitbkg_r, inum, 'dic'           , trn(:,:,:,jpdic)                    )
163            CALL iom_rstput( kt, nitbkg_r, inum, 'alkalinity'    , trn(:,:,:,jpalk)                    )
164            CALL iom_rstput( kt, nitbkg_r, inum, 'chlorophyll'   , trn(:,:,1,jpchn) + trn(:,:,1,jpchd) )
165#endif
[3764]166            !
167            CALL iom_close( inum )
168         ENDIF
169         !
170      ENDIF
171
172      !                                !-------------------------------------------
173      IF( kt == nitdin_r ) THEN        ! Write out background at time step nitdin_r
174         !                             !-----------------------------------========
175         !
176         WRITE(cl_asmdin, FMT='(A,".nc")' ) TRIM( c_asmdin )
177         cl_asmdin = TRIM( cl_asmdin )
178         INQUIRE( FILE = cl_asmdin, EXIST = llok )
179         !
180         IF( .NOT. llok ) THEN
181            IF(lwp) WRITE(numout,*) ' Setting up assimilation background file '// TRIM( c_asmdin )
182            !
183            !                                      ! Define the output file       
184            CALL iom_open( c_asmdin, inum, ldwrt = .TRUE., kiolib = jprstlib)
185            !
186            IF( nitdin_r == nit000 - 1 ) THEN      ! Treat special case when nitbkg = 0
187
188               zdate = REAL( ndastp )
189            ELSE
190               zdate = REAL( ndastp )
191            ENDIF
192            !
193            !                                      ! Write the information
194            CALL iom_rstput( kt, nitdin_r, inum, 'rdastp' , zdate             )
195            CALL iom_rstput( kt, nitdin_r, inum, 'un'     , un                )
196            CALL iom_rstput( kt, nitdin_r, inum, 'vn'     , vn                )
197            CALL iom_rstput( kt, nitdin_r, inum, 'tn'     , tsn(:,:,:,jp_tem) )
198            CALL iom_rstput( kt, nitdin_r, inum, 'sn'     , tsn(:,:,:,jp_sal) )
[8400]199            CALL iom_rstput( kt, nitdin_r, inum, 'avt'    , avt     )
[3764]200            CALL iom_rstput( kt, nitdin_r, inum, 'sshn'   , sshn              )
201#if defined key_lim2 || defined key_lim3
202            IF(( nn_ice == 2 ) .OR. ( nn_ice == 3 )) THEN
[4990]203          IF(ALLOCATED(frld)) THEN
204                  CALL iom_rstput( kt, nitdin_r, inum, 'iceconc', 1.0 - frld(:,:)   )
205               ELSE
206        CALL ctl_warn('Ice concentration not written to background as ice variable frld not allocated on this timestep')
207          ENDIF
[3764]208            ENDIF
209#endif
210            !
211            CALL iom_close( inum )
212         ENDIF
213         !
214      ENDIF
215      !                   
216   END SUBROUTINE asm_bkg_wri
217
218   !!======================================================================
219END MODULE asmbkg
Note: See TracBrowser for help on using the repository browser.