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.
asmbal.F90 in branches/UKMO/dev_r5518_v3.6_asm_nemovar_community_ersem_hem08/NEMOGCM/NEMO/OPA_SRC/ASM – NEMO

source: branches/UKMO/dev_r5518_v3.6_asm_nemovar_community_ersem_hem08/NEMOGCM/NEMO/OPA_SRC/ASM/asmbal.F90 @ 9331

Last change on this file since 9331 was 9331, checked in by dford, 6 years ago

Add balancing code.
File size: 8.7 KB
Line 
1MODULE asmbal
2   !!======================================================================
3   !!                       ***  MODULE asmbal  ***
4   !! Assimilation balancing interface: Write to file the balancing increments
5   !!                                   calculated for biogeochemistry
6   !!======================================================================
7   !!----------------------------------------------------------------------
8   !!   'key_asminc' : Switch on the assimilation increment interface
9   !!----------------------------------------------------------------------
10   !!   asm_bal_wri  : Write out the background state
11   !!----------------------------------------------------------------------
12   !! * Modules used
13   USE par_kind, ONLY: &   ! Precision variables
14      & wp
15   USE iom                 ! I/O module
16   USE asminc              ! Main assimilation increments module
17   USE asmpar              ! Parameters for the assimilation interface
18#if defined key_fabm
19   USE par_fabm
20#elif defined key_medusa && defined key_foam_medusa
21   USE par_medusa
22#elif defined key_hadocc
23   USE par_hadocc
24#endif
25
26   IMPLICIT NONE
27
28   !! * Routine accessibility
29   PRIVATE
30   PUBLIC asm_bal_wri   !: Write out the background state
31
32CONTAINS
33
34   SUBROUTINE asm_bal_wri( kt )
35      !!-----------------------------------------------------------------------
36      !!
37      !!                  ***  ROUTINE asm_bal_wri ***
38      !!
39      !! ** Purpose : Write to file the balancing increments
40      !!              calculated for biogeochemistry
41      !!
42      !! ** Method  : Write to file the balancing increments
43      !!              calculated for biogeochemistry
44      !!
45      !! ** Action  :
46      !!                   
47      !! References :
48      !!
49      !! History    :
50      !!        ! 2014-08 (D. Ford)  Initial version, based on asm_bkg_wri
51      !!-----------------------------------------------------------------------
52      !! * Arguments
53      INTEGER, INTENT( IN ) :: kt        ! Current time-step
54      !! * Local declarations
55      CHARACTER(LEN=50) :: cl_asmbal     ! Filename (with extension)
56      LOGICAL           :: llok          ! Check if file exists
57      INTEGER           :: inum          ! File unit number
58      REAL(wp)          :: zdate         ! Date
59      !!-----------------------------------------------------------------------
60     
61      ! Set things up
62      zdate = REAL( ndastp )
63      WRITE(cl_asmbal, FMT='(A,".nc")' ) TRIM( c_asmbal )
64
65      ! Check if file exists
66      INQUIRE( FILE = TRIM( cl_asmbal ), EXIST = llok )
67      IF( .NOT. llok ) THEN
68         IF(lwp) WRITE(numout,*) ' Setting up assimilation balancing increments file '// &
69            &                    TRIM( c_asmbal ) // ' at timestep = ', kt
70
71         ! Define the output file       
72         CALL iom_open( c_asmbal, inum, ldwrt = .TRUE., kiolib = jprstlib)
73
74         ! Write the information
75         CALL iom_rstput( kt, kt, inum, 'rdastp' , zdate   )
76
77         IF ( ln_logchltotinc .OR. ln_logchlpftinc ) THEN
78#if defined key_fabm
79            CALL iom_rstput( kt, kt, inum, 'bal_chl1', logchl_balinc(:,:,:,jp_fabm_m1+jp_fabm_chl1) )
80            CALL iom_rstput( kt, kt, inum, 'bal_chl2', logchl_balinc(:,:,:,jp_fabm_m1+jp_fabm_chl2) )
81            CALL iom_rstput( kt, kt, inum, 'bal_chl3', logchl_balinc(:,:,:,jp_fabm_m1+jp_fabm_chl3) )
82            CALL iom_rstput( kt, kt, inum, 'bal_chl4', logchl_balinc(:,:,:,jp_fabm_m1+jp_fabm_chl4) )
83            IF ( ln_logchlbal ) THEN
84               CALL iom_rstput( kt, kt, inum, 'bal_p1n', logchl_balinc(:,:,:,jp_fabm_m1+jp_fabm_p1n) )
85               CALL iom_rstput( kt, kt, inum, 'bal_p1c', logchl_balinc(:,:,:,jp_fabm_m1+jp_fabm_p1c) )
86               CALL iom_rstput( kt, kt, inum, 'bal_p1p', logchl_balinc(:,:,:,jp_fabm_m1+jp_fabm_p1p) )
87               CALL iom_rstput( kt, kt, inum, 'bal_p1s', logchl_balinc(:,:,:,jp_fabm_m1+jp_fabm_p1s) )
88               CALL iom_rstput( kt, kt, inum, 'bal_p2n', logchl_balinc(:,:,:,jp_fabm_m1+jp_fabm_p2n) )
89               CALL iom_rstput( kt, kt, inum, 'bal_p2c', logchl_balinc(:,:,:,jp_fabm_m1+jp_fabm_p2c) )
90               CALL iom_rstput( kt, kt, inum, 'bal_p2p', logchl_balinc(:,:,:,jp_fabm_m1+jp_fabm_p2p) )
91               CALL iom_rstput( kt, kt, inum, 'bal_p3n', logchl_balinc(:,:,:,jp_fabm_m1+jp_fabm_p3n) )
92               CALL iom_rstput( kt, kt, inum, 'bal_p3c', logchl_balinc(:,:,:,jp_fabm_m1+jp_fabm_p3c) )
93               CALL iom_rstput( kt, kt, inum, 'bal_p3p', logchl_balinc(:,:,:,jp_fabm_m1+jp_fabm_p3p) )
94               CALL iom_rstput( kt, kt, inum, 'bal_p4n', logchl_balinc(:,:,:,jp_fabm_m1+jp_fabm_p4n) )
95               CALL iom_rstput( kt, kt, inum, 'bal_p4c', logchl_balinc(:,:,:,jp_fabm_m1+jp_fabm_p4c) )
96               CALL iom_rstput( kt, kt, inum, 'bal_p4p', logchl_balinc(:,:,:,jp_fabm_m1+jp_fabm_p4p) )
97               CALL iom_rstput( kt, kt, inum, 'bal_n3n', logchl_balinc(:,:,:,jp_fabm_m1+jp_fabm_n3n) )
98               CALL iom_rstput( kt, kt, inum, 'bal_n4n', logchl_balinc(:,:,:,jp_fabm_m1+jp_fabm_n4n) )
99               CALL iom_rstput( kt, kt, inum, 'bal_z4c', logchl_balinc(:,:,:,jp_fabm_m1+jp_fabm_z4c) )
100               CALL iom_rstput( kt, kt, inum, 'bal_z5n', logchl_balinc(:,:,:,jp_fabm_m1+jp_fabm_z5n) )
101               CALL iom_rstput( kt, kt, inum, 'bal_z5c', logchl_balinc(:,:,:,jp_fabm_m1+jp_fabm_z5c) )
102               CALL iom_rstput( kt, kt, inum, 'bal_z5p', logchl_balinc(:,:,:,jp_fabm_m1+jp_fabm_z5p) )
103               CALL iom_rstput( kt, kt, inum, 'bal_z6n', logchl_balinc(:,:,:,jp_fabm_m1+jp_fabm_z6n) )
104               CALL iom_rstput( kt, kt, inum, 'bal_z6c', logchl_balinc(:,:,:,jp_fabm_m1+jp_fabm_z6c) )
105               CALL iom_rstput( kt, kt, inum, 'bal_z6p', logchl_balinc(:,:,:,jp_fabm_m1+jp_fabm_z6p) )
106               CALL iom_rstput( kt, kt, inum, 'bal_r4n', logchl_balinc(:,:,:,jp_fabm_m1+jp_fabm_r4n) )
107               CALL iom_rstput( kt, kt, inum, 'bal_r6n', logchl_balinc(:,:,:,jp_fabm_m1+jp_fabm_r6n) )
108               CALL iom_rstput( kt, kt, inum, 'bal_r8n', logchl_balinc(:,:,:,jp_fabm_m1+jp_fabm_r8n) )
109               CALL iom_rstput( kt, kt, inum, 'bal_o3c', logchl_balinc(:,:,:,jp_fabm_m1+jp_fabm_o3c) )
110               CALL iom_rstput( kt, kt, inum, 'bal_o3a', logchl_balinc(:,:,:,jp_fabm_m1+jp_fabm_o3a) )
111            ENDIF
112#elif defined key_medusa && defined key_foam_medusa
113            CALL iom_rstput( kt, kt, inum, 'logchl_balinc_chn', logchl_balinc(:,:,:,jpchn) )
114            CALL iom_rstput( kt, kt, inum, 'logchl_balinc_chd', logchl_balinc(:,:,:,jpchd) )
115            CALL iom_rstput( kt, kt, inum, 'logchl_balinc_phn', logchl_balinc(:,:,:,jpphn) )
116            CALL iom_rstput( kt, kt, inum, 'logchl_balinc_phd', logchl_balinc(:,:,:,jpphd) )
117            CALL iom_rstput( kt, kt, inum, 'logchl_balinc_pds', logchl_balinc(:,:,:,jppds) )
118            CALL iom_rstput( kt, kt, inum, 'logchl_balinc_zmi', logchl_balinc(:,:,:,jpzmi) )
119            CALL iom_rstput( kt, kt, inum, 'logchl_balinc_zme', logchl_balinc(:,:,:,jpzme) )
120            CALL iom_rstput( kt, kt, inum, 'logchl_balinc_din', logchl_balinc(:,:,:,jpdin) )
121            CALL iom_rstput( kt, kt, inum, 'logchl_balinc_sil', logchl_balinc(:,:,:,jpsil) )
122            CALL iom_rstput( kt, kt, inum, 'logchl_balinc_fer', logchl_balinc(:,:,:,jpfer) )
123            CALL iom_rstput( kt, kt, inum, 'logchl_balinc_det', logchl_balinc(:,:,:,jpdet) )
124            CALL iom_rstput( kt, kt, inum, 'logchl_balinc_dtc', logchl_balinc(:,:,:,jpdtc) )
125            CALL iom_rstput( kt, kt, inum, 'logchl_balinc_dic', logchl_balinc(:,:,:,jpdic) )
126            CALL iom_rstput( kt, kt, inum, 'logchl_balinc_alk', logchl_balinc(:,:,:,jpalk) )
127            CALL iom_rstput( kt, kt, inum, 'logchl_balinc_oxy', logchl_balinc(:,:,:,jpoxy) )
128#elif defined key_hadocc
129            CALL iom_rstput( kt, kt, inum, 'logchl_balinc_nut', logchl_balinc(:,:,:,jp_had_nut) )
130            CALL iom_rstput( kt, kt, inum, 'logchl_balinc_phy', logchl_balinc(:,:,:,jp_had_phy) )
131            CALL iom_rstput( kt, kt, inum, 'logchl_balinc_zoo', logchl_balinc(:,:,:,jp_had_zoo) )
132            CALL iom_rstput( kt, kt, inum, 'logchl_balinc_det', logchl_balinc(:,:,:,jp_had_det) )
133            CALL iom_rstput( kt, kt, inum, 'logchl_balinc_dic', logchl_balinc(:,:,:,jp_had_dic) )
134            CALL iom_rstput( kt, kt, inum, 'logchl_balinc_alk', logchl_balinc(:,:,:,jp_had_alk) )
135#endif
136         ENDIF
137
138         CALL iom_close( inum )
139      ELSE
140         CALL ctl_warn( TRIM( cl_asmbal ) // ' already exists ', &
141            &           ' Therefore not writing out balancing increments at this timestep', &
142            &           ' Something has probably gone wrong somewhere' )
143         IF(lwp) WRITE(numout,*) ' Failed to set up assimilation balancing increments file '// &
144            &                    TRIM( c_asmbal ) // ' at timestep = ', kt
145      ENDIF
146                                 
147   END SUBROUTINE asm_bal_wri
148END MODULE asmbal
Note: See TracBrowser for help on using the repository browser.