Skip to content
Snippets Groups Projects
Commit e5373443 authored by Gaelle DELAUTIER's avatar Gaelle DELAUTIER
Browse files

Maud 19/6/2048 : modif pour TUV avec RACM2

parent 16d334d3
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
src/MNH/BASIC.f90
+ 3
− 3
View file @ e5373443
......@@ -29185,7 +29185,7 @@ REAL,DIMENSION(:,:,:,:), INTENT(IN) :: PJVALUES ! Tuv coefficient
! /BEGIN_SET_PHOTO_RATES/
! parameter for use by subroutine JVALUES,
! contains the actual photolysis rates
REAL, DIMENSION(KVECNPT,41) :: ZRATESIO ! TUV photolysis rates at one level
REAL, DIMENSION(KVECNPT,42) :: ZRATESIO ! TUV photolysis rates at one level
REAL, DIMENSION(KVECNPT,19) :: ZRATES ! photolysis rates of RACM (vector)
INTEGER :: JITPK ! loop counter for J-Value transfer
INTEGER :: IDTI,IDTJ
......@@ -29247,8 +29247,8 @@ DO JITPK = 0, KVECNPT-1
ZRATES(JITPK+1, 17) = 0.20*ZRATESIO(JITPK+1,20)&
&+ 0.80*ZRATESIO(JITPK+1,21)
! aqueous phase photolysis
ZRATES(JITPK+1, 18) = ZRATESIO(JITPK+1,40)
ZRATES(JITPK+1, 19) = ZRATESIO(JITPK+1,41)
ZRATES(JITPK+1, 18) = ZRATESIO(JITPK+1,41)
ZRATES(JITPK+1, 19) = ZRATESIO(JITPK+1,42)
!
END DO
!
......
src/MNH/ch_f77.fx90
+ 186
− 8
View file @ e5373443
......@@ -5141,8 +5141,8 @@ c
 
C copy labels into output array
 
if (njout .ne. 41) then
WRITE(kout,*) 'There should be 41 J-Values to be updated!'
if (njout .ne. 42) then
WRITE(kout,*) 'There should be 42 J-Values to be updated!'
WRITE(kout,*) 'We better stop here ... in tuvmain.f'
C callabortstop
CALL ABORT
......@@ -19678,7 +19678,7 @@ CCC FILE rxn.f
* the product (cross section) x (quantum yield) for photo-reactions:
* r01 through r47
* r101 through r148
* r149, r150 and r151 added from original TUV code
* r149, r150, r151 and r152 added from original TUV code
*=============================================================================*
SUBROUTINE r01(nw,wl,wc,nz,tlev,airden,j,sq,jlabel,tpflag,kout)
 
......@@ -23675,7 +23675,7 @@ c INCLUDE 'params'
jlabel(j) = 'CHOCHO -> HCO + HCO'
 
j = j + 1
jlabel(j) = 'CHOCHO -> CH2O + CO'
jlabel(j) = 'CHOCHO -> H2 + 2CO'
 
j = j + 1
jlabel(j) = 'CHOCHO -> CH2O + CO'
......@@ -39846,7 +39846,180 @@ c INCLUDE 'params'
 
*=============================================================================*
 
