source: CONFIG/publications/ICOLMDZORINCA_CO2_Transport_GMD_2023/INCA/src/INCA_MOD/pht_tables_mod.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: 8.3 KB
Line 
1!$Id: pht_tables_mod.F90 104 2008-12-23 10:28:51Z acosce $
2!! =========================================================================
3!! INCA - INteraction with Chemistry and Aerosols
4!!
5!! Copyright Laboratoire des Sciences du Climat et de l'Environnement (LSCE)
6!!           Unite mixte CEA-CNRS-UVSQ
7!!
8!! Contributors to this INCA subroutine:
9!!
10!! Didier Hauglustaine, LSCE, hauglustaine@cea.fr
11!! Stacy Walters, NCAR, stacy@ucar.edu
12!!
13!! Anne Cozic, LSCE, anne.cozic@cea.fr
14!! Yann Meurdesoif, LSCE, yann.meurdesoif@cea.fr
15!!
16!! This software is a computer program whose purpose is to simulate the
17!! atmospheric gas phase and aerosol composition. The model is designed to be
18!! used within a transport model or a general circulation model. This version
19!! of INCA was designed to be coupled to the LMDz GCM. LMDz-INCA accounts
20!! for emissions, transport (resolved and sub-grid scale), photochemical
21!! transformations, and scavenging (dry deposition and washout) of chemical
22!! species and aerosols interactively in the GCM. Several versions of the INCA
23!! model are currently used depending on the envisaged applications with the
24!! chemistry-climate model.
25!!
26!! This software is governed by the CeCILL  license under French law and
27!! abiding by the rules of distribution of free software.  You can  use,
28!! modify and/ or redistribute the software under the terms of the CeCILL
29!! license as circulated by CEA, CNRS and INRIA at the following URL
30!! "http://www.cecill.info".
31!!
32!! As a counterpart to the access to the source code and  rights to copy,
33!! modify and redistribute granted by the license, users are provided only
34!! with a limited warranty  and the software's author,  the holder of the
35!! economic rights,  and the successive licensors  have only  limited
36!! liability.
37!!
38!! In this respect, the user's attention is drawn to the risks associated
39!! with loading,  using,  modifying and/or developing or reproducing the
40!! software by the user in light of its specific status of free software,
41!! that may mean  that it is complicated to manipulate,  and  that  also
42!! therefore means  that it is reserved for developers  and  experienced
43!! professionals having in-depth computer knowledge. Users are therefore
44!! encouraged to load and test the software's suitability as regards their
45!! requirements in conditions enabling the security of their systems and/or
46!! data to be ensured and,  more generally, to use and operate it in the
47!! same conditions as regards security.
48!!
49!! The fact that you are presently reading this means that you have had
50!! knowledge of the CeCILL license and that you accept its terms.
51!! =========================================================================
52
53#include "inca_define.h"
54
55MODULE PHT_TABLES
56  !----------------------------------------------------------------------
57  !     ... Photolysis interp table and related arrays
58  ! Stacy Walters, NCAR, 1998.
59  ! Modified by Didier Hauglustaine, IPSL, for LMDZ/INCA, 1999.
60  !----------------------------------------------------------------------
61  USE CONST_MOD
62
63  IMPLICIT NONE
64
65
66  INTEGER, PARAMETER :: jdim     = 48
67  INTEGER, PARAMETER :: altmxdim = 80
68  INTEGER, PARAMETER :: altdim   = 24
69  INTEGER, PARAMETER :: zangdim  = 40
70  INTEGER, PARAMETER :: o3ratdim = 7
71  INTEGER, PARAMETER :: albdim   = 4
72  INTEGER, PARAMETER :: t500dim  = 3
73  INTEGER, PARAMETER :: t200dim  = 2
74  INTEGER, PARAMETER :: tabdim   = jdim*altdim*zangdim*o3ratdim &
75     *albdim*t500dim*t200dim
76
77  INTEGER, save :: offset(7)
78!$OMP THREADPRIVATE(offset)
79
80
81!          1 O2 + hv -> O + O
82!          2 O3 -> O2 + O(1D)
83!          3 O3 -> O2 + O(3P)
84!          4 NO2 -> NO + O(3P)
85!          5 NO3 -> NO + O2
86!          6 NO3 -> NO2 + O(3P)
87!          7 N2O5 -> NO3 + NO2
88!          8 HNO2 -> OH + NO
89!          9 HNO3 -> OH + NO2
90!         10 HNO4 -> HO2 + NO2
91!         11 CH3OOH -> CH3O + OH
92!         12 CH2O -> H + HCO
93!         13 CH2O -> H2 + CO
94!         14 H2O2 -> 2 OH
95!         15 N2O + hv -> N2 + O(1D)
96!         16 CCl3F (CFC-11) + hv -> Products
97!         17 CCl2F2 (CFC-12) + hv -> Products
98!         18 CF2ClCFCl2 (CFC-113) + hv -> Products
99!         19 CHClF2 (HCFC-22) + hv -> Products
100!         20 CH3CFCl2 (HCFC-141b) + hv -> Products
101!         21 CH3CF2Cl (HCFC-142b) + hv -> Products
102!         22 CF3Br (Halon-1301) + hv -> Products
103!         23 CF2BrCl (Halon-1211) + hv -> Products
104!         24 CH3CCl3 + hv -> Products
105!         25 CCl4 + hv -> Products
106!         26 CH3Cl + hv -> Products
107!         27 CH3Br + hv -> Products
108!         28 H2O -> H + OH
109!         29 HOCl -> OH + Cl
110!         30 ClONO2 + hv -> Cl + NO3
111!         31 ClONO2 + hv -> ClO + NO2
112!         32 Cl2O2 -> Cl + Cl + O2
113!         33 HCl -> H + Cl
114!         34 Cl2 + hv -> Cl + Cl
115!         35 ClNO2 -> Cl + NO2
116!         36 BrO -> Br + O
117!         37 BrONO2 + hv -> Br + NO3
118!         38 HOBr -> Br + OH
119!         39 OClO -> O + ClO
120!         40 BrCl -> Br + Cl
121!         41 CO2 -> CO + O
122!         42 CH3CHO -> products
123!         43 CH3COCH3 -> products
124!         44 CH3COCHO -> products
125!         45 MVK -> products
126!         46 PAN + hv -> products
127!         47 MACR -> products
128!         48 CH3ONO2 -> CH3O + NO2
129
130#ifdef NMHC
131#ifdef STRAT
132!NMHC_AER_S
133  INTEGER, save ::  indexer(jdim) =    & !mapping to full photorate matrix
134     (/ 1, 2, 3, 4, 5, 6, 7, 8, 9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,&
135       31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48 /)
136!$OMP THREADPRIVATE(indexer)
137#else
138!NMHC & NMHC_AER Tropo
139  INTEGER, save ::  indexer(jdim) =    & !mapping to full photorate matrix
140     (/ 1, 2, 3, 4, 5, 6, 7, 8, 9,10,11,12,13,14,15,0,0,0,0,0,0,0,0,0,0,16,0,17,0,0,&
141       0,0,0,0,0,0,0,0,0,0,0,18,19,20,21,22,23,24 /)
142!$OMP THREADPRIVATE(indexer)
143#endif
144#endif
145#ifdef GES
146!GES
147  INTEGER, save ::  indexer(jdim) =    & !mapping to full photorate matrix
148       (/ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, &
149       0,0,0,0,0,0,0,0 /)       
150!$OMP THREADPRIVATE(indexer)
151#endif
152#ifdef AERONLY
153#ifdef DUSS 
154!DUSS
155  INTEGER, save ::  indexer(jdim) =    & !mapping to full photorate matrix
156       (/ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, &
157       0,0,0,0,0,0,0,0 /)       
158!$OMP THREADPRIVATE(indexer)
159#else
160!AER
161  INTEGER, save ::  indexer(jdim) =    & !mapping to full photorate matrix
162       (/ 0,0,0,0,2,3,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, &
163       0,0,0,0,0,0,0,0 /)       
164!$OMP THREADPRIVATE(indexer)
165#endif
166#endif
167  REAL, save ::  ajl(tabdim) = 0.
168  REAL, save ::  vo3(0:altmxdim)
169  REAL, save ::  delz(altdim-1)
170  REAL, save ::  delang(zangdim-1)
171  REAL, save ::  delv(o3ratdim-1)
172  REAL, save ::  delalb(albdim-1)
173  REAL, save ::  delt500(t500dim-1)
174  REAL, save ::  delt200(t200dim-1)
175!$OMP THREADPRIVATE( ajl, vo3, delz, delang, delv, delalb, delt500, delt200)
176 
177  REAL, save :: zz(altdim) =   &
178     (/ 0., 1., 2., 3., 5., 7., 9., 12., 15., 18., 21., 24.,   &
179     27., 30., 35., 40., 45., 50., 55., 60., 65., 70., 75., 79. /)
180  REAL, save :: vsec(zangdim)
181  REAL, save :: dsza(zangdim) = &
182     (/ 0.,     5.,     10.,   15.,   20.,  25.,    &
183        30.,   35.,   40.,   45.,   50.,  55.,    &
184        60.,   65.,   70.,   75.,   80.,  81.,    &
185        82.,   83.,   84.,   85.,   86.,  87.,    &
186        88.,   89.,   89.1,  89.2,  89.3, 89.4,   &
187        89.5,  89.6,  89.7,  89.8,  89.9, 89.92,  &
188        89.94, 89.96, 89.98, 89.99 /)
189!$OMP THREADPRIVATE(dsza)
190
191
192
193  REAL, save :: xv3(o3ratdim) = (/ .5, .75, 1., 1.25, 1.5, 2., 5. /)
194  REAL, save :: albev(albdim) = (/ .05, .2, .5, 1. /)
195  REAL, save :: t500(t500dim) = (/ 228., 248., 268. /)
196  REAL, save :: t200(t200dim) = (/ 205., 225. /)
197!$OMP THREADPRIVATE(zz,vsec,xv3,albev,t500,t200)
198
199REAL, DIMENSION(jdim) , save :: alpha =                     &!Chang et al., 1987
200     (/ 1.0, 0.7, 1.0, 1.2, 1.3, 1.0, 1.0, 1.0, 1.0, 1.0, &
201        1.0, 1.1, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, &
202        1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, &
203        1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, &
204        1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0 /)
205!$OMP THREADPRIVATE(alpha)
206
207
208  REAL,SAVE,ALLOCATABLE :: jrates(:,:,:)
209!$OMP THREADPRIVATE(jrates)
210 
211CONTAINS
212       
213  SUBROUTINE init_pht_tables
214    USE INCA_DIM
215    IMPLICIT NONE
216   
217    ALLOCATE(jrates(PLON,PLEV,PHTCNT))
218         
219  END SUBROUTINE init_pht_tables
220       
221END MODULE PHT_TABLES
222
Note: See TracBrowser for help on using the repository browser.