diff --git a/README.MD b/README.MD
new file mode 100644
index 0000000..767fd2b
--- /dev/null
+++ b/README.MD
@@ -0,0 +1,9 @@
+OPS (Operationele Prioritaire Stoffen) is een rekenprogramma om de verspreiding van verontreinigende stoffen in de lucht te simuleren.
+Daarnaast berekent het model hoeveel van die stoffen per hectare op bodem of gewas terechtkomt (depositie).
+Het model wordt sinds 1989 gebruikt om de relatie tussen de uitstoot van stoffen in Europa enerzijds en de concentratie of depositie van die stoffen anderzijds op de schaal van Nederland te bepalen.
+
+Meer informatie en een uitgebreide documentatie van de werking van het model vindt u op www.rivm.nl/ops.
+
+Een Windows-executable van OPS + Grafische User Interface om invoerbestanden voor OPS te genereren is te downloaden via dezelfde website.
+
+Voor instructies voor het zelf compileren van de source code kunt u contact opnemen met OPS-support@rivm.nl.
diff --git a/binas.f90 b/binas.f90
index 9eb7fad..bc866fd 100644
--- a/binas.f90
+++ b/binas.f90
@@ -1,35 +1,31 @@
-!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
-! National Institute of Public Health and Environment
-! Laboratory for Air Research (RIVM/LLO)
-! The Netherlands
-!-------------------------------------------------------------------------------------------------------------------------------
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
module Binas
implicit none
-
+
public
-
+
!
!ProTeX: 1.14-AJS
!
!BOI
!
! !TITLE: Binas - geometrical and physical constants
- ! !AUTHORS: Arjo Segers
+ ! !AUTHORS:
! !AFFILIATION: KNMI
! !DATE: \today
!
@@ -46,16 +42,16 @@ module Binas
! ---------------------------------------------------------------
! gonio
! ---------------------------------------------------------------
-
+
! defintions for pi :
! o old definition:
!real, parameter :: pi = 3.1415927
! o EMOS definition (emos/interpolation/strlat.F, parameter PPI)
real, parameter :: pi = 3.14159265358979
- ! two pi :
+ ! two pi :
real, parameter :: twopi = 2*pi
-
+
! factors to convert to radians from degrees and the otrher way around;
! alpha_deg = alpha_rad*rad2deg
! alpha_rad = alpha_deg*deg2rad
@@ -66,7 +62,7 @@ module Binas
! ---------------------------------------------------------------
! earth
! ---------------------------------------------------------------
-
+
! Radius of earth as used in EMOS library (ECMWF model),
! see for example "jvod2uv.F"
! NOTE: the value 6.375e6 was used in TM !
@@ -75,33 +71,33 @@ module Binas
! acceleration of gravity:
!real, parameter :: grav = 9.81 ! m/s2
real, parameter :: grav = 9.80665 ! m/s2
-
+
! Earth's angular speed of rotation
! Omega = 2 * pi * (365.25/364.25) / (86400.0)
real, parameter :: Omega = 7.292e-5 ! rad/s
-
+
! ---------------------------------------------------------------
! molecules, mols, etc
! ---------------------------------------------------------------
-
+
! Avogadro number
real, parameter :: Avog = 6.02205e23 ! mlc/mol
-
+
! Dobson units:
real,parameter :: Dobs = 2.68668e16 ! (mlc/cm2) / DU
-
+
!
! molar weights of components
- !
-
+ !
+
! naming convention:
! o old names 'xm***' are in g/mol
! o new names 'xm_***' are in kg/mol
!
- ! atomic weights:
+ ! atomic weights:
real, parameter :: xm_H = 1.00790e-3 ! kg/mol
real, parameter :: xm_N = 14.00670e-3 ! kg/mol
real, parameter :: xm_C = 12.01115e-3 ! kg/mol
@@ -121,57 +117,57 @@ module Binas
real, parameter :: xm_NH4 = xm_N + xm_O * 4 ! kg/mol
real, parameter :: xm_SO4 = xm_S + xm_O * 4 ! kg/mol
real, parameter :: xm_NO3 = xm_N + xm_O * 3 ! kg/mol
-
+
! mass of air
real, parameter :: xm_air = 28.964e-3 ! kg/mol
real, parameter :: xmair = 28.94 ! g/mol; old name!
-
+
! dummy weight, used for complex molecules:
real, parameter :: xm_dummy = 1000.0e-3 ! kg/mol
! * seasalt
-
+
! sesalt composition:
! (Seinfeld and Pandis, "Atmospheric Chemistry and Physics",
! table 7.8 "Composition of Sea-Salt", p. 444)
real, parameter :: massfrac_Cl_in_seasalt = 0.5504 ! (kg Cl )/(kg seasalt)
real, parameter :: massfrac_Na_in_seasalt = 0.3061 ! (kg Na )/(kg seasalt)
real, parameter :: massfrac_SO4_in_seasalt = 0.0768 ! (kg SO4)/(kg seasalt)
-
+
! other numbers (wikipedia ?)
real, parameter :: xm_seasalt = 74.947e-3 ! kg/mol : NaCl, SO4, ..
real, parameter :: rho_seasalt = 2.2e3 ! kg/m3
! * amonium sulphate
-
+
real, parameter :: xm_NH4HSO4 = xm_NH4 + xm_H + xm_SO4 ! kg/mol
real, parameter :: rho_NH4HSO4a = 1.8e3 ! kg/m3
-
+
! mlc/mol
! [cdob] = ------------------------ = DU / (kg/m2)
! kg/mol cm2/m2 mlc/cm2/DU
!
-
+
real, parameter :: cdob_o3 = Avog / ( xm_o3 * 1.0e4 * Dobs ) ! DU/(kg/m2)
-
+
! ---------------------------------------------------------------
! gas
! ---------------------------------------------------------------
-
- ! gas constant
+
+ ! gas constant
real, parameter :: Rgas = 8.3144 ! J/mol/K
-
+
! gas constant for dry air
!real, parameter :: rgas_x = 287.05
! NEW:
! Rgas_air = Rgas / xmair = 287.0598
real, parameter :: Rgas_air = Rgas / xm_air ! J/kg/K
-
+
! water vapour
!real,parameter :: rgasv = 461.51
real, parameter :: Rgas_h2o = Rgas / xm_h2o ! J/kg/K
-
+
! standard pressure
real, parameter :: p0 = 1.0e5 ! Pa
!real, parameter :: p0 = 1.01325e5 ! Pa <-- suggestion Bram Bregman
@@ -189,7 +185,7 @@ module Binas
! Latent heat of condensation at 0 deg Celcius
! (heat (J) necesarry to evaporate 1 kg of water)
real, parameter :: Lc = 22.6e5 ! J/kg
-
+
! kappa = R/cp = 2/7
real, parameter :: kappa = 2.0/7.0
! 'kapa' is probably 'kappa' ....
@@ -207,15 +203,15 @@ module Binas
real, parameter :: eps = Rgas_air / Rgas_h2o
real, parameter :: eps1 = ( 1.0 - eps )/eps
-
-
+
+
! ---------------------------------------------------------------
! other
! ---------------------------------------------------------------
! melting point
real, parameter :: T0 = 273.16 ! K
-
+
! Rv/Rd
real, parameter :: gamma = 6.5e-3
@@ -227,18 +223,18 @@ module Binas
! density of pure water at 15 deg C
real, parameter :: rho_water = 999.0 ! kg/m^3
-
+
! density of dry air at 20 oC and 1013.25 hPa :
real, parameter :: rho_dry_air_20C_1013hPa = 1.2041 ! kg/m3
-
+
! Planck times velocity of light
real, parameter :: hc = 6.626176e-34 * 2.997924580e8 ! Jm
-
-
+
+
! ---------------------------------------------------------------
! end
! ---------------------------------------------------------------
!EOC
-
+
end module Binas
diff --git a/m_aps.f90 b/m_aps.f90
index ea239c5..83ef28a 100644
--- a/m_aps.f90
+++ b/m_aps.f90
@@ -1,21 +1,24 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! MODULE : aps
! IMPLEMENTS : aps-grid related grid-types:
@@ -29,7 +32,7 @@
! BRANCH - SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR : Martien de Haan (ARIS)
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM/LLO/IS
! LANGUAGE : FORTRAN(HP-F90)
! DESCRIPTION : Handling of aps grid data.
@@ -78,7 +81,7 @@ MODULE m_aps
!-------------------------------------------------------------------------------------------------------------------------------
TYPE TApsGridReal
TYPE (TGridHeader) :: gridheader ! grid header
- REAL*4 :: average ! average of all grid values
+ REAL*4, DIMENSION(:), POINTER :: average ! average of all grid values
REAL*4, DIMENSION(:,:,:), POINTER :: value ! 3D array with real values
END TYPE TApsGridReal
@@ -189,10 +192,19 @@ SUBROUTINE read_aps_real(filename, gridtitle, floatgrid, error)
!
nfield = 1
CALL read_aps_header(88, filename, gridtitle, floatgrid%gridheader, error)
+IF (error%haserror) GOTO 3000
+
+! Allocate help grid:
nrcol = floatgrid%gridheader%nrcol
nrrow = floatgrid%gridheader%nrrow
-ALLOCATE(helpgrid(nrcol,nrrow))
-IF (error%haserror) GOTO 3000
+! write(*,*)'read_aps1: ',trim(gridtitle),nrcol,nrrow
+if (nrcol .le. 0 .or. nrrow .le. 0) then
+ call SetError('need positive nmber of rows and columns in APS header', error)
+ goto 2000
+else
+ ALLOCATE(helpgrid(nrcol,nrrow))
+endif
+
!
! Determine the number of subgrids in the aps-file
!
@@ -212,6 +224,7 @@ SUBROUTINE read_aps_real(filename, gridtitle, floatgrid, error)
!
nrcol = floatgrid%gridheader%nrcol
nrrow = floatgrid%gridheader%nrrow
+! write(*,*)'read_aps2: ',nrcol,nrrow,nfield
ALLOCATE(floatgrid%value(nrcol,nrrow,nfield),STAT=ierr)
@@ -220,6 +233,13 @@ SUBROUTINE read_aps_real(filename, gridtitle, floatgrid, error)
GOTO 1000
ENDIF
+ALLOCATE(floatgrid%average(nfield),STAT=ierr)
+
+IF (ierr.NE.0) THEN
+ CALL SetError('Memory allocation error 2 in reading grid data', error)
+ GOTO 1000
+ENDIF
+
DO n = 1,nfield
READ (88, IOSTAT=ierr) teststring
@@ -245,8 +265,7 @@ SUBROUTINE read_aps_real(filename, gridtitle, floatgrid, error)
!
! Error handling section, first when memory allocation or reading the gridfile failed
!
-1000 CALL ErrorParam('filename', filename, error)
-CALL ErrorParam('error number', ierr, error)
+1000 CALL ErrorParam('error number', ierr, error)
!
! These parameters are also written when closing the file failed
!
@@ -254,7 +273,8 @@ SUBROUTINE read_aps_real(filename, gridtitle, floatgrid, error)
CALL ErrorParam('grid dimension nrcol', nrcol, error)
CALL ErrorParam('grid dimension nrrow', nrrow, error)
-3000 CALL ErrorCall(ROUTINENAAM, error)
+3000 CALL ErrorParam('filename', filename, error)
+CALL ErrorCall(ROUTINENAAM, error)
RETURN
END SUBROUTINE read_aps_real
@@ -388,6 +408,7 @@ SUBROUTINE dealloc_aps_real(realgrid)
! When allocated this object is now deallocated.
!
IF (ASSOCIATED(realgrid%value)) DEALLOCATE(realgrid%value)
+IF (ASSOCIATED(realgrid%average)) DEALLOCATE(realgrid%average)
RETURN
END SUBROUTINE dealloc_aps_real
@@ -456,6 +477,9 @@ SUBROUTINE read_aps_header(fileunit, filename, gridtitle, gridheader, error)
!
READ(fileunit, IOSTAT = ierr ) ij,inu1,inu2,inu3,kmpnm, eenheid, oors, comment, form, kode, gridheader%xorgl, &
& gridheader%yorgl, gridheader%nrcol, gridheader%nrrow, gridheader%grixl, gridheader%griyl
+! write(*,*) 'APS header 1 ',ij,inu1,inu2,inu3
+! write(*,*) 'APS header 2 ',kmpnm, eenheid, oors, comment, form, kode
+! write(*,*) 'APS header 3 ',gridheader%xorgl, gridheader%yorgl, gridheader%nrcol, gridheader%nrrow, gridheader%grixl, gridheader%griyl
IF (ierr /= 0) THEN
IF (ierr > 0) THEN
@@ -511,7 +535,8 @@ SUBROUTINE set_average(factor, grid, fieldnumber)
grid%value(:,:,fn) = grid%value(:nrcol, :nrrow, fn) * factor
ENDIF
-grid%average = SUM(grid%value(:nrcol,:nrrow,fn)) / COUNT(grid%value(:nrcol, :nrrow,fn) > EPS_DELTA)
+! Each grid has its own average:
+grid%average(fn) = SUM(grid%value(:nrcol,:nrrow,fn)) / COUNT(grid%value(:nrcol, :nrrow,fn) > EPS_DELTA)
END SUBROUTINE set_average
@@ -597,7 +622,7 @@ SUBROUTINE grid_value_real(x, y, grid, gridvalue, iscell, fieldnumber)
IF (iscell) THEN
gridvalue = grid%value(m,n,fn)
ELSE
- gridvalue = grid%average
+ gridvalue = grid%average(fn)
ENDIF
RETURN
diff --git a/m_commonconst.f90 b/m_commonconst.f90
index 96b0902..bfcb97f 100644
--- a/m_commonconst.f90
+++ b/m_commonconst.f90
@@ -1,21 +1,24 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! MODULE : m_commonconst
! FILENAME : %M%
@@ -24,7 +27,7 @@
! BRANCH - SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR : Martien de Haan (ARIS)
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM/LLO
! LANGUAGE : FORTRAN-F90
! DESCRIPTION : Defines common parameters, values, etc.
@@ -54,7 +57,7 @@ MODULE m_commonconst
INTEGER*4, PARAMETER :: NCATMAX = 199 ! maximal number of emission categories
INTEGER*4, PARAMETER :: NLANDMAX = 50 ! maximal number of emission countries (land << country)
INTEGER*4, PARAMETER :: NBGMAPS = 5 ! number of background maps
-INTEGER*4, PARAMETER :: NYEARS = 41 ! number of years for interpolating backgground maps
+INTEGER*4, PARAMETER :: NYEARS = 42 ! number of years for interpolating backgground maps
INTEGER*4, PARAMETER :: MAXDISTR = 9999 ! maximal number of distributions (for particle size or emission variation)
INTEGER*4, PARAMETER :: MAXROW = 9999 ! maximal number of rows in receptor grid
INTEGER*4, PARAMETER :: MAXCOL = 9999 ! maximal number of columns in receptor grid
@@ -75,10 +78,9 @@ MODULE m_commonconst
REAL*8 :: r8_for_tiny ! help variable to define DEPS_DELTA
REAL*4, PARAMETER :: EPS_DELTA = tiny(r4_for_tiny) ! tiny number (real)
REAL*8, PARAMETER :: DPEPS_DELTA = tiny(r8_for_tiny) ! tiny number (double precision)
-! REAL*4, PARAMETER :: PI = 3.14159265
REAL*4, PARAMETER :: HUMAX = 500. ! maximal plume height [m]
-CHARACTER*8, PARAMETER :: MODVERSIE = '4.6.2.5' ! model version OPS-LT
-CHARACTER*20, PARAMETER :: RELEASEDATE = '06 dec 2019' ! release date
+CHARACTER*8, PARAMETER :: MODVERSIE = '5.0.0.0' ! model version OPS-LT
+CHARACTER*20, PARAMETER :: RELEASEDATE = '26 dec 2019' ! release date
!
! CONSTANTS - Data
@@ -96,6 +98,7 @@ MODULE m_commonconst
REAL*4 :: tf_nh3(NYEARS + 1) ! trendfactors for NH3: concentration in year T, relative to the concentration in reference year
REAL*4 :: nox_no2_beta(2) ! coefficient in conversion NO2 = beta(1)*log(NOx) + beta(2)
CHARACTER*10 :: CNAME(3,5) ! names of substances (primary, secondary, second secondary, deposited, name in DEPAC)
+CHARACTER*10 :: CNAME_SUBSEC(4) ! names of sub-secondary species (HNO3, NO3_C, NO3_F)
CHARACTER*10 :: UNITS(2) ! units for concentration
CHARACTER*10 :: DEPUNITS(NUNIT) ! units for deposition
CHARACTER*40 :: KLIGEB(NKLIGEB) ! climate regions in NL (KLIGEB << klimaatgebieden = climate regions)
@@ -145,17 +148,17 @@ MODULE m_commonconst
DATA tf_so2 /1.11,1.39,1.79,1.27,1.19,1.20,0.94,1.00,1.04,1.02,1.10,0.62,0.65, & ! 1977 t/m 1989 (ref=1984)
& 1.60,1.70,1.46,1.33,1.00,0.86,1.02,0.78,0.63,0.50, & ! 1990 t/m 1999 (ref=1994)
& 1.33,1.15,1.20,1.14,1.01,1.00,0.96, & ! 2000 t/m 2006 (ref=2005)
- & 1.72,1.85,1.75,1.44,1.14,1.00,0.98,1.10,0.81,0.61,0.58,1.00/ ! 2007 t/m 2017 plus future (ref=2012)
+ & 1.72,1.85,1.75,1.44,1.14,1.00,0.98,1.10,0.81,0.61,0.58,0.77,1.00/ ! 2007 t/m 2018 plus future (ref=2012)
DATA tf_no2 /0.91,0.92,1.03,0.93,0.92,1.00,0.93,1.00,1.05,0.93,0.88,0.81,0.94, & ! 1977 t/m 1989 (ref=1984)
& 1.12,1.19,1.06,1.02,1.00,0.94,1.04,1.03,0.91,0.86, & ! 1990 t/m 1999 (ref=1994)
& 1.07,1.05,1.06,1.17,1.06,1.00,0.99, & ! 2000 t/m 2006 (ref=2005)
- & 1.09,1.15,1.12,1.06,1.04,1.00,0.94,0.90,0.84,0.88,0.89,1.00/ ! 2007 t/m 2017 plus future (ref=2012)
+ & 1.09,1.15,1.12,1.06,1.04,1.00,0.94,0.90,0.84,0.88,0.89,0.88,1.00/ ! 2007 t/m 2018 plus future (ref=2012)
DATA tf_nh3 /1.00,1.00,1.00,1.00,1.00,1.00,1.00,1.00,1.00,1.00,1.00,1.00,1.00, & ! 1977 t/m 1989 (ref=1984)
& 1.00,1.00,1.00,1.01,1.00,0.97,0.97,1.03,0.75,0.85, & ! 1990 t/m 1999 (ref=1994)
& 0.94,1.00,0.83,1.04,0.84,1.00,1.08, & ! 2000 t/m 2006 (ref=2005)
- & 0.86,0.84,0.98,1.00,1.10,1.00,1.00,1.05,0.93,1.04,1.04,1.00/ ! 2007 t/m 2017 plus future (ref=2012)
+ & 0.86,0.84,0.98,1.00,1.10,1.00,1.00,1.05,0.93,1.04,1.04,1.51,1.00/ ! 2007 t/m 2018 plus future (ref=2012)
!
! Declaration of the naming convention used for SO2, NOx and NH3
! CNAME(:,1): name of primary substance
@@ -169,22 +172,26 @@ MODULE m_commonconst
& ' ', 'NO3' , ' ', &
& 'SOx', 'NOy' , 'NHx', &
& 'SO2', 'NO2' , 'NH3' /
+
+! CNAME_SEC is defined in ops_read_ctr
+! DATA CNAME_SUBSEC /'HNO3', 'NO3_C', 'NO3_F' / ! HNO3, NO3_coarse (in PM10-PM2.5), NO3_fine (in PM2.5)
+! DATA CNAME_SUBSEC /'HNO3', 'NO3_AER' / ! HNO3, NO3_aerosol (in PM10)
!
! Units for concentration and deposition
!
-DATA UNITS /'ug/m3', 'ug/m3 NO2'/
+DATA UNITS /'ug/m3', 'ug/m3_NO2'/
DATA DEPUNITS /' mmol/m2/s', ' g/m2/s ', ' mol/ha/y ', ' kg/ha/y ', ' mmol/m2/y', ' g/m2/y '/
!
! meteo regions (KLIGEB << klimaatgebieden = climate regions)
!
-DATA KLIGEB /'The Netherlands ', &
+DATA KLIGEB /'The_Netherlands ', &
& 'N-Holland, N-Friesland, N-Groningen', &
& 'Randstad, W-Brabant, E-Zeeland ', &
& 'Drente, S-Friesland, S-Groningen ', &
& 'W-Zeeland, ZH-Islands ', &
& 'Mid-Brabant, Veluwe, Twente ', &
& 'S-Limburg, E-Brabant, Achterhoek ', &
- & 'Special climatological datafile '/ ! always the last one
+ & 'Special_climatological_datafile '/ ! always the last one
END MODULE m_commonconst
diff --git a/m_commonfile.f90 b/m_commonfile.f90
index dfe66f0..ba83dd4 100644
--- a/m_commonfile.f90
+++ b/m_commonfile.f90
@@ -1,21 +1,24 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! MODULE : m_commonfile
! FILENAME : %M%
@@ -24,7 +27,7 @@
! BRANCH - SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR : Martien de Haan (ARIS)
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM/LLO
! LANGUAGE : FORTRAN-F90
! DESCRIPTION : Define file unit numbers and file names. Subroutine to make full file name.
@@ -108,10 +111,17 @@ MODULE m_commonfile
CHARACTER*24 :: map_so2(5) ! name of file with background map SO2 (for 4 years)
CHARACTER*24 :: map_nox(5) ! name of file with background map NOx (for 4 years)
CHARACTER*24 :: map_nh3(5) ! name of file with background map NH3 (for 4 years)
+CHARACTER*128 :: map_mass_prec ! filename with MASS_PREC averaged column mass precursor pre chemistry step, used for vchem
+CHARACTER*128 :: map_mass_conv_dtfac ! filename with MASS_CONV_DTFAC = (100/dt) * averaged column mass converted in chemistry step, used for vchem
+CHARACTER*128 :: map_no3_distr ! filename with distribution factors for different secondary species NO3
+ ! HNO3/NO3_total, NO3_C/NO3_total, NO3_F/NO3_total
DATA map_so2 / 'bgso2c1984.ops', 'bgso2c1994.ops', 'bgso2c2005.ops', 'bgso2c2012.ops','bgso2c2020.ops' /
DATA map_nox / 'bgnoxc1984.ops', 'bgnoxc1994.ops', 'bgnoxc2005.ops', 'bgnoxc2012.ops','bgnoxc2020.ops' /
DATA map_nh3 / 'bgnh3c1984.ops', 'bgnh3c1994.ops', 'bgnh3c2005.ops', 'bgnh3c2012.ops','bgnh3c2020.ops' /
+DATA map_mass_prec / 'xxx_mass_prec_yyyy.ops' / ! xxx = name primary species (SO2, NOx, NH3), yyyy = year (e.g. 2019)
+DATA map_mass_conv_dtfac / 'xxx_mass_conv_dtfac_yyyy.ops' /
+DATA map_no3_distr / 'no3_distr_yyyy.ops' /
!-------------------------------------------------------------------------------------------------------------------------------
! SUBROUTINE : MakeCommonPath
! DESCRIPTION : Generates full file names for the common background or diurnal variation files and checks existence. An error is
diff --git a/m_depac.f90 b/m_depac.f90
index 9322b0e..9d85ce6 100644
--- a/m_depac.f90
+++ b/m_depac.f90
@@ -1,21 +1,24 @@
-!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
-! National Institute of Public Health and Environment
-! Laboratory for Air Research (RIVM/LLO)
-! The Netherlands
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
+!************************************************************************
+! 2013-09-17: this version has been derived from the 'hybrid' version
+! depac_GCN2010, which consisted of a shell around version
+! depac311 (for NH3) and depac33 (for other species).
+! In this version, only depac311 has been retained, with some
+! bug fixes,
!************************************************************************
!************************************************************************
@@ -27,13 +30,13 @@
!
! MODULE : m_depac
! INTERFACE : depac
-! AUTHOR : Addo van Pul, Jan Willem Erisman, Ferd Sauter, Margreet van Zanten, Roy Wichink Kruit
+! AUTHOR :
! FIRM/INSTITUTE : RIVM
! LANGUAGE : FORTRAN-90
! DESCRIPTION : In this subroutine the canopy or surface resistance Rc
! is parameterised.
!
-! Documentation by Ferd Sauter, Mar 2009.
+! Documentation by , Mar 2009.
! Deposition fluxes are computed using one of the following resistance approaches;
! Note that, with the appopriate definitions (see below), B and C are totally equivalent.
!
@@ -225,10 +228,10 @@
! UPDATE HISTORY :
! 1994 , article Erisman & van Pul, Atm. Env.
! ? , Franka Loeve (Cap Volmac)
-! Jan 2003, Martien de Haan (ARIS): made single depac module.
+! Jan 2003, : made single depac module.
! ? , ? (TNO) : added rc for O3
! ? , ? (TNO) : separate routines for each species.
-! Nov 2008, Ferd Sauter (RIVM): v3.0 synthesis of OPS and LOTOS-EUROS versions of DEPAC
+! Nov 2008, (RIVM): v3.0 synthesis of OPS and LOTOS-EUROS versions of DEPAC
! v3.0 model structure improved; common tasks in separate routines; documentation added
! names have been changed for readability:
!
@@ -248,28 +251,28 @@
! gs -> gstom : stomatal conductance (m/s)
! gstot -> gc_tot : total canopy conductance (m/s)
!
-! 10 Dec 2008, Ferd Sauter (RIVM): v3.1 try-out version with new model structure;
+! 10 Dec 2008, (RIVM): v3.1 try-out version with new model structure;
! v3.1 no calls to separate routines in subroutine depac, but all components
! are dealt with in subroutine depac.
! This version is NOT developed any further; depacv3.2 is developed from v3.0
!
-! 11 Dec 2008, Ferd Sauter (RIVM): v3.2 new model structure;
+! 11 Dec 2008, (RIVM): v3.2 new model structure;
! v3.2 in subroutine depac, calls are made to routines for separate conductances, e.g.
! for external, stomatal, soil conductance; the dependence on the components is
! placed inside these conductance-routines.
!
-! 22 Jan 2009, Ferd Sauter (RIVM): v3.3 bug fix in season dependency leaf area index;
+! 22 Jan 2009, (RIVM): v3.3 bug fix in season dependency leaf area index;
! v3.3 see function rc_lai. Older versions of this routine use a wrong numbering of
! land use types (no conversion to Olson land use types).
! rc_gstom_wes (Wesely) readability improved; routine gives the same results.
!
-! 03 Feb 2009, Ferd Sauter (RIVM): v3.4 Rsoil(NH3,urban) = 100 (was 1000).
+! 03 Feb 2009, (RIVM): v3.4 Rsoil(NH3,urban) = 100 (was 1000).
! v3.4
!
-! 03 Feb 2009, Ferd Sauter (RIVM): v3.5 Rinc(grass) = Inf (was 0).
+! 03 Feb 2009, (RIVM): v3.5 Rinc(grass) = Inf (was 0).
! v3.5
!
-! 03 Feb 2009, Ferd Sauter (RIVM): v3.6 stomatal compensation point and
+! 03 Feb 2009, (RIVM): v3.6 stomatal compensation point and
! v3.6 new parameterisation Rw.
! New routines:
! rc_comp_point (called from depac)
@@ -278,7 +281,7 @@
! New option ipar_rw_nh3. (obsolete in final version MCvZ Nov 2009)
! New (optional) arguments of depac: see header of depac.
!
-! 02 Mar 2009, Ferd Sauter (RIVM): v3.7
+! 02 Mar 2009, (RIVM): v3.7
! v3.7 - added compensation point for external leaf;
! new parameterisation for Rw (routine rw_nh3_sutton replaces rw_nh3_rwk);
! - added compensation point for soil; value of compensation point
@@ -288,17 +291,17 @@
! parameterisation of Rstom; it was decided to change not everything in this version
! but to do it stepwise. See v3.8 for Baldocchi
!
-! 10 Mar 2009, Ferd Sauter (RIVM): v3.8
+! 10 Mar 2009, (RIVM): v3.8
! v3.8 - the same as v3.7, but Baldocchi for Rstom
!
-! 24 Mar 2009, Ferd Sauter (RIVM): v3.8.1 LAI in external leaf resistance
+! 24 Mar 2009, (RIVM): v3.8.1 LAI in external leaf resistance
! v3.8.1 gw = (lai/lai(grass)) * gw (adjusted Oct 2009; lai -> sai and
! sai_grass scaling inside rw_nh3_sutton routine)
!
-! 9 Apr 2009, Ferd Sauter (RIVM): v3.8.2 bug fix in temperature
+! 9 Apr 2009, (RIVM): v3.8.2 bug fix in temperature
! v3.8.2 correction factor Baldocchi BT
!
-! 6 July 2009, Ferd Sauter (RIVM): v3.9 call added to calculate Rstom with Emberson
+! 6 July 2009, (RIVM): v3.9 call added to calculate Rstom with Emberson
! v3.9
!
! 13 Aug 2009, Margreet van Zanten (RIVM): Emberson update, PARshade and PARsun added
@@ -310,13 +313,13 @@
! 9 Sep 2009, Margreet van Zanten (RIVM): calc of PARdir and PARdiff in Emberson
! according to Weiss and Norman 1985
!
-! 22 Sep 2009, Ferd Sauter (RIVM): gstom of Emberson scaled with diffc/dO3 (instead of
+! 22 Sep 2009, (RIVM): gstom of Emberson scaled with diffc/dO3 (instead of
! v3.10 erroneously with dwat)
!
! 24 Sep 2009, Margreet van Zanten (RIVM): choices made on lu classes, F_phen set to 1
! since described effect is negligible for chosen lu's
!
-! 29 Sep 2009, Ferd Sauter (RIVM): Emberson parameterisation of leaf area index (rc_lai);
+! 29 Sep 2009, (RIVM): Emberson parameterisation of leaf area index (rc_lai);
! new subroutine arguments for DEPAC: day_of_year and lat (latitude).
!
! 2 Oct 2009, Margreet van Zanten (RIVM): v3.10 Merged version of earlier version of 3.10 and 3.9.2
@@ -363,14 +366,14 @@
! calling depac routine for several components in a row (esp. NO after NH3),
! ccomp_tot added as optional argument to rc_special routine
!
-! 04 Jan 2010, Ferd Sauter (RIVM): v3.16 is shell around versions 3.11 ('new' DEPAC for NH3 only)
+! 04 Jan 2010, (RIVM): v3.16 is shell around versions 3.11 ('new' DEPAC for NH3 only)
! v3.16 and 3.3 (old DEPAC for other species).
! This file is constructed as follows:
! module m_depac311
! module m_depac33
! module m_depac316
!
-! 04 Jan 2010, Ferd Sauter (RIVM): iopt_debug -> optional writing of debug output
+! 04 Jan 2010, (RIVM): iopt_debug -> optional writing of debug output
! v3.16 added to m_depac311 and m_depac33 in this file
!
! 04 Jan 2010, Margreet van Zanten(RIVM): frozen version of depac v3.16, renamed in depac_GCN2010
@@ -450,7 +453,7 @@ END SUBROUTINE get_version_depac
! depac: compute total canopy (or surface) resistance Rc for gases
!-------------------------------------------------------------------
subroutine depac318(compnam, day_of_year, lat, t, ust, glrad, sinphi, rh, nwet, lu, iratns, rc_tot, &
- c_ave_prev, catm, ccomp_tot, &
+ c_ave_prev_nh3, c_ave_prev_so2, catm, ccomp_tot, &
ra, rb, rc_eff)
!DEC$ ATTRIBUTES DLLEXPORT:: depac318
@@ -462,11 +465,11 @@ subroutine depac318(compnam, day_of_year, lat, t, ust, glrad, sinphi, rh, nwet,
!
! B. compute Rc (incl. new parameterisation Rw) and compensation points (used for LOTOS-EUROS):
! call depac (compnam, day_of_year, lat, t, ust, glrad, sinphi, rh, nwet, lu, iratns, rc_tot, &
-! c_ave_prev, catm, ccomp_tot)
+! c_ave_prev_nh3, c_ave_prev_so2, catm, ccomp_tot)
!
! C. compute effective Rc based on compensation points, incl. new parameterisation Rw (used for OPS):
! call depac (compnam, day_of_year, lat, t, ust, glrad, sinphi, rh, nwet, lu, iratns, rc_tot, &
-! c_ave_prev, catm, ccomp_tot, &
+! c_ave_prev_nh3, c_ave_prev_so2, catm, ccomp_tot, &
! ra, rb, rc_eff)
implicit none
@@ -490,8 +493,10 @@ subroutine depac318(compnam, day_of_year, lat, t, ust, glrad, sinphi, rh, nwet,
real , intent(out) :: rc_tot ! total canopy resistance Rc (s/m)
! optional arguments needed only if compensation points are computed
-real, optional , intent(in) :: c_ave_prev ! air concentration averaged over a previous
- ! period (e.g. previous year or month) (ug/m3)
+real, optional , intent(in) :: c_ave_prev_nh3 ! air concentration averaged over a previous
+ ! period (e.g. previous year or month) (ug/m3)
+real, optional , intent(in) :: c_ave_prev_so2 ! air concentration averaged over a previous
+ ! period (e.g. previous year or month) (ug/m3)
real, optional , intent(in) :: catm ! actual atmospheric concentration (ug/m3)
real, optional , intent(out) :: ccomp_tot ! total compensation point (ug/m3)
@@ -546,8 +551,8 @@ subroutine depac318(compnam, day_of_year, lat, t, ust, glrad, sinphi, rh, nwet,
call rc_rctot(gstom,gsoil_eff,gw,gc_tot,rc_tot)
! Compensation points:
- if (present(c_ave_prev) .and. present(catm) .and. present(ccomp_tot)) then
- call rc_comp_point(compnam,lu,day_of_year,t,catm,c_ave_prev,gw,gstom,gsoil_eff,gc_tot,ccomp_tot)
+ if (present(c_ave_prev_nh3) .and. present(c_ave_prev_so2) .and. present(catm) .and. present(ccomp_tot)) then
+ call rc_comp_point(compnam,lu,day_of_year,t,catm,c_ave_prev_nh3,c_ave_prev_so2,gw,gstom,gsoil_eff,gc_tot,ccomp_tot)
! Effective Rc based on compensation points:
if (present(rc_eff)) then
@@ -1503,7 +1508,7 @@ end subroutine rc_rctot
!-------------------------------------------------------------------
! rc_comp_point: calculate compensation points (stomata, external leaf)
!-------------------------------------------------------------------
-subroutine rc_comp_point(compnam,lu,day_of_year,t,catm,c_ave_prev,gw,gstom,gsoil_eff,gc_tot,ccomp_tot)
+subroutine rc_comp_point(compnam,lu,day_of_year,t,catm,c_ave_prev_nh3,c_ave_prev_so2,gw,gstom,gsoil_eff,gc_tot,ccomp_tot)
! Calculate ccomp, i.e. compensation point for NH3, for different deposition path ways
! (external leaf, stomata, soil), according to Roy Wichink Kruit article submitted 2009 Atm. Env.
@@ -1518,7 +1523,7 @@ subroutine rc_comp_point(compnam,lu,day_of_year,t,catm,c_ave_prev,gw,gstom,gsoil
! The [NH4+]/[H+] ratio gamma depends on
! 1. for stomata
! the average concentration over a previous period:
-! gamma_stom = gamma_stom_c_fac * c_ave_prev
+! gamma_stom = gamma_stom_c_fac * c_ave_prev_nh3
!
! 2. for external leaf
! actual atmospheric concentration at 4 m. and surface temperature:
@@ -1538,8 +1543,11 @@ subroutine rc_comp_point(compnam,lu,day_of_year,t,catm,c_ave_prev,gw,gstom,gsoil
integer, intent (in) :: day_of_year ! day of year
real, intent(in) :: t ! temperature (C)
real, intent(in) :: catm ! actual atmospheric concentration (ug/m3)
-real, intent(in) :: c_ave_prev ! air concentration averaged over a previous
- ! period (e.g. previous year or month) (ug/m3)
+real, intent(in) :: c_ave_prev_nh3 ! air concentration averaged over a previous
+ ! period (e.g. previous year or month) (ug/m3)
+!real, optional, intent(in) :: c_ave_prev_so2 ! air concentration averaged over a previous
+real, intent(in) :: c_ave_prev_so2 ! air concentration averaged over a previous
+ ! period (e.g. previous year or month) (ug/m3)
real, intent(in) :: gw ! external leaf conductance (m/s)
real, intent(in) :: gstom ! stomatal conductance (m/s)
real, intent(in) :: gsoil_eff ! effective soil conductance (m/s)
@@ -1560,6 +1568,7 @@ subroutine rc_comp_point(compnam,lu,day_of_year,t,catm,c_ave_prev,gw,gstom,gsoil
real :: gamma_w ! [NH4+]/[H+] ratio in external leaf surface water
real :: tk ! temperature (K)
real :: tfac ! temperature factor = (2.75e15/tk)*exp(-1.04e4/tk)
+real :: co_dep_fac ! co-deposition factor
real , dimension(nlu) :: gamma_stom_c_fac ! factor in linear relation between gamma_stom and NH3
! air concentration; gamma_stom = [NH4+]/[H+] ratio in apoplast
@@ -1595,10 +1604,10 @@ subroutine rc_comp_point(compnam,lu,day_of_year,t,catm,c_ave_prev,gw,gstom,gsoil
tfac = (2.75e15/tk)*exp(-1.04e4/tk)
! Stomatal compensation point:
- if (LAI_present .and. c_ave_prev .gt. 0.) then
+ if (LAI_present .and. c_ave_prev_nh3 .gt. 0.) then
! gamma_stom ([NH4+]/[H+] ratio in apoplast) is linearly dependent on an
! averaged air concentration in a previous period (stored in soil and leaves):
- gamma_stom = gamma_stom_c_fac(lu)*c_ave_prev*4.7*exp(-0.071*t)
+ gamma_stom = gamma_stom_c_fac(lu)*c_ave_prev_nh3*4.7*exp(-0.071*t)
! calculate stomatal compensation point for NH3 in ug/m3:
cstom = max(0.0,gamma_stom*tfac)
@@ -1609,15 +1618,29 @@ subroutine rc_comp_point(compnam,lu,day_of_year,t,catm,c_ave_prev,gw,gstom,gsoil
! External leaf gamma depends on atmospheric concentration and
! surface temperature (assumed to hold for all land use types with vegetation):
- if (SAI_present) then
+! if (SAI_present .and. present(catm) .and. present(c_ave_prev_nh3) .and. present(c_ave_prev_so2) .and. c_ave_prev_nh3 .gt. 0. .and. c_ave_prev_so2 .gt. 0.) then
+ if (SAI_present .and. c_ave_prev_nh3 .gt. 0. .and. c_ave_prev_so2 .gt. 0.) then
+ gamma_w = -850.+1840.*catm*exp(-0.11*t)
+ ! correction gamma_w for co deposition
+ ! xxx documentation to be added
+ ! gamma(with SNratio) = [1.12-1.32*SNratio(molair)] * gamma_original
+ ! where SNratio(molar) = (CSO2longterm/64)/(CNH3longterm/17))
+ ! where CSO2longterm and CNH3longterm in ug m-3.
+ co_dep_fac = 1.12 - 1.32 * ((c_ave_prev_so2/64.)/(c_ave_prev_nh3/17.))
+ co_dep_fac = max(0.0,co_dep_fac)
+ gamma_w = co_dep_fac * gamma_w
+ cw = max(0.0,gamma_w*tfac)
+! elseif (SAI_present .and. present(catm)) then
+ elseif (SAI_present) then
gamma_w = -850.+1840.*catm*exp(-0.11*t)
cw = max(0.0,gamma_w*tfac)
else
cw = 0.0
endif
-
+
+
! Soil compensation point:
- if (c_ave_prev .gt. 0. .and. gamma_soil_c_fac(lu) > 0) then
+ if (c_ave_prev_nh3 .gt. 0. .and. gamma_soil_c_fac(lu) > 0) then
if (lu .eq. 6)then
! gamma_soil for water is determined to be 430 based on Waterbase data,
! here it is 'calculated' analogous to the other gamma_stom
@@ -1625,7 +1648,7 @@ subroutine rc_comp_point(compnam,lu,day_of_year,t,catm,c_ave_prev,gw,gstom,gsoil
else
! gamma_soil ([NH4+]/[H+] ratio in soil) is linearly dependent on an
! averaged air concentration in a previous period:
- gamma_soil = gamma_soil_c_fac(lu)*c_ave_prev
+ gamma_soil = gamma_soil_c_fac(lu)*c_ave_prev_nh3
endif
! calculate soil compensation point for NH3 in ug/m3:
csoil = gamma_soil*tfac
@@ -1653,7 +1676,7 @@ end subroutine rc_comp_point
! old name: NH3rc (see depac v3.6 is based on Avero workshop Marc Sutton. p. 173.
! Sutton 1998 AE 473-480)
!
-! Documentation by Ferd Sauter, 2008; see also documentation block in header of this module.
+! Documentation by , 2008; see also documentation block in header of this module.
!
diff --git a/m_error.f90 b/m_error.f90
index 850a052..ae5868f 100644
--- a/m_error.f90
+++ b/m_error.f90
@@ -1,21 +1,24 @@
-!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
+!-------------------------------------------------------------------------------------------------------------------------------
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! MODULE : m_error
! FILENAME : %M%
@@ -24,7 +27,7 @@
! BRANCH - SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR : Martien de Haan (ARIS)
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM/LLO
! LANGUAGE : FORTRAN-F90
! DESCRIPTION : Handling of errors occurring in ops.
diff --git a/m_fileutils.f90 b/m_fileutils.f90
index d1b84c6..3b77498 100644
--- a/m_fileutils.f90
+++ b/m_fileutils.f90
@@ -1,21 +1,24 @@
-!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
+!-------------------------------------------------------------------------------------------------------------------------------
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! MODULE : fileutils
! NAME : %M%
@@ -24,7 +27,7 @@
! BRANCH -SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR :
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM/LLO/IS
! LANGUAGE : FORTRAN-90
! DESCRIPTION : This module contains all utilities handling files.
@@ -76,7 +79,7 @@ MODULE m_fileutils
! PURPOSE : Checking the existence of a file. If the file does not exist the error message is assigned. The callback of the
! error is not assigned, so that it appears the non-existing error is detected in the calling procedure (which is
! what the user wants to know).
-! AUTHOR : Martien de Haan (ARIS).
+! AUTHOR : OPS-support .
! INPUTS : fname (character*(*)). The full path of the file.
! OUTPUTS : error (type TError). Is assigned when the file does not exist.
! RESULT : .TRUE. when the file exists, .FALSE. if not.
@@ -88,7 +91,7 @@ MODULE m_fileutils
!-------------------------------------------------------------------------------------------------------------------------------
! FUNCTION : sysopen
! PURPOSE : Opens a file for reading or writing.
-! AUTHOR : Erik Bobeldijk/Franka Loeve (Cap Volmac)
+! AUTHOR : OPS-support
! INPUTS : iu (integer*4). Unit number of file.
! filename (character*(*)). Path of file to be opened.
! rw (character*(*)). Whether reading or writing. Options:
@@ -109,7 +112,7 @@ MODULE m_fileutils
!-------------------------------------------------------------------------------------------------------------------------------
! SUBROUTINE : sysclose
! PURPOSE : Closes a file. Low level.
-! AUTHOR : Erik Bobeldijk/Franka Loeve (Cap Volmac)
+! AUTHOR : OPS-support
! ADAPTATIONS : 2002 - Error handling through error object (Martien de Haan, ARIS).
! INPUTS : iu (integer*4). Unit number of file.
! filename (character*(*)). Name of file. Only relevant when error is written.
@@ -123,7 +126,7 @@ MODULE m_fileutils
! SUBROUTINE : sysread
! PURPOSE : Reads a string from an input device.
! PRECONDITION: Input file: Ascii, recordlength <= 512
-! AUTHOR : Erik Bobeldijk/Franka Loeve (Cap Volmac)
+! AUTHOR : OPS-support
! ADAPTATIONS : 2002 - Error handling through error object (Martien de Haan, ARIS).
! INPUTS : iu (integer*4). Unit number of file.
! OUTPUTS : end_of_file (logical) Whether end-of-file was reached, so that nothing was read.
@@ -467,7 +470,7 @@ END SUBROUTINE sys_close_file
!-------------------------------------------------------------------------------------------------------------------------------
! SUBROUTINE: sysopen_read
! PURPOSE : Opening of text file for reading. See interface definition
-! AUTHOR : Erik Bobeldijk/Franka Loeve (Cap Volmac)
+! AUTHOR : OPS-support
!-------------------------------------------------------------------------------------------------------------------------------
SUBROUTINE sysopen_read(iu, fnam, io_status)
@@ -499,7 +502,7 @@ END SUBROUTINE sysopen_read
!-------------------------------------------------------------------------------------------------------------------------------
! SUBROUTINE: sysopen_read_bin
! PURPOSE : Opening of binary file for reading.
-! AUTHOR : Erik Bobeldijk/Franka Loeve (Cap Volmac)
+! AUTHOR : OPS-support
!-------------------------------------------------------------------------------------------------------------------------------
SUBROUTINE sysopen_read_bin(iu, fnam, io_status)
@@ -528,7 +531,7 @@ END SUBROUTINE sysopen_read_bin
!-------------------------------------------------------------------------------------------------------------------------------
! SUBROUTINE: sysopen_write
! PURPOSE : Opening of text file for writing.
-! AUTHOR : Erik Bobeldijk/Franka Loeve (Cap Volmac)
+! AUTHOR : OPS-support
!-------------------------------------------------------------------------------------------------------------------------------
SUBROUTINE sysopen_write(iu, fnam, io_status)
@@ -564,7 +567,7 @@ END SUBROUTINE sysopen_write
!-------------------------------------------------------------------------------------------------------------------------------
! SUBROUTINE: sysopen_direct
! PURPOSE : Opening of direct-access file for reading.
-! AUTHOR : Erik Bobeldijk/Franka Loeve (Cap Volmac)
+! AUTHOR : OPS-support
!-------------------------------------------------------------------------------------------------------------------------------
SUBROUTINE sysopen_direct(iu, fnam, LREC, io_status)
@@ -601,7 +604,7 @@ END SUBROUTINE sysopen_direct
!-------------------------------------------------------------------------------------------------------------------------------
! SUBROUTINE: sysread
! PURPOSE : Reading a string from a file
-! AUTHOR : Erik Bobeldijk/Franka Loeve (Cap Volmac)
+! AUTHOR : OPS-support
!-------------------------------------------------------------------------------------------------------------------------------
SUBROUTINE sys_read_string(fdin, in_str, end_of_file, error)
diff --git a/m_geoutils.f90 b/m_geoutils.f90
index 10d159a..9aee7a2 100644
--- a/m_geoutils.f90
+++ b/m_geoutils.f90
@@ -1,21 +1,24 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! MODULE : geoutils
! IMPLEMENTS : - amc2geo: conversion of RDM to geographical lon-lat coordinates
@@ -26,7 +29,7 @@
! BRANCH -SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR :
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM LLO
! LANGUAGE : FORTRAN-90
! DESCRIPTION : This module contains geographical utilities.
diff --git a/m_getkey.f90 b/m_getkey.f90
index de59a43..2542ab4 100644
--- a/m_getkey.f90
+++ b/m_getkey.f90
@@ -1,21 +1,24 @@
-!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
+!-------------------------------------------------------------------------------------------------------------------------------
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! MODULE : getkey
! IMPLEMENTS : Generic functions GetKeyValue and GetCheckedKey.
@@ -25,7 +28,7 @@
! BRANCH - SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR : Martien de Haan (ARIS)
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM/LLO
! LANGUAGE : FORTRAN-90
! DESCRIPTION : Checks name of parameter and extracts a value for that parameter, or sets a default.
@@ -73,33 +76,30 @@ MODULE m_getkey
! FUNCTION : GetCheckedKey
! DESCRIPTION : This function checks a string for the name of input parameter. Then the value of the parameter is extracted and
! assigned to it. This function also checks whether the parameter is inside a specified range. If no value is
-! extracted, a default is set.
+! extracted a default is set.
! INPUTS : parname (character*(*)). Name of the parameter.
! lower (type, type is generic). Lower limit of value allowed.
! upper (type, type is generic). Upper limit of value allowed.
-! isrequired (logical) Whether a value is required. If not, a default can be assigned.
+! isrequired (logical) Whether a value is required. If not a default can be assigned.
! OUTPUTS : value (type, type is generic) value assigned to the parameter.
! error (TError object). Assigned when an error occurred.
! RESULT : Logical. False if an error was detected.
! REMARK : GetCheckedKey is generic for the following types:
! integer*4
! real*4
-! logical
-! real*4
-! REMARK2 : A special GetCheckedKey instance (check_exist_file) checks filepaths and has a different argument list (isrequired is not passed):
-! INPUTS
-! parname (character*(*)) Name of the parameter.
-! checkdefine(logical) file name must be defined (must be present on the input line); note that this is not checked if checkexist is .false.
-! checkexists(logical) file name must exist
-! OUTPUTS
-! value (character*(*)) The name of the file
-! error (TError object). Assigned when an error occurred.
+! REMARK2 : A special checked key instance checks filepaths and has a different profile (isrequired is not passed):
+! : parname (character*(*)). Name of the parameter. checkdefine(logical). If flag is set: test whether name was
+! entered.
+! checkexists(logical) If flag is set: test whether file path is present, otherwise an error is returned.
+! value (character*(*)) Output: the path of the file. the parameter.
+! error (TError object). Assigned when an error occurred.
!-------------------------------------------------------------------------------------------------------------------------------
INTERFACE GetCheckedKey
MODULE PROCEDURE check_range_real
MODULE PROCEDURE check_range_integer
MODULE PROCEDURE check_range_integer_array
MODULE PROCEDURE check_exist_file
+ MODULE PROCEDURE check_range_string
END INTERFACE
!-------------------------------------------------------------------------------------------------------------------------------
@@ -542,7 +542,7 @@ FUNCTION check_range_real(parname,lower,upper,isrequired, value, error)
!-------------------------------------------------------------------------------------------------------------------------------
!
-! Retrieve the integer value for parname.
+! Retrieve the real value for parname.
!
check_range_real = .TRUE.
IF (GetKeyValue(parname, value, error)) THEN
@@ -678,7 +678,7 @@ FUNCTION check_range_integer_array(parname, lower, upper, isrequired, nword, val
LOGICAL :: check_range_integer_array !
!-------------------------------------------------------------------------------------------------------------------------------
!
-! Retrieve the integer value for parname.
+! Retrieve the integer array value for parname.
!
check_range_integer_array = .TRUE.
IF (checkparname(parname,string , error)) THEN
@@ -792,24 +792,12 @@ FUNCTION check_exist_file(parname, checkdefine, checkexist, filename, error)
USE m_fileutils
! SUBROUTINE ARGUMENTS - INPUT
-CHARACTER*(*), INTENT(IN) :: parname ! name of the parameter
-LOGICAL, INTENT(IN) :: checkdefine ! file name must be defined (must be present on the input line); note that this is not checked if checkexist is .false.
-LOGICAL, INTENT(IN) :: checkexist ! file name must exist
-
- ! if checkexist -> if filename empty -> if checkdefine -> error
- ! -> if NOT checkdefine -> OK
- ! if filename not empty -> file exists -> OK
- ! -> file does not exist -> error
- ! if NOT checkexist -> OK (no checks)
-
- ! Special case checkdefine = .TRUE.
- ! if checkexist -> if filename empty -> error
- ! if filename not empty -> file exists -> OK
- ! -> file does not exist -> error
- ! if NOT checkexist -> OK (no checks)
+CHARACTER*(*), INTENT(IN) :: parname !
+LOGICAL, INTENT(IN) :: checkdefine ! if set and checkexist set, this function
+LOGICAL, INTENT(IN) :: checkexist ! if set, this function checks whether filename
! SUBROUTINE ARGUMENTS - OUTPUT
-CHARACTER*(*), INTENT(OUT) :: filename ! name of the file
+CHARACTER*(*), INTENT(OUT) :: filename !
TYPE (TError), INTENT(OUT) :: error ! error handling record
! RESULT
@@ -858,4 +846,70 @@ FUNCTION check_exist_file(parname, checkdefine, checkexist, filename, error)
END FUNCTION check_exist_file
+!-------------------------------------------------------------------------------------------------------------------------------
+! SUBROUTINE : check_range_string
+! DESCRIPTION : This function checks a string for the name of the parameter. Then the string value of the parameter is
+! extracted and assigned to the parameter.
+! If no value is extracted a default is set (empty string). If a value is extracted it is checked whether the value lies
+! within input limits (for strings, the lower and upper limits are normally the same, which means that the input string
+! must be equal to the limit values.
+! RESULT : False if an error was detected.
+! CALLED FUNCTIONS : get_key
+!-------------------------------------------------------------------------------------------------------------------------------
+FUNCTION check_range_string(parname,lower,upper,isrequired, value, error)
+
+!DEC$ ATTRIBUTES DLLEXPORT:: check_range_real
+
+! SUBROUTINE ARGUMENTS - INPUT
+CHARACTER*(*), INTENT(IN) :: parname ! parameter name
+CHARACTER*(*), INTENT(IN) :: lower ! lower limit of value
+CHARACTER*(*), INTENT(IN) :: upper ! upper limit of value
+LOGICAL, INTENT(IN) :: isrequired ! whether a value is required
+
+! SUBROUTINE ARGUMENTS - OUTPUT
+CHARACTER*(*), INTENT(OUT) :: value ! string value extracted
+TYPE (TError), INTENT(OUT) :: error ! error handling record
+
+! RESULT
+LOGICAL :: check_range_string !
+
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! Retrieve the string value for parname.
+!
+check_range_string = .TRUE.
+IF (GetKeyValue(parname, value, error)) THEN
+!
+! Check whether a value is required
+!
+ IF (isrequired ) THEN
+!
+! Check lower limit.
+!
+ IF (value.LT.lower) THEN
+ CALL SetError('Value read is below allowed lower limit', error)
+ GOTO 1000
+ ENDIF
+!
+! Check upper limit.
+!
+ IF (value.GT.upper) THEN
+ CALL SetError('Value read is above allowed upper limit', error)
+ GOTO 1000
+ ENDIF
+ ENDIF
+ENDIF
+
+RETURN
+!
+! Range error occurred. Append some parameters to error.
+!
+1000 CALL ErrorParam('parameter', parname, error)
+CALL ErrorParam('value read', value, error)
+CALL ErrorParam('lower limit', lower, error)
+CALL ErrorParam('upper limit', upper, error)
+check_range_string = .FALSE.
+
+END FUNCTION check_range_string
+
END MODULE m_getkey
diff --git a/m_ops_building.f90 b/m_ops_building.f90
index de2724a..90ef777 100644
--- a/m_ops_building.f90
+++ b/m_ops_building.f90
@@ -1,22 +1,18 @@
-!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
-! National Institute of Public Health and Environment
-! Laboratory for Air Research (RIVM/LLO)
-! The Netherlands
-!-------------------------------------------------------------------------------------------------------------------------------
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
module m_ops_building
implicit none
@@ -26,11 +22,11 @@ module m_ops_building
! General setup up of multi dimensional lookup table
!
! 1) Class definition file:
-! A file with n parameters at n rows; each row contains a parameter with a generic names of the parameter in the first column,
+! A file with n parameters at n rows; each row contains a parameter with a generic names of the parameter in the first column,
! followed by a number of columns with representative parameter values for each class. Note that each parameter can have a different number of classes.
! Example file:
! p1 5.0 9.0 16.0 25 50 75 100
-! p2 5.0 9.0 20.0
+! p2 5.0 9.0 20.0
! **
! pn 10 20 30 40 50 60
!
@@ -38,11 +34,11 @@ module m_ops_building
!
! 2) Lookup table:
! Table with n + 1 columns containing the class indices for n parameters and the associated building effect factor.
-! Example lookup table
+! Example lookup table
! 1. last parameter varies first, then last but one, ... THIS IS ESSENTIAL FOR CORRECT READING OF THE DATA!
! 2. ! Last two parameters must be (source-receptor angle, source-receptor distance
! p1 p2 *** pn buildingFact
-! 1 1 1 2.20
+! 1 1 1 2.20
! 1 1 2 2.10
! 1 1 3 1.90
! 1 1 4 1.85
@@ -51,7 +47,7 @@ module m_ops_building
! 1 2 1 2.30
! 1 2 2 2.15
! .......
-! 3 2 5 1.26
+! 3 2 5 1.26
! 3 2 6 1.05
!
! Note that class i of a parameter corresponds to column i+1 for this parameter in the class definition file.
@@ -65,7 +61,7 @@ module m_ops_building
integer, parameter :: mClass = 100 ! maximal number of classes for any parameter
! Define parameter names - these must be the same as the parameters as filled into valueArray (see ops_bron_rek) - distance must be last parameter !
-!character(len=200) :: buildingParamNames(3) = (/'hEmis', 'angleSRxaxis', 'distance' /) ! 3 parameters, simple test
+!character(len=200) :: buildingParamNames(3) = (/'hEmis', 'angleSRxaxis', 'distance' /) ! 3 parameters, simple test
character(len=200) :: buildingParamNames(9) = (/'hEmis', 'V_stack', 'D_stack', 'buildingHeight', 'buildingLength', 'buildingWLRatio', 'buildingOrientation', 'angleSRxaxis', 'distance' /) ! 9 parameters
! character(len=200) :: buildingParamNames(7) = (/'hEmis', 'V_stack', 'D_stack', 'buildingHeight', 'buildingLength', 'buildingWLRatio', 'distance' /) ! 7 parameters
! character(len=200) :: buildingParamNames(4) = (/'V_stack', 'buildingHeight', 'hEmis', 'distance' /) ! simple test with 4 parameters
@@ -75,23 +71,23 @@ module m_ops_building
real :: width ! building width [m]
real :: height ! building height [m]
real :: orientation ! building orientation (degrees w.r.t. North)
- real, allocatable :: buildingFactFunction(:,:) ! building effect function (function of source receptor angle, source receptor distance)
+ real, allocatable :: buildingFactFunction(:,:) ! building effect function (function of source receptor angle, source receptor distance)
integer :: type ! building type for determining distance function for building effect [-]; type = 0 -> no building effect
-End Type Tbuilding
+End Type Tbuilding
type TbuildingEffect
integer :: nParam ! number of building parameters (read from file)
- real, allocatable :: classdefinitionArray(:) ! array with representative class values for each parameter
+ real, allocatable :: classdefinitionArray(:) ! array with representative class values for each parameter
! (stored in one-dimensional array: [nClass(1) values for p1, nClass(2) values for p2, ...])
- integer :: nClass(mParam) ! number of classes for each parameter
- real :: minClass(mParam) ! minimum of class values for each parameter
- real :: maxClass(mParam) ! maximum of class values for each parameter
+ integer :: nClass(mParam) ! number of classes for each parameter
+ real :: minClass(mParam) ! minimum of class values for each parameter
+ real :: maxClass(mParam) ! maximum of class values for each parameter
real, allocatable :: buildingFactArray(:) ! building effect factors for each parameter/class, stored in a one-dimensional array
real, allocatable :: buildingFactAngleSRxaxis(:) ! source receptor angles (w.r.t. x-axis) where to evaluate 2D function of building effect
real, allocatable :: buildingFactDistances(:) ! distances where to evaluate 2D function of building effect
end type TbuildingEffect
-contains
+contains
!-----------------------------------------------------------------------------------
subroutine ops_building_file_names(error)
@@ -129,16 +125,16 @@ subroutine ops_building_read_tables(buildingEffect, error)
! Output:
type(tbuildingEffect), intent(out) :: buildingEffect ! structure containing data for building effect
type(Terror), intent(out) :: error ! error handling record
-
-! Local:
+
+! Local:
integer :: nClassProd ! product of number of classes for each parameter
! Read classes for building parameters:
-call ops_building_read_classes(mParam, mClass, buildingEffect%classdefinitionArray, buildingEffect%buildingFactAngleSRxaxis, buildingEffect%buildingFactDistances, &
+call ops_building_read_classes(mParam, mClass, buildingEffect%classdefinitionArray, buildingEffect%buildingFactAngleSRxaxis, buildingEffect%buildingFactDistances, &
buildingEffect%nParam, buildingEffect%nClass, buildingEffect%minClass, buildingEffect%maxClass, nClassProd, error)
if (error%haserror) goto 9999
-
-! Read building factors:
+
+! Read building factors:
call ops_building_read_building_factors(mClass, buildingEffect%nParam, nClassProd, buildingEffect%nClass, buildingEffect%buildingFactArray, error)
if (error%haserror) goto 9999
@@ -149,31 +145,31 @@ subroutine ops_building_read_tables(buildingEffect, error)
end subroutine ops_building_read_tables
!-----------------------------------------------------------------------------------
-subroutine ops_building_read_classes(mParam, mClass, &
+subroutine ops_building_read_classes(mParam, mClass, &
classdefinitionArray, buildingFactAngleSRxaxis, buildingFactDistances, nParam, nClass, minClass, maxClass, nClassProd, error)
-
+
use m_commonfile, only: buildingClassFilename, fu_tmp
use m_error
use m_fileutils
CHARACTER*512, PARAMETER :: ROUTINENAAM = 'ops_building_read_classes'
-
+
! Input:
integer, intent(in) :: mParam ! maximal number of parameters
integer, intent(in) :: mClass ! maximal number of classes for any parameter
! Output:
- real, allocatable, intent(out) :: classdefinitionArray(:) ! array with representative class values for each parameter
+ real, allocatable, intent(out) :: classdefinitionArray(:) ! array with representative class values for each parameter
! (stored in one-dimensional array: [nClass(1) values for p1, nClass(2) values for p2, ...])
- real, allocatable, intent(out) :: buildingFactAngleSRxaxis(:) ! source rceptor angles (w.r.t. x-axis) where to evaluate 2D function of building effect
- real, allocatable, intent(out) :: buildingFactDistances(:) ! distances where to evaluate 2D function of building effect
+ real, allocatable, intent(out) :: buildingFactAngleSRxaxis(:) ! source rceptor angles (w.r.t. x-axis) where to evaluate 2D function of building effect
+ real, allocatable, intent(out) :: buildingFactDistances(:) ! distances where to evaluate 2D function of building effect
integer, intent(out) :: nParam ! actual number of parameters (read from file)
- integer, intent(out) :: nClass(mParam) ! number of classes for each parameter
- real , intent(out) :: minClass(mParam) ! minimum of class values for each parameter
- real , intent(out) :: maxClass(mParam) ! maximum of class values for each parameter
+ integer, intent(out) :: nClass(mParam) ! number of classes for each parameter
+ real , intent(out) :: minClass(mParam) ! minimum of class values for each parameter
+ real , intent(out) :: maxClass(mParam) ! maximum of class values for each parameter
integer, intent(out) :: nClassProd ! product of number of classes for each parameter
type(Terror), intent(out) :: error ! error handling record
-
+
! Local:
real :: classdefinitionArrayTemp(mClass*mParam) ! temporary array for reading classdefinitionArray
integer :: iParam ! index of parameter
@@ -182,16 +178,16 @@ subroutine ops_building_read_classes(mParam, mClass, &
character(100) :: pName ! parameter name
real :: pVals( mClass ) ! representative parameter values for classes for one parameter
integer :: n ! number of values read from file
- character(100) :: paramNames(mParam) ! parameter names
+ character(100) :: paramNames(mParam) ! parameter names
integer :: nClassSum ! sum of number of classes for each parameter
! Initialisation:
iParam = 0
ilast = 0 ! index of last value in classdefinitionArrayTemp
-
+
! Open file:
IF (.NOT. sysopen(fu_tmp, buildingClassFilename, 'r', 'class definition file for building effect', error)) GOTO 9999
-
+
! Loop over lines in file:
do
! Read line from file and split into name and values:
@@ -206,30 +202,30 @@ subroutine ops_building_read_classes(mParam, mClass, &
iParam = iParam + 1
if (iParam .gt. mParam) then
call SetError('Too many parameters in file ',error)
- call ErrorParam('maximal number of parameters allowed', mParam, error)
+ call ErrorParam('maximal number of parameters allowed', mParam, error)
goto 9998
endif
-
+
! Set number of classes for this parameter and fill paramNames and classdefinitionArrayTemp:
nClass(iParam) = n
- paramNames(iParam) = pName
+ paramNames(iParam) = pName
classdefinitionArrayTemp(ilast+1:ilast+n) = pVals(1:n) ! note that pVals has to be sorted .. check?
- minClass(iParam) = minval(pVals(1:n))
- maxClass(iParam) = maxval(pVals(1:n))
+ minClass(iParam) = minval(pVals(1:n))
+ maxClass(iParam) = maxval(pVals(1:n))
ilast = ilast + n
endif
enddo
500 continue
close( fu_tmp )
-
+
! Now we know the number of parameters and the number of classes:
nParam = iParam
- nClassSum = sum(nClass(1:nParam))
- nClassProd = product(nClass(1:nParam))
-
+ nClassSum = sum(nClass(1:nParam))
+ nClassProd = product(nClass(1:nParam))
+
! Check:
if (ilast .ne. nClassSum) then
- write(*,*) 'Internal programming error in ', ROUTINENAAM
+ write(*,*) 'Internal programming error in ', ROUTINENAAM
write(*,*) 'ilast = ',ilast, ' nClassSum = ',nClassSum
write(*,*) 'ilast must be nClassSum '
stop
@@ -238,31 +234,31 @@ subroutine ops_building_read_classes(mParam, mClass, &
! Check parameter names:
if (any(paramNames(1:nParam) .ne. buildingParamNames)) then
call SetError('Error in parameter names ',error)
- call ErrorParam('parameter names in file ', paramNames(1:nParam), error)
- call ErrorParam('expected parameter names', buildingParamNames, error)
+ call ErrorParam('parameter names in file ', paramNames(1:nParam), error)
+ call ErrorParam('expected parameter names', buildingParamNames, error)
goto 9999
endif
-
- ! **** Allocate memory and fill class definition table *****
-
+
+ ! **** Allocate memory and fill class definition table *****
+
allocate(classdefinitionArray(nClassSum))
- classdefinitionArray = classdefinitionArrayTemp(1:nClassSum)
-
+ classdefinitionArray = classdefinitionArrayTemp(1:nClassSum)
+
! Allocate and fill array with source rceptor angles (w.r.t. x-axis) used to evaluate building factors
! (one but last parameter in classdefinitionArray):
- allocate(buildingFactAngleSRxaxis(nClass(nParam-1)))
+ allocate(buildingFactAngleSRxaxis(nClass(nParam-1)))
buildingFactAngleSRxaxis = classdefinitionArray(nClassSum - nClass(nParam) - nClass(nParam-1) + 1 : nClassSum - nClass(nParam))
! Allocate and fill array with distances used to evaluate building factors
! (last parameter in classdefinitionArray):
- allocate(buildingFactDistances(nClass(nParam)))
+ allocate(buildingFactDistances(nClass(nParam)))
buildingFactDistances = classdefinitionArray(nClassSum - nClass(nParam) + 1 : nClassSum)
!write(*,*) 'ops_building_read_classes/buildingFactDistances:',buildingFactDistances
!write(*,*) 'ops_building_read_classes/buildingFactAngleSRxaxis:',buildingFactAngleSRxaxis
-
+
RETURN
-
+
9998 CALL ErrorParam('line read from file', trim(line), error)
9999 CALL ErrorParam('file name', buildingClassFilename, error)
@@ -277,22 +273,22 @@ subroutine ops_building_read_building_factors(mClass, nParam, nClassProd, nClass
use m_error
use m_fileutils
- ! **** Read factors for building effects table from file *****
+ ! **** Read factors for building effects table from file *****
- CHARACTER*512, PARAMETER :: ROUTINENAAM = 'ops_building_read_building_factors'
+ CHARACTER*512, PARAMETER :: ROUTINENAAM = 'ops_building_read_building_factors'
! Input:
integer, intent(in) :: mClass ! maximal number of classes for any parameter
integer, intent(in) :: nParam ! actual number of parameters (read from file)
integer, intent(in) :: nClassProd ! product of number of classes for each parameter
- integer, intent(in) :: nClass(:) ! number of classes for each parameter
-
+ integer, intent(in) :: nClass(:) ! number of classes for each parameter
+
! Output:
real, allocatable, intent(out) :: buildingFactArray(:) ! building effect factors for each parameter/class, stored in a one-dimensional array
type(Terror), intent(out) :: error ! error handling record
- ! Local:
+ ! Local:
character(1000) :: line ! line read from file
integer :: iLine ! index of line read (includes header line)
integer :: iParam ! index of parameter
@@ -306,80 +302,80 @@ subroutine ops_building_read_building_factors(mClass, nParam, nClassProd, nClass
logical :: read_unformatted = .true. ! read unformatted file (is much faster than formatted file)
! Allocate memory for building effects table:
- allocate(buildingFactArray(nClassProd))
+ allocate(buildingFactArray(nClassProd))
if (read_unformatted) then
! Open file, read array with building factors and close file:
IF (.NOT. sysopen(fu_tmp, buildingFactFilename, 'rb', 'file with building effect factors', error)) GOTO 9999
read(fu_tmp) buildingFactArray
close(fu_tmp)
-
+
else
!------------------------------------------------------------------------------------------------------
! This part of the subroutine is not used anymore in OPS; there is a separate program to convert
! the ASCII table into an unformatted file which read musch faster. This separate program uses
! the code below.
- !------------------------------------------------------------------------------------------------------
-
+ !------------------------------------------------------------------------------------------------------
+
! Construct format for write to screen
fmt = '(i6,": ", (1x,i4),1x,f8.3)'
write(fmt(10:11),'(i2)') nParam
-
+
! Open file:
IF (.NOT. sysopen(fu_tmp, buildingFactFilename, 'r', 'file with building effect factors', error)) GOTO 9999
-
+
! Initialise:
iClassExpected = 1
-
+
! Read file until end-of-file:
- iLine = 0
+ iLine = 0
do
read( fu_tmp, "(a)", end=510 ) line
! print *,line
-
+
! Skip empty line:
if (len_trim(line) > 0) then
iLine = iLine + 1
if (iLine .eq. 1) then
! Header line
- read( line, *) colNames(1:nParam+1 )
+ read( line, *) colNames(1:nParam+1 )
!write(*,*) 'Table '
- !write(*,'(99(1x,a))') colNames(1:nParam+1 )
-
+ !write(*,'(99(1x,a))') colNames(1:nParam+1 )
+
! Check parameter names:
if (any(colNames(1:nParam) .ne. buildingParamNames)) then
call SetError('Error in parameter names ',error)
- call ErrorParam('parameter names in file ', colNames(1:nParam), error)
- call ErrorParam('expected parameter names', buildingParamNames, error)
+ call ErrorParam('parameter names in file ', colNames(1:nParam), error)
+ call ErrorParam('expected parameter names', buildingParamNames, error)
goto 9999
endif
-
+
else
! Check number of lines read:
if (iLine-1 .gt. nClassProd) then
call SetError('number of lines read from file larger than expected ',error)
- call ErrorParam('line number ', iLine, error)
+ call ErrorParam('line number ', iLine, error)
call ErrorParam('number of lines expected', nClassProd+1, error) ! including header line
goto 9998
endif
-
- ! Split line into nParam integer class indices and (last value) buiding effect factor:
- call split2( line, nParam, iClassRead, buildingFactInput)
-
- ! Check class indices read from file:
+
+ ! Split line into nParam integer class indices and (last value) buiding effect factor:
+ call split2( line, nParam, iClassRead, buildingFactInput)
+
+ ! Check class indices read from file:
if (any(iClassExpected .ne. iClassRead)) then
call SetError('Incorrect set of class indices.','Last index must vary fastest, then last but one, ...',error)
- call ErrorParam('line number ', iLine, error)
- call ErrorParam('expected class indices', iClassExpected, error)
+ call ErrorParam('line number ', iLine, error)
+ call ErrorParam('expected class indices', iClassExpected, error)
goto 9998
endif
-
+
! Shift to next set of class indices ((must be in order for routine SILUPM: last index varies fast, then last but one, ...):
shiftNext = .true.
iParam = nParam
- do while (shiftNext .and. iParam .ge. 1)
+ do while (shiftNext .and. iParam .ge. 1)
iClassExpected(iParam) = iClassExpected(iParam) + 1
-
+
! If this parameter exceeds the number of classes -> reset to 1 and shift to next parameter:
if (iClassExpected(iParam) .gt. nClass(iParam)) then
iClassExpected(iParam) = 1
@@ -389,43 +385,43 @@ subroutine ops_building_read_building_factors(mClass, nParam, nClassProd, nClass
endif
iParam = iParam - 1
enddo
-
+
! Fill building effect factor into buildingFactArray;
! order of lines is essential here and has been checked above (iClassRead = iClassExpected). See definition SILUPM for 2D array ((y(x1(i), x2(j)), j=1:NTAB(2)), i=1:NTAB(1))
! if (iLine .le. 3) write(*,fmt) iLine-1,iClassRead(1:nParam),buildingFactInput
- buildingFactArray(iLine-1) = buildingFactInput
- endif ! iLine .eq. 1
+ buildingFactArray(iLine-1) = buildingFactInput
+ endif ! iLine .eq. 1
endif ! len_trim(line) > 0
enddo
510 continue
close( fu_tmp )
-
+
! write(*,'(a)') '............................'
! write(*,fmt) iLine-1,iClassRead(1:nparam),buildingFactInput
-
+
! Check number of lines read:
if (iLine-1 .ne. nClassProd) then
call SetError('number of lines read from file smaller than expected ',error)
- call ErrorParam('line number ', iLine, error)
+ call ErrorParam('line number ', iLine, error)
call ErrorParam('number of lines expected', nClassProd+1, error) ! including header line
goto 9999
endif
endif ! read_unformatted
-
+
! **** Printing/checking building effects table *****
- if (.FALSE.) then
+ if (.FALSE.) then
do i = 1,nClassProd
print *, i, buildingFactArray(i)
enddo
endif
RETURN
-
+
9998 CALL ErrorParam('line read from file', trim(line), error)
-
+
9999 CALL ErrorParam('file name', buildingFactFilename, error)
CALL ErrorCall(ROUTINENAAM, error)
-
+
end subroutine ops_building_read_building_factors
!-----------------------------------------------------------------------------------------
@@ -434,44 +430,44 @@ subroutine ops_building_get_function(nParam, valueArray, nClass, classdefinition
! Get 2D building effect function (function of source-receptor angle and distance to source) for a specific set of building parameter values in valueArray;
! interpolate this factor from factors in buildingFactArray, based on the location of valueArray within the table classdefinitionArray.
-
+
use m_error
-
+
CHARACTER*512, PARAMETER :: ROUTINENAAM = 'ops_building_get_function'
-
+
! Input:
integer, intent(IN) :: nParam ! number of parameters
- integer, intent(IN) :: nClass(nParam) ! number of classes for each parameter
+ integer, intent(IN) :: nClass(nParam) ! number of classes for each parameter
real, intent(IN) :: classdefinitionArray(:) ! array with representative class values for each parameter
real, intent(IN) :: buildingFactAngleSRxaxis(:) ! source-receptor angles (w.r.t. x-axis) where to evaluate 2D building effect function
real, intent(IN) :: buildingFactDistances(:) ! distances where to evaluate 2D building effect function
real, intent(IN) :: buildingFactArray(:) ! building effect factors for each parameter/class.
-
+
! Input/output:
real, intent(INOUT) :: valueArray(nParam) ! array with set of parameter values for specific building (output: values outside table are moved to boundaries of table)
-
+
! Output:
real, allocatable, intent(OUT) :: buildingFactFunction(:,:) ! 2D buiding effect function for specific building (function of angle, distance)
type(Terror), intent(out) :: error ! error handling record
- ! Arguments for SILUPM
+ ! Arguments for SILUPM
! Local variables for SILUPM
- integer :: NTAB(2*nParam+1)
- integer :: NDEG(nParam)
- integer :: LUP(nParam)
+ integer :: NTAB(2*nParam+1)
+ integer :: NDEG(nParam)
+ integer :: LUP(nParam)
integer :: IOPT(3) ! options used for output of SILUPM
- real :: EOPT(6*nParam) ! error estimate
-
- ! Local:
- integer :: iParam ! parameter index
+ real :: EOPT(6*nParam) ! error estimate
+
+ ! Local:
+ integer :: iParam ! parameter index
integer :: ix, iy ! loop indices
-
- ! print *, "Building effects table from within subroutine getbuildingEffect"
+
+ ! print *, "Building effects table from within subroutine getbuildingEffect"
! do ix = 1,size(buildingFactArray)
! print *, ix, buildingFactArray(ix)
! enddo
-
-! ! Interpolate multidimensional table:
+
+! ! Interpolate multidimensional table:
! ! CALL SILUPM(NDIM, X, Y, NTAB, XT, YT, NDEG, LUP, IOPT, EOPT)
! ! NDIM = nParam
! ! X = ValueArray (input for a specific building)
@@ -483,23 +479,23 @@ subroutine ops_building_get_function(nParam, valueArray, nClass, classdefinition
! ! LUP = type of lookup method (binary search or sequntial search, see doc SILUPM)
! ! IOPT = options used for output
-
+
NTAB(1:nParam) = nClass(1:nParam)
NTAB(nParam+1) = 0 ! as required by SILUPM
NDEG = 1
LUP = 1 ! binary search
-
+
! Set IOPT:
- IOPT(1) = 1
+ IOPT(1) = 1
!IOPT(2) = 0
!IOPT(3) = 0
- IOPT(2) = 6*nParam; ! size(EOPT)
+ IOPT(2) = 6*nParam; ! size(EOPT)
IOPT(3) = 0
-
+
! Loop over distances for building effect function:
- allocate(buildingFactFunction(size(buildingFactAngleSRxaxis),size(buildingFactDistances)))
+ allocate(buildingFactFunction(size(buildingFactAngleSRxaxis),size(buildingFactDistances)))
- ! write(*,*) '==================================================================================='
+ ! write(*,*) '==================================================================================='
! write(*,*) 'ops_building_get_function/valueArray = ',ValueArray
! write(*,*) 'ops_building_get_function/buildingFactAngleSRxaxis: ', buildingFactAngleSRxaxis
! write(*,*) 'ops_building_get_function/buildingFactDistances: ', buildingFactDistances
@@ -510,34 +506,34 @@ subroutine ops_building_get_function(nParam, valueArray, nClass, classdefinition
! Loop over angles and distances for building effect function:
do iy = 1,size(buildingFactDistances)
do ix = 1,size(buildingFactAngleSRxaxis)
-
+
! Put current angle, distance as last two values in valueArray:
- valueArray(nParam-1) = buildingFactAngleSRxaxis(ix)
- valueArray(nParam) = buildingFactDistances(iy)
-
+ valueArray(nParam-1) = buildingFactAngleSRxaxis(ix)
+ valueArray(nParam) = buildingFactDistances(iy)
+
! Look up building factor in table and put factor into buildingFactFunction(ix,iy):
CALL SILUPM(nParam, ValueArray, buildingFactFunction(ix,iy), NTAB, classdefinitionArray, buildingFactArray, NDEG, LUP, IOPT, EOPT)
enddo
enddo
-
+
! do ix = 1,size(buildingFactAngleSRxaxis)
! write(*,*) 'ops_building_get_function/buildingFactFunction for angle ',buildingFactAngleSRxaxis(ix),'degrees : ', buildingFactFunction(ix,:)
! enddo
- ! write(*,*) '==================================================================================='
-
+ ! write(*,*) '==================================================================================='
+
if (IOPT(1) .ne. 0) then
if (IOPT(1) .eq. 1) then
call SetError('Error in look up in table of building factors; parameter values outside domain of the table ',error)
else
- call ErrorParam('error status (see documentation netlib/SILUPM) ', IOPT(1), error)
+ call ErrorParam('error status (see documentation netlib/SILUPM) ', IOPT(1), error)
endif
- call ErrorParam('parameter names ', buildingParamNames, error)
- call ErrorParam('parameter values ', valueArray, error)
+ call ErrorParam('parameter names ', buildingParamNames, error)
+ call ErrorParam('parameter values ', valueArray, error)
goto 9999
endif
RETURN
-
+
9999 CALL ErrorCall(ROUTINENAAM, error)
end subroutine ops_building_get_function
@@ -556,11 +552,11 @@ end subroutine ops_building_get_function
! BRANCH - SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR : Sjoerd van Ratingen
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM/LLO
! LANGUAGE : FORTRAN-77/90
-! DESCRIPTION : Returns closest and interpolated building effect based on "buildingEffectTable",
-! DESCRIPTION : given a source catergory and a distance from source to receptor.
+! DESCRIPTION : Returns closest and interpolated building effect based on "buildingEffectTable",
+! DESCRIPTION : given a source catergory and a distance from source to receptor.
! EXIT CODES :
! FILES I/O DEVICES :
! SYSTEM DEPENDENCIES : HP Fortran
@@ -575,11 +571,11 @@ SUBROUTINE ops_building_get_factor(buildingType, angle_SR_xaxis, dist, buildingF
! Note the cut-off value of 50 m from the source.
! CONSTANTS
-CHARACTER*512 :: ROUTINENAAM !
+CHARACTER*512 :: ROUTINENAAM !
PARAMETER (ROUTINENAAM = 'ops_building_get_factor')
! SUBROUTINE ARGUMENTS - INPUT
-INTEGER, INTENT(IN) :: buildingType ! = 0 -> no building effect (factor = 1)
+INTEGER, INTENT(IN) :: buildingType ! = 0 -> no building effect (factor = 1)
REAL*4, INTENT(IN) :: angle_SR_xaxis ! angle between source-receptor vector and x-axis (needed for building effect) [degrees]
REAL*4, INTENT(IN) :: dist ! distance between source and receptor
REAL*4, INTENT(IN) :: buildingFactDistances(:) ! distances for which building effect function has been computed
@@ -601,7 +597,7 @@ SUBROUTINE ops_building_get_factor(buildingType, angle_SR_xaxis, dist, buildingF
distcor = max(dist,buildingFactDistances(1))
! If source receptor distance larger than largest distance in table -> no building effect; else interpolate building factor from 2d table:
-
+
if (distcor > buildingFactDistances(size(buildingFactDistances))) then
buildingFact = 1.0
else
@@ -630,24 +626,24 @@ real function interpol_2d(tabx,taby,f,nx,ny,x,y)
integer :: i,ix,iy ! array indices
real :: x_intp,y_intp ! 1D interpolation factors
-! Check if outside tabel boundaries (normally this should not occur, because values have been shifted
+! Check if outside tabel boundaries (normally this should not occur, because values have been shifted
! inside table boundaries before call -> normal error handling not needed):
if (x < tabx(1) .or. x > tabx(nx)) then
write(*,*) ' '
- write(*,*) ' error: x index outside table'
+ write(*,*) ' error: x index outside table'
write(*,*) ' boundaries: ',tabx(1), tabx(nx)
write(*,*) ' value : ',x
stop
endif
if (y < taby(1) .or. y > taby(ny)) then
write(*,*) ' '
- write(*,*) ' error: y index outside table'
+ write(*,*) ' error: y index outside table'
write(*,*) ' boundaries: ',taby(1), taby(ny)
write(*,*) ' value : ',y
stop
endif
-
-! Find index ix, such that tabx(ix) < x <= tabx(ix+1)
+
+! Find index ix, such that tabx(ix) < x <= tabx(ix+1)
! Note: first interval includes left boundary: tabx(1) <= x <= tabx(2)
do i = 1,nx-1
if (x <= tabx(i+1)) then
@@ -676,58 +672,58 @@ end function interpol_2d
!-------------------------------------------------------------------------------------------
subroutine split1( mClass, line, pName , pVals, n )
-
+
implicit none
-
+
! Input:
integer, intent(IN) :: mClass ! maximal number of classes for any parameter
character(*), intent(in) :: line ! line read from file with parameter names and parameter values
-
+
! Output:
character(100), intent(out) :: pName ! parameter name
real, intent(out) :: pVals(*) ! parameter values
integer, intent(out) :: n ! number of parameter values read
-
+
! Local
character*100 :: cbuf( mClass )
integer :: m
- ! Read word for word from line:
+ ! Read word for word from line:
n = 1
do
read( line, *, end=100) cbuf( 1 : n) ! !! (See Appendix for why buf is used here)
read(cbuf(1),*) pName
do m = 2,n
- read(cbuf(m),*) pVals(m-1)
+ read(cbuf(m),*) pVals(m-1)
!print *, pVals(m)
enddo
n = n + 1
enddo
100 continue
n = n - 1 ! length of cbuf
- n = n - 1 ! number of reals behind first column with parameter name
+ n = n - 1 ! number of reals behind first column with parameter name
end subroutine split1
!-------------------------------------------------------------------------------------------
-subroutine split2( line, nParam, iClassRead, buildingFactInput)
-
+subroutine split2( line, nParam, iClassRead, buildingFactInput)
+
implicit none
-
+
! Input:
character(*), intent(in) :: line ! line read from file with class indices for each parameter and corresponding building effect factor
integer, intent(in) :: nParam ! number of parameters
-
+
! Output:
integer, intent(out) :: iClassRead(nParam) ! class indices for each parameter
real, intent(out) :: buildingFactInput ! buiding effect factor, read from input
-
+
! Local variables:
character*8 :: cbuf( nParam+1 )
integer :: iParam
- ! Read data from line:
+ ! Read data from line:
read( line, *) (iClassRead(iParam), iParam = 1,nParam), buildingFactInput
-
+
end subroutine split2
-
+
end module m_ops_building
diff --git a/m_ops_emis.f90 b/m_ops_emis.f90
index d0e9e3f..8d76f9d 100644
--- a/m_ops_emis.f90
+++ b/m_ops_emis.f90
@@ -1,26 +1,22 @@
-!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
-! National Institute of Public Health and Environment
-! Laboratory for Air Research (RIVM/LLO)
-! The Netherlands
-!-------------------------------------------------------------------------------------------------------------------------------
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
module m_ops_emis
-! Emission module, contains subroutines to read emissions.
-
+! Emission module, contains subroutines to read emissions.
+
implicit none
PRIVATE ! default for module
@@ -46,7 +42,7 @@ SUBROUTINE ops_emis_read_header(fu_bron, brn_version, VsDs_opt, nrec, numbron, e
IMPLICIT NONE
! CONSTANTS
-CHARACTER*512 :: ROUTINENAAM
+CHARACTER*512 :: ROUTINENAAM
PARAMETER (ROUTINENAAM = 'ops_emis_read_header')
! SUBROUTINE ARGUMENTS - INPUT
@@ -69,14 +65,14 @@ SUBROUTINE ops_emis_read_header(fu_bron, brn_version, VsDs_opt, nrec, numbron, e
!-------------------------------------------------------------------------------------------------------------------------------
-! Initialisation:
+! Initialisation:
numbron = 0
nrec = 0
end_of_info = .FALSE.
! Default (if no ! BRN-VERSION can be found) -> old brn-file, no stack parameters:
brn_version = 0
-VsDs_opt = .FALSE.
+VsDs_opt = .FALSE.
! Read first header line:
CALL sysread(fu_bron, cbuf, end_of_info, error)
@@ -107,7 +103,7 @@ SUBROUTINE ops_emis_read_header(fu_bron, brn_version, VsDs_opt, nrec, numbron, e
call SetError('Error while reading BRN-VERSION version_number in first line of header', error)
goto 9999
endif
-
+
! Read rest of header lines:
DO WHILE (.NOT. end_of_info)
CALL sysread(fu_bron, cbuf, end_of_info, error)
@@ -115,7 +111,7 @@ SUBROUTINE ops_emis_read_header(fu_bron, brn_version, VsDs_opt, nrec, numbron, e
IF (error%haserror) GOTO 9999
IF (cbuf(1:1) .NE. "!") THEN
end_of_info = .TRUE.
-
+
! First real emission record has been reached, so we backspace 1 line:
backspace(fu_bron)
nrec = nrec - 1
@@ -137,7 +133,7 @@ SUBROUTINE ops_emis_read_annual1(fu_bron, icm, check_psd, presentcode, brn_versi
! Read one data line from the emission file (brn-file; brn << bron = source)) and return emission parameters.
! Emission parameters that lie outside a specified range generate an error.
-! This subroutine supports old type of emission files (with no BRN-VERSION header or BRN-VERSION 1
+! This subroutine supports old type of emission files (with no BRN-VERSION header or BRN-VERSION 1
! both in fixed format (old type of brn-files) and free format and extended free format (with V_stack, D_stack, Ts_stack) .
USE m_error
@@ -151,7 +147,7 @@ SUBROUTINE ops_emis_read_annual1(fu_bron, icm, check_psd, presentcode, brn_versi
IMPLICIT NONE
! CONSTANTS
-CHARACTER*512 :: ROUTINENAAM
+CHARACTER*512 :: ROUTINENAAM
PARAMETER (ROUTINENAAM = 'ops_emis_read_annual1')
! SUBROUTINE ARGUMENTS - INPUT
@@ -169,11 +165,11 @@ SUBROUTINE ops_emis_read_annual1(fu_bron, icm, check_psd, presentcode, brn_versi
! SUBROUTINE ARGUMENTS - INPUT/OUTPUT
INTEGER, INTENT(INOUT) :: nrec ! record number of source file
INTEGER, INTENT(INOUT) :: numbron ! number of (selected) source
-LOGICAL, INTENT(INOUT) :: building_present1 ! at least one building is present in the source file
+LOGICAL, INTENT(INOUT) :: building_present1 ! at least one building is present in the source file
! SUBROUTINE ARGUMENTS - OUTPUT
INTEGER, INTENT(OUT) :: mm ! source identification number [-]
-REAL , INTENT(OUT) :: x ! x coordinate of source location (RDM [m])
+REAL , INTENT(OUT) :: x ! x coordinate of source location (RDM [m])
REAL , INTENT(OUT) :: y ! y coordinate of source location (RDM [m])
REAL , INTENT(OUT) :: qob ! emission strength [g/s]
REAL , INTENT(OUT) :: qww ! heat content [MW]
@@ -194,8 +190,8 @@ SUBROUTINE ops_emis_read_annual1(fu_bron, icm, check_psd, presentcode, brn_versi
! LOCAL VARIABLES
INTEGER :: ierr ! I/O error value
-REAL :: gl ! x coordinate of source location (longitude [degrees])
-REAL :: gb ! y coordinate of source location (latitude [degrees])
+REAL :: gl ! x coordinate of source location (longitude [degrees])
+REAL :: gb ! y coordinate of source location (latitude [degrees])
CHARACTER*512 :: cbuf ! character buffer, used to store an emission record
real :: Ts_stack_C ! temperature of effluent from stack [C]
@@ -217,53 +213,53 @@ SUBROUTINE ops_emis_read_annual1(fu_bron, icm, check_psd, presentcode, brn_versi
! Read string cbuf from emission file:
CALL sysread(fu_bron, cbuf, end_of_file, error)
-IF (error%haserror) GOTO 9999
+IF (error%haserror) GOTO 9999
-IF (.NOT. end_of_file) THEN
+IF (.NOT. end_of_file) THEN
IF (brn_version .GE. 1) THEN
!*************************************************************************
- ! New brn-file, free format
- ! BRN-VERSION 1 -> no D_stack, V_stack, Ts_stack
- ! BRN-VERSION 2 -> include D_stack, V_stack, Ts_stack
- ! BRN-VERSION 3 -> include D_stack, V_stack, Ts_stack, building%type
+ ! New brn-file, free format
+ ! BRN-VERSION 1 -> no D_stack, V_stack, Ts_stack
+ ! BRN-VERSION 2 -> include D_stack, V_stack, Ts_stack
+ ! BRN-VERSION 3 -> include D_stack, V_stack, Ts_stack, building%type
! BRN-VERSION 4 -> free format, include include D_stack, V_stack, Ts_stack, building%length, building%width, building%height, building%orientation
!*************************************************************************
idgr=-999
-
+
! Read emission line:
IF (VsDs_opt) then
IF (brn_version .GE. 4) THEN
READ (cbuf, *, IOSTAT = ierr) mm, x, y, qob, qww, hbron, diameter, szopp, D_stack, V_stack, Ts_stack_C, ibtg, ibroncat, iland, idgr, &
building%length, building%width, building%height, building%orientation
-
+
! Building orientation must be between 0 and 180 degrees:
- if (.not. is_missing (building%orientation)) building%orientation = modulo(building%orientation, 180.0)
-
+ if (.not. is_missing (building%orientation)) building%orientation = modulo(building%orientation, 180.0)
+
! Set flag if one building is present:
- if (.not. building_present1) building_present1 = (.not. (is_missing(building%length) .or. is_missing(building%width) .or. is_missing(building%height) .or. is_missing(building%orientation)))
-
+ if (.not. building_present1) building_present1 = (.not. (is_missing(building%length) .or. is_missing(building%width) .or. is_missing(building%height) .or. is_missing(building%orientation)))
+
ELSEIF (brn_version .EQ. 3) THEN
READ (cbuf, *, IOSTAT = ierr) mm, x, y, qob, qww, hbron, diameter, szopp, D_stack, V_stack, Ts_stack_C, ibtg, ibroncat, iland, idgr, building%type
-
- ELSE
+
+ ELSE
READ (cbuf, *, IOSTAT = ierr) mm, x, y, qob, qww, hbron, diameter, szopp, D_stack, V_stack, Ts_stack_C, ibtg, ibroncat, iland, idgr
ENDIF
-
+
! Negative V_stack in input -> horizontal outflow (except V_stack = -999 -> missing value):
if (V_stack .lt. 0.0 .and. .not. is_missing(V_stack)) then
V_stack = -V_stack
emis_horizontal = .TRUE.
endif
-
+
ELSE
READ (cbuf, *, IOSTAT = ierr) mm, x, y, qob, qww, hbron, diameter, szopp, ibtg, ibroncat, iland, idgr
ENDIF
! write(*,*) 'ops_read_source VsDs_opt = ',VsDs_opt
! write(*,'(a,i6,10(1x,e12.5),4(1x,i4),1x,l6)') 'ops_read_source a ',mm, x, y, qob, qww, hbron, diameter, szopp, D_stack, V_stack, Ts_stack_C, ibtg, ibroncat, iland, idgr,emis_horizontal
- ! write(*,*) 'ops_read_source a, nrec, ierr = ',nrec,ierr
-
+ ! write(*,*) 'ops_read_source a, nrec, ierr = ',nrec,ierr
+
IF (ierr == 0) THEN
-
+
! Convert lon-lat coordinates to RDM coordinates; lon-lat coordinates are detected if the value read for y is less than 90 degrees:
IF ( abs(y) .LT. 90 ) THEN
gb = y
@@ -275,45 +271,45 @@ SUBROUTINE ops_emis_read_annual1(fu_bron, icm, check_psd, presentcode, brn_versi
ENDIF
ELSE
!*******************************************************
- ! Old brn-file, fixed format
+ ! Old brn-file, fixed format
! Reading of D_stack, V_stack, Ts_stack not supported.
!*******************************************************
! In the old format, if there is a dot at position 9, coordinates are assumed to be lon-lat
IF ( cbuf(9:9) .EQ. '.' ) THEN
-
- ! Read source record with lon-lat coordinates (gl,gb)
+
+ ! Read source record with lon-lat coordinates (gl,gb)
! "g" << geographical coordinates; "l" << lengtegraad = longitude, "b" << breedtegraad = latitude
READ (cbuf, 100, IOSTAT = ierr) mm, gl, gb, qob, qww, hbron, diameter, szopp, ibtg, ibroncat, iland, idgr
IF (ierr == 0) THEN
-
+
! Convert lon-lat coordinates to RDM coordinates
CALL geo2amc(gb, gl, x, y) ! (x,y) in km
x = AINT(x*1000.) ! [m]
y = AINT(y*1000.) ! [m]
ENDIF
ELSE
-
+
! Read source record with RDM coordinates:
READ (cbuf, 150, IOSTAT = ierr) mm, x, y, qob, qww, hbron, diameter, szopp, ibtg, ibroncat, iland, idgr
ENDIF
ENDIF ! IF (brn_version .GE. 1)
- ! Current emission record has been read and coordinates have been converted to RDM;
+ ! Current emission record has been read and coordinates have been converted to RDM;
! add 1 to record number (unless ierr < 0 = end-of-file):
- IF (ierr .GE. 0 ) nrec = nrec + 1
- ! write(*,*) 'nrec, ierr = ',nrec,ierr
- ! write(*,'(a,a)') 'cbuf: ',trim(cbuf)
-
+ IF (ierr .GE. 0 ) nrec = nrec + 1
+ ! write(*,*) 'nrec, ierr = ',nrec,ierr
+ ! write(*,'(a,a)') 'cbuf: ',trim(cbuf)
+
IF (ierr == 0) THEN
-
+
! Check emission strength, heat content, emission height and diameter area source.
- ! Note: check is only performed inside check_source2 if no error has occurred;
+ ! Note: check is only performed inside check_source2 if no error has occurred;
! therefore there is no need to check for error%haserror here each time.
- ! JA* check is only needed if source is selected.
- !
-
- ! Check range for
+ ! JA* check is only needed if source is selected.
+ !
+
+ ! Check range for
! deviation : 0 <= szopp <= hbron
! diurnal variation : -999 <= ibtg <= 999
! emission category : 1 <= ibroncat <= 9999
@@ -322,7 +318,7 @@ SUBROUTINE ops_emis_read_annual1(fu_bron, icm, check_psd, presentcode, brn_versi
if (brn_version .lt. 2) then
! Adjust value within range and continue OPS; write warning to log-file (backward compatibility for old emission files):
CALL check_source (nrec, '', 0., 99999., qob, error)
- if (.not. is_missing(qww)) CALL check_source(nrec, '', 0., 999., qww, error)
+ if (.not. is_missing(qww)) CALL check_source(nrec, '', 0., 999., qww, error)
CALL check_source (nrec, '', 0., 5000.0, hbron, error)
CALL check_source (nrec, '',-999999., 999999., diameter, error)
CALL check_source (nrec, '', 0., hbron, szopp, error)
@@ -334,7 +330,7 @@ SUBROUTINE ops_emis_read_annual1(fu_bron, icm, check_psd, presentcode, brn_versi
else
! Generate error and stop OPS:
CALL check_source2('', 0., 99999., qob, error)
- if (.not. is_missing(qww)) CALL check_source2('', 0., 999., qww, error)
+ if (.not. is_missing(qww)) CALL check_source2('', 0., 999., qww, error)
! CALL check_source2('', 0., HUMAX, hbron, error)
CALL check_source2('', 0., 5000.0, hbron, error)
CALL check_source2('',-999999., 999999., diameter, error)
@@ -343,7 +339,7 @@ SUBROUTINE ops_emis_read_annual1(fu_bron, icm, check_psd, presentcode, brn_versi
CALL check_isource2('', 1, 9999, ibroncat, error)
CALL check_isource2('', 1, 9999, iland, error)
CALL check_isource2('', -999, MAXDISTR, idgr, error)
-
+
! Check stack parameters:
call check_stack_param(qww, VsDs_opt, D_stack, V_stack, Ts_stack_C, error)
@@ -357,26 +353,26 @@ SUBROUTINE ops_emis_read_annual1(fu_bron, icm, check_psd, presentcode, brn_versi
call check_building_param(building, hbron, qww, D_stack, V_stack, error)
endif
endif
-
+
if (VsDs_opt) then
! Convert Ts_stack to K:
if (is_missing(Ts_stack_C)) then
Ts_stack = Ts_stack_C
else
- Ts_stack = Ts_stack_C + T0
+ Ts_stack = Ts_stack_C + T0
endif
endif
-
+
! Check whether ibtg and idgr distributions in this record have been read (using presentcode array).
! Check whether ibtg is not for NH3 (icm=3) and NOx (icm=2) if a special diurnal variation (4 or 5) is used.
- ! Check whether particle size distribution has been read.
+ ! Check whether particle size distribution has been read.
IF (.NOT.((icm == 2 .OR. icm == 3) .AND. (ibtg == 4 .OR. ibtg == 5))) THEN
CALL check_verdeling(ibtg, presentcode, 1, 3, 'ibtg', error)
ENDIF
- IF (check_psd) THEN
+ IF (check_psd) THEN
CALL check_verdeling(idgr, presentcode, 2, 4, 'idgr', error)
ENDIF
- IF (error%haserror) GOTO 9999
+ IF (error%haserror) GOTO 9999
ELSE
@@ -400,7 +396,7 @@ END SUBROUTINE ops_emis_read_annual1
! SUBROUTINE NAME : check_source
! DESCRIPTION : check whether a source parameter lies within a specified range. If not, the paramater is fixed at either
! the lower or upper limit of the range. In this case, a warning is written to the log file;
-! this warning includes the record number of the source.
+! this warning includes the record number of the source.
! Included for backward compatibility of old source files; better use check_source2.
! CALLED FUNCTIONS :
!-------------------------------------------------------------------------------------------------------------------------------
@@ -411,7 +407,7 @@ SUBROUTINE check_source(nr, varnaam, onder, boven, varwaarde, error)
USE m_commonconst, only: EPS_DELTA
! CONSTANTS
-CHARACTER*512 :: ROUTINENAAM
+CHARACTER*512 :: ROUTINENAAM
PARAMETER (ROUTINENAAM = 'check_source')
! SUBROUTINE ARGUMENTS - INPUT
@@ -496,7 +492,7 @@ END SUBROUTINE check_source
! SUBROUTINE NAME : check_isource
! DESCRIPTION : check whether an integer source parameter lies within a specified range. If not, the paramater is fixed at either
! the lower or upper limit of the range. In this case, a warning is written to the log file;
-! this warning includes the record number of the source.
+! this warning includes the record number of the source.
! Included for backward compatibility of old source files; better use check_isource2.
! CALLED FUNCTIONS :
!-------------------------------------------------------------------------------------------------------------------------------
@@ -505,7 +501,7 @@ SUBROUTINE check_isource(nr, varnaam, onder, boven, varwaarde, error)
USE m_error
! CONSTANTS
-CHARACTER*512 :: ROUTINENAAM
+CHARACTER*512 :: ROUTINENAAM
PARAMETER (ROUTINENAAM = 'check_source')
! SUBROUTINE ARGUMENTS - INPUT
@@ -519,7 +515,7 @@ SUBROUTINE check_isource(nr, varnaam, onder, boven, varwaarde, error)
TYPE (TError), INTENT(INOUT) :: error ! error handling record
! LOCAL VARIABLES
-REAL*4 :: var ! help variable (= float(varwaarde))
+REAL*4 :: var ! help variable (= float(varwaarde))
var = FLOAT(varwaarde)
CALL check_source(nr, varnaam, FLOAT(onder), FLOAT(boven), var, error)
@@ -540,7 +536,7 @@ SUBROUTINE check_source2(varnaam, onder, boven, varwaarde, error)
USE m_commonconst, only: EPS_DELTA
! CONSTANTS
-CHARACTER*512 :: ROUTINENAAM
+CHARACTER*512 :: ROUTINENAAM
PARAMETER (ROUTINENAAM = 'check_source2')
! SUBROUTINE ARGUMENTS - INPUT
@@ -587,7 +583,7 @@ SUBROUTINE check_source3(warning1, varnaam, onder, boven, varwaarde, error)
USE m_commonfile, only: fu_log
! CONSTANTS
-CHARACTER*512 :: ROUTINENAAM
+CHARACTER*512 :: ROUTINENAAM
PARAMETER (ROUTINENAAM = 'check_source3')
! SUBROUTINE ARGUMENTS - INPUT
@@ -612,10 +608,10 @@ SUBROUTINE check_source3(warning1, varnaam, onder, boven, varwaarde, error)
CALL ErrorParam(trim(varnaam), varwaarde, error)
CALL ErrorParam('upper limit', boven, error)
CALL ErrorCall(ROUTINENAAM, error)
-
+
! Reset error message (only warning):
error%haserror = .FALSE.
-
+
! Write warning to log file:
CALL WriteError(fu_log, error)
@@ -637,7 +633,7 @@ SUBROUTINE check_isource2(varnaam, onder, boven, varwaarde, error)
USE m_error
! CONSTANTS
-CHARACTER*512 :: ROUTINENAAM
+CHARACTER*512 :: ROUTINENAAM
PARAMETER (ROUTINENAAM = 'check_source2')
! SUBROUTINE ARGUMENTS - INPUT
@@ -666,15 +662,15 @@ SUBROUTINE check_verdeling(icode, presentcode, stdclass, usdclass, parname, erro
USE m_commonconst, only: MAXDISTR
! CONSTANTS
-CHARACTER*512 :: ROUTINENAAM
+CHARACTER*512 :: ROUTINENAAM
PARAMETER (ROUTINENAAM = 'check_verdeling')
! SUBROUTINE ARGUMENTS - INPUT
-INTEGER*4, INTENT(IN) :: icode ! code that has to be checked;
+INTEGER*4, INTENT(IN) :: icode ! code that has to be checked;
! if icode < 0 -> check whether a user defined distribution is present
! if icode > 0 -> check whether a standard distribution is present
! if icode = 0 -> do not check anything
-LOGICAL, INTENT(IN) :: presentcode(MAXDISTR,4)
+LOGICAL, INTENT(IN) :: presentcode(MAXDISTR,4)
INTEGER*4, INTENT(IN) :: stdclass ! index of standard distributions in 2nd dimension of presentcode
INTEGER*4, INTENT(IN) :: usdclass ! index of user defined distributions in 2nd dimension of presentcode
CHARACTER*(*), INTENT(IN) :: parname ! parameter name in error messages
@@ -722,7 +718,7 @@ SUBROUTINE check_stack_param(qww, VsDs_opt, D_stack, V_stack, Ts_stack_C, error)
USE m_commonconst, only: EPS_DELTA
! CONSTANTS
-CHARACTER*512 :: ROUTINENAAM
+CHARACTER*512 :: ROUTINENAAM
PARAMETER (ROUTINENAAM = 'check_stack_param')
! SUBROUTINE ARGUMENTS - INPUT
@@ -749,14 +745,14 @@ SUBROUTINE check_stack_param(qww, VsDs_opt, D_stack, V_stack, Ts_stack_C, error)
if (is_missing(qww)) then
CALL SetError('Heat content (Qw) must be specified', error)
CALL ErrorParam('Qw', qww, error)
- CALL ErrorCall(ROUTINENAAM, error)
+ CALL ErrorCall(ROUTINENAAM, error)
endif
endif
! Check ranges:
! (for the check on Ts_stack_C -> see also check in m_ops_plume_rise - ops_plumerise_qw_Ts)
if (.not. is_missing(D_stack)) CALL check_source2('' , 0.01 , 30.0 , D_stack, error) ! Infomil NNM 2.1.2 - Modelinvoer
-if (.not. is_missing(V_stack)) CALL check_source2('' , 0.0 , 50.0 , V_stack, error) ! V_stack = 0 is ok; in this case Qw = 0. Upper limit V_stack?
+if (.not. is_missing(V_stack)) CALL check_source2('' , 0.0 , 50.0 , V_stack, error) ! V_stack = 0 is ok; in this case Qw = 0. Upper limit V_stack?
if (.not. is_missing(Ts_stack_C)) CALL check_source2('' , 0.0 , 2000.0 , Ts_stack_C, error) ! temperature waste burning ~ 1300 C
! Check whether V_stack = 0 and Qw > 0 -> error
@@ -765,7 +761,7 @@ SUBROUTINE check_stack_param(qww, VsDs_opt, D_stack, V_stack, Ts_stack_C, error)
CALL SetError('If exit velocity (V_stack) is zero, then heat content (Qw) must be zero also.','Use V_stack = -999. if you only want to specify Qw.', error)
CALL ErrorParam('V_stack', V_stack, error)
CALL ErrorParam('Qw', qww, error)
- CALL ErrorCall(ROUTINENAAM, error)
+ CALL ErrorCall(ROUTINENAAM, error)
endif
endif
@@ -773,7 +769,7 @@ END SUBROUTINE check_stack_param
!-------------------------------------------------------------------------------------------------------------------------------
! SUBROUTINE NAME : check_building_param
-! DESCRIPTION : Check building parameters
+! DESCRIPTION : Check building parameters
! CALLED FUNCTIONS :
!-------------------------------------------------------------------------------------------------------------------------------
SUBROUTINE check_building_param(building, hbron, qww, D_stack, V_stack, error)
@@ -785,7 +781,7 @@ SUBROUTINE check_building_param(building, hbron, qww, D_stack, V_stack, error)
USE m_commonfile, only: fu_log
! CONSTANTS
-CHARACTER*512 :: ROUTINENAAM
+CHARACTER*512 :: ROUTINENAAM
PARAMETER (ROUTINENAAM = 'check_building_param')
! Input:
@@ -806,27 +802,27 @@ SUBROUTINE check_building_param(building, hbron, qww, D_stack, V_stack, error)
! Set width/length ratio:
if (building%length > 0.0) then
- wlRatio = building%width/building%length
+ wlRatio = building%width/building%length
else
! if length = 0 -> buildingType = 0 (see below)
wlRatio = HUGE(1.0)
endif
-
- ! If values outside limits -> warning
- ! limits based on data for 2500 animal houses in 2018
+
+ ! If values outside limits -> warning
+ ! limits based on data for 2500 animal houses in 2018
! Note that it is already checked that all building dimensions (length, width, height) have been specified
- ! Open log file if not already open:
+ ! Open log file if not already open:
call ops_openlog(error)
if (error%haserror) goto 9999
-
+
! Error if Qw must be specified (= 0) and cannot be missing:
if (is_missing(qww)) then
CALL SetError('If building is present, then heat content (Qw) must be zero (cannot be missing).', error)
CALL ErrorParam('Qw', qww, error)
- goto 9999
+ goto 9999
endif
-
+
! Warnings if value is outside table boundaries:
CALL check_source3('check table building effect ','' , 0.0 , 20.0 , building%height, error)
if (.not. is_missing(hbron)) CALL check_source3('check table building effect ','' , 0.0 , 20.0 , hbron, error)
@@ -836,9 +832,9 @@ SUBROUTINE check_building_param(building, hbron, qww, D_stack, V_stack, error)
CALL check_source3('check table building effect ','' , 0.15 , 1.0 , wlRatio, error)
CALL check_source3('check table building effect ','' , 10.0 , 105.0 , building%length, error)
CALL check_source3('check table building effect ','' , 0.0 , 180.0 , building%orientation, error)
-
+
endif
-
+
RETURN
9999 CALL ErrorCall(ROUTINENAAM, error)
diff --git a/m_ops_plumerise.f90 b/m_ops_plumerise.f90
index a1b57ad..64ac3bb 100644
--- a/m_ops_plumerise.f90
+++ b/m_ops_plumerise.f90
@@ -1,26 +1,22 @@
-!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
-! National Institute of Public Health and Environment
-! Laboratory for Air Research (RIVM/LLO)
-! The Netherlands
-!-------------------------------------------------------------------------------------------------------------------------------
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
module m_ops_plumerise
! module m_ops_plumerise with plume rise due to either buoyancy or momentum
-! Marina Sterk and Ferd Sauter 2018-02-20
+! Marina Sterk and 2018-02-20
! ops_plumerise : main routine containing the calls to different parts of the final plume rise, and the calculation of the final plume rise
! ops_plumerise_buoyancy : determine plume rise due to buoyancy
@@ -31,7 +27,7 @@ module m_ops_plumerise
! T0 = reference temperature = 273.15 K = 0 C
! P0 = reference pressure = 1 atm = 101.325 kPa
-real, parameter :: rho0 = 1.293 ! reference density air at pressure P0, temperature T0 (= 1.293 kg/m3)
+real, parameter :: rho0 = 1.293 ! reference density air at pressure P0, temperature T0 (= 1.293 kg/m3)
real, parameter :: Cp0 = 1005 ! reference specific heat of air at pressure P0, temperature T0 (= 1005 J/kg/K)
contains
@@ -40,11 +36,11 @@ module m_ops_plumerise
subroutine ops_plumerise_prelim(istab, isek, astat, hemis0, qw, D_stack, V_stack, Ts_stack, emis_horizontal, hemis1, error)
! Compute preliminary plume rise, based on stability class and preliminary wind sector (ol, uster, ... still unknown)
-
+
use m_commonconst, only: NTRAJ, NCOMP, NSTAB, NSEK
use m_ops_utils, only: is_missing
use m_error
-
+
! Input:
integer, intent(in) :: istab ! index of stability class and preliminary wind sector
integer, intent(in) :: isek ! index of preliminary wind sector (wind shear not yet taken into account)
@@ -58,12 +54,12 @@ subroutine ops_plumerise_prelim(istab, isek, astat, hemis0, qw, D_stack, V_stack
! Output:
real, intent(out) :: hemis1 ! emission height, including plume rise [m]
-type (TError), intent(out) :: error ! error handling record
+type (TError), intent(out) :: error ! error handling record
! Local:
logical :: prelim ! preliminary plume rise, based on stability class and preliminary wind sector (ol, uster, ... still unknown)
- ! if prelim = true -> ol = -999, uster = -999, z0 = -999, zmix = zmix_loc = -999
- ! these parameters are still unknown;
+ ! if prelim = true -> ol = -999, uster = -999, z0 = -999, zmix = zmix_loc = -999
+ ! these parameters are still unknown;
! wind profile is based on power law with coefficient based on stability class
logical :: VsDs_opt ! include exit velocity (Vs = V_stack), stack diameter (Ds = D_stack) and effluent temperature (Ts_stack) in the emission file
real :: dum ! dummy output of ops_plumerise
@@ -74,16 +70,16 @@ subroutine ops_plumerise_prelim(istab, isek, astat, hemis0, qw, D_stack, V_stack
prelim = .true.
VsDs_opt = .not. is_missing(V_stack)
temp_C = 12.0 ! default average value (is not a sensitive parameter for preliminary estimate)
-call ops_plumerise(-999., hemis0, -999., -999., qw, VsDs_opt, D_stack, V_stack, Ts_stack, emis_horizontal, temp_C, -999., -999., &
+call ops_plumerise(-999., hemis0, -999., -999., qw, VsDs_opt, D_stack, V_stack, Ts_stack, emis_horizontal, temp_C, -999., -999., &
hemis1, dum, error, prelim, istab, isek, astat)
! write(*,'(a,4(1x,e12.5))') 'in routine ops_plumerise_prelim a: ',hemis0,hemis1,hemis1-hemis0,-999.0
-if (error%haserror) call ErrorCall(ROUTINENAAM, error)
-
+if (error%haserror) call ErrorCall(ROUTINENAAM, error)
+
end subroutine ops_plumerise_prelim
!------------------------------------------------------------
-subroutine ops_plumerise(z0, hemis0, uster, ol, qw, VsDs_opt, D_stack, V_stack, Ts_stack, emis_horizontal, temp_C, zmix, zmix_loc, &
+subroutine ops_plumerise(z0, hemis0, uster, ol, qw, VsDs_opt, D_stack, V_stack, Ts_stack, emis_horizontal, temp_C, zmix, zmix_loc, &
hemis1, onder, error, prelim, istab, isek, astat)
! Main routine for the different plume rise calculations
@@ -103,27 +99,27 @@ subroutine ops_plumerise(z0, hemis0, uster, ol, qw, VsDs_opt, D_stack, V_stack,
real, intent(in) :: V_stack ! exit velocity of plume at stack tip [m/s]
real, intent(in) :: Ts_stack ! temperature of effluent from stack [K]
logical, intent(in) :: emis_horizontal ! horizontal outflow of emission
-real, intent(in) :: temp_C ! ambient temperature at height zmet_T [C]
-real, intent(in) :: zmix ! mixing height [m]
+real, intent(in) :: temp_C ! ambient temperature at height zmet_T [C]
+real, intent(in) :: zmix ! mixing height [m]
real, intent(in) :: zmix_loc ! mixing height, local scale [m]
-! Output
+! Output
real, intent(out) :: hemis1 ! emission height, including plume rise [m]
-real, intent(out) :: onder ! part of plume below mixing height
-type (TError), intent(out) :: error ! error handling record
+real, intent(out) :: onder ! part of plume below mixing height
+type (TError), intent(out) :: error ! error handling record
! Input, optional:
logical, intent(in), optional :: prelim ! preliminary plume rise, based on stability class and preliminary wind sector (ol, uster, ... still unknown)
- ! if prelim = true -> ol = -999, uster = -999, z0 = -999, zmix = zmix_loc = -999
- ! these parameters are still unknown;
+ ! if prelim = true -> ol = -999, uster = -999, z0 = -999, zmix = zmix_loc = -999
+ ! these parameters are still unknown;
! wind profile is based on power law with coefficient based on stability class
! if prelim = false or not present -> istab, isek are not used
- ! wind profile is computed with ops_wvprofile (logarithmic profile) using z0, ol, uster
+ ! wind profile is computed with ops_wvprofile (logarithmic profile) using z0, ol, uster
integer, intent(in), optional :: istab ! index of stability class and preliminary wind sector
integer, intent(in), optional :: isek ! index of preliminary wind sector (wind shear not yet taken into account)
real , intent(in), optional :: astat(NTRAJ, NCOMP, NSTAB, NSEK) ! statistical meteo parameters
-
-! Local
+
+! Local
real :: u_stack ! wind speed at stack height [m/s]
real :: u_threshold ! threshold wind speed at height z_u_threshold [m/s]
real :: dh_buoyancy ! plume rise due to buoyancy [m]
@@ -151,37 +147,37 @@ subroutine ops_plumerise(z0, hemis0, uster, ol, qw, VsDs_opt, D_stack, V_stack,
! write(*,'(a,4(1x,e12.5))') 'in routine ops_plumerise a: ',hemis0,hemis1,hemis1-hemis0,-999.0
-! Set fixed potential temperature gradient dtheta/dz for stable conditions.
+! Set fixed potential temperature gradient dtheta/dz for stable conditions.
! In the OPS manual (just below Eq. 4.6) it is stated that an average value of 0.006 K/m is taken as representative
-! for stable situations, following TNO (1976).
-! TNO (1976) Modellen voor de berekening van de verspreiding van luchtverontreiniging inclusief aanbevelingen voor de waarden van
+! for stable situations, following TNO (1976).
+! TNO (1976) Modellen voor de berekening van de verspreiding van luchtverontreiniging inclusief aanbevelingen voor de waarden van
! parameters in het lange-termijnmodel. Staatsuitgeverij, The Hague, the Netherlands.
-! Just above Eq. 4.3 of the OPS manual it is stated that this is the reference to the Dutch National Model.
-! However, in the manual of the NNM (March 2002), 0.006 is not used, but the profile is reviewed per 10m layer.
-! For stable conditions a dtheta/dz of at least 0.005 K/m is applied.
+! Just above Eq. 4.3 of the OPS manual it is stated that this is the reference to the Dutch National Model.
+! However, in the manual of the NNM (March 2002), 0.006 is not used, but the profile is reviewed per 10m layer.
+! For stable conditions a dtheta/dz of at least 0.005 K/m is applied.
! MS Possibly better to calculate dtheta/dz per layer as well? Also due to changing stability with height which affects plume rise?
-dthetadz_stable = 0.006
+dthetadz_stable = 0.006
-! Obtain temperature at stack height.
-! Use theta(z) = T(z) + Tau*z (Tau = 9.8*10^-3 K/m = dry adiabatic lapse rate = g/Cp) (Stull 2000, Meteorology for Scientists and Engineers, Second Edition).
+! Obtain temperature at stack height.
+! Use theta(z) = T(z) + Tau*z (Tau = 9.8*10^-3 K/m = dry adiabatic lapse rate = g/Cp) (Stull 2000, Meteorology for Scientists and Engineers, Second Edition).
!
! T(z2) - T(z1) + Tau*(z2-z1)
-! dtheta/dz = --------------------------- --> T(z2) = dtheta/dz * (z2-z1) - Tau*(z2-z1) + T(z1);
+! dtheta/dz = --------------------------- --> T(z2) = dtheta/dz * (z2-z1) - Tau*(z2-z1) + T(z1);
! z2 - z1
! T(z1) is the temperature at z1, taken as the temperature from the meteo-file at zmet_T = 1.5m height.
Ta_stack = dthetadz_stable*(hemis0-zmet_T) - (9.8e-3)*(hemis0-zmet_T) + (temp_C + T0)
! Check for non-stable (unstable/neutral) conditions:
if (prelim1) then
- non_stable = ( istab .lt. 5 )
+ non_stable = ( istab .lt. 5 )
else
- non_stable = ( ol .lt. (0. - EPS_DELTA) .or. abs(ol) .gt. 50 )
+ non_stable = ( ol .lt. (0. - EPS_DELTA) .or. abs(ol) .gt. 50 )
endif
! 1. Compute effluent temperature Ts_stack or heat content Qw depending on input specified;
! Ts missing -> compute Qw, Qw missing -> compute Ts:
call ops_plumerise_qw_Ts(VsDs_opt, qw, D_stack, V_stack, Ts_stack, emis_horizontal, Ta_stack, qw2, Ts_stack2, error)
-if (error%haserror) goto 9999
+if (error%haserror) goto 9999
! 2. Compute wind speed at stack height:
if (prelim1) then
@@ -192,17 +188,17 @@ subroutine ops_plumerise(z0, hemis0, uster, ol, qw, VsDs_opt, D_stack, V_stack,
! 3. Determine plume rise due to buoyancy. This is including iterations to resolve the interdependency between plume rise and wind speed
if (present(prelim)) then
- call ops_plumerise_buoyancy(z0,ol,uster,non_stable,qw2,Ta_stack,dthetadz_stable,u_stack,hemis0,dh_buoyancy,prelim,istab,isek,astat)
+ call ops_plumerise_buoyancy(z0,ol,uster,non_stable,qw2,Ta_stack,dthetadz_stable,u_stack,hemis0,dh_buoyancy,prelim,istab,isek,astat)
else
- call ops_plumerise_buoyancy(z0,ol,uster,non_stable,qw2,Ta_stack,dthetadz_stable,u_stack,hemis0,dh_buoyancy)
+ call ops_plumerise_buoyancy(z0,ol,uster,non_stable,qw2,Ta_stack,dthetadz_stable,u_stack,hemis0,dh_buoyancy)
endif
! write(*,'(a,4(1x,e12.5))') 'in routine ops_plumerise b: ',hemis0,hemis1,hemis1-hemis0,-999.0
! 4. Determine plume rise due to momentum (no momentum plume rise in case of horizontal emission):
if (VsDs_opt .and. .not. emis_horizontal) then
-
- ! Low stack with low wind velocity may lead to large oversestimation of plume rise ->
+
+ ! Low stack with low wind velocity may lead to large oversestimation of plume rise ->
! 10 m is used as threshold for wind speed calculation (personal communication Hans Erbrink):
if (hemis0 .lt. z_u_threshold) then
if (prelim1) then
@@ -214,14 +210,14 @@ subroutine ops_plumerise(z0, hemis0, uster, ol, qw, VsDs_opt, D_stack, V_stack,
else
call ops_plumerise_momentum(u_stack,D_stack,V_stack,Ts_stack2,Ta_stack,dthetadz_stable,non_stable,dh_momentum)
endif
-else
+else
dh_momentum = 0.0
endif
! write(*,'(a,4(1x,e12.5))') 'in routine ops_plumerise : ',dh_buoyancy,dh_momentum
! 5. Compare plume rise due to buoyancy and momentum, which process is dominant? Adopt that plume rise.
-! If buoyancy plume rise is greater than momentum plume rise, discard momentum plume rise,
-! because in the parameterisation of buoyancy plume rise, momentum plume rise has been taken into account (see NNM Paarse boekje):
+! If buoyancy plume rise is greater than momentum plume rise, discard momentum plume rise,
+! because in the parameterisation of buoyancy plume rise, momentum plume rise has been taken into account (see NNM Paarse boekje):
if (dh_buoyancy .ge. dh_momentum) then
dh = dh_buoyancy
else
@@ -231,12 +227,12 @@ subroutine ops_plumerise(z0, hemis0, uster, ol, qw, VsDs_opt, D_stack, V_stack,
! write(*,'(a,4(1x,e12.5))') 'in routine ops_plumerise c: ',hemis0,hemis1,hemis1-hemis0,-999.0
! 6. plume penetration
-if (.not. prelim1) call ops_plume_penetration(hemis0,zmix,zmix_loc,ol,dh,hemis1,onder)
+if (.not. prelim1) call ops_plume_penetration(hemis0,zmix,zmix_loc,ol,dh,hemis1,onder)
! write(*,'(a,4(1x,e12.5))') 'in routine ops_plumerise d: ',hemis0,hemis1,hemis1-hemis0,-999.0
return
-9999 call ErrorCall(ROUTINENAAM, error)
+9999 call ErrorCall(ROUTINENAAM, error)
end subroutine ops_plumerise
@@ -244,7 +240,7 @@ end subroutine ops_plumerise
subroutine ops_plumerise_qw_Ts(VsDs_opt, qw, D_stack, V_stack, Ts_stack, emis_horizontal, Ta_stack, qw2, Ts_stack2, error)
! Compute effluent temperature Ts_stack or heat content Qw depending on input specified;
-! Ts_stack missing -> compute Qw, Qw missing -> compute Ts_stack. Note that is has been checked already that either one of them is missing.
+! Ts_stack missing -> compute Qw, Qw missing -> compute Ts_stack. Note that is has been checked already that either one of them is missing.
!
use Binas, only: T0, pi ! melting point of ice [K], pi
@@ -258,41 +254,41 @@ subroutine ops_plumerise_qw_Ts(VsDs_opt, qw, D_stack, V_stack, Ts_stack, emis_ho
real, intent(in) :: V_stack ! exit velocity of plume at stack tip [m/s]
real, intent(in) :: Ts_stack ! temperature of effluent from stack [K]
logical, intent(in) :: emis_horizontal ! horizontal outflow of emission
-real, intent(in) :: Ta_stack ! ambient temperature at stack height (K)
+real, intent(in) :: Ta_stack ! ambient temperature at stack height (K)
! Output:
real, intent(out) :: Ts_stack2 ! effluent temperature at stack height, but missing value replaced by computation from Qw [K]
real, intent(out) :: qw2 ! heat content emission, but missing value replaced by computation from Ts [MW]
-type (TError), intent(out) :: error ! error handling record
+type (TError), intent(out) :: error ! error handling record
-!Local:
-real :: C1 ! help variable = rho0*Cp0*(pi*(0.5*D_stack)**2)*V_stack*T0*(1.0e-6). Needed for Ts_stack2
+!Local:
+real :: C1 ! help variable = rho0*Cp0*(pi*(0.5*D_stack)**2)*V_stack*T0*(1.0e-6). Needed for Ts_stack2
real :: V0 ! normal volume flux [m0**3/s)
character(len = 80), parameter :: ROUTINENAAM = 'ops_plumerise_qw_Ts'
-! qw = rho0*Cp0*V0*(Ts - Ta)*1e-6 or 1e6*qw/(rho0*Cp0*V0) = Ts - Ta <=> Ts = Ta + 1e6*qw/(rho0*Cp0*V0)
+! qw = rho0*Cp0*V0*(Ts - Ta)*1e-6 or 1e6*qw/(rho0*Cp0*V0) = Ts - Ta <=> Ts = Ta + 1e6*qw/(rho0*Cp0*V0)
! T0 = reference temperature = 273.15 K = 0 C
! P0 = reference pressure = 1 atm = 101.325 kPa
! rho0 = reference density air (= 1.293 kg/m3) at pressure P0, temperature T0
! Cp0 = reference specific heat of air at pressure P0, temperature T0 (= 1005 J/kg/K)
-! V0 = normal volume flux (m03/s) at pressure P0, temperature T0
-! Ts = effluent temperature (K)
-! Ta = ambient temperature at stack height (K)
+! V0 = normal volume flux (m03/s) at pressure P0, temperature T0
+! Ts = effluent temperature (K)
+! Ta = ambient temperature at stack height (K)
! write(*,*) 'ops_plumerise_qw_Ts a:',VsDs_opt,qw,Ts_stack
if (VsDs_opt) then
if (is_missing(Ts_stack)) then
-
+
!----------------------------------------------------------------
! Heat content qw given, compute effluent temperature Ts_stack2
!----------------------------------------------------------------
-
+
if (emis_horizontal) then
Ts_stack2 = -999.0
else
if (qw .eq. 0.0) then
- Ts_stack2 = Ta_stack
+ Ts_stack2 = Ta_stack
else
! Compute effluent temperature (not needed in case of horizontal outflow):
! Ts = Ta + 1e6*qw/(rho0*Cp0*V0) (1)
@@ -300,7 +296,7 @@ subroutine ops_plumerise_qw_Ts(VsDs_opt, qw, D_stack, V_stack, Ts_stack, emis_ho
! Substitute (2) in (1) gives Ts = Ta + f Ts <=> Ts = Ta/(1-f), with f = 1e6*qw/(rho0*Cp0*(pi*(0.5*D_stack)**2)*V_stack*T0):
C1 = rho0*Cp0*(pi*(0.5*D_stack)**2)*V_stack*T0*(1.0e-6)
Ts_stack2 = Ta_stack/(1.0 - qw/C1)
-
+
! Check:
! This check is not needed; next check is more stringent:
! if (qw .ge. C1) then
@@ -317,20 +313,20 @@ subroutine ops_plumerise_qw_Ts(VsDs_opt, qw, D_stack, V_stack, Ts_stack, emis_ho
call ErrorParam('lower limit effluent gas temperature [C]',0.0,error)
call ErrorParam('',Ts_stack2-T0,error)
call ErrorParam('upper limit effluent gas temperature [C]',2000.0,error)
- call ErrorCall(ROUTINENAAM, error)
+ call ErrorCall(ROUTINENAAM, error)
endif
endif ! if qw = 0
- endif ! if emis_horizontal
+ endif ! if emis_horizontal
qw2 = qw
else
!------------------------------------------------
! Ts_stack is given; compute heat content qw2
!------------------------------------------------
-
+
! Compute normal volume flux, according to ideal gas-law (at constant pressure): V0_flux/T0 = Vs_flux/Ts, Vs_flux = pi R**2 Vs_stack
- V0 = (pi*(0.5*D_stack)**2)*V_stack*T0/Ts_stack
-
+ V0 = (pi*(0.5*D_stack)**2)*V_stack*T0/Ts_stack
+
! Compute qw:
Ts_stack2 = Ts_stack
qw2 = rho0*Cp0*V0*(Ts_stack - Ta_stack)*1e-6
@@ -347,11 +343,11 @@ end subroutine ops_plumerise_qw_Ts
!------------------------------------------------------------
subroutine ops_plumerise_buoyancy(z0, ol, uster, non_stable, qw, Ta_stack, dthetadz_stable, u_stack, hemis0, dh_buoyancy, prelim, istab, isek, astat)
!-------------------------------------------------------------------------------------------------------------------------------
-!
-! DESCRIPTION: This routine calculates the plume rise due to buoyancy.
+!
+! DESCRIPTION: This routine calculates the plume rise due to buoyancy.
! This routine includes plume rise formulations given by Briggs(1969) and Briggs(1971).
! This method is equal to the method used in the (old) Dutch National Model (TNO, 1976).
-! HvJ 960121
+! 960121
! Extra iteration, because wind speed depends on plume height and vice versa.
!
!-------------------------------------------------------------------------------------------------------------------------------
@@ -360,31 +356,31 @@ subroutine ops_plumerise_buoyancy(z0, ol, uster, non_stable, qw, Ta_stack, dthet
use Binas, only: grav, T0 ! acceleration of gravity [m/s2], melting point of ice [K]
! Input
-real, intent(in) :: z0 ! roughness length [m]
+real, intent(in) :: z0 ! roughness length [m]
real, intent(in) :: ol ! Monin-Obukhovlengte [m]
-real, intent(in) :: uster ! friction velocity [m/s]
+real, intent(in) :: uster ! friction velocity [m/s]
logical, intent(in):: non_stable ! non-stable (unstable/neutral) conditions
real, intent(in) :: qw ! heat content (MW)
real, intent(in) :: Ta_stack ! ambient temperature at stack height [K]
real, intent(in) :: dthetadz_stable ! fixed potential temperature gradient dtheta/dz [K/m] for stable conditions, used for dh_buoyancy and dh_momentum
real, intent(in) :: u_stack ! wind speed at stack height [m/s]
-real, intent(in) :: hemis0 ! initial emission height = stack height [m]
+real, intent(in) :: hemis0 ! initial emission height = stack height [m]
-! Output
+! Output
real, intent(out) :: dh_buoyancy ! plume rise due to buoyancy [m]
! Input, optional:
logical, intent(in), optional :: prelim ! preliminary plume rise, based on stability class and preliminary wind sector (ol, uster, ... still unknown)
- ! if prelim = true -> ol = -999, uster = -999, z0 = -999, zmix = zmix_loc = -999
- ! these parameters are still unknown;
+ ! if prelim = true -> ol = -999, uster = -999, z0 = -999, zmix = zmix_loc = -999
+ ! these parameters are still unknown;
! wind profile is based on power law with coefficient based on stability class
! if prelim = false or not present -> istab, isek are not used
- ! wind profile is computed with ops_wvprofile (logarithmic profile) using z0, ol, uster
+ ! wind profile is computed with ops_wvprofile (logarithmic profile) using z0, ol, uster
integer, intent(in), optional :: istab ! index of stability class and preliminary wind sector
integer, intent(in), optional :: isek ! index of preliminary wind sector (wind shear not yet taken into account)
real , intent(in), optional :: astat(NTRAJ, NCOMP, NSTAB, NSEK) ! statistical meteo parameters
-
-! Local
+
+! Local
real :: f ! stack buoyancy flux [m^4/s^3]
real :: u_plume ! wind speed at effective plume height, representative for the whole plume rise length [m/s]
real :: dtdz ! potential temperature gradient [K/m]
@@ -392,17 +388,17 @@ subroutine ops_plumerise_buoyancy(z0, ol, uster, non_stable, qw, Ta_stack, dthet
logical :: prelim1 ! = prelim if present, otherwise false
real :: vw10 ! wind velocity at 10 m heigth [m/s]
real :: pcoef ! coefficient in wind speed power law
-character(len=1) :: char_debug1 ! debug character (test only)
+character(len=1) :: char_debug1 ! debug character (test only)
! Iteration variables
! iteration converges if |dh_buoyancy - dh_buoyancy_prev| < epsa + epsr*dh_buoyancy
integer :: it ! iteration index
logical :: converged ! iteration has converged
real :: dh_buoyancy_prev ! plume rise of previous iteration
-integer, parameter :: maxit = 10 ! maximal number of iterations
+integer, parameter :: maxit = 10 ! maximal number of iterations
real, parameter :: epsa = 0.1 ! absolute error tolerance (m)
-real, parameter :: epsr = 0.05 ! relative error tolerance
-
+real, parameter :: epsr = 0.05 ! relative error tolerance
+
!-------------------------------------------------------------------------------------------------------------------------------
! MS Briggs is developed for large stacks (energy production,..); should not be used for low emissions, e.g. emissions from animal housing.
@@ -418,14 +414,14 @@ subroutine ops_plumerise_buoyancy(z0, ol, uster, non_stable, qw, Ta_stack, dthet
!Initialization
u_plume = u_stack
dh_buoyancy = 0.0
- ! if (prelim1) write(*,'(a,2(1x,e12.5))') 'ops_plumerise_buoyancy a',hemis0,u_stack
+ ! if (prelim1) write(*,'(a,2(1x,e12.5))') 'ops_plumerise_buoyancy a',hemis0,u_stack
- ! f = stack buoyancy flux (4.5 in 'The OPS-model Description of OPS 4.5.0). Briggs 1982, eq. 11. Assumed that Ps/Pa = 1.
+ ! f = stack buoyancy flux (4.5 in 'The OPS-model Description of OPS 4.5.0). Briggs 1982, eq. 11. Assumed that Ps/Pa = 1.
! f = g/(pi*0.0013*T)*qw = 9.81/(3.14*0.0013*273)*qw ! 0.0013 = rho*cp*fac_W_to_MW = 1.293*1005*1e-6
! f = 8.8*qw
f = (grav*1.0e6/(pi*rho0*Cp0*T0))*qw
-
- ! We want to use a wind speed that is representative for the whole plume rise length,
+
+ ! We want to use a wind speed that is representative for the whole plume rise length,
! but because we don't know the plume rise yet, we need an iteration.
! Initialisation for iteration:
converged = .false.
@@ -433,8 +429,8 @@ subroutine ops_plumerise_buoyancy(z0, ol, uster, non_stable, qw, Ta_stack, dthet
dh_buoyancy_prev = -999.
! Do iteration:
- do while (.not. converged .and. it .le. maxit)
-
+ do while (.not. converged .and. it .le. maxit)
+
! plume rise for unstable or neutral conditions, L < 0 or |L| > 50 (Eq 4.3 - 4.4 in 'The OPS-model Description of OPS 4.5.0):
! original value plrise_nonstab_Fbsplit = 55
if ( non_stable ) then
@@ -442,7 +438,7 @@ subroutine ops_plumerise_buoyancy(z0, ol, uster, non_stable, qw, Ta_stack, dthet
dh_buoyancy = 38.8*f**0.6/u_plume ! Briggs 1971 (as in the Dutch Nat. Mod.)
! char_debug1 = 'd'
else
- dh_buoyancy = 21.3*f**0.75/u_plume
+ dh_buoyancy = 21.3*f**0.75/u_plume
! char_debug1 = 'c'
endif
else
@@ -450,13 +446,13 @@ subroutine ops_plumerise_buoyancy(z0, ol, uster, non_stable, qw, Ta_stack, dthet
! use fixed potential temperature gradient dtheta/dz = 0.006 (K/m); is valid for conditions above mixing layer.
! For low emissions and stable atmospheric conditions, dtheta/dz = 0.2 K/m
! original value: plrise_stab_dtheta_dz = 0.006
- s = 9.81/Ta_stack*dthetadz_stable ! Stability parameter, Briggs (1969) Eq. 4.16.
- dh_buoyancy = 2.6*(f/(s*u_plume))**0.333 ! Briggs 1982, Eq. 59.
-
+ s = 9.81/Ta_stack*dthetadz_stable ! Stability parameter, Briggs (1969) Eq. 4.16.
+ dh_buoyancy = 2.6*(f/(s*u_plume))**0.333 ! Briggs 1982, Eq. 59.
+
! Check with old code of routine voorlpl:
! if (prelim1) then
- ! ! voorlpl: dh_buoyancy = 65.*(qw/u_plume)**.333
- ! ! 2.6*(f/(s*u_plume))**0.333 = 2.6*(8.8*qw/(s*u_plume))**0.333 = 2.6*(8.8**.333)*((1/s)**.333)*(qw/u_plume)**.333
+ ! ! voorlpl: dh_buoyancy = 65.*(qw/u_plume)**.333
+ ! ! 2.6*(f/(s*u_plume))**0.333 = 2.6*(8.8*qw/(s*u_plume))**0.333 = 2.6*(8.8**.333)*((1/s)**.333)*(qw/u_plume)**.333
! write(*,'(a,7(1x,e12.5))') 'ops_plumerise_buoyancy b',hemis0,dh_buoyancy,2.6*(f/s)**0.333,65.*qw**0.333,(grav*1.0e6/(pi*rho0*Cp0*T0)),2.6*((grav*1.0e6/(pi*rho0*Cp0*T0))**.333)*((1.0/s)**.333),Ta_stack
! char_debug1 = 'b'
! endif
@@ -464,7 +460,7 @@ subroutine ops_plumerise_buoyancy(z0, ol, uster, non_stable, qw, Ta_stack, dthet
! Check for convergence:
converged = (abs(dh_buoyancy - dh_buoyancy_prev) .lt. epsa + epsr*dh_buoyancy )
-
+
! Update for next iteration:
if (.not. converged .and. it .lt. maxit) then
! Compute wind speed at z = h_stack + 1/2 plume_rise:
@@ -492,7 +488,7 @@ subroutine ops_plumerise_buoyancy(z0, ol, uster, non_stable, qw, Ta_stack, dthet
ELSE
! Qw = 0
- dh_buoyancy = 0.0
+ dh_buoyancy = 0.0
ENDIF
end subroutine ops_plumerise_buoyancy
@@ -520,18 +516,18 @@ subroutine ops_plumerise_momentum(u_stack,D_stack,V_stack,Ts_stack,Ta_stack,dthe
! Gaussian Plume Air Dispersion Model
! https://www.weblakes.com/guides/iscst3/section6/6_1_4.html (14-2-2018)
-use m_commonconst, only: EPS_DELTA
+use m_commonconst, only: EPS_DELTA
use m_ops_utils, only: is_missing
! Input:
real , intent(in) :: u_stack ! wind speed at stack height [m/s]. For low sources the threshold height of 10m is applied.
real , intent(in) :: D_stack ! stack internal diameter [m]
real , intent(in) :: V_stack ! exit velocity of plume at stack tip [m/s]
-real , intent(in) :: Ts_stack ! temperature of effluent from stack [K]
+real , intent(in) :: Ts_stack ! temperature of effluent from stack [K]
real , intent(in) :: Ta_stack ! ambient temperature at stack height [K]
real , intent(in) :: dthetadz_stable ! fixed potential temperature gradient dtheta/dz [K/m] for stable conditions, used for dh_buoyancy and dh_momentum
logical, intent(in) :: non_stable ! non-stable (unstable/neutral) conditions
-
+
! Output:
real , intent(out) :: dh_momentum ! plume rise due to momentum [m]
@@ -544,16 +540,16 @@ subroutine ops_plumerise_momentum(u_stack,D_stack,V_stack,Ts_stack,Ta_stack,dthe
dh_momentum = 0.0
else
- ! Plume rise due to momentum for non-stable (unstable/neutral) conditions (Briggs, 1969, Eq. 5.2)
- dh_nonstable = 3*D_stack*V_stack/u_stack
-
+ ! Plume rise due to momentum for non-stable (unstable/neutral) conditions (Briggs, 1969, Eq. 5.2)
+ dh_nonstable = 3*D_stack*V_stack/u_stack
+
! Plume rise due to momentum for stable conditions:
! 2 2
! Vs D_stack 1/3 1/2 -1/6
- ! dh = 0.646 [ --------------- ] (Ta) (dTdz)
+ ! dh = 0.646 [ --------------- ] (Ta) (dTdz)
! Ts Us
! This originates from (Briggs 1969: Eq. 4.28, 4.19b, 4.16), see also Turner et al. (1986):
- ! Fm 1/3 -1/6 rhos 2 2 Ps*Ta 2 2 g dtheta
+ ! Fm 1/3 -1/6 rhos 2 2 Ps*Ta 2 2 g dtheta
! dh = 1.5 [ ------- ] [s] ; Fm = ------ (Vs) (r0) = -------- (Vs) 0.25 (D_stack) ; s = [ --- ------ ]
! u_stack rho P*Ts Ta dz
! with:
@@ -566,9 +562,9 @@ subroutine ops_plumerise_momentum(u_stack,D_stack,V_stack,Ts_stack,Ta_stack,dthe
! P = pressure ambient air, Ps = pressure of gases emitted from the stack, R = gas constant
! Ta = average absolute temperature of ambient air (K) ( = Ta_stack below)
! Ts = temperature of gases emitted from the stack (K) ( = Ts_stack below)
-
+
! This can be rewritten to (assuming Ps/P = 1):
- ! 2 2 2 2
+ ! 2 2 2 2
! 1/3 -1/6 Ps Vs D_stack 1/3 1/3 1/6 -1/6 Vs D_stack 1/3 1/2 -1/6
! dh = 1.5 * 0.25 * 9.81 [ ---- -------------- ] (Ta) (Ta) (dtheta/dz) = 0.646 [ -------------- ] (Ta) (dtheta/dz)
! P Ts u_stack Ts u_stack
@@ -576,37 +572,37 @@ subroutine ops_plumerise_momentum(u_stack,D_stack,V_stack,Ts_stack,Ta_stack,dthe
! For stable conditions, the lower value of dh_nonstable and dh_stable is chosen (see also Turner et al., 1986)
dh_stable = 0.646 * (( (V_stack**2.)*(D_stack**2.) / (Ts_stack*u_stack) )**(1./3.)) * (Ta_stack**0.5) * (dthetadz_stable**(-1./6.))
if (dh_stable > dh_nonstable) dh_stable = dh_nonstable
-
+
! Set output plume rise dh_momentum, depending on stability:
if (non_stable) then
dh_momentum = dh_nonstable
- else
+ else
dh_momentum = dh_stable
endif
endif
-end subroutine ops_plumerise_momentum
+end subroutine ops_plumerise_momentum
!------------------------------------------------------------
-subroutine ops_plume_penetration(hemis0,zmix,zmix_loc,ol,dh,hemis1,onder)
+subroutine ops_plume_penetration(hemis0,zmix,zmix_loc,ol,dh,hemis1,onder)
!
-! Subroutine to determine whether there is plume penetration.
+! Subroutine to determine whether there is plume penetration.
!
-use m_commonconst, only: EPS_DELTA
+use m_commonconst, only: EPS_DELTA
-! Input
+! Input
real, intent(in) :: hemis0 ! initial emission height = stack height [m]
-real, intent(in) :: zmix ! mixing height [m]
+real, intent(in) :: zmix ! mixing height [m]
real, intent(in) :: zmix_loc ! mixing height, local scale [m]
real, intent(in) :: ol ! Monin-Obukhov length [m]
real, intent(in) :: dh ! plume rise due to either buoyancy or momentum [m]
-! Input/Output
+! Input/Output
real, intent(inout) :: hemis1 ! emission height, including plume rise [m]
-! Output
-real, intent(out) :: onder ! part of plume below mixing height
+! Output
+real, intent(out) :: onder ! part of plume below mixing height
! The emission distribution of an area source has a sigma equal to the height of the source hemis0.
! If hemis0 is close to the inversion height, the emission must be distributed over mixing layer and reservoir layer.
! last change: 21 Oct 2002
@@ -618,7 +614,7 @@ subroutine ops_plume_penetration(hemis0,zmix,zmix_loc,ol,dh,hemis1,onder)
! onder = 1 -> plume completely below mixing height
! onder = 0 -> plume completely above mixing height
if( (hemis0 .gt. zmix + EPS_DELTA) .or. (hemis1 .le. hemis0 + EPS_DELTA) ) then
- onder = (zmix - hemis1)/zmix + 0.5 ! OPS
+ onder = (zmix - hemis1)/zmix + 0.5 ! OPS
else
onder = (zmix - hemis1)/dh + 0.5 ! Briggs (1975) and NNM
endif
@@ -630,8 +626,8 @@ subroutine ops_plume_penetration(hemis0,zmix,zmix_loc,ol,dh,hemis1,onder)
!
! Stable and unstable conditions and stack < mixing height -> add extra amount plrise_ci_add_stab_unstab to onder;
-if ( hemis0 .lt. zmix_loc .and. abs(ol) .lt. 100 ) then
- onder = onder + 0.35
+if ( hemis0 .lt. zmix_loc .and. abs(ol) .lt. 100 ) then
+ onder = onder + 0.35
endif
! Limit onder, such that 0 <= onder <= 1
@@ -641,7 +637,7 @@ subroutine ops_plume_penetration(hemis0,zmix,zmix_loc,ol,dh,hemis1,onder)
onder = 0.
else
continue
-endif
+endif
! Plume centre is maximal equal to mixing haight:
if ((hemis1 .gt. (zmix + EPS_DELTA)) .and. (onder .gt. (0. + EPS_DELTA))) then
diff --git a/m_ops_utils.f90 b/m_ops_utils.f90
index d7b0758..b33447d 100644
--- a/m_ops_utils.f90
+++ b/m_ops_utils.f90
@@ -1,22 +1,18 @@
-!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
-! National Institute of Public Health and Environment
-! Laboratory for Air Research (RIVM/LLO)
-! The Netherlands
-!-------------------------------------------------------------------------------------------------------------------------------
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
module m_ops_utils
! Different utility routines and functions
@@ -109,7 +105,7 @@ real function angle180(a)
use Binas, only: pi
! Return angle in interval (-pi,pi]
-! Input
+! Input
real, intent(in) :: a ! angle [radians]
! Local
@@ -165,7 +161,7 @@ subroutine proj_point(v1x,v1y,v2x,v2y,px,py,p_projx,p_projy,fac,len2)
! e2 = p-v1:
e2x = px - v1x;
e2y = py - v1y;
-
+
! Dot product of e1, e2:
dot_prod = e1x*e2x + e1y*e2y;
diff --git a/m_ops_vchem.f90 b/m_ops_vchem.f90
new file mode 100644
index 0000000..5e3ac4b
--- /dev/null
+++ b/m_ops_vchem.f90
@@ -0,0 +1,59 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
+!-------------------------------------------------------------------------------------------------------------------------------
+! Copyright by
+! National Institute of Public Health and Environment
+! Laboratory for Air Research (RIVM/LLO)
+! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
+!
+! MODULE : m_ops_vchem
+! FILENAME : %M%
+! SCCS(SOURCE) : %P%
+! RELEASE - LEVEL : %R% - %L%
+! BRANCH - SEQUENCE : %B% - %S%
+! DATE - TIME : %E% - %U%
+! WHAT : %W%:%E%
+! AUTHOR : OPS-support
+! FIRM/INSTITUTE : RIVM
+! LANGUAGE : FORTRAN-F90
+! DESCRIPTION : Define structure for chemical conversion rates
+! EXIT CODES :
+! FILES AND OTHER :
+! I/O DEVICES
+! SYSTEM DEPENDENCIES:
+! CALLED FUNCTIONS :
+! UPDATE HISTORY :
+!-------------------------------------------------------------------------------------------------------------------------------
+MODULE m_ops_vchem
+
+USE m_aps
+
+IMPLICIT NONE
+
+type Tvchem
+
+ TYPE (TApsGridReal) :: mass_prec_grid ! APS grid with column averaged mass of precursor pre chemistry step (from chemistry model, e.g. EMEP) [ug/m2]
+ TYPE (TApsGridReal) :: mass_conv_dtfac_grid ! APS grid with (100/dt) * column averaged mass, converted during chemistry step (from chemistry model, e.g. EMEP) [(ug/m2) (%/h)]
+
+ real :: mass_prec_tra ! column averaged mass of precursor pre chemistry step, average between source - receptor [ug/m2]
+ real :: mass_conv_dtfac_tra ! (100/dt) * column averaged mass, converted during chemistry step, average between source - receptor [(ug/m2) (%/h)]
+
+ real :: vchem ! chemical conversion rates for net reaction primary -> secondary species [%/h]
+
+end type Tvchem
+
+END MODULE m_ops_vchem
diff --git a/m_string.f90 b/m_string.f90
index 2c4dd26..bcd99a3 100644
--- a/m_string.f90
+++ b/m_string.f90
@@ -1,21 +1,24 @@
-!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
+!-------------------------------------------------------------------------------------------------------------------------------
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! MODULE : string
! IMPLEMENTS : Collection of useful string routines.
@@ -29,7 +32,7 @@
! BRANCH -SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR : Martien de Haan (ARIS)
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM/LLO
! LANGUAGE : FORTRAN-77/90
! EXIT CODES :
diff --git a/m_utils.f90 b/m_utils.f90
index c7aca71..31c1d54 100644
--- a/m_utils.f90
+++ b/m_utils.f90
@@ -1,21 +1,24 @@
-!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
+!-------------------------------------------------------------------------------------------------------------------------------
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! SUBROUTINE
! FILENAME : %M%
@@ -24,7 +27,7 @@
! BRANCH - SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR : Martien de Haan, okt 2001
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM/LLO/IS
! LANGUAGE : FORTRAN-77/90
! DESCRIPTION : General utilities
@@ -77,7 +80,8 @@ MODULE m_utils
INTERFACE Alloc
MODULE PROCEDURE allocreal0 ! allocation of real array (def=0.0)
MODULE PROCEDURE allocreal ! allocation of real array
- MODULE PROCEDURE allocreal2 ! allocation of 2-dimensional real array
+ MODULE PROCEDURE allocreal2 ! allocation of 2-dimensional real array (pointer)
+ MODULE PROCEDURE allocreal2a ! allocation of 2-dimensional real array (allocatable)
MODULE PROCEDURE allocreal3 ! allocation of 3-dimensional real array
MODULE PROCEDURE allocdouble0 ! allocation of double array (def = 0.0)
MODULE PROCEDURE allocdouble ! allocation of double array
@@ -167,7 +171,7 @@ MODULE m_utils
!-------------------------------------------------------------------------------------------------------------------------------
! FUNCTION : WisselBytes
! DESCRIPTION : Converts integer*2 internal notation from HP fortran to Microsoft Fortran and visa versa
-! AUTHOR : HvJ/Franka Loeve (Cap Volmac)
+! AUTHOR : OPS-support
! INPUTS : string (character*(*)) The string which should represent the number to be extracted.
! OUTPUTS : default (logical) Returns .TRUE. if no value was read because no value was defined following the = sign.
! error (type TError). Is assigned when an error occurred in the number defined in the string.
@@ -183,7 +187,7 @@ MODULE m_utils
! PURPOSE : Initial assignment to a format string.
! DESCRIPTION : To be called when starting the creation of a format string. The format string is then extended through
! AppendFormat and PrependFormat.
-! AUTHOR : Martien de Haan (ARIS).
+! AUTHOR : OPS-support .
! OUTPUTS : formatstring (character*(*)) The formnat string to be created.
! error (type TError). Is assigned when an error occurred in the assignment FormatString.
!-------------------------------------------------------------------------------------------------------------------------------
@@ -200,7 +204,7 @@ MODULE m_utils
! REMARK : AppendFormat checks first whether an error has occurred. If so nothing happens. This is handy, because the
! calling procedure only has to check the error status once after all append and prepend procedures have been
! called.
-! AUTHOR : Martien de Haan (ARIS).
+! AUTHOR : OPS-support .
! INPUTS : nrelts (integer*4, optional) Assigns how many descriptor fields are present (that is number of integers,
! floats or whatever in the format string).
! descriptor (character*(*)) The descriptor appended, such as 'I6', or 'F7.3' or 'X, I3'. This descriptor is
@@ -218,7 +222,7 @@ MODULE m_utils
! PURPOSE : Puts format descriptor at beginning of a format string.
! DESCRIPTION : See AppendFormat.
! REMARK : See AppendFormat.
-! AUTHOR : Martien de Haan (ARIS).
+! AUTHOR : OPS-support .
! INPUTS : nrelts (integer*4, optional) Assigns how many descriptor fields are present (that is number of integers,
! floats or whatever in the format string).
! descriptor (character*(*)) The descriptor appended, such as 'I6', or 'F7.3' or 'X, I3'. This descriptor is
@@ -444,6 +448,41 @@ SUBROUTINE allocreal2(dim1, dim2, arr, error)
ENDIF
END SUBROUTINE allocreal2
+!-------------------------------------------------------------------------------------------------------------------------------
+! SUBROUTINE : allocreal2
+! INTERFACE : Alloc
+! PURPOSE : Allocation of 2-dimensional real array.
+!-------------------------------------------------------------------------------------------------------------------------------
+SUBROUTINE allocreal2a(dim1, dim2, arr, error)
+
+!DEC$ ATTRIBUTES DLLEXPORT:: allocreal2a
+
+! SUBROUTINE ARGUMENTS - INPUT
+INTEGER*4, INTENT(IN) :: dim1 !
+INTEGER*4, INTENT(IN) :: dim2 !
+
+! SUBROUTINE ARGUMENTS - OUTPUT
+REAL*4, INTENT(OUT), DIMENSION(:,:), ALLOCATABLE :: arr !
+TYPE (TError), INTENT(OUT) :: error ! Error handling record
+
+! LOCAL VARIABLES
+INTEGER*4 :: ierr !
+
+! CONSTANTS
+CHARACTER*512 :: ROUTINENAAM !
+PARAMETER (ROUTINENAAM = 'allocreal2')
+
+!-------------------------------------------------------------------------------------------------------------------------------
+IF (.NOT. error%haserror .AND. dim1 > 0 .AND. dim2 > 0) THEN
+ ALLOCATE(arr(dim1, dim2), stat=ierr)
+
+ IF (ierr /= 0) THEN
+ CALL AllocError(ierr, ROUTINENAAM, dim1, '2-dimensional real', error)
+ CALL ErrorParam('second dimension', dim2, error)
+ ENDIF
+ENDIF
+
+END SUBROUTINE allocreal2a
!-------------------------------------------------------------------------------------------------------------------------------
! SUBROUTINE : allocdouble2
@@ -985,7 +1024,7 @@ END SUBROUTINE getreal
!-------------------------------------------------------------------------------------------------------------------------------
! SUBROUTINE : getint
-! AUTHOR : Martien de Haan, okt 2001
+! AUTHOR : OPS-support
! PURPOSE : Extraheren van integer waarde uit een string. Geeft terug of er een waarde was, welke positie, etc.
! CALLED FUNCTIONS : extractint
!-------------------------------------------------------------------------------------------------------------------------------
@@ -1114,7 +1153,7 @@ END SUBROUTINE byteswap2
!-------------------------------------------------------------------------------------------------------------------------------
! SUBROUTINE : byteswap
! DESCRIPTION : Converts integer*2 internal notation from HP fortran to Microsoft Fortran and visa versa.
-! AUTHOR : HvJ/Franka Loeve (Cap Volmac)
+! AUTHOR : OPS-support
!-------------------------------------------------------------------------------------------------------------------------------
SUBROUTINE byteswap(ishort)
@@ -1146,11 +1185,6 @@ SUBROUTINE byteswap(ishort)
ENDIF
k1 = mod(ishort, maxint2)
k2 = ishort/maxint2
-!! The following code may lead to overflow
-!! j = k1*maxint2 + k2 + iflg
-!! IF ( j .GT. 32768 ) THEN
-!! j = j - 65536
-!! ENDIF
IF (k1 > 128) THEN ! 32768/maxint2 = 128
j = (k1-256)*maxint2 + k2 + iflg ! 256*maxint2 = 65536
ELSE
@@ -1159,6 +1193,7 @@ SUBROUTINE byteswap(ishort)
j = j - 65536
ENDIF
ENDIF
+
ishort = j
RETURN
@@ -1284,15 +1319,6 @@ SUBROUTINE GetOS(os, slash)
rtc = GETCWD(directory)
-!! ! GETCWD is compiler dependent; alternative with IFNDEF Unix:
-!! #ifndef UNIX
-!! os = 1 ! Windows
-!! IF (PRESENT(slash)) slash = '\'
-!! #else
-!! os = 0 ! Unix
-!! IF (PRESENT(slash)) slash = '/'
-!! #endif
-
colonpos = INDEX(directory,':')
IF (ANY(colonpos == (/2,3/)) .AND. directory(colonpos+1:colonpos+1) == '\') THEN
diff --git a/ops_bgcon.f90 b/ops_bgcon.f90
index 18680e1..cf70a37 100644
--- a/ops_bgcon.f90
+++ b/ops_bgcon.f90
@@ -1,21 +1,24 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! SUBROUTINE
! FILENAME : %M%
@@ -24,10 +27,11 @@
! BRANCH - SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR : Hans van Jaarveld/Martien de Haan
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM/LLO/IS
! LANGUAGE : FORTRAN(HP-UX, HP-F77, HP-F90)
-! DESCRIPTION : Returns background concentration at a specific location.
+! DESCRIPTION : Returns grid value at a specific location.
+! Originally made for background concentrations (bgcon), but now also used for other grids.
! EXIT CODES :
! FILES AND OTHER :
! I/O DEVICES
@@ -35,7 +39,11 @@
! CALLED FUNCTIONS :
! UPDATE HISTORY :
!-------------------------------------------------------------------------------------------------------------------------------
-SUBROUTINE ops_bgcon(x, y, bgdata, bgcon)
+module m_ops_bgcon
+
+contains
+
+SUBROUTINE ops_bgcon(x, y, bgdata, bgcon, fieldnumber)
USE m_aps
USE m_commonconst ! EPS_DELTA only
@@ -50,6 +58,7 @@ SUBROUTINE ops_bgcon(x, y, bgdata, bgcon)
REAL*4, INTENT(IN) :: x ! x coordinate of specific location
REAL*4, INTENT(IN) :: y ! y coordinate of specific location
TYPE (TApsGridReal), INTENT(IN) :: bgdata ! APS-grid with background concentrations
+INTEGER, OPTIONAL :: fieldnumber ! field number in APS-grid
! SUBROUTINE ARGUMENTS - OUTPUT
REAL*4, INTENT(OUT) :: bgcon ! background concentration at (x,y)
@@ -58,16 +67,23 @@ SUBROUTINE ops_bgcon(x, y, bgdata, bgcon)
LOGICAL :: iscell ! whether (x,y) is inside APS-grid bgdata
!-------------------------------------------------------------------------------------------------------------------------------
!
-! Get value of background concentration bgdata at location (x,y).
+! Get value of background concentration bgdata at location (x,y); return grid average if point is outside grid or if value is negative
! Note: arguments of GridValue must be in km
!
-CALL GridValue(x/1000., y/1000., bgdata, bgcon, iscell)
-!
-! Get value from background grid. If point (x,y) is outside background grid, the average background value is returned.
-!
-IF (iscell .AND. bgcon < 0.+EPS_DELTA) THEN
- bgcon = bgdata%average
-ENDIF
+if (present(fieldnumber)) then
+ CALL GridValue(x/1000., y/1000., bgdata, bgcon, iscell, fieldnumber)
+ IF ( (.not. iscell ) .OR. bgcon < 0.+EPS_DELTA) THEN
+ bgcon = bgdata%average(fieldnumber)
+ ENDIF
+else
+ CALL GridValue(x/1000., y/1000., bgdata, bgcon, iscell)
+ IF ( (.not. iscell ) .OR. bgcon < 0.+EPS_DELTA) THEN
+ bgcon = bgdata%average(1)
+ ENDIF
+endif
+! write(*,'(a,3(1x,e12.5),L3,1x,e12.5)') 'ops_bgcon: ',x,y,bgcon,iscell,bgdata%average
RETURN
END SUBROUTINE ops_bgcon
+
+end module m_ops_bgcon
diff --git a/ops_bgcon_tra.f90 b/ops_bgcon_tra.f90
index fae729c..3668114 100644
--- a/ops_bgcon_tra.f90
+++ b/ops_bgcon_tra.f90
@@ -1,21 +1,24 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! SUBROUTINE
! FILENAME : %M%
@@ -24,7 +27,7 @@
! BRANCH - SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR : Hans van Jaarveld/Martien de Haan
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM/LLO/IS
! LANGUAGE : FORTRAN(HP-UX, HP-F77, HP-F90)
! DESCRIPTION : This routine reads for a given location the background conc. and
@@ -43,6 +46,7 @@
SUBROUTINE ops_bgcon_tra(xr, yr, xb, yb, bgdata, bgcon)
USE m_aps
+USE m_ops_bgcon
IMPLICIT NONE
@@ -80,6 +84,7 @@ SUBROUTINE ops_bgcon_tra(xr, yr, xb, yb, bgdata, bgcon)
!
x=xr+(xb-xr)/ns*i
y=yr+(yb-yr)/ns*i
+
!
! Calculate background concentration contribution at this point and add to total
!
diff --git a/ops_bron_rek.f90 b/ops_bron_rek.f90
index 4c2ce45..e3521c5 100644
--- a/ops_bron_rek.f90
+++ b/ops_bron_rek.f90
@@ -1,21 +1,24 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! SUBROUTINE
! FILENAME : %M%
@@ -24,7 +27,7 @@
! BRANCH - SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR : Hans van Jaarsveld, Franka Loeve (Cap Volmac)
+! AUTHOR : OPS-support
! Chris Twenh"ofel (Cap Gemini)
! FIRM/INSTITUTE : RIVM/LLO/IS
! LANGUAGE : FORTRAN-77/90
diff --git a/ops_brondepl.f90 b/ops_brondepl.f90
index e3b300b..80b0baa 100644
--- a/ops_brondepl.f90
+++ b/ops_brondepl.f90
@@ -1,21 +1,24 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! SUBROUTINE
! NAME : %M%
@@ -24,7 +27,7 @@
! BRANCH -SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR : HvJ/ Franka Loeve (Cap Volmac)
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM/LLO
! LANGUAGE : FORTRAN(HP-UX, HP-F77)
! DESCRIPTION : Compute source depletion (brondepl << "bron" = source, depl << depletion).
@@ -368,7 +371,7 @@ SUBROUTINE ops_brondepl(disx, xg, c, ux0, ueff, sigz, vg50trans, xl, istab, xloc
! ugem: average wind speed depending on phase of plume development
!
! source code:
-! 2.*al*1.e-6*vg0tra*(xx - radius) (xx + virty)*cxx*ueff*(1.-cgt) 2 pi
+! 2.*al*1.e-6*vg0tra*(xx - radius) (xx + virty)*cxx*ueff*(1.-cgt) 2 pi FS
! cq2 = EXP( - ---------------------------------- -------------------------------- ------)
! ugem onder*qbstf 12
diff --git a/ops_calc_stats.f90 b/ops_calc_stats.f90
index e74b7ce..7d4cf47 100644
--- a/ops_calc_stats.f90
+++ b/ops_calc_stats.f90
@@ -1,21 +1,24 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! SUBROUTINE
! NAME : %M%
@@ -24,7 +27,7 @@
! BRANCH - SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR : Chris Twenh"ofel (Cap Gemini)
+! AUTHOR : OPS-support Chris Twenh"ofel (Cap Gemini)
! FIRM/INSTITUTE : RIVM/LLO
! LANGUAGE : FORTRAN-77/90
! DESCRIPTION : Calculates summary statistics for concentration and deposition.
@@ -34,10 +37,10 @@
! CALLED FUNCTIONS :
! UPDATE HISTORY :
!-------------------------------------------------------------------------------------------------------------------------------
-SUBROUTINE ops_calc_stats(nrrcp, frac, cpri, csec, drydep, wetdep, gemre, sdrypri, sdrysec, snatpri, snatsec, somvnpri, &
- & somvnsec, vvchem, vtel, telvnpri, telvnsec, grid, conc_cf, amol21, ugmoldep, cseccor, &
+SUBROUTINE ops_calc_stats(nrrcp, nsubsec, frac, cpri, csec, drydep, wetdep, gemre, sdrypri, sdrysec, snatpri, snatsec, somvnpri, &
+ & somvnsec, vvchem, vtel, telvnpri, telvnsec, grid, conc_cf, amol21, ugmoldep, csubsec, &
& gemcpri, gemcsec, totddep, gemddep, gemddpri, gemddsec, ddrpri, ddrsec, totwdep, gemwdep, &
- & gemwdpri, gemwdsec, wdrpri, wdrsec, gemprec, tottdep, gemtdep, ccr, gemcseccor)
+ & gemwdpri, gemwdsec, wdrpri, wdrsec, gemprec, tottdep, gemtdep, ccr, gem_subsec)
USE m_commonconst ! EPS_DELTA only
@@ -49,6 +52,7 @@ SUBROUTINE ops_calc_stats(nrrcp, frac, cpri, csec, drydep, wetdep, gemre, sdrypr
! SUBROUTINE ARGUMENTS - INPUT
INTEGER*4, INTENT(IN) :: nrrcp ! number of receptor points
+INTEGER*4, INTENT(IN) :: nsubsec ! number of sub-secondary species
REAL*4, INTENT(IN) :: frac(nrrcp) ! fraction per cell inside NL
REAL*4, INTENT(IN) :: cpri(nrrcp) ! primary concentration [ug/m3]
REAL*4, INTENT(IN) :: csec(nrrcp) ! secondary concentration [ug/m3]
@@ -67,7 +71,7 @@ SUBROUTINE ops_calc_stats(nrrcp, frac, cpri, csec, drydep, wetdep, gemre, sdrypr
REAL*4, INTENT(IN) :: conc_cf !
REAL*4, INTENT(IN) :: amol21 !
REAL*4, INTENT(IN) :: ugmoldep !
-REAL*4, INTENT(IN) :: cseccor(nrrcp) ! concentration of second secondary substance [ug/m3]
+REAL*4, INTENT(IN) :: csubsec(nrrcp,nsubsec) ! concentration of sub-secondary species [ug/m3]
! SUBROUTINE ARGUMENTS - I/O
DOUBLE PRECISION, INTENT(INOUT) :: snatpri !
@@ -92,7 +96,7 @@ SUBROUTINE ops_calc_stats(nrrcp, frac, cpri, csec, drydep, wetdep, gemre, sdrypr
REAL*4, INTENT(OUT) :: tottdep ! grid total of total deposition (g/s)
REAL*4, INTENT(OUT) :: gemtdep ! grid mean of total deposition ["depeh"]
REAL*4, INTENT(OUT) :: ccr ! effective chemical conversion rate [%/h]
-REAL*4, INTENT(OUT) :: gemcseccor ! grid mean for second secondary concentration [ug/m3]
+REAL*4, INTENT(OUT) :: gem_subsec(nsubsec) ! grid mean for concentration of sub-secondary species [ug/m3]
! LOCAL VARIABLES
REAL*4 :: somcsec ! sum of secondary concentrations [ug/m3]
@@ -102,8 +106,9 @@ SUBROUTINE ops_calc_stats(nrrcp, frac, cpri, csec, drydep, wetdep, gemre, sdrypr
! LOCAL VARIABLES
REAL*4 :: cf ! conversion factor
REAL*4 :: somcpri ! sum of primary concentrations [ug/m3]
-REAL*4 :: somcseccor ! sum of second secondary concentrations [ug/m3]
+REAL*4 :: som_subsec(nsubsec) ! sum of concentrations of sub-secondary species [ug/m3]
REAL*4 :: somfrac ! sum of frac
+INTEGER*4 :: isubsec ! index of sub-secondary species
! SCCS-ID VARIABLES
CHARACTER*81 :: sccsida !
@@ -117,7 +122,9 @@ SUBROUTINE ops_calc_stats(nrrcp, frac, cpri, csec, drydep, wetdep, gemre, sdrypr
somfrac = SUM(frac(:))
somcpri = SUM(cpri(:) * frac(:))
somcsec = SUM(csec(:) * frac(:))
-somcseccor = SUM(cseccor(:) * frac(:))
+do isubsec = 1,nsubsec
+ som_subsec(isubsec) = SUM(csubsec(:,isubsec) * frac(:))
+enddo
somddep = SUM(drydep(:) * frac(:))
somwdep = SUM(wetdep(:) * frac(:))
!
@@ -130,7 +137,7 @@ SUBROUTINE ops_calc_stats(nrrcp, frac, cpri, csec, drydep, wetdep, gemre, sdrypr
! (1) concentration
gemcpri = somcpri/somfrac
gemcsec = somcsec/somfrac
-gemcseccor = somcseccor/somfrac
+gem_subsec = som_subsec/somfrac
! (2) dry deposition
totddep = somddep*cf
diff --git a/ops_conc_ini.f90 b/ops_conc_ini.f90
index d632d72..dce9451 100644
--- a/ops_conc_ini.f90
+++ b/ops_conc_ini.f90
@@ -1,21 +1,24 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+! copyright by
! National Institute of Public Health and Environment
-! Laboratory for Air Research (RIVM/LLO)
-! The Netherlands
+! Laboratory for Air Research (RIVM/LLO)
+! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! SUBROUTINE
! NAME : %M%
@@ -24,7 +27,7 @@
! BRANCH -SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR : HvJ/Franka Loeve (Cap Volmac)
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM/LLO/IS
! LANGUAGE : FORTRAN-77/90
! DESCRIPTION : Compute initial concentrations due to transport and dispersion; no removal processes yet.
diff --git a/ops_conc_rek.f90 b/ops_conc_rek.f90
index 2b0f6e1..7b52ae6 100644
--- a/ops_conc_rek.f90
+++ b/ops_conc_rek.f90
@@ -1,21 +1,24 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! SUBROUTINE
! NAME : %M%
@@ -24,7 +27,7 @@
! BRANCH -SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR : HvJ / Franka Loeve (Cap Volmac)
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM/LLO/IS
! LANGUAGE : FORTRAN-77/90
! DESCRIPTION : Compute concentration, taking into account source depletion factors for dry deposition,
@@ -40,7 +43,7 @@ SUBROUTINE ops_conc_rek(ueff, qbpri, isec, rcsec, routsec, ccc, amol1, amol2, si
& rb_rcp, amol21, ugmoldep, cch, cgt, cgt_z, grof, percvk, onder, regenk, virty, ri, vw10, hbron, pcoef, &
& rkc, disx, vnatpri, vchem, radius, xl, xloc, htot, twt, rb, ra50, xvghbr, xvglbr, grad, frac, &
& cdn, cq2, c, sdrypri, sdrysec, snatsec, somvnsec, telvnsec, vvchem, vtel, snatpri, somvnpri, &
- & telvnpri, ddepri, drydep, wetdep, dm, qsec, consec, pr, vg50trans, ra50tra, rb_tra, rclocal, vgpart, xg,&
+ & telvnpri, ddepri, drydep, wetdep, qsec, consec, pr, vg50trans, ra50tra, rb_tra, rclocal, vgpart, xg,&
& buildingFact)
USE m_commonconst
@@ -121,13 +124,13 @@ SUBROUTINE ops_conc_rek(ueff, qbpri, isec, rcsec, routsec, ccc, amol1, amol2, si
DOUBLE PRECISION, INTENT(INOUT) :: wetdep !
! SUBROUTINE ARGUMENTS - OUTPUT
-REAL*4, INTENT(OUT) :: dm !
REAL*4, INTENT(OUT) :: qsec !
REAL*4, INTENT(OUT) :: consec !
REAL*4, INTENT(OUT) :: pr !
REAL*4, INTENT(OUT) :: vg50trans !
! LOCAL VARIABLES
+REAL*4 :: qpri_depl ! depleted source strength = integrated mass flux [g/s]
REAL*4 :: vv !
REAL*4 :: drypri !
REAL*4 :: ddrup !
@@ -242,29 +245,29 @@ SUBROUTINE ops_conc_rek(ueff, qbpri, isec, rcsec, routsec, ccc, amol1, amol2, si
!
dn = rkc/100.*percvk*1.e6/(ueff*2.*PI/12.* (disx + virty + 3. + virnat))
!
-! Compute dm = Q(x) = depleted source strength (effect of all source depletion factors on source strength qbpri)
+! Compute qpri_depl = Q(x) = depleted source strength (effect of all source depletion factors on source strength qbpri)
!
-dm = qbpri*cdn*cq2*cch
+qpri_depl = qbpri*cdn*cq2*cch
!
! Compute dnatpri = wet deposition flux [ug/m2/h] of primary component
! and snatpri = summed wet deposition of primary component (weighed with fraction cell inside NL)
! vnatpri: [%/h] wet deposition loss rate for primary components
-! dm : [g/s]
-! dn : [s/m2 ug/g]
-! dm*dn : [ug/m2] deposited mass per area, during time step dt; dm*dn = Q(x)*dt*percvk*1e6/A
+! qpri_depl : [g/s]
+! dn : [s/m2 ug/g]
+! qpri_depl*dn : [ug/m2] deposited mass per area, during time step dt; qpri_depl*dn = Q(x)*dt*percvk*1e6/A
!
IF ((disx + virty) .LT. (virnat - EPS_DELTA)) THEN
dnatpri = 0.
ELSE
- dnatpri = vnatpri*dm*dn
+ dnatpri = vnatpri*qpri_depl*dn
ENDIF
snatpri = snatpri + dnatpri*frac
!
-! Sum wet deposition flux [ug/m2/h] of primary component and sum deposited mass per area dm*dn [ug/m2];
+! Sum wet deposition flux [ug/m2/h] of primary component and sum deposited mass per area qpri_depl*dn [ug/m2];
! later on we use this for computing effective wet deposition rate wdrpri = somvnpri/telvnpri [%/h]
!
somvnpri = somvnpri + dnatpri
-telvnpri = telvnpri + dm*dn
+telvnpri = telvnpri + qpri_depl*dn
!
! Compute concentration and deposition of secondary component (SO4, NO3, NH4)
!
@@ -303,10 +306,10 @@ SUBROUTINE ops_conc_rek(ueff, qbpri, isec, rcsec, routsec, ccc, amol1, amol2, si
ENDIF
ENDIF
!
-! Sum chemical conversion rate (weighed with dm*dn = deposited mass per area [ug/m2])
+! Sum chemical conversion rate (weighed with qpri_depl*dn = deposited mass per area [ug/m2])
!
-vvchem = vvchem + (vchem*dm*dn)
-vtel = vtel + (dm*dn)
+vvchem = vvchem + (vchem*qpri_depl*dn)
+vtel = vtel + (qpri_depl*dn)
!
! Sum deposition (drydep = dry/primary+secondary, ddepri = dry/primary, wetdep = wet/primary+secondary);
! convert from ug/m2/h to mol/ha/y
diff --git a/ops_conltexp.f90 b/ops_conltexp.f90
index 05584aa..3c0ac0a 100644
--- a/ops_conltexp.f90
+++ b/ops_conltexp.f90
@@ -1,21 +1,24 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! SUBROUTINE
! NAME : %M%
@@ -24,7 +27,7 @@
! BRANCH -SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR : HvJ/Franka Loeve (Cap Volmac)
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM/LLO
! LANGUAGE : FORTRAN-77/90
! DESCRIPTION : Compute long term concentration for a given source and source-receptor distance;
diff --git a/ops_convec.f90 b/ops_convec.f90
index 1370dcb..de313c8 100644
--- a/ops_convec.f90
+++ b/ops_convec.f90
@@ -1,21 +1,24 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! SUBROUTINE
! NAME : %M%
@@ -24,7 +27,7 @@
! BRANCH -SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR : HvJ/Franka Loeve (Cap Volmac)
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM/LLO
! LANGUAGE : FORTRAN(HP-UX, HP-F77)
! DESCRIPTION : This routine calculates sigmaz for convective cases according to Weil and Brower (1982) formally defined
diff --git a/ops_depoparexp.f90 b/ops_depoparexp.f90
index 375802e..d47e03d 100644
--- a/ops_depoparexp.f90
+++ b/ops_depoparexp.f90
@@ -1,21 +1,24 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! SUBROUTINE
! NAME : %M%
@@ -24,7 +27,7 @@
! BRANCH -SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR : HvJ/Franka Loeve (Cap Volmac)
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM/LLO
! LANGUAGE : FORTRAN-77/90
! DESCRIPTION : Get parameters needed for dry deposition, wet deposition and chemical conversion.
@@ -607,7 +610,7 @@ SUBROUTINE ops_depoparexp(kdeel, c, ol, qbstf, ra4_rcp, ra50_rcp, raz_rcp, rb_rc
!-------------------------------------------------------------------------------------------------------------------------------
! SUBROUTINE : par_nat
! DESCRIPTION : Compute rain intensity and the wet deposition loss rate for primary components vnatpri
-! AUTHOR : HvJ/Franka Loeve (Cap Volmac)
+! AUTHOR : OPS-support
! SYSTEM DEPENDENCIES: NON-ANSI F77
!-------------------------------------------------------------------------------------------------------------------------------
SUBROUTINE par_nat(regenk, rint, buil, zf, isek, iseiz, mb, disx, radius, diameter, ueff, xl, onder, sigz, htot, gasv, dg, &
@@ -721,7 +724,7 @@ SUBROUTINE par_nat(regenk, rint, buil, zf, isek, iseiz, mb, disx, radius, diamet
! Correction of twet [h] and ri [mm/h] for one month;
! iseiz = 4 -> one month in winter -> correction needed
!
- IF (iseiz .EQ. 4) THEN ! IF (iseiz .EQ. 4 .OR. iseiz .EQ. 5) THEN
+ IF (iseiz .EQ. 4) THEN ! IF (iseiz .EQ. 4 .OR. iseiz .EQ. 5) THEN FS
twet = twet/CMND(mb)
ri = ri*CMND(mb)
ENDIF
diff --git a/ops_depos_rc.f90 b/ops_depos_rc.f90
index af82b04..358bc80 100644
--- a/ops_depos_rc.f90
+++ b/ops_depos_rc.f90
@@ -1,21 +1,24 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! SUBROUTINE
! NAME : %M%
@@ -24,7 +27,7 @@
! BRANCH -SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR :
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM/LLO
! LANGUAGE : FORTRAN-F77/90
! USAGE : %M%
@@ -36,7 +39,8 @@
! CALLED FUNCTIONS : depac
! UPDATE HISTORY :
!-------------------------------------------------------------------------------------------------------------------------------
-SUBROUTINE ops_depos_rc(icm, iseiz, mb, gym ,temp_C, uster, glrad, hum, nwet, ratns, catm, c_ave_prev, lu_per, ra, rb, rc_eff_pos, rc_eff)
+SUBROUTINE ops_depos_rc(icm, iseiz, mb, gym ,temp_C, uster, glrad, hum, nwet, ratns, catm, c_ave_prev_nh3, c_ave_prev_so2, &
+ & lu_per, ra, rb, rc_eff_pos, rc_eff)
USE m_commonconst
USE m_depac318
@@ -59,7 +63,8 @@ SUBROUTINE ops_depos_rc(icm, iseiz, mb, gym ,temp_C, uster, glrad, hum, nwet, ra
REAL*4, INTENT(IN) :: glrad !
REAL*4, INTENT(IN) :: ratns !
REAL*4, INTENT(IN) :: catm
-REAL*4, INTENT(IN) :: c_ave_prev
+REAL*4, INTENT(IN) :: c_ave_prev_nh3
+REAL*4, INTENT(IN) :: c_ave_prev_so2
REAL*4, INTENT(IN) :: ra
REAL*4, INTENT(IN) :: rb
REAL*4, INTENT(IN) :: lu_per(NLU) ! land use percentages for all land use classes
@@ -156,7 +161,7 @@ SUBROUTINE ops_depos_rc(icm, iseiz, mb, gym ,temp_C, uster, glrad, hum, nwet, ra
! rc_eff_depac: effective Rc (includes effect of compensation point); rc_eff_depac depends on the value of Ra and Rb.
!
CALL depac318(CNAME(icm,5), day_of_year, gym ,temp_C, uster, glrad, sinphi, hum, nwet, luclass, nint(ratns), &
- & rc_tot, c_ave_prev, max(catm,catm_min), ccomp_tot, ra, rb, rc_eff_depac)
+ & rc_tot, c_ave_prev_nh3, c_ave_prev_so2, max(catm,catm_min), ccomp_tot, ra, rb, rc_eff_depac)
!
! Detect missing values and set default values
!
diff --git a/ops_depu.f90 b/ops_depu.f90
index 3d1a6d5..775990c 100644
--- a/ops_depu.f90
+++ b/ops_depu.f90
@@ -1,21 +1,24 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! SUBROUTINE
! NAME : %M%
@@ -24,7 +27,7 @@
! BRANCH -SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR : J.W. mrt 1990/ Franka Loeve (Cap Volmac)
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM/LLO
! LANGUAGE : FORTRAN-77/90
! USAGE :
@@ -147,7 +150,7 @@ SUBROUTINE ops_depu(icnr, z0, zra, d, rc, ol, uster, vg, ra, rb)
! DESCRIPTION : Stability correction function in the surface layer temperature profile. The present model is an empirical
! fit by Holtslag and De Bruin(1987) of data by Hicks (1976, Quart. J. R. Meteor. Soc., 102, 535-551).
! See also Holtslag (1984, BLM, 29, 225-250)
-! AUTHOR : ANTON BELJAARS (KNMI 25-5-87) / Franka Loeve (Cap Volmac)
+! AUTHOR : OPS-support
!-------------------------------------------------------------------------------------------------------------------------------
REAL FUNCTION fpsih(eta)
diff --git a/ops_gen_fnames.f90 b/ops_gen_fnames.f90
index e0b5fc9..ab706e2 100644
--- a/ops_gen_fnames.f90
+++ b/ops_gen_fnames.f90
@@ -1,21 +1,24 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! SUBROUTINE
! NAME : %M%
@@ -25,7 +28,7 @@
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
! USAGE :
-! AUTHOR :
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM/LLO
! LANGUAGE : FORTRAN-90
! DESCRIPTION : Check existence and generate full file names of those files that have not been explicitly defined
diff --git a/ops_gen_precip.f90 b/ops_gen_precip.f90
index a35bba7..5cd6e34 100644
--- a/ops_gen_precip.f90
+++ b/ops_gen_precip.f90
@@ -1,21 +1,24 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! SUBROUTINE
!
@@ -25,7 +28,7 @@
! BRANCH -SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR : Hans van Jaarsveld
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM/LLO
! LANGUAGE : FORTRAN-77/90
! DESCRIPTION : Generate precipitation for receptors (sum of precipitation over
diff --git a/ops_gen_rcp.f90 b/ops_gen_rcp.f90
index cb815dc..5b63db6 100644
--- a/ops_gen_rcp.f90
+++ b/ops_gen_rcp.f90
@@ -1,21 +1,24 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! SUBROUTINE
! FILENAME : %M%
@@ -24,7 +27,7 @@
! BRANCH -SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR : Hans van Jaarsveld
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM/LLO/IS
! LANGUAGE : FORTRAN(HP-UX, HP-F77, HP-F90)
! DESCRIPTION : Generate coordinates of receptor points.
diff --git a/ops_get_arg.f90 b/ops_get_arg.f90
index 8633aea..0a015b2 100644
--- a/ops_get_arg.f90
+++ b/ops_get_arg.f90
@@ -1,21 +1,24 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! SUBROUTINE
!
@@ -25,7 +28,7 @@
! BRANCH -SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR :
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM/LLO
! LANGUAGE : FORTRAN-77/90
! DESCRIPTION : Retrieves the command line arguments and determines whether syntax is correct. If so, the complete
diff --git a/ops_get_dim.f90 b/ops_get_dim.f90
index d8f878d..f08b227 100644
--- a/ops_get_dim.f90
+++ b/ops_get_dim.f90
@@ -1,21 +1,24 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! SUBROUTINE
! FILENAME : %M%
@@ -24,7 +27,7 @@
! BRANCH -SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR : Hans van Jaarsveld
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM/LLO/IS
! LANGUAGE : FORTRAN(HP-UX, HP-F77, HP-F90)
! DESCRIPTION : Calculation of dimension of receptor point grids.
diff --git a/ops_getlu.f90 b/ops_getlu.f90
index 1265ee0..0bcf067 100644
--- a/ops_getlu.f90
+++ b/ops_getlu.f90
@@ -1,21 +1,24 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! SUBROUTINE
! NAME : %M%
@@ -24,7 +27,7 @@
! BRANCH -SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR :
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM/LLO
! LANGUAGE : FORTRAN-77/90
! DESCRIPTION : Retrieve dominant landuse class and percentages of each landuse class for a specific point.
diff --git a/ops_getlu_tra.f90 b/ops_getlu_tra.f90
index 3760840..b5a63c2 100644
--- a/ops_getlu_tra.f90
+++ b/ops_getlu_tra.f90
@@ -1,21 +1,24 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! SUBROUTINE
! NAME : %M%
@@ -24,7 +27,7 @@
! BRANCH -SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR :
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM/LLO
! LANGUAGE : FORTRAN-77/90
! DESCRIPTION : Compute dominant land use class and percentage of each land use
diff --git a/ops_getz0.f90 b/ops_getz0.f90
index f935797..04e2fba 100644
--- a/ops_getz0.f90
+++ b/ops_getz0.f90
@@ -1,21 +1,24 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! SUBROUTINE
! NAME : %M%
@@ -24,7 +27,7 @@
! BRANCH -SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR :
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM/LLO
! LANGUAGE : FORTRAN-77/90
! DESCRIPTION : Retrieve roughness length z0 for a specific location.
diff --git a/ops_getz0_tra.f90 b/ops_getz0_tra.f90
index 9ea35c3..f573f40 100644
--- a/ops_getz0_tra.f90
+++ b/ops_getz0_tra.f90
@@ -1,21 +1,24 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! SUBROUTINE
! NAME : %M%
@@ -24,7 +27,7 @@
! BRANCH -SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR :
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM/LLO
! LANGUAGE : FORTRAN-77/90
! DESCRIPTION : Compute average roughness length z0 over a trajectory.
diff --git a/ops_init.f90 b/ops_init.f90
index b04a6cf..c650551 100644
--- a/ops_init.f90
+++ b/ops_init.f90
@@ -1,21 +1,24 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+! copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! SUBROUTINE
!
@@ -25,7 +28,7 @@
! BRANCH -SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR :
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM/LLO
! LANGUAGE : FORTRAN-77/90
! DESCRIPTION : Initialisation of variables based on data from the control file and on meteo statistics.
@@ -36,10 +39,10 @@
! CALLED FUNCTIONS : ops_masknew, amcgeo
! UPDATE HISTORY :
!-------------------------------------------------------------------------------------------------------------------------------
-SUBROUTINE ops_init (gasv, idep, building_present1, kdeppar, knatdeppar, ddeppar, wdeppar, amol2, ideh, icm, isec, iseiz, mb, astat, dverl, &
+SUBROUTINE ops_init (gasv, idep, building_present1, kdeppar, knatdeppar, ddeppar, wdeppar, amol2, ideh, icm, isec, nsubsec, iseiz, mb, astat, dverl, &
& usdverl, dv, usdv, namco, amol1, dg, irev, vchemc, vchemv, emtrend, rc, coneh, amol21, depeh, namsec, &
& namse3, ugmoldep, scavcoef, rcno, rhno2, rchno3, routsec, routpri, conc_cf, koh, croutpri, somcsec, &
- & ar, rno2nox, ecvl, namseccor, buildingEffect, error)
+ & ar, rno2nox, ecvl, nam_subsec, buildingEffect, error)
USE m_commonconst
USE m_error
@@ -60,7 +63,8 @@ SUBROUTINE ops_init (gasv, idep, building_present1, kdeppar, knatdeppar, ddeppar
REAL*4, INTENT(IN) :: wdeppar
INTEGER*4, INTENT(IN) :: ideh
INTEGER*4, INTENT(IN) :: icm
-LOGICAL, INTENT(IN) :: isec
+LOGICAL, INTENT(IN) :: isec
+INTEGER*4, INTENT(IN) :: nsubsec ! number of sub-secondary species
INTEGER*4, INTENT(IN) :: iseiz
INTEGER*4, INTENT(IN) :: mb
REAL*4, INTENT(IN) :: astat(NTRAJ, NCOMP, NSTAB, NSEK)
@@ -103,7 +107,7 @@ SUBROUTINE ops_init (gasv, idep, building_present1, kdeppar, knatdeppar, ddeppar
REAL*4, INTENT(OUT) :: ar
REAL*4, INTENT(OUT) :: rno2nox
REAL*4, INTENT(OUT) :: ecvl(NSTAB, NTRAJ, *)
-CHARACTER*(*), INTENT(OUT) :: namseccor
+CHARACTER*(*), INTENT(OUT) :: nam_subsec(nsubsec)
type(TbuildingEffect), INTENT(OUT) :: buildingEffect ! structure with building effect tables
TYPE (TError), INTENT(OUT) :: error ! error handling record
@@ -181,7 +185,7 @@ SUBROUTINE ops_init (gasv, idep, building_present1, kdeppar, knatdeppar, ddeppar
! routsec : in-cloud scavenging ratio for secondary component
! (rout << rain-out = in-cloud) [-])
! conc_cf : concentration correction factor for output.
- ! Section 6.3 OPS report
+ ! Section 6.3 OPS report FS
knatdeppar = 3
scavcoef = 0
@@ -200,7 +204,7 @@ SUBROUTINE ops_init (gasv, idep, building_present1, kdeppar, knatdeppar, ddeppar
routsec = 1.4e7
! Set parameters specific for NOx
- ! rhno2 : ratio [HNO2]/[NOx] based on measurements Speuld, Slanina et al 1990, but they report 4% (p. 66 OPS report)
+ ! rhno2 : ratio [HNO2]/[NOx] based on measurements Speuld, Slanina et al 1990, but they report 4% (p. 66 OPS report) FS
! koh : second order reaction rate constant of reaction NO2 + OH -> HNO3 [cm3/(molec s)]
! Baulch et al 1982 (OPS report Table 6.2 FS): kOH = 1.035e-11 cm3/(molec s) = 1000.9 ppb-1 h-1, at T = 0 C
! = 932.6 ppb-1 h-1, at T = 20 C
@@ -243,10 +247,10 @@ SUBROUTINE ops_init (gasv, idep, building_present1, kdeppar, knatdeppar, ddeppar
! Component names (see m_commonconst for definition of CNAME)
!
IF (isec) THEN
- namco = CNAME(icm,1)
- namsec = CNAME(icm,2)
- namseccor = CNAME(icm,3)
- namse3 = CNAME(icm,4)
+ namco = CNAME(icm,1)
+ namsec = CNAME(icm,2)
+ nam_subsec = CNAME_SUBSEC
+ namse3 = CNAME(icm,4)
ELSE
namsec = namco
namse3 = namco
diff --git a/ops_logfile.f90 b/ops_logfile.f90
index f99ff41..16d195c 100644
--- a/ops_logfile.f90
+++ b/ops_logfile.f90
@@ -1,21 +1,24 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! FILENAME : %M%
! SCCS (SOURCE) : %P%
@@ -23,7 +26,7 @@
! BRANCH - SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR : Martien de Haan (ARIS)
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM/LLO
! LANGUAGE : FORTRAN-F77/90
! DESCRIPTION : Handling of log file. The log file is only opened and closed if something is written to it.
diff --git a/ops_main.f90 b/ops_main.f90
index 9272a84..ff8e4d8 100644
--- a/ops_main.f90
+++ b/ops_main.f90
@@ -1,21 +1,24 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! SUBROUTINE
! NAME : %M%
@@ -24,7 +27,7 @@
! BRANCH -SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR : HvJ, Franka Loeve (Cap Volmac)
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM/LLO
! LANGUAGE : FORTRAN-77/FORTRAN-90
! DESCRIPTION :
@@ -56,14 +59,14 @@
! SYSTEM DEPENDENCIES : HP-Fortran
! CALLED FUNCTIONS :
! UPDATE HISTORY :
-! 2012-01-24, Ferd Sauter: documentation added; also references to OPS-report. In close cooperation
-! with Hans van Jaarsveld.
+! 2012-01-24, : documentation added; also references to OPS-report. In close cooperation
+! with .
! DISCLAIMER: although care has been taken to make the documentation as clear as possible,
! it should be noted that documentation has been added some 20 years after the start of the model.
! This means that not all references have been resolved and that in some cases, source code
! may have been misinterpreted.
!-------------------------------------------------------------------------------------------------------------------------------
-PROGRAM opsmode
+PROGRAM ops_main
USE m_ops_building
USE m_aps
@@ -74,6 +77,7 @@ PROGRAM opsmode
USE m_commonconst
USE m_commonfile
USE IFPORT
+USE m_ops_vchem
IMPLICIT NONE
@@ -108,6 +112,7 @@ PROGRAM opsmode
INTEGER*4 :: usdv
INTEGER*4 :: iseiz
INTEGER*4 :: icm
+INTEGER*4 :: nsubsec ! number of sub-secondary species
INTEGER*4 :: nrrcp
INTEGER*4 :: nrcol
INTEGER*4 :: nrrow
@@ -142,6 +147,7 @@ PROGRAM opsmode
REAL*4 :: z0_src ! roughness length at source; from z0-map [m]
REAL*4 :: z0_tra ! roughness length representative for trajectory [m]
REAL*4 :: vchemc
+INTEGER*4 :: iopt_vchem ! option for chemical conversion rate (0 = old OPS, 1 = EMEP)
REAL*4 :: vchemv
REAL*4 :: xc
REAL*4 :: yc
@@ -220,15 +226,15 @@ PROGRAM opsmode
REAL*4 :: koh
REAL*4 :: so2sek(NSEK)
REAL*4 :: no2sek(NSEK)
-REAL*4 :: gemcseccor
+REAL*4, DIMENSION(:), POINTER :: gem_subsec ! grid mean for concentration of sub-secondary species [ug/m3]
REAL*4 :: scale_con
REAL*4 :: scale_sec
-REAL*4 :: scale_sec_cor
+REAL*4, DIMENSION(:), POINTER :: scale_subsec
REAL*4 :: scale_dep
REAL*4 :: so2bgtra !
REAL*4 :: no2bgtra !
REAL*4 :: nh3bgtra !
-
+type(Tvchem) :: vchem2
REAL*8, DIMENSION(:), POINTER :: sdrypri_arr
REAL*8 :: sdrypri
REAL*8, DIMENSION(:), POINTER :: snatpri_arr
@@ -254,7 +260,7 @@ PROGRAM opsmode
CHARACTER*80 :: project
CHARACTER*80 :: runid
CHARACTER*80 :: namsec
-CHARACTER*80 :: namseccor
+CHARACTER*80, DIMENSION(:), POINTER :: nam_subsec
CHARACTER*80 :: namse3
CHARACTER*10 :: coneh
CHARACTER*10 :: depeh
@@ -293,6 +299,7 @@ PROGRAM opsmode
REAL*4, DIMENSION(:), POINTER :: gym
REAL*4, DIMENSION(:), POINTER :: z0_rcp_all ! roughness lengths for all receptors; from z0-map or receptor file [m]
REAL*4, DIMENSION(:), POINTER :: rhno3_rcp
+REAL*4, DIMENSION(:,:), ALLOCATABLE :: f_subsec_rcp ! fractions for sub-secondary species, HNO3/NO3_total, NO3_C/NO3_total, NO3_F/NO3_total [-]
REAL*4, DIMENSION(:), POINTER :: precip
DOUBLE PRECISION, DIMENSION(:,:), POINTER :: cpri_d ! concentration of primary component, double precision [ug/m3]
REAL*4, DIMENSION(:), POINTER :: cpri ! concentration of primary component [ug/m3]
@@ -305,8 +312,9 @@ PROGRAM opsmode
DOUBLE PRECISION, DIMENSION(:,:), POINTER :: ddepri_d
REAL*4, DIMENSION(:), POINTER :: ddepri
REAL*4, DIMENSION(:), POINTER :: totdep
-REAL*4, DIMENSION(:), POINTER :: cseccor
+REAL*4, DIMENSION(:,:), POINTER :: csubsec ! concentration of sub-secondary species [ug/m3]
REAL*4, DIMENSION(:), POINTER :: nh3bg_rcp
+REAL*4, DIMENSION(:), POINTER :: so2bg_rcp
REAL*4, DIMENSION(:), POINTER :: rno2_nox_sum ! NO2/NOx ratio, weighed sum over classes
CHARACTER*12, DIMENSION(:), POINTER :: namrcp ! receptor names
@@ -317,6 +325,7 @@ PROGRAM opsmode
TYPE (TApsGridReal) :: so2bggrid
TYPE (TApsGridReal) :: no2bggrid
TYPE (TApsGridReal) :: nh3bggrid
+TYPE (TApsGridReal) :: f_subsec_grid ! grids of fractions for sub-secondary species, HNO3/NO3_total, NO3_C/NO3_total, NO3_F/NO3_total [-]
TYPE (TApsGridReal) :: masker
TYPE (TError) :: error
!
@@ -388,8 +397,8 @@ PROGRAM opsmode
! Read variables from control file
!
CALL ops_read_ctr(project, runid, year, icm, namco, amol1, gasv, idep, kdeppar, ddeppar, knatdeppar, wdeppar, dg, irev, &
- & vchemc, vchemv, emtrend, ncatsel, catsel, nlandsel, landsel, spgrid, xc, yc, nrcol, nrrow, grid, igrens, &
- & z0_user, intpol, ideh, igrid, checked, f_z0user, isec, error)
+ & vchemc, iopt_vchem, vchemv, emtrend, ncatsel, catsel, nlandsel, landsel, spgrid, xc, yc, nrcol, nrrow, grid, igrens, &
+ & z0_user, intpol, ideh, igrid, checked, f_z0user, isec, nsubsec, error)
IF (error%haserror) GOTO 1000 ! GOTO error handling at end of program
!
! Generate full file names of those files that were not set explicitly in the control file.
@@ -438,7 +447,10 @@ PROGRAM opsmode
! Read background concentrations for SO2, NH3, NO2
!
IF (isec) THEN
- CALL ops_read_bg(icm, year, so2bggrid, no2bggrid, nh3bggrid, error)
+ allocate(nam_subsec(nsubsec))
+ allocate(scale_subsec(nsubsec))
+ allocate(gem_subsec(nsubsec))
+ CALL ops_read_bg(icm, iopt_vchem, nsubsec, year, so2bggrid, no2bggrid, nh3bggrid, f_subsec_grid, vchem2, error)
IF (error%haserror) GOTO 1000 ! GOTO error handling at end of program
ENDIF
!
@@ -475,10 +487,11 @@ PROGRAM opsmode
!
! Initialisation
!
-CALL ops_init (gasv, idep, building_present1, kdeppar, knatdeppar, ddeppar, wdeppar, amol2, ideh, icm, isec, iseiz, mb, astat, dverl, &
+CALL ops_init (gasv, idep, building_present1, kdeppar, knatdeppar, ddeppar, wdeppar, amol2, ideh, icm, isec, nsubsec, iseiz, mb, astat, dverl, &
& usdverl, dv, usdv, namco, amol1, dg, irev, vchemc, vchemv, emtrend, rc, coneh, amol21, depeh, namsec, &
& namse3, ugmoldep, scavcoef, rcno, rhno2, rchno3, routsec, routpri, conc_cf, koh, croutpri, somcsec, &
- & ar, rno2nox, ecvl, namseccor, buildingEffect, error)
+ & ar, rno2nox, ecvl, nam_subsec, buildingEffect, error)
+
IF (error%haserror) GOTO 3300 ! GOTO deallocate all arrays and do error handling at end of program.
! Allocate miscellaneous arrays for receptor points
@@ -486,15 +499,16 @@ PROGRAM opsmode
CALL alloc(nrrcp, gym, error)
CALL alloc(nrrcp, nh3bg_rcp, error)
+CALL alloc(nrrcp, so2bg_rcp, error)
CALL alloc(nrrcp, rhno3_rcp, error)
+CALL alloc(nrrcp, nsubsec, f_subsec_rcp, error)
IF (error%haserror) GOTO 3300 ! GOTO deallocate all arrays and do error handling at end of program.
!
-! Fill arrays with roughness length, landuse and rhno3_rcp for all receptor points
+! Fill arrays with roughness length, landuse and rhno3_rcp, nh3bg_rcp, f_subsec_rcp, domlu for all receptor points
!
-CALL ops_rcp_char_all(icm, isec, xm, ym, f_z0user, z0_user, z0nlgrid, z0eurgrid, lugrid, so2bggrid, nh3bggrid, nrrcp, gxm, gym, &
- & lu_rcp_dom_all, z0_rcp_all, rhno3_rcp, nh3bg_rcp, domlu, error)
-
+CALL ops_rcp_char_all(icm, iopt_vchem, isec, nsubsec, xm, ym, f_z0user, z0_user, z0nlgrid, z0eurgrid, lugrid, so2bggrid, nh3bggrid, f_subsec_grid, &
+ & nrrcp, gxm, gym, lu_rcp_dom_all, z0_rcp_all, rhno3_rcp, nh3bg_rcp, so2bg_rcp, f_subsec_rcp, domlu, error)
!
! Allocate other arrays for receptor points;
! directly after deallocating memory for different grids, some other receptor-vectors are allocated (see below).
@@ -591,7 +605,7 @@ PROGRAM opsmode
!
! Retreive landuse values for this receptorpoint.
!
- CALL ops_rcp_char_1 (ircp, nrrcp, intpol, gxm(ircp), gym(ircp), cs, z0_metreg, xreg, yreg, i1, astat, z0_metreg_user, &
+ CALL ops_rcp_char_1 (isec, ircp, nrrcp, intpol, gxm(ircp), gym(ircp), cs, z0_metreg, xreg, yreg, i1, astat, z0_metreg_user, &
& spgrid, xm(ircp), ym(ircp), lugrid, domlu, perc, lu_rcp_per_user_all, lu_rcp_dom_all, f_z0user, z0_rcp_all, &
& uurtot, z0_metreg_rcp, lu_rcp_per, lu_rcp_dom, z0_rcp, error)
IF (error%haserror) GOTO 3300 ! GOTO deallocate all arrays and do error handling at end of program.
@@ -607,22 +621,22 @@ PROGRAM opsmode
!
! compute trajectory characteristics
!
- CALL ops_tra_char (icm, f_z0user, z0_user, nrrcp, xm(ircp), ym(ircp), bx(mmm), by(mmm), &
- & lugrid, z0nlgrid, z0eurgrid, so2bggrid, no2bggrid, nh3bggrid, domlu, &
+ CALL ops_tra_char (icm, iopt_vchem, f_z0user, z0_user, nrrcp, xm(ircp), ym(ircp), bx(mmm), by(mmm), &
+ & lugrid, z0nlgrid, z0eurgrid, so2bggrid, no2bggrid, nh3bggrid, vchem2, domlu, &
& z0_tra, lu_tra_per, so2bgtra, no2bgtra, nh3bgtra, error)
IF (error%haserror) GOTO 3300 ! GOTO deallocate all arrays and do error handling at end of program.
!
! compute concentrations and depositions
- CALL ops_reken(idep, isec, icm, gasv, intpol, vchemc, vchemv, dv, amol1, amol2, amol21, ar, rno2nox, ecvl, iseiz, zf, &
+ CALL ops_reken(idep, isec, icm, gasv, intpol, vchemc, iopt_vchem, vchemv, dv, amol1, amol2, amol21, ar, rno2nox, ecvl, iseiz, zf, &
& trafst, knatdeppar, mb, ugmoldep, dg, irev, scavcoef, koh, croutpri, rcno, rhno2, rchno3, &
& nrrcp, ircp, gxm(ircp), gym(ircp), xm(ircp), ym(ircp), zm(ircp), &
- & frac(ircp), nh3bg_rcp(ircp), rhno3_rcp(ircp), &
+ & frac(ircp), nh3bg_rcp(ircp), so2bg_rcp(ircp), rhno3_rcp(ircp), &
& bqrv(mmm), bqtr(mmm), bx(mmm), by(mmm), bdiam(mmm), bsterkte(mmm), bwarmte(mmm), bhoogte(mmm), &
& bsigmaz(mmm), bD_stack(mmm), bV_stack(mmm), bTs_stack(mmm), bemis_horizontal(mmm), bbuilding(mmm), &
& buildingEffect,btgedr(mmm), bdegr(mmm), &
& z0_src, z0_tra, z0_rcp, z0_metreg_rcp, lu_tra_per, &
- & lu_rcp_per, so2sek, no2sek, so2bgtra, no2bgtra, nh3bgtra, maxidx, pmd, uspmd, spgrid, grid, &
+ & lu_rcp_per, so2sek, no2sek, so2bgtra, no2bgtra, nh3bgtra, vchem2, maxidx, pmd, uspmd, spgrid, grid, &
& subbron, uurtot, routsec, rc, somvnsec_arr, telvnsec_arr, vvchem_arr, vtel_arr, somvnpri_arr, &
& telvnpri_arr, ddepri_d, sdrypri_arr, snatpri_arr, sdrysec_arr, snatsec_arr, &
& cpri_d, csec_d, drydep_d, wetdep_d, astat, rno2_nox_sum, precip(ircp), routpri, dispg, error)
@@ -651,6 +665,7 @@ PROGRAM opsmode
CALL dealloc(no2bggrid)
CALL dealloc(so2bggrid)
CALL dealloc(nh3bg_rcp)
+CALL dealloc(so2bg_rcp)
CALL dealloc(gxm)
CALL dealloc(gym)
@@ -662,7 +677,7 @@ PROGRAM opsmode
!CALL sysclose(fu_scratch, 'sources scratch file', error)
!IF (error%haserror) GOTO 3300 ! GOTO deallocate all arrays and do error handling at end of program.
!
-! Compute variables that are used for different output purposes
+! Compute variables that are used for different output purposes and initialise them to zero:
!
CALL alloc(nrrcp, 0., cpri, error)
CALL alloc(nrrcp, 0., csec, error)
@@ -670,7 +685,7 @@ PROGRAM opsmode
CALL alloc(nrrcp, 0., wetdep, error)
CALL alloc(nrrcp, 0., ddepri, error)
CALL alloc(nrrcp, 0., totdep, error)
-CALL alloc(nrrcp, 0., cseccor, error)
+CALL alloc(nrrcp, nsubsec, csubsec, error); if (nsubsec .gt. 0) csubsec = 0.0
! ntodo: number of particle size classes that are relevant for producing output fields
! Default value for ntodo (for gas):
@@ -729,15 +744,15 @@ PROGRAM opsmode
!
! compute variables used in different output sources
!
- CALL ops_outp_prep (nrrcp, icm, conc_cf, rhno3_rcp, csec, drydep, wetdep, cpri, totdep, cseccor, scale_con, scale_sec, &
- & scale_sec_cor, scale_dep)
+ CALL ops_outp_prep (nrrcp, icm, nsubsec, conc_cf, rhno3_rcp, f_subsec_rcp, csec, drydep, wetdep, cpri, totdep, csubsec, scale_con, scale_sec, &
+ & scale_subsec, scale_dep)
!
! Compute (grid) statistics
!
- CALL ops_calc_stats (nrrcp, frac, cpri, csec, drydep ,wetdep, gemre, sdrypri, sdrysec, snatpri, snatsec, somvnpri, &
- & somvnsec, vvchem, vtel, telvnpri, telvnsec, grid, conc_cf, amol21, ugmoldep, cseccor, gemcpri, gemcsec, totddep, &
+ CALL ops_calc_stats (nrrcp, nsubsec, frac, cpri, csec, drydep ,wetdep, gemre, sdrypri, sdrysec, snatpri, snatsec, somvnpri, &
+ & somvnsec, vvchem, vtel, telvnpri, telvnsec, grid, conc_cf, amol21, ugmoldep, csubsec, gemcpri, gemcsec, totddep, &
& gemddep, gemddpri, gemddsec, ddrpri, ddrsec, totwdep, gemwdep, gemwdpri, gemwdsec, wdrpri, wdrsec, &
- & gemprec, tottdep, gemtdep, ccr, gemcseccor)
+ & gemprec, tottdep, gemtdep, ccr, gem_subsec)
!
! Open print output file
!
@@ -749,16 +764,16 @@ PROGRAM opsmode
!
IF (spgrid .EQ. 2) THEN
CALL ops_print_recep(project, gasv, idep, isec, igrid, verb, namco, namsec, namse3, coneh, depeh, conc_cf, amol21, &
- & ugmoldep, nrrcp, namrcp, xm, ym, precip, cpri, csec, drydep, ddepri, wetdep, rno2_nox_sum, &
+ & ugmoldep, nrrcp, nsubsec, namrcp, xm, ym, precip, cpri, csec, drydep, ddepri, wetdep, rno2_nox_sum, &
& lu_rcp_dom_all, z0_rcp_all, gemcpri, gemcsec, ccr, gemddep, gemddpri, gemddsec, ddrpri, ddrsec, gemwdep, &
- & gemwdpri, gemwdsec, wdrpri, wdrsec, gemprec, gemtdep, icm, cseccor, gemcseccor, namseccor, totdep, &
- & scale_con, scale_sec, scale_sec_cor, scale_dep, error)
+ & gemwdpri, gemwdsec, wdrpri, wdrsec, gemprec, gemtdep, icm, csubsec, gem_subsec, nam_subsec, totdep, &
+ & scale_con, scale_sec, scale_subsec, scale_dep, error)
ELSE
- CALL ops_print_grid (nrrcp, jump, project, icm, gasv, idep, isec, igrid, verb, namco, namsec, namse3, coneh, depeh, &
+ CALL ops_print_grid (nrrcp, nsubsec, jump, project, icm, gasv, idep, isec, igrid, verb, namco, namsec, namse3, coneh, depeh, &
& conc_cf, amol21, ugmoldep, nrcol, nrrow, grid, xorg, yorg, precip, cpri, csec, drydep, wetdep, ddepri, &
& lu_rcp_dom_all, z0_rcp_all, gemcpri, gemcsec, ccr, gemddep, gemddpri, gemddsec, totddep, ddrpri, ddrsec, gemwdep, &
- & gemwdpri, gemwdsec, totwdep, wdrpri, wdrsec, gemprec, gemtdep, tottdep, cseccor, gemcseccor, namseccor, totdep, &
- & scale_con, scale_sec, scale_sec_cor, scale_dep, error)
+ & gemwdpri, gemwdsec, totwdep, wdrpri, wdrsec, gemprec, gemtdep, tottdep, csubsec, gem_subsec, nam_subsec, totdep, &
+ & scale_con, scale_sec, scale_subsec, scale_dep, error)
ENDIF
IF (error%haserror) GOTO 4000
!
@@ -768,8 +783,8 @@ PROGRAM opsmode
IF (.NOT. sysopen(fu_plt, pltnam, 'w', 'plot file', error)) GOTO 3300
ENDIF
- CALL ops_plot_uitv(spgrid, isec, coneh, nrrcp, jump, xorg, yorg, nrcol, nrrow, grid, idep, namco, namse3, namsec, depeh, &
- & namrcp, xm, ym, cpri, csec, drydep, wetdep, icm, cseccor, namseccor, error)
+ CALL ops_plot_uitv(spgrid, isec, coneh, nrrcp, nsubsec, jump, xorg, yorg, nrcol, nrrow, grid, idep, namco, namse3, namsec, depeh, &
+ & namrcp, xm, ym, cpri, csec, drydep, wetdep, icm, csubsec, nam_subsec, error)
IF (error%haserror) GOTO 4000
outputfile_opened = .TRUE.
ENDIF
@@ -839,4 +854,4 @@ PROGRAM opsmode
CALL EXIT(0)
ENDIF
-END PROGRAM opsmode
+END PROGRAM ops_main
diff --git a/ops_neutral.f90 b/ops_neutral.f90
index 7cdd455..ff70a29 100644
--- a/ops_neutral.f90
+++ b/ops_neutral.f90
@@ -1,21 +1,24 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! SUBROUTINE
! NAME : %M%
@@ -24,7 +27,7 @@
! BRANCH -SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR : HvJ / Franka Loeve (Cap Volmac)
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM/LLO
! LANGUAGE : FORTRAN-77/90
! DESCRIPTION : This routine calculates sigmaz for near neutral cases according to Gryning et al. (1987).
diff --git a/ops_outp_prep.f90 b/ops_outp_prep.f90
index e5e8d06..b5e427d 100644
--- a/ops_outp_prep.f90
+++ b/ops_outp_prep.f90
@@ -1,21 +1,24 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! SUBROUTINE
!
@@ -25,7 +28,7 @@
! BRANCH -SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR : Wilco de Vries
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM LLO
! LANGUAGE : FORTRAN-77/90
! DESCRIPTION : Prepare output process (print/plot)
@@ -36,16 +39,18 @@
! CALLED FUNCTIONS :
! UPDATE HISTORY :
!-------------------------------------------------------------------------------------------------------------------------------
-SUBROUTINE ops_outp_prep(nrrcp, icm, conc_cf, rhno3_rcp, csec, drydep, wetdep, cpri, totdep, cseccor, scale_con, scale_sec, &
- & scale_sec_cor, scale_dep)
+SUBROUTINE ops_outp_prep(nrrcp, icm, nsubsec, conc_cf, rhno3_rcp, f_subsec_rcp, csec, drydep, wetdep, cpri, totdep, csubsec, scale_con, scale_sec, &
+ & scale_subsec, scale_dep)
IMPLICIT NONE
! SUBROUTINE ARGUMENTS - INPUT
INTEGER*4, INTENT(IN) :: nrrcp !
INTEGER*4, INTENT(IN) :: icm !
+INTEGER*4, INTENT(IN) :: nsubsec ! number of sub-secondary species
REAL*4, INTENT(IN) :: conc_cf !
REAL*4, INTENT(IN) :: rhno3_rcp(nrrcp) !
+REAL*4, INTENT(OUT) :: f_subsec_rcp(nrrcp,nsubsec) ! fractions for sub-secondary species, HNO3/NO3_total, NO3_C/NO3_total, NO3_F/NO3_total [-]
REAL*4, INTENT(IN) :: csec(nrrcp) !
REAL*4, INTENT(IN) :: drydep(nrrcp) !
REAL*4, INTENT(IN) :: wetdep(nrrcp) !
@@ -55,14 +60,14 @@ SUBROUTINE ops_outp_prep(nrrcp, icm, conc_cf, rhno3_rcp, csec, drydep, wetdep, c
! SUBROUTINE ARGUMENTS - OUTPUT
REAL*4, INTENT(OUT) :: totdep(nrrcp) !
-REAL*4, INTENT(OUT) :: cseccor(nrrcp) !
+REAL*4, INTENT(OUT) :: csubsec(nrrcp,nsubsec) ! concentration of sub-secondary species [ug/m3]
REAL*4, INTENT(OUT) :: scale_con !
REAL*4, INTENT(OUT) :: scale_sec !
-REAL*4, INTENT(OUT) :: scale_sec_cor !
+REAL*4, INTENT(OUT) :: scale_subsec(nsubsec) ! scaling factor for sub-secondary species
REAL*4, INTENT(OUT) :: scale_dep !
! LOCAL VARIABLES
-INTEGER*4 :: j !
+INTEGER*4 :: isubsec ! index of sub-secondary species
! CONSTANTS
CHARACTER*512 :: ROUTINENAAM !
@@ -73,28 +78,20 @@ SUBROUTINE ops_outp_prep(nrrcp, icm, conc_cf, rhno3_rcp, csec, drydep, wetdep, c
sccsida = '%W%:%E%'//char(0)
!-------------------------------------------------------------------------------------------------------------------------------
!
-! Calculate
-! 1. totdep = total deposition = dry deposition + wet deposition
-! 2. corrected NOx concentration (to account for HNO2 and PAN contributions to NO2)
-! 3. concentration of second secondary substance;
-!
-! rhno3 = ratio [HNO3]/[NO3]_total (NO3_total = HNO3+NO3_aerosol)
-!
-! [HNO3] [NO3_aerosol]
-! cseccor = csec (1 - rhno3) = csec (1 - ------------ ) = csec ------------- = [NO3_aerosol]
-! [NO3]_total [NO3]_total
-!
-DO j = 1, nrrcp
- totdep(j) = drydep(j) + wetdep(j)
- IF (icm == 2) THEN
- cpri(j) = cpri(j) * conc_cf
- cseccor(j) = csec(j) - csec(j) * rhno3_rcp(j)
- ENDIF
-ENDDO
+! 1. Calculate totdep = total deposition = dry deposition + wet deposition
+! 2. Correct cpri = NOx concentration (to account for HNO2 and PAN contributions to NO2)
+! 3. Calculate concentration of sub-secondary species
+totdep = drydep + wetdep
+IF (icm == 2) THEN
+ cpri = cpri * conc_cf
+ do isubsec = 1,nsubsec
+ csubsec(:,isubsec) = f_subsec_rcp(:,isubsec)*csec
+ enddo
+ENDIF
!
! Scaling factors for concentration and deposition fields
!
-CALL ops_scalefac(nrrcp, cpri, csec, drydep, wetdep, scale_con, scale_sec, scale_dep, cseccor, scale_sec_cor)
+CALL ops_scalefac(nrrcp, nsubsec, cpri, csec, drydep, wetdep, scale_con, scale_sec, scale_dep, csubsec, scale_subsec)
RETURN
diff --git a/ops_par_chem.f90 b/ops_par_chem.f90
index bbf821f..a281f71 100644
--- a/ops_par_chem.f90
+++ b/ops_par_chem.f90
@@ -1,21 +1,24 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! SUBROUTINE
! NAME : %M%
@@ -24,7 +27,7 @@
! BRANCH -SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR : HvJ
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM/LLO
! LANGUAGE : FORTRAN-77/90
! DESCRIPTION : Get chemical parameters (conversion rates, concentration ratios).
@@ -35,11 +38,12 @@
! CALLED FUNCTIONS :
! UPDATE HISTORY :
!-------------------------------------------------------------------------------------------------------------------------------
-SUBROUTINE ops_par_chem (icm, isek, so2sek, no2sek, so2bgtra, no2bgtra, nh3bgtra, disx, diameter, vchemnh3, rhno3, &
+SUBROUTINE ops_par_chem (icm, iopt_vchem, isek, so2sek, no2sek, so2bgtra, no2bgtra, nh3bgtra, vchem2, disx, diameter, vchemnh3, rhno3, &
& rrno2nox, rations)
USE m_commonconst
USE m_aps
+USE m_ops_vchem
IMPLICIT NONE
@@ -48,18 +52,20 @@ SUBROUTINE ops_par_chem (icm, isek, so2sek, no2sek, so2bgtra, no2bgtra, nh3bgtra
PARAMETER (ROUTINENAAM = 'ops_par_chem')
! SUBROUTINE ARGUMENTS - INPUT
-INTEGER*4, INTENT(IN) :: icm
+INTEGER*4, INTENT(IN) :: icm
+INTEGER*4, INTENT(IN) :: iopt_vchem ! option for chemical conversion rate (0 = old OPS, 1 = EMEP)
INTEGER*4, INTENT(IN) :: isek
REAL*4, INTENT(IN) :: so2sek(NSEK)
REAL*4, INTENT(IN) :: no2sek(NSEK)
REAL*4, INTENT(IN) :: so2bgtra
REAL*4, INTENT(IN) :: no2bgtra
REAL*4, INTENT(IN) :: nh3bgtra
+type(Tvchem), INTENT(INOUT) :: vchem2
REAL*4, INTENT(IN) :: disx
-REAL*4, INTENT(IN) :: diameter
+REAL*4, INTENT(IN) :: diameter
! SUBROUTINE ARGUMENTS - OUTPUT
-REAL*4, INTENT(OUT) :: vchemnh3
+REAL*4, INTENT(OUT) :: vchemnh3
REAL*4, INTENT(OUT) :: rhno3
REAL*4, INTENT(OUT) :: rrno2nox
REAL*4, INTENT(OUT) :: rations
@@ -107,69 +113,71 @@ SUBROUTINE ops_par_chem (icm, isek, so2sek, no2sek, so2bgtra, no2bgtra, nh3bgtra
nh3bgtra_corr = nh3bgtra
IF (icm == 1) THEN
-!
-! SO2
-! compute N/S ratio; factor 2 is because of (NH4) (SO4)
-! 2
-!
- rations = nh3bgtra_corr/(2*so2bgtra_corr)
+
+ ! SO2
+ ! compute N/S ratio; factor 2 is because of (NH4) (SO4)
+ rations = nh3bgtra_corr/(2*so2bgtra_corr)
ELSE
- IF (icm == 2) THEN
-!
-! NOx
-! rhno3 = ratio [HNO3]/[NO3]_total (NO3_total = HNO3+NO3_aerosol)
-! This ratio has been computed with the help of a 1D chemistry model (model chemie5)
-! (fit between daily averaged HNO3 and NO3 concentrations for november and december 1989);
-! see also ops_rcp_char.
-! Here we use the trajectory averaged, wind sector corrected background NH3 concentration.
-!
- rhno3 = amin1(0.024*(nh3bgtra_corr/1000)**(-0.44),0.8)
-!
-! rrno2nox is the spatially variable component in the [NO2]/[NOx] ratio, using an average [NO2]/[NOx] ratio
-! in NL equal to 0.65 (see also ops_init).
-! This empirical [NO2]/[NOx] ratio follows from a fit of measured yearly averaged concentrations in NL (1993).
+ IF (icm == 2) THEN
+
+ ! NOx
+ ! rhno3 = ratio [HNO3]/[NO3]_total (NO3_total = HNO3+NO3_aerosol)
+ ! This ratio has been computed with the help of a 1D chemistry model (model chemie5)
+ ! (fit between daily averaged HNO3 and NO3 concentrations for november and december 1989);
+ ! see also ops_rcp_char.
+ ! Here we use the trajectory averaged, wind sector corrected background NH3 concentration.
+ rhno3 = amin1(0.024*(nh3bgtra_corr/1000)**(-0.44),0.8)
+
+ ! rrno2nox is the spatially variable component in the [NO2]/[NOx] ratio, using an average [NO2]/[NOx] ratio
+ ! in NL equal to 0.65 (see also ops_init).
+ ! This empirical [NO2]/[NOx] ratio follows from a fit of measured yearly averaged concentrations in NL (1993).
+
+ !
+ ! In ops_read_bg, the grid with corrected NOx background concentrations (in ppbv) is converted cellwise to NO2 (in ppbv).
+ ! [NO2] = beta1*log([NOx]) + beta2; coefficients are defined in m_commonconst. Tag: NOx-NO2 relation
+ ! Since this function drops below zero for low values of [NOx], a linear function is used for [NOx] <= NOx_threshold ppbv,
+ ! that touches the log-function at the threshold value and is zero for [NOx] = 0 ppbv.
+ ! g(x) = alpha*x, f(x) = beta1*log(x) + beta2.
+ ! First derivative equal at threshold x0: alpha = beta1/x0.
+ ! Function equal at x0: (beta1/x0)*x0 = beta1*log(x0) + beta2 <=> x0 = exp(1-beta2/beta1).
+ !
+ ! Here we need the inverse function of this function:
+ ! NO2_threshold = alpha*x0 = beta1
+ ! NO2 > NO2_threshold -> [NOx] = exp(([NO2]-beta2)/beta1)
+ ! NO2 <= NO2_threshold -> [NOx] = [NO2]/alpha
+ !
+ nox_threshold = exp(1-(nox_no2_beta(2)/nox_no2_beta(1)))
+ no2_threshold = nox_no2_beta(1)
+ alpha = nox_no2_beta(1)/nox_threshold
+ IF (no2bgtra_corr .GT. no2_threshold) THEN
+ noxbgtra_corr = exp((no2bgtra_corr-nox_no2_beta(2))/nox_no2_beta(1))
+ ELSE
+ noxbgtra_corr = no2bgtra_corr/alpha
+ ENDIF
+ rrno2nox=no2bgtra_corr/(0.65*noxbgtra_corr)
-!
-! In ops_read_bg, the grid with corrected NOx background concentrations (in ppbv) is converted cellwise to NO2 (in ppbv).
-! [NO2] = beta1*log([NOx]) + beta2; coefficients are defined in m_commonconst. Tag: NOx-NO2 relation
-! Since this function drops below zero for low values of [NOx], a linear function is used for [NOx] <= NOx_threshold ppbv,
-! that touches the log-function at the threshold value and is zero for [NOx] = 0 ppbv.
-! g(x) = alpha*x, f(x) = beta1*log(x) + beta2.
-! First derivative equal at threshold x0: alpha = beta1/x0.
-! Function equal at x0: (beta1/x0)*x0 = beta1*log(x0) + beta2 <=> x0 = exp(1-beta2/beta1).
-!
-! Here we need the inverse function of this function:
-! NO2_threshold = alpha*x0 = beta1
-! NO2 > NO2_threshold -> [NOx] = exp(([NO2]-beta2)/beta1)
-! NO2 <= NO2_threshold -> [NOx] = [NO2]/alpha
-!
- nox_threshold = exp(1-(nox_no2_beta(2)/nox_no2_beta(1)))
- no2_threshold = nox_no2_beta(1)
- alpha = nox_no2_beta(1)/nox_threshold
- IF (no2bgtra_corr .GT. no2_threshold) THEN
- noxbgtra_corr = exp((no2bgtra_corr-nox_no2_beta(2))/nox_no2_beta(1))
- ELSE
- noxbgtra_corr = no2bgtra_corr/alpha
- ENDIF
- rrno2nox=no2bgtra_corr/(0.65*noxbgtra_corr)
-
- ELSE
-!
-! icm = 3, NH3
-! Compute conversion rate NH3 -> NH4;
-! ch = [SO2]/[NH3]
-
-! note that 1.7*[0.1 0.8 6.3 1.8 -0.17] = [0.17 1.36 10.71 3.06 -0.29]
-
-! Chemistry model computes hourly concentrations for one column (including emissions, deposition);
-! then relations between different components are derived.
-!
- ch = amin1(so2bgtra_corr/nh3bgtra_corr,3.0)
- vchemnh3 = 0.1 + 0.8*no2bgtra_corr/nh3bgtra_corr + 6.3*ch + 1.8*ch**4 - 0.17*ch**6
- vchemnh3 = amax1(1.0,vchemnh3*3.0+0.5) ! calibration to bulk measurements (yearly averaged NH3/NH4 ratios)
+ ELSE
+
+ ! icm = 3, NH3
+ ! Compute conversion rate NH3 -> NH4;
+ ! ch = [SO2]/[NH3]
+
+ ! note that 1.7*[0.1 0.8 6.3 1.8 -0.17] = [0.17 1.36 10.71 3.06 -0.29]
+
+ ! Chemistry model computes hourly concentrations for one column (including emissions, deposition);
+ ! then relations between different components are derived.
+
+ ch = amin1(so2bgtra_corr/nh3bgtra_corr,3.0)
+ vchemnh3 = 0.1 + 0.8*no2bgtra_corr/nh3bgtra_corr + 6.3*ch + 1.8*ch**4 - 0.17*ch**6
+ vchemnh3 = amax1(1.0,vchemnh3*3.0+0.5) ! calibration to bulk measurements (yearly averaged NH3/NH4 ratios)
+ ENDIF
+ENDIF
- ENDIF
+! Compute chemical conversion rates [%/h] from averaged mass pre chemistry and mass converted during time step (EMEP option iopt_vchem = 1):
+IF ((icm == 1 .or. icm == 2 .or. icm == 3) .and. iopt_vchem .eq. 1) THEN
+ vchem2%vchem = vchem2%mass_conv_dtfac_tra/vchem2%mass_prec_tra ! note: factor (100.0/dt) is already in mass_conv_dtfac_tra
ENDIF
+
RETURN
END SUBROUTINE ops_par_chem
diff --git a/ops_plot_uitv.f90 b/ops_plot_uitv.f90
index a597961..d8aed11 100644
--- a/ops_plot_uitv.f90
+++ b/ops_plot_uitv.f90
@@ -1,21 +1,24 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! SUBROUTINE
!
@@ -25,7 +28,7 @@
! BRANCH -SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR : HvJ/ Franka Loeve (Cap Volmac)
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM LLO
! LANGUAGE : FORTRAN-77/90
! DESCRIPTION : Write results to plot-file (*.plt)
@@ -36,8 +39,8 @@
! CALLED FUNCTIONS :
! UPDATE HISTORY :
!-------------------------------------------------------------------------------------------------------------------------------
-SUBROUTINE ops_plot_uitv(spgrid, isec, coneh, nrrcp, jump, xorg, yorg, nrcol, nrrow, grid, idep, namco, namse3, namsec, &
- & depeh, namrcp, xm, ym, cpri, csec, drydep, wetdep, icm, cseccor, namseccor, error)
+SUBROUTINE ops_plot_uitv(spgrid, isec, coneh, nrrcp, nsubsec, jump, xorg, yorg, nrcol, nrrow, grid, idep, namco, namse3, namsec, &
+ & depeh, namrcp, xm, ym, cpri, csec, drydep, wetdep, icm, csubsec, nam_subsec, error)
USE m_error
USE m_commonfile
@@ -51,6 +54,7 @@ SUBROUTINE ops_plot_uitv(spgrid, isec, coneh, nrrcp, jump, xorg, yorg, nrcol, nr
LOGICAL, INTENT(IN) :: isec !
CHARACTER*(*), INTENT(IN) :: coneh !
INTEGER*4, INTENT(IN) :: nrrcp !
+INTEGER*4, INTENT(IN) :: nsubsec ! number of sub-secondary species
INTEGER*4, INTENT(IN) :: jump(nrrcp+1) ! distance between receptor points in grid units
REAL*4, INTENT(IN) :: xorg !
REAL*4, INTENT(IN) :: yorg !
@@ -70,8 +74,8 @@ SUBROUTINE ops_plot_uitv(spgrid, isec, coneh, nrrcp, jump, xorg, yorg, nrcol, nr
REAL*4, INTENT(IN) :: drydep(nrrcp) !
REAL*4, INTENT(IN) :: wetdep(nrrcp) !
INTEGER*4, INTENT(IN) :: icm !
-REAL*4, INTENT(IN) :: cseccor(nrrcp) !
-CHARACTER*(*), INTENT(IN) :: namseccor !
+REAL*4, INTENT(IN) :: csubsec(nrrcp,nsubsec) ! concentration of sub-secondary species [ug/m3]
+CHARACTER*(*), INTENT(IN) :: nam_subsec(nsubsec) ! names of sub-secondary species
! SUBROUTINE ARGUMENTS - OUTPUT
TYPE (TError), INTENT(OUT) :: error ! Error handling record
@@ -83,6 +87,7 @@ SUBROUTINE ops_plot_uitv(spgrid, isec, coneh, nrrcp, jump, xorg, yorg, nrcol, nr
REAL*4 :: xlb !
REAL*4 :: ylb !
REAL*4 :: totdep(nrrcp) !
+INTEGER*4 :: isubsec ! index of sub-secondary species
! CONSTANTS
CHARACTER*512 :: ROUTINENAAM !
@@ -107,64 +112,36 @@ SUBROUTINE ops_plot_uitv(spgrid, isec, coneh, nrrcp, jump, xorg, yorg, nrcol, nr
!
! Acidifying components
!
-
- IF (icm == 2) THEN
-!
-! NOx
-!
- WRITE (fu_plt, '(a4,8x,a8,a8,6a12)', IOSTAT = ierr) 'name', 'x-coord', 'y-coord', 'conc.', 'dry dep.', 'wet dep.', &
- & 'tot.dep.', 'conc.', 'conc.'
+ WRITE (fu_plt, '(a4,8x,a8,a8,9a12)', IOSTAT = ierr) 'name', 'x-coord', 'y-coord', 'conc.', 'dry_dep.', 'wet_dep.', &
+ & 'tot_dep.', ('conc.', isubsec = 1,nsubsec+1)
IF (ierr .GT. 0) GOTO 4200
ls = LEN_TRIM(namse3)
- WRITE (fu_plt, '(28x,6a12)', IOSTAT = ierr) namco(:LEN_TRIM(namco)), namse3(:ls), namse3(:ls), namse3(:ls), &
- & namsec(:LEN_TRIM(namsec)), namseccor(:LEN_TRIM(namseccor))
+ WRITE (fu_plt, '(a4,8x,a8,a8,9a12:)', IOSTAT = ierr) '-', '-', '-', namco(:LEN_TRIM(namco)), namse3(:ls), namse3(:ls), namse3(:ls), &
+ & namsec(:LEN_TRIM(namsec)), (nam_subsec(isubsec)(:LEN_TRIM(nam_subsec(isubsec))), isubsec = 1,nsubsec)
IF (ierr .GT. 0) GOTO 4200
- WRITE (fu_plt, '(12x,a8,a8,6a12)', IOSTAT = ierr) 'm', 'm', coneh, depeh, depeh, depeh, 'ug/m3', 'ug/m3'
+ WRITE (fu_plt, '(a4,8x,a8,a8,9a12:)', IOSTAT = ierr) '-','m', 'm', coneh, depeh, depeh, depeh, ('ug/m3', isubsec = 1,nsubsec+1)
IF (ierr .GT. 0) GOTO 4200
DO j = 1, nrrcp
- WRITE (fu_plt, '(a12,2i8,6e12.4)', IOSTAT = ierr) namrcp(j), NINT(xm(j)), NINT(ym(j)), cpri(j), drydep(j), &
- & wetdep(j), drydep(j) + wetdep(j), csec(j), cseccor(j)
+ WRITE (fu_plt, '(a12,2i8,9e12.4)', IOSTAT = ierr) namrcp(j), NINT(xm(j)), NINT(ym(j)), cpri(j), drydep(j), &
+ & wetdep(j), drydep(j) + wetdep(j), csec(j), (csubsec(j,isubsec), isubsec = 1,nsubsec)
IF (ierr .GT. 0) GOTO 4200
ENDDO
- ELSE
-!
-! other than NOx
-!
- WRITE (fu_plt, '(a4,8x,a8,a8,5a12)', IOSTAT = ierr) 'name', 'x-coord', 'y-coord', 'conc.', 'dry dep.', 'wet dep.', &
- & 'tot.dep.', 'conc.'
- IF (ierr .GT. 0) GOTO 4200
-
- ls = LEN_TRIM(namse3)
- WRITE (fu_plt, '(28x,5a12)', IOSTAT = ierr) namco(:LEN_TRIM(namco)), namse3(:ls), namse3(:ls), namse3(:ls), &
- & namsec(:LEN_TRIM(namsec))
- IF (ierr .GT. 0) GOTO 4200
-
- WRITE (fu_plt, '(12x,a8,a8,5a12)', IOSTAT = ierr) 'm', 'm', coneh, depeh, depeh, depeh, 'ug/m3'
- IF (ierr .GT. 0) GOTO 4200
-
- DO j = 1, nrrcp
- WRITE (fu_plt, '(a12,2i8,5e12.4)', IOSTAT = ierr) namrcp(j), NINT(xm(j)), NINT(ym(j)), cpri(j), drydep(j), &
- & wetdep(j), drydep(j) + wetdep(j), csec(j)
- IF (ierr .GT. 0) GOTO 4200
- ENDDO
- ENDIF
-
ELSE IF (idep) THEN
!
! Depositions
!
- WRITE (fu_plt, '(a4,8x,a8,a8,5a12)', IOSTAT = ierr) 'name', 'x-coord', 'y-coord', 'conc.', 'dry dep.', 'wet dep.', &
- & 'tot.dep.'
+ WRITE (fu_plt, '(a4,8x,a8,a8,5a12)', IOSTAT = ierr) 'name', 'x-coord', 'y-coord', 'conc.', 'dry_dep.', 'wet_dep.', &
+ & 'tot_dep.'
IF (ierr .GT. 0) GOTO 4200
- WRITE (fu_plt, '(28x,5a12)', IOSTAT = ierr) namco(:5), namse3(:5), namse3(:5), namse3(:5)
+ WRITE (fu_plt, '(a4,8x,a8,a8,5a12:)', IOSTAT = ierr) '-', '-', '-', namco(:5), namse3(:5), namse3(:5), namse3(:5)
IF (ierr .GT. 0) GOTO 4200
- WRITE (fu_plt, '(12x,a8,a8,5a12)', IOSTAT = ierr) 'm', 'm', coneh, depeh, depeh, depeh
+ WRITE (fu_plt, '(a4,8x,a8,a8,5a12:)', IOSTAT = ierr) '-', 'm', 'm', coneh, depeh, depeh, depeh
IF (ierr .GT. 0) GOTO 4200
DO j = 1, nrrcp
@@ -180,10 +157,10 @@ SUBROUTINE ops_plot_uitv(spgrid, isec, coneh, nrrcp, jump, xorg, yorg, nrcol, nr
WRITE (fu_plt, '(a4,8x,a8,a8,a12)', IOSTAT = ierr) 'name', 'x-coord', 'y-coord', 'conc.'
IF (ierr .GT. 0) GOTO 4200
- WRITE (fu_plt, '(28x,a12)', IOSTAT = ierr) namco(:5)
+ WRITE (fu_plt, '(a4,8x,a8,a8,a12:)', IOSTAT = ierr) '-', '-', '-', namco(:5)
IF (ierr .GT. 0) GOTO 4200
- WRITE (fu_plt, '(12x,a8,a8,a12)', IOSTAT = ierr) 'm', 'm', coneh
+ WRITE (fu_plt, '(a4,8x,a8,a8,a12:)', IOSTAT = ierr) '-', 'm', 'm', coneh
IF (ierr .GT. 0) GOTO 4200
DO j = 1, nrrcp
@@ -213,30 +190,32 @@ SUBROUTINE ops_plot_uitv(spgrid, isec, coneh, nrrcp, jump, xorg, yorg, nrcol, nr
! Depositions (dry, wet, total)
!
IF (idep) THEN
- CALL plot_mat(fu_plt, drydep, nrrcp, jump, nrcol, nrrow, 'dry deposition ', namse3, depeh, grid, xlb, ylb, error)
+ CALL plot_mat(fu_plt, drydep, nrrcp, jump, nrcol, nrrow, 'dry_deposition ', namse3, depeh, grid, xlb, ylb, error)
IF (error%haserror) GOTO 9000
- CALL plot_mat(fu_plt, wetdep, nrrcp, jump, nrcol, nrrow, 'wet deposition ', namse3, depeh, grid, xlb, ylb, error)
+ CALL plot_mat(fu_plt, wetdep, nrrcp, jump, nrcol, nrrow, 'wet_deposition ', namse3, depeh, grid, xlb, ylb, error)
IF (error%haserror) GOTO 9000
totdep(:nrrcp) = drydep(:) + wetdep(:)
- CALL plot_mat(fu_plt, totdep, nrrcp, jump, nrcol, nrrow, 'total deposition ', namse3, depeh, grid, xlb, ylb, error)
+ CALL plot_mat(fu_plt, totdep, nrrcp, jump, nrcol, nrrow, 'total_deposition ', namse3, depeh, grid, xlb, ylb, error)
IF (error%haserror) GOTO 9000
ENDIF
!
! Secondary concentration
!
IF (isec) THEN
- CALL plot_mat(fu_plt, csec, nrrcp, jump, nrcol, nrrow, 'conctr. sec. component', namsec, 'ug/m3', grid, xlb, ylb, error)
+ CALL plot_mat(fu_plt, csec, nrrcp, jump, nrcol, nrrow, 'conctr._sec._component', namsec, 'ug/m3', grid, xlb, ylb, error)
IF (error%haserror) GOTO 9000
ENDIF
!
! Second secondary concentration (NOx only, icm = 2)
!
IF (icm == 2) THEN
- CALL plot_mat(fu_plt, cseccor, nrrcp, jump, nrcol, nrrow, 'NO3 concentration ', namseccor, 'ug/m3', grid, xlb, ylb, &
+ do isubsec = 1,nsubsec
+ CALL plot_mat(fu_plt, csubsec(:,isubsec), nrrcp, jump, nrcol, nrrow, trim(nam_subsec(isubsec))//'_concentration', nam_subsec(isubsec), 'ug/m3', grid, xlb, ylb, &
& error)
- IF (error%haserror) GOTO 9000
+ IF (error%haserror) GOTO 9000
+ enddo
ENDIF
ENDIF
diff --git a/ops_plrise71.f90 b/ops_plrise71.f90
index 442eb0e..f083f1e 100644
--- a/ops_plrise71.f90
+++ b/ops_plrise71.f90
@@ -1,21 +1,24 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! SUBROUTINE
! NAME : %M%
@@ -24,14 +27,14 @@
! BRANCH -SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR : HvJ 940217 /Franka Loeve (Cap Volmac)
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM/LLO
! LANGUAGE : FORTRAN-77/90
! DESCRIPTION : Deze routine berekent de pluimhoogte.
! This routine includes plume rise formulations given by Briggs(1969) and Briggs(1971)
! This method is equal to the method used in the (old) Dutch National Model (TNO, 1976).
! The formulas used in 'STACKS' are the same, except for convective cases (Erbrink, 1995)
-! HvJ 960121
+! 960121
! Extra iteration, because wind speed depends on plume height and vice versa
!
! EXIT CODES :
diff --git a/ops_print_grid.f90 b/ops_print_grid.f90
index acbb997..c984a13 100644
--- a/ops_print_grid.f90
+++ b/ops_print_grid.f90
@@ -1,18 +1,21 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
@@ -25,7 +28,7 @@
! BRANCH - SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR : Chris Twenh"ofel (Cap Gemini)
+! AUTHOR : OPS-support Chris Twenh"ofel (Cap Gemini)
! FIRM/INSTITUTE : RIVM/LLO
! LANGUAGE : FORTRAN (HP-UX, HP-F77)
! DESCRIPTION : Print concentration, deposition and other gridded data.
@@ -36,11 +39,11 @@
! UPDATE HISTORY :
!
!-------------------------------------------------------------------------------------------------------------------------------
-SUBROUTINE ops_print_grid (nrrcp, jump, project, icm, gasv, idep, isec, igrid, verb, namco, namsec, namse3, coneh, depeh, &
- & conc_cf, amol21, ugmoldep, nrcol, nrrow, grid, xorg, yorg, precip, cpri, csec, drydep, wetdep, ddepri, &
- & lu_rcp_dom_all, z0_rcp_all, gemcpri, gemcsec, ccr, gemddep, gemddpri, gemddsec, totddep, ddrpri, ddrsec, gemwdep, &
- & gemwdpri, gemwdsec, totwdep, wdrpri, wdrsec, gemprec, gemtdep, tottdep, cseccor, gemcseccor, namseccor, totdep, &
- & scale_con, scale_sec, scale_sec_cor, scale_dep, error)
+SUBROUTINE ops_print_grid (nrrcp, nsubsec, jump, project, icm, gasv, idep, isec, igrid, verb, namco, namsec, namse3, coneh, depeh, &
+ & conc_cf, amol21, ugmoldep, nrcol, nrrow, grid, xorg, yorg, precip, cpri, csec, drydep, wetdep, ddepri, &
+ & lu_rcp_dom_all, z0_rcp_all, gemcpri, gemcsec, ccr, gemddep, gemddpri, gemddsec, totddep, ddrpri, ddrsec, gemwdep, &
+ & gemwdpri, gemwdsec, totwdep, wdrpri, wdrsec, gemprec, gemtdep, tottdep, csubsec, gem_subsec, nam_subsec, totdep, &
+ & scale_con, scale_sec, scale_subsec, scale_dep, error)
USE m_error
USE m_commonfile
@@ -53,7 +56,8 @@ SUBROUTINE ops_print_grid (nrrcp, jump, project, icm, gasv, idep, isec, igrid, v
PARAMETER (ROUTINENAAM = 'ops_print_grid')
! SUBROUTINE ARGUMENTS - INPUT
-INTEGER*4, INTENT(IN) :: nrrcp ! number ofreceptor points
+INTEGER*4, INTENT(IN) :: nrrcp ! number of receptor points
+INTEGER*4, INTENT(IN) :: nsubsec ! number of sub-secondary species
INTEGER*4, INTENT(IN) :: jump(nrrcp+1) ! distance between receptor points in grid units
CHARACTER*(*), INTENT(IN) :: project ! project name
INTEGER*4, INTENT(IN) :: icm ! component number
@@ -98,13 +102,13 @@ SUBROUTINE ops_print_grid (nrrcp, jump, project, icm, gasv, idep, isec, igrid, v
REAL*4, INTENT(IN) :: gemprec ! grid mean annual precpitation from meteo
REAL*4, INTENT(IN) :: gemtdep ! grid mean for total deposition
REAL*4, INTENT(IN) :: tottdep ! grid total total deposition
-REAL*4, INTENT(IN) :: cseccor(nrrcp) ! concentration of second secondary substance
-REAL*4, INTENT(IN) :: gemcseccor ! grid mean for second secondary concentration
-CHARACTER*(*), INTENT(IN) :: namseccor !
+REAL*4, INTENT(IN) :: csubsec(nrrcp,nsubsec) ! concentration of sub-secondary substance [ug/m3]
+REAL*4, INTENT(IN) :: gem_subsec(nsubsec) ! grid mean for concentration of sub-secondary species [ug/m3]
+CHARACTER*(*), INTENT(IN) :: nam_subsec(nsubsec) ! names of sub-secondary species
REAL*4, INTENT(IN) :: totdep(nrrcp) ! total deposition
REAL*4, INTENT(IN) :: scale_con ! scalefactor prim. concentration
REAL*4, INTENT(IN) :: scale_sec ! scalefactor sec. concentration
-REAL*4, INTENT(IN) :: scale_sec_cor ! scalefactor corrected sec. concentration
+REAL*4, INTENT(IN) :: scale_subsec(nsubsec) ! scaling factor for sub-secondary species
REAL*4, INTENT(IN) :: scale_dep ! scalefactor deposition
! SUBROUTINE ARGUMENTS - I/O
@@ -118,6 +122,8 @@ SUBROUTINE ops_print_grid (nrrcp, jump, project, icm, gasv, idep, isec, igrid, v
! LOCAL VARIABLES
INTEGER :: j ! counter through receptro points
REAL*4 :: tmp(nrrcp) ! tempory array with values to be written
+INTEGER*4 :: isubsec ! index of sub-secondary species
+
! SCCS-ID VARIABLES
CHARACTER*81 :: sccsida !
@@ -144,7 +150,7 @@ SUBROUTINE ops_print_grid (nrrcp, jump, project, icm, gasv, idep, isec, igrid, v
CALL print_mat(fu_prt, cpri, scale_con, nrrcp, jump, nrcol, nrrow, grid, xorg, yorg, error)
ENDIF
-WRITE (fu_prt, '(/,'' average '',a,'' concentration'', T50, '': '', e9.3, 1x, a6)') namco(:LEN_TRIM(namco)), gemcpri, coneh
+WRITE (fu_prt, '(/,'' average '',a,'' concentration'', T50, '': '', e9.3, 1x, a10)') namco(:LEN_TRIM(namco)), gemcpri, coneh
IF (gasv.and.(icm.ne.0.or.idep)) THEN
WRITE (fu_prt,'('' eff. chem. conv. rate'', T50, '': '', f9.3, '' %/h'')') ccr
@@ -158,17 +164,21 @@ SUBROUTINE ops_print_grid (nrrcp, jump, project, icm, gasv, idep, isec, igrid, v
WRITE (fu_prt, '(a)') char(12)
CALL ops_print_kop(project, namco)
- WRITE (fu_prt, '('' concentration distribution of '', a, '': ('', 1p, e7.0, 1x, a5, '')'')') &
- & namseccor(:LEN_TRIM(namseccor)), 1/scale_sec_cor, 'ug/m3'
- CALL print_mat(fu_prt, cseccor, scale_sec_cor, nrrcp, jump, nrcol, nrrow, grid, xorg, yorg, error)
+ do isubsec = 1,nsubsec
+ WRITE (fu_prt, '('' concentration distribution of '', a, '': ('', 1p, e7.0, 1x, a5, '')'')') &
+ & nam_subsec(isubsec)(:LEN_TRIM(nam_subsec(isubsec))), 1/scale_subsec(isubsec), 'ug/m3'
+ CALL print_mat(fu_prt, csubsec(:,isubsec), scale_subsec(isubsec), nrrcp, jump, nrcol, nrrow, grid, xorg, yorg, error)
+ enddo
ENDIF
- WRITE (fu_prt, '(/,'' average '',a,'' concentration'', T50, '': '', e9.3, a6)') namseccor(:LEN_TRIM(namseccor)), &
- & gemcseccor, 'ug/m3'
+ do isubsec = 1,nsubsec
+ WRITE (fu_prt, '(/,'' average '',a,'' concentration'', T50, '': '', e9.3, a6)') nam_subsec(isubsec)(:LEN_TRIM(nam_subsec(isubsec))), &
+ & gem_subsec(isubsec), 'ug/m3'
+ enddo
ENDIF
!
-! (1aa) Concentration of secondary component
+! (1aa) Concentration of secondary component (non-NOx)
!
IF (verb .or. icm /= 2) THEN
IF (igrid) THEN
diff --git a/ops_print_info.f90 b/ops_print_info.f90
index 1aafeda..f20eb39 100644
--- a/ops_print_info.f90
+++ b/ops_print_info.f90
@@ -1,21 +1,24 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! SUBROUTINE
! NAME : %M%
@@ -24,7 +27,7 @@
! BRANCH -SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR :
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM/LLO
! LANGUAGE : FORTRAN-77/90
! DESCRIPTION : Prints input parameters at the end of text output
diff --git a/ops_print_kop.f90 b/ops_print_kop.f90
index 0f25472..fddc179 100644
--- a/ops_print_kop.f90
+++ b/ops_print_kop.f90
@@ -1,21 +1,24 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! SUBROUTINE
! NAME : %M%
@@ -24,7 +27,7 @@
! BRANCH -SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR :
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM/LLO
! LANGUAGE : FORTRAN-F77/90
! DESCRIPTION : Print page header ("kop"= head)
diff --git a/ops_print_recep.f90 b/ops_print_recep.f90
index 7a458e0..adaffd5 100644
--- a/ops_print_recep.f90
+++ b/ops_print_recep.f90
@@ -1,21 +1,24 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! SUBROUTINE
! NAME : %M%
@@ -24,7 +27,7 @@
! BRANCH - SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR : Chris Twenh"ofel (Cap Gemini)
+! AUTHOR : OPS-support Chris Twenh"ofel (Cap Gemini)
! FIRM/INSTITUTE : RIVM/LLO
! LANGUAGE : FORTRAN-77/90
! DESCRIPTION : Print output for non-gridded receptors
@@ -35,11 +38,11 @@
! CALLED FUNCTIONS : ops_print_kop, ops_scalefac
! UPDATE HISTORY :
!-------------------------------------------------------------------------------------------------------------------------------
-SUBROUTINE ops_print_recep (project, gasv, idep, isec, igrid, verb, namco, namsec, namse3, coneh, depeh, conc_cf, amol21, &
- & ugmoldep, nrrcp, namrcp, xm, ym, precip, cpri, csec, drydep, ddepri, wetdep, rno2_nox_sum, lu_rcp_dom_all, z0_rcp_all, &
- & gemcpri, gemcsec, ccr, gemddep, gemddpri, gemddsec, ddrpri, ddrsec, gemwdep, gemwdpri, gemwdsec, wdrpri, &
- & wdrsec, gemprec, gemtdep, icm, cseccor, gemcseccor, namseccor, totdep, scale_con, scale_sec, &
- & scale_sec_cor, scale_dep, error)
+SUBROUTINE ops_print_recep (project, gasv, idep, isec, igrid, verb, namco, namsec, namse3, coneh, depeh, conc_cf, amol21, &
+ & ugmoldep, nrrcp, nsubsec, namrcp, xm, ym, precip, cpri, csec, drydep, ddepri, wetdep, rno2_nox_sum, lu_rcp_dom_all, z0_rcp_all, &
+ & gemcpri, gemcsec, ccr, gemddep, gemddpri, gemddsec, ddrpri, ddrsec, gemwdep, gemwdpri, gemwdsec, wdrpri, &
+ & wdrsec, gemprec, gemtdep, icm, csubsec, gem_subsec, nam_subsec, totdep, scale_con, scale_sec, &
+ & scale_subsec, scale_dep, error)
USE ops_print_table
USE m_error
@@ -66,6 +69,7 @@ SUBROUTINE ops_print_recep (project, gasv, idep, isec, igrid, verb, namco, namse
REAL*4, INTENT(IN) :: amol21 !
REAL*4, INTENT(IN) :: ugmoldep !
INTEGER*4, INTENT(IN) :: nrrcp ! number of receptor points
+INTEGER*4, INTENT(IN) :: nsubsec ! number of sub-secondary species
CHARACTER*(*), INTENT(IN) :: namrcp (nrrcp) !
REAL*4, INTENT(IN) :: xm(nrrcp) !
REAL*4, INTENT(IN) :: ym(nrrcp) !
@@ -94,13 +98,13 @@ SUBROUTINE ops_print_recep (project, gasv, idep, isec, igrid, verb, namco, namse
REAL*4, INTENT(IN) :: gemprec ! mean annual precpitation from meteo
REAL*4, INTENT(IN) :: gemtdep ! mean for total deposition
INTEGER*4, INTENT(IN) :: icm ! number of component
-REAL*4, INTENT(IN) :: cseccor(nrrcp) ! gaseous secondary concentration
-REAL*4, INTENT(IN) :: gemcseccor ! mean gaseous secondary concentration
-CHARACTER*(*), INTENT(IN) :: namseccor !
+REAL*4, INTENT(IN) :: csubsec(nrrcp,nsubsec) ! concentration of sub-secondary species [ug/m3]
+REAL*4, INTENT(IN) :: gem_subsec(nsubsec) ! grid mean for concentration of sub-secondary species [ug/m3]
+CHARACTER*(*), INTENT(IN) :: nam_subsec(nsubsec) ! names of sub-secondary speciea
REAL*4, INTENT(IN) :: totdep(nrrcp) ! total deposition
REAL*4, INTENT(IN) :: scale_con !
REAL*4, INTENT(IN) :: scale_sec !
-REAL*4, INTENT(IN) :: scale_sec_cor !
+REAL*4, INTENT(IN) :: scale_subsec(nsubsec) ! scaling factor for sub-secondary species
REAL*4, INTENT(IN) :: scale_dep !
! SUBROUTINE ARGUMENTS - I/O
@@ -108,11 +112,12 @@ SUBROUTINE ops_print_recep (project, gasv, idep, isec, igrid, verb, namco, namse
LOGICAL, INTENT(INOUT) :: igrid !
! SUBROUTINE ARGUMENTS - OUTPUT
-TYPE (Terror), INTENT(OUT) :: error !
+TYPE (Terror), INTENT(INOUT) :: error !
! LOCAL VARIABLES
INTEGER*4 :: i !
INTEGER*4 :: j !
+INTEGER*4 :: isubsec ! index of sub-secondary species
REAL*4 :: scalec !
REAL*4 :: scaled !
REAL*4 :: scalen !
@@ -132,20 +137,20 @@ SUBROUTINE ops_print_recep (project, gasv, idep, isec, igrid, verb, namco, namse
!
! FORMATS for possible header rows
!
-1703 FORMAT (/,' nr name x-coord y-coord pri.con')
-2703 FORMAT (/,' nr name x-coord y-coord pri.con', ' z0 lu_dom precip')
-3703 FORMAT (/,' nr name x-coord y-coord pri.con', ' dry.dep wet.dep tot.dep')
-4703 FORMAT (/,' nr name x-coord y-coord pri.con', ' dry.dep wet.dep tot.dep', &
- & ' vdpri z0 lu_dom precip')
-5703 FORMAT (/,' nr name x-coord y-coord pri.con', ' dry.dep wet.dep tot.dep sec.con')
-6703 FORMAT (/,' nr name x-coord y-coord pri.con', ' dry.dep wet.dep tot.dep sec.con' &
- & ' vdpri vdsec z0 lu_dom ' ' precip')
-7703 FORMAT (/,' nr name x-coord y-coord pri.con', ' dry.dep wet.dep tot.dep sec.con sec.cor')
-8703 FORMAT (/,' nr name x-coord y-coord pri.con', ' dry.dep wet.dep tot.dep sec.con sec.cor' &
- & ' vdpri vdsec z0 lu_dom ' ' precip')
-
-704 FORMAT (33x,5(6x,a3:),(6x,a4:)) ! component name (for isec=1)
-705 FORMAT (22x,'(m) (m)',10(a9:)) ! unit
+1703 FORMAT (/,' nr name x-coord y-coord conc')
+2703 FORMAT (/,' nr name x-coord y-coord conc', ' z0 lu_dom precip')
+3703 FORMAT (/,' nr name x-coord y-coord conc', ' dry_dep wet_dep tot_dep')
+4703 FORMAT (/,' nr name x-coord y-coord conc', ' dry_dep wet_dep tot_dep vdpri z0 lu_dom precip')
+5703 FORMAT (/,' nr name x-coord y-coord conc', ' dry_dep wet_dep tot_dep conc')
+6703 FORMAT (/,' nr name x-coord y-coord conc', ' dry_dep wet_dep tot_dep conc vdpri vdsec z0 lu_dom ' ' precip')
+7703 FORMAT (/,' nr name x-coord y-coord conc', ' dry_dep wet_dep tot_dep conc conc conc')
+7704 FORMAT (/,' nr name x-coord y-coord conc', ' dry_dep wet_dep tot_dep conc conc conc conc conc')
+8703 FORMAT (/,' nr name x-coord y-coord conc', ' dry_dep wet_dep tot_dep conc conc conc vdpri vdsec z0 lu_dom ' ' precip')
+8704 FORMAT (/,' nr name x-coord y-coord conc', ' dry_dep wet_dep tot_dep conc conc conc conc conc vdpri vdsec z0 lu_dom ' ' precip')
+
+!WdV704 FORMAT (33x,5(6x,a3:),9(6x,a4:)) ! component names (for isec=1)
+704 FORMAT (a3,a8,3x,2(a8),3x,14(1x,a8:)) ! component names (for isec=1)
+705 FORMAT (a3,a8,4x,' m m ',19(a9:)) ! units
!
! Definition of units for deposition velocity vd, roughness length z0, land use
!
@@ -173,7 +178,7 @@ SUBROUTINE ops_print_recep (project, gasv, idep, isec, igrid, verb, namco, namse
CALL print_conc_names(namco)
CALL print_depo_names()
WRITE (fu_prt,1703)
- WRITE (fu_prt,705) coneh ! unit for concentration
+ WRITE (fu_prt,705) '-', '-', coneh ! unit for concentration
CALL print_values(nrrcp, namrcp, xm, ym, error, cpri, scale_con)
ELSE
@@ -183,7 +188,7 @@ SUBROUTINE ops_print_recep (project, gasv, idep, isec, igrid, verb, namco, namse
CALL print_conc_names(namco)
CALL print_depo_names()
WRITE (fu_prt,2703)
- WRITE (fu_prt,705) coneh, z0eh, lueh
+ WRITE (fu_prt,705) '-', '-', coneh, z0eh, lueh
CALL print_values(nrrcp, namrcp, xm, ym, error, cpri, scale_con, z0_rcp_all, 1.E3, REAL(lu_rcp_dom_all), 1., precip, 1.)
ENDIF
@@ -202,7 +207,7 @@ SUBROUTINE ops_print_recep (project, gasv, idep, isec, igrid, verb, namco, namse
CALL print_conc_names(namco)
CALL print_depo_names()
WRITE (fu_prt,3703)
- WRITE (fu_prt,705) coneh,depeh,depeh,depeh
+ WRITE (fu_prt,705) '-', '-', coneh,depeh,depeh,depeh
CALL print_values(nrrcp, namrcp, xm, ym, error, cpri, scale_con, drydep, scale_dep, wetdep, scale_dep, totdep, &
& scale_dep)
@@ -214,7 +219,7 @@ SUBROUTINE ops_print_recep (project, gasv, idep, isec, igrid, verb, namco, namse
CALL print_conc_names(namco)
CALL print_depo_names()
WRITE (fu_prt,4703)
- WRITE (fu_prt,705) coneh,depeh,depeh,depeh,z0eh,lueh
+ WRITE (fu_prt,705) '-', '-', coneh,depeh,depeh,depeh,z0eh,lueh
DO j = 1, nrrcp
vdpri(j) = ddepri(j)/ugmoldep*1.0e2/(cpri(j)/ conc_cf*3600.)/amol21
@@ -236,36 +241,57 @@ SUBROUTINE ops_print_recep (project, gasv, idep, isec, igrid, verb, namco, namse
!
! print primary concentration, drydep, wetdep, totdep, secondary concentration, second secondary concentration in tables
!
- CALL print_conc_names(namco, namsec, namseccor)
+ CALL print_conc_names(namco, namsec, nam_subsec)
CALL print_depo_names(namsec)
- WRITE (fu_prt,7703)
- WRITE (fu_prt,704) namco(:LEN_TRIM(namco)), (namse3(:LEN_TRIM(namse3)), i=1, 3), namsec(:LEN_TRIM(namsec)), &
- & namseccor(:LEN_TRIM(namseccor))
- WRITE (fu_prt,705) coneh, depeh, depeh, depeh, 'ug/m3', 'ug/m3'
-
- CALL print_values(nrrcp, namrcp, xm, ym, error, cpri, scale_con, drydep, scale_dep, wetdep, scale_dep, totdep, &
- & scale_dep, csec, scale_sec, cseccor, scale_sec_cor)
-
+ IF (nsubsec .eq. 2) WRITE (fu_prt,7703)
+ IF (nsubsec .eq. 4) WRITE (fu_prt,7704)
+ WRITE (fu_prt,704) '-', '-', '-', '-', namco(:LEN_TRIM(namco)), (namse3(:LEN_TRIM(namse3)), i=1, 3), namsec(:LEN_TRIM(namsec)), &
+ & (nam_subsec(isubsec)(:LEN_TRIM(nam_subsec(isubsec))), isubsec = 1,nsubsec)
+ WRITE (fu_prt,705) '-', '-', coneh, depeh, depeh, depeh, 'ug/m3', ('ug/m3', isubsec = 1,nsubsec)
+
+ IF (nsubsec .eq. 4) then
+ CALL print_values(nrrcp, namrcp, xm, ym, error, cpri, scale_con, drydep, scale_dep, wetdep, scale_dep, totdep, &
+ & scale_dep, csec, scale_sec, csubsec(:,1), scale_subsec(1), csubsec(:,2), scale_subsec(2), &
+ & csubsec(:,3), scale_subsec(3),csubsec(:,4), scale_subsec(4))
+ ELSEIF (nsubsec .eq. 2) then
+ CALL print_values(nrrcp, namrcp, xm, ym, error, cpri, scale_con, drydep, scale_dep, wetdep, scale_dep, totdep, &
+ & scale_dep, csec, scale_sec, csubsec(:,1), scale_subsec(1), csubsec(:,2), scale_subsec(2))
+ ELSE
+ write(*,*) 'internal programming error ops_print_recep'
+ write(*,*) ' nsubsec must be 2 or 4 (see ops_read_ctr)'
+ stop
+ ENDIF
ELSE
!
-! print primary concentration, drydep, wetdep, totdep, secondary conc, second secondary concentration, vdpri, vdsec, z0, lu and precip in table
+! print primary concentration, drydep, wetdep, totdep, secondary conc, sub-secondary concentrations, vdpri, vdsec, z0, lu and precip in table
!
- CALL print_conc_names(namco, namsec, namseccor)
+ CALL print_conc_names(namco, namsec, nam_subsec)
CALL print_depo_names(namsec)
- WRITE (fu_prt,8703)
- WRITE (fu_prt,704) namco(:LEN_TRIM(namco)), (namse3(:LEN_TRIM(namse3)), i=1, 3), namsec(:LEN_TRIM(namsec)), &
- & namseccor(:LEN_TRIM(namseccor))
- WRITE (fu_prt,705) coneh, depeh, depeh, depeh, 'ug/m3', 'ug/m3', vdeh, vdeh, z0eh, lueh
+ IF (nsubsec .eq. 2) WRITE (fu_prt,8703)
+ IF (nsubsec .eq. 4) WRITE (fu_prt,8704)
+ WRITE (fu_prt,704) '-', '-', '-', '-', namco(:LEN_TRIM(namco)), (namse3(:LEN_TRIM(namse3)), i=1, 3), namsec(:LEN_TRIM(namsec)), &
+ & (nam_subsec(isubsec)(:LEN_TRIM(nam_subsec(isubsec))), isubsec = 1,nsubsec)
+ WRITE (fu_prt,705) '-', '-', coneh, depeh, depeh, depeh, 'ug/m3', ('ug/m3', isubsec = 1,nsubsec), vdeh, vdeh, z0eh, lueh
DO j = 1, nrrcp
vdpri(j) = ddepri(j)/ugmoldep*1.0e2/(cpri(j)/ conc_cf*3600.)/amol21
vdsec(j) = (drydep(j) - ddepri(j))/ugmoldep*1.0e2/ (csec(j)*3600.)
ENDDO
- CALL print_values(nrrcp, namrcp, xm, ym, error, cpri, scale_con, drydep, scale_dep, wetdep, scale_dep, totdep, &
- & scale_dep, csec, scale_sec, cseccor, scale_sec_cor, vdpri, 1.E3, vdsec, 1.E3, z0_rcp_all, 1.E3, &
- & REAL(lu_rcp_dom_all), 1., precip, 1.)
-
+ IF (nsubsec .eq. 4) then
+ CALL print_values(nrrcp, namrcp, xm, ym, error, cpri, scale_con, drydep, scale_dep, wetdep, scale_dep, totdep, &
+ & scale_dep, csec, scale_sec, csubsec(:,1), scale_subsec(1), csubsec(:,2), scale_subsec(2), &
+ & csubsec(:,3), scale_subsec(3), csubsec(:,4), scale_subsec(4), &
+ & vdpri, 1.E3, vdsec, 1.E3, z0_rcp_all, 1.E3, REAL(lu_rcp_dom_all), 1., precip, 1.)
+ ELSEIF (nsubsec .eq. 2) then
+ CALL print_values(nrrcp, namrcp, xm, ym, error, cpri, scale_con, drydep, scale_dep, wetdep, scale_dep, totdep, &
+ & scale_dep, csec, scale_sec, csubsec(:,1), scale_subsec(1), csubsec(:,2), scale_subsec(2), &
+ & vdpri, 1.E3, vdsec, 1.E3, z0_rcp_all, 1.E3, REAL(lu_rcp_dom_all), 1., precip, 1.)
+ ELSE
+ write(*,*) 'internal programming error ops_print_recep'
+ write(*,*) ' nsubsec must be 2 or 4 (see ops_read_ctr)'
+ stop
+ ENDIF
ENDIF
ELSE
@@ -278,8 +304,8 @@ SUBROUTINE ops_print_recep (project, gasv, idep, isec, igrid, verb, namco, namse
CALL print_conc_names(namco, namsec)
CALL print_depo_names(namsec)
WRITE (fu_prt,5703)
- WRITE (fu_prt,704) namco(:3),(namse3(:3),i=1,3), namsec(:3)
- WRITE (fu_prt,705) coneh, depeh, depeh, depeh, 'ug/m3'
+ WRITE (fu_prt,704) '-', '-', '-', '-', namco(:3),(namse3(:3),i=1,3), namsec(:3)
+ WRITE (fu_prt,705) '-', '-', coneh, depeh, depeh, depeh, 'ug/m3'
CALL print_values(nrrcp, namrcp, xm, ym, error, cpri, scale_con, drydep, scale_dep, wetdep, scale_dep, totdep, &
& scale_dep, csec, scale_sec)
@@ -291,8 +317,8 @@ SUBROUTINE ops_print_recep (project, gasv, idep, isec, igrid, verb, namco, namse
CALL print_conc_names(namco, namsec)
CALL print_depo_names(namsec)
WRITE (fu_prt,6703)
- WRITE (fu_prt,704) namco(:3),(namse3(:3),i=1,3),namsec(:3)
- WRITE (fu_prt,705) coneh, depeh, depeh, depeh, 'ug/m3', vdeh, vdeh, z0eh, lueh
+ WRITE (fu_prt,704) '-', '-', '-', '-', namco(:3),(namse3(:3),i=1,3),namsec(:3)
+ WRITE (fu_prt,705) '-', '-', coneh, depeh, depeh, depeh, 'ug/m3', vdeh, vdeh, z0eh, lueh
DO j = 1, nrrcp
vdpri(j) = ddepri(j)/ugmoldep*1.0e2/(cpri(j)/ conc_cf*3600.)/amol21
@@ -344,7 +370,7 @@ SUBROUTINE ops_print_recep (project, gasv, idep, isec, igrid, verb, namco, namse
! concentration of primary component always written to output
-WRITE (fu_prt, '(/,'' average '',a,'' concentration'', T50, '': '', e9.3, a6)') namco(:LEN_TRIM(namco)), gemcpri, coneh
+WRITE (fu_prt, '(/,'' average '',a,'' concentration'', T50, '': '', e9.3, a10)') namco(:LEN_TRIM(namco)), gemcpri, coneh
IF (idep)THEN
@@ -384,10 +410,11 @@ SUBROUTINE ops_print_recep (project, gasv, idep, isec, igrid, verb, namco, namse
IF (icm == 2) THEN
-! concentration of second secondary component
-
- WRITE (fu_prt, '(/,'' average '',a,'' concentration'', T50, '': '', e9.3, a6)') namseccor(:LEN_TRIM(namseccor)), &
- & gemcseccor, 'ug/m3'
+ ! concentration of sub-secondary species
+ do isubsec = 1,nsubsec
+ WRITE (fu_prt, '(/,'' average '',a,'' concentration'', T50, '': '', e9.3, a6)') nam_subsec(isubsec)(:LEN_TRIM(nam_subsec(isubsec))), &
+ & gem_subsec(isubsec), 'ug/m3'
+ enddo
ENDIF
diff --git a/ops_print_table.f90 b/ops_print_table.f90
index 86000ba..fd7f986 100644
--- a/ops_print_table.f90
+++ b/ops_print_table.f90
@@ -1,21 +1,24 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! SUBROUTINE
! NAME : %M%
@@ -24,7 +27,7 @@
! BRANCH - SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR : Martien de Haan (ARIS)
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM/LLO
! LANGUAGE : FORTRAN-77/90
! DESCRIPTION : Subroutines supporting receptor point printing.
@@ -64,7 +67,7 @@ MODULE ops_print_table
! SUBROUTINE: print_conc_names
! PURPOSE: prints names of concentration parameters
!-------------------------------------------------------------------------------------------------------------------------------
-SUBROUTINE print_conc_names(namco, namsec, namseccor)
+SUBROUTINE print_conc_names(namco, namsec, nam_subsec)
! CONSTANTS
CHARACTER*512 :: ROUTINENAAM !
@@ -73,18 +76,20 @@ SUBROUTINE print_conc_names(namco, namsec, namseccor)
! SUBROUTINE ARGUMENTS - INPUT
CHARACTER*(*), INTENT(IN) :: namco !
CHARACTER*(*), INTENT(IN), OPTIONAL :: namsec !
-CHARACTER*(*), INTENT(IN), OPTIONAL :: namseccor !
+CHARACTER*(*), INTENT(IN), OPTIONAL :: nam_subsec(:) ! names of sub-secondary species
+! Local variable
+INTEGER :: isubsec ! index of sub-secondary species
!-------------------------------------------------------------------------------------------------------------------------------
!
! FORMATS
!
-700 FORMAT (/' Concentrations for ',a:,' and ',a:,' and ',a:)
+700 FORMAT (/' Concentrations for ',9(1x,a))
701 FORMAT (/' Concentrations for ',a:,' and ',a:)
702 FORMAT (/' Concentrations for ',a:)
-IF (PRESENT(namseccor)) THEN
- WRITE(fu_prt, 700) namco(1:LEN_TRIM(namco)), namsec(:LEN_TRIM(namsec)), namseccor(:LEN_TRIM(namseccor))
+IF (PRESENT(nam_subsec)) THEN
+ WRITE(fu_prt, 700) namco(1:LEN_TRIM(namco)), namsec(:LEN_TRIM(namsec)), (nam_subsec(isubsec)(:LEN_TRIM(nam_subsec(isubsec))), isubsec = 1,size(nam_subsec))
ELSEIF (PRESENT(namsec)) THEN
WRITE(fu_prt, 701) namco(1:LEN_TRIM(namco)), namsec(:LEN_TRIM(namsec))
ELSE
@@ -126,14 +131,14 @@ END SUBROUTINE print_depo_names
!-------------------------------------------------------------------------------------------------------------------------------
! SUBROUTINE: print_values
! PURPOSE: prints values at all the receptor points for certain parameters. The parameters and even their numbers are
-! variable (up to 12 currently, but this can easily be increased).
+! variable (up to 14 currently, but this can easily be increased).
!-------------------------------------------------------------------------------------------------------------------------------
SUBROUTINE print_values (nrrcp, namrcp, xm, ym, error, par1, spar1, par2, spar2, par3, spar3, par4, spar4, par5, spar5, &
& par6, spar6, par7, spar7, par8, spar8, par9, spar9, par10, spar10, par11, spar11, par12, &
- & spar12)
+ & spar12, par13, spar13, par14, spar14)
INTEGER :: nrparam !
-PARAMETER (nrparam = 12)
+PARAMETER (nrparam = 14)
! CONSTANTS
CHARACTER*512 :: ROUTINENAAM !
@@ -168,6 +173,10 @@ SUBROUTINE print_values (nrrcp, namrcp, xm, ym, error, par1, spar1, par2, sp
REAL*4, INTENT(IN), OPTIONAL :: spar11 ! factor in parameter
REAL*4, INTENT(IN), OPTIONAL :: par12(nrrcp) ! values of parameter
REAL*4, INTENT(IN), OPTIONAL :: spar12 ! factor in parameter
+REAL*4, INTENT(IN), OPTIONAL :: par13(nrrcp) ! values of parameter
+REAL*4, INTENT(IN), OPTIONAL :: spar13 ! factor in parameter
+REAL*4, INTENT(IN), OPTIONAL :: par14(nrrcp) ! values of parameter
+REAL*4, INTENT(IN), OPTIONAL :: spar14 ! factor in parameter
! SUBROUTINE ARGUMENTS - I/O
TYPE (TError), INTENT(INOUT) :: error ! should not happen as format string is long enough
@@ -182,9 +191,9 @@ SUBROUTINE print_values (nrrcp, namrcp, xm, ym, error, par1, spar1, par2, sp
INTEGER*4 :: nrunit !
LOGICAL :: dummybool !
-CHARACTER*120 :: formatpar ! format in writing parameter names
-CHARACTER*120 :: formatval ! format in writing parameter values
-CHARACTER*120 :: formatunit ! format in writing parameter units
+CHARACTER*180 :: formatpar ! format in writing parameter names
+CHARACTER*180 :: formatval ! format in writing parameter values
+CHARACTER*180 :: formatunit ! format in writing parameter units
!
! Create factors array and determine nrpresent.
!
@@ -196,7 +205,8 @@ SUBROUTINE print_values (nrrcp, namrcp, xm, ym, error, par1, spar1, par2, sp
& .AND. has_rcp_values(spar5, nrpresent, factors) .AND. has_rcp_values(spar6, nrpresent, factors) &
& .AND. has_rcp_values(spar7, nrpresent, factors) .AND. has_rcp_values(spar8, nrpresent, factors) &
& .AND. has_rcp_values(spar9, nrpresent, factors) .AND. has_rcp_values(spar10, nrpresent, factors) &
- & .AND. has_rcp_values(spar11, nrpresent, factors) .AND. has_rcp_values(spar12, nrpresent, factors)
+ & .AND. has_rcp_values(spar11, nrpresent, factors) .AND. has_rcp_values(spar12, nrpresent, factors) &
+ & .AND. has_rcp_values(spar13, nrpresent, factors) .AND. has_rcp_values(spar14, nrpresent, factors)
!
! Create the factorscopy, where only factors unequal to 1 are counted.
! Determine nrunit and create formatstrings that depends upon the factors.
@@ -251,6 +261,10 @@ SUBROUTINE print_values (nrrcp, namrcp, xm, ym, error, par1, spar1, par2, sp
IF (set_rcp_values(par10(i), factors, nrpresent, j, values)) THEN
IF (set_rcp_values(par11(i), factors, nrpresent, j, values)) THEN
IF (set_rcp_values(par12(i), factors, nrpresent, j, values)) THEN
+ IF (set_rcp_values(par13(i), factors, nrpresent, j, values)) THEN
+ IF (set_rcp_values(par14(i), factors, nrpresent, j, values)) THEN
+ ENDIF
+ ENDIF
ENDIF
ENDIF
ENDIF
diff --git a/ops_rcp_char_1.f90 b/ops_rcp_char_1.f90
index 83ad508..330e8b7 100644
--- a/ops_rcp_char_1.f90
+++ b/ops_rcp_char_1.f90
@@ -1,21 +1,24 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! SUBROUTINE
! NAME : %M%
@@ -24,7 +27,7 @@
! BRANCH -SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR :
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM/LLO
! LANGUAGE : FORTRAN-77/90
! DESCRIPTION : Prepares values for landuse and roughness for one receptorpoint.
@@ -35,7 +38,7 @@
! CALLED FUNCTIONS :
! UPDATE HISTORY :
!-------------------------------------------------------------------------------------------------------------------------------
-SUBROUTINE ops_rcp_char_1(ircp, nrrcp, intpol, gxm_rcp, gym_rcp, cs, z0_metreg, xreg, yreg, i1, astat, z0_metreg_user, &
+SUBROUTINE ops_rcp_char_1(isec, ircp, nrrcp, intpol, gxm_rcp, gym_rcp, cs, z0_metreg, xreg, yreg, i1, astat, z0_metreg_user, &
& spgrid, x_rcp, y_rcp, lugrid, domlu, perc, lu_rcp_per_user_all, lu_rcp_dom_all, f_z0user, z0_rcp_all, &
& uurtot, z0_metreg_rcp, lu_rcp_per, lu_rcp_dom, z0_rcp, error)
@@ -52,7 +55,8 @@ SUBROUTINE ops_rcp_char_1(ircp, nrrcp, intpol, gxm_rcp, gym_rcp, cs, z0_metreg,
PARAMETER (ROUTINENAAM = 'ops_rcp_char_1')
! SUBROUTINE ARGUMENTS - INPUT
-INTEGER*4, INTENT(IN) :: ircp
+LOGICAL*4, INTENT(IN) :: isec
+INTEGER*4, INTENT(IN) :: ircp
INTEGER*4, INTENT(IN) :: nrrcp
INTEGER*4, INTENT(IN) :: intpol !
REAL*4, INTENT(IN) :: gxm_rcp ! array met x-coordinaat van receptorpunten (lola)
@@ -116,10 +120,12 @@ SUBROUTINE ops_rcp_char_1(ircp, nrrcp, intpol, gxm_rcp, gym_rcp, cs, z0_metreg,
! --- Fill lu_rcp_per array with info from standard grid with landuse info
! --- The first aps-grid contains dominant landuse so we start with the second
!
- DO lu=2,NLU+1
- CALL GridValue(x_rcp/1000, y_rcp/1000, lugrid, lu_rcp_per_int(lu-1), iscell, lu)
- ENDDO
- lu_rcp_per = float(lu_rcp_per_int)
+ IF (isec) THEN
+ DO lu=2,NLU+1
+ CALL GridValue(x_rcp/1000, y_rcp/1000, lugrid, lu_rcp_per_int(lu-1), iscell, lu)
+ ENDDO
+ lu_rcp_per = float(lu_rcp_per_int)
+ ENDIF
ENDIF
ELSE
IF (.not.perc) THEN
@@ -127,10 +133,12 @@ SUBROUTINE ops_rcp_char_1(ircp, nrrcp, intpol, gxm_rcp, gym_rcp, cs, z0_metreg,
! --- User did not specify percentages landuse in rcp-file.
! --- Fill lu_rcp_per array with info from standard grid with landuse info
!
- DO lu=2,NLU+1
- CALL GridValue(x_rcp/1000, y_rcp/1000, lugrid, lu_rcp_per_int(lu-1), iscell, lu)
- ENDDO
- lu_rcp_per = float(lu_rcp_per_int)
+ IF (isec) THEN
+ DO lu=2,NLU+1
+ CALL GridValue(x_rcp/1000, y_rcp/1000, lugrid, lu_rcp_per_int(lu-1), iscell, lu)
+ ENDDO
+ lu_rcp_per = float(lu_rcp_per_int)
+ ENDIF
ELSE
!
! --- User specified percentages landuse in rcp-file.
diff --git a/ops_rcp_char_all.f90 b/ops_rcp_char_all.f90
index 4de5086..198dd78 100644
--- a/ops_rcp_char_all.f90
+++ b/ops_rcp_char_all.f90
@@ -1,21 +1,24 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! SUBROUTINE
! NAME : %M%
@@ -24,7 +27,7 @@
! BRANCH -SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR :
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM/LLO
! LANGUAGE : FORTRAN-77/90
! DESCRIPTION : Fill arrays with receptor characteristics:
@@ -36,12 +39,13 @@
! CALLED FUNCTIONS : amcgeo, ops_getz0, ops_getlu, ops_bgcon
! UPDATE HISTORY :
!-------------------------------------------------------------------------------------------------------------------------------
-subroutine ops_rcp_char_all(icm, isec, xm, ym, f_z0user, z0_user, z0nlgrid, z0eurgrid, lugrid, so2bggrid, nh3bggrid, &
- & nrrcp, gxm, gym, lu_rcp_dom_all, z0_rcp_all, rhno3_rcp, nh3bg_rcp, domlu, error)
+subroutine ops_rcp_char_all(icm, iopt_vchem, isec, nsubsec, xm, ym, f_z0user, z0_user, z0nlgrid, z0eurgrid, lugrid, so2bggrid, nh3bggrid, f_subsec_grid, &
+ & nrrcp, gxm, gym, lu_rcp_dom_all, z0_rcp_all, rhno3_rcp, nh3bg_rcp, so2bg_rcp, f_subsec_rcp, domlu, error)
USE m_aps
USE m_geoutils
USE m_commonconst
+USE m_ops_bgcon
USE m_error
IMPLICIT NONE
@@ -52,7 +56,9 @@ subroutine ops_rcp_char_all(icm, isec, xm, ym, f_z0user, z0_user, z0nlgrid, z0eu
! SUBROUTINE ARGUMENTS - INPUT
INTEGER*4, INTENT(IN) :: icm
+INTEGER*4, INTENT(IN) :: iopt_vchem ! option for chemical conversion rate (0 = old OPS, 1 = EMEP)
LOGICAL*4, INTENT(IN) :: isec
+INTEGER*4, INTENT(IN) :: nsubsec ! number of sub-secondary species
REAL*4, INTENT(IN) :: xm(nrrcp) ! x-coordinates of receptors
REAL*4, INTENT(IN) :: ym(nrrcp) ! y-coordinates of receptors
LOGICAL*4, INTENT(IN) :: f_z0user
@@ -60,8 +66,9 @@ subroutine ops_rcp_char_all(icm, isec, xm, ym, f_z0user, z0_user, z0nlgrid, z0eu
TYPE (TApsGridInt), INTENT(IN) :: z0nlgrid ! map of roughness lengths in NL [m]
TYPE (TApsGridInt), INTENT(IN) :: z0eurgrid ! map of roughness lengths in Europe [m]
TYPE (TApsGridInt), INTENT(IN) :: lugrid ! grid with land use information
-TYPE (TApsGridReal), INTENT(IN) :: so2bggrid !
-TYPE (TApsGridReal), INTENT(IN) :: nh3bggrid !
+TYPE (TApsGridReal), INTENT(IN) :: so2bggrid ! grid of SO2 background concentrations [ug/m3]
+TYPE (TApsGridReal), INTENT(IN) :: nh3bggrid ! grid of NH3 background concentrations [ug/m3]
+TYPE (TApsGridReal), INTENT(IN) :: f_subsec_grid ! grids of fractions for sub-secondary species, HNO3/NO3_total, NO3_C/NO3_total, NO3_F/NO3_total [-]
INTEGER*4, INTENT(IN) :: nrrcp ! number of receptors
LOGICAL*4, INTENT(IN) :: domlu ! index of dominant land use class
@@ -70,21 +77,25 @@ subroutine ops_rcp_char_all(icm, isec, xm, ym, f_z0user, z0_user, z0nlgrid, z0eu
REAL*4, INTENT(OUT) :: gym(nrrcp)
REAL*4, INTENT(OUT) :: rhno3_rcp(nrrcp)
REAL*4, INTENT(OUT) :: nh3bg_rcp(nrrcp)
+REAL*4, INTENT(OUT) :: so2bg_rcp(nrrcp)
+REAL*4, INTENT(OUT) :: f_subsec_rcp(nrrcp,nsubsec) ! fractions for sub-secondary species, HNO3/NO3_total, NO3_C/NO3_total, NO3_F/NO3_total [-]
-! SUBROUTINE ARGUMENTS - INPUT/OUTPUT
+! SUBROUTINE ARGUMENTS - OUTPUT
INTEGER*4 :: landuse(NLU+1) ! land-use value at receptor
! landuse(1) = index of dominant landuse
! landuse(lu+1) = percentage of grid cell with landuse class lu, lu = 1,NLU
! For locations outside lugrid, a default land use class = 1 (grass) is taken.
INTEGER*4, INTENT(INOUT) :: lu_rcp_dom_all(nrrcp) ! index of dominant land use for all receptor points
REAL*4, INTENT(INOUT) :: z0_rcp_all(nrrcp) ! roughness lengths for all receptors; from z0-map or receptor file [m]
-TYPE (TError), INTENT(INOUT) :: error ! error handling record
+TYPE (TError), INTENT(INOUT) :: error
! LOCAL VARIABLES
INTEGER*4 :: ircp ! index of receptor
+INTEGER*4 :: isubsec ! index of sub-secondary species
REAL*4 :: so2bgconc ! background concentratie SO2
REAL*4 :: nh3bgconc ! background concentration NH3 at receptor [ppb]
LOGICAL :: z0found
+INTEGER :: ifield ! field index in f_subsec_grid
! SCCS-ID VARIABLES
CHARACTER*81 :: sccsida !
@@ -125,14 +136,14 @@ subroutine ops_rcp_char_all(icm, isec, xm, ym, f_z0user, z0_user, z0nlgrid, z0eu
ENDIF
ENDIF
ENDIF
-!
-! Get background concentrations at receptor
-!
- IF (isec) THEN
- CALL ops_bgcon(xm(ircp),ym(ircp),nh3bggrid, nh3bgconc)
+! For SO2, NOx, NH3:
+IF (isec) THEN
-!
+ ! Get background concentrations at receptor
+ CALL ops_bgcon(xm(ircp),ym(ircp),nh3bggrid, nh3bgconc)
+! Distribute NO3 and SO4 into sub-secondary species
+!
! rhno3 = ratio [HNO3]/[NO3]_total (NO3_total = HNO3+NO3_aerosol); all concentrations in ppb.
!
! [NH3]_background -0.44
@@ -145,18 +156,52 @@ subroutine ops_rcp_char_all(icm, isec, xm, ym, f_z0user, z0_user, z0nlgrid, z0eu
! Here we use the background NH3 concentration at the receptor.
! Note that for background [NH3] = 0.346 ppb, rhno3_rcp = 0.024*(nh3bgconc/1000)**(-0.44) = 0.8
! for background [NH3] < 0.346 ppb, rhno3_rcp is fixed at 0.8.
+!
+! Note that we still use rhno3_rcp for computing weighed averaged Rc-values; later on, this must be replaced by f_subsec_rcp.
+! For distributing concentrations over different secondary species, we use f_subsec_rcp, which is read from file.
!
IF (icm == 2) THEN
rhno3_rcp(ircp)=amin1(0.024*(nh3bgconc/1000)**(-0.44),0.8)
- ENDIF
+
+ ! Get fractions for different sub-secondary species, HNO3/NO3_total, NO3_C/NO3_total, NO3_F/NO3_total at current receptor location:
+ if (iopt_vchem .eq. 0) then
+
+ ! File with f_subsec_grid is not present, use old OPS parameterisation rhno3 and do not split into coarse and fine:
+ !WdV f_subsec_rcp(ircp,1) = rhno3_rcp(ircp) ! HNO3
+ !WdV f_subsec_rcp(ircp,2) = (1.0 - rhno3_rcp(ircp)) ! NO3_AEROSOL
+ f_subsec_rcp(ircp,1) = (1.0 - rhno3_rcp(ircp)) ! NO3_AEROSOL
+ f_subsec_rcp(ircp,2) = rhno3_rcp(ircp) ! HNO3
+
+ ! for NO3-coarse and - fine, fractions are used from BOP-report
+ ! f_subsec_rcp(ircp,2) = frac_no3c_bop*(1.0 - rhno3_rcp(ircp)) ! NO3_C
+ ! f_subsec_rcp(ircp,3) = frac_no3f_bop*(1.0 - rhno3_rcp(ircp)) ! NO3_F
+ else
+ ! Get fraction from EMEP grid:
+ ! (3 fields in f_subsec_grid: HNO3/NO3_total, NO3_C/NO3_total, NO3_F/NO3_total; 4 sub species NO3_aerosol, HNO3, NO3_C, NO3_F)
+ do isubsec = 2,nsubsec
+ ifield = isubsec - 1
+ CALL ops_bgcon(xm(ircp),ym(ircp),f_subsec_grid, f_subsec_rcp(ircp,isubsec),ifield)
+ enddo
+
+ ! Fraction NO3_aerosol / NO3_total:
+ f_subsec_rcp(ircp,1) = f_subsec_rcp(ircp,3) + f_subsec_rcp(ircp,4)
+ endif
+ ELSE
!
-! Convert NH3 background concentration from ppb to ug/m3 (is used as such in DEPAC)
+! Convert NH3 background concentration from ppb to ug/m3 (is used as such in DEPAC)
!
- nh3bg_rcp(ircp)=nh3bgconc*17/24
-
+ nh3bg_rcp(ircp)=nh3bgconc*17/24
+!
+! Get so2 background concentration at receptor
+!
+ CALL ops_bgcon(xm(ircp),ym(ircp),so2bggrid, so2bgconc)
+!
+! Convert SO2 background concentration from ppb to ug/m3 (is used as such in DEPAC)
+!
+ so2bg_rcp(ircp)=so2bgconc*64./24.
+ ENDIF
ENDIF
-
- if (error%debug) write(*,'(3a,1x,i6,99(1x,e12.5))') trim(ROUTINENAAM),',A,',' ircp,z0_rcp_all(ircp),lu_rcp_dom_all(ircp),nh3bg_rcp(ircp): ', &
+ IF (error%debug) WRITE(*,'(3a,1x,i6,99(1x,e12.5))') trim(ROUTINENAAM),',A,',' ircp,z0_rcp_all(ircp),lu_rcp_dom_all(ircp),nh3bg_rcp(ircp): ', &
ircp,z0_rcp_all(ircp),lu_rcp_dom_all(ircp),nh3bg_rcp(ircp)
ENDDO
diff --git a/ops_read_bg.f90 b/ops_read_bg.f90
index 1de3677..136dc38 100644
--- a/ops_read_bg.f90
+++ b/ops_read_bg.f90
@@ -1,21 +1,25 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+!-------------------------------------------------------------------------------------------------------------------------------
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! SUBROUTINE
! FILENAME : %M%
@@ -24,7 +28,7 @@
! BRANCH - SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR : Hans van Jaarveld/Martien de Haan
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM/LLO/IS
! LANGUAGE : FORTRAN(HP-UX, HP-F77, HP-F90)
! DESCRIPTION : Handling of background concentrations.
@@ -39,23 +43,28 @@
! Purpose Reads background concentrations for SO2, NO2 and NH3.
! Called only when isec is set (icm = 1, 2 or 3).
!-------------------------------------------------------------------------------------------------------------------------------
-SUBROUTINE ops_read_bg(icm, year, so2bggrid, no2bggrid, nh3bggrid, error)
+SUBROUTINE ops_read_bg(icm, iopt_vchem, nsubsec, year, so2bggrid, no2bggrid, nh3bggrid, f_subsec_grid, vchem2, error)
USE m_aps
USE m_error
USE m_commonconst
USE m_commonfile
+USE m_ops_vchem
IMPLICIT NONE
! SUBROUTINE ARGUMENTS - INPUT
-INTEGER*4, INTENT(IN) :: icm
+INTEGER*4, INTENT(IN) :: icm ! substance index
+INTEGER*4, INTENT(IN) :: iopt_vchem ! option for chemical conversion rate (0 = old OPS, 1 = EMEP)
+INTEGER*4, INTENT(IN) :: nsubsec ! number of sub-secondary species
INTEGER*4, INTENT(IN) :: year ! year under consideration
! SUBROUTINE ARGUMENTS - OUTPUT
TYPE (TApsGridReal), INTENT(OUT) :: so2bggrid ! grid with SO2 background concentration [ppb]
TYPE (TApsGridReal), INTENT(OUT) :: no2bggrid ! grid with NO2 background concentration [ppb]
TYPE (TApsGridReal), INTENT(OUT) :: nh3bggrid ! grid with NH3 background concentration [ppb]
+TYPE (TApsGridReal), INTENT(OUT) :: f_subsec_grid ! grids of fractions for sub-secondary species, HNO3/NO3_total, NO3_C/NO3_total, NO3_F/NO3_total [-]
+TYPE (Tvchem), INTENT(INOUT) :: vchem2 !
TYPE (TError), INTENT(OUT) :: error ! error handling record
! LOCAL VARIABLES
@@ -70,7 +79,13 @@ SUBROUTINE ops_read_bg(icm, year, so2bggrid, no2bggrid, nh3bggrid, error)
! historic year
REAL*4 :: nox_threshold ! threshold value for NOx in log-function in NOx -> NO2 conversion
REAL*4 :: alpha ! slope of linear function NOx -> NO2 conversion
-
+INTEGER :: i1 ! index of yyyy in filename
+CHARACTER*128 :: fnam ! filename
+TYPE (TApsGridReal) :: qq ! test grid output
+INTEGER*4 :: isubsec ! index of sub-secondary species
+CHARACTER*512 :: apsfile ! full file name of APS-file to read
+INTEGER :: nfield ! number of fields in file with NO3-distribution grids (f_subsec_grid)
+INTEGER :: ifield ! field number in f_subsec_grid
! CONSTANTS
CHARACTER*512 :: ROUTINENAAM !
@@ -202,6 +217,114 @@ SUBROUTINE ops_read_bg(icm, year, so2bggrid, no2bggrid, nh3bggrid, error)
!
factor = 24./17. * cf_nh3(mapnumber) * tf_nh3(ji)
CALL SetAverage(factor, nh3bggrid)
+
+! iopt_vchem = 1 -> read EMEP grids with column averaged masses and mass converted [ug/m2] used for chemical conversion rate vchem:
+if (iopt_vchem .eq. 1) then
+ ! Read MASS_PRE for this year from file 'xxx_mass_prec_yyyy.ops'; xxx = name primary species (SO2, NOx, NH3), yyyy = year (e.g. 2019):
+ fnam = map_mass_prec
+ write(fnam(1:3),'(A3)') CNAME(icm,1)
+ i1 = index(fnam,'yyyy');
+ write(fnam(i1:i1+3),'(I4)') year
+ CALL read_bg_file(trim(fnam),'mass precursor', vchem2%mass_prec_grid, error)
+ if (error%haserror) GOTO 9999
+
+ call SetAverage(grid = vchem2%mass_prec_grid)
+
+ ! Read MASS_CONV_DTFAC for this year:
+ fnam = map_mass_conv_dtfac
+ write(fnam(1:3),'(A3)') CNAME(icm,1)
+ i1 = index(fnam,'yyyy');
+ write(fnam(i1:i1+3),'(I4)') year
+ CALL read_bg_file(trim(fnam),'(100/dt) * mass converted chemistry', vchem2%mass_conv_dtfac_grid, error)
+ if (error%haserror) GOTO 9999
+
+ call SetAverage(grid = vchem2%mass_conv_dtfac_grid)
+
+ ! write(*,*) 'average of mass_prec_grid: ', vchem2%mass_prec_grid%average
+ ! write(*,*) 'average of mass_conv_dtfac_grid: ', vchem2%mass_conv_dtfac_grid%average
+ ! write(*,*) 'average conversion rate [%/h]: ', vchem2%mass_conv_dtfac_grid%average/vchem2%mass_prec_grid%average
+
+ ! Read distribution maps for NO3_total: HNO3/NO3_total, NO3_C/NO3_total, NO3_F/NO3_total;
+ ! from file 'no3_distr_yyyy.ops'; yyyy = year (e.g. 2019)
+ if (icm .eq. 2) then
+ fnam = map_no3_distr
+ i1 = index(fnam,'yyyy');
+ write(fnam(i1:i1+3),'(I4)') year
+
+ ! Prepend datadir and check if file exists:
+ call MakeCommonPath(fnam, apsfile, error)
+ if (error%haserror) goto 9999
+
+ ! Read fractions for sub-secondary species:
+ ! write(*,*) 'reading fractions NO3 from file ',trim(apsfile)
+ CALL read_bg_file(trim(fnam),'fractions of NO3' , f_subsec_grid, error)
+ if (error%haserror) GOTO 9999
+
+ ! Get number of fields in f_subsec_grid; should be equal to nsubsec-1
+ ! (3 fields HNO3/NO3_total, NO3_C/NO3_total, NO3_F/NO3_total; 4 sub species NO3_aerosol, HNO3, NO3_C, NO3_F)
+ nfield = size(f_subsec_grid%value,3)
+ ! WdV write(*,'(a,i6)') '--------------- number of fields read in ops_read_bg ----------------- : ',nfield
+ if (nfield .ne. nsubsec-1) then
+ write(*,'(/,/,a)') 'internal programming error'
+ write(*,'(a,a)') 'incorrect number of fields in file ',trim(fnam)
+ write(*,'(a,i6)') 'number of fields read: ',nfield
+ write(*,'(a,i6)') 'number of sub species: ',nsubsec
+ write(*,'(a)') 'number of fields must be equal to number of sub species - 1: '
+ stop
+ endif
+
+ ! Set average of grid (is used in ops_bgcon for missing (negative) values or values outside grid):
+ do ifield = 1,nfield
+ call SetAverage(grid = f_subsec_grid, fieldnumber = ifield)
+ ! write(*,*) 'average of grid of secondary component ',ifield,' = ',f_subsec_grid%average(ifield)
+ enddo
+ endif
+
+ ! ! START TEST write to APS file --------------------------------------------------------------------------------------------
+ ! qq%gridheader%xorgl = 1000*vchem2%mass_prec_grid(1)%gridheader%xorgl
+ ! qq%gridheader%yorgl = 1000*vchem2%mass_prec_grid(1)%gridheader%yorgl
+ ! qq%gridheader%grixl = 1000*vchem2%mass_prec_grid(1)%gridheader%grixl
+ ! qq%gridheader%griyl = 1000*vchem2%mass_prec_grid(1)%gridheader%griyl
+ ! qq%gridheader%nrcol = vchem2%mass_prec_grid(1)%gridheader%nrcol
+ ! qq%gridheader%nrrow = vchem2%mass_prec_grid(1)%gridheader%nrrow
+ ! allocate(qq%value(qq%gridheader%nrcol, qq%gridheader%nrrow, 1))
+ ! qq%value = vchem2%mass_conv_dtfac_grid(1)%value/vchem2%mass_prec_grid(1)%value
+ ! write(*,*) 'grid for conversion factor'
+ ! open(unit = 34, file = 'cvr_tst1.aps')
+ ! !
+ ! !
+ ! ! character*(*) coord_sys ! coordinate system, either 'RDM' or 'lon-lat'
+ ! ! integer lu
+ ! ! real xorg, yorg
+ ! ! real gridx,gridy
+ ! ! integer matx,maty
+ ! ! integer ijg,img,idg,iug
+ ! ! real*4 cpri(matx,maty)
+ ! ! character*8 unit_conc
+ ! ! character*10 namco
+ ! ! character*10 modversie
+ ! ! character*12 kname
+ ! ! character*(*) namegr ! name of grid file (used for error message)
+ ! !
+ ! ! character*12 quantity
+ ! !subroutine saveaps(coord_sys,lu,namegr,xorg,yorg,gridx,gridy,matx,maty,cpri,namco,unit_conc,modversie,kname,quantity,ijg,img,idg,iug)
+ ! call saveaps('RDM',34,'qq0',qq%gridheader%xorgl,qq%gridheader%yorgl,qq%gridheader%grixl,qq%gridheader%griyl,qq%gridheader%nrcol,qq%gridheader%nrrow,qq%value(:,:,1),'conv_rate ','%/h ','OPS_tst ','qq1 ','qq2 ',10,0,0,0)
+ ! close(34)
+ ! !! TYPE TGridHeader
+ ! !! REAL*4 :: xorgl ! x-origin of the grid [km]
+ ! !! ! (origin is left-upper corner of grid)
+ ! !! REAL*4 :: yorgl ! y-origin of the grid [km]
+ ! !! ! (origin is left-upper corner of grid)
+ ! !! INTEGER*4 :: nrcol ! number of grid columns
+ ! !! INTEGER*4 :: nrrow ! number of grid rows
+ ! !! REAL*4 :: grixl ! horizontal size of grid cell [km]
+ ! !! REAL*4 :: griyl ! vertical size of grid cell [km]
+ ! !! END TYPE TGridHeader
+ ! ! END TEST write to APS file --------------------------------------------------------------------------------------------
+
+ IF (error%haserror) GOTO 9999
+endif
+
!
RETURN
!
@@ -222,7 +345,7 @@ SUBROUTINE read_bg_file(filename, compname, bggrid, error)
! SUBROUTINE ARGUMENTS - INPUT
CHARACTER*(*), INTENT(IN) :: filename ! name of file to read background concentration from
-CHARACTER*(*), INTENT(IN) :: compname ! component name for which to read background concentration
+CHARACTER*(*), INTENT(IN) :: compname ! component name for which to read background concentration (used in error message only)
! SUBROUTINE ARGUMENTS - OUTPUT
TYPE (TApsGridReal), INTENT(OUT) :: bggrid ! background concentration grid
diff --git a/ops_read_ctr.f90 b/ops_read_ctr.f90
index 6bc5c49..b801ee9 100644
--- a/ops_read_ctr.f90
+++ b/ops_read_ctr.f90
@@ -1,21 +1,24 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! SUBROUTINE
! NAME : %M%
@@ -24,7 +27,7 @@
! BRANCH - SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR : Martien de Haan (ARIS)
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM/LLO
! LANGUAGE : FORTRAN-77/90
! DESCRIPTION : Read parameters for the OPS-model from the control file.
@@ -36,8 +39,8 @@
! UPDATE HISTORY
!-------------------------------------------------------------------------------------------------------------------------------
SUBROUTINE ops_read_ctr(project, runid, year, icm, namco, amol1, gasv, idep, kdeppar, ddeppar, knatdeppar, wdeppar, dg, &
- & irev, vchemc, vchemv, emtrend, ncatsel, catsel, nlandsel, landsel, spgrid, xc, yc, nrcol, nrrow, &
- & grid, igrens, z0_user, intpol, ideh, igrid, checked, f_z0user, isec, error)
+ & irev, vchemc, iopt_vchem, vchemv, emtrend, ncatsel, catsel, nlandsel, landsel, spgrid, xc, yc, nrcol, nrrow, &
+ & grid, igrens, z0_user, intpol, ideh, igrid, checked, f_z0user, isec, nsubsec, error)
USE m_getkey
USE m_fileutils
@@ -64,7 +67,8 @@ SUBROUTINE ops_read_ctr(project, runid, year, icm, namco, amol1, gasv, idep, kde
REAL*4, INTENT(OUT) :: wdeppar
REAL*4, INTENT(OUT) :: dg
LOGICAL, INTENT(OUT) :: irev
-REAL*4, INTENT(OUT) :: vchemc
+REAL*4, INTENT(OUT) :: vchemc ! chemical conversion rate [%/h]
+INTEGER*4, INTENT(OUT) :: iopt_vchem ! option for chemical conversion rate (0 = old OPS, 1 = EMEP)
REAL*4, INTENT(OUT) :: vchemv
REAL*4, INTENT(OUT) :: emtrend
INTEGER*4, INTENT(OUT) :: ncatsel
@@ -85,11 +89,13 @@ SUBROUTINE ops_read_ctr(project, runid, year, icm, namco, amol1, gasv, idep, kde
LOGICAL, INTENT(OUT) :: checked
LOGICAL*4, INTENT(OUT) :: f_z0user
LOGICAL, INTENT(OUT) :: isec
+INTEGER*4, INTENT(OUT) :: nsubsec ! number of sub-secondary species
TYPE (TError), INTENT(OUT) :: error ! error handling record
! LOCAL VARIABLES
REAL*4 :: lower ! lower limit (is used for checking variables read)
REAL*4 :: upper ! upper limit (is used for checking variables read)
+CHARACTER*(512) :: str1 ! string value read from control file
! SCCS-ID VARIABLES
CHARACTER*81 :: sccsida !
@@ -159,10 +165,58 @@ SUBROUTINE ops_read_ctr(project, runid, year, icm, namco, amol1, gasv, idep, kde
! Read diffusion coefficient, logical for ireversible wash-out or not, chemical conversion rate, light dependent conversion rate
IF (.NOT. GetCheckedKey('DIFFCOEFF', 0., 1., gasv .AND. idep .AND. knatdeppar.EQ.3, dg, error)) GOTO 1000
IF (.NOT. GetKeyValue ('WASHOUT', gasv .AND. idep .AND. knatdeppar.EQ.3, irev, error)) GOTO 1000
-IF (.NOT. GetCheckedKey('CONVRATE', 0., 999., gasv .AND. idep .AND..NOT.isec, vchemc, error)) GOTO 1000
+
+! Read chemical conversion rate vchemc; this can be either the string EMEP (meaning that we use conversion rate maps from the EMEP-model ->
+! iopt_vchem = 1) or a fixed value of vchemc.
+! A value of vchemc is only required for non-acidifying components (isec = false), because for acidifying components, we use either
+! the EMEP maps or (if EMEP is not specified) an old chemical conversion rate parameterisation (iopt_vchem = 0; see OPS-doc).
+! IF (.NOT. GetCheckedKey('CONVRATE', 'EMEP', 'EMEP', gasv .AND. isec, str1, error)) GOTO 1000
+call read_conv_rate(gasv,idep,isec,vchemc,iopt_vchem,error)
+if (error%haserror) GOTO 1000
+
+!!vchemc = MISVALNUM
+!!iopt_vchem = 0
+!!IF (GetCheckedKey('CONVRATE', 'EMEP', 'EMEP', gasv .AND. idep .AND. isec, str1, error)) THEN
+!! ! EMEP has been found or EMEP is not required; if it is required, set iopt_vchem to 1:
+!! if (gasv .AND. idep .AND. isec) then
+!! ! EMEP has been found and acidifying component and chemical conversion is on:
+!! iopt_vchem = 1
+!! else
+!! ! EMEP has been found, but is not needed:
+!! call ErrorParam('CONVRATE EMEP can only be used for acidifying components SO2, NOx, NH3 ','', error)
+!! GOTO 1000
+!! endif
+!!ENDIF
+!!If (iopt_vchem .eq. 0) THEN
+!! ! vchemc has not been set, read line again and extract vchemc (if required):
+!! backspace(fu_input); error%haserror = .false.
+!! IF (.NOT. GetCheckedKey('CONVRATE', 0., 999., gasv .AND. idep .AND..NOT.isec, vchemc, error)) GOTO 1000
+!!ENDIF
+
IF (.NOT. GetCheckedKey('LDCONVRATE', 0., 99.99, gasv .AND. idep .AND..NOT.isec, vchemv, error)) GOTO 1000
-!
+! Secondary species are SO4, NO3_total, NH4;
+! for NOx with EMEP chemical conversion, we have 3 sub-secondary species (HNO3, NO3_C (coarse in PM10-PM2.5), NO3_F (fine in PM2.5)):
+if (icm .eq. 2) then
+ if (iopt_vchem .eq. 0) then
+ ! Old OPS parameterisation; no information on fine and coarse NO3:
+ nsubsec = 2
+ CNAME_SUBSEC(1:nsubsec) = (/'NO3_AER', 'HNO3' /) ! HNO3, NO3_aerosol (in PM10)
+ else
+ ! EMEP gives also a split between coarse and fine NO3:
+ nsubsec = 4
+ CNAME_SUBSEC(1:nsubsec) = (/'NO3_AER', 'HNO3', 'NO3_C', 'NO3_F' /) ! HNO3, NO3_aerosol (in PM10), NO3_coarse (in PM10-PM2.5), NO3_fine (in PM2.5)
+ endif
+else
+ ! SO4 and NH4 all in fine PM-fraction; no sub-species:
+ nsubsec = 0
+endif
+!if (icm .eq. 2) then
+! nsubsec = 3
+!else
+! nsubsec = 0
+!endif
+
! Read emission layer (emission file, user defined diurnal variation file,
! user defined particle size distribution file, emission trend factor, selected emission categories,
! selected emission countries)
@@ -246,4 +300,96 @@ SUBROUTINE ops_read_ctr(project, runid, year, icm, namco, amol1, gasv, idep, kde
2000 CALL ErrorParam('control file', ctrnam, error)
CALL ErrorCall(ROUTINENAAM, error)
+CONTAINS
+
+!------------------------------------------------------------------------------------------------
+subroutine read_conv_rate(gasv,idep,isec,vchemc,iopt_vchem,error)
+
+use m_error
+use m_commonconst,only: MISVALNUM, EPS_DELTA
+use m_commonfile
+use m_getkey
+
+implicit none
+
+! Input:
+logical, intent(in) :: gasv ! gasuous component
+logical, intent(in) :: idep ! deposition/chemical conversion is switched on
+logical, intent(in) :: isec ! acidifying component (SO2, NOx, NH3)
+
+! Output
+real, intent(out) :: vchemc ! chemical conversion rate [%/h]
+integer, intent(out) :: iopt_vchem ! = 0 -> use conversion rates from old OPS parameterisation
+ ! = 1 -> use conversion rates from EMEP
+type(Terror), intent(inout) :: error ! error structure
+
+! Local:
+character(len=200) :: str1
+
+! Initialise:
+vchemc = MISVALNUM
+iopt_vchem = 0 ! old OPS parameterisation for chemical conversion rates
+
+! Check for "CONVRATE EMEP":
+IF (GetCheckedKey('CONVRATE', 'EMEP', 'EMEP', gasv .AND. idep .AND. isec, str1, error)) THEN
+! ! EMEP has been found or EMEP is not required; if it is required, set iopt_vchem to 1:
+! if (gasv .AND. idep .AND. isec) iopt_vchem = 1
+
+ ! EMEP has been found or EMEP is not required; if it is required, set iopt_vchem to 1:
+ if (gasv .AND. idep .AND. isec) then
+ ! CONVRATE EMEP has been found and 'gasuous component' and 'chemical conversion is on' and 'acidifying component':
+ iopt_vchem = 1 ! use EMEP conversion rates
+ else
+ ! CONVRATE EMEP is not needed; generate error if it is provided in input anyway:
+ if (str1 .eq. 'EMEP') then
+ if (.not. isec) then
+ call SetError('CONVRATE EMEP can only be used for acidifying components SO2, NOx, NH3 ', error)
+ elseif (.not. idep) then
+ call SetError('CONVRATE EMEP can only be used if deposition/chemical conversion switched on', error)
+ else
+ call SetError('CONVRATE EMEP can only be used for gasuous components', error)
+ endif
+ GOTO 1000
+ endif
+ endif
+ENDIF
+
+If (iopt_vchem .eq. 0) THEN
+ ! vchemc has not been set; read line again and extract vchemc (if required):
+ backspace(fu_input); error%haserror = .false.
+ IF (GetCheckedKey('CONVRATE', 0., 999., gasv .AND. idep .AND. .NOT.isec, vchemc, error)) then
+
+ ! If 'CONVRATE value' is not required and a value is specified anyway, generate error:
+ if (.not. (gasv .AND. idep .AND. .NOT.isec)) then
+ if (error%haserror) then
+ GOTO 1000
+ elseif (vchemc .eq. MISVALNUM) then
+ continue ! is ok; no error
+ else
+ if (isec) then
+ call SetError('CONVRATE value cannot be specified for acidifying components SO2, NOx, NH3 ', error)
+ elseif (.not. idep) then
+ call SetError('CONVRATE value can only be specified if deposition/chemical conversion switched on', error)
+ else
+ call SetError('CONVRATE value can only be used for gasuous components', error)
+ endif
+ GOTO 1000
+ endif
+ endif
+ else
+ ! CONVRATE value is required but not found -> error
+ if (vchemc .eq. MISVALNUM) then
+ error%haserror = .false.
+ call SetError('CONVRATE must have a value ', error)
+ endif
+ endif
+ENDIF
+
+RETURN
+1000 CONTINUE ! error handling in calling routine
+
+end subroutine read_conv_rate
+
END SUBROUTINE ops_read_ctr
+
+
diff --git a/ops_read_emis.f90 b/ops_read_emis.f90
index 206c650..da95dad 100644
--- a/ops_read_emis.f90
+++ b/ops_read_emis.f90
@@ -1,21 +1,24 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! SUBROUTINE
!
@@ -25,7 +28,7 @@
! BRANCH -SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR :
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM/LLO
! LANGUAGE : FORTRAN-77/90
! DESCRIPTION : Read source file with emissions and files with diurnal emission variations and particle size distributions.
@@ -161,7 +164,7 @@ SUBROUTINE ops_read_emis(icm, gasv, ncatsel, catsel, nlandsel, landsel, numbron,
! +002 33 33 35 80 150 155 120 116 122 135 145 77 Average heating behaviour
! +003 24 16 23 150 175 121 127 154 190 112 60 48 Average traffic intensity
-! Example of particle size distribution file:
+! Example of particle size distribution file: FS
!
!-------------------------------------------------------------------------------------------------------------------------------
SUBROUTINE read_variation(distnam, fmt, nrclass, normalvalue, compdesc, fraction, distrib, maxcode, presentcode, error)
diff --git a/ops_read_meteo.f90 b/ops_read_meteo.f90
index d939ae8..5994f3d 100644
--- a/ops_read_meteo.f90
+++ b/ops_read_meteo.f90
@@ -1,21 +1,24 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! SUBROUTINE
!
@@ -25,7 +28,7 @@
! BRANCH -SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR :
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM/LLO
! LANGUAGE : FORTRAN-77/90
! DESCRIPTION : Read meteo statistics.
diff --git a/ops_read_source.f90 b/ops_read_source.f90
index 5a33845..cbcea4c 100644
--- a/ops_read_source.f90
+++ b/ops_read_source.f90
@@ -1,21 +1,24 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! SUBROUTINE
!
@@ -25,7 +28,7 @@
! BRANCH -SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR :
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM/LLO
! LANGUAGE : FORTRAN-77/90
! DESCRIPTION : Read source file with emissions.
diff --git a/ops_reken.f90 b/ops_reken.f90
index 251248c..924b375 100644
--- a/ops_reken.f90
+++ b/ops_reken.f90
@@ -1,21 +1,24 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+! copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! SUBROUTINE
! NAME : %M%
@@ -24,7 +27,7 @@
! BRANCH -SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR :
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM/LLO
! LANGUAGE : FORTRAN-77/90
! USAGE :
@@ -36,14 +39,14 @@
! CALLED FUNCTIONS :
! UPDATE HISTORY :
!-------------------------------------------------------------------------------------------------------------------------------
-SUBROUTINE ops_reken(idep, isec, icm, gasv, intpol, vchemc, vchemv, dv, amol1, amol2, amol21, ar, rno2nox, ecvl, iseiz, zf, &
+SUBROUTINE ops_reken(idep, isec, icm, gasv, intpol, vchemc, iopt_vchem, vchemv, dv, amol1, amol2, amol21, ar, rno2nox, ecvl, iseiz, zf, &
& trafst, knatdeppar, mb, ugmoldep, dg, irev, scavcoef, koh, croutpri, rcno, rhno2, rchno3, &
- & nrrcp, ircp, gxm, gym, xm, ym, zm, frac, nh3bg_rcp, rhno3_rcp, &
+ & nrrcp, ircp, gxm, gym, xm, ym, zm, frac, nh3bg_rcp, so2bg_rcp, rhno3_rcp, &
& bqrv, bqtr, bx, by, bdiam, bsterkte, bwarmte, bhoogte, &
& bsigmaz, bD_stack, bV_stack, bTs_stack, bemis_horizontal, bbuilding, buildingEffect, &
& btgedr, bdegr, &
& z0_src, z0_tra, z0_rcp, z0_metreg_rcp, lu_tra_per, lu_rcp_per, &
- & so2sek, no2sek, so2bgtra, no2bgtra, nh3bgtra, maxidx, pmd, uspmd, spgrid, grid, subbron, uurtot, routsec, &
+ & so2sek, no2sek, so2bgtra, no2bgtra, nh3bgtra, vchem2, maxidx, pmd, uspmd, spgrid, grid, subbron, uurtot, routsec, &
& rc, somvnsec, telvnsec, vvchem, vtel, somvnpri, &
& telvnpri, ddepri, sdrypri, snatpri, sdrysec, snatsec, cpri, csec, drydep, wetdep, astat, rno2_nox_sum, &
& precip, routpri, dispg, error)
@@ -57,7 +60,8 @@ SUBROUTINE ops_reken(idep, isec, icm, gasv, intpol, vchemc, vchemv, dv, amol1, a
USE m_aps
USE m_geoutils
USE m_ops_building
- use m_ops_utils, only: is_missing
+use m_ops_utils, only: is_missing
+USE m_ops_vchem
IMPLICIT NONE
@@ -79,6 +83,7 @@ SUBROUTINE ops_reken(idep, isec, icm, gasv, intpol, vchemc, vchemv, dv, amol1, a
! 1 use meteo parameters from user specified meteo region
! 2? use meteo parameters from user specified meteo file
REAL*4, INTENT(IN) :: vchemc ! chemical conversion rate, independent of light [%/h]
+INTEGER*4, INTENT(IN) :: iopt_vchem ! option for chemical conversion rate (0 = old OPS, 1 = EMEP)
REAL*4, INTENT(IN) :: vchemv ! chemical conversion rate, dependent on light [%/h]
INTEGER*4, INTENT(IN) :: dv ! maximum code diurnal emission variation dverl
REAL*4, INTENT(IN) :: amol1 ! molar mass primary component [g/mol]
@@ -116,6 +121,7 @@ SUBROUTINE ops_reken(idep, isec, icm, gasv, intpol, vchemc, vchemv, dv, amol1, a
REAL*4, INTENT(IN) :: zm ! z-coordinate of receptor points (RDM)
REAL*4, INTENT(IN) :: frac ! fraction of grid cell inside NL
REAL*4, INTENT(IN) :: nh3bg_rcp ! NH3 background concentration (used in DEPAC) [ug/m3]
+REAL*4, INTENT(IN) :: so2bg_rcp ! SO2 background concentration (used in DEPAC) [ug/m3]
REAL*4, INTENT(IN) :: rhno3_rcp ! ratio [HNO3]/[NO3]_total at receptor points, [NO3]_total = [HNO3] + [NO3_aerosol]
REAL*4, INTENT(IN) :: bqrv ! source strength of space heating source (rv << "ruimteverwarming" = space heating) [g/s]
REAL*4, INTENT(IN) :: bqtr ! source strength of traffic source [g/s]
@@ -148,6 +154,7 @@ SUBROUTINE ops_reken(idep, isec, icm, gasv, intpol, vchemc, vchemv, dv, amol1, a
REAL*4, INTENT(IN) :: so2bgtra ! SO2 background concentration, trajectory averaged [ppb]
REAL*4, INTENT(IN) :: no2bgtra ! NO2 background concentration, trajectory averaged [ppb]
REAL*4, INTENT(IN) :: nh3bgtra ! NH3 background concentration, trajectory averaged [ppb]
+type(Tvchem), INTENT(INOUT) :: vchem2 !
INTEGER*4, INTENT(IN) :: maxidx ! max. number of particle classes (= 1 for gas)
REAL*4, INTENT(IN) :: pmd(NPARTCLASS,MAXDISTR) ! standard particle size distributions
REAL*4, INTENT(IN) :: uspmd(NPARTCLASS,MAXDISTR) ! user-defined particle size distributions
@@ -341,7 +348,6 @@ SUBROUTINE ops_reken(idep, isec, icm, gasv, intpol, vchemc, vchemv, dv, amol1, a
REAL*4 :: cq2 !
REAL*4 :: cdn !
REAL*4 :: cch !
-REAL*4 :: dm !
REAL*4 :: cratio !
REAL*4 :: rhno3 !
REAL*4 :: rrno2nox !
@@ -505,7 +511,7 @@ SUBROUTINE ops_reken(idep, isec, icm, gasv, intpol, vchemc, vchemv, dv, amol1, a
! Compute chemical parameters (conversion rates, concentration ratios) in case of secondary components
!
IF (isec) THEN
- CALL ops_par_chem(icm, isek, so2sek, no2sek, so2bgtra, no2bgtra, nh3bgtra, disx, diameter, vchemnh3, rhno3, &
+ CALL ops_par_chem(icm, iopt_vchem, isek, so2sek, no2sek, so2bgtra, no2bgtra, nh3bgtra, vchem2, disx, diameter, vchemnh3, rhno3, &
& rrno2nox, rations)
ENDIF
if (error%debug) write(*,'(3a,1x,i6,4(1x,e12.5))') trim(ROUTINENAAM),' B ',' ircp,vchemnh3, rhno3, rrno2nox, rations :',ircp,vchemnh3, rhno3, rrno2nox, rations
@@ -625,14 +631,14 @@ SUBROUTINE ops_reken(idep, isec, icm, gasv, intpol, vchemc, vchemv, dv, amol1, a
! of deposition and (chemical) conversion. Only if idep = TRUE.
!
IF (idep) THEN
- CALL ops_resist_rek(vchemc, vchemv, rad, isec, icm, rcso2, regenk, rcaerd, iseiz, istab, itra, ar, &
- & rno2nox, rcnh3d, vchemnh3, hum, uster_rcp, ol_rcp, uster_tra, ol_tra, &
+ CALL ops_resist_rek(vchemc, iopt_vchem, vchemv, rad, isec, icm, rcso2, regenk, rcaerd, iseiz, istab, itra, ar, &
+ & rno2nox, rcnh3d, vchemnh3, vchem2, hum, uster_rcp, ol_rcp, uster_tra, ol_tra, &
& z0_rcp, z0_metreg_rcp, rcno2d, kdeel, mb, vw10, temp_C, disxx, zm, koh, &
& rations, rhno3, rcno, rhno2, rchno3, croutpri, rrno2nox, rhno3_rcp, &
& rb, ra4, ra50, rc, routpri, vchem, rcsec, uh, rc_sec_rcp, rc_rcp, rb_rcp, &
& ra4_rcp, ra50_rcp, raz_rcp, z0_src, ol_src, uster_src, z0_tra, rctra_0, rcsrc, &
& ra4src, rb_src, ra50src, ra4tra, ra50tra, rb_tra, rclocal, nh3bg_rcp, nh3bgtra, &
- & gym, depudone, gasv, lu_rcp_per, lu_tra_per, rnox)
+ & so2bg_rcp, so2bgtra, gym, depudone, gasv, lu_rcp_per, lu_tra_per, rnox)
cratio = 1.
CALL ops_depoparexp(kdeel, c, ol_src, qbpri, ra4_rcp, ra50_rcp, raz_rcp, rb_rcp, sigz, ueff, &
@@ -651,7 +657,7 @@ SUBROUTINE ops_reken(idep, isec, icm, gasv, intpol, vchemc, vchemv, dv, amol1, a
& htot, twt, rb, ra50, xvghbr, xvglbr, grad, frac, cdn, cq2, c, sdrypri(kdeel), &
& sdrysec(kdeel), snatsec(kdeel), somvnsec(kdeel), telvnsec(kdeel), vvchem(kdeel), &
& vtel(kdeel), snatpri(kdeel), somvnpri(kdeel), telvnpri(kdeel), ddepri(ircp,kdeel), &
- & drydep(ircp,kdeel), wetdep(ircp,kdeel), dm, qsec, consec, pr, &
+ & drydep(ircp,kdeel), wetdep(ircp,kdeel), qsec, consec, pr, &
& vg50trans, ra50tra, rb_tra, rclocal, vgpart, xg, buildingFact)
!
diff --git a/ops_resist_rek.f90 b/ops_resist_rek.f90
index c7049eb..e77fb1e 100644
--- a/ops_resist_rek.f90
+++ b/ops_resist_rek.f90
@@ -1,21 +1,24 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! SUBROUTINE
! NAME : %M%
@@ -24,7 +27,7 @@
! BRANCH -SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR :
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM/LLO
! LANGUAGE : FORTRAN-F77/90
! USAGE : %M%
@@ -36,16 +39,17 @@
! CALLED FUNCTIONS : ops_depu
! UPDATE HISTORY :
!-------------------------------------------------------------------------------------------------------------------------------
-SUBROUTINE ops_resist_rek(vchemc, vchemv, rad, isec, icm, rcso2, regenk, rcaerd, iseiz, istab, itra, ar, &
- rno2nox, rcnh3d, vchemnh3, hum, uster_rcp, ol_rcp, uster_tra, ol_tra, &
- z0_rcp, z0_metreg_rcp, rcno2d, kdeel, mb, vw10, temp_C, disx, zm, koh, &
+SUBROUTINE ops_resist_rek(vchemc, iopt_vchem, vchemv, rad, isec, icm, rcso2, regenk, rcaerd, iseiz, istab, itra, ar, &
+ rno2nox, rcnh3d, vchemnh3, vchem2, hum, uster_rcp, ol_rcp, uster_tra, ol_tra, &
+ z0_rcp, z0_metreg_rcp, rcno2d, kdeel, mb, vw10, temp_C, disx, zm, koh, &
rations, rhno3, rcno, rhno2, rchno3, croutpri, rrno2nox, rhno3_rcp, &
rb, ra4, ra50, rc, routpri, vchem, rcsec, uh, rc_sec_rcp, rc_rcp, rb_rcp, &
ra4_rcp, ra50_rcp, raz_rcp, z0_src, ol_src, uster_src, z0_tra, rctra_0, rcsrc, ra4src, &
- rb_src, ra50src, ra4tra, ra50tra, rb_tra, rclocal, nh3bg_rcp, nh3bgtra, gym, &
- depudone, gasv, lu_rcp_per, lu_tra_per, rnox)
+ rb_src, ra50src, ra4tra, ra50tra, rb_tra, rclocal, nh3bg_rcp, nh3bgtra, &
+ so2bg_rcp, so2bgtra, gym, depudone, gasv, lu_rcp_per, lu_tra_per, rnox)
USE m_commonconst
+USE m_ops_vchem
IMPLICIT NONE
@@ -54,7 +58,8 @@ SUBROUTINE ops_resist_rek(vchemc, vchemv, rad, isec, icm, rcso2, regenk, rcaerd,
PARAMETER (ROUTINENAAM = 'ops_resist_rek')
! SUBROUTINE ARGUMENTS - INPUT
-REAL*4, INTENT(IN) :: vchemc !
+REAL*4, INTENT(IN) :: vchemc ! chemical conversion rate [%/h]
+INTEGER*4, INTENT(IN) :: iopt_vchem ! option for chemical conversion rate (0 = old OPS, 1 = EMEP)
REAL*4, INTENT(IN) :: vchemv !
REAL*4, INTENT(IN) :: rad !
LOGICAL, INTENT(IN) :: isec ! TRUE als component=[SO2, NOx, NH3]
@@ -68,7 +73,8 @@ SUBROUTINE ops_resist_rek(vchemc, vchemv, rad, isec, icm, rcso2, regenk, rcaerd,
REAL*4, INTENT(IN) :: ar !
REAL*4, INTENT(IN) :: rno2nox !
REAL*4, INTENT(IN) :: rcnh3d !
-REAL*4, INTENT(IN) :: vchemnh3 !
+REAL*4, INTENT(IN) :: vchemnh3
+type(Tvchem), INTENT(IN) :: vchem2 !
REAL*4, INTENT(IN) :: hum !
REAL*4, INTENT(IN) :: uster_rcp ! friction velocity at receptor; for z0 at receptor [m/s]
REAL*4, INTENT(IN) :: ol_rcp ! Monin-Obukhov length at receptor; for z0 at receptor [m/s]
@@ -98,6 +104,8 @@ SUBROUTINE ops_resist_rek(vchemc, vchemv, rad, isec, icm, rcso2, regenk, rcaerd,
REAL*4, INTENT(IN) :: z0_tra ! roughness length representative for trajectory [m]
REAL*4, INTENT(IN) :: nh3bg_rcp !
REAL*4, INTENT(IN) :: nh3bgtra !
+REAL*4, INTENT(IN) :: so2bg_rcp !
+REAL*4, INTENT(IN) :: so2bgtra !
REAL*4, INTENT(IN) :: gym !
LOGICAL, INTENT(IN) :: gasv !
REAL*4, INTENT(IN) :: lu_rcp_per(NLU) ! land use percentages for all land use classes of receptor
@@ -112,7 +120,7 @@ SUBROUTINE ops_resist_rek(vchemc, vchemv, rad, isec, icm, rcso2, regenk, rcaerd,
! SUBROUTINE ARGUMENTS - OUTPUT
REAL*4, INTENT(OUT) :: routpri ! in-cloud scavenging ratio for primary component
! (rout << rain-out = in-cloud) [-]
-REAL*4, INTENT(OUT) :: vchem !
+REAL*4, INTENT(OUT) :: vchem ! chemical conversion rate [%/h]
REAL*4, INTENT(OUT) :: uh !
! Canopy resistances
@@ -144,7 +152,7 @@ SUBROUTINE ops_resist_rek(vchemc, vchemv, rad, isec, icm, rcso2, regenk, rcaerd,
! LOCAL VARIABLES
INTEGER*4 :: day_of_year !
-INTEGER*4 :: icmpsec !
+INTEGER*4 :: icmpsec !
INTEGER*4 :: ipar !
INTEGER*4 :: mnt !
INTEGER*4, DIMENSION(2) :: mnt_select !
@@ -176,13 +184,14 @@ SUBROUTINE ops_resist_rek(vchemc, vchemv, rad, isec, icm, rcso2, regenk, rcaerd,
REAL*4 :: som_rcsrc
REAL*4 :: telmaand
REAL*4 :: catm
-REAL*4 :: c_ave_prev
+REAL*4 :: c_ave_prev_nh3
+REAL*4 :: c_ave_prev_so2
REAL*4 :: cfact
REAL*4 :: ccomp_tot
REAL*4 :: rc_tot
REAL*4 :: rc_sum
REAL*4 :: sinphi
-INTEGER i
+INTEGER :: i
REAL*4, PARAMETER :: catm_min = 0.1E-05
! SCCS-ID VARIABLES
@@ -286,18 +295,24 @@ SUBROUTINE ops_resist_rek(vchemc, vchemv, rad, isec, icm, rcso2, regenk, rcaerd,
!
! Note: in source code 1.2*[0.016 0.5 12] = [0.0192 0.6 14.4] = [ar khe kaq]
- vchem = 1.2*((rad*.016) + .5 + (regenk*12.))
- routpri = croutpri*rations ! Note factor 2 in rations
- rc = rcso2
- rcsec = rcaerd*0.8
+ IF (iopt_vchem .eq. 0) THEN
+ ! OPS parameterisation:
+ vchem = 1.2*((rad*.016) + .5 + (regenk*12.))
+ ELSE
+ ! EMEP maps:
+ vchem = vchem2%vchem
+ ENDIF
+ ! write(*,*) 'ops_resist_rek, vchem: ',vchem
+ routpri = croutpri*rations ! Note factor 2 in rations
+ rc = rcso2
+ rcsec = rcaerd*0.8
! NOx:
ELSE IF (icm .EQ. 2) THEN
-!
-! Compute percn = fraction of nighttime hours, depending on season;
-! NACHTZOMER and NACHTWINTER are relative occurrences (%) of nighttime hours in summer and winter,
-! for each stability class and distance class. ("NACHT" = night, "ZOMER" = summer)
-!
+
+ ! Compute percn = fraction of nighttime hours, depending on season;
+ ! NACHTZOMER and NACHTWINTER are relative occurrences (%) of nighttime hours in summer and winter,
+ ! for each stability class and distance class. ("NACHT" = night, "ZOMER" = summer)
IF ((iseiz .EQ. 3) .OR. (iseiz .EQ. 5)) THEN
percn = FLOAT(NACHTZOMER(istab, itra))/100.
ELSE IF ((iseiz .EQ. 2) .OR. (iseiz .EQ. 4)) THEN
@@ -305,37 +320,41 @@ SUBROUTINE ops_resist_rek(vchemc, vchemv, rad, isec, icm, rcso2, regenk, rcaerd,
ELSE
percn = FLOAT(NACHTWINTER(istab, itra) + NACHTZOMER(istab, itra))/200.
ENDIF
-!
-! Compute chemn = chemical conversion rate for NO2+O3 -> NO3 (nigthttime), assuming a 2%/h conversion rate
-! Van Egmond N.D. and Kesseboom H. (1983) Mesoscale air pollution dispersion models-II. Lagrangian PUFF model,
-! and comparison with Eulerian GRID model. Atmospheric Environment, 17, 265-274.
-!
+
+ ! Compute chemn = chemical conversion rate for NO2+O3 -> NO3 (nigthttime), assuming a 2%/h conversion rate
+ ! Van Egmond N.D. and Kesseboom H. (1983) Mesoscale air pollution dispersion models-II. Lagrangian PUFF model,
+ ! and comparison with Eulerian GRID model. Atmospheric Environment, 17, 265-274.
chemn = percn*2.
-!
-! rnox = [NO2]/[NOx] ratio consists of a space varying component (rrno2nox, computed in ops_par_chem),
-! a season dependent component (rno2nox, set in ops_init)
-! and a stability class dependent component (scno2nox, only in winter)
-!
+
+ ! rnox = [NO2]/[NOx] ratio consists of a space varying component (rrno2nox, computed in ops_par_chem),
+ ! a season dependent component (rno2nox, set in ops_init)
+ ! and a stability class dependent component (scno2nox, only in winter)
IF ((iseiz .EQ. 2) .OR. (iseiz .EQ. 4)) THEN
scno2nox = SCWINTER(istab)
ELSE
scno2nox = 1.
ENDIF
rnox = rrno2nox*rno2nox*scno2nox
-!
-! Set parameters that depend on this [NO2]/[NOx] ratio.
-! chemr : chemical conversion rate for NO2 + OH -> HNO3; [%/h] (factor 100 is to make percentage instead of fractions)
-! rad : global radiation [J/cm2/h]
-! ar : proportionality constant [ppb J-1 cm2 h] in relation [OH] = ar Qr, with
-! [OH] = OH radical concentration [ppb] , Qr = global radiation [J/cm2/h]
-! koh : reaction constant [ppb-1 h-1] (Van Aalst en Bergsma, 1981)
-! vchem : total chemical conversion rate, split into daytime and nighttime part
-! routpri: in-cloud scavenging ratio for primary component
-! (rout << rain-out = in-cloud) [-]
-!
- chemr = 100*rad*ar*koh*rnox
- vchem = chemr + chemn
- routpri = croutpri*rnox
+
+ ! chemr : chemical conversion rate for NO2 + OH -> HNO3; [%/h] (factor 100 is to make percentage instead of fractions)
+ ! rad : global radiation [J/cm2/h]
+ ! ar : proportionality constant [ppb J-1 cm2 h] in relation [OH] = ar Qr, with
+ ! [OH] = OH radical concentration [ppb] , Qr = global radiation [J/cm2/h]
+ ! koh : reaction constant [ppb-1 h-1] (Van Aalst en Bergsma, 1981)
+ ! vchem : total chemical conversion rate, split into daytime and nighttime part
+ chemr = 100*rad*ar*koh*rnox
+
+ ! vchem : total chemical conversion rate, split into daytime and nighttime part
+ IF (iopt_vchem .eq. 0) THEN
+ ! OPS parameterisation:
+ vchem = chemr + chemn
+ ELSE
+ ! EMEP maps:
+ vchem = vchem2%vchem
+ ENDIF
+
+ ! routpri: in-cloud scavenging ratio for primary component (rout << rain-out = in-cloud) [-]
+ routpri = croutpri*rnox
!
! Set surface resistance.
! The primary substance is calculated as NO2 (because emissions are specified as such) but contains in reality a mixture of
@@ -376,11 +395,17 @@ SUBROUTINE ops_resist_rek(vchemc, vchemv, rad, isec, icm, rcso2, regenk, rcaerd,
! rc : surface resistance primary component [s/m]
! rcsec : surface resistance secondary component over trajectory [s/m]; taken as 0.8*Rc(NO3_aerosol)
- rb = rb*0.64
- vchem = vchemnh3
- routpri = croutpri
- rc = rcnh3d
- rcsec = rcaerd*0.8
+ rb = rb*0.64
+ IF (iopt_vchem .eq. 0) THEN
+ ! OPS parameterisation:
+ vchem = vchemnh3
+ ELSE
+ ! EMEP maps:
+ vchem = vchem2%vchem
+ ENDIF
+ routpri = croutpri
+ rc = rcnh3d
+ rcsec = rcaerd*0.8
ELSE
CONTINUE
ENDIF ! IF icm = 1,2 or 3
@@ -394,7 +419,7 @@ SUBROUTINE ops_resist_rek(vchemc, vchemv, rad, isec, icm, rcso2, regenk, rcaerd,
! rc_rcp : canopy resistance at receptor, no re-emission allowed [s/m];
! is used for deposition gradient at receptor
! rclocal: canopy resistance at receptor, re-emission allowed [s/m];
-! is used for the computation of drypri, the local deposition at the receptor
+! is used for the computation of drypri, the local depsosition at the receptor
!-------------------------------------------------------------------------------------------
! Wesely parameterization
@@ -430,12 +455,12 @@ SUBROUTINE ops_resist_rek(vchemc, vchemv, rad, isec, icm, rcso2, regenk, rcaerd,
!
! (17/24) = conversion factor ppb -> ug/m3.
!
- catm = nh3bgtra*17/24
- c_ave_prev = nh3bgtra*17/24
- ! write(*,'(a,2(1x,e12.5))') 'catm,c_ave_prev traj = ',catm,c_ave_prev
-
- CALL ops_depos_rc(icm, iseiz, mb, gym ,temp_C, uster_tra, glrad, hum, nwet, ratns, catm, c_ave_prev, lu_tra_per, ra4tra, rb_tra, &
- & rctra_0, rclocal)
+ catm = nh3bgtra*17/24
+ c_ave_prev_nh3 = nh3bgtra*17/24
+ c_ave_prev_so2 = so2bgtra*64/24
+!
+ CALL ops_depos_rc(icm, iseiz, mb, gym ,temp_C, uster_tra, glrad, hum, nwet, ratns, catm, c_ave_prev_nh3, c_ave_prev_so2, lu_tra_per, &
+ & ra4tra, rb_tra, rctra_0, rclocal)
rcsrc = rctra_0 !
!
! 2. Compute surface resistance Rc near the receptor.
@@ -445,13 +470,12 @@ SUBROUTINE ops_resist_rek(vchemc, vchemv, rad, isec, icm, rcso2, regenk, rcaerd,
! Note: catm and c_ave_prev are only used for NH3.
! Conversion from ppb -> ug/m3 for nh3bg_rcp already done in ops_rcp_char.
!
- catm = nh3bg_rcp
- c_ave_prev = nh3bg_rcp
- !write(*,'(a,2(1x,e12.5))') 'catm,c_ave_prev rcp = ',catm,c_ave_prev
-
- CALL ops_depos_rc(icm, iseiz, mb, gym ,temp_C, uster_rcp, glrad, hum, nwet, ratns, catm, c_ave_prev, lu_rcp_per, ra4_rcp, rb_rcp, &
- & rc_rcp, rclocal)
-
+ catm = nh3bg_rcp
+ c_ave_prev_nh3 = nh3bg_rcp
+ c_ave_prev_so2 = so2bg_rcp
+!
+ CALL ops_depos_rc(icm, iseiz, mb, gym ,temp_C, uster_rcp, glrad, hum, nwet, ratns, catm, c_ave_prev_nh3, c_ave_prev_so2, lu_rcp_per, &
+ & ra4_rcp, rb_rcp, rc_rcp, rclocal)
!------------------------------------------------------------------
! Compute surface resistance Rc for the secondary component
!------------------------------------------------------------------
@@ -491,7 +515,7 @@ SUBROUTINE ops_resist_rek(vchemc, vchemv, rad, isec, icm, rcso2, regenk, rcaerd,
! Rc(NOx) + Rb + Ra Rc(NO2)+ Rb + Ra Rc(NO) + Rb + Ra Rc(HNO2) + Rb + Ra
!
r = rb + ra4
- rc_rcp = 1./(rnox/(rc_rcp+r) + (1.-rnox)/(rcno+r) + rhno2/(rchno2+r)) - r
+ rc_rcp = 1./(rnox/(rc_rcp+r) + (1.-rnox)/(rcno+r) + rhno2/(rchno2+r)) - r
rclocal = rc_rcp
rctra_0 = 1./(rnox/(rctra_0+r) + (1.-rnox)/(rcno+r) + rhno2/(rchno2+r)) - r
rcsrc = rctra_0
@@ -536,7 +560,7 @@ SUBROUTINE ops_resist_rek(vchemc, vchemv, rad, isec, icm, rcso2, regenk, rcaerd,
! a roughness length (znul) < 0.5m and to Erisman et al (1994) and
! Ruijgrok et al. (1994) for forest and other areas with a roughness
! length above 0.5m.
-! AUTHOR : Hans van Jaarsveld
+! AUTHOR : OPS-support
!-------------------------------------------------------------------------------------------------------------------------------
SUBROUTINE vdsecaer (ust, ol, vd, rh, nwet,Uh, ra, znul, icmp)
diff --git a/ops_scalefac.f90 b/ops_scalefac.f90
index e2f4c67..1ddaf3a 100644
--- a/ops_scalefac.f90
+++ b/ops_scalefac.f90
@@ -1,21 +1,24 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! SUBROUTINE
! NAME : %M%
@@ -24,7 +27,7 @@
! BRANCH - SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR : HvJ/Franka Loeve (Cap Volmac)
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM/LLO
! LANGUAGE : FORTRAN-77/90
! DESCRIPTION : Compute scaling factors for printing of concentrations and depositions. A scaling factor is the ratio between the
@@ -37,7 +40,7 @@
! CALLED FUNCTIONS :
! UPDATE HISTORY :
!-------------------------------------------------------------------------------------------------------------------------------
-SUBROUTINE ops_scalefac(nrrcp, cpri, csec, drydep, wetdep, scale_con, scale_sec, scale_dep, cseccor, scale_sec_cor)
+SUBROUTINE ops_scalefac(nrrcp, nsubsec, cpri, csec, drydep, wetdep, scale_con, scale_sec, scale_dep, csubsec, scale_subsec)
USE m_commonconst ! EPS_DELTA only
@@ -49,23 +52,25 @@ SUBROUTINE ops_scalefac(nrrcp, cpri, csec, drydep, wetdep, scale_con, scale_sec,
! SUBROUTINE ARGUMENTS - INPUT
INTEGER*4, INTENT(IN) :: nrrcp ! number of receptor points
+INTEGER*4, INTENT(IN) :: nsubsec ! number sub-secondary species
REAL*4, INTENT(IN) :: cpri(nrrcp) ! array van primaire concentraties
REAL*4, INTENT(IN) :: csec(nrrcp) ! array van secundaire concentraties
REAL*4, INTENT(IN) :: drydep(nrrcp) ! array van droge depositie
REAL*4, INTENT(IN) :: wetdep(nrrcp) ! array van natte depositie
-REAL*4, INTENT(IN), OPTIONAL :: cseccor(nrrcp) ! concentration of second secondary substance
+REAL*4, INTENT(IN), OPTIONAL :: csubsec(nrrcp,nsubsec) ! concentration of sub-secondary substance [ug/m3]
! SUBROUTINE ARGUMENTS - OUTPUT
REAL*4, INTENT(OUT) :: scale_con ! schaal vergr. concentratie
REAL*4, INTENT(OUT) :: scale_sec ! schaal vergr. secundaire concentratie
REAL*4, INTENT(OUT) :: scale_dep ! schaal vergr. droge depositie
-REAL*4, INTENT(OUT), OPTIONAL :: scale_sec_cor ! schaal vergr. secundaire concentratie in gasvorm
+REAL*4, INTENT(OUT), OPTIONAL :: scale_subsec(nsubsec) ! scaling factor for sub-secondary species
! LOCAL VARIABLES
INTEGER*4 :: i ! teller over schaalfactoren
+INTEGER*4 :: isubsec ! index of sub-secondary species
REAL*4 :: cmax ! grootst voorkomende primaire concentratie
REAL*4 :: csmax ! grootst voorkomende secundaire concentratie
-REAL*4 :: csgmax ! grootst voorkomende secundaire concentratie in gasvorm
+REAL*4 :: csubsecmax(nsubsec) ! maximal value csubsec
REAL*4 :: ddepmax ! grootst voorkomende droge depositie
REAL*4 :: depntmax ! grootst voorkomende natte depositie
REAL*4 :: s ! schaalfactor
@@ -73,7 +78,7 @@ SUBROUTINE ops_scalefac(nrrcp, cpri, csec, drydep, wetdep, scale_con, scale_sec,
REAL*4 :: td ! teller aantal te grote droge dep.
REAL*4 :: tn ! teller aantal te grote natte dep.
REAL*4 :: ts ! teller aantal te grote sec. conc.
-REAL*4 :: tg ! teller aantal te grote sec. conc. gas
+REAL*4 :: tsubsec(nsubsec) ! number of sub-secondary species with too large concentrations
REAL*4 :: scale_dry ! schaal vergr. concentratie
REAL*4 :: scale_wet ! schaal vergr. concentratie
@@ -86,7 +91,7 @@ SUBROUTINE ops_scalefac(nrrcp, cpri, csec, drydep, wetdep, scale_con, scale_sec,
!
cmax = MAXVAL(cpri(:))
csmax = MAXVAL(csec(:))
-IF (PRESENT(cseccor)) csgmax = MAXVAL(cseccor(:))
+IF (PRESENT(csubsec)) csubsecmax = MAXVAL(csubsec,1)
ddepmax = MAXVAL(drydep(:))
depntmax = MAXVAL(wetdep(:))
@@ -95,7 +100,7 @@ SUBROUTINE ops_scalefac(nrrcp, cpri, csec, drydep, wetdep, scale_con, scale_sec,
!
scale_con = 1.0e-10
scale_sec = 1.0e-10
-IF (PRESENT(cseccor)) scale_sec_cor = 1.0e-10
+IF (PRESENT(csubsec)) scale_subsec = 1.0e-10
scale_dry = 1.0e-10
scale_wet = 1.0e-10
!
@@ -110,10 +115,12 @@ SUBROUTINE ops_scalefac(nrrcp, cpri, csec, drydep, wetdep, scale_con, scale_sec,
IF (csmax .GT. (0. + EPS_DELTA) .AND. (2000./csmax) .GT. (s + EPS_DELTA)) THEN
scale_sec = s
ENDIF
- IF (PRESENT(cseccor)) THEN
- IF (csgmax .GT. (0. + EPS_DELTA) .AND. (2000./csgmax) .GT. (s + EPS_DELTA)) THEN
- scale_sec_cor = s
- ENDIF
+ IF (PRESENT(csubsec)) THEN
+ do isubsec = 1,nsubsec
+ IF (csubsecmax(isubsec) .GT. (0. + EPS_DELTA) .AND. (2000./csubsecmax(isubsec)) .GT. (s + EPS_DELTA)) THEN
+ scale_subsec(isubsec) = s
+ ENDIF
+ enddo
ENDIF
IF (ddepmax .GT. (0. + EPS_DELTA) .AND. (2000./ddepmax) .GT. (s + EPS_DELTA)) THEN
scale_dry = s
@@ -127,7 +134,11 @@ SUBROUTINE ops_scalefac(nrrcp, cpri, csec, drydep, wetdep, scale_con, scale_sec,
!
tc = COUNT(cpri(:)*scale_con .GT. 999.+EPS_DELTA)
ts = COUNT(csec(:)*scale_sec .GT. 999.+EPS_DELTA)
-IF (PRESENT(cseccor)) tg = COUNT(cseccor(:)*scale_sec_cor .GT. 999.+EPS_DELTA)
+IF (PRESENT(csubsec)) then
+ do isubsec = 1,nsubsec
+ tsubsec(isubsec) = COUNT(csubsec(:,isubsec)*scale_subsec(isubsec) .GT. 999.+EPS_DELTA)
+ enddo
+ENDIF
td = COUNT(drydep(:)*scale_dry .GT. 999.+EPS_DELTA)
tn = COUNT(wetdep(:)*scale_wet .GT. 999.+EPS_DELTA)
!
@@ -139,10 +150,12 @@ SUBROUTINE ops_scalefac(nrrcp, cpri, csec, drydep, wetdep, scale_con, scale_sec,
IF (ts .GT. (0.05*nrrcp + EPS_DELTA)) THEN
scale_sec = scale_sec/10.
ENDIF
-IF (PRESENT(cseccor)) THEN
- IF (tg .GT. (0.05*nrrcp + EPS_DELTA)) THEN
- scale_sec_cor = scale_sec_cor/10.
- ENDIF
+IF (PRESENT(csubsec)) THEN
+ do isubsec = 1,nsubsec
+ IF (tsubsec(isubsec) .GT. (0.05*nrrcp + EPS_DELTA)) THEN
+ scale_subsec(isubsec) = scale_subsec(isubsec)/10.
+ ENDIF
+ enddo
ENDIF
IF (td .GT. (0.05*nrrcp + EPS_DELTA)) THEN
scale_dry = scale_dry/10.
diff --git a/ops_seccmp.f90 b/ops_seccmp.f90
index b2757ff..8c30083 100644
--- a/ops_seccmp.f90
+++ b/ops_seccmp.f90
@@ -1,21 +1,24 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! SUBROUTINE
! NAME : %M%
@@ -24,10 +27,10 @@
! BRANCH -SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR : HvJ/Franka Loeve (Cap Volmac)
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM LLO
! LANGUAGE : FORTRAN-77/90
-! DESCRIPTION : Compute concentration of secondary component (SO4,NO3,NH4) and deposition velocities
+! DESCRIPTION : Compute concentration of secondary component (SO4,NO3,NH4)
! EXIT CODES :
! FILES AND OTHER :
! I/O DEVICES
@@ -40,6 +43,7 @@ SUBROUTINE ops_seccmp(qbpri, ueff, rcsec, routsec, ccc, vv, amol1, amol2, xvg, s
& ra50_rcp, rb_rcp, rc_sec_rcp, pr, vnatsec, cgtsec, vgsec, qsec, consec, vg50trans, ra50tra, rb_tra, xg)
USE m_commonconst
+USE m_ops_vchem
IMPLICIT NONE
@@ -48,7 +52,7 @@ SUBROUTINE ops_seccmp(qbpri, ueff, rcsec, routsec, ccc, vv, amol1, amol2, xvg, s
PARAMETER (ROUTINENAAM = 'ops_seccmp')
! SUBROUTINE ARGUMENTS - INPUT
-REAL*4, INTENT(IN) :: qbpri ! cross-wind integrated mass flux [g/s] of primary substance emitted from source
+REAL*4, INTENT(IN) :: qbpri ! cross-wind integrated mass flux [g/s] of primary species emitted from source
REAL*4, INTENT(IN) :: ueff ! effective transport velocity of plume [m/s]
REAL*4, INTENT(IN) :: rcsec ! opp. weerstand sec. component
REAL*4, INTENT(IN) :: routsec ! in-cloud scavenging ratio for secondary component
@@ -80,7 +84,7 @@ SUBROUTINE ops_seccmp(qbpri, ueff, rcsec, routsec, ccc, vv, amol1, amol2, xvg, s
REAL*4, INTENT(IN) :: xvghbr !
REAL*4, INTENT(IN) :: xvglbr !
REAL*4, INTENT(IN) :: vnatpri !
-REAL*4, INTENT(IN) :: vchem !
+REAL*4, INTENT(IN) :: vchem ! chemical conversion rate [%/h]
REAL*4, INTENT(IN) :: ra4_rcp !
REAL*4, INTENT(IN) :: ra50_rcp !
REAL*4, INTENT(IN) :: rb_rcp !
@@ -93,7 +97,7 @@ SUBROUTINE ops_seccmp(qbpri, ueff, rcsec, routsec, ccc, vv, amol1, amol2, xvg, s
REAL*4, INTENT(OUT) :: vnatsec !
REAL*4, INTENT(OUT) :: cgtsec !
REAL*4, INTENT(OUT) :: vgsec ! deposition velocity secondary component [m/s[
-REAL*4, INTENT(OUT) :: qsec ! cross-wind integrated mass flux of secondary substance [g/s]
+REAL*4, INTENT(OUT) :: qsec ! cross-wind integrated mass flux of secondary species [g/s]
REAL*4, INTENT(OUT) :: consec ! concentration secondary component [ug/m3]
REAL*4, INTENT(OUT) :: vg50trans !
@@ -103,7 +107,7 @@ SUBROUTINE ops_seccmp(qbpri, ueff, rcsec, routsec, ccc, vv, amol1, amol2, xvg, s
REAL*4 :: h !
REAL*4 :: hl !
REAL*4 :: gradsec !
-REAL*4 :: qpri ! cross-wind integrated mass flux [g/s] of primary substance of depleted source
+REAL*4 :: qpri ! cross-wind integrated mass flux [g/s] of primary species of depleted source
REAL*4 :: rcrs !
REAL*4 :: s !
@@ -285,13 +289,13 @@ SUBROUTINE ops_seccmp(qbpri, ueff, rcsec, routsec, ccc, vv, amol1, amol2, xvg, s
& qsec)
!
! In reality, we have to deal with variable mixing heigth and a transport speed that depends on emission height ->
-! a correction is needed, using the 'exact' depletion factor for primary substance vv:
+! a correction is needed, using the 'exact' depletion factor for primary species vv:
!
-! vv : total source depletion factor for primary substance
-! qbpri : cross-wind integrated mass flux [g/s] of primary substance emitted from source
-! qbpri*vv: cross-wind integrated mass flux [g/s] of primary substance of depleted source, using 'exact' depletion factor vv
-! qpri : cross-wind integrated mass flux [g/s] of primary substance of depleted source (numerical approximation from subroutine seccd)
-! qsec : cross-wind integrated mass flux [g/s] of secondary substance (numerical approximation from subroutine seccd)
+! vv : total source depletion factor for primary species
+! qbpri : cross-wind integrated mass flux [g/s] of primary species emitted from source
+! qbpri*vv: cross-wind integrated mass flux [g/s] of primary species of depleted source, using 'exact' depletion factor vv
+! qpri : cross-wind integrated mass flux [g/s] of primary species of depleted source (numerical approximation from subroutine seccd)
+! qsec : cross-wind integrated mass flux [g/s] of secondary species (numerical approximation from subroutine seccd)
!
! Correct qsec:
! qbpri*vv
@@ -302,9 +306,9 @@ SUBROUTINE ops_seccmp(qbpri, ueff, rcsec, routsec, ccc, vv, amol1, amol2, xvg, s
!
IF (qpri .GT. (0. + EPS_DELTA)) qsec = min(qbpri,(qsec*qbpri*vv)/qpri)
!
-! Compute concentration of secondary substance
+! Compute concentration of secondary species
!
-! 1. sigma_z < 1.6*xl -> in Gaussian plume OPS report 3.7, 3.15
+! 1. sigma_z < 1.6*xl -> in Gaussian plume OPS report 3.7, 3.15 FS
!
! q q NSEK 2 -h^2 -(2z - h)^2 -(2z + h)^2
! csec = --- Dy Dz = --- -------- -------------------- [ exp(------------) + exp(------------) + exp(-------------) ]
@@ -317,14 +321,14 @@ SUBROUTINE ops_seccmp(qbpri, ueff, rcsec, routsec, ccc, vv, amol1, amol2, xvg, s
! factor 1e6 for conversion g -> ug
!
! 2. sigma_z > 1.6*xl (well mixed plume) AND depleted source strength > 1e-4*undepleted source strength
-! assume that ratio of concentration and cross-wind integrated mass flux at the receptor is the same for primary and secondary substance:
+! assume that ratio of concentration and cross-wind integrated mass flux at the receptor is the same for primary and secondary species:
!
! csec cpri qsec qsec qbpri qsec
! ---- = ---- -> csec = ---- cpri = ----- ----- cpri = ----- ccc,
! qsec qpri qpri qbpri qpri qbpri
!
! qbpri
-! with ccc = undepleted concentration primary substance = ----- cpri
+! with ccc = undepleted concentration primary species = ----- cpri
! qpri
!
! 3. sigma_z > 1.6*xl (well mixed plume) AND depleted source strength <= 1e-4*undepleted source strength -> (3.7, 3.9 OPS report)
@@ -351,18 +355,20 @@ SUBROUTINE ops_seccmp(qbpri, ueff, rcsec, routsec, ccc, vv, amol1, amol2, xvg, s
!-------------------------------------------------------------------------------------------------------------------------------
! SUBROUTINE : seccd
-! DESCRIPTION : Compute cross-wind integrated mass fluxes for primary and secondary substances.
+! DESCRIPTION : Compute cross-wind integrated mass fluxes Q for primary and secondary substances.
! A numerical time stepping scheme is used here.
!-------------------------------------------------------------------------------------------------------------------------------
SUBROUTINE seccd(qbpri, disx, radius, vw, xl, vgpri, vnatpri, vchem, vgsec, vnatsec, amol1, amol2, diameter, sigz, qpri, &
& qsec)
+IMPLICIT NONE
+
! CONSTANTS
CHARACTER*512 :: ROUTINENAAM !
PARAMETER (ROUTINENAAM = 'seccd')
! SUBROUTINE ARGUMENTS - INPUT
-REAL*4, INTENT(IN) :: qbpri ! cross-wind integrated mass flux [g/s] of primary substance emitted from source
+REAL*4, INTENT(IN) :: qbpri ! cross-wind integrated mass flux [g/s] of primary species emitted from source
REAL*4, INTENT(IN) :: disx !
REAL*4, INTENT(IN) :: radius !
REAL*4, INTENT(IN) :: vw ! average wind speed over trajectory [m/s]
@@ -378,28 +384,31 @@ SUBROUTINE seccd(qbpri, disx, radius, vw, xl, vgpri, vnatpri, vchem, vgsec, vnat
REAL*4, INTENT(IN) :: sigz !
! SUBROUTINE ARGUMENTS - OUTPUT
-REAL*4, INTENT(OUT) :: qpri ! cross-wind integrated mass flux of primary substance of last time step (at receptor) [g/s]
-REAL*4, INTENT(OUT) :: qsec ! cross-wind integrated mass flux of secondary substance of last time step (at receptor) [g/s]
+REAL*4, INTENT(OUT) :: qpri ! cross-wind integrated mass flux of primary species at receptor [g/s]
+REAL*4, INTENT(OUT) :: qsec ! cross-wind integrated mass flux of secondary species at receptor [g/s]
! LOCAL VARIABLES
INTEGER*4 :: itim ! time step index
INTEGER*4 :: ntim ! number of time steps
REAL*4 :: a ! effective transport distance over which conversion takes place
REAL*4 :: a1 !
-REAL*4 :: amolv ! ratio of molecular weights secondary : primary component
REAL*4 :: b !
REAL*4 :: dt ! length of time step [s]
-REAL*4 :: dqsec ! amount of secondary component produced per time step
-REAL*4 :: depl_pri_wetdep_chem ! depletion factor for primary substance due to wet deposition and chemical conversion
-REAL*4 :: depl_pri_drydep ! depletion factor for primary substance due to dry deposition
-REAL*4 :: e2 !
-REAL*4 :: e3 !
-REAL*4 :: qpri_prev ! cross-wind integrated mass flux of primary substance in previous time step [g/s]
-REAL*4 :: qsec2 ! alternative form for qsec
-INTEGER :: iopt ! option for method to compute qsec;
- ! iopt = 0 -> old method,
- ! iopt = 1 -> new version, which starts deposition after the plume hits the ground
- ! iopt = 2 -> as iopt = 1 and 'midpoint' approximation of depletion of secondary substance
+integer :: it ! iteration count
+integer, parameter :: nit = 10 ! maximal number of iterations
+logical :: converged ! iteration procedure for Q(it) has converged : abs(Q(it-1) = Q(it)) < epsa + epsr * Q(it)
+real, parameter :: epsa = 0.001 ! absolute tolerance for iterative procedure (g/s)
+real :: epsr = 0.01 ! relative tolerance for iterative procedure (-)
+real :: qpri_prev_tim ! cross-wind integrated mass flux of primary species at end of previous time step (g/s)
+real :: qsec_prev_tim ! cross-wind integrated mass flux of secondary species at end of previous time step (g/s)
+real :: qpri_prev_it ! cross-wind integrated mass flux of primary species at current time step, previous iteration (g/s)
+real :: qsec_prev_it ! cross-wind integrated mass flux of secondary species at current time step, previous iteration (g/s)
+real :: loss_pri ! loss term of primary species (g/s)
+real :: prod_sec ! production term of secondary species (g/s)
+real :: loss_sec ! loss term of secondary species (g/s)
+real :: e3_pri_sec ! factor in production term of secondary species = (Msec/Mpri) * delta_t * k_chem
+real :: e1_pri ! source depletion factor for primary species, due to dry deposition, wet deposition and chemical conversion
+real :: e1_sec ! source depletion factor for secondary species, due to dry deposition, wet deposition and chemical conversion
REAL*4 :: xseg ! end point of plume segment [m]
REAL*4 :: dx ! travelled distance during one time step = length of plume segment [m]
logical :: lfound_seg_depos ! plume segment where deposition starts has been found
@@ -408,16 +417,10 @@ SUBROUTINE seccd(qbpri, disx, radius, vw, xl, vgpri, vnatpri, vchem, vgsec, vnat
CHARACTER*81 :: sccsida !
sccsida = '%W%:%E%'//char(0)
!-------------------------------------------------------------------------------------------------------------------------------
-! Choose method:
-iopt = 0
-! Ratio of molecular weights of secondary and primary component:
-!
-amolv = amol2/amol1
-!
! Parameterisation of a = distance over which production of secondary species takes place;
! a = x, point source; a = R*exp(-kt), inside area source; a = x - R*(1-exp(-kt)), outside area source.
-! Production takes place, where the concentration of the primary substance is > 0, hence
+! Production takes place, where the concentration of the primary species is > 0, hence
! the loss term b = exp(-k*t), with k = loss rate primary species (due to dry and wet deposition
! and chemical conversion), t = travel time = radius/u = diameter/(2*u), u wind speed.
! The loss rate for dry deposition is k_dry_depos = vgpri/a1, a1 = effective plume thickness.
@@ -429,7 +432,7 @@ SUBROUTINE seccd(qbpri, disx, radius, vw, xl, vgpri, vnatpri, vchem, vgsec, vnat
ELSE
a1 = 1.5*sigz
ENDIF
- b = EXP( - (diameter/(vw*3.)*(vgpri/a1 + (vchem + vnatpri)/360000.)))
+ b = EXP( - (diameter/(vw*3.)*(vgpri/a1 + (vchem + vnatpri)/360000.)))
IF (disx .LE. (radius + EPS_DELTA)) THEN
a = diameter/2.*b
ELSE
@@ -441,7 +444,7 @@ SUBROUTINE seccd(qbpri, disx, radius, vw, xl, vgpri, vnatpri, vchem, vgsec, vnat
! Set ntim = number of time steps; start with 6 time steps for each travel distance < 50 km
! and add 1 time step for each further 50 km:
-ntim = NINT(a)/50000 + 6
+ntim = NINT(a)/50000 + 6
! Set dt = length of time step [s]; end time = ntim*dt = a/wind_velocity
! and dx = distance travelled in one time step [m]
@@ -457,129 +460,96 @@ SUBROUTINE seccd(qbpri, disx, radius, vw, xl, vgpri, vnatpri, vchem, vgsec, vnat
dt = a/vw/ntim
dx = dt*vw
-!
-! Initialise qpri_prev = cross-wind integrated mass flux of primary substance in previous time step [g/s]
-! qpri = cross-wind integrated mass flux of primary substance in current time step [g/s]
-! qsec = cross-wind integrated mass flux of secondary substance up till current time step [g/s]
+! Initialise
+! qpri = cross-wind integrated mass flux of primary species [g/s]
+! qsec = cross-wind integrated mass flux of secondary species [g/s]
! xseg = end point of plume segment after each time step [m]
-qpri_prev = qbpri
-qpri = qbpri
-qsec = 0.
-qsec2 = 0.
-xseg = 0.0
-lfound_seg_depos = .false. ! segment where deposition starts has been found
+! lfound_seg_depos = segment where deposition starts has been found
+qpri = qbpri
+qsec = 0.0
+xseg = 0.0
+lfound_seg_depos = .false.
+
!
! factor 3.6e5 = 3600*100 conversion from %/h to 1/s
!
! dC
-! ---- = -k C --> C(t+dt) = C(t) exp(-k dt); k = k_drydep + k_chem + k_wetdep
+! ---- = -k C --> C(t) = C(0) exp(-k t); k = k_drydep + k_chem + k_wetdep
! dt
-! Source depletion -> effect on C is translated into depleted source strength: Q(t+dt) = Q(t) exp(-k dt).
+! Source depletion -> effect on C is translated into depleted source strength: Q(t) = Q(0) exp(-k t).
!
! k_drydep = conversion rate for dry deposition = vgpri/xl [1/s]
! k_wetdep = conversion rate for wet deposition = vnatpri/(3600*100) [1/s]
! k_chem = conversion rate for chemical conversion = vchem/(3600*100) [1/s]
-! dt = time step [s]
-!
-! depl_pri_wetdep_chem = source depletion factor for primary substance, due to wet deposition and chemical conversion
-! = EXP( -dt*(k_wetdep + k_chem))
-! = EXP( -dt*(vnatpri + vchem)/3.6e5)
-!
-! depl_pri_drydep = source depletion factor for primary substance, due to dry deposition
-! = EXP( -dt*k_drydep)
-! = EXP( -dt*vgpri/xl)
-!
-! e2 = 1 - source depletion factor for secondary substance, due to dry deposition and wet deposition
-! = 1. - EXP( -dt*(k_drydep + k_wetdep))
-! = 1. - EXP( -dt*(vgsec/xl + vnatsec/3.6e5))
-!
-! e3 = help variable for conversion of mass from primary to secondary substance [-] (see below);
-! = dt*(k_chem/2)
-! = dt*vchem/(3600*100*2)
-! = dt*vchem/7.2e+05
+! delta_t = time step = dt [s]
+!
+! In order to resolve the interdependency between the primary and secondary species, we use an extra iteration within
+! each time step. In tests, this iteration only needs 2-3 iterations to converge.
!
-
-depl_pri_wetdep_chem = EXP( - dt*((vnatpri + vchem)/3.6e5))
-e2 = 1. - EXP( - dt*(vgsec/xl + vnatsec/3.6e5))
-e3 = dt*vchem/7.2e+05
+! qpri = cross-wind integrated mass flux of primary species at current time step, current iteration (g/s)
+! qpri_prev_tim = cross-wind integrated mass flux of primary species at end of previous time step (g/s)
+! qpri_prev_it = cross-wind integrated mass flux of primary species at current time step, previous iteration (g/s)
+! qsec, qsec_prev_tim, qsec_prev_it: the same for secondary species
!
-! Loop over time steps
+! prod_sec = production term of secondary species (g/s) = (Msec/Mpri) * (average mass primary) * k_chem =
+! = (Msec/Mpri) * delta_t*(qpri_prev_tim + qpri)/2 * k_chem
+! e3_pri_sec = factor in production term of secondary species = (Msec/Mpri) * delta_t * k_chem
!
+! mass flux at start of time interval : Q(t)
+! mass flux at end of time interval, after deposition, chemical conversion : Q(t+dt) = Q(t) exp(-k dt)
+!
+! loss_pri = loss term of primary species (g/s) = Q(t) - Q(t+dt) = Q(t) [1 - exp(-k dt)], k = k_drydep + k_wetdep + k_chem;
+! Q = qpri_prev_tim.
+! loss_sec = loss term of secondary species (g/s) = Q(t) - Q(t+dt) = Q(t) [1 - exp(-k dt)], k = k_drydep + k_wetdep + k_chem;
+! Q is evaluated by means of a 'midpoint' apprimation: Q = (qsec_prev_tim + 0.5*prod_sec); this makes
+! larger time steps possible.
+!
+! e1_pri = source depletion factor for primary species, due to dry deposition, wet deposition and chemical conversion
+! = 1 - EXP( -delta_t*(k_drydep + k_wetdep + k_chem)) = 1 - EXP( -dt*(vgpri/xl + (vnatpri + vchem)/3.6e5))
+! e1_sec = source depletion factor for secondary species, due to dry deposition and wet deposition
+! = 1 - EXP( -delta_t*(k_drydep + k_wetdep)) = 1 - EXP( -dt*(vgsec/xl + vnatsec/3.6e5))
+
+e1_pri = 1. - exp( - dt*(vgpri/xl + (vnatpri + vchem)/3.6e5));
+e1_sec = 1. - exp( - dt*(vgsec/xl + vnatsec/3.6e5));
+e3_pri_sec = (amol2/amol1)*dt*vchem/3.6e+05;
+
+! Loop over time steps:
DO itim = 1, ntim
-
- if (iopt .eq. 0) then
- ! Old method: deposition for each time step:
- depl_pri_drydep = exp( - dt*vgpri/xl)
- else
- ! New method; deposition starts at xg
-
- ! Update end point:
- xseg = xseg + dx
-
- ! Check whether the plume has hit the ground (and deposition is going on):
- if (xseg .le. xg) then
- ! No deposition:
- depl_pri_drydep = 1.0
- else
- if (.not. lfound_seg_depos) then
- ! xseg > xg, so this is the first egment with deposition; deposition takes place not over the whole time step,
- ! but over the time neede to travel from xg to xseg: (xseg - xg)/vw
- lfound_seg_depos = .true.
- depl_pri_drydep = exp( - ((xseg - xg)/vw)*vgpri/xl)
- else
- ! Deposition takes place over the whole segment:
- depl_pri_drydep = exp( - dt*vgpri/xl)
- endif
- endif
- endif
+ ! Store mass fluxes of previous time step:
+ qpri_prev_tim = qpri
+ qsec_prev_tim = qsec
+
+ ! Loop over iterations:
+ ! NOTE; iteration is only needed if we include both reactions NH3 -> NH4 and
+ ! NH4 -> NH3; if we use the net reaction NH3 -> NH4 only, we don't need an iteration.
+ !
+ !it = 0
+ !converged = .false.
+ !do while (it .lt. nit .and. .not. converged)
+ ! it = it + 1
+
+ ! Store mass fluxes of previous iteration:
+ qpri_prev_it = qpri
+ qsec_prev_it = qsec
+
+ ! Primary species:
+ loss_pri = qpri_prev_tim*e1_pri
+ qpri = qpri_prev_tim - loss_pri
+
+ ! Secondary species:
+ prod_sec = 0.5*(qpri_prev_tim + qpri)*e3_pri_sec
+ loss_sec = (qsec_prev_tim + 0.5*prod_sec)*e1_sec
+ !loss_sec = (qsec_prev_tim - 0.5*prod_sec)*e1_sec
+ qsec = qsec_prev_tim + prod_sec - loss_sec
+
+ !! Check for convergence:
+ !converged = (abs(qpri - qpri_prev_it) .lt. epsa + epsr*qpri .and. abs(qsec - qsec_prev_it) .lt. epsa + epsr*qsec)
+ !! write(*,*) 'seccd: ',it,qpri,abs(qpri-qpri_prev_it),qsec,abs(qsec-qsec_prev_it)
+
+ !enddo ! loop over iterations
- ! Compute new depleted cross-wind integrated mass flux [g/s] for primary substance; Q(t+dt) = Q(t)*depl_pri_wetdep_chem*depl_pri_drydep:
- qpri = qpri*depl_pri_wetdep_chem*depl_pri_drydep
-
- ! dqsec = mass flux converted (due to chemical conversion) from primary to secondary substance, in the current time step [g/s];
- ! qpri_prev = mass flux of primary substance in previous time step [g/s]
- ! qpri = mass flux of primary substance in current time step [g/s]
- ! mass_ave_pri = average mass of primary substance over time step = dt*(qpri + qpri_prev)/2 [g]
- ! k_chem = conversion rate for chemical conversion = vchem/(3600*100) [1/s]
- ! mass converted = (Msec/Mpri) * mass_ave_pri * k_chem = (Msec/Mpri) * dt*(qpri+qpri_prev)/2 * k_chem =
- ! = (Msec/Mpri) * (qpri+qpri_prev) * e3
- dqsec = amolv*(qpri + qpri_prev)*e3
-
- !-----------------------------------------------------------------------
- ! Update cross-wind integrated mass flux for secondary substance
- !-----------------------------------------------------------------------
- ! In case we have no production,
- ! mass flux at start of time interval: Q(t) = qsec
- ! mass flux at end of time interval, without deposition : Q(t)
- ! mass flux at end of time interval, with deposition : Q(t) exp(-k dt)
- ! ------------------------------------------------------------------------
- ! L = loss term due to deposition : Q(t) [1 - exp(-k dt)] = Q(t) e2
- !
- ! In case we have a production term P (= dqsec = production from the primary component), we can make different choices at which point the factor e2 is used:
- ! A. L = Q(t) e2 (depletion at old time step)
- ! B. L = [Q(t)+P] e2 (depletion at new time step)
- ! C. L = [Q(t)+ P/2] e2 (depletion at 'midpoint')
- !
- ! and this leads to:
- !
- ! A. Q(t+dt) = Q(t) + P - L = Q(t) + P - Q(t) e2 = qsec(1-e2) + dqsec
- ! B. Q(t+dt) = Q(t) + P - L = Q(t) + P - [Q(t)+P] e2 = (qsec + dqsec)(1-e2)
- ! C. Q(t+dt) = Q(t) + P - L = Q(t) + P - [Q(t)+ P/2] e2 = qsec (1-e2) + dqsec (1-e2/2)
- ! Original formula of Hans van Jaarsveld: qsec + dqsec - (qsec - dqsec/2.)*e2
- ! identical to original formula of Hans van Jaarsveld: qsec (1-e2) + dqsec (1 + e2/2), which looks like C, apart from a - sign -> BUG ??
-
- if (iopt .eq. 2) then
- ! Midpoint approximation:
- qsec = qsec*(1-e2) + dqsec*(1-0.5*e2)
- else
- ! Original method
- qsec = qsec + dqsec - (qsec - dqsec/2.)*e2
- endif
-
- ! Save mass per second [g/s] of current time step of primary substance:
- qpri_prev = qpri
-ENDDO
+ENDDO ! end loop over time steps
RETURN
END SUBROUTINE seccd
diff --git a/ops_src_char.f90 b/ops_src_char.f90
index eaa285d..8e56c0f 100644
--- a/ops_src_char.f90
+++ b/ops_src_char.f90
@@ -1,21 +1,24 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+! copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! SUBROUTINE
! NAME : %M%
@@ -24,7 +27,7 @@
! BRANCH -SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR :
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM/LLO
! LANGUAGE : FORTRAN-77/90
! USAGE :
diff --git a/ops_stab_rek.f90 b/ops_stab_rek.f90
index 5860e3b..344573c 100644
--- a/ops_stab_rek.f90
+++ b/ops_stab_rek.f90
@@ -1,21 +1,24 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! SUBROUTINE
! NAME : %M%
@@ -24,7 +27,7 @@
! BRANCH -SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR :
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM/LLO
! LANGUAGE : FORTRAN-77/90
! USAGE :
@@ -112,7 +115,7 @@ SUBROUTINE ops_stab_rek(icm, rb, temp_C, h0, z0_metreg_rcp, disx, z0_rcp, xl, ra
REAL*4 :: ol_metreg_from_rb_rcp ! Monin-Obukhov length at receptor from Rb(SO2); for z0 interpolated from meteo regions [m/s]
REAL*4 :: dsx ! ratio disx/radius, i.e.
! ! (source-receptor distance)/(radius of area source)
-REAL*4 :: szsrc !
+REAL*4 :: sz_rcp_stab_src ! vertical dispersion coefficient sigma_z at receptor with (z0,u*,L,uh,zu) of source site
REAL*4 :: uh_rcp !
REAL*4 :: zu_rcp !
REAL*4 :: sz_rcp !
@@ -228,10 +231,10 @@ SUBROUTINE ops_stab_rek(icm, rb, temp_C, h0, z0_metreg_rcp, disx, z0_rcp, xl, ra
IF (dsx .GT. (1. + EPS_DELTA)) THEN
! Compute vertical dispersion coefficient at receptor with (z0,u*,L,uh,zu) of source site
- CALL ops_vertdisp(z0_src, xl, ol_src, uster_src, htot, dsx, uh, zu, szsrc, error)
+ CALL ops_vertdisp(z0_src, xl, ol_src, uster_src, htot, dsx, uh, zu, sz_rcp_stab_src, error)
if (error%debug) write(*,'(3a,2(1x,i6),99(1x,e12.5))') trim(ROUTINENAAM),',A,', &
- ' ircp,istab,z0_src, xl, ol_src, uster_src, htot, dsx, uh, zu, szsrc:', &
- -999,istab,z0_src, xl, ol_src, uster_src, htot, dsx, uh, zu, szsrc
+ ' ircp,istab,z0_src, xl, ol_src, uster_src, htot, dsx, uh, zu, sz_rcp_stab_src:', &
+ -999,istab,z0_src, xl, ol_src, uster_src, htot, dsx, uh, zu, sz_rcp_stab_src
! Compute vertical dispersion coefficient at receptor with (z0,u*,L,uh,zu) of receptor site
CALL ops_vertdisp(z0_rcp, xl, ol_rcp, uster_rcp, htot, dsx, uh_rcp, zu_rcp, sz_rcp, error)
@@ -242,15 +245,15 @@ SUBROUTINE ops_stab_rek(icm, rb, temp_C, h0, z0_metreg_rcp, disx, z0_rcp, xl, ra
!
! Limit sigma_z at source, such that sigma_z(source) < sigma_z(receptor)
!
- IF (szsrc .GT. (sz_rcp + EPS_DELTA)) THEN
- sz_rcp = szsrc
+ IF (sz_rcp_stab_src .GT. (sz_rcp + EPS_DELTA)) THEN
+ sz_rcp = sz_rcp_stab_src
ENDIF
!
! Compute dispersion coefficient dispg of average between sigma_z at source and receptor;
! sigma_z = dispg*disx**disph <=> dispg = sigma_z/(disx**disph), 3.16 new! OPS report
! Since in the rest of the code the old formula sigma_z = dispg*disx**disph is still used,
-! we need dispg and disph and we do not use szsrc and sz_rcp hereafter.
- dispg(istab) = (szsrc + sz_rcp)*0.5/(dsx**DISPH(istab))
+! we need dispg and disph and we do not use sz_rcp_stab_src and sz_rcp hereafter.
+ dispg(istab) = (sz_rcp_stab_src + sz_rcp)*0.5/(dsx**DISPH(istab))
if (error%debug) write(*,'(3a,2(1x,i6),99(1x,e12.5))') trim(ROUTINENAAM),',C,', ' ircp,istab,dispg(istab):', -999,istab,dispg(istab)
! Check limits 0 <= dispg <= 50; if outside limits, generate warning:
@@ -258,8 +261,8 @@ SUBROUTINE ops_stab_rek(icm, rb, temp_C, h0, z0_metreg_rcp, disx, z0_rcp, xl, ra
IF (.NOT. ops_openlog(error)) GOTO 9999
WRITE (fu_log,'("WARNING: OPS has detected a value", " outside its limits in routine ", A)') &
& ROUTINENAAM(:LEN_TRIM(ROUTINENAAM))
- WRITE (fu_log, '("istab,uster_metreg_from_rb_rcp,ol_metreg_rcp, ol_rcp, szsrc,", "sz_rcp: ", i4, 4f8.2, f10.2)') istab, &
- & uster_metreg_from_rb_rcp, ol_metreg_rcp, ol_rcp, szsrc, sz_rcp
+ WRITE (fu_log, '("istab,uster_metreg_from_rb_rcp,ol_metreg_rcp, ol_rcp, sz_rcp_stab_src,", "sz_rcp: ", i4, 4f8.2, f10.2)') istab, &
+ & uster_metreg_from_rb_rcp, ol_metreg_rcp, ol_rcp, sz_rcp_stab_src, sz_rcp
ENDIF
ENDIF
@@ -308,7 +311,7 @@ SUBROUTINE ops_stab_rek(icm, rb, temp_C, h0, z0_metreg_rcp, disx, z0_rcp, xl, ra
! temperature correction for NH3 emissions from animal housing systems; OPS report 6.33.
! Tavg = 10 C
! Temperature correction tcor = 1 + (T - Tavg)/f = 1 + T/f - 10/f = (1-10/f) + T/f = (f-10)/f + T/f = (T + f-10)/f;
- ! Here f = 34, corresponding with a factor 1/34 = 0.0294 (0.04 in 6.33 OPS report).
+ ! Here f = 34, corresponding with a factor 1/34 = 0.0294 (0.04 in 6.33 OPS report). FS
!
tcor=amax1((temp_C+24)/34, 0.2)
diff --git a/ops_statparexp.f90 b/ops_statparexp.f90
index 9a3f656..22e8969 100644
--- a/ops_statparexp.f90
+++ b/ops_statparexp.f90
@@ -1,21 +1,24 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! SUBROUTINE
! NAME : %M%
@@ -24,7 +27,7 @@
! BRANCH - SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR : HvJ/Franka Loeve (Cap Volmac)
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM/LLO
! LANGUAGE : FORTRAN-77/90
! DESCRIPTION : Get parameters as windspeed, mixing height, frequency etc. from the meteo statistics as a function of
@@ -609,7 +612,7 @@ SUBROUTINE ronafhpar(radius, disxx, istab, s, isek, astat, s1,ids, aksek, sa, ph
! Currently not averaged:
! wish for
! future version
-! (HvJ)
+! ( )
! no 1. number of hours for which a certain combination of classes has occurred [-]
! yes 3. wind speed (at 10 m height) [m/s]
! no 7. ratio effective dry deposition velocity over transport distance and average dry deposition velocity over transport distance for low sources [-]
diff --git a/ops_surface.f90 b/ops_surface.f90
index 853fac1..0e429a1 100644
--- a/ops_surface.f90
+++ b/ops_surface.f90
@@ -1,21 +1,24 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! SUBROUTINE
! NAME : %M%
@@ -24,7 +27,7 @@
! BRANCH - SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR : HvJ/Franka Loeve (Cap Volmac)
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM LLO
! LANGUAGE : FORTRAN-77/90
! DESCRIPTION : This routine calculates sigmaz in the surface layer (all stabilities) on the basis of Monin Obukhov
diff --git a/ops_tra_char.f90 b/ops_tra_char.f90
index ae02a1c..6499114 100644
--- a/ops_tra_char.f90
+++ b/ops_tra_char.f90
@@ -1,21 +1,24 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+! copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! SUBROUTINE
! NAME : %M%
@@ -24,7 +27,7 @@
! BRANCH -SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR :
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM/LLO
! LANGUAGE : FORTRAN-77/90
! USAGE :
@@ -36,15 +39,16 @@
! CALLED FUNCTIONS :
! UPDATE HISTORY :
!-------------------------------------------------------------------------------------------------------------------------------
-SUBROUTINE ops_tra_char (icm, f_z0user, z0_user, nrrcp, x_rcp, y_rcp, x_src, y_src, &
- & lugrid, z0nlgrid, z0eurgrid, so2bggrid, no2bggrid, nh3bggrid, domlu, &
- & z0_tra, lu_tra_per, so2bgtra, no2bgtra, nh3bgtra, &
+SUBROUTINE ops_tra_char (icm, iopt_vchem, f_z0user, z0_user, nrrcp, x_rcp, y_rcp, x_src, y_src, &
+ & lugrid, z0nlgrid, z0eurgrid, so2bggrid, no2bggrid, nh3bggrid, vchem2, domlu, &
+ & z0_tra, lu_tra_per, so2bgtra, no2bgtra, nh3bgtra, &
& error)
USE m_commonconst
USE m_commonfile
USE m_error
USE m_aps
+USE m_ops_vchem
IMPLICIT NONE
@@ -54,6 +58,7 @@ SUBROUTINE ops_tra_char (icm, f_z0user, z0_user, nrrcp, x_rcp, y_rcp, x_src, y_s
! SUBROUTINE ARGUMENTS - INPUT
INTEGER*4, INTENT(IN) :: icm !
+INTEGER*4, INTENT(IN) :: iopt_vchem ! option for chemical conversion rate (0 = old OPS, 1 = EMEP)
LOGICAL, INTENT(IN) :: f_z0user ! user overwrites z0 values from meteo input
REAL*4, INTENT(IN) :: z0_user ! roughness length specified by the user [m]
INTEGER*4, INTENT(IN) :: nrrcp ! aantal receptorpunten
@@ -67,6 +72,7 @@ SUBROUTINE ops_tra_char (icm, f_z0user, z0_user, nrrcp, x_rcp, y_rcp, x_src, y_s
TYPE (TApsGridReal), INTENT(IN) :: so2bggrid !
TYPE (TApsGridReal), INTENT(IN) :: no2bggrid !
TYPE (TApsGridReal), INTENT(IN) :: nh3bggrid !
+TYPE (Tvchem) , INTENT(INOUT) :: vchem2 !
LOGICAL, INTENT(IN) :: domlu
! SUBROUTINE ARGUMENTS - OUTPUT
@@ -77,6 +83,8 @@ SUBROUTINE ops_tra_char (icm, f_z0user, z0_user, nrrcp, x_rcp, y_rcp, x_src, y_s
REAL*4, INTENT(OUT) :: nh3bgtra !
TYPE (TError), INTENT(OUT) :: error ! error handling record
+! LOCAL VARIABLES:
+
! SCCS-ID VARIABLES
CHARACTER*81 :: sccsida !
sccsida = '%W%:%E%'//char(0)
@@ -92,11 +100,8 @@ SUBROUTINE ops_tra_char (icm, f_z0user, z0_user, nrrcp, x_rcp, y_rcp, x_src, y_s
! Calculate average roughness length and land use for path between source and receptor
!
CALL ops_getz0_tra(x_rcp, y_rcp, float(x_src), float(y_src), z0nlgrid, z0eurgrid, z0_tra)
- CALL ops_getlu_tra(x_rcp, y_rcp, float(x_src), float(y_src), lugrid, domlu, lu_tra_per)
+IF (ANY(icm == (/1,2,3/))) CALL ops_getlu_tra(x_rcp, y_rcp, float(x_src), float(y_src), lugrid, domlu, lu_tra_per)
ENDIF
-!write(*,'(a,a,1x,e12.5)') trim(ROUTINENAAM),' z0_tra:',z0_tra
-!write(*,'(a,a,99(1x,e12.5))') trim(ROUTINENAAM),' lu_tra_per:',lu_tra_per
-
!
! Calculate average (actual) concentration levels of SO2, NO2 and NH3 between source and receptor
! from background concentration maps which are scaled on the basis of measurements
@@ -104,7 +109,13 @@ SUBROUTINE ops_tra_char (icm, f_z0user, z0_user, nrrcp, x_rcp, y_rcp, x_src, y_s
IF (ANY(icm == (/1,3/))) CALL ops_bgcon_tra(x_rcp, y_rcp, float(x_src), float(y_src), so2bggrid, so2bgtra)
IF (ANY(icm == (/2,3/))) CALL ops_bgcon_tra(x_rcp, y_rcp, float(x_src), float(y_src), no2bggrid, no2bgtra)
IF (ANY(icm == (/1,2,3/))) CALL ops_bgcon_tra(x_rcp, y_rcp, float(x_src), float(y_src), nh3bggrid, nh3bgtra)
-! write(*,'(a,a,3(1x,e12.5))') trim(ROUTINENAAM),' so2bgtra,no2bgtra,nh3bgtra:',so2bgtra,no2bgtra,nh3bgtra
+
+! Compute average mass_prec and mass_conv_dtfac values ocver trajectory (EMEP option iopt_vchem = 1):
+IF ((icm == 1 .or. icm == 2 .or. icm == 3) .and. iopt_vchem .eq. 1) then
+ CALL ops_bgcon_tra(x_rcp, y_rcp, float(x_src), float(y_src), vchem2%mass_prec_grid, vchem2%mass_prec_tra)
+ CALL ops_bgcon_tra(x_rcp, y_rcp, float(x_src), float(y_src), vchem2%mass_conv_dtfac_grid, vchem2%mass_conv_dtfac_tra)
+ ! write(*,*) 'ops_tra_char: ',vchem2%mass_prec_tra,vchem2%mass_conv_dtfac_tra,vchem2%mass_conv_dtfac_tra/vchem2%mass_prec_tra
+ENDIF
RETURN
diff --git a/ops_vertdisp.f90 b/ops_vertdisp.f90
index 1f14aa9..bf2fe96 100644
--- a/ops_vertdisp.f90
+++ b/ops_vertdisp.f90
@@ -1,21 +1,24 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! SUBROUTINE
! NAME : %M%
@@ -24,7 +27,7 @@
! BRANCH - SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR : HvJ/Franka Loeve (Cap Volmac)
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM/LLO
! LANGUAGE : FORTRAN-77/90
! DESCRIPTION : Calculation of vertical dispersion coefficient as a function of stability parameters and downwind distance
diff --git a/ops_virtdist.f90 b/ops_virtdist.f90
index 7964a13..2d6cdd2 100644
--- a/ops_virtdist.f90
+++ b/ops_virtdist.f90
@@ -1,21 +1,24 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! FUNCTION
! NAME : %M%
@@ -24,7 +27,7 @@
! BRANCH - SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR : Martien de Haan, okt 2001
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM/LLO
! LANGUAGE : FORTRAN-77/90
! DESCRIPTION : Compute distance between (virtual point source) and (centre of area source);
diff --git a/ops_write_progress.f90 b/ops_write_progress.f90
index 69c07fe..04b6e36 100644
--- a/ops_write_progress.f90
+++ b/ops_write_progress.f90
@@ -1,21 +1,24 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! SUBROUTINE
! NAME : %M%
@@ -24,7 +27,7 @@
! BRANCH - SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR :
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM/LLO
! LANGUAGE : FORTRAN-77/90
! USAGE :
diff --git a/ops_wv_powerlaw.f90 b/ops_wv_powerlaw.f90
index f43e9b3..bb24327 100644
--- a/ops_wv_powerlaw.f90
+++ b/ops_wv_powerlaw.f90
@@ -1,25 +1,21 @@
-!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
-! National Institute of Public Health and Environment
-! Laboratory for Air Research (RIVM/LLO)
-! The Netherlands
-!-------------------------------------------------------------------------------------------------------------------------------
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
subroutine ops_wv_powerlaw(istab,isek,astat,z,uz,vw10,pcoef)
-! Compute wind profile based on power law. Note that below the reference height of 10 m,
+! Compute wind profile based on power law. Note that below the reference height of 10 m,
! the wind profile is assumed to be constant: uz(z < 10) = uz(z = 10).
USE m_commonconst
diff --git a/ops_wvprofile.f90 b/ops_wvprofile.f90
index 3f9898c..1160bf8 100644
--- a/ops_wvprofile.f90
+++ b/ops_wvprofile.f90
@@ -1,21 +1,24 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! SUBROUTINE
! NAME : %M%
@@ -24,7 +27,7 @@
! BRANCH -SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR : HvJ/Franka Loeve (Cap Volmac)
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM/LLO
! LANGUAGE : FORTRAN-77/90
! DESCRIPTION : This routine calculates the wind velocity at a certain height, assuming a logarithmic wind profile.
diff --git a/ops_z0corr.f90 b/ops_z0corr.f90
index 5363a1d..686446c 100644
--- a/ops_z0corr.f90
+++ b/ops_z0corr.f90
@@ -1,21 +1,24 @@
+!-------------------------------------------------------------------------------------------------------------------------------
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see .
+!
!-------------------------------------------------------------------------------------------------------------------------------
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see .
-!
-! Copyright (C) 2002 by
+! Copyright by
! National Institute of Public Health and Environment
! Laboratory for Air Research (RIVM/LLO)
! The Netherlands
+! No part of this software may be used, copied or distributed without permission of RIVM/LLO (2002)
!
! SUBROUTINE
! NAME : %M%
@@ -24,10 +27,10 @@
! BRANCH -SEQUENCE : %B% - %S%
! DATE - TIME : %E% - %U%
! WHAT : %W%:%E%
-! AUTHOR : HvJ/Franka Loeve (Cap Volmac)
+! AUTHOR : OPS-support
! FIRM/INSTITUTE : RIVM/LLO
! LANGUAGE : FORTRAN-77/90
-! DESCRIPTION : Correct friction velocity (uster) and Monin-Obukhov length (ol) at a standard roughness length for a
+! DESCRIPTION : Correct friction velocity (uster) and Monin-Obukhov length (ol) at a standard roughness length for a
! situation with another roughness length. The main assumption here is that the wind speed at 50 m height
! is not influenced by the roughness of the surface. Temperature effects are not taken into account.
! An iterative procedure is used: starting with uster1 compute a new uster2 and ol2 and continue the iteration,
@@ -46,40 +49,40 @@ SUBROUTINE ops_z0corr(z01, uster1, ol1, z02, uster2, ol2)
IMPLICIT NONE
! CONSTANTS
-CHARACTER*512 :: ROUTINENAAM !
+CHARACTER*512 :: ROUTINENAAM !
PARAMETER (ROUTINENAAM = 'ops_z0corr')
! CONSTANTS
-REAL*4 :: C1 !
-REAL*4 :: Z !
-PARAMETER (C1 = 93500.)
+REAL*4 :: C1 !
+REAL*4 :: Z !
+PARAMETER (C1 = 93500.)
PARAMETER (Z = 50.)
! SUBROUTINE ARGUMENTS - INPUT
REAL*4, INTENT(IN) :: z01 ! standard roughness length [m]
-REAL*4, INTENT(IN) :: uster1 ! friction velocity at standard roughness length
+REAL*4, INTENT(IN) :: uster1 ! friction velocity at standard roughness length
REAL*4, INTENT(IN) :: ol1 ! Monin-Obukhov length at standard roughness length [m]
REAL*4, INTENT(IN) :: z02 ! new roughness length [m]
! SUBROUTINE ARGUMENTS - OUTPUT
-REAL*4, INTENT(OUT) :: uster2 ! friction velocity at new roughness length
+REAL*4, INTENT(OUT) :: uster2 ! friction velocity at new roughness length
REAL*4, INTENT(OUT) :: ol2 ! Monin-Obukhov length at standard roughness length [m]
! LOCAL VARIABLES
INTEGER*4 :: n ! iteration index
-REAL*4 :: h0 !
+REAL*4 :: h0 !
REAL*4 :: delta ! difference between old and new iterand for uster2
-REAL*4 :: phim !
+REAL*4 :: phim !
REAL*4 :: u50 ! wind speed at 50 m height
REAL*4 :: uold ! uster at previous iteration
REAL*4 :: delta_old ! old difference between old and new iterand for uster2
REAL*4 :: ur ! ratio uster/uold
! SCCS-ID VARIABLES
-CHARACTER*81 :: sccsida !
+CHARACTER*81 :: sccsida !
sccsida = '%W%:%E%'//char(0)
!-------------------------------------------------------------------------------------------------------------------------------
-!
+!
! T rho_a cp (u*)^3
! (2.1) OPS report: L = -------------------
! g H0 kappa
@@ -87,16 +90,16 @@ SUBROUTINE ops_z0corr(z01, uster1, ol1, z02, uster2, ol2)
! rho_a : air density = 1.292 kg/m3 (0 C), 1.247 kg/m3 (20 C), 1.204 kg/m3 (20 C), pressure = 1 atm
! cp : specific heat capacity = 1003.5 J/(kg K), sea level, dry, T=0 C; 1012 J/(kg/K), typical room conditions (T = 23 C)
! kappa : von Karman constant = 0.4 [-]
-! g : accelaration of gravity = 9.81 m/s2
+! g : accelaration of gravity = 9.81 m/s2
! T : absolute temperature [K]
! H0 : surface heat flux [W/m2]
!
-! T rho_a cp (u*)^3 T rho_a cp (u*)^3 (u*)^3
+! T rho_a cp (u*)^3 T rho_a cp (u*)^3 (u*)^3
! From this follows: H0 = ----------------- = ------------ ------ = C1 ------
-! g L kappa g kappa L L
+! g L kappa g kappa L L
!
! T rho_a cp K kg J s2 kg m2 s2 kg
-! [C1] = [ ------------ ] = ------------- = --------- = ------ (J = kg m2/s2)
+! [C1] = [ ------------ ] = ------------- = --------- = ------ (J = kg m2/s2)
! g kappa m3 kg K m s2 m4 m2
!
! actual values in code: rho = 1.29 kg/m3, cp = 1005 J/(kg K), kappa=0.4, g=9.81 m/s2, T=283 K; c1=rho*cp*T/(kappa*g) = 93467 kg/m2.
@@ -143,13 +146,13 @@ SUBROUTINE ops_z0corr(z01, uster1, ol1, z02, uster2, ol2)
h0 = h0*ur**0.1
ENDIF
- ! If percentual difference of iterands > 1.5% AND number of iterations < 40 -> continue iteration
+ ! If percentual difference of iterands > 1.5% AND number of iterations < 40 -> continue iteration
IF ((delta .GT. (0.015*uster2 + EPS_DELTA)) .AND. (n .LT. 40)) THEN
GOTO 50
ENDIF
! Converged OR number of iterations >= 40;
-! limit L, u* such that
+! limit L, u* such that
! -5 < L < 0 -> L = -5
! 0 < L < 5 -> L = 5
! u* >= 0.06 m/s
@@ -178,7 +181,7 @@ SUBROUTINE ops_z0corr(z01, uster1, ol1, z02, uster2, ol2)
SUBROUTINE stabcm(h, ol, phim)
! CONSTANTS
-CHARACTER*512 :: ROUTINENAAM !
+CHARACTER*512 :: ROUTINENAAM !
PARAMETER (ROUTINENAAM = 'stabcm')
! SUBROUTINE ARGUMENTS - INPUT
@@ -192,7 +195,7 @@ SUBROUTINE stabcm(h, ol, phim)
REAL*4 :: y ! hulpvariabele voor berekening
! SCCS-ID VARIABLES
-CHARACTER*81 :: sccsida !
+CHARACTER*81 :: sccsida !
sccsida = '%W%:%E%'//char(0)
!-------------------------------------------------------------------------------------------------------------------------------
IF (ol .GT. (0. + EPS_DELTA)) THEN