SUBROUTINE r150(nw,wl,wc,nz,tlev,airden,j,sq,jlabel,tpflag,kout)
SUBROUTINE r149(nw,wl,wc,nz,tlev,airden,j,sq,jlabel,tpflag,kout)
*-----------------------------------------------------------------------------*
*= PURPOSE: =*
*= Provide the product (cross section) x (quantum yield) for benzaldehyde =*
*= photolysis: =*
*= C6H5CHO + hv -> CHO + HO2 + CO =*
*= =*
*= Cross section from SAPRC-07 (Calvert et al., 2002) =*
*= =*
*= Products from Zhu and Cronin (Chem. Phys. Let., 317, 2000) =*
*= =*
*= Quantum yield asumed 0.06 (RACM2, Goliff et al., 2013) =*
*-----------------------------------------------------------------------------*
*= PARAMETERS: =*
*= NW - INTEGER, number of specified intervals + 1 in working (I)=*
*= wavelength grid =*
*= WL - REAL, vector of lower limits of wavelength intervals in (I)=*
*= working wavelength grid =*
*= WC - REAL, vector of center points of wavelength intervals in (I)=*
*= working wavelength grid =*
*= NZ - INTEGER, number of altitude levels in working altitude grid (I)=*
*= TLEV - REAL, temperature (K) at each specified altitude level (I)=*
*= AIRDEN - REAL, air density (molec/cc) at each altitude level (I)=*
*= J - INTEGER, counter for number of weighting functions defined (IO)=*
*= SQ - REAL, cross section x quantum yield (cm^2) for each (O)=*
*= photolysis reaction defined, at each defined wavelength and =*
*= at each defined altitude level =*
*= JLABEL - CHARACTER*50, string identifier for each photolysis reaction (O)=*
*= defined =*
*-----------------------------------------------------------------------------*
*= Routine added by M. Leriche for BALD in RACM2 mecanism - March 2018 =*
*-----------------------------------------------------------------------------*
IMPLICIT NONE
c INCLUDE 'params'
* BROADLY USED PARAMETERS:
*_________________________________________________
* i/o file unit numbers
INTEGER kout, kin
* output
* PARAMETER(kout=6)
* input
PARAMETER(kin=78)
*_________________________________________________
* altitude, wavelength, time (or solar zenith angle) grids
INTEGER kz, kw
* altitude
PARAMETER(kz=151)
* wavelength
PARAMETER(kw=157)
*_________________________________________________
* number of weighting functions
INTEGER kj
* wavelength and altitude dependent
PARAMETER(kj=90)
* delta for adding points at beginning or end of data grids
REAL deltax
PARAMETER (deltax = 1.E-5)
* some constants...
* pi:
REAL pi
PARAMETER(pi=3.1415926535898)
* radius of the earth, km:
REAL radius
PARAMETER(radius=6.371E+3)
* Planck constant x speed of light, J m
REAL hc
PARAMETER(hc = 6.626068E-34 * 2.99792458E8)
* largest number of the machine:
REAL largest
PARAMETER(largest=1.E+36)
* small numbers (positive and negative)
REAL pzero, nzero
PARAMETER(pzero = +10./largest)
PARAMETER(nzero = -10./largest)
* machine precision
REAL precis
PARAMETER(precis = 1.e-7)
* input
INTEGER nw
REAL wl(kw), wc(kw)
INTEGER nz
REAL tlev(kz)
REAL airden(kz)
* weighting functions
CHARACTER*50 jlabel(kj)
INTEGER TPFLAG(kj)
REAL sq(kj,kz,kw)
* input/output:
INTEGER j
* data arrays
INTEGER kdata
PARAMETER(kdata=20000)
INTEGER i, n
REAL x(kdata), y(kdata)
* local
REAL yg(kw)
REAL qy, sig
INTEGER ierr
INTEGER iw
************************* C6H5CHO photolysis
j = j+1
jlabel(j) = 'C6H5CHO -> HCO + HO2 + CO'
OPEN(UNIT=kin,FILE='DATAJ1/ABS/BENZALD.abs',
$ STATUS='old')
DO i = 1, 5
READ(kin,*)
ENDDO
n = 100
DO i = 1, n
READ(kin,*) x(i), y(i)
ENDDO
CLOSE(kin)
CALL addpnt(x,y,kdata,n,x(1)*(1.-deltax),0.)
CALL addpnt(x,y,kdata,n, 0.,0.)
CALL addpnt(x,y,kdata,n,x(n)*(1.+deltax),0.)
CALL addpnt(x,y,kdata,n, 1.e+38,0.)
CALL inter2(nw,wl,yg,n,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
STOP
ENDIF
* quantum yields assumed to be 0.06
qy = 0.06
DO iw = 1, nw-1
DO i = 1, nz
sig = yg(iw)
sq(j,i,iw) = qy * sig
ENDDO
ENDDO
tpflag(j) = 0
RETURN
END
*=============================================================================*
SUBROUTINE r151(nw,wl,wc,nz,tlev,airden,j,sq,jlabel,tpflag,kout)
 
*-----------------------------------------------------------------------------*
*= PURPOSE: =*
......@@ -40025,7 +40198,7 @@ c INCLUDE 'params'
 
*=============================================================================*
 
SUBROUTINE r151(nw,wl,wc,nz,tlev,airden,j,sq,jlabel,tpflag,kout)
SUBROUTINE r152(nw,wl,wc,nz,tlev,airden,j,sq,jlabel,tpflag,kout)
 
*-----------------------------------------------------------------------------*
*= PURPOSE: =*
......@@ -42392,6 +42565,11 @@ C call r124(nw,wl,wc,nz,tlev,airden,j,sq,jlabel,tpflag,kout)
* Uses availble Martinez data for cross section
CALL r149(nw,wl,wc,nz,tlev,airden,j,sq,jlabel,tpflag,kout)
 
* BENZALD + hv -> phenoxy + HO2 + CO
* M. Leriche added March 2018 for BALD (RACM2)
* Uses data from SAPRC-07 for cross section
CALL r150(nw,wl,wc,nz,tlev,airden,j,sq,jlabel,tpflag,kout)
******** FOx Photochemistry
 
*E12. CF2O + hv -> Products
......@@ -42553,10 +42731,10 @@ C CALL r145(nw,wl,wc,nz,tlev,airden,j,sq,jlabel,tpflag,kout)
*** Add from LaMP code (Deguillaume et al., 2004)
 
*AQ01. H2O2(aq) -> 2OH
CALL r151(nw,wl,wc,nz,tlev,airden,j,sq,jlabel,tpflag,kout)
CALL r152(nw,wl,wc,nz,tlev,airden,j,sq,jlabel,tpflag,kout)
 
*AQ02. NO3-(aq) -> NO2 + OH
CALL r150(nw,wl,wc,nz,tlev,airden,j,sq,jlabel,tpflag,kout)
CALL r151(nw,wl,wc,nz,tlev,airden,j,sq,jlabel,tpflag,kout)
 
****************************************************************
 
src/MNH/modd_ch_init_jvalues.f90
+ 1
− 1
View file @ e5373443
......@@ -33,7 +33,7 @@ INTEGER :: NSZA_INCR = 99 + 1
REAL, ALLOCATABLE, DIMENSION(:) :: XSZA_JVAL
INTEGER, PARAMETER :: NZZ_JVAL = 30 + 1
REAL, ALLOCATABLE, DIMENSION(:) :: XZZ_JVAL
INTEGER, PARAMETER :: JPJVMAX = 41
INTEGER, PARAMETER :: JPJVMAX = 42
INTEGER :: NBALB = 10
!
END MODULE MODD_CH_INIT_JVALUES
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment

Documentation | Mentions légales | CGU | Accessibilité : non conforme