Changeset 2542 for trunk/LMDZ.GENERIC


Ignore:
Timestamp:
Jul 5, 2021, 2:44:34 PM (3 years ago)
Author:
aslmd
Message:

Generic GCM:

Large update of the chemical modules

  • Read chemical network from input files
  • Init chemistry with ModernTrac?
  • Photolysis online calculation

YJ

Location:
trunk/LMDZ.GENERIC
Files:
5 added
1 deleted
16 edited

Legend:

Unmodified
Added
Removed
  • trunk/LMDZ.GENERIC/README

    r2537 r2542  
    16621662==16/06/2021 == MT
    16631663- Add the Surface SW spectrum in diagspecVI netcdf output file (useful as a diagnostic of surface radiation condition for e.g. habitability studies)
     1664
     1665== 05/07/2021 == YJ
     1666Large update of the chemical modules
     1667- Read chemical network from input files
     1668- Init chemistry with ModernTrac
     1669- Photolysis online calculation
  • trunk/LMDZ.GENERIC/deftank/traceur.def.modern

    r2436 r2542  
    2222#               only mandatory information ! But you can specify all the options you
    2323#               want in separate blocks following 'option=value', assuming this option
    24 #               is defined in traceur_h.F90 & initracer.F for physics or infotrac.F90
    25 #               for dynamics. Indeed this file is read once by dynamics who keep only
    26 #               the information needed and re-read by physics.
     24#               is defined in traceur_h.F90 & initracer.F for physics, infotrac.F90
     25#               for dynamics or chimiedata_h.F90 & calchim_asis.F90 for chemistry.
     26#               Indeed this file is read once by dynamics, once by physics and once by
     27#               chemistry who keep only the information needed.
    2728#
    2829#               Note that by default a tracer listed below will be sent to dynamics
    2930#               except if you specify is_dyn=0. If nothing is given, then is_dyn=1.
     31#               Not yet fully implemented.
    3032#
    3133# 3. Options.   Implemented options listed below.
    3234# ~~~~~~~~~~~~  For dynamic see "infotrac.F90".
    3335#               For physic see "initracer.F90".
     36#               For chemistry see "calchim_asis.F90".
     37#                        init see "inichim_1D.F90" and "inichim_newstart.F90"
    3438#
    35 # Dynamic:      vadv        ! index of vertical trasport schema
    36 #               hadv        ! index of horizontal trasport schema
    37 #               tnom_transp ! transporting fluid short name: CRisi
     39# Dynamic:      vadv           ! index of vertical trasport schema
     40#               hadv           ! index of horizontal trasport schema
     41#               tnom_transp    ! transporting fluid short name: CRisi
    3842#
    39 # Physic:       mmol        ! mole mass of tracer (g/mol-1)
     43# Physic:       mmol           ! mole mass of tracer [g.mol-1]
     44#               aki            ! coefficient of thermal concduction
     45#               cpi            ! heat capacity [J.kg-1.K-1]
     46#               is_chim        ! 1 if tracer used in chemistry, else 0
    4047#
     48# Chemistry:    SF_mode        ! 1 if surface set up value, else 2 sedimentation velocity
     49#               SF_value       ! [vmr] if SF_mode=1, else [cm.s-1]
     50#               prod_rate      ! if SF_mode=2 production flux [molecules.m-2.s-1]
     51#
     52#      init:    qx             ! value that initialize constant profile [vmr]
     53#               qxf            ! file that initialize profile [Pa,vmr] (1 line header)
    4154#
    4255#
  • trunk/LMDZ.GENERIC/libf/aeronostd/calchim_asis.F90

    r1811 r2542  
    33                         zzlev,zzlay,zday,pq,pdq,dqchim,dqschim,            &
    44                         tauref,co2ice,                                     &
    5                          pu,pdu,pv,pdv,surfdust,surfice)
    6 
    7       use tracer_h, only:   igcm_co2, igcm_co, igcm_o, igcm_o1d, igcm_o2, &
    8                             igcm_o3, igcm_h, igcm_h2, igcm_oh, igcm_ho2,  &
    9                             igcm_h2o2, igcm_ch4, igcm_n2, igcm_h2o_vap,   &
    10                             igcm_n, igcm_no, igcm_no2, igcm_n2d,   &
    11                             mmol
     5                         pu,pdu,pv,pdv,surfdust,surfice,icount,zdtchim)
     6
     7      use tracer_h, only: mmol, noms, nesp, is_chim
    128
    139      use conc_mod, only: mmean ! mean molecular mass of the atmosphere
    1410      USE comcstfi_mod
    1511      use callkeys_mod
     12      use time_phylmdz_mod, only: ecritphy, iphysiq ! output rate set by ecritphy
     13      use types_asis,       only: v_phot_3d, jlabel, nb_phot_hv_max
     14      use chimiedata_h
     15      use radcommon_h,      only: glat
    1616
    1717      implicit none
     
    3535!    update 11/12/2013 optimization (Franck Lefevre)
    3636!    update 20/10/2017 adapted to LMDZ GENERIC+cosmetic changes (Benjamin Charnay)
     37!    update 06/03/2021 generic tracer/network + photolysis online (Yassin Jaziri)
    3738!
    3839!   Arguments:
     
    6263!  Output:
    6364!
    64 !    dqchim(ngrid,nlayer,nq) ! tendencies on pq due to chemistry
    65 !    dqschim(ngrid,nq)         ! tendencies on qsurf
    66 !
    67 !=======================================================================
    68 
    69 #include "chimiedata.h"
     65!    dqchim(ngrid,nlayer,nesp)   ! tendencies on pq due to chemistry
     66!    dqschim(ngrid,nesp)         ! tendencies on qsurf
     67!
     68!=======================================================================
    7069
    7170!     input:
     
    7675      real :: ptimestep
    7776      real :: pplay(ngrid,nlayer)    ! pressure at the middle of the layers
    78       real :: zzlay(ngrid,nlayer)    ! pressure at the middle of the layers
     77      real :: zzlay(ngrid,nlayer)    ! altitude at the middle of the layers
    7978      real :: pplev(ngrid,nlayer+1)  ! intermediate pressure levels
    8079      real :: zzlev(ngrid,nlayer+1)  ! altitude at layer boundaries
     
    9796!     output:
    9897
    99       real :: dqchim(ngrid,nlayer,nq)   ! tendencies on pq due to chemistry
    100       real :: dqschim(ngrid,nq)         ! tendencies on qsurf
     98      real :: dqchim(ngrid,nlayer,nesp)   ! tendencies on pq due to chemistry
     99      real :: dqschim(ngrid,nesp)         ! tendencies on qsurf
    101100
    102101!     local variables:
    103102
    104       integer,save :: nbq                   ! number of tracers used in the chemistry
    105       integer,allocatable,save :: niq(:)    ! array storing the indexes of the tracers
    106       integer :: iloc(1)                    ! index of major species
    107       integer :: ig,l,i,iq,iqmax
    108       integer :: foundswitch, lswitch
     103      integer :: iloc(1)                  ! index of major species
     104      integer :: ig,l,i,iq,iqmax,iesp
     105      integer :: foundswitch, lswitch     ! to switch between photochem and thermochem ? (YJ)
    109106      integer,save :: chemthermod
    110107
    111       integer,save :: i_co2  = 0
    112       integer,save :: i_co   = 0
    113       integer,save :: i_o    = 0
    114       integer,save :: i_o1d  = 0
    115       integer,save :: i_o2   = 0
    116       integer,save :: i_o3   = 0
    117       integer,save :: i_h    = 0
    118       integer,save :: i_h2   = 0
    119       integer,save :: i_oh   = 0
    120       integer,save :: i_ho2  = 0
    121       integer,save :: i_h2o2 = 0
    122       integer,save :: i_ch4  = 0
    123       integer,save :: i_n2   = 0
    124       integer,save :: i_h2o  = 0
    125       integer,save :: i_n    = 0
    126       integer,save :: i_no    = 0
    127       integer,save :: i_no2    = 0
    128       integer,save :: i_n2d    = 0
    129 
    130       integer :: ig_vl1
    131 
    132       real    :: latvl1, lonvl1
    133       real    :: zq(ngrid,nlayer,nq)   ! pq+pdq*ptimestep before chemistry
     108      real    :: zq(ngrid,nlayer,nesp) ! pq+pdq*ptimestep before chemistry
    134109                                       ! new mole fraction after
    135110      real    :: zt(ngrid,nlayer)      ! temperature
     
    137112      real    :: zv(ngrid,nlayer)      ! v component of the wind
    138113      real    :: taucol                ! optical depth at 7 hPa
    139 
     114      real    :: xmmol(nlayer,nesp)    ! mmol/mmean but only for chemical species
     115 
    140116      logical,save :: firstcall = .true.
    141       logical,save :: depos = .false.  ! switch for dry deposition
    142117
    143118!     for each column of atmosphere:
     
    147122      real :: ztemp(nlayer)        ! Temperature (K)
    148123      real :: zlocal(nlayer)       ! Altitude (km)
    149       real :: zycol(nlayer,nq)     ! Composition (mole fractions)
     124      real :: zycol(nlayer,nesp)   ! Composition (mole fractions)
    150125      real :: zmmean(nlayer)       ! Mean molecular mass (g.mole-1)
    151126      real :: szacol               ! Solar zenith angle
     
    154129      real :: surfice1d(nlayer)    ! Ice surface area (cm2/cm3)
    155130      real :: surfdust1d(nlayer)   ! Dust surface area (cm2/cm3)
    156       real :: jo3(nlayer)          ! Photodissociation rate O3->O1D (s-1)
    157131
    158132      integer :: iter(nlayer)      !  Number of chemical iterations
    159133                                   !  within one physical timestep
    160 
     134      integer :: icount
    161135!     for output:
    162136
    163       logical :: output             ! to issue calls to writediagfi and stats
     137      logical :: output              ! to issue calls to writediagfi and stats
    164138      parameter (output = .true.)
    165       real :: jo3_3d(ngrid,nlayer)  ! Photodissociation rate O3->O1D (s-1)
    166       real :: iter_3d(ngrid,nlayer) ! Number of chemical iterations
    167                                     !  within one physical timestep
     139      real :: iter_3d(ngrid,nlayer)  ! Number of chemical iterations
     140                                     !  within one physical timestep
     141      integer           ::  ierr
     142      real              ::  zdtchim(ngrid,nlayer)    ! temperature modification by chemistry
     143      real              ::  dEzchim(ngrid,nlayer)    ! energy modification by chemistry
     144      real              ::  zdtchim_output(ngrid)    ! flux modification by chemistry in W.m-2
    168145
    169146!=======================================================================
     
    173150      if (firstcall) then
    174151
    175          if (photochem) then
    176             print*,'calchim: Read photolysis lookup table'
    177             call read_phototable
    178          end if
    179          ! find index of chemical tracers to use
    180          allocate(niq(nq))
    181          ! Listed here are all tracers that can go into photochemistry
    182          nbq = 0 ! to count number of tracers
    183          ! Species ALWAYS present if photochem=.T. or thermochem=.T.
    184          i_co2 = igcm_co2
    185          if (i_co2 == 0) then
    186             write(*,*) "calchim: Error; no CO2 tracer !!!"
    187             stop
    188          else
    189             nbq = nbq + 1
    190             niq(nbq) = i_co2
    191          end if
    192          i_co = igcm_co
    193          if (i_co == 0) then
    194             write(*,*) "calchim: Error; no CO tracer !!!"
    195             stop
    196          else
    197             nbq = nbq + 1
    198             niq(nbq) = i_co
    199          end if
    200          i_o = igcm_o
    201          if (i_o == 0) then
    202             write(*,*) "calchim: Error; no O tracer !!!"
    203             stop
    204          else
    205             nbq = nbq + 1
    206             niq(nbq) = i_o
    207          end if
    208          i_o1d = igcm_o1d
    209          if (i_o1d == 0) then
    210             write(*,*) "calchim: Error; no O1D tracer !!!"
    211             stop
    212          else
    213             nbq = nbq + 1
    214             niq(nbq) = i_o1d
    215          end if
    216          i_o2 = igcm_o2
    217          if (i_o2 == 0) then
    218             write(*,*) "calchim: Error; no O2 tracer !!!"
    219             stop
    220          else
    221             nbq = nbq + 1
    222             niq(nbq) = i_o2
    223          end if
    224          i_o3 = igcm_o3
    225          if (i_o3 == 0) then
    226             write(*,*) "calchim: Error; no O3 tracer !!!"
    227             stop
    228          else
    229             nbq = nbq + 1
    230             niq(nbq) = i_o3
    231          end if
    232          i_h = igcm_h
    233          if (i_h == 0) then
    234             write(*,*) "calchim: Error; no H tracer !!!"
    235             stop
    236          else
    237             nbq = nbq + 1
    238             niq(nbq) = i_h
    239          end if
    240          i_h2 = igcm_h2
    241          if (i_h2 == 0) then
    242             write(*,*) "calchim: Error; no H2 tracer !!!"
    243             stop
    244          else
    245             nbq = nbq + 1
    246             niq(nbq) = i_h2
    247          end if
    248          i_oh = igcm_oh
    249          if (i_oh == 0) then
    250             write(*,*) "calchim: Error; no OH tracer !!!"
    251             stop
    252          else
    253             nbq = nbq + 1
    254             niq(nbq) = i_oh
    255          end if
    256          i_ho2 = igcm_ho2
    257          if (i_ho2 == 0) then
    258             write(*,*) "calchim: Error; no HO2 tracer !!!"
    259             stop
    260          else
    261             nbq = nbq + 1
    262             niq(nbq) = i_ho2
    263          end if
    264          i_h2o2 = igcm_h2o2
    265          if (i_h2o2 == 0) then
    266             write(*,*) "calchim: Error; no H2O2 tracer !!!"
    267             stop
    268          else
    269             nbq = nbq + 1
    270             niq(nbq) = i_h2o2
    271          end if
    272          i_ch4 = igcm_ch4
    273          if (i_ch4 == 0) then
    274             write(*,*) "calchim: Error; no CH4 tracer !!!"
    275             write(*,*) "CH4 will be ignored in the chemistry"
    276          else
    277             nbq = nbq + 1
    278             niq(nbq) = i_ch4
    279          end if
    280          i_n2 = igcm_n2
    281          if (i_n2 == 0) then
    282             write(*,*) "calchim: Error; no N2 tracer !!!"
    283             stop
    284          else
    285             nbq = nbq + 1
    286             niq(nbq) = i_n2
    287          end if
    288          i_n = igcm_n
    289          if (i_n == 0) then
    290             if (photochem) then
    291                write(*,*) "calchim: Error; no N tracer !!!"
    292                write(*,*) "N will be ignored in the chemistry"
     152!! Moved to routine indice in photochemistry_asis
     153!! because nb_phot_hv_max value needed in order
     154!! to choose if we call read_phototable or not.
     155!! A cleaner solution need to be find.
     156!         if (photochem .and. .not. jonline) then
     157!           print*,'calchim: Read photolysis lookup table'
     158!           call read_phototable
     159!         end if
     160
     161         if (.not.allocated(SF_mode))       allocate(SF_mode(nesp))
     162         if (.not.allocated(SF_value))      allocate(SF_value(nesp))
     163         if (.not.allocated(prod_rate))     allocate(prod_rate(nesp))
     164         if (.not.allocated(surface_flux))  allocate(surface_flux(ngrid,nesp))
     165         if (.not.allocated(surface_flux2)) allocate(surface_flux2(ngrid,nesp))
     166         if (.not.allocated(escape))        allocate(escape(ngrid,nesp))
     167         if (.not.allocated(chemnoms))      allocate(chemnoms(nesp))
     168
     169         surface_flux(:,:)  = 0.
     170         surface_flux2(:,:) = 0.
     171         escape(:,:)        = 0.
     172         SF_mode(:)         = 2
     173         SF_value(:)        = 0.
     174         prod_rate(:)       = 0.
     175         iter_3d(:,:)       = 0.
     176         iter(:)            = 0.
     177
     178         call ini_tracchim
     179
     180         ! Sanity check mmol /= 0. in chemistry
     181         do iq = 1,nq
     182            if (is_chim(iq).eq.1 .and. mmol(iq).eq.0.) then
     183               write(*,*) 'Error in calchim:'
     184               write(*,*) 'Mmol cannot be equal to 0 for chemical species'
     185               stop
    293186            end if
    294          else
    295             nbq = nbq + 1
    296             niq(nbq) = i_n
    297          end if
    298          i_n2d = igcm_n2d
    299          if (i_n2d == 0) then
    300             if (photochem) then
    301                write(*,*) "calchim: Error; no N2D tracer !!!"
    302                write(*,*) "N2d will be ignored in the chemistry"
    303             end if
    304          else
    305             nbq = nbq + 1
    306             niq(nbq) = i_n2d
    307          end if
    308          i_no = igcm_no
    309          if (i_no == 0) then
    310             if (photochem) then
    311                write(*,*) "calchim: Error; no NO tracer !!!"
    312                write(*,*) "NO will be ignored in the chemistry"
    313             end if
    314          else
    315             nbq = nbq + 1
    316             niq(nbq) = i_no
    317          end if
    318          i_no2 = igcm_no2
    319          if (i_no2 == 0) then
    320             if (photochem) then
    321                write(*,*) "calchim: Error; no NO2 tracer !!!"
    322                write(*,*) "NO2 will be ignored in the chemistry"
    323             end if
    324          else
    325             nbq = nbq + 1
    326             niq(nbq) = i_no2
    327          end if
    328          i_h2o = igcm_h2o_vap
    329          if (i_h2o == 0) then
    330             write(*,*) "calchim: Error; no water vapor tracer !!!"
    331             stop
    332          else
    333             nbq = nbq + 1
    334             niq(nbq) = i_h2o
    335          end if
    336          !Check tracers needed for thermospheric chemistry
    337 !         if(thermochem) then
    338 !            chemthermod=0  !Default: C/O/H chemistry
    339 !            !Nitrogen chemistry
    340 !            !NO is used to determine if N chemistry is wanted
    341 !            !chemthermod=2 -> N chemistry
    342 !            if (i_no == 0) then
    343 !               write(*,*) "calchim: no NO tracer"
    344 !               write(*,*) "C/O/H themosp chemistry only "
    345 !            else
    346 !               chemthermod=2
    347 !               write(*,*) "calchim: NO in traceur.def"
    348 !               write(*,*) "Nitrogen chemistry included"
    349 !            end if
    350 !            ! N
    351 !            if(chemthermod == 2) then
    352 !               if (i_n == 0) then
    353 !                  write(*,*) "calchim: Error; no N tracer !!!"
    354 !                  write(*,*) "N is needed if NO is in traceur.def"
    355 !                  stop
    356 !               end if
    357 !            ! NO2
    358 !               if (i_no2 == 0) then
    359 !                  write(*,*) "calchim: Error; no NO2 tracer !!!"
    360 !                  write(*,*) "NO2 is needed if NO is in traceur.def"
    361 !                  stop
    362 !               end if
    363 !            ! N(2D)
    364 !               if (i_n2d == 0) then
    365 !                  write(*,*) "calchim: Error; no N2D !!!"
    366 !                  write(*,*) "N2D is needed if NO is in traceur.def"
    367 !                  stop
    368 !               end if
    369 !            endif    !Of if(chemthermod == 2)
    370 !         endif      !Of thermochem
    371 
    372          write(*,*) 'calchim: found nbq    = ',nbq,' tracers'
    373                
     187         end do
     188
    374189         firstcall = .false.
    375190      end if ! if (firstcall)
     
    380195      dqchim(:,:,:) = 0.
    381196      dqschim(:,:)  = 0.
    382 
    383 !     latvl1= 22.27
    384 !     lonvl1= -47.94
    385 !     ig_vl1= 1+ int( (1.5-(latvl1-90.)*jjm/180.)  -2 )*iim +    &
    386 !             int(1.5+(lonvl1+180)*iim/360.)
    387197
    388198!=======================================================================
     
    394204         foundswitch = 0
    395205         do l = 1,nlayer
    396             do i = 1,nbq
    397                iq = niq(i) ! get tracer index
    398                zq(ig,l,iq) = pq(ig,l,iq) + pdq(ig,l,iq)*ptimestep
    399                zycol(l,iq) = zq(ig,l,iq)*mmean(ig,l)/mmol(iq)
    400             end do
     206            iesp = 0
     207            do iq = 1,nq
     208               if (is_chim(iq).eq.1) then
     209                  iesp = iesp + 1
     210                  zq(ig,l,iesp) = pq(ig,l,iq) + pdq(ig,l,iq)*ptimestep
     211                  xmmol(l,iesp) = mmol(iq)/mmean(ig,l)
     212                  zycol(l,iesp) = zq(ig,l,iesp)/xmmol(l,iesp)
     213               end if
     214            end do
     215
    401216            zt(ig,l)  = pt(ig,l) + pdt(ig,l)*ptimestep
    402217            zu(ig,l)  = pu(ig,l) + pdu(ig,l)*ptimestep
     
    430245         end do ! of do l=1,nlayer
    431246
    432          szacol = acos(mu0(ig))*180./pi
    433          taucol = tauref(ig)*(700./610.)  ! provisoire en attente de nouveau jmars
    434          fractcol=fract(ig)
     247         szacol   = acos(mu0(ig))*180./pi
     248         taucol   = tauref(ig)*(700./610.)  ! provisoire en attente de nouveau jmars
     249         fractcol = fract(ig)
    435250
    436251!=======================================================================
     
    440255!        chemistry in lower atmosphere
    441256
    442          if (photochem) then
    443 
    444             call photochemistry_asis(nlayer,nq,ngrid,                          &
    445                                 ig,lswitch,zycol,szacol,fractcol,ptimestep,    &
    446                                 zpress,ztemp,zdens,zmmean,dist_sol,            &
    447                                 surfdust1d,surfice1d,jo3,taucol,iter)
    448 
    449 !        ozone photolysis, for output
    450 
     257!         if (photochem) then
     258
     259            call photochemistry_asis(nlayer,ngrid,                         &
     260                                ig,lswitch,zycol,szacol,fractcol,ptimestep,&
     261                                zpress,zlocal,ztemp,zdens,zmmean,dist_sol, &
     262                                surfdust1d,surfice1d,taucol,iter,zdtchim(ig,:))
     263
     264            ! diagnostic photochemical heating
     265            zdtchim_output(ig) = 0.
    451266            do l = 1,nlayer
    452                jo3_3d(ig,l) = jo3(l)
     267              dEzchim(ig,l) = zdtchim(ig,l)*cpp*(pplev(ig,l) - pplev(ig,l+1))/glat(ig)
     268              zdtchim_output(ig) = zdtchim_output(ig) + zdtchim(ig,l)*cpp*(pplev(ig,l) - pplev(ig,l+1))/glat(ig)
     269            end do
     270
     271            do l = 1,nlayer
    453272               iter_3d(ig,l) = iter(l)
    454273            end do
    455 
    456 !        condensation of h2o2
    457 
    458 !            call perosat(ngrid, nlayer, nq,                        &
    459 !                         ig,ptimestep,pplev,pplay,                 &
    460 !                         ztemp,zycol,dqcloud,dqscloud)
    461          end if
    462274
    463275!        chemistry in upper atmosphere
     
    470282!        dry deposition
    471283
    472 !         if (depos) then
    473 !            call deposition(ngrid, nlayer, nq,                      &
    474 !                            ig, ig_vl1, pplay, pplev, zzlay, zzlev, &
    475 !                            zu, zv, zt, zycol, ptimestep, co2ice)
    476 !         end if
     284         if (depos) then
     285            call deposition_source(ngrid, nlayer, nq,   &
     286                        ig, zzlay, zzlev, zdens, zycol, ptimestep)
     287            surface_flux2(ig,:) = surface_flux2(ig,:) + surface_flux(ig,:)
     288            if (ngrid==1) then
     289              if(mod(icount,ecritphy).eq.0) then
     290                surface_flux2(ig,:) = surface_flux2(ig,:)/float(ecritphy)
     291              endif
     292            else
     293              if(mod(icount*iphysiq,ecritphy).eq.0) then
     294                surface_flux2(ig,:) = surface_flux2(ig,:)*iphysiq/float(ecritphy)
     295              endif
     296            endif
     297         end if
    477298
    478299!=======================================================================
     
    489310            iloc=maxloc(zycol(l,:))
    490311            iqmax=iloc(1)
    491             do i = 1,nbq
    492                iq = niq(i) ! get tracer index
     312            do iq = 1,nesp
    493313               if (iq /= iqmax) then
    494                   dqchim(ig,l,iq) = (zycol(l,iq)*mmol(iq)/mmean(ig,l) - zq(ig,l,iq))/ptimestep
     314                  dqchim(ig,l,iq) = (zycol(l,iq)*xmmol(l,iq) - zq(ig,l,iq))/ptimestep
    495315                  dqchim(ig,l,iq) = max(dqchim(ig,l,iq),-zq(ig,l,iq)/ptimestep)
    496316                  dqchim(ig,l,iqmax) = dqchim(ig,l,iqmax) - dqchim(ig,l,iq)
    497317               end if
    498318            end do
     319
    499320         end do ! of do l = 1,nlayer
    500321
     
    508329!=======================================================================
    509330
    510       end do ! of do ig=1,ngrid
     331      end do ! of do ig=1,ngridbidon(ig,:) = 1
    511332
    512333!=======================================================================
     
    516337! value of parameter 'output' to trigger writting of outputs
    517338! is set above at the declaration of the variable.
    518 
    519339      if (photochem .and. output) then
    520             call writediagfi(ngrid,'jo3','j o3->o1d',    &
    521                              's-1',3,jo3_3d(1,1))
    522             call writediagfi(ngrid,'iter','iterations',  &
     340
     341         if (callstats) then
     342            ! photoloysis
     343            do i=1,nb_phot_hv_max
     344               call wstats(ngrid,trim(jlabel(i,1)),jlabel(i,1),    &
     345                                's-1',3,v_phot_3d(1,1,i))
     346            end do
     347            ! iter
     348            call wstats(ngrid,'iter','iterations',  &
    523349                             ' ',3,iter_3d(1,1))
    524             if (callstats) then
    525                call wstats(ngrid,'jo3','j o3->o1d',       &
    526                            's-1',3,jo3_3d(1,1))
    527                call wstats(ngrid,'mmean','mean molecular mass',       &
     350            ! phothcemical heating
     351            call wstats(ngrid,'zdtchim','dT chim',    &
     352                             'K.s-1',3,zdtchim)
     353            call wstats(ngrid,'dEzchim','dE chim',    &
     354                             'W m-2',3,dEzchim)
     355            call wstats(ngrid,"Ezchim","integrated dT chim","W m-2",2,zdtchim_output)
     356            ! Mean molecular mass
     357            call wstats(ngrid,'mmean','mean molecular mass',       &
    528358                           'g.mole-1',3,mmean(1,1))
     359            ! Chemical tendencies
     360            do iesp=1,nesp
     361               call wstats(ngrid,trim(chemnoms(iesp))//'_dq',trim(chemnoms(iesp))//'_dq',    &
     362                               'kg/kg s^-1',3,dqchim(1,1,iesp) )
     363            end do
     364            if (depos) then
     365               ! Surface fluxes
     366               do iesp=1,nesp
     367                  call wstats(ngrid,trim(chemnoms(iesp))//'_flux_mean',trim(chemnoms(iesp))//' mean flux',    &
     368                               'molecule.m-2.s-1',2,surface_flux2(1,indexchim(trim(chemnoms(iesp)))))
     369                  call wstats(ngrid,trim(chemnoms(iesp))//'_flux',trim(chemnoms(iesp))//' flux',    &
     370                               'molecule.m-2.s-1',2,surface_flux(1,indexchim(trim(chemnoms(iesp)))))
     371               end do
     372            endif ! end depos
     373         endif ! end callstats
     374
     375         ! photoloysis
     376         do i=1,nb_phot_hv_max
     377            call writediagfi(ngrid,trim(jlabel(i,1)),jlabel(i,1),    &
     378                             's-1',3,v_phot_3d(1,1,i))
     379         end do
     380         ! iter
     381         call writediagfi(ngrid,'iter','iterations',  &
     382                          ' ',3,iter_3d(1,1))
     383         ! phothcemical heating
     384         call writediagfi(ngrid,'zdtchim','dT chim',    &
     385                          'K.s-1',3,zdtchim)
     386         call writediagfi(ngrid,'dEzchim','dE chim',    &
     387                          'W m-2',3,dEzchim)
     388         call writediagfi(ngrid,"Ezchim","integrated dT chim","W m-2",2,zdtchim_output)
     389         ! Mean molecular mass
     390         call writediagfi(ngrid,'mmean','mean molecular mass',       &
     391                        'g.mole-1',3,mmean(1,1))
     392         ! Chemical tendencies
     393         do iesp=1,nesp
     394            call writediagfi(ngrid,trim(chemnoms(iesp))//'_dq',trim(chemnoms(iesp))//'_dq',    &
     395                            'kg/kg s^-1',3,dqchim(1,1,iesp) )
     396         end do
     397         if (depos) then
     398            ! Surface fluxes
     399            do iesp=1,nesp
     400               call writediagfi(ngrid,trim(chemnoms(iesp))//'_flux_mean',trim(chemnoms(iesp))//' mean flux',    &
     401                            'molecule.m-2.s-1',2,surface_flux2(1,indexchim(trim(chemnoms(iesp)))))
     402               call writediagfi(ngrid,trim(chemnoms(iesp))//'_flux',trim(chemnoms(iesp))//' flux',    &
     403                            'molecule.m-2.s-1',2,surface_flux(1,indexchim(trim(chemnoms(iesp)))))
     404            end do
     405            ! Restart flux average
     406            if (ngrid == 1) then
     407               if(mod(icount,ecritphy).eq.0) then
     408                  surface_flux2(:,:) = 0.0
     409               endif
     410            else
     411               if(mod(icount*iphysiq,ecritphy).eq.0) then
     412                  surface_flux2(:,:) = 0.0
     413               endif
    529414            endif
     415         endif ! end depos
     416
    530417      end if ! of if (output)
    531418
    532419      return
    533       end
     420
     421
     422      contains
     423
     424
     425!======================================================================
     426
     427      subroutine ini_tracchim
     428
     429!======================================================================
     430! YJ Modern tracer.def
     431! Get in tracer.def chemical parameters
     432!======================================================================
     433
     434         use chimiedata_h
     435         use tracer_h, only:   is_chim
     436         implicit none
     437
     438         ! local
     439         character(len=500) :: tracline ! to store a line of text
     440         integer            :: nq       ! number of tracers
     441         integer            :: iesp, iq
     442
     443         ! Get nq
     444         open(90,file='traceur.def',status='old',form='formatted',iostat=ierr)
     445         if (ierr.eq.0) then
     446           READ(90,'(A)') tracline
     447           IF (trim(tracline).ne.'#ModernTrac-v1') THEN ! Test modern traceur.def
     448            READ(tracline,*,iostat=ierr) nq ! Try standard traceur.def
     449           ELSE
     450              DO
     451                READ(90,'(A)',iostat=ierr) tracline
     452                IF (ierr.eq.0) THEN
     453                  IF (index(tracline,'#').ne.1) THEN ! Allows arbitary number of comments lines in the header
     454                    READ(tracline,*,iostat=ierr) nq
     455                    EXIT
     456                  ENDIF
     457                ELSE ! If pb, or if reached EOF without having found number of tracer
     458                   write(*,*) "calchim: error reading line of tracers"
     459                   write(*,*) "   (first lines of traceur.def) "
     460                   stop
     461                ENDIF
     462              ENDDO
     463           ENDIF ! if modern or standard traceur.def
     464         else
     465            write(*,*) "calchim: error opening traceur.def"
     466            stop
     467         endif
     468
     469         ! Get data of tracers
     470         iesp = 0
     471         do iq=1,nq
     472            read(90,'(A)') tracline
     473            if (is_chim(iq).eq.1) then
     474               iesp = iesp + 1
     475               read(tracline,*) chemnoms(iesp)
     476               write(*,*)"ini_tracchim: iq=",iq,"noms(iq)=",trim(chemnoms(iesp))
     477               if (index(tracline,'SF_mode='    ) /= 0) then
     478                  read(tracline(index(tracline,'SF_mode=')+len('SF_mode='):),*) SF_mode(iesp)
     479                  write(*,*) ' Parameter value (traceur.def) : SF_mode=', SF_mode(iesp)
     480               else
     481                  write(*,*) ' Parameter value (default)     : SF_mode=', SF_mode(iesp)
     482               end if
     483               if (index(tracline,'SF_value='    ) /= 0) then
     484                  read(tracline(index(tracline,'SF_value=')+len('SF_value='):),*) SF_value(iesp)
     485                  write(*,*) ' Parameter value (traceur.def) : SF_value=', SF_value(iesp)
     486               else
     487                  write(*,*) ' Parameter value (default)     : SF_value=', SF_value(iesp)
     488               end if
     489               if (index(tracline,'prod_rate='    ) /= 0) then
     490                  read(tracline(index(tracline,'prod_rate=')+len('prod_rate='):),*) prod_rate(iesp)
     491                  write(*,*) ' Parameter value (traceur.def) : prod_rate=', prod_rate(iesp)
     492               else
     493                  write(*,*) ' Parameter value (default)     : prod_rate=', prod_rate(iesp)
     494               end if
     495            end if
     496         end do
     497
     498         close(90)
     499
     500      end subroutine ini_tracchim
     501
     502      end subroutine calchim_asis
     503
  • trunk/LMDZ.GENERIC/libf/aeronostd/concentrations.F

    r1796 r2542  
    22     &                          pplay,pt,pdt,pq,pdq,ptimestep)
    33                                             
    4       use tracer_h, only: igcm_co2, igcm_co, igcm_o, igcm_o1d,
    5      &                      igcm_o2, igcm_o3, igcm_h, igcm_h2,
    6      &                      igcm_oh, igcm_ho2, igcm_n2, igcm_ar,
    7      &                      igcm_h2o_vap, igcm_n, igcm_no, igcm_no2,
    8      &                      igcm_n2d, igcm_ch4,
    9      &                      igcm_ch3, igcm_ch, igcm_3ch2, igcm_1ch2,     
    10      &                      igcm_cho, igcm_ch2o, igcm_ch3o,               
    11      &                      igcm_c, igcm_c2, igcm_c2h, igcm_c2h2,         
    12      &                      igcm_c2h3, igcm_c2h4, igcm_c2h6, igcm_ch2co, 
    13      &                      igcm_ch3co, igcm_hcaer,
    14      &                      igcm_h2o2, mmol
     4      use tracer_h, only: mmol, noms, aki, cpi, nesp
    155
    16       use conc_mod, only: mmean, Akknew, rnew, cpnew
     6      use conc_mod, only: mmean, akknew, rnew, cpnew
    177      USE comcstfi_mod                   
    188      use callkeys_mod
     9      use chimiedata_h
    1910      implicit none
    2011
     
    2819!
    2920! version: April 2012 - Franck Lefevre
     21! update 06/03/2021 cpi/aki input (Yassin Jaziri)
    3022!=======================================================================
    3123
    32 !     declarations
    33  
    34 #include "chimiedata.h"
    3524!     input/output
    3625
    37       integer,intent(in) :: ngrid ! number of atmospheric columns
     26      integer,intent(in) :: ngrid  ! number of atmospheric columns
    3827      integer,intent(in) :: nlayer ! number of atmospheric layers
    39       integer,intent(in) :: nq ! number of tracers
    40       real,intent(in) :: pplay(ngrid,nlayer)
    41       real,intent(in) :: pt(ngrid,nlayer)
    42       real,intent(in) :: pdt(ngrid,nlayer)
    43       real,intent(in) :: pq(ngrid,nlayer,nq)
    44       real,intent(in) :: pdq(ngrid,nlayer,nq)
    45       real,intent(in) :: ptimestep
     28      integer,intent(in) :: nq     ! number of tracers
     29      real,   intent(in) :: pplay(ngrid,nlayer)
     30      real,   intent(in) :: pt(ngrid,nlayer)
     31      real,   intent(in) :: pdt(ngrid,nlayer)
     32      real,   intent(in) :: pq(ngrid,nlayer,nq)
     33      real,   intent(in) :: pdq(ngrid,nlayer,nq)
     34      real,   intent(in) :: ptimestep
    4635
    4736!     local variables
    4837
    49       integer       :: i, l, ig, iq
    50       integer, save :: nbq
    51       integer,allocatable,save :: niq(:)
     38      integer       :: l, ig, iq
    5239      real          :: ni(nq), ntot
    5340      real          :: zq(ngrid, nlayer, nq)
    5441      real          :: zt(ngrid, nlayer)
    55       real,allocatable,save    :: aki(:)
    56       real,allocatable,save    :: cpi(:)
    57 
    58       logical, save :: firstcall = .true.
    59 
    60 
    61       if (firstcall) then
    62 
    63          ! allocate local saved arrays:
    64          allocate(aki(nq))
    65          allocate(cpi(nq))
    66          allocate(niq(nq))
    67 !        find index of chemical tracers to use
    68 !        initialize thermal conductivity and specific heat coefficients
    69 !        !? values are estimated
    70 
    71          nbq = 0 ! to count number of tracers used in this subroutine
    72 
    73          if (igcm_co2 /= 0) then
    74             nbq = nbq + 1
    75             niq(nbq) = igcm_co2
    76             aki(nbq) = 3.072e-4
    77             cpi(nbq) = 0.834e3
    78          end if
    79          if (igcm_co /= 0) then
    80             nbq = nbq + 1
    81             niq(nbq) = igcm_co
    82             aki(nbq) = 4.87e-4
    83             cpi(nbq) = 1.034e3
    84          end if
    85          if (igcm_o /= 0) then
    86             nbq = nbq + 1
    87             niq(nbq) = igcm_o
    88             aki(nbq) = 7.59e-4
    89             cpi(nbq) = 1.3e3
    90          end if
    91          if (igcm_o1d /= 0) then
    92             nbq = nbq + 1
    93             niq(nbq) = igcm_o1d
    94             aki(nbq) = 7.59e-4  !?
    95             cpi(nbq) = 1.3e3    !?
    96          end if
    97          if (igcm_o2 /= 0) then
    98             nbq = nbq + 1
    99             niq(nbq) = igcm_o2
    100             aki(nbq) = 5.68e-4
    101             cpi(nbq) = 0.9194e3
    102          end if
    103          if (igcm_o3 /= 0) then
    104             nbq = nbq + 1
    105             niq(nbq) = igcm_o3
    106             aki(nbq) = 3.00e-4  !?
    107             cpi(nbq) = 0.800e3  !?
    108          end if
    109          if (igcm_h /= 0) then
    110             nbq = nbq + 1
    111             niq(nbq) = igcm_h
    112             aki(nbq) = 0.0
    113             cpi(nbq) = 20.780e3
    114          end if
    115          if (igcm_h2 /= 0) then
    116             nbq = nbq + 1
    117             niq(nbq) = igcm_h2
    118             aki(nbq) = 36.314e-4
    119             cpi(nbq) = 14.266e3
    120          end if
    121          if (igcm_oh /= 0) then
    122             nbq = nbq + 1
    123             niq(nbq) = igcm_oh
    124             aki(nbq)  = 7.00e-4 !?
    125             cpi(nbq)  = 1.045e3
    126          end if
    127          if (igcm_ho2 /= 0) then
    128             nbq = nbq + 1
    129             niq(nbq) = igcm_ho2
    130             aki(nbq) = 0.0
    131             cpi(nbq) = 1.065e3  !?
    132          end if
    133          if (igcm_h2o2 /= 0) then
    134             nbq = nbq + 1
    135             niq(nbq) = igcm_h2o2
    136             aki(nbq) = 0.0
    137             cpi(nbq) = 1.065e3  !?
    138          end if
    139          if (igcm_h2o_vap /= 0) then
    140             nbq = nbq + 1
    141             niq(nbq) = igcm_h2o_vap
    142             aki(nbq) = 0.0
    143             cpi(nbq) = 1.870e3
    144          end if
    145          if (igcm_n /= 0) then
    146             nbq = nbq + 1
    147             niq(nbq) = igcm_n
    148             aki(nbq) = 0.0
    149             cpi(nbq) = 0.0
    150          endif
    151          if(igcm_n2d /= 0) then
    152             nbq = nbq + 1
    153             niq(nbq) = igcm_n2d
    154             aki(nbq) = 0.0
    155             cpi(nbq) = 0.0
    156          endif
    157          if(igcm_no /= 0) then
    158             nbq = nbq + 1
    159             niq(nbq) = igcm_no
    160             aki(nbq) = 0.0
    161             cpi(nbq) = 0.0
    162          endif
    163          if(igcm_no2 /= 0) then
    164             nbq = nbq + 1
    165             niq(nbq) = igcm_no2
    166             aki(nbq) = 0.0
    167             cpi(nbq) = 0.0
    168          endif
    169          if (igcm_n2 /= 0) then
    170             nbq = nbq + 1
    171             niq(nbq) = igcm_n2
    172             aki(nbq) = 5.6e-4
    173             cpi(nbq) = 1.034e3
    174          end if
    175          if(igcm_ch4 /= 0) then
    176             nbq = nbq + 1
    177             niq(nbq) = igcm_ch4
    178             aki(nbq) = 0.0
    179             cpi(nbq) = 0.0
    180          endif
    181          if(igcm_ch3 /= 0) then
    182             nbq = nbq + 1
    183             niq(nbq) = igcm_ch3
    184             aki(nbq) = 0.0
    185             cpi(nbq) = 0.0
    186          endif
    187          if(igcm_ch /= 0) then
    188             nbq = nbq + 1
    189             niq(nbq) = igcm_ch
    190             aki(nbq) = 0.0
    191             cpi(nbq) = 0.0
    192          endif
    193          if(igcm_1ch2 /= 0) then
    194             nbq = nbq + 1
    195             niq(nbq) = igcm_1ch2
    196             aki(nbq) = 0.0
    197             cpi(nbq) = 0.0
    198          endif
    199          if(igcm_3ch2 /= 0) then
    200             nbq = nbq + 1
    201             niq(nbq) = igcm_3ch2
    202             aki(nbq) = 0.0
    203             cpi(nbq) = 0.0
    204          endif
    205          if(igcm_cho /= 0) then
    206             nbq = nbq + 1
    207             niq(nbq) = igcm_cho
    208             aki(nbq) = 0.0
    209             cpi(nbq) = 0.0
    210          endif
    211          if(igcm_ch2o /= 0) then
    212             nbq = nbq + 1
    213             niq(nbq) = igcm_ch2o
    214             aki(nbq) = 0.0
    215             cpi(nbq) = 0.0
    216          endif
    217          if(igcm_ch3o /= 0) then
    218             nbq = nbq + 1
    219             niq(nbq) = igcm_ch3o
    220             aki(nbq) = 0.0
    221             cpi(nbq) = 0.0
    222          endif
    223          if(igcm_c /= 0) then
    224             nbq = nbq + 1
    225             niq(nbq) = igcm_c
    226             aki(nbq) = 0.0
    227             cpi(nbq) = 0.0
    228          endif
    229          if(igcm_c2 /= 0) then
    230             nbq = nbq + 1
    231             niq(nbq) = igcm_c2
    232             aki(nbq) = 0.0
    233             cpi(nbq) = 0.0
    234          endif
    235          if(igcm_c2h /= 0) then
    236             nbq = nbq + 1
    237             niq(nbq) = igcm_c2h
    238             aki(nbq) = 0.0
    239             cpi(nbq) = 0.0
    240          endif
    241          if(igcm_c2h2 /= 0) then
    242             nbq = nbq + 1
    243             niq(nbq) = igcm_c2h2
    244             aki(nbq) = 0.0
    245             cpi(nbq) = 0.0
    246          endif
    247          if(igcm_c2h3 /= 0) then
    248             nbq = nbq + 1
    249             niq(nbq) = igcm_c2h3
    250             aki(nbq) = 0.0
    251             cpi(nbq) = 0.0
    252          endif
    253          if(igcm_c2h4 /= 0) then
    254             nbq = nbq + 1
    255             niq(nbq) = igcm_c2h4
    256             aki(nbq) = 0.0
    257             cpi(nbq) = 0.0
    258          endif
    259          if(igcm_c2h6 /= 0) then
    260             nbq = nbq + 1
    261             niq(nbq) = igcm_c2h6
    262             aki(nbq) = 0.0
    263             cpi(nbq) = 0.0
    264          endif
    265          if(igcm_ch2co /= 0) then
    266             nbq = nbq + 1
    267             niq(nbq) = igcm_ch2co
    268             aki(nbq) = 0.0
    269             cpi(nbq) = 0.0
    270          endif
    271          if(igcm_ch3co /= 0) then
    272             nbq = nbq + 1
    273             niq(nbq) = igcm_ch3co
    274             aki(nbq) = 0.0
    275             cpi(nbq) = 0.0
    276          endif
    277          if(igcm_hcaer /= 0) then
    278             nbq = nbq + 1
    279             niq(nbq) = igcm_hcaer
    280             aki(nbq) = 0.0
    281             cpi(nbq) = 0.0
    282          endif
    283          if (igcm_ar /= 0) then
    284             nbq = nbq + 1
    285             niq(nbq) = igcm_ar
    286             aki(nbq) = 0.0      !?
    287             cpi(nbq) = 1.000e3  !?
    288          end if
    289 
    290 
    291          ! tell the world about it:
    292          write(*,*) "concentrations: firstcall, nbq=",nbq
    293          write(*,*) "  niq(1:nbq)=",niq(1:nbq)
    294          write(*,*) "  aki(1:nbq)=",aki(1:nbq)
    295          write(*,*) "  cpi(1:nbq)=",cpi(1:nbq)
    296 
    297          firstcall = .false.
    298 
    299       end if ! if (firstcall)
    30042
    30143!     update temperature
     
    31153      do l = 1,nlayer
    31254         do ig = 1,ngrid
    313             do i = 1,nbq
    314                iq = niq(i)
     55            do iq = 1,nq
    31556               zq(ig,l,iq) = max(1.e-30, pq(ig,l,iq)
    31657     $                                 + pdq(ig,l,iq)*ptimestep)
     
    32566      do l = 1,nlayer
    32667         do ig = 1,ngrid
    327             do i = 1,nbq
    328                iq = niq(i)
    329                mmean(ig,l) = mmean(ig,l) + zq(ig,l,iq)/mmol(iq)
     68            do iq = 1,nq
     69               if (mmol(iq).ne.0.) then
     70                  mmean(ig,l) = mmean(ig,l) + zq(ig,l,iq)/mmol(iq)
     71               end if
    33072            end do
    33173            mmean(ig,l) = 1./mmean(ig,l)
     
    34385         do ig = 1,ngrid
    34486            ntot = pplay(ig,l)/(1.381e-23*zt(ig,l))*1.e-6  ! in #/cm3
    345             do i = 1,nbq
    346                iq = niq(i)
     87            do iq = 1,nq
    34788               ni(iq) = ntot*zq(ig,l,iq)*mmean(ig,l)/mmol(iq)
    348                cpnew(ig,l) = cpnew(ig,l) + ni(iq)*cpi(i)
    349                akknew(ig,l) = akknew(ig,l) + ni(iq)*aki(i)
     89               cpnew(ig,l)  = cpnew(ig,l) + ni(iq)*cpi(iq)
     90               akknew(ig,l) = akknew(ig,l) + ni(iq)*aki(iq)
    35091            end do
    351             cpnew(ig,l) = cpnew(ig,l)/ntot
     92            cpnew(ig,l)  = cpnew(ig,l)/ntot
    35293            akknew(ig,l) = akknew(ig,l)/ntot
    35394         end do
  • trunk/LMDZ.GENERIC/libf/aeronostd/photochemistry_asis.F90

    r1813 r2542  
    44!
    55!     Author: Franck Lefevre
     6!             Benjamin Charnay
     7!             Yassin Jaziri
    68!     ------
    79!
    8 !     Version: 10/11/2015
     10!     Version: 27/05/2016
     11!     update 06/03/2021 generic tracer/network + photolysis online (Yassin Jaziri)
    912!
    1013!*****************************************************************
    1114
    12 subroutine photochemistry_asis(nlayer, nq, ngrid,                               &
     15subroutine photochemistry_asis(nlayer, ngrid,                                   &
    1316                          ig, lswitch, zycol, sza, fractcol, ptimestep, press,  &
    14                           temp, dens, zmmean, dist_sol, surfdust1d,             &
    15                           surfice1d, jo3, tau, iter)
     17                          alt, temp, dens, zmmean, dist_sol, surfdust1d,        &
     18                          surfice1d, tau, iter,zdtchim)
    1619
    1720      use callkeys_mod
     21      use comcstfi_mod, only:  r,cpp,avocado,pi
     22      use tracer_h
     23      use types_asis
     24      use chimiedata_h
     25      use photolysis_mod
     26
    1827implicit none
    1928
    20 #include "chimiedata.h"
    21 
    2229!===================================================================
    2330!     inputs:
     
    2532
    2633integer, intent(in) :: nlayer ! number of atmospheric layers
    27 integer, intent(in) :: nq     ! number of tracers
    28 integer,intent(in) :: ngrid   ! number of atmospheric columns
     34integer, intent(in) :: ngrid  ! number of atmospheric columns
     35
    2936integer :: ig                 ! grid point index
    3037     
     
    3340real :: ptimestep             ! physics timestep (s)
    3441real :: press(nlayer)         ! pressure (hpa)
     42real :: alt(nlayer)           ! altitude (km)
    3543real :: temp(nlayer)          ! temperature (k)
    3644real :: dens(nlayer)          ! density (cm-3)
     
    4553!===================================================================
    4654     
    47 real :: zycol(nlayer,nq)       ! chemical species volume mixing ratio
     55real :: zycol(nlayer,nesp)    ! chemical species volume mixing ratio
    4856
    4957!===================================================================
     
    5159!===================================================================
    5260     
    53 integer :: iter(nlayer)        ! iteration counter
    54 real    :: jo3(nlayer)         ! photodissociation rate o3 -> o1d
     61integer :: iter(nlayer)       ! iteration counter
     62real    :: zdtchim(nlayer)    ! temperature modification by ozone
    5563
    5664!===================================================================
     
    5967
    6068integer :: phychemrat         ! (physical timestep)/(nominal chemical timestep)
    61 integer :: j_o3_o1d, ilev
    62 integer :: iesp, nesp
     69integer :: ilev, iesp, iphot, iw
    6370integer :: lswitch
    6471
    6572logical, save :: firstcall = .true.
    66 
    67 parameter (nesp = 17)         ! number of species in the chemistry
    68 
    69 ! tracer indexes in the chemistry:
    70 
    71 integer,parameter :: i_co2  =  1
    72 integer,parameter :: i_co   =  2
    73 integer,parameter :: i_o    =  3
    74 integer,parameter :: i_o1d  =  4
    75 integer,parameter :: i_o2   =  5
    76 integer,parameter :: i_o3   =  6
    77 integer,parameter :: i_h    =  7
    78 integer,parameter :: i_h2   =  8
    79 integer,parameter :: i_oh   =  9
    80 integer,parameter :: i_ho2  = 10
    81 integer,parameter :: i_h2o2 = 11
    82 integer,parameter :: i_h2o  = 12
    83 integer,parameter :: i_n    = 13
    84 integer,parameter :: i_n2d  = 14
    85 integer,parameter :: i_no   = 15
    86 integer,parameter :: i_no2  = 16
    87 integer,parameter :: i_n2   = 17
    8873
    8974real :: stimestep           ! standard timestep for the chemistry (s)
     
    9580real :: j(nlayer,nd)        ! interpolated photolysis rates (s-1)
    9681real :: time                ! internal time (between 0 and ptimestep, in s)
     82real :: rho(nlayer)         ! mass density (kg/m-3)
    9783
    9884real, dimension(nlayer,nesp)            :: rm   ! mixing ratios
     
    10389! reaction rates
    10490 
    105 real (kind = 8), dimension(nlayer,      nb_phot_max) :: v_phot
    106 real (kind = 8), dimension(nlayer,nb_reaction_3_max) :: v_3
    107 real (kind = 8), dimension(nlayer,nb_reaction_4_max) :: v_4
    108 logical :: hetero_dust, hetero_ice
     91real (kind = 8), allocatable, save     :: v_phot(:,:)
     92real (kind = 8), allocatable, save     :: v_3(:,:)
     93real (kind = 8), allocatable, save     :: v_4(:,:)
     94real (kind = 8), allocatable, save     :: e_phot(:,:)    ! photolysis rates by energie (J.mol-1.s-1)
     95
     96integer, save                          :: nreact         ! number of reactions in reactions files
     97integer, allocatable, save             :: rtype(:)       ! reaction rate type
     98integer, allocatable, save             :: third_body(:)  ! if the reaction have a third body: index of the third body, else zero
     99logical, allocatable, save             :: three_prod(:)  ! if the reaction have a three defferent proucts egal .true.
    109100
    110101! matrix
    111102
    112 real (kind = 8), dimension(nesp,nesp) :: mat, mat1
    113 integer, dimension(nesp)              :: indx
    114 integer                               :: code
     103real (kind = 8), dimension(nesp,nesp)  :: mat, mat1
     104integer, dimension(nesp)               :: indx
     105integer                                :: code
    115106
    116107! production and loss terms (for first-guess solution only)
    117108
    118 real (kind = 8), dimension(nesp) :: prod, loss
    119 
    120 ! curvatures
    121 
    122 real :: ratio, curv, e, e1, e2, e3
     109real (kind = 8), dimension(nesp)       :: prod, loss
    123110
    124111!===================================================================
     
    128115if (firstcall) then
    129116   print*,'photochemistry: initialize indexes'
    130    call indice(i_co2, i_co, i_o, i_o1d, i_o2, i_o3, i_h,       &
    131                i_h2, i_oh, i_ho2, i_h2o2, i_h2o,               &
    132                i_n, i_n2d, i_no, i_no2, i_n2)
     117   call indice(nreact,rtype,third_body,three_prod)
     118   allocate(v_phot(nlayer,nb_phot_max))
     119   allocate(v_3(nlayer,nb_reaction_3_max))
     120   allocate(v_4(nlayer,nb_reaction_4_max))
     121   allocate(v_phot_3d(ngrid,nlayer,nb_phot_hv_max))
     122   allocate(e_phot(nlayer,nb_phot_max))
     123   v_phot(:,:)      = 0.
     124   v_3(:,:)         = 0.
     125   v_4(:,:)         = 0.
     126   v_phot_3d(:,:,:) = 0.
     127   e_phot(:,:)      = 0.
     128
     129   ! Need to be done after subroutine indice
     130   if (jonline) then
     131     print*,'calchim: Read UV absorption cross-sections'
     132     ! Jonline cannot run without photolysis
     133     if (nb_phot_hv_max == 0) then
     134       print*,'Jonline cannot run without photolysis'
     135       print*,'set jonline=.false. in callphys.def'
     136       print*,'or set photolysis reactions in monoreact file'
     137       stop
     138     end if
     139     call init_photolysis(nlayer,nreact,three_prod)     ! on-line photolysis
     140     allocate(albedo_snow_chim(nw))
     141     allocate(albedo_co2_ice_chim(nw))
     142    ! Step 1 : Initialisation of the Spectral Albedos.
     143     DO iw=1,nw
     144      albedo_snow_chim(iw)=albedosnow
     145      albedo_co2_ice_chim(iw)=albedoco2ice
     146
     147      ! Spectral Snow Albedo Calculation.
     148      call albedo_snow_calc(wc(iw)*1.0e-3,        &
     149                     albedo_snow_chim(iw),  &
     150                     albedosnow)
     151     
     152     ENDDO
     153   end if
     154
    133155   firstcall = .false.
    134156end if
     
    138160!===================================================================
    139161
    140 call gcmtochim(nlayer, nq, zycol, lswitch, nesp,               &
    141                i_co2, i_co, i_o, i_o1d, i_o2, i_o3, i_h,       &
    142                i_h2, i_oh, i_ho2, i_h2o2, i_h2o,               &
    143                i_n, i_n2d, i_no, i_no2, i_n2, dens, rm, c)
     162call gcmtochim(nlayer, zycol, lswitch, nesp, dens, rm, c)
    144163
    145164!===================================================================
     
    147166!===================================================================
    148167
    149 call photolysis_asis(nlayer, ngrid, lswitch, press, temp, sza, fractcol, tau, zmmean, dist_sol, &
    150                      rm(:,i_co2), rm(:,i_o3), v_phot)
    151 
    152 ! save o3 photolysis for output
    153 
    154 j_o3_o1d = 5
    155 jo3(:) = v_phot(:,j_o3_o1d)
     168if (jonline) then
     169   if (sza <= 95.) then
     170      call photolysis_online(nlayer, alt, press, temp, zmmean, rm,   &
     171                             tau, sza, dist_sol, v_phot, e_phot, ig, ngrid, nreact, three_prod)
     172      if (ngrid.eq.1) then
     173        do iphot = 1,nb_phot_hv_max
     174          v_phot(:,iphot) = v_phot(:,iphot)* 0.25 / cos(sza*pi/180.) ! globally averaged = divide by 4
     175          e_phot(:,iphot) = e_phot(:,iphot)* 0.25 / cos(sza*pi/180.) ! globally averaged = divide by 4
     176        end do
     177      elseif(diurnal .eqv. .false.) then
     178        do iphot = 1,nb_phot_hv_max
     179          v_phot(:,iphot) = v_phot(:,iphot) * fractcol
     180          e_phot(:,iphot) = e_phot(:,iphot) * fractcol
     181        end do
     182      endif
     183   else ! night
     184      v_phot(:,:) = 0.
     185      e_phot(:,:) = 0.
     186   end if
     187   ! save photolysis for output
     188   v_phot_3d(ig,:,:) = v_phot(:,1:nb_phot_hv_max)
     189else if (nb_phot_hv_max /= 0) then
     190   call photolysis_asis(nlayer, ngrid, lswitch, press, temp, sza, fractcol,tau, zmmean, dist_sol, &
     191                     rm(:,indexchim('co2')), rm(:,indexchim('o3')), rm(:,indexchim('ch4')), v_phot)
     192   ! save photolysis for output
     193   v_phot_3d(ig,:,:) = v_phot(:,1:nb_phot_hv_max)
     194end if
    156195
    157196!===================================================================
    158197!     reaction rates                                     
    159198!===================================================================
    160 !     switches for heterogeneous chemistry
    161 !     hetero_ice  : reactions on ice clouds
    162 !     hetero_dust : reactions on dust   
    163 !===================================================================
    164 
    165 hetero_dust = .false.
    166 hetero_ice  = .false.
    167 
    168 call reactionrates(nlayer, lswitch, dens, c(:,i_co2), c(:,i_o2), &
    169                    press, temp, hetero_dust, hetero_ice,         &
    170                    surfdust1d, surfice1d, v_phot, v_3, v_4)
     199
     200call reactionrates(nlayer, nreact, rtype, third_body, three_prod, c, lswitch, dens, &
     201                   press, temp, zmmean, sza, surfdust1d, surfice1d, v_phot, v_3, v_4)
     202
     203zdtchim(:) = 0.
     204rho(:)     = (press(:)*1e2)/(r*temp(:))
     205
     206!===================================================================
     207!     temperature modification by photolysis reaction                                   
     208!===================================================================
     209
     210if (photoheat .and. jonline) then ! for now just with jonline
     211
     212  do iphot = 1,nb_phot_hv_max
     213    zdtchim(:nlayer-1) = zdtchim(:nlayer-1) + e_phot(:nlayer-1,iphot)*c(:nlayer-1,indexchim(trim(jlabel(iphot,2))))/(cpp*(rho(:nlayer-1)*1e-6)*avocado)
     214  end do
     215
     216else
     217
     218!! o + o2 -> o3
     219!!dE = 24 ! kcal.mol-1
     220!!zdtchim(:) = zdtchim(:) + 4.184*24e3*v_4(:,1)*c(:,indexchim('o'))*c(:,indexchim('o2'))*1e6/(cpp*rho*avocado)
     221!
     222!! o3 -> o2 + o1d
     223!! E(250nm) = 480 kJ.mol-1
     224!j_o3_o1d   = 3
     225!zdtchim(:) = zdtchim(:) + 480e3*v_phot(:,j_o3_o1d)*c(:,indexchim('o3'))/(cpp*(rho*1e-6)*avocado)
     226!
     227!! o3 -> o2 + o
     228!! E(350nm) = 343 kJ.mol-1
     229!j_o3_o     = 4
     230!zdtchim(:) = zdtchim(:) + 343e3*v_phot(:,j_o3_o)*c(:,indexchim('o3'))/(cpp*(rho*1e-6)*avocado)
     231
     232zdtchim(:) = 0.
     233
     234end if
    171235
    172236!===================================================================
     
    182246
    183247ctimestep = ptimestep/real(phychemrat)
    184 
    185 !print*, "stimestep  = ", stimestep
    186 !print*, "ptimestep  = ", ptimestep
    187 !print*, "phychemrat = ", phychemrat
    188 !print*, "ctimestep  = ", ctimestep
    189 !stop
    190248
    191249!===================================================================
     
    207265
    208266   iter(ilev) = iter(ilev) + 1    ! iteration counter
    209 
     267 
    210268!  first-guess: fill matrix
    211269
     
    268326!===================================================================
    269327
    270 call chimtogcm(nlayer, nq, zycol, lswitch, nesp,              &
    271                i_co2, i_co, i_o, i_o1d, i_o2, i_o3, i_h,      &
    272                i_h2, i_oh, i_ho2, i_h2o2, i_h2o,              &
    273                i_n, i_n2d, i_no, i_no2, i_n2, dens, c)
     328call chimtogcm(nlayer, zycol, lswitch, nesp, dens, c)
    274329
    275330contains
     
    318373real (kind = 8), parameter :: dtmin   = 10.      ! minimum time step (s)
    319374real (kind = 8), parameter :: vmrtol  = 1.e-11   ! absolute tolerance on vmr
    320 real (kind = 8), parameter :: rtol    = 1./0.05   ! 1/rtol recommended value : 0.1-0.02
     375real (kind = 8), parameter :: rtol    = 1./0.05  ! 1/rtol recommended value : 0.1-0.02
    321376integer,         parameter :: niter   = 3        ! number of iterations
    322377real (kind = 8), parameter :: coefmax = 2.
     
    382437! timestep correction
    383438
    384 coef = max(coefmin, min(coefmax,0.8/sqrt(e)))
     439if (e <= 0.) then
     440  coef = coefmax
     441else
     442  coef = max(coefmin, min(coefmax,0.8/sqrt(e)))
     443end if
    385444
    386445dttest = max(dtmin,dttest*coef)
     
    396455
    397456
    398 
    399 
    400457!======================================================================
    401458
    402  subroutine reactionrates(nlayer,                               &
    403                           lswitch, dens, co2, o2, press, t,     &
    404                           hetero_dust, hetero_ice,              &
     459 subroutine reactionrates(nlayer, nreact, rtype, third_body, three_prod, c, &
     460                          lswitch, dens, press, t, zmmean, sza, &
    405461                          surfdust1d, surfice1d,                &
    406462                          v_phot, v_3, v_4)
     
    418474
    419475use comcstfi_mod
     476use types_asis
     477use pfunc
     478use tracer_h
     479use chimiedata_h
    420480
    421481implicit none
    422 
    423 #include "chimiedata.h"
    424482
    425483!----------------------------------------------------------------------
     
    427485!----------------------------------------------------------------------
    428486
    429 integer, intent(in)     :: nlayer            ! number of atmospheric layers
    430 integer                 :: lswitch           ! interface level between lower
    431                                              ! atmosphere and thermosphere chemistries
    432 real, dimension(nlayer) :: dens              ! total number density (molecule.cm-3)
    433 real, dimension(nlayer) :: press             ! pressure (hPa)
    434 real, dimension(nlayer) :: t                 ! temperature (K)
    435 real, dimension(nlayer) :: surfdust1d        ! dust surface area (cm2.cm-3)
    436 real, dimension(nlayer) :: surfice1d         ! ice surface area (cm2.cm-3)
    437 real (kind = 8), dimension(nlayer) :: co2    ! co2 number density (molecule.cm-3)
    438 real (kind = 8), dimension(nlayer) :: o2     ! o2 number density (molecule.cm-3)
    439 logical :: hetero_dust, hetero_ice           ! switches for heterogeneous chemistry
     487integer, intent(in)     :: nlayer             ! number of atmospheric layers
     488integer, intent(in)     :: nreact             ! number of reactions in reactions files
     489integer                 :: lswitch            ! interface level between lower
     490                                              ! atmosphere and thermosphere chemistries
     491real, dimension(nlayer) :: dens               ! total number density (molecule.cm-3)
     492real, dimension(nlayer) :: press              ! pressure (hPa)
     493real, dimension(nlayer) :: t                  ! temperature (K)
     494real, dimension(nlayer) :: zmmean             ! mean molar mass (g/mole)
     495real                    :: sza                ! solar zenith angle (deg)
     496real, dimension(nlayer) :: surfdust1d         ! dust surface area (cm2.cm-3)
     497real, dimension(nlayer) :: surfice1d          ! ice surface area (cm2.cm-3)
     498real (kind = 8), dimension(nlayer,nesp) :: c  ! species number density (molecule.cm-3)
     499
     500integer, intent(in)     :: rtype(nreact)      ! reaction rate type
     501integer, intent(in)     :: third_body(nreact) ! if the reaction have a third body: index of the third body, else zero
     502logical, intent(in)     :: three_prod(nreact) ! if the reaction have three different products egal .true.
    440503
    441504!----------------------------------------------------------------------
     
    451514!----------------------------------------------------------------------
    452515
    453 integer          :: ilev
     516logical,save     :: firstcall = .true.
     517integer          :: ilev, ireact
    454518integer          :: nb_phot, nb_reaction_3, nb_reaction_4
    455 real :: ak0, ak1, xpo, rate
    456 real :: k1a0, k1b0, k1ainf, k1a, k1b, fc, fx, x, y, gam
    457 real, dimension(nlayer) :: deq
    458 real, dimension(nlayer) :: a001, a002, a003,                           &
    459                              b001, b002, b003, b004, b005, b006, b007,   &
    460                              b008, b009,                                 &
    461                              c001, c002, c003, c004, c005, c006, c007,   &
    462                              c008, c009, c010, c011, c012, c013, c014,   &
    463                              c015, c016, c017, c018,                     &
    464                              d001, d002, d003, d004, d005, d006, d007,   &
    465                              d008, d009,                                 &
    466                              e001, e002,                                 &
    467                              h001, h002, h003, h004, h005
     519integer          :: nb_hv, nb_pfunc1, nb_pfunc2, nb_pfunc3
     520real, dimension(nlayer) :: ratec ! rate coefficient
    468521
    469522!----------------------------------------------------------------------
     
    471524!----------------------------------------------------------------------
    472525
    473       nb_phot       = 11       ! jmars.20140930 reduit de 13 a 11
     526      nb_phot       = nb_phot_hv_max
    474527      nb_reaction_3 = 0
    475528      nb_reaction_4 = 0
    476529
     530      nb_hv         = 0
     531      nb_pfunc1     = 0
     532      nb_pfunc2     = 0
     533      nb_pfunc3     = 0
     534
    477535!----------------------------------------------------------------------
    478 !     oxygen reactions
     536!     reactions
    479537!----------------------------------------------------------------------
    480538
    481 !---  a001: o + o2 + co2 -> o3 + co2
    482 
    483 !     jpl 2003
    484 !
    485 !     co2 efficiency as a third body (2.075)
    486 !     from sehested et al., j. geophys. res., 100, 1995.
    487 
    488       a001(:) = 2.075*6.0e-34*(t(:)/300.)**(-2.4)*dens(:)
    489 
    490       nb_reaction_4 = nb_reaction_4 + 1
    491       v_4(:,nb_reaction_4) = a001(:)
    492 
    493 !---  a002: o + o + co2 -> o2 + co2
    494 
    495 !     Tsang and Hampson, J. Chem. Phys. Ref. Data, 15, 1087, 1986
    496 
    497 !     a002(:) = 2.5*5.2e-35*exp(900./t(:))*dens(:)
    498 
    499 !     Campbell and Gray, Chem. Phys. Lett., 18, 607, 1973
    500 
    501 !     a002(:) = 1.2e-32*(300./t(:))**(2.0)*dens(:)  ! yung expression
    502       a002(:) = 2.5*9.46e-34*exp(485./t(:))*dens(:) ! nist expression
    503 
    504       nb_reaction_3 = nb_reaction_3 + 1
    505       v_3(:,nb_reaction_3) = a002(:)
    506 
    507 !---  a003: o + o3 -> o2 + o2
    508 
    509 !     jpl 2003
    510 
    511       a003(:) = 8.0e-12*exp(-2060./t(:))
    512 
    513       nb_reaction_4 = nb_reaction_4 + 1
    514       v_4(:,nb_reaction_4) = a003(:)
    515 
    516 !----------------------------------------------------------------------
    517 !     o(1d) reactions
    518 !----------------------------------------------------------------------
    519 
    520 !---  b001: o(1d) + co2  -> o + co2
    521 
    522 !     jpl 2006
    523 
    524       b001(:) = 7.5e-11*exp(115./t(:))
    525    
     539ireact = 1
     540
     541! Reaction from monoreact file are implemented first
     542do while(nb_phot<nb_phot_max-nphot_hard_coding)
     543
     544  if (rtype(ireact)/=0) then     ! skip photolysis reactions
     545    ! get right coefficient rate function
     546    if (rtype(ireact)==1) then
     547      nb_pfunc1 = nb_pfunc1 + 1
     548      if (third_body(ireact)==0) then            !! third_body check
     549        ratec = pfunc1(nlayer,t,dens,pfunc1_param(nb_pfunc1))
     550      else
     551        ratec = pfunc1(nlayer,t,c(:,third_body(ireact)),pfunc1_param(nb_pfunc1))
     552      end if
     553    else if (rtype(ireact)==2) then
     554      nb_pfunc2 = nb_pfunc2 + 1
     555      if (third_body(ireact)==0) then            !! third_body check
     556        ratec = pfunc2(nlayer,t,dens,pfunc2_param(nb_pfunc2))
     557      else
     558        ratec = pfunc2(nlayer,t,c(:,third_body(ireact)),pfunc2_param(nb_pfunc2))
     559      end if
     560    else if (rtype(ireact)==3) then
     561      nb_pfunc3 = nb_pfunc3 + 1
     562      if (third_body(ireact)==0) then            !! third_body check
     563        ratec = pfunc3(nlayer,t,dens,pfunc3_param(nb_pfunc3))
     564      else
     565        ratec = pfunc3(nlayer,t,c(:,third_body(ireact)),pfunc3_param(nb_pfunc3))
     566      end if
     567    else
     568      print*, 'Error in reactionrates: wrong index coefficient rate vphot'
     569      print*, 'rtype(ireact) = ',rtype(ireact)
     570      print*, 'It should be 1 or 2 '
     571      print*, 'Please check the reaction ',ireact
     572      if (ireact>nreact) print*, 'Please check the reaction count into the code beacause ireact > nreact is not possible'
     573      stop
     574    end if
     575
     576    ! fill the right type index
     577    nb_phot = nb_phot + 1
     578    v_phot(:,nb_phot) = ratec(:)
     579    if (three_prod(ireact)) then             ! three_prod check
    526580      nb_phot = nb_phot + 1
    527       v_phot(:,nb_phot) = b001(:)*co2(:)
    528 
    529 !---  b002: o(1d) + h2o  -> oh + oh
    530 
    531 !     jpl 2006
    532  
    533       b002(:) = 1.63e-10*exp(60./t(:))
    534 
    535       nb_reaction_4 = nb_reaction_4 + 1
    536       v_4(:,nb_reaction_4) = b002(:)
    537 
    538 !---  b003: o(1d) + h2  -> oh + h
    539 
    540 !     jpl 2011
    541 
    542       b003(:) = 1.2e-10
    543 
    544       nb_reaction_4 = nb_reaction_4 + 1
    545       v_4(:,nb_reaction_4) = b003(:)
    546 
    547 !---  b004: o(1d) + o2  -> o + o2
    548 
    549 !     jpl 2006
    550 
    551       b004(:) = 3.3e-11*exp(55./t(:))
    552 
    553       nb_phot = nb_phot + 1
    554       v_phot(:,nb_phot) = b004(:)*o2(:)
    555    
    556 !---  b005: o(1d) + o3  -> o2 + o2
    557 
    558 !     jpl 2003
    559 
    560       b005(:) = 1.2e-10
    561 
    562       nb_reaction_4 = nb_reaction_4 + 1
    563       v_4(:,nb_reaction_4) = b005(:)
    564    
    565 !---  b006: o(1d) + o3  -> o2 + o + o
    566 
    567 !     jpl 2003
    568 
    569       b006(:) = 1.2e-10
    570 
    571       nb_reaction_4 = nb_reaction_4 + 1
    572       v_4(:,nb_reaction_4) = b006(:)
    573    
    574 !---  b007: o(1d) + ch4 -> ch3 + oh
    575 
    576 !     jpl 2003
    577 
    578       b007(:) = 1.5e-10*0.75
    579 
    580 !---  b008: o(1d) + ch4 -> ch3o + h
    581 
    582 !     jpl 2003
    583 
    584       b008(:) = 1.5e-10*0.20
    585 !
    586 !---  b009: o(1d) + ch4 -> ch2o + h2
    587 
    588 !     jpl 2003
    589 
    590       b009(:) = 1.5e-10*0.05
    591 
    592 !----------------------------------------------------------------------
    593 !     hydrogen reactions
    594 !----------------------------------------------------------------------
    595 
    596 !---  c001: o + ho2 -> oh + o2
    597 
    598 !     jpl 2003
    599 
    600       c001(:) = 3.0e-11*exp(200./t(:))
    601 
    602       nb_reaction_4 = nb_reaction_4 + 1
    603       v_4(:,nb_reaction_4) = c001(:)
    604 
    605 !---  c002: o + oh -> o2 + h
    606 
    607 !     jpl 2011
    608 
    609       c002(:) = 1.8e-11*exp(180./t(:))
    610 
    611 !     robertson and smith, j. chem. phys. a 110, 6673, 2006
    612 
    613 !     c002(:) = 11.2e-11*t(:)**(-0.32)*exp(177./t(:))
    614 
    615       nb_reaction_4 = nb_reaction_4 + 1
    616       v_4(:,nb_reaction_4) = c002(:)
    617 
    618 !---  c003: h + o3 -> oh + o2
    619 
    620 !     jpl 2003
    621 
    622       c003(:) = 1.4e-10*exp(-470./t(:))
    623 
    624       nb_reaction_4 = nb_reaction_4 + 1
    625       v_4(:,nb_reaction_4) = c003(:)
    626 
    627 !---  c004: h + ho2 -> oh + oh
    628 
    629 !     jpl 2006
    630 
    631       c004(:) = 7.2e-11
    632 
    633       nb_reaction_4 = nb_reaction_4 + 1
    634       v_4(:,nb_reaction_4) = c004(:)
    635 
    636 !---  c005: h + ho2 -> h2 + o2
    637 
    638 !     jpl 2006
    639 
    640       c005(:) = 6.9e-12
    641 
    642       nb_reaction_4 = nb_reaction_4 + 1
    643       v_4(:,nb_reaction_4) = c005(:)
    644 
    645 !---  c006: h + ho2 -> h2o + o
    646 
    647 !     jpl 2006
    648 
    649       c006(:) = 1.6e-12
    650 
    651       nb_reaction_4 = nb_reaction_4 + 1
    652       v_4(:,nb_reaction_4) = c006(:)
    653 
    654 !---  c007: oh + ho2 -> h2o + o2
    655 
    656 !     jpl 2003
    657 
    658 !     canty et al., grl, 2006 suggest to increase this rate
    659 !     by 20%. not done here.
    660 
    661       c007(:) = 4.8e-11*exp(250./t(:))
    662 
    663       nb_reaction_4 = nb_reaction_4 + 1
    664       v_4(:,nb_reaction_4) = c007(:)
    665 
    666 !---  c008: ho2 + ho2 -> h2o2 + o2
    667 
    668 !     jpl 2006
    669 
    670 !     c008(:) = 3.5e-13*exp(430./t(:))
    671 
    672 !     christensen et al., grl, 13, 2002
    673 
    674       c008(:) = 1.5e-12*exp(19./t(:))
    675 
    676       nb_reaction_3 = nb_reaction_3 + 1
    677       v_3(:,nb_reaction_3) = c008(:)
    678 
    679 !---  c009: oh + h2o2 -> h2o + ho2
    680 
    681 !     jpl 2006
    682 
    683       c009(:) = 1.8e-12
    684 
    685       nb_reaction_4 = nb_reaction_4 + 1
    686       v_4(:,nb_reaction_4) = c009(:)
    687 
    688 !---  c010: oh + h2 -> h2o + h
    689 
    690 !     jpl 2006
    691 
    692       c010(:) = 2.8e-12*exp(-1800./t(:))
    693 
    694       nb_reaction_4 = nb_reaction_4 + 1
    695       v_4(:,nb_reaction_4) = c010(:)
    696 
    697 !---  c011: h + o2 + co2 -> ho2 + co2
    698 
    699 !     jpl 2011
    700 
    701       do ilev = 1,lswitch-1
    702          ak0 = 2.5*4.4e-32*(t(ilev)/300.)**(-1.3)
    703          ak1 = 7.5e-11*(t(ilev)/300.)**(0.2)
    704 
    705          rate = (ak0*dens(ilev))/(1. + ak0*dens(ilev)/ak1)
    706          xpo = 1./(1. + alog10((ak0*dens(ilev))/ak1)**2)
    707          c011(ilev) = rate*0.6**xpo
    708       end do
    709 
    710       nb_reaction_4 = nb_reaction_4 + 1
    711       v_4(:,nb_reaction_4) = c011(:)
    712 
    713 !---  c012: o + h2o2 -> oh + ho2
    714 
    715 !     jpl 2003
    716 
    717       c012(:) = 1.4e-12*exp(-2000./t(:))
    718 
    719       nb_reaction_4 = nb_reaction_4 + 1
    720       v_4(:,nb_reaction_4) = c012(:)
    721 
    722 !---  c013: oh + oh -> h2o + o
    723 
    724 !     jpl 2006
    725 
    726       c013(:) = 1.8e-12
    727 
    728       nb_reaction_3 = nb_reaction_3 + 1
    729       v_3(:,nb_reaction_3) = c013(:)
    730 
    731 !---  c014: oh + o3 -> ho2 + o2
    732 
    733 !     jpl 2003
    734 
    735       c014(:) = 1.7e-12*exp(-940./t(:))
    736 
    737       nb_reaction_4 = nb_reaction_4 + 1
    738       v_4(:,nb_reaction_4) = c014(:)
    739 
    740 !---  c015: ho2 + o3 -> oh + o2 + o2
    741 
    742 !     jpl 2003
    743 
    744       c015(:) = 1.0e-14*exp(-490./t(:))
    745 
    746       nb_reaction_4 = nb_reaction_4 + 1
    747       v_4(:,nb_reaction_4) = c015(:)
    748 
    749 !---  c016: ho2 + ho2 + co2 -> h2o2 + o2 + co2
    750 
    751 !     jpl 2011
    752 
    753       c016(:) = 2.5*2.1e-33*exp(920./t(:))*dens(:)
    754 
    755       nb_reaction_3 = nb_reaction_3 + 1
    756       v_3(:,nb_reaction_3) = c016(:)
    757 
    758 !---  c017: oh + oh + co2 -> h2o2 + co2
    759 
    760 !     jpl 2003
    761 
    762       do ilev = 1,lswitch-1
    763          ak0 = 2.5*6.9e-31*(t(ilev)/300.)**(-1.0)
    764          ak1 = 2.6e-11*(t(ilev)/300.)**(0.0)
    765 
    766          rate = (ak0*dens(ilev))/(1. + ak0*dens(ilev)/ak1)
    767          xpo = 1./(1. + alog10((ak0*dens(ilev))/ak1)**2)
    768          c017(ilev) = rate*0.6**xpo
    769       end do
    770 
    771       nb_reaction_3 = nb_reaction_3 + 1
    772       v_3(:,nb_reaction_3) = c017(:)
    773 
    774 !---  c018: h + h + co2 -> h2 + co2
    775 
    776 !     baulch et al., 2005
    777 
    778       c018(:) = 2.5*1.8e-30*(t(:)**(-1.0))*dens(:)
    779 
    780       nb_reaction_3 = nb_reaction_3 + 1
    781       v_3(:,nb_reaction_3) = c018(:)
    782 
    783 !----------------------------------------------------------------------
    784 !     nitrogen reactions
    785 !----------------------------------------------------------------------
    786 
    787 !---  d001: no2 + o -> no + o2
    788 
    789 !     jpl 2006
    790 
    791       d001(:) = 5.1e-12*exp(210./t(:))
    792 
    793       nb_reaction_4 = nb_reaction_4 + 1
    794       v_4(:,nb_reaction_4) = d001(:)
    795 
    796 !---  d002: no + o3 -> no2 + o2
    797 
    798 !     jpl 2006
    799 
    800       d002(:) = 3.0e-12*exp(-1500./t(:))
    801 
    802       nb_reaction_4 = nb_reaction_4 + 1
    803       v_4(:,nb_reaction_4) = d002(:)
    804 
    805 !---  d003: no + ho2 -> no2 + oh
    806 
    807 !     jpl 2011
    808 
    809       d003(:) = 3.3e-12*exp(270./t(:))
    810 
    811       nb_reaction_4 = nb_reaction_4 + 1
    812       v_4(:,nb_reaction_4) = d003(:)
    813 
    814 !---  d004: n + no -> n2 + o
    815 
    816 !     jpl 2011
    817 
    818       d004(:) = 2.1e-11*exp(100./t(:))
    819 
    820       nb_reaction_4 = nb_reaction_4 + 1
    821       v_4(:,nb_reaction_4) = d004(:)
    822 
    823 !---  d005: n + o2 -> no + o
    824 
    825 !     jpl 2011
    826 
    827       d005(:) = 1.5e-11*exp(-3600./t(:))
    828 
    829       nb_reaction_4 = nb_reaction_4 + 1
    830       v_4(:,nb_reaction_4) = d005(:)
    831 
    832 !---  d006: no2 + h -> no + oh
    833 
    834 !     jpl 2011
    835 
    836       d006(:) = 4.0e-10*exp(-340./t(:))
    837 
    838       nb_reaction_4 = nb_reaction_4 + 1
    839       v_4(:,nb_reaction_4) = d006(:)
    840 
    841 !---  d007: n + o -> no
    842  
    843       d007(:) = 2.8e-17*(300./t(:))**0.5
    844 
    845       nb_reaction_4 = nb_reaction_4 + 1
    846       v_4(:,nb_reaction_4) = d007(:)
    847 
    848 !---  d008: n + ho2 -> no + oh
    849 
    850 !     brune et al., j. chem. phys., 87, 1983
    851 
    852       d008(:) = 2.19e-11
    853 
    854       nb_reaction_4 = nb_reaction_4 + 1
    855       v_4(:,nb_reaction_4) = d008(:)
    856 
    857 !---  d009: n + oh -> no + h
    858 
    859 !     atkinson et al., j. phys. chem. ref. data, 18, 881, 1989
    860 
    861       d009(:) = 3.8e-11*exp(85./t(:))
    862 
    863       nb_reaction_4 = nb_reaction_4 + 1
    864       v_4(:,nb_reaction_4) = d009(:)
    865 
    866 !----------------------------------------------------------------------
    867 !     carbon reactions
    868 !----------------------------------------------------------------------
    869 
    870 !---  e001: oh + co -> co2 + h
    871 
    872 !     jpl 2003
    873 
    874 !     e001(:) = 1.5e-13*(1 + 0.6*press(:)/1013.)
    875 
    876 !     mccabe et al., grl, 28, 3135, 2001
    877 
    878 !     e001(:) = 1.57e-13 + 3.54e-33*dens(:)
    879 
    880 !     jpl 2006
    881 
    882 !     ak0 = 1.5e-13*(t(:)/300.)**(0.6)
    883 !     ak1 = 2.1e-9*(t(:)/300.)**(6.1)
    884 !     rate1 = ak0/(1. + ak0/(ak1/dens(:)))
    885 !     xpo1 = 1./(1. + alog10(ak0/(ak1/dens(:)))**2)
    886 
    887 !     ak0 = 5.9e-33*(t(:)/300.)**(-1.4)
    888 !     ak1 = 1.1e-12*(t(:)/300.)**(1.3)
    889 !     rate2 = (ak0*dens(:))/(1. + ak0*dens(:)/ak1)
    890 !     xpo2 = 1./(1. + alog10((ak0*dens(:))/ak1)**2)
    891 
    892 !     e001(:) = rate1*0.6**xpo1 + rate2*0.6**xpo2
    893 
    894 !     joshi et al., 2006
    895 
    896       do ilev = 1,lswitch-1
    897          k1a0 = 1.34*2.5*dens(ilev)                                  &
    898                *1/(1/(3.62e-26*t(ilev)**(-2.739)*exp(-20./t(ilev)))  &
    899                + 1/(6.48e-33*t(ilev)**(0.14)*exp(-57./t(ilev))))     ! typo in paper corrected
    900          k1b0 = 1.17e-19*t(ilev)**(2.053)*exp(139./t(ilev))          &
    901               + 9.56e-12*t(ilev)**(-0.664)*exp(-167./t(ilev))
    902          k1ainf = 1.52e-17*t(ilev)**(1.858)*exp(28.8/t(ilev))        &
    903                 + 4.78e-8*t(ilev)**(-1.851)*exp(-318./t(ilev))
    904          x = k1a0/(k1ainf - k1b0)
    905          y = k1b0/(k1ainf - k1b0)
    906          fc = 0.628*exp(-1223./t(ilev)) + (1. - 0.628)*exp(-39./t(ilev))  &
    907             + exp(-t(ilev)/255.)
    908          fx = fc**(1./(1. + (alog(x))**2))                           ! typo in paper corrected
    909          k1a = k1a0*((1. + y)/(1. + x))*fx
    910          k1b = k1b0*(1./(1.+x))*fx
    911 
    912          e001(ilev) = k1a + k1b
    913       end do
    914 
    915       nb_reaction_4 = nb_reaction_4 + 1
    916       v_4(:,nb_reaction_4) = e001(:)
    917 
    918 !---  e002: o + co + m -> co2 + m
    919 
    920 !     tsang and hampson, 1986.
    921 
    922       e002(:) = 2.5*6.5e-33*exp(-2184./t(:))*dens(:)
    923 
    924       nb_reaction_4 = nb_reaction_4 + 1
    925       v_4(:,nb_reaction_4) = e002(:)
    926 
    927 !----------------------------------------------------------------------
    928 !     heterogeneous chemistry
    929 !----------------------------------------------------------------------
    930 
    931       if (hetero_ice) then
    932 
    933 !        k = (surface*v*gamma)/4 (s-1)
    934 !        v = 100*sqrt(8rt/(pi*m))  (cm s-1)
    935  
    936 !---     h001: ho2 + ice -> products
    937  
    938 !        cooper and abbatt, 1996: gamma = 0.025
    939      
    940          gam = 0.025
    941          h001(:) = surfice1d(:)       &
    942                    *100.*sqrt(8.*8.31*t(:)/(33.e-3*pi))*gam/4.
    943  
    944 !        h002: oh + ice -> products
    945  
    946 !        cooper and abbatt, 1996: gamma = 0.03
    947  
    948          gam = 0.03
    949          h002(:) = surfice1d(:)       &
    950                    *100.*sqrt(8.*8.31*t(:)/(17.e-3*pi))*gam/4.
    951 
    952 !---     h003: h2o2 + ice -> products
    953  
    954 !        gamma = 0.    test value
    955  
    956          gam = 0.
    957          h003(:) = surfice1d(:)       &
    958                    *100.*sqrt(8.*8.31*t(:)/(34.e-3*pi))*gam/4.
    959       else
    960          h001(:) = 0.
    961          h002(:) = 0.
    962          h003(:) = 0.
    963       end if
    964 
    965       nb_phot = nb_phot + 1
    966       v_phot(:,nb_phot) = h001(:)
    967 
    968       nb_phot = nb_phot + 1
    969       v_phot(:,nb_phot) = h002(:)
    970 
    971       nb_phot = nb_phot + 1
    972       v_phot(:,nb_phot) = h003(:)
    973 
    974       if (hetero_dust) then
    975  
    976 !---     h004: ho2 + dust -> products
    977  
    978 !        jacob, 2000: gamma = 0.2
    979 !        see dereus et al., atm. chem. phys., 2005
    980  
    981          gam = 0.2
    982          h004(:) = surfdust1d(:)  &
    983                    *100.*sqrt(8.*8.31*t(:)/(33.e-3*pi))*gam/4.
    984  
    985 !---     h005: h2o2 + dust -> products
    986  
    987 !        gamma = 5.e-4
    988 !        see dereus et al., atm. chem. phys., 2005
    989  
    990          gam = 5.e-4
    991          h005(:) = surfdust1d(:)  &
    992                    *100.*sqrt(8.*8.31*t(:)/(34.e-3*pi))*gam/4.
    993       else
    994          h004(:) = 0.
    995          h005(:) = 0.
    996       end if
    997  
    998       nb_phot = nb_phot + 1
    999       v_phot(:,nb_phot) = h004(:)
    1000 
    1001       nb_phot = nb_phot + 1
    1002       v_phot(:,nb_phot) = h005(:)
     581      v_phot(:,nb_phot) = ratec(:)
     582    end if
     583  else
     584    nb_hv = nb_hv + 1
     585  end if
     586
     587  ireact = ireact + 1
     588
     589end do
     590
     591! Reaction from bimolreact file are implemented secondly
     592do while(nb_reaction_4<nb_reaction_4_max-n4_hard_coding)
     593
     594  ! get right coefficient rate function
     595  if (rtype(ireact)==1) then
     596    nb_pfunc1 = nb_pfunc1 + 1
     597    if (third_body(ireact)==0) then            !! third_body check
     598      ratec = pfunc1(nlayer,t,dens,pfunc1_param(nb_pfunc1))
     599    else
     600      ratec = pfunc1(nlayer,t,c(:,third_body(ireact)),pfunc1_param(nb_pfunc1))
     601    end if
     602  else if (rtype(ireact)==2) then
     603    nb_pfunc2 = nb_pfunc2 + 1
     604    if (third_body(ireact)==0) then            !! third_body check
     605      ratec = pfunc2(nlayer,t,dens,pfunc2_param(nb_pfunc2))
     606    else
     607      ratec = pfunc2(nlayer,t,c(:,third_body(ireact)),pfunc2_param(nb_pfunc2))
     608    end if
     609  else if (rtype(ireact)==3) then
     610    nb_pfunc3 = nb_pfunc3 + 1
     611    if (third_body(ireact)==0) then            !! third_body check
     612      ratec = pfunc3(nlayer,t,dens,pfunc3_param(nb_pfunc3))
     613    else
     614      ratec = pfunc3(nlayer,t,c(:,third_body(ireact)),pfunc3_param(nb_pfunc3))
     615    end if
     616  else
     617    print*, 'Error in reactionrates: wrong index coefficient rate v4'
     618    print*, 'rtype(ireact) = ',rtype(ireact)
     619    print*, 'It should be 1 or 2 '
     620    print*, 'Please check the reaction ',ireact-nb_phot_max
     621    if (ireact>nreact) print*, 'Please check the reaction count into the code beacause ireact > nreact is not possible'
     622    stop
     623  end if
     624
     625  ! fill the right type index
     626  nb_reaction_4 = nb_reaction_4 + 1
     627  v_4(:,nb_reaction_4) = ratec(:)
     628  if (three_prod(ireact)) then             ! three_prod check
     629    nb_reaction_4 = nb_reaction_4 + 1
     630    v_4(:,nb_reaction_4) = ratec(:)
     631  end if
     632
     633  ireact = ireact + 1
     634
     635end do
     636
     637! Reaction from quadrareact file are implemented thirdly
     638do while(nb_reaction_3<nb_reaction_3_max-n3_hard_coding)
     639
     640  ! get right coefficient rate function
     641  if (rtype(ireact)==1) then
     642    nb_pfunc1 = nb_pfunc1 + 1
     643    if (third_body(ireact)==0) then            !! third_body check
     644      ratec = pfunc1(nlayer,t,dens,pfunc1_param(nb_pfunc1))
     645    else
     646      ratec = pfunc1(nlayer,t,c(:,third_body(ireact)),pfunc1_param(nb_pfunc1))
     647    end if
     648  else if (rtype(ireact)==2) then
     649    nb_pfunc2 = nb_pfunc2 + 1
     650    if (third_body(ireact)==0) then            !! third_body check
     651      ratec = pfunc2(nlayer,t,dens,pfunc2_param(nb_pfunc2))
     652    else
     653      ratec = pfunc2(nlayer,t,c(:,third_body(ireact)),pfunc2_param(nb_pfunc2))
     654    end if
     655  else if (rtype(ireact)==3) then
     656    nb_pfunc3 = nb_pfunc3 + 1
     657    if (third_body(ireact)==0) then            !! third_body check
     658      ratec = pfunc3(nlayer,t,dens,pfunc3_param(nb_pfunc3))
     659    else
     660      ratec = pfunc3(nlayer,t,c(:,third_body(ireact)),pfunc3_param(nb_pfunc3))
     661    end if
     662  else
     663    print*, 'Error in reactionrates: wrong index coefficient rate v3'
     664    print*, 'rtype(ireact) = ',rtype(ireact)
     665    print*, 'It should be 1 or 2 '
     666    print*, 'Please check the reaction ',ireact-nb_phot_max-nb_reaction_4_max
     667    if (ireact>nreact) print*, 'Please check the reaction count into the code beacause ireact > nreact is not possible'
     668    stop
     669  end if
     670
     671  ! fill the right type index
     672  nb_reaction_3 = nb_reaction_3 + 1
     673  v_3(:,nb_reaction_3) = ratec(:)
     674  if (three_prod(ireact)) then             ! three_prod check
     675    nb_reaction_3 = nb_reaction_3 + 1
     676    v_3(:,nb_reaction_3) = ratec(:)
     677  end if
     678
     679  ireact = ireact + 1
     680
     681end do
     682
     683call reactionrates_HC(nlayer,nesp,dens,t,press,zmmean,sza,c,v_phot,v_4,v_3,nb_phot,nb_reaction_4,nb_reaction_3)
     684
     685!===========================================================
     686!  check dimensions
     687!===========================================================
     688
     689if (firstcall) then
     690 ireact = ireact-1
     691 if (ireact /= nreact) print*, 'wrong dimensions in reactionrates : number of reaction should be ', nreact,' and not ', ireact
     692 if ((nb_phot /= nb_phot_max)             .or.  &
     693     (nb_reaction_3 /= nb_reaction_3_max) .or.  &
     694     (nb_reaction_4 /= nb_reaction_4_max)) then
     695    print*, 'nb_phot       = ', nb_phot
     696    print*, 'nb_reaction_4 = ', nb_reaction_4
     697    print*, 'nb_reaction_3 = ', nb_reaction_3
     698    print*, 'wrong dimensions in reactionrates'
     699    print*, 'nb_phot_max       = ', nb_phot_max
     700    print*, 'nb_reaction_4_max = ', nb_reaction_4_max
     701    print*, 'nb_reaction_3_max = ', nb_reaction_3_max
     702    print*, '------ hard coding reaction ------'
     703    print*, 'nphot_hard_coding = ', nphot_hard_coding
     704    print*, 'n4_hard_coding    = ', n4_hard_coding
     705    print*, 'n3_hard_coding    = ', n3_hard_coding
     706    stop
     707 end if
     708 if ((nb_hv /= nb_hv_max)         .or.  &
     709     (nb_pfunc1 /= nb_pfunc1_max) .or.  &
     710     (nb_pfunc2 /= nb_pfunc2_max) .or.  &
     711     (nb_pfunc3 /= nb_pfunc3_max)) then
     712    print*, 'nb_hv         = ', nb_hv
     713    print*, 'nb_pfunc1     = ', nb_pfunc1
     714    print*, 'nb_pfunc2     = ', nb_pfunc2
     715    print*, 'nb_pfunc3     = ', nb_pfunc3
     716    print*, 'wrong dimensions in reactionrates'
     717    print*, 'nb_hv_max     = ', nb_hv_max
     718    print*, 'nb_pfunc1_max = ', nb_pfunc1_max
     719    print*, 'nb_pfunc2_max = ', nb_pfunc2_max
     720    print*, 'nb_pfunc3_max = ', nb_pfunc3_max
     721    stop
     722 end if
     723firstcall = .false.
     724end if
    1003725
    1004726end subroutine reactionrates
     
    1013735
    1014736use types_asis
     737use chimiedata_h
    1015738
    1016739implicit none
    1017 
    1018 #include "chimiedata.h"
    1019740
    1020741! input
     
    1122843!================================================================
    1123844
    1124  subroutine indice(i_co2, i_co, i_o, i_o1d, i_o2, i_o3, i_h,       &
    1125                    i_h2, i_oh, i_ho2, i_h2o2, i_h2o,               &
    1126                    i_n, i_n2d, i_no, i_no2, i_n2)
     845 subroutine indice(nreact,rtype,third_body,three_prod)
    1127846
    1128847!================================================================
     
    1139858
    1140859use types_asis
     860use datafile_mod
     861use ioipsl_getin_p_mod, only: getin_p
     862use tracer_h, only: nesp
     863use chimiedata_h
     864use callkeys_mod, only: jonline
    1141865
    1142866implicit none
    1143867
    1144 #include "chimiedata.h"
    1145 
    1146 ! input
    1147 
    1148 integer :: i_co2, i_co, i_o, i_o1d, i_o2, i_o3, i_h,       &
    1149            i_h2, i_oh, i_ho2, i_h2o2, i_h2o,               &
    1150            i_n, i_n2d, i_no, i_no2, i_n2
     868! output
     869
     870integer, intent(out)              :: nreact          ! number of reactions in reactions files
     871integer, allocatable, intent(out) :: rtype(:)        ! reaction rate type
     872integer, allocatable, intent(out) :: third_body(:)   ! if the reaction have a third body: index of the third body, else zero
     873logical, allocatable, intent(out) :: three_prod(:)   ! if the reaction have a three defferent proucts egal .true.
    1151874
    1152875! local
    1153876
    1154877integer :: nb_phot, nb_reaction_3, nb_reaction_4
    1155 integer :: i_dummy
    1156 
    1157 allocate (indice_phot(nb_phot_max))
    1158 allocate (indice_3(nb_reaction_3_max))
    1159 allocate (indice_4(nb_reaction_4_max))
    1160 
    1161 i_dummy = 1
    1162 
    1163 nb_phot       = 0
    1164 nb_reaction_3 = 0
    1165 nb_reaction_4 = 0
     878integer :: nb_hv, nb_pfunc1, nb_pfunc2, nb_pfunc3
     879integer :: iq, ireact
     880
     881character(len = 128)              :: reactfile       ! reactions table file name
     882character(len = 128)              :: monoreact       ! photochemical reactions table file name
     883character(len = 128)              :: bimolreact      ! bimolecular reactions table file name
     884character(len = 128)              :: quadrareact     ! quadratic reactions table file name
     885integer                           :: nbq             ! number of species in reactions file
     886integer                           :: pnlines         ! number of lines in photochemical reactions file
     887integer                           :: bnlines         ! number of lines in bimolecular reactions file
     888integer                           :: qnlines         ! number of lines in quadratic reactions file
     889integer                           :: pnreact         ! number of reaction in photochemical reactions file
     890integer                           :: bnreact         ! number of reaction in bimolecular reactions file
     891integer                           :: qnreact         ! number of reaction in quadratic reactions file
     892integer                           :: specheck(nesp)  ! to count the species of traceur.def in reactions file
     893integer                           :: specheckr(nesp) ! to count the reactant species of traceur.def in reactions file
     894integer                           :: specheckp(nesp) ! to count the product species of traceur.def in reactions file
     895
     896nb_phot        = 0
     897nb_reaction_3  = 0
     898nb_reaction_4  = 0
     899nb_phot_hv_max = 0
     900
     901nb_hv          = 0
     902nb_pfunc1      = 0
     903nb_pfunc2      = 0
     904nb_pfunc3      = 0
    1166905
    1167906!===========================================================
    1168     O2 + hv -> O + O
     907Read chemical reactions
    1169908!===========================================================
    1170909
    1171 nb_phot = nb_phot + 1
    1172 
    1173 indice_phot(nb_phot) = z3spec(1.0, i_o2, 2.0, i_o, 0.0, i_dummy)
     910! Get number of reactions
     911pnlines        = 0
     912bnlines        = 0
     913qnlines        = 0
     914nreact         = 0
     915pnreact        = 0
     916bnreact        = 0
     917qnreact        = 0
     918
     919write(*,*) "Read photochemical reaction"
     920 monoreact = "monoreact" ! default
     921call getin_p("monoreact",monoreact) ! default path
     922write(*,*) " monoreact = ",trim(monoreact)
     923
     924write(*,*) "Read bimolecular reaction"
     925 bimolreact = "bimolreact" ! default
     926call getin_p("bimolreact",bimolreact) ! default path
     927write(*,*) " bimolreact = ",trim(bimolreact)
     928
     929write(*,*) "Read quadratic reaction"
     930 quadrareact = "quadrareact" ! default
     931call getin_p("quadrareact",quadrareact) ! default path
     932write(*,*) " quadrareact = ",trim(quadrareact)
     933
     934call count_react(monoreact,pnlines,pnreact,nb_phot,nb_hv,nb_pfunc1,nb_pfunc2,nb_pfunc3)
     935call count_react(bimolreact,bnlines,bnreact,nb_reaction_4,nb_hv,nb_pfunc1,nb_pfunc2,nb_pfunc3)
     936call count_react(quadrareact,qnlines,qnreact,nb_reaction_3,nb_hv,nb_pfunc1,nb_pfunc2,nb_pfunc3)
     937nreact = pnreact + bnreact + qnreact
     938
     939!!!!!!!!!!! Hard coding reaction !!!!!!!!!!!!!!!!!!!!!!!!!!!
     940nb_phot       = nb_phot       + nphot_hard_coding
     941nb_reaction_4 = nb_reaction_4 + n4_hard_coding
     942nb_reaction_3 = nb_reaction_3 + n3_hard_coding
     943!!!!!!!!!!! END Hard coding reaction !!!!!!!!!!!!!!!!!!!!!!!
     944
     945write(*,*)'number of reaction in reaction files is = ',nreact
     946print*, 'nb_phot       = ', nb_phot
     947print*, 'nb_reaction_4 = ', nb_reaction_4
     948print*, 'nb_reaction_3 = ', nb_reaction_3
     949print*, '****************'
     950print*, 'nb_hv         = ', nb_hv
     951print*, 'nb_pfunc1     = ', nb_pfunc1
     952print*, 'nb_pfunc2     = ', nb_pfunc2
     953print*, 'nb_pfunc3     = ', nb_pfunc3
     954nb_phot_max       = nb_phot
     955nb_reaction_4_max = nb_reaction_4
     956nb_reaction_3_max = nb_reaction_3
     957nb_hv_max         = nb_hv
     958nb_pfunc1_max     = nb_pfunc1
     959nb_pfunc2_max     = nb_pfunc2
     960nb_pfunc3_max     = nb_pfunc3
     961
     962! Allocate
     963allocate(indice_phot(nb_phot_max))
     964allocate(indice_4(nb_reaction_4_max))
     965allocate(indice_3(nb_reaction_3_max))
     966allocate(rtype(nreact))
     967allocate(third_body(nreact))
     968allocate(three_prod(nreact))
     969allocate(jlabel(nb_phot_hv_max,2))
     970allocate(jparamline(nb_phot_hv_max))
     971allocate(pfunc1_param(nb_pfunc1_max))
     972allocate(pfunc2_param(nb_pfunc2_max))
     973allocate(pfunc3_param(nb_pfunc3_max))
     974
     975! Get reactants, products and number of species in reactfile
     976! inititialize variables
     977nbq             = 0
     978specheck(:)     = 0
     979specheckr(:)    = 0
     980specheckp(:)    = 0
     981rtype(:)        = 0
     982third_body(:)   = 0
     983pfunc1_param(:) = rtype1(0.,0.,0.,0.,0.)
     984pfunc2_param(:) = rtype2(0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.)
     985pfunc3_param(:) = rtype3(0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.)
     986nb_pfunc1       = 0
     987nb_pfunc2       = 0
     988nb_pfunc3       = 0
     989three_prod(:)   = .false.
     990jlabel(:,:)     = ''
     991jparamline(:)   = ''
     992
     993call get_react(monoreact,pnlines,pnreact,rtype(1:pnreact),third_body(1:pnreact),three_prod(1:pnreact),    &
     994               nb_phot,specheck,specheckr,specheckp,'vphot',nbq,nb_pfunc1,nb_pfunc2,nb_pfunc3)
     995call get_react(bimolreact,bnlines,bnreact,rtype(pnreact+1:pnreact+bnreact),third_body(pnreact+1:pnreact+bnreact), &
     996               three_prod(pnreact+1:pnreact+bnreact),nb_reaction_4,specheck,specheckr,specheckp,'v4',nbq,nb_pfunc1,nb_pfunc2,nb_pfunc3)
     997call get_react(quadrareact,qnlines,qnreact,rtype(pnreact+bnreact+1:nreact),third_body(pnreact+bnreact+1:nreact),  &
     998               three_prod(pnreact+bnreact+1:nreact),nb_reaction_3,specheck,specheckr,specheckp,'v3',nbq,nb_pfunc1,nb_pfunc2,nb_pfunc3)
     999
     1000! rewrite jlabel corretly for output
     1001do ireact=1,nb_phot_hv_max
     1002  if (three_prod(ireact)) then
     1003    jlabel(ireact+1:nb_phot_hv_max,2) = jlabel(ireact:nb_phot_hv_max-1,2)
     1004    jlabel(ireact+1:nb_phot_hv_max,1) = jlabel(ireact:nb_phot_hv_max-1,1)
     1005    jlabel(ireact,1) = trim(jlabel(ireact,1))//'_a'
     1006    jlabel(ireact+1,1) = trim(jlabel(ireact+1,1))//'_b'
     1007  end if
     1008end do
     1009
     1010!!!!!!!!!!! Hard coding reaction !!!!!!!!!!!!!!!!!!!!!!!!!!!
     1011call indice_HC(nb_phot,nb_reaction_4,nb_reaction_3)
     1012!!!!!!!!!!! END Hard coding reaction !!!!!!!!!!!!!!!!!!!!!!!
     1013
     1014write(*,*)'number of species in reaction files is = ',nbq
     1015write(*,*)'species in reaction files are:'
     1016
     1017do iq=1,nesp
     1018  if (specheck(iq)==1) print*, chemnoms(iq)
     1019end do
    11741020
    11751021!===========================================================
    1176     O2 + hv -> O + O(1D)
     1022check species only destroy or product
    11771023!===========================================================
    11781024
    1179 nb_phot = nb_phot + 1
    1180 
    1181 indice_phot(nb_phot) = z3spec(1.0, i_o2, 1.0, i_o, 1.0, i_o1d)
     1025do iq=1,nesp
     1026  if (specheckr(iq)/=specheckp(iq)) then
     1027    if (specheckr(iq)==0 .and. specheckp(iq)==1) then
     1028      print*, 'WARNING: ', chemnoms(iq),' is only product'
     1029    else if (specheckr(iq)==1 .and. specheckp(iq)==0) then
     1030      print*, 'WARNING: ', chemnoms(iq),' is only destroy'
     1031    else
     1032      print*, 'Error in indice: bad value in specheckr or specheckp'
     1033      stop
     1034    end if
     1035  end if
     1036end do
    11821037
    11831038!===========================================================
    1184     CO2 + hv -> CO + O
     1039check stochiometry
    11851040!===========================================================
    11861041
    1187 nb_phot = nb_phot + 1
    1188 
    1189 indice_phot(nb_phot) = z3spec(1.0, i_co2, 1.0, i_co, 1.0, i_o)
    1190 
    1191 !===========================================================
    1192 !      CO2 + hv -> CO + O(1D)
    1193 !===========================================================
    1194 
    1195 nb_phot = nb_phot + 1
    1196 
    1197 indice_phot(nb_phot) = z3spec(1.0, i_co2, 1.0, i_co, 1.0, i_o1d)
    1198 
    1199 !===========================================================
    1200 !      O3 + hv -> O2 + O(1D)
    1201 !===========================================================
    1202 
    1203 nb_phot = nb_phot + 1
    1204 
    1205 indice_phot(nb_phot) = z3spec(1.0, i_o3, 1.0, i_o2, 1.0, i_o1d)
    1206 
    1207 !===========================================================
    1208 !      O3 + hv -> O2 + O
    1209 !===========================================================
    1210 
    1211 nb_phot = nb_phot + 1
    1212 
    1213 indice_phot(nb_phot) = z3spec(1.0, i_o3, 1.0, i_o2, 1.0, i_o)
    1214 
    1215 !===========================================================
    1216 !      H2O + hv -> H + OH
    1217 !===========================================================
    1218 
    1219 nb_phot = nb_phot + 1
    1220 
    1221 indice_phot(nb_phot) = z3spec(1.0, i_h2o, 1.0, i_h, 1.0, i_oh)
    1222 
    1223 !===========================================================
    1224 !      H2O2 + hv -> OH + OH
    1225 !===========================================================
    1226 
    1227 nb_phot = nb_phot + 1
    1228 
    1229 indice_phot(nb_phot) = z3spec(1.0, i_h2o2, 2.0, i_oh, 0.0, i_dummy)
    1230 
    1231 !===========================================================
    1232 !      HO2 + hv -> OH + O
    1233 !===========================================================
    1234 
    1235 nb_phot = nb_phot + 1
    1236 
    1237 indice_phot(nb_phot) = z3spec(1.0, i_ho2, 1.0, i_oh, 1.0, i_o)
    1238 
    1239 !===========================================================
    1240 !      NO + hv -> N + O
    1241 !===========================================================
    1242 
    1243 nb_phot = nb_phot + 1
    1244 
    1245 indice_phot(nb_phot) = z3spec(1.0, i_no, 1.0, i_n, 1.0, i_o)
    1246 
    1247 !===========================================================
    1248 !      NO2 + hv -> NO + O
    1249 !===========================================================
    1250 
    1251 nb_phot = nb_phot + 1
    1252 
    1253 indice_phot(nb_phot) = z3spec(1.0, i_no2, 1.0, i_no, 1.0, i_o)
    1254 
    1255 !===========================================================
    1256 !      a001 : O + O2 + CO2 -> O3 + CO2
    1257 !===========================================================
    1258 
    1259 nb_reaction_4 = nb_reaction_4 + 1
    1260 
    1261 indice_4(nb_reaction_4) = z4spec(1.0, i_o, 1.0, i_o2, 1.0, i_o3, 0.0, i_dummy)
    1262 
    1263 !===========================================================
    1264 !      a002 : O + O + CO2 -> O2 + CO2
    1265 !===========================================================
    1266 
    1267 nb_reaction_3 = nb_reaction_3 + 1
    1268 
    1269 indice_3(nb_reaction_3) = z3spec(2.0, i_o, 1.0, i_o2, 0.0, i_dummy)
    1270 
    1271 !===========================================================
    1272 !      a003 : O + O3 -> O2 + O2
    1273 !===========================================================
    1274 
    1275 nb_reaction_4 = nb_reaction_4 + 1
    1276 
    1277 indice_4(nb_reaction_4) = z4spec(1.0, i_o, 1.0, i_o3, 2.0, i_o2, 0.0, i_dummy)
    1278 
    1279 !===========================================================
    1280 !      b001 : O(1D) + CO2 -> O + CO2
    1281 !===========================================================
    1282 
    1283 nb_phot = nb_phot + 1
    1284 
    1285 indice_phot(nb_phot) = z3spec(1.0, i_o1d, 1.0, i_o, 0.0, i_dummy)
    1286 
    1287 !===========================================================
    1288 !      b002 : O(1D) + H2O -> OH + OH
    1289 !===========================================================
    1290 
    1291 nb_reaction_4 = nb_reaction_4 + 1
    1292 
    1293 indice_4(nb_reaction_4) = z4spec(1.0, i_o1d, 1.0, i_h2o, 2.0, i_oh, 0.0, i_dummy)
    1294 
    1295 !===========================================================
    1296 !      b003 : O(1D) + H2 -> OH + H
    1297 !===========================================================
    1298 
    1299 nb_reaction_4 = nb_reaction_4 + 1
    1300 
    1301 indice_4(nb_reaction_4) = z4spec(1.0, i_o1d, 1.0, i_h2, 1.0, i_oh, 1.0, i_h)
    1302 
    1303 !===========================================================
    1304 !      b004 : O(1D) + O2 -> O + O2
    1305 !===========================================================
    1306 
    1307 nb_phot = nb_phot + 1
    1308 
    1309 indice_phot(nb_phot) = z3spec(1.0, i_o1d, 1.0, i_o, 0.0, i_dummy)
    1310 
    1311 !===========================================================
    1312 !      b005 : O(1D) + O3 -> O2 + O2
    1313 !===========================================================
    1314 
    1315 nb_reaction_4 = nb_reaction_4 + 1
    1316 
    1317 indice_4(nb_reaction_4) = z4spec(1.0, i_o1d, 1.0, i_o3, 2.0, i_o2, 0.0, i_dummy)
    1318 
    1319 !===========================================================
    1320 !      b006 : O(1D) + O3 -> O2 + O + O
    1321 !===========================================================
    1322 
    1323 nb_reaction_4 = nb_reaction_4 + 1
    1324 
    1325 indice_4(nb_reaction_4) = z4spec(1.0, i_o1d, 1.0, i_o3, 1.0, i_o2, 2.0, i_o)
    1326 
    1327 !===========================================================
    1328 !      c001 : O + HO2 -> OH + O2
    1329 !===========================================================
    1330 
    1331 nb_reaction_4 = nb_reaction_4 + 1
    1332 
    1333 indice_4(nb_reaction_4) = z4spec(1.0, i_o, 1.0, i_ho2, 1.0, i_oh, 1.0, i_o2)
    1334 
    1335 !===========================================================
    1336 !      c002 : O + OH -> O2 + H
    1337 !===========================================================
    1338 
    1339 nb_reaction_4 = nb_reaction_4 + 1
    1340 
    1341 indice_4(nb_reaction_4) = z4spec(1.0, i_o, 1.0, i_oh, 1.0, i_o2, 1.0, i_h)
    1342 
    1343 !===========================================================
    1344 !      c003 : H + O3 -> OH + O2
    1345 !===========================================================
    1346 
    1347 nb_reaction_4 = nb_reaction_4 + 1
    1348 
    1349 indice_4(nb_reaction_4) = z4spec(1.0, i_h, 1.0, i_o3, 1.0, i_oh, 1.0, i_o2)
    1350 
    1351 !===========================================================
    1352 !      c004 : H + HO2 -> OH + OH
    1353 !===========================================================
    1354 
    1355 nb_reaction_4 = nb_reaction_4 + 1
    1356 
    1357 indice_4(nb_reaction_4) = z4spec(1.0, i_h, 1.0, i_ho2, 2.0, i_oh, 0.0, i_dummy)
    1358 
    1359 !===========================================================
    1360 !      c005 : H + HO2 -> H2 + O2
    1361 !===========================================================
    1362 
    1363 nb_reaction_4 = nb_reaction_4 + 1
    1364 
    1365 indice_4(nb_reaction_4) = z4spec(1.0, i_h, 1.0, i_ho2, 1.0, i_h2, 1.0, i_o2)
    1366 
    1367 !===========================================================
    1368 !      c006 : H + HO2 -> H2O + O
    1369 !===========================================================
    1370 
    1371 nb_reaction_4 = nb_reaction_4 + 1
    1372 
    1373 indice_4(nb_reaction_4) = z4spec(1.0, i_h, 1.0, i_ho2, 1.0, i_h2o, 1.0, i_o)
    1374 
    1375 !===========================================================
    1376 !      c007 : OH + HO2 -> H2O + O2
    1377 !===========================================================
    1378 
    1379 nb_reaction_4 = nb_reaction_4 + 1
    1380 
    1381 indice_4(nb_reaction_4) = z4spec(1.0, i_oh, 1.0, i_ho2, 1.0, i_h2o, 1.0, i_o2)
    1382 
    1383 !===========================================================
    1384 !      c008 : HO2 + HO2 -> H2O2 + O2
    1385 !===========================================================
    1386 
    1387 nb_reaction_3 = nb_reaction_3 + 1
    1388 
    1389 indice_3(nb_reaction_3) = z3spec(2.0, i_ho2, 1.0, i_h2o2, 1.0, i_o2)
    1390 
    1391 !===========================================================
    1392 !      c009 : OH + H2O2 -> H2O + HO2
    1393 !===========================================================
    1394 
    1395 nb_reaction_4 = nb_reaction_4 + 1
    1396 
    1397 indice_4(nb_reaction_4) = z4spec(1.0, i_oh, 1.0, i_h2o2, 1.0, i_h2o, 1.0, i_ho2)
    1398 
    1399 !===========================================================
    1400 !      c010 : OH + H2 -> H2O + H
    1401 !===========================================================
    1402 
    1403 nb_reaction_4 = nb_reaction_4 + 1
    1404 
    1405 indice_4(nb_reaction_4) = z4spec(1.0, i_oh, 1.0, i_h2, 1.0, i_h2o, 1.0, i_h)
    1406 
    1407 !===========================================================
    1408 !      c011 : H + O2 + CO2 -> HO2 + CO2
    1409 !===========================================================
    1410 
    1411 nb_reaction_4 = nb_reaction_4 + 1
    1412 
    1413 indice_4(nb_reaction_4) = z4spec(1.0, i_h, 1.0, i_o2, 1.0, i_ho2, 0.0, i_dummy)
    1414 
    1415 !===========================================================
    1416 !      c012 : O + H2O2 -> OH + HO2
    1417 !===========================================================
    1418 
    1419 nb_reaction_4 = nb_reaction_4 + 1
    1420 
    1421 indice_4(nb_reaction_4) = z4spec(1.0, i_o, 1.0, i_h2o2, 1.0, i_oh, 1.0, i_ho2)
    1422 
    1423 !===========================================================
    1424 !      c013 : OH + OH -> H2O + O
    1425 !===========================================================
    1426 
    1427 nb_reaction_3 = nb_reaction_3 + 1
    1428 
    1429 indice_3(nb_reaction_3) = z3spec(2.0, i_oh, 1.0, i_h2o, 1.0, i_o)
    1430 
    1431 !===========================================================
    1432 !      c014 : OH + O3 -> HO2 + O2
    1433 !===========================================================
    1434 
    1435 nb_reaction_4 = nb_reaction_4 + 1
    1436 
    1437 indice_4(nb_reaction_4) = z4spec(1.0, i_oh, 1.0, i_o3, 1.0, i_ho2, 1.0, i_o2)
    1438 
    1439 !===========================================================
    1440 !      c015 : HO2 + O3 -> OH + O2 + O2
    1441 !===========================================================
    1442 
    1443 nb_reaction_4 = nb_reaction_4 + 1
    1444 
    1445 indice_4(nb_reaction_4) = z4spec(1.0, i_ho2, 1.0, i_o3, 1.0, i_oh, 2.0, i_o2)
    1446 
    1447 !===========================================================
    1448 !      c016 : HO2 + HO2 + CO2 -> H2O2 + O2 + CO2
    1449 !===========================================================
    1450 
    1451 nb_reaction_3 = nb_reaction_3 + 1
    1452 
    1453 indice_3(nb_reaction_3) = z3spec(2.0, i_ho2, 1.0, i_h2o2, 1.0, i_o2)
    1454 
    1455 !===========================================================
    1456 !      c017 : OH + OH + CO2 -> H2O2 + CO2
    1457 !===========================================================
    1458 
    1459 nb_reaction_3 = nb_reaction_3 + 1
    1460 
    1461 indice_3(nb_reaction_3) = z3spec(2.0, i_oh, 1.0, i_h2o2, 0.0, i_dummy)
    1462 
    1463 !===========================================================
    1464 !      c018 : H + H + CO2 -> H2 + CO2
    1465 !===========================================================
    1466 
    1467 nb_reaction_3 = nb_reaction_3 + 1
    1468 
    1469 indice_3(nb_reaction_3) = z3spec(2.0, i_h, 1.0, i_h2, 0.0, i_dummy)
    1470 
    1471 !===========================================================
    1472 !      d001 : NO2 + O -> NO + O2
    1473 !===========================================================
    1474 
    1475 nb_reaction_4 = nb_reaction_4 + 1
    1476 
    1477 indice_4(nb_reaction_4) = z4spec(1.0, i_no2, 1.0, i_o, 1.0, i_no, 1.0, i_o2)
    1478 
    1479 !===========================================================
    1480 !      d002 : NO + O3 -> NO2 + O2
    1481 !===========================================================
    1482 
    1483 nb_reaction_4 = nb_reaction_4 + 1
    1484 
    1485 indice_4(nb_reaction_4) = z4spec(1.0, i_no, 1.0, i_o3, 1.0, i_no2, 1.0, i_o2)
    1486 
    1487 !===========================================================
    1488 !      d003 : NO + HO2 -> NO2 + OH
    1489 !===========================================================
    1490 
    1491 nb_reaction_4 = nb_reaction_4 + 1
    1492 
    1493 indice_4(nb_reaction_4) = z4spec(1.0, i_no, 1.0, i_ho2, 1.0, i_no2, 1.0, i_oh)
    1494 
    1495 !===========================================================
    1496 !      d004 : N + NO -> N2 + O
    1497 !===========================================================
    1498 
    1499 nb_reaction_4 = nb_reaction_4 + 1
    1500 
    1501 indice_4(nb_reaction_4) = z4spec(1.0, i_n, 1.0, i_no, 1.0, i_n2, 1.0, i_o)
    1502 
    1503 !===========================================================
    1504 !      d005 : N + O2 -> NO + O
    1505 !===========================================================
    1506 
    1507 nb_reaction_4 = nb_reaction_4 + 1
    1508 
    1509 indice_4(nb_reaction_4) = z4spec(1.0, i_n, 1.0, i_o2, 1.0, i_no, 1.0, i_o)
    1510 
    1511 !===========================================================
    1512 !      d006 : NO2 + H -> NO + OH
    1513 !===========================================================
    1514 
    1515 nb_reaction_4 = nb_reaction_4 + 1
    1516 
    1517 indice_4(nb_reaction_4) = z4spec(1.0, i_no2, 1.0, i_h, 1.0, i_no, 1.0, i_oh)
    1518 
    1519 !===========================================================
    1520 !      d007 : N + O -> NO
    1521 !===========================================================
    1522 
    1523 nb_reaction_4 = nb_reaction_4 + 1
    1524 
    1525 indice_4(nb_reaction_4) = z4spec(1.0, i_n, 1.0, i_o, 1.0, i_no, 0.0, i_dummy)
    1526 
    1527 !===========================================================
    1528 !      d008 : N + HO2 -> NO + OH
    1529 !===========================================================
    1530 
    1531 nb_reaction_4 = nb_reaction_4 + 1
    1532 
    1533 indice_4(nb_reaction_4) = z4spec(1.0, i_n, 1.0, i_ho2, 1.0, i_no, 1.0, i_oh)
    1534 
    1535 !===========================================================
    1536 !      d009 : N + OH -> NO + H
    1537 !===========================================================
    1538 
    1539 nb_reaction_4 = nb_reaction_4 + 1
    1540 
    1541 indice_4(nb_reaction_4) = z4spec(1.0, i_n, 1.0, i_oh, 1.0, i_no, 1.0, i_h)
    1542 
    1543 !===========================================================
    1544 !      e001 : CO + OH -> CO2 + H
    1545 !===========================================================
    1546 
    1547 nb_reaction_4 = nb_reaction_4 + 1
    1548 
    1549 indice_4(nb_reaction_4) = z4spec(1.0, i_co, 1.0, i_oh, 1.0, i_co2, 1.0, i_h)
    1550 
    1551 !===========================================================
    1552 !      e002 : CO + O + M -> CO2 + M
    1553 !===========================================================
    1554 
    1555 nb_reaction_4 = nb_reaction_4 + 1
    1556 
    1557 indice_4(nb_reaction_4) = z4spec(1.0, i_co, 1.0, i_o, 1.0, i_co2, 0.0, i_dummy)
    1558 
    1559 !===========================================================
    1560 !      h001: HO2 + ice -> products
    1561 !            treated as
    1562 !            HO2 -> 0.5 H2O + 0.75 O2
    1563 !===========================================================
    1564 
    1565 nb_phot = nb_phot + 1
    1566 
    1567 indice_phot(nb_phot) = z3spec(1.0, i_ho2, 0.5, i_h2o, 0.75, i_o2)
    1568 
    1569 !===========================================================
    1570 !      h002: OH + ice -> products
    1571 !            treated as
    1572 !            OH -> 0.5 H2O + 0.25 O2
    1573 !===========================================================
    1574 
    1575 nb_phot = nb_phot + 1
    1576 
    1577 indice_phot(nb_phot) = z3spec(1.0, i_oh, 0.5, i_h2o, 0.25, i_o2)
    1578 
    1579 !===========================================================
    1580 !      h003: H2O2 + ice -> products
    1581 !            treated as
    1582 !            H2O2 -> H2O + 0.5 O2
    1583 !===========================================================
    1584 
    1585 nb_phot = nb_phot + 1
    1586 
    1587 indice_phot(nb_phot) = z3spec(1.0, i_h2o2, 1.0, i_h2o, 0.5, i_o2)
    1588 
    1589 !===========================================================
    1590 !      h004: HO2 + dust -> products
    1591 !            treated as
    1592 !            HO2 -> 0.5 H2O + 0.75 O2
    1593 !===========================================================
    1594 
    1595 nb_phot = nb_phot + 1
    1596 
    1597 indice_phot(nb_phot) = z3spec(1.0, i_ho2, 0.5, i_h2o, 0.75, i_o2)
    1598 
    1599 !===========================================================
    1600 !      h005: H2O2 + dust -> products
    1601 !            treated as
    1602 !            H2O2 -> H2O + 0.5 O2
    1603 !===========================================================
    1604 
    1605 nb_phot = nb_phot + 1
    1606 
    1607 indice_phot(nb_phot) = z3spec(1.0, i_h2o2, 1.0, i_h2o, 0.5, i_o2)
     1042! If you found a way
    16081043
    16091044!===========================================================
     
    16111046!===========================================================
    16121047
    1613 print*, 'nb_phot       = ', nb_phot
    1614 print*, 'nb_reaction_4 = ', nb_reaction_4
    1615 print*, 'nb_reaction_3 = ', nb_reaction_3
     1048if (jonline) then
     1049  nd = nb_hv_max
     1050else if (nb_phot_hv_max /= 0) then
     1051  print*,'calchim: Read photolysis lookup table'
     1052  call read_phototable
     1053end if
    16161054
    16171055if ((nb_phot /= nb_phot_max)             .or.  &
    16181056    (nb_reaction_3 /= nb_reaction_3_max) .or.  &
    1619     (nb_reaction_4 /= nb_reaction_4_max)) then
     1057    (nb_reaction_4 /= nb_reaction_4_max) .or.  &
     1058    (nd /= nb_hv_max)) then
     1059   print*, 'nb_phot       = ', nb_phot
     1060   print*, 'nb_reaction_4 = ', nb_reaction_4
     1061   print*, 'nb_reaction_3 = ', nb_reaction_3
     1062   print*, 'nd            = ', nd
    16201063   print*, 'wrong dimensions in indice'
     1064   print*, 'nb_phot_max       = ', nb_phot_max
     1065   print*, 'nb_reaction_4_max = ', nb_reaction_4_max
     1066   print*, 'nb_reaction_3_max = ', nb_reaction_3_max
     1067   print*, 'nb_phot_hv_max    = ', nb_phot_hv_max
     1068   print*, 'nb_hv_max         = ', nb_hv_max
    16211069   stop
    16221070end if 
     
    16261074!*****************************************************************
    16271075
    1628       subroutine gcmtochim(nlayer, nq, zycol, lswitch, nesp,         &
    1629                            i_co2, i_co, i_o, i_o1d, i_o2, i_o3, i_h, &
    1630                            i_h2, i_oh, i_ho2, i_h2o2, i_h2o,         &
    1631                            i_n, i_n2d, i_no, i_no2, i_n2,            &
    1632                            dens, rm, c)
     1076      subroutine gcmtochim(nlayer, zycol, lswitch, nesp, dens, rm, c)
    16331077
    16341078!*****************************************************************
    1635 
    1636       use tracer_h, only: igcm_co2, igcm_co, igcm_o, igcm_o1d,         &
    1637      &                      igcm_o2, igcm_o3, igcm_h, igcm_h2, igcm_oh,  &
    1638      &                      igcm_ho2, igcm_h2o2, igcm_h2o_vap,           &
    1639      &                      igcm_n, igcm_n2d, igcm_no, igcm_no2, igcm_n2
    16401079
    16411080      use callkeys_mod
     
    16491088     
    16501089      integer, intent(in) :: nlayer ! number of atmospheric layers
    1651       integer, intent(in) :: nq     ! number of tracers in the gcm
    1652       integer :: nesp               ! number of species in the chemistry
     1090      integer, intent(in) :: nesp   ! number of species in the chemistry
    16531091      integer :: lswitch            ! interface level between chemistries
    16541092
    1655       integer :: i_co2, i_co, i_o, i_o1d, i_o2, i_o3, i_h,           &
    1656                  i_h2, i_oh, i_ho2, i_h2o2, i_h2o,                   &
    1657                  i_n, i_n2d, i_no, i_no2, i_n2
    1658 
    1659       real :: zycol(nlayer,nq)      ! volume mixing ratios in the gcm
     1093      real :: zycol(nlayer,nesp)    ! volume mixing ratios in the gcm
    16601094      real :: dens(nlayer)          ! total number density (molecule.cm-3)
    16611095
     
    16721106
    16731107      integer      :: l, iesp
    1674       logical,save :: firstcall = .true.
    16751108     
     1109      rm(:,:) = 0.
    16761110     
    1677 !     first call initializations
    1678 
    1679       if (firstcall) then
    1680 
    1681 !       identify the indexes of the tracers we need
    1682 
    1683          if (igcm_co2 == 0) then
    1684             write(*,*) "gcmtochim: Error; no CO2 tracer !!!"
    1685             stop
    1686          endif
    1687          if (igcm_co == 0) then
    1688             write(*,*) "gcmtochim: Error; no CO tracer !!!"
    1689             stop
    1690          end if
    1691          if (igcm_o == 0) then
    1692             write(*,*) "gcmtochim: Error; no O tracer !!!"
    1693             stop
    1694          end if
    1695          if (igcm_o1d == 0) then
    1696             write(*,*) "gcmtochim: Error; no O1D tracer !!!"
    1697             stop
    1698          end if
    1699          if (igcm_o2 == 0) then
    1700             write(*,*) "gcmtochim: Error; no O2 tracer !!!"
    1701             stop
    1702          end if
    1703          if (igcm_o3 == 0) then
    1704             write(*,*) "gcmtochim: Error; no O3 tracer !!!"
    1705             stop
    1706          end if
    1707          if (igcm_h == 0) then
    1708             write(*,*) "gcmtochim: Error; no H tracer !!!"
    1709             stop
    1710          end if
    1711          if (igcm_h2 == 0) then
    1712             write(*,*) "gcmtochim: Error; no H2 tracer !!!"
    1713             stop
    1714          end if
    1715          if (igcm_oh == 0) then
    1716             write(*,*) "gcmtochim: Error; no OH tracer !!!"
    1717             stop
    1718          end if
    1719          if (igcm_ho2 == 0) then
    1720             write(*,*) "gcmtochim: Error; no HO2 tracer !!!"
    1721             stop
    1722          end if
    1723          if (igcm_h2o2 == 0) then
    1724             write(*,*) "gcmtochim: Error; no H2O2 tracer !!!"
    1725             stop
    1726          end if
    1727          if (igcm_n == 0) then
    1728             write(*,*) "gcmtochim: Error; no N tracer !!!"
    1729 !            stop
    1730          end if
    1731          if (igcm_n2d == 0) then
    1732             write(*,*) "gcmtochim: Error; no N2D tracer !!!"
    1733 !            stop
    1734          end if
    1735          if (igcm_no == 0) then
    1736             write(*,*) "gcmtochim: Error; no NO tracer !!!"
    1737 !            stop
    1738          end if
    1739          if (igcm_no2 == 0) then
    1740             write(*,*) "gcmtochim: Error; no NO2 tracer !!!"
    1741 !            stop
    1742          end if
    1743          if (igcm_n2 == 0) then
    1744             write(*,*) "gcmtochim: Error; no N2 tracer !!!"
    1745             stop
    1746          end if
    1747          if (igcm_h2o_vap == 0) then
    1748             write(*,*) "gcmtochim: Error; no water vapor tracer !!!"
    1749             stop
    1750          end if
    1751          firstcall = .false.
    1752       end if ! of if (firstcall)
    1753 
    17541111!ccccccccccccccccccccccccccccccccccccccccccccccccccccccc
    17551112!     initialise mixing ratios
     
    17571114
    17581115      do l = 1,lswitch-1
    1759          rm(l,i_co2)  = zycol(l, igcm_co2)
    1760          rm(l,i_co)   = zycol(l, igcm_co)
    1761          rm(l,i_o)    = zycol(l, igcm_o)
    1762          rm(l,i_o1d)  = zycol(l, igcm_o1d)
    1763          rm(l,i_o2)   = zycol(l, igcm_o2)
    1764          rm(l,i_o3)   = zycol(l, igcm_o3)
    1765          rm(l,i_h)    = zycol(l, igcm_h)
    1766          rm(l,i_h2)   = zycol(l, igcm_h2)
    1767          rm(l,i_oh)   = zycol(l, igcm_oh)
    1768          rm(l,i_ho2)  = zycol(l, igcm_ho2)
    1769          rm(l,i_h2o2) = zycol(l, igcm_h2o2)
    1770          rm(l,i_h2o)  = zycol(l, igcm_h2o_vap)
    1771          rm(l,i_n)    = zycol(l, igcm_n)
    1772          rm(l,i_n2d)  = zycol(l, igcm_n2d)
    1773          rm(l,i_no)   = zycol(l, igcm_no)
    1774          rm(l,i_no2)  = zycol(l, igcm_no2)
    1775          rm(l,i_n2)   = zycol(l, igcm_n2)
     1116         rm(l,:) = zycol(l,:)
    17761117      end do
    17771118
     
    17941135!*****************************************************************
    17951136 
    1796       subroutine chimtogcm(nlayer, nq, zycol, lswitch, nesp,         &
    1797                            i_co2, i_co, i_o, i_o1d, i_o2, i_o3, i_h, &
    1798                            i_h2, i_oh, i_ho2, i_h2o2, i_h2o,         &
    1799                            i_n, i_n2d, i_no, i_no2, i_n2, dens, c)
     1137      subroutine chimtogcm(nlayer, zycol, lswitch, nesp, dens, c)
     1138
    18001139 
    18011140!*****************************************************************
    1802  
    1803       use tracer_h, only: igcm_co2, igcm_co, igcm_o, igcm_o1d,          &
    1804                             igcm_o2, igcm_o3, igcm_h, igcm_h2, igcm_oh,   &
    1805                             igcm_ho2, igcm_h2o2, igcm_h2o_vap,            &
    1806                             igcm_n, igcm_n2d, igcm_no, igcm_no2, igcm_n2
    18071141
    18081142      use callkeys_mod
     
    18161150 
    18171151      integer, intent(in) :: nlayer  ! number of atmospheric layers
    1818       integer, intent(in) :: nq      ! number of tracers in the gcm
    1819       integer :: nesp                ! number of species in the chemistry
     1152      integer, intent(in) :: nesp    ! number of species in the chemistry
    18201153      integer :: lswitch             ! interface level between chemistries
    1821       integer :: i_co2, i_co, i_o, i_o1d, i_o2, i_o3, i_h,       &
    1822                  i_h2, i_oh, i_ho2, i_h2o2, i_h2o,               &
    1823                  i_n, i_n2d, i_no, i_no2, i_n2
    18241154
    18251155      real :: dens(nlayer)     ! total number density (molecule.cm-3)
     
    18301160!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
    18311161       
    1832       real zycol(nlayer,nq)  ! volume mixing ratios in the gcm
     1162      real zycol(nlayer,nesp)  ! volume mixing ratios in the gcm
    18331163
    18341164!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
     
    18431173
    18441174      do l = 1,lswitch-1
    1845          zycol(l, igcm_co2)     = c(l,i_co2)/dens(l)
    1846          zycol(l, igcm_co)      = c(l,i_co)/dens(l)
    1847          zycol(l, igcm_o)       = c(l,i_o)/dens(l)
    1848          zycol(l, igcm_o1d)     = c(l,i_o1d)/dens(l)
    1849          zycol(l, igcm_o2)      = c(l,i_o2)/dens(l)
    1850          zycol(l, igcm_o3)      = c(l,i_o3)/dens(l)
    1851          zycol(l, igcm_h)       = c(l,i_h)/dens(l) 
    1852          zycol(l, igcm_h2)      = c(l,i_h2)/dens(l)
    1853          zycol(l, igcm_oh)      = c(l,i_oh)/dens(l)
    1854          zycol(l, igcm_ho2)     = c(l,i_ho2)/dens(l)
    1855          zycol(l, igcm_h2o2)    = c(l,i_h2o2)/dens(l)
    1856          zycol(l, igcm_h2o_vap) = c(l,i_h2o)/dens(l)
    1857          zycol(l, igcm_n)       = c(l,i_n)/dens(l)
    1858          zycol(l, igcm_n2d)     = c(l,i_n2d)/dens(l)
    1859          zycol(l, igcm_no)      = c(l,i_no)/dens(l)
    1860          zycol(l, igcm_no2)     = c(l,i_no2)/dens(l)
    1861          zycol(l, igcm_n2)      = c(l,i_n2)/dens(l)
     1175         zycol(l,:)  = c(l,:)/dens(l)
    18621176      end do
    18631177
    18641178      end subroutine chimtogcm
    18651179
     1180!*****************************************************************
     1181
     1182    subroutine split_str(line,words,n,nmax)
     1183
     1184!*****************************************************************
     1185
     1186        implicit none
     1187        character(*), intent(in)  :: line
     1188        integer,      intent(in)  :: nmax
     1189        character(*), intent(out) :: words(nmax)
     1190        integer,      intent(out) :: n          ! number of words at the end
     1191        integer :: ios
     1192        character(100) :: buf(100)  ! large buffer!
     1193   
     1194        n = 0
     1195        do
     1196            n = n + 1
     1197            read(line,*,iostat=ios) buf(1:n)  ! use list-directed input
     1198            if (ios==0) then
     1199                words(1:n) = buf(1:n)   ! if success, copy to the original array
     1200            else
     1201                n = n-1
     1202                exit       ! if all the words are obtained, finish
     1203            endif
     1204            if (n>nmax) then
     1205              print*,'Error in split_str: to much words'
     1206              print*,'limit = ',nmax
     1207              print*,'change it, if you want, with increasing nmax'
     1208              stop
     1209            end if
     1210        enddo
     1211    end subroutine split_str
     1212
     1213!*****************************************************************
     1214
     1215    subroutine count_react(reactfile,nlines,nreact,nrtype,nb_hv,nb_pfunc1,nb_pfunc2,nb_pfunc3)
     1216
     1217!*****************************************************************
     1218
     1219        use types_asis, only : nb_phot_hv_max
     1220
     1221        implicit none
     1222        character(*), intent(in)     :: reactfile ! name of the file to read
     1223        integer,      intent(inout)  :: nlines    ! number of lines in the file
     1224        integer,      intent(out)    :: nreact    ! real number of reaction
     1225        integer,      intent(inout)  :: nrtype    ! number of reaction for calculation
     1226        integer,      intent(inout)  :: nb_hv, nb_pfunc1, nb_pfunc2, nb_pfunc3
     1227
     1228        ! local
     1229        character(len = 50) :: reactline          ! all reactants of one reaction
     1230        character(len = 50) :: prodline           ! all produts of one reaction
     1231        integer             :: typerate           ! get the type of the rate reaction coefficient (pfunc_i)
     1232        integer             :: nwp                ! number of products for a reaction
     1233        integer,parameter   :: nmax = 5           ! number max of reactants or products
     1234        character(len = 24) :: words(nmax)        ! to get words in reactants and products line
     1235        integer             :: ierr
     1236
     1237        nreact     = 0
     1238
     1239        open(402, form = 'formatted', status = 'old',                &
     1240              file ='chemnetwork/'//trim(reactfile),iostat=ierr)
     1241
     1242        if (ierr /= 0) THEN
     1243           write(*,*)'Error : cannot open chemical reaction file : chemnetwork/'//trim(reactfile)
     1244           write(*,*)'It should be in your simulation directory in chemnetwork directory'
     1245           write(*,*)'   You can change the input chemical reactions file name in'
     1246           write(*,*)'   callphys.def with:'
     1247           write(*,*)'   monoreact=filename or bimolreact=filename or quadrareact=filename'
     1248           write(*,*)'   depending on what chemical reaction type it is'
     1249           stop
     1250        end if
     1251   
     1252        do
     1253          read(402,'(A,A,I2)',iostat=ierr) reactline, prodline, typerate
     1254          if (ierr<0) exit
     1255          nlines = nlines + 1
     1256          if (reactline(1:1)/='!' .and. reactline(1:1)/='') then
     1257            ! count the number of reaction
     1258            nreact = nreact + 1
     1259            call split_str(prodline,words,nwp,nmax)
     1260            nrtype = nrtype + 1
     1261            ! check three product reaction
     1262            if (nwp>2 .and. trim(words(1))/=trim(words(2)) &
     1263                      .and. trim(words(1))/=trim(words(3)) &
     1264                      .and. trim(words(2))/=trim(words(3))) nrtype = nrtype + 1
     1265
     1266            ! count the number of each rate reaction coefficient type
     1267            if (typerate==0) then
     1268              nb_hv = nb_hv + 1
     1269              nb_phot_hv_max = nb_phot_hv_max + 1
     1270              if (nwp>2 .and. trim(words(1))/=trim(words(2)) &
     1271                        .and. trim(words(1))/=trim(words(3)) &
     1272                        .and. trim(words(2))/=trim(words(3))) nb_phot_hv_max = nb_phot_hv_max + 1
     1273            else if (typerate==1) then
     1274              nb_pfunc1 = nb_pfunc1 + 1
     1275            else if (typerate==2) then
     1276              nb_pfunc2 = nb_pfunc2 + 1
     1277            else if (typerate==3) then
     1278              nb_pfunc3 = nb_pfunc3 + 1
     1279            else
     1280              print*, 'Error in indice: wrong index coefficient rate line ',nlines
     1281              print*, 'in file : chemnetwork/'//trim(reactfile)
     1282              print*, 'It should be 0 for photolysis reations and 1 or 2 for the others'
     1283              print*, 'And not : ', typerate
     1284              stop
     1285            end if
     1286
     1287          end if
     1288
     1289        end do
     1290
     1291        close(402)
     1292
     1293    end subroutine count_react
     1294
     1295!*****************************************************************
     1296
     1297    subroutine get_react(reactfile,nlines,nreact,rtype,third_body,three_prod, &
     1298                         nrtype,specheck,specheckr,specheckp,typeindice,nbq,  &
     1299                         init_nb_pfunc1,init_nb_pfunc2,init_nb_pfunc3)
     1300
     1301!*****************************************************************
     1302
     1303        use types_asis
     1304        use tracer_h
     1305        use chimiedata_h, only: indexchim
     1306        use callkeys_mod, only: jonline
     1307
     1308        implicit none
     1309        character(*), intent(in)     :: reactfile          ! name of the file to read
     1310        integer,      intent(in)     :: nlines             ! number of lines in the file
     1311        integer,      intent(in)     :: nreact             ! real number of reaction in the file
     1312        integer,      intent(inout)  :: rtype(nreact)      ! reaction rate type
     1313        integer,      intent(inout)  :: third_body(nreact) ! if the reaction have a third body: index of the third body, else zero
     1314        logical,      intent(inout)  :: three_prod(nreact) ! if the reaction have a three defferent proucts egal .true.
     1315        integer,      intent(out)    :: nrtype             ! number of calculation reactions
     1316        integer,      intent(inout)  :: specheck(nesp)     ! to count the species of traceur.def in reactions file
     1317        integer,      intent(inout)  :: specheckr(nesp)    ! to count the reactant species of traceur.def in reactions file
     1318        integer,      intent(inout)  :: specheckp(nesp)    ! to count the product species of traceur.def in reactions file
     1319        character(*), intent(in)     :: typeindice         ! reaction type (v3, v4 or vphot)
     1320        integer,      intent(inout)  :: nbq                ! number of species in reactions file
     1321        integer,      intent(inout)  :: init_nb_pfunc1     ! in : initial value of nb_pfunc1 - out : final value of nb_pfunc1
     1322        integer,      intent(inout)  :: init_nb_pfunc2     ! in : initial value of nb_pfunc2 - out : final value of nb_pfunc2
     1323        integer,      intent(inout)  :: init_nb_pfunc3     ! in : initial value of nb_pfunc3 - out : final value of nb_pfunc3
     1324
     1325        ! local
     1326        character(len = 50)  :: reactline                  ! all reactants of one reaction
     1327        character(len = 50)  :: prodline                   ! all produts of one reaction
     1328        integer              :: nwr                        ! number of reactants for a reaction
     1329        integer              :: nwp                        ! number of products for a reaction
     1330        integer,parameter    :: nmax = 5                   ! number max of reactants or products
     1331        character(len = 24)  :: words(nmax)                ! to get words in reactants and products line
     1332        real                 :: nindice(2*nmax)            ! stoichiometry of species (for indice variables)
     1333        integer              :: iindice(2*nmax)            ! indice of species (for indice variables)
     1334        character(len = 500) :: paramline                  ! line of reactions parameters
     1335        character(len = 50)  :: reactants(nreact,nmax)     ! reactions reactants
     1336        character(len = 50)  :: products(nreact,nmax)      ! reactions products
     1337        logical              :: spedouble                  ! check if a specie appears twice in reactants or products
     1338        integer              :: ierr, ilines, ireact, i_dummy, iw, iwhere, i
     1339        integer              :: nb_hv, nb_pfunc1, nb_pfunc2, nb_pfunc3
     1340
     1341        i_dummy   = 1
     1342        nrtype    = 0
     1343        ireact    = 0
     1344        nb_hv     = 0
     1345        nb_pfunc1 = init_nb_pfunc1
     1346        nb_pfunc2 = init_nb_pfunc2
     1347        nb_pfunc3 = init_nb_pfunc3
     1348
     1349        open(402, form = 'formatted', status = 'old',                &
     1350              file ='chemnetwork/'//trim(reactfile),iostat=ierr)
     1351
     1352        if (ierr /= 0) THEN
     1353           write(*,*)'Error : cannot open chemical reaction file : chemnetwork/'//trim(reactfile)
     1354           write(*,*)'It should be in your simulation directory in chemnetwork directory'
     1355           write(*,*)'   You can change the input chemical reactions file name in'
     1356           write(*,*)'   callphys.def with:'
     1357           write(*,*)'   monoreact=filename or bimolreact=filename or quadrareact=filename'
     1358           write(*,*)'   depending on what chemical reaction type it is'
     1359           stop
     1360        end if
     1361
     1362        do ilines=1,nlines
     1363          paramline = ''
     1364
     1365          read(402,'(A,A,A)') reactline, prodline, paramline
     1366
     1367          ! continue only if it's not a comment line
     1368          if (reactline(1:1)/='!' .and. reactline(1:1)/='') then
     1369
     1370            ! increment number of reactions and init
     1371            ireact = ireact + 1
     1372        !!!!!!!!!!!!!!!!!!!!!!!!!!! for fill indice part
     1373            nrtype = nrtype + 1
     1374            nindice(:) = 0.0
     1375            iindice(:) = i_dummy
     1376        !!!!!!!!!!!!!!!!!!!!!!!!!!! end
     1377            ! get indice, rate type and parameters
     1378            if (trim(paramline)=='') then
     1379              print*, 'Error in reactfile: where are the parameters - line',ilines
     1380              stop
     1381            else
     1382              read(paramline,*) rtype(ireact)
     1383              if (rtype(ireact)==1) then
     1384                nb_pfunc1 = nb_pfunc1 + 1
     1385                read(paramline,*) rtype(ireact), pfunc1_param(nb_pfunc1)
     1386              else if (rtype(ireact)==0) then
     1387                nb_hv = nb_hv + 1
     1388                if (jonline) then
     1389                  read(paramline,'(I5,A,A)') rtype(ireact), jlabel(nb_hv,1), jparamline(nb_hv)
     1390                else
     1391                  read(paramline,*) rtype(ireact), jlabel(nb_hv,1)
     1392                end if
     1393              else if (rtype(ireact)==2) then
     1394                nb_pfunc2 = nb_pfunc2 + 1
     1395                read(paramline,*) rtype(ireact), pfunc2_param(nb_pfunc2)
     1396              else if (rtype(ireact)==3) then
     1397                nb_pfunc3 = nb_pfunc3 + 1
     1398                read(paramline,*) rtype(ireact), pfunc3_param(nb_pfunc3)
     1399              end if
     1400            end if
     1401       
     1402            ! get reactants
     1403            call split_str(reactline,words,nwr,nmax)
     1404            if (rtype(ireact)==0) jlabel(nb_hv,2) = words(1)
     1405            ! loop on reactants
     1406            do iw=1,nwr
     1407              ! store reactants in variable 'reactants'
     1408              reactants(ireact,iw) = trim(words(iw))
     1409              ! check third body and exit reactants loop
     1410              if (reactants(ireact,iw)=='M') then
     1411                if (iw==nwr) then
     1412                  exit
     1413                else if (iw==nwr-1) then
     1414                  third_body(ireact) = indexchim(words(iw+1))
     1415                  exit
     1416                else
     1417                  print*, 'Error in reactfile: just only one specie can be after M corresponding to the third body - line',ilines
     1418                  stop
     1419                end if
     1420              end if
     1421              if (trim(words(iw))/='hv' .and. trim(words(iw))/='dummy') then
     1422                iwhere = indexchim(words(iw))
     1423                ! check if species are chemical tracers
     1424                if (iwhere>nesp) then
     1425                  print*, 'Error: in ', trim(reactfile)
     1426                  print*, 'check if the specie', trim(words(iw)),' is include into chemical tracers in traceur.def'
     1427                  stop
     1428                end if
     1429                ! to count the species used in 'reactfile'
     1430                if (specheck(iwhere)==0) then
     1431                  specheckr(iwhere) = 1
     1432                  specheck(iwhere) = 1
     1433                  nbq = nbq + 1
     1434                else if (specheckr(iwhere)==0) then
     1435                  specheckr(iwhere) = 1
     1436                end if
     1437       
     1438        !!!!!!!!!!!!!!!!!!! for fill indice part
     1439                ! fill stochiometry and indice of rection species depending of reaction type
     1440                if (trim(typeindice)=='v3') then
     1441                  nindice(1) = 2.0
     1442                  iindice(1) = indexchim(words(iw))
     1443                  if (nwr>3 .or. nwr<2) print*, 'Error in reactfile: wrong number of reactants for v3 reaction line',ilines
     1444                  if (nwr==2 .and. trim(words(1))/=trim(words(2))) print*, 'Error in reactfile: both reactants should be the same for v3 reaction line',ilines
     1445                else if (trim(typeindice)=='v4') then
     1446                  nindice(iw) = 1.0
     1447                  iindice(iw) = indexchim(words(iw))
     1448                else if (trim(typeindice)=='vphot') then
     1449                  nindice(1) = 1.0
     1450                  if (iw>2) then
     1451                    print*, 'Something weird in your photolysis reaction'
     1452                    print*, 'You should have 1 reactants and hv'
     1453                    print*, 'Reactants are: ',words
     1454                    stop
     1455                  end if
     1456                  iindice(1) = indexchim(words(iw))
     1457                end if
     1458        !!!!!!!!!!!!!!!!!!! end
     1459       
     1460              end if
     1461            end do
     1462
     1463            ! same as reactants but for the products
     1464            call split_str(prodline,words,nwp,nmax)
     1465            do iw=1,nwp
     1466              spedouble = .false.
     1467              products(ireact,iw) = trim(words(iw))
     1468              if (trim(words(iw))/='hv' .and. trim(words(iw))/='dummy' .and. trim(words(iw))/='M') then
     1469                iwhere = indexchim(words(iw))
     1470                if (iwhere>nesp) then
     1471                  print*, 'Error: in ', trim(reactfile)
     1472                  print*, 'check if the specie', trim(words(iw)),' is include into chemical tracers in traceur.def'
     1473                  stop
     1474                end if
     1475                if (specheck(iwhere)==0) then
     1476                  specheckp(iwhere) = 1
     1477                  specheck(iwhere) = 1
     1478                  nbq = nbq + 1
     1479                else if (specheckp(iwhere)==0) then
     1480                  specheckp(iwhere) = 1
     1481                end if
     1482       
     1483        !!!!!!!!!!!!!!!!!!!!!!!!!! for fill indice part
     1484                if (trim(typeindice)=='v3' .or. trim(typeindice)=='vphot') then
     1485                    iindice(1+iw) = indexchim(words(iw))
     1486                  do i=1,iw-1
     1487                    if (iindice(1+iw)==iindice(1+i)) then
     1488                      nindice(1+i)  = nindice(1+i) + 1.0
     1489                      iindice(1+iw) = i_dummy
     1490                      spedouble = .true.
     1491                    end if
     1492                  end do
     1493                  if (.not. spedouble) nindice(1+iw) = 1.0
     1494                else if (trim(typeindice)=='v4') then
     1495                  iindice(2+iw) = indexchim(words(iw))
     1496                  do i=1,iw-1
     1497                    if (iindice(2+iw)==iindice(2+i)) then
     1498                      nindice(2+i)  = nindice(2+i) + 1.0
     1499                      iindice(2+iw) = i_dummy
     1500                      spedouble = .true.
     1501                    end if
     1502                  end do
     1503                  if (.not. spedouble) nindice(2+iw) = 1.0
     1504                end if
     1505        !!!!!!!!!!!!!!!!!!!!!!!!!!! end
     1506              else
     1507                print*, 'Error: no hv, dummy or M in products'
     1508                stop
     1509              end if
     1510            end do
     1511
     1512            ! fill indice variables
     1513            if (trim(typeindice)=='v3') then
     1514              if (nindice(4)/=0.0) then ! reaction with 3 products
     1515                if (nindice(3)==0.0) then ! 2 are the same species
     1516                  indice_3(nrtype) = z3spec(nindice(1), iindice(1), nindice(2), iindice(2), nindice(4), iindice(4))
     1517                else ! reaction with 3 different products
     1518                  indice_3(nrtype) = z3spec(nindice(1)/2., iindice(1), nindice(2), iindice(2), 0.0, i_dummy)
     1519                  nrtype = nrtype + 1
     1520                  indice_3(nrtype) = z3spec(nindice(1)/2., iindice(1), nindice(3), iindice(3), nindice(4), iindice(4))
     1521                  three_prod(ireact) = .true.
     1522                end if
     1523              else ! reaction with 1 or 2 products
     1524                indice_3(nrtype) = z3spec(nindice(1), iindice(1), nindice(2), iindice(2), nindice(3), iindice(3))
     1525              end if
     1526            else if (trim(typeindice)=='v4') then
     1527              if (nindice(5)/=0.0) then ! reaction with 3 products
     1528                if (nindice(4)==0.0) then ! 2 are the same species
     1529                  indice_4(nrtype) = z4spec(nindice(1), iindice(1), nindice(2), iindice(2), nindice(3), iindice(3), nindice(5), iindice(5))
     1530                else ! reaction with 3 different products
     1531                  indice_4(nrtype) = z4spec(nindice(1)/2., iindice(1), nindice(2)/2., iindice(2), nindice(3), iindice(3), nindice(4)/2., iindice(4))
     1532                  nrtype = nrtype + 1
     1533                  indice_4(nrtype) = z4spec(nindice(1)/2., iindice(1), nindice(2)/2., iindice(2), nindice(5), iindice(5), nindice(4)/2., iindice(4))
     1534                  three_prod(ireact) = .true.
     1535                end if
     1536              else ! reaction with 1 or 2 products
     1537                indice_4(nrtype) = z4spec(nindice(1), iindice(1), nindice(2), iindice(2), nindice(3), iindice(3), nindice(4), iindice(4))
     1538              end if
     1539            else if (trim(typeindice)=='vphot') then
     1540              if (nindice(4)/=0.0) then ! reaction with 3 products
     1541                if (nindice(3)==0.0) then ! 2 are the same species
     1542                  indice_phot(nrtype) = z3spec(nindice(1), iindice(1), nindice(2), iindice(2), nindice(4), iindice(4))
     1543                else ! reaction with 3 different products
     1544                  indice_phot(nrtype) = z3spec(nindice(1)/2., iindice(1), nindice(2), iindice(2), 0.0, i_dummy)
     1545                  nrtype = nrtype + 1
     1546                  indice_phot(nrtype) = z3spec(nindice(1)/2., iindice(1), nindice(3), iindice(3), nindice(4), iindice(4))
     1547                  three_prod(ireact) = .true.
     1548                end if
     1549              else ! reaction with 1 or 2 products
     1550                indice_phot(nrtype) = z3spec(nindice(1), iindice(1), nindice(2), iindice(2), nindice(3), iindice(3))
     1551              end if
     1552            end if
     1553       
     1554          end if
     1555
     1556        end do
     1557
     1558        init_nb_pfunc1 = nb_pfunc1
     1559        init_nb_pfunc2 = nb_pfunc2
     1560        init_nb_pfunc3 = nb_pfunc3
     1561
     1562        close(402)
     1563
     1564    end subroutine get_react
     1565
    18661566end subroutine photochemistry_asis
    1867 
  • trunk/LMDZ.GENERIC/libf/aeronostd/photolysis_asis.F90

    r1796 r2542  
    11!==========================================================================
    22
    3       subroutine photolysis_asis(nlayer, ngrid,                                 &
    4                                  lswitch, press, temp, sza, fractcol, tauref,   &
    5                                  zmmean, dist_sol, rmco2, rmo3, v_phot)
     3      subroutine photolysis_asis(nlayer, ngrid,                    &
     4                                 lswitch, press, temp, sza,fractcol, tauref,   &
     5                                 zmmean, dist_sol, rmco2, rmo3, rmch4, v_phot, e_phot, nreact, three_prod)
    66
    77!==========================================================================
     
    99      use comcstfi_mod
    1010      use callkeys_mod
     11      use types_asis
     12      use chimiedata_h
    1113
    1214      implicit none
    1315
    14 #include "chimiedata.h"
     16!#include "chimiedata.h"
    1517
    1618!==========================================================================
     
    1921       
    2022      integer, intent(in) :: nlayer ! number of atmospheric layers
    21       integer,intent(in) :: ngrid   ! number of atmospheric columns
     23      integer, intent(in) :: ngrid  ! number of atmospheric columns
    2224      integer :: lswitch            ! interface level between chemistries
    2325      real :: press(nlayer)         ! pressure (hPa)
     
    2628      real :: fractcol              ! day fraction
    2729      real :: tauref                ! optical depth at 7 hpa
    28       real :: zmmean(nlayer)        ! mean molecular mass (g)
     30      real :: zmmean(nlayer)        ! mean molecular mass (g/mol)
    2931      real :: dist_sol              ! sun distance (AU)
    3032      real :: rmco2(nlayer)         ! co2 mixing ratio
    3133      real :: rmo3(nlayer)          ! ozone mixing ratio
     34      real :: rmch4(nlayer)         ! ch4 mixing ratio
     35      integer, intent(in) :: nreact             ! number of reactions in reactions files
     36      logical, intent(in) :: three_prod(nreact) ! if the reaction have a three defferent products egal .true.
    3237
    3338!==========================================================================
     
    3641
    3742      real (kind = 8), dimension(nlayer,nb_phot_max) :: v_phot
     43      real (kind = 8), dimension(nlayer,nb_phot_max) :: e_phot
    3844
    3945!==========================================================================
     
    4248
    4349      integer :: icol, ij, indsza, indtau, indcol, indozo, indtemp,     &
    44                  iozo, isza, itau, it, l
    45 
    46       integer :: j_o2_o, j_o2_o1d, j_co2_o, j_co2_o1d, j_o3_o1d,        &
    47                  j_o3_o, j_h2o, j_hdo, j_h2o2, j_ho2, j_no, j_no2,      &
    48                  j_hno3, j_hno4,                                        &
    49                  j_ch4_ch3_h, j_ch4_1ch2_h2, j_ch4_3ch2_h_h,            &
    50                  j_ch4_ch_h2_h, j_ch3o2h, j_ch2o_hco, j_ch2o_co,        &
    51                  j_ch3oh, j_c2h6, j_hcl, j_hocl, j_clo, j_so2, j_so,    &
    52                  j_h2s, j_so3
     50                 iozo, isza, itau, it, ich4, indch4, l, nb_phot
    5351
    5452      real :: col(nlayer)                 ! overhead air column   (molecule cm-2)
    5553      real :: colo3(nlayer)               ! overhead ozone column (molecule cm-2)
    56       real :: poids(2,2,2,2,2)            ! 5D interpolation weights
     54      real :: colch4(nlayer)               ! overhead CH4 column (molecule cm-2)
     55      real :: tauch4(nlayer)               ! estimation of optical depth by CH4
     56      real :: ch4_equ(nlayer)               ! equivalent constant mixing ratio for the same column of CH4
     57      real :: poids(2,2,2,2,2,2)          ! 6D interpolation weights
    5758      real :: tref                        ! temperature  at 1.9 hPa in the gcm (K)
    5859      real :: table_temp(ntemp)           ! temperatures at 1.9 hPa in jmars   (K)
    59       real :: cinf, csup, cicol, ciozo, cisza, citemp, citau
     60      real :: ch4ref                      ! ch4 mixing ratio at top of the atmosphere
     61      real :: cinf, csup, cicol, ciozo, cisza, citemp, citau, cich4
    6062      real :: colo3min, dp, coef
    6163      real :: ratio_o3(nlayer)
    6264      real :: tau
    6365      real :: j(nlayer,nd)
     66      real :: e(nlayer,nd)
    6467
    6568!==========================================================================
     
    7376!==========================================================================
    7477     
    75       table_temp(1) = 226.2
    76       table_temp(2) = 206.2
    77       table_temp(3) = 186.2
    78       table_temp(4) = 169.8
     78!      table_temp(1) = 226.2
     79!      table_temp(2) = 206.2
     80!      table_temp(3) = 186.2
     81!      table_temp(4) = 169.8
     82
     83!      table_temp(2) = 186.2
     84      table_temp(1) = 176.2
    7985
    8086!==========================================================================
     
    9096         end if
    9197      end do
    92       cisza = (sza - szatab(indsza))  &
     98
     99      if(nsza.eq.1) then
     100        cisza = 0.
     101        indsza=1
     102      else
     103        cisza = (sza - szatab(indsza))  &
    93104             /(szatab(indsza + 1) - szatab(indsza))
     105      endif
    94106
    95107!==========================================================================
     
    108120         end if
    109121      end do
    110       citau = (tau - tautab(indtau))     &
     122
     123      if(ntau.eq.1) then
     124        citau=0.
     125        indtau=1
     126      else
     127        citau = (tau - tautab(indtau))     &
    111128             /(tautab(indtau + 1) - tautab(indtau))
    112 
    113 !==========================================================================
    114 !     co2 and ozone columns
     129      endif
     130
     131
     132
     133!==========================================================================
     134!     air and ozone columns
    115135!==========================================================================
    116136
    117137!     co2 column at model top (molecule.cm-2)
    118138
    119       col(lswitch-1) = 6.022e22*rmco2(lswitch-1)*press(lswitch-1)*100.  &
    120                        /(zmmean(lswitch-1)*g)
     139!      col(lswitch-1) = 6.022e22*rmco2(lswitch-1)*press(lswitch-1)*100.  &
     140!                       /(zmmean(lswitch-1)*g)
     141      col(lswitch-1) = 6.022e22*press(lswitch-1)*100./(zmmean(lswitch-1)*g)
     142
    121143
    122144!     ozone column at model top
    123145
    124146      colo3(lswitch-1) = 0.
    125 
    126147!     co2 and ozone columns for other levels (molecule.cm-2)
    127148
    128149      do l = lswitch-2,1,-1
    129150         dp = (press(l) - press(l+1))*100.
    130          col(l) = col(l+1) + (rmco2(l+1) + rmco2(l))*0.5   &
    131                              *6.022e22*dp/(zmmean(l)*g)
     151!         col(l) = col(l+1) + (rmco2(l+1) + rmco2(l))*0.5   &
     152!                             *6.022e22*dp/(zmmean(l)*g)
     153         col(l) = col(l+1) +  6.022e22*dp/(zmmean(l)*g)
    132154         col(l) = min(col(l), colairtab(1))
    133155         colo3(l) = colo3(l+1) + (rmo3(l+1) + rmo3(l))*0.5 &
    134156                                 *6.022e22*dp/(zmmean(l)*g)
    135       end do
    136 
    137 !     ratio ozone column/minimal theoretical column (0.1 micron-atm)
    138 
    139 !     ro3 = 7.171e-10 is the o3 mixing ratio for a uniform
    140 !     profile giving a column 0.1 micron-atmosphere at
    141 !     a surface pressure of 10 hpa.
     157
     158      end do
     159
     160!     ratio ozone column/minimal theoretical column (10 micron-atm)
     161
     162!     ro3 = 1.227e-10 is the o3 mixing ratio for a uniform
     163!     profile giving a column 10 micron-atmosphere at
     164!     a surface pressure of 1 bar.
    142165
    143166      do l = 1,lswitch-1
    144          colo3min    = col(l)*7.171e-10
     167!         colo3min    = col(l)*7.171e-10
     168         colo3min    = col(l)*1.227e-10*(g/9.81)*(mugaz/28)
    145169         ratio_o3(l) = colo3(l)/colo3min
    146          ratio_o3(l) = min(ratio_o3(l), table_ozo(nozo)*10.)
    147          ratio_o3(l) = max(ratio_o3(l), 1.)
    148       end do
     170         ratio_o3(l) = min(ratio_o3(l), table_ozo(nozo))
     171         ratio_o3(l) = max(ratio_o3(l), 0.)
     172      end do
     173
     174!      print*,'co3(1)=',colo3(1)
     175!      print*,'col(1)=',col(1)
     176!      print*,'ratio_o3(1)=',ratio_o3(1)
     177!      print*,'maxval(ratio_o3)=',maxval(ratio_o3(:))
     178!      print*,'maxval(ozo)=',table_ozo(nozo)/10.
     179
     180!==========================================================================
     181!     ch4 dependence
     182!==========================================================================
     183
     184!     1) search for temperature at 1.9 hPa (tref): vertical
     185!     interpolation
     186
     187      ch4ref = rmch4(lswitch-2)
     188      colch4(lswitch-1) = 0.
     189      ch4_equ(lswitch-1) = 0.
     190      do l = lswitch-2,1,-1
     191         dp = (press(l) - press(l+1))*100.
     192         colch4(l) = colch4(l+1) + (rmch4(l+1) + rmch4(l))*0.5 &
     193                                 *6.022e22*dp/(zmmean(l)*g)
     194         ch4_equ(l)=colch4(l)/col(l)
     195!         tauch4(l)=1.8e-21*colch4(l)
     196!         if(tauch4(l).ge.1.0) exit
     197      end do
     198!      ch4ref = (rmch4(l+1)*(tauch4(l)-1)+rmch4(l)*(1-tauch4(l+1))) &
     199!                                 /(tauch4(l)-tauch4(l+1))
     200
     201!     2) interpolation in CH4
     202
     203!      ch4ref = min(ch4ref,table_ch4(nch4))
     204!      ch4ref = max(ch4ref,table_ch4(1))
     205
     206!      indch4 = nch4 - 1
     207!      do ich4 = 1,nch4
     208!         if (table_ch4(ich4) >= ch4ref) then
     209!            indch4 = ich4 - 1
     210!            indch4 = max(indch4, 1)
     211!            exit
     212!         end if
     213!      end do
     214!      cich4 = (ch4ref - table_ch4(indch4))     &
     215!             /(table_ch4(indch4 + 1) - table_ch4(indch4))
     216
     217
    149218
    150219!==========================================================================
     
    169238      tref = max(tref,table_temp(ntemp))
    170239
    171       do it = 2, ntemp
    172          if (table_temp(it) <= tref) then
    173             citemp = (log(tref) - log(table_temp(it)))              &
    174                     /(log(table_temp(it-1)) - log(table_temp(it)))
    175             indtemp = it - 1
    176             exit
    177          end if
    178       end do
     240      if(ntemp.eq.1) then
     241        citemp = 1.
     242        indtemp = 1
     243      else
     244        do it = 2, ntemp
     245           if (table_temp(it) <= tref) then
     246              citemp = (log(tref) - log(table_temp(it)))              &
     247                      /(log(table_temp(it-1)) - log(table_temp(it)))
     248              indtemp = it - 1
     249              exit
     250           end if
     251        end do
     252      endif
     253
     254
    179255
    180256!==========================================================================
     
    200276         indozo = nozo - 1
    201277         do iozo = 1,nozo
    202             if (table_ozo(iozo)*10. >= ratio_o3(l)) then
     278            if (table_ozo(iozo) >= ratio_o3(l)) then
    203279               indozo = iozo - 1
    204280               indozo = max(indozo, 1)
     
    206282            end if
    207283         end do
    208          ciozo = (ratio_o3(l) - table_ozo(indozo)*10.)             &
    209                 /(table_ozo(indozo + 1)*10. - table_ozo(indozo)*10.)
    210 
    211 !     4-dimensional interpolation weights
    212 
    213 !     poids(temp,sza,co2,o3,tau)
    214 
    215          poids(1,1,1,1,1) = citemp*(1.-cisza)*cicol*(1.-ciozo)*(1.-citau)
    216          poids(1,1,1,2,1) = citemp*(1.-cisza)*cicol*ciozo*(1.-citau)
    217          poids(1,1,2,1,1) = citemp*(1.-cisza)*(1.-cicol)*(1.-ciozo)*(1.-citau)
    218          poids(1,1,2,2,1) = citemp*(1.-cisza)*(1.-cicol)*ciozo*(1.-citau)
    219          poids(1,2,1,1,1) = citemp*cisza*cicol*(1.-ciozo)*(1.-citau)
    220          poids(1,2,1,2,1) = citemp*cisza*cicol*ciozo*(1.-citau)
    221          poids(1,2,2,1,1) = citemp*cisza*(1.-cicol)*(1.-ciozo)*(1.-citau)
    222          poids(1,2,2,2,1) = citemp*cisza*(1.-cicol)*ciozo*(1.-citau)
    223          poids(2,1,1,1,1) = (1.-citemp)*(1.-cisza)*cicol*(1.-ciozo)*(1.-citau)
    224          poids(2,1,1,2,1) = (1.-citemp)*(1.-cisza)*cicol*ciozo*(1.-citau)
    225          poids(2,1,2,1,1) = (1.-citemp)*(1.-cisza)*(1.-cicol)*(1.-ciozo)*(1.-citau)
    226          poids(2,1,2,2,1) = (1.-citemp)*(1.-cisza)*(1.-cicol)*ciozo*(1.-citau)
    227          poids(2,2,1,1,1) = (1.-citemp)*cisza*cicol*(1.-ciozo)*(1.-citau)
    228          poids(2,2,1,2,1) = (1.-citemp)*cisza*cicol*ciozo*(1.-citau)
    229          poids(2,2,2,1,1) = (1.-citemp)*cisza*(1.-cicol)*(1.-ciozo)*(1.-citau)
    230          poids(2,2,2,2,1) = (1.-citemp)*cisza*(1.-cicol)*ciozo*(1.-citau)
    231 !
    232          poids(1,1,1,1,2) = citemp*(1.-cisza)*cicol*(1.-ciozo)*citau
    233          poids(1,1,1,2,2) = citemp*(1.-cisza)*cicol*ciozo*citau
    234          poids(1,1,2,1,2) = citemp*(1.-cisza)*(1.-cicol)*(1.-ciozo)*citau
    235          poids(1,1,2,2,2) = citemp*(1.-cisza)*(1.-cicol)*ciozo*citau
    236          poids(1,2,1,1,2) = citemp*cisza*cicol*(1.-ciozo)*citau
    237          poids(1,2,1,2,2) = citemp*cisza*cicol*ciozo*citau
    238          poids(1,2,2,1,2) = citemp*cisza*(1.-cicol)*(1.-ciozo)*citau
    239          poids(1,2,2,2,2) = citemp*cisza*(1.-cicol)*ciozo*citau
    240          poids(2,1,1,1,2) = (1.-citemp)*(1.-cisza)*cicol*(1.-ciozo)*citau
    241          poids(2,1,1,2,2) = (1.-citemp)*(1.-cisza)*cicol*ciozo*citau
    242          poids(2,1,2,1,2) = (1.-citemp)*(1.-cisza)*(1.-cicol)*(1.-ciozo)*citau
    243          poids(2,1,2,2,2) = (1.-citemp)*(1.-cisza)*(1.-cicol)*ciozo*citau
    244          poids(2,2,1,1,2) = (1.-citemp)*cisza*cicol*(1.-ciozo)*citau
    245          poids(2,2,1,2,2) = (1.-citemp)*cisza*cicol*ciozo*citau
    246          poids(2,2,2,1,2) = (1.-citemp)*cisza*(1.-cicol)*(1.-ciozo)*citau
    247          poids(2,2,2,2,2) = (1.-citemp)*cisza*(1.-cicol)*ciozo*citau
     284
     285      if(nozo.eq.1) then
     286         ciozo = 0.
     287      else
     288         ciozo = (ratio_o3(l) - table_ozo(indozo))             &
     289                /(table_ozo(indozo + 1) - table_ozo(indozo))
     290      endif
     291
     292!     2) interpolation in CH4
     293
     294      ch4ref = min(ch4_equ(l),table_ch4(nch4))
     295      ch4ref = max(ch4ref,table_ch4(1))
     296
     297      indch4 = nch4 - 1
     298      do ich4 = 1,nch4
     299         if (table_ch4(ich4) >= ch4ref) then
     300            indch4 = ich4 - 1
     301            indch4 = max(indch4, 1)
     302            exit
     303         end if
     304      end do
     305      if(nch4.eq.1) then
     306        cich4=0.
     307        indch4=1
     308      else
     309        cich4 = (ch4ref - table_ch4(indch4))     &
     310               /(table_ch4(indch4 + 1) - table_ch4(indch4))
     311      endif
     312
     313!     5-dimensional interpolation weights
     314
     315!     poids(temp,sza,co2,o3,tau,ch4)
     316
     317         poids(1,1,1,1,1,1) = citemp*(1.-cisza)*cicol*(1.-ciozo)*(1.-citau)*(1.-cich4)
     318         poids(1,1,1,2,1,1) = citemp*(1.-cisza)*cicol*ciozo*(1.-citau)*(1.-cich4)       
     319         poids(1,1,2,1,1,1) = citemp*(1.-cisza)*(1.-cicol)*(1.-ciozo)*(1.-citau)*(1.-cich4)
     320         poids(1,1,2,2,1,1) = citemp*(1.-cisza)*(1.-cicol)*ciozo*(1.-citau)*(1.-cich4)
     321         poids(1,2,1,1,1,1) = citemp*cisza*cicol*(1.-ciozo)*(1.-citau)*(1.-cich4)               
     322         poids(1,2,1,2,1,1) = citemp*cisza*cicol*ciozo*(1.-citau)*(1.-cich4)                   
     323         poids(1,2,2,1,1,1) = citemp*cisza*(1.-cicol)*(1.-ciozo)*(1.-citau)*(1.-cich4)         
     324         poids(1,2,2,2,1,1) = citemp*cisza*(1.-cicol)*ciozo*(1.-citau)*(1.-cich4)               
     325!         poids(2,1,1,1,1,1) = (1.-citemp)*(1.-cisza)*cicol*(1.-ciozo)*(1.-citau)*(1.-cich4)     
     326!         poids(2,1,1,2,1,1) = (1.-citemp)*(1.-cisza)*cicol*ciozo*(1.-citau)*(1.-cich4)         
     327!         poids(2,1,2,1,1,1) = (1.-citemp)*(1.-cisza)*(1.-cicol)*(1.-ciozo)*(1.-citau)*(1.-cich4)
     328!         poids(2,1,2,2,1,1) = (1.-citemp)*(1.-cisza)*(1.-cicol)*ciozo*(1.-citau)*(1.-cich4)     
     329!         poids(2,2,1,1,1,1) = (1.-citemp)*cisza*cicol*(1.-ciozo)*(1.-citau)*(1.-cich4)         
     330!         poids(2,2,1,2,1,1) = (1.-citemp)*cisza*cicol*ciozo*(1.-citau)*(1.-cich4)               
     331!         poids(2,2,2,1,1,1) = (1.-citemp)*cisza*(1.-cicol)*(1.-ciozo)*(1.-citau)*(1.-cich4)     
     332!         poids(2,2,2,2,1,1) = (1.-citemp)*cisza*(1.-cicol)*ciozo*(1.-citau)*(1.-cich4)         
     333!!
     334!         poids(1,1,1,1,2,1) = citemp*(1.-cisza)*cicol*(1.-ciozo)*citau*(1.-cich4)               
     335!         poids(1,1,1,2,2,1) = citemp*(1.-cisza)*cicol*ciozo*citau*(1.-cich4)                   
     336!         poids(1,1,2,1,2,1) = citemp*(1.-cisza)*(1.-cicol)*(1.-ciozo)*citau*(1.-cich4)         
     337!         poids(1,1,2,2,2,1) = citemp*(1.-cisza)*(1.-cicol)*ciozo*citau*(1.-cich4)               
     338!         poids(1,2,1,1,2,1) = citemp*cisza*cicol*(1.-ciozo)*citau*(1.-cich4)                   
     339!         poids(1,2,1,2,2,1) = citemp*cisza*cicol*ciozo*citau*(1.-cich4)                         
     340!         poids(1,2,2,1,2,1) = citemp*cisza*(1.-cicol)*(1.-ciozo)*citau*(1.-cich4)               
     341!         poids(1,2,2,2,2,1) = citemp*cisza*(1.-cicol)*ciozo*citau*(1.-cich4)                   
     342!         poids(2,1,1,1,2,1) = (1.-citemp)*(1.-cisza)*cicol*(1.-ciozo)*citau*(1.-cich4)         
     343!         poids(2,1,1,2,2,1) = (1.-citemp)*(1.-cisza)*cicol*ciozo*citau*(1.-cich4)               
     344!         poids(2,1,2,1,2,1) = (1.-citemp)*(1.-cisza)*(1.-cicol)*(1.-ciozo)*citau*(1.-cich4)     
     345!         poids(2,1,2,2,2,1) = (1.-citemp)*(1.-cisza)*(1.-cicol)*ciozo*citau*(1.-cich4)         
     346!         poids(2,2,1,1,2,1) = (1.-citemp)*cisza*cicol*(1.-ciozo)*citau*(1.-cich4)               
     347!         poids(2,2,1,2,2,1) = (1.-citemp)*cisza*cicol*ciozo*citau*(1.-cich4)                   
     348!         poids(2,2,2,1,2,1) = (1.-citemp)*cisza*(1.-cicol)*(1.-ciozo)*citau*(1.-cich4)         
     349!         poids(2,2,2,2,2,1) = (1.-citemp)*cisza*(1.-cicol)*ciozo*citau*(1.-cich4)               
     350!     
     351         poids(1,1,1,1,1,2) = citemp*(1.-cisza)*cicol*(1.-ciozo)*(1.-citau)*cich4               
     352         poids(1,1,1,2,1,2) = citemp*(1.-cisza)*cicol*ciozo*(1.-citau)*cich4                   
     353         poids(1,1,2,1,1,2) = citemp*(1.-cisza)*(1.-cicol)*(1.-ciozo)*(1.-citau)*cich4         
     354         poids(1,1,2,2,1,2) = citemp*(1.-cisza)*(1.-cicol)*ciozo*(1.-citau)*cich4               
     355         poids(1,2,1,1,1,2) = citemp*cisza*cicol*(1.-ciozo)*(1.-citau)*cich4                   
     356         poids(1,2,1,2,1,2) = citemp*cisza*cicol*ciozo*(1.-citau)*cich4                         
     357         poids(1,2,2,1,1,2) = citemp*cisza*(1.-cicol)*(1.-ciozo)*(1.-citau)*cich4               
     358         poids(1,2,2,2,1,2) = citemp*cisza*(1.-cicol)*ciozo*(1.-citau)*cich4                   
     359!         poids(2,1,1,1,1,2) = (1.-citemp)*(1.-cisza)*cicol*(1.-ciozo)*(1.-citau)*cich4         
     360!         poids(2,1,1,2,1,2) = (1.-citemp)*(1.-cisza)*cicol*ciozo*(1.-citau)*cich4               
     361!         poids(2,1,2,1,1,2) = (1.-citemp)*(1.-cisza)*(1.-cicol)*(1.-ciozo)*(1.-citau)*cich4     
     362!         poids(2,1,2,2,1,2) = (1.-citemp)*(1.-cisza)*(1.-cicol)*ciozo*(1.-citau)*cich4         
     363!         poids(2,2,1,1,1,2) = (1.-citemp)*cisza*cicol*(1.-ciozo)*(1.-citau)*cich4               
     364!         poids(2,2,1,2,1,2) = (1.-citemp)*cisza*cicol*ciozo*(1.-citau)*cich4                   
     365!         poids(2,2,2,1,1,2) = (1.-citemp)*cisza*(1.-cicol)*(1.-ciozo)*(1.-citau)*cich4         
     366!         poids(2,2,2,2,1,2) = (1.-citemp)*cisza*(1.-cicol)*ciozo*(1.-citau)*cich4               
     367!!
     368!         poids(1,1,1,1,2,2) = citemp*(1.-cisza)*cicol*(1.-ciozo)*citau*cich4                   
     369!         poids(1,1,1,2,2,2) = citemp*(1.-cisza)*cicol*ciozo*citau*cich4                         
     370!         poids(1,1,2,1,2,2) = citemp*(1.-cisza)*(1.-cicol)*(1.-ciozo)*citau*cich4               
     371!         poids(1,1,2,2,2,2) = citemp*(1.-cisza)*(1.-cicol)*ciozo*citau*cich4                   
     372!         poids(1,2,1,1,2,2) = citemp*cisza*cicol*(1.-ciozo)*citau*cich4                         
     373!         poids(1,2,1,2,2,2) = citemp*cisza*cicol*ciozo*citau*cich4                             
     374!         poids(1,2,2,1,2,2) = citemp*cisza*(1.-cicol)*(1.-ciozo)*citau*cich4                   
     375!         poids(1,2,2,2,2,2) = citemp*cisza*(1.-cicol)*ciozo*citau*cich4                         
     376!         poids(2,1,1,1,2,2) = (1.-citemp)*(1.-cisza)*cicol*(1.-ciozo)*citau*cich4               
     377!         poids(2,1,1,2,2,2) = (1.-citemp)*(1.-cisza)*cicol*ciozo*citau*cich4                   
     378!         poids(2,1,2,1,2,2) = (1.-citemp)*(1.-cisza)*(1.-cicol)*(1.-ciozo)*citau*cich4         
     379!         poids(2,1,2,2,2,2) = (1.-citemp)*(1.-cisza)*(1.-cicol)*ciozo*citau*cich4               
     380!         poids(2,2,1,1,2,2) = (1.-citemp)*cisza*cicol*(1.-ciozo)*citau*cich4                   
     381!         poids(2,2,1,2,2,2) = (1.-citemp)*cisza*cicol*ciozo*citau*cich4                         
     382!         poids(2,2,2,1,2,2) = (1.-citemp)*cisza*(1.-cicol)*(1.-ciozo)*citau*cich4               
     383!         poids(2,2,2,2,2,2) = (1.-citemp)*cisza*(1.-cicol)*ciozo*citau*cich4                   
     384
     385
     386
     387
     388
     389
     390
    248391
    249392!     4-dimensional interpolation in the lookup table
    250393
    251394         do ij = 1,nd
    252             j(l,ij) =                                                                &
    253             poids(1,1,1,1,1)*jphot(indtemp,indsza,indcol,indozo,indtau,ij)           &
    254           + poids(1,1,1,2,1)*jphot(indtemp,indsza,indcol,indozo+1,indtau,ij)         &
    255           + poids(1,1,2,1,1)*jphot(indtemp,indsza,indcol+1,indozo,indtau,ij)         &
    256           + poids(1,1,2,2,1)*jphot(indtemp,indsza,indcol+1,indozo+1,indtau,ij)       &
    257           + poids(1,2,1,1,1)*jphot(indtemp,indsza+1,indcol,indozo,indtau,ij)         &
    258           + poids(1,2,1,2,1)*jphot(indtemp,indsza+1,indcol,indozo+1,indtau,ij)       &
    259           + poids(1,2,2,1,1)*jphot(indtemp,indsza+1,indcol+1,indozo,indtau,ij)       &
    260           + poids(1,2,2,2,1)*jphot(indtemp,indsza+1,indcol+1,indozo+1,indtau,ij)     &
    261           + poids(2,1,1,1,1)*jphot(indtemp+1,indsza,indcol,indozo,indtau,ij)         &
    262           + poids(2,1,1,2,1)*jphot(indtemp+1,indsza,indcol,indozo+1,indtau,ij)       &
    263           + poids(2,1,2,1,1)*jphot(indtemp+1,indsza,indcol+1,indozo,indtau,ij)       &
    264           + poids(2,1,2,2,1)*jphot(indtemp+1,indsza,indcol+1,indozo+1,indtau,ij)     &
    265           + poids(2,2,1,1,1)*jphot(indtemp+1,indsza+1,indcol,indozo,indtau,ij)       &
    266           + poids(2,2,1,2,1)*jphot(indtemp+1,indsza+1,indcol,indozo+1,indtau,ij)     &
    267           + poids(2,2,2,1,1)*jphot(indtemp+1,indsza+1,indcol+1,indozo,indtau,ij)     &
    268           + poids(2,2,2,2,1)*jphot(indtemp+1,indsza+1,indcol+1,indozo+1,indtau,ij)   &
    269 !
    270           + poids(1,1,1,1,2)*jphot(indtemp,indsza,indcol,indozo,indtau+1,ij)         &
    271           + poids(1,1,1,2,2)*jphot(indtemp,indsza,indcol,indozo+1,indtau+1,ij)       &
    272           + poids(1,1,2,1,2)*jphot(indtemp,indsza,indcol+1,indozo,indtau+1,ij)       &
    273           + poids(1,1,2,2,2)*jphot(indtemp,indsza,indcol+1,indozo+1,indtau+1,ij)     &
    274           + poids(1,2,1,1,2)*jphot(indtemp,indsza+1,indcol,indozo,indtau+1,ij)       &
    275           + poids(1,2,1,2,2)*jphot(indtemp,indsza+1,indcol,indozo+1,indtau+1,ij)     &
    276           + poids(1,2,2,1,2)*jphot(indtemp,indsza+1,indcol+1,indozo,indtau+1,ij)     &
    277           + poids(1,2,2,2,2)*jphot(indtemp,indsza+1,indcol+1,indozo+1,indtau+1,ij)   &
    278           + poids(2,1,1,1,2)*jphot(indtemp+1,indsza,indcol,indozo,indtau+1,ij)       &
    279           + poids(2,1,1,2,2)*jphot(indtemp+1,indsza,indcol,indozo+1,indtau+1,ij)     &
    280           + poids(2,1,2,1,2)*jphot(indtemp+1,indsza,indcol+1,indozo,indtau+1,ij)     &
    281           + poids(2,1,2,2,2)*jphot(indtemp+1,indsza,indcol+1,indozo+1,indtau+1,ij)   &
    282           + poids(2,2,1,1,2)*jphot(indtemp+1,indsza+1,indcol,indozo,indtau+1,ij)     &
    283           + poids(2,2,1,2,2)*jphot(indtemp+1,indsza+1,indcol,indozo+1,indtau+1,ij)   &
    284           + poids(2,2,2,1,2)*jphot(indtemp+1,indsza+1,indcol+1,indozo,indtau+1,ij)   &
    285           + poids(2,2,2,2,2)*jphot(indtemp+1,indsza+1,indcol+1,indozo+1,indtau+1,ij)
     395            j(l,ij) =                                                                         &
     396            poids(1,1,1,1,1,1)*jphot(indtemp,indsza,indcol,indozo,indtau,indch4,ij)           &
     397          + poids(1,1,1,2,1,1)*jphot(indtemp,indsza,indcol,indozo+1,indtau,indch4,ij)         &
     398          + poids(1,1,2,1,1,1)*jphot(indtemp,indsza,indcol+1,indozo,indtau,indch4,ij)         &
     399          + poids(1,1,2,2,1,1)*jphot(indtemp,indsza,indcol+1,indozo+1,indtau,indch4,ij)       &
     400          + poids(1,2,1,1,1,1)*jphot(indtemp,indsza+1,indcol,indozo,indtau,indch4,ij)         &
     401          + poids(1,2,1,2,1,1)*jphot(indtemp,indsza+1,indcol,indozo+1,indtau,indch4,ij)       &
     402          + poids(1,2,2,1,1,1)*jphot(indtemp,indsza+1,indcol+1,indozo,indtau,indch4,ij)       &
     403          + poids(1,2,2,2,1,1)*jphot(indtemp,indsza+1,indcol+1,indozo+1,indtau,indch4,ij)     &
     404!          + poids(2,1,1,1,1,1)*jphot(indtemp+1,indsza,indcol,indozo,indtau,indch4,ij)         &
     405!          + poids(2,1,1,2,1,1)*jphot(indtemp+1,indsza,indcol,indozo+1,indtau,indch4,ij)       &
     406!          + poids(2,1,2,1,1,1)*jphot(indtemp+1,indsza,indcol+1,indozo,indtau,indch4,ij)       &
     407!          + poids(2,1,2,2,1,1)*jphot(indtemp+1,indsza,indcol+1,indozo+1,indtau,indch4,ij)     &
     408!          + poids(2,2,1,1,1,1)*jphot(indtemp+1,indsza+1,indcol,indozo,indtau,indch4,ij)       &
     409!          + poids(2,2,1,2,1,1)*jphot(indtemp+1,indsza+1,indcol,indozo+1,indtau,indch4,ij)     &
     410!          + poids(2,2,2,1,1,1)*jphot(indtemp+1,indsza+1,indcol+1,indozo,indtau,indch4,ij)     &
     411!          + poids(2,2,2,2,1,1)*jphot(indtemp+1,indsza+1,indcol+1,indozo+1,indtau,indch4,ij)   &
     412!!
     413!          + poids(1,1,1,1,2,1)*jphot(indtemp,indsza,indcol,indozo,indtau+1,indch4,ij)         &
     414!          + poids(1,1,1,2,2,1)*jphot(indtemp,indsza,indcol,indozo+1,indtau+1,indch4,ij)       &
     415!          + poids(1,1,2,1,2,1)*jphot(indtemp,indsza,indcol+1,indozo,indtau+1,indch4,ij)       &
     416!          + poids(1,1,2,2,2,1)*jphot(indtemp,indsza,indcol+1,indozo+1,indtau+1,indch4,ij)     &
     417!          + poids(1,2,1,1,2,1)*jphot(indtemp,indsza+1,indcol,indozo,indtau+1,indch4,ij)       &
     418!          + poids(1,2,1,2,2,1)*jphot(indtemp,indsza+1,indcol,indozo+1,indtau+1,indch4,ij)     &
     419!          + poids(1,2,2,1,2,1)*jphot(indtemp,indsza+1,indcol+1,indozo,indtau+1,indch4,ij)     &
     420!          + poids(1,2,2,2,2,1)*jphot(indtemp,indsza+1,indcol+1,indozo+1,indtau+1,indch4,ij)   &
     421!          + poids(2,1,1,1,2,1)*jphot(indtemp+1,indsza,indcol,indozo,indtau+1,indch4,ij)       &
     422!          + poids(2,1,1,2,2,1)*jphot(indtemp+1,indsza,indcol,indozo+1,indtau+1,indch4,ij)     &
     423!          + poids(2,1,2,1,2,1)*jphot(indtemp+1,indsza,indcol+1,indozo,indtau+1,indch4,ij)     &
     424!          + poids(2,1,2,2,2,1)*jphot(indtemp+1,indsza,indcol+1,indozo+1,indtau+1,indch4,ij)   &
     425!          + poids(2,2,1,1,2,1)*jphot(indtemp+1,indsza+1,indcol,indozo,indtau+1,indch4,ij)     &
     426!          + poids(2,2,1,2,2,1)*jphot(indtemp+1,indsza+1,indcol,indozo+1,indtau+1,indch4,ij)   &
     427!          + poids(2,2,2,1,2,1)*jphot(indtemp+1,indsza+1,indcol+1,indozo,indtau+1,indch4,ij)   &
     428!          + poids(2,2,2,2,2,1)*jphot(indtemp+1,indsza+1,indcol+1,indozo+1,indtau+1,indch4,ij)
     429! CH4
     430          + poids(1,1,1,1,1,2)*jphot(indtemp,indsza,indcol,indozo,indtau,indch4+1,ij)         &
     431          + poids(1,1,1,2,1,2)*jphot(indtemp,indsza,indcol,indozo+1,indtau,indch4+1,ij)       &
     432          + poids(1,1,2,1,1,2)*jphot(indtemp,indsza,indcol+1,indozo,indtau,indch4+1,ij)       &
     433          + poids(1,1,2,2,1,2)*jphot(indtemp,indsza,indcol+1,indozo+1,indtau,indch4+1,ij)     &
     434          + poids(1,2,1,1,1,2)*jphot(indtemp,indsza+1,indcol,indozo,indtau,indch4+1,ij)       &
     435          + poids(1,2,1,2,1,2)*jphot(indtemp,indsza+1,indcol,indozo+1,indtau,indch4+1,ij)     &
     436          + poids(1,2,2,1,1,2)*jphot(indtemp,indsza+1,indcol+1,indozo,indtau,indch4+1,ij)     &
     437          + poids(1,2,2,2,1,2)*jphot(indtemp,indsza+1,indcol+1,indozo+1,indtau,indch4+1,ij)
     438!          + poids(2,1,1,1,1,2)*jphot(indtemp+1,indsza,indcol,indozo,indtau,indch4+1,ij) &
     439!          + poids(2,1,1,2,1,2)*jphot(indtemp+1,indsza,indcol,indozo+1,indtau,indch4+1,ij) &
     440!          + poids(2,1,2,1,1,2)*jphot(indtemp+1,indsza,indcol+1,indozo,indtau,indch4+1,ij) &
     441!          + poids(2,1,2,2,1,2)*jphot(indtemp+1,indsza,indcol+1,indozo+1,indtau,indch4+1,ij) &
     442!          + poids(2,2,1,1,1,2)*jphot(indtemp+1,indsza+1,indcol,indozo,indtau,indch4+1,ij) &
     443!          + poids(2,2,1,2,1,2)*jphot(indtemp+1,indsza+1,indcol,indozo+1,indtau,indch4+1,ij) &
     444!          + poids(2,2,2,1,1,2)*jphot(indtemp+1,indsza+1,indcol+1,indozo,indtau,indch4+1,ij) &
     445!          + poids(2,2,2,2,1,2)*jphot(indtemp+1,indsza+1,indcol+1,indozo+1,indtau,indch4+1,ij) &
     446!!
     447!          + poids(1,1,1,1,2,2)*jphot(indtemp,indsza,indcol,indozo,indtau+1,indch4+1,ij) &
     448!          + poids(1,1,1,2,2,2)*jphot(indtemp,indsza,indcol,indozo+1,indtau+1,indch4+1,ij) &
     449!          + poids(1,1,2,1,2,2)*jphot(indtemp,indsza,indcol+1,indozo,indtau+1,indch4+1,ij) &
     450!          + poids(1,1,2,2,2,2)*jphot(indtemp,indsza,indcol+1,indozo+1,indtau+1,indch4+1,ij) &
     451!          + poids(1,2,1,1,2,2)*jphot(indtemp,indsza+1,indcol,indozo,indtau+1,indch4+1,ij) &
     452!          + poids(1,2,1,2,2,2)*jphot(indtemp,indsza+1,indcol,indozo+1,indtau+1,indch4+1,ij) &
     453!          + poids(1,2,2,1,2,2)*jphot(indtemp,indsza+1,indcol+1,indozo,indtau+1,indch4+1,ij) &
     454!          + poids(1,2,2,2,2,2)*jphot(indtemp,indsza+1,indcol+1,indozo+1,indtau+1,indch4+1,ij) &
     455!          + poids(2,1,1,1,2,2)*jphot(indtemp+1,indsza,indcol,indozo,indtau+1,indch4+1,ij) &
     456!          + poids(2,1,1,2,2,2)*jphot(indtemp+1,indsza,indcol,indozo+1,indtau+1,indch4+1,ij) &
     457!          + poids(2,1,2,1,2,2)*jphot(indtemp+1,indsza,indcol+1,indozo,indtau+1,indch4+1,ij) &
     458!          + poids(2,1,2,2,2,2)*jphot(indtemp+1,indsza,indcol+1,indozo+1,indtau+1,indch4+1,ij) &
     459!          + poids(2,2,1,1,2,2)*jphot(indtemp+1,indsza+1,indcol,indozo,indtau+1,indch4+1,ij) &
     460!          + poids(2,2,1,2,2,2)*jphot(indtemp+1,indsza+1,indcol,indozo+1,indtau+1,indch4+1,ij) &
     461!          + poids(2,2,2,1,2,2)*jphot(indtemp+1,indsza+1,indcol+1,indozo,indtau+1,indch4+1,ij) &
     462!          + poids(2,2,2,2,2,2)*jphot(indtemp+1,indsza+1,indcol+1,indozo+1,indtau+1,indch4+1,ij)
     463
    286464         end do
     465
     466      if (photoheat) then
     467         do ij = 1,nd
     468            e(l,ij) =                                                                         &
     469            poids(1,1,1,1,1,1)*ephot(indtemp,indsza,indcol,indozo,indtau,indch4,ij)           &
     470          + poids(1,1,1,2,1,1)*ephot(indtemp,indsza,indcol,indozo+1,indtau,indch4,ij)         &
     471          + poids(1,1,2,1,1,1)*ephot(indtemp,indsza,indcol+1,indozo,indtau,indch4,ij)         &
     472          + poids(1,1,2,2,1,1)*ephot(indtemp,indsza,indcol+1,indozo+1,indtau,indch4,ij)       &
     473          + poids(1,2,1,1,1,1)*ephot(indtemp,indsza+1,indcol,indozo,indtau,indch4,ij)         &
     474          + poids(1,2,1,2,1,1)*ephot(indtemp,indsza+1,indcol,indozo+1,indtau,indch4,ij)       &
     475          + poids(1,2,2,1,1,1)*ephot(indtemp,indsza+1,indcol+1,indozo,indtau,indch4,ij)       &
     476          + poids(1,2,2,2,1,1)*ephot(indtemp,indsza+1,indcol+1,indozo+1,indtau,indch4,ij)     &
     477!          + poids(2,1,1,1,1,1)*ephot(indtemp+1,indsza,indcol,indozo,indtau,indch4,ij)         &
     478!          + poids(2,1,1,2,1,1)*ephot(indtemp+1,indsza,indcol,indozo+1,indtau,indch4,ij)       &
     479!          + poids(2,1,2,1,1,1)*ephot(indtemp+1,indsza,indcol+1,indozo,indtau,indch4,ij)       &
     480!          + poids(2,1,2,2,1,1)*ephot(indtemp+1,indsza,indcol+1,indozo+1,indtau,indch4,ij)     &
     481!          + poids(2,2,1,1,1,1)*ephot(indtemp+1,indsza+1,indcol,indozo,indtau,indch4,ij)       &
     482!          + poids(2,2,1,2,1,1)*ephot(indtemp+1,indsza+1,indcol,indozo+1,indtau,indch4,ij)     &
     483!          + poids(2,2,2,1,1,1)*ephot(indtemp+1,indsza+1,indcol+1,indozo,indtau,indch4,ij)     &
     484!          + poids(2,2,2,2,1,1)*ephot(indtemp+1,indsza+1,indcol+1,indozo+1,indtau,indch4,ij)   &
     485!!
     486!          + poids(1,1,1,1,2,1)*ephot(indtemp,indsza,indcol,indozo,indtau+1,indch4,ij)         &
     487!          + poids(1,1,1,2,2,1)*ephot(indtemp,indsza,indcol,indozo+1,indtau+1,indch4,ij)       &
     488!          + poids(1,1,2,1,2,1)*ephot(indtemp,indsza,indcol+1,indozo,indtau+1,indch4,ij)       &
     489!          + poids(1,1,2,2,2,1)*ephot(indtemp,indsza,indcol+1,indozo+1,indtau+1,indch4,ij)     &
     490!          + poids(1,2,1,1,2,1)*ephot(indtemp,indsza+1,indcol,indozo,indtau+1,indch4,ij)       &
     491!          + poids(1,2,1,2,2,1)*ephot(indtemp,indsza+1,indcol,indozo+1,indtau+1,indch4,ij)     &
     492!          + poids(1,2,2,1,2,1)*ephot(indtemp,indsza+1,indcol+1,indozo,indtau+1,indch4,ij)     &
     493!          + poids(1,2,2,2,2,1)*ephot(indtemp,indsza+1,indcol+1,indozo+1,indtau+1,indch4,ij)   &
     494!          + poids(2,1,1,1,2,1)*ephot(indtemp+1,indsza,indcol,indozo,indtau+1,indch4,ij)       &
     495!          + poids(2,1,1,2,2,1)*ephot(indtemp+1,indsza,indcol,indozo+1,indtau+1,indch4,ij)     &
     496!          + poids(2,1,2,1,2,1)*ephot(indtemp+1,indsza,indcol+1,indozo,indtau+1,indch4,ij)     &
     497!          + poids(2,1,2,2,2,1)*ephot(indtemp+1,indsza,indcol+1,indozo+1,indtau+1,indch4,ij)   &
     498!          + poids(2,2,1,1,2,1)*ephot(indtemp+1,indsza+1,indcol,indozo,indtau+1,indch4,ij)     &
     499!          + poids(2,2,1,2,2,1)*ephot(indtemp+1,indsza+1,indcol,indozo+1,indtau+1,indch4,ij)   &
     500!          + poids(2,2,2,1,2,1)*ephot(indtemp+1,indsza+1,indcol+1,indozo,indtau+1,indch4,ij)   &
     501!          + poids(2,2,2,2,2,1)*ephot(indtemp+1,indsza+1,indcol+1,indozo+1,indtau+1,indch4,ij)
     502! CH4
     503          + poids(1,1,1,1,1,2)*ephot(indtemp,indsza,indcol,indozo,indtau,indch4+1,ij)         &
     504          + poids(1,1,1,2,1,2)*ephot(indtemp,indsza,indcol,indozo+1,indtau,indch4+1,ij)       &
     505          + poids(1,1,2,1,1,2)*ephot(indtemp,indsza,indcol+1,indozo,indtau,indch4+1,ij)       &
     506          + poids(1,1,2,2,1,2)*ephot(indtemp,indsza,indcol+1,indozo+1,indtau,indch4+1,ij)     &
     507          + poids(1,2,1,1,1,2)*ephot(indtemp,indsza+1,indcol,indozo,indtau,indch4+1,ij)       &
     508          + poids(1,2,1,2,1,2)*ephot(indtemp,indsza+1,indcol,indozo+1,indtau,indch4+1,ij)     &
     509          + poids(1,2,2,1,1,2)*ephot(indtemp,indsza+1,indcol+1,indozo,indtau,indch4+1,ij)     &
     510          + poids(1,2,2,2,1,2)*ephot(indtemp,indsza+1,indcol+1,indozo+1,indtau,indch4+1,ij)
     511!          + poids(2,1,1,1,1,2)*ephot(indtemp+1,indsza,indcol,indozo,indtau,indch4+1,ij) &
     512!          + poids(2,1,1,2,1,2)*ephot(indtemp+1,indsza,indcol,indozo+1,indtau,indch4+1,ij) &
     513!          + poids(2,1,2,1,1,2)*ephot(indtemp+1,indsza,indcol+1,indozo,indtau,indch4+1,ij) &
     514!          + poids(2,1,2,2,1,2)*ephot(indtemp+1,indsza,indcol+1,indozo+1,indtau,indch4+1,ij) &
     515!          + poids(2,2,1,1,1,2)*ephot(indtemp+1,indsza+1,indcol,indozo,indtau,indch4+1,ij) &
     516!          + poids(2,2,1,2,1,2)*ephot(indtemp+1,indsza+1,indcol,indozo+1,indtau,indch4+1,ij) &
     517!          + poids(2,2,2,1,1,2)*ephot(indtemp+1,indsza+1,indcol+1,indozo,indtau,indch4+1,ij) &
     518!          + poids(2,2,2,2,1,2)*ephot(indtemp+1,indsza+1,indcol+1,indozo+1,indtau,indch4+1,ij) &
     519!!
     520!          + poids(1,1,1,1,2,2)*ephot(indtemp,indsza,indcol,indozo,indtau+1,indch4+1,ij) &
     521!          + poids(1,1,1,2,2,2)*ephot(indtemp,indsza,indcol,indozo+1,indtau+1,indch4+1,ij) &
     522!          + poids(1,1,2,1,2,2)*ephot(indtemp,indsza,indcol+1,indozo,indtau+1,indch4+1,ij) &
     523!          + poids(1,1,2,2,2,2)*ephot(indtemp,indsza,indcol+1,indozo+1,indtau+1,indch4+1,ij) &
     524!          + poids(1,2,1,1,2,2)*ephot(indtemp,indsza+1,indcol,indozo,indtau+1,indch4+1,ij) &
     525!          + poids(1,2,1,2,2,2)*ephot(indtemp,indsza+1,indcol,indozo+1,indtau+1,indch4+1,ij) &
     526!          + poids(1,2,2,1,2,2)*ephot(indtemp,indsza+1,indcol+1,indozo,indtau+1,indch4+1,ij) &
     527!          + poids(1,2,2,2,2,2)*ephot(indtemp,indsza+1,indcol+1,indozo+1,indtau+1,indch4+1,ij) &
     528!          + poids(2,1,1,1,2,2)*ephot(indtemp+1,indsza,indcol,indozo,indtau+1,indch4+1,ij) &
     529!          + poids(2,1,1,2,2,2)*ephot(indtemp+1,indsza,indcol,indozo+1,indtau+1,indch4+1,ij) &
     530!          + poids(2,1,2,1,2,2)*ephot(indtemp+1,indsza,indcol+1,indozo,indtau+1,indch4+1,ij) &
     531!          + poids(2,1,2,2,2,2)*ephot(indtemp+1,indsza,indcol+1,indozo+1,indtau+1,indch4+1,ij) &
     532!          + poids(2,2,1,1,2,2)*ephot(indtemp+1,indsza+1,indcol,indozo,indtau+1,indch4+1,ij) &
     533!          + poids(2,2,1,2,2,2)*ephot(indtemp+1,indsza+1,indcol,indozo+1,indtau+1,indch4+1,ij) &
     534!          + poids(2,2,2,1,2,2)*ephot(indtemp+1,indsza+1,indcol+1,indozo,indtau+1,indch4+1,ij) &
     535!          + poids(2,2,2,2,2,2)*ephot(indtemp+1,indsza+1,indcol+1,indozo+1,indtau+1,indch4+1,ij)
     536
     537         end do
     538       end if
    287539
    288540!     correction for sun distance
     
    291543!            j(l,ij) = j(l,ij)*(1.52/dist_sol)**2.
    292544            j(l,ij) = j(l,ij)*(1.0/dist_sol)**2.
    293 
     545            if (photoheat) e(l,ij) = e(l,ij)*(1.0/dist_sol)**2.
     546 
    294547            ! Only during daylight.
    295548            if((ngrid.eq.1))then
    296                   j(l,ij)= j(l,ij)* 0.25 ! globally averaged = divide by 4
     549                  j(l,ij)= j(l,ij)* 0.25 / cos(sza*pi/180.) ! globally averaged = divide by 4
     550                  if (photoheat) e(l,ij)= e(l,ij)* 0.25 / cos(sza*pi/180.) ! globally averaged = divide by 4
    297551            elseif(diurnal .eqv. .false.) then
    298552                  j(l,ij)= j(l,ij) * fractcol
     553                  if (photoheat) e(l,ij)= e(l,ij) * fractcol
    299554            endif
     555
     556
    300557         end do
    301558
     559
     560
    302561!==========================================================================
    303562!     end of loop over vertical levels
     
    313572
    314573         j(:,:) = 0.
     574         if (photoheat) e(:,:) = 0.
    315575
    316576      end if
    317577
    318 ! photodissociation rates numbering in the lookup table
    319 
    320 ! jmars.20140930
    321 
    322 
    323       j_o2_o         =  1      ! o2 + hv     -> o + o
    324       j_o2_o1d       =  2      ! o2 + hv     -> o + o(1d)
    325       j_co2_o        =  3      ! co2 + hv    -> co + o
    326       j_co2_o1d      =  4      ! co2 + hv    -> co + o(1d)
    327       j_o3_o1d       =  5      ! o3 + hv     -> o2 + o(1d)
    328       j_o3_o         =  6      ! o3 + hv     -> o2 + o
    329       j_h2o          =  7      ! h2o + hv    -> h + oh
    330       j_h2o2         =  8      ! h2o2 + hv   -> oh + oh
    331       j_ho2          =  9      ! ho2 + hv    -> oh + o
    332       j_no           =  10     ! no + hv     -> n + o
    333       j_no2          =  11     ! no2 + hv    -> no + o
    334       j_hno3         =  12     ! hno3 + hv   -> no2 + oh
    335       j_hno4         =  13     ! hno4 + hv   -> no2 + ho2
    336 
    337 ! jmars.20111014
    338 
    339 !     j_o2_o         =  1      ! o2 + hv     -> o + o
    340 !     j_o2_o1d       =  2      ! o2 + hv     -> o + o(1d)
    341 !     j_co2_o        =  3      ! co2 + hv    -> co + o
    342 !     j_co2_o1d      =  4      ! co2 + hv    -> co + o(1d)
    343 !     j_o3_o1d       =  5      ! o3 + hv     -> o2 + o(1d)
    344 !     j_o3_o         =  6      ! o3 + hv     -> o2 + o
    345 !     j_h2o          =  7      ! h2o + hv    -> h + oh
    346 !     j_hdo          =  8      ! hdo + hv    -> d + oh
    347 !     j_h2o2         =  9      ! h2o2 + hv   -> oh + oh
    348 !     j_ho2          =  10     ! ho2 + hv    -> oh + o
    349 !     j_no2          =  11     ! no2 + hv    -> no + o
    350 !     j_ch4_ch3_h    =  12     ! ch4 + hv    -> ch3 + h
    351 !     j_ch4_1ch2_h2  =  13     ! ch4 + hv    -> 1ch2 + h2
    352 !     j_ch4_3ch2_h_h =  14     ! ch4 + hv    -> 3ch2 + h + h
    353 !     j_ch4_ch_h2_h  =  15     ! ch4 + hv    -> ch + h2 + h
    354 !     j_ch3o2h       =  16     ! ch3o2h + hv -> ch3o + oh
    355 !     j_ch2o_hco     =  17     ! ch2o + hv   -> h + hco
    356 !     j_ch2o_co      =  18     ! ch2o + hv   -> h2 + co
    357 !     j_ch3oh        =  19     ! ch3oh + hv  -> ch3o + h
    358 !     j_c2h6         =  20     ! c2h6 + hv   -> products
    359 !     j_hcl          =  21     ! hcl + hv    -> h + cl
    360 !     j_hocl         =  22     ! hocl + hv   -> oh + cl
    361 !     j_clo          =  23     ! clo + hv    -> o + cl
    362 !     j_so2          =  24     ! so2 + hv    -> so + o
    363 !     j_so           =  25     ! so + hv     -> s + o
    364 !     j_h2s          =  26     ! h2s + hv    -> hs + s
    365 !     j_so3          =  27     ! so2 + hv    -> so2 + o
    366 !     j_hno3         =  28     ! hno3 + hv   -> oh + no2
    367 !     j_hno4         =  29     ! hno4 + hv   -> ho2 + no2
    368 
    369578! fill v_phot array
    370579
    371580      v_phot(:,:) = 0.
    372 
    373       do l = 1,lswitch-1
    374          v_phot(l, 1) = j(l,j_o2_o)
    375          v_phot(l, 2) = j(l,j_o2_o1d)
    376          v_phot(l, 3) = j(l,j_co2_o)
    377          v_phot(l, 4) = j(l,j_co2_o1d)
    378          v_phot(l, 5) = j(l,j_o3_o1d)
    379          v_phot(l, 6) = j(l,j_o3_o)
    380          v_phot(l, 7) = j(l,j_h2o)
    381          v_phot(l, 8) = j(l,j_h2o2)
    382          v_phot(l, 9) = j(l,j_ho2)
    383          v_phot(l,10) = j(l,j_no)
    384          v_phot(l,11) = j(l,j_no2)
     581      e_phot(:,:) = 0.
     582
     583! Order of photolysis reaction has to be the same in monoreact file and the phototable file
     584      ij      = 0
     585      nb_phot = 0
     586      do while(nb_phot<nb_phot_hv_max)
     587        ij      = ij + 1
     588        nb_phot = nb_phot + 1
     589        do l = 1,lswitch-1
     590          v_phot(l,nb_phot) = j(l,ij)
     591          if (photoheat) e_phot(l,nb_phot) = e(l,ij)
     592        end do
     593        if (three_prod(ij)) then
     594          nb_phot = nb_phot + 1
     595          do l = 1,lswitch-1
     596            v_phot(l,nb_phot) = j(l,ij)
     597            if (photoheat) e_phot(l,nb_phot) = e(l,ij)
     598          end do
     599        end if
    385600      end do
    386601
  • trunk/LMDZ.GENERIC/libf/aeronostd/read_phototable.F90

    r1796 r2542  
    1313!
    1414!   Author:   Franck Lefevre
     15!   update 06/03/2021 dimension set in table + CH4 dimension + photoheat (Yassin Jaziri)
    1516!
    1617!   Arguments:
    1718!   ----------
    1819!
    19 !   The output variable is jphot and is put in common chimiedata.
     20!   The output variable is jphot/ephot and is put in common chimiedata.
    2021!
    2122!***********************************************************************
     
    2425      use ioipsl_getin_p_mod, only: getin_p
    2526      use datafile_mod
     27      use callkeys_mod
     28      use chimiedata_h
    2629      implicit none
    2730
    28 #include "chimiedata.h"
     31!#include "chimiedata.h"
    2932
    3033!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
     
    3235!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
    3336
    34       integer :: fic, ij, iozo, isza, itemp, iz, itau, ierr
    35       real    :: xsza
     37      integer :: fic, ij, iozo, isza, itemp, iz, itau, ich4, ierr
     38      real    :: xsza, dummy
    3639
    3740      character(len = 128) :: phototable ! photolysis table file name
     41      character(len = 128) :: ephototable ! energie photolysis table file name
    3842
    3943!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
     
    7377      print*, 'read photolysis lookup table ',trim(phototable)
    7478
     79      read(fic,*) nz, nsza, nozo, dummy, ntemp, ntau, nch4, nd
     80
     81      allocate(jphot(ntemp,nsza,nz,nozo,ntau,nch4,nd))
     82      allocate(ephot(ntemp,nsza,nz,nozo,ntau,nch4,nd))
     83      allocate(colairtab(nz))
     84      allocate(szatab(nsza))
     85      allocate(table_ozo(nozo))
     86      allocate(tautab(ntau))
     87      allocate(table_ch4(nch4))
     88
    7589      do itau = 1,ntau
    7690         do itemp = 1,ntemp
    7791            do iozo = 1,nozo
    78                do isza = 1,nsza
    79                   do iz = nz,1,-1
    80                      read(fic,*) colairtab(iz), xsza, table_ozo(iozo)
    81                      read(fic,'(7e11.4)') (jphot(itemp,isza,iz,iozo,itau,ij), ij= 1,nd)
    82                      do ij = 1,nd
    83                         if (jphot(itemp,isza,iz,iozo,itau,ij) == 1.e-30) then
    84                            jphot(itemp,isza,iz,iozo,itau,ij) = 0.
    85                         end if
     92               do ich4 =1,nch4
     93                  do isza = 1,nsza
     94                     do iz = nz,1,-1
     95                        read(fic,*) colairtab(iz), szatab(isza),table_ozo(iozo), dummy, dummy, dummy, table_ch4(ich4)
     96                        read(fic,'(7e11.4)') (jphot(itemp,isza,iz,iozo,itau,ich4,ij), ij= 1,nd)
     97                        do ij = 1,nd
     98                           if (jphot(itemp,isza,iz,iozo,itau,ich4,ij) == 1.e-30) then
     99                              jphot(itemp,isza,iz,iozo,itau,ich4,ij) = 0.
     100                           end if
     101                        end do
    86102                     end do
    87103                  end do
     
    94110      close(fic)
    95111
     112      if (photoheat) then
     113!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
     114! set energie photolysis table input file name
     115!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
     116
     117
     118
     119! look for a " ephototable= ..." option in def files
     120     write(*,*) "Directory where external input files are:"
     121      ephototable = "zdtearth_N+_CO2_0.0004_O2_0.21_G11" ! default
     122     call getin_p("ephototable",ephototable) ! default path
     123     write(*,*) " ephototable = ",trim(ephototable)
     124
     125
     126      fic = 81
     127
     128      open(fic, form = 'formatted', status = 'old',                &
     129           file =trim(datadir)//"/"//trim(ephototable),iostat=ierr)
     130
     131      if (ierr /= 0) THEN
     132        write(*,*)'Error : cannot open energie photolysis lookup table ', trim(ephototable)
     133        write(*,*)'It should be in :',trim(datadir),'/'
     134        write(*,*)'1) You can change this directory in callphys.def'
     135        write(*,*)'   with:'
     136        write(*,*)'   datadir=/path/to/the/directory'
     137        write(*,*)'2) You can change the input ephototable file name in'
     138        write(*,*)'   callphys.def with:'
     139        write(*,*)'   ephototable=filename'
     140        stop
     141      end if
     142
     143!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
     144! read energie photolys table
     145!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
     146
     147      print*, 'read energie photolysis lookup table ',trim(ephototable)
     148
     149      do itau = 1,ntau
     150         do itemp = 1,ntemp
     151            do iozo = 1,nozo
     152               do ich4 =1,nch4
     153                  do isza = 1,nsza
     154                     do iz = nz,1,-1
     155                        read(fic,*) colairtab(iz), xsza,table_ozo(iozo), dummy, dummy, dummy, table_ch4(ich4)
     156                        read(fic,'(7e11.4)') (ephot(itemp,isza,iz,iozo,itau,ich4,ij), ij= 1,nd)
     157                        do ij = 1,nd
     158                           if (ephot(itemp,isza,iz,iozo,itau,ich4,ij) == 1.e-30) then
     159                              ephot(itemp,isza,iz,iozo,itau,ich4,ij) = 0.
     160                           end if
     161                        end do
     162                     end do
     163                  end do
     164               end do
     165            end do
     166         end do
     167      end do
     168
     169      print*, 'lookup etable...ok'
     170      close(fic)
     171      end if
     172
    96173      return
    97174      end
  • trunk/LMDZ.GENERIC/libf/aeronostd/types_asis.F90

    r1796 r2542  
    77
    88type z3spec
    9         real(kind=jprb)    :: z1
    10         integer(kind=jpim) :: z2
    11         real(kind=jprb)    :: z3
    12         integer(kind=jpim) :: z4
    13         real(kind=jprb)    :: z5
    14         integer(kind=jpim) :: z6
     9    real(kind=jprb)    :: z1
     10    integer(kind=jpim) :: z2
     11    real(kind=jprb)    :: z3
     12    integer(kind=jpim) :: z4
     13    real(kind=jprb)    :: z5
     14    integer(kind=jpim) :: z6
    1515end type z3spec
    1616type z4spec
    17         real(kind=jprb)    :: z1
    18         integer(kind=jpim) :: z2
    19         real(kind=jprb)    :: z3
    20         integer(kind=jpim) :: z4
    21         real(kind=jprb)    :: z5
    22         integer(kind=jpim) :: z6
    23         real(kind=jprb)    :: z7
    24         integer(kind=jpim) :: z8
     17    real(kind=jprb)    :: z1
     18    integer(kind=jpim) :: z2
     19    real(kind=jprb)    :: z3
     20    integer(kind=jpim) :: z4
     21    real(kind=jprb)    :: z5
     22    integer(kind=jpim) :: z6
     23    real(kind=jprb)    :: z7
     24    integer(kind=jpim) :: z8
    2525end type z4spec
    2626
     
    3131type(z4spec), allocatable, save :: indice_4(:)
    3232
     33! dimension of indexes variables
     34
     35integer, save :: nb_phot_max       ! dimension of phot reaction, including photolysis and quenching reaction
     36integer, save :: nb_reaction_3_max
     37integer, save :: nb_reaction_4_max
     38integer, save :: nb_phot_hv_max    ! dimension of photolysis, including three product photolysis
     39
     40! photolysis reaction rate and label
     41
     42real (kind = 8),      allocatable, save :: v_phot_3d(:,:,:)
     43character(len = 20),  allocatable, save :: jlabel(:,:)        ! photolysis label and species name
     44character(len = 300), allocatable, save :: jparamline(:)      ! line of jonline parameters
     45
     46! pfunc type
     47
     48type rtype1
     49    real(kind=jprb)    :: a
     50    real(kind=jprb)    :: b
     51    real(kind=jprb)    :: c
     52    real(kind=jprb)    :: t0
     53    real(kind=jprb)    :: d
     54end type rtype1
     55
     56type rtype2
     57    real(kind=jprb)    :: k0
     58    real(kind=jprb)    :: n
     59    real(kind=jprb)    :: a
     60    real(kind=jprb)    :: kinf
     61    real(kind=jprb)    :: m
     62    real(kind=jprb)    :: b
     63    real(kind=jprb)    :: t0
     64    real(kind=jprb)    :: fc
     65    real(kind=jprb)    :: g
     66    real(kind=jprb)    :: h
     67    real(kind=jprb)    :: dup
     68    real(kind=jprb)    :: ddown
     69end type rtype2
     70
     71type rtype3
     72    real(kind=jprb)    :: k0
     73    real(kind=jprb)    :: n
     74    real(kind=jprb)    :: a
     75    real(kind=jprb)    :: kinf
     76    real(kind=jprb)    :: m
     77    real(kind=jprb)    :: b
     78    real(kind=jprb)    :: t0
     79    real(kind=jprb)    :: atroe
     80    real(kind=jprb)    :: btroe
     81    real(kind=jprb)    :: ctroe
     82    real(kind=jprb)    :: dtroe
     83    real(kind=jprb)    :: dup
     84    real(kind=jprb)    :: ddown
     85end type rtype3
     86
     87! pfunc parameters for the reaction rates
     88
     89type(rtype1), allocatable, save :: pfunc1_param(:)
     90type(rtype2), allocatable, save :: pfunc2_param(:)
     91type(rtype3), allocatable, save :: pfunc3_param(:)
     92
     93! dimension of pfunc type variables
     94
     95integer, save :: nb_hv_max
     96integer, save :: nb_pfunc1_max
     97integer, save :: nb_pfunc2_max
     98integer, save :: nb_pfunc3_max
     99
    33100end module types_asis
  • trunk/LMDZ.GENERIC/libf/dynphy_lonlat/phystd/inichim_newstart.F90

    r1882 r2542  
    22                                  flagh2o, flagthermo)
    33
    4       use tracer_h
    5       USE comvert_mod, ONLY: aps,bps
    6       USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, nbp_lev
    7       use callkeys_mod
    8       use datafile_mod
     4      use tracer_h,          only: noms, mmol
     5      use datafile_mod,      only: datadir
     6      use comvert_mod,       only: aps,bps
     7      use mod_grid_phy_lmdz, only: nbp_lon, nbp_lat, nbp_lev
    98
    109      implicit none
     
    2625!  Modified 11/2011 Addition of methane Franck Lefevre
    2726!  Rewritten 04/2012 Franck Lefevre
     27!  Rewritten 03/2021 Yassin Jaziri (Use of #Moderntrac-v1 to init thanks traceur.def)
    2828!
    2929!  Arguments:
    3030!  ----------
    3131!
    32 !  pq(nbp_lon+1,nbp_lat,nbp_lev,nq)  Advected fields, ie chemical species here
    33 !  qsurf(ngrid,nq)     Amount of tracer on the surface (kg/m2)
    34 !  ps(nbp_lon+1,nbp_lat)           Surface pressure (Pa)
    35 !  flagh2o                 flag for initialisation of h2o (1: yes / 0: no)
    36 !  flagthermo              flag for initialisation of thermosphere only (1: yes / 0: no)
     32!  pq(nbp_lon+1,nbp_lat,nbp_lev,nq)   Advected fields, ie chemical species here
     33!  qsurf(ngrid,nq)                    Amount of tracer on the surface (kg/m2)
     34!  ps(nbp_lon+1,nbp_lat)              Surface pressure (Pa)
     35!  flagh2o                            flag for initialisation of h2o (1: yes / 0: no)
     36!  flagthermo                         flag for initialisation of thermosphere only (1: yes / 0: no)
    3737!
    3838!=======================================================================
     
    4141! inputs :
    4242
    43       integer,intent(in) :: ngrid         ! number of atmospheric columns in the physics
    44       integer,intent(in) :: nq                    ! number of tracers
    45       real,intent(in) :: ps(nbp_lon+1,nbp_lat)            ! surface pressure in the gcm (Pa)   
    46       integer,intent(in) :: flagh2o               ! flag for h2o initialisation
    47       integer,intent(in) :: flagthermo            ! flag for thermosphere initialisation only
     43      integer,intent(in) :: ngrid                  ! number of atmospheric columns in the physics
     44      integer,intent(in) :: nq                     ! number of tracers
     45      real   ,intent(in) :: ps(nbp_lon+1,nbp_lat)  ! surface pressure in the gcm (Pa)
     46      integer,intent(in) :: flagh2o                ! flag for h2o initialisation
     47      integer,intent(in) :: flagthermo             ! flag for thermosphere initialisation only
    4848
    4949! outputs :
    5050
    51       real,intent(out) :: pq(nbp_lon+1,nbp_lat,nbp_lev,nq) ! advected fields, ie chemical species
    52       real,intent(out) :: qsurf(ngrid,nq)     ! surface values (kg/m2) of tracers
     51      real,intent(out)   :: pq(nbp_lon+1,nbp_lat,nbp_lev,nq) ! advected fields, ie chemical species
     52      real,intent(out)   :: qsurf(ngrid,nq)                  ! surface values (kg/m2) of tracers
    5353
    5454! local :
    5555
    56       integer :: iq, i, j, l, n, nbqchem
    57       integer :: count, ierr, dummy
    58       real    :: mmean(nbp_lon+1,nbp_lat,nbp_lev)             ! mean molecular mass (g)
    59       real    :: pgcm                             ! pressure at each layer in the gcm (Pa)
    60 
    61       integer, parameter         :: nalt = 252    ! number of altitudes in the initialization files
    62       integer                    :: nspe          ! number of species in the initialization files
    63       integer, allocatable       :: niq(:)        ! local index of species in initialization files
    64       real, dimension(nalt)      :: tinit, zzfile ! temperature in initialization files
    65       real, dimension(nalt)      :: pinit         ! pressure in initialization files
    66       real, dimension(nalt)      :: densinit      ! total number density in initialization files
    67       real, allocatable          :: vmrinit(:,:)  ! mixing ratios in initialization files
    68       real, allocatable          :: vmrint(:)     ! mixing ratio interpolated onto the gcm vertical grid
    69       real                       :: vmr
    70 
    71       character(len=20)          :: txt           ! to store some text
    72       logical                    :: flagnitro     ! checks if N species present
    73 
    74 ! 1. identify tracers by their names: (and set corresponding values of mmol)
    75 
    76 ! 1.1 initialize tracer indexes to zero:
    77 !      nqmx=nq ! initialize value of nqmx
    78 
    79       do iq = 1,nq
    80         igcm_dustbin(iq) = 0
    81       end do
    82 
    83 !      igcm_dust_mass   = 0
    84 !      igcm_dust_number = 0
    85 !      igcm_ccn_mass    = 0
    86 !      igcm_ccn_number  = 0
    87       igcm_h2o_vap     = 0
    88       igcm_h2o_ice     = 0
    89       igcm_co2         = 0
    90       igcm_co          = 0
    91       igcm_o           = 0
    92       igcm_o1d         = 0
    93       igcm_o2          = 0
    94       igcm_o3          = 0
    95       igcm_h           = 0
    96       igcm_h2          = 0
    97       igcm_oh          = 0
    98       igcm_ho2         = 0
    99       igcm_h2o2        = 0
    100       igcm_ch4         = 0
    101       igcm_n2          = 0
    102       igcm_ar          = 0
    103       igcm_ar_n2       = 0
    104       igcm_ch3         = 0
    105       igcm_ch          = 0
    106       igcm_3ch2        = 0
    107       igcm_1ch2        = 0
    108       igcm_cho         = 0
    109       igcm_ch2o        = 0
    110       igcm_c           = 0
    111       igcm_c2          = 0
    112       igcm_c2h         = 0
    113       igcm_c2h2        = 0
    114       igcm_c2h3        = 0
    115       igcm_c2h4        = 0
    116       igcm_c2h6        = 0
    117       igcm_ch2co       = 0
    118       igcm_ch3co       = 0
    119       igcm_hcaer       = 0
    120 
    121 ! 1.2 find dust tracers
    122       count = 0
    123 !
    124 !      if (dustbin > 0) then
    125 !         do iq = 1,nq
    126 !            txt = " "
    127 !            write(txt,'(a4,i2.2)') 'dust', count + 1
    128 !            if (noms(iq) == txt) then
    129 !               count = count + 1
    130 !               igcm_dustbin(count) = iq
    131 !               mmol(iq) = 100.
    132 !            end if
    133 !         end do !do iq=1,nq
    134 !      end if ! of if (dustbin.gt.0)
    135 !
    136 !      if (doubleq) then
    137 !         do iq = 1,nq
    138 !            if (noms(iq) == "dust_mass") then
    139 !               igcm_dust_mass = iq
    140 !               count = count + 1
    141 !            end if
    142 !            if (noms(iq) == "dust_number") then
    143 !               igcm_dust_number = iq
    144 !               count = count + 1
    145 !            end if
    146 !         end do
    147 !      end if ! of if (doubleq)
    148 !
    149 !      if (scavenging) then
    150 !         do iq = 1,nq
    151 !            if (noms(iq) == "ccn_mass") then
    152 !               igcm_ccn_mass = iq
    153 !               count = count + 1
    154 !            end if
    155 !            if (noms(iq) == "ccn_number") then
    156 !               igcm_ccn_number = iq
    157 !               count = count + 1
    158 !            end if
    159 !         end do
    160 !      end if ! of if (scavenging)
    161 !
    162 !      if (submicron) then
    163 !         do iq=1,nq
    164 !            if (noms(iq) == "dust_submicron") then
    165 !               igcm_dust_submicron = iq
    166 !               mmol(iq) = 100.
    167 !               count = count + 1
    168 !            end if
    169 !         end do
    170 !      end if ! of if (submicron)
    171 
    172 ! 1.3 find chemistry and water tracers
    173 
    174       nbqchem = 0
    175 
    176       do iq = 1,nq
    177          if (noms(iq) == "co2") then
    178             igcm_co2 = iq
    179             mmol(igcm_co2) = 44.
    180             count = count + 1
    181             nbqchem = nbqchem + 1
    182         end if
    183         if (noms(iq) == "co") then
    184            igcm_co = iq
    185            mmol(igcm_co) = 28.
    186            count = count + 1
    187            nbqchem = nbqchem + 1
    188         end if
    189         if (noms(iq) == "o") then
    190            igcm_o = iq
    191            mmol(igcm_o) = 16.
    192            count = count + 1
    193            nbqchem = nbqchem + 1
    194         end if
    195         if (noms(iq) == "o1d") then
    196            igcm_o1d = iq
    197            mmol(igcm_o1d) = 16.
    198            count = count + 1
    199            nbqchem = nbqchem + 1
    200         end if
    201         if (noms(iq) == "o2") then
    202            igcm_o2 = iq
    203            mmol(igcm_o2) = 32.
    204            count = count + 1
    205            nbqchem = nbqchem + 1
    206         end if
    207         if (noms(iq) == "o3") then
    208            igcm_o3 = iq
    209            mmol(igcm_o3) = 48.
    210            count = count + 1
    211            nbqchem = nbqchem + 1
    212         end if
    213         if (noms(iq) == "h") then
    214            igcm_h = iq
    215            mmol(igcm_h) = 1.
    216            count = count + 1
    217            nbqchem = nbqchem + 1
    218         end if
    219         if (noms(iq) == "h2") then
    220            igcm_h2 = iq
    221            mmol(igcm_h2) = 2.
    222            count = count + 1
    223            nbqchem = nbqchem + 1
    224         end if
    225         if (noms(iq) == "oh") then
    226            igcm_oh = iq
    227            mmol(igcm_oh) = 17.
    228            count = count + 1
    229            nbqchem = nbqchem + 1
    230         end if
    231         if (noms(iq) == "ho2") then
    232            igcm_ho2 = iq
    233            mmol(igcm_ho2) = 33.
    234            count = count + 1
    235            nbqchem = nbqchem + 1
    236         end if
    237         if (noms(iq) == "h2o2") then
    238            igcm_h2o2 = iq
    239            mmol(igcm_h2o2) = 34.
    240            count = count + 1
    241            nbqchem = nbqchem + 1
    242         end if
    243         if (noms(iq) == "ch4") then
    244            igcm_ch4 = iq
    245            mmol(igcm_ch4) = 16.
    246            count = count + 1
    247            nbqchem = nbqchem + 1
    248         end if
    249         if (noms(iq) == "n2") then
    250            igcm_n2 = iq
    251            mmol(igcm_n2) = 28.
    252            count = count + 1
    253            nbqchem = nbqchem + 1
    254         end if
    255         if (noms(iq) == "n") then
    256            igcm_n = iq
    257            mmol(igcm_n) = 14.
    258            count = count + 1
    259            nbqchem = nbqchem + 1
    260         end if
    261         if (noms(iq) == "n2d") then
    262            igcm_n2d = iq
    263            mmol(igcm_n2d) = 14.
    264            count = count + 1
    265            nbqchem = nbqchem + 1
    266         end if
    267         if (noms(iq) == "no") then
    268            igcm_no = iq
    269            mmol(igcm_no) = 30.
    270            count = count + 1
    271            nbqchem = nbqchem + 1
    272         end if
    273         if (noms(iq) == "no2") then
    274            igcm_no2 = iq
    275            mmol(igcm_no2) = 46.
    276            count = count + 1
    277            nbqchem = nbqchem + 1
    278         end if
    279         if (noms(iq) == "h2o_vap") then
    280            igcm_h2o_vap = iq
    281            mmol(igcm_h2o_vap) = 18.
    282            count = count + 1
    283            nbqchem = nbqchem + 1
    284         end if
    285         if (noms(iq) == "h2o_ice") then
    286            igcm_h2o_ice = iq
    287            mmol(igcm_h2o_ice) = 18.
    288            count = count + 1
    289            nbqchem = nbqchem + 1
    290         end if
    291 
    292         if (noms(iq).eq."ch3") then
    293           igcm_ch3=iq
    294           mmol(igcm_ch3)=15.
    295           count=count+1
    296            nbqchem = nbqchem + 1
    297         endif
    298         if (noms(iq).eq."ch") then
    299           igcm_ch=iq
    300           mmol(igcm_ch)=13.
    301           count=count+1
    302            nbqchem = nbqchem + 1
    303         endif
    304         if (noms(iq).eq."3ch2") then
    305           igcm_3ch2=iq
    306           mmol(igcm_3ch2)=14.
    307           count=count+1
    308            nbqchem = nbqchem + 1
    309         endif
    310         if (noms(iq).eq."1ch2") then
    311           igcm_1ch2=iq
    312           mmol(igcm_1ch2)=14.
    313           count=count+1
    314            nbqchem = nbqchem + 1
    315         endif
    316         if (noms(iq).eq."cho") then
    317           igcm_cho=iq
    318           mmol(igcm_cho)=29.
    319           count=count+1
    320            nbqchem = nbqchem + 1
    321         endif
    322         if (noms(iq).eq."ch2o") then
    323           igcm_ch2o=iq
    324           mmol(igcm_ch2o)=30.
    325           count=count+1
    326            nbqchem = nbqchem + 1
    327         endif
    328         if (noms(iq).eq."ch3o") then
    329           igcm_ch3o=iq
    330           mmol(igcm_ch3o)=31.
    331           count=count+1
    332            nbqchem = nbqchem + 1
    333         endif
    334         if (noms(iq).eq."c") then
    335           igcm_c=iq
    336           mmol(igcm_c)=12.
    337           count=count+1
    338            nbqchem = nbqchem + 1
    339         endif
    340         if (noms(iq).eq."c2") then
    341           igcm_c2=iq
    342           mmol(igcm_c2)=24.
    343           count=count+1
    344            nbqchem = nbqchem + 1
    345         endif
    346         if (noms(iq).eq."c2h") then
    347           igcm_c2h=iq
    348           mmol(igcm_c2h)=25.
    349           count=count+1
    350            nbqchem = nbqchem + 1
    351         endif
    352         if (noms(iq).eq."c2h2") then
    353           igcm_c2h2=iq
    354           mmol(igcm_c2h2)=26.
    355           count=count+1
    356            nbqchem = nbqchem + 1
    357         endif
    358         if (noms(iq).eq."c2h3") then
    359           igcm_c2h3=iq
    360           mmol(igcm_c2h3)=27.
    361           count=count+1
    362            nbqchem = nbqchem + 1
    363         endif
    364         if (noms(iq).eq."c2h4") then
    365           igcm_c2h4=iq
    366           mmol(igcm_c2h4)=28.
    367           count=count+1
    368            nbqchem = nbqchem + 1
    369         endif
    370         if (noms(iq).eq."c2h6") then
    371           igcm_c2h6=iq
    372           mmol(igcm_c2h6)=30.
    373           count=count+1
    374            nbqchem = nbqchem + 1
    375         endif
    376         if (noms(iq).eq."ch2co") then
    377           igcm_ch2co=iq
    378           mmol(igcm_ch2co)=42.
    379           count=count+1
    380            nbqchem = nbqchem + 1
    381         endif
    382         if (noms(iq).eq."ch3co") then
    383           igcm_ch3co=iq
    384           mmol(igcm_ch3co)=43.
    385           count=count+1
    386            nbqchem = nbqchem + 1
    387         endif
    388         if (noms(iq).eq."hcaer") then
    389           igcm_hcaer=iq
    390           mmol(igcm_hcaer)=50.
    391           count=count+1
    392            nbqchem = nbqchem + 1
    393         endif
    394         if (noms(iq) == "ar") then
    395            igcm_ar = iq
    396            mmol(igcm_ar) = 40.
    397            count = count + 1
    398            nbqchem = nbqchem + 1
    399         end if
    400 
    401 
    402 
    403 ! 1.5 find idealized non-condensible tracer
    404 
    405         if (noms(iq) == "Ar_N2") then
    406            igcm_ar_n2 = iq
    407            mmol(igcm_ar_n2) = 30.
    408            count = count + 1
    409         end if
    410 
    411       end do ! of do iq=1,nq
    412      
    413 ! 1.6 check that we identified all tracers:
    414 
    415       if (count /= nq) then
    416          write(*,*) "inichim_newstart: found only ",count," tracers"
    417          write(*,*) "                  expected ",nq
    418          do iq = 1,count
    419             write(*,*) '      ', iq, ' ', trim(noms(iq))
    420          end do
     56      real, allocatable  :: pf(:)                  ! pressure in vmr profile files set in traceur.def
     57      real, allocatable  :: qf(:)                  ! vmr      in vmr profile files set in traceur.def
     58
     59      real    :: pgcm                              ! pressure at each layer in the gcm (Pa)
     60      real    :: mmean(nbp_lev)                    ! mean molecular mass (g)
     61      real    :: pqx(nbp_lon+1,nbp_lat,nbp_lev,nq) ! tracers (vmr)
     62      real    :: qx(nq)                            ! constant vmr set in traceur.def
     63      integer :: ilon, ilat, iq, ilay, iline, nlines, ierr
     64
     65      CHARACTER(len=100) :: qxf(nq)                ! vmr profile files set in traceur.def
     66      CHARACTER(len=100) :: fil                    ! path files
     67      character(len=500) :: tracline               ! to store a line of text
     68
     69      logical :: foundback = .false.
     70
     71! 1. initialization
     72
     73      pq(:,:,:,:)  = 0.
     74      qsurf(:,:)   = 0.
     75      pqx(:,:,:,:) = 0.
     76      qx(:)        = 0.
     77      qxf(:)       = 'None'
     78
     79! 2. load in traceur.def chemistry data for initialization:
     80
     81      ! Skip nq
     82      open(90,file='traceur.def',status='old',form='formatted',iostat=ierr)
     83      if (ierr.eq.0) then
     84        READ(90,'(A)') tracline
     85        IF (trim(tracline).eq.'#ModernTrac-v1') THEN ! Test modern traceur.def
     86           DO
     87             READ(90,'(A)',iostat=ierr) tracline
     88             IF (ierr.eq.0) THEN
     89               IF (index(tracline,'#').ne.1) THEN ! Allows arbitary number of comments lines in the header
     90                 EXIT
     91               ENDIF
     92             ELSE ! If pb, or if reached EOF without having found number of tracer
     93                write(*,*) "calchim: error reading line of tracers"
     94                write(*,*) "   (first lines of traceur.def) "
     95                stop
     96             ENDIF
     97           ENDDO
     98        ENDIF ! if modern or standard traceur.def
     99      else
     100         write(*,*) "calchim: error opening traceur.def in inichim_newstart"
    421101         stop
    422       else
    423          write(*,*) "inichim_newstart: found all expected tracers"
    424          do iq = 1,nq
    425             write(*,*) '      ', iq, ' ', trim(noms(iq))
    426          end do
    427       end if
    428 
    429 ! 1.7 check if nitrogen species are present:
    430 
    431       if(igcm_no == 0) then
    432          !check that no N species is in traceur.def
    433          if(igcm_n /= 0 .or. igcm_no2 /= 0 .or. igcm_n2d /= 0) then
    434             write(*,*)'inichim_newstart error:'
    435             write(*,*)'N, NO2 and/or N2D are in traceur.def, but not NO'
    436             write(*,*)'stop'
    437             stop
    438          endif
    439          flagnitro = .false.
    440          nspe = 14
    441       else
    442          !check that all N species are in traceur.def
    443          if(igcm_n == 0 .or. igcm_no2 == 0 .or. igcm_n2d == 0) then
    444             write(*,*)'inichim_newstart error:'
    445             write(*,*)'if NO is in traceur.def, N, NO2 and N2D must also be'
    446             write(*,*)'stop'
    447             stop
    448          endif
    449          flagnitro = .true.
    450          nspe = 18
    451102      endif
    452103
    453 ! 1.8 allocate arrays
    454 
    455       allocate(niq(nspe))
    456       allocate(vmrinit(nalt,nspe))
    457       allocate(vmrint(nspe))
    458 
    459 ! 2. load in chemistry data for initialization:
    460 
    461 ! order of major species in initialization file:
    462 !
    463 !    1: co2
    464 !    2: ar
    465 !    3: n2 
    466 !    4: o2 
    467 !    5: co 
    468 !    6: o   
    469 !    7: h2
    470 !
    471 ! order of minor species in initialization file:
    472 !
    473 !    1: h 
    474 !    2: oh
    475 !    3: ho2
    476 !    4: h2o
    477 !    5: h2o2
    478 !    6: o1d
    479 !    7: o3
    480 !
    481 ! order of nitrogen species in initialization file:
    482 !
    483 !    1: n
    484 !    2: no
    485 !    3: no2
    486 !    4: n2d
    487 
    488 ! major species:
    489 
    490       niq(1) = igcm_co2
    491       niq(2) = igcm_ar
    492       niq(3) = igcm_n2
    493       niq(4) = igcm_o2
    494       niq(5) = igcm_co
    495       niq(6) = igcm_o
    496       niq(7) = igcm_h2
    497 
    498 ! minor species:
    499 
    500       niq(8)  = igcm_h
    501       niq(9)  = igcm_oh
    502       niq(10) = igcm_ho2
    503       niq(11) = igcm_h2o_vap
    504       niq(12) = igcm_h2o2
    505       niq(13) = igcm_o1d
    506       niq(14) = igcm_o3
    507 
    508 ! nitrogen species:
    509 
    510       if (flagnitro) then
    511          niq(15) = igcm_n
    512          niq(16) = igcm_no
    513          niq(17) = igcm_no2
    514          niq(18) = igcm_n2d         
    515       end if
    516 
    517 
    518 
    519 
    520 ! carbon species:
    521 !      niq(18) = igcm_ch4
    522 !      niq(19) = igcm_ch3
    523 !      niq(20) = igcm_ch
    524 !      niq(21) = igcm_1ch2
    525 !      niq(22) = igcm_3ch2
    526 !      niq(23) = igcm_cho
    527 !      niq(24) = igcm_ch2o
    528 !      niq(25) = igcm_ch3o
    529 !      niq(26) = igcm_c
    530 !      niq(27) = igcm_c2
    531 !      niq(28) = igcm_c2h
    532 !      niq(29) = igcm_c2h2
    533 !      niq(30) = igcm_c2h3
    534 !      niq(31) = igcm_c2h4
    535 !      niq(32) = igcm_c2h6
    536 !      niq(33) = igcm_ch2co
    537 !      niq(34) = igcm_ch3co
    538 !      niq(35) = igcm_hcaer
    539 
    540 
    541 ! 2.1 open initialization files
    542       open(210, iostat=ierr,file=trim(datadir)//'/atmosfera_LMD_may.dat')
    543       if (ierr /= 0) then
    544          write(*,*)'Error : cannot open file atmosfera_LMD_may.dat '
    545          write(*,*)'(in aeronomars/inichim_newstart.F)'
    546          write(*,*)'It should be in :', trim(datadir),'/'
    547          write(*,*)'1) You can change this path in callphys.def with'
    548          write(*,*)'   datadir=/path/to/datafiles/'
    549          write(*,*)'2) If necessary atmosfera_LMD_may.dat (and others)'
    550          write(*,*)'   can be obtained online on:'
    551          write(*,*)' http://www.lmd.jussieu.fr/~lmdz/planets/mars/datadir'
     104      ! Get data of tracers
     105      do iq=1,nq
     106         read(90,'(A)') tracline
     107         write(*,*)"inichim_newstart: iq=",iq,"noms(iq)=",trim(noms(iq))
     108         if (index(tracline,'qx='    ) /= 0) then
     109            read(tracline(index(tracline,'qx=')+len('qx='):),*) qx(iq)
     110            write(*,*) ' Parameter value (traceur.def) : qx=', qx(iq)
     111         else
     112            write(*,*) ' Parameter value (default)     : qx=', qx(iq)
     113         end if
     114         if (index(tracline,'qxf='    ) /= 0) then
     115            read(tracline(index(tracline,'qxf=')+len('qxf='):),*) qxf(iq)
     116            write(*,*) ' Parameter value (traceur.def) : qxf=', qxf(iq)
     117         else
     118            write(*,*) ' Parameter value (default)     : qxf=', qxf(iq)
     119         end if
     120      end do
     121
     122      close(90)
     123
     124! 3. initialization of tracers
     125
     126! 3.1 vertical interpolation
     127
     128      do iq=1,nq
     129         if (qx(iq) /= 0.) then
     130            pqx(:,:,:,iq) = qx(iq)
     131         else if (qxf(iq) /= 'None') then
     132            ! Opening file
     133            fil = trim(datadir)//'/chemical_profiles/'//qxf(iq)
     134            print*, 'chemical pofile '//trim(noms(iq))//': ', fil
     135            open(UNIT=90,FILE=fil,STATUS='old',iostat=ierr)
     136            if (ierr.eq.0) then
     137               read(90,*) ! read one header line
     138               do         ! get number of lines
     139                   read(90,*,iostat=ierr)
     140                   if (ierr<0) exit
     141                   nlines = nlines + 1
     142               end do
     143               ! allocate reading variable
     144               allocate(pf(nlines))
     145               allocate(qf(nlines))
     146               ! read file
     147               rewind(90) ! restart from the beggining of the file
     148               read(90,*) ! read one header line
     149               do iline=1,nlines
     150                  read(90,*) pf(iline), qf(iline) ! pf [Pa], qf [vmr]
     151               end do
     152               ! interp in gcm grid
     153               do ilon = 1,nbp_lon+1
     154                  do ilat = 1,nbp_lat
     155                     do ilay=1,nbp_lev
     156                        pgcm = aps(ilay) + bps(ilay)*ps(ilon,ilat)  ! gcm pressure
     157                        call intrplf(log(pgcm),pqx(ilon,ilat,ilay,iq),log(pf),qf,nlines)
     158                     end do
     159                  end do
     160               end do
     161               ! deallocate for next tracer
     162               deallocate(pf)
     163               deallocate(qf)
     164            else
     165               write(*,*) 'inichim_newstart: error opening ', fil
     166               stop
     167            endif
     168            close(90)
     169         end if
     170      end do
     171
     172! 3.2 background gas
     173
     174      do iq=1,nq
     175         if (qx(iq)==1.) then
     176            pqx(:,:,:,iq) = 0.
     177            do ilon = 1,nbp_lon+1
     178               do ilat = 1,nbp_lat
     179                  do ilay=1,nbp_lev
     180                     pqx(ilon,ilat,ilay,iq) = 1-sum(pqx(ilon,ilat,ilay,:))
     181                     if (pqx(ilon,ilat,ilay,iq)<=0.) then
     182                        write(*,*) 'inichim_newstart: vmr tot > 1 not possible'
     183                        stop
     184                     end if
     185                  end do
     186               end do
     187            end do
     188            foundback = .true.
     189            exit ! you found the background gas you can skip others
     190         end if
     191      end do
     192      if (.not.foundback) then
     193         write(*,*) 'inichim_newstart: you need to set a background gas'
     194         write(*,*) '            by qx=1. in traceur.def'
    552195         stop
    553196      end if
    554       open(220, iostat=ierr,file=trim(datadir)//'/atmosfera_LMD_min.dat')
    555       if (ierr /= 0) then
    556          write(*,*)'Error : cannot open file atmosfera_LMD_min.dat '
    557          write(*,*)'(in aeronomars/inichim_newstart.F)'
    558          write(*,*)'It should be in :', trim(datadir),'/'
    559          write(*,*)'1) You can change this path in callphys.def with'
    560          write(*,*)'   datadir=/path/to/datafiles/'
    561          write(*,*)'2) If necessary atmosfera_LMD_min.dat (and others)'
    562          write(*,*)'   can be obtained online on:'
    563          write(*,*)' http://www.lmd.jussieu.fr/~lmdz/planets/mars/datadir'
    564          stop
    565       end if
    566       if(flagnitro) then
    567          open(230, iostat=ierr,file=trim(datadir)//'/atmosfera_LMD_nitr.dat')
    568          if (ierr.ne.0) then
    569             write(*,*)'Error : cannot open file atmosfera_LMD_nitr.dat '
    570             write(*,*)'(in aeronomars/inichim_newstart.F)'
    571             write(*,*)'It should be in :', datadir
    572             write(*,*)'1) You can change this directory address in '
    573             write(*,*)'   file phymars/datafile.h'
    574             write(*,*)'2) If necessary atmosfera_LMD_nitr.dat (and others)'
    575             write(*,*)'   can be obtained online on:'
    576             write(*,*)' http://www.lmd.jussieu.fr/~lmdz/planets/mars/datadir'
    577             STOP
    578          endif
    579       endif   ! Of if(flagnitro)
    580 
    581 ! 2.2 read initialization files
    582 
    583 ! major species
    584 
    585       read(210,*)
    586       do l = 1,nalt
    587          read(210,*) dummy, tinit(l), pinit(l), densinit(l), &
    588                      (vmrinit(l,n), n = 1,7)
    589          pinit(l) = pinit(l)*100.              ! conversion in Pa
    590          pinit(l) = log(pinit(l))              ! for the vertical interpolation
    591       end do
    592       close(210)
    593 
    594 ! minor species
    595 
    596       read(220,*)
    597       do l = 1,nalt
    598          read(220,*) dummy, (vmrinit(l,n), n = 8,14)
    599       end do
    600       close(220)
    601 
    602 ! nitrogen species
    603 
    604       if (flagnitro) then
    605          read(230,*)
    606          do l = 1,nalt
    607             read(230,*) dummy, (vmrinit(l,n), n = 15,18)
    608          end do
    609          close(230)
    610       end if
    611 
    612 ! initialization for the early eath
    613       if (1.eq.0) then
    614         do l = 1,nalt
    615          vmrinit(l,:)=0.0
    616          vmrinit(l,1)=0.01 !co2
    617          vmrinit(l,2)=0.989 !n2
    618 !         vmrinit(l,3)=2.e-17/mmol(niq(3))*28 !o2
    619 !         vmrinit(l,4)=3.8e-6/mmol(niq(4))*28  !co
    620 !         vmrinit(l,5)=4.e-14/mmol(niq(5))*28  !o
    621 !         vmrinit(l,6)=1.3e-7/mmol(niq(6))*28  !h2
    622          vmrinit(l,6)=1e-3
    623 !         vmrinit(l,7)=5.e-16/mmol(niq(7))*28 !h
    624 !         vmrinit(l,8)=2.e-17/mmol(niq(8))*28 !oh
    625 !         vmrinit(l,9)=1.e-17/mmol(niq(9))*28 !ho2
    626          vmrinit(l,10)=1e-6 !h2o
    627 !         vmrinit(l,11)=2.e-20/mmol(niq(11))*28 !h2o2
    628 !         vmrinit(l,12)=0. !o1d
    629 !         vmrinit(l,13)=3.e-22/mmol(niq(13))*28 !o3
    630 
    631 
    632          vmrinit(l,18)=1.0e-3 !ch4
    633 !         vmrinit(l,19)=1.3e-12/mmol(niq(19))*28 !ch3
    634 !         vmrinit(l,23)=1.e-12/mmol(niq(23))*28 !cho
    635 !         vmrinit(l,24)=2.7e-11/mmol(niq(24))*28 !ch2o
    636 !         vmrinit(l,25)=2.e-9/mmol(niq(25))*28 !ch3o
    637 !         vmrinit(l,32)=2.e-7/mmol(niq(32))*28 !c2h6
    638 !         vmrinit(l,33)=5.e-12/mmol(niq(33))*28 !ch2co
    639 !         vmrinit(l,34)=1.e-13/mmol(niq(34))*28 !ch3co
    640 
    641 
    642 
    643 !         pinit(l)=aps(l) + bps(l)*ps
    644 !         vmrinit(l,18)=2e-3*min(pinit(l)/100.,1.) ! decrease with scale
    645 !         height above 1 hpa
    646          vmrinit(l,2)=0.0
    647          vmrinit(l,2)=1-sum(vmrinit(l,:)) !n2
    648 !         vmrinit(l,4)=0.1
    649 !         vmrinit(l,7)=0.001
    650         end do
    651       endif
    652 
    653      
    654 ! 3. initialization of tracers
    655 
    656       do i = 1,nbp_lon+1
    657          do j = 1,nbp_lat
    658             do l = 1,nbp_lev
    659 
    660                pgcm = aps(l) + bps(l)*ps(i,j)  ! gcm pressure
    661                pgcm = log(pgcm)                ! for the vertical interpolation
    662                mmean(i,j,l) = 0.
    663 
    664 ! 3.1 vertical interpolation
    665 
    666                do n = 1,nspe
    667                   call intrplf(pgcm,vmr,pinit,vmrinit(:,n),nalt)
    668                   vmrint(n) = vmr
    669 !                  vmrint(n) = vmrinit(l,n)
    670                   iq = niq(n)
    671                   mmean(i,j,l) = mmean(i,j,l) + vmrint(n)*mmol(iq)
    672                end do
    673 
    674 ! 3.2 attribute mixing ratio: - all layers or only thermosphere
    675 !                             - with our without h2o
    676 
    677 
    678 
    679                if (flagthermo == 0 .or. (flagthermo == 1 .and. exp(pgcm) < 0.1)) then
    680                   do n = 1,nspe
    681                      iq = niq(n)
    682                      if (iq /= igcm_h2o_vap .or. flagh2o == 1) then
    683                         pq(i,j,l,iq) = vmrint(n)*mmol(iq)/mmean(i,j,l)
    684                      end if
    685                   end do
    686                end if
    687 
     197
     198! 3.3 convert vmr to mmr
     199
     200      do ilon = 1,nbp_lon+1
     201         do ilat = 1,nbp_lat
     202            mmean(:) = 0.
     203            do ilay=1,nbp_lev
     204               do iq=1,nq
     205                  mmean(ilay) = mmean(ilay) + pqx(ilon,ilat,ilay,iq)*mmol(iq)
     206               end do
     207               do iq=1,nq
     208                  pq(ilon,ilat,ilay,iq) = pqx(ilon,ilat,ilay,iq)*mmol(iq)/mmean(ilay)
     209               end do
    688210            end do
    689211         end do
    690212      end do
    691213
    692 ! set surface values of chemistry tracers to zero
    693 
    694 
    695       if (flagthermo == 0) then
    696          ! NB: no problem for "surface water vapour" tracer which is always 0
    697          do n = 1,nspe
    698             iq = niq(n)
    699             qsurf(1:ngrid,iq) = 0.
    700          end do
    701       end if
    702 
    703 ! 3.3 initialization of tracers not contained in the initialization files
    704 
    705 ! methane : 10 ppbv
    706 
    707 !      if (igcm_ch4 /= 0) then
    708 !         vmr = 10.e-9       
    709 !         do i = 1,nbp_lon+1
    710 !            do j = 1,nbp_lat
    711 !               do l = 1,nbp_lev
    712 !                  pq(i,j,l,igcm_ch4) = vmr*mmol(igcm_ch4)/mmean(i,j,l)
    713 !               end do
    714 !            end do
    715 !         end do
    716 !         ! set surface value to zero
    717 !         qsurf(1:ngrid,igcm_ch4) = 0.
    718 !      end if
    719 
    720 ! ions: 0
    721 
    722      
    723       ! deallocations
    724 
    725       deallocate(niq)
    726       deallocate(vmrinit)
    727       deallocate(vmrint)
     214! 4. Hard coding
     215! Do whatever you want here to specify pq and qsurf
     216! Or use #ModernTrac-v1 and add another option section 2.
    728217
    729218      end
  • trunk/LMDZ.GENERIC/libf/phystd/callkeys_mod.F90

    r2520 r2542  
    2929!$OMP THREADPRIVATE(newtonian,check_cpp_match,force_cpp,testradtimes,rayleigh)
    3030      logical,save :: stelbbody
    31       logical,save :: ozone
    3231      logical,save :: nearco2cond
    3332      logical,save :: tracer
    3433      logical,save :: mass_redistrib
    35 !$OMP THREADPRIVATE(stelbbody,ozone,nearco2cond,tracer,mass_redistrib)
     34!$OMP THREADPRIVATE(stelbbody,nearco2cond,tracer,mass_redistrib)
    3635      logical,save :: varactive
    3736      logical,save :: varfixed
     
    5958!$OMP THREADPRIVATE(ok_slab_ocean,ok_slab_sic,ok_slab_heat_transp,albedo_spectral_mode)
    6059      logical,save :: photochem
     60      logical,save :: photoheat
     61      logical,save :: jonline
     62      logical,save :: depos
    6163      logical,save :: haze
    62 !$OMP THREADPRIVATE(photochem)
     64!$OMP THREADPRIVATE(photochem,photoheat,jonline,depos)
    6365      logical,save :: calllott_nonoro
    6466      logical,save :: gwd_convective_source
  • trunk/LMDZ.GENERIC/libf/phystd/dyn1d/inichim_1D.F90

    r1882 r2542  
    1       subroutine inichim_1D(nq, pq, qsurf, ps, &
     1      subroutine inichim_1D(nlayer, nq, pq, qsurf, play, &
    22                                  flagh2o,flagthermo)
    33
    4       use tracer_h
    5       USE comvert_mod, ONLY: aps,bps
    6       USE mod_grid_phy_lmdz, ONLY: nbp_lev
    7       use callkeys_mod
    8       use datafile_mod
     4      use tracer_h, only: noms, mmol
     5      use datafile_mod, only: datadir
    96
    107      implicit none
     
    2623!  Modified 11/2011 Addition of methane Franck Lefevre
    2724!  Rewritten 04/2012 Franck Lefevre
     25!  Rewritten 03/2021 Yassin Jaziri (Use of #Moderntrac-v1 to init thanks traceur.def)
    2826!
    2927!  Arguments:
    3028!  ----------
    3129!
    32 !  pq(nbp_lon+1,nbp_lat,nbp_lev,nq)  Advected fields, ie chemical species here
    33 !  qsurf(ngrid,nq)     Amount of tracer on the surface (kg/m2)
    34 !  ps(nbp_lon+1,nbp_lat)           Surface pressure (Pa)
    35 !  flagh2o                 flag for initialisation of h2o (1: yes / 0: no)
    36 !  flagthermo              flag for initialisation of thermosphere only (1: yes / 0: no)
     30!  nlayer          Number of atmospheric layers
     31!  pq(nlayer,nq)   Advected fields, ie chemical species here
     32!  qsurf(nq)       Amount of tracer on the surface (kg/m2)
     33!  play(nlayer)    Pressure (Pa)
     34!  flagh2o         flag for initialisation of h2o (1: yes / 0: no)
     35!  flagthermo      flag for initialisation of thermosphere only (1: yes / 0: no)
    3736!
    3837!=======================================================================
     
    4140! inputs :
    4241
    43       integer,intent(in) :: nq                    ! number of tracers
    44       real,intent(in) :: ps            ! surface pressure in the gcm (Pa)   
    45       integer,intent(in) :: flagh2o               ! flag for h2o initialisation
    46       integer,intent(in) :: flagthermo            ! flag for thermosphere initialisation only
     42      integer,intent(in) :: nlayer         ! Number of atmospheric layers.
     43      integer,intent(in) :: nq             ! number of tracers
     44      real   ,intent(in) :: play(nlayer)   ! Mid-layer pressure (Pa). 
     45      integer,intent(in) :: flagh2o        ! flag for h2o initialisation
     46      integer,intent(in) :: flagthermo     ! flag for thermosphere initialisation only
    4747
    4848! outputs :
    4949
    50       real,intent(out) :: pq(nbp_lev,nq)  ! advected fields, ie chemical species
    51       real,intent(out) :: qsurf(nq)     ! surface values (kg/m2) of tracers
     50      real,intent(out)   :: pq(nlayer,nq)  ! tracers (kg/kg_of_air)
     51      real,intent(out)   :: qsurf(nq)      ! surface values (kg/m2) of tracers
    5252
    5353! local :
    5454
    55       integer :: iq, l, n, nbqchem
    56       integer :: count, ierr, dummy
    57       real    :: mmean(nbp_lev)             ! mean molecular mass (g)
    58       real    :: pgcm                             ! pressure at each layer in the gcm (Pa)
    59 
    60       integer, parameter         :: nalt = 252    ! number of altitudes in the initialization files
    61       integer                    :: nspe          ! number of species in the initialization files
    62       integer, allocatable       :: niq(:)        ! local index of species in initialization files
    63       real, dimension(nalt)      :: tinit, zzfile ! temperature in initialization files
    64       real, dimension(nalt)      :: pinit         ! pressure in initialization files
    65       real, dimension(nalt)      :: densinit      ! total number density in initialization files
    66       real, allocatable          :: vmrinit(:,:)  ! mixing ratios in initialization files
    67       real, allocatable          :: vmrint(:)     ! mixing ratio interpolated onto the gcm vertical grid
    68       real                       :: vmr
    69 
    70       character(len=20)          :: txt           ! to store some text
    71       logical                    :: flagnitro     ! checks if N species present
    72 
    73 ! 1. identify tracers by their names: (and set corresponding values of mmol)
    74 
    75 ! 1.1 initialize tracer indexes to zero:
    76 !      nqmx=nq ! initialize value of nqmx
    77 
    78 !      do iq = 1,nq
    79 !        igcm_dustbin(iq) = 0
    80 !      end do
    81 
    82 !      igcm_dust_mass   = 0
    83 !      igcm_dust_number = 0
    84 !      igcm_ccn_mass    = 0
    85 !      igcm_ccn_number  = 0
    86       igcm_h2o_vap     = 0
    87       igcm_h2o_ice     = 0
    88       igcm_co2         = 0
    89       igcm_co          = 0
    90       igcm_o           = 0
    91       igcm_o1d         = 0
    92       igcm_o2          = 0
    93       igcm_o3          = 0
    94       igcm_h           = 0
    95       igcm_h2          = 0
    96       igcm_oh          = 0
    97       igcm_ho2         = 0
    98       igcm_h2o2        = 0
    99       igcm_ch4         = 0
    100       igcm_n2          = 0
    101       igcm_n           = 0
    102       igcm_n2d         = 0
    103       igcm_no          = 0
    104       igcm_no2         = 0
    105       igcm_ar          = 0
    106       igcm_ar_n2       = 0
    107       igcm_ch3         = 0
    108       igcm_ch          = 0
    109       igcm_3ch2        = 0
    110       igcm_1ch2        = 0
    111       igcm_cho         = 0
    112       igcm_ch2o        = 0
    113       igcm_c           = 0
    114       igcm_c2          = 0
    115       igcm_c2h         = 0
    116       igcm_c2h2        = 0
    117       igcm_c2h3        = 0
    118       igcm_c2h4        = 0
    119       igcm_c2h6        = 0
    120       igcm_ch2co       = 0
    121       igcm_ch3co       = 0
    122       igcm_hcaer       = 0
    123 
    124 ! 1.2 find dust tracers
    125       count = 0
    126 !
    127 !      if (dustbin > 0) then
    128 !         do iq = 1,nq
    129 !            txt = " "
    130 !            write(txt,'(a4,i2.2)') 'dust', count + 1
    131 !            if (noms(iq) == txt) then
    132 !               count = count + 1
    133 !               igcm_dustbin(count) = iq
    134 !               mmol(iq) = 100.
    135 !            end if
    136 !         end do !do iq=1,nq
    137 !      end if ! of if (dustbin.gt.0)
    138 !
    139 !      if (doubleq) then
    140 !         do iq = 1,nq
    141 !            if (noms(iq) == "dust_mass") then
    142 !               igcm_dust_mass = iq
    143 !               count = count + 1
    144 !            end if
    145 !            if (noms(iq) == "dust_number") then
    146 !               igcm_dust_number = iq
    147 !               count = count + 1
    148 !            end if
    149 !         end do
    150 !      end if ! of if (doubleq)
    151 !
    152 !      if (scavenging) then
    153 !         do iq = 1,nq
    154 !            if (noms(iq) == "ccn_mass") then
    155 !               igcm_ccn_mass = iq
    156 !               count = count + 1
    157 !            end if
    158 !            if (noms(iq) == "ccn_number") then
    159 !               igcm_ccn_number = iq
    160 !               count = count + 1
    161 !            end if
    162 !         end do
    163 !      end if ! of if (scavenging)
    164 !
    165 !      if (submicron) then
    166 !         do iq=1,nq
    167 !            if (noms(iq) == "dust_submicron") then
    168 !               igcm_dust_submicron = iq
    169 !               mmol(iq) = 100.
    170 !               count = count + 1
    171 !            end if
    172 !         end do
    173 !      end if ! of if (submicron)
    174 
    175 ! 1.3 find chemistry and water tracers
    176 
    177       nbqchem = 0
    178 
    179       do iq = 1,nq
    180          if (noms(iq) == "co2") then
    181             igcm_co2 = iq
    182             mmol(igcm_co2) = 44.
    183             count = count + 1
    184             nbqchem = nbqchem + 1
    185         end if
    186         if (noms(iq) == "co") then
    187            igcm_co = iq
    188            mmol(igcm_co) = 28.
    189            count = count + 1
    190            nbqchem = nbqchem + 1
    191         end if
    192         if (noms(iq) == "o") then
    193            igcm_o = iq
    194            mmol(igcm_o) = 16.
    195            count = count + 1
    196            nbqchem = nbqchem + 1
    197         end if
    198         if (noms(iq) == "o1d") then
    199            igcm_o1d = iq
    200            mmol(igcm_o1d) = 16.
    201            count = count + 1
    202            nbqchem = nbqchem + 1
    203         end if
    204         if (noms(iq) == "o2") then
    205            igcm_o2 = iq
    206            mmol(igcm_o2) = 32.
    207            count = count + 1
    208            nbqchem = nbqchem + 1
    209         end if
    210         if (noms(iq) == "o3") then
    211            igcm_o3 = iq
    212            mmol(igcm_o3) = 48.
    213            count = count + 1
    214            nbqchem = nbqchem + 1
    215         end if
    216         if (noms(iq) == "h") then
    217            igcm_h = iq
    218            mmol(igcm_h) = 1.
    219            count = count + 1
    220            nbqchem = nbqchem + 1
    221         end if
    222         if (noms(iq) == "h2") then
    223            igcm_h2 = iq
    224            mmol(igcm_h2) = 2.
    225            count = count + 1
    226            nbqchem = nbqchem + 1
    227         end if
    228         if (noms(iq) == "oh") then
    229            igcm_oh = iq
    230            mmol(igcm_oh) = 17.
    231            count = count + 1
    232            nbqchem = nbqchem + 1
    233         end if
    234         if (noms(iq) == "ho2") then
    235            igcm_ho2 = iq
    236            mmol(igcm_ho2) = 33.
    237            count = count + 1
    238            nbqchem = nbqchem + 1
    239         end if
    240         if (noms(iq) == "h2o2") then
    241            igcm_h2o2 = iq
    242            mmol(igcm_h2o2) = 34.
    243            count = count + 1
    244            nbqchem = nbqchem + 1
    245         end if
    246         if (noms(iq) == "n2") then
    247            igcm_n2 = iq
    248            mmol(igcm_n2) = 28.
    249            count = count + 1
    250            nbqchem = nbqchem + 1
    251         end if
    252         if (noms(iq) == "ch4") then
    253            igcm_ch4 = iq
    254            mmol(igcm_ch4) = 16.
    255            count = count + 1
    256            nbqchem = nbqchem + 1
    257         end if
    258         if (noms(iq) == "ar") then
    259            igcm_ar = iq
    260            mmol(igcm_ar) = 40.
    261            count = count + 1
    262            nbqchem = nbqchem + 1
    263         end if
    264         if (noms(iq) == "n") then
    265            igcm_n = iq
    266            mmol(igcm_n) = 14.
    267            count = count + 1
    268            nbqchem = nbqchem + 1
    269         end if
    270         if (noms(iq) == "n2d") then
    271            igcm_n2d = iq
    272            mmol(igcm_n2d) = 14.
    273            count = count + 1
    274            nbqchem = nbqchem + 1
    275         end if
    276         if (noms(iq) == "no") then
    277            igcm_no = iq
    278            mmol(igcm_no) = 30.
    279            count = count + 1
    280            nbqchem = nbqchem + 1
    281         end if
    282         if (noms(iq) == "no2") then
    283            igcm_no2 = iq
    284            mmol(igcm_no2) = 46.
    285            count = count + 1
    286            nbqchem = nbqchem + 1
    287         end if
    288 
    289         if (noms(iq) == "h2o_vap") then
    290            igcm_h2o_vap = iq
    291            mmol(igcm_h2o_vap) = 18.
    292            count = count + 1
    293            nbqchem = nbqchem + 1
    294         end if
    295         if (noms(iq) == "h2o_ice") then
    296            igcm_h2o_ice = iq
    297            mmol(igcm_h2o_ice) = 18.
    298            count = count + 1
    299            nbqchem = nbqchem + 1
    300         end if
    301 
    302 
    303         if (noms(iq).eq."ch3") then
    304           igcm_ch3=iq
    305           mmol(igcm_ch3)=15.
    306           count=count+1
    307            nbqchem = nbqchem + 1
    308         endif
    309         if (noms(iq).eq."ch") then
    310           igcm_ch=iq
    311           mmol(igcm_ch)=13.
    312           count=count+1
    313            nbqchem = nbqchem + 1
    314         endif
    315         if (noms(iq).eq."3ch2") then
    316           igcm_3ch2=iq
    317           mmol(igcm_3ch2)=14.
    318           count=count+1
    319            nbqchem = nbqchem + 1
    320         endif
    321         if (noms(iq).eq."1ch2") then
    322           igcm_1ch2=iq
    323           mmol(igcm_1ch2)=14.
    324           count=count+1
    325            nbqchem = nbqchem + 1
    326         endif
    327         if (noms(iq).eq."cho") then
    328           igcm_cho=iq
    329           mmol(igcm_cho)=29.
    330           count=count+1
    331            nbqchem = nbqchem + 1
    332         endif
    333         if (noms(iq).eq."ch2o") then
    334           igcm_ch2o=iq
    335           mmol(igcm_ch2o)=30.
    336           count=count+1
    337            nbqchem = nbqchem + 1
    338         endif
    339         if (noms(iq).eq."ch3o") then
    340           igcm_ch3o=iq
    341           mmol(igcm_ch3o)=31.
    342           count=count+1
    343            nbqchem = nbqchem + 1
    344         endif
    345         if (noms(iq).eq."c") then
    346           igcm_c=iq
    347           mmol(igcm_c)=12.
    348           count=count+1
    349            nbqchem = nbqchem + 1
    350         endif
    351         if (noms(iq).eq."c2") then
    352           igcm_c2=iq
    353           mmol(igcm_c2)=24.
    354           count=count+1
    355            nbqchem = nbqchem + 1
    356         endif
    357         if (noms(iq).eq."c2h") then
    358           igcm_c2h=iq
    359           mmol(igcm_c2h)=25.
    360           count=count+1
    361            nbqchem = nbqchem + 1
    362         endif
    363         if (noms(iq).eq."c2h2") then
    364           igcm_c2h2=iq
    365           mmol(igcm_c2h2)=26.
    366           count=count+1
    367            nbqchem = nbqchem + 1
    368         endif
    369         if (noms(iq).eq."c2h3") then
    370           igcm_c2h3=iq
    371           mmol(igcm_c2h3)=27.
    372           count=count+1
    373            nbqchem = nbqchem + 1
    374         endif
    375         if (noms(iq).eq."c2h4") then
    376           igcm_c2h4=iq
    377           mmol(igcm_c2h4)=28.
    378           count=count+1
    379            nbqchem = nbqchem + 1
    380         endif
    381         if (noms(iq).eq."c2h6") then
    382           igcm_c2h6=iq
    383           mmol(igcm_c2h6)=30.
    384           count=count+1
    385            nbqchem = nbqchem + 1
    386         endif
    387         if (noms(iq).eq."ch2co") then
    388           igcm_ch2co=iq
    389           mmol(igcm_ch2co)=42.
    390           count=count+1
    391            nbqchem = nbqchem + 1
    392         endif
    393         if (noms(iq).eq."ch3co") then
    394           igcm_ch3co=iq
    395           mmol(igcm_ch3co)=43.
    396           count=count+1
    397            nbqchem = nbqchem + 1
    398         endif
    399         if (noms(iq).eq."hcaer") then
    400           igcm_hcaer=iq
    401           mmol(igcm_hcaer)=50.
    402           count=count+1
    403            nbqchem = nbqchem + 1
    404         endif
    405 
    406 
    407 
    408 
    409 ! 1.5 find idealized non-condensible tracer
    410 
    411         if (noms(iq) == "Ar_N2") then
    412            igcm_ar_n2 = iq
    413            mmol(igcm_ar_n2) = 30.
    414            count = count + 1
    415         end if
    416 
    417       end do ! of do iq=1,nq
    418      
    419  
    420 ! 1.6 check that we identified all tracers:
    421 
    422       if (count /= nq) then
    423          write(*,*) "inichim_1D: found only ",count," tracers"
    424          write(*,*) "                  expected ",nq
    425          do iq = 1,count
    426             write(*,*) '      ', iq, ' ', trim(noms(iq))
    427          end do
     55      real, allocatable  :: pf(:)          ! pressure in vmr profile files set in traceur.def
     56      real, allocatable  :: qf(:)          ! vmr      in vmr profile files set in traceur.def
     57
     58      real    :: mmean(nlayer)             ! mean molecular mass (g)
     59      real    :: pqx(nlayer,nq)            ! tracers (vmr)
     60      real    :: qx(nq)                    ! constant vmr set in traceur.def
     61      integer :: iq, ilay, iline, nlines, ierr
     62
     63      CHARACTER(len=100) :: qxf(nq)        ! vmr profile files set in traceur.def
     64      CHARACTER(len=100) :: fil            ! path files
     65      character(len=500) :: tracline       ! to store a line of text
     66
     67      logical :: foundback = .false.
     68
     69! 1. initialization
     70
     71      pq(:,:)  = 0.
     72      qsurf(:) = 0.
     73      pqx(:,:) = 0.
     74      qx(:)    = 0.
     75      qxf(:)   = 'None'
     76
     77! 2. load in traceur.def chemistry data for initialization:
     78
     79      ! Skip nq
     80      open(90,file='traceur.def',status='old',form='formatted',iostat=ierr)
     81      if (ierr.eq.0) then
     82        READ(90,'(A)') tracline
     83        IF (trim(tracline).eq.'#ModernTrac-v1') THEN ! Test modern traceur.def
     84           DO
     85             READ(90,'(A)',iostat=ierr) tracline
     86             IF (ierr.eq.0) THEN
     87               IF (index(tracline,'#').ne.1) THEN ! Allows arbitary number of comments lines in the header
     88                 EXIT
     89               ENDIF
     90             ELSE ! If pb, or if reached EOF without having found number of tracer
     91                write(*,*) "calchim: error reading line of tracers"
     92                write(*,*) "   (first lines of traceur.def) "
     93                stop
     94             ENDIF
     95           ENDDO
     96        ENDIF ! if modern or standard traceur.def
     97      else
     98         write(*,*) "calchim: error opening traceur.def in inichim_1D"
    42899         stop
    429       else
    430          write(*,*) "inichim_1D: found all expected tracers"
    431          do iq = 1,nq
    432             write(*,*) '      ', iq, ' ', trim(noms(iq))
    433          end do
    434       end if
    435 
    436 ! 1.7 check if nitrogen species are present:
    437 
    438       if(igcm_no == 0) then
    439          !check that no N species is in traceur.def
    440          if(igcm_n /= 0 .or. igcm_no2 /= 0 .or. igcm_n2d /= 0) then
    441             write(*,*)'inichim_1D error:'
    442             write(*,*)'N, NO2 and/or N2D are in traceur.def, but not NO'
    443             write(*,*)'stop'
    444             stop
    445          endif
    446          flagnitro = .false.
    447          nspe = 15
    448       else
    449          !check that all N species are in traceur.def
    450          if(igcm_n == 0 .or. igcm_no2 == 0 .or. igcm_n2d == 0) then
    451             write(*,*)'inichim_1D error:'
    452             write(*,*)'if NO is in traceur.def, N, NO2 and N2D must also be'
    453             write(*,*)'stop'
    454             stop
    455          endif
    456          flagnitro = .true.
    457          nspe = 18
    458100      endif
    459101
    460 ! 1.8 allocate arrays
    461 
    462       allocate(niq(nspe))
    463       allocate(vmrinit(nalt,nspe))
    464       allocate(vmrint(nspe))
    465 
    466 ! 2. load in chemistry data for initialization:
    467 
    468 ! order of major species in initialization file:
    469 !
    470 !    1: co2
    471 !    2: ar
    472 !    3: n2 
    473 !    4: o2 
    474 !    5: co 
    475 !    6: o   
    476 !    7: h2
    477 !
    478 ! order of minor species in initialization file:
    479 !
    480 !    1: h 
    481 !    2: oh
    482 !    3: ho2
    483 !    4: h2o
    484 !    5: h2o2
    485 !    6: o1d
    486 !    7: o3
    487 !
    488 ! order of nitrogen species in initialization file:
    489 !
    490 !    1: n
    491 !    2: no
    492 !    3: no2
    493 !    4: n2d
    494 
    495 ! major species:
    496 
    497       niq(1) = igcm_co2
    498       niq(2) = igcm_ar
    499       niq(3) = igcm_n2
    500       niq(4) = igcm_o2
    501       niq(5) = igcm_co
    502       niq(6) = igcm_o
    503       niq(7) = igcm_h2
    504 
    505 ! minor species:
    506 
    507       niq(8)  = igcm_h
    508       niq(9)  = igcm_oh
    509       niq(10) = igcm_ho2
    510       niq(11) = igcm_h2o_vap
    511       niq(12) = igcm_h2o2
    512       niq(13) = igcm_o1d
    513       niq(14) = igcm_o3
    514 
    515 ! nitrogen species:
    516 
    517       if (flagnitro) then
    518          niq(15) = igcm_n
    519          niq(16) = igcm_no
    520          niq(17) = igcm_no2
    521          niq(18) = igcm_n2d         
    522       end if
    523 
    524 ! carbon species:
    525 !      niq(18) = igcm_ch4
    526 !      niq(19) = igcm_ch3
    527 !      niq(20) = igcm_ch
    528 !      niq(21) = igcm_1ch2
    529 !      niq(22) = igcm_3ch2
    530 !      niq(23) = igcm_cho
    531 !      niq(24) = igcm_ch2o
    532 !      niq(25) = igcm_ch3o
    533 !      niq(26) = igcm_c
    534 !      niq(27) = igcm_c2
    535 !      niq(28) = igcm_c2h
    536 !      niq(29) = igcm_c2h2
    537 !      niq(30) = igcm_c2h3
    538 !      niq(31) = igcm_c2h4
    539 !      niq(32) = igcm_c2h6
    540 !      niq(33) = igcm_ch2co
    541 !      niq(34) = igcm_ch3co
    542 !      niq(35) = igcm_hcaer
    543 
    544 
    545 
    546 ! 2.1 open initialization files
    547       if(1.eq.1) then
    548       open(210, iostat=ierr,file=trim(datadir)//'/atmosfera_LMD_may.dat')
    549       if (ierr /= 0) then
    550          write(*,*)'Error : cannot open file atmosfera_LMD_may.dat '
    551          write(*,*)'(in aeronomars/inichim_1D.F)'
    552          write(*,*)'It should be in :', trim(datadir),'/'
    553          write(*,*)'1) You can change this path in callphys.def with'
    554          write(*,*)'   datadir=/path/to/datafiles/'
    555          write(*,*)'2) If necessary atmosfera_LMD_may.dat (and others)'
    556          write(*,*)'   can be obtained online on:'
    557          write(*,*)' http://www.lmd.jussieu.fr/~lmdz/planets/mars/datadir'
     102      ! Get data of tracers
     103      do iq=1,nq
     104         read(90,'(A)') tracline
     105         write(*,*)"inichim_1D: iq=",iq,"noms(iq)=",trim(noms(iq))
     106         if (index(tracline,'qx='    ) /= 0) then
     107            read(tracline(index(tracline,'qx=')+len('qx='):),*) qx(iq)
     108            write(*,*) ' Parameter value (traceur.def) : qx=', qx(iq)
     109         else
     110            write(*,*) ' Parameter value (default)     : qx=', qx(iq)
     111         end if
     112         if (index(tracline,'qxf='    ) /= 0) then
     113            read(tracline(index(tracline,'qxf=')+len('qxf='):),*) qxf(iq)
     114            write(*,*) ' Parameter value (traceur.def) : qxf=', qxf(iq)
     115         else
     116            write(*,*) ' Parameter value (default)     : qxf=', qxf(iq)
     117         end if
     118      end do
     119
     120      close(90)
     121
     122! 3. initialization of tracers
     123
     124! 3.1 vertical interpolation
     125
     126      do iq=1,nq
     127         if (qx(iq) /= 0.) then
     128            pqx(:,iq) = qx(iq)
     129         else if (qxf(iq) /= 'None') then
     130            ! Opening file
     131            fil = trim(datadir)//'/chemical_profiles/'//qxf(iq)
     132            print*, 'chemical pofile '//trim(noms(iq))//': ', fil
     133            open(UNIT=90,FILE=fil,STATUS='old',iostat=ierr)
     134            if (ierr.eq.0) then
     135               read(90,*) ! read one header line
     136               do         ! get number of lines
     137                   read(90,*,iostat=ierr)
     138                   if (ierr<0) exit
     139                   nlines = nlines + 1
     140               end do
     141               ! allocate reading variable
     142               allocate(pf(nlines))
     143               allocate(qf(nlines))
     144               ! read file
     145               rewind(90) ! restart from the beggining of the file
     146               read(90,*) ! read one header line
     147               do iline=1,nlines
     148                  read(90,*) pf(iline), qf(iline) ! pf [Pa], qf [vmr]
     149               end do
     150               ! interp in gcm grid
     151               do ilay=1,nlayer
     152                  call intrplf(log(play(ilay)),pqx(ilay,iq),log(pf),qf,nlines)
     153               end do
     154               ! deallocate for next tracer
     155               deallocate(pf)
     156               deallocate(qf)
     157            else
     158               write(*,*) 'inichim_1D: error opening ', fil
     159               stop
     160            endif
     161            close(90)
     162         end if
     163      end do
     164
     165! 3.2 background gas
     166
     167      do iq=1,nq
     168         if (all(pqx(:,iq)==1.)) then
     169            pqx(:,iq) = 0.
     170            do ilay=1,nlayer
     171               pqx(ilay,iq) = 1-sum(pqx(ilay,:))
     172               if (pqx(ilay,iq)<=0.) then
     173                  write(*,*) 'inichim_1D: vmr tot > 1 not possible'
     174                  stop
     175               end if
     176            end do
     177            foundback = .true.
     178            exit ! you found the background gas you can skip others
     179         end if
     180      end do
     181      if (.not.foundback) then
     182         write(*,*) 'inichim_1D: you need to set a background gas'
     183         write(*,*) '            by qx=1. in traceur.def'
    558184         stop
    559185      end if
    560       open(220, iostat=ierr,file=trim(datadir)//'/atmosfera_LMD_min.dat')
    561       if (ierr /= 0) then
    562          write(*,*)'Error : cannot open file atmosfera_LMD_min.dat '
    563          write(*,*)'(in aeronomars/inichim_1D.F)'
    564          write(*,*)'It should be in :', trim(datadir),'/'
    565          write(*,*)'1) You can change this path in callphys.def with'
    566          write(*,*)'   datadir=/path/to/datafiles/'
    567          write(*,*)'2) If necessary atmosfera_LMD_min.dat (and others)'
    568          write(*,*)'   can be obtained online on:'
    569          write(*,*)' http://www.lmd.jussieu.fr/~lmdz/planets/mars/datadir'
    570          stop
    571       end if
    572 
    573       print*,'flagnitro=',flagnitro
    574       if(flagnitro) then
    575          open(230, iostat=ierr,file=trim(datadir)//'/atmosfera_LMD_nitr.dat')
    576          if (ierr /= 0) then
    577             write(*,*)'Error : cannot open file atmosfera_LMD_nitr.dat '
    578             write(*,*)'(in aeronomars/inichim_1D.F)'
    579             write(*,*)'It should be in :', datadir
    580             write(*,*)'1) You can change this directory address in '
    581             write(*,*)'   file phymars/datafile.h'
    582             write(*,*)'2) If necessary atmosfera_LMD_nitr.dat (and others)'
    583             write(*,*)'   can be obtained online on:'
    584             write(*,*)' http://www.lmd.jussieu.fr/~lmdz/planets/mars/datadir'
    585             STOP
    586          endif
    587       endif   ! Of if(flagnitro)
    588 
    589 
    590 ! 2.2 read initialization files'
    591 
    592 ! major species
    593 
    594       read(210,*)
    595       do l = 1,nalt
    596          read(210,*) dummy, tinit(l), pinit(l), densinit(l), &
    597                      (vmrinit(l,n), n = 1,7)
    598          pinit(l) = pinit(l)*100.              ! conversion in Pa
    599          pinit(l) = log(pinit(l))              ! for the vertical interpolation
    600       end do
    601       close(210)
    602 
    603 ! minor species
    604 
    605       read(220,*)
    606       do l = 1,nalt
    607          read(220,*) dummy, (vmrinit(l,n), n = 8,14)
    608       end do
    609       close(220)
    610 
    611 ! nitrogen species
    612 
    613       if(flagnitro) then
    614          read(230,*)
    615          do l = 1,nalt
    616             read(230,*) dummy, (vmrinit(l,n), n = 15,18)
     186
     187! 3.3 mmean
     188      mmean(:) = 0.
     189      do ilay=1,nlayer
     190         do iq=1,nq
     191            mmean(ilay) = mmean(ilay) + pqx(ilay,iq)*mmol(iq)
    617192         end do
    618          close(230)
    619       endif
    620       endif !if(1.eq.0)
    621 
    622 
    623 ! initialization for the early eath
    624       if (1.eq.0) then
    625         do l = 1,nalt
    626          vmrinit(l,:)=0e-7
    627          vmrinit(l,1)=0.1 !co2
    628          vmrinit(l,2)=0.9 !n2
    629          vmrinit(l,3)=0.0 !o2
    630          vmrinit(l,6)=4e-3 !h2
    631          vmrinit(l,10)=1e-9 !h2o
    632          vmrinit(l,18)=0.0e-5 !ch4
    633          vmrinit(l,10:13)=0.0e-7 !n
    634          vmrinit(l,14)=0.0 !n
    635          vmrinit(l,15)=0.0 !no
    636          vmrinit(l,16)=0.0 !no2 
    637 !         pinit(l)=aps(l) + bps(l)*ps
    638 !        vmrinit(l,18)=2e-3*min(pinit(l)/100.,1.) ! decrease with scale height above 1 hpa
    639          vmrinit(l,2)=0.0
    640          vmrinit(l,2)=1-sum(vmrinit(l,:)) !n2
    641 !         vmrinit(l,4)=0.1
    642 !         vmrinit(l,7)=0.001
    643         end do
    644       endif
    645 
    646 
    647      
    648 ! 3. initialization of tracers
    649 
    650             do l = 1,nbp_lev
    651 
    652                pgcm = aps(l) + bps(l)*ps  ! gcm pressure               
    653                pgcm = log(pgcm)                ! for the vertical interpolation
    654                mmean(l) = 0.
    655                
    656 ! 3.1 vertical interpolation
    657                do n = 1,nspe
    658                   call intrplf(pgcm,vmr,pinit,vmrinit(:,n),nalt)
    659                   vmrint(n) = vmr
    660                   iq = niq(n)
    661                   mmean(l) = mmean(l) + vmrint(n)*mmol(iq)
    662 !                  mmean(l) = mmean(l) + vmrinit(1,n)*mmol(iq)
    663                end do
    664 
    665 ! 3.2 attribute mixing ratio: - all layers or only thermosphere
    666 !                             - with our without h2o
    667 
    668                if (flagthermo == 0 .or. (flagthermo == 1 .and. exp(pgcm) < 0.1)) then
    669                   do n = 1,nq
    670                     pq(l,iq) = 0.
    671                     qsurf(iq) = 0.
    672                   enddo
    673 
    674                   do n = 1,nspe
    675                      iq = niq(n)
    676 !                     if (iq /= igcm_h2o_vap .or. flagh2o == 1) then
    677                         pq(l,iq) = vmrint(n)*mmol(iq)/mmean(l)
    678 !                        pq(l,iq) = vmrinit(1,n)*mmol(iq)/mmean(1)
    679 !                     end if
    680                   end do
    681 !                     pq(l,igcm_ch4) = 2.e-3*min((aps(l) + bps(l)*ps)/100.,1.)*mmol(igcm_ch4)/mmean(l)
    682                end if
    683  
    684             end do
    685 
    686 
    687 ! set surface values of chemistry tracers to zero
    688 
    689       if (flagthermo == 0) then
    690          ! NB: no problem for "surface water vapour" tracer which is always 0
    691          do n = 1,nspe
    692             iq = niq(n)
    693             qsurf(iq) = 0.
     193      end do
     194
     195! 3.4 convert vmr to mmr
     196
     197      do ilay=1,nlayer
     198         do iq=1,nq
     199            pq(ilay,iq) = pqx(ilay,iq)*mmol(iq)/mmean(ilay)
    694200         end do
    695       end if
    696 
    697 ! 3.3 initialization of tracers not contained in the initialization files
    698 
    699 ! methane : 10 ppbv
    700 
    701 !      if (igcm_ch4 /= 0) then
    702 !         vmr = 10.e-9       
    703 !               do l = 1,nbp_lev
    704 !                  pq(l,igcm_ch4) = vmr*mmol(igcm_ch4)/mmean(l)
    705 !               end do
    706 !         ! set surface value to zero
    707 !         qsurf(igcm_ch4) = 0.
    708 !      end if
    709 
    710      
    711       ! deallocations
    712 
    713       deallocate(niq)
    714       deallocate(vmrinit)
    715       deallocate(vmrint)
     201      end do
     202
     203! 4. Hard coding
     204! Do whatever you want here to specify pq and qsurf
     205! Or use #ModernTrac-v1 and add another option section 2.
    716206
    717207      end
  • trunk/LMDZ.GENERIC/libf/phystd/dyn1d/rcm1d.F

    r2436 r2542  
    898898           allocate(nametmp(nq))
    899899           nametmp(1:nq)=tname(1:nq)
    900            call inichim_1D(nq, q, qsurf, psurf, 0, 0)
     900           call inichim_1D(nlayer, nq, q, qsurf, play, 0, 0)
    901901           tname(1:nq)=nametmp(1:nq)
    902902           noms(1:nq)=nametmp(1:nq)
  • trunk/LMDZ.GENERIC/libf/phystd/inifis_mod.F90

    r2520 r2542  
    422422     write(*,*) "photochem = ",photochem
    423423
     424     write(*,*) "Use photolysis heat table ?"
     425     photoheat=.false.         ! default value
     426     call getin_p("photoheat",photoheat)
     427     write(*,*) "photoheat = ",photoheat
     428
     429     write(*,*) "Use photolysis online calculation ?"
     430     jonline=.false.         ! default value
     431     call getin_p("jonline",jonline)
     432     write(*,*) "jonline = ",jonline
     433
     434     write(*,*) "Use deposition ?"
     435     depos=.false.         ! default value
     436     call getin_p("depos",depos)
     437     write(*,*) "depos = ",depos
     438
    424439     write(*,*)"Production of haze ?"
    425440     haze=.false. ! default value
  • trunk/LMDZ.GENERIC/libf/phystd/initracer.F

    r2436 r2542  
    6565               ! Temporary not implemented solution
    6666               if (nqtot/=nq) then
    67                  call abort_physic('initracer','Different number of&
    68      & tracers in dynamics and physics not managed yet',1)
     67                 call abort_physic('initracer','Different number of '//
     68     & 'tracers in dynamics and physics not managed yet',1)
    6969               endif
    7070               EXIT
    7171             ENDIF
    7272           ELSE ! If pb, or if reached EOF without having found nqtot
    73              call abort_physic('initracer','Unable to read numbers&
    74      & of tracers in traceur.def',1)
     73             call abort_physic('initracer','Unable to read numbers '//
     74     & 'of tracers in traceur.def',1)
    7575           ENDIF
    7676         ENDDO
     
    8383       IF (.NOT.ALLOCATED(noms))         ALLOCATE(noms(nq))
    8484       IF (.NOT.ALLOCATED(mmol))         ALLOCATE(mmol(nq))
     85       IF (.NOT.ALLOCATED(aki))          ALLOCATE(aki(nqtot))
     86       IF (.NOT.ALLOCATED(cpi))          ALLOCATE(cpi(nqtot))
    8587       IF (.NOT.ALLOCATED(radius))       ALLOCATE(radius(nq))
    8688       IF (.NOT.ALLOCATED(rho_q))        ALLOCATE(rho_q(nq))
     
    9092       IF (.NOT.ALLOCATED(qextrhor))     ALLOCATE(qextrhor(nq))
    9193       IF (.NOT.ALLOCATED(igcm_dustbin)) ALLOCATE(igcm_dustbin(nq))
     94       IF (.NOT.ALLOCATED(is_chim))      ALLOCATE(is_chim(nqtot))
    9295       !! initialization
    93        alpha_lift(:)=0.
    94        alpha_devil(:)=0.
     96       alpha_lift(:)  = 0.
     97       alpha_devil(:) = 0.
     98       mmol(:)        = 0.
     99       aki(:)         = 0.
     100       cpi(:)         = 0.
     101       is_chim(:)     = 0
    95102       
    96103       ! Added by JVO 2017 : these arrays are handled later
     
    382389      close(407)
    383390
     391      ! Calculate number of species in the chemistry
     392      nesp = sum(is_chim)
     393      write(*,*) 'Number of species in the chemistry nesp = ',nesp
     394
    384395c------------------------------------------------------------
    385396c     Initialisation tracers ....
     
    469480          ! JVO 20 : We should add a sanity check aborting when duplicates in names !
    470481          write(*,*)"initracer: iq=",iq,"noms(iq)=",trim(noms(iq))
     482          ! option mmol
    471483          if (index(tracline,'mmol='   ) /= 0) then
    472484              read(tracline(index(tracline,'mmol=')+len('mmol='):),*)
     
    478490     $             mmol(iq)
    479491          end if
     492          ! option aki
     493          if (index(tracline,'aki='   ) /= 0) then
     494              read(tracline(index(tracline,'aki=')+len('aki='):),*)
     495     $             aki(iq)
     496              write(*,*) ' Parameter value (traceur.def) : aki=',
     497     $             aki(iq)
     498          else
     499              write(*,*) ' Parameter value (default)     : aki=',
     500     $             aki(iq)
     501          end if
     502          ! option cpi
     503          if (index(tracline,'cpi='   ) /= 0) then
     504              read(tracline(index(tracline,'cpi=')+len('cpi='):),*)
     505     $             cpi(iq)
     506              write(*,*) ' Parameter value (traceur.def) : cpi=',
     507     $             cpi(iq)
     508          else
     509              write(*,*) ' Parameter value (default)     : cpi=',
     510     $             cpi(iq)
     511          end if
     512          ! option is_chim
     513          if (index(tracline,'is_chim='   ) /= 0) then
     514          read(tracline(index(tracline,'is_chim=')+len('is_chim='):),*)
     515     $             is_chim(iq)
     516              write(*,*) ' Parameter value (traceur.def) : is_chim=',
     517     $             is_chim(iq)
     518          else
     519              write(*,*) ' Parameter value (default)     : is_chim=',
     520     $             is_chim(iq)
     521          end if
    480522      end subroutine get_tracdat
    481523
  • trunk/LMDZ.GENERIC/libf/phystd/physiq_mod.F90

    r2537 r2542  
    3131                          alpha_lift, alpha_devil, qextrhor, &
    3232                          igcm_h2o_ice, igcm_h2o_vap, igcm_dustbin, &
    33                           igcm_co2_ice
     33                          igcm_co2_ice, nesp, is_chim
    3434      use time_phylmdz_mod, only: ecritphy, iphysiq, nday
    3535      use phyetat0_mod, only: phyetat0
     
    258258      real omega(ngrid,nlayer)            ! omega velocity (Pa/s, >0 when downward)
    259259
    260       integer l,ig,ierr,iq,nw,isoil
     260      integer l,ig,ierr,iq,nw,isoil,iesp
    261261     
    262262      real zls                       ! Solar longitude (radians).
     
    300300      real dt_ekman(ngrid,noceanmx), dt_hdiff(ngrid,noceanmx) ! Slab_ocean routine.
    301301      real zdtsw1(ngrid,nlayer), zdtlw1(ngrid,nlayer)         ! Callcorrk routine.
     302      real zdtchim(ngrid,nlayer)                              ! Calchim routine.
    302303                             
    303304      ! For Surface Tracers : (kg/m2/s)
     
    323324      real dqvaplscale(ngrid,nlayer)  ! Largescale routine.
    324325      real dqcldlscale(ngrid,nlayer)  ! Largescale routine.
    325       REAL zdqchim(ngrid,nlayer,nq)  ! Calchim_asis routine
    326       REAL zdqschim(ngrid,nq)         ! Calchim_asis routine
     326      REAL,allocatable,save :: zdqchim(:,:,:) ! Calchim_asis routine
     327      REAL,allocatable,save :: zdqschim(:,:)  ! Calchim_asis routine
    327328
    328329      REAL array_zero1(ngrid)
     
    476477            if(photochem) then
    477478              call ini_conc_mod(ngrid,nlayer)
     479              IF (.NOT.ALLOCATED(zdqchim))  ALLOCATE(zdqchim(ngrid,nlayer,nesp))
     480              IF (.NOT.ALLOCATED(zdqschim)) ALLOCATE(zdqschim(ngrid,nesp))
    478481            endif
    479482         endif
     
    14871490                        fract,zzlev,zzlay,zday,pq,pdq,zdqchim,zdqschim, &
    14881491                        array_zero1,array_zero1,                        &
    1489                         pu,pdu,pv,pdv,array_zero2,array_zero2)
     1492                        pu,pdu,pv,pdv,array_zero2,array_zero2,icount,zdtchim)
    14901493
    14911494           ! increment values of tracers:
    1492            DO iq=1,nq ! loop on all tracers; tendencies for non-chemistry
    1493                       ! tracers is zero anyways
    1494              DO l=1,nlayer
    1495                DO ig=1,ngrid
    1496                  pdq(ig,l,iq)=pdq(ig,l,iq)+zdqchim(ig,l,iq)
     1495           iesp = 0
     1496           DO iq=1,nq   ! loop on all tracers; tendencies for non-chemistry
     1497                        ! tracers is zero anyways
     1498                        ! September 2020: flag is_chim to increment only on chemical species
     1499             IF (is_chim(iq)==1) THEN
     1500               iesp = iesp + 1
     1501               DO l=1,nlayer
     1502                 DO ig=1,ngrid
     1503                   pdq(ig,l,iq)=pdq(ig,l,iq)+zdqchim(ig,l,iesp)
     1504                 ENDDO
    14971505               ENDDO
    1498              ENDDO
     1506             ENDIF
    14991507           ENDDO ! of DO iq=1,nq
    15001508
     
    15071515             ENDDO
    15081516           ENDDO ! of DO iq=1,nq
     1517
     1518           ! increment values of temperature:
     1519           pdt(1:ngrid,1:nlayer)=pdt(1:ngrid,1:nlayer)+zdtchim(1:ngrid,1:nlayer)
    15091520
    15101521         END IF  ! of IF (photochem)
  • trunk/LMDZ.GENERIC/libf/phystd/tracer_h.F90

    r2436 r2542  
    55
    66       integer, save :: nqtot ! total number of tracers
    7 !$OMP THREADPRIVATE(nqtot)
     7       integer, save :: nesp  ! number of species in the chemistry
     8!$OMP THREADPRIVATE(nqtot,nesp)
    89
    910       logical :: moderntracdef=.false. ! Standard or modern traceur.def
     
    1213       character*30, save, allocatable :: noms(:)   ! name of the tracer
    1314       real, save, allocatable :: mmol(:)     ! mole mass of tracer (g/mol-1)
     15       real, save, allocatable :: aki(:)      ! to compute coefficient of thermal concduction if photochem
     16       real, save, allocatable :: cpi(:)      ! to compute cpnew in concentration.F if photochem
    1417       real, save, allocatable :: radius(:)   ! dust and ice particle radius (m)
    1518       real, save, allocatable :: rho_q(:)    ! tracer densities (kg.m-3)
     
    2528       real,save :: rho_co2     ! CO2 ice density (kg.m-3)
    2629       real,save :: ref_r0        ! for computing reff=ref_r0*r0 (in log.n. distribution)
    27 !$OMP THREADPRIVATE(noms,mmol,radius,rho_q,qext,alpha_lift,alpha_devil,qextrhor, &
     30!$OMP THREADPRIVATE(noms,mmol,aki,cpi,radius,rho_q,qext,alpha_lift,alpha_devil,qextrhor, &
    2831        !$OMP varian,r3n_q,rho_dust,rho_ice,rho_co2,ref_r0)
     32
     33       integer, save, allocatable :: is_chim(:) ! 1 if tracer used in chemistry, else 0
     34!$OMP THREADPRIVATE(is_chim)
    2935
    3036! tracer indexes: these are initialized in initracer and should be 0 if the
Note: See TracChangeset for help on using the changeset viewer.