source: CONFIG/publications/ICOLMDZORINCA_CO2_Transport_GMD_2023/INCA/build/ppsrc/INCA_SRC/chemini.f90 @ 6610

Last change on this file since 6610 was 6610, checked in by acosce, 10 months ago

INCA used for ICOLMDZORINCA_CO2_Transport_GMD_2023
File size: 11.1 KB
Line 
1
2
3
4
5
6
7
8
9
10
11
12!$Id: chemini.F90 163 2010-02-22 15:41:45Z acosce $
13!! =========================================================================
14!! INCA - INteraction with Chemistry and Aerosols
15!!
16!! Copyright Laboratoire des Sciences du Climat et de l'Environnement (LSCE)
17!!           Unite mixte CEA-CNRS-UVSQ
18!!
19!! Contributors to this INCA subroutine:
20!!
21!! Didier Hauglustaine, LSCE, hauglustaine@cea.fr
22!! Stacy Walters, NCAR, stacy@ucar.edu
23!!
24!! Anne Cozic, LSCE, anne.cozic@cea.fr
25!! Yann Meurdesoif, LSCE, yann.meurdesoif@cea.fr
26!!
27!! This software is a computer program whose purpose is to simulate the
28!! atmospheric gas phase and aerosol composition. The model is designed to be
29!! used within a transport model or a general circulation model. This version
30!! of INCA was designed to be coupled to the LMDz GCM. LMDz-INCA accounts
31!! for emissions, transport (resolved and sub-grid scale), photochemical
32!! transformations, and scavenging (dry deposition and washout) of chemical
33!! species and aerosols interactively in the GCM. Several versions of the INCA
34!! model are currently used depending on the envisaged applications with the
35!! chemistry-climate model.
36!!
37!! This software is governed by the CeCILL  license under French law and
38!! abiding by the rules of distribution of free software.  You can  use,
39!! modify and/ or redistribute the software under the terms of the CeCILL
40!! license as circulated by CEA, CNRS and INRIA at the following URL
41!! "http://www.cecill.info".
42!!
43!! As a counterpart to the access to the source code and  rights to copy,
44!! modify and redistribute granted by the license, users are provided only
45!! with a limited warranty  and the software's author,  the holder of the
46!! economic rights,  and the successive licensors  have only  limited
47!! liability.
48!!
49!! In this respect, the user's attention is drawn to the risks associated
50!! with loading,  using,  modifying and/or developing or reproducing the
51!! software by the user in light of its specific status of free software,
52!! that may mean  that it is complicated to manipulate,  and  that  also
53!! therefore means  that it is reserved for developers  and  experienced
54!! professionals having in-depth computer knowledge. Users are therefore
55!! encouraged to load and test the software's suitability as regards their
56!! requirements in conditions enabling the security of their systems and/or
57!! data to be ensured and,  more generally, to use and operate it in the
58!! same conditions as regards security.
59!!
60!! The fact that you are presently reading this means that you have had
61!! knowledge of the CeCILL license and that you accept its terms.
62!! =========================================================================
63
64
65SUBROUTINE CHEMINI( &
66   xgravit  ,&
67   xrearth  ,&
68   xlatwts  ,&
69   latgcm   ,&
70   longcm   ,&
71   presnivs ,&
72   calday   ,&
73   klon     ,&
74   nqmax    ,&
75   nqo      ,&
76   pdtphys  ,&
77   annee_ref ,& 
78   year_cur, &
79   day_ref  ,&
80   day_ini, &
81   start_time, &
82   itau_phy ,&
83   date0,    &
84   io_lon   ,&
85   io_lat   ,&
86   chemistry_couple, &
87   init_source, init_tauinca, init_pizinca, init_cginca,init_ccm)
88  !-----------------------------------------------------------------------
89  !     ... Chemistry module intialization
90  ! Didier Hauglustaine and Stacy Walters, 1999.
91  !-----------------------------------------------------------------------
92
93  USE CONST_MOD
94  USE CONST_LMDZ
95  USE CHEM_CONS
96  USE CHEM_TRACNM
97  USE INCA_DIM
98  USE PARAM_CHEM, ONLY : flag_o3, flag_plane
99  USE  MOD_CONST_MPI_INCA
100  USE AEROSOL_DIAG, ONLY :  naero_grp, nbands
101
102  USE CARBONATOR
103
104  USE SURF_CHEM_MOD
105  USE PRINT_INCA
106  USE IOIPSL
107  USE xios
108  USE xios_inca
109  USE INCA_DATA_PARA
110
111  IMPLICIT NONE
112
113  !-----------------------------------------------------------------------
114  !     ... Dummy arguments
115  !-----------------------------------------------------------------------
116  REAL, INTENT(in) ::  xgravit
117  REAL, INTENT(in) ::  xrearth
118  REAL, INTENT(in) ::  calday
119  REAL, INTENT(in) ::  latgcm(PLON)
120  REAL, INTENT(in) ::  longcm(PLON)
121  REAL, INTENT(in) ::  presnivs(PLEV)
122  REAL, INTENT(in) ::  xlatwts(PLON)
123  INTEGER, INTENT(in) :: klon
124  INTEGER, INTENT(in) :: nqmax  ! nombre total de traceurs = inca + lmdz
125  INTEGER, INTENT(in) :: nqo ! nombre de traceurs lus dans traceur.def
126  REAL, INTENT(in) :: pdtphys
127  INTEGER, INTENT(in) :: annee_ref, year_cur
128  INTEGER, INTENT(in) :: day_ref, day_ini
129  REAL, INTENT(in) :: start_time
130  INTEGER, INTENT(in) :: itau_phy
131  REAL,INTENT(IN) :: io_lat(jjm_glo-1/(iim_glo*(jjm_glo-1))) ! latitudes (of global grid)
132  REAL,INTENT(IN) :: io_lon(iim_glo) ! longitudes (of global grid)
133  REAL,INTENT(IN):: date0
134  LOGICAL, INTENT(IN) :: chemistry_couple 
135
136  REAL, DIMENSION(PLON,8),INTENT(OUT) :: init_source
137  REAL, DIMENSION(PLON,PLEV,naero_grp,nbands),INTENT(OUT) :: init_tauinca
138  REAL, DIMENSION(PLON,PLEV,naero_grp,nbands),INTENT(OUT) :: init_pizinca
139  REAL, DIMENSION(PLON,PLEV,naero_grp,nbands),INTENT(OUT) :: init_cginca
140  REAL, DIMENSION(PLON,PLEV,nbands),INTENT(OUT) :: init_ccm
141  !-----------------------------------------------------------------------
142  !     ... Local variables
143  !-----------------------------------------------------------------------
144  INTEGER :: grid_id, vert_id          ! axes ID
145  INTEGER :: unit
146
147  !-----------------------------------------------------------------------
148  !     ... Function declarations
149  !-----------------------------------------------------------------------
150  INTEGER  ::  NAVU
151  REAL     ::  TSECND
152  INTEGER :: x_an, x_mois, x_jour
153  real :: x_heure, zjulian, zjulian_start
154  INTEGER :: ini_an, ini_mois, ini_jour
155  REAL :: ini_heure
156
157  init_source = 0. 
158  init_tauinca =  0. 
159  init_pizinca = 0. 
160  init_cginca = 0. 
161  init_ccm = 0. 
162
163
164  !
165  ! Initialisation de xios
166  !
167  CALL conf_chem(chemistry_couple) 
168
169
170  ! -----------------------------------------------------------------------
171  ! initialisation des autres parametres pour le couplage avec la vegetation
172  ! ------------------------------------------------------------------------
173  call INIT_SURF_CHEM_MOD
174
175  !-----------------------------------------------------------------------
176  !     ... Readin chemistry simulation specific data
177  !-----------------------------------------------------------------------
178  CALL CHEM_INTI()
179
180
181  ! Initialisation de 1
182
183  CALL ymds2ju(annee_ref, 1, day_ref, 0.0, zjulian)
184  CALL ju2ymds(zjulian, x_an, x_mois, x_jour, x_heure)
185
186  CALL ymds2ju(annee_ref, 1, day_ini, start_time, zjulian_start)
187  CALL ju2ymds(zjulian_start, ini_an, ini_mois, ini_jour, ini_heure)
188
189
190  call xios_inca_init(COMM_INCA , pdtphys, x_an, x_mois,x_jour, x_heure, &
191       ini_an, ini_mois, ini_jour, ini_heure, io_lon, io_lat, presnivs) 
192
193
194
195  ! lecture du restart
196  CALL xios_chem_read_restart(init_source, init_tauinca, init_pizinca, init_cginca,init_ccm)
197
198  !-----------------------------------------------------------------------
199  !     ... Parameters initialisation
200  !-----------------------------------------------------------------------
201
202
203  !-----------------------------------------------------------------------
204  !       ... Make sure LMDz and INCA resolutions are identical
205  !-----------------------------------------------------------------------
206
207  IF ( (klon /= PLON) .OR. ( (nqmax-nqo) /= 8) ) THEN
208     WRITE(lunout,*) '          [klon,  plon]  ', klon, PLON
209     WRITE(lunout,*) '          [nqmax-nqo, pcnst, nqo] ', nqmax-nqo, 8, nqo
210     CALL print_err(3, 'chemini', 'LMDZ-INCA resolution mismatch -- Abort.', &
211          'check klon,plon', 'and nqmax-nqo, pcnst')
212  END IF
213
214  CALL suphel_I
215
216
217
218  !-----------------------------------------------------------------------
219  !     ... Initialize chemistry variables
220  !-----------------------------------------------------------------------
221  d2r = pi / 180.
222  r2d = 1. / d2r
223  rearth = xrearth
224  phi(:) = latgcm(:) * d2r
225  lambda(:) = longcm(:) * d2r
226  latwts(:) = xlatwts(:)
227
228
229  !-----------------------------------------------------------------------
230  !     ... Diagnostics initialization
231  !-----------------------------------------------------------------------
232  !DH   call DIAGS_INTI( solsym )
233  unit = NAVU()
234
235  !-----------------------------------------------------------------------
236  !     ... Initialize photorate module
237  !-----------------------------------------------------------------------
238  CALL PRATE_INTI( unit )
239
240
241
242
243  !-----------------------------------------------------------------------
244  !     ... Read time-dependent surface flux dataset
245  !-----------------------------------------------------------------------
246  CALL XIOS_SFLX_INTI  ()
247  CALL CARBONATOR_INTI(itau_phy,date0,pdtphys)
248!  CALL DVEL_INTI  (  'landuse.nc' )
249!  CALL NPP_INTI   (  'npp.nc' )
250  call xios_npp_landuse_inti()
251
252  !-----------------------------------------------------------------------
253  !     ... Read time-dependent data sets
254  !-----------------------------------------------------------------------
255
256!  CALL OXYDANT_INTI ('oxydants.nc')
257 
258
259!  CALL xios_chem_read_restart()
260
261
262  call xios_inca_change_context("LMDZ")
263!  CALL xios_chem_read_restart()
264END SUBROUTINE CHEMINI
265
266SUBROUTINE check_err(iret, name, string)
267
268  USE PRINT_INCA
269   IMPLICIT NONE
270
271  !----------------------------------------------------------------------
272  !       ... netCDF error check
273  !----------------------------------------------------------------------
274
275  INTEGER :: iret
276  CHARACTER(LEN=*) :: name, string
277  INCLUDE 'netcdf.inc'
278  IF (iret /= NF_NOERR) THEN
279     WRITE(lunout, *) 'netCDF error ', nf_strerror(iret), ' : ', &
280          ' in Routine : ', name,' ', string(:LEN_TRIM(string))
281     WRITE(*,'("Fatal error from INCA. Read INCA output text")')
282     flush(lunout)
283     call MPI_ABORT(3)
284     STOP
285  ENDIF
286
287END SUBROUTINE check_err
288
289  !----------------------------------------------------------------------
290  !       ... Print error message
291  !----------------------------------------------------------------------
292SUBROUTINE print_err(lev,name,str1,str2,str3) 
293!---------------------------------------------------------------------
294!! The "print_err" routine
295!! allows to handle the messages to the user.
296!!
297!! parallel version of IOIPSL ipslerr
298!!
299!! INPUT
300!!
301!! lev   : Category of message to be reported to the user
302!!          1 = Note to the user
303!!          2 = Warning to the user
304!!          3 = Fatal error
305!! name : Name of subroutine which has called ipslerr
306!! str1   
307!! str2  : Strings containing the explanations to the user
308!! str3
309!---------------------------------------------------------------------
310  USE PRINT_INCA
311   IMPLICIT NONE
312
313   INTEGER :: lev
314   CHARACTER(LEN=*) :: name,str1,str2,str3
315!-
316   CHARACTER(LEN=30),DIMENSION(3) :: pemsg = &
317  &  (/ "NOTE TO THE USER FROM ROUTINE ", &
318  &     "WARNING FROM ROUTINE          ", &
319  &     "FATAL ERROR FROM ROUTINE      " /)
320!---------------------------------------------------------------------
321   IF ( (lev >= 1).AND.(lev <= 3) ) THEN
322     WRITE(lunout,'(/,A," ",A)') TRIM(pemsg(lev)),TRIM(name)
323     WRITE(lunout,'(3(" --> ",A,/))') TRIM(str1),TRIM(str2),TRIM(str3)
324   ENDIF
325   IF (lev == 3) THEN
326     WRITE(*,'("Fatal error from INCA. Go to Read DEBUG INCA output text")')
327     flush(lunout)
328    CALL MPI_ABORT(lev)
329    STOP
330   ENDIF
331!---------------------
332 
333END SUBROUTINE print_err
Note: See TracBrowser for help on using the repository browser.