diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml
index dab311c4d1fbe3d1516d8d1d6c5bba8ef11ae516..a678ab53078f12fa0fd797eb4ea60aa217fe4056 100644
--- a/.gitlab-ci.yml
+++ b/.gitlab-ci.yml
@@ -77,7 +77,6 @@ nests-test:
when: on_success
paths:
-
openmp-simulation:
# image: harbor.wolke.img.univie.ac.at/flexpart/almalinux8:latest
image: harbor.wolke.img.univie.ac.at/flexpart/rockylinux9:latest
diff --git a/options/COMMAND b/options/COMMAND
index 3f3e57509d83169453c0f43d9d3d75d0b1a626f5..7d4e611dc8e3f44b641bac8afd5acc64a53c6d5a 100644
--- a/options/COMMAND
+++ b/options/COMMAND
@@ -42,4 +42,5 @@
MAXFILESIZE= 10000, ! Maximum output of each partoutput NetCDF-4 file in Mb before a new one is created
LOGVERTINTERP= 0, ! Flag to set all vertical interpolation to logarithmic instead of linear
BCSCHEME= 1, ! Below-cloud scheme; [1] Laakso & Kyro [2] Wang et al [3] modified Wang et al
+ LCMOUTPUT= 0, ! Switch for the Linear Chemistry Module; [0] off [1] on
/
diff --git a/options_lcm/AGECLASSES b/options_lcm/AGECLASSES
new file mode 100644
index 0000000000000000000000000000000000000000..08a41a662e7bd6b5301f7eb5af3ba1b3b3441d51
--- /dev/null
+++ b/options_lcm/AGECLASSES
@@ -0,0 +1,17 @@
+************************************************
+* *
+*Lagrangian particle dispersion model FLEXPART *
+* Please select your options *
+* *
+*This file determines the ageclasses to be used*
+* *
+*Ages are given in seconds. The first class *
+*starts at age zero and goes up to the first *
+*age specified. The last age gives the maximum *
+*time a particle is carried in the simulation. *
+* *
+************************************************
+&AGECLASS
+ NAGECLASS= 1,
+ LAGE= 1728000,
+ /
diff --git a/options_lcm/COMMAND b/options_lcm/COMMAND
new file mode 100644
index 0000000000000000000000000000000000000000..040a03222722599984f4bc04d0d8a9dfd5d61296
--- /dev/null
+++ b/options_lcm/COMMAND
@@ -0,0 +1,49 @@
+***************************************************************************************************************
+* *
+* Input file for the Lagrangian particle dispersion model FLEXPART *
+* Please select your options *
+* *
+***************************************************************************************************************
+&COMMAND
+ LDIRECT= 1, ! Simulation direction in time ; 1 (forward) or -1 (backward)
+ IBDATE= 20200701, ! Start date of the simulation ; YYYYMMDD: YYYY=year, MM=month, DD=day
+ IBTIME= 000000, ! Start time of the simulation ; HHMISS: HH=hours, MI=min, SS=sec; UTC
+ IEDATE= 20200701, ! End date of the simulation ; same format as IBDATE
+ IETIME= 030000, ! End time of the simulation ; same format as IBTIME
+ LOUTSTEP= 3600, ! Interval of model output; average concentrations calculated every LOUTSTEP (s)
+ LOUTAVER= 3600, ! Interval of output averaging (s)
+ LOUTSAMPLE= 1200, ! Interval of output sampling (s), higher stat. accuracy with shorter intervals
+ LOUTRESTART= -1, ! Interval of writing restart files (s), switched off when set to -1
+ LRECOUTSTEP= 3600, ! Interval of model output at receptors (s)
+ LRECOUTAVER= 3600, ! Interval of receptor output averaging (s)
+ LRECOUTSAMPLE= 1200, ! Interval of receptor output sampling (s)
+ LSYNCTIME= 1200, ! All processes are synchronized to this time interval (s)
+ CTL= -5.0000000, ! CTL>1, ABL time step = (Lagrangian timescale (TL))/CTL, uses LSYNCTIME if CTL<0
+ IFINE= 4, ! Reduction for time step in vertical transport, used only if CTL>1
+ IOUT= 2, ! Gridded output type: [0]off [1]mass 2]pptv 3]1&2 4]plume 5]1&4, +8 for NetCDF output
+ IPOUT= 2, ! Particle position output: 0]off 1]every output 2]only at end
+ LSUBGRID= 1, ! Increase of ABL heights due to sub-grid scale orographic variations;[0]off 1]on
+ LCONVECTION= 1, ! Switch for convection parameterization;0]off [1]on
+ LTURBULENCE= 1, ! Switch for turbulence parameterisation;0]off [1]on
+ LTURBULENCE_MESO= 0, ! Switch for mesoscale turbulence parameterisation;0]off (recommended) [1]on
+ LAGESPECTRA= 0, ! Switch for calculation of age spectra (needs AGECLASSES);[0]off 1]on
+ IPIN= 0, ! Warm start from particle dump; [0]no 1]from restart.bin file 2]from previous partoutput file 3]self made initial conditions 4]restart.bin and self made initial conditions
+ IOUTPUTFOREACHRELEASE= 0, ! Separate output fields for each location in the RELEASE file; [0]no 1]yes
+ IFLUX= 0, ! Output of mass fluxes through output grid box boundaries
+ MDOMAINFILL= 1, ! Switch for domain-filling, if limited-area particles generated at boundary
+ IND_SOURCE= 1, ! Unit to be used at the source; [1]mass 2]mass mixing ratio
+ IND_RECEPTOR= 1, ! Unit to be used at the receptor; [0]no receptor [1]mass 2]mass mixing ratio 3]wet depo. 4]dry depo.
+ MQUASILAG= 0, ! Quasi-Lagrangian mode to track individual numbered particles
+ NESTED_OUTPUT= 0, ! Output also for a nested domain
+ LNETCDFOUT= 1, ! Grid and receptors output in NetCDF format [0]no (binary) [1]yes
+ LINIT_COND= 0, ! Output sensitivity to initial conditions (bkw mode only) [0]off 1]conc 2]mmr
+ SFC_ONLY= 0, ! Output only for the lowest model layer, used w/ LINIT_COND=1 or 2
+ LINVERSIONOUT= 0, ! Inversion output format [0]no [1]yes (bkw mode only)
+ CBLFLAG= 0, ! Skewed, not Gaussian turbulence in the convective ABL, need large CTL and IFINE
+ NXSHIFT= 0, ! Shift of the global meteorological data. Default 359 for ECMWF and 0 for GFS if not given
+ MAXTHREADGRID= 8, ! Set maximum number of threads for doing grid computations. Recommended to set this no higher than 16. High numbers create more overhead and a larger memory footprint, 1=no parallelisation on grid.
+ MAXFILESIZE= 10000, ! Maximum output of each partoutput NetCDF-4 file in Mb before a new one is created
+ LOGVERTINTERP= 0, ! Flag to set all vertical interpolation to logarithmic instead of linear
+ BCSCHEME= 1, ! Below-cloud scheme; [1] Laakso & Kyro [2] Wang et al [3] modified Wang et al
+ LCMOUTPUT= 1, ! Switch for the Linear Chemistry Module; [0] off [1] on
+ /
diff --git a/options_lcm/IGBP_int1.dat b/options_lcm/IGBP_int1.dat
new file mode 100644
index 0000000000000000000000000000000000000000..089a3dd57efec5ae30eddb9b2eae8c8498df0279
Binary files /dev/null and b/options_lcm/IGBP_int1.dat differ
diff --git a/options_lcm/INITCONC b/options_lcm/INITCONC
new file mode 100644
index 0000000000000000000000000000000000000000..9f82370e68ec38489dcadc773230a6975c41d06b
--- /dev/null
+++ b/options_lcm/INITCONC
@@ -0,0 +1,41 @@
+!*******************************************************************************
+! *
+! Input file for the Lagrangian particle dispersion model FLEXPART *
+! Please specify file info for initial mixing ratios (domainfill runs only) *
+! *
+! NINIT = number of species for which initial concentration specified *
+! SPECNUM_REL = list of species of length nspec *
+! *
+! Specify INITCONC variables for each species: *
+! PATH_NAME = path to initial concentration files *
+! FILE_NAME = generic name of file (using YYYY[MM][DD]) for dates *
+! VAR_NAME = name of concentration variable in file *
+! HYA_NAME = name of hybrid pressure coord A (use "" if none) *
+! HYB_NAME = name of hybrid pressure coord B (use "" if none) *
+! PS_NAME = name of surface pressure variable (use "" if none) *
+! Q_NAME = name of specific humidity variable (use "" if none, then *
+! assumes dry air mixing ratio) *
+! PRS_NAME = name of vertical pressure coordinate (use "" if none) *
+! ALT_NAME = name of altitude coordinate (use "" if none) *
+! COEFF = coefficient from input unit to ppbv *
+! *
+! Note: if hybrid pres coord need variable PS_NAME, otherwise one of *
+! ALT_NAME or PRS_NAME needs to be given *
+! *
+!*******************************************************************************
+&INITCONC_CTRL
+ NINIT = 1,
+ SPECNUM_REL = 26,
+/
+&INITCONC
+ PATH_NAME = "/xnilu_wrk/users/rlt/NILU/FLEXDATA/BACKGROUND/CAMS/CH4/v20r1/",
+ FILE_NAME = "cams73_v20r1_ch4_conc_surface_dm_YYYYMM.nc",
+ VAR_NAME = "CH4",
+ HYA_NAME = "hyam",
+ HYB_NAME = "hybm",
+ PS_NAME = "ps",
+ Q_NAME = "Q",
+ PRS_NAME = "",
+ ALT_NAME = "",
+ COEFF = 1.,
+/
diff --git a/options_lcm/OUTGRID b/options_lcm/OUTGRID
new file mode 100644
index 0000000000000000000000000000000000000000..b9aed4b098b0db14eee264206745273896d6573b
--- /dev/null
+++ b/options_lcm/OUTGRID
@@ -0,0 +1,22 @@
+!*******************************************************************************
+! *
+! Input file for the Lagrangian particle dispersion model FLEXPART *
+! Please specify your output grid *
+! *
+! OUTLON0 = GEOGRAPHYICAL LONGITUDE OF LOWER LEFT CORNER OF OUTPUT GRID *
+! OUTLAT0 = GEOGRAPHYICAL LATITUDE OF LOWER LEFT CORNER OF OUTPUT GRID *
+! NUMXGRID = NUMBER OF GRID POINTS IN X DIRECTION (= No. of cells + 1) *
+! NUMYGRID = NUMBER OF GRID POINTS IN Y DIRECTION (= No. of cells + 1) *
+! DXOUT = GRID DISTANCE IN X DIRECTION *
+! DYOUN = GRID DISTANCE IN Y DIRECTION *
+! OUTHEIGHTS = HEIGHT OF LEVELS (UPPER BOUNDARY) *
+!*******************************************************************************
+&OUTGRID
+ OUTLON0= -179.50,
+ OUTLAT0= -90.00,
+ NUMXGRID= 180,
+ NUMYGRID= 90,
+ DXOUT= 2.00,
+ DYOUT= 2.00,
+ OUTHEIGHTS= 100.0, 500.0, 1000.0 , 50000.0,
+ /
diff --git a/options_lcm/PARTOPTIONS b/options_lcm/PARTOPTIONS
new file mode 100644
index 0000000000000000000000000000000000000000..0f05584d77603a72025380c50b5bbe8b459ab968
--- /dev/null
+++ b/options_lcm/PARTOPTIONS
@@ -0,0 +1,42 @@
+***************************************************************************************************************
+* *
+* Input file for the Lagrangian particle dispersion model FLEXPART *
+* Please select which fields you would like to print in the partoutput files *
+* *
+***************************************************************************************************************
+&PARTOPTIONS
+ LONGITUDE= .true., !
+ LONGITUDE_AVERAGE= .true., !
+ LATITUDE= .true., !
+ LATITUDE_AVERAGE= .true., !
+ HEIGHT= .true., !
+ HEIGHT_AVERAGE= .true., !
+ PV= .true., !
+ PV_AVERAGE= .true., !
+ QV= .true., !
+ QV_AVERAGE= .false., !
+ DENSITY= .false., !
+ DENSITY_AVERAGE= .false., !
+ TEMPERATURE= .false., !
+ TEMPERATURE_AVERAGE= .false., !
+ PRESSURE= .false., !
+ PRESSURE_AVERAGE= .false., !
+ MIXINGHEIGHT= .false., !
+ MIXINGHEIGHT_AVERAGE= .false., !
+ TROPOPAUSE= .false., !
+ TROPOPAUSE_AVERAGE= .false., !
+ TOPOGRAPHY= .false., !
+ TOPOGRAPHY_AVERAGE= .false., !
+ MASS= .false., !
+ MASS_AVERAGE= .false., !
+ U= .false., !
+ U_AVERAGE= .false., !
+ V= .false., !
+ V_AVERAGE= .false., !
+ W= .false., !
+ W_AVERAGE= .false., !
+ VSETTLING= .false., !
+ VSETTLING_AVERAGE= .false., !
+ WETDEPOSITION= .false., !
+ DRYDEPOSITION= .false.,
+ /
diff --git a/options_lcm/REAGENTS b/options_lcm/REAGENTS
new file mode 100644
index 0000000000000000000000000000000000000000..24f14aeef466770f763c958b1661afe99667d630
--- /dev/null
+++ b/options_lcm/REAGENTS
@@ -0,0 +1,16 @@
+!*******************************************************************************
+! *
+! Input file for the Lagrangian particle dispersion model FLEXPART *
+! Please specify reagents used for chemical loss *
+! *
+! PREAGENT = reagent name (must be same as variable name and match those *
+! used in reactions list in SPECIES file) *
+! PREAG_PATH = path to reagent file *
+! PHOURLY = interpolate field to hourly based on solar zenith angle *
+! (0 = NO, 1 = YES) *
+!*******************************************************************************
+&REAGENT_PARAMS
+ PREAGENT="OH",
+ PREAG_PATH="/xnilu_wrk/users/rlt/NILU/FLEXDATA/REGAME/flexpart_ctm/oh_fields/",
+ PHOURLY=1,
+/
diff --git a/options_lcm/RECEPTORS b/options_lcm/RECEPTORS
new file mode 100644
index 0000000000000000000000000000000000000000..7dce6836420530d4b70d0c594b566cd366078c21
--- /dev/null
+++ b/options_lcm/RECEPTORS
@@ -0,0 +1,232 @@
+&RECEPTORS
+ RECEPTOR="BRW ",
+ LAT= 71.3199997 ,
+ LON= -156.610001 ,
+ ALT= 16.0000000 ,
+ TIME= 2459032.0000000000 ,
+ /
+&RECEPTORS
+ RECEPTOR="CRV ",
+ LAT= 64.9899979 ,
+ LON= -147.600006 ,
+ ALT= 32.0000000 ,
+ TIME= 2459032.0000000000 ,
+ /
+&RECEPTORS
+ RECEPTOR="LEF ",
+ LAT= 45.9500008 ,
+ LON= -90.2699966 ,
+ ALT= 396.000000 ,
+ TIME= 2459032.0000000000 ,
+ /
+&RECEPTORS
+ RECEPTOR="MLO ",
+ LAT= 19.5400009 ,
+ LON= -155.580002 ,
+ ALT= 300.000000 ,
+ TIME= 2459032.0000000000 ,
+ /
+&RECEPTORS
+ RECEPTOR="SCT ",
+ LAT= 33.4099998 ,
+ LON= -81.8300018 ,
+ ALT= 305.000000 ,
+ TIME= 2459032.0000000000 ,
+ /
+&RECEPTORS
+ RECEPTOR="WGC ",
+ LAT= 38.2599983 ,
+ LON= -121.489998 ,
+ ALT= 484.000000 ,
+ TIME= 2459032.0000000000 ,
+ /
+&RECEPTORS
+ RECEPTOR="MHD ",
+ LAT= 53.3300018 ,
+ LON= -9.98999977 ,
+ ALT= 11.0000000 ,
+ TIME= 2459032.0000000000 ,
+ /
+&RECEPTORS
+ RECEPTOR="THD ",
+ LAT= 41.0499992 ,
+ LON= -124.150002 ,
+ ALT= 15.0000000 ,
+ TIME= 2459032.0000000000 ,
+ /
+&RECEPTORS
+ RECEPTOR="RPB ",
+ LAT= 13.1700001 ,
+ LON= -59.4300003 ,
+ ALT= 13.0000000 ,
+ TIME= 2459032.0000000000 ,
+ /
+&RECEPTORS
+ RECEPTOR="SMO ",
+ LAT= -14.2500000 ,
+ LON= -170.559998 ,
+ ALT= 35.0000000 ,
+ TIME= 2459032.0000000000 ,
+ /
+&RECEPTORS
+ RECEPTOR="CGO ",
+ LAT= -40.6800003 ,
+ LON= 144.690002 ,
+ ALT= 80.0000000 ,
+ TIME= 2459032.0000000000 ,
+ /
+&RECEPTORS
+ RECEPTOR="BRW ",
+ LAT= 71.3199997 ,
+ LON= -156.610001 ,
+ ALT= 16.0000000 ,
+ TIME= 2459032.0416666665 ,
+ /
+&RECEPTORS
+ RECEPTOR="CRV ",
+ LAT= 64.9899979 ,
+ LON= -147.600006 ,
+ ALT= 32.0000000 ,
+ TIME= 2459032.0416666665 ,
+ /
+&RECEPTORS
+ RECEPTOR="LEF ",
+ LAT= 45.9500008 ,
+ LON= -90.2699966 ,
+ ALT= 396.000000 ,
+ TIME= 2459032.0416666665 ,
+ /
+&RECEPTORS
+ RECEPTOR="MLO ",
+ LAT= 19.5400009 ,
+ LON= -155.580002 ,
+ ALT= 300.000000 ,
+ TIME= 2459032.0416666665 ,
+ /
+&RECEPTORS
+ RECEPTOR="SCT ",
+ LAT= 33.4099998 ,
+ LON= -81.8300018 ,
+ ALT= 305.000000 ,
+ TIME= 2459032.0416666665 ,
+ /
+&RECEPTORS
+ RECEPTOR="WGC ",
+ LAT= 38.2599983 ,
+ LON= -121.489998 ,
+ ALT= 484.000000 ,
+ TIME= 2459032.0416666665 ,
+ /
+&RECEPTORS
+ RECEPTOR="MHD ",
+ LAT= 53.3300018 ,
+ LON= -9.98999977 ,
+ ALT= 11.0000000 ,
+ TIME= 2459032.0416666665 ,
+ /
+&RECEPTORS
+ RECEPTOR="THD ",
+ LAT= 41.0499992 ,
+ LON= -124.150002 ,
+ ALT= 15.0000000 ,
+ TIME= 2459032.0416666665 ,
+ /
+&RECEPTORS
+ RECEPTOR="RPB ",
+ LAT= 13.1700001 ,
+ LON= -59.4300003 ,
+ ALT= 13.0000000 ,
+ TIME= 2459032.0416666665 ,
+ /
+&RECEPTORS
+ RECEPTOR="SMO ",
+ LAT= -14.2500000 ,
+ LON= -170.559998 ,
+ ALT= 35.0000000 ,
+ TIME= 2459032.0416666665 ,
+ /
+&RECEPTORS
+ RECEPTOR="CGO ",
+ LAT= -40.6800003 ,
+ LON= 144.690002 ,
+ ALT= 80.0000000 ,
+ TIME= 2459032.0416666665 ,
+ /
+&RECEPTORS
+ RECEPTOR="BRW ",
+ LAT= 71.3199997 ,
+ LON= -156.610001 ,
+ ALT= 16.0000000 ,
+ TIME= 2459032.0833333335 ,
+ /
+&RECEPTORS
+ RECEPTOR="CRV ",
+ LAT= 64.9899979 ,
+ LON= -147.600006 ,
+ ALT= 32.0000000 ,
+ TIME= 2459032.0833333335 ,
+ /
+&RECEPTORS
+ RECEPTOR="LEF ",
+ LAT= 45.9500008 ,
+ LON= -90.2699966 ,
+ ALT= 396.000000 ,
+ TIME= 2459032.0833333335 ,
+ /
+&RECEPTORS
+ RECEPTOR="MLO ",
+ LAT= 19.5400009 ,
+ LON= -155.580002 ,
+ ALT= 300.000000 ,
+ TIME= 2459032.0833333335 ,
+ /
+&RECEPTORS
+ RECEPTOR="SCT ",
+ LAT= 33.4099998 ,
+ LON= -81.8300018 ,
+ ALT= 305.000000 ,
+ TIME= 2459032.0833333335 ,
+ /
+&RECEPTORS
+ RECEPTOR="WGC ",
+ LAT= 38.2599983 ,
+ LON= -121.489998 ,
+ ALT= 484.000000 ,
+ TIME= 2459032.0833333335 ,
+ /
+&RECEPTORS
+ RECEPTOR="MHD ",
+ LAT= 53.3300018 ,
+ LON= -9.98999977 ,
+ ALT= 11.0000000 ,
+ TIME= 2459032.0833333335 ,
+ /
+&RECEPTORS
+ RECEPTOR="THD ",
+ LAT= 41.0499992 ,
+ LON= -124.150002 ,
+ ALT= 15.0000000 ,
+ TIME= 2459032.0833333335 ,
+ /
+&RECEPTORS
+ RECEPTOR="RPB ",
+ LAT= 13.1700001 ,
+ LON= -59.4300003 ,
+ ALT= 13.0000000 ,
+ TIME= 2459032.0833333335 ,
+ /
+&RECEPTORS
+ RECEPTOR="SMO ",
+ LAT= -14.2500000 ,
+ LON= -170.559998 ,
+ ALT= 35.0000000 ,
+ TIME= 2459032.0833333335 ,
+ /
+&RECEPTORS
+ RECEPTOR="CGO ",
+ LAT= -40.6800003 ,
+ LON= 144.690002 ,
+ ALT= 80.0000000 ,
+ TIME= 2459032.0833333335 ,
+ /
+
diff --git a/options_lcm/RELEASES b/options_lcm/RELEASES
new file mode 100644
index 0000000000000000000000000000000000000000..b52718787e02b1c9274c6a78374e08255cef0e16
--- /dev/null
+++ b/options_lcm/RELEASES
@@ -0,0 +1,30 @@
+***************************************************************************************************************
+* *
+* *
+* *
+* Input file for the Lagrangian particle dispersion model FLEXPART *
+* Please select your options *
+* *
+* *
+* *
+***************************************************************************************************************
+&RELEASES_CTRL
+ NSPEC = 2, ! Total number of species
+ SPECNUM_REL= 24, 26, ! Species numbers in directory SPECIES (airtracer, CH4)
+ /
+&RELEASE ! For each release
+ IDATE1 = 20200701, ! Release start date, YYYYMMDD: YYYY=year, MM=month, DD=day
+ ITIME1 = 000000, ! Release start time in UTC HHMISS: HH hours, MI=minutes, SS=seconds
+ IDATE2 = 20200702, ! Release end date, same as IDATE1
+ ITIME2 = 000000, ! Release end time, same as ITIME1
+ LON1 = -179.500, ! Left longitude of release box -180 < LON1 <180
+ LON2 = 180.000, ! Right longitude of release box, same as LON1
+ LAT1 = -90.000, ! Lower latitude of release box, -90 < LAT1 < 90
+ LAT2 = 89.500, ! Upper latitude of release box same format as LAT1
+ Z1 = 0.000, ! Lower height of release box meters/hPa above reference level
+ Z2 = 50000.000, ! Upper height of release box meters/hPa above reference level
+ ZKIND = 1, ! Reference level 1=above ground, 2=above sea level, 3 for pressure in hPa
+ MASS = 1.0000, ! Total mass emitted, only relevant for fwd simulations
+ PARTS = 10000000, ! Total number of particles to be released
+ COMMENT = "DOMAINFILL", ! Comment, written in the outputfile
+ /
diff --git a/options_lcm/SATELLITES b/options_lcm/SATELLITES
new file mode 100644
index 0000000000000000000000000000000000000000..1fa0d63ac6468397abfca4c49a7f25d44782e7d7
--- /dev/null
+++ b/options_lcm/SATELLITES
@@ -0,0 +1,5 @@
+&SATELLITES
+ PSATNAME = "esa_ch4",
+ PPATH = "/home/rthompson/BACKWARD_RUNS/REGAME/bremen/test_fpctm/",
+ PFILE = "releases_esa_ch4_YYYYMMDD.nc",
+ /
diff --git a/options_lcm/SPECIES/SPECIES.README b/options_lcm/SPECIES/SPECIES.README
new file mode 100644
index 0000000000000000000000000000000000000000..4a1e85794825f819fbbb2afdcf655101ca9a3369
--- /dev/null
+++ b/options_lcm/SPECIES/SPECIES.README
@@ -0,0 +1,18 @@
+Specifies all physico-chemical properties for the species.
+
+To generate an overview table compile the specoverview.f90 program
+
+gfortran specoverview.f90 -o specoverview
+./specoverview
+
+UPDATE FOR FLEXPART VERSION 10.0 DEV:
+--------------------------------------------------------------------------------
+Please note that the format of the SPECIES files has changed from the previous
+version (9.2) of FLEXPART and it is important to update all SPECIES files
+accordingly. The use of SPECIES files from older FLEXPART versions may lead to
+run-time errors or erroneous results.
+--------------------------------------------------------------------------------
+Half life due to radioactive or chemical decay and can be switched off by
+specifying a negative value. Molecular weight (molweight of the species, needed
+for mixing ratio output)
+--------------------------------------------------------------------------------
diff --git a/options_lcm/SPECIES/SPECIES_002 b/options_lcm/SPECIES/SPECIES_002
new file mode 100644
index 0000000000000000000000000000000000000000..371e65b09b7f5844798f08843826a98890ba188b
--- /dev/null
+++ b/options_lcm/SPECIES/SPECIES_002
@@ -0,0 +1,22 @@
+&SPECIES_PARAMS
+ PSPECIES="O3", ! Tracer name
+ PDECAY=-9.9, ! Species half life
+ PWETA_GAS=-0.9E-9, ! Below-cloud scavenging (gases) - A (weta_gas)
+ PWETB_GAS=-9.9, ! Below-cloud scavenging (gases) - B (wetb_gas)
+ PCRAIN_AERO=-9.9, ! Below-cloud scavenging (particles) - Crain (crain_aero)
+ PCSNOW_AERO=-9.9, ! Below-cloud scavenging (particles) - Csnow (csnow_aero)
+ PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero)
+ PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero)
+ PDENSITY=-0.9E+9, ! Dry deposition (particles) - rho
+ PDQUER=0., ! Dry deposition (particles) - dquer
+ PDSIGMA=0., ! Dry deposition (particles) - dsig
+ PNDIA=1, ! Dry deposition (particles) - ndia
+ PDRYVEL=-9.9, ! Alternative: dry deposition velocity
+ PRELDIFF=1.6, ! Dry deposition (gases) - D
+ PHENRY=1.0E-2, ! Dry deposition (gases) - Henrys const.
+ PF0=1, ! Dry deposition (gases) - f0 (reactivity)
+ PWEIGHTMOLAR=48.0, ! molweight
+ POHCCONST=-0.9E-9, ! OH Reaction rate - C [cm^3/molecule/sec]
+ POHDCONST=-9.9, ! OH Reaction rate - D [K]
+ POHNCONST=2.0, ! OH Reaction rate - N (no unit)
+ /
diff --git a/options_lcm/SPECIES/SPECIES_003 b/options_lcm/SPECIES/SPECIES_003
new file mode 100644
index 0000000000000000000000000000000000000000..3df5f23c95c7778e2962877e8b33e34e82684bb3
--- /dev/null
+++ b/options_lcm/SPECIES/SPECIES_003
@@ -0,0 +1,22 @@
+&SPECIES_PARAMS
+ PSPECIES="NO", ! Tracer name
+ PDECAY=-9.9, ! Species half life
+ PWETA_GAS=8.0E-6, ! Below-cloud scavenging (gases) - A (weta_gas)
+ PWETB_GAS=0.62, ! Below-cloud scavenging (gases) - B (wetb_gas)
+ PCRAIN_AERO=-9.9, ! Below-cloud scavenging (particles) - Crain (crain_aero)
+ PCSNOW_AERO=-9.9, ! Below-cloud scavenging (particles) - Csnow (csnow_aero)
+ PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero)
+ PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero)
+ PDENSITY=-0.9E+9, ! Dry deposition (particles) - rho
+ PDQUER=0.0, ! Dry deposition (particles) - dquer
+ PDSIGMA=0.0, ! Dry deposition (particles) - dsig
+ PNDIA=1, ! Dry deposition (particles) - ndia
+ PDRYVEL=-9.99, ! Alternative: dry deposition velocity
+ PRELDIFF=1.2, ! Dry deposition (gases) - D
+ PHENRY=2.0E-03, ! Dry deposition (gases) - Henrys const.
+ PF0=0.0, ! Dry deposition (gases) - f0 (reactivity)
+ PWEIGHTMOLAR=30.0, ! molweight
+ POHCCONST=-0.9E+9, ! OH Reaction rate - C [cm^3/molecule/sec]
+ POHDCONST=-9.9 ! OH Reaction rate - D [K]
+ POHNCONST=2.0, ! OH Reaction rate - N (no unit)
+ /
diff --git a/options_lcm/SPECIES/SPECIES_004 b/options_lcm/SPECIES/SPECIES_004
new file mode 100644
index 0000000000000000000000000000000000000000..2fea08e601e305dc0d98e3a6f6c7fbe2320eb182
--- /dev/null
+++ b/options_lcm/SPECIES/SPECIES_004
@@ -0,0 +1,22 @@
+&SPECIES_PARAMS
+ PSPECIES="NO2", ! Tracer name
+ PDECAY=-9.9, ! Species half life
+ PWETA_GAS=1.0E-05, ! Below-cloud scavenging (gases) - A (weta_gas)
+ PWETB_GAS=0.62, ! Below-cloud scavenging (gases) - B (wetb_gas)
+ PCRAIN_AERO=-9.9, ! Below-cloud scavenging (particles) - Crain (crain_aero)
+ PCSNOW_AERO=-9.9, ! Below-cloud scavenging (particles) - Csnow (csnow_aero)
+ PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero)
+ PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero)
+ PDENSITY=-0.9E9, ! Dry deposition (particles) - rho
+ PDQUER=0.0, ! Dry deposition (particles) - dquer
+ PDSIGMA=0.0, ! Dry deposition (particles) - dsig
+ PNDIA=1, ! Dry deposition (particles) - ndia
+ PDRYVEL=-9.99, ! Alternative: dry deposition velocity
+ PRELDIFF=1.6, ! Dry deposition (gases) - D
+ PHENRY=1.0E-02, ! Dry deposition (gases) - Henrys const.
+ PF0=0.1, ! Dry deposition (gases) - f0 (reactivity)
+ PWEIGHTMOLAR=46.0, ! molweight
+ POHCCONST=-0.9E9, ! OH Reaction rate - C [cm^3/molecule/sec]
+ POHDCONST=-9.9, ! OH Reaction rate - D [K]
+ POHNCONST=2.0, ! OH Reaction rate - N (no unit)
+ /
diff --git a/options_lcm/SPECIES/SPECIES_005 b/options_lcm/SPECIES/SPECIES_005
new file mode 100644
index 0000000000000000000000000000000000000000..900a461cc8fbc924797f2f21e2e83c782adc5738
--- /dev/null
+++ b/options_lcm/SPECIES/SPECIES_005
@@ -0,0 +1,22 @@
+&SPECIES_PARAMS
+ PSPECIES="HNO3", ! Tracer name
+ PDECAY=-9.9, ! Species half life
+ PWETA_GAS=8.0E-04, ! Below-cloud scavenging (gases) - A (weta_gas)
+ PWETB_GAS=0.62, ! Below-cloud scavenging (gases) - B (wetb_gas)
+ PCRAIN_AERO=-9.9, ! Below-cloud scavenging (particles) - Crain (crain_aero)
+ PCSNOW_AERO=-9.9, ! Below-cloud scavenging (particles) - Csnow (csnow_aero)
+ PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero)
+ PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero)
+ PDENSITY=-0.9E+9, ! Dry deposition (particles) - rho
+ PDQUER=0.0, ! Dry deposition (particles) - dquer
+ PDSIGMA=0.0, ! Dry deposition (particles) - dsig
+ PNDIA=1, ! Dry deposition (particles) - ndia
+ PDRYVEL=-9.99, ! Alternative: dry deposition velocity
+ PRELDIFF=1.9, ! Dry deposition (gases) - D
+ PHENRY=1E14, ! Dry deposition (gases) - Henrys const.
+ PF0=0, ! Dry deposition (gases) - f0 (reactivity)
+ PWEIGHTMOLAR=63.0, ! molweight
+ POHCCONST=-0.9E+9, ! OH Reaction rate - C [cm^3/molecule/sec]
+ POHDCONST=-9.9, ! OH Reaction rate - D [K]
+ POHNCONST=2.0, ! OH Reaction rate - N (no unit)
+ /
diff --git a/options_lcm/SPECIES/SPECIES_006 b/options_lcm/SPECIES/SPECIES_006
new file mode 100644
index 0000000000000000000000000000000000000000..446441a69dd50bcbaf9b6c246f7f924538716087
--- /dev/null
+++ b/options_lcm/SPECIES/SPECIES_006
@@ -0,0 +1,22 @@
+&SPECIES_PARAMS
+ PSPECIES="HNO2", ! Tracer name
+ PDECAY=-9.9, ! Species half life
+ PWETA_GAS=-0.9E-9, ! Below-cloud scavenging (gases) - A (weta_gas)
+ PWETB_GAS=-9.9, ! Below-cloud scavenging (gases) - B (wetb_gas)
+ PCRAIN_AERO=-9.9, ! Below-cloud scavenging (particles) - Crain (crain_aero)
+ PCSNOW_AERO=-9.9, ! Below-cloud scavenging (particles) - Csnow (csnow_aero)
+ PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero)
+ PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero)
+ PDENSITY=-0.9E+9, ! Dry deposition (particles) - rho
+ PDQUER=0.0, ! Dry deposition (particles) - dquer
+ PDSIGMA=0.0, ! Dry deposition (particles) - dsig
+ PNDIA=1, ! Dry deposition (particles) - ndia
+ PDRYVEL=-9.99, ! Alternative: dry deposition velocity
+ PRELDIFF=1.6, ! Dry deposition (gases) - D
+ PHENRY=100000.0, ! Dry deposition (gases) - Henrys const.
+ PF0=.1, ! Dry deposition (gases) - f0 (reactivity)
+ PWEIGHTMOLAR=47.0, ! molweight
+ POHCCONST=-0.9E+9, ! OH Reaction rate - C [cm^3/molecule/sec]
+ POHDCONST=-9.9, ! OH Reaction rate - D [K]
+ POHNCONST=2.0, ! OH Reaction rate - N (no unit)
+ /
diff --git a/options_lcm/SPECIES/SPECIES_007 b/options_lcm/SPECIES/SPECIES_007
new file mode 100644
index 0000000000000000000000000000000000000000..362ff3ae308077ce499379d474c950f119b40a64
--- /dev/null
+++ b/options_lcm/SPECIES/SPECIES_007
@@ -0,0 +1,22 @@
+&SPECIES_PARAMS
+ PSPECIES="H2O2", ! Tracer name
+ PDECAY=-9.9, ! Species half life
+ PWETA_GAS=1.0E-04, ! Below-cloud scavenging (gases) - A (weta_gas)
+ PWETB_GAS=0.62, ! Below-cloud scavenging (gases) - B (wetb_gas)
+ PCRAIN_AERO=-9.9, ! Below-cloud scavenging (particles) - Crain (crain_aero)
+ PCSNOW_AERO=-9.9, ! Below-cloud scavenging (particles) - Csnow (csnow_aero)
+ PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero)
+ PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero)
+ PDENSITY=-0.9E+9, ! Dry deposition (particles) - rho
+ PDQUER=0.0, ! Dry deposition (particles) - dquer
+ PDSIGMA=0.0, ! Dry deposition (particles) - dsig
+ PNDIA=1, ! Dry deposition (particles) - ndia
+ PDRYVEL=-9.99, ! Alternative: dry deposition velocity
+ PRELDIFF=1.4, ! Dry deposition (gases) - D
+ PHENRY=100000.0, ! Dry deposition (gases) - Henrys const.
+ PF0=1.0, ! Dry deposition (gases) - f0 (reactivity)
+ PWEIGHTMOLAR=34.0, ! molweight
+ POHCCONST=-0.9E+9, ! OH Reaction rate - C [cm^3/molecule/sec]
+ POHDCONST=-9.9, ! OH Reaction rate - D [K]
+ POHNCONST=2.0, ! OH Reaction rate - N (no unit)
+ /
diff --git a/options_lcm/SPECIES/SPECIES_008 b/options_lcm/SPECIES/SPECIES_008
new file mode 100644
index 0000000000000000000000000000000000000000..5c49b9b07ca682b503881893aa1c5e4506e21259
--- /dev/null
+++ b/options_lcm/SPECIES/SPECIES_008
@@ -0,0 +1,26 @@
+&SPECIES_PARAMS
+ PSPECIES="NO2", ! Tracer name
+ PDECAY=-9.9, ! Species half life
+ PWETA_GAS=1.0E-05, ! Below-cloud scavenging (gases) - A (weta_gas)
+ PWETB_GAS=0.62, ! Below-cloud scavenging (gases) - B (wetb_gas)
+ PCRAIN_AERO=-9.9, ! Below-cloud scavenging (particles) - Crain (crain_aero)
+ PCSNOW_AERO=-9.9, ! Below-cloud scavenging (particles) - Csnow (csnow_aero)
+ PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero)
+ PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero)
+ PDENSITY=-0.9E9, ! Dry deposition (particles) - rho
+ PDQUER=0.0, ! Dry deposition (particles) - dquer
+ PDSIGMA=0.0, ! Dry deposition (particles) - dsig
+ PNDIA=1, ! Dry deposition (particles) - ndia
+ PDRYVEL=-9.99, ! Alternative: dry deposition velocity
+ PRELDIFF=1.6, ! Dry deposition (gases) - D
+ PHENRY=1.0E-02, ! Dry deposition (gases) - Henrys const.
+ PF0=0.1, ! Dry deposition (gases) - f0 (reactivity)
+ PWEIGHTMOLAR=46.0, ! molweight
+ POHCCONST=-0.9E9, ! OH Reaction rate - C [cm^3/molecule/sec]
+ POHDCONST=-9.9, ! OH Reaction rate - D [K]
+ POHNCONST=2.0, ! OH Reaction rate - N (no unit)
+ PAREA_HOUR=0.578, 0.491, 0.428, 0.329, 0.384, 0.485, 0.763, 1.103, 1.084, 1.047, 1.096, 1.196, 1.298, 1.357, 1.447, 1.565, 1.636, 1.662, 1.401, 1.168, 1.031, 0.926, 0.816, 0.709,
+ PPOINT_HOUR=0.845, 0.806, 0.786, 0.779, 0.793, 0.832, 0.895, 0.977, 1.031, 1.071, 1.105, 1.118, 1.131, 1.136, 1.143, 1.141, 1.133, 1.118, 1.097, 1.091, 1.079, 1.036, 0.966, 0.892,
+ PAREA_DOW=1.060, 1.060, 1.060, 1.060, 1.060, 0.900, 0.000,
+ PPOINT_DOW=1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000,
+ /
diff --git a/options_lcm/SPECIES/SPECIES_009 b/options_lcm/SPECIES/SPECIES_009
new file mode 100644
index 0000000000000000000000000000000000000000..b15e09554361536c1c8b32906e52bbe191879843
--- /dev/null
+++ b/options_lcm/SPECIES/SPECIES_009
@@ -0,0 +1,22 @@
+&SPECIES_PARAMS
+ PSPECIES="HCHO", ! Tracer name
+ PDECAY=-9.9, ! Species half life
+ PWETA_GAS=-0.9E-9, ! Below-cloud scavenging (gases) - A (weta_gas)
+ PWETB_GAS=-9.9, ! Below-cloud scavenging (gases) - B (wetb_gas)
+ PCRAIN_AERO=-9.9, ! Below-cloud scavenging (particles) - Crain (crain_aero)
+ PCSNOW_AERO=-9.9, ! Below-cloud scavenging (particles) - Csnow (csnow_aero)
+ PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero)
+ PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero)
+ PDENSITY=-0.9E+9, ! Dry deposition (particles) - rho
+ PDQUER=0.0, ! Dry deposition (particles) - dquer
+ PDSIGMA=0.0, ! Dry deposition (particles) - dsig
+ PNDIA=1, ! Dry deposition (particles) - ndia
+ PDRYVEL=-9.99, ! Alternative: dry deposition velocity
+ PRELDIFF=1,3, ! Dry deposition (gases) - D
+ PHENRY=6000.0, ! Dry deposition (gases) - Henrys const.
+ PF0=-9, ! Dry deposition (gases) - f0 (reactivity)
+ PWEIGHTMOLAR=30.0, ! molweight
+ POHCCONST=-0.9E+9, ! OH Reaction rate - C [cm^3/molecule/sec]
+ POHDCONST=-9.9, ! OH Reaction rate - D [K]
+ POHNCONST=2.0, ! OH Reaction rate - N (no unit)
+ /
diff --git a/options_lcm/SPECIES/SPECIES_010 b/options_lcm/SPECIES/SPECIES_010
new file mode 100644
index 0000000000000000000000000000000000000000..2fb4e88d6d5a676b86bafbf6e796ea6aa536372f
--- /dev/null
+++ b/options_lcm/SPECIES/SPECIES_010
@@ -0,0 +1,22 @@
+&SPECIES_PARAMS
+ PSPECIES="PAN", ! Tracer name
+ PDECAY=-9.9, ! Species half life
+ PWETA_GAS=-0.9E-9, ! Below-cloud scavenging (gases) - A (weta_gas)
+ PWETB_GAS=-9.9, ! Below-cloud scavenging (gases) - B (wetb_gas)
+ PCRAIN_AERO=-9.9, ! Below-cloud scavenging (particles) - Crain (crain_aero)
+ PCSNOW_AERO=-9.9, ! Below-cloud scavenging (particles) - Csnow (csnow_aero)
+ PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero)
+ PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero)
+ PDENSITY=-0.9E+9, ! Dry deposition (particles) - rho
+ PDQUER=0.0, ! Dry deposition (particles) - dquer
+ PDSIGMA=0.0, ! Dry deposition (particles) - dsig
+ PNDIA=1, ! Dry deposition (particles) - ndia
+ PDRYVEL=-9.99, ! Alternative: dry deposition velocity
+ PRELDIFF=2.6, ! Dry deposition (gases) - D
+ PHENRY=3.6, ! Dry deposition (gases) - Henrys const.
+ PF0=0.1, ! Dry deposition (gases) - f0 (reactivity)
+ PWEIGHTMOLAR=121.0, ! molweight
+ POHCCONST=-0.9E+9, ! OH Reaction rate - C [cm^3/molecule/sec]
+ POHDCONST=-9.9, ! OH Reaction rate - D [K]
+ POHNCONST=2.0, ! OH Reaction rate - N (no unit)
+ /
diff --git a/options_lcm/SPECIES/SPECIES_011 b/options_lcm/SPECIES/SPECIES_011
new file mode 100644
index 0000000000000000000000000000000000000000..371c515e066acf5aa270eca7071d3565b2f37a46
--- /dev/null
+++ b/options_lcm/SPECIES/SPECIES_011
@@ -0,0 +1,22 @@
+&SPECIES_PARAMS
+ PSPECIES="NH3", ! Tracer name
+ PDECAY=-9.9, ! Species half life
+ PWETA_GAS=9.9E-05, ! Below-cloud scavenging (gases) - A (weta_gas)
+ PWETB_GAS=0.62, ! Below-cloud scavenging (gases) - B (wetb_gas)
+ PCRAIN_AERO=-9.9, ! Below-cloud scavenging (particles) - Crain (crain_aero)
+ PCSNOW_AERO=-9.9, ! Below-cloud scavenging (particles) - Csnow (csnow_aero)
+ PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero)
+ PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero)
+ PDENSITY=-0.9E+9, ! Dry deposition (particles) - rho
+ PDQUER=0.0, ! Dry deposition (particles) - dquer
+ PDSIGMA=0.0, ! Dry deposition (particles) - dsig
+ PNDIA=1, ! Dry deposition (particles) - ndia
+ PDRYVEL=-9.99, ! Alternative: dry deposition velocity
+ PRELDIFF=1.1, ! Dry deposition (gases) - D
+ PHENRY=2.0E14, ! Dry deposition (gases) - Henrys const.
+ PF0=0.0, ! Dry deposition (gases) - f0 (reactivity)
+ PWEIGHTMOLAR=17.0, ! molweight
+ POHCCONST=-0.9E+9, ! OH Reaction rate - C [cm^3/molecule/sec]
+ POHDCONST=-9.9, ! OH Reaction rate - D [K]
+ POHNCONST=2.0, ! OH Reaction rate - N (no unit)
+ /
diff --git a/options_lcm/SPECIES/SPECIES_012 b/options_lcm/SPECIES/SPECIES_012
new file mode 100644
index 0000000000000000000000000000000000000000..d4bd4ac24b38100229c704304ae96b6c0c33c4df
--- /dev/null
+++ b/options_lcm/SPECIES/SPECIES_012
@@ -0,0 +1,22 @@
+&SPECIES_PARAMS
+ PSPECIES="SO4-aero", ! Tracer name
+ PDECAY=-9.9, ! Species half life
+ PWETA_GAS=-0.9E-9, ! Below-cloud scavenging (gases) - A (weta_gas)
+ PWETB_GAS=-9.9, ! Below-cloud scavenging (gases) - B (wetb_gas)
+ PCRAIN_AERO=1.0, ! Below-cloud scavenging (particles) - Crain (crain_aero)
+ PCSNOW_AERO=1.0, ! Below-cloud scavenging (particles) - Csnow (csnow_aero)
+ PCCN_AERO=0.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero)
+ PIN_AERO=0.1, ! In-cloud scavenging (particles) - INeff (in_aero)
+ PDENSITY=2000.0, ! Dry deposition (particles) - rho
+ PDQUER=4.0E-07, ! Dry deposition (particles) - dquer
+ PDSIGMA=3.3, ! Dry deposition (particles) - dsig
+ PNDIA=1, ! Dry deposition (particles) - ndia
+ PDRYVEL=-9.99, ! Alternative: dry deposition velocity
+ PRELDIFF=-9.9, ! Dry deposition (gases) - D
+ PHENRY=-0.9E+9, ! Dry deposition (gases) - Henrys const.
+ PF0=-9, ! Dry deposition (gases) - f0 (reactivity)
+ PWEIGHTMOLAR=-9.9, ! molweight
+ POHCCONST=-0.9E+9, ! OH Reaction rate - C [cm^3/molecule/sec]
+ POHDCONST=-9.9, ! OH Reaction rate - D [K]
+ POHNCONST=2.0, ! OH Reaction rate - N (no unit)
+ /
diff --git a/options_lcm/SPECIES/SPECIES_013 b/options_lcm/SPECIES/SPECIES_013
new file mode 100644
index 0000000000000000000000000000000000000000..21da254fcdd378f610aca68f96f3c5af9b20ba01
--- /dev/null
+++ b/options_lcm/SPECIES/SPECIES_013
@@ -0,0 +1,22 @@
+&SPECIES_PARAMS
+ PSPECIES="NO3-aero", ! Tracer name
+ PDECAY=-9.9, ! Species half life
+ PWETA_GAS=-0.9E-9, ! Below-cloud scavenging (gases) - A (weta_gas)
+ PWETB_GAS=-9.9, ! Below-cloud scavenging (gases) - B (wetb_gas)
+ PCRAIN_AERO=1.0, ! Below-cloud scavenging (particles) - Crain (crain_aero)
+ PCSNOW_AERO=1.0, ! Below-cloud scavenging (particles) - Csnow (csnow_aero)
+ PCCN_AERO=0.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero)
+ PIN_AERO=0.1, ! In-cloud scavenging (particles) - INeff (in_aero)
+ PDENSITY=2.0E+3, ! Dry deposition (particles) - rho
+ PDQUER=4.0E-07, ! Dry deposition (particles) - dquer
+ PDSIGMA=3.3, ! Dry deposition (particles) - dsig
+ PNDIA=1, ! Dry deposition (particles) - ndia
+ PDRYVEL=-9.99, ! Alternative: dry deposition velocity
+ PRELDIFF=-9.9, ! Dry deposition (gases) - D
+ PHENRY=-0.9E+9, ! Dry deposition (gases) - Henrys const.
+ PF0=-9, ! Dry deposition (gases) - f0 (reactivity)
+ PWEIGHTMOLAR=-9.9, ! molweight
+ POHCCONST=-0.9E+9, ! OH Reaction rate - C [cm^3/molecule/sec]
+ POHDCONST=-9.9, ! OH Reaction rate - D [K]
+ POHNCONST=2.0, ! OH Reaction rate - N (no unit)
+ /
diff --git a/options_lcm/SPECIES/SPECIES_014 b/options_lcm/SPECIES/SPECIES_014
new file mode 100644
index 0000000000000000000000000000000000000000..5ad9079085e99f49c04992745030961373892f70
--- /dev/null
+++ b/options_lcm/SPECIES/SPECIES_014
@@ -0,0 +1,22 @@
+&SPECIES_PARAMS
+ PSPECIES="I2-131", ! Tracer name
+ PDECAY=691200.0, ! Species half life
+ PWETA_GAS=8.0E-05, ! Below-cloud scavenging (gases) - A (weta_gas)
+ PWETB_GAS=0.62, ! Below-cloud scavenging (gases) - B (wetb_gas)
+ PCRAIN_AERO=-9.9, ! Below-cloud scavenging (particles) - Crain (crain_aero)
+ PCSNOW_AERO=-9.9, ! Below-cloud scavenging (particles) - Csnow (csnow_aero)
+ PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero)
+ PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero)
+ PDENSITY=-0.9E+9, ! Dry deposition (particles) - rho
+ PDQUER=0.0, ! Dry deposition (particles) - dquer
+ PDSIGMA=0.0, ! Dry deposition (particles) - dsig
+ PNDIA=1, ! Dry deposition (particles) - ndia
+ PDRYVEL=-9.99, ! Alternative: dry deposition velocity
+ PRELDIFF=2.7, ! Dry deposition (gases) - D
+ PHENRY=100000.0, ! Dry deposition (gases) - Henrys const.
+ PF0=0.1, ! Dry deposition (gases) - f0 (reactivity)
+ PWEIGHTMOLAR=-9.9, ! molweight
+ POHCCONST=-0.9E-9, ! OH Reaction rate - C [cm^3/molecule/sec]
+ POHDCONST=-9.9, ! OH Reaction rate - D [K]
+ POHNCONST=2.0, ! OH Reaction rate - N (no unit)
+ /
diff --git a/options_lcm/SPECIES/SPECIES_015 b/options_lcm/SPECIES/SPECIES_015
new file mode 100644
index 0000000000000000000000000000000000000000..d8fad0fa33f09a980ad5fe4ada8ec27d60bcf51a
--- /dev/null
+++ b/options_lcm/SPECIES/SPECIES_015
@@ -0,0 +1,22 @@
+&SPECIES_PARAMS
+ PSPECIES="I-131", ! Tracer name
+ PDECAY=691200.0, ! Species half life
+ PWETA_GAS=-0.9E-9, ! Below-cloud scavenging (gases) - A (weta_gas)
+ PWETB_GAS=-9.9, ! Below-cloud scavenging (gases) - B (wetb_gas)
+ PCRAIN_AERO=1.0, ! Below-cloud scavenging (particles) - Crain (crain_aero)
+ PCSNOW_AERO=1.0, ! Below-cloud scavenging (particles) - Csnow (csnow_aero)
+ PCCN_AERO=0.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero)
+ PIN_AERO=0.1, ! In-cloud scavenging (particles) - INeff (in_aero)
+ PDENSITY=2500.0, ! Dry deposition (particles) - rho
+ PDQUER=6.0E-07, ! Dry deposition (particles) - dquer
+ PDSIGMA=3.3, ! Dry deposition (particles) - dsig
+ PNDIA=1, ! Dry deposition (particles) - ndia
+ PDRYVEL=-9.99, ! Alternative: dry deposition velocity
+ PRELDIFF=-9.9, ! Dry deposition (gases) - D
+ PHENRY=-9.9, ! Dry deposition (gases) - Henrys const.
+ PF0=-9, ! Dry deposition (gases) - f0 (reactivity)
+ PWEIGHTMOLAR=350.0, ! molweight
+ POHCCONST=-0.9E-9, ! OH Reaction rate - C [cm^3/molecule/sec]
+ POHDCONST=-9.9, ! OH Reaction rate - D [K]
+ POHNCONST=2.0, ! OH Reaction rate - N (no unit)
+ /
diff --git a/options_lcm/SPECIES/SPECIES_016 b/options_lcm/SPECIES/SPECIES_016
new file mode 100644
index 0000000000000000000000000000000000000000..fad26c579c2d9f2f78968e1698d73d3fa88e0350
--- /dev/null
+++ b/options_lcm/SPECIES/SPECIES_016
@@ -0,0 +1,22 @@
+&SPECIES_PARAMS
+ PSPECIES="Cs-137", ! Tracer name
+ PDECAY=-9.9, ! Species half life
+ PWETA_GAS=-0.9E-9, ! Below-cloud scavenging (gases) - A (weta_gas)
+ PWETB_GAS=-9.9, ! Below-cloud scavenging (gases) - B (wetb_gas)
+ PCRAIN_AERO=1.0, ! Below-cloud scavenging (particles) - Crain (crain_aero)
+ PCSNOW_AERO=1.0, ! Below-cloud scavenging (particles) - Csnow (csnow_aero)
+ PCCN_AERO=0.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero)
+ PIN_AERO=0.9, ! In-cloud scavenging (particles) - INeff (in_aero)
+ PDENSITY=1900.0, ! Dry deposition (particles) - rho
+ PDQUER=0.4E-06, ! Dry deposition (particles) - dquer
+ PDSIGMA=3.3, ! Dry deposition (particles) - dsig
+ PNDIA=1, ! Dry deposition (particles) - ndia
+ PDRYVEL=-9.99, ! Alternative: dry deposition velocity
+ PRELDIFF=-9.9, ! Dry deposition (gases) - D
+ PHENRY=-0.9E-9, ! Dry deposition (gases) - Henrys const.
+ PF0=-9, ! Dry deposition (gases) - f0 (reactivity)
+ PWEIGHTMOLAR=-9.9, ! molweight
+ POHCCONST=-0.9E-9, ! OH Reaction rate - C [cm^3/molecule/sec]
+ POHDCONST=-9.9, ! OH Reaction rate - D [K]
+ POHNCONST=2.0, ! OH Reaction rate - N (no unit)
+ /
diff --git a/options_lcm/SPECIES/SPECIES_017 b/options_lcm/SPECIES/SPECIES_017
new file mode 100644
index 0000000000000000000000000000000000000000..54d9aec279df0b46b9fbc29ea9e4736b776be20e
--- /dev/null
+++ b/options_lcm/SPECIES/SPECIES_017
@@ -0,0 +1,23 @@
+&SPECIES_PARAMS
+ PSPECIES="Y-91", ! Tracer name
+ PDECAY=5037120.0, ! Species half life
+ PWETA_GAS=-0.9E-9, ! Below-cloud scavenging (gases) - A (weta_gas)
+ PWETB_GAS=-9.9, ! Below-cloud scavenging (gases) - B (wetb_gas)
+ PCRAIN_AERO=1.0, ! Below-cloud scavenging (particles) - Crain (crain_aero)
+ PCSNOW_AERO=1.0, ! Below-cloud scavenging (particles) - Csnow (csnow_aero)
+ PCCN_AERO=0.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero)
+ PIN_AERO=0.1, ! In-cloud scavenging (particles) - INeff (in_aero)
+ PDENSITY=2500.0, ! Dry deposition (particles) - rho
+ PDQUER=6.0E-07, ! Dry deposition (particles) - dquer
+ PDSIGMA=3.3, ! Dry deposition (particles) - dsig
+ PNDIA=1, ! Dry deposition (particles) - ndia
+ PNDIA=1, ! Dry deposition (particles) - ndia
+ PDRYVEL=-9.99, ! Alternative: dry deposition velocity
+ PRELDIFF=-9.9, ! Dry deposition (gases) - D
+ PHENRY=-0.9E-9, ! Dry deposition (gases) - Henrys const.
+ PF0=-9.0, ! Dry deposition (gases) - f0 (reactivity)
+ PWEIGHTMOLAR=350.0, ! molweight
+ POHCCONST=-0.9E-9, ! OH Reaction rate - C [cm^3/molecule/sec]
+ POHDCONST=-9.9, ! OH Reaction rate - D [K]
+ POHNCONST=2.0, ! OH Reaction rate - N (no unit)
+ /
diff --git a/options_lcm/SPECIES/SPECIES_018 b/options_lcm/SPECIES/SPECIES_018
new file mode 100644
index 0000000000000000000000000000000000000000..e10df5743d8b18d2d5732006eba361ef5f60ee9b
--- /dev/null
+++ b/options_lcm/SPECIES/SPECIES_018
@@ -0,0 +1,22 @@
+&SPECIES_PARAMS
+ PSPECIES="Ru-106", ! Tracer name
+ PDECAY=31536000.0, ! Species half life
+ PWETA_GAS=-0.9E-9, ! Below-cloud scavenging (gases) - A (weta_gas)
+ PWETB_GAS=-9.9, ! Below-cloud scavenging (gases) - B (wetb_gas)
+ PCRAIN_AERO=1.0, ! Below-cloud scavenging (particles) - Crain (crain_aero)
+ PCSNOW_AERO=1.0, ! Below-cloud scavenging (particles) - Csnow (csnow_aero)
+ PCCN_AERO=0.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero)
+ PIN_AERO=0.1, ! In-cloud scavenging (particles) - INeff (in_aero)
+ PDENSITY=2500.0, ! Dry deposition (particles) - rho
+ PDQUER=6.0E-07, ! Dry deposition (particles) - dquer
+ PDSIGMA=3.3, ! Dry deposition (particles) - dsig
+ PNDIA=1, ! Dry deposition (particles) - ndia
+ PDRYVEL=-9.99, ! Alternative: dry deposition velocity
+ PRELDIFF=-9.9, ! Dry deposition (gases) - D
+ PHENRY=-0.9E-9, ! Dry deposition (gases) - Henrys const.
+ PF0=-9, ! Dry deposition (gases) - f0 (reactivity)
+ PWEIGHTMOLAR=350.0, ! molweight
+ POHCCONST=-0.9E-9, ! OH Reaction rate - C [cm^3/molecule/sec]
+ POHDCONST=-9.9, ! OH Reaction rate - D [K]
+ POHNCONST=2.0, ! OH Reaction rate - N (no unit)
+ /
diff --git a/options_lcm/SPECIES/SPECIES_019 b/options_lcm/SPECIES/SPECIES_019
new file mode 100644
index 0000000000000000000000000000000000000000..76cc9868d03c2f8c36fce39d402bb6b337a5bca2
--- /dev/null
+++ b/options_lcm/SPECIES/SPECIES_019
@@ -0,0 +1,22 @@
+&SPECIES_PARAMS
+ PSPECIES="Kr-85", ! Tracer name
+ PDECAY=-9.9, ! Species half life
+ PWETA_GAS=-0.9E-9, ! Below-cloud scavenging (gases) - A (weta_gas)
+ PWETB_GAS=-9.9, ! Below-cloud scavenging (gases) - B (wetb_gas)
+ PCRAIN_AERO=-9.9, ! Below-cloud scavenging (particles) - Crain (crain_aero)
+ PCSNOW_AERO=-9.9, ! Below-cloud scavenging (particles) - Csnow (csnow_aero)
+ PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero)
+ PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero)
+ PDENSITY=-0.9E+9, ! Dry deposition (particles) - rho
+ PDQUER=0.0, ! Dry deposition (particles) - dquer
+ PDSIGMA=0.0, ! Dry deposition (particles) - dsig
+ PNDIA=1, ! Dry deposition (particles) - ndia
+ PDRYVEL=-9.99, ! Alternative: dry deposition velocity
+ PRELDIFF=-9.9, ! Dry deposition (gases) - D
+ PHENRY=-0.9E-9, ! Dry deposition (gases) - Henrys const.
+ PF0=-9, ! Dry deposition (gases) - f0 (reactivity)
+ PWEIGHTMOLAR=83.8, ! molweight
+ POHCCONST=-0.9E-9, ! OH Reaction rate - C [cm^3/molecule/sec]
+ POHDCONST=-9.9, ! OH Reaction rate - D [K]
+ POHNCONST=2.0, ! OH Reaction rate - N (no unit)
+ /
diff --git a/options_lcm/SPECIES/SPECIES_020 b/options_lcm/SPECIES/SPECIES_020
new file mode 100644
index 0000000000000000000000000000000000000000..17dafa57ed84681ac468be1008e35d7551a6829a
--- /dev/null
+++ b/options_lcm/SPECIES/SPECIES_020
@@ -0,0 +1,22 @@
+&SPECIES_PARAMS
+ PSPECIES="Sr-90", ! Tracer name
+ PDECAY=-9.9, ! Species half life
+ PWETA_GAS=-0.9E-9, ! Below-cloud scavenging (gases) - A (weta_gas)
+ PWETB_GAS=-9.9, ! Below-cloud scavenging (gases) - B (wetb_gas)
+ PCRAIN_AERO=1.0, ! Below-cloud scavenging (particles) - Crain (crain_aero)
+ PCSNOW_AERO=1.0, ! Below-cloud scavenging (particles) - Csnow (csnow_aero)
+ PCCN_AERO=0.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero)
+ PIN_AERO=0.1, ! In-cloud scavenging (particles) - INeff (in_aero)
+ PDENSITY=2500.0, ! Dry deposition (particles) - rho
+ PDQUER=6.0E-07, ! Dry deposition (particles) - dquer
+ PDSIGMA=3.3, ! Dry deposition (particles) - dsig
+ PNDIA=1, ! Dry deposition (particles) - ndia
+ PDRYVEL=-9.99, ! Alternative: dry deposition velocity
+ PRELDIFF=-9.9, ! Dry deposition (gases) - D
+ PHENRY=-0.9E-9, ! Dry deposition (gases) - Henrys const.
+ PF0=-9, ! Dry deposition (gases) - f0 (reactivity)
+ PWEIGHTMOLAR=-9.9, ! molweight
+ POHCCONST=-0.9E-9, ! OH Reaction rate - C [cm^3/molecule/sec]
+ POHDCONST=-9.9, ! OH Reaction rate - D [K]
+ POHNCONST=2.0, ! OH Reaction rate - N (no unit)
+ /
diff --git a/options_lcm/SPECIES/SPECIES_021 b/options_lcm/SPECIES/SPECIES_021
new file mode 100644
index 0000000000000000000000000000000000000000..4d89b6c7b82b42f59f48d30a1aaea7bc709af386
--- /dev/null
+++ b/options_lcm/SPECIES/SPECIES_021
@@ -0,0 +1,22 @@
+&SPECIES_PARAMS
+ PSPECIES="Xe-133", ! Tracer name
+ PDECAY=453168.0, ! Species half life
+ PWETA_GAS=-0.9E-9, ! Below-cloud scavenging (gases) - A (weta_gas)
+ PWETB_GAS=-9.9, ! Below-cloud scavenging (gases) - B (wetb_gas)
+ PCRAIN_AERO=-9.9, ! Below-cloud scavenging (particles) - Crain (crain_aero)
+ PCSNOW_AERO=-9.9, ! Below-cloud scavenging (particles) - Csnow (csnow_aero)
+ PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero)
+ PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero)
+ PDENSITY=-0.9E+9, ! Dry deposition (particles) - rho
+ PDQUER=0.0, ! Dry deposition (particles) - dquer
+ PDSIGMA=0.0, ! Dry deposition (particles) - dsig
+ PNDIA=1, ! Dry deposition (particles) - ndia
+ PDRYVEL=-9.99, ! Alternative: dry deposition velocity
+ PRELDIFF=-9.9, ! Dry deposition (gases) - D
+ PHENRY=-0.9E-9, ! Dry deposition (gases) - Henrys const.
+ PF0=-9, ! Dry deposition (gases) - f0 (reactivity)
+ PWEIGHTMOLAR=-9.9, ! molweight
+ POHCCONST=-0.9E-9, ! OH Reaction rate - C [cm^3/molecule/sec]
+ POHDCONST=-9.9, ! OH Reaction rate - D [K]
+ POHNCONST=2.0, ! OH Reaction rate - N (no unit)
+ /
diff --git a/options_lcm/SPECIES/SPECIES_022 b/options_lcm/SPECIES/SPECIES_022
new file mode 100644
index 0000000000000000000000000000000000000000..50accc0769f96843b96d488b588d3cb095b9528b
--- /dev/null
+++ b/options_lcm/SPECIES/SPECIES_022
@@ -0,0 +1,22 @@
+&SPECIES_PARAMS
+ PSPECIES="CO", ! Tracer name
+ PDECAY=-9.9, ! Species half life
+ PWETA_GAS=-0.9E-9, ! Below-cloud scavenging (gases) - A (weta_gas)
+ PWETB_GAS=-9.9, ! Below-cloud scavenging (gases) - B (wetb_gas)
+ PCRAIN_AERO=-9.9, ! Below-cloud scavenging (particles) - Crain (crain_aero)
+ PCSNOW_AERO=-9.9, ! Below-cloud scavenging (particles) - Csnow (csnow_aero)
+ PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero)
+ PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero)
+ PDENSITY=-0.9E+9, ! Dry deposition (particles) - rho
+ PDQUER=0.0, ! Dry deposition (particles) - dquer
+ PDSIGMA=0.0, ! Dry deposition (particles) - dsig
+ PNDIA=1, ! Dry deposition (particles) - ndia
+ PDRYVEL=-9.99, ! Alternative: dry deposition velocity
+ PRELDIFF=-9.9, ! Dry deposition (gases) - D
+ PHENRY=-0.9E-9, ! Dry deposition (gases) - Henrys const.
+ PF0=-9, ! Dry deposition (gases) - f0 (reactivity)
+ PWEIGHTMOLAR=28.0, ! molweight
+ POHCCONST=-0.9E-9, ! OH Reaction rate - C [cm^3/molecule/sec]
+ POHDCONST=-9.9, ! OH Reaction rate - D [K]
+ POHNCONST=2.0, ! OH Reaction rate - N (no unit)
+ /
diff --git a/options_lcm/SPECIES/SPECIES_023 b/options_lcm/SPECIES/SPECIES_023
new file mode 100644
index 0000000000000000000000000000000000000000..12461e766ff8be1afa78632dc81dac228cbfdde3
--- /dev/null
+++ b/options_lcm/SPECIES/SPECIES_023
@@ -0,0 +1,22 @@
+&SPECIES_PARAMS
+ PSPECIES="SO2", ! Tracer name
+ PDECAY=-9.9, ! Species half life
+ PWETA_GAS=2.0E-05, ! Below-cloud scavenging (gases) - A (weta_gas)
+ PWETB_GAS=0.62, ! Below-cloud scavenging (gases) - B (wetb_gas)
+ PCRAIN_AERO=-9.9, ! Below-cloud scavenging (particles) - Crain (crain_aero)
+ PCSNOW_AERO=-9.9, ! Below-cloud scavenging (particles) - Csnow (csnow_aero)
+ PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero)
+ PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero)
+ PDENSITY=-0.9E-9, ! Dry deposition (particles) - rho
+ PDQUER=0.0, ! Dry deposition (particles) - dquer
+ PDSIGMA=0.0, ! Dry deposition (particles) - dsig
+ PNDIA=1, ! Dry deposition (particles) - ndia
+ PDRYVEL=-9.99, ! Alternative: dry deposition velocity
+ PRELDIFF=2.0, ! Dry deposition (gases) - D
+ PHENRY=100000.0, ! Dry deposition (gases) - Henrys const.
+ PF0=0, ! Dry deposition (gases) - f0 (reactivity)
+ PWEIGHTMOLAR=64.0, ! molweight
+ POHCCONST=-0.9E-9, ! OH Reaction rate - C [cm^3/molecule/sec]
+ POHDCONST=-9.9, ! OH Reaction rate - D [K]
+ POHNCONST=2.0, ! OH Reaction rate - N (no unit)
+ /
diff --git a/options_lcm/SPECIES/SPECIES_024 b/options_lcm/SPECIES/SPECIES_024
new file mode 100644
index 0000000000000000000000000000000000000000..66be1f66795725feb32e198b20b9540de7e4b8e0
--- /dev/null
+++ b/options_lcm/SPECIES/SPECIES_024
@@ -0,0 +1,27 @@
+&SPECIES_PARAMS
+ PSPECIES="AIRTRACER", ! Tracer name
+ PDECAY=-9.9, ! Species half life
+ PWETA_GAS=-0.9E-9, ! Below-cloud scavenging (gases) - A (weta_gas)
+ PWETB_GAS=-9.9, ! Below-cloud scavenging (gases) - B (wetb_gas)
+ PCRAIN_AERO=-9.9, ! Below-cloud scavenging (particles) - Crain (crain_aero)
+ PCSNOW_AERO=-9.9, ! Below-cloud scavenging (particles) - Csnow (csnow_aero)
+ PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero)
+ PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero)
+ PDENSITY=-0.9E+9, ! Dry deposition (particles) - rho
+ PDQUER=0.0, ! Dry deposition (particles) - dquer
+ PDSIGMA=0.0, ! Dry deposition (particles) - dsig
+ PDRYVEL=-9.99, ! Alternative: dry deposition velocity
+ PRELDIFF=-9.9, ! Dry deposition (gases) - D
+ PHENRY=-0.9E-9, ! Dry deposition (gases) - Henrys const.
+ PF0=-9, ! Dry deposition (gases) - f0 (reactivity)
+ PWEIGHTMOLAR=29.0, ! molweight
+ PREACTIONS="", ! List of reactions (must correspond to names in REAGENTS)
+ PCCONST=-9.99E-9, ! List of reaction rates C [cm^3/molecule/sec] (in order of PREACTIONS)
+ PDCONST=-9.99, ! List of reaction rates D [K] (in order of PREACTIONS)
+ PNCONST=-9.99, ! List of reaction rates N (no unit) (in order of PREACTIONS)
+ PEMIS_PATH="", ! Emissions path (if empty no emission)
+ PEMIS_FILE="", ! Generic file name for emissions (if empty no emission)
+ PEMIS_NAME="", ! Variable name for emissions (if empty no emission)
+ PEMIS_UNIT=1, ! 0 [per gridcell], 1 [per m^2]
+ PEMIS_COEFF=1., ! Coefficient to convert from emission input unit to kg/s
+ /
diff --git a/options_lcm/SPECIES/SPECIES_025 b/options_lcm/SPECIES/SPECIES_025
new file mode 100644
index 0000000000000000000000000000000000000000..f41666a29cdb623ab9294586dadcf8e7cfc3d4e7
--- /dev/null
+++ b/options_lcm/SPECIES/SPECIES_025
@@ -0,0 +1,22 @@
+&SPECIES_PARAMS
+ PSPECIES="AERO-TRACE", ! Tracer name
+ PDECAY=-9.9, ! Species half life
+ PWETA_GAS=-0.9E-9, ! Below-cloud scavenging (gases) - A (weta_gas)
+ PWETB_GAS=-9.9, ! Below-cloud scavenging (gases) - B (wetb_gas)
+ PCRAIN_AERO=1.0, ! Below-cloud scavenging (particles) - Crain (crain_aero)
+ PCSNOW_AERO=1.0, ! Below-cloud scavenging (particles) - Csnow (csnow_aero)
+ PCCN_AERO=0.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero)
+ PIN_AERO=0.1, ! In-cloud scavenging (particles) - INeff (in_aero)
+ PDENSITY=1400.0, ! Dry deposition (particles) - rho
+ PDQUER=2.5E-07, ! Dry deposition (particles) - dquer
+ PDSIGMA=1.25, ! Dry deposition (particles) - dsig
+ PNDIA=1, ! Dry deposition (particles) - ndia
+ PDRYVEL=-9.99, ! Alternative: dry deposition velocity
+ PRELDIFF=-9.9, ! Dry deposition (gases) - D
+ PHENRY=-0.9E-9, ! Dry deposition (gases) - Henrys const.
+ PF0=-9, ! Dry deposition (gases) - f0 (reactivity)
+ PWEIGHTMOLAR=-9.9, ! molweight
+ POHCCONST=-0.9E-9, ! OH Reaction rate - C [cm^3/molecule/sec]
+ POHDCONST=-9.9, ! OH Reaction rate - D [K]
+ POHNCONST=2.0, ! OH Reaction rate - N (no unit)
+ /
diff --git a/options_lcm/SPECIES/SPECIES_026 b/options_lcm/SPECIES/SPECIES_026
new file mode 100644
index 0000000000000000000000000000000000000000..d5247827729787fba7c4dfe87e33065aab77169a
--- /dev/null
+++ b/options_lcm/SPECIES/SPECIES_026
@@ -0,0 +1,27 @@
+&SPECIES_PARAMS
+ PSPECIES="CH4", ! Tracer name
+ PDECAY=-9.9, ! Species half life
+ PWETA_GAS=-0.9E-9, ! Below-cloud scavenging (gases) - A (weta_gas)
+ PWETB_GAS=-9.9, ! Below-cloud scavenging (gases) - B (wetb_gas)
+ PCRAIN_AERO=-9.9, ! Below-cloud scavenging (particles) - Crain (crain_aero)
+ PCSNOW_AERO=-9.9, ! Below-cloud scavenging (particles) - Csnow (csnow_aero)
+ PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero)
+ PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero)
+ PDENSITY=-0.9E+9, ! Dry deposition (particles) - rho
+ PDQUER=0.0, ! Dry deposition (particles) - dquer
+ PDSIGMA=0.0, ! Dry deposition (particles) - dsig
+ PDRYVEL=-9.99, ! Alternative: dry deposition velocity
+ PRELDIFF=-9.9, ! Dry deposition (gases) - D
+ PHENRY=-0.9E-9, ! Dry deposition (gases) - Henrys const.
+ PF0=-9, ! Dry deposition (gases) - f0 (reactivity)
+ PWEIGHTMOLAR=16.0, ! molweight
+ PREACTIONS="OH", ! List of reactions (must correspond to names in REAGENTS)
+ PCCONST=9.65E-20, ! List of reaction rates C [cm^3/molecule/sec] (in order of PREACTIONS)
+ PDCONST=1082.0, ! List of reaction rates D [K] (in order of PREACTIONS)
+ PNCONST=2.58, ! List of reaction rates N (no unit) (in order of PREACTIONS)
+ PEMIS_PATH="/xnilu_wrk/users/rlt/FLUX/CH4/CAMS/v20r1/", ! Emissions path (if empty no emission)
+ PEMIS_FILE="cams73_v20r1_ch4_flux_surface_mm_YYYYMM.nc",! Generic file name for emissions (if empty no emission)
+ PEMIS_NAME="ch4_emis_total", ! Variable name for emissions (if empty no emission)
+ PEMIS_UNIT=1, ! 0 [per gridcell], 1 [per m^2]
+ PEMIS_COEFF=1., ! Coefficient to convert from emission input unit to kg/s
+/
diff --git a/options_lcm/SPECIES/SPECIES_027 b/options_lcm/SPECIES/SPECIES_027
new file mode 100644
index 0000000000000000000000000000000000000000..6265f9ba6f1004b7486207052a0b85a9075cb220
--- /dev/null
+++ b/options_lcm/SPECIES/SPECIES_027
@@ -0,0 +1,22 @@
+&SPECIES_PARAMS
+ PSPECIES="C2H6", ! Tracer name
+ PDECAY=-9.9, ! Species half life
+ PWETA_GAS=-0.9E-9, ! Below-cloud scavenging (gases) - A (weta_gas)
+ PWETB_GAS=-9.9, ! Below-cloud scavenging (gases) - B (wetb_gas)
+ PCRAIN_AERO=-9.9, ! Below-cloud scavenging (particles) - Crain (crain_aero)
+ PCSNOW_AERO=-9.9, ! Below-cloud scavenging (particles) - Csnow (csnow_aero)
+ PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero)
+ PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero)
+ PDENSITY=-0.9E+9, ! Dry deposition (particles) - rho
+ PDQUER=0.0, ! Dry deposition (particles) - dquer
+ PDSIGMA=0.0, ! Dry deposition (particles) - dsig
+ PNDIA=1, ! Dry deposition (particles) - ndia
+ PDRYVEL=-9.99, ! Alternative: dry deposition velocity
+ PRELDIFF=-9.9, ! Dry deposition (gases) - D
+ PHENRY=-0.9E-9, ! Dry deposition (gases) - Henrys const.
+ PF0=-9, ! Dry deposition (gases) - f0 (reactivity)
+ PWEIGHTMOLAR=30.0, ! molweight
+ POHCCONST=15.2E-18, ! OH Reaction rate - C [cm^3/molecule/sec]
+ POHDCONST=498.0, ! OH Reaction rate - D [K]
+ POHNCONST=2.0, ! OH Reaction rate - N (no unit)
+ /
diff --git a/options_lcm/SPECIES/SPECIES_028 b/options_lcm/SPECIES/SPECIES_028
new file mode 100644
index 0000000000000000000000000000000000000000..4e92447c237978dd059312b51173d651e52e70a0
--- /dev/null
+++ b/options_lcm/SPECIES/SPECIES_028
@@ -0,0 +1,7 @@
+&SPECIES_PARAMS
+ PSPECIES="C3H8 ",
+ PWEIGHTMOLAR= 44.0000000 ,
+ POHCCONST= 1.55-E17,
+ POHDCONST= 61.0000000 ,
+ POHNCONST= 2.00000000 ,
+ /
diff --git a/options_lcm/SPECIES/SPECIES_031 b/options_lcm/SPECIES/SPECIES_031
new file mode 100644
index 0000000000000000000000000000000000000000..701f2866389a6e527e4bb25a0bbab198823cca6c
--- /dev/null
+++ b/options_lcm/SPECIES/SPECIES_031
@@ -0,0 +1,22 @@
+&SPECIES_PARAMS
+ PSPECIES="PCB28", ! Tracer name
+ PDECAY=-9.9, ! Species half life
+ PWETA_GAS=3.5E-05, ! Below-cloud scavenging (gases) - A (weta_gas)
+ PWETB_GAS=0.62, ! Below-cloud scavenging (gases) - B (wetb_gas)
+ PCRAIN_AERO=-9.9, ! Below-cloud scavenging (particles) - Crain (crain_aero)
+ PCSNOW_AERO=-9.9, ! Below-cloud scavenging (particles) - Csnow (csnow_aero)
+ PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero)
+ PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero)
+ PDENSITY=-0.9E+9, ! Dry deposition (particles) - rho
+ PDQUER=0.0, ! Dry deposition (particles) - dquer
+ PDSIGMA=0.0, ! Dry deposition (particles) - dsig
+ PNDIA=1, ! Dry deposition (particles) - ndia
+ PDRYVEL=-9.99, ! Alternative: dry deposition velocity
+ PRELDIFF=4.3, ! Dry deposition (gases) - D
+ PHENRY=3.1, ! Dry deposition (gases) - Henrys const.
+ PF0=0.1, ! Dry deposition (gases) - f0 (reactivity)
+ PWEIGHTMOLAR=257.54, ! molweight
+ POHCCONST=1.07E-11, ! OH Reaction rate - C [cm^3/molecule/sec]
+ POHDCONST=1203.0, ! OH Reaction rate - D [K]
+ POHNCONST=0.0, ! OH Reaction rate - N (no unit)
+ /
diff --git a/options_lcm/SPECIES/SPECIES_034 b/options_lcm/SPECIES/SPECIES_034
new file mode 100644
index 0000000000000000000000000000000000000000..5e7ebe277313703828a58db941f89e68058d8757
--- /dev/null
+++ b/options_lcm/SPECIES/SPECIES_034
@@ -0,0 +1,22 @@
+&SPECIES_PARAMS
+ PSPECIES="G-HCH", ! Tracer name
+ PDECAY=-9.9, ! Species half life
+ PWETA_GAS=3.5E-05, ! Below-cloud scavenging (gases) - A (weta_gas)
+ PWETB_GAS=0.62, ! Below-cloud scavenging (gases) - B (wetb_gas)
+ PCRAIN_AERO=-9.9, ! Below-cloud scavenging (particles) - Crain (crain_aero)
+ PCSNOW_AERO=-9.9, ! Below-cloud scavenging (particles) - Csnow (csnow_aero)
+ PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero)
+ PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero)
+ PDENSITY=-0.9E+9, ! Dry deposition (particles) - rho
+ PDQUER=0.0, ! Dry deposition (particles) - dquer
+ PDSIGMA=0.0, ! Dry deposition (particles) - dsig
+ PNDIA=1, ! Dry deposition (particles) - ndia
+ PDRYVEL=-9.99, ! Alternative: dry deposition velocity
+ PRELDIFF=4.3, ! Dry deposition (gases) - D
+ PHENRY=422.0, ! Dry deposition (gases) - Henrys const.
+ PF0=0.1, ! Dry deposition (gases) - f0 (reactivity)
+ PWEIGHTMOLAR=290.83, ! molweight
+ POHCCONST=6.21E-11, ! OH Reaction rate - C [cm^3/molecule/sec]
+ POHDCONST=1203.0, ! OH Reaction rate - D [K]
+ POHNCONST=2.00, ! OH Reaction rate - N (no unit)
+ /
diff --git a/options_lcm/SPECIES/SPECIES_040 b/options_lcm/SPECIES/SPECIES_040
new file mode 100644
index 0000000000000000000000000000000000000000..28c4552dad6c25fd8e39b5287efcf4dfdc71727c
--- /dev/null
+++ b/options_lcm/SPECIES/SPECIES_040
@@ -0,0 +1,28 @@
+&SPECIES_PARAMS
+ PSPECIES="EXAMPLE", ! Tracer name
+ PDECAY=-9.9, ! Species half life
+ PWETA_GAS=-0.9E-9, ! Below-cloud scavenging (gases) - A (weta_gas)
+ PWETB_GAS=-9.9, ! Below-cloud scavenging (gases) - B (wetb_gas)
+ PCRAIN_AERO=1.0, ! Below-cloud scavenging (particles) - Crain (crain_aero)
+ PCSNOW_AERO=1.0, ! Below-cloud scavenging (particles) - Csnow (csnow_aero)
+ PCCN_AERO=0.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero)
+ PIN_AERO=0.1, ! In-cloud scavenging (particles) - INeff (in_aero)
+ PDENSITY=1000.0, ! Dry deposition (particles) - rho
+ PDQUER=50.0E-06, ! Dry deposition (particles) - dquer (equivalent diameter for shape)
+ PDSIGMA=3.3, ! Dry deposition (particles) - dsig
+ PNDIA=1, ! Dry deposition (particles) - number of diameter bins
+ PDRYVEL=-9.9, ! Alternative: dry deposition velocity
+ PRELDIFF=-9.9, ! Dry deposition (gases) - D
+ PHENRY=-0.9E-9, ! Dry deposition (gases) - Henrys const.
+ PF0=-9, ! Dry deposition (gases) - f0 (reactivity)
+ PWEIGHTMOLAR=-9.9, ! molweight
+ POHCCONST=-0.9E-9, ! OH Reaction rate - C [cm^3/molecule/sec]
+ POHDCONST=-9.9, ! OH Reaction rate - D [K]
+ POHNCONST=2.0, ! OH Reaction rate - C [cm^3/molecule/sec]
+ PSHAPE=1, ! 0 for sphere, 1 any shape (defined by axes PLA,PIA,PSA), 2-cylinder, 3-cube, 4-tetrahedron, 5-octahedron, 6-ellipsoid
+ PASPECTRATIO=20.0 ! Aspect ratio of cylinders: works for PSHAPE=2 only
+ PLA=940, ! Longest axis in micrometer (Bagheri & Bonadonna 2016): only for PSHAPE=1
+ PIA=9.4, ! Intermediate axis in micrometer: only for PSHAPE=1
+ PSA=9.4, ! Smallest axis in micrometer: only for PSHAPE=1
+ PORIENT=0, ! 0 for horizontal, 1 for random orientation of particles, 2 for an average between random and horizontal
+ /
diff --git a/options_lcm/SPECIES/specoverview.f90 b/options_lcm/SPECIES/specoverview.f90
new file mode 100644
index 0000000000000000000000000000000000000000..065b5721ad42ca7a478b2491d88332c11529ff49
--- /dev/null
+++ b/options_lcm/SPECIES/specoverview.f90
@@ -0,0 +1,115 @@
+!**********************************************************************
+! Copyright 1998,1999,2000,2001,2002,2005,2007,2008,2009,2010 *
+! Andreas Stohl, Petra Seibert, A. Frank, Gerhard Wotawa, *
+! Caroline Forster, Sabine Eckhardt, John Burkhart, Harald Sodemann *
+! *
+! This file is part of FLEXPART. *
+! *
+! FLEXPART 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. *
+! *
+! FLEXPART 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 FLEXPART. If not, see <http://www.gnu.org/licenses/>. *
+!**********************************************************************
+ implicit none
+
+ character(len=11) :: speciesfn
+ character(len=3) :: aspec
+ character(len=16) :: pspecies
+ real :: pdecay, pweta_gas, pwetb_gas, preldiff, phenry, pf0, pdensity, pdquer
+ real :: pdsigma, pdryvel, pweightmolar, pohcconst, pohdconst, pohnconst
+ real :: pcrain_aero, pcsnow_aero, pccn_aero, pin_aero
+ integer :: readerror, unitspecies, specnumber
+
+! declare namelist
+ namelist /species_params/ &
+ pspecies, pdecay, pweta_gas, pwetb_gas, &
+ pcrain_aero, pcsnow_aero, pccn_aero, pin_aero, &
+ preldiff, phenry, pf0, pdensity, pdquer, &
+ pdsigma, pdryvel, pweightmolar, pohcconst, pohdconst, pohnconst
+
+ unitspecies=4
+
+ write(*,*) ' Species | | WetDep(gas) | DryDep(gas) |WetDep(below-C)| WetDep(in-C)|'//&
+ ' DryDepo(particles) Altern| Radioact. | OH Reaction |'
+
+ write(*,*) ' Name |molwght| A B | D H f0 | Crain Csnow | ccn in |' //&
+ ' rho dquer dsig vd | Halflife[s]| C** D[T] N*** |'
+
+ write(*,*) '--------------|-------|-----------------|------------------|---------------|-------------|'//&
+ '-------------------------------|------------|----------------------|'
+
+
+! write(*,*) ' Specie | Radioact. | WetDep(gas) |WetDep(below-C)| WetDep(in-C)| DryDepo(gas) |'//&
+! ' DryDepo(particles) Altern| | OH Reaction |'
+! write(*,*) ' Name | Halflife[s]| A B | Crain Csnow | ccn in | D H f0 |' //&
+! ' rho dquer dsig vd |molwght| C** D[T] N*** |'
+! write(*,*) '--------------|------------|-----------------|---------------|-------------|-------------------|'//&
+! '-------------------------------|-------|----------------------|'
+
+ do specnumber=1,100
+
+ write (aspec,'(i0.3)') specnumber
+ speciesfn='SPECIES_'//aspec
+
+! write(*,*) 'Processing: ',speciesfn
+
+ pspecies="" ! read failure indicator value
+ pdecay=-9.9
+ pweta_gas=-0.9E-09
+ pwetb_gas=0.0
+ pcrain_aero=-9.9
+ pcsnow_aero=-9.9
+ pccn_aero=-9.9
+ pin_aero=-9.9
+ preldiff=-9.9
+ phenry=0.0
+ pf0=0.0
+ pdensity=-0.9E09
+ pdquer=0.0
+ pdsigma=0.0
+ pdryvel=-9.99
+ pohcconst=-9.9
+ pohdconst=-9.9
+ pohnconst=2.0
+ pweightmolar=-9.9
+
+! Open the SPECIES file and read species names and properties
+!************************************************************
+ open(unitspecies,file=speciesfn,status='old',form='formatted',err=998)
+ read(unitspecies,species_params,err=998)
+ close(unitspecies)
+
+ write(*,45) specnumber,' ',pspecies,'|',pweightmolar,'|',pweta_gas,' ',pwetb_gas,'|', &
+ preldiff,' ',phenry,' ',pf0,'|', &
+ pcrain_aero,' ',pcsnow_aero,'|',pccn_aero,' ',pin_aero,'|', &
+ pdensity,pdquer,pdsigma,pdryvel,'|',pdecay,'|',pohcconst,pohdconst,pohnconst,'|'
+
+45 format(i3,a1,a11,a1,f7.1,a1,e8.1,a1,f8.2,a1, &
+ f4.1,a1,e8.1,a1,f4.1,a1, &
+ f7.1,a1,f7.1,a1,f6.1,a1,f6.1,a1, &
+ e8.1,e9.1,f7.1,f7.2,a1,f12.1,a1,e8.1,f7.1,f7.1,a1)
+
+! write(*,45) specnumber,' ',pspecies,'|',pdecay,'|',pweta_gas,' ',pwetb_gas,'|',pcrain_aero,' ', &
+! pcsnow_aero,'|',pccn_aero,' ',pin_aero,'|',preldiff,' ',phenry,' ',pf0,'|', &
+! pdensity,pdquer,pdsigma,pdryvel,'|',pweightmolar,'|',pohcconst,pohdconst,pohnconst,'|'
+
+!5 format(i3,a1,a11,a1,f12.1,a1,e8.1,a1,f8.2,a1,f7.1,a1,f7.1,a1,f6.1,a1,f6.1,a1,f5.1,a1,e8.1,a1,f4.1,a1, &
+! e8.1,e9.1,f7.1,f7.2,a1,f7.1,a1,e8.1,f7.1,f7.1,a1)
+
+998 continue
+enddo
+
+write(*,*) '** unit [cm^3/molec/s] (in FLEXPART version 9.2 and below this had unit [cm3/s], note the unit is now changed!)'
+write(*,*) '*** no unit'
+
+ print*,'rho: density'
+
+end
diff --git a/options_lcm/sfcdata.t b/options_lcm/sfcdata.t
new file mode 100644
index 0000000000000000000000000000000000000000..d19e84100b0316962d77e43db7529c387953ca1b
--- /dev/null
+++ b/options_lcm/sfcdata.t
@@ -0,0 +1,17 @@
+13 landuse categories are related roughness length
+--------------------------------------------------------
+landuse comment z0
+--------------------------------------------------------
+ 1 Urban land 0.7
+ 2 Agricultural land 0.1
+ 3 Range land 0.1
+ 4 Deciduous forest 1.
+ 5 Coniferous forest 1.
+ 6 Mixed forest including wetland 0.7
+ 7 water, both salt and fresh 0.001
+ 8 barren land mostly desert 0.01
+ 9 nonforested wetland 0.1
+10 mixed agricultural and range land 0.1
+11 rocky open areas with low grow shrubs 0.05
+12 snow and ice 0.001
+13 rainforest 1.
diff --git a/options_lcm/sfcdepo.t b/options_lcm/sfcdepo.t
new file mode 100644
index 0000000000000000000000000000000000000000..1171b672ea773a57c6eb90cc03091caf1a08ce92
--- /dev/null
+++ b/options_lcm/sfcdepo.t
@@ -0,0 +1,57 @@
+==============================================================================
+INPUT RESISTANCES (s/m) FOR THE COMPUTATION OF SURFACE RESISTANCES TO
+DRY DEPOSITION
+==============================================================================
+AFTER WESELY, 1989
+==============================================================================
+1 to 11: Landuse types after Wesely; 12 .. snow, 13 .. rainforest
+==============================================================================
+Values are tabulated for 5 seasonal categories:
+1 Midsummer with lush vegetation
+2 Autumn with unharvested cropland
+3 Late autumn after frost, no snow
+4 Winter, snow on ground and subfreezing
+5 Transitional spring with partially green short annuals
+==============================================================================
+ 1 2 3 4 5 6 7 8 9 10 11 12 13
+________________________________________________________________________________________________________________
+ri 9999. 60. 120. 70. 130. 100. 9999. 9999. 80. 100. 150. 9999. 200. 1
+rlu 9999. 2000. 2000. 2000. 2000. 2000. 9999. 9999. 2500. 2000. 4000. 9999. 1000.
+rac 100. 200. 100. 2000. 2000. 2000. 0. 0. 300. 150. 200. 0. 2000.
+rgss 400. 150. 350. 500. 500. 100. 0. 1000. 0. 220. 400. 100. 200.
+rgso 300. 150. 200. 200. 200. 300. 2000. 400. 1000. 180. 200. 10000. 200.
+rcls 9999. 2000. 2000. 2000. 2000. 2000. 9999. 9999. 2500. 2000. 4000. 9999. 9999.
+rclo 9999. 1000. 1000. 1000. 1000. 1000. 9999. 9999. 1000. 1000. 1000. 9999. 9999.
+_________________________________________________________________________________________________________________
+ri 9999. 9999. 9999. 9999. 250. 500. 9999. 9999. 9999. 9999. 9999. 9999. 200. 2
+rlu 9999. 9000. 9000. 9000. 4000. 8000. 9999. 9999. 9000. 9000. 9000. 9999. 1000.
+rac 100. 150. 100. 1500. 2000. 1700. 0. 0. 200. 120. 140. 0. 2000.
+rgss 400. 200. 350. 500. 500. 100. 0. 1000. 0. 300. 400. 100. 200.
+rgso 300. 150. 200. 200. 200. 300. 2000. 400. 800. 180. 200. 10000. 200.
+rcls 9999. 9000. 9000. 9000. 2000. 4000. 9999. 9999. 9000. 9000. 9000. 9999. 9999.
+rclo 9999. 400. 400. 400. 1000. 600. 9999. 9999. 400. 400. 400. 9999. 9999.
+_________________________________________________________________________________________________________________
+ri 9999. 9999. 9999. 9999. 250. 500. 9999. 9999. 9999. 9999. 9999. 9999. 200. 3
+rlu 9999. 9999. 9000. 9000. 4000. 8000. 9999. 9999. 9000. 9000. 9000. 9999. 1000.
+rac 100. 10. 100. 1000. 2000. 1500. 0. 0. 100. 50. 120. 0. 2000.
+rgss 400. 150. 350. 500. 500. 200. 0. 1000. 0. 200. 400. 100. 200.
+rgso 300. 150. 200. 200. 200. 300. 2000. 400. 1000. 180. 200. 10000. 200.
+rcls 9999. 9999. 9000. 9000. 3000. 6000. 9999. 9999. 9000. 9000. 9000. 9999. 9999.
+rclo 9999. 1000. 400. 400. 1000. 600. 9999. 9999. 800. 600. 600. 9999. 9999.
+_________________________________________________________________________________________________________________
+ri 9999. 9999. 9999. 9999. 400. 800. 9999. 9999. 9999. 9999. 9999. 9999. 200. 4
+rlu 9999. 9999. 9999. 9999. 6000. 9000. 9999. 9999. 9000. 9000. 9000. 9999. 1000.
+rac 100. 10. 10. 1000. 2000. 1500. 0. 0. 50. 10. 50. 0. 2000.
+rgss 100. 100. 100. 100. 100. 100. 0. 1000. 100. 100. 50. 100. 200.
+rgso 600. 3500. 3500. 3500. 3500. 3500. 2000. 400. 3500. 3500. 3500. 10000. 200.
+rcls 9999. 9999. 9999. 9000. 200. 400. 9999. 9999. 9000. 9999. 9000. 9999. 9999.
+rclo 9999. 1000. 1000. 400. 1500. 600. 9999. 9999. 800. 1000. 800. 9999. 9999.
+_________________________________________________________________________________________________________________
+ri 9999. 120. 240. 140. 250. 190. 9999. 9999. 160. 200. 300. 9999. 200. 5
+rlu 9999. 4000. 4000. 4000. 2000. 3000. 9999. 9999. 4000. 4000. 8000. 9999. 1000.
+rac 100. 50. 80. 1200. 2000. 1500. 0. 0. 200. 60. 120. 0. 2000.
+rgss 500. 150. 350. 500 500. 200. 0. 1000. 0. 250. 400. 100. 200.
+rgso 300. 150. 200. 200. 200. 300. 2000. 400. 1000. 180. 200. 10000. 200.
+rcls 9999. 4000. 4000. 4000. 2000. 3000. 9999. 9999. 4000. 4000. 8000. 9999. 9999.
+rclo 9999. 1000. 500. 500. 1500. 700. 9999. 9999. 600. 800. 800. 9999. 9999.
+_________________________________________________________________________________________________________________
diff --git a/src/FLEXPART.f90 b/src/FLEXPART.f90
index 1942fc3199fd131fe6fafd5554c650b1df49b70a..7a20ec48641002521d67936867e6de0692b45aa6 100644
--- a/src/FLEXPART.f90
+++ b/src/FLEXPART.f90
@@ -44,7 +44,7 @@ program flexpart
real :: s_timemanager
character(len=256) :: &
inline_options ! pathfile, flexversion, arg2
- character(len=256) :: gitversion_tmp="undefined"
+ character(len=256) :: gitversion_tmp="8d9c680 Mon Apr 22 15:37:39 2024 +0200"
! Keeping track of the total running time of FLEXPART, printed out at the end.
!*****************************************************************************
@@ -170,10 +170,16 @@ subroutine read_options_and_initialise_flexpart
use initialise_mod
use drydepo_mod
use getfields_mod
- use interpol_mod, only: alloc_interpol
+ use interpol_mod, only: alloc_interpol
use outgrid_mod
use binary_output_mod
- use omp_lib, only: OMP_GET_MAX_THREADS
+ use omp_lib, only: OMP_GET_MAX_THREADS
+#ifdef USE_NCF
+ use chemistry_mod, only: readreagents
+ use totals_mod
+ use receptor_netcdf_mod, only: readreceptors_satellite, receptorout_init, satelliteout_init
+#endif
+ use receptor_mod, only: alloc_receptor
implicit none
@@ -291,22 +297,39 @@ subroutine read_options_and_initialise_flexpart
! Read the receptor points for which extra concentrations are to be calculated
!*****************************************************************************
+ numreceptor=0
+ numsatreceptor=0
+ nlayermax=1
+#ifdef USE_NCF
+ call readreceptors_satellite
+#endif
call readreceptors
- ! Read the physico-chemical species property table
- !*************************************************
- !SEC: now only needed SPECIES are read in readreleases.f
- !call readspecies
-
! Read the landuse inventory
!***************************
call readlanduse ! CHECK ETA
+ ! Read chemical reagent information
+ !**********************************
+ ! default settings
+ nreagent=0
+ reagents(:)=""
+#ifdef USE_NCF
+ call readreagents
+#endif
+
! For continuation of previous run or from user defined initial
! conditions, read in particle positions
!*************************************************************************
call initialise_particles
+ ! Initialize variables for totals calculations
+ !*********************************************
+#ifdef USE_NCF
+ call alloc_totals
+ call totals_init
+#endif
+
! Convert the release point coordinates from geografical to grid coordinates
!***************************************************************************
call coordtrafo(nxmin1,nymin1)
@@ -323,29 +346,32 @@ subroutine read_options_and_initialise_flexpart
call alloc_interpol
#ifdef USE_NCF
if (lnetcdfout.eq.1) call alloc_netcdf
-#endif USE_NCF
+#endif
! Assign fractional cover of landuse classes to each ECMWF grid point
!********************************************************************
call assignland
! Calculate volume, surface area, etc., of all output grid cells
- ! Allocate fluxes and OHfield if necessary
!***************************************************************
if (iout.ne.0) then
call outgrid_init
if (nested_output.eq.1) call outgrid_init_nest ! CHECK ETA
endif
- ! Read the OH field
- !******************
- if (OHREA) then
- call readOHfield
- endif
+ ! Initialize receptor output
+ !***************************
- ! Binary receptor output when lnetcdfout is set to zero, otherwise
- ! added to gridded output
- if (lnetcdfout.eq.0) call openreceptors
+ call alloc_receptor
+ if (lnetcdfout.eq.1) then
+#ifdef USE_NCF
+ call receptorout_init
+ call satelliteout_init
+#endif
+ else
+ call receptorout_init_binary
+ call satelliteout_init_binary
+ endif
if ((iout.eq.4).or.(iout.eq.5)) call openouttraj ! CHECK ETA
@@ -363,6 +389,7 @@ subroutine read_options_and_initialise_flexpart
!************************************
allocate(nan_count(numthreads), stat=stat)
if (stat.ne.0) error stop "Could not allocate nan_count"
+
end subroutine read_options_and_initialise_flexpart
subroutine initialise_particles
@@ -418,8 +445,6 @@ subroutine initialise_particles
#endif
endif
-
-
if (iout.ne.0) then
call alloc_grid
call alloc_grid_unc
diff --git a/src/binary_output_mod.f90 b/src/binary_output_mod.f90
index 39087de7cb252016dca4b4ebbdc843faefd19d95..b19fa1dd13c07d1bc92421626b8c3688fd32c3ba 100644
--- a/src/binary_output_mod.f90
+++ b/src/binary_output_mod.f90
@@ -6,9 +6,9 @@
! This module contains routines that output gridded data to binary files. *
! *
! Not all routines that should have a netcdf equivalent, have one yet: *
- ! writeheader_bin_sfc_nest,writeheader_bin_sfc,concoutput_sfc, *
- ! concoutput_sfc_nest,initcond_output,initcond_output_inv, *
- ! concoutput_inv_nest *
+ ! writeheader_bin_sfc_nest,writeheader_bin_sfc, *
+ ! initcond_output,initcond_output_inversion *
+ ! concoutput_inversion, concoutput_inversion_nest *
! *
! L. Bakels 2022 *
! *
@@ -583,41 +583,48 @@ subroutine writeheader_bin_sfc
end subroutine writeheader_bin_sfc
-subroutine openreceptors
+subroutine receptorout_init_binary
!*****************************************************************************
! *
! This routine opens the receptor output files and writes out the receptor *
- ! names and the receptor locations. The receptor output files are not *
+ ! names, location and times. The receptor output files are not *
! closed, but kept open throughout the simulation. Concentrations are *
! continuously dumped to these files. *
! *
! Author: A. Stohl *
- ! *
! 7 August 2002 *
! *
+ ! Modified: R. Thompson *
+ ! January 2024: for moving receptors *
+ ! changed format write to: *
+ ! nspec *
+ ! and then for each timestep and receptors: *
+ ! name, lat, lon, alt, time, nn, xk, conc, unc *
+ ! *
!*****************************************************************************
! *
! Variables: *
! numreceptor actual number of receptor points specified *
- ! receptornames names of the receptor points *
- ! xreceptor,yreceptor coordinates of the receptor points *
+ ! receptorname names of the receptor points *
+ ! xreceptor longitude coordinate of the receptor points *
+ ! yreceptor latitude coordinate of the receptor points *
+ ! zreceptor altitude coordinate of the receptor points *
+ ! treceptor time coordinate of the receptor points *
! *
!*****************************************************************************
implicit none
- integer :: j
-
- ! Open output file for receptor points and write out a short header
- ! containing receptor names and locations
- !******************************************************************
-
- if (numreceptor.ge.1) then ! do it only if receptors are specified
+ if (numreceptor.eq.0) then
+ return
+ endif
- ! Concentration output
- !*********************
+ ! Open output file for receptor points and write number
+ ! of receptors and species for concentration and uncertainty variables
+ !**********************************************************************
+ ! Concentration output
if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
if ((ipin.eq.1).or.(ipin.eq.4)) then
open(unitoutrecept,file=path(2)(1:length(2))//'receptor_conc', &
@@ -625,40 +632,197 @@ subroutine openreceptors
else
open(unitoutrecept,file=path(2)(1:length(2))//'receptor_conc', &
form='unformatted',err=997)
- write(unitoutrecept) (receptorname(j),j=1,numreceptor)
- write(unitoutrecept) (xreceptor(j)*dx+xlon0, &
- yreceptor(j)*dy+ylat0,j=1,numreceptor)
+ write(unitoutrecept) numreceptor
+ if (llcmoutput) then
+ write(unitoutrecept) nspec-1 ! first species is mass of air
+ else
+ write(unitoutrecept) nspec
+ endif
endif
endif
- ! Mixing ratio output
- !********************
-
+ ! Mixing ratio output
if ((iout.eq.2).or.(iout.eq.3)) then
if ((ipin.eq.1).or.(ipin.eq.4)) then
open(unitoutreceptppt,file=path(2)(1:length(2))//'receptor_pptv', &
- access='APPEND',status='OLD',err=997)
+ access='APPEND',status='OLD',err=998)
else
open(unitoutreceptppt,file=path(2)(1:length(2))//'receptor_pptv', &
form='unformatted',err=998)
- write(unitoutreceptppt) (receptorname(j),j=1,numreceptor)
- write(unitoutreceptppt) (xreceptor(j)*dx+xlon0, &
- yreceptor(j)*dy+ylat0,j=1,numreceptor)
+ write(unitoutreceptppt) numreceptor
+ if (llcmoutput) then
+ write(unitoutreceptppt) nspec-1 ! first species is mass of air
+ else
+ write(unitoutreceptppt) nspec
+ endif
endif
endif
- endif
- return
+ return
+
997 write(*,*) ' #### FLEXPART MODEL ERROR! THE FILE #### '
- write(*,*) ' #### receptor_conc #### '
- write(*,*) ' #### CANNOT BE OPENED. #### '
- error stop
+ write(*,*) ' #### receptor_conc #### '
+ write(*,*) ' #### CANNOT BE OPENED. #### '
+ error stop
998 write(*,*) ' #### FLEXPART MODEL ERROR! THE FILE #### '
- write(*,*) ' #### receptor_pptv #### '
- write(*,*) ' #### CANNOT BE OPENED. #### '
- error stop
-end subroutine openreceptors
+ write(*,*) ' #### receptor_pptv #### '
+ write(*,*) ' #### CANNOT BE OPENED. #### '
+ error stop
+
+end subroutine receptorout_init_binary
+
+
+subroutine satelliteout_init_binary
+
+ !*****************************************************************************
+ ! *
+ ! This routine opens the satellite output files for subsequent writing *
+ ! *
+ ! Author: R. Thompson *
+ ! January 2024 *
+ ! *
+ !*****************************************************************************
+ ! *
+ ! Variables: *
+ ! numsatreceptor actual number of satellite receptors *
+ ! nspec number of species *
+ ! nlayermax max number of layers in retrievals *
+ ! *
+ !*****************************************************************************
+
+ implicit none
+
+ if (numsatreceptor.eq.0) then
+ return
+ endif
+
+ ! Open output file for satellite receptors and write number
+ ! of receptors and species for concentration and uncertainty variables
+ !**********************************************************************
+
+ ! Mixing ratio output
+ if ((ipin.eq.1).or.(ipin.eq.4)) then
+ open(unitoutsatellite,file=path(2)(1:length(2))//'satellite_pptv', &
+ access='APPEND',status='OLD',err=998)
+ else
+ open(unitoutsatellite,file=path(2)(1:length(2))//'satellite_pptv', &
+ form='unformatted',err=998)
+ write(unitoutsatellite) numsatreceptor
+ if (llcmoutput) then
+ write(unitoutsatellite) nspec-1 ! first species is mass of air
+ else
+ write(unitoutsatellite) nspec
+ endif
+ write(unitoutsatellite) nlayermax
+ endif
+
+ return
+
+998 write(*,*) ' #### FLEXPART MODEL ERROR! THE FILE #### '
+ write(*,*) ' #### satellite_pptv #### '
+ write(*,*) ' #### CANNOT BE OPENED. #### '
+ error stop
+
+end subroutine satelliteout_init_binary
+
+
+subroutine write_receptor_binary(crec,cunc,nnrec,xkrec,lonrec,latrec,altrec,timerec,namerec,nrec)
+
+ !*****************************************************************************
+ ! *
+ ! This routine writes the receptor concentrations for each time step *
+ ! and receptor to binary output files *
+ ! *
+ ! R. Thompson, January 2024 *
+ ! *
+ !*****************************************************************************
+
+ implicit none
+
+ integer :: nrec, ks, ks_start
+ real, dimension(nspec,maxrecsample,nlayermax) :: crec, cunc
+ real, dimension(maxrecsample,nlayermax) :: nnrec, xkrec, altrec
+ real, dimension(maxrecsample) :: lonrec, latrec
+ integer, dimension(maxrecsample) :: timerec
+ character(len=16), dimension(maxrecsample) :: namerec
+
+ if (llcmoutput) then
+ ks_start=2
+ else
+ ks_start=1
+ endif
+
+ if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
+ write(unitoutrecept) nrec
+ write(unitoutrecept) namerec(1:nrec)
+ write(unitoutrecept) lonrec(1:nrec)
+ write(unitoutrecept) latrec(1:nrec)
+ write(unitoutrecept) altrec(1:nrec,1)
+ write(unitoutrecept) timerec(1:nrec)
+ write(unitoutrecept) nnrec(1:nrec,1)
+ write(unitoutrecept) xkrec(1:nrec,1)
+ write(unitoutrecept) (crec(ks,1:nrec,1),ks=ks_start,nspec)
+ write(unitoutrecept) (cunc(ks,1:nrec,1),ks=ks_start,nspec)
+ endif
+ if ((iout.eq.2).or.(iout.eq.3)) then
+ write(unitoutreceptppt) nrec
+ write(unitoutreceptppt) namerec(1:nrec)
+ write(unitoutreceptppt) lonrec(1:nrec)
+ write(unitoutreceptppt) latrec(1:nrec)
+ write(unitoutreceptppt) altrec(1:nrec,1)
+ write(unitoutreceptppt) timerec(1:nrec)
+ write(unitoutreceptppt) nnrec(1:nrec,1)
+ write(unitoutreceptppt) xkrec(1:nrec,1)
+ write(unitoutreceptppt) (crec(ks,1:nrec,1),ks=ks_start,nspec)
+ write(unitoutreceptppt) (cunc(ks,1:nrec,1),ks=ks_start,nspec)
+ endif
+
+end subroutine write_receptor_binary
+
+
+subroutine write_satellite_binary(crec,cunc,nnrec,xkrec,lonrec,latrec,altrec,timerec,namerec,nrec)
+
+ !*****************************************************************************
+ ! *
+ ! This routine writes the satellite concentrations for each time step *
+ ! and receptor to binary output files *
+ ! *
+ ! R. Thompson, January 2024 *
+ ! *
+ !*****************************************************************************
+
+ implicit none
+
+ integer :: nrec, n, ks, ks_start
+ real, dimension(nspec,maxrecsample,nlayermax) :: crec, cunc
+ real, dimension(maxrecsample,nlayermax) :: nnrec, xkrec, altrec
+ real, dimension(maxrecsample) :: lonrec, latrec
+ integer, dimension(maxrecsample) :: timerec
+ character(len=16), dimension(maxrecsample) :: namerec
+
+ if (llcmoutput) then
+ ks_start=2
+ else
+ ks_start=1
+ endif
+
+ ! satellite only mixing ratio output
+ write(unitoutsatellite) nrec
+ write(unitoutsatellite) namerec(1:nrec)
+ write(unitoutsatellite) timerec(1:nrec)
+ write(unitoutsatellite) lonrec(1:nrec)
+ write(unitoutsatellite) latrec(1:nrec)
+ write(unitoutsatellite) (altrec(n,1:nlayermax),n=1,nrec)
+ write(unitoutsatellite) (nnrec(n,1:nlayermax),n=1,nrec)
+ write(unitoutsatellite) (xkrec(n,1:nlayermax),n=1,nrec)
+ do ks=ks_start,nspec
+ write(unitoutsatellite) (crec(ks,n,1:nlayermax),n=1,nrec)
+ write(unitoutsatellite) (cunc(ks,n,1:nlayermax),n=1,nrec)
+ end do
+
+end subroutine write_satellite_binary
+
subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, &
drygridtotalunc)
@@ -666,7 +830,7 @@ subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, &
! o
!*****************************************************************************
! *
- ! Output of the concentration grid and the receptor concentrations. *
+ ! Output of the concentration grid *
! *
! Author: A. Stohl *
! *
@@ -707,10 +871,7 @@ subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, &
integer :: itime,i,ix,jy,kz,ks,kp,l,iix,jjy,kzz,nage,jjjjmmdd,ihmmss
integer :: sp_count_i,sp_count_r
real :: sp_fact
- real :: outnum,densityoutrecept(numreceptor),xl,yl
- ! RLT
- real :: densitydryrecept(numreceptor)
- real :: factor_dryrecept(numreceptor)
+ real :: outnum,xl,yl
real(dep_prec) :: auxgrid(nclassunc)
real(sp) :: gridtotal,gridsigmatotal,gridtotalunc
@@ -729,6 +890,7 @@ subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, &
logical :: lexist
integer :: ierr
character(LEN=100) :: dates_char
+ integer :: numzwrite, ks_start
! Determine current calendar date, needed for the file name
!**********************************************************
@@ -740,7 +902,6 @@ subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, &
! Overwrite existing dates file on first call, later append to it
! This fixes a bug where the dates file kept growing across multiple runs
-
! Restarting a run:
if ((ipin.eq.1).or.(ipin.eq.4)) then
file_stat='OLD'
@@ -782,11 +943,7 @@ subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, &
if (ldirect.eq.1) then
- do ks=1,nspec
- do kp=1,maxpointspec_act
- tot_mu(ks,kp)=1
- end do
- end do
+ tot_mu(:,:)=1.
else
do ks=1,nspec
do kp=1,maxpointspec_act
@@ -801,70 +958,90 @@ subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, &
! from coarse grid at some time
! Determine center altitude of output layer, and interpolate density
! data to that altitude
+ !
+ ! Note:
+ ! llcmoutput = true: grid is mass_spec/mass_air
+ ! for iout 1,3, or 5 multiply by rho
+ ! for iout 2 multiply by 1
+ ! llcmoutput = false: grid is mass_spec/V
+ ! for iout 1,3, or 5 multiply by 1
+ ! for iout 2 multiply by 1/rho
!*******************************************************************
- mind=memind(2)
- do kz=1,numzgrid
- if (kz.eq.1) then
- halfheight=outheight(1)*0.5
- else
- halfheight=(outheight(kz)+outheight(kz-1))*0.5
- endif
- do kzz=2,nz
- if ((height(kzz-1).lt.halfheight).and. &
- (height(kzz).gt.halfheight)) exit
- end do
- kzz=max(min(kzz,nz),2)
- dz1=halfheight-height(kzz-1)
- dz2=height(kzz)-halfheight
- dz=dz1+dz2
- do jy=0,numygrid-1
- do ix=0,numxgrid-1
- xl=outlon0+real(ix)*dxout
- yl=outlat0+real(jy)*dyout
- xl=(xl-xlon0)/dx
- yl=(yl-ylat0)/dy !v9.1.1
- iix=max(min(nint(xl),nxmin1),0)
- jjy=max(min(nint(yl),nymin1),0)
- ! densityoutgrid(ix,jy,kz)=(rho(iix,jjy,kzz,2)*dz1+ &
- ! rho(iix,jjy,kzz-1,2)*dz2)/dz
- densityoutgrid(ix,jy,kz)=(rho(iix,jjy,kzz,mind)*dz1+ &
- rho(iix,jjy,kzz-1,mind)*dz2)/dz
- ! RLT
- densitydrygrid(ix,jy,kz)=(rho_dry(iix,jjy,kzz,mind)*dz1+ &
- rho_dry(iix,jjy,kzz-1,mind)*dz2)/dz
+!$OMP PARALLEL &
+!$OMP PRIVATE(kz,halfheight,kzz,dz1,dz2,dz,xl,yl,iix,jjy, &
+!$OMP ix,jy,l,ks,kp,nage,auxgrid) &
+!$OMP REDUCTION(+:wetgridtotal,wetgridsigmatotal, &
+!$OMP drygridtotal,drygridsigmatotal,gridtotal,gridsigmatotal)
+
+ if (((.not.llcmoutput).and.(iout.eq.2)).or.&
+ (llcmoutput.and.((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)))) then
+ ! compute density
+ mind=memind(2)
+!$OMP DO
+ do kz=1,numzgrid
+ if (kz.eq.1) then
+ halfheight=outheight(1)*0.5
+ else
+ halfheight=(outheight(kz)+outheight(kz-1))*0.5
+ endif
+ do kzz=2,nz
+ if ((height(kzz-1).lt.halfheight).and. &
+ (height(kzz).gt.halfheight)) exit
+ end do
+ kzz=max(min(kzz,nz),2)
+ dz1=halfheight-height(kzz-1)
+ dz2=height(kzz)-halfheight
+ dz=dz1+dz2
+ do jy=0,numygrid-1
+ do ix=0,numxgrid-1
+ xl=outlon0+real(ix)*dxout
+ yl=outlat0+real(jy)*dyout
+ xl=(xl-xlon0)/dx
+ yl=(yl-ylat0)/dy !v9.1.1
+ iix=max(min(nint(xl),nxmin1),0)
+ jjy=max(min(nint(yl),nymin1),0)
+ densityoutgrid(ix,jy,kz)=(rho(iix,jjy,kzz,mind)*dz1+ &
+ rho(iix,jjy,kzz-1,mind)*dz2)/dz
+ densitydrygrid(ix,jy,kz)=(rho_dry(iix,jjy,kzz,mind)*dz1+ &
+ rho_dry(iix,jjy,kzz-1,mind)*dz2)/dz
+ end do
end do
end do
- end do
-
- do i=1,numreceptor
- xl=xreceptor(i)
- yl=yreceptor(i)
- iix=max(min(nint(xl),nxmin1),0)
- jjy=max(min(nint(yl),nymin1),0)
- !densityoutrecept(i)=rho(iix,jjy,1,2)
- densityoutrecept(i)=rho(iix,jjy,1,mind)
- ! RLT
- densitydryrecept(i)=rho_dry(iix,jjy,1,mind)
- end do
-
- ! RLT
- ! conversion factor for output relative to dry air
- factor_drygrid=densityoutgrid/densitydrygrid
- factor_dryrecept=densityoutrecept/densitydryrecept
+!$OMP END DO
+ ! conversion factor for output relative to dry air
+ factor_drygrid=densityoutgrid/densitydrygrid
+ if (llcmoutput) then
+ ! because divide grid by densityoutgrid
+ densityoutgrid=1./densityoutgrid
+ endif
+ else
+ ! no division by density
+ densityoutgrid(:,:,:)=1.
+ endif
! Output is different for forward and backward simulations
- do kz=1,numzgrid
- do jy=0,numygrid-1
- do ix=0,numxgrid-1
- if (ldirect.eq.1) then
- factor3d(ix,jy,kz)=1.e12/volume(ix,jy,kz)/outnum
- else
- factor3d(ix,jy,kz)=real(abs(loutaver))/outnum
- endif
+ if (ldirect.eq.1) then
+!$OMP DO
+ do kz=1,numzgrid
+ do jy=0,numygrid-1
+ do ix=0,numxgrid-1
+ if (llcmoutput) then
+ if (gridcnt(ix,jy,kz).gt.0.) then
+ factor3d(ix,jy,kz)=1.e12/gridcnt(ix,jy,kz)
+ else
+ factor3d(ix,jy,kz)=0.
+ endif
+ else
+ factor3d(ix,jy,kz)=1.e12/volume(ix,jy,kz)/outnum
+ endif
+ end do
end do
end do
- end do
+!$OMP END DO
+ else
+ factor3d(:,:,:)=real(abs(loutaver))/outnum
+ endif
!*********************************************************************
! Determine the standard deviation of the mean concentration or mixing
@@ -881,8 +1058,16 @@ subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, &
drygridsigmatotal=0.
drygridtotalunc=0.
- do ks=1,nspec
+ if (llcmoutput) then
+ ks_start=2
+ else
+ ks_start=1
+ endif
+ do ks=ks_start,nspec
+
+!$OMP BARRIER
+!$OMP SINGLE
write(anspec,'(i3.3)') ks
if (DRYBKDEP.or.WETBKDEP) then !scavdep output
@@ -910,10 +1095,11 @@ subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, &
write(unitoutgridppt) itime
endif
endif ! if deposition output
+!$OMP END SINGLE
do kp=1,maxpointspec_act
do nage=1,nageclass
-
+!$OMP DO
do jy=0,numygrid-1
do ix=0,numxgrid-1
@@ -975,6 +1161,7 @@ subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, &
end do
end do
end do
+!$OMP END DO
!*******************************************************************
! Generate output: may be in concentration (ng/m3) or in mixing
@@ -984,8 +1171,12 @@ subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, &
! For backward simulations, the unit is seconds, stored in grid_time
!*******************************************************************
+!$OMP BARRIER
+!$OMP SINGLE
+
! Concentration output
!*********************
+
if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
! Wet deposition
@@ -996,7 +1187,7 @@ subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, &
if ((ldirect.eq.1).and.(WETDEP)) then
do jy=0,numygrid-1
do ix=0,numxgrid-1
- !oncentraion greater zero
+ ! concentration greater zero
if (wetgrid(ix,jy).gt.smallnum) then
if (sp_zer.eqv..true.) then ! first non zero value
sp_count_i=sp_count_i+1
@@ -1054,14 +1245,14 @@ subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, &
write(unitoutgrid) sp_count_r
write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
-
-
! Concentrations
sp_count_i=0
sp_count_r=0
sp_fact=-1.
sp_zer=.true.
- do kz=1,numzgrid
+ numzwrite=numzgrid
+ if (sfc_only.eq.1) numzwrite=1
+ do kz=1,numzwrite
do jy=0,numygrid-1
do ix=0,numxgrid-1
if (grid(ix,jy,kz).gt.smallnum) then
@@ -1094,9 +1285,6 @@ subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, &
write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
write(unitoutgrid) sp_count_r
write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
-
-
-
endif ! concentration output
! Mixing ratio output
@@ -1138,7 +1326,6 @@ subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, &
write(unitoutgridppt) sp_count_r
write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
-
! Dry deposition
sp_count_i=0
sp_count_r=0
@@ -1173,13 +1360,14 @@ subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, &
write(unitoutgridppt) sp_count_r
write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
-
! Mixing ratios
sp_count_i=0
sp_count_r=0
sp_fact=-1.
sp_zer=.true.
- do kz=1,numzgrid
+ numzwrite=numzgrid
+ if (sfc_only.eq.1) numzwrite=1
+ do kz=1,numzwrite
do jy=0,numygrid-1
do ix=0,numxgrid-1
if (grid(ix,jy,kz).gt.smallnum) then
@@ -1193,8 +1381,7 @@ subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, &
sp_count_r=sp_count_r+1
sparse_dump_r(sp_count_r)= &
sp_fact* &
- 1.e12*grid(ix,jy,kz) &
- /volume(ix,jy,kz)/outnum* &
+ factor3d(ix,jy,kz)*grid(ix,jy,kz)* &
weightair/weightmolar(ks)/densityoutgrid(ix,jy,kz)
else ! concentration is zero
sp_zer=.true.
@@ -1208,7 +1395,8 @@ subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, &
write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
endif ! output for ppt
-
+!$OMP END SINGLE
+!$OMP BARRIER
end do
end do
@@ -1216,49 +1404,54 @@ subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, &
close(unitoutgrid)
end do
+!$OMP END PARALLEL
- ! RLT Aug 2017
! Write out conversion factor for dry air
- inquire(file=path(2)(1:length(2))//'factor_drygrid',exist=lexist)
- if (lexist) then
- ! open and append
- open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid',form='unformatted',&
+ !****************************************
+
+ if (.not.llcmoutput) then
+ inquire(file=path(2)(1:length(2))//'factor_drygrid',exist=lexist)
+ if (lexist) then
+ ! open and append
+ open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid',form='unformatted',&
status='old',action='write',access='append')
- else
- ! create new
- open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid',form='unformatted',&
+ else
+ ! create new
+ open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid',form='unformatted',&
status='new',action='write')
- endif
- sp_count_i=0
- sp_count_r=0
- sp_fact=-1.
- sp_zer=.true.
- do kz=1,numzgrid
- do jy=0,numygrid-1
- do ix=0,numxgrid-1
- if (factor_drygrid(ix,jy,kz).gt.(1.+smallnum).or.factor_drygrid(ix,jy,kz).lt.(1.-smallnum)) then
- if (sp_zer.eqv..true.) then ! first value not equal to one
- sp_count_i=sp_count_i+1
- sparse_dump_i(sp_count_i)= &
+ endif
+ sp_count_i=0
+ sp_count_r=0
+ sp_fact=-1.
+ sp_zer=.true.
+ numzwrite=numzgrid
+ if (sfc_only.eq.1) numzwrite=1
+ do kz=1,numzwrite
+ do jy=0,numygrid-1
+ do ix=0,numxgrid-1
+ if (factor_drygrid(ix,jy,kz).gt.(1.+smallnum).or.factor_drygrid(ix,jy,kz).lt.(1.-smallnum)) then
+ if (sp_zer.eqv..true.) then ! first value not equal to one
+ sp_count_i=sp_count_i+1
+ sparse_dump_i(sp_count_i)= &
ix+jy*numxgrid+kz*numxgrid*numygrid
- sp_zer=.false.
- sp_fact=sp_fact*(-1.)
+ sp_zer=.false.
+ sp_fact=sp_fact*(-1.)
+ endif
+ sp_count_r=sp_count_r+1
+ sparse_dump_r(sp_count_r)= &
+ sp_fact*factor_drygrid(ix,jy,kz)
+ else ! factor is one
+ sp_zer=.true.
endif
- sp_count_r=sp_count_r+1
- sparse_dump_r(sp_count_r)= &
- sp_fact*factor_drygrid(ix,jy,kz)
- else ! factor is one
- sp_zer=.true.
- endif
+ end do
end do
end do
- end do
- write(unitoutfactor) sp_count_i
- write(unitoutfactor) (sparse_dump_i(i),i=1,sp_count_i)
- write(unitoutfactor) sp_count_r
- write(unitoutfactor) (sparse_dump_r(i),i=1,sp_count_r)
- close(unitoutfactor)
-
+ write(unitoutfactor) sp_count_i
+ write(unitoutfactor) (sparse_dump_i(i),i=1,sp_count_i)
+ write(unitoutfactor) sp_count_r
+ write(unitoutfactor) (sparse_dump_r(i),i=1,sp_count_r)
+ close(unitoutfactor)
+ endif
if (gridtotal.gt.0.) gridtotalunc=gridsigmatotal/gridtotal
if (wetgridtotal.gt.0.) wetgridtotalunc=wetgridsigmatotal/ &
@@ -1266,53 +1459,20 @@ subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, &
if (drygridtotal.gt.0.) drygridtotalunc=drygridsigmatotal/ &
drygridtotal
- ! Dump of receptor concentrations
-
- if (numreceptor.gt.0 .and. (iout.eq.2 .or. iout.eq.3) ) then
- write(unitoutreceptppt) itime
- do ks=1,nspec
- write(unitoutreceptppt) (1.e12*creceptor(i,ks)/outnum* &
- weightair/weightmolar(ks)/densityoutrecept(i),i=1,numreceptor)
- end do
- endif
-
- ! Dump of receptor concentrations
-
- if (numreceptor.gt.0) then
- write(unitoutrecept) itime
- do ks=1,nspec
- write(unitoutrecept) (1.e12*creceptor(i,ks)/outnum, &
- i=1,numreceptor)
- end do
- endif
-
- ! RLT Aug 2017
- ! Write out conversion factor for dry air
- if (numreceptor.gt.0) then
- inquire(file=path(2)(1:length(2))//'factor_dryreceptor',exist=lexist)
- if (lexist) then
- ! open and append
- open(unitoutfactor,file=path(2)(1:length(2))//'factor_dryreceptor',form='unformatted',&
- status='old',action='write',access='append')
- else
- ! create new
- open(unitoutfactor,file=path(2)(1:length(2))//'factor_dryreceptor',form='unformatted',&
- status='new',action='write')
- endif
- write(unitoutfactor) itime
- write(unitoutfactor) (factor_dryrecept(i),i=1,numreceptor)
- close(unitoutfactor)
- endif
-
- creceptor(:,:)=0.
gridunc(:,:,:,:,:,:,:)=0.
+ gridcnt(:,:,:) = 0.
+#ifdef _OPENMP
+ gridunc_omp(:,:,:,:,:,:,:,:) = 0.
+ gridcnt_omp(:,:,:,:) = 0.
+#endif
+
end subroutine concoutput
subroutine concoutput_nest(itime,outnum)
! i i
!*****************************************************************************
! *
- ! Output of the concentration grid and the receptor concentrations. *
+ ! Output of the nested concentration grid *
! *
! Author: A. Stohl *
! *
@@ -1352,29 +1512,7 @@ subroutine concoutput_nest(itime,outnum)
integer :: itime,i,ix,jy,kz,ks,kp,l,iix,jjy,kzz,nage,jjjjmmdd,ihmmss
integer :: sp_count_i,sp_count_r
real :: sp_fact
- real :: outnum,densityoutrecept(numreceptor),xl,yl
- ! RLT
- real :: densitydryrecept(numreceptor)
- real :: factor_dryrecept(numreceptor)
-
- !real densityoutgrid(0:numxgrid-1,0:numygrid-1,numzgrid),
- ! +grid(0:numxgrid-1,0:numygrid-1,numzgrid,maxspec,maxpointspec_act,
- ! + maxageclass)
- !real wetgrid(0:numxgrid-1,0:numygrid-1,maxspec,maxpointspec_act,
- ! + maxageclass)
- !real drygrid(0:numxgrid-1,0:numygrid-1,maxspec,
- ! + maxpointspec_act,maxageclass)
- !real gridsigma(0:numxgrid-1,0:numygrid-1,numzgrid,maxspec,
- ! + maxpointspec_act,maxageclass),
- ! + drygridsigma(0:numxgrid-1,0:numygrid-1,maxspec,
- ! + maxpointspec_act,maxageclass),
- ! + wetgridsigma(0:numxgrid-1,0:numygrid-1,maxspec,
- ! + maxpointspec_act,maxageclass)
- !real factor(0:numxgrid-1,0:numygrid-1,numzgrid)
- !real sparse_dump_r(numxgrid*numygrid*numzgrid)
- !integer sparse_dump_i(numxgrid*numygrid*numzgrid)
-
- !real sparse_dump_u(numxgrid*numygrid*numzgrid)
+ real :: outnum,xl,yl
real(dep_prec) :: auxgrid(nclassunc)
real :: halfheight,dz,dz1,dz2,tot_mu(maxspec,maxpointspec_act)
real,parameter :: smallnum = tiny(0.0) ! smallest number that can be handled
@@ -1384,6 +1522,7 @@ subroutine concoutput_nest(itime,outnum)
character(len=3) :: anspec
logical :: lexist
integer :: mind
+ integer :: numzwrite
! Determine current calendar date, needed for the file name
@@ -1401,19 +1540,15 @@ subroutine concoutput_nest(itime,outnum)
!*****************************************************************
- if (ldirect.eq.1) then
- do ks=1,nspec
- do kp=1,maxpointspec_act
- tot_mu(ks,kp)=1
- end do
- end do
- else
- do ks=1,nspec
- do kp=1,maxpointspec_act
- tot_mu(ks,kp)=xmass(kp,ks)
- end do
+ if (ldirect.eq.1) then
+ tot_mu(:,:)=1.
+ else
+ do ks=1,nspec
+ do kp=1,maxpointspec_act
+ tot_mu(ks,kp)=xmass(kp,ks)
end do
- endif
+ end do
+ endif
!*******************************************************************
@@ -1424,6 +1559,12 @@ subroutine concoutput_nest(itime,outnum)
!*******************************************************************
mind=memind(2)
+
+!$OMP PARALLEL &
+!$OMP PRIVATE(halfheight,kzz,dz1,dz2,dz,xl,yl,iix,jjy, &
+!$OMP kz,ix,jy,l,ks,kp,nage,auxgrid)
+
+!$OMP DO
do kz=1,numzgrid
if (kz.eq.1) then
halfheight=outheight(1)*0.5
@@ -1432,9 +1573,9 @@ subroutine concoutput_nest(itime,outnum)
endif
do kzz=2,nz
if ((height(kzz-1).lt.halfheight).and. &
- (height(kzz).gt.halfheight)) goto 46
+ (height(kzz).gt.halfheight)) exit
end do
-46 kzz=max(min(kzz,nz),2)
+ kzz=max(min(kzz,nz),2)
dz1=halfheight-height(kzz-1)
dz2=height(kzz)-halfheight
dz=dz1+dz2
@@ -1446,45 +1587,24 @@ subroutine concoutput_nest(itime,outnum)
yl=(yl-ylat0)/dy
iix=max(min(nint(xl),nxmin1),0)
jjy=max(min(nint(yl),nymin1),0)
- ! densityoutgrid(ix,jy,kz)=(rho(iix,jjy,kzz,2)*dz1+ &
- ! rho(iix,jjy,kzz-1,2)*dz2)/dz
densityoutgrid(ix,jy,kz)=(rho(iix,jjy,kzz,mind)*dz1+ &
rho(iix,jjy,kzz-1,mind)*dz2)/dz
- ! RLT
densitydrygrid(ix,jy,kz)=(rho_dry(iix,jjy,kzz,mind)*dz1+ &
rho_dry(iix,jjy,kzz-1,mind)*dz2)/dz
end do
end do
end do
+!$OMP END DO
- do i=1,numreceptor
- xl=xreceptor(i)
- yl=yreceptor(i)
- iix=max(min(nint(xl),nxmin1),0)
- jjy=max(min(nint(yl),nymin1),0)
- !densityoutrecept(i)=rho(iix,jjy,1,2)
- densityoutrecept(i)=rho(iix,jjy,1,mind)
- ! RLT
- densitydryrecept(i)=rho_dry(iix,jjy,1,mind)
- end do
-
- ! RLT
! conversion factor for output relative to dry air
factor_drygrid=densityoutgrid/densitydrygrid
- factor_dryrecept=densityoutrecept/densitydryrecept
! Output is different for forward and backward simulations
- do kz=1,numzgrid
- do jy=0,numygridn-1
- do ix=0,numxgridn-1
- if (ldirect.eq.1) then
- factor3d(ix,jy,kz)=1.e12/volumen(ix,jy,kz)/outnum
- else
- factor3d(ix,jy,kz)=real(abs(loutaver))/outnum
- endif
- end do
- end do
- end do
+ if ( ldirect.eq.1) then
+ factor3d(:,:,:)=1.e12/volumen(:,:,:)/outnum
+ else
+ factor3d(:,:,:)=real(abs(loutaver))/outnum
+ endif
!*********************************************************************
! Determine the standard deviation of the mean concentration or mixing
@@ -1493,9 +1613,11 @@ subroutine concoutput_nest(itime,outnum)
do ks=1,nspec
- write(anspec,'(i3.3)') ks
+!$OMP BARRIER
+!$OMP SINGLE
+ write(anspec,'(i3.3)') ks
- if (DRYBKDEP.or.WETBKDEP) then !scavdep output
+ if (DRYBKDEP.or.WETBKDEP) then !scavdep output
if (DRYBKDEP) &
open(unitoutgrid,file=path(2)(1:length(2))//'grid_drydep_nest_'//adate// &
atime//'_'//anspec,form='unformatted')
@@ -1503,1264 +1625,67 @@ subroutine concoutput_nest(itime,outnum)
open(unitoutgrid,file=path(2)(1:length(2))//'grid_wetdep_nest_'//adate// &
atime//'_'//anspec,form='unformatted')
write(unitoutgrid) itime
- else
- if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
- if (ldirect.eq.1) then
- open(unitoutgrid,file=path(2)(1:length(2))//'grid_conc_nest_' &
- //adate// &
- atime//'_'//anspec,form='unformatted')
- else
- open(unitoutgrid,file=path(2)(1:length(2))//'grid_time_nest_' &
- //adate// &
- atime//'_'//anspec,form='unformatted')
- endif
- write(unitoutgrid) itime
- endif
- endif
-
- if ((iout.eq.2).or.(iout.eq.3)) then ! mixing ratio
- open(unitoutgridppt,file=path(2)(1:length(2))//'grid_pptv_nest_' &
- //adate// &
- atime//'_'//anspec,form='unformatted')
-
- write(unitoutgridppt) itime
- endif
+ else
+ if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
+ if (ldirect.eq.1) then
+ open(unitoutgrid,file=path(2)(1:length(2))//'grid_conc_nest_' &
+ //adate// &
+ atime//'_'//anspec,form='unformatted')
+ else
+ open(unitoutgrid,file=path(2)(1:length(2))//'grid_time_nest_' &
+ //adate// &
+ atime//'_'//anspec,form='unformatted')
+ endif
+ write(unitoutgrid) itime
+ endif
+ endif
+ if ((iout.eq.2).or.(iout.eq.3)) then ! mixing ratio
+ open(unitoutgridppt,file=path(2)(1:length(2))//'grid_pptv_nest_' &
+ //adate// &
+ atime//'_'//anspec,form='unformatted')
- do kp=1,maxpointspec_act
- do nage=1,nageclass
+ write(unitoutgridppt) itime
+ endif
+!$OMP END SINGLE
- do jy=0,numygridn-1
- do ix=0,numxgridn-1
+ do kp=1,maxpointspec_act
+ do nage=1,nageclass
+!$OMP DO
+ do jy=0,numygridn-1
+ do ix=0,numxgridn-1
! WET DEPOSITION
- if ((WETDEP).and.(ldirect.gt.0)) then
- do l=1,nclassunc
- auxgrid(l)=wetgriduncn(ix,jy,ks,kp,l,nage)
- end do
- call mean(auxgrid,wetgrid(ix,jy), &
- wetgridsigma(ix,jy),nclassunc)
+ if ((WETDEP).and.(ldirect.gt.0)) then
+ do l=1,nclassunc
+ auxgrid(l)=wetgriduncn(ix,jy,ks,kp,l,nage)
+ end do
+ call mean(auxgrid,wetgrid(ix,jy), &
+ wetgridsigma(ix,jy),nclassunc)
! Multiply by number of classes to get total concentration
- wetgrid(ix,jy)=wetgrid(ix,jy) &
- *nclassunc
+ wetgrid(ix,jy)=wetgrid(ix,jy) &
+ *nclassunc
! Calculate standard deviation of the mean
- wetgridsigma(ix,jy)= &
- wetgridsigma(ix,jy)* &
- sqrt(real(nclassunc))
- endif
+ wetgridsigma(ix,jy)= &
+ wetgridsigma(ix,jy)* &
+ sqrt(real(nclassunc))
+ endif
! DRY DEPOSITION
- if ((DRYDEP).and.(ldirect.gt.0)) then
- do l=1,nclassunc
- auxgrid(l)=drygriduncn(ix,jy,ks,kp,l,nage)
- end do
- call mean(auxgrid,drygrid(ix,jy), &
- drygridsigma(ix,jy),nclassunc)
- ! Multiply by number of classes to get total concentration
- drygrid(ix,jy)=drygrid(ix,jy)* &
- nclassunc
- ! Calculate standard deviation of the mean
- drygridsigma(ix,jy)= &
- drygridsigma(ix,jy)* &
- sqrt(real(nclassunc))
- endif
-
- ! CONCENTRATION OR MIXING RATIO
- do kz=1,numzgrid
- do l=1,nclassunc
- auxgrid(l)=griduncn(ix,jy,kz,ks,kp,l,nage)
- end do
- call mean(auxgrid,grid(ix,jy,kz), &
- gridsigma(ix,jy,kz),nclassunc)
- ! Multiply by number of classes to get total concentration
- grid(ix,jy,kz)= &
- grid(ix,jy,kz)*nclassunc
- ! Calculate standard deviation of the mean
- gridsigma(ix,jy,kz)= &
- gridsigma(ix,jy,kz)* &
- sqrt(real(nclassunc))
- end do
- end do
- end do
-
-
- !*******************************************************************
- ! Generate output: may be in concentration (ng/m3) or in mixing
- ! ratio (ppt) or both
- ! Output the position and the values alternated multiplied by
- ! 1 or -1, first line is number of values, number of positions
- ! For backward simulations, the unit is seconds, stored in grid_time
- !*******************************************************************
-
- ! Concentration output
- !*********************
- if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
-
- ! Wet deposition
- sp_count_i=0
- sp_count_r=0
- sp_fact=-1.
- sp_zer=.true.
- if ((ldirect.eq.1).and.(WETDEP)) then
- do jy=0,numygridn-1
- do ix=0,numxgridn-1
- !oncentraion greater zero
- if (wetgrid(ix,jy).gt.smallnum) then
- if (sp_zer.eqv..true.) then ! first non zero value
- sp_count_i=sp_count_i+1
- sparse_dump_i(sp_count_i)=ix+jy*numxgridn
- sp_zer=.false.
- sp_fact=sp_fact*(-1.)
- endif
- sp_count_r=sp_count_r+1
- sparse_dump_r(sp_count_r)= &
- sp_fact*1.e12*real(wetgrid(ix,jy))/arean(ix,jy)
- ! sparse_dump_u(sp_count_r)=
- !+ 1.e12*wetgridsigma(ix,jy,ks,kp,nage)/area(ix,jy)
- else ! concentration is zero
- sp_zer=.true.
- endif
- end do
- end do
- else
- sp_count_i=0
- sp_count_r=0
- endif
- write(unitoutgrid) sp_count_i
- write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
- write(unitoutgrid) sp_count_r
- write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
- ! write(unitoutgrid) sp_count_u
- ! write(unitoutgrid) (sparse_dump_u(i),i=1,sp_count_r)
-
- ! Dry deposition
- sp_count_i=0
- sp_count_r=0
- sp_fact=-1.
- sp_zer=.true.
- if ((ldirect.eq.1).and.(DRYDEP)) then
- do jy=0,numygridn-1
- do ix=0,numxgridn-1
- if (drygrid(ix,jy).gt.smallnum) then
- if (sp_zer.eqv..true.) then ! first non zero value
- sp_count_i=sp_count_i+1
- sparse_dump_i(sp_count_i)=ix+jy*numxgridn
- sp_zer=.false.
- sp_fact=sp_fact*(-1.)
- endif
- sp_count_r=sp_count_r+1
- sparse_dump_r(sp_count_r)= &
- sp_fact* &
- 1.e12*real(drygrid(ix,jy))/arean(ix,jy)
- ! sparse_dump_u(sp_count_r)=
- !+ 1.e12*drygridsigma(ix,jy,ks,kp,nage)/area(ix,jy)
- else ! concentration is zero
- sp_zer=.true.
- endif
- end do
- end do
- else
- sp_count_i=0
- sp_count_r=0
- endif
- write(unitoutgrid) sp_count_i
- write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
- write(unitoutgrid) sp_count_r
- write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
- ! write(*,*) sp_count_u
- ! write(unitoutgrid) (sparse_dump_u(i),i=1,sp_count_r)
-
-
-
- ! Concentrations
- sp_count_i=0
- sp_count_r=0
- sp_fact=-1.
- sp_zer=.true.
- do kz=1,numzgrid
- do jy=0,numygridn-1
- do ix=0,numxgridn-1
- if (grid(ix,jy,kz).gt.smallnum) then
- if (sp_zer.eqv..true.) then ! first non zero value
- sp_count_i=sp_count_i+1
- sparse_dump_i(sp_count_i)= &
- ix+jy*numxgridn+kz*numxgridn*numygridn
- sp_zer=.false.
- sp_fact=sp_fact*(-1.)
- endif
- sp_count_r=sp_count_r+1
- sparse_dump_r(sp_count_r)= &
- sp_fact* &
- grid(ix,jy,kz)* &
- factor3d(ix,jy,kz)/tot_mu(ks,kp)
- ! if ((factor(ix,jy,kz)/tot_mu(ks,kp)).eq.0)
- ! + write (*,*) factor(ix,jy,kz),tot_mu(ks,kp),ks,kp
- ! sparse_dump_u(sp_count_r)=
- !+ ,gridsigma(ix,jy,kz,ks,kp,nage)*
- !+ factor(ix,jy,kz)/tot_mu(ks,kp)
- else ! concentration is zero
- sp_zer=.true.
- endif
- end do
- end do
- end do
- write(unitoutgrid) sp_count_i
- write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
- write(unitoutgrid) sp_count_r
- write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
- ! write(unitoutgrid) sp_count_u
- ! write(unitoutgrid) (sparse_dump_u(i),i=1,sp_count_r)
-
-
-
- endif ! concentration output
-
- ! Mixing ratio output
- !********************
-
- if ((iout.eq.2).or.(iout.eq.3)) then ! mixing ratio
-
- ! Wet deposition
- sp_count_i=0
- sp_count_r=0
- sp_fact=-1.
- sp_zer=.true.
- if ((ldirect.eq.1).and.(WETDEP)) then
- do jy=0,numygridn-1
- do ix=0,numxgridn-1
- if (wetgrid(ix,jy).gt.smallnum) then
- if (sp_zer.eqv..true.) then ! first non zero value
- sp_count_i=sp_count_i+1
- sparse_dump_i(sp_count_i)= &
- ix+jy*numxgridn
- sp_zer=.false.
- sp_fact=sp_fact*(-1.)
- endif
- sp_count_r=sp_count_r+1
- sparse_dump_r(sp_count_r)= &
- sp_fact* &
- 1.e12*real(wetgrid(ix,jy))/arean(ix,jy)
- ! sparse_dump_u(sp_count_r)=
- ! + ,1.e12*wetgridsigma(ix,jy,ks,kp,nage)/area(ix,jy)
- else ! concentration is zero
- sp_zer=.true.
- endif
- end do
- end do
- else
- sp_count_i=0
- sp_count_r=0
- endif
- write(unitoutgridppt) sp_count_i
- write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
- write(unitoutgridppt) sp_count_r
- write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
- ! write(unitoutgridppt) sp_count_u
- ! write(unitoutgridppt) (sparse_dump_u(i),i=1,sp_count_r)
-
-
- ! Dry deposition
- sp_count_i=0
- sp_count_r=0
- sp_fact=-1.
- sp_zer=.true.
- if ((ldirect.eq.1).and.(DRYDEP)) then
- do jy=0,numygridn-1
- do ix=0,numxgridn-1
- if (drygrid(ix,jy).gt.smallnum) then
- if (sp_zer.eqv..true.) then ! first non zero value
- sp_count_i=sp_count_i+1
- sparse_dump_i(sp_count_i)= &
- ix+jy*numxgridn
- sp_zer=.false.
- sp_fact=sp_fact*(-1)
- endif
- sp_count_r=sp_count_r+1
- sparse_dump_r(sp_count_r)= &
- sp_fact* &
- 1.e12*real(drygrid(ix,jy))/arean(ix,jy)
- ! sparse_dump_u(sp_count_r)=
- ! + ,1.e12*drygridsigma(ix,jy,ks,kp,nage)/area(ix,jy)
- else ! concentration is zero
- sp_zer=.true.
- endif
- end do
- end do
- else
- sp_count_i=0
- sp_count_r=0
- endif
- write(unitoutgridppt) sp_count_i
- write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
- write(unitoutgridppt) sp_count_r
- write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
- ! write(unitoutgridppt) sp_count_u
- ! write(unitoutgridppt) (sparse_dump_u(i),i=1,sp_count_r)
-
-
- ! Mixing ratios
- sp_count_i=0
- sp_count_r=0
- sp_fact=-1.
- sp_zer=.true.
- do kz=1,numzgrid
- do jy=0,numygridn-1
- do ix=0,numxgridn-1
- if (grid(ix,jy,kz).gt.smallnum) then
- if (sp_zer.eqv..true.) then ! first non zero value
- sp_count_i=sp_count_i+1
- sparse_dump_i(sp_count_i)= &
- ix+jy*numxgridn+kz*numxgridn*numygridn
- sp_zer=.false.
- sp_fact=sp_fact*(-1.)
- endif
- sp_count_r=sp_count_r+1
- sparse_dump_r(sp_count_r)= &
- sp_fact* &
- 1.e12*grid(ix,jy,kz) &
- /volumen(ix,jy,kz)/outnum* &
- weightair/weightmolar(ks)/densityoutgrid(ix,jy,kz)
- ! sparse_dump_u(sp_count_r)=
- !+ ,1.e12*gridsigma(ix,jy,kz,ks,kp,nage)/volume(ix,jy,kz)/
- !+ outnum*weightair/weightmolar(ks)/
- !+ densityoutgrid(ix,jy,kz)
- else ! concentration is zero
- sp_zer=.true.
- endif
- end do
- end do
- end do
- write(unitoutgridppt) sp_count_i
- write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
- write(unitoutgridppt) sp_count_r
- write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
- ! write(unitoutgridppt) sp_count_u
- ! write(unitoutgridppt) (sparse_dump_u(i),i=1,sp_count_r)
-
- endif ! output for ppt
-
- end do
- end do
- close(unitoutgridppt)
- close(unitoutgrid)
-
- end do
-
- ! RLT Aug 2017
- ! Write out conversion factor for dry air
- inquire(file=path(2)(1:length(2))//'factor_drygrid_nest',exist=lexist)
- if (lexist) then
- ! open and append
- open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid_nest',form='unformatted',&
- status='old',action='write',access='append')
- else
- ! create new
- open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid_nest',form='unformatted',&
- status='new',action='write')
- endif
- sp_count_i=0
- sp_count_r=0
- sp_fact=-1.
- sp_zer=.true.
- do kz=1,numzgrid
- do jy=0,numygridn-1
- do ix=0,numxgridn-1
- if (factor_drygrid(ix,jy,kz).gt.(1.+smallnum).or.factor_drygrid(ix,jy,kz).lt.(1.-smallnum)) then
- if (sp_zer.eqv..true.) then ! first value not equal to one
- sp_count_i=sp_count_i+1
- sparse_dump_i(sp_count_i)= &
- ix+jy*numxgridn+kz*numxgridn*numygridn
- sp_zer=.false.
- sp_fact=sp_fact*(-1.)
- endif
- sp_count_r=sp_count_r+1
- sparse_dump_r(sp_count_r)= &
- sp_fact*factor_drygrid(ix,jy,kz)
- else ! factor is one
- sp_zer=.true.
- endif
- end do
- end do
- end do
- write(unitoutfactor) sp_count_i
- write(unitoutfactor) (sparse_dump_i(i),i=1,sp_count_i)
- write(unitoutfactor) sp_count_r
- write(unitoutfactor) (sparse_dump_r(i),i=1,sp_count_r)
- close(unitoutfactor)
-
- creceptor(:,:)=0.
- griduncn(:,:,:,:,:,:,:)=0.
-end subroutine concoutput_nest
-
-subroutine concoutput_inversion(itime,outnum,gridtotalunc,wetgridtotalunc, &
- drygridtotalunc)
- ! i i o o
- ! o
- !*****************************************************************************
- ! *
- ! Output of the concentration grid and the receptor concentrations. *
- ! *
- ! Author: A. Stohl *
- ! *
- ! 24 May 1995 *
- ! *
- ! 13 April 1999, Major update: if output size is smaller, dump output *
- ! in sparse matrix format; additional output of *
- ! uncertainty *
- ! *
- ! 05 April 2000, Major update: output of age classes; output for backward*
- ! runs is time spent in grid cell times total mass of *
- ! species. *
- ! *
- ! 17 February 2002, Appropriate dimensions for backward and forward runs *
- ! are now specified in file par_mod *
- ! *
- ! June 2006, write grid in sparse matrix with a single write command *
- ! in order to save disk space *
- ! *
- ! 2008 new sparse matrix format *
- !
- ! January 2017, Separate files by release but include all timesteps
- ! *
- !*****************************************************************************
- ! *
- ! Variables: *
- ! outnum number of samples *
- ! ncells number of cells with non-zero concentrations *
- ! sparse .true. if in sparse matrix format, else .false. *
- ! tot_mu 1 for forward, initial mass mixing ration for backw. runs *
- ! *
- !*****************************************************************************
-
- use unc_mod
- use mean_mod
-
- implicit none
-
- real(kind=dp) :: jul
- integer :: itime,i,ix,jy,kz,ks,kp,l,iix,jjy,kzz,nage,jjjjmmdd,ihmmss
- integer :: sp_count_i,sp_count_r
- real :: sp_fact
- real :: outnum,densityoutrecept(numreceptor),xl,yl
- ! RLT
- real :: densitydryrecept(numreceptor)
- real :: factor_dryrecept(numreceptor)
-
-
- real(dep_prec) :: auxgrid(nclassunc)
- real(sp) :: gridtotal,gridsigmatotal,gridtotalunc
- real(dep_prec) :: wetgridtotal,wetgridsigmatotal,wetgridtotalunc
- real(dep_prec) :: drygridtotal,drygridsigmatotal,drygridtotalunc
- real :: halfheight,dz,dz1,dz2,tot_mu(maxspec,maxpointspec_act)
- real,parameter :: smallnum = tiny(0.0) ! smallest number that can be handled
- real,parameter :: weightair=28.97
- logical :: sp_zer
- character :: adate*8,atime*6
- character(len=3) :: anspec
- logical :: lexist
- character :: areldate*8,areltime*6
- logical,save :: lstart=.true.
- logical,save,allocatable,dimension(:) :: lstartrel
- integer :: ierr
- character(LEN=100) :: dates_char
- integer, parameter :: unitrelnames=654
-
-
- if(lstart) then
- allocate(lstartrel(maxpointspec_act))
- lstartrel(:)=.true.
- endif
- print*, 'lstartrel = ',lstartrel
-
- if (verbosity.eq.1) then
- print*,'inside concoutput_inversion '
- CALL SYSTEM_CLOCK(count_clock)
- WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0
- endif
-
- ! Determine current calendar date
- !**********************************************************
-
- jul=bdate+real(itime,kind=dp)/86400._dp
- call caldate(jul,jjjjmmdd,ihmmss)
- write(adate,'(i8.8)') jjjjmmdd
- write(atime,'(i6.6)') ihmmss
-
-
- ! Prepare output files for dates
- !**********************************************************
-
- ! Overwrite existing dates file on first call, later append to it
- ! If 'dates' file exists in output directory, copy to new file dates.old
- inquire(file=path(2)(1:length(2))//'dates', exist=lexist)
- if (lexist.and.lstart) then
- ! copy contents of existing dates file to dates.old
- print*, 'warning: replacing old dates file'
- open(unit=unitdates, file=path(2)(1:length(2))//'dates',form='formatted', &
- &access='sequential', status='old', action='read', iostat=ierr)
- open(unit=unittmp, file=path(2)(1:length(2))//'dates.old', access='sequential', &
- &status='replace', action='write', form='formatted', iostat=ierr)
- do while (.true.)
- read(unitdates, '(a)', iostat=ierr) dates_char
- if (ierr.ne.0) exit
- write(unit=unittmp, fmt='(a)', iostat=ierr, advance='yes') trim(dates_char)
- end do
- close(unit=unitdates)
- close(unit=unittmp)
- ! create new dates file
- open(unit=unitdates, file=path(2)(1:length(2))//'dates',form='formatted', &
- &access='sequential', status='replace', iostat=ierr)
- close(unit=unitdates)
- endif
-
- open(unitdates,file=path(2)(1:length(2))//'dates', ACCESS='APPEND')
- write(unitdates,'(a)') adate//atime
- close(unitdates)
-
- !CGZ: Make a filename with names of releases
- if (lstart) then
- open(unit=unitrelnames, file=path(2)(1:length(2))//'releases_out',form='formatted', &
- &access='sequential', status='replace', iostat=ierr)
- close(unitrelnames)
- endif
-
- print*, 'after creating dates files: lstart = ',lstart
- ! print*, 'outnum:',outnum
- ! print*, 'datetime:',adate//atime
-
-
- ! For forward simulations, output fields have dimension MAXSPEC,
- ! for backward simulations, output fields have dimension MAXPOINT.
- ! Thus, make loops either about nspec, or about numpoint
- !*****************************************************************
-
-
- if (ldirect.eq.1) then
- do ks=1,nspec
- do kp=1,maxpointspec_act
- tot_mu(ks,kp)=1
- end do
- end do
- else
- do ks=1,nspec
- do kp=1,maxpointspec_act
- tot_mu(ks,kp)=xmass(kp,ks)
- end do
- end do
- endif
-
-
- if (verbosity.eq.1) then
- print*,'concoutput_inversion 2'
- CALL SYSTEM_CLOCK(count_clock)
- WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0
- endif
-
- !*******************************************************************
- ! Compute air density: sufficiently accurate to take it
- ! from coarse grid at some time
- ! Determine center altitude of output layer, and interpolate density
- ! data to that altitude
- !*******************************************************************
-
- do kz=1,numzgrid
- if (kz.eq.1) then
- halfheight=outheight(1)*0.5
- else
- halfheight=(outheight(kz)+outheight(kz-1))*0.5
- endif
- do kzz=2,nz
- if ((height(kzz-1).lt.halfheight).and. &
- (height(kzz).gt.halfheight)) goto 46
- end do
-46 kzz=max(min(kzz,nz),2)
- dz1=halfheight-height(kzz-1)
- dz2=height(kzz)-halfheight
- dz=dz1+dz2
- do jy=0,numygrid-1
- do ix=0,numxgrid-1
- xl=outlon0+real(ix)*dxout
- yl=outlat0+real(jy)*dyout
- xl=(xl-xlon0)/dx
- yl=(yl-ylat0)/dy
- iix=max(min(nint(xl),nxmin1),0)
- jjy=max(min(nint(yl),nymin1),0)
- densityoutgrid(ix,jy,kz)=(rho(iix,jjy,kzz,2)*dz1+ &
- rho(iix,jjy,kzz-1,2)*dz2)/dz
- ! RLT
- densitydrygrid(ix,jy,kz)=(rho_dry(iix,jjy,kzz,2)*dz1+ &
- rho_dry(iix,jjy,kzz-1,2)*dz2)/dz
- end do
- end do
- end do
-
- do i=1,numreceptor
- xl=xreceptor(i)
- yl=yreceptor(i)
- iix=max(min(nint(xl),nxmin1),0)
- jjy=max(min(nint(yl),nymin1),0)
- densityoutrecept(i)=rho(iix,jjy,1,2)
- ! RLT
- densitydryrecept(i)=rho_dry(iix,jjy,1,2)
- end do
-
- ! RLT
- ! conversion factor for output relative to dry air
- factor_drygrid=densityoutgrid/densitydrygrid
- factor_dryrecept=densityoutrecept/densitydryrecept
-
- ! Output is different for forward and backward simulations
- do kz=1,numzgrid
- do jy=0,numygrid-1
- do ix=0,numxgrid-1
- if (ldirect.eq.1) then
- factor3d(ix,jy,kz)=1.e12/volume(ix,jy,kz)/outnum
- else
- factor3d(ix,jy,kz)=real(abs(loutaver))/outnum
- endif
- end do
- end do
- end do
-
- !*********************************************************************
- ! Determine the standard deviation of the mean concentration or mixing
- ! ratio (uncertainty of the output) and the dry and wet deposition
- !*********************************************************************
-
- if (verbosity.eq.1) then
- print*,'concoutput_inversion 3 (sd)'
- CALL SYSTEM_CLOCK(count_clock)
- WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0
- endif
- gridtotal=0.
- gridsigmatotal=0.
- gridtotalunc=0.
- wetgridtotal=0.
- wetgridsigmatotal=0.
- wetgridtotalunc=0.
- drygridtotal=0.
- drygridsigmatotal=0.
- drygridtotalunc=0.
-
- do ks=1,nspec
-
- write(anspec,'(i3.3)') ks
-
- ! loop over releases
- do kp=1,maxpointspec_act
-
- print*, 'itime = ',itime
- !print*, 'lage(1) = ',lage(1)
- print*, 'ireleasestart(kp) = ',ireleasestart(kp)
- print*, 'ireleaseend(kp) = ',ireleaseend(kp)
-
- ! check itime is within release and backward trajectory length
- if (nageclass.eq.1) then
- if ((itime.gt.ireleaseend(kp)).or.(itime.lt.(ireleasestart(kp)-lage(1)))) then
- go to 10
- endif
- endif
-
- ! calculate date of release for filename
- jul=bdate+real(ireleasestart(kp),kind=dp)/86400._dp ! this is the current day
- call caldate(jul,jjjjmmdd,ihmmss)
- write(areldate,'(i8.8)') jjjjmmdd
- write(areltime,'(i6.6)') ihmmss
- print*, 'areldate/areltime = ',areldate//areltime
-
- ! calculate date of field
- jul=bdate+real(itime,kind=dp)/86400._dp
- call caldate(jul,jjjjmmdd,ihmmss)
- write(adate,'(i8.8)') jjjjmmdd
- write(atime,'(i6.6)') ihmmss
-
- if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
- if (ldirect.eq.1) then
- ! concentrations
- inquire(file=path(2)(1:length(2))//'grid_conc_'//areldate// &
- areltime//'_'//anspec,exist=lexist)
- if(lexist.and..not.lstartrel(kp)) then
- ! open and append to existing file
- open(unitoutgrid,file=path(2)(1:length(2))//'grid_conc_'//areldate// &
- areltime//'_'//anspec,form='unformatted',status='old',action='write',access='append')
- else
- ! open new file
- open(unitoutgrid,file=path(2)(1:length(2))//'grid_conc_'//areldate// &
- areltime//'_'//anspec,form='unformatted',status='replace',action='write')
- endif
- else
- ! residence times
- inquire(file=path(2)(1:length(2))//'grid_time_'//areldate// &
- areltime//'_'//anspec,exist=lexist)
- if(lexist.and..not.lstartrel(kp)) then
- ! open and append to existing file
- open(unitoutgrid,file=path(2)(1:length(2))//'grid_time_'//areldate// &
- areltime//'_'//anspec,form='unformatted',status='old',action='write',access='append')
- else
- ! open new file
- open(unitoutgrid,file=path(2)(1:length(2))//'grid_time_'//areldate// &
- areltime//'_'//anspec,form='unformatted',status='replace',action='write')
- ! add part of the filename to a file (similar to dates) for easier post-processing
- open(unit=unitrelnames, file=path(2)(1:length(2))//'releases_out',form='formatted', &
- & access='APPEND', iostat=ierr)
- write(unitrelnames,'(a)') areldate//areltime//'_'//anspec
- close(unitrelnames)
- endif
- endif
- write(unitoutgrid) jjjjmmdd
- write(unitoutgrid) ihmmss
- endif
-
- if ((iout.eq.2).or.(iout.eq.3)) then
- ! mixing ratio
- inquire(file=path(2)(1:length(2))//'grid_pptv_'//areldate// &
- areltime//'_'//anspec,exist=lexist)
- if(lexist.and..not.lstartrel(kp)) then
- ! open and append to existing file
- open(unitoutgridppt,file=path(2)(1:length(2))//'grid_pptv_'//areldate// &
- areltime//'_'//anspec,form='unformatted',status='old',action='write',access='append')
- else
- ! open new file
- open(unitoutgridppt,file=path(2)(1:length(2))//'grid_pptv_'//areldate// &
- areltime//'_'//anspec,form='unformatted',status='replace',action='write')
- endif
- write(unitoutgridppt) jjjjmmdd
- write(unitoutgridppt) ihmmss
- endif
-
- lstartrel(kp)=.false.
-
- do nage=1,nageclass
-
- do jy=0,numygrid-1
- do ix=0,numxgrid-1
-
- ! CONCENTRATION OR MIXING RATIO
- do kz=1,numzgrid
- do l=1,nclassunc
- auxgrid(l)=gridunc(ix,jy,kz,ks,kp,l,nage)
- end do
- call mean(auxgrid,grid(ix,jy,kz), &
- gridsigma(ix,jy,kz),nclassunc)
- ! Multiply by number of classes to get total concentration
- grid(ix,jy,kz)= &
- grid(ix,jy,kz)*nclassunc
- gridtotal=gridtotal+grid(ix,jy,kz)
- ! Calculate standard deviation of the mean
- gridsigma(ix,jy,kz)= &
- gridsigma(ix,jy,kz)* &
- sqrt(real(nclassunc))
- gridsigmatotal=gridsigmatotal+ &
- gridsigma(ix,jy,kz)
- end do
- end do
- end do
-
-
- !*******************************************************************
- ! Generate output: may be in concentration (ng/m3) or in mixing
- ! ratio (ppt) or both
- ! Output the position and the values alternated multiplied by
- ! 1 or -1, first line is number of values, number of positions
- ! For backward simulations, the unit is seconds, stored in grid_time
- !*******************************************************************
-
- if (verbosity.eq.1) then
- print*,'concoutput_inversion 4 (output)'
- CALL SYSTEM_CLOCK(count_clock)
- WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0
- endif
-
- ! Concentration output
- !*********************
-
- if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
-
- if (verbosity.eq.1) then
- print*,'concoutput_inversion (Wet deposition)'
- CALL SYSTEM_CLOCK(count_clock)
- WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0
- endif
-
- if (verbosity.eq.1) then
- print*,'concoutput_inversion (Concentrations)'
- CALL SYSTEM_CLOCK(count_clock)
- WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0
- endif
-
- ! Concentrations
-
- ! sfc_only write only 1st layer
-
- sp_count_i=0
- sp_count_r=0
- sp_fact=-1.
- sp_zer=.true.
- do kz=1,1
- do jy=0,numygrid-1
- do ix=0,numxgrid-1
- if (grid(ix,jy,kz).gt.smallnum) then
- if (sp_zer.eqv..true.) then ! first non zero value
- sp_count_i=sp_count_i+1
- sparse_dump_i(sp_count_i)= &
- ix+jy*numxgrid+kz*numxgrid*numygrid
- sp_zer=.false.
- sp_fact=sp_fact*(-1.)
- endif
- sp_count_r=sp_count_r+1
- sparse_dump_r(sp_count_r)= &
- sp_fact* &
- grid(ix,jy,kz)* &
- factor3d(ix,jy,kz)/tot_mu(ks,kp)
- sparse_dump_u(sp_count_r)= &
- gridsigma(ix,jy,kz)* &
- factor3d(ix,jy,kz)/tot_mu(ks,kp)
-
- else ! concentration is zero
- sp_zer=.true.
- endif
- end do
- end do
- end do
- write(unitoutgrid) sp_count_i
- write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
- write(unitoutgrid) sp_count_r
- write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
-
- endif ! concentration output
-
- ! Mixing ratio output
- !********************
-
- if ((iout.eq.2).or.(iout.eq.3)) then ! mixing ratio
-
- ! Mixing ratios
-
- ! sfc_only write only 1st layer
-
- sp_count_i=0
- sp_count_r=0
- sp_fact=-1.
- sp_zer=.true.
- do kz=1,1
- do jy=0,numygrid-1
- do ix=0,numxgrid-1
- if (grid(ix,jy,kz).gt.smallnum) then
- if (sp_zer.eqv..true.) then ! first non zero value
- sp_count_i=sp_count_i+1
- sparse_dump_i(sp_count_i)= &
- ix+jy*numxgrid+kz*numxgrid*numygrid
- sp_zer=.false.
- sp_fact=sp_fact*(-1.)
- endif
- sp_count_r=sp_count_r+1
- sparse_dump_r(sp_count_r)= &
- sp_fact* &
- 1.e12*grid(ix,jy,kz) &
- /volume(ix,jy,kz)/outnum* &
- weightair/weightmolar(ks)/densityoutgrid(ix,jy,kz)
- sparse_dump_u(sp_count_r)= &
- 1.e12*gridsigma(ix,jy,kz)/volume(ix,jy,kz)/ &
- outnum*weightair/weightmolar(ks)/ &
- densityoutgrid(ix,jy,kz)
- else ! concentration is zero
- sp_zer=.true.
- endif
- end do
- end do
- end do
- write(unitoutgridppt) sp_count_i
- write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
- write(unitoutgridppt) sp_count_r
- write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
-
- endif ! output for ppt
-
- end do ! nageclass
-
- close(unitoutgridppt)
- close(unitoutgrid)
-
- ! itime is outside range
-10 continue
-
- end do ! maxpointspec_act
-
- end do ! nspec
-
- ! RLT Aug 2017
- ! Write out conversion factor for dry air
- inquire(file=path(2)(1:length(2))//'factor_drygrid',exist=lexist)
- if (lexist.and..not.lstart) then
- ! open and append
- open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid',form='unformatted',&
- status='old',action='write',access='append')
- else
- ! create new
- open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid',form='unformatted',&
- status='replace',action='write')
- endif
- sp_count_i=0
- sp_count_r=0
- sp_fact=-1.
- sp_zer=.true.
- do kz=1,1
- do jy=0,numygrid-1
- do ix=0,numxgrid-1
- if (factor_drygrid(ix,jy,kz).gt.(1.+smallnum).or.factor_drygrid(ix,jy,kz).lt.(1.-smallnum)) then
- if (sp_zer.eqv..true.) then ! first value not equal to one
- sp_count_i=sp_count_i+1
- sparse_dump_i(sp_count_i)= &
- ix+jy*numxgrid+kz*numxgrid*numygrid
- sp_zer=.false.
- sp_fact=sp_fact*(-1.)
- endif
- sp_count_r=sp_count_r+1
- sparse_dump_r(sp_count_r)= &
- sp_fact*factor_drygrid(ix,jy,kz)
- else ! factor is one
- sp_zer=.true.
- endif
- end do
- end do
- end do
- write(unitoutfactor) sp_count_i
- write(unitoutfactor) (sparse_dump_i(i),i=1,sp_count_i)
- write(unitoutfactor) sp_count_r
- write(unitoutfactor) (sparse_dump_r(i),i=1,sp_count_r)
- close(unitoutfactor)
-
-
- if (gridtotal.gt.0.) gridtotalunc=gridsigmatotal/gridtotal
-
- ! Dump of receptor concentrations
-
- if (numreceptor.gt.0 .and. (iout.eq.2 .or. iout.eq.3) ) then
- write(unitoutreceptppt) itime
- do ks=1,nspec
- write(unitoutreceptppt) (1.e12*creceptor(i,ks)/outnum* &
- weightair/weightmolar(ks)/densityoutrecept(i),i=1,numreceptor)
- end do
- endif
-
- ! Dump of receptor concentrations
-
- if (numreceptor.gt.0) then
- write(unitoutrecept) itime
- do ks=1,nspec
- write(unitoutrecept) (1.e12*creceptor(i,ks)/outnum, &
- i=1,numreceptor)
- end do
- endif
-
- ! RLT Aug 2017
- ! Write out conversion factor for dry air
- if (numreceptor.gt.0) then
- inquire(file=path(2)(1:length(2))//'factor_dryreceptor',exist=lexist)
- if (lexist.and..not.lstart) then
- ! open and append
- open(unitoutfactor,file=path(2)(1:length(2))//'factor_dryreceptor',form='unformatted',&
- status='old',action='write',access='append')
- else
- ! create new
- open(unitoutfactor,file=path(2)(1:length(2))//'factor_dryreceptor',form='unformatted',&
- status='replace',action='write')
- endif
- write(unitoutfactor) itime
- write(unitoutfactor) (factor_dryrecept(i),i=1,numreceptor)
- close(unitoutfactor)
- endif
-
- ! reset lstart
- if (lstart) then
- lstart=.false.
- endif
- print*, 'after writing output files: lstart = ',lstart
-
-
- ! Reinitialization of grid
- !*************************
-
- do ks=1,nspec
- do kp=1,maxpointspec_act
- do i=1,numreceptor
- creceptor(i,ks)=0.
- end do
- do jy=0,numygrid-1
- do ix=0,numxgrid-1
- do l=1,nclassunc
- do nage=1,nageclass
- do kz=1,numzgrid
- gridunc(ix,jy,kz,ks,kp,l,nage)=0.
- end do
- end do
- end do
- end do
- end do
- end do
- end do
-end subroutine concoutput_inversion
-
-subroutine concoutput_inversion_nest(itime,outnum)
- ! i i
- !*****************************************************************************
- ! *
- ! Output of the concentration grid and the receptor concentrations. *
- ! *
- ! Author: A. Stohl *
- ! *
- ! 24 May 1995 *
- ! *
- ! 13 April 1999, Major update: if output size is smaller, dump output *
- ! in sparse matrix format; additional output of *
- ! uncertainty *
- ! *
- ! 05 April 2000, Major update: output of age classes; output for backward*
- ! runs is time spent in grid cell times total mass of *
- ! species. *
- ! *
- ! 17 February 2002, Appropriate dimensions for backward and forward runs *
- ! are now specified in file par_mod *
- ! *
- ! June 2006, write grid in sparse matrix with a single write command *
- ! in order to save disk space *
- ! *
- ! 2008 new sparse matrix format *
- !
- ! January 2017, Separate files by release but include all timesteps *
- ! *
- !*****************************************************************************
- ! *
- ! Variables: *
- ! outnum number of samples *
- ! ncells number of cells with non-zero concentrations *
- ! sparse .true. if in sparse matrix format, else .false. *
- ! tot_mu 1 for forward, initial mass mixing ration for backw. runs *
- ! *
- !*****************************************************************************
-
- use unc_mod
- use mean_mod
-
- implicit none
-
- real(kind=dp) :: jul
- integer :: itime,i,ix,jy,kz,ks,kp,l,iix,jjy,kzz,nage,jjjjmmdd,ihmmss
- integer :: sp_count_i,sp_count_r
- real :: sp_fact
- real :: outnum,densityoutrecept(numreceptor),xl,yl
- ! RLT
- real :: densitydryrecept(numreceptor)
- real :: factor_dryrecept(numreceptor)
-
- real(dep_prec) :: auxgrid(nclassunc)
- real :: halfheight,dz,dz1,dz2,tot_mu(maxspec,maxpointspec_act)
- real,parameter :: smallnum = tiny(0.0) ! smallest number that can be handled
- real,parameter :: weightair=28.97
- logical :: sp_zer
- logical,save :: lnstart=.true.
- logical,save,allocatable,dimension(:) :: lnstartrel
- character :: adate*8,atime*6
- character(len=3) :: anspec
- logical :: lexist
- character :: areldate*8,areltime*6
-
- if(lnstart) then
- allocate(lnstartrel(maxpointspec_act))
- lnstartrel(:)=.true.
- endif
- print*, 'lnstartrel = ',lnstartrel
-
- ! Determine current calendar date, needed for the file name
- !**********************************************************
-
- jul=bdate+real(itime,kind=dp)/86400._dp
- call caldate(jul,jjjjmmdd,ihmmss)
- write(adate,'(i8.8)') jjjjmmdd
- write(atime,'(i6.6)') ihmmss
-
- print*, 'outnum:',outnum
- print*, 'datetime:',adate//atime
-
- ! For forward simulations, output fields have dimension MAXSPEC,
- ! for backward simulations, output fields have dimension MAXPOINT.
- ! Thus, make loops either about nspec, or about numpoint
- !*****************************************************************
-
-
- if (ldirect.eq.1) then
- do ks=1,nspec
- do kp=1,maxpointspec_act
- tot_mu(ks,kp)=1
- end do
- end do
- else
- do ks=1,nspec
- do kp=1,maxpointspec_act
- tot_mu(ks,kp)=xmass(kp,ks)
- end do
- end do
- endif
-
-
- !*******************************************************************
- ! Compute air density: sufficiently accurate to take it
- ! from coarse grid at some time
- ! Determine center altitude of output layer, and interpolate density
- ! data to that altitude
- !*******************************************************************
-
- do kz=1,numzgrid
- if (kz.eq.1) then
- halfheight=outheight(1)*0.5
- else
- halfheight=(outheight(kz)+outheight(kz-1))*0.5
- endif
- do kzz=2,nz
- if ((height(kzz-1).lt.halfheight).and. &
- (height(kzz).gt.halfheight)) goto 46
- end do
-46 kzz=max(min(kzz,nz),2)
- dz1=halfheight-height(kzz-1)
- dz2=height(kzz)-halfheight
- dz=dz1+dz2
- do jy=0,numygridn-1
- do ix=0,numxgridn-1
- xl=outlon0n+real(ix)*dxoutn
- yl=outlat0n+real(jy)*dyoutn
- xl=(xl-xlon0)/dx
- yl=(yl-ylat0)/dy
- iix=max(min(nint(xl),nxmin1),0)
- jjy=max(min(nint(yl),nymin1),0)
- densityoutgrid(ix,jy,kz)=(rho(iix,jjy,kzz,2)*dz1+ &
- rho(iix,jjy,kzz-1,2)*dz2)/dz
- ! RLT
- densitydrygrid(ix,jy,kz)=(rho_dry(iix,jjy,kzz,2)*dz1+ &
- rho_dry(iix,jjy,kzz-1,2)*dz2)/dz
- end do
- end do
- end do
-
- do i=1,numreceptor
- xl=xreceptor(i)
- yl=yreceptor(i)
- iix=max(min(nint(xl),nxmin1),0)
- jjy=max(min(nint(yl),nymin1),0)
- densityoutrecept(i)=rho(iix,jjy,1,2)
- ! RLT
- densitydryrecept(i)=rho_dry(iix,jjy,1,2)
- end do
-
- ! RLT
- ! conversion factor for output relative to dry air
- factor_drygrid=densityoutgrid/densitydrygrid
- factor_dryrecept=densityoutrecept/densitydryrecept
-
- ! Output is different for forward and backward simulations
- do kz=1,numzgrid
- do jy=0,numygridn-1
- do ix=0,numxgridn-1
- if (ldirect.eq.1) then
- factor3d(ix,jy,kz)=1.e12/volumen(ix,jy,kz)/outnum
- else
- factor3d(ix,jy,kz)=real(abs(loutaver))/outnum
- endif
- end do
- end do
- end do
-
- !*********************************************************************
- ! Determine the standard deviation of the mean concentration or mixing
- ! ratio (uncertainty of the output) and the dry and wet deposition
- !*********************************************************************
-
- do ks=1,nspec
-
- write(anspec,'(i3.3)') ks
-
- do kp=1,maxpointspec_act
-
- print*, 'itime = ',itime
- print*, 'lage(1) = ',lage(1)
- print*, 'ireleasestart(kp) = ',ireleasestart(kp)
- print*, 'ireleaseend(kp) = ',ireleaseend(kp)
-
- ! check itime is within release and backward trajectory length
- if (nageclass.eq.1) then
- if ((itime.gt.ireleaseend(kp)).or.(itime.lt.(ireleasestart(kp)-lage(1)))) then
- go to 10
- endif
- endif
-
- ! calculate date of release
- jul=bdate+real(ireleasestart(kp),kind=dp)/86400._dp ! this is the current day
- call caldate(jul,jjjjmmdd,ihmmss)
- write(areldate,'(i8.8)') jjjjmmdd
- write(areltime,'(i6.6)') ihmmss
- print*, areldate//areltime
-
- ! calculate date of field
- jul=bdate+real(itime,kind=dp)/86400._dp
- call caldate(jul,jjjjmmdd,ihmmss)
- write(adate,'(i8.8)') jjjjmmdd
- write(atime,'(i6.6)') ihmmss
- print*, adate//atime
-
- if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
- if (ldirect.eq.1) then
- ! concentrations
- inquire(file=path(2)(1:length(2))//'grid_conc_nest_'//areldate// &
- areltime//'_'//anspec,exist=lexist)
- if(lexist.and..not.lnstartrel(kp)) then
- ! open and append to existing file
- open(unitoutgrid,file=path(2)(1:length(2))//'grid_conc_nest_'//areldate// &
- areltime//'_'//anspec,form='unformatted',status='old',action='write',access='append')
- else
- ! open new file
- open(unitoutgrid,file=path(2)(1:length(2))//'grid_conc_nest_'//areldate// &
- areltime//'_'//anspec,form='unformatted',status='replace',action='write')
- endif
- else
- ! residence times
- inquire(file=path(2)(1:length(2))//'grid_time_nest_'//areldate// &
- areltime//'_'//anspec,exist=lexist)
- if(lexist.and..not.lnstartrel(kp)) then
- ! open and append to existing file
- open(unitoutgrid,file=path(2)(1:length(2))//'grid_time_nest_'//areldate// &
- areltime//'_'//anspec,form='unformatted',status='old',action='write',access='append')
- else
- ! open new file
- open(unitoutgrid,file=path(2)(1:length(2))//'grid_time_nest_'//areldate// &
- areltime//'_'//anspec,form='unformatted',status='replace',action='write')
- endif
- endif
- write(unitoutgrid) jjjjmmdd
- write(unitoutgrid) ihmmss
- endif
-
- if ((iout.eq.2).or.(iout.eq.3)) then
- ! mixing ratio
- inquire(file=path(2)(1:length(2))//'grid_pptv_nest_'//areldate// &
- areltime//'_'//anspec,exist=lexist)
- if(lexist.and..not.lnstartrel(kp)) then
- ! open and append to existing file
- open(unitoutgridppt,file=path(2)(1:length(2))//'grid_pptv_nest_'//areldate// &
- areltime//'_'//anspec,form='unformatted',status='old',action='write',access='append')
- else
- ! open new file
- open(unitoutgridppt,file=path(2)(1:length(2))//'grid_pptv_nest_'//areldate// &
- areltime//'_'//anspec,form='unformatted',status='replace',action='write')
- endif
- write(unitoutgridppt) jjjjmmdd
- write(unitoutgridppt) ihmmss
- endif
-
- lnstartrel(kp)=.false.
-
- do nage=1,nageclass
-
- do jy=0,numygridn-1
- do ix=0,numxgridn-1
+ if ((DRYDEP).and.(ldirect.gt.0)) then
+ do l=1,nclassunc
+ auxgrid(l)=drygriduncn(ix,jy,ks,kp,l,nage)
+ end do
+ call mean(auxgrid,drygrid(ix,jy), &
+ drygridsigma(ix,jy),nclassunc)
+ ! Multiply by number of classes to get total concentration
+ drygrid(ix,jy)=drygrid(ix,jy)* &
+ nclassunc
+ ! Calculate standard deviation of the mean
+ drygridsigma(ix,jy)= &
+ drygridsigma(ix,jy)* &
+ sqrt(real(nclassunc))
+ endif
! CONCENTRATION OR MIXING RATIO
do kz=1,numzgrid
@@ -2768,7 +1693,7 @@ subroutine concoutput_inversion_nest(itime,outnum)
auxgrid(l)=griduncn(ix,jy,kz,ks,kp,l,nage)
end do
call mean(auxgrid,grid(ix,jy,kz), &
- gridsigma(ix,jy,kz),nclassunc)
+ gridsigma(ix,jy,kz),nclassunc)
! Multiply by number of classes to get total concentration
grid(ix,jy,kz)= &
grid(ix,jy,kz)*nclassunc
@@ -2777,9 +1702,9 @@ subroutine concoutput_inversion_nest(itime,outnum)
gridsigma(ix,jy,kz)* &
sqrt(real(nclassunc))
end do
- end do
- end do
-
+ end do ! ix
+ end do ! jy
+!$OMP END DO
!*******************************************************************
! Generate output: may be in concentration (ng/m3) or in mixing
@@ -2789,20 +1714,87 @@ subroutine concoutput_inversion_nest(itime,outnum)
! For backward simulations, the unit is seconds, stored in grid_time
!*******************************************************************
+!$OMP BARRIER
+!$OMP SINGLE
+
! Concentration output
!*********************
-
if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
- ! Concentrations
+ ! Wet deposition
+ sp_count_i=0
+ sp_count_r=0
+ sp_fact=-1.
+ sp_zer=.true.
+ if ((ldirect.eq.1).and.(WETDEP)) then
+ do jy=0,numygridn-1
+ do ix=0,numxgridn-1
+ !concentration greater zero
+ if (wetgrid(ix,jy).gt.smallnum) then
+ if (sp_zer.eqv..true.) then ! first non zero value
+ sp_count_i=sp_count_i+1
+ sparse_dump_i(sp_count_i)=ix+jy*numxgridn
+ sp_zer=.false.
+ sp_fact=sp_fact*(-1.)
+ endif
+ sp_count_r=sp_count_r+1
+ sparse_dump_r(sp_count_r)= &
+ sp_fact*1.e12*real(wetgrid(ix,jy))/arean(ix,jy)
+ else ! concentration is zero
+ sp_zer=.true.
+ endif
+ end do
+ end do
+ else
+ sp_count_i=0
+ sp_count_r=0
+ endif
+ write(unitoutgrid) sp_count_i
+ write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
+ write(unitoutgrid) sp_count_r
+ write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
- ! sfc_only write only 1st layer
+ ! Dry deposition
+ sp_count_i=0
+ sp_count_r=0
+ sp_fact=-1.
+ sp_zer=.true.
+ if ((ldirect.eq.1).and.(DRYDEP)) then
+ do jy=0,numygridn-1
+ do ix=0,numxgridn-1
+ if (drygrid(ix,jy).gt.smallnum) then
+ if (sp_zer.eqv..true.) then ! first non zero value
+ sp_count_i=sp_count_i+1
+ sparse_dump_i(sp_count_i)=ix+jy*numxgridn
+ sp_zer=.false.
+ sp_fact=sp_fact*(-1.)
+ endif
+ sp_count_r=sp_count_r+1
+ sparse_dump_r(sp_count_r)= &
+ sp_fact* &
+ 1.e12*real(drygrid(ix,jy))/arean(ix,jy)
+ else ! concentration is zero
+ sp_zer=.true.
+ endif
+ end do
+ end do
+ else
+ sp_count_i=0
+ sp_count_r=0
+ endif
+ write(unitoutgrid) sp_count_i
+ write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
+ write(unitoutgrid) sp_count_r
+ write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
- sp_count_i=0
- sp_count_r=0
- sp_fact=-1.
- sp_zer=.true.
- do kz=1,1
+ ! Concentrations
+ sp_count_i=0
+ sp_count_r=0
+ sp_fact=-1.
+ sp_zer=.true.
+ numzwrite=numzgrid
+ if (sfc_only.eq.1) numzwrite=1
+ do kz=1,numzwrite
do jy=0,numygridn-1
do ix=0,numxgridn-1
if (grid(ix,jy,kz).gt.smallnum) then
@@ -2812,45 +1804,106 @@ subroutine concoutput_inversion_nest(itime,outnum)
ix+jy*numxgridn+kz*numxgridn*numygridn
sp_zer=.false.
sp_fact=sp_fact*(-1.)
- endif
- sp_count_r=sp_count_r+1
- sparse_dump_r(sp_count_r)= &
+ endif
+ sp_count_r=sp_count_r+1
+ sparse_dump_r(sp_count_r)= &
sp_fact* &
grid(ix,jy,kz)* &
factor3d(ix,jy,kz)/tot_mu(ks,kp)
- ! if ((factor(ix,jy,kz)/tot_mu(ks,kp)).eq.0)
- ! + write (*,*) factor(ix,jy,kz),tot_mu(ks,kp),ks,kp
- sparse_dump_u(sp_count_r)= &
- gridsigma(ix,jy,kz)* &
- factor3d(ix,jy,kz)/tot_mu(ks,kp)
- else ! concentration is zero
+ else ! concentration is zero
sp_zer=.true.
- endif
+ endif
end do
end do
end do
- write(unitoutgrid) sp_count_i
- write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
- write(unitoutgrid) sp_count_r
- write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
+ write(unitoutgrid) sp_count_i
+ write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
+ write(unitoutgrid) sp_count_r
+ write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
- endif ! concentration output
+ endif ! concentration output
! Mixing ratio output
!********************
- if ((iout.eq.2).or.(iout.eq.3)) then ! mixing ratio
-
+ if ((iout.eq.2).or.(iout.eq.3)) then ! mixing ratio
- ! Mixing ratios
+ ! Wet deposition
+ sp_count_i=0
+ sp_count_r=0
+ sp_fact=-1.
+ sp_zer=.true.
+ if ((ldirect.eq.1).and.(WETDEP)) then
+ do jy=0,numygridn-1
+ do ix=0,numxgridn-1
+ if (wetgrid(ix,jy).gt.smallnum) then
+ if (sp_zer.eqv..true.) then ! first non zero value
+ sp_count_i=sp_count_i+1
+ sparse_dump_i(sp_count_i)= &
+ ix+jy*numxgridn
+ sp_zer=.false.
+ sp_fact=sp_fact*(-1.)
+ endif
+ sp_count_r=sp_count_r+1
+ sparse_dump_r(sp_count_r)= &
+ sp_fact* &
+ 1.e12*real(wetgrid(ix,jy))/arean(ix,jy)
+ else ! concentration is zero
+ sp_zer=.true.
+ endif
+ end do
+ end do
+ else
+ sp_count_i=0
+ sp_count_r=0
+ endif
+ write(unitoutgridppt) sp_count_i
+ write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
+ write(unitoutgridppt) sp_count_r
+ write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
- ! sfc_only write only 1st layer
+ ! Dry deposition
+ sp_count_i=0
+ sp_count_r=0
+ sp_fact=-1.
+ sp_zer=.true.
+ if ((ldirect.eq.1).and.(DRYDEP)) then
+ do jy=0,numygridn-1
+ do ix=0,numxgridn-1
+ if (drygrid(ix,jy).gt.smallnum) then
+ if (sp_zer.eqv..true.) then ! first non zero value
+ sp_count_i=sp_count_i+1
+ sparse_dump_i(sp_count_i)= &
+ ix+jy*numxgridn
+ sp_zer=.false.
+ sp_fact=sp_fact*(-1)
+ endif
+ sp_count_r=sp_count_r+1
+ sparse_dump_r(sp_count_r)= &
+ sp_fact* &
+ 1.e12*real(drygrid(ix,jy))/arean(ix,jy)
+ else ! concentration is zero
+ sp_zer=.true.
+ endif
+ end do
+ end do
+ else
+ sp_count_i=0
+ sp_count_r=0
+ endif
+ write(unitoutgridppt) sp_count_i
+ write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
+ write(unitoutgridppt) sp_count_r
+ write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
- sp_count_i=0
- sp_count_r=0
- sp_fact=-1.
- sp_zer=.true.
- do kz=1,1
+ ! Mixing ratios
+ sp_count_i=0
+ sp_count_r=0
+ sp_fact=-1.
+ sp_zer=.true.
+ numzwrite=numzgrid
+ if (sfc_only.eq.1) numzwrite=1
+ do kz=1,numzwrite
do jy=0,numygridn-1
do ix=0,numxgridn-1
if (grid(ix,jy,kz).gt.smallnum) then
@@ -2867,13 +1920,9 @@ subroutine concoutput_inversion_nest(itime,outnum)
1.e12*grid(ix,jy,kz) &
/volumen(ix,jy,kz)/outnum* &
weightair/weightmolar(ks)/densityoutgrid(ix,jy,kz)
- sparse_dump_u(sp_count_r)= &
- 1.e12*gridsigma(ix,jy,kz)/volumen(ix,jy,kz)/ &
- outnum*weightair/weightmolar(ks)/ &
- densityoutgrid(ix,jy,kz)
- else ! concentration is zero
+ else ! concentration is zero
sp_zer=.true.
- endif
+ endif
end do
end do
end do
@@ -2883,37 +1932,37 @@ subroutine concoutput_inversion_nest(itime,outnum)
write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
endif ! output for ppt
-
- end do ! nageclass
-
- close(unitoutgridppt)
- close(unitoutgrid)
-
- ! itime is outside range
-10 continue
-
- end do ! maxpointspec_act
+!$OMP END SINGLE
+!$OMP BARRIER
+ end do
+ end do
- end do ! nspec
+ close(unitoutgridppt)
+ close(unitoutgrid)
+ end do
+!$OMP END PARALLEL
- ! RLT Aug 2017
! Write out conversion factor for dry air
+ !****************************************
+
inquire(file=path(2)(1:length(2))//'factor_drygrid_nest',exist=lexist)
- if (lexist.and..not.lnstart) then
+ if (lexist) then
! open and append
open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid_nest',form='unformatted',&
status='old',action='write',access='append')
else
! create new
open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid_nest',form='unformatted',&
- status='replace',action='write')
+ status='new',action='write')
endif
sp_count_i=0
sp_count_r=0
sp_fact=-1.
sp_zer=.true.
- do kz=1,1
+ numzwrite=numzgrid
+ if (sfc_only.eq.1) numzwrite=1
+ do kz=1,numzwrite
do jy=0,numygridn-1
do ix=0,numxgridn-1
if (factor_drygrid(ix,jy,kz).gt.(1.+smallnum).or.factor_drygrid(ix,jy,kz).lt.(1.-smallnum)) then
@@ -2939,41 +1988,21 @@ subroutine concoutput_inversion_nest(itime,outnum)
write(unitoutfactor) (sparse_dump_r(i),i=1,sp_count_r)
close(unitoutfactor)
- ! reset lnstart
- if (lnstart) then
- lnstart=.false.
- endif
+ griduncn(:,:,:,:,:,:,:)=0.
+#ifdef _OPENMP
+ griduncn_omp(:,:,:,:,:,:,:,:) = 0.
+#endif
- ! Reinitialization of grid
- !*************************
+end subroutine concoutput_nest
- do ks=1,nspec
- do kp=1,maxpointspec_act
- do i=1,numreceptor
- creceptor(i,ks)=0.
- end do
- do jy=0,numygridn-1
- do ix=0,numxgridn-1
- do l=1,nclassunc
- do nage=1,nageclass
- do kz=1,numzgrid
- griduncn(ix,jy,kz,ks,kp,l,nage)=0.
- end do
- end do
- end do
- end do
- end do
- end do
- end do
-end subroutine concoutput_inversion_nest
-subroutine concoutput_sfc(itime,outnum,gridtotalunc,wetgridtotalunc, &
+subroutine concoutput_inversion(itime,outnum,gridtotalunc,wetgridtotalunc, &
drygridtotalunc)
! i i o o
! o
!*****************************************************************************
! *
- ! Output of the concentration grid and the receptor concentrations. *
+ ! Output of the concentration grid formatted for inversions. *
! *
! Author: A. Stohl *
! *
@@ -2995,6 +2024,8 @@ subroutine concoutput_sfc(itime,outnum,gridtotalunc,wetgridtotalunc, &
! *
! 2008 new sparse matrix format *
! *
+ ! January 2017, Separate files by release but include all timesteps *
+ ! *
!*****************************************************************************
! *
! Variables: *
@@ -3014,11 +2045,7 @@ subroutine concoutput_sfc(itime,outnum,gridtotalunc,wetgridtotalunc, &
integer :: itime,i,ix,jy,kz,ks,kp,l,iix,jjy,kzz,nage,jjjjmmdd,ihmmss
integer :: sp_count_i,sp_count_r
real :: sp_fact
- real :: outnum,densityoutrecept(numreceptor),xl,yl
- ! RLT
- real :: densitydryrecept(numreceptor)
- real :: factor_dryrecept(numreceptor)
-
+ real :: outnum,xl,yl
real(dep_prec) :: auxgrid(nclassunc)
real(sp) :: gridtotal,gridsigmatotal,gridtotalunc
real(dep_prec) :: wetgridtotal,wetgridsigmatotal,wetgridtotalunc
@@ -3030,15 +2057,25 @@ subroutine concoutput_sfc(itime,outnum,gridtotalunc,wetgridtotalunc, &
character :: adate*8,atime*6
character(len=3) :: anspec
logical :: lexist
+ character :: areldate*8,areltime*6
+ logical,save :: lstart=.true.
+ logical,save,allocatable,dimension(:) :: lstartrel
+ integer :: ierr
+ character(LEN=100) :: dates_char
+ integer, parameter :: unitrelnames=654
+ if(lstart) then
+ allocate(lstartrel(maxpointspec_act))
+ lstartrel(:)=.true.
+ endif
+
if (verbosity.eq.1) then
- print*,'inside concoutput_sfc '
CALL SYSTEM_CLOCK(count_clock)
WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0
endif
- ! Determine current calendar date, needed for the file name
+ ! Determine current calendar date
!**********************************************************
jul=bdate+real(itime,kind=dp)/86400._dp
@@ -3046,10 +2083,49 @@ subroutine concoutput_sfc(itime,outnum,gridtotalunc,wetgridtotalunc, &
write(adate,'(i8.8)') jjjjmmdd
write(atime,'(i6.6)') ihmmss
+
+ ! Prepare output files for dates
+ !**********************************************************
+
+ ! Overwrite existing dates file on first call, later append to it
+ ! If 'dates' file exists in output directory, copy to new file dates.old
+ inquire(file=path(2)(1:length(2))//'dates', exist=lexist)
+ if (lexist.and.lstart) then
+ ! copy contents of existing dates file to dates.old
+ print*, 'warning: replacing old dates file'
+ open(unit=unitdates, file=path(2)(1:length(2))//'dates',form='formatted', &
+ &access='sequential', status='old', action='read', iostat=ierr)
+ open(unit=unittmp, file=path(2)(1:length(2))//'dates.old', access='sequential', &
+ &status='replace', action='write', form='formatted', iostat=ierr)
+ do while (.true.)
+ read(unitdates, '(a)', iostat=ierr) dates_char
+ if (ierr.ne.0) exit
+ write(unit=unittmp, fmt='(a)', iostat=ierr, advance='yes') trim(dates_char)
+ end do
+ close(unit=unitdates)
+ close(unit=unittmp)
+ ! create new dates file
+ open(unit=unitdates, file=path(2)(1:length(2))//'dates',form='formatted', &
+ &access='sequential', status='replace', iostat=ierr)
+ close(unit=unitdates)
+ endif
+
open(unitdates,file=path(2)(1:length(2))//'dates', ACCESS='APPEND')
write(unitdates,'(a)') adate//atime
close(unitdates)
+ !CGZ: Make a filename with names of releases
+ if (lstart) then
+ open(unit=unitrelnames, file=path(2)(1:length(2))//'releases_out',form='formatted', &
+ &access='sequential', status='replace', iostat=ierr)
+ close(unitrelnames)
+ endif
+
+ print*, 'after creating dates files: lstart = ',lstart
+ ! print*, 'outnum:',outnum
+ ! print*, 'datetime:',adate//atime
+
+
! For forward simulations, output fields have dimension MAXSPEC,
! for backward simulations, output fields have dimension MAXPOINT.
! Thus, make loops either about nspec, or about numpoint
@@ -3072,7 +2148,7 @@ subroutine concoutput_sfc(itime,outnum,gridtotalunc,wetgridtotalunc, &
if (verbosity.eq.1) then
- print*,'concoutput_sfc 2'
+ print*,'concoutput_inversion 2'
CALL SYSTEM_CLOCK(count_clock)
WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0
endif
@@ -3115,20 +2191,8 @@ subroutine concoutput_sfc(itime,outnum,gridtotalunc,wetgridtotalunc, &
end do
end do
- do i=1,numreceptor
- xl=xreceptor(i)
- yl=yreceptor(i)
- iix=max(min(nint(xl),nxmin1),0)
- jjy=max(min(nint(yl),nymin1),0)
- densityoutrecept(i)=rho(iix,jjy,1,2)
- ! RLT
- densitydryrecept(i)=rho_dry(iix,jjy,1,2)
- end do
-
- ! RLT
! conversion factor for output relative to dry air
factor_drygrid=densityoutgrid/densitydrygrid
- factor_dryrecept=densityoutrecept/densitydryrecept
! Output is different for forward and backward simulations
do kz=1,numzgrid
@@ -3149,7 +2213,7 @@ subroutine concoutput_sfc(itime,outnum,gridtotalunc,wetgridtotalunc, &
!*********************************************************************
if (verbosity.eq.1) then
- print*,'concoutput_sfc 3 (sd)'
+ print*,'concoutput_inversion 3 (sd)'
CALL SYSTEM_CLOCK(count_clock)
WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0
endif
@@ -3166,68 +2230,95 @@ subroutine concoutput_sfc(itime,outnum,gridtotalunc,wetgridtotalunc, &
do ks=1,nspec
write(anspec,'(i3.3)') ks
- if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
- if (ldirect.eq.1) then
- open(unitoutgrid,file=path(2)(1:length(2))//'grid_conc_'//adate// &
- atime//'_'//anspec,form='unformatted')
- else
- open(unitoutgrid,file=path(2)(1:length(2))//'grid_time_'//adate// &
- atime//'_'//anspec,form='unformatted')
+
+ ! loop over releases
+ do kp=1,maxpointspec_act
+
+ print*, 'itime = ',itime
+ print*, 'ireleasestart(kp) = ',ireleasestart(kp)
+ print*, 'ireleaseend(kp) = ',ireleaseend(kp)
+
+ ! check itime is within release and backward trajectory length
+ if (nageclass.eq.1) then
+ if ((itime.gt.ireleaseend(kp)).or.(itime.lt.(ireleasestart(kp)-lage(1)))) then
+ go to 10
+ endif
endif
- write(unitoutgrid) itime
- endif
- if ((iout.eq.2).or.(iout.eq.3)) then ! mixing ratio
- open(unitoutgridppt,file=path(2)(1:length(2))//'grid_pptv_'//adate// &
- atime//'_'//anspec,form='unformatted')
+ ! calculate date of release for filename
+ jul=bdate+real(ireleasestart(kp),kind=dp)/86400._dp ! this is the current day
+ call caldate(jul,jjjjmmdd,ihmmss)
+ write(areldate,'(i8.8)') jjjjmmdd
+ write(areltime,'(i6.6)') ihmmss
+ print*, 'areldate/areltime = ',areldate//areltime
- write(unitoutgridppt) itime
- endif
+ ! calculate date of field
+ jul=bdate+real(itime,kind=dp)/86400._dp
+ call caldate(jul,jjjjmmdd,ihmmss)
+ write(adate,'(i8.8)') jjjjmmdd
+ write(atime,'(i6.6)') ihmmss
+
+ if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
+ if (ldirect.eq.1) then
+ ! concentrations
+ inquire(file=path(2)(1:length(2))//'grid_conc_'//areldate// &
+ areltime//'_'//anspec,exist=lexist)
+ if(lexist.and..not.lstartrel(kp)) then
+ ! open and append to existing file
+ open(unitoutgrid,file=path(2)(1:length(2))//'grid_conc_'//areldate// &
+ areltime//'_'//anspec,form='unformatted',status='old',action='write',access='append')
+ else
+ ! open new file
+ open(unitoutgrid,file=path(2)(1:length(2))//'grid_conc_'//areldate// &
+ areltime//'_'//anspec,form='unformatted',status='replace',action='write')
+ endif
+ else
+ ! residence times
+ inquire(file=path(2)(1:length(2))//'grid_time_'//areldate// &
+ areltime//'_'//anspec,exist=lexist)
+ if(lexist.and..not.lstartrel(kp)) then
+ ! open and append to existing file
+ open(unitoutgrid,file=path(2)(1:length(2))//'grid_time_'//areldate// &
+ areltime//'_'//anspec,form='unformatted',status='old',action='write',access='append')
+ else
+ ! open new file
+ open(unitoutgrid,file=path(2)(1:length(2))//'grid_time_'//areldate// &
+ areltime//'_'//anspec,form='unformatted',status='replace',action='write')
+ ! add part of the filename to a file (similar to dates) for easier post-processing
+ open(unit=unitrelnames, file=path(2)(1:length(2))//'releases_out',form='formatted', &
+ & access='APPEND', iostat=ierr)
+ write(unitrelnames,'(a)') areldate//areltime//'_'//anspec
+ close(unitrelnames)
+ endif
+ endif
+ write(unitoutgrid) jjjjmmdd
+ write(unitoutgrid) ihmmss
+ endif
+
+ if ((iout.eq.2).or.(iout.eq.3)) then
+ ! mixing ratio
+ inquire(file=path(2)(1:length(2))//'grid_pptv_'//areldate// &
+ areltime//'_'//anspec,exist=lexist)
+ if(lexist.and..not.lstartrel(kp)) then
+ ! open and append to existing file
+ open(unitoutgridppt,file=path(2)(1:length(2))//'grid_pptv_'//areldate// &
+ areltime//'_'//anspec,form='unformatted',status='old',action='write',access='append')
+ else
+ ! open new file
+ open(unitoutgridppt,file=path(2)(1:length(2))//'grid_pptv_'//areldate// &
+ areltime//'_'//anspec,form='unformatted',status='replace',action='write')
+ endif
+ write(unitoutgridppt) jjjjmmdd
+ write(unitoutgridppt) ihmmss
+ endif
+
+ lstartrel(kp)=.false.
- do kp=1,maxpointspec_act
do nage=1,nageclass
do jy=0,numygrid-1
do ix=0,numxgrid-1
- ! WET DEPOSITION
- if ((WETDEP).and.(ldirect.gt.0)) then
- do l=1,nclassunc
- auxgrid(l)=wetgridunc(ix,jy,ks,kp,l,nage)
- end do
- call mean(auxgrid,wetgrid(ix,jy), &
- wetgridsigma(ix,jy),nclassunc)
- ! Multiply by number of classes to get total concentration
- wetgrid(ix,jy)=wetgrid(ix,jy) &
- *nclassunc
- wetgridtotal=wetgridtotal+wetgrid(ix,jy)
- ! Calculate standard deviation of the mean
- wetgridsigma(ix,jy)= &
- wetgridsigma(ix,jy)* &
- sqrt(real(nclassunc))
- wetgridsigmatotal=wetgridsigmatotal+ &
- wetgridsigma(ix,jy)
- endif
-
- ! DRY DEPOSITION
- if ((DRYDEP).and.(ldirect.gt.0)) then
- do l=1,nclassunc
- auxgrid(l)=drygridunc(ix,jy,ks,kp,l,nage)
- end do
- call mean(auxgrid,drygrid(ix,jy), &
- drygridsigma(ix,jy),nclassunc)
- ! Multiply by number of classes to get total concentration
- drygrid(ix,jy)=drygrid(ix,jy)* &
- nclassunc
- drygridtotal=drygridtotal+drygrid(ix,jy)
- ! Calculate standard deviation of the mean
- drygridsigma(ix,jy)= &
- drygridsigma(ix,jy)* &
- sqrt(real(nclassunc))
- drygridsigmatotal=drygridsigmatotal+ &
- drygridsigma(ix,jy)
- endif
-
! CONCENTRATION OR MIXING RATIO
do kz=1,numzgrid
do l=1,nclassunc
@@ -3257,101 +2348,26 @@ subroutine concoutput_sfc(itime,outnum,gridtotalunc,wetgridtotalunc, &
! 1 or -1, first line is number of values, number of positions
! For backward simulations, the unit is seconds, stored in grid_time
!*******************************************************************
-
- if (verbosity.eq.1) then
- print*,'concoutput_sfc 4 (output)'
- CALL SYSTEM_CLOCK(count_clock)
- WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0
- endif
-
- ! Concentration output
- !*********************
-
- if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
-
- if (verbosity.eq.1) then
- print*,'concoutput_sfc (Wet deposition)'
- CALL SYSTEM_CLOCK(count_clock)
- WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0
- endif
-
- ! Wet deposition
- sp_count_i=0
- sp_count_r=0
- sp_fact=-1.
- sp_zer=.true.
- if ((ldirect.eq.1).and.(WETDEP)) then
- do jy=0,numygrid-1
- do ix=0,numxgrid-1
- ! concentraion greater zero
- if (wetgrid(ix,jy).gt.smallnum) then
- if (sp_zer.eqv..true.) then ! first non zero value
- sp_count_i=sp_count_i+1
- sparse_dump_i(sp_count_i)=ix+jy*numxgrid
- sp_zer=.false.
- sp_fact=sp_fact*(-1.)
- endif
- sp_count_r=sp_count_r+1
- sparse_dump_r(sp_count_r)= &
- sp_fact*1.e12*real(wetgrid(ix,jy))/area(ix,jy)
- sparse_dump_u(sp_count_r)= &
- 1.e12*real(wetgridsigma(ix,jy))/area(ix,jy)
- else ! concentration is zero
- sp_zer=.true.
- endif
- end do
- end do
- else
- sp_count_i=0
- sp_count_r=0
- endif
- write(unitoutgrid) sp_count_i
- write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
- write(unitoutgrid) sp_count_r
- write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
-
- if (verbosity.eq.1) then
- print*,'concoutput_sfc (Dry deposition)'
- CALL SYSTEM_CLOCK(count_clock)
- WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0
- endif
- ! Dry deposition
- sp_count_i=0
- sp_count_r=0
- sp_fact=-1.
- sp_zer=.true.
- if ((ldirect.eq.1).and.(DRYDEP)) then
- do jy=0,numygrid-1
- do ix=0,numxgrid-1
- if (drygrid(ix,jy).gt.smallnum) then
- if (sp_zer.eqv..true.) then ! first non zero value
- sp_count_i=sp_count_i+1
- sparse_dump_i(sp_count_i)=ix+jy*numxgrid
- sp_zer=.false.
- sp_fact=sp_fact*(-1.)
- endif
- sp_count_r=sp_count_r+1
- sparse_dump_r(sp_count_r)= &
- sp_fact* &
- 1.e12*real(drygrid(ix,jy))/area(ix,jy)
- sparse_dump_u(sp_count_r)= &
- 1.e12*real(drygridsigma(ix,jy))/area(ix,jy)
- else ! concentration is zero
- sp_zer=.true.
- endif
- end do
- end do
- else
- sp_count_i=0
- sp_count_r=0
+
+ if (verbosity.eq.1) then
+ print*,'concoutput_inversion 4 (output)'
+ CALL SYSTEM_CLOCK(count_clock)
+ WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0
+ endif
+
+ ! Concentration output
+ !*********************
+
+ if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
+
+ if (verbosity.eq.1) then
+ print*,'concoutput_inversion (Wet deposition)'
+ CALL SYSTEM_CLOCK(count_clock)
+ WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0
endif
- write(unitoutgrid) sp_count_i
- write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
- write(unitoutgrid) sp_count_r
- write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
if (verbosity.eq.1) then
- print*,'concoutput_sfc (Concentrations)'
+ print*,'concoutput_inversion (Concentrations)'
CALL SYSTEM_CLOCK(count_clock)
WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0
endif
@@ -3383,6 +2399,7 @@ subroutine concoutput_sfc(itime,outnum,gridtotalunc,wetgridtotalunc, &
sparse_dump_u(sp_count_r)= &
gridsigma(ix,jy,kz)* &
factor3d(ix,jy,kz)/tot_mu(ks,kp)
+
else ! concentration is zero
sp_zer=.true.
endif
@@ -3393,6 +2410,7 @@ subroutine concoutput_sfc(itime,outnum,gridtotalunc,wetgridtotalunc, &
write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
write(unitoutgrid) sp_count_r
write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
+
endif ! concentration output
! Mixing ratio output
@@ -3400,78 +2418,6 @@ subroutine concoutput_sfc(itime,outnum,gridtotalunc,wetgridtotalunc, &
if ((iout.eq.2).or.(iout.eq.3)) then ! mixing ratio
- ! Wet deposition
- sp_count_i=0
- sp_count_r=0
- sp_fact=-1.
- sp_zer=.true.
- if ((ldirect.eq.1).and.(WETDEP)) then
- do jy=0,numygrid-1
- do ix=0,numxgrid-1
- if (wetgrid(ix,jy).gt.smallnum) then
- if (sp_zer.eqv..true.) then ! first non zero value
- sp_count_i=sp_count_i+1
- sparse_dump_i(sp_count_i)= &
- ix+jy*numxgrid
- sp_zer=.false.
- sp_fact=sp_fact*(-1.)
- endif
- sp_count_r=sp_count_r+1
- sparse_dump_r(sp_count_r)= &
- sp_fact* &
- 1.e12*real(wetgrid(ix,jy))/area(ix,jy)
- sparse_dump_u(sp_count_r)= &
- 1.e12*real(wetgridsigma(ix,jy))/area(ix,jy)
- else ! concentration is zero
- sp_zer=.true.
- endif
- end do
- end do
- else
- sp_count_i=0
- sp_count_r=0
- endif
- write(unitoutgridppt) sp_count_i
- write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
- write(unitoutgridppt) sp_count_r
- write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
-
- ! Dry deposition
- sp_count_i=0
- sp_count_r=0
- sp_fact=-1.
- sp_zer=.true.
- if ((ldirect.eq.1).and.(DRYDEP)) then
- do jy=0,numygrid-1
- do ix=0,numxgrid-1
- if (drygrid(ix,jy).gt.smallnum) then
- if (sp_zer.eqv..true.) then ! first non zero value
- sp_count_i=sp_count_i+1
- sparse_dump_i(sp_count_i)= &
- ix+jy*numxgrid
- sp_zer=.false.
- sp_fact=sp_fact*(-1)
- endif
- sp_count_r=sp_count_r+1
- sparse_dump_r(sp_count_r)= &
- sp_fact* &
- 1.e12*real(drygrid(ix,jy))/area(ix,jy)
- sparse_dump_u(sp_count_r)= &
- 1.e12*real(drygridsigma(ix,jy))/area(ix,jy)
- else ! concentration is zero
- sp_zer=.true.
- endif
- end do
- end do
- else
- sp_count_i=0
- sp_count_r=0
- endif
- write(unitoutgridppt) sp_count_i
- write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
- write(unitoutgridppt) sp_count_r
- write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
-
! Mixing ratios
! sfc_only write only 1st layer
@@ -3511,27 +2457,33 @@ subroutine concoutput_sfc(itime,outnum,gridtotalunc,wetgridtotalunc, &
write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
write(unitoutgridppt) sp_count_r
write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
+
endif ! output for ppt
- end do
- end do
+ end do ! nageclass
- close(unitoutgridppt)
- close(unitoutgrid)
+ close(unitoutgridppt)
+ close(unitoutgrid)
- end do
+ ! itime is outside range
+10 continue
+
+ end do ! maxpointspec_act
+
+ end do ! nspec
- ! RLT Aug 2017
! Write out conversion factor for dry air
+ !*****************************************
+
inquire(file=path(2)(1:length(2))//'factor_drygrid',exist=lexist)
- if (lexist) then
+ if (lexist.and..not.lstart) then
! open and append
open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid',form='unformatted',&
status='old',action='write',access='append')
else
! create new
open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid',form='unformatted',&
- status='new',action='write')
+ status='replace',action='write')
endif
sp_count_i=0
sp_count_r=0
@@ -3563,79 +2515,27 @@ subroutine concoutput_sfc(itime,outnum,gridtotalunc,wetgridtotalunc, &
write(unitoutfactor) (sparse_dump_r(i),i=1,sp_count_r)
close(unitoutfactor)
-
if (gridtotal.gt.0.) gridtotalunc=gridsigmatotal/gridtotal
- if (wetgridtotal.gt.0.) wetgridtotalunc=wetgridsigmatotal/ &
- wetgridtotal
- if (drygridtotal.gt.0.) drygridtotalunc=drygridsigmatotal/ &
- drygridtotal
-
- ! Dump of receptor concentrations
-
- if (numreceptor.gt.0 .and. (iout.eq.2 .or. iout.eq.3) ) then
- write(unitoutreceptppt) itime
- do ks=1,nspec
- write(unitoutreceptppt) (1.e12*creceptor(i,ks)/outnum* &
- weightair/weightmolar(ks)/densityoutrecept(i),i=1,numreceptor)
- end do
- endif
-
- ! Dump of receptor concentrations
-
- if (numreceptor.gt.0) then
- write(unitoutrecept) itime
- do ks=1,nspec
- write(unitoutrecept) (1.e12*creceptor(i,ks)/outnum, &
- i=1,numreceptor)
- end do
- endif
- ! RLT Aug 2017
- ! Write out conversion factor for dry air
- if (numreceptor.gt.0) then
- inquire(file=path(2)(1:length(2))//'factor_dryreceptor',exist=lexist)
- if (lexist) then
- ! open and append
- open(unitoutfactor,file=path(2)(1:length(2))//'factor_dryreceptor',form='unformatted',&
- status='old',action='write',access='append')
- else
- ! create new
- open(unitoutfactor,file=path(2)(1:length(2))//'factor_dryreceptor',form='unformatted',&
- status='new',action='write')
- endif
- write(unitoutfactor) itime
- write(unitoutfactor) (factor_dryrecept(i),i=1,numreceptor)
- close(unitoutfactor)
+ ! reset lstart
+ if (lstart) then
+ lstart=.false.
endif
+ print*, 'after writing output files: lstart = ',lstart
! Reinitialization of grid
!*************************
- do ks=1,nspec
- do kp=1,maxpointspec_act
- do i=1,numreceptor
- creceptor(i,ks)=0.
- end do
- do jy=0,numygrid-1
- do ix=0,numxgrid-1
- do l=1,nclassunc
- do nage=1,nageclass
- do kz=1,numzgrid
- gridunc(ix,jy,kz,ks,kp,l,nage)=0.
- end do
- end do
- end do
- end do
- end do
- end do
- end do
-end subroutine concoutput_sfc
+ gridunc(:,:,:,:,:,:,:)=0.
+
+end subroutine concoutput_inversion
+
-subroutine concoutput_sfc_nest(itime,outnum)
+subroutine concoutput_inversion_nest(itime,outnum)
! i i
!*****************************************************************************
! *
- ! Output of the concentration grid and the receptor concentrations. *
+ ! Output of the nested concentration grid formatted for inversions. *
! *
! Author: A. Stohl *
! *
@@ -3657,6 +2557,8 @@ subroutine concoutput_sfc_nest(itime,outnum)
! *
! 2008 new sparse matrix format *
! *
+ ! January 2017, Separate files by release but include all timesteps *
+ ! *
!*****************************************************************************
! *
! Variables: *
@@ -3676,19 +2578,25 @@ subroutine concoutput_sfc_nest(itime,outnum)
integer :: itime,i,ix,jy,kz,ks,kp,l,iix,jjy,kzz,nage,jjjjmmdd,ihmmss
integer :: sp_count_i,sp_count_r
real :: sp_fact
- real :: outnum,densityoutrecept(numreceptor),xl,yl
- ! RLT
- real :: densitydryrecept(numreceptor)
- real :: factor_dryrecept(numreceptor)
+ real :: outnum,xl,yl
real(dep_prec) :: auxgrid(nclassunc)
real :: halfheight,dz,dz1,dz2,tot_mu(maxspec,maxpointspec_act)
real,parameter :: smallnum = tiny(0.0) ! smallest number that can be handled
real,parameter :: weightair=28.97
logical :: sp_zer
+ logical,save :: lnstart=.true.
+ logical,save,allocatable,dimension(:) :: lnstartrel
character :: adate*8,atime*6
character(len=3) :: anspec
logical :: lexist
+ character :: areldate*8,areltime*6
+
+ if(lnstart) then
+ allocate(lnstartrel(maxpointspec_act))
+ lnstartrel(:)=.true.
+ endif
+ print*, 'lnstartrel = ',lnstartrel
! Determine current calendar date, needed for the file name
!**********************************************************
@@ -3698,6 +2606,8 @@ subroutine concoutput_sfc_nest(itime,outnum)
write(adate,'(i8.8)') jjjjmmdd
write(atime,'(i6.6)') ihmmss
+ print*, 'outnum:',outnum
+ print*, 'datetime:',adate//atime
! For forward simulations, output fields have dimension MAXSPEC,
! for backward simulations, output fields have dimension MAXPOINT.
@@ -3751,40 +2661,21 @@ subroutine concoutput_sfc_nest(itime,outnum)
jjy=max(min(nint(yl),nymin1),0)
densityoutgrid(ix,jy,kz)=(rho(iix,jjy,kzz,2)*dz1+ &
rho(iix,jjy,kzz-1,2)*dz2)/dz
- ! RLT
densitydrygrid(ix,jy,kz)=(rho_dry(iix,jjy,kzz,2)*dz1+ &
rho_dry(iix,jjy,kzz-1,2)*dz2)/dz
end do
end do
end do
- do i=1,numreceptor
- xl=xreceptor(i)
- yl=yreceptor(i)
- iix=max(min(nint(xl),nxmin1),0)
- jjy=max(min(nint(yl),nymin1),0)
- densityoutrecept(i)=rho(iix,jjy,1,2)
- ! RLT
- densitydryrecept(i)=rho_dry(iix,jjy,1,2)
- end do
-
- ! RLT
! conversion factor for output relative to dry air
factor_drygrid=densityoutgrid/densitydrygrid
- factor_dryrecept=densityoutrecept/densitydryrecept
! Output is different for forward and backward simulations
- do kz=1,numzgrid
- do jy=0,numygridn-1
- do ix=0,numxgridn-1
- if (ldirect.eq.1) then
- factor3d(ix,jy,kz)=1.e12/volumen(ix,jy,kz)/outnum
- else
- factor3d(ix,jy,kz)=real(abs(loutaver))/outnum
- endif
- end do
- end do
- end do
+ if (ldirect.eq.1) then
+ factor3d(:,:,:)=1.e12/volumen(:,:,:)/outnum
+ else
+ factor3d(:,:,:)=real(abs(loutaver))/outnum
+ endif
!*********************************************************************
! Determine the standard deviation of the mean concentration or mixing
@@ -3794,82 +2685,108 @@ subroutine concoutput_sfc_nest(itime,outnum)
do ks=1,nspec
write(anspec,'(i3.3)') ks
- if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
- if (ldirect.eq.1) then
- open(unitoutgrid,file=path(2)(1:length(2))//'grid_conc_nest_' &
- //adate// &
- atime//'_'//anspec,form='unformatted')
- else
- open(unitoutgrid,file=path(2)(1:length(2))//'grid_time_nest_' &
- //adate// &
- atime//'_'//anspec,form='unformatted')
- endif
- write(unitoutgrid) itime
- endif
- if ((iout.eq.2).or.(iout.eq.3)) then ! mixing ratio
- open(unitoutgridppt,file=path(2)(1:length(2))//'grid_pptv_nest_' &
- //adate// &
- atime//'_'//anspec,form='unformatted')
+ do kp=1,maxpointspec_act
- write(unitoutgridppt) itime
- endif
+ print*, 'itime = ',itime
+ print*, 'lage(1) = ',lage(1)
+ print*, 'ireleasestart(kp) = ',ireleasestart(kp)
+ print*, 'ireleaseend(kp) = ',ireleaseend(kp)
+
+ ! check itime is within release and backward trajectory length
+ if (nageclass.eq.1) then
+ if ((itime.gt.ireleaseend(kp)).or.(itime.lt.(ireleasestart(kp)-lage(1)))) then
+ go to 10
+ endif
+ endif
+
+ ! calculate date of release
+ jul=bdate+real(ireleasestart(kp),kind=dp)/86400._dp ! this is the current day
+ call caldate(jul,jjjjmmdd,ihmmss)
+ write(areldate,'(i8.8)') jjjjmmdd
+ write(areltime,'(i6.6)') ihmmss
+ print*, areldate//areltime
+
+ ! calculate date of field
+ jul=bdate+real(itime,kind=dp)/86400._dp
+ call caldate(jul,jjjjmmdd,ihmmss)
+ write(adate,'(i8.8)') jjjjmmdd
+ write(atime,'(i6.6)') ihmmss
+ print*, adate//atime
+
+ if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
+ if (ldirect.eq.1) then
+ ! concentrations
+ inquire(file=path(2)(1:length(2))//'grid_conc_nest_'//areldate// &
+ areltime//'_'//anspec,exist=lexist)
+ if(lexist.and..not.lnstartrel(kp)) then
+ ! open and append to existing file
+ open(unitoutgrid,file=path(2)(1:length(2))//'grid_conc_nest_'//areldate// &
+ areltime//'_'//anspec,form='unformatted',status='old',action='write',access='append')
+ else
+ ! open new file
+ open(unitoutgrid,file=path(2)(1:length(2))//'grid_conc_nest_'//areldate// &
+ areltime//'_'//anspec,form='unformatted',status='replace',action='write')
+ endif
+ else
+ ! residence times
+ inquire(file=path(2)(1:length(2))//'grid_time_nest_'//areldate// &
+ areltime//'_'//anspec,exist=lexist)
+ if(lexist.and..not.lnstartrel(kp)) then
+ ! open and append to existing file
+ open(unitoutgrid,file=path(2)(1:length(2))//'grid_time_nest_'//areldate// &
+ areltime//'_'//anspec,form='unformatted',status='old',action='write',access='append')
+ else
+ ! open new file
+ open(unitoutgrid,file=path(2)(1:length(2))//'grid_time_nest_'//areldate// &
+ areltime//'_'//anspec,form='unformatted',status='replace',action='write')
+ endif
+ endif
+ write(unitoutgrid) jjjjmmdd
+ write(unitoutgrid) ihmmss
+ endif
- do kp=1,maxpointspec_act
- do nage=1,nageclass
+ if ((iout.eq.2).or.(iout.eq.3)) then
+ ! mixing ratio
+ inquire(file=path(2)(1:length(2))//'grid_pptv_nest_'//areldate// &
+ areltime//'_'//anspec,exist=lexist)
+ if(lexist.and..not.lnstartrel(kp)) then
+ ! open and append to existing file
+ open(unitoutgridppt,file=path(2)(1:length(2))//'grid_pptv_nest_'//areldate// &
+ areltime//'_'//anspec,form='unformatted',status='old',action='write',access='append')
+ else
+ ! open new file
+ open(unitoutgridppt,file=path(2)(1:length(2))//'grid_pptv_nest_'//areldate// &
+ areltime//'_'//anspec,form='unformatted',status='replace',action='write')
+ endif
+ write(unitoutgridppt) jjjjmmdd
+ write(unitoutgridppt) ihmmss
+ endif
- do jy=0,numygridn-1
- do ix=0,numxgridn-1
+ lnstartrel(kp)=.false.
- ! WET DEPOSITION
- if ((WETDEP).and.(ldirect.gt.0)) then
- do l=1,nclassunc
- auxgrid(l)=wetgriduncn(ix,jy,ks,kp,l,nage)
- end do
- call mean(auxgrid,wetgrid(ix,jy), &
- wetgridsigma(ix,jy),nclassunc)
- ! Multiply by number of classes to get total concentration
- wetgrid(ix,jy)=wetgrid(ix,jy) &
- *nclassunc
- ! Calculate standard deviation of the mean
- wetgridsigma(ix,jy)= &
- wetgridsigma(ix,jy)* &
- sqrt(real(nclassunc))
- endif
+ do nage=1,nageclass
- ! DRY DEPOSITION
- if ((DRYDEP).and.(ldirect.gt.0)) then
- do l=1,nclassunc
- auxgrid(l)=drygriduncn(ix,jy,ks,kp,l,nage)
- end do
- call mean(auxgrid,drygrid(ix,jy), &
- drygridsigma(ix,jy),nclassunc)
- ! Multiply by number of classes to get total concentration
- drygrid(ix,jy)=drygrid(ix,jy)* &
- nclassunc
- ! Calculate standard deviation of the mean
- drygridsigma(ix,jy)= &
- drygridsigma(ix,jy)* &
- sqrt(real(nclassunc))
- endif
+ do jy=0,numygridn-1
+ do ix=0,numxgridn-1
! CONCENTRATION OR MIXING RATIO
- do kz=1,numzgrid
- do l=1,nclassunc
- auxgrid(l)=griduncn(ix,jy,kz,ks,kp,l,nage)
- end do
- call mean(auxgrid,grid(ix,jy,kz), &
- gridsigma(ix,jy,kz),nclassunc)
+ do kz=1,numzgrid
+ do l=1,nclassunc
+ auxgrid(l)=griduncn(ix,jy,kz,ks,kp,l,nage)
+ end do
+ call mean(auxgrid,grid(ix,jy,kz), &
+ gridsigma(ix,jy,kz),nclassunc)
! Multiply by number of classes to get total concentration
- grid(ix,jy,kz)= &
- grid(ix,jy,kz)*nclassunc
+ grid(ix,jy,kz)= &
+ grid(ix,jy,kz)*nclassunc
! Calculate standard deviation of the mean
- gridsigma(ix,jy,kz)= &
- gridsigma(ix,jy,kz)* &
- sqrt(real(nclassunc))
+ gridsigma(ix,jy,kz)= &
+ gridsigma(ix,jy,kz)* &
+ sqrt(real(nclassunc))
+ end do
+ end do
end do
- end do
- end do
!*******************************************************************
@@ -3882,82 +2799,13 @@ subroutine concoutput_sfc_nest(itime,outnum)
! Concentration output
!*********************
- if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
- ! Wet deposition
- sp_count_i=0
- sp_count_r=0
- sp_fact=-1.
- sp_zer=.true.
- if ((ldirect.eq.1).and.(WETDEP)) then
- do jy=0,numygridn-1
- do ix=0,numxgridn-1
- !oncentraion greater zero
- if (wetgrid(ix,jy).gt.smallnum) then
- if (sp_zer.eqv..true.) then ! first non zero value
- sp_count_i=sp_count_i+1
- sparse_dump_i(sp_count_i)=ix+jy*numxgridn
- sp_zer=.false.
- sp_fact=sp_fact*(-1.)
- endif
- sp_count_r=sp_count_r+1
- sparse_dump_r(sp_count_r)= &
- sp_fact*1.e12*real(wetgrid(ix,jy))/arean(ix,jy)
- sparse_dump_u(sp_count_r)= &
- 1.e12*real(wetgridsigma(ix,jy))/area(ix,jy)
- else ! concentration is zero
- sp_zer=.true.
- endif
- end do
- end do
- else
- sp_count_i=0
- sp_count_r=0
- endif
- write(unitoutgrid) sp_count_i
- write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
- write(unitoutgrid) sp_count_r
- write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
- ! Dry deposition
- sp_count_i=0
- sp_count_r=0
- sp_fact=-1.
- sp_zer=.true.
- if ((ldirect.eq.1).and.(DRYDEP)) then
- do jy=0,numygridn-1
- do ix=0,numxgridn-1
- if (drygrid(ix,jy).gt.smallnum) then
- if (sp_zer.eqv..true.) then ! first non zero value
- sp_count_i=sp_count_i+1
- sparse_dump_i(sp_count_i)=ix+jy*numxgridn
- sp_zer=.false.
- sp_fact=sp_fact*(-1.)
- endif
- sp_count_r=sp_count_r+1
- sparse_dump_r(sp_count_r)= &
- sp_fact* &
- 1.e12*real(drygrid(ix,jy))/arean(ix,jy)
- sparse_dump_u(sp_count_r)= &
- 1.e12*real(drygridsigma(ix,jy))/area(ix,jy)
- else ! concentration is zero
- sp_zer=.true.
- endif
- end do
- end do
- else
- sp_count_i=0
- sp_count_r=0
- endif
- write(unitoutgrid) sp_count_i
- write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
- write(unitoutgrid) sp_count_r
- write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
+ if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
! Concentrations
- ! if sfc_only write only 1st layer
+ ! sfc_only write only 1st layer
- if(sfc_only.eq.1) then
sp_count_i=0
sp_count_r=0
sp_fact=-1.
@@ -3993,130 +2841,19 @@ subroutine concoutput_sfc_nest(itime,outnum)
write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
write(unitoutgrid) sp_count_r
write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
- else
-
- ! write full vertical resolution
-
- sp_count_i=0
- sp_count_r=0
- sp_fact=-1.
- sp_zer=.true.
- do kz=1,numzgrid
- do jy=0,numygridn-1
- do ix=0,numxgridn-1
- if (grid(ix,jy,kz).gt.smallnum) then
- if (sp_zer.eqv..true.) then ! first non zero value
- sp_count_i=sp_count_i+1
- sparse_dump_i(sp_count_i)= &
- ix+jy*numxgridn+kz*numxgridn*numygridn
- sp_zer=.false.
- sp_fact=sp_fact*(-1.)
- endif
- sp_count_r=sp_count_r+1
- sparse_dump_r(sp_count_r)= &
- sp_fact* &
- grid(ix,jy,kz)* &
- factor3d(ix,jy,kz)/tot_mu(ks,kp)
- sparse_dump_u(sp_count_r)= &
- gridsigma(ix,jy,kz)* &
- factor3d(ix,jy,kz)/tot_mu(ks,kp)
- else ! concentration is zero
- sp_zer=.true.
- endif
- end do
- end do
- end do
- write(unitoutgrid) sp_count_i
- write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
- write(unitoutgrid) sp_count_r
- write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
- endif ! sfc_only
-
- endif ! concentration output
+ endif ! concentration output
! Mixing ratio output
!********************
- if ((iout.eq.2).or.(iout.eq.3)) then ! mixing ratio
-
- ! Wet deposition
- sp_count_i=0
- sp_count_r=0
- sp_fact=-1.
- sp_zer=.true.
- if ((ldirect.eq.1).and.(WETDEP)) then
- do jy=0,numygridn-1
- do ix=0,numxgridn-1
- if (wetgrid(ix,jy).gt.smallnum) then
- if (sp_zer.eqv..true.) then ! first non zero value
- sp_count_i=sp_count_i+1
- sparse_dump_i(sp_count_i)= &
- ix+jy*numxgridn
- sp_zer=.false.
- sp_fact=sp_fact*(-1.)
- endif
- sp_count_r=sp_count_r+1
- sparse_dump_r(sp_count_r)= &
- sp_fact* &
- 1.e12*real(wetgrid(ix,jy))/arean(ix,jy)
- sparse_dump_u(sp_count_r)= &
- 1.e12*real(wetgridsigma(ix,jy))/area(ix,jy)
- else ! concentration is zero
- sp_zer=.true.
- endif
- end do
- end do
- else
- sp_count_i=0
- sp_count_r=0
- endif
- write(unitoutgridppt) sp_count_i
- write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
- write(unitoutgridppt) sp_count_r
- write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
+ if ((iout.eq.2).or.(iout.eq.3)) then ! mixing ratio
- ! Dry deposition
- sp_count_i=0
- sp_count_r=0
- sp_fact=-1.
- sp_zer=.true.
- if ((ldirect.eq.1).and.(DRYDEP)) then
- do jy=0,numygridn-1
- do ix=0,numxgridn-1
- if (drygrid(ix,jy).gt.smallnum) then
- if (sp_zer.eqv..true.) then ! first non zero value
- sp_count_i=sp_count_i+1
- sparse_dump_i(sp_count_i)= &
- ix+jy*numxgridn
- sp_zer=.false.
- sp_fact=sp_fact*(-1)
- endif
- sp_count_r=sp_count_r+1
- sparse_dump_r(sp_count_r)= &
- sp_fact* &
- 1.e12*real(drygrid(ix,jy))/arean(ix,jy)
- sparse_dump_u(sp_count_r)= &
- 1.e12*real(drygridsigma(ix,jy))/area(ix,jy)
- else ! concentration is zero
- sp_zer=.true.
- endif
- end do
- end do
- else
- sp_count_i=0
- sp_count_r=0
- endif
- write(unitoutgridppt) sp_count_i
- write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
- write(unitoutgridppt) sp_count_r
- write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
! Mixing ratios
- ! if sfc_only write only 1st layer
+ ! sfc_only write only 1st layer
- if(sfc_only.eq.1) then
sp_count_i=0
sp_count_r=0
sp_fact=-1.
@@ -4148,72 +2885,37 @@ subroutine concoutput_sfc_nest(itime,outnum)
end do
end do
end do
- write(unitoutgridppt) sp_count_i
- write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
- write(unitoutgridppt) sp_count_r
- write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
- else
-
- ! write full vertical resolution
+ write(unitoutgridppt) sp_count_i
+ write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
+ write(unitoutgridppt) sp_count_r
+ write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
- sp_count_i=0
- sp_count_r=0
- sp_fact=-1.
- sp_zer=.true.
- do kz=1,numzgrid
- do jy=0,numygridn-1
- do ix=0,numxgridn-1
- if (grid(ix,jy,kz).gt.smallnum) then
- if (sp_zer.eqv..true.) then ! first non zero value
- sp_count_i=sp_count_i+1
- sparse_dump_i(sp_count_i)= &
- ix+jy*numxgridn+kz*numxgridn*numygridn
- sp_zer=.false.
- sp_fact=sp_fact*(-1.)
- endif
- sp_count_r=sp_count_r+1
- sparse_dump_r(sp_count_r)= &
- sp_fact* &
- 1.e12*grid(ix,jy,kz) &
- /volumen(ix,jy,kz)/outnum* &
- weightair/weightmolar(ks)/densityoutgrid(ix,jy,kz)
- sparse_dump_u(sp_count_r)= &
- 1.e12*gridsigma(ix,jy,kz)/volumen(ix,jy,kz)/ &
- outnum*weightair/weightmolar(ks)/ &
- densityoutgrid(ix,jy,kz)
- else ! concentration is zero
- sp_zer=.true.
- endif
- end do
- end do
- end do
- write(unitoutgridppt) sp_count_i
- write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
- write(unitoutgridppt) sp_count_r
- write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
- endif ! sfc_only
+ endif ! output for ppt
+
+ end do ! nageclass
- endif ! output for ppt
+ close(unitoutgridppt)
+ close(unitoutgrid)
- end do
- end do
+ ! itime is outside range
+10 continue
- close(unitoutgridppt)
- close(unitoutgrid)
+ end do ! maxpointspec_act
- end do
+ end do ! nspec
- ! RLT Aug 2017
! Write out conversion factor for dry air
+ !*****************************************
+
inquire(file=path(2)(1:length(2))//'factor_drygrid_nest',exist=lexist)
- if (lexist) then
+ if (lexist.and..not.lnstart) then
! open and append
open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid_nest',form='unformatted',&
status='old',action='write',access='append')
else
! create new
open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid_nest',form='unformatted',&
- status='new',action='write')
+ status='replace',action='write')
endif
sp_count_i=0
sp_count_r=0
@@ -4245,30 +2947,18 @@ subroutine concoutput_sfc_nest(itime,outnum)
write(unitoutfactor) (sparse_dump_r(i),i=1,sp_count_r)
close(unitoutfactor)
-
+ ! reset lnstart
+ if (lnstart) then
+ lnstart=.false.
+ endif
! Reinitialization of grid
!*************************
- do ks=1,nspec
- do kp=1,maxpointspec_act
- do i=1,numreceptor
- creceptor(i,ks)=0.
- end do
- do jy=0,numygridn-1
- do ix=0,numxgridn-1
- do l=1,nclassunc
- do nage=1,nageclass
- do kz=1,numzgrid
- griduncn(ix,jy,kz,ks,kp,l,nage)=0.
- end do
- end do
- end do
- end do
- end do
- end do
- end do
-end subroutine concoutput_sfc_nest
+ griduncn(:,:,:,:,:,:,:)=0.
+
+end subroutine concoutput_inversion_nest
+
subroutine initcond_output(itime)
! i
diff --git a/src/chemistry_mod.f90 b/src/chemistry_mod.f90
new file mode 100644
index 0000000000000000000000000000000000000000..3bd7f844567dcbe5c1e9f5a5ff829359533018e8
--- /dev/null
+++ b/src/chemistry_mod.f90
@@ -0,0 +1,952 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2019, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+ !*****************************************************************************
+ ! *
+ ! This module contains variables and subroutines for calculating *
+ ! chemical loss of species *
+ ! *
+ !*****************************************************************************
+
+module chemistry_mod
+
+ use netcdf
+ use par_mod
+ use com_mod
+ use date_mod
+ use windfields_mod, only: rho,nxmax,nymax,nzmax
+ use totals_mod, only: chem_loss
+ use netcdf_output_mod, only: nf90_err
+
+ ! reagent field variables
+
+ implicit none
+
+ integer, allocatable, dimension(:) :: nxCL, nyCL, nzCL
+ integer :: nxjr, nyjr
+ real, allocatable, dimension(:,:) :: lonCL, latCL, altCL
+ real, allocatable, dimension(:) :: dxCL, dyCL
+ real :: dxjr, dyjr
+ real, allocatable, dimension(:,:,:,:,:) :: CL_field ! chemical loss fields at input resolution
+ real, allocatable, dimension(:,:,:,:) :: clfield_cur ! chemical loss fields current hour
+ integer, dimension(2) :: memCLtime ! time of fields in memory (sec)
+ integer :: curCLhour ! current hour since start of simulation
+ real(kind=dp), dimension(2) :: CL_time ! julian date of fields in memory
+ real, allocatable, dimension(:,:,:) :: jrate_average ! monthly average actinic flux
+ real, allocatable, dimension(:) :: lonjr, latjr
+
+ private :: zenithangle, photo_O1D
+
+ contains
+
+ subroutine readreagents()
+
+ !*****************************************************************************
+ ! *
+ ! This routine reads names and input paths of chemical reagents *
+ ! *
+ ! Author: R. Thompson, Sep 2023 *
+ ! *
+ !*****************************************************************************
+ ! *
+ ! Variables: *
+ ! preagent Reagent name *
+ ! preag_path Path to reagent fields *
+ ! phourly Logical for hourly interpolate (0 = no, 1 = yes) *
+ ! *
+ !*****************************************************************************
+
+ implicit none
+
+ character(len=256) :: preag_path
+ character(len=16) :: preagent, punit
+ integer :: phourly
+ integer,parameter :: unitreagents=2, unitreagentsout=3
+ integer :: readerror
+ integer :: j
+
+ ! declare namelist
+ namelist /reagent_params/ &
+ preagent, preag_path, phourly, punit
+
+ preagent="" ! read failure indicator value
+ preag_path=""
+ punit=""
+ phourly=0
+ reag_hourly(:)=0
+
+ open(unitreagents,file=path(1)(1:length(1))//'REAGENTS',status='old',form='formatted',iostat=readerror)
+ if (readerror.ne.0) then
+ ! no REAGENTS file
+ nreagent=0
+ go to 999
+ endif
+
+ ! prepare namelist output if requested
+ if (nmlout.and.lroot) then
+ open(unitreagentsout,file=path(2)(1:length(2))//'REAGENTS.namelist',access='append',status='replace',iostat=readerror)
+ if (readerror.ne.0) then
+ write(*,*) '#### FLEXPART MODEL ERROR CANNOT CREATE FILE: ####'
+ write(*,*) '#### ',path(2)(1:length(2))//'REAGENTS.namelist ####'
+ endif
+ endif
+
+ ! try namelist input
+ read(unitreagents,reagent_params,iostat=readerror)
+ close(unitreagents)
+ if (readerror.ne.0) then
+ ! not namelist format
+ nreagent=0
+ go to 999
+ endif
+
+ ! namelist input
+ open(unitreagents,file=path(1)(1:length(1))//'REAGENTS',status='old',form='formatted',iostat=readerror)
+ j=0
+ do while (readerror.eq.0)
+ j=j+1
+ if (j.gt.maxreagent) then
+ write(*,*) ' #### FLEXPART MODEL ERROR! TOO MANY REAGENTS #### '
+ write(*,*) ' #### MAXIMUM NUMBER IS ',maxreagent,' #### '
+ write(*,*) ' #### PLEASE MAKE CHANGES IN FILE REAGENTS #### '
+ stop
+ endif
+ read(unitreagents,reagent_params,iostat=readerror)
+ reagents(j)=preagent
+ reag_path(j)=preag_path
+ reag_hourly(j)=phourly
+ reag_unit(j)=punit
+ ! namelist output
+ if (nmlout.and.lroot) then
+ write(unitreagentsout,nml=reagent_params)
+ endif
+ end do
+ nreagent=j-1
+ if (lroot) then
+ write(*,*) 'Number of reagents: ',nreagent
+ write(*,*) 'Reagent names: ',reagents(1:nreagent)
+ write(*,*) 'Reagent units: ',reag_unit(1:nreagent)
+ endif
+ close(unitreagents)
+ close(unitreagentsout)
+
+999 continue ! no reagents file
+
+ end subroutine readreagents
+
+ subroutine getchemfield(itime)
+
+ !*****************************************************************************
+ ! *
+ ! This routine reads the chemical reagent fields into memory *
+ ! *
+ ! Author: Rona Thompson, Sep 2023 *
+ ! *
+ !*****************************************************************************
+ ! *
+ ! Variables: *
+ ! *
+ ! itime time since start of simulation in sec *
+ ! *
+ !*****************************************************************************
+
+ implicit none
+
+ integer :: itime
+ integer :: jjjjmmdd, hhmmss, mm, eomday
+ integer :: nr, memid
+ character(len=2) :: amonth
+ character(len=256):: CL_name, jr_name
+ logical :: lexist
+
+ print*, 'getchemfield: ldirect*memCLtime(1) = ',ldirect*memCLtime(1)
+ print*, 'getchemfield: ldirect*memCLtime(2) = ',ldirect*memCLtime(2)
+
+ ! Check fields are available for the current time step
+ !*****************************************************
+
+ if ((ldirect*memCLtime(1).le.ldirect*itime).and. &
+ (ldirect*memCLtime(2).gt.ldirect*itime)) then
+
+ ! The rightfields are already in memory -> don't do anything
+ return
+
+ else if ((ldirect*memCLtime(2).le.ldirect*itime).and. &
+ (memCLtime(2).ne.0.)) then
+
+ ! Current time is after 2nd chem field
+ !*************************************
+
+ do nr=1,nreagent
+
+ write(*,*) 'Updating CL field for: ',trim(reagents(nr))
+
+ CL_field(:,:,:,nr,1)=CL_field(:,:,:,nr,2)
+ memCLtime(1)=memCLtime(2) ! time in sec
+ CL_time(1)=CL_time(2) ! julian date
+ memid=2
+
+ ! Read new chem field and store in 2nd position
+ !**********************************************
+
+ ! julian date of next chem field assuming monthly fields
+ call caldate(CL_time(1), jjjjmmdd, hhmmss)
+ eomday=calceomday(jjjjmmdd/100)
+ memCLtime(2)=memCLtime(1)+ldirect*eomday*24*3600 ! time in sec
+ CL_time(2)=CL_time(1)+real(ldirect*eomday,kind=dp) ! julian date
+ !! test
+ write(*,*) 'memCLtime = ',memCLtime(1), memCLtime(2)
+ write(*,*) 'CL_time = ',CL_time(1), CL_time(2)
+ !!
+ call caldate(CL_time(2), jjjjmmdd,hhmmss)
+ mm=int((jjjjmmdd-(jjjjmmdd/10000)*10000)/100)
+ write(amonth,'(I2.2)') mm
+ write(CL_name,'(A)') trim(reag_path(nr))//trim(reagents(nr))//'_'//amonth//'.nc'
+ inquire(file=CL_name,exist=lexist)
+ if (lexist) then
+ write(*,*) 'Reading CL field: ',CL_name
+ call readchemfield(CL_name, memid, nr)
+ else
+ write(*,*) '#### FLEXPART ERROR ####'
+ write(*,*) '#### CHEMISTRY FIELD NOT FOUND ####'
+ write(*,*) '#### '//trim(CL_name)//' ####'
+ error stop
+ endif
+
+ if (reag_hourly(nr).gt.0) then
+
+ ! Read average jrates and store in 2nd position
+ !**********************************************
+
+ write(jr_name,'(A)') trim(reag_path(nr))//'jrate_average.nc'
+ inquire(file=jr_name,exist=lexist)
+ if (lexist) then
+ write(*,*) 'Reading jrate field: ',jr_name
+ call readjrate(jr_name, memid, mm)
+ else
+ write(*,*) '#### FLEXPART ERROR ####'
+ write(*,*) '#### JRATE_AVERAGE NOT FOUND ####'
+ write(*,*) '#### '//trim(jr_name)//' ####'
+ error stop
+ endif
+
+ endif
+
+ end do ! nreagent
+
+ else
+
+ ! No chem field in memory that can be used
+ !******************************************
+
+ do nr=1,nreagent
+
+ write(*,*) 'Reading two new CL fields for: ',trim(reagents(nr))
+
+ ! read both fields into memory
+ do memid=1,2
+ if (memid.eq.1) then
+ CL_time(memid)=bdate+real(ldirect*itime,kind=dp)/86400._dp
+ else
+ CL_time(memid)=CL_time(memid-1)+real(ldirect*eomday,kind=dp)
+ endif
+ memCLtime(memid)=int((CL_time(memid)-bdate)*86400._dp)*ldirect
+ call caldate(CL_time(memid), jjjjmmdd, hhmmss)
+ mm=int((jjjjmmdd-(jjjjmmdd/10000)*10000)/100)
+ eomday=calceomday(jjjjmmdd/100)
+ write(amonth,'(I2.2)') mm
+ write(CL_name,'(A)') trim(reag_path(nr))//trim(reagents(nr))//'_'//amonth//'.nc'
+ inquire(file=CL_name,exist=lexist)
+ if (lexist) then
+ write(*,*) 'Reading CL field: ',CL_name
+ call readchemfield(CL_name, memid, nr)
+ else
+ write(*,*) '#### FLEXPART ERROR ####'
+ write(*,*) '#### CHEMISTRY FIELD NOT FOUND ####'
+ write(*,*) '#### '//trim(CL_name)//' ####'
+ error stop
+ endif
+ if (reag_hourly(nr).gt.0) then
+ ! Read average jrates into memory
+ write(jr_name,'(A)') trim(reag_path(nr))//'jrate_average.nc'
+ inquire(file=jr_name,exist=lexist)
+ if (lexist) then
+ write(*,*) 'Reading jrate field: ',jr_name
+ call readjrate(jr_name, memid, mm)
+ else
+ write(*,*) '#### FLEXPART ERROR ####'
+ write(*,*) '#### JRATE_AVERAGE NOT FOUND ####'
+ write(*,*) '#### '//trim(jr_name)//' ####'
+ error stop
+ endif
+ endif ! reag_hourly
+ end do ! memid
+
+ end do ! nreagent
+
+ endif ! update hourly fields
+
+
+ end subroutine getchemfield
+
+
+ subroutine readchemfield(CL_name,memid,nr)
+
+ !*****************************************************************************
+ ! *
+ ! Reads the chemical reagent fields into memory *
+ ! *
+ ! Author: Rona Thompson, Sep 2023 *
+ ! *
+ !*****************************************************************************
+ ! *
+ ! Variables: *
+ ! *
+ ! CL_name name of chemical reagent file *
+ ! memid time index to chemical field variable *
+ ! nr reagent index to chemical field variable *
+ ! *
+ !*****************************************************************************
+
+ implicit none
+
+ character(len=256) :: CL_name
+ integer :: memid,nr,len
+ integer :: ncid,dimid,varid
+
+ ! Read netcdf file
+ !******************
+
+ ! open file
+ call nf90_err( nf90_open(trim(CL_name),nf90_NOWRITE,ncid) )
+
+ ! longitude
+ call nf90_err( nf90_inq_dimid(ncid,'lon',dimid) )
+ call nf90_err( nf90_inquire_dimension(ncid,dimid,len=len) )
+ if (.not.allocated(lonCL)) then
+ allocate(nxCL(nreagent))
+ allocate(dxCL(nreagent))
+ allocate(lonCL(nxmax,nreagent))
+ endif
+ nxCL(nr)=len
+ call nf90_err( nf90_inq_varid(ncid,'lon',varid) )
+ call nf90_err( nf90_get_var(ncid,varid,lonCL(1:nxCL(nr),nr)) )
+ dxCL(nr)=abs(lonCL(2,nr)-lonCL(1,nr))
+
+ ! latitude
+ call nf90_err( nf90_inq_dimid(ncid,'lat',dimid) )
+ call nf90_err( nf90_inquire_dimension(ncid,dimid,len=len) )
+ if (.not.allocated(latCL)) then
+ allocate(nyCL(nreagent))
+ allocate(dyCL(nreagent))
+ allocate(latCL(nymax,nreagent))
+ endif
+ nyCL(nr)=len
+ call nf90_err( nf90_inq_varid(ncid,'lat',varid) )
+ call nf90_err( nf90_get_var(ncid,varid,latCL(1:nyCL(nr),nr)) )
+ dyCL(nr)=abs(latCL(2,nr)-latCL(1,nr))
+
+ ! altitude
+ call nf90_err( nf90_inq_dimid(ncid,'lev',dimid) )
+ call nf90_err( nf90_inquire_dimension(ncid,dimid,len=len) )
+ if (.not.allocated(altCL)) then
+ allocate(nzCL(nreagent))
+ allocate(altCL(nzmax,nreagent))
+ endif
+ nzCL(nr)=len
+ call nf90_err( nf90_inq_varid(ncid,'lev',varid) )
+ call nf90_err( nf90_get_var(ncid,varid,altCL(1:nzCL(nr),nr)) )
+
+ ! chemical field
+ call nf90_err( nf90_inq_varid(ncid,trim(reagents(nr)),varid) )
+ if (.not.allocated(CL_field)) then
+ allocate(CL_field(nxmax,nymax,nzmax,nreagent,2))
+ allocate(clfield_cur(nxmax,nymax,nzmax,nreagent))
+ endif
+ call nf90_err( nf90_get_var(ncid,varid,CL_field(1:nxCL(nr),1:nyCL(nr),1:nzCL(nr),nr,memid)) )
+
+ ! close file
+ call nf90_err( nf90_close(ncid) )
+
+ !! testing
+! print*, 'readchemfield: nxCL, nyCL, nzCL = ',nxCL(nr), nyCL(nr), nzCL(nr)
+! print*, 'readchemfield: lonCL = ',lonCL(1:nxCL(nr),nr)
+! print*, 'readchemfield: latCL = ',latCL(1:nyCL(nr),nr)
+
+ return
+
+ end subroutine readchemfield
+
+ subroutine getchemhourly(itime)
+
+ !*****************************************************************************
+ ! *
+ ! This routine interpolates the chemistry fields to current hour and *
+ ! if required using information on solar zenith angle *
+ ! *
+ ! Author: Rona Thompson, Mar 2024 *
+ ! *
+ !*****************************************************************************
+ ! *
+ ! Variables: *
+ ! itime [s] actual simulation time [s] *
+ ! *
+ !*****************************************************************************
+
+ use point_mod, only: xlon0, ylat0, dx, dy
+ use windfields_mod, only : height, nz
+
+ implicit none
+
+ integer :: itime, curhour, interp_time
+ integer :: nr, kz, ix, jy, ixm, jym, ixp, jyp, indz, indzm, ii
+ real :: dt1, dt2, dtt, sza, jrate, jrate_cur, r
+ real, dimension(2) :: r1
+ real :: dz1, dz2, dz, ddx, ddy, rddx, rddy, p1, p2, p3, p4
+ integer :: jjjjmmdd, hhmmss
+ integer :: jrx, jry
+ real(kind=dp) :: jul
+ real, parameter :: avog = 6.02214e23 ! Avogadro constant (1/mol)
+ !! testing
+! character(len=4) :: atime
+! character(len=20) :: frmt
+! real, dimension(nxjr,nyjr) :: jscalar, sza_grid
+
+ !! testing
+! jscalar(:,:)=1.
+! sza_grid(:,:)=0.
+
+ ! current hour of simulation
+ curhour=itime/3600
+ print*, 'getchemhourly: curhour, curCLhour = ',curhour, curCLhour
+
+ jul=bdate+real(itime,kind=dp)/86400._dp
+ call caldate(jul,jjjjmmdd,hhmmss)
+
+ if ((ldirect*curCLhour.eq.ldirect*curhour).and.(ldirect*itime.gt.0)) then
+ ! chemical field is for current hour -> don't do anything
+ return
+ else
+ ! interpolate to middle of hour
+ curCLhour=curhour
+ interp_time=curhour*3600+1800
+ dt1=float(interp_time-memCLtime(1))
+ dt2=float(memCLtime(2)-interp_time)
+ dtt=1./(dt1+dt2)
+ !! testing
+! print*, 'getchemhourly: dt1, dt2, dtt = ',dt1,dt2,dtt
+ do nr=1,nreagent
+ write(*,*) 'Interpolating fields for reagent: ',reagents(nr)
+ clfield_cur(:,:,:,nr)=(dt2*CL_field(:,:,:,nr,1) + dt1*CL_field(:,:,:,nr,2))*dtt
+ if (reag_unit(nr).eq.'mol/mol') then
+ ! convert to molecule/cm3
+!$OMP PARALLEL &
+!$OMP PRIVATE(kz,ix,jy,indz,indzm,ixm,jym,ixp,jyp,ddx,ddy,rddx,rddy,&
+!$OMP p1,p2,p3,p4,r1,ii,dz1,dz2,dz,r)
+!$OMP DO
+ do kz=1,nzCL(nr)
+ ! assume chem fields vertical coordinate is in meters
+ indzm=nz-1
+ do indz=1,nz
+ if (height(indz).gt.altCL(kz,nr)) then
+ indzm=indz-1
+ exit
+ endif
+ end do
+ dz1=altCL(kz,nr)-height(indzm)
+ dz2=height(indz)-altCL(kz,nr)
+ dz=1./(dz1+dz2)
+ do jy=1,nyCL(nr)
+ jym=int((latCL(jy,nr)-ylat0)/dy)
+ jyp=jym+1
+ ddy=(latCL(jy,nr)-ylat0)/dy-real(jym)
+ rddy=1.-ddy
+ do ix=1,nxCL(nr)
+ ixm=int((lonCL(ix,nr)-xlon0)/dx)
+ ixp=ixm+1
+ ddx=(lonCL(ix,nr)-xlon0)/dx-real(ixm)
+ rddx=1.-ddx
+ p1=rddx*rddy
+ p2=ddx*rddy
+ p3=rddx*ddy
+ p4=ddx*ddy
+ !! testing
+! if ((ix.lt.5).and.(jy.gt.10.and.jy.lt.20).and.kz.eq.1) then
+! print*, 'getchemhourly: lonCL, xlon, latCL, ylat = ',lonCL(ix,nr), xlon0+ixm*dx, latCL(jy,nr), ylat0+jyp*dy
+! print*, 'getchemhourly: altCL, height = ',altCL(kz,nr), (dz2*height(indzm)+dz1*height(indzm+1))*dz
+! endif
+ ! take density from first field (accurate enough)
+ do ii=1,2
+ indz=indzm+ii-1
+ r1(ii)=p1*rho(ixm,jym,indz,1)+&
+ p2*rho(ixp,jym,indz,1)+&
+ p3*rho(ixm,jyp,indz,1)+&
+ p4*rho(ixp,jyp,indz,1)
+ end do
+ r=(dz2*r1(1)+dz1*r1(2))*dz
+ ! vmr*Avog*P/(RT)/1e6
+ ! using P/T = rho*rair
+ clfield_cur(ix,jy,kz,nr)=clfield_cur(ix,jy,kz,nr)*avog*r*r_air/rgas/1.e6
+ end do
+ end do
+ end do
+!$OMP END DO
+!$OMP END PARALLEL
+ endif
+ if (reag_hourly(nr).gt.0) then
+ ! use actinic flux (jrate) for interpolation
+!$OMP PARALLEL &
+!$OMP PRIVATE(kz,jy,jry,ix,jrx,sza,jrate,jrate_cur)
+!$OMP DO
+ do kz=1,nzCL(nr)
+ do jy=1,nyCL(nr)
+ ! jrate_average dimensions given as grid midpoints
+ jry=int((latCL(jy,nr)-(latjr(1)-0.5*dyjr))/dyjr)+1
+ jry=min(jry,nyCL(nr))
+ !! testing
+! if (kz.eq.1.and.jy.lt.10) print*, 'latCL, latjr = ',latCL(jy), latjr(jry)
+ do ix=1,nxCL(nr)
+ ! jrate_average dimensions given as grid midpoints
+ jrx=int((lonCL(ix,nr)-(lonjr(1)-0.5*dxjr))/dxjr)+1
+ jrx=min(jrx,nxCL(nr))
+ !! testing
+! if (kz.eq.1.and.jy.lt.10.and.ix.lt.10) print*, 'lonCL, lonjr = ',lonCL(ix), lonjr(jrx)
+ ! solar zenith angle
+ sza=zenithangle(latjr(jry),lonjr(jrx),jjjjmmdd,hhmmss)
+ ! calculate J(O1D) (jrate)
+ jrate=photo_O1D(sza)
+ jrate_cur=(dt2*jrate_average(jrx,jry,1) + &
+ dt1*jrate_average(jrx,jry,2))*dtt
+ ! apply hourly correction to chem field
+ if(jrate_cur.gt.0.) then
+ clfield_cur(ix,jy,kz,nr)=clfield_cur(ix,jy,kz,nr)*jrate/jrate_cur
+ !! testing
+! if (kz.eq.1) then
+! jscalar(ix,jy)=jrate/jrate_cur
+! sza_grid(ix,jy)=sza
+! endif
+ endif
+ end do
+ end do
+ end do
+!$OMP END DO
+!$OMP END PARALLEL
+ endif ! reag_hourly
+ end do ! nreagent
+ endif ! curhour
+
+ !! testing
+! write(frmt,fmt='(A,I4,A)') '(',nxCL,'(E14.6))'
+! write(atime,fmt='(I4.4)') curhour
+! open(600,file=path(2)(1:length(2))//'clfield_'//atime//'.txt',action='write',status='replace')
+! do kz=1,nzCL
+! do jy=1,nyCL
+! write(600,fmt=frmt) clfield_cur(:,jy,kz,1)
+! end do
+! end do
+! close(600)
+! write(frmt,fmt='(A,I4,A)') '(',nxjr,'(E14.6))'
+! open(600,file=path(2)(1:length(2))//'jscalar_'//atime//'.txt',action='write',status='replace')
+! do jy=1,nyjr
+! write(600,fmt=frmt) jscalar(:,jy)
+! end do
+! close(600)
+! write(frmt,fmt='(A,I4,A)') '(',nxjr,'(E14.6))'
+! open(600,file=path(2)(1:length(2))//'sza_'//atime//'.txt',action='write',status='replace')
+! do jy=1,nyjr
+! write(600,fmt=frmt) sza_grid(:,jy)
+! end do
+! close(600)
+
+ end subroutine getchemhourly
+
+ subroutine chemreaction(itime)
+
+ !*****************************************************************************
+ ! *
+ ! This routine computes the chemical loss of each species and updates *
+ ! the particle mass *
+ ! *
+ ! Author: Rona Thompson, Sep 2023 *
+ ! updated for v11, Jan 2024 *
+ ! *
+ !*****************************************************************************
+ ! *
+ ! Variables: *
+ ! itime [s] actual simulation time [s] *
+ ! *
+ !*****************************************************************************
+
+ use particle_mod, only: count, part, mass
+ use point_mod, only: xlon0, ylat0, dx, dy
+ use windfields_mod, only: xresoln, yresoln, xln, yln, xrn, yrn, height, tt, nz
+ use omp_lib
+
+ implicit none
+
+ integer :: jpart,itime
+ integer :: ii,i,j,ks,ix,jy,kz,jrx,jry,nr
+ integer :: ngrid,interp_time,n,indz
+ integer :: jjjjmmdd,hhmmss,mm,hh,m1,m2
+ integer :: clx,cly,clz,clzm,ithread
+ real, dimension(nzmax) :: altCLtop
+ real, dimension(2) :: cl_tmp
+ real :: xlon,ylat
+ real :: xtn,ytn
+ real :: dt1,dt2,dtt,dtt1,dtt2,dttt,dz1,dz2,dzz
+ real :: restmass,clreacted,cl_cur
+ real :: jrate,jrate_cur,sza
+ real :: clrate,temp
+ real, parameter :: smallnum = tiny(0.0) ! smallest number that can be handled
+ real(kind=dp) :: jul
+ real :: lonjrx,latjry
+#ifdef _OPENMP
+ real(kind=dp), allocatable, dimension(:,:,:) :: chem_loss_tmp
+#endif
+
+ ! use middle of synchronisation time step
+ interp_time=nint(itime+0.5*lsynctime)
+ dtt1=float(interp_time-memtime(1))
+ dtt2=float(memtime(2)-interp_time)
+ dttt=1./(dtt1+dtt2)
+
+ ! initialization
+ chem_loss(:,:)=0d0
+
+#ifdef _OPENMP
+ allocate( chem_loss_tmp(nreagent,nspec,numthreads) )
+ chem_loss_tmp(:,:,:) = 0d0
+#endif
+
+ ! Loop over particles
+ !*****************************************
+
+!$OMP PARALLEL &
+!$OMP PRIVATE(ii,jpart,ngrid,j,xtn,ytn,ix,jy, &
+!$OMP xlon,ylat,clx,cly,clz,clzm,kz,altCLtop,dz1,dz2,dzz,nr,i, &
+!$OMP cl_cur,indz,temp,ks,clrate,restmass,clreacted,ithread)
+
+#ifdef _OPENMP
+ ithread = OMP_GET_THREAD_NUM()+1 ! Starts with 1
+#else
+ ithread = 1
+#endif
+
+!$OMP DO
+ do ii=1,count%alive
+
+ jpart=count%ialive(ii)
+ ! Determine which nesting level to be used
+ ngrid=0
+ do j=numbnests,1,-1 ! check if need +/- dxn below
+ if ((part(jpart)%xlon.gt.xln(j)).and.(part(jpart)%xlon.lt.xrn(j)).and. &
+ (part(jpart)%ylat.gt.yln(j)).and.(part(jpart)%ylat.lt.yrn(j))) then
+ ngrid=j
+ exit
+ endif
+ end do
+
+ ! Determine nested grid coordinates
+ if (ngrid.gt.0) then
+ xtn=(real(part(jpart)%xlon)-xln(ngrid))*xresoln(ngrid)
+ ytn=(real(part(jpart)%ylat)-yln(ngrid))*yresoln(ngrid)
+ ix=int(xtn)
+ jy=int(ytn)
+ else
+ ix=int(part(jpart)%xlon)
+ jy=int(part(jpart)%ylat)
+ endif
+
+ ! Get CL from nearest grid-cell for current hour
+ !***********************************************
+
+ ! world coordinates
+ xlon=real(part(jpart)%xlon)*dx+xlon0
+ if (xlon.gt.180.) then
+ xlon=xlon-360.
+ endif
+ ylat=real(part(jpart)%ylat)*dy+ylat0
+ if (ylat.gt.90.) then
+ ylat=90.
+ endif
+
+ do nr=1,nreagent
+
+ ! get position in the chem field
+ ! assumes chem field dimensions given as grid midpoints
+ clx=min(nxCL(nr),int((xlon-(lonCL(1,nr)-0.5*dxCL(nr)))/dxCL(nr))+1)
+ cly=min(nyCL(nr),int((ylat-(latCL(1,nr)-0.5*dyCL(nr)))/dyCL(nr))+1)
+
+ ! get the level of the chem field for the particle
+ ! z is the z-coord of the trajectory above model orography in metres
+ ! altCL is the height of the centre of the level in the chem field above orography
+ do kz=2,nzCL(nr)
+ altCLtop(kz-1)=altCL(kz-1,nr)+0.5*(altCL(kz,nr)-altCL(kz-1,nr))
+ end do
+ altCLtop(nzCL(nr))=altCL(nzCL(nr),nr)+0.5*(altCL(nzCL(nr),nr)-altCL(nzCL(nr)-1,nr))
+ clzm=nzCL(nr)-1
+ do clz=1,nzCL(nr)
+ if (real(part(jpart)%z).lt.altCLtop(clz)) then
+ clzm=clz-1
+ exit
+ endif
+ end do
+ clz=min(nzCL(nr),clz)
+ if (clzm.eq.0 ) then
+ dz1=1.
+ dz2=1.
+ clzm=clz
+ else
+ dz1=real(part(jpart)%z)-altCL(clzm,nr)
+ dz2=altCL(clz,nr)-real(part(jpart)%z)
+ endif
+ if (dz1.eq.(-1.*dz2)) then
+ dz1=1.
+ dz2=1.
+ endif
+ dzz=1./(dz1+dz2)
+
+ !! testing
+ if(ii.lt.100) print*, 'chemreaction: nr, clx, cly, clz, clzm = ',nr, clx, cly, clz, clzm
+
+ ! chem reagent for particle time and location
+ cl_cur=(dz2*clfield_cur(clx,cly,clzm,nr) + &
+ dz1*clfield_cur(clx,cly,clz,nr))*dzz
+
+ ! Compute chemical loss
+ !**********************
+
+ if (cl_cur.gt.smallnum) then
+ indz=nz
+ do kz=2,nz
+ if (height(kz).gt.part(jpart)%z) then
+ indz=kz-1
+ exit
+ endif
+ end do
+ temp=(tt(ix,jy,indz,1)*dtt2 &
+ + tt(ix,jy,indz,2)*dtt1)*dttt
+ do ks=1,nspec
+ if (reaccconst(nr,ks).gt.0.) then
+ ! k = CT^Nexp(-D/T)[reagent]
+ clrate=reaccconst(nr,ks)*(temp**reacnconst(nr,ks))*exp(-1.*reacdconst(nr,ks)/temp)*cl_cur
+ ! new particle mass
+ restmass=mass(jpart,ks)*exp(-1.*clrate*abs(lsynctime))
+ if (restmass.gt.smallnum) then
+ clreacted=mass(jpart,ks)-restmass
+ mass(jpart,ks)=restmass
+ else
+ clreacted=mass(jpart,ks)
+ mass(jpart,ks)=0.
+ endif
+#ifdef _OPENMP
+ chem_loss_tmp(nr,ks,ithread)=chem_loss_tmp(nr,ks,ithread)+real(clreacted,kind=dp)
+#else
+ chem_loss(nr,ks)=chem_loss(nr,ks)+real(clreacted,kind=dp)
+#endif
+ endif
+ end do ! nspec
+ endif
+
+ end do ! nreagent
+
+ end do ! loop over all particles
+!$OMP END DO
+
+!$OMP END PARALLEL
+
+#ifdef _OPENMP
+ do ithread=1,numthreads
+ chem_loss(:,:) = chem_loss(:,:)+chem_loss_tmp(:,:,ithread)
+ end do
+ deallocate( chem_loss_tmp )
+#endif
+
+ end subroutine chemreaction
+
+
+ subroutine readjrate(jr_name,memid,mm)
+
+ !*****************************************************************************
+ ! *
+ ! Reads the average actinic flux rates into memory *
+ ! *
+ ! Author: Rona Thompson, Sep 2023 *
+ ! *
+ !*****************************************************************************
+ ! *
+ ! Variables: *
+ ! *
+ ! jr_name name of the file *
+ ! memid time index to chemical field variable *
+ ! mm month to read *
+ ! *
+ !*****************************************************************************
+
+ implicit none
+
+ character(len=256) :: jr_name
+ integer :: memid,mm
+ integer :: ncid,dimid,varid
+
+ ! Read netcdf file
+ !******************
+
+ ! open file
+ call nf90_err( nf90_open(trim(jr_name),nf90_NOWRITE,ncid) )
+
+ ! longitude
+ call nf90_err( nf90_inq_dimid(ncid,'longitude',dimid) )
+ call nf90_err( nf90_inquire_dimension(ncid,dimid,len=nxjr) )
+ if (.not.allocated(lonjr)) allocate(lonjr(nxjr))
+ call nf90_err( nf90_inq_varid(ncid,'longitude',varid) )
+ call nf90_err( nf90_get_var(ncid,varid,lonjr) )
+ dxjr=abs(lonjr(2)-lonjr(1))
+
+ ! latitude
+ call nf90_err( nf90_inq_dimid(ncid,'latitude',dimid) )
+ call nf90_err( nf90_inquire_dimension(ncid,dimid,len=nyjr) )
+ if (.not.allocated(latjr)) allocate(latjr(nyjr))
+ call nf90_err( nf90_inq_varid(ncid,'latitude',varid) )
+ call nf90_err( nf90_get_var(ncid,varid,latjr) )
+ dyjr=abs(latjr(2)-latjr(1))
+
+ ! jrate field
+ call nf90_err( nf90_inq_varid(ncid,'jrate',varid) )
+ if (.not.allocated(jrate_average)) then
+ allocate(jrate_average(nxjr,nyjr,2))
+ endif
+ call nf90_err( nf90_get_var(ncid,varid,jrate_average(:,:,memid),start=(/1,1,mm/),count=(/nxjr,nyjr,1/)) )
+
+ ! close file
+ call nf90_err( nf90_close(ncid) )
+
+ return
+
+ end subroutine readjrate
+
+ function photo_O1D(sza) result(jrate)
+
+ !*****************************************************************************
+ ! *
+ ! Calculates J(O1D) photolysis rate based on solar zenith angle *
+ ! *
+ ! Author: A. Stohl, Nov 2014 *
+ ! *
+ !*****************************************************************************
+ ! *
+ ! INPUT: *
+ ! sza solar zenith angle (degrees) *
+ ! *
+ ! OUTPUT: *
+ ! photo_O1D J(O1D) photoylsis rate *
+ ! *
+ !*****************************************************************************
+
+ implicit none
+
+ real, intent(in) :: sza
+ real :: jrate
+ integer :: iz,ik
+ real :: z1,z2,zg,f1,f2,dummy
+ real :: photo_NO2
+ integer, parameter :: nzenith=11
+ real, parameter :: pi=3.1415927
+ real, dimension(nzenith) :: zangle,fact_photo
+
+ ! zangle: zenith angles for which fact_photo is tabulated
+ ! fact_photo: conversion of photolysis rate of NO2 to photolysis
+ ! rate of O3 into O1D as a function of solar zenith angle
+
+ zangle=(/0.,10.,20.,30.,40.,50.,60.,70.,78.,86.,90.0001/)
+ fact_photo=(/0.4616E-02,0.4478E-02,0.4131E-02,0.3583E-02,0.2867E-02,&
+ &0.2081E-02,0.1235E-02,0.5392E-03,0.2200E-03,0.1302E-03,0.0902E-03/)
+
+ if (sza.lt.90.) then
+ do iz=1,nzenith-1
+ if(sza.ge.zangle(iz)) ik=iz
+ end do
+ z1=1./cos(zangle(ik)*pi/180.)
+ z2=1./cos(zangle(ik+1)*pi/180.)
+ zg=1./cos(sza*pi/180.)
+ dummy=(zg-z1)/(z2-z1)
+ f1=alog(fact_photo(ik))
+ f2=alog(fact_photo(ik+1))
+ photo_NO2=1.45e-2*exp(-0.4/cos(sza*pi/180.))
+ jrate=photo_NO2*exp(f1+(f2-f1)*dummy)
+ else
+ jrate=0.
+ endif
+
+ end function photo_O1D
+
+
+ function zenithangle(ylat,xlon,jjjjmmdd,hhmmss) result(sza)
+
+ !*****************************************************************************
+ ! *
+ ! This function returns the sinus of solar elevation as a function *
+ ! of geographic longitde, latitude and GMT-Time. *
+ ! *
+ ! Author: G. Wotawa, Nov 1993 *
+ ! *
+ !*****************************************************************************
+ ! *
+ ! INPUT: *
+ ! *
+ ! ylat geographical latitude [DEG] *
+ ! xlon geographical longitude [DEG] *
+ ! jjjj Year *
+ ! mm Month *
+ ! dd Day *
+ ! hh Hour *
+ ! minute Minute *
+ ! *
+ !*****************************************************************************
+
+ implicit none
+
+ integer, intent(in) :: jjjjmmdd,hhmmss
+ real, intent(in) :: ylat,xlon
+ real :: sza
+ integer :: jjjj,mm,id,iu,minute
+ integer :: ndaynum
+ real :: sinsol,solelev
+ real :: rnum,rylat,ttime,dekl,rdekl,eq
+ real,parameter :: pi=3.1415927
+
+ jjjj=jjjjmmdd/10000
+ mm=jjjjmmdd/100-jjjj*100
+ id=jjjjmmdd-jjjj*10000-mm*100
+ iu=hhmmss/10000
+ minute=hhmmss/100-100*iu
+
+ ndaynum=31*(mm-1)+id
+ if(mm.gt.2) ndaynum=ndaynum-int(0.4*mm+2.3)
+ if((mm.gt.2).and.(jjjj/4*4.eq.jjjj)) ndaynum=ndaynum+1
+
+ rnum=2.*pi*ndaynum/365.
+ rylat=pi*ylat/180.
+ ttime=real(iu)+real(minute)/60.
+
+ dekl=0.396+3.631*sin(rnum)+0.038*sin(2.*rnum)+0.077*sin(3.*rnum)- &
+ 22.97*cos(rnum)-0.389*cos(2.*rnum)-0.158*cos(3.*rnum)
+ rdekl=pi*dekl/180.
+
+ eq=(0.003-7.343*sin(rnum)-9.47*sin(2.*rnum)- &
+ 0.329*sin(3.*rnum)-0.196*sin(4.*rnum)+ &
+ 0.552*cos(rnum)-3.020*cos(2.*rnum)- &
+ 0.076*cos(3.*rnum)-0.125*cos(4.*rnum))/60.
+ sinsol=sin(rylat)*sin(rdekl)+cos(rylat)*cos(rdekl)* &
+ cos((ttime-12.+xlon/15.+eq)*pi/12.)
+ ! Calculate the maximum solar elevation on that day
+ !sinsol=sin(rylat)*sin(rdekl)+cos(rylat)*cos(rdekl)*
+ ! & cos((eq)*pi/12.)
+ solelev=asin(sinsol)*180./pi
+ sza=90.-solelev
+
+ end function zenithangle
+
+
+end module chemistry_mod
+
diff --git a/src/com_mod.f90 b/src/com_mod.f90
index dd776c779a1a445eb210e2e951cf86b429395166..8e1b38f779067ff27ad936737a05c1788b74da80 100644
--- a/src/com_mod.f90
+++ b/src/com_mod.f90
@@ -16,7 +16,8 @@
module com_mod
use par_mod, only: dp, numpath, maxnests, &
- numclass, maxcolumn, maxrand, numwfmem, numpf
+ numclass, maxcolumn, maxrand, numwfmem, numpf, &
+ maxreagent, maxrecsample
implicit none
@@ -58,7 +59,7 @@ module com_mod
! Variables defining the general model run specifications
!********************************************************
- integer :: ibdate,ibtime,iedate,ietime,itime_init,loutnext_init
+ integer :: ibdate,ibtime,iedate,ietime,itime_init,loutnext_init,lrecoutnext_init
real :: outnum_init
real(kind=dp) :: bdate,edate
@@ -81,11 +82,15 @@ module com_mod
! ending date (s)
integer :: loutstep,loutaver,loutsample,loutrestart,method,lsynctime
+ integer :: lrecoutstep,lrecoutaver,lrecoutsample
real :: outstep
! loutstep [s] gridded concentration output every loutstep seconds
! loutaver [s] concentration output is an average over [s] seconds
! loutsample [s] sampling interval of gridded concentration output
+ ! lrecoutstep [s] receptor concentration output every loutstep seconds
+ ! lrecoutaver [s] receptor concentration output is an average over [s] seconds
+ ! lrecoutsample [s] sampling interval of receptor concentration output
! loutrestart [s] time interval for writing restart files
! lsynctime [s] synchronisation time of all particles
! method indicator which dispersion method is to be used
@@ -98,6 +103,7 @@ module com_mod
integer :: surf_only ! deprecated
logical :: turbswitch
integer :: cblflag !added by mc for cbl
+ logical :: llcmoutput
! ctl factor, by which time step must be smaller than Lagrangian time scale
! ifine reduction factor for time step used for vertical wind
@@ -134,6 +140,7 @@ module com_mod
! ind_rel and ind_samp are used within the code to change between mass and mass-mix (see readcommand.f)
! cblflag !: 1 activate cbl skewed pdf routines with bi-gaussina pdf whan OL<0 added by mc
+ ! llcmoutput switch for LCM output (uses mass ratio of species to air tracer) or normal output
integer :: mintime,itsplit
@@ -221,11 +228,20 @@ module com_mod
real,allocatable,dimension(:,:) :: ri,rac
real,allocatable,dimension(:,:,:) :: rcl,rgs,rlu
real,allocatable,dimension(:) :: rm,dryvel
- real,allocatable,dimension(:) :: ohcconst,ohdconst,ohnconst
! Daria Tatsii: species shape properties
real,allocatable,dimension(:) :: Fn,Fs ! Newton and Stokes' regime
real,allocatable,dimension(:) :: ks1,ks2,kn2
integer,allocatable,dimension(:) :: ishape,orient
+ ! chemical reagent variables
+ character(len=256) :: reag_path(maxreagent)
+ character(len=16) :: reagents(maxreagent), reag_unit(maxreagent)
+ integer :: reag_hourly(maxreagent), nreagent
+ ! reaction rates
+ real,allocatable,dimension(:,:) :: reaccconst,reacdconst,reacnconst
+ ! emissions variables for LCM
+ character(len=256),allocatable,dimension(:) :: emis_path,emis_file,emis_name
+ integer,allocatable,dimension(:) :: emis_unit
+ real,allocatable,dimension(:) :: emis_coeff
real,allocatable,dimension(:,:) :: area_hour,point_hour
real,allocatable,dimension(:,:) :: area_dow,point_dow
@@ -351,7 +367,7 @@ module com_mod
real :: dxoutn,dyoutn,outlon0n,outlat0n,xoutshiftn,youtshiftn
!real outheight(maxzgrid),outheighthalf(maxzgrid)
- logical :: DEP,DRYDEP,WETDEP,OHREA,ASSSPEC,LDECAY
+ logical :: DEP,DRYDEP,WETDEP,CLREA,ASSSPEC,LDECAY,LEMIS
logical,allocatable,dimension(:) :: DRYDEPSPEC,WETDEPSPEC
logical :: DRYBKDEP,WETBKDEP
@@ -371,10 +387,11 @@ module com_mod
! DRYDEPSPEC .true., if dry deposition is switched on for that species
! WETDEP .true., if wet deposition is switched on
! WETDEPSPEC .true., if wet deposition is switched on for that species
- ! OHREA .true., if OH reaction is switched on
+ ! CLREA .true., if chemical reactions is switched on
! ASSSPEC .true., if there are two species asscoiated
! DRYBKDEP,WETBKDEP .true., for bkwd runs, where mass deposited and source regions is calculated - either for dry or for wet deposition
! (i.e. transfer of mass between these two occurs
+ ! LEMIS .true., if particle mass should change due to surface fluxes
! if output for each releasepoint shall be created maxpointspec=number of releasepoints
! else maxpointspec is 1 -> moved to unc_mod
@@ -394,16 +411,38 @@ module com_mod
! Variables defining receptor points
!***********************************
- real,allocatable,dimension(:) :: xreceptor,yreceptor
- real,allocatable,dimension(:) :: receptorarea
- real,allocatable,dimension(:,:) :: creceptor
- character(len=16),allocatable,dimension(:) :: receptorname
- integer :: numreceptor
-
- ! xreceptor,yreceptor receptor position
- ! creceptor concentrations at receptor points
- ! receptorarea area of 1*1 grid cell at receptor point
- ! numreceptor number of receptor points
+ ! general receptors
+ real, allocatable, dimension(:) :: xreceptor,yreceptor,zreceptor
+ integer, allocatable, dimension(:) :: treceptor
+ real, allocatable, dimension(:) :: receptorarea
+ real, allocatable, dimension(:,:) :: creceptor,crecuncert
+ real, allocatable, dimension(:) :: xkreceptor,nnreceptor
+ character(len=16), allocatable, dimension(:) :: receptorname
+ integer :: cpointer(maxrecsample)
+ integer :: numreceptor, numcurrec
+
+ ! satellite receptors
+ real, allocatable, dimension(:) :: xsatellite,ysatellite
+ integer, allocatable, dimension(:) :: tsatellite
+ real, allocatable, dimension(:) :: satellitearea
+ real, allocatable, dimension(:,:) :: zsatellite
+ real, allocatable, dimension(:,:,:) :: csatellite, csatuncert
+ real, allocatable, dimension(:,:) :: xksatellite, nnsatellite
+ character(len=16), allocatable, dimension(:) :: satellitename
+ integer :: numsatreceptor, nlayermax, numsatellite, numcursat
+ integer, allocatable, dimension(:) :: nnsatlayer
+ integer :: csatpointer(maxrecsample)
+
+ ! xreceptor,yreceptor,zreceptor receptor position
+ ! creceptor concentrations at receptor points
+ ! receptorarea area of 1*1 grid cell at receptor point
+ ! numreceptor number of receptors (non-satellite)
+ ! numcurrec number of receptors in current time interval (updated each time interval)
+ ! numsatreceptor number of satellite receptors (aka. retrievals)
+ ! numcursat number of satellite receptors in current time interval (updated each time interval)
+ ! numsatellite number of satellite instruments
+ ! nlayermax max number of vertical layers in satellite retrievals
+ ! nnsatlayer actual number of vertical layers for each satellite
!***************************************
! Variables characterizing each particle
@@ -552,8 +591,7 @@ contains
allocate( vsetaver(maxspec),cunningham(maxspec), &
weightmolar(maxspec),ri(5,numclass),rac(5,numclass), &
rcl(maxspec,5,numclass),rgs(maxspec,5,numclass), &
- rlu(maxspec,5,numclass),rm(maxspec),dryvel(maxspec), &
- ohcconst(maxspec),ohdconst(maxspec),ohnconst(maxspec),stat=stat)
+ rlu(maxspec,5,numclass),rm(maxspec),dryvel(maxspec),stat=stat)
if (stat.ne.0) error stop "Could not allocate particle property arrays 2"
allocate( Fn(maxspec),Fs(maxspec),ks1(maxspec),ks2(maxspec), &
kn2(maxspec),ishape(maxspec),orient(maxspec),stat=stat)
@@ -564,8 +602,8 @@ contains
if (stat.ne.0) error stop "Could not allocate species arrays"
allocate( DRYDEPSPEC(maxspec),WETDEPSPEC(maxspec),stat=stat)
if (stat.ne.0) error stop "Could not allocate DRYDEPSPEC or WETDEPSPEC"
- allocate( creceptor(numreceptor,maxspec),stat=stat)
- if (stat.ne.0) error stop "Could not allocate creceptor"
+! allocate( creceptor(numreceptor,maxspec),stat=stat)
+! if (stat.ne.0) error stop "Could not allocate creceptor"
icnt_belowcld=0
icnt_incld=0
@@ -583,7 +621,7 @@ contains
deallocate(icnt_belowcld,icnt_incld,specnum,decay,weta_gas,wetb_gas, &
crain_aero,csnow_aero,ccn_aero,in_aero,reldiff,henry,f0,density,dquer, &
dsigma,ndia,vsetaver,cunningham,weightmolar,vset,schmi,fract,ri,rac,rcl, &
- rgs,rlu,rm,dryvel,ohcconst,ohdconst,ohnconst,Fn,Fs,ks1,ks2,kn2,ishape, &
+ rgs,rlu,rm,dryvel,Fn,Fs,ks1,ks2,kn2,ishape, &
orient,area_hour,point_hour,area_dow,point_dow,species)
deallocate(DRYDEPSPEC,WETDEPSPEC)
deallocate(creceptor,xreceptor,yreceptor,receptorarea,receptorname)
diff --git a/src/date_mod.f90 b/src/date_mod.f90
index 9101553191e1f257e6a8df62e5b0afbdf677b23d..ade2aac3748fde7bc29db55d5d185a1fdcb9d6b6 100644
--- a/src/date_mod.f90
+++ b/src/date_mod.f90
@@ -154,4 +154,48 @@ real(kind=dp) function juldate(yyyymmdd,hhmiss)
end function juldate
+ !*****************************************************************************
+ ! *
+ ! Calculates number of days in a month *
+ ! *
+ ! Author: Rona Thompson (Sep 2023) *
+ ! *
+ ! Variables: *
+ ! yyyymm year and month *
+ ! eomday number of days in month (end of month day) *
+ ! *
+ !*****************************************************************************
+
+ integer function calceomday(yyyymm)
+
+ integer, intent(in) :: yyyymm
+ integer :: yyyy,mm
+ integer, dimension(12) :: leapdays,days
+ integer :: eomday
+
+ leapdays=(/31,29,31,30,31,30,31,31,30,31,30,31/)
+ days=(/31,28,31,30,31,30,31,31,30,31,30,31/)
+
+ yyyy=floor(yyyymm/100.)
+ mm=yyyymm-yyyy*100
+
+ if((float(yyyy)/100.).eq.float(yyyy/100)) then
+ if((float(yyyy)/400.).eq.float(yyyy/400)) then
+ eomday=leapdays(mm)
+ else
+ eomday=days(mm)
+ endif
+ else
+ if((float(yyyy)/4.).eq.float(yyyy/4)) then
+ eomday=leapdays(mm)
+ else
+ eomday=days(mm)
+ endif
+ endif
+
+ calceomday=eomday
+
+ end function calceomday
+
+
end module date_mod
diff --git a/src/drydepo_mod.f90 b/src/drydepo_mod.f90
index 0c70351ee7bdbc982c971a3f9fa3e699905f1174..98bf7c653873446964cdff93e2f7911e61257a19 100644
--- a/src/drydepo_mod.f90
+++ b/src/drydepo_mod.f90
@@ -827,7 +827,7 @@ subroutine drydepo_probability(ipart,dt,zts,vdepo,ithread)
integer,intent(in) :: ithread ! OMP thread starting at 1
integer,intent(in) :: ipart ! particle index
- real,intent(inout) :: vdepo(maxspec) ! deposition velocities for all species
+ real,intent(out) :: vdepo(maxspec) ! deposition velocities for all species
real,intent(in) :: dt,zts ! real(ldt), real(zt)
integer :: ns,m ! loop variable over species
real :: vdeptemp(2)
diff --git a/src/emissions_mod.f90 b/src/emissions_mod.f90
new file mode 100644
index 0000000000000000000000000000000000000000..de85615a2b0266a8e52e43327b1e942ad2624d93
--- /dev/null
+++ b/src/emissions_mod.f90
@@ -0,0 +1,817 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2019, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+module emissions_mod
+
+ !*****************************************************************************
+ ! *
+ ! This module contains variables and subroutines for injecting mass *
+ ! into particles based on gridded emissions estimates *
+ ! *
+ !*****************************************************************************
+
+ use par_mod
+ use com_mod
+ use point_mod, only: xlon0, ylat0, dx, dy, npart
+ use particle_mod
+ use date_mod
+ use totals_mod, only: tot_em_up, tot_em_field, tot_em_res
+ use netcdf
+ use netcdf_output_mod, only: nf90_err
+
+ implicit none
+
+ real, parameter :: tau_em_r=4000. ! time scale of residual emission release (s)
+ real, parameter :: tau_ipm=900. ! time scale of micro mixing (s)
+ logical, parameter :: ABLMIX=.true. ! mass exchange for particles in same PBL grid cell
+
+ integer :: nxem, nyem
+ real :: dxem, dyem
+ integer, dimension(2) :: em_memtime
+ real, allocatable, dimension(:,:,:,:) :: em_field ! emission fields all species
+ real, allocatable, dimension(:) :: lonem, latem ! emission field lon and lat
+ real, allocatable, dimension(:,:,:) :: em_res ! residual emissions
+ real, allocatable, dimension(:,:,:) :: mass_field
+ real, allocatable, dimension(:,:) :: em_area ! area for emissions grid
+ integer, allocatable, dimension(:,:) :: nn_field
+ real(kind=dp), dimension(2) :: em_time
+ character(len=32), allocatable, dimension(:) :: emf_name
+
+ contains
+
+ subroutine emissions(itime)
+
+ !*****************************************************************************
+ ! *
+ ! This subroutine calculates the fraction of emission to be released *
+ ! in each timestep and adds this mass to the particles in the PBL *
+ ! *
+ ! Author: S. Henne, Mar-2009 *
+ ! Adapted by R. Thompson for v10.4, Oct-2023 *
+ ! *
+ !*****************************************************************************
+
+ use windfields_mod, only: hmix
+ use omp_lib
+
+ implicit none
+
+ integer :: itime
+ real :: xlon,ylat
+ integer :: ix, jy, ixp, jyp, ii, ks, em_ix, em_jy, ithread
+ real :: dt1,dt2,dtt,ddx,ddy,rddx,rddy,p1,p2,p3,p4,dz1,dz2,dz
+ real :: em_dt1, em_dt2, em_dtt
+ real, dimension(2) :: hm
+ real :: hmixi
+ real :: tmp, max_val, em_cur
+ logical, dimension(npart(1)) :: em_cond
+ integer :: mm
+ character(len=20) :: frmt
+ real :: em_frac
+ real, allocatable, dimension(:,:,:) :: em_neg
+ real, allocatable, dimension(:,:) :: tot_em_up_tmp
+ real, allocatable, dimension(:,:,:,:) :: mass_field_tmp, em_neg_tmp
+ real :: f_m
+ logical :: lexist
+! integer, parameter :: unittest=120
+
+
+ ! fraction of stored emissions that is released in a time step
+ em_frac = 1. - exp(-1.*real(lsynctime)/tau_em_r)
+
+ ! distance of emission fields in memory from current time
+ em_dt1 = float(itime-em_memtime(1))
+ em_dt2 = float(em_memtime(2)-itime)
+ em_dtt = 1./(em_dt1+em_dt2)
+
+ ! determine temporal distances for interpolation of meteo fields
+ dt1=float(itime-memtime(1))
+ dt2=float(memtime(2)-itime)
+ dtt=1./(dt1+dt2)
+
+ tot_em_up(:) = 0.
+
+ ! estimate mass in PBL from particle positions
+ !**********************************************
+
+ mass_field(:,:,:) = 0.
+ allocate( em_neg(nspec-1,nxem,nyem) )
+#if _OPENMP
+ allocate( mass_field_tmp(nspec,nxem,nyem,numthreads))
+ allocate( em_neg_tmp(nspec-1,nxem,nyem,numthreads))
+ allocate( tot_em_up_tmp(nspec,numthreads) )
+ mass_field_tmp(:,:,:,:) = 0.
+ em_neg_tmp(:,:,:,:) = 0.
+ tot_em_up_tmp(:,:) = 0.
+#endif
+ tot_em_up(:) = 0.
+ mass_field(:,:,:) = 0.
+ em_neg(:,:,:) = 0.
+
+!$OMP PARALLEL &
+!$OMP PRIVATE(ii,xlon,ylat,em_ix,em_jy,ix,jy,ixp,jyp,ddx,ddy, &
+!$OMP rddx,rddy,p1,p2,p3,p4,mm,hm,hmixi,ks,ithread)
+
+#ifdef _OPENMP
+ ithread = OMP_GET_THREAD_NUM()+1 ! Starts with 1
+#else
+ ithread = 1
+#endif
+
+!$OMP DO
+ do ii=1,count%alive ! loop over all particles
+
+ xlon=xlon0+part(ii)%xlon*dx
+ ylat=ylat0+part(ii)%ylat*dy
+
+ ! assume emission dimensions given as grid midpoints
+ em_ix=min(nxem, int((xlon-(lonem(1)-0.5*dxem))/dxem)+1)
+ em_jy=min(nyem, int((ylat-(latem(1)-0.5*dyem))/dyem)+1)
+ !! testing
+! if (ii.lt.20) print*, 'lonem, lon, latem, lat = ',lonem(em_ix),xlon,latem(em_jy),ylat
+
+ ! interpolate to particle position
+ ix=int(part(ii)%xlon)
+ jy=int(part(ii)%ylat)
+ ixp=ix+1
+ jyp=jy+1
+ ddx=part(ii)%xlon-float(ix)
+ ddy=part(ii)%ylat-float(jy)
+ rddx=1.-ddx
+ rddy=1.-ddy
+ p1=rddx*rddy
+ p2=ddx*rddy
+ p3=rddx*ddy
+ p4=ddx*ddy
+
+ do mm=1,2
+ ! PBL height at particle position
+ hm(mm)=p1*hmix(ix,jy ,1,memind(mm)) + &
+ p2*hmix(ixp,jy ,1,memind(mm)) + &
+ p3*hmix(ix ,jyp,1,memind(mm)) + &
+ p4*hmix(ixp,jyp,1,memind(mm))
+ end do
+ hmixi=(hm(1)*dt2+hm(2)*dt1)*dtt
+ ! set minimum PBL height to dampen day/night amplitude of emission
+ hmixi=max(hmixi,hmixmin)
+
+ ! determine if particle is in PBL
+ em_cond(ii) = part(ii)%z.le.hmixi
+
+ if (em_cond(ii)) then
+#ifdef _OPENMP
+ mass_field_tmp(1:nspec,em_ix,em_jy,ithread)= &
+ mass_field_tmp(1:nspec,em_ix,em_jy,ithread) + &
+ mass(ii,1:nspec)
+#else
+ mass_field(1:nspec,em_ix,em_jy)=mass_field(1:nspec,em_ix,em_jy) + &
+ mass(ii,1:nspec)
+#endif
+ endif
+
+ end do ! end of particle loop
+!$OMP END DO
+!$OMP END PARALLEL
+
+#ifdef _OPENMP
+ ! manual reduction of mass_field
+ do ithread=1,numthreads
+ mass_field(:,:,:) = mass_field(:,:,:)+mass_field_tmp(:,:,:,ithread)
+ end do
+#endif
+
+ f_m = exp(-1.*real(lsynctime)/tau_ipm)
+
+ ! estimate emissions for each particle
+ !**************************************
+
+!$OMP PARALLEL &
+!$OMP PRIVATE(ii,xlon,ylat,em_ix,em_jy, &
+!$OMP ks,em_cur,tmp,ithread)
+
+#ifdef _OPENMP
+ ithread = OMP_GET_THREAD_NUM()+1 ! Starts with 1
+#else
+ ithread = 1
+#endif
+
+!$OMP DO
+ do ii=1,count%alive ! loop over particles
+
+ if (.not.em_cond(ii)) cycle ! skip particles not in PBL
+
+ xlon=xlon0+part(ii)%xlon*dx
+ ylat=ylat0+part(ii)%ylat*dy
+ ! assume emission dimensions given as grid midpoints
+ em_ix=min(nxem, int((xlon-(lonem(1)-0.5*dxem))/dxem)+1)
+ em_jy=min(nyem, int((ylat-(latem(1)-0.5*dyem))/dyem)+1)
+
+ ! loop over species
+ ! skip species 1 as it is always air tracer with no emission
+ do ks=2,nspec
+ em_cur=(em_field(ks-1,em_ix,em_jy,1)*em_dt2 + &
+ em_field(ks-1,em_ix,em_jy,2)*em_dt1)*em_dtt
+ tmp=(em_cur*real(lsynctime) + em_res(ks-1,em_ix,em_jy)*em_frac ) * &
+ mass(ii,1)/mass_field(1,em_ix,em_jy)
+
+ ! micro mixing scheme executed before new emissions are taken up
+ !*****************************************************************
+ if (ABLMIX) then
+ mass(ii,ks)=mass(ii,1) * &
+ (f_m * mass(ii,ks)/mass(ii,1) + &
+ (1.-f_m) * mass_field(ks,em_ix,em_jy)/mass_field(1,em_ix,em_jy))
+ endif
+
+ ! deal with negative emissions
+ if (tmp.lt.0.) then
+ if (-1.*tmp.gt.mass(ii,ks)) then
+ tmp = tmp + mass(ii,ks)
+ ! subtract mass from atmosphere by setting it to zero below
+#ifdef _OPENMP
+ tot_em_up_tmp(ks,ithread) = tot_em_up_tmp(ks,ithread) - real(mass(ii,ks),kind=dp)
+#else
+ tot_em_up(ks) = tot_em_up(ks) - real(mass(ii,ks),kind=dp)
+#endif
+ mass(ii,ks) = 0.
+ ! add remaining uptake to em_neg
+#ifdef _OPENMP
+ em_neg_tmp(ks-1,em_ix,em_jy,ithread) = em_neg_tmp(ks-1,em_ix,em_jy,ithread) + &
+ tmp/mass(ii,1)*mass_field(1,em_ix,em_jy)
+#else
+ em_neg(ks-1, em_ix, em_jy) = em_neg(ks-1, em_ix, em_jy) + &
+ tmp/mass(ii,1)*mass_field(1,em_ix,em_jy)
+#endif
+ else
+ mass(ii,ks)=mass(ii,ks)+tmp
+#ifdef _OPENMP
+ tot_em_up_tmp(ks,ithread) = tot_em_up_tmp(ks,ithread) + real(tmp,kind=dp)
+#else
+ tot_em_up(ks) = tot_em_up(ks) + real(tmp,kind=dp)
+#endif
+ endif
+ else
+ mass(ii,ks)=mass(ii,ks)+tmp
+#ifdef _OPENMP
+ tot_em_up_tmp(ks,ithread) = tot_em_up_tmp(ks,ithread) + real(tmp,kind=dp)
+#else
+ tot_em_up(ks) = tot_em_up(ks) + real(tmp,kind=dp)
+#endif
+ endif ! negative emissions
+
+ end do ! nspec
+
+ end do ! loop over particles
+!$OMP END DO
+
+ ! loop over grid points to update residual emissions
+ ! skip species 1 as it is always air tracer
+ !***************************************************
+
+!$OMP DO
+ do jy=1,nyem
+ do ix=1,nxem
+ do ks=2,nspec
+ if (mass_field(1,ix,jy).eq.0.) then
+ em_cur=(em_field(ks-1,ix,jy,1)*em_dt2 + &
+ em_field(ks-1,ix,jy,2)*em_dt1)*em_dtt
+ em_res(ks-1,ix,jy)=em_res(ks-1,ix,jy) + &
+ em_cur*real(lsynctime)
+ else
+ em_res(ks-1,ix,jy)=(1.-em_frac) * em_res(ks-1,ix,jy)
+ endif
+ end do
+ end do
+ end do
+!$OMP END DO
+!$OMP END PARALLEL
+
+ ! manual reduction of em_neg and tot_em_up
+#ifdef _OPENMP
+ do ithread=1,numthreads
+ em_neg(:,:,:) = em_neg(:,:,:)+em_neg_tmp(:,:,:,ithread)
+ tot_em_up(:) = tot_em_up(:) + tot_em_up_tmp(:,ithread)
+ end do
+ deallocate( mass_field_tmp, em_neg_tmp, tot_em_up_tmp )
+#endif
+
+ ! update for negative emissions
+ em_res(:,:,:) = em_res(:,:,:)+em_neg(:,:,:)
+ deallocate(em_neg)
+
+ ! calculate total emission flux and field
+!$OMP PARALLEL IF(nspec>99) PRIVATE(ks)
+!$OMP DO
+ do ks=2,nspec
+ tot_em_field(ks)=sum((em_field(ks-1,:,:,1)*em_dt2 + &
+ em_field(ks-1,:,:,2)*em_dt1)*em_dtt)*real(lsynctime)
+ tot_em_res(ks)=sum(em_res(ks-1,:,:))
+ end do
+!$OMP END DO
+!$OMP END PARALLEL
+
+ !! test
+! inquire(file=path(2)(1:length(2))//'mass_field.txt',exist=lexist)
+! write(*,*) 'emissions: lexist = ',lexist
+! if (lexist) then
+! open(unittest,file=path(2)(1:length(2))//'mass_field.txt',ACCESS='APPEND',STATUS='OLD')
+! else
+! open(unittest,file=path(2)(1:length(2))//'mass_field.txt',STATUS='NEW')
+! endif
+! write(frmt, '(A, I4, A)') '(', nxem, 'E12.3)'
+! do jy=1,nyem-1
+! write(unittest,frmt) (mass_field(2,ix,jy),ix=1,nxem)
+! end do
+! close(unittest)
+ !!
+
+ end subroutine emissions
+
+ subroutine getemissions(itime)
+
+ !*****************************************************************************
+ ! *
+ ! This subroutine checks which emission fields need to be read and *
+ ! interpolates these to the current time step *
+ ! *
+ ! Author: Rona Thompson, Oct-2023 *
+ ! *
+ !*****************************************************************************
+
+ implicit none
+
+ integer :: itime
+ real(kind=dp) :: julstart
+ integer :: jjjjmmdd, hhmmss, dd, mm, yyyy
+ integer :: nn, ks, eomday, memid
+ character(len=4) :: ayear
+ character(len=2) :: amonth, aday
+ character(len=256) :: em_name, file_name, strtmp1, strtmp2
+ logical :: lexist
+
+
+ ! Check fields are available for the current time step
+ !*****************************************************
+
+ if ((ldirect*em_memtime(1).le.ldirect*itime).and. &
+ (ldirect*em_memtime(2).gt.ldirect*itime)) then
+
+ ! The rightfields are already in memory -> don't do anything
+ return
+
+ else if ((ldirect*em_memtime(2).le.ldirect*itime).and. &
+ (em_memtime(2).ne.0.)) then
+
+ ! Current time is after 2nd field
+ !*********************************
+
+ ! update dates of emission fields
+ em_memtime(1)=em_memtime(2) ! time in sec
+ em_time(1)=em_time(2) ! julian date
+ memid=2
+
+ ! julian date of next emission field assuming monthly fields
+ call caldate(em_time(1), jjjjmmdd, hhmmss)
+ eomday=calceomday(jjjjmmdd/100)
+ em_memtime(2)=em_memtime(1)+ldirect*eomday*24*3600 ! time in sec
+ em_time(2)=em_time(1)+real(ldirect*eomday,kind=dp) ! julian date
+ call caldate(em_time(2), jjjjmmdd,hhmmss)
+ yyyy=jjjjmmdd/10000
+ mm=(jjjjmmdd-yyyy*10000)/100
+ dd=jjjjmmdd-yyyy*10000-mm*100
+ write(amonth,'(I2.2)') mm
+ write(aday,'(I2.2)') dd
+ write(ayear,'(I4)') yyyy
+
+ ! skip species 1 as is always air tracer with no emissions
+!$OMP PARALLEL IF(nspec>99) &
+!$OMP PRIVATE(ks,file_name,nn,strtmp1,strtmp2,julstart,em_name,lexist)
+!$OMP DO
+ do ks=2,nspec
+
+ write(*,*) 'Updating emission fields for: ',trim(species(ks))
+
+ em_field(ks-1,:,:,1)=em_field(ks-1,:,:,2)
+
+ ! Read new emission field and store in 2nd position
+ !***************************************************
+
+ ! TO DO: make more general to fit any field frequency
+
+ file_name=emis_file(ks)
+ nn=index(file_name,'YYYY',back=.false.)
+ if (nn.ne.0) then
+ strtmp1=file_name(1:nn-1)
+ nn=index(file_name,'YYYY',back=.true.)
+ strtmp2=file_name(nn+4:len_trim(file_name))
+ file_name=trim(strtmp1)//ayear//trim(strtmp2)
+ julstart=juldate((jjjjmmdd/10000)*10000+101,0)
+ endif
+ nn=index(file_name,'MM',back=.false.)
+ if (nn.ne.0) then
+ strtmp1=file_name(1:nn-1)
+ nn=index(file_name,'MM',back=.true.)
+ strtmp2=file_name(nn+2:len_trim(file_name))
+ file_name=trim(strtmp1)//amonth//trim(strtmp2)
+ julstart=juldate((jjjjmmdd/100)*100+1,0)
+ endif
+ nn=index(file_name,'DD',back=.false.)
+ if (nn.ne.0) then
+ strtmp1=file_name(1:nn-1)
+ nn=index(file_name,'DD',back=.true.)
+ strtmp2=file_name(nn+2:len_trim(file_name))
+ file_name=trim(strtmp1)//aday//trim(strtmp2)
+ julstart=juldate(jjjjmmdd,0)
+ endif
+
+ em_name=trim(emis_path(ks))//trim(file_name)
+ inquire(file=em_name,exist=lexist)
+ if (lexist) then
+ write(*,*) 'Reading emissions field: ',trim(em_name)
+ call reademissions(em_name, julstart, itime, memid, ks-1)
+ else
+ write(*,*) '#### FLEXPART ERROR ####'
+ write(*,*) '#### EMISSION FIELD NOT FOUND ####'
+ write(*,*) '#### '//trim(em_name)//' ####'
+ error stop
+ endif
+
+ end do ! nspec
+!$OMP END DO
+!$OMP END PARALLEL
+
+ else
+
+ ! No emission field in memory that can be used
+ !**********************************************
+
+ ! read both fields into memory
+ do memid=1,2
+
+ if (memid.eq.1) then
+ em_time(memid)=bdate+real(ldirect*itime,kind=dp)/86400._dp
+ else
+ em_time(memid)=em_time(memid-1)+real(ldirect*eomday,kind=dp)
+ endif
+ em_memtime(memid)=int((em_time(memid)-bdate)*86400._dp)*ldirect
+
+ call caldate(em_time(memid), jjjjmmdd, hhmmss)
+ eomday=calceomday(jjjjmmdd/100)
+ yyyy=jjjjmmdd/10000
+ mm=(jjjjmmdd-yyyy*10000)/100
+ dd=jjjjmmdd-yyyy*10000-mm*100
+ write(amonth,'(I2.2)') mm
+ write(aday,'(I2.2)') dd
+ write(ayear,'(I4)') yyyy
+
+!$OMP PARALLEL IF(nspec>99) &
+!$OMP PRIVATE(ks,file_name,nn,strtmp1,strtmp2,julstart,em_name,lexist)
+!$OMP DO
+ do ks=2,nspec
+
+ write(*,*) 'Reading two new emission fields for: ',trim(species(ks))
+
+ ! TO DO: make more general to fit any field frequency
+
+ file_name=emis_file(ks)
+ nn=index(file_name,'YYYY',back=.false.)
+ if (nn.ne.0) then
+ strtmp1=file_name(1:nn-1)
+ nn=index(file_name,'YYYY',back=.true.)
+ strtmp2=file_name(nn+4:len_trim(file_name))
+ file_name=trim(strtmp1)//ayear//trim(strtmp2)
+ julstart=juldate((jjjjmmdd/10000)*10000+101,0)
+ endif
+ nn=index(file_name,'MM',back=.false.)
+ if (nn.ne.0) then
+ strtmp1=file_name(1:nn-1)
+ nn=index(file_name,'MM',back=.true.)
+ strtmp2=file_name(nn+2:len_trim(file_name))
+ file_name=trim(strtmp1)//amonth//trim(strtmp2)
+ julstart=juldate((jjjjmmdd/100)*100+1,0)
+ endif
+ nn=index(file_name,'DD',back=.false.)
+ if (nn.ne.0) then
+ strtmp1=file_name(1:nn-1)
+ nn=index(file_name,'DD',back=.true.)
+ strtmp2=file_name(nn+2:len_trim(file_name))
+ file_name=trim(strtmp1)//aday//trim(strtmp2)
+ julstart=juldate(jjjjmmdd,0)
+ endif
+
+ em_name=trim(emis_path(ks))//trim(file_name)
+ inquire(file=em_name,exist=lexist)
+ if (lexist) then
+ write(*,*) 'Reading emissions field: ',trim(em_name)
+ call reademissions(em_name, julstart, itime, memid, ks-1)
+ else
+ write(*,*) '#### FLEXPART ERROR ####'
+ write(*,*) '#### EMISSION FIELD NOT FOUND ####'
+ write(*,*) '#### '//trim(em_name)//' ####'
+ error stop
+ endif
+
+ end do ! nspec
+!$OMP END DO
+!$OMP END PARALLEL
+
+ end do ! memid
+
+ endif ! update fields
+
+
+ end subroutine getemissions
+
+
+ subroutine reademissions(em_name, julstart, itime, memid, kk)
+
+ !*****************************************************************************
+ ! *
+ ! This subroutine reads the emission fields *
+ ! *
+ ! Author: Rona Thompson, Oct-2023 *
+ ! *
+ !*****************************************************************************
+
+ implicit none
+
+ character(len=256) :: em_name, unitinfo
+ integer :: memid, kk, itime
+ real(kind=dp) :: julstart, jtime
+ integer :: jjjjmmdd, ihmmss, mm
+ integer :: nn, ntem, len, ix, jy
+ integer :: ncid, dimid, varid, ndim, nvar, natt, xtype, indxt, unlimid
+ real :: ylatp, ylatm, hzone, cosfactm, cosfactp
+ real :: sclfact, offset
+ integer, dimension(:), allocatable :: dimids
+ real(kind=dp), dimension(:), allocatable :: jdate
+ real, dimension(:), allocatable :: time
+ real, dimension(:,:), allocatable :: emis
+ character(len=32) :: dimname, nameout, attname
+
+ ! current time in julian days
+ jtime=real(itime,kind=dp)/86400._dp+bdate
+
+ ! Read netcdf file
+ !******************
+
+ ! open file
+ call nf90_err( nf90_open(trim(em_name),nf90_NOWRITE,ncid) )
+
+ ! inquire about dims and vars
+ call nf90_err( nf90_inquire( ncid, ndim, nvar, natt, unlimid ) )
+ allocate(dimids(ndim))
+
+ if (.not.allocated(lonem)) then
+ ! read dimension info
+ do nn=1,ndim
+ call nf90_err( nf90_inquire_dimension( ncid, nn, dimname, len ) )
+ if ((index(dimname,'lon').ne.0).or.(index(dimname,'LON').ne.0) &
+ .or.(index(dimname,'Lon').ne.0)) then
+ ! longitude
+ nxem=len
+ allocate( lonem(nxem) )
+ call nf90_err( nf90_inq_varid(ncid,trim(dimname),varid) )
+ call nf90_err( nf90_get_var(ncid,varid,lonem) )
+ dxem=abs(lonem(2)-lonem(1))
+ endif
+ if ((index(dimname,'lat').ne.0).or.(index(dimname,'LAT').ne.0) &
+ .or.(index(dimname,'Lat').ne.0)) then
+ ! latitude
+ nyem=len
+ allocate( latem(nyem) )
+ call nf90_err( nf90_inq_varid(ncid,trim(dimname),varid) )
+ call nf90_err( nf90_get_var(ncid,varid,latem) )
+ dyem=abs(latem(2)-latem(1))
+ endif
+ end do ! ndim
+ ! check dimensions read correctly
+ if (.not.allocated(lonem)) then
+ write(*,*) 'ERROR in reademissions: longitude dimension not found in file: '//trim(em_name)
+ error stop
+ endif
+ if (.not.allocated(latem)) then
+ write(*,*) 'ERROR in reademissions: latitude dimension not found in file: '//trim(em_name)
+ error stop
+ endif
+ ! allocate emission variables
+ allocate( em_field(nspec-1,nxem,nyem,2) )
+ em_field(:,:,:,:)=0.
+ allocate( em_res(nspec-1,nxem,nyem) )
+ if (ipin.eq.2) then
+ ! read residual emissions from end of previous run
+ write(*,*) 'Reading residual emissions from previous run'
+ call em_res_read
+ else
+ em_res(:,:,:)=0.
+ endif
+ allocate( mass_field(nspec,nxem,nyem) )
+ mass_field(:,:,:)=0.
+ ! calculate area for emissions grid
+ allocate( em_area(nxem,nyem) )
+ if (emis_unit(kk+1).eq.1) then
+ ! emissions given per sqm
+ do jy=1,nyem
+ ylatp=latem(jy)+0.5*abs(latem(2)-latem(1))
+ ylatm=latem(jy)-0.5*abs(latem(2)-latem(1))
+ if ((ylatm.lt.0).and.(ylatp.gt.0.)) then
+ hzone=abs(latem(2)-latem(1))*r_earth*pi180
+ else
+ cosfactp=cos(ylatp*pi180)
+ cosfactm=cos(ylatm*pi180)
+ if (cosfactp.lt.cosfactm) then
+ hzone=sqrt(1-cosfactp**2)-sqrt(1-cosfactm**2)
+ hzone=hzone*r_earth
+ else
+ hzone=sqrt(1-cosfactm**2)-sqrt(1-cosfactp**2)
+ hzone=hzone*r_earth
+ endif
+ endif
+ em_area(:,jy)=pi180*r_earth*hzone*abs(lonem(2)-lonem(1))
+ end do ! nyem
+ else
+ ! emissions given per gridcell
+ em_area(:,:)=1.
+ endif
+ endif
+
+ ! read time dimension
+ do nn=1,ndim
+ call nf90_err( nf90_inquire_dimension( ncid, nn, dimname, len ) )
+ if ((index(dimname,'time').ne.0).or.(index(dimname,'Time').ne.0).or. &
+ (index(dimname,'TIME').ne.0).or.(index(dimname,'Date').ne.0).or. &
+ (index(dimname,'date').ne.0).or.(index(dimname,'DATE').ne.0)) then
+ ntem=len
+ allocate( time(ntem), jdate(ntem) )
+ call nf90_err( nf90_inq_varid(ncid,trim(dimname),varid) )
+ call nf90_err( nf90_get_var(ncid,varid,time) )
+ call nf90_err( nf90_get_att(ncid,varid,'units',unitinfo) )
+ write(*,*) 'Time units: ',trim(unitinfo)
+ if (index(unitinfo,'sec').ne.0) then
+ ! seconds
+ jdate=real(time-time(1),kind=dp)/3600._dp/24._dp+julstart
+ indxt=minloc(abs(jdate-jtime),dim=1)
+ else if (index(unitinfo,'hour').ne.0) then
+ ! hours
+ jdate=real(time-time(1),kind=dp)/24._dp+julstart
+ indxt=minloc(abs(jdate-jtime),dim=1)
+ else if (index(unitinfo,'day').ne.0) then
+ ! days
+ jdate=real(time-time(1),kind=dp)+julstart
+ indxt=minloc(abs(jdate-jtime),dim=1)
+ else if (index(unitinfo,'month').ne.0) then
+ ! months
+ call caldate(jtime,jjjjmmdd,ihmmss)
+ mm=jjjjmmdd/10000
+ indxt=minloc(abs(time-mm),dim=1)
+ else
+ write(*,*) 'ERROR in reademissions: unknown time units in file: '//trim(em_name)
+ error stop
+ endif
+ deallocate( time, jdate )
+ exit
+ endif
+ end do ! ndim
+
+ ! emission field
+ allocate( emis(nxem,nyem) )
+ write(*,*) 'Reading emissions for species '//trim(species(kk+1))
+ call nf90_err( nf90_inq_varid(ncid,trim(emis_name(kk+1)),varid) )
+ call nf90_err( nf90_inquire_variable(ncid,varid,nameout,xtype,ndim,dimids,natt) )
+ sclfact=1.
+ offset=0.
+ if (natt.gt.0 ) then
+ do nn=1,natt
+ call nf90_err( nf90_inq_attname(ncid,varid,nn,attname) )
+ if (index(attname,'add_offset').ne.0) then
+ call nf90_err( nf90_get_att(ncid,varid,'add_offset',offset) )
+ else if (index(attname,'scale_factor').ne.0) then
+ call nf90_err( nf90_get_att(ncid,varid,'scale_factor',sclfact) )
+ endif
+ end do
+ endif
+ if (ndim.eq.2) then
+ call nf90_err( nf90_get_var(ncid,varid,emis) )
+ else if (ndim.eq.3) then
+ write(*,*) 'reademissions: time index in file = ',indxt
+ call nf90_err( nf90_get_var(ncid,varid,emis,start=(/1,1,indxt/),count=(/nxem,nyem,1/)) )
+ endif
+ emis=emis*sclfact+offset
+ !! test
+ print*, 'reademissions: sclfact, offset = ',sclfact, offset
+ print*, 'reademissions: range(emis) = ',minval(emis), maxval(emis)
+ print*, 'reademissions: range(em_area) = ',minval(em_area), maxval(em_area)
+ print*, 'reademissions: emis_coeff, emis_unit = ',emis_coeff(kk+1), emis_unit(kk+1)
+ print*, 'reademissions: emis total = ',sum(emis*em_area*emis_coeff(kk+1))*3600.*24.*365./1.e9
+ em_field(kk,:,:,memid)=emis*em_area*emis_coeff(kk+1)
+
+ ! close file
+ call nf90_err( nf90_close(ncid) )
+
+ deallocate(emis)
+
+ return
+
+ end subroutine reademissions
+
+ subroutine em_res_write()
+
+ !*****************************************************************************
+ ! *
+ ! This subroutine outputs the residual emissions to be used if *
+ ! picking up a run from where this one left off (ipin = 1) *
+ ! *
+ ! Author: R. Thompson, Oct-2023 *
+ ! *
+ !*****************************************************************************
+
+ implicit none
+
+ character(len=256) :: file_name
+ integer :: nc_id, londim_id, latdim_id, specdim_id, nchardim_id
+ integer :: spec_id, lon_id, lat_id, emres_id
+
+ file_name=trim(path(2)(1:length(2)))//'emis_residual.nc'
+
+ call nf90_err( nf90_create(trim(file_name), nf90_clobber, ncid=nc_id) )
+
+ ! define dimensions
+ call nf90_err( nf90_def_dim(nc_id, 'species', nspec-1, specdim_id) )
+ call nf90_err( nf90_def_dim(nc_id, 'longitude', nxem, londim_id) )
+ call nf90_err( nf90_def_dim(nc_id, 'latitude', nyem, latdim_id) )
+ call nf90_err( nf90_def_dim(nc_id, 'nchar', 18, nchardim_id) )
+
+ ! define variables
+ call nf90_err( nf90_def_var(nc_id, 'species', nf90_char, (/ nchardim_id, specdim_id /), spec_id) )
+ call nf90_err( nf90_put_att(nc_id, spec_id, 'long_name', 'Species names') )
+ call nf90_err( nf90_def_var(nc_id, 'longitude', nf90_float, (/ londim_id /), lon_id) )
+ call nf90_err( nf90_put_att(nc_id, lon_id, 'units', 'degrees') )
+ call nf90_err( nf90_def_var(nc_id, 'latitude', nf90_float, (/ latdim_id /), lat_id) )
+ call nf90_err( nf90_put_att(nc_id, lat_id, 'units', 'degrees') )
+ call nf90_err( nf90_def_var(nc_id, 'em_res', nf90_double, (/ specdim_id, londim_id, latdim_id /), emres_id) )
+ call nf90_err( nf90_put_att(nc_id, emres_id, 'long_name', 'Emission residuals') )
+ call nf90_err( nf90_put_att(nc_id, emres_id, 'units', 'kg') )
+
+ call nf90_err( nf90_enddef(nc_id) )
+
+ ! write variables
+ call nf90_err( nf90_put_var(nc_id, spec_id, species(2:nspec)) )
+ call nf90_err( nf90_put_var(nc_id, lon_id, lonem) )
+ call nf90_err( nf90_put_var(nc_id, lat_id, latem) )
+ call nf90_err( nf90_put_var(nc_id, emres_id, em_res) )
+
+ call nf90_err( nf90_close(nc_id) )
+
+ end subroutine em_res_write
+
+ subroutine em_res_read()
+
+ !*****************************************************************************
+ ! *
+ ! This subroutine reads the residual emissions from a previous run *
+ ! which have to be copied into the output directory of this run *
+ ! *
+ ! Author: R. Thompson, Oct-2023 *
+ ! *
+ !*****************************************************************************
+
+ implicit none
+
+ character(len=256) :: file_name
+ integer :: nc_id, specdim_id, londim_id, latdim_id, emres_id
+ integer :: xlen, ylen, splen
+ logical :: lexist
+
+ file_name=trim(path(2)(1:length(2)))//'emis_residual.nc'
+
+ inquire(file=trim(file_name),exist=lexist)
+ if (.not.lexist) then
+ write(*,*) 'FLEXPART ERROR: cannot find file '//trim(file_name)
+ error stop
+ endif
+
+ call nf90_err( nf90_open(file_name, nf90_nowrite, nc_id) )
+
+ ! read dimensions
+ call nf90_err( nf90_inq_dimid(nc_id, 'longitude', londim_id) )
+ call nf90_err( nf90_inquire_dimension(nc_id, londim_id, len=xlen) )
+ call nf90_err( nf90_inq_dimid(nc_id, 'latitude', latdim_id) )
+ call nf90_err( nf90_inquire_dimension(nc_id, latdim_id, len=ylen) )
+ call nf90_err( nf90_inq_dimid(nc_id, 'species', specdim_id) )
+ call nf90_err( nf90_inquire_dimension(nc_id, specdim_id, len=splen) )
+
+ ! check dimensions match input emissions
+ if ((xlen.ne.nxem).or.(ylen.ne.nyem).or.(splen.ne.(nspec-1))) then
+ write(*,*) 'FLEXPART ERROR: emis_residual dimensions do not match input emissions'
+ error stop
+ endif
+
+ ! read em_res
+ call nf90_err( nf90_inq_varid(nc_id, 'em_res', emres_id) )
+ call nf90_err( nf90_get_var(nc_id, emres_id, em_res) )
+
+ call nf90_err( nf90_close(nc_id) )
+
+ end subroutine em_res_read
+
+
+end module emissions_mod
diff --git a/src/gitversion.txt b/src/gitversion.txt
new file mode 100644
index 0000000000000000000000000000000000000000..bc95db4e52b5163b21e04c5eec1dbcd6379065e0
--- /dev/null
+++ b/src/gitversion.txt
@@ -0,0 +1 @@
+8d9c680 Mon Apr 22 15:37:39 2024 +0200
diff --git a/src/initdomain_mod.f90 b/src/initdomain_mod.f90
new file mode 100644
index 0000000000000000000000000000000000000000..8e994760ff19cf183ac4a7efa5947fe6a02df678
--- /dev/null
+++ b/src/initdomain_mod.f90
@@ -0,0 +1,1136 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2019, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+module initdomain_mod
+
+ !*****************************************************************************
+ ! *
+ ! This module contains variables and subroutines for initializing *
+ ! particles and their mass for global domain-filling runs *
+ ! *
+ !*****************************************************************************
+
+ use netcdf
+ use par_mod
+ use com_mod
+
+ implicit none
+
+ integer, allocatable, dimension(:) :: specnini ! spec number in initial fields info
+ integer, allocatable, dimension(:) :: nxini ! number grid cells longitude
+ integer, allocatable, dimension(:) :: nyini ! number grid cells latitude
+ integer, allocatable, dimension(:) :: nzini ! number grid cell vertical
+ real, allocatable, dimension(:,:) :: lonini ! longitudes of initial fields
+ real, allocatable, dimension(:,:) :: latini ! latitudes of initial fields
+ real, allocatable, dimension(:) :: dxini, dyini ! longitude, latitude resolution of initial fields
+ real, allocatable, dimension(:,:) :: altini ! altitudes of initial fields
+ real, allocatable, dimension(:,:,:,:) :: prsini ! pressure of initial fields
+ real, allocatable, dimension(:,:,:,:) :: gridini ! initial mixing ratios (dry air, ppbv)
+
+ contains
+
+ subroutine readgridini(ks, lexist)
+
+ !******************************************************************************
+ ! *
+ ! Reads mixing ratios from a netcdf file with general format *
+ ! *
+ ! Author: Rona Thompson, Sep-2023 *
+ ! *
+ !******************************************************************************
+ ! *
+ ! Variables: *
+ ! ks relative number of species *
+ ! lexist logical to indicate if INITCONC file specified *
+ ! *
+ !******************************************************************************
+
+ use date_mod
+ use windfields_mod, only: nxmax,nymax,nzmax
+ use netcdf_output_mod, only: nf90_err
+
+ implicit none
+
+ integer :: ks
+ logical :: lexist
+ integer :: ninit
+ integer, dimension(:), allocatable :: specnum_rel
+ character(len=256) :: path_name, file_name, unitinfo, strtmp1, strtmp2, nameout
+ character(len=10) :: var_name, hya_name, hyb_name, ps_name, prs_name, q_name, alt_name
+ real :: coeff
+ integer :: readerror
+ integer :: ncid, dimid, varid, ndim, nvar, natt, unlimid, ndims, xtype, natts, len
+ integer :: yyyymmdd, hhmiss, yyyy, mm
+ integer, dimension(:), allocatable :: dimids
+ character(len=256) :: dimname, attname
+ character(len=2) :: amonth
+ character(len=4) :: ayear
+ integer :: nn, indxn, ntini, indxt, ix, jy, kz
+ real, dimension(:), allocatable :: time, hya, hyb
+ real, dimension(:,:), allocatable :: psurf
+ real, dimension(:,:,:), allocatable :: shumid, pw
+ real(kind=dp) :: julstart
+ real(kind=dp), dimension(:), allocatable :: jdate
+ real :: sclfact, offset
+ logical :: lfexist
+ integer,parameter :: unitinitconc=103, unitinitconcout=104
+
+ ! declare namelists
+ namelist /initconc_ctrl/ &
+ ninit, &
+ specnum_rel
+
+ namelist /initconc/ &
+ path_name, file_name, var_name, &
+ hya_name, hyb_name, &
+ ps_name, q_name, &
+ prs_name, alt_name, &
+ coeff
+
+ ! Read initconc input info
+ ! ************************
+
+ allocate(specnum_rel(maxspec))
+
+ ! presetting namelist initconc_ctrl
+ ninit = -1 ! use negative value to determine failed namelist input
+ specnum_rel(:) = 0
+
+ ! read initconc_ctrl to find how many fields are specified
+ open(unitinitconc,file=path(1)(1:length(1))//'INITCONC',status='old',form='formatted',iostat=readerror)
+ if (readerror.ne.0) then
+ write(*,*) 'WARNING: cannot open file INITCONC'
+ write(*,*) 'Trying to initialize using latitude profiles'
+ lexist=.false.
+ return
+ endif
+
+ ! check if namelist input provided
+ read(unitinitconc,initconc_ctrl,iostat=readerror)
+ if (readerror.ne.0 ) then
+ write(*,*) 'ERROR in readgridini: cannot read INITCONC namelist'
+ error stop
+ endif
+ write(*,*) 'ninit, specnum = ',ninit, specnum_rel
+
+ ! namelist output
+ if (nmlout.and.lroot) then
+ inquire(file=path(2)(1:length(2))//'INITCONC.namelist',exist=lfexist)
+ if (lfexist) then
+ open(unitinitconcout,file=path(2)(1:length(2))//'INITCONC.namelist',status='old',&
+ access='append',iostat=readerror)
+ else
+ open(unitinitconcout,file=path(2)(1:length(2))//'INITCONC.namelist',status='new',&
+ iostat=readerror)
+ endif
+ if (readerror.ne.0) then
+ write(*,*) 'ERROR in readgridini: file INITCONC cannot be opened'
+ write(*,*) 'in the directory',path(2)(1:length(2))
+ error stop
+ endif
+ if (.not.lfexist) then
+ ! write this only once
+ write(unitinitconcout,nml=initconc_ctrl)
+ endif
+ endif
+
+ ! allocate variables used for initial mixing ratios
+ if (.not.allocated(gridini)) then
+ allocate( nxini(ninit), nyini(ninit), nzini(ninit) )
+ allocate( dxini(ninit), dyini(ninit) )
+ allocate( lonini(nxmax,ninit), latini(nymax,ninit), altini(nzmax,ninit) )
+ allocate( prsini(nxmax,nymax,nzmax,ninit), gridini(nxmax,nymax,nzmax,ninit) )
+ allocate( specnini(ninit) )
+ nxini(:)=0
+ nyini(:)=0
+ nzini(:)=0
+ lonini(:,:)=0.
+ latini(:,:)=0.
+ altini(:,:)=0.
+ prsini(:,:,:,:)=0.
+ gridini(:,:,:,:)=0.
+ specnini(:)=specnum_rel(1:ninit)
+ endif
+
+ ! presetting namelist initconc
+ path_name=""
+ file_name=""
+ var_name=""
+ hya_name=""
+ hyb_name=""
+ ps_name=""
+ q_name=""
+ prs_name=""
+ alt_name=""
+ coeff=-1.
+
+ ! read initconc file info
+ do nn=1,ninit
+ read(unitinitconc,initconc,iostat=readerror)
+ if (readerror.ne.0) then
+ write(*,*) 'ERROR in readgridini: cannot read file info for ',specnum_rel(nn)
+ error stop
+ endif
+ if (specnum_rel(nn).eq.specnum(ks)) then
+ indxn=nn ! index to gridini for this species
+ exit
+ endif
+ end do
+
+ ! namelist output
+ if (nmlout.and.lroot) then
+ write(unitinitconcout,nml=initconc)
+ endif
+
+ write(*,*) 'readgridini: path, filename, varname = ',path_name,file_name,var_name
+ write(*,*) 'readgridini: specnum_rel(indxn), specnum(ks), indxn = ',specnum_rel(indxn), specnum(ks), indxn
+
+ close(unitinitconc)
+ close(unitinitconcout)
+
+ ! get file name for current year and month
+ call caldate(bdate,yyyymmdd,hhmiss)
+ yyyy=yyyymmdd/10000
+ mm=(yyyymmdd-(yyyymmdd/10000)*10000)/100
+ write(ayear,'(I4)') yyyy
+ write(amonth,'(I2.2)') mm
+ nn=index(file_name,'YYYY',back=.false.)
+ if (nn.ne.0) then
+ strtmp1=file_name(1:nn-1)
+ nn=index(file_name,'YYYY',back=.true.)
+ strtmp2=file_name(nn+4:len_trim(file_name))
+ file_name=trim(strtmp1)//ayear//trim(strtmp2)
+ julstart=juldate((yyyymmdd/10000)*10000+101,0)
+ endif
+ nn=index(file_name,'MM',back=.false.)
+ if (nn.ne.0) then
+ strtmp1=file_name(1:nn-1)
+ nn=index(file_name,'MM',back=.true.)
+ strtmp2=file_name(nn+2:len_trim(file_name))
+ file_name=trim(strtmp1)//amonth//trim(strtmp2)
+ julstart=juldate((yyyymmdd/100)*100+1,0)
+ endif
+ write(*,*) 'readgridini: julstart = ',julstart
+ write(*,*) 'readgridini: initial mixing ratio file to read: '//trim(path_name)//trim(file_name)
+
+ ! check file exists
+ inquire(file=trim(path_name)//trim(file_name), exist=lexist)
+ if (.not.lexist) then
+ write(*,*) 'ERROR readgridini: file not found: '//trim(path_name)//trim(file_name)
+ error stop
+ endif
+
+ ! Read netcdf file
+ !******************
+
+ ! open file
+ call nf90_err( nf90_open( trim(path_name)//trim(file_name), nf90_nowrite, ncid ) )
+
+ ! inquire about dims and vars
+ call nf90_err( nf90_inquire( ncid, ndim, nvar, natt, unlimid ) )
+ write(*,*) 'ndim, nvar:', ndim, nvar
+ allocate(dimids(ndim))
+
+ ! read dimension info
+ !********************
+ do nn=1,ndim
+ call nf90_err( nf90_inquire_dimension( ncid, nn, dimname, len ) )
+ if ((index(dimname,'lon').ne.0).or.(index(dimname,'LON').ne.0) &
+ .or.(index(dimname,'Lon').ne.0)) then
+ if (len.gt.nxmax) then
+ write(*,*) 'ERROR in readgridini: length longitude exceeds nxmax'
+ error stop
+ endif
+ nxini(indxn)=len
+ call nf90_err( nf90_inq_varid(ncid,trim(dimname),varid) )
+ call nf90_err( nf90_get_var(ncid,varid,lonini(1:nxini(indxn),indxn)) )
+ dxini(indxn)=abs(lonini(2,indxn)-lonini(1,indxn))
+ else if ((index(dimname,'lat').ne.0).or.(index(dimname,'LAT').ne.0) &
+ .or.(index(dimname,'Lat').ne.0)) then
+ if (len.gt.nymax) then
+ write(*,*) 'ERROR in readgridini: length latitude exceeds nymax'
+ error stop
+ endif
+ nyini(indxn)=len
+ call nf90_err( nf90_inq_varid(ncid,trim(dimname),varid) )
+ call nf90_err( nf90_get_var(ncid,varid,latini(1:nyini(indxn),indxn)) )
+ dyini(indxn)=abs(latini(2,indxn)-latini(1,indxn))
+ else if (((index(dimname,'lev').ne.0).or.(index(dimname,'LEV').ne.0) &
+ .or.(index(dimname,'Lev').ne.0)).and.(index(dimname,'hlevel').eq.0)) then
+ if (len.gt.nzmax) then
+ write(*,*) 'ERROR in readgridini: length vertical coord exceeds nzmax'
+ error stop
+ endif
+ nzini(indxn)=len
+ else if ((index(dimname,'time').ne.0).or.(index(dimname,'Time').ne.0) &
+ .or.(index(dimname,'Date').ne.0).or.(index(dimname,'date').ne.0)) then
+ ntini=len
+ allocate( time(ntini), jdate(ntini) )
+ call nf90_err( nf90_inq_varid(ncid,trim(dimname),varid) )
+ call nf90_err( nf90_get_var(ncid,varid,time) )
+ call nf90_err( nf90_get_att(ncid,varid,'units',unitinfo) )
+ write(*,*) 'Time units: ',trim(unitinfo)
+ if (index(unitinfo,'sec').ne.0) then
+ jdate=real(time-time(1),kind=dp)/3600._dp/24._dp+julstart
+ indxt=minloc(abs(jdate-bdate),dim=1)
+ else if (index(unitinfo,'hour').ne.0) then
+ jdate=real(time-time(1),kind=dp)/24._dp+julstart
+ indxt=minloc(abs(jdate-bdate),dim=1)
+ else if (index(unitinfo,'day').ne.0) then
+ jdate=real(time-time(1),kind=dp)+julstart
+ indxt=minloc(abs(jdate-bdate),dim=1)
+ else if (index(unitinfo,'month').ne.0) then
+ indxt=minloc(abs(time-mm),dim=1)
+ else
+ write(*,*) 'ERROR in readgridini: unknown time units in file: '//trim(path_name)//trim(file_name)
+ error stop
+ endif
+ write(*,*) 'readgridini: time index in file = ',indxt
+ deallocate( time, jdate )
+ endif
+ enddo
+
+ if ((nxini(indxn).eq.0).or.(nyini(indxn).eq.0)) then
+ write(*,*) 'ERROR in reagridini: unable to find lat and lon dimensions in file: '//trim(path_name)//trim(file_name)
+ error stop
+ endif
+ write(*,*) 'readgridini: nxini(indxn), nyini(indxn), nzini(indxn) = ',nxini(indxn), nyini(indxn), nzini(indxn)
+ write(*,*) 'readgridini: lonini(1:nxini(indxn),indxn) = ',lonini(1:nxini(indxn),indxn)
+ write(*,*) 'readgridini: latini(1:nyini(indxn),indxn) = ',latini(1:nyini(indxn),indxn)
+
+ ! read vertical coordinates
+ !**************************
+ if ((alt_name.eq."").and.(prs_name.eq."")) then
+ ! hybrid pressure coordinates
+ write(*,*) 'readgridini: reading hybrid pressure coordinates'
+ if ((hya_name.eq."").or.(hyb_name.eq."").or.(ps_name.eq."")) then
+ write(*,*) 'ERROR in readgridini: hybrid pressure coordinates and/or surface pressure missing'
+ error stop
+ endif
+ ! read hybrid pressure coordinates
+ allocate( hya(nzini(indxn)), hyb(nzini(indxn)), psurf(nxini(indxn),nyini(indxn)) )
+ call nf90_err( nf90_inq_varid(ncid,trim(hya_name),varid) )
+ call nf90_err( nf90_get_var(ncid,varid,hya) )
+ call nf90_err( nf90_inq_varid(ncid,trim(hyb_name),varid) )
+ call nf90_err( nf90_get_var(ncid,varid,hyb) )
+ write(*,*) 'read hybrid pressure coords'
+ ! read surface pressure
+ call nf90_err( nf90_inq_varid(ncid,trim(ps_name),varid) )
+ call nf90_err( nf90_inquire_variable(ncid,varid,nameout,xtype,ndims,dimids,natts) )
+ write(*,*) 'psurf: ndims, natts = ',ndims, natts
+ sclfact=0.
+ offset=0.
+ if (natts.gt.0 ) then
+ do nn=1,natts
+ call nf90_err( nf90_inq_attname(ncid,varid,nn,attname) )
+ if (index(attname,'add_offset').ne.0) then
+ call nf90_err( nf90_get_att(ncid,varid,'add_offset',offset) )
+ else if (index(attname,'scale_factor').ne.0) then
+ call nf90_err( nf90_get_att(ncid,varid,'scale_factor',sclfact) )
+ endif
+ end do
+ endif
+ write(*,*) 'psurf: sclfact, offset = ',sclfact, offset
+ if (ndims.eq.2) then
+ call nf90_err( nf90_get_var(ncid,varid,psurf,start=(/1,1/),count=(/nxini(indxn),nyini(indxn)/)) )
+ else if (ndims.eq.3) then
+ ! read from first time step (assume this is good enough)
+ call nf90_err( nf90_get_var(ncid,varid,psurf,start=(/1,1,1/),count=(/nxini(indxn),nyini(indxn),1/)) )
+ endif
+ if ((sclfact.ne.0).and.(offset.ne.0)) then
+ psurf=psurf*sclfact+offset
+ endif
+ ! calculate pressure
+ do kz=1,nzini(indxn)
+ prsini(1:nxini(indxn),1:nyini(indxn),kz,indxn)=hya(kz)+hyb(kz)*psurf(:,:)
+ end do
+ deallocate( psurf, hya, hyb )
+ else if (alt_name.ne."") then
+ ! height coordinates (assume metres above ground)
+ call nf90_err( nf90_inq_varid(ncid,trim(alt_name),varid) )
+ call nf90_err( nf90_get_var(ncid,varid,altini(1:nzini(indxn),indxn)) )
+ else if (prs_name.ne."") then
+ ! pressure coordinates
+ call nf90_err( nf90_inq_varid(ncid,trim(prs_name),varid) )
+ call nf90_err( nf90_get_var(ncid,varid,prsini(1,1,1:nzini(indxn),indxn)) )
+ do jy=1,nyini(indxn)
+ do ix=1,nxini(indxn)
+ prsini(ix,jy,:,indxn)=prsini(1,1,:,indxn)
+ end do
+ end do
+ endif
+
+ ! read mixing ratio variables
+ !****************************
+ if (var_name.eq."") then
+ write(*,*) 'ERROR in readgridini: mixing ratios missing in file'//trim(path_name)//trim(file_name)
+ error stop
+ endif
+ call nf90_err( nf90_inq_varid(ncid,trim(var_name),varid) )
+ call nf90_err( nf90_inquire_variable(ncid,varid,nameout,xtype,ndims,dimids,natts) )
+ write(*,*) 'conc: ndims, natts, dimids = ',ndims, natts, dimids
+ sclfact=0.
+ offset=0.
+ if (natts.gt.0 ) then
+ do nn=1,natts
+ call nf90_err( nf90_inq_attname(ncid,varid,nn,attname) )
+ if (index(attname,'add_offset').ne.0) then
+ call nf90_err( nf90_get_att(ncid,varid,'add_offset',offset) )
+ else if (index(attname,'scale_factor').ne.0) then
+ call nf90_err( nf90_get_att(ncid,varid,'scale_factor',sclfact) )
+ endif
+ end do
+ endif
+ write(*,*) 'conc: sclfact, offset = ',sclfact, offset
+ if (ndims.eq.3) then
+ call nf90_err( nf90_get_var(ncid,varid,gridini(1:nxini(indxn),1:nyini(indxn),1:nzini(indxn),indxn), &
+ start=(/1,1,1/),count=(/nxini(indxn),nyini(indxn),nzini(indxn)/)) )
+ else if (ndims.eq.4) then
+ call nf90_err( nf90_get_var(ncid,varid,gridini(1:nxini(indxn),1:nyini(indxn),1:nzini(indxn),indxn), &
+ start=(/1,1,1,indxt/),count=(/nxini(indxn),nyini(indxn),nzini(indxn),1/)) )
+ endif
+ if ((sclfact.ne.0).and.(offset.ne.0)) then
+ gridini(:,:,:,indxn)=gridini(:,:,:,indxn)*sclfact+offset
+ endif
+
+ ! other variables
+ !****************
+ if (q_name.ne."") then
+ ! read specific humidity
+ allocate( shumid(nxini(indxn),nyini(indxn),nzini(indxn)), pw(nxini(indxn),nyini(indxn),nzini(indxn)) )
+ call nf90_err( nf90_inq_varid(ncid,trim(q_name),varid) )
+ call nf90_err( nf90_inquire_variable(ncid,varid,nameout,xtype,ndims,dimids,natts) )
+ sclfact=0.
+ offset=0.
+ if (natts.gt.0 ) then
+ do nn=1,natts
+ call nf90_err( nf90_inq_attname(ncid,varid,nn,attname) )
+ if (index(attname,'add_offset').ne.0) then
+ call nf90_err( nf90_get_att(ncid,varid,'add_offset',offset) )
+ else if (index(attname,'scale_factor').ne.0) then
+ call nf90_err( nf90_get_att(ncid,varid,'scale_factor',sclfact) )
+ endif
+ end do
+ endif
+ if (ndims.eq.3) then
+ call nf90_err( nf90_get_var(ncid,varid,shumid(:,:,:), &
+ start=(/1,1,1/),count=(/nxini(indxn),nyini(indxn),nzini(indxn)/)) )
+ else if (ndims.eq.4) then
+ call nf90_err( nf90_get_var(ncid,varid,shumid(:,:,:), &
+ start=(/1,1,1,indxt/),count=(/nxini(indxn),nyini(indxn),nzini(indxn),1/)) )
+ endif
+ write(*,*) 'conc: sclfact, offset = ',sclfact, offset
+ if ((sclfact.ne.0).and.(offset.ne.0)) then
+ shumid=shumid*sclfact+offset
+ endif
+ ! partial pressure of water from specific humidity
+ pw = shumid*prsini(1:nxini(indxn),1:nyini(indxn),1:nzini(indxn),indxn)/(0.622 + 0.378*shumid)
+ ! correct mixing ratio to dry air (needed in init_domainfill)
+ gridini(1:nxini(indxn),1:nyini(indxn),1:nzini(indxn),indxn)= &
+ gridini(1:nxini(indxn),1:nyini(indxn),1:nzini(indxn),indxn)* &
+ prsini(1:nxini(indxn),1:nyini(indxn),1:nzini(indxn),indxn)/ &
+ (prsini(1:nxini(indxn),1:nyini(indxn),1:nzini(indxn),indxn) - pw)
+ deallocate( shumid, pw )
+ endif
+
+ ! convert units to ppbv
+ !**********************
+ if (coeff.gt.0) gridini(:,:,:,indxn)=gridini(:,:,:,indxn)*coeff
+ write(*,*) 'range(gridini) = ',minval(gridini(1:nxini(indxn),1:nyini(indxn),1,indxn)),&
+ maxval(gridini(1:nxini(indxn),1:nyini(indxn),1,indxn))
+
+ end subroutine readgridini
+
+
+ subroutine init_domainfill_ncf
+
+ !******************************************************************************
+ ! *
+ ! Initializes particles equally distributed over the first release location *
+ ! specified in file RELEASES. This box is assumed to be the domain for doing *
+ ! domain-filling trajectory calculations. *
+ ! All particles carry the same amount of mass which alltogether comprises the*
+ ! mass of air within the box. *
+ ! *
+ ! Author: A. Stohl, Oct 2002 *
+ ! Modifications: *
+ ! R. Thompson, Sep 2023: added initialization of mass from grid based *
+ ! on code of S. Henne for Flexpart-CTM *
+ ! *
+ !******************************************************************************
+ ! *
+ ! Variables: *
+ ! *
+ ! numparticlecount consecutively counts the number of particles released *
+ ! nx_we(2) grid indices for western and eastern boundary of domain- *
+ ! filling trajectory calculations *
+ ! ny_sn(2) grid indices for southern and northern boundary of domain- *
+ ! filling trajectory calculations *
+ ! *
+ !******************************************************************************
+
+ use point_mod
+ use random_mod
+ use outgrid_mod
+ use particle_mod
+#ifdef ETA
+ use coord_ecmwf_mod
+#endif
+ use initialise_mod, only: nx_we,ny_sn,numcolumn,numcolumn_we,numcolumn_sn, &
+ zcolumn_we,zcolumn_sn,acc_mass_we,acc_mass_sn, &
+ xmassperparticle,alloc_domainfill
+ use totals_mod, only: tot_mass
+
+ implicit none
+
+ integer :: j,ix,jy,kz,ncolumn,numparttot,iterminate,stat
+ real :: ylat,ylatp,ylatm,hzone
+ real :: cosfactm,cosfactp,deltacol,dz1,dz2,dz,pnew,fractus
+ real,parameter :: pih=pi/180.
+ real :: colmasstotal,zposition
+ real :: hgt_tmp
+ real, allocatable,dimension(:) :: pp
+
+ integer :: ixm,ixp,jym,jyp,indzm,indzp,nn,indzh,i,ii,jj,ks,indxn
+ real :: pvpart,ddx,ddy,rddx,rddy,p1,p2,p3,p4,y1(2)
+ integer :: idummy = -11
+ logical :: deall
+ real,parameter :: eps=1.e-6
+
+ ! dry and moist air density at particle position
+ real :: rho_d_i, rho_m_i
+
+ ! variables for column mass calculation
+ integer,allocatable,dimension(:,:) :: nncolumn
+ real,allocatable,dimension(:) :: gridarea
+ real,allocatable,dimension(:,:) :: colmass
+ real,parameter :: weightair=28.97
+
+ ! variables to store source profiles
+ real :: bg_lat(maxspec,ny), dummy1, dummy2
+ real :: ppbvpart, presspart
+ character(256) :: filename
+ logical :: lexist, lgridini
+ real :: xl, yl
+
+ ! io variables
+ character(30) :: frmt
+ integer, parameter :: unitcolmass=98, unitinitconc=99
+
+ ! Determine the release region (only full grid cells), over which particles
+ ! shall be initialized
+ ! Use 2 fields for west/east and south/north boundary
+ !**************************************************************************
+ call alloc_domainfill
+ nx_we(1)=max(int(xpoint1(1)),0)
+ nx_we(2)=min((int(xpoint2(1))+1),nxmin1)
+ ny_sn(1)=max(int(ypoint1(1)),0)
+ ny_sn(2)=min((int(ypoint2(1))+1),nymin1)
+
+ ! For global simulations (both global wind data and global domain-filling),
+ ! set a switch, such that no boundary conditions are used
+ !**************************************************************************
+ if (xglobal.and.sglobal.and.nglobal) then
+ if ((nx_we(1).eq.0).and.(nx_we(2).eq.nxmin1).and. &
+ (ny_sn(1).eq.0).and.(ny_sn(2).eq.nymin1)) then
+ gdomainfill=.true.
+ else
+ gdomainfill=.false.
+ endif
+ endif
+
+ ! If resuming a run from particle dump
+ ! calculate total mass each species then exit
+ !********************************************
+ if (gdomainfill.and.ipin.ne.0) then
+ write(*,*) 'Initialising particles from partoutput'
+ tot_mass(:)=0.
+ do ks=2,nspec
+ tot_mass(ks)=sum(mass(1:count%alive,ks))
+ write(*,'(A,E12.4,A)') 'Species '//species(ks)//': ',tot_mass(ks),' (kg)'
+ end do
+ return
+ endif
+
+ ! Allocate fields used within this subroutine
+ !*********************************************
+ allocate( nncolumn(0:nxmax-1, 0:nymax-1),stat=stat )
+ if (stat.ne.0) write(*,*)'ERROR: could not allocate nncolumn'
+ allocate(gridarea(0:nymax-1),colmass(0:nxmax-2,0:nymax-1),stat=stat)
+ if (stat.ne.0) write(*,*)'ERROR: could not allocate gridarea or colmass'
+
+ ! Do not release particles twice (i.e., not at both in the leftmost and rightmost
+ ! grid cell) for a global domain
+ !*****************************************************************************
+ if (xglobal) nx_we(2)=min(nx_we(2),nx-2)
+ write(*,*) 'init_domainfill: nx_we, ny_sn = ',nx_we, ny_sn
+
+ ! Try reading initial mixing ratio fields into gridini
+ !*****************************************************
+ ! this is to restart from 3D fields
+ ! grid_pptv files have to be present for all species except 1 (airtracer)
+ lgridini = .true.
+ do ks=2,nspec ! species 1 is assumed to be air tracer
+ call readgridini(ks,lexist)
+ if (.not.lexist) then
+ lgridini = .false.
+ exit
+ end if
+ end do
+
+ if (lgridini) then
+ write(*,*) "Initialising all species with gridded input"
+ !! test
+ open(unitoutgrid,file=path(2)(1:length(2))//'gridini.txt',status='replace',action='write')
+ write(frmt,fmt='(A,I4,A)') '(',nxini(1),'(E14.6))'
+ do kz=1,nzini(1)
+ do jj=1,nyini(1)
+ write(unitoutgrid,frmt) gridini(1:nxini(1),jj,kz,1)
+ end do
+ end do
+ close(unitoutgrid)
+ !!
+ else
+ ! read latitude profiles for initialization
+ do ks=2,nspec ! species 1 is assumed to be air tracer
+ filename=trim(path(2)(1:length(2)))//'latitude_profile_'//trim(species(ks))//'.txt'
+ print*, 'init_domainfill: filename = ',filename
+ inquire(file=filename,exist=lexist)
+ if (lexist) then
+ open(unitinitconc,file=filename,action='read')
+ do jj=1,ny
+ read(unitinitconc,'(3F13.6)') dummy1, bg_lat(ks,jj), dummy2
+ write(*,*) 'read values; ', dummy1, bg_lat(ks,jj), dummy2
+ enddo
+ close(unitinitconc)
+ write(*,'(A)') "Initialising species "//species(ks)//" with latitudinal profile"
+ else
+ bg_lat(ks,:) = 1.
+ write(*,'(A)') "Initialising species "//species(ks)//" with value in RELEASES"
+ endif
+ end do ! nspec
+ endif ! lgridini
+
+ ! Calculate area of grid cell with formula M=2*pi*R*h*dx/360,
+ ! see Netz, Formeln der Mathematik, 5. Auflage (1983), p.90
+ ! Note gridarea is for meteo grid
+ !************************************************************
+
+ write(*,*) 'init_domainfill: nxmin1, nxmax, nymin1, nymax = ',nxmin1, nxmax, nymin1, nymax
+
+ ! for the south pole
+ if (sglobal) then
+ ylat=ylat0
+ ylatp=ylat+0.5*dy
+ ylatm=ylat
+ cosfactm=0.
+ cosfactp=cos(ylatp*pih)*r_earth
+ hzone=sqrt(r_earth**2-cosfactm**2)- &
+ sqrt(r_earth**2-cosfactp**2)
+ gridarea(0)=2.*pi*r_earth*hzone*dx/360.
+ endif
+
+ ! do the same for the north pole
+ if (nglobal) then
+ ylat=ylat0+real(nymin1)*dy
+ ylatp=ylat
+ ylatm=ylat-0.5*dy
+ cosfactp=0.
+ cosfactm=cos(ylatm*pih)*r_earth
+ hzone=sqrt(r_earth**2-cosfactp**2)- &
+ sqrt(r_earth**2-cosfactm**2)
+ gridarea(nymin1)=2.*pi*r_earth*hzone*dx/360.
+ endif
+
+ ! Initialise the sum over the total mass of the atmosphere
+ colmasstotal=0.
+ colmass(:,:)=0.
+
+ write(*,*) 'init_domainfill: ny_sn, nx_we = ',ny_sn, nx_we
+ write(*,*) 'init_domainfill: dxini, dyini = ',dxini, dyini
+
+ allocate( pp(nzmax),stat=stat)
+ if (stat.ne.0) write(*,*)'ERROR: could not allocate pp'
+
+!$OMP PARALLEL PRIVATE(jy,ix,ylat,ylatp,ylatm,hzone,cosfactp,cosfactm,pp)
+
+!$OMP DO
+ ! loop over latitudes
+ do jy=ny_sn(1),ny_sn(2)
+ if (sglobal.and.(jy.eq.ny_sn(1))) cycle
+ if (nglobal.and.(jy.eq.ny_sn(2))) cycle
+ ylat=ylat0+real(jy)*dy
+ ylatp=ylat+0.5*dy
+ ylatm=ylat-0.5*dy
+ if ((ylatm.lt.0).and.(ylatp.gt.0.)) then
+ hzone=1./dyconst
+ else
+ cosfactp=cos(ylatp*pih)*r_earth
+ cosfactm=cos(ylatm*pih)*r_earth
+ if (cosfactp.lt.cosfactm) then
+ hzone=sqrt(r_earth**2-cosfactp**2)- &
+ sqrt(r_earth**2-cosfactm**2)
+ else
+ hzone=sqrt(r_earth**2-cosfactm**2)- &
+ sqrt(r_earth**2-cosfactp**2)
+ endif
+ endif
+ gridarea(jy)=2.*pi*r_earth*hzone*dx/360.
+ end do
+!$OMP END DO
+!$OMP BARRIER
+
+ ! Calculate total mass of each grid column and of the whole atmosphere
+ !*********************************************************************
+
+!$OMP DO
+ do jy=ny_sn(1),ny_sn(2)
+ do ix=nx_we(1),nx_we(2)
+ pp(1)=prs(ix,jy,1,1)
+ pp(nz)=prs(ix,jy,nz,1)
+ colmass(ix,jy)=(pp(1)-pp(nz))/ga*gridarea(jy)
+ end do
+ end do
+!$OMP END DO
+!$OMP END PARALLEL
+
+ deallocate(pp)
+
+ colmasstotal=sum(colmass)
+ write(*,*) 'Atmospheric mass air = ',colmasstotal
+
+ ! Output of colmass distribution
+ !********************************
+
+ open(unitcolmass,file=path(2)(1:length(2))//'colmass.dat',action='write')
+ write(frmt, '(A, I4, A)') '(', ny_sn(2)-ny_sn(1)+1, 'E12.3)'
+ do ix=nx_we(1),nx_we(2)
+ write(unitcolmass, frmt) (colmass(ix,i),i=0,(nymax-1))
+ end do
+ close(unitcolmass)
+
+ ! If not continuing from particle dump
+ !*************************************
+
+ if (ipin.eq.0) numpart=0
+
+ ! Determine the particle positions
+ !*********************************
+ allocate( pp(nzmax),stat=stat)
+ if (stat.ne.0) write(*,*)'ERROR: could not allocate pp'
+ numparttot=0
+ numcolumn=0
+ iterminate=0
+
+ ! allocate all particles before loop
+ call spawn_particles(0, npart(1))
+ write(*,*) 'init_domainfill: count%alive = ',count%alive
+
+ do jy=ny_sn(1),ny_sn(2) ! loop about latitudes
+ ylat=ylat0+real(jy)*dy
+ do ix=nx_we(1),nx_we(2) ! loop about longitudes
+ ncolumn=nint(0.999*real(npart(1))*colmass(ix,jy)/colmasstotal)
+ ! this condition means with 0.5 degrees need around 200 million particles
+ ! to avoid any grid cells having zero particles
+ ncolumn=max(ncolumn,1)
+ nncolumn(ix,jy) = ncolumn
+ if (ncolumn.gt.numcolumn) numcolumn=ncolumn
+
+ ! Calculate pressure at the altitudes of model surfaces, using the air density
+ ! information, which is stored as a 3-d field
+ pp(:)=prs(ix,jy,:,1)
+
+ ! Loop over number of particles in grid column
+ deltacol=(pp(1)-pp(nz))/real(ncolumn)
+ pnew=pp(1)+deltacol/2.
+ jj=0
+ do j=1,ncolumn
+ jj=jj+1
+
+ ! For columns with many particles (i.e. around the equator), distribute
+ ! the particles equally, for columns with few particles (i.e. around the
+ ! poles), distribute the particles randomly. When only few particles are
+ ! left distribute them randomly
+
+ if ((ncolumn.gt.20)) then !.and.(ncolumn-j.gt.20)) then
+ pnew=pnew-deltacol
+! else if (ncolumn.gt.20) then
+! pnew=pnew-ran1(idummy,0)*(pnew-pp(nz))
+ else
+ pnew=pp(1)-ran1(idummy,0)*(pp(1)-pp(nz))
+ endif
+ pnew=min(pp(1),pnew)
+ pnew=max(pp(nz)+eps,pnew)
+
+ ! find vertical layer
+ do kz=1,nz-1
+ if ((pp(kz).ge.pnew).and.(pp(kz+1).lt.pnew)) then
+ dz1=log(pp(kz))-log(pnew)
+ dz2=log(pnew)-log(pp(kz+1))
+ dz=1./(dz1+dz2)
+
+ ! Assign particle position
+ !*************************
+
+ ! Do the following steps only if particles are not read in from
+ ! previous model run
+ if (ipin.eq.0) then
+
+ ! Horizontal position
+ call set_xlon(numpart+jj,real(real(ix)-0.5+ran1(idummy,0),kind=dp))
+ if (ix.eq.0) call set_xlon(numpart+jj,real(ran1(idummy,0),kind=dp))
+ if (ix.eq.nxmin1) &
+ call set_xlon(numpart+jj,real(real(nxmin1)-ran1(idummy,0),kind=dp))
+ call set_ylat(numpart+jj,real(real(jy)-0.5+ran1(idummy,0),kind=dp))
+ if (jy.eq.0) call set_ylat(numpart+jj,real(ran1(idummy,0),kind=dp))
+ if (jy.eq.nymin1) &
+ call set_ylat(numpart+jj,real(real(nymin1)-ran1(idummy,0),kind=dp))
+ ! Vertical position
+ hgt_tmp=(height(kz)*dz2+height(kz+1)*dz1)*dz
+ call set_z(numpart+jj,hgt_tmp)
+ if (real(part(numpart+jj)%z).gt.(height(nz)-0.5)) &
+ call set_z(numpart+jj,height(nz)-0.5)
+#ifdef ETA
+ call update_z_to_zeta(0, numpart+jj)
+#endif
+ ! Interpolate PV to the particle position
+ !****************************************
+ ixm=int(part(numpart+jj)%xlon)
+ jym=int(part(numpart+jj)%ylat)
+ ixp=ixm+1
+ jyp=jym+1
+ ddx=real(part(numpart+jj)%xlon)-real(ixm)
+ ddy=real(part(numpart+jj)%ylat)-real(jym)
+ rddx=1.-ddx
+ rddy=1.-ddy
+ p1=rddx*rddy
+ p2=ddx*rddy
+ p3=rddx*ddy
+ p4=ddx*ddy
+ indzm=nz-1
+ indzp=nz
+ do ii=2,nz
+ if (real(height(ii),kind=dp).gt.part(numpart+jj)%z) then
+ indzm=ii-1
+ indzp=ii
+ exit
+ endif
+ end do
+ dz1=real(part(numpart+jj)%z)-height(indzm)
+ dz2=height(indzp)-real(part(numpart+jj)%z)
+ dz=1./(dz1+dz2)
+ do ii=1,2
+ indzh=indzm+ii-1
+ y1(ii)=p1*pv(ixm,jym,indzh,1) &
+ + p2*pv(ixp,jym,indzh,1) &
+ + p3*pv(ixm,jyp,indzh,1) &
+ + p4*pv(ixp,jyp,indzh,1)
+ end do
+ pvpart=(dz2*y1(1)+dz1*y1(2))*dz
+ if (ylat.lt.0.) pvpart=-1.*pvpart
+
+ ! Interpolate moist air density to the particle position
+ !*******************************************************
+ do ii=1,2
+ indzh=indzm+ii-1
+ y1(ii)=p1*rho(ixm,jym,indzh,1) &
+ +p2*rho(ixp,jym,indzh,1) &
+ +p3*rho(ixm,jyp,indzh,1) &
+ +p4*rho(ixp,jyp,indzh,1)
+ end do
+ rho_m_i=(dz2*y1(1)+dz1*y1(2))*dz
+
+ ! Interpolate dry air density to the particle position
+ !*****************************************************
+ do ii=1,2
+ indzh=indzm+ii-1
+ y1(ii)=p1*rho(ixm,jym,indzh,1)*(1-qv(ixm,jym,indzh,1)) &
+ +p2*rho(ixp,jym,indzh,1)*(1-qv(ixp,jym,indzh,1)) &
+ +p3*rho(ixm,jyp,indzh,1)*(1-qv(ixm,jyp,indzh,1)) &
+ +p4*rho(ixp,jyp,indzh,1)*(1-qv(ixp,jyp,indzh,1))
+ end do
+ rho_d_i=(dz2*y1(1)+dz1*y1(2))*dz
+
+ ! For domain-filling option 2 (stratospheric O3),
+ ! do the rest only in the stratosphere
+ !************************************************
+
+ if (((part(numpart+jj)%z.gt.3000.).and. &
+ (pvpart.gt.pvcrit)).or.(mdomainfill.eq.1)) then
+
+ ! Assign certain properties to the particle
+ !******************************************
+ part(numpart+jj)%nclass=min(int(ran1(idummy,0)*real(nclassunc))+1,nclassunc)
+ numparticlecount=numparticlecount+1
+ part(numpart+jj)%npoint=numparticlecount
+ part(numpart+jj)%idt=mintime
+ mass(numpart+jj,1)=colmass(ix,jy)/real(ncolumn)
+
+ if (lgridini) then
+
+ ! Initialize particle mass using gridded input
+ !*********************************************
+ ! Assume input is in units of ppv and species 1 carries airmass tracer so
+ ! mass of other species is easily determined
+ ! loop over all species, assuming species 1 is airtracer
+ do ks=2, nspec
+ indxn=minloc(abs(specnini-specnum(ks)),dim=1)
+ ! lon and lat of particle
+ xl=real(part(numpart+jj)%xlon)*dx+xlon0
+ yl=real(part(numpart+jj)%ylat)*dy+ylat0
+ ! get coordinates in gridini
+ ! Assumes lon and lat dimensions are midpoints
+ ixm=int((xl-(lonini(1,indxn)-0.5*dxini(indxn)))/dxini(indxn))+1
+ jym=int((yl-(latini(1,indxn)-0.5*dyini(indxn)))/dyini(indxn))+1
+ ixm=min(ixm,nxini(indxn))
+ jym=min(jym,nyini(indxn))
+ !! testing
+ if (jj.eq.1.and.jy.lt.5.and.ix.lt.5) then
+ print*, 'init_domainfill: lonini, xl, latini, yl = ',lonini(ixm,indxn),xl,latini(jym,indxn),yl
+ endif !!
+ ! Get vertical position in gridini
+ if (any(altini(:,indxn).gt.0)) then
+ ! vertical coordinate in metres above ground
+ indzm=nzini(indxn)-1
+ indzp=nzini(indxn)
+ do ii=2,nzini(indxn)
+ if (altini(ii,indxn).gt.real(part(numpart+jj)%z)) then
+ indzm=ii-1
+ indzp=ii
+ exit
+ endif
+ enddo
+ dz1=real(part(numpart+jj)%z)-altini(indzm,indxn)
+ dz2=altini(indzp,indxn)-real(part(numpart+jj)%z)
+ dz=1./(dz1+dz2)
+ ppbvpart=(dz2*gridini(ixm,jym,indzm,indxn)+ &
+ dz1*gridini(ixm,jym,indzp,indxn))*dz
+ else if (any(prsini(:,:,:,indxn).gt.0)) then
+ ! vertical coordinate in pressure (Pa)
+ presspart=pnew
+ indzm=nzini(indxn)-1
+ indzp=nzini(indxn)
+ do ii=2,nzini(indxn)
+ if (presspart.gt.prsini(ixm,jym,ii,indxn)) then
+ indzm=ii-1
+ indzp=ii
+ exit
+ endif
+ end do
+ dz1=presspart-prsini(ixm,jym,indzm,indxn)
+ dz2=prsini(ixm,jym,indzp,indxn)-presspart
+ dz=1./(dz1+dz2)
+ ppbvpart=(dz2*gridini(ixm,jym,indzm,indxn)+ &
+ dz1*gridini(ixm,jym,indzp,indxn))*dz
+ endif
+ !! test
+! if (numpart.lt.100) write(*,*) 'init_domainfill: ratio dry/moist density =',rho_d_i/rho_m_i
+ mass(numpart+jj,ks)=mass(numpart+jj,1) * &
+ weightmolar(ks)/weightair * &
+ rho_d_i/rho_m_i*ppbvpart/1.E9
+ end do ! nspec
+
+ else
+
+ ! Initialize with latitude profile
+ !*********************************
+ ! loop over all species, assuming species 1 is airtracer
+ do ks=2, nspec
+ mass(numpart+jj,ks)=mass(numpart+jj,1)* &
+ weightmolar(ks)/weightair * &
+ rho_d_i/rho_m_i*bg_lat(ks,jy)/1.E9
+ end do
+
+ endif ! lgridini
+
+ ! Assign ozone mass if domain-filling option 2
+ !*********************************************
+ if (mdomainfill.eq.2) mass(numpart+jj,1)= &
+ mass(numpart+jj,1)*pvpart*48./29.*ozonescale/10.**9
+
+ mass_init(numpart+jj,1)=mass(numpart+jj,1)
+
+ else
+
+ ! Particle in stratosphere and not domain-filling option 1
+ !*********************************************************
+ call terminate_particle(numpart+jj, 0)
+ jj=jj-1
+ iterminate=iterminate+1
+
+ endif ! domainfill option
+ endif ! if initialization
+ endif ! if in layer
+ end do ! loop over layers
+ end do ! loop over column
+
+ numparttot=numparttot+ncolumn
+ if (ipin.eq.0) numpart=numpart+jj
+
+ end do ! loop over longitude
+
+ end do ! loop over latitude
+
+ write(*,*) 'init_domainfill: numpart, numparttot = ',numpart, numparttot
+
+ ! Terminate unused particles
+ !***************************
+ do j=(numpart+1),count%alive
+ call terminate_particle(j,0) ! Cannot be within an OMP region
+ iterminate=iterminate+1
+ end do
+ write(*,*) 'init_domainfill: after terminating extra particles count%alive = ',count%alive
+
+ ! Total mass each species
+ !************************
+ tot_mass(:)=0.
+ do ks=2,nspec
+ tot_mass(ks)=sum(mass(1:count%alive,ks))
+ write(*,'(A,E12.4,A)') 'Species '//species(ks)//': ',tot_mass(ks),' (kg)'
+ end do
+
+ xmassperparticle=colmasstotal/real(numparttot)
+
+ ! Output colmass distribution
+ !****************************
+
+ open(unitcolmass,file=path(2)(1:length(2))//'ncolumn.dat',action='write')
+ write(frmt, '(A, I4, A)') '(', ny_sn(2)-ny_sn(1)+1, 'I5)'
+ do ix=nx_we(1), nx_we(2)
+ write(unitcolmass,frmt) (nncolumn(ix, jj), jj=ny_sn(1),ny_sn(2))
+ end do
+ close(unitcolmass)
+
+ ! For boundary conditions, we need fewer particle release heights per column,
+ ! because otherwise it takes too long until enough mass has accumulated to
+ ! release a particle at the boundary (would take dx/u seconds), leading to
+ ! relatively large position errors of the order of one grid distance.
+ ! It's better to release fewer particles per column, but to do so more often.
+ ! Thus, use on the order of nz starting heights per column.
+ ! We thus repeat the above to determine fewer starting heights, that are
+ ! used furtheron in subroutine boundcond_domainfill.f90
+ !****************************************************************************
+
+ fractus=real(numcolumn)/real(nz)
+ write(*,*) 'Total number of particles at model start: ',numpart
+ write(*,*) 'Maximum number of particles per column: ',numcolumn
+ write(*,*) 'If ',fractus,' <1, better use more particles'
+ fractus=sqrt(max(fractus,1.))/2.
+
+ do jy=ny_sn(1),ny_sn(2) ! loop about latitudes
+ do ix=nx_we(1),nx_we(2) ! loop about longitudes
+ ncolumn=nint(0.999/fractus*real(npart(1))*colmass(ix,jy) &
+ /colmasstotal)
+ if (ncolumn.gt.maxcolumn) error stop 'maxcolumn too small'
+ if (ncolumn.eq.0) cycle
+
+ ! Memorize how many particles per column shall be used for all boundaries
+ ! This is further used in subroutine boundcond_domainfill.f
+ ! Use 2 fields for west/east and south/north boundary
+ !************************************************************************
+
+ if (ix.eq.nx_we(1)) numcolumn_we(1,jy)=ncolumn
+ if (ix.eq.nx_we(2)) numcolumn_we(2,jy)=ncolumn
+ if (jy.eq.ny_sn(1)) numcolumn_sn(1,ix)=ncolumn
+ if (jy.eq.ny_sn(2)) numcolumn_sn(2,ix)=ncolumn
+
+ ! Calculate pressure at the altitudes of model surfaces, using the air density
+ ! information, which is stored as a 3-d field
+ !*****************************************************************************
+
+ do kz=1,nz
+ pp(kz)=prs(ix,jy,kz,1)
+ end do
+
+ ! Determine the reference starting altitudes
+ !*******************************************
+
+ deltacol=(pp(1)-pp(nz))/real(ncolumn)
+ pnew=pp(1)+deltacol/2.
+ do j=1,ncolumn
+ pnew=pnew-deltacol
+ do kz=1,nz-1
+ if ((pp(kz).ge.pnew).and.(pp(kz+1).lt.pnew)) then
+ dz1=pp(kz)-pnew
+ dz2=pnew-pp(kz+1)
+ dz=1./(dz1+dz2)
+ zposition=(height(kz)*dz2+height(kz+1)*dz1)*dz
+ if (zposition.gt.height(nz)-0.5) zposition=height(nz)-0.5
+
+ ! Memorize vertical positions where particles are introduced
+ ! This is further used in subroutine boundcond_domainfill.f
+ !***********************************************************
+
+ if (ix.eq.nx_we(1)) zcolumn_we(1,jy,j)=zposition
+ if (ix.eq.nx_we(2)) zcolumn_we(2,jy,j)=zposition
+ if (jy.eq.ny_sn(1)) zcolumn_sn(1,ix,j)=zposition
+ if (jy.eq.ny_sn(2)) zcolumn_sn(2,ix,j)=zposition
+
+ ! Initialize mass that has accumulated at boundary to zero
+ !*********************************************************
+
+ acc_mass_we(1,jy,j)=0.
+ acc_mass_we(2,jy,j)=0.
+ acc_mass_sn(1,jy,j)=0.
+ acc_mass_sn(2,jy,j)=0.
+
+ endif
+ end do
+ end do
+ end do
+ end do
+
+ ! If there were more particles allocated than used,
+ ! Deallocate unused memory and update numpart
+ !**************************************************
+
+ deall=.false.
+ do i=numpart, 1, -1
+ if (.not. part(i)%alive) then
+ deall=.true.
+ numpart = numpart - 1
+ else
+ exit
+ endif
+ end do
+
+ if (deall) call dealloc_particle(numpart) ! deallocates everything above numpart
+ write(*,*) 'init_domainfill: after dealloc count%alive = ',count%alive
+ write(*,*) 'init_domainfill: count%allocated = ',count%allocated
+
+
+ ! If particles shall be read in to continue an existing run,
+ ! then the accumulated masses at the domain boundaries must be read in, too.
+ ! This overrides any previous calculations.
+ !***************************************************************************
+
+ if ((ipin.eq.1).and.(.not.gdomainfill)) then
+ open(unitboundcond,file=path(2)(1:length(2))//'boundcond.bin', &
+ form='unformatted')
+ read(unitboundcond) numcolumn_we,numcolumn_sn, &
+ zcolumn_we,zcolumn_sn,acc_mass_we,acc_mass_sn
+ close(unitboundcond)
+ endif
+
+ deallocate(pp,nncolumn,gridarea)
+
+ end subroutine init_domainfill_ncf
+
+ !*****************************************************************************
+ ! *
+ ! netcdf error message handling *
+ ! *
+ !*****************************************************************************
+
+! subroutine nf90_err(status)
+!
+! integer, intent (in) :: status
+!
+! if(status /= nf90_noerr) then
+! print*, trim(nf90_strerror(status))
+! error stop 'Stopped'
+! end if
+!
+! end subroutine nf90_err
+
+end module initdomain_mod
diff --git a/src/initialise_mod.f90 b/src/initialise_mod.f90
index e2a8fb79c11782d996aadbe486fa7d579cea8216..5f98e2054e64151385b1ed047612940474b5c124 100644
--- a/src/initialise_mod.f90
+++ b/src/initialise_mod.f90
@@ -889,6 +889,8 @@ subroutine init_domainfill
! *
! Changes *
! 2022, L. Bakels: OpenMP parallelisation *
+ ! 2023, L. Bakels: smooth vertical particle distribution instead of *
+ ! distributing particles on fixed vertical layers *
! *
!*****************************************************************************
! *
@@ -956,7 +958,8 @@ subroutine init_domainfill
! Allocate grid and column mass
!*******************************
- allocate(gridarea(0:nymax-1),colmass(0:nxmax-1,0:nymax-1))
+ allocate(gridarea(0:nymax-1),colmass(0:nxmax-1,0:nymax-1),stat=stat)
+ if (stat.ne.0) write(*,*)'ERROR: could not allocate gridarea or colmass'
! Do not release particles twice (i.e., not at both in the leftmost and rightmost
! grid cell) for a global domain
@@ -1082,11 +1085,11 @@ subroutine init_domainfill
jj=0
do j=1,ncolumn ! looping over the number of particles within the column
- ! For columns with many particles (i.e. around the equator), distribute
- ! the particles equally (1 on a random position within the deltacol range),
- ! for columns with few particles (i.e. around the poles),
- ! distribute the particles randomly
- !***********************************************************************
+ ! For columns with many particles (i.e. around the equator), distribute
+ ! the particles equally (1 on a random position within the deltacol range),
+ ! for columns with few particles (i.e. around the poles),
+ ! distribute the particles randomly
+ !***********************************************************************
if ((ncolumn.gt.20).and.(ncolumn-j.gt.20)) then
pnew_temp=pnew-ran1(idummy,0)*deltacol
diff --git a/src/list-of-modules.txt b/src/list-of-modules.txt
deleted file mode 100644
index e16dc5e18d9695640e22fb0e97dfa69708d12304..0000000000000000000000000000000000000000
--- a/src/list-of-modules.txt
+++ /dev/null
@@ -1,39 +0,0 @@
- 10 xmass_mod.f90 WHY DO WE NEED EXTRA MODULE?
- 99 unc_mod.f90 A BIT STRANGE FOR ME. SHOULD GO IN OUTG?
- 135 point_mod.f90 WHY IS THIS A MODULE? BUNDLE WITH READINPUT?
- 154 date_mod.f90
- 171 txt_output_mod.f90 SHOULD GO IN OUTPUT?
- 179 random_mod.f90 MAYBE BUNDLE WITH ERF?
- 197 qvsat_mod.f90 MAYBE BUNDLE WITH OTHER THERMODY STUFF?
- 201 erf_mod.f90
- 217 settling_mod.f90 MAYBE BUNDLE WITH DRYDEPO?
- 233 mean_mod.f90
- 320 par_mod.f90
- 400 FLEXPART.f90
- 419 cbl_mod.f90
- 419 class_gribfile_mod.f90 WILL REPLACE THIS WITH MY CODE
- 450 oh_mod.f90
- 475 coordinates_ecmwf_mod.f90 NEED A NEW NAME
- 525 com_mod.f90
- 545 flux_mod.f90
- 663 timemanager_mod.f90
- 686 plume_mod.f90
- 717 turbulence_mod.f90 RENAME TURB_MOD?
- 746 particle_mod.f90 RENAME PART_MOD?
- 814 advance_mod.f90
- 816 cmapf_mod.f90
- 838 wetdepo_mod.f90
- 876 outg_mod.f90 RENAME OUTGRID_MOD?
- 952 output_mod_old.f90 REMOVE?
- 1495 output_mod.f90
- 1540 drydepo_mod.f90
- 1558 interpol_mod.f90 RENAME INTERP_MOD?
- 1684 getfields_mod.f90
- 1949 verttransform_mod.f90
- 2009 initialise_mod.f90 IF DOMAINFILLING ONLY, RENAME INITDOMFILL_MOD?
- 2196 conv_mod.f90
- 2767 netcdf_output_mod.f90
- 3309 readoptions_mod.f90
- 4115 windfields_mod.f90
- 4546 binary_output_mod.f90
- 39425 total
diff --git a/src/make_command.sh b/src/make_command.sh
new file mode 100755
index 0000000000000000000000000000000000000000..deb0e704a23a0da693480e6e4455e4a5d0c7a559
--- /dev/null
+++ b/src/make_command.sh
@@ -0,0 +1,23 @@
+
+module purge
+module load eccodes
+export CPATH=/opt/tools/eccodes/2.28.0-gcc9.4/include:/opt/tools/netcdf-fortran/4.6.0-gcc9.4/include
+export LIBRARY_PATH=$LIBRARY_PATH:/opt/tools/eccodes/2.28.0-gcc9.4/lib
+
+rm -f *.o *.mod
+
+# eta ncf - new default FLEXPART_ETA
+FC=/opt/tools/gcc/9.4.0/bin/gfortran make -f makefile_gfortran
+#executable: FLEXPART_ETA
+
+# meter bin - classic
+#FC=/opt/tools/gcc/9.4.0/bin/gfortran make -f makefile_gfortran eta=no ncf=no
+# executable: FLEXPART_BIN
+
+# meter ncf:
+#FC=/opt/tools/gcc/9.4.0/bin/gfortran make -f makefile_gfortran eta=no
+# executable: FLEXPART
+
+# eta/bin
+#FC=/opt/tools/gcc/9.4.0/bin/gfortran make -f makefile_gfortran ncf=no
+# executable: FLEXPART_ETA_BIN
diff --git a/src/makefile_gfortran b/src/makefile_gfortran
index d5a520dc02bf1fc4f4feb35f02bf851a6bfa9bea..6b0c04d73d4a7ad380e4f7add40fc3f0fe93fb7f 100644
--- a/src/makefile_gfortran
+++ b/src/makefile_gfortran
@@ -94,6 +94,8 @@ else
FUSER = -g -fopenmp -march=native -mtune=native
endif
+# To compile in serial
+#FUSER = -g -fopenmp_stubs -march=skylake-avx512
mpi: FUSER := $(FUSER) -Dusempi #-MM -MT -MD
## LIBRARIES
@@ -115,7 +117,7 @@ date_mod.o drydepo_mod.o \
erf_mod.o flux_mod.o \
getfields_mod.o initialise_mod.o \
interpol_mod.o mean_mod.o \
-ohr_mod.o outgrid_mod.o \
+outgrid_mod.o \
output_mod.o par_mod.o \
particle_mod.o pbl_profile_mod.o \
plume_mod.o point_mod.o \
@@ -126,9 +128,12 @@ timemanager_mod.o turbulence_mod.o \
txt_output_mod.o unc_mod.o \
verttransform_mod.o wetdepo_mod.o \
windfields_mod.o qvsat_mod.o \
-xmass_mod.o
+xmass_mod.o receptor_mod.o
-OBJECTS_NCF = netcdf_output_mod.o
+OBJECTS_NCF = \
+netcdf_output_mod.o chemistry_mod.o \
+totals_mod.o initdomain_mod.o \
+receptor_netcdf_mod.o emissions_mod.o \
OBJECTS_ETA = coord_ecmwf_mod.o
@@ -153,6 +158,8 @@ else
endif
endif
+$(info $(OBJECTS))
+
%.o: %.mod
# serial executable
@@ -174,6 +181,8 @@ $(FP): $(MODOBJS) $(OBJECTS)
clean:
\rm -f *.o *.mod
+.PHONY: clean
+
cleanall:
\rm -f *.o *.mod $(FLEXPART) $(FLEXPART-BIN) $(FLEXPART-ETA) $(FLEXPART-ETA-BIN)
@@ -249,7 +258,6 @@ endif
verttransform_mod.o: par_mod.o com_mod.o qvsat_mod.o windfields_mod.o
settling_mod.o: windfields_mod.o
interpol_mod.o: windfields_mod.o particle_mod.o turbulence_mod.o
-ohr_mod.o: windfields_mod.o particle_mod.o
#5)
ifneq ($(eta),no)
@@ -261,12 +269,12 @@ drydepo_mod.o: unc_mod.o interpol_mod.o erf_mod.o
ifneq ($(eta),no)
advance_mod.o: coord_ecmwf_mod.o settling_mod.o drydepo_mod.o turbulence_mod.o
plume_mod.o: mean_mod.o coord_ecmwf_mod.o
-outgrid_mod.o: ohr_mod.o unc_mod.o coord_ecmwf_mod.o
+outgrid_mod.o: unc_mod.o coord_ecmwf_mod.o
wetdepo_mod.o: coord_ecmwf_mod.o unc_mod.o
else
advance_mod.o: interpol_mod.o settling_mod.o drydepo_mod.o turbulence_mod.o
plume_mod.o: mean_mod.o particle_mod.o windfields_mod.o
-outgrid_mod.o: ohr_mod.o unc_mod.o interpol_mod.o
+outgrid_mod.o: unc_mod.o interpol_mod.o
wetdepo_mod.o: interpol_mod.o unc_mod.o
endif
readoptions_mod.o: drydepo_mod.o xmass_mod.o
@@ -277,7 +285,23 @@ flux_mod.o: outgrid_mod.o qvsat_mod.o
txt_output_mod.o: outgrid_mod.o
binary_output_mod.o: mean_mod.o outgrid_mod.o
ifneq ($(ncf), no)
+receptor_mod.o: par_mod.o com_mod.o point_mod.o particle_mod.o date_mod.o \
+ windfields_mod.o receptor_netcdf_mod.o binary_output_mod.o
+else
+receptor_mod.o: par_mod.o com_mod.o point_mod.o particle_mod.o date_mod.o \
+ windfields_mod.o binary_output_mod.o
+endif
+ifneq ($(ncf), no)
netcdf_output_mod.o: mean_mod.o outgrid_mod.o readoptions_mod.o drydepo_mod.o
+totals_mod.o: par_mod.o com_mod.o netcdf_output_mod.o
+chemistry_mod.o: par_mod.o com_mod.o date_mod.o particle_mod.o \
+ point_mod.o windfields_mod.o totals_mod.o netcdf_output_mod.o
+initdomain_mod.o: par_mod.o com_mod.o point_mod.o random_mod.o outgrid_mod.o \
+ initialise_mod.o totals_mod.o date_mod.o windfields_mod.o netcdf_output_mod.o
+receptor_netcdf_mod.o: par_mod.o com_mod.o point_mod.o date_mod.o \
+ windfields_mod.o netcdf_output_mod.o
+emissions_mod.o: par_mod.o com_mod.o point_mod.o particle_mod.o date_mod.o \
+ netcdf_output_mod.o totals_mod.o windfields_mod.o
endif
#8)
@@ -302,7 +326,14 @@ endif
initialise_mod.o: interpol_mod.o xmass_mod.o output_mod.o turbulence_mod.o
#10)
-timemanager_mod.o: advance_mod.o conv_mod.o plume_mod.o getfields_mod.o restart_mod.o initialise_mod.o
+ifneq ($(ncf), no)
+timemanager_mod.o: advance_mod.o conv_mod.o plume_mod.o getfields_mod.o restart_mod.o \
+ initialise_mod.o chemistry_mod.o initdomain_mod.o receptor_mod.o \
+ emissions_mod.o totals_mod.o
+else
+timemanager_mod.o: advance_mod.o conv_mod.o plume_mod.o getfields_mod.o restart_mod.o \
+ initialise_mod.o receptor_mod.o
+endif
#11)
ifneq ($(GIT_VERSION),$(GIT_OLD))
diff --git a/src/netcdf_output_mod.f90 b/src/netcdf_output_mod.f90
index 97b465fc53a3c3b4755069415c0627c73f586898..5d8655d6cf8506079384f10027b1d73f8eab3b17 100644
--- a/src/netcdf_output_mod.f90
+++ b/src/netcdf_output_mod.f90
@@ -14,20 +14,23 @@
! *
! 12 April 2013 *
! *
- ! HSO: 21 Oct 2014
- ! - added option to not writeout releases information by changing
- ! switch write_releases
- ! - additional updates for FLEXPART 9.x
- !
- ! ESO 2016
- ! - Deposition fields can be calculated in double precision, see variable
- ! 'dep_prec' in par_mod
- ! - Hardcoded options 'write_vol' and 'write_area' for grid cell
- ! volume and area
- !
+ ! HSO: 21 Oct 2014 *
+ ! - added option to not writeout releases information by changing *
+ ! switch write_releases *
+ ! - additional updates for FLEXPART 9.x *
+ ! *
+ ! ESO 2016 *
+ ! - Deposition fields can be calculated in double precision, see variable *
+ ! 'dep_prec' in par_mod *
+ ! - Hardcoded options 'write_vol' and 'write_area' for grid cell *
+ ! volume and area *
+ ! *
! LB: 2021 *
! - Particle dump and initial particle positions in NetCDF *
! - Receptor files in NetCDF format *
+ ! *
+ ! RLT: 2024 *
+ ! - Moved receptor output new module *
!*****************************************************************************
@@ -42,26 +45,8 @@ module netcdf_output_mod
area,arean,volumen,orooutn
use par_mod, only: dep_prec, sp, dp, nclassunc,&
unitoutrecept,unitoutreceptppt,unittmp,lpartoutputperfield
- use com_mod, only: path,length,ldirect,ibdate,ibtime,iedate,ietime,itime_init, &
- loutstep,loutaver,loutsample,outlon0,outlat0,&
- numxgrid,numygrid,dxout,dyout,numzgrid, &
- outlon0n,outlat0n,dxoutn,dyoutn,numxgridn,numygridn, &
- nspec,maxpointspec_act,species,numpoint,&
- compoint,method,lsubgrid,lconvection,&
- ind_source,ind_receptor,nageclass,lage,&
- drydep,wetdep,decay,weta_gas,wetb_gas, numbnests, &
- ccn_aero,in_aero, mintime, & ! wetc_in,wetd_in, &
- reldiff,henry,f0,density,dquer,dsigma,dryvel,&
- weightmolar,ohcconst,ohdconst,vsetaver,&
- numparticlecount,receptorname, &
- memind,xreceptor,yreceptor,numreceptor,creceptor,iout, &
- loutrestart,lnetcdfout,lsynctime, ctl, ifine, lagespectra, ipin, &
- ioutputforeachrelease, iflux, mdomainfill, mquasilag, &
- nested_output, ipout, sfc_only, linit_cond, &
- flexversion,mpi_mode,DEP,DRYDEP,WETDEP,DRYBKDEP,WETBKDEP,OHREA, &
- numpart,numpoint,partopt,num_partopt,gitversion,ndia, &
- DRYDEPSPEC,WETDEPSPEC,maxspec,maxndia
- ! use com_mod
+ use com_mod
+
use windfields_mod, only: oro,rho,nxmax,height,nxmin1,nymin1,nz,nx,ny,hmix, &
! for concoutput_netcdf and concoutput_nest_netcdf
tropopause,oron,rhon,xresoln,yresoln,xrn,xln,yrn,yln,nxn,nyn
@@ -117,10 +102,8 @@ module netcdf_output_mod
open_partoutput_file,close_partoutput_file,create_particles_initialoutput,&
topo_written,mass_written,wrt_part_initialpos,partinit_netcdf,open_partinit_file, &
readpartpositions_netcdf,readinitconditions_netcdf,partinitpointer1,tpointer, &
- alloc_netcdf,dealloc_netcdf,update_partoutput_pointers,ppointer_part
+ alloc_netcdf,dealloc_netcdf,nf90_err,update_partoutput_pointers,ppointer_part
- ! Not written yet:
- ! concoutput_sfc_netcdf,concoutput_sfc_nest_netcdf,
contains
subroutine alloc_netcdf
@@ -286,7 +269,7 @@ subroutine writeheader_netcdf(lnest)
logical, intent(in) :: lnest
integer :: ncid, sID, wdsID, ddsID
- integer :: timeDimID, latDimID, lonDimID, levDimID, receptorDimID
+ integer :: timeDimID, latDimID, lonDimID, levDimID
integer :: nspecDimID, npointDimID, nageclassDimID, ncharDimID, pointspecDimID
integer :: tID, lonID, latID, levID, lageID, oroID, ncharrecDimID
integer :: volID, areaID
@@ -308,6 +291,7 @@ subroutine writeheader_netcdf(lnest)
integer, dimension(5) :: dep_chunksizes
integer :: i
+ integer :: numzwrite
! Check if output directory exists (the netcdf library will
@@ -329,6 +313,9 @@ subroutine writeheader_netcdf(lnest)
! Create netcdf file
!************************
+ numzwrite=numzgrid
+ if (sfc_only.eq.1) numzwrite=1
+
if (ldirect.eq.1) then
write(adate,'(i8.8)') ibdate
write(atime,'(i6.6)') ibtime
@@ -379,7 +366,8 @@ subroutine writeheader_netcdf(lnest)
! lat
call nf90_err(nf90_def_dim(ncid, 'latitude', nny, latDimID))
! level
- call nf90_err(nf90_def_dim(ncid, 'height', numzgrid, levDimID))
+! call nf90_err(nf90_def_dim(ncid, 'height', numzgrid, levDimID))
+ call nf90_err(nf90_def_dim(ncid, 'height', numzwrite, levDimID))
! number of species
call nf90_err(nf90_def_dim(ncid, 'numspec', nspec, nspecDimID))
! number of release points
@@ -388,8 +376,6 @@ subroutine writeheader_netcdf(lnest)
call nf90_err(nf90_def_dim(ncid, 'nageclass', nageclass, nageclassDimID))
! dimension for release point characters
call nf90_err(nf90_def_dim(ncid, 'nchar', 45, ncharDimID))
- ! dimension for receptor point characters
- call nf90_err(nf90_def_dim(ncid, 'ncharrec', 16, ncharrecDimID))
! number of actual release points
call nf90_err(nf90_def_dim(ncid, 'numpoint', numpoint, npointDimID))
@@ -512,14 +498,6 @@ subroutine writeheader_netcdf(lnest)
call nf90_err(nf90_put_att(ncid, oroID, 'units', 'm'))
end if
- ! Receptors
- if (numreceptor.ge.1) then
- call nf90_err(nf90_def_dim(ncid, 'receptor', nf90_unlimited, receptorDimID))
- call nf90_err(nf90_def_var(ncid, 'receptor', nf90_char, (/ ncharrecDimID,receptorDimID /), sID))
- call nf90_err(nf90_put_var(ncid, sID, receptorname, (/ 1,1 /), (/ 16,numreceptor /)))
- call nf90_err(nf90_put_att(ncid, sID, 'long_name', 'receptor name'))
- endif
-
! concentration output, wet and dry deposition variables (one per species)
call output_units(units)
@@ -538,7 +516,8 @@ subroutine writeheader_netcdf(lnest)
if (int(nnx,kind=8)*int(nny,kind=8)*int(numzgrid,kind=8).gt.2147483647) then ! Larger than an
chunksizes = (/ nnx, nny, 1, 1, 1, 1 /)
else
- chunksizes = (/ nnx, nny, numzgrid, 1, 1, 1 /)
+! chunksizes = (/ nnx, nny, numzgrid, 1, 1, 1 /)
+ chunksizes = (/ nnx, nny, numzwrite, 1, 1, 1 /)
endif
dep_chunksizes = (/ nnx, nny, 1, 1, 1 /)
@@ -555,9 +534,9 @@ subroutine writeheader_netcdf(lnest)
call nf90_err(nf90_put_att(ncid, sID, 'decay', decay(i)))
call nf90_err(nf90_put_att(ncid, sID, 'weightmolar', weightmolar(i)))
! call nf90_err(nf90_put_att(ncid, sID, 'ohreact', ohreact(i)))
- call nf90_err(nf90_put_att(ncid, sID, 'ohcconst', ohcconst(i)))
- call nf90_err(nf90_put_att(ncid, sID, 'ohdconst', ohdconst(i)))
- call nf90_err(nf90_put_att(ncid, sID, 'vsetaver', vsetaver(i)))
+! call nf90_err(nf90_put_att(ncid, sID, 'ohcconst', ohcconst(i)))
+! call nf90_err(nf90_put_att(ncid, sID, 'ohdconst', ohdconst(i)))
+! call nf90_err(nf90_put_att(ncid, sID, 'vsetaver', vsetaver(i)))
if (lnest) then
specIDn(i) = sID
@@ -576,9 +555,9 @@ subroutine writeheader_netcdf(lnest)
call nf90_err(nf90_put_att(ncid, sID, 'decay', decay(i)))
call nf90_err(nf90_put_att(ncid, sID, 'weightmolar', weightmolar(i)))
! call nf90_err(nf90_put_att(ncid, sID, 'ohreact', ohreact(i)))
- call nf90_err(nf90_put_att(ncid, sID, 'ohcconst', ohcconst(i)))
- call nf90_err(nf90_put_att(ncid, sID, 'ohdconst', ohdconst(i)))
- call nf90_err(nf90_put_att(ncid, sID, 'vsetaver', vsetaver(i)))
+! call nf90_err(nf90_put_att(ncid, sID, 'ohcconst', ohcconst(i)))
+! call nf90_err(nf90_put_att(ncid, sID, 'ohdconst', ohdconst(i)))
+! call nf90_err(nf90_put_att(ncid, sID, 'vsetaver', vsetaver(i)))
if (lnest) then
specIDnppt(i) = sID
@@ -625,19 +604,6 @@ subroutine writeheader_netcdf(lnest)
ddspecID(i) = ddsID
endif
endif
- ! RECEPTORS
- if (numreceptor.ge.1) then
- if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
- call write_to_file(ncid,'receptor_conc'//anspec, nf90_float, (/ timeDimID,receptorDimID /), &
- sID, (/ 1, numreceptor /), 'ng m-3', .true., 'receptor_conc', 'receptor_concentration')
- recconcID(i)=sID
- endif
- if ((iout.eq.2).or.(iout.eq.3)) then
- call write_to_file(ncid,'receptor_pptv'//anspec, nf90_float, (/ timeDimID,receptorDimID /), &
- sID, (/ 1, numreceptor /), 'pptv', .true., 'receptor_pptv', 'receptor_mixingratio')
- recpptvID(i)=sID
- endif
- endif
end do
! global (metadata) attributes
@@ -648,23 +614,6 @@ subroutine writeheader_netcdf(lnest)
! moves the file from define to data mode
call nf90_err(nf90_enddef(ncid))
- ! ! hes: inquire var definition
- ! do i = 1,nspec
- ! write(anspec,'(i3.3)') i
- !
- ! ! concentration output
- ! if (iout.eq.1.or.iout.eq.3.or.iout.eq.5) then
- ! if (lnest) then
- ! sID = specIDn(i)
- ! else
- ! sID = specID(i)
- ! endif
- ! call nf90_err(nf90_inquire_variable(ncid, sID, chunksizes=inq_chunksizes))
- ! write(*,*) "Chunksizes for var "//anspec//": ", inq_chunksizes
- ! endif
- ! end do
-
-
! fill with data
!******************************
! longitudes (grid cell centers)
@@ -700,14 +649,17 @@ subroutine writeheader_netcdf(lnest)
deallocate(coord)
endif
! levels
- call nf90_err(nf90_put_var(ncid, levID, outheight(1:numzgrid)))
+! call nf90_err(nf90_put_var(ncid, levID, outheight(1:numzgrid)))
+ call nf90_err(nf90_put_var(ncid, levID, outheight(1:numzwrite)))
! volume
if (write_vol) then
if (lnest) then
- call nf90_err(nf90_put_var(ncid, volID, volumen(:,:,:)))
+! call nf90_err(nf90_put_var(ncid, volID, volumen(:,:,:)))
+ call nf90_err(nf90_put_var(ncid, volID, volumen(:,:,1:numzwrite)))
else
- call nf90_err(nf90_put_var(ncid, volID, volume(:,:,:)))
+! call nf90_err(nf90_put_var(ncid, volID, volume(:,:,:)))
+ call nf90_err(nf90_put_var(ncid, volID, volume(:,:,1:numzwrite)))
end if
end if
@@ -819,18 +771,6 @@ subroutine read_grid_id(lnest)
end do
endif
- ! RECEPTORS
- if (numreceptor.ge.1) then
- do i = 1,nspec
- if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
- call nf90_err(nf90_inq_varid(ncid,name='receptor_conc'//anspec,varid=recconcID(i)))
- endif
- if ((iout.eq.2).or.(iout.eq.3)) then
- call nf90_err(nf90_inq_varid(ncid,name='receptor_pptv'//anspec,varid=recpptvID(i)))
- endif
- end do
- endif
-
call nf90_err(nf90_close(ncid))
end subroutine read_grid_id
@@ -841,7 +781,7 @@ subroutine concoutput_netcdf(itime,outnum,gridtotalunc,wetgridtotalunc,drygridto
! o
!*****************************************************************************
! *
- ! Output of the concentration grid and the receptor concentrations. *
+ ! Output of the concentration grid and the concentrations. *
! *
! Author: A. Stohl *
! *
@@ -878,6 +818,10 @@ subroutine concoutput_netcdf(itime,outnum,gridtotalunc,wetgridtotalunc,drygridto
! - OpenMP parallelisation *
! - Receptor output to NetCDF instead of binary format *
! *
+ ! January, 2024, Rona Thompson *
+ ! - removed output of receptors (new module) *
+ ! - introduced option for LCM output *
+ ! *
!*****************************************************************************
! *
! Variables: *
@@ -888,7 +832,7 @@ subroutine concoutput_netcdf(itime,outnum,gridtotalunc,wetgridtotalunc,drygridto
! *
!*****************************************************************************
- use unc_mod, only: gridunc,drygridunc,wetgridunc,drygridunc0,wetgridunc0
+ use unc_mod
implicit none
@@ -896,8 +840,8 @@ subroutine concoutput_netcdf(itime,outnum,gridtotalunc,wetgridtotalunc,drygridto
real, intent(in) :: outnum
real(dep_prec),intent(out):: wetgridtotalunc,drygridtotalunc
real, intent(out) :: gridtotalunc
- real :: densityoutrecept(numreceptor),recout(numreceptor)
integer :: ncid,kp,ks,kz,ix,jy,iix,jjy,kzz,ngrid
+ integer :: ks_start
integer :: nage,i,l,jj
real :: tot_mu(maxspec,maxpointspec_act)
real :: halfheight,dz,dz1,dz2
@@ -909,11 +853,15 @@ subroutine concoutput_netcdf(itime,outnum,gridtotalunc,wetgridtotalunc,drygridto
! real(sp) :: gridtotal,gridsigmatotal
! real(sp) :: wetgridtotal,wetgridsigmatotal
! real(sp) :: drygridtotal,drygridsigmatotal
+ integer :: numzwrite
real, parameter :: weightair=28.97
eps=nxmax/3.e5
+ numzwrite=numzgrid
+ if (sfc_only.eq.1 ) numzwrite=1
+
! open output file
call nf90_err(nf90_open(trim(ncfname), nf90_write, ncid))
@@ -957,76 +905,83 @@ subroutine concoutput_netcdf(itime,outnum,gridtotalunc,wetgridtotalunc,drygridto
! a nested domain (before only from mother domain)
! Determine center altitude of output layer, and interpolate density
! data to that altitude
+ !
+ ! Note:
+ ! llcmoutput = true: grid is mass_spec/mass_air
+ ! for iout 1,3, or 5 multiply by rho
+ ! for iout 2 multiply by 1
+ ! llcmoutput = false: grid is mass_spec/V
+ ! for iout 1,3, or 5 multiply by 1
+ ! for iout 2 multiply by 1/rho
!*******************************************************************
+
!$OMP PARALLEL PRIVATE(halfheight,kzz,dz1,dz2,dz,xl,yl,ngrid,iix,jjy, &
!$OMP kz,ix,jy,l,ks,kp,nage,auxgrid) REDUCTION(+:wetgridtotal,wetgridsigmatotal, &
!$OMP drygridtotal,drygridsigmatotal,gridtotal,gridsigmatotal)
+
+ if (((.not.llcmoutput).and.(iout.eq.2)).or.&
+ (llcmoutput.and.((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)))) then
+ ! compute density
!$OMP DO
- do kz=1,numzgrid
- if (kz.eq.1) then
- halfheight=outheight(1)*0.5
- else
- halfheight=(outheight(kz)+outheight(kz-1))*0.5
- endif
- do kzz=2,nz
- if ((height(kzz-1).lt.halfheight).and. &
- (height(kzz).gt.halfheight)) exit
- end do
- kzz=max(min(kzz,nz),2)
- dz1=halfheight-height(kzz-1)
- dz2=height(kzz)-halfheight
- dz=dz1+dz2
+ do kz=1,numzgrid
+ if (kz.eq.1) then
+ halfheight=outheight(1)*0.5
+ else
+ halfheight=(outheight(kz)+outheight(kz-1))*0.5
+ endif
+ do kzz=2,nz
+ if ((height(kzz-1).lt.halfheight).and. &
+ (height(kzz).gt.halfheight)) exit
+ end do
+ kzz=max(min(kzz,nz),2)
+ dz1=halfheight-height(kzz-1)
+ dz2=height(kzz)-halfheight
+ dz=dz1+dz2
- do jy=0,numygrid-1
- do ix=0,numxgrid-1
- xl=outlon0+real(ix)*dxout
- yl=outlat0+real(jy)*dyout
- ! grid index in mother domain
- xl=(xl-xlon0)/dx
- yl=(yl-ylat0)/dx
+ do jy=0,numygrid-1
+ do ix=0,numxgrid-1
+ xl=outlon0+real(ix)*dxout
+ yl=outlat0+real(jy)*dyout
+ ! grid index in mother domain
+ xl=(xl-xlon0)/dx
+ yl=(yl-ylat0)/dx
+
+ ngrid=0
+ do jj=numbnests,1,-1
+ if ( xl.gt.xln(jj)+eps .and. xl.lt.xrn(jj)-eps .and. &
+ yl.gt.yln(jj)+eps .and. yl.lt.yrn(jj)-eps ) then
+ ngrid=jj
+ exit
+ end if
+ end do
- ngrid=0
- do jj=numbnests,1,-1
- if ( xl.gt.xln(jj)+eps .and. xl.lt.xrn(jj)-eps .and. &
- yl.gt.yln(jj)+eps .and. yl.lt.yrn(jj)-eps ) then
- ngrid=jj
- exit
- end if
- end do
+ if (ngrid.eq.0) then
+ iix=max(min(nint(xl),nxmin1),0) ! if output grid cell is outside mother domain
+ jjy=max(min(nint(yl),nymin1),0)
- if (ngrid.eq.0) then
- iix=max(min(nint(xl),nxmin1),0) ! if output grid cell is outside mother domain
- jjy=max(min(nint(yl),nymin1),0)
+ densityoutgrid(ix,jy,kz)=(rho(iix,jjy,kzz,memind(2))*dz1+ &
+ rho(iix,jjy,kzz-1,memind(2))*dz2)/dz
+ else
+ xl=(xl-xln(ngrid))*xresoln(ngrid)
+ yl=(yl-yln(ngrid))*yresoln(ngrid)
+ iix=max(min(nint(xl),nxn(ngrid)-1),0)
+ jjy=max(min(nint(yl),nyn(ngrid)-1),0)
- densityoutgrid(ix,jy,kz)=(rho(iix,jjy,kzz,memind(2))*dz1+ &
- rho(iix,jjy,kzz-1,memind(2))*dz2)/dz
- else
- xl=(xl-xln(ngrid))*xresoln(ngrid)
- yl=(yl-yln(ngrid))*yresoln(ngrid)
- iix=max(min(nint(xl),nxn(ngrid)-1),0)
- jjy=max(min(nint(yl),nyn(ngrid)-1),0)
-
- densityoutgrid(ix,jy,kz)=(rhon(iix,jjy,kzz,memind(2), ngrid)*dz1+ &
- rhon(iix,jjy,kzz-1,memind(2), ngrid)*dz2)/dz
- endif
+ densityoutgrid(ix,jy,kz)=(rhon(iix,jjy,kzz,memind(2), ngrid)*dz1+ &
+ rhon(iix,jjy,kzz-1,memind(2), ngrid)*dz2)/dz
+ endif
+ end do
end do
end do
- end do
-!$OMP END DO NOWAIT
-
- ! brd134: for receptor points no option for nests yet to specify density
- ! and also altitude zreceptor not considered yet (needs revision)
- if (numreceptor.gt.0) then
-!$OMP DO
- do i=1,numreceptor
- xl=xreceptor(i)
- yl=yreceptor(i)
- iix=max(min(nint(xl),nxmin1),0)
- jjy=max(min(nint(yl),nymin1),0)
- densityoutrecept(i)=rho(iix,jjy,1,memind(2))
- end do
!$OMP END DO NOWAIT
- endif
+ if (llcmoutput) then
+ ! because divide grid by densityoutgrid
+ densityoutgrid=1./densityoutgrid
+ endif
+ else
+ ! no division by density
+ densityoutgrid(:,:,:)=1.
+ endif ! llcmoutput
! Output is different for forward and backward simulations
if (ldirect.eq.1) then
@@ -1034,7 +989,11 @@ subroutine concoutput_netcdf(itime,outnum,gridtotalunc,wetgridtotalunc,drygridto
do kz=1,numzgrid
do jy=0,numygrid-1
do ix=0,numxgrid-1
- factor3d(ix,jy,kz)=1.e12/volume(ix,jy,kz)/outnum
+ if (llcmoutput) then
+ factor3d(ix,jy,kz)=1.e12/gridcnt(ix,jy,kz)
+ else
+ factor3d(ix,jy,kz)=1.e12/volume(ix,jy,kz)/outnum
+ endif
end do
end do
end do
@@ -1056,8 +1015,13 @@ subroutine concoutput_netcdf(itime,outnum,gridtotalunc,wetgridtotalunc,drygridto
! ratio (uncertainty of the output) and the dry and wet deposition
!*********************************************************************
+ if (llcmoutput) then
+ ks_start=2
+ else
+ ks_start=1
+ endif
- do ks=1,nspec
+ do ks=ks_start,nspec
do kp=1,maxpointspec_act
do nage=1,nageclass
@@ -1165,9 +1129,12 @@ subroutine concoutput_netcdf(itime,outnum,gridtotalunc,wetgridtotalunc,drygridto
endif
! Concentrations
+! call nf90_err(nf90_put_var(ncid,specID(ks),grid(0:numxgrid-1,0:numygrid-1,&
+! 1:numzgrid)*factor3d(0:numxgrid-1,0:numygrid-1,1:numzgrid)/tot_mu(ks,kp),&
+! (/ 1,1,1,tpointer,kp,nage /), (/ numxgrid,numygrid,numzgrid,1,1,1 /) ))
call nf90_err(nf90_put_var(ncid,specID(ks),grid(0:numxgrid-1,0:numygrid-1,&
- 1:numzgrid)*factor3d(0:numxgrid-1,0:numygrid-1,1:numzgrid)/tot_mu(ks,kp),&
- (/ 1,1,1,tpointer,kp,nage /), (/ numxgrid,numygrid,numzgrid,1,1,1 /) ))
+ 1:numzwrite)*factor3d(0:numxgrid-1,0:numygrid-1,1:numzwrite)/tot_mu(ks,kp),&
+ (/ 1,1,1,tpointer,kp,nage /), (/ numxgrid,numygrid,numzwrite,1,1,1 /) ))
endif ! concentration output
@@ -1192,19 +1159,24 @@ subroutine concoutput_netcdf(itime,outnum,gridtotalunc,wetgridtotalunc,drygridto
endif
! Mixing ratios
+! call nf90_err(nf90_put_var(ncid,specIDppt(ks),weightair/weightmolar(ks)*&
+! grid(0:numxgrid-1,0:numygrid-1,1:numzgrid)*&
+! factor3d(0:numxgrid-1,0:numygrid-1,1:numzgrid)/&
+! densityoutgrid(0:numxgrid-1,0:numygrid-1,1:numzgrid),&
+! (/ 1,1,1,tpointer,kp,nage /), (/ numxgrid,numygrid,numzgrid,1,1,1 /)))
call nf90_err(nf90_put_var(ncid,specIDppt(ks),weightair/weightmolar(ks)*&
- grid(0:numxgrid-1,0:numygrid-1,1:numzgrid)*&
- factor3d(0:numxgrid-1,0:numygrid-1,1:numzgrid)/&
- densityoutgrid(0:numxgrid-1,0:numygrid-1,1:numzgrid),&
- (/ 1,1,1,tpointer,kp,nage /), (/ numxgrid,numygrid,numzgrid,1,1,1 /)))
+ grid(0:numxgrid-1,0:numygrid-1,1:numzwrite)*&
+ factor3d(0:numxgrid-1,0:numygrid-1,1:numzwrite)/&
+ densityoutgrid(0:numxgrid-1,0:numygrid-1,1:numzwrite),&
+ (/ 1,1,1,tpointer,kp,nage /), (/ numxgrid,numygrid,numzwrite,1,1,1 /)))
endif ! output for ppt
!$OMP END SINGLE
!$OMP BARRIER
- end do
- end do
+ end do ! nageclass
+ end do ! maxpointspec_act
- end do
+ end do ! nspec
!$OMP END PARALLEL
if (gridtotal.gt.0.) gridtotalunc=real(gridsigmatotal/gridtotal,kind=sp)
@@ -1213,55 +1185,27 @@ subroutine concoutput_netcdf(itime,outnum,gridtotalunc,wetgridtotalunc,drygridto
if (drygridtotal.gt.0.) drygridtotalunc=real(drygridsigmatotal/ &
drygridtotal, kind=dep_prec)
- ! Dump of receptor concentrations
-
- if (numreceptor.ge.1) then
- if (iout.eq.2 .or. iout.eq.3) then
- do ks=1,nspec
- recout(:)=1.e12*creceptor(:,ks)/outnum*weightair/weightmolar(ks)/densityoutrecept(:)
- call nf90_err(nf90_put_var(ncid,recpptvID(ks),recout(1:numreceptor),(/ tpointer,1 /),(/ 1,numreceptor /)))
- end do
- endif
-
- ! Dump of receptor concentrations
-
- if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
- do ks=1,nspec
- recout(:)=1.e12*creceptor(:,ks)/outnum
- call nf90_err(nf90_put_var(ncid,recconcID(ks),recout(1:numreceptor),(/ tpointer,1 /),(/ 1,numreceptor /)))
- end do
- endif
- endif
-
! Close netCDF file
!**************************
call nf90_err(nf90_close(ncid))
! Reinitialization of grid
!*************************
- if (numreceptor.gt.0) creceptor(1:numreceptor,1:nspec) = 0.
gridunc(:,:,:,1:nspec,:,:,1:nageclass) = 0.
-end subroutine concoutput_netcdf
+ gridcnt(:,:,:) = 0.
+#ifdef _OPENMP
+ gridunc_omp(:,:,:,:,:,:,:,:) = 0.
+ gridcnt_omp(:,:,:,:) = 0.
+#endif
-! subroutine concoutput_sfc_netcdf(itime,outnum,gridtotalunc,wetgridtotalunc,drygridtotalunc)
-
-! use unc_mod, only: gridunc,drygridunc,wetgridunc,drygridunc0,wetgridunc0
-
-! implicit none
-
-! integer, intent(in) :: itime
-! real, intent(in) :: outnum
-! real(sp), intent(out) :: gridtotalunc
-! real(dep_prec), intent(out) :: wetgridtotalunc,drygridtotalunc
+end subroutine concoutput_netcdf
-! print*,'Netcdf output for surface only not yet implemented'
-! end subroutine concoutput_sfc_netcdf
subroutine concoutput_nest_netcdf(itime,outnum)
! i i
!*****************************************************************************
! *
- ! Output of the concentration grid and the receptor concentrations. *
+ ! Output of the concentration grid and the concentrations. *
! *
! Author: A. Stohl *
! *
@@ -1301,7 +1245,6 @@ subroutine concoutput_nest_netcdf(itime,outnum)
integer, intent(in) :: itime
real, intent(in) :: outnum
- real :: densityoutrecept(numreceptor)
integer :: ncid,kp,ks,kz,ix,jy,iix,jjy,kzz,ngrid
integer :: nage,i,l,jj
real :: tot_mu(maxspec,maxpointspec_act)
@@ -1310,9 +1253,13 @@ subroutine concoutput_nest_netcdf(itime,outnum)
real(dep_prec) :: auxgrid(nclassunc)
real :: gridtotal
real, parameter :: weightair=28.97
+ integer :: numzwrite
eps=nxmax/3.e5
+ numzwrite=numzgrid
+ if (sfc_only.eq.1 ) numzwrite=1
+
! open output file
call nf90_err(nf90_open(trim(ncfnamen), nf90_write, ncid))
@@ -1400,18 +1347,6 @@ subroutine concoutput_nest_netcdf(itime,outnum)
end do
!$OMP END DO NOWAIT
- if (numreceptor.gt.0) then
-!$OMP DO
- do i=1,numreceptor
- xl=xreceptor(i)
- yl=yreceptor(i)
- iix=max(min(nint(xl),nxmin1),0)
- jjy=max(min(nint(yl),nymin1),0)
- densityoutrecept(i)=rho(iix,jjy,1,memind(2))
- end do
-!$OMP END DO NOWAIT
- endif
-
! Output is different for forward and backward simulations
if (ldirect.eq.1) then
!$OMP DO
@@ -1538,9 +1473,12 @@ subroutine concoutput_nest_netcdf(itime,outnum)
endif
! Concentrations
+! call nf90_err(nf90_put_var(ncid,specIDn(ks),grid(0:numxgridn-1,0:numygridn-1,&
+! 1:numzgrid)*factor3d(0:numxgridn-1,0:numygridn-1,1:numzgrid)/tot_mu(ks,kp),&
+! (/ 1,1,1,tpointer,kp,nage /), (/ numxgridn,numygridn,numzgrid,1,1,1 /)))
call nf90_err(nf90_put_var(ncid,specIDn(ks),grid(0:numxgridn-1,0:numygridn-1,&
- 1:numzgrid)*factor3d(0:numxgridn-1,0:numygridn-1,1:numzgrid)/tot_mu(ks,kp),&
- (/ 1,1,1,tpointer,kp,nage /), (/ numxgridn,numygridn,numzgrid,1,1,1 /)))
+ 1:numzwrite)*factor3d(0:numxgridn-1,0:numygridn-1,1:numzwrite)/tot_mu(ks,kp),&
+ (/ 1,1,1,tpointer,kp,nage /), (/ numxgridn,numygridn,numzwrite,1,1,1 /)))
endif ! concentration output
@@ -1564,11 +1502,16 @@ subroutine concoutput_nest_netcdf(itime,outnum)
endif
! Mixing ratios
+! call nf90_err(nf90_put_var(ncid,specIDnppt(ks),weightair/weightmolar(ks)*&
+! grid(0:numxgridn-1,0:numygridn-1,1:numzgrid)*&
+! factor3d(0:numxgridn-1,0:numygridn-1,1:numzgrid)/&
+! densityoutgrid(0:numxgridn-1,0:numygridn-1,1:numzgrid),&
+! (/ 1,1,1,tpointer,kp,nage /), (/ numxgridn,numygridn,numzgrid,1,1,1 /)))
call nf90_err(nf90_put_var(ncid,specIDnppt(ks),weightair/weightmolar(ks)*&
- grid(0:numxgridn-1,0:numygridn-1,1:numzgrid)*&
- factor3d(0:numxgridn-1,0:numygridn-1,1:numzgrid)/&
- densityoutgrid(0:numxgridn-1,0:numygridn-1,1:numzgrid),&
- (/ 1,1,1,tpointer,kp,nage /), (/ numxgridn,numygridn,numzgrid,1,1,1 /)))
+ grid(0:numxgridn-1,0:numygridn-1,1:numzwrite)*&
+ factor3d(0:numxgridn-1,0:numygridn-1,1:numzwrite)/&
+ densityoutgrid(0:numxgridn-1,0:numygridn-1,1:numzwrite),&
+ (/ 1,1,1,tpointer,kp,nage /), (/ numxgridn,numygridn,numzwrite,1,1,1 /)))
endif ! output for ppt
!$OMP END SINGLE
@@ -1585,8 +1528,8 @@ subroutine concoutput_nest_netcdf(itime,outnum)
! Reinitialization of grid
!*************************
- if (numreceptor.gt.0) creceptor(1:numreceptor,1:nspec) = 0.
griduncn(:,:,:,1:nspec,:,:,1:nageclass) = 0.
+
end subroutine concoutput_nest_netcdf
! subroutine concoutput_sfc_nest_netcdf(itime,outnum)
@@ -1887,9 +1830,10 @@ subroutine writeheader_partoutput(itime,idate,itime_start,idate_start)!,irelease
write(atime,'(i6.6)') itime
write(adate_start,'(i8.8)') idate_start
write(atime_start,'(i6.6)') itime_start
-
+
timeunit = 'seconds since '//adate_start(1:4)//'-'//adate_start(5:6)// &
- '-'//adate_start(7:8)//' '//atime_start(1:2)//':'//atime_start(3:4)
+ '-'//adate_start(7:8)//' '//atime_start(1:2)//':'//atime_start(3:4)
+
! write(arelease, '(i3.3)') irelease
fprefix_part = 'partoutput_'//adate//atime !rel'//arelease//'_'
@@ -1976,7 +1920,6 @@ subroutine writeheader_partoutput_dims(np,ncid,timeunit,timeDimID,partDimID,latD
integer,intent(out) :: latDimID, lonDimID
integer :: tID,partID
-
logical,save :: first_time=.true.
! create dimensions:
@@ -1997,13 +1940,11 @@ subroutine writeheader_partoutput_dims(np,ncid,timeunit,timeDimID,partDimID,latD
if (.not. lpartoutputperfield .and. (mdomainfill.eq.1)) then
call writeheader_partoutput_grid(ncid,lonDimID,latDimID)
endif
-
call nf90_err(nf90_def_dim(ncid, 'particle', nf90_unlimited, partDimID))
! particles variables
call nf90_err(nf90_def_var(ncid, 'particle', nf90_int, (/ partDimID/), partID))
call nf90_err(nf90_put_att(ncid, partID, 'long_name', 'particle index'))
endif
-
! create variables
!*************************
@@ -2031,7 +1972,6 @@ subroutine writeheader_partoutput_vars(np,ncid,totpart,timeDimID,partDimID,latDi
character(len=3) :: anspec
real :: fillval
-
fillval = -1.
select case(partopt(np)%name)
case ('LO') ! Longitude
@@ -2115,7 +2055,7 @@ subroutine writeheader_partoutput_vars(np,ncid,totpart,timeDimID,partDimID,latDi
call write_to_file(ncid,trim(partopt(np)%short_name),nf90_float,(/ timeDimID,partDimID /), &
varid,(/ 1,totpart /),'m/s',.false.,'settling_velocity_average','settling velocity averaged')
case ('MA') ! Mass
- if (mdomainfill.ge.1) then
+ if ((mdomainfill.ge.1).and.(nspec.eq.1)) then
call nf90_err(nf90_def_var(ncid=ncid, name=trim(partopt(np)%short_name), xtype=nf90_float, &
dimids=1, varid=varid))
call nf90_err(nf90_put_att(ncid, varid, 'units', 'kg'))
@@ -2129,11 +2069,11 @@ subroutine writeheader_partoutput_vars(np,ncid,totpart,timeDimID,partDimID,latDi
write(anspec, '(i3.3)') j
call write_to_file(ncid,trim(partopt(np)%short_name)//anspec,nf90_float, &
(/ timeDimID,partDimID /),varid, &
- (/ 1,totpart /),'kg',.true.,'mass'//anspec,'mass for nspec'//anspec)
+ (/ 1,totpart /),'kg',.true.,'mass'//anspec,'mass for nspec'//anspec)
end do
endif
case ('ma') ! Mass averaged
- if (mdomainfill.ge.1) then
+ if ((mdomainfill.ge.1).and.(nspec.eq.1)) then
call nf90_err(nf90_def_var(ncid=ncid, name=trim(partopt(np)%short_name), xtype=nf90_float, dimids=1, varid=varid))
call nf90_err(nf90_put_att(ncid, varid, 'units', 'kg'))
call nf90_err(nf90_put_att(ncid, varid, '_FillValue', fillval))
@@ -2387,6 +2327,7 @@ subroutine update_partoutput_pointers(itime,ncid)
end subroutine update_partoutput_pointers
subroutine partoutput_netcdf(itime,field,np,imass,ncid)
+
use particle_mod
!*****************************************************************************
@@ -2405,9 +2346,9 @@ subroutine partoutput_netcdf(itime,field,np,imass,ncid)
integer, intent(in) :: np ! input field to interpolate over
integer :: tempIDend
character(len=3) :: anspec
+
! ! open output file
! call nf90_err(nf90_open(trim(ncfname_part), nf90_write, ncid))
-
if ((mdomainfill.ge.1).and. ((partopt(np)%name.eq.'TO').or. &
(partopt(np)%name.eq.'HM').or.(partopt(np)%name.eq.'TR'))) then
if (partopt(np)%name.eq.'TO') then
@@ -2423,7 +2364,7 @@ subroutine partoutput_netcdf(itime,field,np,imass,ncid)
endif
else if (partopt(np)%name.eq.'MA') then
- if ((mdomainfill.ge.1).and.(imass.eq.1)) then
+ if ((mdomainfill.ge.1).and.(imass.eq.1).and.(nspec.eq.1)) then
if (mass_written.eqv..false.) then
call nf90_err(nf90_inq_varid(ncid=ncid,name=trim(partopt(np)%short_name),varid=tempIDend))
call nf90_err(nf90_put_var(ncid=ncid,varid=tempIDend,values=field(1)))
@@ -2435,7 +2376,7 @@ subroutine partoutput_netcdf(itime,field,np,imass,ncid)
call nf90_err(nf90_put_var(ncid,tempIDend,field, (/ tpointer_part,1 /),(/ 1,count%allocated /)))
endif
else if (partopt(np)%name.eq.'ma') then
- if ((mdomainfill.ge.1).and.(imass.eq.1)) then
+ if ((mdomainfill.ge.1).and.(imass.eq.1).and.(nspec.eq.1)) then
if (mass_written.eqv..false.) then
call nf90_err(nf90_inq_varid(ncid=ncid,name=trim(partopt(np)%short_name),varid=tempIDend))
call nf90_err(nf90_put_var(ncid,tempIDend,field, (/ tpointer_part,1 /),(/ 1,count%allocated /)))
@@ -2495,7 +2436,7 @@ subroutine readpartpositions_netcdf(ibtime,ibdate)
endif
! Open partoutput_end.nc file
- call nf90_err(nf90_open(trim('partoutput_end.nc'), mode=NF90_NOWRITE,ncid=ncidend))
+ call nf90_err(nf90_open(path(2)(1:length(2))//trim('partoutput_end.nc'), mode=NF90_NOWRITE,ncid=ncidend))
! Take the positions of the particles at the last timestep in the file
! It needs to be the same as given in the COMMAND file, this is arbitrary
@@ -2526,6 +2467,9 @@ subroutine readpartpositions_netcdf(ibtime,ibdate)
error stop
endif
+ !! testing
+! print*, 'readpartpositions_netcdf: julin, julcommand = ',julin, julcommand
+
! Then the particle dimension
call nf90_err(nf90_inq_dimid(ncid=ncidend,name='particle',dimid=pIDend))
call nf90_err(nf90_inquire_dimension(ncid=ncidend,dimid=pIDend,len=plen))
@@ -2536,26 +2480,26 @@ subroutine readpartpositions_netcdf(ibtime,ibdate)
! And give them the correct positions
! Longitude
- call nf90_err(nf90_inq_varid(ncid=ncidend,name='longitude',varid=tempIDend))
+ call nf90_err(nf90_inq_varid(ncid=ncidend,name='lon',varid=tempIDend))
call nf90_err(nf90_get_var(ncid=ncidend,varid=tempIDend,values=part(:)%xlon, &
start=(/ tlen, 1 /),count=(/ 1, plen /)))
part(:)%xlon=(part(:)%xlon-xlon0)/dx
! Latitude
- call nf90_err(nf90_inq_varid(ncid=ncidend,name='latitude',varid=tempIDend))
+ call nf90_err(nf90_inq_varid(ncid=ncidend,name='lat',varid=tempIDend))
call nf90_err(nf90_get_var(ncid=ncidend,varid=tempIDend,values=part(:)%ylat, &
start=(/ tlen, 1 /),count=(/ 1, plen /)))
part(:)%ylat=(part(:)%ylat-ylat0)/dx
! Height
- call nf90_err(nf90_inq_varid(ncid=ncidend,name='height',varid=tempIDend))
+ call nf90_err(nf90_inq_varid(ncid=ncidend,name='z',varid=tempIDend))
call nf90_err(nf90_get_var(ncid=ncidend,varid=tempIDend,values=part(:)%z, &
start=(/ tlen, 1 /),count=(/ 1, plen /)))
! Mass
! allocate(mass_temp(count%allocated), stat=stat)
! if (stat.ne.0) error stop "Could not allocate mass_temp"
- if (mdomainfill.eq.0) then
+ if ((mdomainfill.eq.0).or.(nspec.gt.1)) then
do j=1,nspec
write(anspec, '(i3.3)') j
- call nf90_err(nf90_inq_varid(ncid=ncidend,name='mass'//anspec,varid=tempIDend))
+ call nf90_err(nf90_inq_varid(ncid=ncidend,name='m'//anspec,varid=tempIDend))
call nf90_err(nf90_get_var(ncid=ncidend,varid=tempIDend,values=mass(:,j), &
start=(/ tlen, 1 /),count=(/ 1, plen /)))
! do i=1,count%allocated
@@ -2569,7 +2513,9 @@ subroutine readpartpositions_netcdf(ibtime,ibdate)
do i=1,plen
if (part(i)%z.lt.0) then
call terminate_particle(i,0)
- write(*,*) 'Particle ',i,'is not alive in the restart file.'
+ if (mdomainfill.eq.0) then
+ write(*,*) 'Particle ',i,'is not alive in the restart file.'
+ endif
iterminate=iterminate+1
endif
part(i)%nclass=min(int(ran1(idummy,0)*real(nclassunc))+1, &
@@ -2582,6 +2528,11 @@ subroutine readpartpositions_netcdf(ibtime,ibdate)
call nf90_err(nf90_close(ncidend))
+ !! testing
+! print*, 'readpartpositions_netcdf: number alive = ',count%alive
+! print*, 'readpartpositions_netcdf: range(part%z) = ',minval(part(1:count%alive)%z),maxval(part(1:count%alive)%z)
+! print*, 'readpartpositions_netcdf: part(1)%tstart = ',part(1)%tstart
+
end subroutine readpartpositions_netcdf
subroutine readinitconditions_netcdf()
@@ -2651,7 +2602,7 @@ subroutine readinitconditions_netcdf()
DEP=.false.
DRYDEP=.false.
WETDEP=.false.
- OHREA=.false.
+ CLREA=.false.
do nsp=1,maxspec
DRYDEPSPEC(nsp)=.false.
WETDEPSPEC(nsp)=.false.
@@ -2738,9 +2689,9 @@ subroutine readinitconditions_netcdf()
if (lroot) write (*,*) ' In-cloud scavenging: OFF'
endif
- if (ohcconst(nsp).gt.0.) then
- OHREA=.true.
- if (lroot) write (*,*) ' OHreaction switched on: ',ohcconst(nsp),nsp
+ if (any(reaccconst(:,:).gt.0.)) then
+ CLREA=.true.
+ if (lroot) write (*,*) ' Chemical reactions switched on'
endif
if ((reldiff(nsp).gt.0.).or.(density(nsp).gt.0.).or.(dryvel(nsp).gt.0.)) then
@@ -2836,7 +2787,7 @@ subroutine readinitconditions_netcdf()
endif
lstart=.false.
endif
- part(i)%tstart = part(i)%tstart*-1
+ part(i)%tstart = part(i)%tstart*(-1)
endif
end do
! Release
diff --git a/src/ohr_mod.f90 b/src/ohr_mod.f90
deleted file mode 100644
index 491322dd041cdc32752fae979fadb39b9c347e00..0000000000000000000000000000000000000000
--- a/src/ohr_mod.f90
+++ /dev/null
@@ -1,452 +0,0 @@
-! SPDX-FileCopyrightText: FLEXPART 1998-2019, see flexpart_license.txt
-! SPDX-License-Identifier: GPL-3.0-or-later
-
-module ohr_mod
-
- !includes OH concentration field as well as the height information
- !for this field
- use date_mod
-
- implicit none
-
- integer :: nxOH,nyOH,nzOH
- real, allocatable, dimension(:) :: lonOH,latOH,altOH
- real, allocatable, dimension(:,:,:,:) :: OH_hourly
- real, allocatable, dimension (:,:,:,:) :: OH_field
- real, dimension(2) :: memOHtime
- real, dimension(360,180,12) :: jrate_average
- real, dimension(360) :: lonjr
- real, dimension(180) :: latjr
-
-contains
-
-real function photo_O1D(sza)
-
- !*****************************************************************************
- ! *
- ! *
- ! Author: A. Stohl *
- ! *
- ! Nov 2014 *
- ! *
- ! *
- !*****************************************************************************
- ! *
- ! INPUT: *
- ! sza solar zenith angle (degrees) *
- ! *
- ! OUTPUT: *
- ! photo_O1D J(O1D) photoylsis rate *
- ! *
- !*****************************************************************************
-
- implicit none
-
- integer :: iz,ik
- real :: sza
- real :: z1,z2,zg,f1,f2,dummy
- real :: photo_NO2
- integer, parameter :: nzenith=11
- real, parameter :: pi=3.1415927
- real, dimension(nzenith) :: zangle,fact_photo
-
- ! zangle: zenith angles for which fact_photo is tabulated
- ! fact_photo: conversion of photolysis rate of NO2 to photolysis
- ! rate of O3 into O1D as a function of solar zenith angle
-
- zangle=(/0.,10.,20.,30.,40.,50.,60.,70.,78.,86.,90.0001/)
- fact_photo=(/0.4616E-02,0.4478E-02,0.4131E-02,0.3583E-02,0.2867E-02,&
- &0.2081E-02,0.1235E-02,0.5392E-03,0.2200E-03,0.1302E-03,0.0902E-03/)
-
- if (sza.lt.90.) then
- do iz=1,nzenith-1
- if(sza.ge.zangle(iz)) ik=iz
- end do
- z1=1./cos(zangle(ik)*pi/180.)
- z2=1./cos(zangle(ik+1)*pi/180.)
- zg=1./cos(sza*pi/180.)
- dummy=(zg-z1)/(z2-z1)
- f1=alog(fact_photo(ik))
- f2=alog(fact_photo(ik+1))
- photo_NO2=1.45e-2*exp(-0.4/cos(sza*pi/180.))
- photo_O1D=photo_NO2*exp(f1+(f2-f1)*dummy)
- else
- photo_O1D=0.
- endif
-
- return
-
-end function photo_O1D
-
-real function zenithangle(ylat,xlon,jul)
-
- !*********************************************************************
- ! *
- ! Author: G. WOTAWA *
- ! Date: 1993-11-17 *
- ! Project: POP-M *
- ! Last update: *
- ! *
- !*********************************************************************
- ! *
- ! DESCRIPTION: This function returns the sinus of solar *
- ! elevation as a function of geographic longitude, *
- ! latitude and GMT-Time. *
- ! *
- !*********************************************************************
- ! *
- ! INPUT: *
- ! *
- ! ylat geographical latitude [DEG] *
- ! xlon geographical longitude [DEG] *
- ! jjjj Year *
- ! mm Month *
- ! dd Day *
- ! hh Hour *
- ! minute Minute *
- ! *
- !*********************************************************************
-
- use par_mod, only: dp
-
- implicit none
-
- integer :: jjjj,mm,id,iu,minute,yyyymmdd,hhmmss
- integer :: ndaynum
- real :: sinsol,solelev,ylat,xlon
- real :: rnum,rylat,ttime,dekl,rdekl,eq
- real,parameter :: pi=3.1415927
- real(kind=dp) :: jul
-
- call caldate(jul,yyyymmdd,hhmmss)
- jjjj=yyyymmdd/10000
- mm=yyyymmdd/100-jjjj*100
- id=yyyymmdd-jjjj*10000-mm*100
- iu=hhmmss/10000
- minute=hhmmss/100-100*iu
-
- ndaynum=31*(mm-1)+id
- if(mm.gt.2) ndaynum=ndaynum-int(0.4*mm+2.3)
- if((mm.gt.2).and.(jjjj/4*4.eq.jjjj)) ndaynum=ndaynum+1
-
- rnum=2.*pi*ndaynum/365.
- rylat=pi*ylat/180.
- ttime=real(iu)+real(minute)/60.
-
- dekl=0.396+3.631*sin(rnum)+0.038*sin(2.*rnum)+0.077*sin(3.*rnum)- &
- 22.97*cos(rnum)-0.389*cos(2.*rnum)-0.158*cos(3.*rnum)
- rdekl=pi*dekl/180.
-
- eq=(0.003-7.343*sin(rnum)-9.47*sin(2.*rnum)- &
- 0.329*sin(3.*rnum)-0.196*sin(4.*rnum)+ &
- 0.552*cos(rnum)-3.020*cos(2.*rnum)- &
- 0.076*cos(3.*rnum)-0.125*cos(4.*rnum))/60.
-
- sinsol=sin(rylat)*sin(rdekl)+cos(rylat)*cos(rdekl)* &
- cos((ttime-12.+xlon/15.+eq)*pi/12.)
- ! Calculate the maximum solar elevation on that day
- !sinsol=sin(rylat)*sin(rdekl)+cos(rylat)*cos(rdekl)*
- ! & cos((eq)*pi/12.)
- solelev=asin(sinsol)*180./pi
- zenithangle=90.-solelev
-
- return
-end function zenithangle
-
-subroutine ohreaction(itime,ltsample,loutnext)
- ! i i i
- !*****************************************************************************
- ! *
- ! *
- ! Author: R.L. Thompson *
- ! *
- ! Nov 2014 *
- ! *
- ! *
- !*****************************************************************************
- ! Variables: *
- ! ix,jy indices of output grid cell for each particle *
- ! itime [s] actual simulation time [s] *
- ! jpart particle index *
- ! ldeltat [s] interval since radioactive decay was computed *
- ! loutnext [s] time for which gridded deposition is next output *
- ! loutstep [s] interval at which gridded deposition is output *
- ! oh_average [molecule/cm^3] OH Concentration *
- ! ltsample [s] interval over which mass is deposited *
- ! *
- !*****************************************************************************
- use par_mod
- use com_mod
- use windfields_mod
- use particle_mod
-
- implicit none
-
- integer :: ii,jpart,itime,ltsample,loutnext,ldeltat,j,k,ix,jy!,ijx,jjy
-!PS integer :: ngrid,interp_time,m,n,ih,indz,i!,ia,il
- integer :: ngrid,interp_time,n,indz,i!,ia,il
-!PS integer :: jjjjmmdd,hhmmss,
- integer OHx,OHy,OHz
- real, dimension(nzOH) :: altOHtop
- real :: xlon,ylat
- real :: xtn,ytn
- real :: restmass,ohreacted,oh_average
- real :: ohrate,temp
- real, parameter :: smallnum = tiny(0.0) ! smallest number that can be handled
-
- ! Compute interval since radioactive decay of deposited mass was computed
- !************************************************************************
-
- if (itime.le.loutnext) then
- ldeltat=itime-(loutnext-loutstep)
- else ! first half of next interval
- ldeltat=itime-loutnext
- endif
-
-!PS jul=bdate+real(itime,kind=dp)/86400.
-!PS call caldate(jul,jjjjmmdd,hhmmss)
-!PS m=(jjjjmmdd-(jjjjmmdd/10000)*10000)/100
-!PS h=hhmmss/10000
-
- ! Loop over particles
- !*****************************************
-!$OMP PARALLEL PRIVATE(jpart,xtn,ytn,j,k,ix,jy,interp_time, &
-!$OMP n,indz,i,xlon,ylat,OHx,OHy,OHz,oh_average,temp,ohrate, &
-!$OMP restmass,ohreacted,altOHtop,ngrid)
-
-!$OMP DO
- do ii=1,count%alive
-
- jpart=count%ialive(ii)
- ! Determine which nesting level to be used
- ngrid=0
- do j=numbnests,1,-1 ! Why is there a +/- eps everywhere else for ngrid but not here?
- if ((part(jpart)%xlon.gt.xln(j)).and.(part(jpart)%xlon.lt.xrn(j)).and. &
- (part(jpart)%ylat.gt.yln(j)).and.(part(jpart)%ylat.lt.yrn(j))) then
- ngrid=j
- exit
- endif
- end do
-
- ! Determine nested grid coordinates
- if (ngrid.gt.0) then
- xtn=(real(part(jpart)%xlon)-xln(ngrid))*xresoln(ngrid)
- ytn=(real(part(jpart)%ylat)-yln(ngrid))*yresoln(ngrid)
- ix=int(xtn)
- jy=int(ytn)
- else
- ix=int(part(jpart)%xlon)
- jy=int(part(jpart)%ylat)
- endif
-
- interp_time=nint(itime-0.5*ltsample)
- n=2
- if(abs(memtime(1)-interp_time).lt.abs(memtime(2)-interp_time)) n=1
-
- indz=nz-1
- do i=2,nz
- if (height(i).gt.part(jpart)%z) then
- indz=i-1
- exit
- endif
- end do
-
- ! Get OH from nearest grid-cell and specific month
- !*************************************************
-
- ! world coordinates
- xlon=real(part(jpart)%xlon)*dx+xlon0
- if (xlon.gt.180) then
- xlon=xlon-360
- endif
- ylat=real(part(jpart)%ylat)*dy+ylat0
-
- ! get position in the OH field
- OHx=minloc(abs(lonOH-xlon),dim=1,mask=abs(lonOH-xlon).eq.minval(abs(lonOH-xlon)))
- OHy=minloc(abs(latOH-ylat),dim=1,mask=abs(latOH-ylat).eq.minval(abs(latOH-ylat)))
-
- ! get the level of the OH field for the particle
- ! z is the z-coord of the trajectory above model orography in metres
- ! altOH is the height of the centre of the level in the OH field above orography
- do i=2,nzOH
- altOHtop(i-1)=altOH(i)+0.5*(altOH(i)-altOH(i-1))
- end do
- altOHtop(nzOH)=altOH(nzOH)+0.5*(altOH(nzOH)-altOH(nzOH-1))
- OHz=minloc(abs(altOHtop-part(jpart)%z),dim=1,mask=abs(altOHtop-part(jpart)%z) &
- .eq.minval(abs(altOHtop-part(jpart)%z)))
-
- ! Interpolate between hourly OH fields to current time
- !*****************************************************
-
- oh_average=OH_hourly(OHx,OHy,OHz,1)+ &
- (OH_hourly(OHx,OHy,OHz,2)-OH_hourly(OHx,OHy,OHz,1))* &
- (itime-memOHtime(1))/(memOHtime(2)-memOHtime(1))
-
- if (oh_average.gt.smallnum) then
-
- ! Computation of the OH reaction
- !**********************************************************
-
- temp=tt(ix,jy,indz,n)
-
- do k=1,nspec
- if (ohcconst(k).gt.0.) then
- ohrate=ohcconst(k)*temp**ohnconst(k)*exp(-ohdconst(k)/temp)*oh_average
- ! new particle mass
- restmass = mass(jpart,k)*exp(-1*ohrate*abs(ltsample))
- if (restmass .gt. smallnum) then
- mass(jpart,k)=restmass
- else
- mass(jpart,k)=0.
- endif
- ohreacted=mass(jpart,k)*(1-exp(-1*ohrate*abs(ltsample)))
- if (jpart.eq.1) write(*,*) 'ohreaction', mass(jpart,k),k
- else
- ohreacted=0.
- endif
- end do
- endif ! oh_average.gt.smallnum
-
- end do !continue loop over all particles
-
-!$OMP END DO
-!$OMP END PARALLEL
-end subroutine ohreaction
-
-subroutine gethourlyOH(itime)
- ! i
- !*****************************************************************************
- ! *
- ! *
- ! Author: R.L. Thompson *
- ! *
- ! Nov 2014 *
- ! *
- ! *
- !*****************************************************************************
- ! Variables: *
- ! *
- !*****************************************************************************
- use par_mod
- use com_mod
-
- implicit none
-
- integer :: itime
- integer :: ix,jy,kz,m1,m2
- integer :: ijx,jjy
- integer :: jjjjmmdd,hhmmss
- real :: sza,jrate
- real(kind=dp) :: jul1,jul2
-
-
- ! Check hourly OH field is available for the current time step
- !**************************************************************
-
- if ((ldirect*memOHtime(1).le.ldirect*itime).and. &
- (ldirect*memOHtime(2).gt.ldirect*itime)) then
-
- ! The right OH fields are already in memory -> don't do anything
- !****************************************************************
-
- return
-
- else if ((ldirect*memOHtime(2).le.ldirect*itime).and. &
- (memOHtime(2).ne.0.)) then
-
- ! Current time is after 2nd OH field
- !************************************
-
- memOHtime(1)=memOHtime(2)
- memOHtime(2)=memOHtime(1)+ldirect*3600.
- OH_hourly(:,:,:,1)=OH_hourly(:,:,:,2)
-
- ! Compute new hourly value of OH
- !**********************************************************
-
- jul2=bdate+memOHtime(2)/86400._dp ! date for next hour
- call caldate(jul2,jjjjmmdd,hhmmss)
- m2=(jjjjmmdd-(jjjjmmdd/10000)*10000)/100
-
-!$OMP PARALLEL PRIVATE(kz,jy,ix,ijx,jjy,sza,jrate)
-!$OMP DO COLLAPSE(3)
- do kz=1,nzOH
- do jy=1,nyOH
- do ix=1,nxOH
- ijx=minloc(abs(lonjr-lonOH(ix)),dim=1,mask=abs(lonjr-lonOH(ix)).eq.minval(abs(lonjr-lonOH(ix))))
- jjy=minloc(abs(latjr-latOH(jy)),dim=1,mask=abs(latjr-latOH(jy)).eq.minval(abs(latjr-latOH(jy))))
- ! calculate solar zenith angle in degrees (sza)
- sza=zenithangle(latOH(jy),lonOH(ix),jul2)
- ! calculate J(O1D) (jrate)
- jrate=photo_O1D(sza)
- ! apply hourly correction to OH
- if(jrate_average(ijx,jjy,m2).gt.0.) then
- OH_hourly(ix,jy,kz,2)=OH_field(ix,jy,kz,m2)*jrate/jrate_average(ijx,jjy,m2)
- else
- OH_hourly(ix,jy,kz,2)=0.
- endif
- !! for testing !!
- ! if(jy.eq.36.and.ix.eq.36.and.kz.eq.1) then
- ! write(999,fmt='(F6.3)') jrate/jrate_average(ijx,jjy,m2)
- ! endif
- ! if(jy.eq.11.and.ix.eq.36.and.kz.eq.1) then
- ! write(998,fmt='(F6.3)') jrate/jrate_average(ijx,jjy,m2)
- ! endif
- end do
- end do
- end do
-!$OMP END DO
-!$OMP END PARALLEL
-
- else
-
- ! No OH fields in memory -> compute both hourly OH fields
- !**********************************************************
-
- jul1=bdate ! begin date of simulation (julian)
- call caldate(jul1,jjjjmmdd,hhmmss)
- m1=(jjjjmmdd-(jjjjmmdd/10000)*10000)/100
- memOHtime(1)=0.
-
- jul2=bdate+ldirect*real(1./24.,kind=dp) ! date for next hour
- call caldate(jul2,jjjjmmdd,hhmmss)
- m2=(jjjjmmdd-(jjjjmmdd/10000)*10000)/100
- memOHtime(2)=ldirect*3600.
-
-!$OMP PARALLEL PRIVATE(kz,jy,ix,ijx,jjy,sza,jrate)
-!$OMP DO COLLAPSE(3)
- do kz=1,nzOH
- do jy=1,nyOH
- do ix=1,nxOH
- ijx=minloc(abs(lonjr-lonOH(ix)),dim=1,mask=abs(lonjr-lonOH(ix)).eq.minval(abs(lonjr-lonOH(ix))))
- jjy=minloc(abs(latjr-latOH(jy)),dim=1,mask=abs(latjr-latOH(jy)).eq.minval(abs(latjr-latOH(jy))))
- ! calculate solar zenith angle in degrees (sza), beginning
- sza=zenithangle(latOH(jy),lonOH(ix),jul1)
- ! calculate J(O1D) (jrate), beginning
- jrate=photo_O1D(sza)
- ! apply hourly correction to OH
- if(jrate_average(ijx,jjy,m1).gt.0.) then
- OH_hourly(ix,jy,kz,1)=OH_field(ix,jy,kz,m1)*jrate/jrate_average(ijx,jjy,m1)
- else
- OH_hourly(ix,jy,kz,1)=0.
- endif
- ! calculate solar zenith angle in degrees (sza), after 1-hour
- sza=zenithangle(latOH(jy),lonOH(ix),jul2)
- ! calculate J(O1D) (jrate), after 1-hour
- jrate=photo_O1D(sza)
- ! apply hourly correction to OH
- if(jrate_average(ijx,jjy,m2).gt.0.) then
- OH_hourly(ix,jy,kz,2)=OH_field(ix,jy,kz,m2)*jrate/jrate_average(ijx,jjy,m2)
- else
- OH_hourly(ix,jy,kz,2)=0.
- endif
- end do
- end do
- end do
-!$OMP END DO
-!$OMP END PARALLEL
-
- endif
-end subroutine gethourlyOH
-
-end module ohr_mod
diff --git a/src/outgrid_mod.f90 b/src/outgrid_mod.f90
index 77e899dd674a5cd563c3a0a4d2628ae3a1f1a27a..97138884050729ef12d3fac1009277e4e6b0d6b4 100644
--- a/src/outgrid_mod.f90
+++ b/src/outgrid_mod.f90
@@ -164,7 +164,7 @@ subroutine outgrid_init
! *
!*****************************************************************************
- use ohr_mod
+! use ohr_mod
use unc_mod
use windfields_mod, only: nxmax
implicit none
@@ -322,60 +322,42 @@ subroutine outgrid_init
! Initialize output grids
!************************
- do ks=1,nspec
- do kp=1,maxpointspec_act
- if ((numreceptor.gt.0).and.(ipin.ne.1).and.(ipin.ne.4)) then
- do i=1,numreceptor
- ! Receptor points
- creceptor(i,ks)=0.
- end do
- endif
- do nage=1,nageclass
- do jy=0,numygrid-1
- do ix=0,numxgrid-1
- do kz=1,numzgrid
- if (iflux.eq.1) then
! Flux fields
- do i=1,5
- if ((ipin.ne.1).and.(ipin.ne.4)) flux(i,ix,jy,kz,ks,kp,nage)=0.
+ if (iflux.eq.1) then
+ do i=1,5
+ if ((ipin.ne.1).and.(ipin.ne.4)) flux(i,:,:,:,:,:,:)=0.
#ifdef _OPENMP
- flux_omp(i,ix,jy,kz,ks,kp,nage,:)=0.
+ flux_omp(i,:,:,:,:,:,:,:)=0.
#endif
- end do
- endif
+ end do
+ endif
! Initial condition field
- if ((nage.eq.1).and.(linit_cond.gt.0)) then
- if ((ipin.ne.1).and.(ipin.ne.4)) init_cond(ix,jy,kz,ks,kp)=0.
+ if ((nage.eq.1).and.(linit_cond.gt.0)) then
+ if ((ipin.ne.1).and.(ipin.ne.4)) init_cond(:,:,:,:,:)=0.
#ifdef _OPENMP
- init_cond_omp(ix,jy,kz,ks,kp,:)=0.
+ init_cond_omp(:,:,:,:,:,:)=0.
#endif
- endif
- end do
- do l=1,nclassunc
- ! Deposition fields
- if (ldirect.gt.0) then
- if ((ipin.ne.1).and.(ipin.ne.4)) then
- wetgridunc(ix,jy,ks,kp,l,nage)=0.
- drygridunc(ix,jy,ks,kp,l,nage)=0.
- endif
+ endif
+ ! Deposition fields
+ if (ldirect.gt.0) then
+ if ((ipin.ne.1).and.(ipin.ne.4)) then
+ wetgridunc(:,:,:,:,:,:)=0.
+ drygridunc(:,:,:,:,:,:)=0.
+ endif
#ifdef _OPENMP
- wetgridunc_omp(ix,jy,ks,kp,l,nage,:)=0.
- drygridunc_omp(ix,jy,ks,kp,l,nage,:)=0.
+ wetgridunc_omp(:,:,:,:,:,:,:)=0.
+ drygridunc_omp(:,:,:,:,:,:,:)=0.
#endif
- endif
- do kz=1,numzgrid
- ! Concentration fields
- if ((ipin.ne.1).and.(ipin.ne.4)) gridunc(ix,jy,kz,ks,kp,l,nage)=0.
+ endif
+ ! Concentration fields
+ if ((ipin.ne.1).and.(ipin.ne.4)) gridunc(:,:,:,:,:,:,:)=0.
+ ! Weighting for LCM output
+ gridcnt(:,:,:)=0.
#ifdef _OPENMP
- gridunc_omp(ix,jy,kz,ks,kp,l,nage,:)=0.
+ gridunc_omp(:,:,:,:,:,:,:,:)=0.
+ gridcnt_omp(:,:,:,:)=0.
#endif
- end do
- end do
- end do
- end do
- end do
- end do
- end do
+
end subroutine outgrid_init
subroutine outgrid_init_nest
diff --git a/src/output_mod.f90 b/src/output_mod.f90
index ebb1bb75f8ec11370d118a863a6646a6a79ae9ae..b8680cf20b99bf9dcaca1b6faa4e45a6f5575e77 100644
--- a/src/output_mod.f90
+++ b/src/output_mod.f90
@@ -209,7 +209,6 @@ subroutine output_particles(itime,initial_output)
init_out=.false.
endif
-
!$OMP PARALLEL PRIVATE(i,j,m,tmp,ns,i_av,cartxyz_comp,cartxyz,np,lskip)
! Some variables needed for temporal interpolation
!*************************************************
@@ -368,7 +367,6 @@ subroutine output_particles(itime,initial_output)
!$OMP END DO
!$OMP END PARALLEL
-
if ((.not. init_out).and.(numpart.gt.0)) then
do np=1,num_partopt
if (.not. partopt(np)%print) cycle
@@ -402,6 +400,7 @@ subroutine output_particles(itime,initial_output)
else
if (.not. lpartoutputperfield) then
call open_partoutput_file(ncid)
+
! First allocate the time and particle dimensions within the netcdf file
else
do np=1,num_partopt
@@ -409,6 +408,7 @@ subroutine output_particles(itime,initial_output)
call open_partoutput_file(partopt(np)%ncid,np)
end do
endif
+
call update_partoutput_pointers(itime, ncid)
!ppointer_part = count%allocated
endif
@@ -539,7 +539,8 @@ subroutine output_conc(itime,loutstart,loutend,loutnext,outnum)
! If necessary, first sample of new grid is also taken
!*****************************************************
if ((iout.le.3.).or.(iout.eq.5)) then
- if (sfc_only.ne.1) then
+ if (linversionout.eq.0) then
+ ! regular output format
if (lnetcdfout.eq.1) then
#ifdef USE_NCF
call concoutput_netcdf(itime,outnum,gridtotalunc,wetgridtotalunc,drygridtotalunc)
@@ -548,39 +549,32 @@ subroutine output_conc(itime,loutstart,loutend,loutnext,outnum)
call concoutput(itime,outnum,gridtotalunc,wetgridtotalunc,drygridtotalunc)
endif
else
+ ! inversion output - one file each release
if (lnetcdfout.eq.1) then
-#ifdef USE_NCF
- ! call concoutput_sfc_netcdf(itime,outnum,gridtotalunc,wetgridtotalunc,drygridtotalunc)
- error stop 'Netcdf output for surface only not yet implemented'
-#endif
+ write(*,*) 'FLEXPART ERROR: netcdf output not avaiable yet for inversion format'
+ error stop
else
- if (linversionout.eq.1) then
- call concoutput_inversion(itime,outnum,gridtotalunc,wetgridtotalunc,drygridtotalunc)
- else
- call concoutput_sfc(itime,outnum,gridtotalunc,wetgridtotalunc,drygridtotalunc)
- endif
+ call concoutput_inversion(itime,outnum,gridtotalunc,wetgridtotalunc,drygridtotalunc)
endif
endif
if (nested_output .eq. 1) then
- if (lnetcdfout.eq.1) then
+ if (linversionout.eq.0) then
+ ! regular output format
+ if (lnetcdfout.eq.1) then
#ifdef USE_NCF
- if (sfc_only.ne.1) then
call concoutput_nest_netcdf(itime,outnum)
+#endif
else
- error stop 'Netcdf output for surface only not yet implemented'
- !call concoutput_sfc_nest_netcdf(itime,outnum)
+ call concoutput_nest(itime,outnum)
endif
-#endif
else
- if (sfc_only.ne.1) then
- call concoutput_nest(itime,outnum)
- else
- if(linversionout.eq.1) then
- call concoutput_inversion_nest(itime,outnum)
- else
- call concoutput_sfc_nest(itime,outnum)
- endif
+ ! inversion output
+ if (lnetcdfout.eq.1) then
+ write(*,*) 'FLEXPART ERROR: netcdf output not avaiable yet for inversion format'
+ error stop
+ else
+ call concoutput_inversion_nest(itime,outnum)
endif
endif
endif
@@ -686,9 +680,9 @@ subroutine conccalc(itime,weight)
! if (xscav_frac1(i,1).lt.0) xscav_count=xscav_count+1
+ !************************************************************************
! For special runs, interpolate the air density to the particle position
!************************************************************************
- !***********************************************************************
!AF IND_SOURCE switches between different units for concentrations at the source
!Af NOTE that in backward simulations the release of particles takes place
!Af at the receptor and the sampling at the source.
@@ -697,12 +691,11 @@ subroutine conccalc(itime,weight)
!Af IND_RECEPTOR switches between different units for concentrations at the receptor
!Af 1="mass"
!Af 2="mass mixing ratio"
-
!Af switches for the conccalcfile:
!AF IND_SAMP = 0 : xmass * 1
!Af IND_SAMP = -1 : xmass / rho
-
!Af ind_samp is defined in readcommand.f
+ !************************************************************************
if ( ind_samp .eq. -1 ) then
#ifdef ETA
@@ -716,8 +709,6 @@ subroutine conccalc(itime,weight)
!****************************************************************************
! 1. Evaluate grid concentrations using a uniform kernel of bandwidths dx, dy
!****************************************************************************
-
-
! For backward simulations, look from which release point the particle comes from
! For domain-filling trajectory option, npoint contains a consecutive particle
! number, not the release point information. Therefore, nrelpointer is set to 1
@@ -787,17 +778,38 @@ subroutine conccalc(itime,weight)
#endif
end do
else
- do ks=1,nspec
+ if (llcmoutput) then
+ ! special case LCM output use mass ratio species to airtracer
+ ! species 1 is always airtracer
+ do ks=2,nspec
#ifdef _OPENMP
- gridunc_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
- gridunc_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ &
- mass(i,ks)/rhoi*weight
+ gridunc_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
+ gridunc_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ &
+ mass(i,ks)/mass(i,1)*weight
#else
- gridunc(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)= &
- gridunc(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)+ &
- mass(i,ks)/rhoi*weight
+ gridunc(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)= &
+ gridunc(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)+ &
+ mass(i,ks)/mass(i,1)*weight
#endif
- end do
+ end do
+#ifdef _OPENMP
+ gridcnt_omp(ix,jy,kz,thread)=gridcnt_omp(ix,jy,kz,thread)+weight
+#else
+ gridcnt(ix,jy,kz)=gridcnt(ix,jy,kz)+weight
+#endif
+ else
+ do ks=1,nspec
+#ifdef _OPENMP
+ gridunc_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
+ gridunc_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ &
+ mass(i,ks)/rhoi*weight
+#else
+ gridunc(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)= &
+ gridunc(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)+ &
+ mass(i,ks)/rhoi*weight
+#endif
+ end do
+ end if ! llcmoutput
end if
endif
endif
@@ -841,17 +853,38 @@ subroutine conccalc(itime,weight)
#endif
end do
else
- do ks=1,nspec
+ if (llcmoutput) then
+ ! special case CTM output use mass ratio species to airtracer
+ ! species 1 is always airtracer
+ do ks=2,nspec
#ifdef _OPENMP
- gridunc_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
- gridunc_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ &
- mass(i,ks)/rhoi*weight*w
+ gridunc_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
+ gridunc_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ &
+ mass(i,ks)/mass(i,1)*weight*w
#else
- gridunc(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)= &
- gridunc(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)+ &
- mass(i,ks)/rhoi*weight*w
+ gridunc(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)= &
+ gridunc(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)+ &
+ mass(i,ks)/mass(i,1)*weight*w
#endif
- end do
+ end do
+#ifdef _OPENMP
+ gridcnt_omp(ix,jy,kz,thread)=gridcnt_omp(ix,jy,kz,thread)+w*weight
+#else
+ gridcnt(ix,jy,kz)=gridcnt(ix,jy,kz)+w*weight
+#endif
+ else
+ do ks=1,nspec
+#ifdef _OPENMP
+ gridunc_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
+ gridunc_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ &
+ mass(i,ks)/rhoi*weight*w
+#else
+ gridunc(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)= &
+ gridunc(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)+ &
+ mass(i,ks)/rhoi*weight*w
+#endif
+ end do
+ endif ! llcmoutput
endif
endif
@@ -868,20 +901,41 @@ subroutine conccalc(itime,weight)
gridunc(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)+ &
mass(i,ks)/rhoi*weight*w*max(xscav_frac1(i,ks),0.0)
#endif
- end do
- else
- do ks=1,nspec
+ end do
+ else
+ if (llcmoutput) then
+ ! special case CTM output use mass ratio species to airtracer
+ ! species 1 is always airtracer
+ do ks=2,nspec
#ifdef _OPENMP
- gridunc_omp(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
- gridunc_omp(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ &
- mass(i,ks)/rhoi*weight*w
+ gridunc_omp(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
+ gridunc_omp(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ &
+ mass(i,ks)/mass(i,1)*weight*w
#else
- gridunc(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)= &
- gridunc(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)+ &
- mass(i,ks)/rhoi*weight*w
+ gridunc(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)= &
+ gridunc(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)+ &
+ mass(i,ks)/mass(i,1)*weight*w
#endif
- end do
- endif
+ end do
+#ifdef _OPENMP
+ gridcnt_omp(ix,jyp,kz,thread)=gridcnt_omp(ix,jyp,kz,thread)+w*weight
+#else
+ gridcnt(ix,jyp,kz)=gridcnt(ix,jyp,kz)+w*weight
+#endif
+ else
+ do ks=1,nspec
+#ifdef _OPENMP
+ gridunc_omp(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
+ gridunc_omp(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ &
+ mass(i,ks)/rhoi*weight*w
+#else
+ gridunc(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)= &
+ gridunc(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)+ &
+ mass(i,ks)/rhoi*weight*w
+#endif
+ end do
+ endif ! llcmoutput
+ endif
endif
endif !ix ge 0
@@ -902,17 +956,38 @@ subroutine conccalc(itime,weight)
#endif
end do
else
- do ks=1,nspec
+ if (llcmoutput) then
+ ! special case CTM output use mass ratio species to airtracer
+ ! species 1 is always airtracer
+ do ks=2,nspec
#ifdef _OPENMP
- gridunc_omp(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
- gridunc_omp(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ &
- mass(i,ks)/rhoi*weight*w
+ gridunc_omp(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
+ gridunc_omp(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ &
+ mass(i,ks)/mass(i,1)*weight*w
#else
- gridunc(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)= &
- gridunc(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)+ &
- mass(i,ks)/rhoi*weight*w
+ gridunc(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)= &
+ gridunc(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)+ &
+ mass(i,ks)/mass(i,1)*weight*w
#endif
- end do
+ end do
+#ifdef _OPENMP
+ gridcnt_omp(ixp,jyp,kz,thread)=gridcnt_omp(ixp,jyp,kz,thread)+w*weight
+#else
+ gridcnt(ixp,jyp,kz)=gridcnt(ixp,jyp,kz)+w*weight
+#endif
+ else
+ do ks=1,nspec
+#ifdef _OPENMP
+ gridunc_omp(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
+ gridunc_omp(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ &
+ mass(i,ks)/rhoi*weight*w
+#else
+ gridunc(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)= &
+ gridunc(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)+ &
+ mass(i,ks)/rhoi*weight*w
+#endif
+ end do
+ endif ! llcmoutput
endif
endif
@@ -931,17 +1006,38 @@ subroutine conccalc(itime,weight)
#endif
end do
else
- do ks=1,nspec
+ if (llcmoutput) then
+ ! special case CTM output use mass ratio species to airtracer
+ ! species 1 is always airtracer
+ do ks=2,nspec
#ifdef _OPENMP
- gridunc_omp(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
- gridunc_omp(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ &
- mass(i,ks)/rhoi*weight*w
+ gridunc_omp(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
+ gridunc_omp(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ &
+ mass(i,ks)/mass(i,1)*weight*w
#else
- gridunc(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage)= &
- gridunc(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage)+ &
- mass(i,ks)/rhoi*weight*w
+ gridunc(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage)= &
+ gridunc(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage)+ &
+ mass(i,ks)/mass(i,1)*weight*w
#endif
- end do
+ end do
+#ifdef _OPENMP
+ gridcnt_omp(ixp,jy,kz,thread)=gridcnt_omp(ixp,jy,kz,thread)+w*weight
+#else
+ gridcnt(ixp,jy,kz)=gridcnt(ixp,jy,kz)+w*weight
+#endif
+ else
+ do ks=1,nspec
+#ifdef _OPENMP
+ gridunc_omp(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
+ gridunc_omp(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ &
+ mass(i,ks)/rhoi*weight*w
+#else
+ gridunc(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage)= &
+ gridunc(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage)+ &
+ mass(i,ks)/rhoi*weight*w
+#endif
+ end do
+ endif ! llcmoutput
endif
endif
endif !ixp ge 0
@@ -1168,7 +1264,9 @@ subroutine conccalc(itime,weight)
#ifdef _OPENMP
do ithread=1,numthreads_grid
gridunc(:,:,:,:,:,:,:)=gridunc(:,:,:,:,:,:,:)+gridunc_omp(:,:,:,:,:,:,:,ithread)
+ gridcnt(:,:,:)=gridcnt(:,:,:)+gridcnt_omp(:,:,:,ithread)
gridunc_omp(:,:,:,:,:,:,:,ithread)=0.
+ gridcnt_omp(:,:,:,ithread)=0.
end do
if (nested_output.eq.1) then
do ithread=1,numthreads_grid
@@ -1176,61 +1274,9 @@ subroutine conccalc(itime,weight)
griduncn_omp(:,:,:,:,:,:,:,ithread)=0.
end do
endif
-#endif
-
- !***********************************************************************
- ! 2. Evaluate concentrations at receptor points, using the kernel method
- !***********************************************************************
- if (numreceptor.eq.0) return
-
- do n=1,numreceptor
-
- ! Reset concentrations
- !*********************
-
- do ks=1,nspec
- c(ks)=0.
- end do
-
-
- ! Estimate concentration at receptor
- !***********************************
-
- do j=1,count%alive
-
- i=count%ialive(j)
-
- itage=abs(itime-part(i)%tstart)
-
- hz=min(50.+0.3*sqrt(real(itage)),hzmax)
- zd=real(part(i)%z)/hz
- if (zd.gt.1.) cycle ! save computing time, leave loop
-
- hx=min((0.29+2.222e-3*sqrt(real(itage)))*dx+ &
- real(itage)*1.2e-5,hxmax) ! 80 km/day
- xd=(real(part(i)%xlon)-xreceptor(n))/hx
- if (xd*xd.gt.1.) cycle ! save computing time, leave loop
-
- hy=min((0.18+1.389e-3*sqrt(real(itage)))*dy+ &
- real(itage)*7.5e-6,hymax) ! 80 km/day
- yd=(real(part(i)%ylat)-yreceptor(n))/hy
- if (yd*yd.gt.1.) cycle ! save computing time, leave loop
- hxyz=hx*hy*hz
-
- r2=xd*xd+yd*yd+zd*zd
- if (r2.lt.1.) then
- xkern=factor*(1.-r2)
- do ks=1,nspec
- c(ks)=c(ks)+mass(i,ks)*xkern/hxyz
- end do
- endif
- end do
+#endif
- do ks=1,nspec
- creceptor(n,ks)=creceptor(n,ks)+2.*weight*c(ks)/receptorarea(n)
- end do
- end do
end subroutine conccalc
subroutine partpos_avg(itime,j)
diff --git a/src/par_mod.f90 b/src/par_mod.f90
index 4f54f7a4194bde6e58835ca2fb2d1053175a8faa..5b815f8552f6e1b21ad7aa5090aefe5aadff6eed 100644
--- a/src/par_mod.f90
+++ b/src/par_mod.f90
@@ -198,6 +198,13 @@ module par_mod
! numwfmem Number of windfields kept in memory. 2 for serial version,
! 2 or 3 for MPI version
+ !**************************************************************************
+ ! Variables for LCM
+ !**************************************************************************
+
+ integer,parameter :: maxreagent=5 ! Max number of reagents
+ integer,parameter :: maxrecsample=2000 ! Max number of receptors per sampling interval
+
!**************************************************************************
! dimension of the OH field
!**************************************************************************
@@ -289,6 +296,7 @@ module par_mod
integer,parameter :: unitreceptorout=2
integer,parameter :: unitoutgrid=97, unitoutgridppt=99, unitoutinfo=1
integer,parameter :: unitspecies=1, unitoutrecept=91, unitoutreceptppt=92
+ integer,parameter :: unitoutsatellite=108
integer,parameter :: unitlsm=1, unitsfcdata=1, unitland=1, unitwesely=1
integer,parameter :: unitOH=1
integer,parameter :: unitdates=94, unitheader=90,unitheader_txt=100
@@ -304,9 +312,10 @@ module par_mod
integer,parameter :: icmv=-9999.
- logical,parameter :: lpartoutputperfield=.false.
-
! Temporary parameter to switch off the gridfaction calculation in the wetdeposition
logical,parameter :: lgridfraction=.false.
+ ! Particle dump: one file per field or all in one netcdf file
+ logical,parameter :: lpartoutputperfield=.false.
+
end module par_mod
diff --git a/src/readoptions_mod.f90 b/src/readoptions_mod.f90
index eddb689710d0b4312e901140518a647fd25119a8..85d1d3916639c5c49a12cec65134cd3e16c490b2 100644
--- a/src/readoptions_mod.f90
+++ b/src/readoptions_mod.f90
@@ -429,6 +429,9 @@ subroutine readcommand
! June 2023 Anne Tipka *
! Added new parameter bcscheme for selcting below cloud scheme *
! *
+ ! January 2024 Rona Thompson *
+ ! Added new variables for LCM *
+ ! *
!*****************************************************************************
! *
! Variables: *
@@ -456,6 +459,9 @@ subroutine readcommand
! loutsample [s] average is computed from samples taken every [s] *
! seconds *
! loutstep [s] time interval of concentration output *
+ ! lrecoutstep [s] time interval of receptor output *
+ ! lrecoutaver [s] receptor output is an average of lrecoutaver seconds *
+ ! lrecoutsample [s] average is computed from samples taken every [s] *
! lsynctime [s] synchronisation time interval for all particles *
! lagespectra switch to turn on (1)/off (0) calculation of age *
! spectra *
@@ -478,7 +484,8 @@ subroutine readcommand
character(len=50) :: line
integer :: ios
- integer :: lturbulence_meso
+ integer :: lturbulence_meso,lcmoutput
+ character(len=50) :: ohfields_path ! deprecated
namelist /command/ &
ldirect, &
@@ -488,6 +495,9 @@ subroutine readcommand
loutaver, &
loutsample, &
loutrestart, &
+ lrecoutstep, &
+ lrecoutaver, &
+ lrecoutsample, &
lsynctime, &
ctl, &
ifine, &
@@ -513,7 +523,6 @@ subroutine readcommand
surf_only, &
cblflag, &
linversionout, &
- ohfields_path, &
d_trop, &
d_strat, &
nxshift, &
@@ -521,6 +530,8 @@ subroutine readcommand
maxfilesize, &
logvertinterp, &
bcscheme, &
+ ohfields_path, &
+ lcmoutput, &
itsplit ! deprecated: only for IO back compatibility
! Presetting namelist command
@@ -532,6 +543,9 @@ subroutine readcommand
loutstep=10800
loutaver=10800
loutsample=900
+ lrecoutstep=3600
+ lrecoutaver=3600
+ lrecoutsample=900
loutrestart=-1
lsynctime=900
ctl=-5.0
@@ -558,12 +572,13 @@ subroutine readcommand
surf_only=-1
cblflag=0 ! if using old-style COMMAND file, set to 1 here to use mc cbl routine
linversionout=0
- ohfields_path="../../flexin/"
nxshift=-9999
maxthreadgrid=1
maxfilesize=10000
logvertinterp=0
bcscheme=2
+ ohfields_path=''
+ lcmoutput=0
itsplit=999999999 ! deprecated: only for IO back compatibility
!Af set release-switch
@@ -663,6 +678,14 @@ subroutine readcommand
! 3 = wet deposition in outputfield
! 4 = dry deposition in outputfield
+ ! Settings for LCM output
+ !************************************************************
+ ! MDOMAINFILL = 1 | LLCMOUTPUT = true
+ ! IND_SOURCE = 1 | IND_SAMP = 0
+ ! IND_RECEPTOR = 1 | calculates mass ratio mixing ratio
+ ! IOUT = 2 | as ratio species_mass to airtracer_mass
+ !------------------------------------------------------------
+
if ( ldirect .eq. 1 ) then ! FWD-Run
!Af set release-switch
if (ind_source .eq. 1 ) then !mass
@@ -1034,6 +1057,95 @@ subroutine readcommand
error stop
endif
+ ! Check consistency of the intervals for receptors
+ ! ************************************************
+ ! only if ldirect=1
+
+ if (ldirect.eq.1) then
+
+ if (lrecoutaver.eq.0) then
+ write(*,*) ' #### FLEXPART MODEL ERROR! TIME AVERAGE OF #### '
+ write(*,*) ' #### RECEPTOR OUTPUT MUST NOT BE ZERO #### '
+ write(*,*) ' #### CHANGE INPUT IN FILE COMMAND. #### '
+ stop
+ endif
+
+ if (lrecoutaver.gt.lrecoutstep) then
+ write(*,*) ' #### FLEXPART MODEL ERROR! TIME AVERAGE OF #### '
+ write(*,*) ' #### RECEPTOR OUTPUT MUST NOT BE #### '
+ write(*,*) ' #### GREATER THAN INTERVAL OF OUTPUT. #### '
+ write(*,*) ' #### CHANGE INPUT IN FILE COMMAND. #### '
+ stop
+ endif
+
+ if (lrecoutsample.gt.lrecoutaver) then
+ write(*,*) ' #### FLEXPART MODEL ERROR! SAMPLING TIME OF #### '
+ write(*,*) ' #### RECEPTOR OUTPUT MUST NOT BE #### '
+ write(*,*) ' #### GREATER THAN TIME AVERAGE OF OUTPUT. #### '
+ write(*,*) ' #### CHANGE INPUT IN FILE COMMAND. #### '
+ stop
+ endif
+
+ if (mod(lrecoutaver,lsynctime).ne.0) then
+ write(*,*) ' #### FLEXPART MODEL ERROR! AVERAGING TIME OF #### '
+ write(*,*) ' #### RECEPTOR OUTPUT MUST BE A MULTIPLE #### '
+ write(*,*) ' #### OF THE SYNCHRONISATION INTERVAL #### '
+ stop
+ endif
+
+ if ((lrecoutaver/lsynctime).lt.2) then
+ write(*,*) ' #### FLEXPART MODEL ERROR! AVERAGING TIME OF #### '
+ write(*,*) ' #### RECEPTOR OUTPUT MUST BE AT LEAST #### '
+ write(*,*) ' #### TWICE THE SYNCHRONISATION INTERVAL #### '
+ stop
+ endif
+
+ if (mod(lrecoutstep,lsynctime).ne.0) then
+ write(*,*) ' #### FLEXPART MODEL ERROR! INTERVAL BETWEEN #### '
+ write(*,*) ' #### RECEPTOR OUTPUT MUST BE A MULTIPLE #### '
+ write(*,*) ' #### OF THE SYNCHRONISATION INTERVAL #### '
+ stop
+ endif
+
+ if ((lrecoutstep/lsynctime).lt.2) then
+ write(*,*) ' #### FLEXPART MODEL ERROR! INTERVAL BETWEEN #### '
+ write(*,*) ' #### RECEPTOR OUTPUT MUST BE AT LEAST #### '
+ write(*,*) ' #### TWICE THE SYNCHRONISATION INTERVAL #### '
+ stop
+ endif
+
+ if (mod(lrecoutsample,lsynctime).ne.0) then
+ write(*,*) ' #### FLEXPART MODEL ERROR! SAMPLING TIME OF #### '
+ write(*,*) ' #### RECEPTOR OUTPUT MUST BE A MULTIPLE #### '
+ write(*,*) ' #### OF THE SYNCHRONISATION INTERVAL #### '
+ stop
+ endif
+
+ endif ! ldirect
+
+ ! Switch for LCM mode
+ !*******************************************************************
+
+ if ( (lcmoutput.ne.0) .and. ((.not. ind_source.eq.1).or. &
+ (.not. ind_receptor.eq.1).or.(.not. iout.eq.2).or. &
+ (.not. ldirect.eq.1).or.(.not. mdomainfill.eq.1)) ) then
+ write(*,*) 'LCM output requested, but one of the following options'
+ write(*,*) 'is not correctly set in COMMAND:'
+ write(*,*) 'ind_source =', ind_source, 'should be set to 1'
+ write(*,*) 'ind_receptor =', ind_receptor, 'should be set to 1'
+ write(*,*) 'iout =', iout, 'should be set to 2'
+ write(*,*) 'ldirect =', ldirect, 'should be set to 1'
+ write(*,*) 'mdomainfill =', mdomainfill, 'should be set to 1'
+ error stop
+ endif
+ if (lcmoutput.eq.0) then
+ llcmoutput=.false.
+ else
+ llcmoutput=.true.
+ endif
+
+ write(*,*) 'Switch for LCM output LCMOUTPUT = ',llcmoutput
+
! Compute modeling time in seconds and beginning date in Julian date
!*******************************************************************
@@ -1202,85 +1314,6 @@ subroutine readdepo
error stop
end subroutine readdepo
-subroutine readOHfield
-
- !*****************************************************************************
- ! *
- ! Reads the OH field into memory *
- ! *
- ! AUTHOR: R.L. Thompson, Nov 2014 *
- ! *
- ! UPDATES: *
- ! 03/2018 SEC: Converted original netCDF files to binary format *
- !*****************************************************************************
- ! *
- ! Variables: *
- ! *
- ! path(numpath) contains the path names *
- ! lonOH(nxOH) longitude of OH fields *
- ! latOH(nyOH) latitude of OH fields *
- ! altOH(nzOH) altitude of OH fields *
- ! etaOH(nzOH) eta-levels of OH fields *
- ! OH_field(nxOH,nyOH,nzOH,m) OH concentration (molecules/cm3) *
- ! *
- ! *
- !*****************************************************************************
-
- use ohr_mod
-
- implicit none
-
- integer :: i,j,k,l,ierr,stat
- real, dimension(:), allocatable :: etaOH
-
- ! real, parameter :: gasct=8.314 ! gas constant
- ! real, parameter :: mct=0.02894 ! kg mol-1
- ! real, parameter :: g=9.80665 ! m s-2
- ! real, parameter :: lrate=0.0065 ! K m-1
- real, parameter :: scalehgt=7000. ! scale height in metres
-
-
- open(unitOH,file=trim(ohfields_path) &
- //'OH_FIELDS/OH_variables.bin',status='old', &
- form='UNFORMATTED', iostat=ierr, convert='little_endian')
-
- if(ierr.ne.0) then
- write(*,*) 'Cannot read binary OH fields in ', &
- trim(ohfields_path)//'OH_FIELDS/OH_variables.bin'
- error stop
- endif
-
- read(unitOH) nxOH
- read(unitOH) nyOH
- read(unitOH) nzOH
- write(*,*) nxOH,nyOH,nzOH
-
- ! allocate variables
- allocate(lonOH(nxOH),stat=stat)
- if (stat.ne.0) error stop "Could not allocate lonOH"
- allocate(latOH(nyOH),stat=stat)
- if (stat.ne.0) error stop "Could not allocate latOH"
- allocate(etaOH(nzOH),stat=stat)
- if (stat.ne.0) error stop "Could not allocate etaOH"
- allocate(altOH(nzOH),stat=stat)
- if (stat.ne.0) error stop "Could not allocate altOH"
- allocate(OH_field(nxOH,nyOH,nzOH,12),stat=stat)
- if (stat.ne.0) error stop "Could not allocate OH_field"
- allocate(OH_hourly(nxOH,nyOH,nzOH,2),stat=stat)
- if (stat.ne.0) error stop "Could not allocate OH_hourly"
-
- read(unitOH) (lonjr(i),i=1,360)
- read(unitOH) (latjr(i),i=1,180)
- read(unitOH) (((jrate_average(i,j,k),i=1,360),j=1,180),k=1,12)
- read(unitOH) (lonOH(i),i=1,nxOH)
- read(unitOH) (latOH(i),i=1,nyOH)
- read(unitOH) (lonOH(i),i=1,nxOH)
-
- read(unitOH) (altOH(i),i=1,nzOH)
- read(unitOH) ((((OH_field(i,j,k,l),i=1,nxOH),j=1,nyOH),k=1,nzOH),l=1,12)
- read(unitOH) ((((OH_hourly(i,j,k,l),i=1,nxOH),j=1,nyOH),k=1,nzOH),l=1,2)
-end subroutine readOHfield
-
subroutine readlanduse
!*****************************************************************************
@@ -1887,22 +1920,25 @@ subroutine readreceptors
real :: xm,ym
character(len=16) :: receptor
- integer :: ios,stat
- real :: lon,lat ! for namelist input, lon/lat are used instead of x,y
- real,allocatable,dimension(:) :: tmpxrec,tmpyrec,tmprecarea
- character(len=16),allocatable,dimension(:) :: tmprecname
+ integer :: ios
+ real :: lon,lat,alt ! for namelist input, lon/lat are used instead of x,y
+ real(kind=dp) :: time
+
+! real,allocatable,dimension(:) :: tmpxrec,tmpyrec,tmprecarea
+! character(len=16),allocatable,dimension(:) :: tmprecname
+
! declare namelist
- namelist /receptors/ receptor, lon, lat
+ namelist /receptors/ &
+ receptor, lon, lat, alt, time
numreceptor=0 ! Initialise numreceptor
-!CPS I comment this out - why should we not have receptor output in bwd runs?
- ! For backward runs, do not allow receptor output. Thus, set number of
- ! receptors to zero
- ! if (ldirect.lt.0) then
- ! numreceptor=0
- ! return
- ! endif
+ ! For backward runs no receptor output
+ !*************************************
+
+ if (ldirect.lt.0) then
+ return
+ endif
! Open the RECEPTORS file and read output grid specifications
!************************************************************
@@ -1917,147 +1953,86 @@ subroutine readreceptors
read(unitreceptor,receptors,iostat=ios)
close (unitreceptor)
- ! prepare namelist output if requested
- if (nmlout) open(unitreceptorout,file=trim(path(2))// &
- 'RECEPTORS.namelist',status='replace',err=1000)
-
- if (ios .ne. 0) then ! read as regular text file
-
- goto 991 ! wrong variable name in namelist
+ if ((lon.lt.-900).or.(ios.ne.0)) then
+ go to 999
+ else ! only namelist input possible
- elseif (ios .eq. 0) then ! read as namelist
+ ! prepare namelist output if requested
+ if (nmlout) open(unitreceptorout,file=trim(path(2))// &
+ 'RECEPTORS.namelist',status='replace',err=1000)
- if (nint(lon) .eq. -999 .or. nint(lat) .eq. -999) goto 993
-
- ! PS: reopen file otherwise first receptor is skipped!
+ ! Get number of receptors
+ !************************
open (unitreceptor,file=trim(path(1))//'RECEPTORS',status='old',err=999)
-
- ! Read the names and coordinates of the receptors
- !************************************************
j=0
- do while (ios .eq. 0)
- j=j+1
+ do while (ios.eq.0)
+ lon=-999.9
read(unitreceptor,receptors,iostat=ios)
- if (ios .eq. 0) then
- numreceptor = j
- allocate( tmprecname(j),tmpxrec(j),tmpyrec(j),tmprecarea(j),stat=stat)
- if (stat.ne.0) error stop 'ERROR: could not allocate tmp arrays in readrec'
- if (j.gt.1) then
- tmprecname(1:j-1)=receptorname
- tmpxrec(1:j-1)=xreceptor
- tmpyrec(1:j-1)=yreceptor
- tmprecarea(1:j-1)=receptorarea
- endif
- tmprecname(j)=receptor
- tmpxrec(j)=(lon-xlon0)/dx ! transform to grid coordinates
- tmpyrec(j)=(lat-ylat0)/dy
- xm=r_earth*cos(lat*pi/180.)*dx/180.*pi
- ym=r_earth*dy/180.*pi
- tmprecarea(j)=xm*ym
-
- call move_alloc(tmprecname,receptorname)
- call move_alloc(tmpxrec,xreceptor)
- call move_alloc(tmpyrec,yreceptor)
- call move_alloc(tmprecarea,receptorarea)
-
- ! write receptors in namelist format to output directory if requested
- if (nmlout) write(unitreceptorout,nml=receptors)
-! if (nmlout) write(unitreceptorout,nml=nml_receptors)
- elseif (ios .gt. 0) then
- write(*,*) ' ### FLEXPART MODEL ERROR! Error in RECEPTORS namelist ###'
- error stop 'Error in RECEPTORS namelist'
- ! else
- ! write (*,*) 'receptor read in nml format, ios<0', ios
- ! write (*,receptors)
- endif
- end do ! end nml receptors reading loop
+ if ((lon.lt.-900).or.(ios.ne.0)) exit
+ if ((time.lt.bdate).or.(time.ge.edate)) cycle ! skip receptors not in simulation window
+ j=j+1
+ end do
+ numreceptor=j
+ write(*,*) 'Number of receptors: ',numreceptor
+ close (unitreceptor)
- else ! ios<0 = EOF, read as conventional input file
+ ! Allocate arrays
+ !****************
- open (unitreceptor,file=trim(path(1))//'RECEPTORS',status='old',err=999)
- call skplin(5,unitreceptor)
+ allocate(receptorname(numreceptor),xreceptor(numreceptor),&
+ yreceptor(numreceptor),zreceptor(numreceptor),&
+ treceptor(numreceptor),receptorarea(numreceptor))
! Read the names and coordinates of the receptors
!************************************************
- j=1
-100 continue
- read(unitreceptor,*,end=99)
- read(unitreceptor,*,end=99)
- read(unitreceptor,*,end=99)
- read(unitreceptor,'(4x,a16)',end=99) receptor
- call skplin(3,unitreceptor)
- read(unitreceptor,'(4x,f11.4)',end=99) lon
- call skplin(3,unitreceptor)
- read(unitreceptor,'(4x,f11.4)',end=99) lat
- if (lon.eq.0. .and. lat.eq.0. .and. &
- (receptor .eq. ' ')) then
- write(*,*) 'WARNING: looks like empty receptor at south pole;'// &
- ' will be skipped'
- j=j-1
- goto 100
- endif
-
- numreceptor = j
- allocate( tmprecname(j),tmpxrec(j),tmpyrec(j),tmprecarea(j),stat=stat)
- if (stat.ne.0) write(*,*)'ERROR: could not allocate tmp arrays in readrec'
- if (j.gt.1) then
- tmprecname(1:j-1)=receptorname
- tmpxrec(1:j-1)=xreceptor
- tmpyrec(1:j-1)=yreceptor
- tmprecarea(1:j-1)=receptorarea
- endif
- tmprecname(j)=receptor
- tmpxrec(j)=(lon-xlon0)/dx ! transform to grid coordinates
- tmpyrec(j)=(lat-ylat0)/dy
+ open (unitreceptor,file=trim(path(1))//'RECEPTORS',status='old',iostat=ios)
+ j=0
+ do while (ios.eq.0)
+ lon=-999.9
+ read(unitreceptor,receptors,iostat=ios)
+ if ((lon.lt.-900).or.(ios.ne.0)) exit ! read error
+ if ((time.lt.bdate).or.(time.ge.edate)) cycle ! skip receptors not in simulation window
+ j=j+1
+ receptorname(j)=receptor
+ xreceptor(j)=(lon-xlon0)/dx ! transform to grid coordinates
+ yreceptor(j)=(lat-ylat0)/dy
+ zreceptor(j)=alt
+ treceptor(j)=int((time-bdate)*24.*3600.) ! time in sec
+ ! round to nearest 10 seconds
+ treceptor(j)=nint(real(treceptor(j))/10.)*10
xm=r_earth*cos(lat*pi/180.)*dx/180.*pi
ym=r_earth*dy/180.*pi
- tmprecarea(j)=xm*ym
-
- call move_alloc(tmprecname,receptorname)
- call move_alloc(tmpxrec,xreceptor)
- call move_alloc(tmpyrec,yreceptor)
- call move_alloc(tmprecarea,receptorarea)
- ! write receptors file in namelist format to output directory if requested
+ receptorarea(j)=xm*ym
+ ! write receptors in namelist format to output directory if requested
if (nmlout) write(unitreceptorout,nml=receptors)
-! if (nmlout) write(unitreceptorout,nml=nml_receptors)
- goto 100
-
-99 continue
+ end do
+ close (unitreceptor)
+ if (nmlout) close (unitreceptorout)
- endif ! end no-nml / nml bloc
+ endif
- close (unitreceptor)
- if (nmlout) close (unitreceptorout)
+ !! testing
+! write(*,*) 'readreceptors: '
+! do j=1,numreceptor
+! print*, 'receptorname = ',receptorname(j)
+! print*, 'xreceptor, yreceptor, zreceptor = ',xreceptor(j), yreceptor(j), zreceptor(j)
+! print*, 'treceptor = ',treceptor(j)
+! end do
+ !!
- write(*,*) 'Number of receptors: ',numreceptor
return
-991 continue
- write(*,*) '#### FLEXPART ERROR: wrong variable names present'
- write(*,*) '#### in namelist in file RECEPTORS'
- write(*,*) '#### note that in v11+ coordinate names are lon and lat'
-
- error stop
-
-993 continue
- write(*,*) '#### FLEXPART ERROR: namelist in file RECEPTORS'
- write(*,*) '#### first receptor point did not contain lon and/or lat'
- write(*,*) '#### Check your namelist!'
- error stop
-
-999 write(*,*) 'INFORMATION: input file RECEPTORS cannot be opened'
- write(*,*) 'in directory '//trim(path(1))
- write(*,*) 'Continuing without RECEPTOR'
-
+999 write(*,*) ' #### FLEXPART WARNING: File RECEPTORS cannot be opened #### '
+ write(*,*) ' #### in directory '//trim(path(1))//' #### '
+ write(*,*) ' #### continuing without RECEPTOR output #### '
numreceptor=0
return
1000 write(*,*) ' #### FLEXPART MODEL ERROR! File "RECEPTORS" #### '
write(*,*) ' #### cannot be opened in the output directory #### '
write(*,'(a)') ' #### '//trim(path(2))
- write(*,*) ' #### either write perm missing or old file exists ###'
-
+ write(*,*) ' #### either write perm missing or old file exists ####'
error stop
end subroutine readreceptors
@@ -2274,7 +2249,7 @@ subroutine readreleases
DEP=.false.
DRYDEP=.false.
WETDEP=.false.
- OHREA=.false.
+ CLREA=.false.
LDECAY=.false.
do i=1,maxspec
DRYDEPSPEC(i)=.false.
@@ -2346,8 +2321,8 @@ subroutine readreleases
dryvel(i)=dryvel(i)*0.01 ! conversion to m/s
- ! Check if wet deposition or OH reaction shall be calculated
- !***********************************************************
+ ! Check if wet deposition shall be calculated
+ !*********************************************
! ESO 04.2016 check for below-cloud scavenging (gas or aerosol)
if ((dquer(i).le.0..and.(weta_gas(i).gt.0. .or. wetb_gas(i).gt.0.)) .or. &
@@ -2375,11 +2350,6 @@ subroutine readreleases
if (lroot) write (*,*) ' In-cloud scavenging: OFF'
endif
- if (ohcconst(i).gt.0.) then
- OHREA=.true.
- if (lroot) write (*,*) ' OHreaction switched on: ',ohcconst(i),i
- endif
-
if ((reldiff(i).gt.0.).or.(density(i).gt.0.).or.(dryvel(i).gt.0.)) then
DRYDEP=.true.
DRYDEPSPEC(i)=.true.
@@ -2390,6 +2360,22 @@ subroutine readreleases
if (WETDEP.or.DRYDEP) DEP=.true.
+ ! Check if chemical reaction shall be calculated
+ !***********************************************
+
+ if (any(reaccconst(:,:).gt.0.)) then
+ CLREA=.true.
+ if (lroot) write (*,*) ' Chemical reactions switched on'
+ endif
+
+ ! Check if emissions shall be used
+ !*********************************
+
+ if (any(emis_path(:).ne."")) then
+ LEMIS=.true.
+ if (lroot) write(*,*) ' Emissions switched on'
+ endif
+
! Not necessary to read releases when using part_ic.nc
!*****************************************************
if ((ipin.eq.3).or.(ipin.eq.4)) then
@@ -2646,6 +2632,9 @@ subroutine readspecies(id_spec,pos_spec)
! HSO, 13 August 2013
! added optional namelist input
! *
+ ! R. Thompson, 18.01.2024 *
+ ! variables for LCM *
+ ! *
!*****************************************************************************
! *
! Variables: *
@@ -2654,12 +2643,12 @@ subroutine readspecies(id_spec,pos_spec)
! weta_gas, wetb_gas Parameters for below-cloud scavenging of gasses *
! crain_aero,csnow_aero Parameters for below-cloud scavenging of aerosols *
! ccn_aero,in_aero Parameters for in-cloud scavenging of aerosols *
- ! ohcconst OH reaction rate constant C *
- ! ohdconst OH reaction rate constant D *
- ! ohnconst OH reaction rate constant n *
+ ! reaccconst Chemical reaction rate constant C *
+ ! reacdconst Chemical reaction rate constant D *
+ ! reacnconst Chemical reaction rate constant n *
! id_spec SPECIES number as referenced in RELEASE file *
! id_pos position where SPECIES data shall be stored *
- ! ni Number of diameter classes of particles * *
+ ! ni Number of diameter classes of particles *
! Constants: *
! *
!*****************************************************************************
@@ -2670,11 +2659,17 @@ subroutine readspecies(id_spec,pos_spec)
integer :: idow,ihour,id_spec
character(len=3) :: aspecnumb
- character(len=16) :: pspecies
+ character(len=16) :: pspecies, pemis_name
+ character(len=256) :: pemis_path, pemis_file
+ integer :: pemis_unit
+ real :: pemis_coeff
character(len=50) :: line
real :: pdecay, pweta_gas, pwetb_gas, preldiff, phenry, pf0, pdensity, pdquer
- real :: pdsigma, pdryvel, pweightmolar, pohcconst, pohdconst, pohnconst, pdia
+ real :: pdsigma, pdryvel, pweightmolar, pdia
+ character(len=10), allocatable, dimension(:) :: preactions
+ real, allocatable, dimension(:) :: pcconst, pdconst, pnconst
real :: pcrain_aero, pcsnow_aero, pccn_aero, pin_aero
+ real :: pohcconst,pohdconst,pohnconst ! deprecated
real :: parea_dow(7), parea_hour(24), ppoint_dow(7), ppoint_hour(24)
integer :: pndia
integer :: ios
@@ -2686,11 +2681,32 @@ subroutine readspecies(id_spec,pos_spec)
namelist /species_params/ &
pspecies, pdecay, pweta_gas, pwetb_gas, &
pcrain_aero, pcsnow_aero, pccn_aero, pin_aero, &
- preldiff, phenry, pf0, pdensity, pdquer, pdia, &
- pdsigma, pndia, pdryvel, pweightmolar, pohcconst, pohdconst, pohnconst, &
+ preldiff, phenry, pf0, pdensity, pdquer, &
+ pdsigma, pndia, pdryvel, pweightmolar, pohnconst, &
+ preactions, pcconst, pdconst, pnconst, pohcconst, pohdconst, &
+ pemis_path, pemis_file, pemis_name, pemis_unit, pemis_coeff, &
parea_dow, parea_hour, ppoint_dow, ppoint_hour, &
pshape, paspectratio, pla, pia, psa, porient
+ ! allocate reaction variables
+ allocate(preactions(maxreagent))
+ allocate(pcconst(maxreagent))
+ allocate(pdconst(maxreagent))
+ allocate(pnconst(maxreagent))
+ if (.not.allocated(reaccconst)) then
+ allocate(reaccconst(maxreagent,nspec))
+ allocate(reacdconst(maxreagent,nspec))
+ allocate(reacnconst(maxreagent,nspec))
+ reaccconst(:,:)=-9.99e-9
+ reacdconst(:,:)=-9.99
+ reacnconst(:,:)=-9.99
+ allocate(emis_path(nspec))
+ allocate(emis_file(nspec))
+ allocate(emis_name(nspec))
+ allocate(emis_unit(nspec))
+ allocate(emis_coeff(nspec))
+ endif
+
pspecies="" ! read failure indicator value
pdecay=-999.9
pweta_gas=-9.9E-09
@@ -2708,9 +2724,13 @@ subroutine readspecies(id_spec,pos_spec)
pdsigma=0.0
pndia=1
pdryvel=-9.99
+ preactions(:)=""
+ pcconst(:)=-9.99e-9
+ pdconst(:)=-9.99
+ pnconst(:)=-9.99
pohcconst=-9.99
- pohdconst=-9.9E-09
- pohnconst=2.0
+ pohdconst=-9.99
+ pohnconst=-9.99
pweightmolar=-999.9
parea_dow=-999.9
parea_hour=-999.9
@@ -2722,7 +2742,11 @@ subroutine readspecies(id_spec,pos_spec)
pia=-1. ! Intermediate axis
psa=-1. ! Smallest axis
porient=0 ! 0 for horizontal, 1 for random
-
+ pemis_path="" ! read failure indicator value
+ pemis_file="" ! read failure indicator value
+ pemis_name="" ! read failure indicator value
+ pemis_unit=0
+ pemis_coeff=1.
do j=1,24 ! initialize everything to no variation
parea_hour(j)=1.
@@ -2747,9 +2771,8 @@ subroutine readspecies(id_spec,pos_spec)
ASSSPEC=.FALSE.
- ! try namelist input
read(unitspecies,species_params,iostat=ios)
- !CGZ add check on which line of species file problem occurs
+ ! check on which line of species file problem occurs
if (ios.ne.0) then
backspace(unitspecies)
read(unitspecies,fmt='(A)') line
@@ -2759,240 +2782,181 @@ subroutine readspecies(id_spec,pos_spec)
close(unitspecies)
if ((len(trim(pspecies)).eq.0).or.(ios.ne.0)) then ! no namelist found
- if (lroot) write(*,*) "SPECIES file not in NAMELIST format, attempting to &
- &read as fixed format"
-
- ios=1
-
- open(unitspecies,file=path(1)(1:length(1))//'SPECIES/SPECIES_'//aspecnumb, &
- status='old',err=998)
+ if (lroot) then
+ write(*,*) "FLEXPART ERROR: SPECIES file not in NAMELIST format"
+ write(*,*) "fixed format no longer supported"
+ endif
+ error stop
+ endif
- do i=1,6
- read(unitspecies,*)
- end do
+ if ((pohcconst.ne.-9.99).or.(pohdconst.ne.-9.99).or.(pohnconst.ne.-9.99)) then
+ write(*,*) "WARNING: POHCCONST,POHDCONST, and POHNCONST in SPECIES file are deprecated."
+ endif
+ species(pos_spec)=pspecies
+ decay(pos_spec)=pdecay
+ weta_gas(pos_spec)=pweta_gas
+ wetb_gas(pos_spec)=pwetb_gas
+ crain_aero(pos_spec)=pcrain_aero
+ csnow_aero(pos_spec)=pcsnow_aero
+ ccn_aero(pos_spec)=pccn_aero
+ in_aero(pos_spec)=pin_aero
+ reldiff(pos_spec)=preldiff
+ henry(pos_spec)=phenry
+ f0(pos_spec)=pf0
+ density(pos_spec)=pdensity
+ dquer(pos_spec)=pdquer
+ dsigma(pos_spec)=pdsigma
+ ndia(pos_spec)=pndia
+ dryvel(pos_spec)=pdryvel
+ weightmolar(pos_spec)=pweightmolar
+ emis_path(pos_spec)=pemis_path
+ emis_file(pos_spec)=pemis_file
+ emis_name(pos_spec)=pemis_name
+ emis_unit(pos_spec)=pemis_unit
+ emis_coeff(pos_spec)=pemis_coeff
+ ishape(pos_spec)=pshape
+ orient(pos_spec)=porient
+
+ ! Daria Tatsii 2023: compute particle shape dimensions
+ if (ishape(pos_spec).ge.1) then ! Compute shape according to given axes
+ select case (ishape(pos_spec))
+ case (1)
+ write(*,*) "Particle shape USER-DEFINED for particle", id_spec
+ if ((psa.le.0.0).or.(pia.le.0.0).or.(pla.le.0.0)) then
+ write(*,*) "#### ERROR: Shape=1 (user-defined) is chosen, &
+ &but no valid axes are provided."
+ write(*,*) "#### SPECIES file requires SA, IA, and LA parameter &
+ &greater than zero."
+ error stop
+ endif
+ write(*,*) "SA,IA,LA:",psa,pia,pla
+ case (2) ! Cylinders (fibers) !
+ if (paspectratio.le.0.0) then
+ write(*,*) "#### ERROR: Shape=2 cylinder is chosen, but no valid apect ratio is provided."
+ write(*,*) "#### SPECIES file requires ASPECTRATIO parameter greater than zero."
+ error stop
+ endif
+ psa=(((dquer(pos_spec)**3.0)*2.0)/ &
+ (3.0*paspectratio))**(1.0/3.0)
+ pia=psa
+ pla=psa*paspectratio
+ write(*,*) "Particle shape CYLINDER for particle", id_spec
+ write(*,*) "SA,IA,LA:",psa,pia,pla
+ case (3) ! Cubes !
+ write(*,*) "Particle shape CUBE for particle", id_spec
+ psa=((dquer(pos_spec)**3)*pi/6.0)**(1.0/3.0)
+ pia=(2.0**0.5)*psa
+ pla=(3.0**0.5)*psa
+ if ((psa.le.0.0).or.(pia.le.0.0).or.(pla.le.0.0)) then
+ write(*,*) "#### ERROR: Shape=3 (user-defined) is chosen, but no valid axes are provided."
+ write(*,*) "#### SPECIES file requires SA, IA, and LA parameter greater than zero."
+ error stop
+ endif
+ write(*,*) "SA,IA,LA:",psa,pia,pla
+ case (4) ! Tetrahedrons !
+ write(*,*) "Particle shape TETRAHEDRON for particle", id_spec
+ pla=((dquer(pos_spec)**3)*pi*2**(0.5))**(1.0/3.0)
+ pia=pla*((3.0/4.0)**(0.5))
+ psa=pla*((2.0/3.0)**(0.5))
+ if ((psa.le.0.0).or.(pia.le.0.0).or.(pla.le.0.0)) then
+ write(*,*) "#### ERROR: Shape=4 (user-defined) is chosen, but no valid axes are provided."
+ write(*,*) "#### SPECIES file requires SA, IA, and LA parameter greater than zero."
+ error stop
+ endif
+ write(*,*) "SA,IA,LA:",psa,pia,pla
+ case (5) ! Octahedrons !
+ write(*,*) "Particle shape OCTAHEDRON for particle", id_spec
+ psa=dquer(pos_spec)*(pi/(2.0*2.0**(0.5)))**3
+ pia=psa
+ pla=psa*(2.0**(0.5))
+ if ((psa.le.0.0).or.(pia.le.0.0).or.(pla.le.0.0)) then
+ write(*,*) "#### ERROR: Shape=5 (user-defined) is chosen, but no valid axes are provided."
+ write(*,*) "#### SPECIES file requires SA, IA, and LA parameter greater than zero."
+ error stop
+ endif
+ write(*,*) "SA,IA,LA:",psa,pia,pla
+ case (6) ! Ellipsoids !
+ write(*,*) "Particle shape ELLIPSOID for particle", id_spec
+ psa=dquer(pos_spec)/(2.0**(1.0/3.0))
+ pia=psa
+ pla=2*pia
+ if ((psa.le.0.0).or.(pia.le.0.0).or.(pla.le.0.0)) then
+ write(*,*) "#### ERROR: Shape=6 (user-defined) is chosen, but no valid axes are provided."
+ write(*,*) "#### SPECIES file requires SA, IA, and LA parameter greater than zero."
+ error stop
+ endif
+ write(*,*) "SA,IA,LA:",psa,pia,pla
+ end select
+
+ ! When using the shape option, dquer is the sphere equivalent diameter
+
+ f=psa/pia
+ e=pia/pla
+ ! Drag coefficient scheme by Bagheri & Bonadonna, 2016 to define settling velocities of other shapes (by D.Tatsii)
+ if ((ishape(pos_spec).eq.2).or.((ishape(pos_spec).eq.1).and. &
+ (pia.eq.psa).and.(pla.ge.20.0*pia))) then
+
+ Fn(pos_spec)=f*f*e ! simplified equation, validated by experiments with fibers
+ Fs(pos_spec)=f*e**(1.3) ! simplified equation, validated by experiments with fibers
+ else
+ Fn(pos_spec)=f*f*e*((dquer(pos_spec))**3)/(psa*pia*pla) ! Newton's regime
+ Fs(pos_spec)=f*e**(1.3)*(dquer(pos_spec)**3/(psa*pia*pla)) ! Stokes' regime
+ endif
- read(unitspecies,'(a10)',end=22) species(pos_spec)
- ! write(*,*) species(pos_spec)
- read(unitspecies,'(f18.1)',end=22) decay(pos_spec)
- ! write(*,*) decay(pos_spec)
- read(unitspecies,'(e18.1)',end=22) weta_gas(pos_spec)
- ! write(*,*) weta_gas(pos_spec)
- read(unitspecies,'(f18.2)',end=22) wetb_gas(pos_spec)
- ! write(*,*) wetb_gas(pos_spec)
- read(unitspecies,'(e18.1)',end=22) crain_aero(pos_spec)
- ! write(*,*) crain_aero(pos_spec)
- read(unitspecies,'(f18.2)',end=22) csnow_aero(pos_spec)
- ! write(*,*) csnow_aero(pos_spec)
- !*** NIK 31.01.2013: including in-cloud scavening parameters
- read(unitspecies,'(e18.1)',end=22) ccn_aero(pos_spec)
- ! write(*,*) ccn_aero(pos_spec)
- read(unitspecies,'(f18.2)',end=22) in_aero(pos_spec)
- ! write(*,*) in_aero(pos_spec)
- read(unitspecies,'(f18.1)',end=22) reldiff(pos_spec)
- ! write(*,*) reldiff(pos_spec)
- read(unitspecies,'(e18.1)',end=22) henry(pos_spec)
- ! write(*,*) henry(pos_spec)
- read(unitspecies,'(f18.1)',end=22) f0(pos_spec)
- ! write(*,*) f0(pos_spec)
- read(unitspecies,'(e18.1)',end=22) density(pos_spec)
- ! write(*,*) density(pos_spec)
- read(unitspecies,'(e18.1)',end=22) dquer(pos_spec)
- ! write(*,*) 'dquer(pos_spec):', dquer(pos_spec)
- read(unitspecies,'(e18.1)',end=22) dsigma(pos_spec)
- ! write(*,*) dsigma(pos_spec)
- read(unitspecies,'(i16)',end=22) ndia(pos_spec)
- ! write(*,*) ndia(pos_spec)
- read(unitspecies,'(f18.2)',end=22) dryvel(pos_spec)
- ! write(*,*) dryvel(pos_spec)
- read(unitspecies,'(f18.2)',end=22) weightmolar(pos_spec)
- ! write(*,*) weightmolar(pos_spec)
- read(unitspecies,'(e18.2)',end=22) ohcconst(pos_spec)
- ! write(*,*) ohcconst(pos_spec)
- read(unitspecies,'(f8.2)',end=22) ohdconst(pos_spec)
- ! write(*,*) ohdconst(pos_spec)
- read(unitspecies,'(f8.2)',end=22) ohnconst(pos_spec)
- ! write(*,*) ohnconst(pos_spec)
-
- ! Read in daily and day-of-week variation of emissions, if available
- !*******************************************************************
+ ! Pre-compute ks and kn values needed for horizontal and average orientation (B&B Figure 12 k_(s,max))
+ ks1(pos_spec)=(Fs(pos_spec)**(1./3.) + Fs(pos_spec)**(-1./3.))/2.
+ ks2(pos_spec)=0.5*((Fs(pos_spec)**0.05)+(Fs(pos_spec)**(-0.36)))
+ kn2(pos_spec)=10.**(alpha2*(-log10(Fn(pos_spec)))**beta2)
- read(unitspecies,*,end=22)
- do j=1,24 ! 24 hours, starting with 0-1 local time
- read(unitspecies,*) ihour,area_hour(pos_spec,j),point_hour(pos_spec,j)
- end do
- read(unitspecies,*)
- do j=1,7 ! 7 days of the week, starting with Monday
- read(unitspecies,*) idow,area_dow(pos_spec,j),point_dow(pos_spec,j)
- end do
+ else ! Spheres
+ write(*,*) "Particle shape SPHERE for particle", id_spec
+ endif
- pspecies=species(pos_spec)
- pdecay=decay(pos_spec)
- pweta_gas=weta_gas(pos_spec)
- pwetb_gas=wetb_gas(pos_spec)
- pcrain_aero=crain_aero(pos_spec)
- pcsnow_aero=csnow_aero(pos_spec)
- pccn_aero=ccn_aero(pos_spec)
- pin_aero=in_aero(pos_spec)
- preldiff=reldiff(pos_spec)
- phenry=henry(pos_spec)
- pf0=f0(pos_spec)
- pdensity=density(pos_spec)
- pdquer=dquer(pos_spec)
- pdsigma=dsigma(pos_spec)
- pndia=ndia(pos_spec)
- pdryvel=dryvel(pos_spec)
- pweightmolar=weightmolar(pos_spec)
- pohcconst=ohcconst(pos_spec)
- pohdconst=ohdconst(pos_spec)
- pohnconst=ohnconst(pos_spec)
-
-
- do j=1,24 ! 24 hours, starting with 0-1 local time
- parea_hour(j)=area_hour(pos_spec,j)
- ppoint_hour(j)=point_hour(pos_spec,j)
- end do
- do j=1,7 ! 7 days of the week, starting with Monday
- parea_dow(j)=area_dow(pos_spec,j)
- ppoint_dow(j)=point_dow(pos_spec,j)
- end do
+ ! assign chemical reaction rate constants to table
+ !*************************************************
- else ! namelist available
-
- species(pos_spec)=pspecies
- decay(pos_spec)=pdecay
- weta_gas(pos_spec)=pweta_gas
- wetb_gas(pos_spec)=pwetb_gas
- crain_aero(pos_spec)=pcrain_aero
- csnow_aero(pos_spec)=pcsnow_aero
- ccn_aero(pos_spec)=pccn_aero
- in_aero(pos_spec)=pin_aero
- reldiff(pos_spec)=preldiff
- henry(pos_spec)=phenry
- f0(pos_spec)=pf0
- density(pos_spec)=pdensity
- if (pdia.ne.0.0) then
- dquer(pos_spec)=pdia
- else if (pdquer.ne.0.0) then
- write(*,*) 'WARNING: PDQUER will be depricated, please use PDIA instead.'
- dquer(pos_spec)=pdquer ! For backwards compatibility
- else
- dquer(pos_spec)=0.0
- endif
- dsigma(pos_spec)=pdsigma
- ndia(pos_spec)=pndia
- dryvel(pos_spec)=pdryvel
- weightmolar(pos_spec)=pweightmolar
- ohcconst(pos_spec)=pohcconst
- ohdconst(pos_spec)=pohdconst
- ohnconst(pos_spec)=pohnconst
- ishape(pos_spec)=pshape
- orient(pos_spec)=porient
-
-
- ! Daria Tatsii 2023: compute particle shape dimensions
- if (ishape(pos_spec).ge.1) then ! Compute shape according to given axes
- select case (ishape(pos_spec))
- case (1)
- write(*,*) "Particle shape USER-DEFINED for particle", id_spec
- if ((psa.le.0.0).or.(pia.le.0.0).or.(pla.le.0.0)) then
- write(*,*) "#### ERROR: Shape=1 (user-defined) is chosen, &
- &but no valid axes are provided."
- write(*,*) "#### SPECIES file requires SA, IA, and LA parameter &
- &greater than zero."
- error stop
- endif
- write(*,*) "SA,IA,LA:",psa,pia,pla
- case (2) ! Cylinders (fibers) !
- if (paspectratio.le.0.0) then
- write(*,*) "#### ERROR: Shape=2 cylinder is chosen, but no valid apect ratio is provided."
- write(*,*) "#### SPECIES file requires ASPECTRATIO parameter greater than zero."
- error stop
- endif
- psa=(((dquer(pos_spec)**3.0)*2.0)/ &
- (3.0*paspectratio))**(1.0/3.0)
- pia=psa
- pla=psa*paspectratio
- write(*,*) "Particle shape CYLINDER for particle", id_spec
- write(*,*) "SA,IA,LA:",psa,pia,pla
- case (3) ! Cubes !
- write(*,*) "Particle shape CUBE for particle", id_spec
- psa=((dquer(pos_spec)**3)*pi/6.0)**(1.0/3.0)
- pia=(2.0**0.5)*psa
- pla=(3.0**0.5)*psa
- if ((psa.le.0.0).or.(pia.le.0.0).or.(pla.le.0.0)) then
- write(*,*) "#### ERROR: Shape=3 (user-defined) is chosen, but no valid axes are provided."
- write(*,*) "#### SPECIES file requires SA, IA, and LA parameter greater than zero."
- error stop
- endif
- write(*,*) "SA,IA,LA:",psa,pia,pla
- case (4) ! Tetrahedrons !
- write(*,*) "Particle shape TETRAHEDRON for particle", id_spec
- pla=((dquer(pos_spec)**3)*pi*2**(0.5))**(1.0/3.0)
- pia=pla*((3.0/4.0)**(0.5))
- psa=pla*((2.0/3.0)**(0.5))
- if ((psa.le.0.0).or.(pia.le.0.0).or.(pla.le.0.0)) then
- write(*,*) "#### ERROR: Shape=4 (user-defined) is chosen, but no valid axes are provided."
- write(*,*) "#### SPECIES file requires SA, IA, and LA parameter greater than zero."
- error stop
- endif
- write(*,*) "SA,IA,LA:",psa,pia,pla
- case (5) ! Octahedrons !
- write(*,*) "Particle shape OCTAHEDRON for particle", id_spec
- psa=dquer(pos_spec)*(pi/(2.0*2.0**(0.5)))**3
- pia=psa
- pla=psa*(2.0**(0.5))
- if ((psa.le.0.0).or.(pia.le.0.0).or.(pla.le.0.0)) then
- write(*,*) "#### ERROR: Shape=5 (user-defined) is chosen, but no valid axes are provided."
- write(*,*) "#### SPECIES file requires SA, IA, and LA parameter greater than zero."
- error stop
- endif
- write(*,*) "SA,IA,LA:",psa,pia,pla
- case (6) ! Ellipsoids !
- write(*,*) "Particle shape ELLIPSOID for particle", id_spec
- psa=dquer(pos_spec)/(2.0**(1.0/3.0))
- pia=psa
- pla=2*pia
- if ((psa.le.0.0).or.(pia.le.0.0).or.(pla.le.0.0)) then
- write(*,*) "#### ERROR: Shape=6 (user-defined) is chosen, but no valid axes are provided."
- write(*,*) "#### SPECIES file requires SA, IA, and LA parameter greater than zero."
- error stop
- endif
- write(*,*) "SA,IA,LA:",psa,pia,pla
- end select
-
- ! When using the shape option, dquer is the sphere equivalent diameter
-
- f=psa/pia
- e=pia/pla
- ! Drag coefficient scheme by Bagheri & Bonadonna, 2016 to define settling velocities of other shapes (by D.Tatsii)
- if ((ishape(pos_spec).eq.2).or.((ishape(pos_spec).eq.1).and. &
- (pia.eq.psa).and.(pla.ge.20.0*pia))) then
-
- Fn(pos_spec)=f*f*e ! simplified equation, validated by experiments with fibers
- Fs(pos_spec)=f*e**(1.3) ! simplified equation, validated by experiments with fibers
- else
- Fn(pos_spec)=f*f*e*((dquer(pos_spec))**3)/(psa*pia*pla) ! Newton's regime
- Fs(pos_spec)=f*e**(1.3)*(dquer(pos_spec)**3/(psa*pia*pla)) ! Stokes' regime
+ print*, 'readspecies: preactions = ',preactions
+
+ if (any(preactions.ne."")) then
+ do j=1,maxreagent
+ if ( preactions(j).eq."" ) cycle
+ do i=1,maxreagent
+ if (preactions(j).eq.reagents(i)) then
+ reaccconst(i,pos_spec)=pcconst(j)
+ reacdconst(i,pos_spec)=pdconst(j)
+ reacnconst(i,pos_spec)=pnconst(j)
+ exit
+ endif
+ end do
+ if (i.gt.nreagent) then
+ write(*,*) '#### FLEXPART MODEL ERROR ####'
+ write(*,*) '#### REAGENT NOT FOUND FOR ####'
+ write(*,*) '#### REACTION '//trim(preactions(j))//' ####'
+ error stop
endif
- ! Pre-compute ks and kn values needed for horizontal and average orientation (B&B Figure 12 k_(s,max))
- ks1(pos_spec)=(Fs(pos_spec)**(1./3.) + Fs(pos_spec)**(-1./3.))*0.5
- ks2(pos_spec)=0.5*((Fs(pos_spec)**0.05)+(Fs(pos_spec)**(-0.36)))
- kn2(pos_spec)=10.**(alpha2*(-log10(Fn(pos_spec)))**beta2)
-
- else ! Spheres
- write(*,*) "Particle shape SPHERE for particle", id_spec
- endif
-
- do j=1,24 ! 24 hours, starting with 0-1 local time
- area_hour(pos_spec,j)=parea_hour(j)
- point_hour(pos_spec,j)=ppoint_hour(j)
end do
- do j=1,7 ! 7 days of the week, starting with Monday
- area_dow(pos_spec,j)=parea_dow(j)
- point_dow(pos_spec,j)=ppoint_dow(j)
+ endif
+
+ ! Check reaction rates
+ if (lroot) then
+ write(*,*) 'Reaction rates for ',species(pos_spec),':'
+ do j=1,nreagent
+ if (reaccconst(j,pos_spec).lt.0.) reaccconst(j,pos_spec)=0.
+ if (reacdconst(j,pos_spec).lt.0.) reacdconst(j,pos_spec)=0.
+ if (reacnconst(j,pos_spec).lt.0.) reacnconst(j,pos_spec)=0.
+ write(*,*) reagents(j),': C, D, N = ',reaccconst(j,pos_spec),reacdconst(j,pos_spec),reacnconst(j,pos_spec)
end do
endif
+ do j=1,24 ! 24 hours, starting with 0-1 local time
+ area_hour(pos_spec,j)=parea_hour(j)
+ point_hour(pos_spec,j)=ppoint_hour(j)
+ end do
+ do j=1,7 ! 7 days of the week, starting with Monday
+ area_dow(pos_spec,j)=parea_dow(j)
+ point_dow(pos_spec,j)=ppoint_dow(j)
+ end do
+
i=pos_spec
!NIK 16.02.2015
@@ -3450,6 +3414,7 @@ subroutine readpartoptions
partopt(34)%short_name='drydepo'
partopt(34)%name='DD'
partopt(34)%print=drydeposition
+
! Numbers are assigned to the averaged fields for proper
! allocation and reading in particle_mod and output_mod
!******************************************************
diff --git a/src/receptor_mod.f90 b/src/receptor_mod.f90
new file mode 100644
index 0000000000000000000000000000000000000000..0883b60b3e4f754c018e1a63d606033665ee4d77
--- /dev/null
+++ b/src/receptor_mod.f90
@@ -0,0 +1,1019 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2019, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+module receptor_mod
+
+ !*****************************************************************************
+ ! *
+ ! This module contains variables and subroutines for calculating *
+ ! receptor concentrations and writing these to file *
+ ! *
+ !*****************************************************************************
+
+ use par_mod
+ use com_mod
+ use point_mod
+ use particle_mod
+ use date_mod
+ use windfields_mod, only: rho, prs, height, nzmax, nz !, qv
+#if USE_NCF
+ use receptor_netcdf_mod, only: nc_id, concvar_id, uncvar_id, &
+ recnamevar_id, timevar_id, &
+ reclonvar_id, reclatvar_id, recaltvar_id, &
+ nnvar_id, xkvar_id, rpointer, &
+ ncsat_id, satvar_id, satuncvar_id, &
+ satnamevar_id, sattimevar_id, &
+ satlonvar_id, satlatvar_id, sataltvar_id, &
+ satnnvar_id, satxkvar_id, spointer, sat_name, &
+ receptor_output_netcdf, write_receptor_netcdf, &
+ satellite_output_netcdf, write_satellite_netcdf, &
+ close_receptor_netcdf, close_satellite_netcdf
+#endif
+ use binary_output_mod, only: receptorout_init_binary, write_receptor_binary, &
+ satelliteout_init_binary, write_satellite_binary
+
+ implicit none
+
+ contains
+
+
+ subroutine alloc_receptor
+
+ !*****************************************************************************
+ ! *
+ ! This routine allocates variables for receptor concentrations *
+ ! *
+ !*****************************************************************************
+
+ implicit none
+
+ if (numreceptor.gt.0) then
+ allocate( creceptor(nspec,maxrecsample) )
+ allocate( crecuncert(nspec,maxrecsample) )
+ allocate( nnreceptor(maxrecsample) )
+ allocate( xkreceptor(maxrecsample) )
+ creceptor(:,:)=0.
+ crecuncert(:,:)=0.
+ nnreceptor(:)=0.
+ xkreceptor(:)=0.
+ endif
+
+ if (numsatreceptor.gt.0) then
+ allocate( csatellite(nspec,nlayermax,maxrecsample) )
+ allocate( csatuncert(nspec,nlayermax,maxrecsample) )
+ allocate( nnsatellite(nlayermax,maxrecsample) )
+ allocate( xksatellite(nlayermax,maxrecsample) )
+ csatellite(:,:,:)=0.
+ csatuncert(:,:,:)=0.
+ nnsatellite(:,:)=0.
+ xksatellite(:,:)=0.
+ endif
+
+ end subroutine alloc_receptor
+
+
+ subroutine receptoroutput(itime,lrecoutstart,lrecoutend,lrecoutnext,recoutnum,recoutnumsat)
+
+ !*****************************************************************************
+ ! *
+ ! Output concentrations at receptors *
+ ! *
+ ! Author: R. Thompson, Sep-2023 *
+ ! *
+ ! *
+ !*****************************************************************************
+
+ use omp_lib, only: OMP_GET_MAX_THREADS, OMP_GET_THREAD_NUM
+
+ implicit none
+
+ integer :: itime, lrecoutstart, lrecoutend, lrecoutnext
+ real, dimension(maxrecsample) :: recoutnum
+ real, dimension(nlayermax,maxrecsample) :: recoutnumsat
+ real :: weight
+ real(kind=dp) :: jul
+ character(len=256) :: fn, fnsat
+ character :: adate*8, atime*6
+ integer :: jjjjmmdd, ihmmss
+ integer :: numsatlayer, nchar, ks_start
+ integer :: n, nn, nr, ix, jy, ixp, jyp, indz, indzp, il, ind, ks, k, kz
+ real :: ddx, ddy, rddx, rddy, p1, p2, p3, p4, dz1, dz2, dz
+ real :: rhoi, zmid
+ real, dimension(2) :: rho_p
+ real, dimension(:), allocatable :: densityoutrecept
+ real, dimension(:,:), allocatable :: nnrec, xkrec, altrec
+ real, dimension(:), allocatable :: lonrec, latrec
+ integer, dimension(:), allocatable :: timerec
+ real, dimension(:,:,:), allocatable :: crec, cunc
+ character(len=16), dimension(:), allocatable :: namerec
+ real, dimension(:,:,:), allocatable :: nnrec_omp, xkrec_omp, altrec_omp
+ real, dimension(:,:), allocatable :: lonrec_omp, latrec_omp
+ integer, dimension(:,:), allocatable :: timerec_omp
+ real, dimension(:,:,:,:), allocatable :: crec_omp, cunc_omp
+ character(len=16), dimension(:,:), allocatable :: namerec_omp
+ integer, dimension(:), allocatable :: nr_omp
+ real, parameter :: weightair=28.97
+ integer, parameter :: unitoutrecdates=109
+ logical :: lexist
+ integer :: nthreads, thread, ithread
+
+
+ if (llcmoutput) then
+ ks_start=2
+ else
+ ks_start=1
+ endif
+
+ if (mod(itime-lrecoutstart,lrecoutsample).eq.0) then
+ if ((itime.eq.lrecoutstart).or.(itime.eq.lrecoutend)) then
+ weight=0.5
+ else
+ weight=1.0
+ endif
+ call receptorcalc(itime,weight,lrecoutstart,lrecoutend,recoutnum,recoutnumsat)
+ endif
+
+ !! testing
+ print*, 'receptor_mod: itime, lrecoutstart, lrecoutend = ',itime, lrecoutstart, lrecoutend
+
+ if ((itime.eq.lrecoutend).and.(any(recoutnum.gt.0.).or.any(recoutnumsat.gt.0.))) then
+
+ ! output receptor concentrations
+ !*******************************
+
+ if ((iout.le.3.).or.(iout.eq.5)) then
+
+ ! Determine current date for output in dates_receptor file
+ !**********************************************************
+
+ jul=bdate+dble(float(itime))/86400.
+ call caldate(jul,jjjjmmdd,ihmmss)
+ write(adate,'(i8.8)') jjjjmmdd
+ write(atime,'(i6.6)') ihmmss
+
+ inquire(file=path(2)(1:length(2))//'dates_receptors',exist=lexist)
+ if (.not.lexist) then
+ ! initialize dates output file
+ open(unitoutrecdates,file=path(2)(1:length(2))//'dates_receptors',STATUS='REPLACE')
+ close(unitoutrecdates)
+ endif
+ open(unitoutrecdates,file=path(2)(1:length(2))//'dates_receptors', &
+ ACCESS='APPEND', STATUS='OLD')
+ write(unitoutrecdates,'(a)') adate//atime
+ close(unitoutrecdates)
+
+ ! For netcdf output open files and get variable info
+ !***************************************************
+
+ if (lnetcdfout.eq.1) then
+#ifdef USE_NCF
+ if (numreceptor.gt.0) then
+ call receptor_output_netcdf()
+ endif
+ if (numsatreceptor.gt.0) then
+ call satellite_output_netcdf()
+ endif
+#endif
+ endif
+
+ !! testing
+! print*, 'receptor_mod: concvar_id = ',concvar_id
+! print*, 'receptor_mod: satvar_id = ',satvar_id
+
+
+ ! Initialize variables
+ !*********************
+
+#if (defined _OPENMP)
+ nthreads=OMP_GET_MAX_THREADS()
+#else
+ nthreads=1
+#endif
+
+ !! testing
+! print*, 'receptor_mod: nthread = ',nthreads
+
+ allocate(densityoutrecept(nlayermax))
+ allocate(nnrec(maxrecsample,nlayermax),&
+ xkrec(maxrecsample,nlayermax),&
+ lonrec(maxrecsample),&
+ latrec(maxrecsample),&
+ altrec(maxrecsample,nlayermax),&
+ namerec(maxrecsample),&
+ timerec(maxrecsample),&
+ crec(nspec,maxrecsample,nlayermax),&
+ cunc(nspec,maxrecsample,nlayermax))
+ allocate(nnrec_omp(maxrecsample,nlayermax,nthreads),&
+ xkrec_omp(maxrecsample,nlayermax,nthreads),&
+ lonrec_omp(maxrecsample,nthreads),&
+ latrec_omp(maxrecsample,nthreads),&
+ altrec_omp(maxrecsample,nlayermax,nthreads),&
+ namerec_omp(maxrecsample,nthreads),&
+ timerec_omp(maxrecsample,nthreads),&
+ crec_omp(nspec,maxrecsample,nlayermax,nthreads),&
+ cunc_omp(nspec,maxrecsample,nlayermax,nthreads))
+ allocate(nr_omp(nthreads))
+ nnrec(:,:)=0.
+ xkrec(:,:)=0.
+ crec(:,:,:)=0.
+ cunc(:,:,:)=0.
+ nnrec_omp(:,:,:)=0.
+ xkrec_omp(:,:,:)=0.
+ crec_omp(:,:,:,:)=0.
+ cunc_omp(:,:,:,:)=0.
+ nr_omp(:)=0
+
+ ! Loop over general receptors
+ !****************************
+
+ write(*,fmt='(A,1X,I8,1X,A,1X,I3)') 'Number of receptors output at itime ',itime,'is',numcurrec
+
+!$OMP PARALLEL &
+!$OMP PRIVATE(n,k,nn,nr,ix,jy,ixp,jyp,ddx,ddy,rddx,rddy,p1,p2,p3,p4,indz,indzp,il,dz1,dz2,dz, &
+!$OMP ind,rho_p,rhoi,densityoutrecept,ks,thread)
+
+#if (defined _OPENMP)
+ thread=OMP_GET_THREAD_NUM()+1 ! Starts with 1
+#else
+ thread=1
+#endif
+
+ nr=0
+!$OMP DO
+ do k=1,numcurrec
+
+ if (cpointer(k).eq.0.) cycle
+
+ ! number of the receptor
+ n=cpointer(k)
+
+ ! counter of receptor values this time interval
+ nr=nr+1
+ nr_omp(thread)=nr
+
+ !! testing
+! print*, 'receptor_mod: n, thread, nr, cpointer(k), rpointer = ',n, thread, nr, cpointer(k), rpointer
+
+ if (((.not.llcmoutput).and.(iout.eq.2)).or.&
+ (llcmoutput.and.((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)))) then
+
+ ! Compute air density
+ !*********************
+
+ ix=int(xreceptor(n))
+ jy=int(yreceptor(n))
+ ixp=ix+1
+ jyp=jy+1
+ ddx=xreceptor(n)-float(ix)
+ ddy=yreceptor(n)-float(jy)
+ rddx=1.-ddx
+ rddy=1.-ddy
+ p1=rddx*rddy
+ p2=ddx*rddy
+ p3=rddx*ddy
+ p4=ddx*ddy
+
+ indz=nzmax-1
+ indzp=nzmax
+ do il=2,nzmax
+ if (height(il).gt.zreceptor(n)) then
+ indz=il-1
+ indzp=il
+ exit
+ endif
+ end do
+
+ dz1=zreceptor(n)-height(indz)
+ dz2=height(indzp)-zreceptor(n)
+ dz=1./(dz1+dz2)
+
+ ! Take density from 2nd wind field in memory
+ !********************************************
+
+ do ind=indz,indzp
+ ! assume moist air density
+ rho_p(ind-indz+1)=p1*rho(ix ,jy ,ind,2) + &
+ p2*rho(ixp,jy ,ind,2) + &
+ p3*rho(ix ,jyp,ind,2) + &
+ p4*rho(ixp,jyp,ind,2)
+ ! dry air density
+! rho_p(ind-indz+1)= &
+! p1*rho(ix ,jy ,ind,2)*(1. - qv(ix ,jy ,ind,2)) + &
+! p2*rho(ixp,jy ,ind,2)*(1. - qv(ixp,jy ,ind,2)) + &
+! p3*rho(ix ,jyp,ind,2)*(1. - qv(ix ,jyp,ind,2)) + &
+! p4*rho(ixp,jyp,ind,2)*(1. - qv(ixp,jyp,ind,2))
+ end do
+ rhoi=(dz1*rho_p(2)+dz2*rho_p(1))*dz
+
+ if (.not.llcmoutput) then
+ densityoutrecept(1)=1./rhoi
+ else
+ densityoutrecept(1)=rhoi
+ endif
+
+ else
+
+ ! no multiplication or division by air density
+ densityoutrecept(1)=1.
+
+ endif ! llcmoutput
+
+ ! Write receptor output
+ !**********************
+ ! llcmoutput = true: creceptor = m_spec/m_air
+ ! llcmoutput = false: creceptor = m_spec/V
+
+ if (recoutnum(k).gt.0.) then
+ do ks = ks_start,nspec
+ ! write mass concentration
+ if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
+ ! concentration (ng/m3)
+ crec_omp(ks,nr,1,thread)=creceptor(ks,k)*1.E12*densityoutrecept(1)/recoutnum(k)
+ cunc_omp(ks,nr,1,thread)=crecuncert(ks,k)*1.E12*densityoutrecept(1)/recoutnum(k)
+ else if (iout.eq.2) then
+ ! mixing ratio (ppt)
+ ! note: for iout=3 (both conc and mixing ratio) only output conc at receptors
+ crec_omp(ks,nr,1,thread)=creceptor(ks,k)*1.E12*densityoutrecept(1)* &
+ weightair/weightmolar(ks)/recoutnum(k)
+ cunc_omp(ks,nr,1,thread)=crecuncert(ks,k)*1.E12*densityoutrecept(1)* &
+ weightair/weightmolar(ks)/recoutnum(k)
+ endif
+ end do
+ nnrec_omp(nr,1,thread)=nnreceptor(k)/recoutnum(k)
+ xkrec_omp(nr,1,thread)=xkreceptor(k)/recoutnum(k)
+ else
+ ! no particles found in kernel for this receptor
+ crec_omp(:,nr,1,thread)=-999.
+ cunc_omp(:,nr,1,thread)=-999.
+ nnrec_omp(nr,1,thread)=-999.
+ xkrec_omp(nr,1,thread)=-999.
+ endif
+ lonrec_omp(nr,thread)=xreceptor(n)*dx+xlon0
+ latrec_omp(nr,thread)=yreceptor(n)*dy+ylat0
+ altrec_omp(nr,1,thread)=zreceptor(n)
+ timerec_omp(nr,thread)=treceptor(n)
+ namerec_omp(nr,thread)=receptorname(n)
+
+ end do ! numcurrec
+!$OMP END DO
+!$OMP END PARALLEL
+
+ ! concatentate from all threads
+ nr=1
+ do ithread=1,nthreads
+ !! testing
+! print*, 'receptor_mod: nr_omp(ithread) = ',nr_omp(ithread)
+ if (nr_omp(ithread).eq.0) cycle
+ crec(:,nr:(nr+nr_omp(ithread)-1),1)=crec_omp(:,1:nr_omp(ithread),1,ithread)
+ cunc(:,nr:(nr+nr_omp(ithread)-1),1)=cunc_omp(:,1:nr_omp(ithread),1,ithread)
+ nnrec(nr:(nr+nr_omp(ithread)-1),1)=nnrec_omp(1:nr_omp(ithread),1,ithread)
+ xkrec(nr:(nr+nr_omp(ithread)-1),1)=xkrec_omp(1:nr_omp(ithread),1,ithread)
+ lonrec(nr:(nr+nr_omp(ithread)-1))=lonrec_omp(1:nr_omp(ithread),ithread)
+ latrec(nr:(nr+nr_omp(ithread)-1))=latrec_omp(1:nr_omp(ithread),ithread)
+ altrec(nr:(nr+nr_omp(ithread)-1),1)=altrec_omp(1:nr_omp(ithread),1,ithread)
+ timerec(nr:(nr+nr_omp(ithread)-1))=timerec_omp(1:nr_omp(ithread),ithread)
+ namerec(nr:(nr+nr_omp(ithread)-1))=namerec_omp(1:nr_omp(ithread),ithread)
+ nr=nr+nr_omp(ithread)
+ !! testing
+! print*, 'receptor_mod: nr = ',nr
+ end do
+
+ ! total number of receptors to write this interval
+ nr=nr-1
+
+ ! write receptor output this time interval
+ if (nr.gt.0) then
+ if (lnetcdfout.eq.1) then
+#if USE_NCF
+ call write_receptor_netcdf(crec,cunc,nnrec,xkrec,lonrec,latrec,altrec,timerec,namerec,nr)
+#endif
+ else
+ call write_receptor_binary(crec,cunc,nnrec,xkrec,lonrec,latrec,altrec,timerec,namerec,nr)
+ endif
+ endif
+ ! advance output index
+ rpointer=rpointer+nr
+
+ !! testing
+! print*, 'receptor_mod: nr_omp = ',nr_omp
+! print*, 'receptor_mod: rpointer = ',rpointer
+
+ ! Loop over satellites
+ !*********************
+
+ nnrec(:,:)=0.
+ xkrec(:,:)=0.
+ crec(:,:,:)=0.
+ cunc(:,:,:)=0.
+ nnrec_omp(:,:,:)=0.
+ xkrec_omp(:,:,:)=0.
+ crec_omp(:,:,:,:)=0.
+ cunc_omp(:,:,:,:)=0.
+ nr_omp(:)=0
+
+ write(*,fmt='(A,1X,I8,1X,A,1X,I3)') 'Number of satellite receptors output at itime ',itime,'is',numcursat
+
+!$OMP PARALLEL &
+!$OMP PRIVATE(n,nr,nn,nchar,k,ix,jy,ixp,jyp,ddx,ddy,rddx,rddy,p1,p2,p3,p4,kz,numsatlayer,zmid,indz,indzp, &
+!$OMP il,dz1,dz2,dz,ind,rho_p,rhoi,densityoutrecept,ks,thread)
+
+#if (defined _OPENMP)
+ thread=OMP_GET_THREAD_NUM()+1 ! Starts with 1
+#else
+ thread=1
+#endif
+
+ nr=0
+!$OMP DO
+ do k=1,numcursat
+
+ if (csatpointer(k).eq.0) cycle
+
+ ! number of satellite receptor
+ n=csatpointer(k)
+
+ ! counter of receptor values this time interval
+ nr=nr+1
+ nr_omp(thread)=nr
+
+ !! testing
+! print*, 'receptor_mod: n, thread, nr, csatpointer(k) = ',n, thread, nr, csatpointer(k)
+
+ ! get actual number vertical layers for this retrieval
+ do nn=1,numsatellite
+ nchar=len_trim(sat_name(nn))
+ if (satellitename(n)(1:nchar).eq.trim(sat_name(nn))) then
+ numsatlayer=nnsatlayer(nn)
+ exit
+ endif
+ end do
+
+ if (.not.llcmoutput) then
+
+ ! Compute air density
+ !*********************
+
+ ix=int(xsatellite(n))
+ jy=int(ysatellite(n))
+ ixp=ix+1
+ jyp=jy+1
+ ddx=xsatellite(n)-float(ix)
+ ddy=ysatellite(n)-float(jy)
+ rddx=1.-ddx
+ rddy=1.-ddy
+ p1=rddx*rddy
+ p2=ddx*rddy
+ p3=rddx*ddy
+ p4=ddx*ddy
+
+ do kz=1,numsatlayer
+
+ zmid=0.5*(zsatellite(kz,n)+zsatellite(kz+1,n))
+ indz=nzmax-1
+ indzp=nzmax
+ do il=2,nzmax
+ if (height(il).gt.zmid) then
+ indz=il-1
+ indzp=il
+ exit
+ endif
+ end do
+
+ dz1=zmid-height(indz)
+ dz2=height(indzp)-zmid
+ dz=1./(dz1+dz2)
+
+ ! Take density from 2nd wind field in memory
+ !********************************************
+
+ do ind=indz,indzp
+ ! assume moist air density
+ rho_p(ind-indz+1)=p1*rho(ix ,jy ,ind,2) + &
+ p2*rho(ixp,jy ,ind,2) + &
+ p3*rho(ix ,jyp,ind,2) + &
+ p4*rho(ixp,jyp,ind,2)
+ ! dry air density
+! rho_p(ind-indz+1)= &
+! p1*rho(ix ,jy ,ind,2)*(1. - qv(ix ,jy ,ind,2)) + &
+! p2*rho(ixp,jy ,ind,2)*(1. - qv(ixp,jy ,ind,2)) + &
+! p3*rho(ix ,jyp,ind,2)*(1. - qv(ix ,jyp,ind,2)) + &
+! p4*rho(ixp,jyp,ind,2)*(1. - qv(ixp,jyp,ind,2))
+ end do
+ rhoi=(dz1*rho_p(2)+dz2*rho_p(1))*dz
+ densityoutrecept(kz)=1./rhoi
+
+ end do ! numsatlayer
+
+ else
+
+ ! no normalization by density
+ densityoutrecept(:)=1.
+
+ endif ! llcmoutput
+
+ ! Write receptor output
+ !**********************
+
+ do kz=1,numsatlayer
+ if (recoutnumsat(kz,k).gt.0.) then
+ do ks = ks_start,nspec
+ ! only mixing ratio (ppt) for satellites
+ crec_omp(ks,nr,kz,thread)=csatellite(ks,kz,k)*1.E12*densityoutrecept(kz)* &
+ weightair/weightmolar(ks)/recoutnumsat(kz,k)
+ cunc_omp(ks,nr,kz,thread)=csatuncert(ks,kz,k)*1.E12*densityoutrecept(kz)* &
+ weightair/weightmolar(ks)/recoutnumsat(kz,k)
+ end do
+ nnrec_omp(nr,kz,thread)=nnsatellite(kz,k)/recoutnumsat(kz,k)
+ xkrec_omp(nr,kz,thread)=xksatellite(kz,k)/recoutnumsat(kz,k)
+ else
+ crec_omp(:,nr,kz,thread)=-999.
+ cunc_omp(:,nr,kz,thread)=-999.
+ nnrec_omp(nr,kz,thread)=-999.
+ xkrec_omp(nr,kz,thread)=-999.
+ endif
+ end do
+ lonrec_omp(nr,thread)=xsatellite(n)*dx+xlon0
+ latrec_omp(nr,thread)=ysatellite(n)*dy+ylat0
+ altrec_omp(nr,:,thread)=zsatellite(:,n)
+ timerec_omp(nr,thread)=tsatellite(n)
+ namerec_omp(nr,thread)=satellitename(n)
+
+ end do ! numcursat
+!$OMP END DO
+!$OMP END PARALLEL
+
+ ! concatentate from all threads
+ nr=1
+ do ithread=1,nthreads
+ !! testing
+! print*, 'receptor_mod: satellites, nr_omp(ithread) = ',nr_omp(ithread)
+ if (nr_omp(ithread).eq.0) cycle
+ crec(:,nr:nr+nr_omp(ithread)-1,:)=crec_omp(:,1:nr_omp(ithread),:,ithread)
+ cunc(:,nr:nr+nr_omp(ithread)-1,:)=cunc_omp(:,1:nr_omp(ithread),:,ithread)
+ nnrec(nr:nr+nr_omp(ithread)-1,:)=nnrec_omp(1:nr_omp(ithread),:,ithread)
+ xkrec(nr:nr+nr_omp(ithread)-1,:)=xkrec_omp(1:nr_omp(ithread),:,ithread)
+ lonrec(nr:nr+nr_omp(ithread)-1)=lonrec_omp(1:nr_omp(ithread),ithread)
+ latrec(nr:nr+nr_omp(ithread)-1)=latrec_omp(1:nr_omp(ithread),ithread)
+ altrec(nr:nr+nr_omp(ithread)-1,:)=altrec_omp(1:nr_omp(ithread),:,ithread)
+ timerec(nr:nr+nr_omp(ithread)-1)=timerec_omp(1:nr_omp(ithread),ithread)
+ namerec(nr:nr+nr_omp(ithread)-1)=namerec_omp(1:nr_omp(ithread),ithread)
+ nr=nr+nr_omp(ithread)
+ !! testing
+! print*, 'receptor_mod: satellites, nr = ',nr
+ end do
+
+ ! total number of receptors to write this interval
+ nr=nr-1
+
+ ! write satellite output this time interval
+ if (nr.gt.0) then
+ if (lnetcdfout.eq.1) then
+#if USE_NCF
+ call write_satellite_netcdf(crec,cunc,nnrec,xkrec,lonrec,latrec,altrec,timerec,namerec,nr)
+#endif
+ else
+ call write_satellite_binary(crec,cunc,nnrec,xkrec,lonrec,latrec,altrec,timerec,namerec,nr)
+ endif
+ endif
+ ! advance output index
+ spointer=spointer+nr
+
+ !! testing
+! print*, 'receptor_mod: satellites, nr_omp = ',nr_omp
+! print*, 'receptor_mod: spointer = ',spointer
+
+ ! close files
+ if (lnetcdfout.eq.1) then
+#ifdef USE_NCF
+ if (numreceptor.gt.0) then
+ call close_receptor_netcdf
+ endif
+ if (numsatreceptor.gt.0) then
+ call close_satellite_netcdf
+ endif
+#endif
+ endif
+
+ deallocate(densityoutrecept)
+ deallocate(crec,cunc,nnrec,xkrec)
+ deallocate(crec_omp,cunc_omp,nnrec_omp,xkrec_omp)
+ deallocate(lonrec,latrec,altrec,timerec,namerec)
+ deallocate(lonrec_omp,latrec_omp,altrec_omp,timerec_omp,namerec_omp)
+ deallocate(nr_omp)
+
+ ! End of receptor output
+ !***********************
+
+ recoutnum(:)=0.
+ recoutnumsat(:,:)=0.
+
+ endif ! output receptor conc
+
+ endif ! receptor output
+
+ if (itime.eq.lrecoutend) then
+
+ ! Reinitialize
+ !*************
+
+ creceptor(:,:)=0.
+ crecuncert(:,:)=0.
+ nnreceptor(:)=0.
+ xkreceptor(:)=0.
+ if (numsatreceptor.gt.0) then
+ csatellite(:,:,:)=0.
+ csatuncert(:,:,:)=0.
+ nnsatellite(:,:)=0.
+ xksatellite(:,:)=0.
+ endif
+
+ recoutnum(:)=0.
+ recoutnumsat(:,:)=0.
+
+ ! Update output timesteps
+ !************************
+ lrecoutnext=lrecoutnext+lrecoutstep
+ lrecoutstart=lrecoutnext-lrecoutaver/2
+ lrecoutend=lrecoutnext+lrecoutaver/2
+
+ if (itime.eq.lrecoutstart) then
+ weight=0.5
+ call receptorcalc(itime,weight,lrecoutstart,lrecoutend,recoutnum,recoutnumsat)
+ endif
+
+ endif
+
+ end subroutine receptoroutput
+
+
+ subroutine receptorcalc(itime,weight,lrecoutstart,lrecoutend,recoutnum,recoutnumsat)
+
+ !*****************************************************************************
+ ! *
+ ! Calculation of the concentrations at receptor points using the *
+ ! kernel method *
+ ! *
+ ! Author: A. Stohl *
+ ! *
+ ! Modifications: *
+ ! Sep-2023, R. Thompson: added option for domain filling mode *
+ ! *
+ !*****************************************************************************
+
+ implicit none
+
+ integer :: itime, itage, lrecoutstart, lrecoutend
+ real, dimension(maxrecsample) :: recoutnum
+ real, dimension(nlayermax,maxrecsample) :: recoutnumsat
+ real :: weight
+ real :: xd, yd, zd, hx, hy, hz, h, r2, xkern
+ real, dimension(nspec) :: conc
+ real, dimension(:,:), allocatable :: unc
+ integer :: n, j, k, ks, kz, i, nn, ks_start, nchar, numsatlayer
+ real :: hxmax, hymax, hzmax, hxsat, hysat, rec_ff, xksum, eta, zmid
+ real, parameter :: factor=.596831 ! 15/(8*pi)
+ real, parameter :: zref=2000. ! normalizing height for calculating eta
+ integer, parameter :: jmax=4000 ! max number of particles in kernel
+
+ ! initialization
+ !***************
+
+ if (llcmoutput) then
+ ks_start=2
+ else
+ ks_start=1
+ endif
+ allocate(unc(nspec,jmax))
+
+ ! hxmax and hymax in degrees, hzmax in metres
+ !********************************************
+
+ if (mdomainfill.ne.1) then
+ hxmax=6.0
+ hymax=4.0
+ hzmax=150.
+ else
+ hxmax=2.0
+ hymax=1.5
+ hzmax=300.
+ hxsat=1.75
+ hysat=1.25
+ endif
+
+ ! convert h-values to grid coordinates
+ !*************************************
+
+ hxmax=hxmax/dx
+ hymax=hymax/dy
+ hxsat=hxsat/dx
+ hysat=hysat/dy
+
+ ! Loop over receptors
+ !********************
+
+ ! pointer for creceptor, xkreceptor and nnreceptor
+ numcurrec=0
+ cpointer(:)=0
+ k=0
+
+ do n=1,numreceptor
+
+ if ((treceptor(n).lt.lrecoutstart).or. &
+ (treceptor(n).ge.lrecoutend)) cycle ! skip if not in current sampling time interval
+
+ ! update pointer
+ k=k+1
+ if (k.gt.maxrecsample) then
+ write(*,*) 'FLEXPART ERROR in receptorcalc: maxrecsample too small'
+ error stop
+ endif
+ cpointer(k)=n
+
+ !! testing
+! print*, 'receptorcalc: n, receptorname(n) = ',n, receptorname(n)
+
+ ! Reset concentrations for new receptor
+ conc(:)=0.
+ unc(:,:)=0.
+ xksum=0.
+ j=0
+
+ if (zreceptor(n).lt.hzmax) then
+ rec_ff=0.5 + 0.9375*(zreceptor(n)/hzmax) - &
+ 0.625*(zreceptor(n)/hzmax)**3 + &
+ 0.1875*(zreceptor(n)/hzmax)**5
+ rec_ff=1./rec_ff
+ else
+ rec_ff=1.
+ endif
+ h=hxmax*hymax*hzmax
+
+ !! testing
+! print*, 'receptorcalc: rec_ff = ',rec_ff
+
+ ! Estimate concentration at receptor
+ !***********************************
+
+!$OMP PARALLEL &
+!$OMP PRIVATE(i,itage,hz,zd,hx,xd,hy,yd,h,r2,xkern,ks) &
+!$OMP SHARED(j,unc,conc) &
+!$OMP REDUCTION(+:xksum,xkreceptor,nnreceptor)
+
+!$OMP DO
+ do i=1,count%alive
+
+ if (mdomainfill.ne.1) then
+
+ ! not domain filling run so consider age of particle
+ itage=abs(itime-part(i)%tstart)
+
+ hz=min(50.+0.3*sqrt(real(itage)),hzmax)
+ zd=part(i)%z/hz
+ if (zd.gt.1.) cycle ! save computing time
+
+ hx=min((0.29+2.222e-3*sqrt(real(itage)))*dx+ &
+ real(itage)*1.2e-5,hxmax) ! 80 km/day
+ xd=(part(i)%xlon-xreceptor(n))/hx
+ if (xd*xd.gt.1.) cycle ! save computing time
+
+ hy=min((0.18+1.389e-3*sqrt(real(itage)))*dy+ &
+ real(itage)*7.5e-6,hymax) ! 80 km/day
+ yd=(part(i)%ylat-yreceptor(n))/hy
+ if (yd*yd.gt.1.) cycle ! save computing time
+ h=hx*hy*hz
+
+ r2=xd*xd+yd*yd+zd*zd
+ if (r2.ge.1.) cycle ! save computing time
+ xkern=2.*factor*(1.-r2) ! parabolic kernel
+
+ else
+
+ ! domain filling run
+ xd=(part(i)%xlon-xreceptor(n))/hxmax
+ if (xd*xd.gt.1) cycle ! save computing time
+
+ yd=(part(i)%ylat-yreceptor(n))/hymax
+ if (yd*yd.gt.1.) cycle ! save computing time
+
+ zd=(part(i)%z-zreceptor(n))/hzmax
+ if (zd*zd.gt.1.) cycle ! save computing time
+
+ r2=xd*xd+yd*yd+zd*zd
+ if (r2.ge.1.) cycle ! save computing time
+ xkern=rec_ff*factor*(1.-r2) ! parabolic kernel
+
+ endif ! mdomainfill
+
+ ! counter of particles used in conc calculation
+ ! note: use of atomic may not be efficient, alternative split unc, j over threads
+ ! and combine all threads after end of parallel section, need to save j from each thread
+!$OMP ATOMIC
+ j=j+1
+ if (j.gt.jmax) then
+ write(*,*) 'FLEXPART ERROR in receptorcalc: size of jmax too small'
+ error stop
+ endif
+
+ do ks=ks_start,nspec
+ if (llcmoutput) then
+ ! special case LCM output use mass ratio species to airtracer
+ ! species 1 is always airtracer
+ conc(ks)=conc(ks) + mass(i,ks)/mass(i,1) * &
+ weight * xkern
+ unc(ks,j)=mass(i,ks)/mass(i,1)
+ else
+ ! normal case
+ conc(ks)=conc(ks) + mass(i,ks) * &
+ weight * xkern/h/receptorarea(n)
+ unc(ks,j)=mass(i,ks)/h/receptorarea(n)
+ endif
+ end do
+ nnreceptor(k)=nnreceptor(k) + 1.
+ xkreceptor(k)=xkreceptor(k) + xkern
+ xksum=xksum + xkern
+
+ end do ! count%alive
+!$OMP END DO
+!$OMP END PARALLEL
+
+!$OMP PARALLEL IF(nspec>99) PRIVATE(ks)
+!$OMP DO
+ do ks=ks_start,nspec
+ if (conc(ks).gt.0.) then
+ ! only do if conc could be calculated for this receptor at this time
+ creceptor(ks,k)=creceptor(ks,k) + conc(ks)/xksum
+ crecuncert(ks,k)=crecuncert(ks,k) + &
+ sqrt(sum((unc(ks,1:j)-conc(ks)/xksum/weight)**2)/real(j))
+ endif
+ end do
+!$OMP END DO
+!$OMP END PARALLEL
+ if (any(conc(:).gt.0.)) then
+ recoutnum(k)=recoutnum(k)+weight
+ endif
+
+ ! update number receptors this time interval
+ numcurrec=k
+
+ !! testing
+! print*, 'receptorcalc: j, conc, xksum = ',j, conc(2), xksum
+! print*, 'receptorcalc: n, k, cpointer(k) = ',n, k, cpointer(k)
+! print*, 'receptorcalc: nnreceptor(k) = ',nnreceptor(k)
+! print*, 'receptorcalc: xkreceptor(k) = ',xkreceptor(k)
+! print*, 'receptorcalc: creceptor(2,k) = ',creceptor(2,k)
+! print*, 'receptorcalc: crecuncert(2,k) = ',crecuncert(2,k)
+
+ end do ! numreceptor
+
+ ! Loop over satellites
+ !*********************
+
+ ! pointer for csatellite, xksatellite and nnsatellite
+ numcursat=0
+ csatpointer(:)=0
+ k=0
+
+ do n=1,numsatreceptor
+
+ if ((tsatellite(n).lt.lrecoutstart).or. &
+ (tsatellite(n).ge.lrecoutend)) cycle ! skip if not in current sampling time interval
+
+ !! testing
+! print*, 'receptorcalc: lrecoutstart, lrecoutend, tsatellite(n) = ',lrecoutstart, lrecoutend, tsatellite(n)
+
+ ! update pointer
+ k=k+1
+ if (k.gt.maxrecsample) then
+ write(*,*) 'FLEXPART ERROR in receptorcalc: maxrecsample too small'
+ error stop
+ endif
+ csatpointer(k)=n
+
+ ! get actual number vertical layers for this retrieval
+ do nn=1,numsatellite
+ nchar=len_trim(sat_name(nn))
+ if (satellitename(n)(1:nchar).eq.trim(sat_name(nn))) then
+ numsatlayer=nnsatlayer(nn)
+ exit
+ endif
+ end do
+
+ !! testing
+! print*, 'receptorcalc: n, satellitename(n) = ',n, satellitename(n)
+
+ do kz=1,numsatlayer
+
+ ! Reset concentrations for new receptor
+ conc(:)=0.
+ unc(:,:)=0.
+ xksum=0.
+ j=0
+
+ ! height of layer
+ hz=zsatellite(kz+1,n)-zsatellite(kz,n)
+
+ ! rare cases when 2 satellite pressure layers fall in same meteo layer
+ ! set minimum height between layers
+ hz=max(200.,hz)
+
+ ! midpoint of layer
+ zmid=zsatellite(kz,n)+0.5*hz
+
+ ! factor by which to expand horizontal threshhold
+ ! as expect particle density to decrease with altitude
+ eta=max(1.,sqrt(0.5*zmid/zref))
+
+ h=hxsat*hysat*(0.5*hz)
+
+ !! testing
+! print*, 'zmid, hz, eta =',zmid, hz, eta
+
+!$OMP PARALLEL &
+!$OMP PRIVATE(i,zd,xd,yd,r2,xkern,ks) &
+!$OMP SHARED(j,unc,conc) &
+!$OMP REDUCTION(+:xksum,xksatellite,nnsatellite)
+
+!$OMP DO
+ do i=1,count%alive
+
+ ! sample satellite retrievals for domain-filling and
+ ! non-domain-filling modes in the same way
+
+ zd=(part(i)%z-zmid)/(0.5*hz)
+ if (zd*zd.gt.1.) cycle ! save computing time
+
+ xd=(part(i)%xlon-xsatellite(n))/(eta*hxsat)
+ if (xd*xd.gt.1) cycle ! save computing time
+
+ yd=(part(i)%ylat-ysatellite(n))/(eta*hysat)
+ if (yd*yd.gt.1.) cycle ! save computing time
+
+ r2=xd*xd+yd*yd+zd*zd
+ if (r2.ge.1.) cycle ! save computing time
+
+ xkern=factor*(1.-r2) ! parabolic kernel
+
+ ! counter of particles used in conc calculation
+!$OMP ATOMIC
+ j=j+1
+ if (j.gt.jmax) then
+ write(*,*) 'FLEXPART ERROR in receptorcalc: size of jmax too small'
+ error stop
+ endif
+
+ do ks=ks_start,nspec
+ if (llcmoutput) then
+ ! special case LCM output use mass ratio species to airtracer
+ ! species 1 is always airtracer
+ conc(ks)=conc(ks) + mass(i,ks)/mass(i,1) * &
+ weight * xkern
+ unc(ks,j)=mass(i,ks)/mass(i,1)
+ else
+ ! normal case
+ conc(ks)=conc(ks) + mass(i,ks) * &
+ weight * xkern/h/satellitearea(n)
+ unc(ks,j)=mass(i,ks)/h/satellitearea(n)
+ endif
+ end do
+ nnsatellite(kz,k)=nnsatellite(kz,k) + 1.
+ xksatellite(kz,k)=xksatellite(kz,k) + xkern
+ xksum=xksum + xkern
+
+ end do ! count%alive
+!$OMP END DO
+!$OMP END PARALLEL
+
+!$OMP PARALLEL IF(nspec>99) PRIVATE(ks)
+!$OMP DO
+ do ks=ks_start,nspec
+ if (conc(ks).gt.0.) then
+ ! only do if conc could be calculated for this receptor and time
+ csatellite(ks,kz,k)=csatellite(ks,kz,k) + conc(ks)/xksum
+ csatuncert(ks,kz,k)=csatuncert(ks,kz,k) + &
+ sqrt(sum((unc(ks,1:j)-conc(ks)/xksum/weight)**2)/real(j))
+ endif
+ end do
+!$OMP END DO
+!$OMP END PARALLEL
+ if (any(conc(:).gt.0.)) then
+ recoutnumsat(kz,k)=recoutnumsat(kz,k)+weight
+ endif
+
+ !! testing
+! print*, 'receptorcalc: for satellite: j, conc, xksum = ',j, conc(2), xksum
+! print*, 'receptorcalc: n, k, csatpointer(k) = ',n, k, csatpointer(k)
+! print*, 'receptorcalc: nnsatellite(:,k) = ',nnsatellite(:,k)
+! print*, 'receptorcalc: xksatellite(:,k) = ',xksatellite(:,k)
+
+ end do ! numsatlayer
+
+ ! update current number of satellite receptors this time interval
+ numcursat=k
+
+ end do ! numsatreceptor
+
+ end subroutine receptorcalc
+
+
+end module receptor_mod
+
diff --git a/src/receptor_netcdf_mod.f90 b/src/receptor_netcdf_mod.f90
new file mode 100644
index 0000000000000000000000000000000000000000..1c7de4ad36a5a1a7ff214a659df0283419abc434
--- /dev/null
+++ b/src/receptor_netcdf_mod.f90
@@ -0,0 +1,985 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2019, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+module receptor_netcdf_mod
+
+ !*****************************************************************************
+ ! *
+ ! This module contains variables and subroutines for reading input *
+ ! for satellite receptors and for saving the output of all receptor *
+ ! types to netcdf file *
+ ! *
+ ! Author, Rona Thompson *
+ ! *
+ !*****************************************************************************
+
+ use netcdf
+ use par_mod
+ use com_mod
+ use point_mod
+ use date_mod
+ use netcdf_output_mod, only: nf90_err
+ use windfields_mod, only: prs, height, nzmax, nz
+
+ implicit none
+
+ ! general receptors
+ integer :: rpointer
+ integer :: nc_id
+ integer :: recdim_id, nchardim_id
+ integer :: timevar_id, recvar_id, reclonvar_id, reclatvar_id, recaltvar_id, recnamevar_id
+ integer, dimension(:), allocatable :: concvar_id, uncvar_id
+ integer :: nnvar_id, xkvar_id
+ ! satellite receptors
+ integer :: spointer
+ character(len=8), dimension(:), allocatable :: sat_name
+ integer :: ncsat_id
+ integer :: satrecdim_id, sataltdim_id, satlayerdim_id
+ integer :: sattimevar_id, satrecvar_id, satlonvar_id, satlatvar_id, sataltvar_id, satnamevar_id
+ integer, dimension(:), allocatable :: satvar_id, satuncvar_id
+ integer :: satnnvar_id, satxkvar_id
+
+ contains
+
+ subroutine receptorout_init
+
+ !*****************************************************************************
+ ! *
+ ! Intitialize netcdf files for receptor concentrations *
+ ! *
+ ! Author: R. Thompson, Sep-2023 *
+ ! *
+ ! *
+ !*****************************************************************************
+
+ implicit none
+
+ character(len=256) :: fn, timeunit
+ character(len=8) :: adate
+ character(len=6) :: atime
+ integer :: ks, n, ks_start
+ character(8) :: date
+ character(10) :: time
+ character(5) :: zone
+
+ if (numreceptor.eq.0) then
+ return
+ endif
+
+ if (llcmoutput) then
+ ks_start=2
+ else
+ ks_start=1
+ endif
+
+ ! time at simulation start
+ if (ldirect.eq.1) then
+ write(adate,'(i8.8)') ibdate
+ write(atime,'(i6.6)') ibtime
+ else
+ write(adate,'(i8.8)') iedate
+ write(atime,'(i6.6)') ietime
+ end if
+
+ if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
+ ! concentration output file
+ write(fn,'(A)') path(2)(1:length(2))//'receptor_conc.nc'
+ else if (iout.eq.2) then
+ ! mixing ratio output file
+ ! note: for iout=3 (both conc and mixing ratio) only output conc at receptors
+ write(fn,'(A)') path(2)(1:length(2))//'receptor_pptv.nc'
+ endif
+
+ ! initialization
+ if (.not.allocated(concvar_id)) then
+ allocate(concvar_id(nspec))
+ allocate(uncvar_id(nspec))
+ endif
+
+ ! pointer for receptor dimension
+ rpointer=1
+
+ ! create file
+ call nf90_err( nf90_create(trim(fn), nf90_clobber, nc_id) )
+
+ ! define dimensions
+ !******************
+
+ call nf90_err( nf90_def_dim(nc_id, "rec", numreceptor, recdim_id) )
+ call nf90_err( nf90_def_dim(nc_id, 'nchar', 16, nchardim_id) )
+
+ ! define variables
+ !*****************
+
+ ! time
+ timeunit = 'seconds since '//adate(1:4)//'-'//adate(5:6)// &
+ '-'//adate(7:8)//' '//atime(1:2)//':'//atime(3:4)
+ call nf90_err( nf90_def_var(nc_id, 'time', nf90_int, (/ recdim_id /), timevar_id) )
+ call nf90_err( nf90_put_att(nc_id, timevar_id, 'units', trim(timeunit)) )
+ call nf90_err( nf90_put_att(nc_id, timevar_id, 'calendar', 'proleptic_gregorian') )
+
+ ! receptors
+ call nf90_err( nf90_def_var(nc_id, "rec", nf90_float, (/ recdim_id /), recvar_id) )
+ call nf90_err( nf90_put_att(nc_id, recvar_id, "longname", "receptors") )
+ call nf90_err( nf90_put_att(nc_id, recvar_id, "units", "index") )
+
+ ! receptor names
+ call nf90_err( nf90_def_var(nc_id, "receptorname", nf90_char, (/ nchardim_id, recdim_id /), &
+ recnamevar_id) )
+ call nf90_err( nf90_put_att(nc_id, recnamevar_id, "longname", "receptor name") )
+
+ ! receptor longitude
+ call nf90_err( nf90_def_var(nc_id, "lon", nf90_float, (/ recdim_id /), reclonvar_id) )
+ call nf90_err( nf90_put_att(nc_id, reclonvar_id, "longname", "receptor longitude") )
+ call nf90_err( nf90_put_att(nc_id, reclonvar_id, "units", "degrees_east") )
+
+ ! receptor latitude
+ call nf90_err( nf90_def_var(nc_id, "lat", nf90_float, (/ recdim_id /), reclatvar_id) )
+ call nf90_err( nf90_put_att(nc_id, reclatvar_id, "longname", "receptor latitude") )
+ call nf90_err( nf90_put_att(nc_id, reclatvar_id, "units", "degrees_north") )
+
+ ! receptor altitude
+ call nf90_err( nf90_def_var(nc_id, "lev", nf90_float, (/ recdim_id /), recaltvar_id) )
+ call nf90_err( nf90_put_att(nc_id, recaltvar_id, "longname", "receptor altitude") )
+ call nf90_err( nf90_put_att(nc_id, recaltvar_id, "units", "meters") )
+
+ ! species specific variables
+ do ks=ks_start,nspec
+ ! concentration/mixing ratio variables
+ call nf90_err( nf90_def_var(nc_id, trim(species(ks)), nf90_float, (/ recdim_id /), concvar_id(ks)) )
+ call nf90_err( nf90_def_var(nc_id, trim(species(ks))//"_uncert", nf90_float, (/ recdim_id /), &
+ uncvar_id(ks)) )
+ if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
+ call nf90_err( nf90_put_att(nc_id, concvar_id(ks), "units", "ng/m3") )
+ call nf90_err( nf90_put_att(nc_id, concvar_id(ks), "longname", "mean receptor concentration") )
+ call nf90_err( nf90_put_att(nc_id, uncvar_id(ks), "units", "ng/m3") )
+ call nf90_err( nf90_put_att(nc_id, uncvar_id(ks), "longname", "uncertainty receptor concentration") )
+ else if ((iout.eq.2)) then
+ call nf90_err( nf90_put_att(nc_id, concvar_id(ks), "units", "pptv") )
+ call nf90_err( nf90_put_att(nc_id, concvar_id(ks), "longname", "mean receptor VMR") )
+ call nf90_err( nf90_put_att(nc_id, uncvar_id(ks), "units", "pptv") )
+ call nf90_err( nf90_put_att(nc_id, uncvar_id(ks), "longname", "uncertainty receptor VMR") )
+ endif
+ end do
+
+ ! not species specific variables
+ ! number of particles in receptor output
+ call nf90_err( nf90_def_var(nc_id,"npart", nf90_float, (/ recdim_id /), nnvar_id) )
+ call nf90_err( nf90_put_att(nc_id, nnvar_id, "units", "counts") )
+ call nf90_err( nf90_put_att(nc_id, nnvar_id, "longname","number of particles at receptor") )
+ ! average kernel weight at receptor
+ call nf90_err( nf90_def_var(nc_id,"kernel", nf90_float, (/ recdim_id /), xkvar_id) )
+ call nf90_err( nf90_put_att(nc_id, xkvar_id, "units", "") )
+ call nf90_err( nf90_put_att(nc_id, xkvar_id, "longname", "average kernel weight at receptor") )
+
+ ! write global attributes
+ !************************
+
+ call date_and_time(date,time,zone)
+ call nf90_err( nf90_put_att(nc_id, nf90_global, 'Conventions', 'CF-1.6') )
+ call nf90_err( nf90_put_att(nc_id, nf90_global, 'title', 'FLEXPART receptor output') )
+ call nf90_err( nf90_put_att(nc_id, nf90_global, 'source', trim(flexversion)//' model output') )
+ call nf90_err( nf90_put_att(nc_id, nf90_global, 'history', date(1:4)//'-'//date(5:6)//&
+ '-'//date(7:8)//' '//time(1:2)//':'//time(3:4)//' '//zone ) )
+ call nf90_err( nf90_put_att(nc_id, nf90_global, 'references', &
+ 'Stohl et al., Atmos. Chem. Phys., 2005, doi:10.5194/acp-5-2461-200;'//&
+ 'Henne et al., in Lagrangian Modeling of the Atmosphere, 2012, doi:10.1029/2012GM001247') )
+
+ ! end definition
+ call nf90_err( nf90_enddef(nc_id) )
+
+ ! write dimension variables
+ !**************************
+
+ ! receptor index
+ call nf90_err( nf90_put_var(nc_id, recvar_id, (/(n,n=1,numreceptor)/)) )
+
+ ! close file
+ call nf90_err( nf90_close(nc_id) )
+
+ end subroutine receptorout_init
+
+
+ subroutine satelliteout_init
+
+ !*****************************************************************************
+ ! *
+ ! Intitialize netcdf files for satellite concentrations *
+ ! *
+ ! Author: R. Thompson, Oct-2023 *
+ ! *
+ ! *
+ !*****************************************************************************
+
+ implicit none
+
+ character(len=256) :: fn, timeunit
+ character(len=8) :: adate
+ character(len=6) :: atime
+ integer :: ks, n, ks_start
+ character(8) :: date
+ character(10) :: time
+ character(5) :: zone
+
+ if (numsatreceptor.eq.0) then
+ return
+ endif
+
+ if (llcmoutput) then
+ ks_start=2
+ else
+ ks_start=1
+ endif
+
+ ! time at simulation start
+ if (ldirect.eq.1) then
+ write(adate,'(i8.8)') ibdate
+ write(atime,'(i6.6)') ibtime
+ else
+ write(adate,'(i8.8)') iedate
+ write(atime,'(i6.6)') ietime
+ end if
+
+ ! mixing ratio output for satellites
+ write(fn,'(A)') path(2)(1:length(2))//'satellite_pptv.nc'
+
+ ! initialization
+ if (.not.allocated(satvar_id)) then
+ allocate(satvar_id(nspec))
+ allocate(satuncvar_id(nspec))
+ endif
+
+ ! pointer for satellite receptor dimension
+ spointer=1
+
+ ! create file
+ call nf90_err( nf90_create(trim(fn), nf90_clobber, ncsat_id) )
+
+ ! define dimensions
+ !******************
+
+ call nf90_err( nf90_def_dim(ncsat_id, "rec", numsatreceptor, satrecdim_id) )
+ call nf90_err( nf90_def_dim(ncsat_id, "layer", (nlayermax-1), satlayerdim_id) )
+ call nf90_err( nf90_def_dim(ncsat_id, "level", nlayermax, sataltdim_id) )
+ call nf90_err( nf90_def_dim(ncsat_id, 'nchar', 16, nchardim_id) )
+
+ ! define variables
+ !*****************
+
+ ! Note: did not include variables for kernel parameters as currently use same
+ ! at all sites and did not include windspeed, ageclasses, and release points
+
+ ! time
+ timeunit = 'seconds since '//adate(1:4)//'-'//adate(5:6)// &
+ '-'//adate(7:8)//' '//atime(1:2)//':'//atime(3:4)
+ call nf90_err( nf90_def_var(ncsat_id, 'time', nf90_int, (/ satrecdim_id /), sattimevar_id) )
+ call nf90_err( nf90_put_att(ncsat_id, sattimevar_id, 'units', trim(timeunit)) )
+ call nf90_err( nf90_put_att(ncsat_id, sattimevar_id, 'calendar', 'proleptic_gregorian') )
+
+ ! receptor names
+ call nf90_err( nf90_def_var(ncsat_id, "receptorname", nf90_char, (/ nchardim_id, satrecdim_id /), &
+ satnamevar_id) )
+ call nf90_err( nf90_put_att(ncsat_id, satnamevar_id, "longname", "receptor name") )
+
+ ! receptors
+ call nf90_err( nf90_def_var(ncsat_id, "rec", nf90_float, (/ satrecdim_id /), satrecvar_id) )
+ call nf90_err( nf90_put_att(ncsat_id, satrecvar_id, "longname", "receptors") )
+ call nf90_err( nf90_put_att(ncsat_id, satrecvar_id, "units", "index") )
+
+ ! receptor longitude
+ call nf90_err( nf90_def_var(ncsat_id, "lon", nf90_float, (/ satrecdim_id /), satlonvar_id) )
+ call nf90_err( nf90_put_att(ncsat_id, satlonvar_id, "longname", "receptor longitude") )
+ call nf90_err( nf90_put_att(ncsat_id, satlonvar_id, "units", "degrees_east") )
+
+ ! receptor latitude
+ call nf90_err( nf90_def_var(ncsat_id, "lat", nf90_float, (/ satrecdim_id /), satlatvar_id) )
+ call nf90_err( nf90_put_att(ncsat_id, satlatvar_id, "longname", "receptor latitude") )
+ call nf90_err( nf90_put_att(ncsat_id, satlatvar_id, "units", "degrees_north") )
+
+ ! receptor altitude
+ call nf90_err( nf90_def_var(ncsat_id, "alt", nf90_float, (/ satrecdim_id, sataltdim_id /), sataltvar_id) )
+ call nf90_err( nf90_put_att(ncsat_id, sataltvar_id, "longname", "receptor altitude of levels") )
+ call nf90_err( nf90_put_att(ncsat_id, sataltvar_id, "units", "meters") )
+
+ ! species specific variables
+ do ks=ks_start,nspec
+ ! mixing ratio output for each layer of retrieval
+ call nf90_err( nf90_def_var(ncsat_id, trim(species(ks)), nf90_float, (/ satrecdim_id, satlayerdim_id /), &
+ satvar_id(ks)) )
+ call nf90_err( nf90_put_att(ncsat_id, satvar_id(ks), "units", "pptv") )
+ call nf90_err( nf90_put_att(ncsat_id, satvar_id(ks), "longname", "mean VMR") )
+ ! uncertainty output for each layer of retrieval
+ call nf90_err( nf90_def_var(ncsat_id, trim(species(ks))//"_uncert", nf90_float, (/ satrecdim_id, satlayerdim_id /), &
+ satuncvar_id(ks)) )
+ call nf90_err( nf90_put_att(ncsat_id, satuncvar_id(ks), "units", "pptv") )
+ call nf90_err( nf90_put_att(ncsat_id, satuncvar_id(ks), "longname", "uncertainty VMR") )
+ end do
+
+ ! not species specific variables
+ ! number of particles in receptor output
+ call nf90_err( nf90_def_var(ncsat_id,"npart", nf90_float, (/ satrecdim_id, satlayerdim_id /), satnnvar_id) )
+ call nf90_err( nf90_put_att(ncsat_id, satnnvar_id, "units", "counts") )
+ call nf90_err( nf90_put_att(ncsat_id, satnnvar_id, "longname","number of particles at receptor") )
+ ! average kernel weight at receptor
+ call nf90_err( nf90_def_var(ncsat_id,"kernel", nf90_float, (/ satrecdim_id, satlayerdim_id /), satxkvar_id) )
+ call nf90_err( nf90_put_att(ncsat_id, satxkvar_id, "units", "") )
+ call nf90_err( nf90_put_att(ncsat_id, satxkvar_id, "longname", "average kernel weight at receptor") )
+
+ ! write global attributes
+ !************************
+
+ call date_and_time(date,time,zone)
+ call nf90_err( nf90_put_att(ncsat_id, nf90_global, 'Conventions', 'CF-1.6') )
+ call nf90_err( nf90_put_att(ncsat_id, nf90_global, 'title', 'FLEXPART receptor output') )
+ call nf90_err( nf90_put_att(ncsat_id, nf90_global, 'source', trim(flexversion)//' model output') )
+ call nf90_err( nf90_put_att(ncsat_id, nf90_global, 'history', date(1:4)//'-'//date(5:6)//&
+ '-'//date(7:8)//' '//time(1:2)//':'//time(3:4)//' '//zone ) )
+ call nf90_err( nf90_put_att(ncsat_id, nf90_global, 'references', &
+ 'Stohl et al., Atmos. Chem. Phys., 2005, doi:10.5194/acp-5-2461-200;'//&
+ 'Henne et al., in Lagrangian Modeling of the Atmosphere, 2012, doi:10.1029/2012GM001247') )
+
+ ! end definition
+ call nf90_err( nf90_enddef(ncsat_id) )
+
+ ! write dimension variables
+ !**************************
+
+ ! receptor index
+ call nf90_err( nf90_put_var(ncsat_id, satrecvar_id, (/(n,n=1,numsatreceptor)/)) )
+
+ ! close file
+ call nf90_err( nf90_close(ncsat_id) )
+
+ end subroutine satelliteout_init
+
+
+ subroutine receptor_output_netcdf()
+
+ !*****************************************************************************
+ ! *
+ ! This routine writes receptor concentrations to netcdf files *
+ ! *
+ ! Author: R. Thompson *
+ ! January 2024 *
+ ! *
+ !*****************************************************************************
+
+ implicit none
+
+ integer :: ks, ks_start
+ character(len=256) :: fn
+
+ ! Open output files
+ !******************
+
+ if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
+ ! concentration output file
+ write(fn,'(A)') path(2)(1:length(2))//'receptor_conc.nc'
+ else if (iout.eq.2) then
+ ! mixing ratio output file
+ ! note for iout=3 (both conc and mixing ratio) only output conc at receptors
+ write(fn,'(A)') path(2)(1:length(2))//'receptor_pptv.nc'
+ endif
+ call nf90_err( nf90_open(trim(fn), nf90_write, nc_id) )
+
+ ! Get variable ids
+ !*****************
+
+ if (llcmoutput) then
+ ks_start=2
+ else
+ ks_start=1
+ endif
+
+
+ do ks = ks_start,nspec
+ call nf90_err( nf90_inq_varid(nc_id, trim(species(ks)), concvar_id(ks)) )
+ call nf90_err( nf90_inq_varid(nc_id, trim(species(ks))//"_uncert", uncvar_id(ks)) )
+ end do
+ call nf90_err( nf90_inq_varid(nc_id, "npart", nnvar_id) )
+ call nf90_err( nf90_inq_varid(nc_id, "kernel", xkvar_id) )
+
+ end subroutine receptor_output_netcdf
+
+
+ subroutine satellite_output_netcdf()
+
+ !*****************************************************************************
+ ! *
+ ! This routine writes receptor concentrations to netcdf files *
+ ! *
+ ! Author: R. Thompson *
+ ! January 2024 *
+ ! *
+ !*****************************************************************************
+
+ implicit none
+
+ integer :: ks, ks_start
+ character(len=256) :: fn
+
+ ! Open output files
+ !******************
+
+ write(fn,'(A)') path(2)(1:length(2))//'satellite_pptv.nc'
+ call nf90_err( nf90_open(trim(fn), nf90_write, ncsat_id) )
+
+ ! Get variable ids
+ !*****************
+
+ if (llcmoutput) then
+ ks_start=2
+ else
+ ks_start=1
+ endif
+
+ ! satellite receptors
+ do ks = ks_start,nspec
+ call nf90_err( nf90_inq_varid(ncsat_id, trim(species(ks)), satvar_id(ks)) )
+ call nf90_err( nf90_inq_varid(ncsat_id, trim(species(ks))//"_uncert", satuncvar_id(ks)) )
+ end do
+ call nf90_err( nf90_inq_varid(ncsat_id, "npart", satnnvar_id) )
+ call nf90_err( nf90_inq_varid(ncsat_id, "kernel", satxkvar_id) )
+
+ end subroutine satellite_output_netcdf
+
+
+ subroutine write_receptor_netcdf(crec,cunc,nnrec,xkrec,lonrec,latrec,altrec,timerec,namerec,nrec)
+
+ !*****************************************************************************
+ ! *
+ ! This routine writes receptor concentrations to netcdf files *
+ ! *
+ ! Author: R. Thompson *
+ ! January 2024 *
+ ! *
+ !*****************************************************************************
+
+ implicit none
+
+ integer :: ks, ks_start, nrec
+ real, dimension(nspec,maxrecsample,nlayermax) :: crec, cunc
+ real, dimension(maxrecsample,nlayermax) :: nnrec, xkrec, altrec
+ real, dimension(maxrecsample) :: lonrec, latrec
+ integer, dimension(maxrecsample) :: timerec
+ character(len=16), dimension(maxrecsample) :: namerec
+
+ if (llcmoutput) then
+ ks_start=2
+ else
+ ks_start=1
+ endif
+
+ !! testing
+ print*, 'write_receptor_netcdf: rpointer, nrec = ',rpointer, nrec
+
+ ! species specific
+ do ks=ks_start,nspec
+ call nf90_err( nf90_put_var(nc_id, concvar_id(ks), crec(ks,1:nrec,1), (/rpointer/), (/nrec/) ) )
+ call nf90_err( nf90_put_var(nc_id, uncvar_id(ks), cunc(ks,1:nrec,1), (/rpointer/), (/nrec/) ) )
+ end do
+
+ ! not species specific output
+ ! receptor name
+ call nf90_err( nf90_put_var(nc_id, recnamevar_id, namerec(1:nrec), (/1,rpointer/), (/16,nrec/) ) )
+ ! receptor time
+ call nf90_err( nf90_put_var(nc_id, timevar_id, timerec(1:nrec), (/rpointer/), (/nrec/) ) )
+ ! receptor longitude
+ call nf90_err( nf90_put_var(nc_id, reclonvar_id, lonrec(1:nrec), (/rpointer/), (/nrec/) ) )
+ ! receptor latitude
+ call nf90_err( nf90_put_var(nc_id, reclatvar_id, latrec(1:nrec), (/rpointer/), (/nrec/) ) )
+ ! receptor latitude
+ call nf90_err( nf90_put_var(nc_id, recaltvar_id, altrec(1:nrec,1), (/rpointer/), (/nrec/) ) )
+ ! average number of particles all timesteps for each receptor
+ call nf90_err( nf90_put_var(nc_id, nnvar_id, nnrec(1:nrec,1), (/rpointer/), (/nrec/) ) )
+ ! average kernel all timesteps
+ call nf90_err( nf90_put_var(nc_id, xkvar_id, xkrec(1:nrec,1), (/rpointer/), (/nrec/) ) )
+
+ end subroutine write_receptor_netcdf
+
+
+ subroutine write_satellite_netcdf(crec,cunc,nnrec,xkrec,lonrec,latrec,altrec,timerec,namerec,nrec)
+
+ !*****************************************************************************
+ ! *
+ ! This routine writes receptor concentrations to netcdf files *
+ ! *
+ ! Author: R. Thompson *
+ ! January 2024 *
+ ! *
+ !*****************************************************************************
+
+ implicit none
+
+ integer :: ks, ks_start, nrec
+ real, dimension(nspec,maxrecsample,nlayermax) :: crec, cunc
+ real, dimension(maxrecsample,nlayermax) :: nnrec, xkrec, altrec
+ real, dimension(maxrecsample) :: lonrec, latrec
+ integer, dimension(maxrecsample) :: timerec
+ character(len=16), dimension(maxrecsample) :: namerec
+
+ if (llcmoutput) then
+ ks_start=2
+ else
+ ks_start=1
+ endif
+
+ !! testing
+ print*, 'write_satellite_netcdf: spointer, nrec = ',spointer, nrec
+
+ ! species specific output
+ do ks = ks_start,nspec
+ call nf90_err( nf90_put_var(ncsat_id,satvar_id(ks),crec(ks,1:nrec,1:nlayermax-1),(/spointer,1/),(/nrec,nlayermax-1/) ) )
+ call nf90_err( nf90_put_var(ncsat_id,satuncvar_id(ks),cunc(ks,1:nrec,1:nlayermax-1),(/spointer,1/),(/nrec,nlayermax-1/) ) )
+ end do
+
+ ! non-species specific
+ ! receptor name
+ call nf90_err( nf90_put_var(ncsat_id, satnamevar_id, namerec(1:nrec), (/1,spointer/), (/16,nrec/) ) )
+ ! receptor time
+ call nf90_err( nf90_put_var(ncsat_id, sattimevar_id, timerec(1:nrec), (/spointer/), (/nrec/) ) )
+ ! receptor longitude
+ call nf90_err( nf90_put_var(ncsat_id, satlonvar_id, lonrec(1:nrec), (/spointer/), (/nrec/) ) )
+ ! receptor latitude
+ call nf90_err( nf90_put_var(ncsat_id, satlatvar_id, latrec(1:nrec), (/spointer/), (/nrec/) ) )
+ ! receptor altitude
+ call nf90_err( nf90_put_var(ncsat_id, sataltvar_id, altrec(1:nrec,:), (/spointer,1/), (/nrec,(nlayermax)/) ) )
+ ! average number of particles all timesteps for each receptor
+ call nf90_err( nf90_put_var(ncsat_id, satnnvar_id, nnrec(1:nrec,1:nlayermax-1), (/spointer,1/), (/nrec,nlayermax-1/) ) )
+ ! average kernel all timesteps
+ call nf90_err( nf90_put_var(ncsat_id, satxkvar_id, xkrec(1:nrec,1:nlayermax-1), (/spointer,1/), (/nrec,nlayermax-1/) ) )
+
+ end subroutine write_satellite_netcdf
+
+
+ !*****************************************************************************
+
+ subroutine close_receptor_netcdf
+
+ call nf90_err( nf90_close(nc_id) )
+
+ end subroutine close_receptor_netcdf
+
+ !*****************************************************************************
+
+ subroutine close_satellite_netcdf
+
+ call nf90_err( nf90_close(ncsat_id) )
+
+ end subroutine close_satellite_netcdf
+
+ !*****************************************************************************
+
+
+ subroutine readreceptors_satellite
+
+ !*****************************************************************************
+ ! *
+ ! This routine reads the satellite retrieval information for which *
+ ! mixing ratios should be modelled *
+ ! *
+ ! Author: R. Thompson *
+ ! October 2023 *
+ ! *
+ !*****************************************************************************
+
+ implicit none
+
+ character(len=256) :: file_name, ppath, pfile, strtmp1, strtmp2
+ character(len=256), dimension(:), allocatable :: sat_file, sat_path
+ character(len=8) :: anretr, psatname
+ character(len=4) :: ayear
+ character(len=2) :: amonth, aday
+ integer :: jjjjmmdd, hhmmss, yyyy, mm, dd
+ integer :: nc_id, dimid, varid
+ real :: xm, ym
+ real(kind=dp) :: jul, jd
+ real, allocatable, dimension(:,:) :: xpts, ypts, zpt1, zpt2
+ integer, allocatable, dimension(:) :: npt, sdate, stime
+ integer :: readerror, writeerror, stat
+ integer :: j, nn, nr, nretr, nlayer, tmp_numsat
+ integer,parameter :: unitreceptorout=2
+ logical :: lexist
+ real, allocatable, dimension(:) :: tmp_xsat, tmp_ysat, tmp_satarea
+ real, allocatable, dimension(:,:) :: tmp_zsat
+ integer, allocatable, dimension(:) :: tmp_tsat
+ character(len=16), allocatable, dimension(:) :: tmp_satname
+
+ ! declare namelist
+ namelist /satellites/ psatname, ppath, pfile
+
+ numsatreceptor=0
+
+ ! For backward runs, do not allow receptor output
+ !************************************************
+
+ if (ldirect.lt.0) then
+ return
+ endif
+
+ ! Open the SATELLITES file and read path and file info
+ !*****************************************************
+
+ open(unitreceptor,file=path(1)(1:length(1))//'SATELLITES',form='formatted',status='old',iostat=readerror)
+
+ if (readerror.ne.0) then
+ write(*,*) 'FLEXPART WARNING readreceptors_satellite: no satellite file found'
+ return
+ endif
+
+ ! try namelist input
+ read(unitreceptor,satellites,iostat=readerror)
+ close(unitreceptor)
+
+ if (readerror.ne.0) then
+ write(*,*) ' #### FLEXPART ERROR in readreceptors_satellite: #### '
+ write(*,*) ' #### error in namelist input #### '
+ error stop
+ endif ! only namelist input
+
+
+ ! prepare namelist output if requested
+ if (nmlout) then
+ open(unitreceptorout,file=path(2)(1:length(2))//'SATELLITES.namelist',&
+ &access='append',status='replace',iostat=writeerror)
+ if (writeerror.ne.0) then
+ write(*,*) ' #### FLEXPART ERROR readreceptors_satellite: cannot open file #### '
+ write(*,*) ' #### '//trim(path(2)(1:length(2)))//'SATELLITES.namelist #### '
+ error stop
+ endif
+ endif
+
+ ! Get number of satellites
+ !*************************
+
+ open (unitreceptor,file=trim(path(1))//'SATELLITES',status='old',iostat=readerror)
+ j=0
+ do while (readerror.eq.0)
+ read(unitreceptor,satellites,iostat=readerror)
+ if (readerror.ne.0) exit
+ j=j+1
+ end do
+ numsatellite=j
+ write(*,*) 'Number of satellites: ',numsatellite
+ close(unitreceptor)
+
+ ! Allocate arrays
+ !****************
+
+ allocate(sat_name(numsatellite),sat_path(numsatellite),sat_file(numsatellite))
+ allocate(nnsatlayer(numsatellite))
+
+ ! Read satellite info
+ !********************
+
+ open(unitreceptor,file=path(1)(1:length(1))//'SATELLITES',form='formatted',status='old',iostat=readerror)
+ j=0
+ do while (readerror.eq.0)
+ read(unitreceptor,satellites,iostat=readerror)
+ if (readerror.ne.0) exit
+ j=j+1
+ write(*,*) 'readreceptors_satellite: psatname, ppath = ',trim(psatname),', ',trim(ppath)
+ sat_name(j)=trim(psatname)
+ sat_path(j)=trim(ppath)
+ sat_file(j)=trim(pfile)
+ ! namelist output
+ if (nmlout) then
+ write(unitreceptorout,nml=satellites)
+ endif
+ end do
+ close(unitreceptor)
+ close(unitreceptorout)
+
+ ! Get number of satellite receptors
+ !**********************************
+
+ ! Loop over satellites and days
+ jd=bdate
+ tmp_numsat=0
+ do while (jd.le.edate)
+ do j=1,numsatellite
+ ! get filename for current day
+ call caldate(jd, jjjjmmdd, hhmmss)
+ file_name=sat_file(j)
+ call getfilename(jjjjmmdd, file_name)
+ write(*,*) 'readreceptors_satellite: file_name = ',file_name
+ inquire(file=trim(sat_path(j))//'/'//trim(file_name),exist=lexist)
+ if (.not.lexist) then
+ write(*,*) 'readreceptors_satellite: no retrievals file for '//ayear//amonth//aday
+ cycle
+ endif
+ ! open file
+ call nf90_err( nf90_open(trim(sat_path(j))//'/'//trim(file_name), nf90_nowrite, nc_id) )
+ ! read dimensions
+ call nf90_err( nf90_inq_dimid(nc_id, 'retrieval', dimid) )
+ call nf90_err( nf90_inquire_dimension(nc_id, dimid, len=nretr) )
+ call nf90_err( nf90_inq_dimid(nc_id, 'nlayer', dimid) )
+ call nf90_err( nf90_inquire_dimension(nc_id, dimid, len=nlayer) )
+ tmp_numsat=tmp_numsat+nretr
+ nlayermax=max(nlayermax,nlayer)
+ nnsatlayer(j)=nlayer
+ call nf90_err(nf90_close(nc_id))
+ end do
+ jd=jd+1d0
+ end do
+ nlayermax=nlayermax+1 ! for levels
+
+ ! Allocate temporary arrays
+ !**************************
+
+ allocate(tmp_xsat(tmp_numsat),tmp_ysat(tmp_numsat),&
+ tmp_tsat(tmp_numsat),tmp_satarea(tmp_numsat),&
+ tmp_zsat(nlayermax,tmp_numsat),tmp_satname(tmp_numsat))
+
+ ! Read satellite retrievals info
+ !*******************************
+
+ ! Loop over days in simulation
+ numsatreceptor=0
+ jd=bdate
+ do while (jd.le.edate)
+
+ do j=1,numsatellite
+
+ ! get filename for current day
+ ! assumes same format as output from prep_satellite
+ call caldate(jd, jjjjmmdd, hhmmss)
+ file_name=sat_file(j)
+ call getfilename(jjjjmmdd, file_name)
+ write(*,*) 'readreceptors_satellite: file_name = ',file_name
+ inquire(file=trim(sat_path(j))//'/'//trim(file_name),exist=lexist)
+ if (.not.lexist) then
+ write(*,*) 'readreceptors_satellite: no retrievals file for '//ayear//amonth//aday
+ cycle
+ endif
+
+ ! open file
+ call nf90_err( nf90_open(trim(sat_path(j))//'/'//trim(file_name), nf90_nowrite, nc_id) )
+
+ ! read dimensions
+ call nf90_err( nf90_inq_dimid(nc_id, 'retrieval', dimid) )
+ call nf90_err( nf90_inquire_dimension(nc_id, dimid, len=nretr) )
+ call nf90_err( nf90_inq_dimid(nc_id, 'nlayer', dimid) )
+ call nf90_err( nf90_inquire_dimension(nc_id, dimid, len=nlayer) )
+
+ ! allocate temporary variables
+ allocate(sdate(nretr),stat=stat)
+ if (stat.ne.0) write(*,*)'ERROR: could not allocate sdate'
+ allocate(stime(nretr),stat=stat)
+ if (stat.ne.0) write(*,*)'ERROR: could not allocate stime'
+ allocate(xpts(nretr,4),stat=stat)
+ if (stat.ne.0) write(*,*)'ERROR: could not allocate xpts'
+ allocate(ypts(nretr,4),stat=stat)
+ if (stat.ne.0) write(*,*)'ERROR: could not allocate ypts'
+ allocate(zpt1(nretr,nlayer),stat=stat)
+ if (stat.ne.0) write(*,*)'ERROR: could not allocate zpt1'
+ allocate(zpt2(nretr,nlayer),stat=stat)
+ if (stat.ne.0) write(*,*)'ERROR: could not allocate zpt2'
+
+ ! read coordinate variables
+ call nf90_err( nf90_inq_varid(nc_id,'idate',varid) )
+ call nf90_err( nf90_get_var(nc_id,varid,sdate) )
+ call nf90_err( nf90_inq_varid(nc_id,'itime',varid) )
+ call nf90_err( nf90_get_var(nc_id,varid,stime) )
+ call nf90_err( nf90_inq_varid(nc_id,'xpoints',varid) )
+ call nf90_err( nf90_get_var(nc_id,varid,xpts) )
+ call nf90_err( nf90_inq_varid(nc_id,'ypoints',varid) )
+ call nf90_err( nf90_get_var(nc_id,varid,ypts) )
+ call nf90_err( nf90_inq_varid(nc_id,'zpoint1',varid) )
+ call nf90_err( nf90_get_var(nc_id,varid,zpt1) )
+ call nf90_err( nf90_inq_varid(nc_id,'zpoint2',varid) )
+ call nf90_err( nf90_get_var(nc_id,varid,zpt2) )
+ call nf90_err( nf90_close(nc_id) )
+
+ ! write to coordinates receptor variables
+ do nr=1,nretr
+ ! time of retrieval from bdate in seconds
+ jul=juldate(sdate(nr),stime(nr))
+ if ((jul.lt.bdate).or.(jul.gt.edate)) cycle
+ numsatreceptor=numsatreceptor+1
+ write(anretr,'(I8.8)') nr
+ tmp_satname(numsatreceptor)=trim(sat_name(j))//'_'//anretr
+ tmp_tsat(numsatreceptor)=int((jul-bdate)*24.*3600.) ! time in sec
+ ! transform to grid coordinates
+ tmp_xsat(numsatreceptor)=(sum(xpts(nr,:))/4.-xlon0)/dx
+ tmp_ysat(numsatreceptor)=(sum(ypts(nr,:))/4.-ylat0)/dy
+ ! vertical coordinates layer boundaries in Pa
+ tmp_zsat(1:nlayer,numsatreceptor)=zpt1(nr,:)
+ tmp_zsat(nlayer+1,numsatreceptor)=zpt2(nr,nlayer)
+ ! area for mixing ratio calc (used if ind_samp = -1)
+ xm=r_earth*cos((sum(ypts(nr,:))/4.)*pi/180.)*dx/180.*pi
+ ym=r_earth*dy/180.*pi
+ tmp_satarea(numsatreceptor)=xm*ym
+ end do ! nretr
+
+ deallocate(sdate, stime, xpts, ypts, zpt1, zpt2)
+
+ end do ! numsatellite
+
+ jd=jd+1d0
+
+ end do ! jd
+
+ write(*,*) 'readreceptors_satellite: numsatreceptor = ',numsatreceptor
+
+ ! Reallocate satellite arrays to actual size
+ !*******************************************
+
+ allocate(xsatellite(numsatreceptor),ysatellite(numsatreceptor),&
+ tsatellite(numsatreceptor),satellitearea(numsatreceptor),&
+ zsatellite(nlayermax,numsatreceptor),satellitename(numsatreceptor))
+
+ xsatellite=tmp_xsat(1:numsatreceptor)
+ ysatellite=tmp_ysat(1:numsatreceptor)
+ tsatellite=tmp_tsat(1:numsatreceptor)
+ satellitearea=tmp_satarea(1:numsatreceptor)
+ zsatellite=tmp_zsat(:,1:numsatreceptor)
+ satellitename=tmp_satname(1:numsatreceptor)
+
+ deallocate(tmp_xsat,tmp_ysat,tmp_tsat,tmp_satarea,tmp_zsat,tmp_satname)
+ deallocate(sat_path,sat_file)
+
+ end subroutine readreceptors_satellite
+
+
+ subroutine getfilename(jjjjmmdd,file_name)
+
+ !*****************************************************************************
+ ! *
+ ! Get actual filename based on dates from generic name *
+ ! *
+ ! Author: R. Thompson, Sep-2023 *
+ ! *
+ ! *
+ !*****************************************************************************
+
+ implicit none
+
+ character(len=256) :: file_name, strtmp1, strtmp2
+ character(len=4) :: ayear
+ character(len=2) :: amonth, aday
+ integer :: jjjjmmdd, yyyy, mm, dd, nn
+
+ yyyy=jjjjmmdd/10000
+ mm=(jjjjmmdd-yyyy*10000)/100
+ dd=jjjjmmdd-yyyy*10000-mm*100
+ write(ayear,'(I4)') yyyy
+ write(amonth,'(I2.2)') mm
+ write(aday,'(I2.2)') dd
+ nn=index(file_name,'YYYY',back=.false.)
+ if (nn.ne.0) then
+ strtmp1=file_name(1:nn-1)
+ nn=index(file_name,'YYYY',back=.true.)
+ strtmp2=file_name(nn+4:len_trim(file_name))
+ file_name=trim(strtmp1)//ayear//trim(strtmp2)
+ endif
+ nn=index(file_name,'MM',back=.false.)
+ if (nn.ne.0) then
+ strtmp1=file_name(1:nn-1)
+ nn=index(file_name,'MM',back=.true.)
+ strtmp2=file_name(nn+2:len_trim(file_name))
+ file_name=trim(strtmp1)//amonth//trim(strtmp2)
+ endif
+ nn=index(file_name,'DD',back=.false.)
+ if (nn.ne.0) then
+ strtmp1=file_name(1:nn-1)
+ nn=index(file_name,'DD',back=.true.)
+ strtmp2=file_name(nn+2:len_trim(file_name))
+ file_name=trim(strtmp1)//aday//trim(strtmp2)
+ endif
+
+ end subroutine getfilename
+
+
+ subroutine verttransform_satellite
+
+ !*****************************************************************************
+ ! *
+ ! This routine transforms the vertical coordinate of the satellite *
+ ! receptors from pressure to height above ground *
+ ! *
+ ! Author: R. Thompson *
+ ! October 2023 *
+ ! *
+ !*****************************************************************************
+
+ implicit none
+
+ integer :: nr, nn, nl, kz, nchar
+ integer :: numsatlayer
+ integer :: ix, jy, ixp, jyp
+ real :: p1, p2, p3, p4, ddx, ddy, rddx, rddy, dz1, dz2
+ real :: press, pressold, zpres
+
+!$OMP PARALLEL &
+!$OMP PRIVATE(nr,nn,nchar,numsatlayer,nl,zpres,ix,jy,ddx,ddy,ixp,jyp,rddx,rddy,&
+!$OMP p1,p2,p3,p4,kz,press,pressold,dz1,dz2)
+
+!$OMP DO
+ do nr=1,numsatreceptor
+
+ ! get actual number vertical layers for this retrieval
+ do nn=1,numsatellite
+ nchar=len_trim(sat_name(nn))
+ if (satellitename(nr)(1:nchar).eq.trim(sat_name(nn))) then
+ numsatlayer=nnsatlayer(nn)
+ exit
+ endif
+ end do
+
+ do nl=1,(numsatlayer+1)
+
+ ! pressure of level in Pa
+ zpres=zsatellite(nl,nr)
+ ix=int(xsatellite(nr))
+ jy=int(ysatellite(nr))
+ ddx=xsatellite(nr)-real(ix)
+ ddy=ysatellite(nr)-real(jy)
+ ixp=ix+1
+ jyp=jy+1
+ rddx=1.-ddx
+ rddy=1.-ddy
+ p1=rddx*rddy
+ p2=ddx*rddy
+ p3=rddx*ddy
+ p4=ddx*ddy
+
+ ! use pressure from second field regardless of time stamp
+ ! think this is adequate otherwise need to transform just
+ ! for retrievals in recoutaverage interval before calling receptorcalc
+ do kz=1,nz
+ press=p1*prs(ix,jy,kz,2) &
+ +p2*prs(ixp,jy,kz,2) &
+ +p3*prs(ix,jyp,kz,2) &
+ +p4*prs(ixp,jyp,kz,2)
+ if (kz.eq.1) pressold=press
+ if (press.lt.zpres) then
+ if (kz.eq.1) then
+ zsatellite(nl,nr)=height(1)/2.
+ else
+ dz1=pressold-zpres
+ dz2=zpres-press
+ zsatellite(nl,nr)=(height(kz-1)*dz2+height(kz)*dz1)/(dz1+dz2)
+ endif
+ exit ! found height end loop over nz
+ endif
+ pressold=press
+ end do ! nz
+ if ((kz.gt.nz).and.(zpres.le.press)) then
+ ! ztra1 press less than top of windfield press
+ zsatellite(nl,nr)=0.5*(height(nz-1)+height(nz))
+ endif
+
+ end do ! numsatlayer
+
+ !! testing
+ if (nr.lt.20) print*, 'zsatellite after transform = ',zsatellite(:,nr)
+
+ end do ! numsatreceptor
+!$OMP END DO
+!$OMP END PARALLEL
+
+ end subroutine verttransform_satellite
+
+end module receptor_netcdf_mod
+
diff --git a/src/restart_mod.f90 b/src/restart_mod.f90
index d22d96f8b2a25055805da1859477570db9576379..6236394cbb8f4195b9aab4e56846fff39fa47c08 100644
--- a/src/restart_mod.f90
+++ b/src/restart_mod.f90
@@ -1,4 +1,15 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2019, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
module restart_mod
+
+ !*****************************************************************************
+ ! *
+ ! This module write variables to file for eventual restart, and reads *
+ ! these variables from file in case of restart *
+ ! *
+ !*****************************************************************************
+
use particle_mod
#ifdef ETA
use coord_ecmwf_mod
@@ -14,11 +25,11 @@ module restart_mod
contains
-subroutine output_restart(itime,loutnext,outnum)
+subroutine output_restart(itime,loutnext,lrecoutnext,outnum)
implicit none
- integer, intent(in) :: itime,loutnext
+ integer, intent(in) :: itime,loutnext,lrecoutnext
real, intent(in) :: outnum
integer :: imax,i,j,jjjjmmdd,ihmmss,ipart,iwritten
integer :: ks,kp,kz,nage,jy,ix,l,n
@@ -73,8 +84,8 @@ subroutine output_restart(itime,loutnext,outnum)
write(unitrestart) imax
write(unitrestart) iwritten
write(unitrestart) loutnext
+ write(unitrestart) lrecoutnext
write(unitrestart) outnum
- write(unitrestart) numreceptor
do ipart=1,imax
if ((ipout.gt.0).and.(n_average.gt.0)) then
@@ -159,11 +170,6 @@ subroutine output_restart(itime,loutnext,outnum)
end do
endif
end do
- if (numreceptor.gt.0) then
- do n=1,numreceptor
- write(unitrestart) creceptor(n,ks)
- end do
- endif
end do
endif
close(unitrestart)
@@ -204,8 +210,8 @@ subroutine readrestart
read(unitpartin) imax ! count%alive
read(unitpartin) numpart
read(unitpartin) loutnext_init
+ read(unitpartin) lrecoutnext_init
read(unitpartin) outnum_init
- read(unitpartin) numreceptor
count%alive=numpart
count%spawned=numpart
@@ -339,4 +345,4 @@ subroutine readrestart
write(*,*) ' #### RESTART FILE TO restart.bin. #### '
end subroutine readrestart
-end module restart_mod
\ No newline at end of file
+end module restart_mod
diff --git a/src/timemanager_mod.f90 b/src/timemanager_mod.f90
index 841d5990c6a308b3a6beafcf8ec5bea7f842d1f4..931477c1a4ea865d8a873fda1ef3350303e7f288 100644
--- a/src/timemanager_mod.f90
+++ b/src/timemanager_mod.f90
@@ -71,6 +71,8 @@ subroutine timemanager
! in the particle loop *
! nstop1 serves as indicator for wind fields (see getfields) *
! outnum number of samples for each concentration calculation *
+ ! recoutnum number of samples for each receptor calculation *
+ ! recoutnumsat number of samples for each satellite calculation *
! prob probability of absorption at ground due to dry *
! deposition *
! WETDEP .true. if wet deposition is switched on *
@@ -85,7 +87,7 @@ subroutine timemanager
use xmass_mod
use flux_mod
use outgrid_mod
- use ohr_mod
+! use ohr_mod
use par_mod
use com_mod
#ifdef ETA
@@ -103,6 +105,14 @@ subroutine timemanager
use output_mod
use restart_mod
use interpol_mod, only: alloc_interpol,dealloc_interpol
+#ifdef USE_NCF
+ use chemistry_mod
+ use initdomain_mod
+ use receptor_netcdf_mod, only: verttransform_satellite
+ use emissions_mod
+ use totals_mod
+#endif
+ use receptor_mod, only: receptoroutput
implicit none
real, parameter :: &
@@ -116,6 +126,8 @@ subroutine timemanager
nstop1, & ! windfield existence flag
loutnext, & ! following timestep
loutstart,loutend, & ! concentration calculation starting and ending time
+ lrecoutnext, & ! following timestep for receptor output
+ lrecoutstart,lrecoutend,& ! receptor calculation interval start and end time
ldeltat, & ! radioactive decay time
itage,nage,inage, & ! related to age classes
i_nan=0,ii_nan,total_nan_intl=0, & !added by mc to check instability in CBL scheme
@@ -130,23 +142,32 @@ subroutine timemanager
! integer :: &
! jjjjmmdd,ihmmss
real :: &
- outnum, & ! concentration calculation sample number
+ outnum, & ! number of samples for grid concentration calculation
prob_rec(maxspec), & ! dry deposition related
xmassfract ! dry deposition related
real(dep_prec),allocatable,dimension(:) :: &
drytmp ! dry deposition related
+ logical :: itsopen
+ real, dimension(maxrecsample) :: recoutnum ! number of samples for receptor calculation
+ real, dimension(nlayermax,maxrecsample) :: recoutnumsat ! number of samples for satellite receptor calculation
! First output for time 0
!************************
if (itime_init.ne.0) then
loutnext=loutnext_init
+ lrecoutnext=lrecoutnext_init
outnum=outnum_init
else
loutnext=loutstep/2
+ lrecoutnext=lrecoutstep/2
outnum=0.
+ recoutnum(:)=0.
+ recoutnumsat(:,:)=0.
endif
loutstart=loutnext-loutaver/2
loutend=loutnext+loutaver/2
+ lrecoutstart=lrecoutnext-lrecoutaver/2
+ lrecoutend=lrecoutnext+lrecoutaver/2
! Initialise the nan count for CBL option
!****************************************
@@ -189,24 +210,22 @@ subroutine timemanager
s_firstt = real(count_clock)/real(count_rate)
endif
- ! Writing restart file
- !*********************
+ ! Writing restart file
+ !*********************
if ((itime.ne.itime_init).and.(loutrestart.ne.-1).and.(mod(itime,loutrestart).eq.0)) then
- call output_restart(itime,loutnext,outnum)
+ call output_restart(itime,loutnext,lrecoutnext,outnum)
endif
- ! if ((itime.ne.0).and.(count%alive.gt.0)) then
- ! if (part(1)%alive) write(*,*) 'xlon,ylat,z,zeta', part(1)%xlon,part(1)%ylat,part(1)%z,part(1)%zeta
- ! endif
call init_output(itime,filesize)
- ! Get necessary wind fields if not available
- !*******************************************
+ ! Get necessary wind fields if not available
+ !*******************************************
call getfields(itime,nstop1) !OMP on verttransform_ecmwf and readwind_ecmwf, getfields_mod.f90
if (nstop1.gt.1) error stop 'NO METEO FIELDS AVAILABLE'
- ! In case of ETA coordinates being read from file, convert the z positions to zeta
- !*********************************************************************************
+ ! In case of ETA coordinates being read from file, convert the z positions to zeta
+ !*********************************************************************************
+#ifdef ETA
if ((itime.eq.itime_init).and.((ipin.eq.1).or.(ipin.eq.3).or.(ipin.eq.4))) then
if (count%allocated.le.0) error stop 'Something is going wrong reading the old particle file! &
@@ -225,14 +244,19 @@ subroutine timemanager
!$OMP END DO
!$OMP END PARALLEL
endif
-
+#endif
if (WETDEP .and. (itime.ne.0) .and. (numpart.gt.0)) then
call wetdepo(itime,lsynctime,loutnext)
endif
- if (OHREA .and. (itime.ne.0) .and. (numpart.gt.0)) &
- call ohreaction(itime,lsynctime,loutnext)
+ ! compute chemical losses
+ !************************
+#ifdef USE_NCF
+ if (CLREA .and. (itime.ne.0) .and. (numpart.gt.0)) then
+ call chemreaction(itime)
+ endif
+#endif
! compute convection for backward runs
!*************************************
@@ -241,17 +265,58 @@ subroutine timemanager
call convmix(itime)
endif
- ! Get hourly OH fields if not available
- !****************************************************
- if (OHREA) then
- call gethourlyOH(itime)
+ ! Get chemical fields if not available
+ !*************************************
+#ifdef USE_NCF
+ if (CLREA) then
+ call getchemfield(itime)
+ call getchemhourly(itime)
endif
+#endif
+ ! Get emission fields if not available
+ !*************************************
+
+#ifdef USE_NCF
+ if (LEMIS.and.mdomainfill.eq.1) then
+ call getemissions(itime)
+ endif
+#endif
+
+ ! Transform vertical coordinates of satellite receptors
+ !******************************************************
+#ifdef USE_NCF
+ if ((numsatreceptor.gt.0).and.(itime.eq.0)) then
+ call verttransform_satellite
+ endif
+#endif
+
! Release particles
!******************
if (mdomainfill.ge.1) then
- if (itime.eq.itime_init) then
- call init_domainfill
+ if (itime.eq.itime_init) then
+ if (llcmoutput) then
+#ifdef USE_NCF
+ call init_domainfill_ncf
+#else
+ call init_domainfill
+#endif
+ else
+ call init_domainfill
+ endif
+ if (ipin.eq.2) then
+ ! Particles initialized from partoutput
+#ifdef ETA
+!$OMP PARALLEL PRIVATE(i,j)
+!$OMP DO
+ do i=1,count%alive
+ j=count%ialive(i)
+ call update_z_to_zeta(itime,j)
+ end do
+!$OMP END DO
+!$OMP END PARALLEL
+#endif
+ endif
else
call boundcond_domainfill(itime,loutend)
endif
@@ -275,7 +340,7 @@ subroutine timemanager
end do
#ifdef ETA
-!$OMP PARALLEL PRIVATE(i)
+!$OMP PARALLEL PRIVATE(i,j)
!$OMP DO
do i=1,count%alive
j=count%ialive(i)
@@ -291,6 +356,15 @@ subroutine timemanager
call releaseparticles(itime)
endif
+ ! Inject emissions
+ !*****************
+
+#ifdef USE_NCF
+ if (LEMIS.and.mdomainfill.eq.1) then
+ call emissions(itime)
+ endif
+#endif
+
! Compute convective mixing for forward runs
! for backward runs it is done before next windfield is read in
!**************************************************************
@@ -329,6 +403,15 @@ subroutine timemanager
s_writepart = s_writepart + ((count_clock - count_clock0)/real(count_rate)-s_temp)
endif
+ ! Check whether receptor concentrations are to be calculated
+ !***********************************************************
+
+ if ((ldirect*itime.ge.ldirect*lrecoutstart).and. &
+ ((numreceptor.gt.0.).or.(numsatreceptor.gt.0)).and. &
+ (ldirect*itime.le.ldirect*lrecoutend)) then
+ call receptoroutput(itime,lrecoutstart,lrecoutend,lrecoutnext,recoutnum,recoutnumsat)
+ endif
+
if (itime.eq.ideltas) exit ! almost finished
! Compute interval since radioactive decay of deposited mass was computed
@@ -629,12 +712,33 @@ subroutine timemanager
s_firstt = real(count_clock)/real(count_rate) - s_firstt
endif
+ ! Output totals
+ !**************
+
+#ifdef USE_NCF
+ if ((mdomainfill.eq.1).and.(llcmoutput)) then
+ do ks=1,nspec
+ tot_mass(ks)=sum(real(mass(1:count%alive,ks),kind=dp))
+ end do
+ call totals_write(itime)
+ endif
+#endif
+
end do
! Complete the calculation of initial conditions for particles not yet terminated
!*****************************************************************************
call finalise_output(itime)
+ ! Output residual emissions
+ !**************************
+
+#ifdef USE_NCF
+ if (LEMIS.and.(ipout.eq.2)) then
+ call em_res_write
+ endif
+#endif
+
! De-allocate memory and end
!***************************
call dealloc_all_particles
@@ -647,11 +751,27 @@ subroutine timemanager
call dealloc_random
if (numbnests.ge.1) call dealloc_windfields_nest
if (iflux.eq.1) deallocate(flux)
- if (OHREA) deallocate(OH_field,OH_hourly,lonOH,latOH,altOH)
if (ipin.ne.3 .and. ipin.ne.4) deallocate(xmasssave)
-#ifdef _USE_NCF
- if (lnetcdfout.eq.1) call dealloc_netcdf
-#endif _USE_NCF
+ if (CLREA) then
+ deallocate(CL_field,lonCL,latCL,altCL)
+ endif
+ deallocate(reaccconst,reacdconst,reacnconst)
+ deallocate(emis_path,emis_file,emis_name,emis_unit,emis_coeff)
+ if (lnetcdfout.eq.1) then
+#ifdef USE_NCF
+ call dealloc_netcdf
+ if (LEMIS) then
+ deallocate(em_field,em_res,em_area,mass_field)
+ endif
+#endif
+ else
+ inquire(unit=unitoutrecept, opened=itsopen)
+ if (itsopen) close(unitoutrecept)
+ inquire(unit=unitoutreceptppt, opened=itsopen)
+ if (itsopen) close(unitoutreceptppt)
+ inquire(unit=unitoutsatellite, opened=itsopen)
+ if (itsopen) close(unitoutsatellite)
+ endif
deallocate(xpoint1,xpoint2,ypoint1,ypoint2,zpoint1,zpoint2)
deallocate(xmass)
deallocate(ireleasestart,ireleaseend,npart,kindz)
@@ -661,8 +781,10 @@ subroutine timemanager
deallocate(outheight,outheighthalf)
deallocate(oroout, area, volume)
deallocate(gridunc)
+ deallocate(gridcnt)
#ifdef _OPENMP
deallocate(gridunc_omp)
+ deallocate(gridcnt_omp)
#endif
if (ldirect.gt.0) then
deallocate(drygridunc,wetgridunc)
diff --git a/src/totals_mod.f90 b/src/totals_mod.f90
new file mode 100644
index 0000000000000000000000000000000000000000..65491241618ec983564247c16d62c09f6017b0ab
--- /dev/null
+++ b/src/totals_mod.f90
@@ -0,0 +1,215 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2019, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+module totals_mod
+
+ !*****************************************************************************
+ ! *
+ ! This module contains variables and subroutines for injecting mass *
+ ! into particles based on gridded emissions estimates *
+ ! *
+ !*****************************************************************************
+
+ use netcdf
+ use par_mod, only: dp
+ use com_mod
+ use netcdf_output_mod, only: nf90_err
+
+ implicit none
+
+ character(len=256) :: fn_totals
+ integer :: nc_id, specdim_id, reagdim_id, timedim_id, nchardim_id
+ integer :: time_id, spec_id, cl_id, emis_id, efld_id, eres_id, mass_id
+ real(kind=dp), dimension(:,:), allocatable :: chem_loss
+ real(kind=dp), dimension(:), allocatable :: tot_mass
+ real(kind=dp), dimension(:), allocatable :: tot_em_up
+ real(kind=dp), dimension(:), allocatable :: tot_em_res
+ real(kind=dp), dimension(:), allocatable :: tot_em_field
+
+ contains
+
+ subroutine alloc_totals
+
+ !*****************************************************************************
+ ! *
+ ! Allocate variables for totals *
+ ! *
+ !*****************************************************************************
+
+ implicit none
+
+ integer :: stat
+
+ allocate(chem_loss(nreagent,nspec),stat=stat)
+ if (stat.ne.0) error stop "Could not allocate totals arrays"
+ chem_loss(:,:)=0.
+
+ allocate( tot_mass(nspec) )
+ allocate( tot_em_up(nspec) )
+ allocate( tot_em_field(nspec) )
+ allocate( tot_em_res(nspec) )
+
+ end subroutine alloc_totals
+
+ subroutine totals_init()
+
+ !*****************************************************************************
+ ! *
+ ! This subroutine initializes the totals output *
+ ! *
+ ! Author: S. Henne *
+ ! Adapted by R. Thompson for v11, Feb-2024 *
+ ! *
+ !*****************************************************************************
+
+ implicit none
+
+ character(len=10) :: time
+ character(len=8) :: date
+ character(len=5) :: zone
+ character(len=8) :: adate
+ character(len=6) :: atime
+ character(len=32) :: timeunit
+ character(len=256) :: host_name, login_name
+ integer :: ks
+
+ ! get string of start time
+ write(adate,'(i8.8)') ibdate
+ write(atime,'(i6.6)') ibtime
+ timeunit = 'seconds since '//adate(1:4)//'-'//adate(5:6)// &
+ '-'//adate(7:8)//' '//atime(1:2)//':'//atime(3:4)
+
+ ! get run info
+ call date_and_time(date,time,zone)
+ call getlog(login_name)
+ call hostnm(host_name)
+
+ ! file name
+ fn_totals=trim(path(2)(1:length(2)))//'totals.nc'
+
+ ! open new file handle
+ call nf90_err( nf90_create(trim(fn_totals), cmode=nf90_hdf5, ncid=nc_id) )
+
+ ! define dimensions
+ !******************
+
+ call nf90_err( nf90_def_dim(nc_id, "species", nspec, specdim_id) )
+ call nf90_err( nf90_def_dim(nc_id, "reagents", nreagent, reagdim_id) )
+ call nf90_err( nf90_def_dim(nc_id, "time", nf90_unlimited, timedim_id) )
+ call nf90_err( nf90_def_dim(nc_id, "nchar", 18, nchardim_id) )
+
+ ! define variables
+ !*****************
+
+ ! time
+ call nf90_err( nf90_def_var(nc_id, 'time', nf90_int, (/ timedim_id /), time_id) )
+ call nf90_err( nf90_put_att(nc_id, time_id, 'units', timeunit) )
+ ! species names
+ call nf90_err( nf90_def_var(nc_id, 'species', nf90_char, (/ nchardim_id, specdim_id /), spec_id) )
+ call nf90_err( nf90_put_att(nc_id, spec_id, 'long_name', 'Species names') )
+ ! total masses
+ call nf90_err( nf90_def_var(nc_id, 'mass', nf90_double, (/ specdim_id, timedim_id /), mass_id) )
+ call nf90_err( nf90_put_att(nc_id, mass_id, 'units', 'kg') )
+ call nf90_err( nf90_put_att(nc_id, mass_id, 'long_name', 'Total global mass') )
+ ! emission uptake
+ call nf90_err( nf90_def_var(nc_id, 'emissions', nf90_double, (/ specdim_id, timedim_id /), emis_id) )
+ call nf90_err( nf90_put_att(nc_id, emis_id, 'units', 'kg s-1') )
+ call nf90_err( nf90_put_att(nc_id, emis_id, 'long_name', 'Actual emission flux') )
+ ! emission field
+ call nf90_err( nf90_def_var(nc_id, 'em_field', nf90_double, (/ specdim_id, timedim_id /), efld_id) )
+ call nf90_err( nf90_put_att(nc_id, efld_id, 'units', 'kg s-1') )
+ call nf90_err( nf90_put_att(nc_id, efld_id, 'long_name', 'Emission flux in fields') )
+ ! emission residual
+ call nf90_err( nf90_def_var(nc_id, 'em_res', nf90_double, (/ specdim_id, timedim_id /), eres_id) )
+ call nf90_err( nf90_put_att(nc_id, eres_id, 'units', 'kg') )
+ call nf90_err( nf90_put_att(nc_id, eres_id, 'long_name', 'Emission residuals') )
+ ! chemical loss
+ call nf90_err( nf90_def_var(nc_id, 'chem_loss', nf90_double, (/ reagdim_id, specdim_id, timedim_id /), cl_id) )
+ call nf90_err( nf90_put_att(nc_id, cl_id, 'units', 'kg s-1') )
+ call nf90_err( nf90_put_att(nc_id, cl_id, 'long_name', 'Mass loss through chemical reactions') )
+
+ ! write global attributes
+ !************************
+
+ call nf90_err( nf90_put_att(nc_id, nf90_global, 'title', 'FLEXPART total mass and flux output') )
+ call nf90_err( nf90_put_att(nc_id, nf90_global, 'source', trim(flexversion)//' model output') )
+ call nf90_err( nf90_put_att(nc_id, nf90_global, 'history', date(1:4)//'-'//date(5:6)// &
+ '-'//date(7:8)//' '//time(1:2)//':'//time(3:4)//' '//zone//' created by '// &
+ trim(login_name)//' on '//trim(host_name)) )
+ call nf90_err( nf90_put_att(nc_id, nf90_global, 'references', &
+ 'Stohl et al., Atmos. Chem. Phys., 2005, doi:10.5194/acp-5-2461-200;'//&
+ 'Henne et al., in Lagrangian Modeling of the Atmosphere, 2012, doi:10.1029/2012GM001247') )
+
+ ! end definition of file
+ call nf90_err( nf90_enddef(nc_id) )
+
+ ! write species info
+ do ks=1,nspec
+ call nf90_err( nf90_put_var(nc_id, spec_id, species(ks), (/1,ks/), (/18,1/)) )
+ end do
+
+ ! close file
+ call nf90_err( nf90_close(nc_id) )
+
+ end subroutine totals_init
+
+
+ subroutine totals_write(itime)
+
+ !*****************************************************************************
+ ! *
+ ! This subroutine writes the totals to file *
+ ! *
+ ! Author: S. Henne *
+ ! Adapted by R. Thompson for v11, Feb-2024 *
+ ! *
+ !*****************************************************************************
+
+ implicit none
+
+ integer :: itime, tidx
+ integer :: var_id
+
+ ! open file
+ print*, 'fn_totals = ',fn_totals
+ call nf90_err( nf90_open(trim(fn_totals), nf90_write, nc_id) )
+
+ ! get length of time dimension -> increase index by one to write new data
+ call nf90_err( nf90_inq_dimid(nc_id, "time", timedim_id) )
+ call nf90_err( nf90_inquire_dimension(nc_id, timedim_id, len=tidx) )
+ tidx = tidx + 1
+
+ ! add to time variable
+ call nf90_err( nf90_inq_varid(nc_id, "time", time_id) )
+ call nf90_err( nf90_put_var(nc_id, time_id, itime, (/ tidx /)) )
+
+ ! write variables
+ !****************
+
+ call nf90_err( nf90_inq_varid(nc_id, "mass", var_id) )
+ call nf90_err( nf90_put_var(nc_id, var_id, tot_mass(1:nspec), (/ 1, tidx /), (/ nspec, 1/)) )
+
+ call nf90_err( nf90_inq_varid(nc_id, "emissions", var_id) )
+ call nf90_err( nf90_put_var(nc_id, var_id, tot_em_up(1:nspec)/real(lsynctime), &
+ (/ 1, tidx /), (/ nspec, 1/)) )
+
+ call nf90_err( nf90_inq_varid(nc_id, "em_field", var_id) )
+ call nf90_err( nf90_put_var(nc_id, var_id, tot_em_field(1:nspec)/real(lsynctime), &
+ (/ 1, tidx /), (/ nspec, 1/)) )
+
+ ! em_res accumulated over all time steps (units kg) -> no division by lsynctime
+ call nf90_err( nf90_inq_varid(nc_id, "em_res", var_id) )
+ call nf90_err( nf90_put_var(nc_id, var_id, tot_em_res(1:nspec), &
+ (/ 1, tidx /), (/ nspec, 1/)) )
+
+ if (nreagent.gt.0) then
+ call nf90_err( nf90_inq_varid(nc_id, "chem_loss", var_id) )
+ call nf90_err( nf90_put_var(nc_id, var_id, chem_loss(1:nreagent,1:nspec)/real(lsynctime), &
+ (/ 1, 1, tidx /), (/ nreagent, nspec, 1/)) )
+ endif
+
+ call nf90_err( nf90_close(nc_id) )
+
+ end subroutine totals_write
+
+end module totals_mod
diff --git a/src/unc_mod.f90 b/src/unc_mod.f90
index 70a2081747ef45b0a3dd8022f033f694f122e620..7b588fda66e35247b51c1e68ff578bc15cd2fc4f 100644
--- a/src/unc_mod.f90
+++ b/src/unc_mod.f90
@@ -14,6 +14,7 @@ module unc_mod
implicit none
real(dep_prec),allocatable, dimension (:,:,:,:,:,:,:) :: gridunc
+ real(dep_prec),allocatable, dimension (:,:,:) :: gridcnt
#ifdef USE_MPIINPLACE
#else
! If MPI_IN_PLACE option is not used in mpi_mod.f90::mpif_tm_reduce_grid(),
@@ -33,6 +34,7 @@ module unc_mod
real(dep_prec),allocatable, dimension (:,:,:,:,:,:,:) :: drygriduncn_omp
real(dep_prec),allocatable, dimension (:,:,:,:,:,:,:) :: wetgridunc_omp
real(dep_prec),allocatable, dimension (:,:,:,:,:,:,:) :: wetgriduncn_omp
+ real(dep_prec),allocatable, dimension (:,:,:,:) :: gridcnt_omp
#endif
! For sum of individual contributions, used for the MPI version
real(dep_prec),allocatable, dimension (:,:,:,:,:,:) :: drygridunc0
@@ -53,6 +55,8 @@ subroutine alloc_grid_unc()
allocate(gridunc(0:numxgrid-1,0:numygrid-1,numzgrid,nspec, &
maxpointspec_act,nclassunc,nageclass),stat=stat)
if (stat.ne.0) write(*,*)'ERROR: could not allocate gridunc'
+ allocate(gridcnt(0:numxgrid-1,0:numygrid-1,numzgrid),stat=stat)
+ if (stat.ne.0) write(*,*)'ERROR: could not allocate gridcnt'
#ifdef _OPENMP
allocate(gridunc_omp(0:numxgrid-1,0:numygrid-1,numzgrid,nspec, &
maxpointspec_act,nclassunc,nageclass,numthreads_grid),stat=stat)
@@ -61,6 +65,12 @@ subroutine alloc_grid_unc()
write(*,*)'increase the memory or reduce MAXTHREADGRID in COMMAND.'
error stop
endif
+ allocate(gridcnt_omp(0:numxgrid-1,0:numygrid-1,numzgrid,numthreads_grid),stat=stat)
+ if (stat.ne.0) then
+ write(*,*)'ERROR: could not allocate gridcnt_omp'
+ write(*,*)'increase the memory or reduce MAXTHREADGRID in COMMAND.'
+ error stop
+ endif
#endif
if (ldirect.gt.0) then
allocate(wetgridunc(0:numxgrid-1,0:numygrid-1,nspec, &
diff --git a/tests/default_options/SPECIES/SPECIES_050 b/tests/default_options/SPECIES/SPECIES_050
new file mode 100755
index 0000000000000000000000000000000000000000..53b8ee977e864d367d7be18b1c6966afb315c96d
--- /dev/null
+++ b/tests/default_options/SPECIES/SPECIES_050
@@ -0,0 +1,25 @@
+&SPECIES_PARAMS
+ PSPECIES="DUST-1um ",
+ PDECAY= -999.900024 ,
+ PWETA_GAS= -9.89999993E-09,
+ PWETB_GAS= 0.00000000 ,
+ PCRAIN_AERO= 1.00000000 ,
+ PCSNOW_AERO= 1.00000000 ,
+ PCCN_AERO= 0.150000000 ,
+ PIN_AERO= 0.020000000 ,
+ PRELDIFF= -9.89999962 ,
+ PHENRY= 9.99999972E-10,
+ PF0= 0.00000000 ,
+ PDENSITY= 2650.00000 ,
+ PDQUER= 9.99999997E-07,
+ PDSIGMA= 1.10000002 ,
+ PDRYVEL= -9.98999977 ,
+ PWEIGHTMOLAR= -999.900024 ,
+ POHCCONST= -9.98999977 ,
+ POHDCONST= -9.89999993E-09,
+ POHNCONST= 2.00000000 ,
+ PAREA_DOW= 7*1.00000000 ,
+ PAREA_HOUR= 24*1.00000000 ,
+ PPOINT_DOW= 7*1.00000000 ,
+ PPOINT_HOUR= 24*1.00000000 ,
+ /
diff --git a/tests/default_options/SPECIES/SPECIES_051 b/tests/default_options/SPECIES/SPECIES_051
new file mode 100755
index 0000000000000000000000000000000000000000..0a88284ce590ffc641ab5099006322b7ad090ae9
--- /dev/null
+++ b/tests/default_options/SPECIES/SPECIES_051
@@ -0,0 +1,25 @@
+&SPECIES_PARAMS
+ PSPECIES="DUST-5um ",
+ PDECAY= -999.900024 ,
+ PWETA_GAS= -9.89999993E-09,
+ PWETB_GAS= 0.00000000 ,
+ PCRAIN_AERO= 1.00000000 ,
+ PCSNOW_AERO= 1.00000000 ,
+ PCCN_AERO= 0.150000000 ,
+ PIN_AERO= 0.020000000 ,
+ PRELDIFF= -9.89999962 ,
+ PHENRY= 9.99999972E-10,
+ PF0= 0.00000000 ,
+ PDENSITY= 2650.00000 ,
+ PDQUER= 4.99999987E-06,
+ PDSIGMA= 1.10000002 ,
+ PDRYVEL= -9.98999977 ,
+ PWEIGHTMOLAR= -999.900024 ,
+ POHCCONST= -9.98999977 ,
+ POHDCONST= -9.89999993E-09,
+ POHNCONST= 2.00000000 ,
+ PAREA_DOW= 7*1.00000000 ,
+ PAREA_HOUR= 24*1.00000000 ,
+ PPOINT_DOW= 7*1.00000000 ,
+ PPOINT_HOUR= 24*1.00000000 ,
+ /
diff --git a/tests/default_winds/AVAILABLE_europe b/tests/default_winds/AVAILABLE_europe
new file mode 100644
index 0000000000000000000000000000000000000000..148f27c135e285b93a3dfbdcd920e4550a05d980
--- /dev/null
+++ b/tests/default_winds/AVAILABLE_europe
@@ -0,0 +1,5 @@
+XXXXXX EMPTY LINES XXXXXXXXX
+XXXXXX EMPTY LINES XXXXXXXX
+YYYYMMDD HHMMSS name of the file(up to 80 characters)
+20090101 000000 EAe2009010100 ON DISK
+20090101 060000 EAe2009010106 ON DISK
diff --git a/tests/default_winds/AVAILABLE_glob b/tests/default_winds/AVAILABLE_glob
new file mode 100644
index 0000000000000000000000000000000000000000..1cac537d7f4e3e5543525c5ab1cc5ae11faa1246
--- /dev/null
+++ b/tests/default_winds/AVAILABLE_glob
@@ -0,0 +1,5 @@
+XXXXXX EMPTY LINES XXXXXXXXX
+XXXXXX EMPTY LINES XXXXXXXX
+YYYYMMDD HHMMSS name of the file(up to 80 characters)
+20090101 000000 EA2009010100 ON DISK
+20090101 060000 EA2009010106 ON DISK
diff --git a/tests/part_ic.nc b/tests/part_ic.nc
new file mode 100644
index 0000000000000000000000000000000000000000..5ec33e537c4e90c2732b3564b5be5e81de33fcdc
Binary files /dev/null and b/tests/part_ic.nc differ
diff --git a/tests/pathnames_nests b/tests/pathnames_nests
index 7ee7831a14dd1de4d4d7e4321a07177dc414708c..491ada3f98de456481e7f9076f5791dc24dd6b53 100644
--- a/tests/pathnames_nests
+++ b/tests/pathnames_nests
@@ -3,4 +3,5 @@
./default_winds/
./default_winds/AVAILABLE_glob
./default_winds/
+./default_winds/AVAILABLE_europe
============================================
\ No newline at end of file
diff --git a/tests/run_default_options_test.sh b/tests/run_default_options_test.sh
index c29196144de2ee15da30c4f391c3dd2f0c527ea0..7bbd6782be50db0a5991a351725d359ac3accbc0 100644
--- a/tests/run_default_options_test.sh
+++ b/tests/run_default_options_test.sh
@@ -277,22 +277,23 @@ TESTSRUN=$((TESTSRUN + 1))
# clean up
rm -rf ./current ./output/*
#
-# # part_ic option
-# cp -rf ./default_options ./current
-# sed -i "/IPIN=/c\ IPIN= 3," ./current/COMMAND
-# sed -i "/LDIRECT=/c\ LDIRECT= -1," ./current/COMMAND
-# sed -i "/IOUTPUTFOREACHRELEASE=/c\ IOUTPUTFOREACHRELEASE= 1," ./current/COMMAND
-# sed -i "/IOUT=/c\ IOUT= 1," ./current/COMMAND
-# sed -i "/IBTIME=/c\ IBTIME= 020000," ./current/COMMAND
-# sed -i "/LOUTSTEP=/c\ LOUTSTEP= 3600," ./current/COMMAND
-# sed -i "/LOUTAVER=/c\ LOUTAVER= 3600," ./current/COMMAND
-# cp -rf part_ic.nc output/
-# ./FLEXPART pathnames
-# report "[$MM] TEST $TESTRUN (IPIN=3)"
-# STATUS=$((STATUS + $?))
-# TESTSRUN=$((TESTSRUN + 1))
-# # clean up
-# rm -rf ./current ./output/*
+#
+#PART_IC.NC input
+cp -rf ./default_options ./current
+sed -i "/IPIN=/c\ IPIN= 3," ./current/COMMAND
+sed -i "/LDIRECT=/c\ LDIRECT= -1," ./current/COMMAND
+sed -i "/IOUTPUTFOREACHRELEASE=/c\ IOUTPUTFOREACHRELEASE= 1," ./current/COMMAND
+sed -i "/IOUT=/c\ IOUT= 1," ./current/COMMAND
+sed -i "/IBTIME=/c\ IBTIME= 020000," ./current/COMMAND
+sed -i "/LOUTSTEP=/c\ LOUTSTEP= 3600," ./current/COMMAND
+sed -i "/LOUTAVER=/c\ LOUTAVER= 3600," ./current/COMMAND
+cp -rf part_ic.nc output/
+./FLEXPART pathnames
+report "[$MM] TEST $TESTRUN (IPIN=3)"
+STATUS=$((STATUS + $?))
+TESTSRUN=$((TESTSRUN + 1))
+# clean up
+rm -rf ./current ./output/*
#
#IFLUX
cp -rf ./default_options ./current