source: CONFIG/publications/ICOLMDZORINCA_CO2_Transport_GMD_2023/INCA/build/ppsrc/INCA_SRC/chem_hook.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: 13.9 KB
Line 
1
2
3
4
5
6
7
8
9
10
11
12!$Id: chem_hook.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 CHEMHOOK_BEGIN(  &
66   calday,     &
67   ijour,      &
68   gmtime,     &
69   oro,        &
70   lat,        &
71   lon,        &
72   area,       &
73   pfull,      &
74   pmid,       &
75   coefh,      &
76   zma,        &
77   temp,       &
78   u,          &
79   v,          &
80   rot,        & 
81   ozrad,      &
82   sh,         &
83   ts,         &
84   t_air_2m,   & 
85   dpth_snow,  &
86   sws,        &
87   albs,       &
88   rain_fall,  &
89   snow_fall,  &
90   ctop,       &
91   cbot,       &
92   cldfr,      &
93   nx,         &
94   ny,         &
95   mmr,        &
96   ftsol,      &
97   paprs,      &
98   cdragh,     &
99   cdragm,     &
100   pctsrf,     &   
101   delt,       &
102   nstep )
103  !----------------------------------------------------------------------
104  !       ... General purpose chemistry "hook" routine
105  ! Didier Hauglustaine and Stacy Walters, 2000.
106  !----------------------------------------------------------------------
107
108   USE MOD_INCA_PARA
109   USE MOD_GRID_INCA, ONLY : PLON_GLO
110   USE CHEM_CONS
111   USE CONST_LMDZ
112   USE INCA_DIM
113   USE CARBONATOR
114   USE SPECIES_NAMES
115   USE PARAM_CHEM
116   USE DRYDEP_ARRAYS, ONLY : fraction_landuse
117   USE AIRPLANE_SRC,  ONLY : itrop, ttrop, ztrop
118
119   USE XIOS_INCA
120
121  IMPLICIT NONE
122
123  !----------------------------------------------------------------------
124  !       ... Dummy args
125  !----------------------------------------------------------------------
126  REAL, INTENT(IN)    :: calday
127  INTEGER, INTENT(in) :: ijour  ! jour julien
128  REAL, INTENT(in)    :: gmtime ! input-R-temps universel dans la journee (0 a 86400 s)
129  INTEGER, INTENT(IN) :: ctop(PLON)
130  INTEGER, INTENT(IN) :: cbot(PLON)
131  INTEGER, INTENT(IN) :: nx, ny 
132  REAL, INTENT(IN)    :: pmid(PLON,PLEV)     
133  REAL, INTENT(IN)    :: pfull(PLON,PLEV+1)     
134  REAL, INTENT(IN)    :: coefh(PLON,PLEV)     
135  REAL, INTENT(IN)    :: zma(PLON,PLEV)     
136  REAL, INTENT(IN)    :: temp(PLON,PLEV)   
137  REAL, INTENT(IN)    :: u(PLON,PLEV)   
138  REAL, INTENT(IN)    :: v(PLON,PLEV) 
139  REAL, INTENT(IN)    :: rot(PLON,PLEV) 
140  REAL, INTENT(IN)    :: ozrad(PLON,PLEV) 
141  REAL, INTENT(IN)    :: sh(PLON,PLEV)
142  REAL, INTENT(IN)    :: lat(PLON)       
143  REAL, INTENT(IN)    :: lon(PLON)       
144  REAL, INTENT(IN)    :: oro(PLON) 
145  REAL, INTENT(IN)    :: area(PLON) 
146  REAL, INTENT(IN)    :: ts(PLON)
147  REAL, INTENT(IN)    :: t_air_2m(PLON) ! air temperature near surface
148  REAL, INTENT(IN)    :: dpth_snow(PLON)
149  REAL, INTENT(IN)    :: sws(PLON)
150  REAL, INTENT(IN)    :: albs(PLON)
151  REAL, INTENT(IN)    :: rain_fall(PLON)
152  REAL, INTENT(IN)    :: snow_fall(PLON)         
153  REAL, INTENT(IN)    :: mmr(PLON,PLEV,8)
154  REAL, INTENT(IN)    :: cldfr (PLON,PLEV)
155  ! variables used in nightingale
156  REAL, INTENT(in)    :: ftsol(PLON,nbsrf)           
157  REAL, INTENT(in)    :: paprs(PLON,PLEV+1)           
158  REAL, INTENT(in)    :: cdragh(PLON), cdragm(PLON)   
159  REAL, INTENT(in)    :: pctsrf(PLON,nbsrf)           
160  REAL, INTENT(in)    :: delt               ! timestep in seconds of physics
161  INTEGER, INTENT(IN) :: nstep              ! model time step
162
163  !----------------------------------------------------------------------
164  !       ... Local arguments needed to calculate diurnal
165  !           variation of isoprene and monoterpenes
166  !----------------------------------------------------------------------
167
168  INTEGER ::     iplon, i 
169  REAL    ::     sunon(PLON)        ! sunrise angle in radians
170  REAL    ::     sunoff(PLON)       ! sunset angle in radians
171  REAL    ::     zen_angle(PLON)    ! solar zenith angle
172  REAL    ::     loc_angle(PLON)    ! "local" time angle
173  LOGICAL ::     polar_day(PLON)    ! continuous daylight flag
174  LOGICAL ::     polar_night(PLON)  ! continuous night flag
175  LOGICAL ::     zangtz(PLON)
176
177    REAL :: tfld_glo(PLON_GLO,PLEV)
178    REAL :: pmid_glo(PLON_GLO,PLEV)
179
180  !----------------------------------------------------------------------
181  !       ... Local variables
182  !----------------------------------------------------------------------
183  REAL :: zmid(PLON,PLEV)     
184
185  !-----------------------------------------------------------------------
186  !       ... Function interface
187  !-----------------------------------------------------------------------
188!  CALL xios_chem_read_restart()
189  zmid(:,:) = zma(:PLON,:) / gravit !meters
190
191  !-----------------------------------------------------------------------
192  !        ... Tropopause Location
193  !-----------------------------------------------------------------------
194    CALL gather(pmid,pmid_glo)
195    CALL bcast(pmid_glo)
196    CALL gather(temp,tfld_glo)
197    CALL bcast(tfld_glo)
198
199
200! dans le cas dynamico il faut revoir le calcul de la tropopause
201!    CALL FDTROPOPAUSE ( &
202!         nx,       &
203!         ny+1,     &    ! chemhook_begin recupere nbp_lat-1 de lmdz chemmain avait nbp_lat
204!         PLEV,     &
205!         pmid_glo, &
206!         tfld_glo)
207
208
209
210    DO i = 1, PLON
211       itrop(i)=nint(3./4.*PLEVP)
212    END DO
213
214    DO iplon = 1, PLON
215
216       ttrop(iplon) = temp(iplon,itrop(iplon))
217       ztrop(iplon) = zmid(iplon,itrop(iplon))
218
219    ENDDO
220
221  ! appel de l'interface entre inca et orchidee
222
223  IF (CoupSurfAtm) THEN
224     CALL surf_chem_atm(pctsrf, fraction_landuse)
225  ENDIF
226
227
228  CALL XIOS_OXYDANT_READ   (calday)
229
230
231  ! ... Dry deposition velocities
232  CALL MKDVEL (&
233       oro, lat, zmid, coefh,  &
234       calday, temp, u, v, sh, &
235       pfull, pmid, ts,        &
236       dpth_snow, sws, albs,   &
237       rain_fall, snow_fall) 
238 
239  CALL CARBONATOR_SFLX(ijour,gmtime)
240
241
242
243  ! ... Surface emissions
244     CALL MKSFLX_P2P( &
245          calday, oro, lat, lon, area, loc_angle,    &
246          polar_night, polar_day, sunon, sunoff,     &
247          u, v, paprs, pmid, cdragh, cdragm, temp,   &
248          sh, ftsol, ts, pctsrf)
249
250  CALL CALC_PV(lat,paprs,pmid,t_air_2m,temp,rot) 
251
252  CALL xios_inca_change_context("inca")
253  CALL xios_inca_send_field("pfull", pfull)
254  CALL xios_inca_send_field("ttrop", ttrop)
255  CALL xios_inca_send_field("ztrop", ztrop)
256  CALL xios_inca_change_context("LMDZ")
257
258
259END SUBROUTINE CHEMHOOK_BEGIN
260
261SUBROUTINE CHEMHOOK_END( &
262   dt,         &
263   pmid,       &
264   temp,       &
265   mmr,        &
266   nbtr,       &
267   paprs,      &
268   sh,         &
269   area,       &
270   zma,        &
271   phis,       &
272   rh, aps, bps, ap, bp, lafin )
273  !----------------------------------------------------------------------
274  !       ... General purpose chemistry "hook" routine
275  ! Didier Hauglustaine, IPSL, 2000.
276  !----------------------------------------------------------------------
277
278  USE SPECIES_NAMES
279  USE IOIPSL
280  USE MOD_INCA_PARA
281  USE CHEM_CONS
282  USE TIMING
283  USE INCA_DIM
284  USE CHEM_MODS 
285  USE SFLX, ONLY : eflux, dvel, dflux, aflux
286  USE PHT_TABLES, ONLY : jrates
287
288
289
290
291  USE XIOS_INCA
292
293  USE CHEM_TRACNM
294  USE PRINT_INCA
295  USE RATE_INDEX_MOD
296  USE SRF_FLUX_INT
297  IMPLICIT NONE
298
299  !----------------------------------------------------------------------
300  !       ... Dummy args
301  !----------------------------------------------------------------------
302  INTEGER, INTENT(IN)  :: nbtr
303  REAL, INTENT(IN)     :: dt
304  REAL, INTENT(IN)     :: pmid(PLON,PLEV)
305  REAL, INTENT(IN)     :: area(PLON)
306  REAL, INTENT(IN)     :: temp(PLON,PLEV)
307  REAL, INTENT(IN)     :: paprs(PLON,PLEVP)
308  REAL, INTENT(IN)     :: sh(PLON,PLEV)
309  REAL, INTENT(INOUT)  :: mmr(PLON,PLEV,8)
310  REAL, INTENT(IN)     :: zma(PLON,PLEV)
311  REAL, INTENT(IN)     :: phis(PLON)
312  REAL, INTENT(IN)     :: rh(PLON,PLEV)
313  REAL, INTENT(IN), DIMENSION(PLEV)   :: aps, bps
314  REAL, INTENT(IN), DIMENSION(PLEV+1) :: ap, bp
315  LOGICAL, INTENT(IN) :: lafin 
316  !----------------------------------------------------------------------
317  !       ... Local variables
318  !----------------------------------------------------------------------
319  REAL                 :: pdel(PLON,PLEV)
320  REAL, PARAMETER      :: dry_mass = 28.966    !test userd
321  INTEGER, PARAMETER   :: inst=1, avgr=2
322  INTEGER :: k,i,j
323  INTEGER, PARAMETER   :: ilev=1               
324  REAL    :: dtinv
325  real, dimension(PLON) :: field1d
326  real, dimension(PLON) :: mmrpm2p5surf,mmrpm2p5asurf,mmrpm10surf,mmrpm1surf,mmrpm1asurf,vmro3surf,pmidsurf,tempsurf
327  real, dimension(PLON) :: SOAasurf,SOAbsurf,POMMsurf,AIBCMsurf,ASBCMsurf 
328  real, dimension(PLON,PLEV) :: field2d
329  REAL, DIMENSION(PLEV+1,2) :: Ahyb_bounds, Bhyb_bounds
330  REAL, DIMENSION(PLEV,2) :: Ahyb_mid_bounds, Bhyb_mid_bounds
331  character(3) :: text
332
333  !-----------------------------------------------------------------------
334  !       ... Function interface
335  !-----------------------------------------------------------------------
336 dtinv = 1./dt
337
338 write(lunout,*)  'lafin = ', lafin
339
340 call xios_inca_change_context("inca")
341
342
343
344
345
346     DO k = 1, PLEV
347        pdel(:,k) = paprs(:,k) - paprs (:,k+1)
348     END DO
349
350  !----------------------------------------------------------------------
351  !       ...  Writing the species concentration, surface flux and deposition
352  !            velocity and the group members concentration
353  !-----------------------------------------------------------------------
354
355     CALL xios_inca_send_field("emich4ref", flx_ch4_ant(:,1)) 
356     CALL xios_inca_send_field("emich4interp", flx_ch4_ant_interp(:,1) ) 
357
358
359     CALL outfld_xios(pmid,temp,sh,paprs(1,1),pdel,area)
360
361     DO i=1,8
362           IF( adv_mass(i) /= 0. ) THEN
363              field2d(:,:) = mmr(:,:,i) * dry_mass / adv_mass(i)
364           ENDIF
365       
366        call xios_inca_send_field(tracnam(i), field2d)
367        call xios_inca_send_field("Emi_"//tracnam(i), eflux(:,i))
368        call xios_inca_send_field("Dep_"//tracnam(i), dvel(:,i))
369        call xios_inca_send_field("Dflux_"//tracnam(i), dflux(:,i))
370     ENDDO
371   
372
373    Ahyb_bounds(1,1) = 0.
374    Ahyb_bounds(1,2) = aps(1)
375    Bhyb_bounds(1,1) = 1.
376    Bhyb_bounds(1,2) = bps(1)   
377    DO i=2,PLEV
378      Ahyb_bounds(i,1) = aps(i-1)
379      Ahyb_bounds(i,2) = aps(i)
380      Bhyb_bounds(i,1) = bps(i-1)
381      Bhyb_bounds(i,2) = bps(i)
382    ENDDO
383     Ahyb_bounds(PLEV+1,1) = aps(PLEV)
384     Ahyb_bounds(PLEV+1,2) = 0.
385     Bhyb_bounds(PLEV+1,1) = bps(PLEV)
386     Bhyb_bounds(PLEV+1,2) = 0.
387
388    DO i=1, PLEV
389      Ahyb_mid_bounds(i,1) = ap(i)
390      Ahyb_mid_bounds(i,2) = ap(i+1)
391      Bhyb_mid_bounds(i,1) = bp(i)
392      Bhyb_mid_bounds(i,2) = bp(i+1)
393    END DO   
394
395
396     CALL xios_inca_send_field("Ahyb", ap) 
397     CALL xios_inca_send_field("Bhyb", bp) 
398
399     CALL xios_inca_send_field("Ahyb_bounds", Ahyb_bounds) 
400     CALL xios_inca_send_field("Bhyb_bounds", Bhyb_bounds) 
401
402     CALL xios_inca_send_field("Ahyb_mid", aps ) 
403     CALL xios_inca_send_field("Bhyb_mid", bps) 
404
405     CALL xios_inca_send_field("Ahyb_mid_bounds", Ahyb_mid_bounds) 
406     CALL xios_inca_send_field("Bhyb_mid_bounds", Bhyb_mid_bounds) 
407
408     DO i=1,1
409        CALL xios_inca_send_field("hrate_"//hetname(i), hrates(:,:,i))
410        CALL xios_inca_send_field("wetloss_"//hetname(i), wetloss(:,:,i))
411     ENDDO
412
413     do i=1, 2
414        call xios_inca_send_field("phtrate_"//trim(reacname(i)), jrates(:,:,i))
415     enddo
416
417     DO i=1, 1
418        CALL xios_inca_send_field("extfrc_"//trim(extname(i)), extfrc(:,:,i))
419        CALL xios_inca_send_field("extfrc_"//trim(extname(i))//"_col", extfrc_col(:,i))
420     ENDDO
421
422
423
424  CALL xios_inca_send_field("prod_light_col", prod_light_col)
425  CALL xios_inca_send_field("ASAP_p_col", ASAP_p_col)
426  CALL xios_inca_send_field("ASAR_p_col", ASAR_p_col)
427
428
429    ! define surface concentrations of PM2.5, PM10 and PM1 ---- YZ edits
430
431
432  call xios_inca_change_context("LMDZ")
433  if (lafin)  CALL chem_write_restart
434 
435END SUBROUTINE CHEMHOOK_END
436
437
Note: See TracBrowser for help on using the repository browser.