diff --git a/m_aps.f90 b/m_aps.f90 index 83ef28a..5b4e1d4 100644 --- a/m_aps.f90 +++ b/m_aps.f90 @@ -56,14 +56,14 @@ MODULE m_aps ! Purpose : Defines grid dimensions. !------------------------------------------------------------------------------------------------------------------------------- TYPE TGridHeader - REAL*4 :: xorgl ! x-origin of the grid [km] + real :: xorgl ! x-origin of the grid [km] ! (origin is left-upper corner of grid) - REAL*4 :: yorgl ! y-origin of the grid [km] + real :: yorgl ! y-origin of the grid [km] ! (origin is left-upper corner of grid) INTEGER*4 :: nrcol ! number of grid columns INTEGER*4 :: nrrow ! number of grid rows - REAL*4 :: grixl ! horizontal size of grid cell [km] - REAL*4 :: griyl ! vertical size of grid cell [km] + real :: grixl ! horizontal size of grid cell [km] + real :: griyl ! vertical size of grid cell [km] END TYPE TGridHeader !------------------------------------------------------------------------------------------------------------------------------- @@ -81,8 +81,8 @@ MODULE m_aps !------------------------------------------------------------------------------------------------------------------------------- TYPE TApsGridReal TYPE (TGridHeader) :: gridheader ! grid header - REAL*4, DIMENSION(:), POINTER :: average ! average of all grid values - REAL*4, DIMENSION(:,:,:), POINTER :: value ! 3D array with real values + real, DIMENSION(:), POINTER :: average ! average of all grid values + real, DIMENSION(:,:,:), POINTER :: value ! 3D array with real values END TYPE TApsGridReal !------------------------------------------------------------------------------------------------------------------------------- @@ -113,10 +113,10 @@ MODULE m_aps ! DESCRIPTION : Returns value of grid cell with input coordinates. ! If coordinates outside grid, the average value (real grid) or 0 (integer) grid is returned. A flag, which ! indicates whether coordinates were inside the grid, is also returned. -! INPUTS : x (real*4). RDM x-coordinate value (in km). -! y (real*4). RDM y-coordinate value (in km). +! INPUTS : x (real). RDM x-coordinate value (in km). +! y (real). RDM y-coordinate value (in km). ! grid (type TAPSGrid, generic) The aps grid definition. -! OUTPUTS : value (integer*4 or real*4, generic with grid type) +! OUTPUTS : value (integer*4 or real, generic with grid type) ! The value in the grid cell or the default value (in case of location outside grid) ! iscell (logical) Whether value comes from a grid cell. !------------------------------------------------------------------------------------------------------------------------------- @@ -129,7 +129,7 @@ MODULE m_aps ! SUBROUTINE : SetAverage ! DESCRIPTION : Sets average field in aps grid structure. Average is calculated over all cells with value > 0. It is possible ! to multiply all values by a certain factor first. -! INPUTS : factor (real*4, optional). Multiplication factor. +! INPUTS : factor (real, optional). Multiplication factor. ! INPUT/OUTPUTS: grid (TApsGridReal). The field grid.average is adjusted. !------------------------------------------------------------------------------------------------------------------------------- INTERFACE SetAverage @@ -176,8 +176,8 @@ SUBROUTINE read_aps_real(filename, gridtitle, floatgrid, error) INTEGER*4 :: nrrow ! number of grid rows INTEGER*4 :: ierr ! error status (ierr != 0 => error) CHARACTER*1 :: teststring ! helpvariable -REAL*4 :: r ! helpvariable -REAL*4, DIMENSION(:,:), ALLOCATABLE :: helpgrid +real :: r ! helpvariable +real, DIMENSION(:,:), ALLOCATABLE :: helpgrid ! CONSTANTS CHARACTER*512 :: ROUTINENAAM ! name of subroutine @@ -509,7 +509,7 @@ SUBROUTINE set_average(factor, grid, fieldnumber) USE m_commonconst ! EPS_DELTA only ! SUBROUTINE ARGUMENTS - INPUT -REAL*4, INTENT(IN), OPTIONAL :: factor ! multiplication factor for the whole grid +real, INTENT(IN), OPTIONAL :: factor ! multiplication factor for the whole grid ! SUBROUTINE ARGUMENTS - I/O TYPE (TApsGridReal), INTENT(INOUT) :: grid ! real APS grid @@ -549,8 +549,8 @@ SUBROUTINE grid_value_integer(x, y, grid, gridvalue, iscell, fieldnumber) !DEC$ ATTRIBUTES DLLEXPORT:: grid_value_integer ! SUBROUTINE ARGUMENTS - INPUT -REAL*4, INTENT(IN) :: x ! RDM x-coordinate value (in km) -REAL*4, INTENT(IN) :: y ! RDM y-coordinate value (in km) +real, INTENT(IN) :: x ! RDM x-coordinate value (in km) +real, INTENT(IN) :: y ! RDM y-coordinate value (in km) TYPE (TAPSGridInt), INTENT(IN) :: grid ! integer APS grid ! SUBROUTINE ARGUMENTS - OUTPUT @@ -593,12 +593,12 @@ SUBROUTINE grid_value_real(x, y, grid, gridvalue, iscell, fieldnumber) !DEC$ ATTRIBUTES DLLEXPORT:: grid_value_real ! SUBROUTINE ARGUMENTS - INPUT -REAL*4, INTENT(IN) :: x ! RDM x-coordinate value (in km) -REAL*4, INTENT(IN) :: y ! RDM y-coordinate value (in km) +real, INTENT(IN) :: x ! RDM x-coordinate value (in km) +real, INTENT(IN) :: y ! RDM y-coordinate value (in km) TYPE (TAPSGridReal), INTENT(IN) :: grid ! real APS grid ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT) :: gridvalue ! the value in the grid cell or the default value +real, INTENT(OUT) :: gridvalue ! the value in the grid cell or the default value ! (in case of location outside grid) LOGICAL, INTENT(OUT) :: iscell ! whether value comes from a grid cell INTEGER, OPTIONAL, INTENT(IN) :: fieldnumber ! fieldnumber to retreive data from @@ -636,8 +636,8 @@ END SUBROUTINE grid_value_real SUBROUTINE grid_cell_index(x, y, gridheader, m, n, iscell) ! SUBROUTINE ARGUMENTS - INPUT -REAL*4, INTENT(IN) :: x ! RDM x-coordinate [km] -REAL*4, INTENT(IN) :: y ! RDM y-coordinate [km] +real, INTENT(IN) :: x ! RDM x-coordinate [km] +real, INTENT(IN) :: y ! RDM y-coordinate [km] TYPE (TGridHeader), INTENT(IN) :: gridheader ! Header definition of grid ! SUBROUTINE ARGUMENTS - OUTPUT diff --git a/m_commonconst.f90 b/m_commonconst.f90 index bfcb97f..e8bdfc6 100644 --- a/m_commonconst.f90 +++ b/m_commonconst.f90 @@ -65,38 +65,38 @@ MODULE m_commonconst INTEGER*4, PARAMETER :: ncolBuildingEffectTable = 5 ! 1st column corresponds to distance from building. 2-5 correspond to different building types ! CONSTANTS - overige -REAL*4 :: z0_FACT_NL = 10000. ! default factor for conversion of z0_nl gridvalue to meters -REAL*4 :: z0_FACT_EUR = 10000. ! default factor for conversion of z0_eur gridvalue to meters - -REAL*4, PARAMETER :: zmet_T = 1.5 ! reference height for temperature measurements [m] +real :: z0_FACT_NL = 10000. ! default factor for conversion of z0_nl gridvalue to meters +real :: z0_FACT_EUR = 10000. ! default factor for conversion of z0_eur gridvalue to meters -INTEGER*4, PARAMETER :: IGEO = 0 ! 1 -> Geographical coordinates lon-lat [degrees]; 0 -> RDM coordinates [m] +real, PARAMETER :: zmet_T = 1.5 ! reference height for temperature measurements [m] + +INTEGER*4, PARAMETER :: IGEO = 0 ! 1 -> Geographical coordinates lon-lat [degrees]; 0 -> RDM coordinates [m] INTEGER*4, PARAMETER :: MISVALNUM = -9999 ! missing value INTEGER*4, PARAMETER :: FIRSTYEAR = 1977 ! first year, used for interpolating background maps INTEGER*4, PARAMETER :: FUTUREYEAR = 2020 ! future year, used for interpolating background maps -REAL*4 :: r4_for_tiny ! help variable to define EPS_DELTA -REAL*8 :: r8_for_tiny ! help variable to define DEPS_DELTA -REAL*4, PARAMETER :: EPS_DELTA = tiny(r4_for_tiny) ! tiny number (real) -REAL*8, PARAMETER :: DPEPS_DELTA = tiny(r8_for_tiny) ! tiny number (double precision) -REAL*4, PARAMETER :: HUMAX = 500. ! maximal plume height [m] +real :: r4_for_tiny ! help variable to define EPS_DELTA +double precision :: r8_for_tiny ! help variable to define DEPS_DELTA +real, PARAMETER :: EPS_DELTA = tiny(r4_for_tiny) ! tiny number (real) +double precision, PARAMETER :: DPEPS_DELTA = tiny(r8_for_tiny) ! tiny number (double precision) +real, PARAMETER :: HUMAX = 500. ! maximal plume height [m] CHARACTER*8, PARAMETER :: MODVERSIE = '5.0.0.0' ! model version OPS-LT CHARACTER*20, PARAMETER :: RELEASEDATE = '26 dec 2019' ! release date -! + ! CONSTANTS - Data -! + INTEGER*4 :: NACHTZOMER(NSTAB, NTRAJ) ! relative occurrences (%) of nighttime hours in summer (for each stability class and distance class) ("NACHT" = night, "ZOMER" = summer) INTEGER*4 :: NACHTWINTER(NSTAB, NTRAJ) ! relative occurrences (%) of nighttime hours in winter (for each stability class and distance class) ("NACHT" = night) -REAL*4 :: DISPH(NSTAB) ! coefficients for vertical dispersion coefficient sigma_z; sigma_z = dispg*x**disph -REAL*4 :: STOKES(NPARTCLASS) ! Sedimentation velocity (m/s) needed for plume descent in case of heavy particles, for each particle class -REAL*4 :: SCWINTER(NSTAB) ! variation in NO2/NOx ratio (relative to stability class S2) for each stability class (only in winter) -REAL*4 :: cf_so2(NBGMAPS) ! correction factors for the difference between model output and measurements for SO2 -REAL*4 :: cf_nox(NBGMAPS) ! correction factors for the difference between model output and measurements for NOx -REAL*4 :: cf_nh3(NBGMAPS) ! correction factors for the difference between model output and measurements for NH3 -REAL*4 :: tf_so2(NYEARS + 1) ! trendfactors for SO2: concentration in year T, relative to the concentration in reference year -REAL*4 :: tf_no2(NYEARS + 1) ! trendfactors for NO2: concentration in year T, relative to the concentration in reference year -REAL*4 :: tf_nh3(NYEARS + 1) ! trendfactors for NH3: concentration in year T, relative to the concentration in reference year -REAL*4 :: nox_no2_beta(2) ! coefficient in conversion NO2 = beta(1)*log(NOx) + beta(2) +real :: DISPH(NSTAB) ! coefficients for vertical dispersion coefficient sigma_z; sigma_z = dispg*x**disph +real :: STOKES(NPARTCLASS) ! Sedimentation velocity (m/s) needed for plume descent in case of heavy particles, for each particle class +real :: SCWINTER(NSTAB) ! variation in NO2/NOx ratio (relative to stability class S2) for each stability class (only in winter) +real :: cf_so2(NBGMAPS) ! correction factors for the difference between model output and measurements for SO2 +real :: cf_nox(NBGMAPS) ! correction factors for the difference between model output and measurements for NOx +real :: cf_nh3(NBGMAPS) ! correction factors for the difference between model output and measurements for NH3 +real :: tf_so2(NYEARS + 1) ! trendfactors for SO2: concentration in year T, relative to the concentration in reference year +real :: tf_no2(NYEARS + 1) ! trendfactors for NO2: concentration in year T, relative to the concentration in reference year +real :: tf_nh3(NYEARS + 1) ! trendfactors for NH3: concentration in year T, relative to the concentration in reference year +real :: nox_no2_beta(2) ! coefficient in conversion NO2 = beta(1)*log(NOx) + beta(2) CHARACTER*10 :: CNAME(3,5) ! names of substances (primary, secondary, second secondary, deposited, name in DEPAC) CHARACTER*10 :: CNAME_SUBSEC(4) ! names of sub-secondary species (HNO3, NO3_C, NO3_F) CHARACTER*10 :: UNITS(2) ! units for concentration diff --git a/m_error.f90 b/m_error.f90 index ae5868f..b21b0d4 100644 --- a/m_error.f90 +++ b/m_error.f90 @@ -59,7 +59,7 @@ MODULE m_error CHARACTER :: paramtype ! type of parameter CHARACTER*512 :: stringvalue ! string value INTEGER*4 :: intvalue ! integer value - REAL*4 :: realvalue ! real value + real :: realvalue ! real value TYPE (TErrorParam), pointer :: nextparam ! pointer to next parameter END TYPE TErrorParam @@ -119,8 +119,8 @@ MODULE m_error MODULE PROCEDURE error_iparam ! integer*4 parameter MODULE PROCEDURE error_iaparam ! integer*4 parameter array MODULE PROCEDURE error_lparam ! logical parameter - MODULE PROCEDURE error_rparam ! real*4 parameter - MODULE PROCEDURE error_raparam ! real*4 parameter array + MODULE PROCEDURE error_rparam ! real parameter + MODULE PROCEDURE error_raparam ! real parameter array MODULE PROCEDURE error_sparam ! character*(*) string parameter MODULE PROCEDURE error_wparam ! character*(*) string parameter, but only first word is written MODULE PROCEDURE error_saparam ! character*(*) string parameter array @@ -372,7 +372,7 @@ SUBROUTINE error_rparam(paramname, value, error) ! SUBROUTINE ARGUMENTS - INPUT CHARACTER*(*), INTENT(IN) :: paramname ! -REAL*4, INTENT(IN) :: value ! +real, INTENT(IN) :: value ! SUBROUTINE ARGUMENTS - I/O TYPE (TError), INTENT(INOUT) :: error ! @@ -398,7 +398,7 @@ SUBROUTINE error_raparam(paramname, value, error) ! SUBROUTINE ARGUMENTS - INPUT CHARACTER*(*), INTENT(IN) :: paramname ! -REAL*4, INTENT(IN) :: value(:) ! +real, INTENT(IN) :: value(:) ! SUBROUTINE ARGUMENTS - I/O TYPE (TError), INTENT(INOUT) :: error ! @@ -995,7 +995,7 @@ SUBROUTINE simple_r_append(realvalue, significance, targetstring) !DEC$ ATTRIBUTES DLLEXPORT:: simple_r_append ! SUBROUTINE ARGUMENTS - INPUT -REAL*4, INTENT(IN) :: realvalue ! string to be appended +real, INTENT(IN) :: realvalue ! string to be appended INTEGER*4, INTENT(IN) :: significance ! number of significant digits ! SUBROUTINE ARGUMENTS - I/O @@ -1018,8 +1018,8 @@ SUBROUTINE simple_rb_append(nrblanks, realvalue, significance, targetstring) USE m_commonconst ! EPS_DELTA only ! SUBROUTINE ARGUMENTS - INPUT -INTEGER*4, INTENT(IN) :: nrblanks ! -REAL*4, INTENT(IN) :: realvalue ! string to be appended +INTEGER*4, INTENT(IN) :: nrblanks +real, INTENT(IN) :: realvalue ! string to be appended INTEGER*4, INTENT(IN) :: significance ! number of significant digits ! SUBROUTINE ARGUMENTS - I/O @@ -1030,7 +1030,7 @@ SUBROUTINE simple_rb_append(nrblanks, realvalue, significance, targetstring) INTEGER*4 :: position ! position counter in writing to string INTEGER*4 :: power ! the e-value in the number INTEGER*4 :: counter ! simple loop counter -REAL*4 :: realcopy ! copy of realvalue +real :: realcopy ! copy of realvalue INTEGER*4 :: intcopy ! copy of significant realvalue INTEGER*4 :: intcopy2 ! copy of significant realvalue INTEGER*4 :: char0 ! '0' character diff --git a/m_geoutils.f90 b/m_geoutils.f90 index 9aee7a2..8aff5dd 100644 --- a/m_geoutils.f90 +++ b/m_geoutils.f90 @@ -64,10 +64,10 @@ MODULE m_geoutils ! ca. 10000 km west (y < 4000 km) -96 lon 17 lat ! ca. 6000 km west (y < 5000 km) -95 lon 47 lat ! -! INPUTS : amcx (real*4), RDM x-coordinate [km] -! amcy (real*4), RDM y-coordinate [km] -! OUTPUTS : geol (real*4), longitude [degrees] -! geob (real*4), latitude [degrees] +! INPUTS : amcx (real), RDM x-coordinate [km] +! amcy (real), RDM y-coordinate [km] +! OUTPUTS : geol (real), longitude [degrees] +! geob (real), latitude [degrees] ! "geo" << geographical coordinates; "l" << lengtegraad = longitude, "b" << breedtegraad = latitude !------------------------------------------------------------------------------------------------------------------------------- @@ -78,10 +78,10 @@ MODULE m_geoutils !------------------------------------------------------------------------------------------------------------------------------- ! SUBROUTINE : geo2amc ! PURPOSE : Convert greographical lon-lat coordinates to RDM coordinates -! INPUTS : geob (real*4), latitude, phi (degrees) -! geob (real*4), longitude, lambda (degrees) -! OUTPUTS : amcx (real*4), RDM x-coordinate -! amcx (real*4), RDM y-coordinate +! INPUTS : geob (real), latitude, phi (degrees) +! geob (real), longitude, lambda (degrees) +! OUTPUTS : amcx (real), RDM x-coordinate +! amcx (real), RDM y-coordinate !------------------------------------------------------------------------------------------------------------------------------- INTERFACE geo2amc @@ -91,10 +91,10 @@ MODULE m_geoutils !------------------------------------------------------------------------------------------------------------------------------- ! SUBROUTINE : amc2lam ! PURPOSE : Berekenen van de lambert azimuthal equal area coordinaten (x,y) in km. uit de topografische (amersfoortse) coordinaten. -! INPUTS : amcx (real*4), x-coordinaat, Amersfoorts -! amcy (real*4), y-coordinaat, Amersfoorts -! OUTPUTS : lamx (real*4), x-coordinaat, Lambert azimuthaal -! : lamy (real*4), y-coordinaat, Lambert azimuthaal +! INPUTS : amcx (real), x-coordinaat, Amersfoorts +! amcy (real), y-coordinaat, Amersfoorts +! OUTPUTS : lamx (real), x-coordinaat, Lambert azimuthaal +! : lamy (real), y-coordinaat, Lambert azimuthaal !------------------------------------------------------------------------------------------------------------------------------- INTERFACE amc2lam @@ -104,10 +104,10 @@ MODULE m_geoutils !------------------------------------------------------------------------------------------------------------------------------- ! SUBROUTINE : geo2lam ! PURPOSE : Berekenen van de lambert azimuthal equal area coordinaten (x,y) in km. uit de geografische coordinaten. -! INPUTS : geob (real*4), breedtegraad, phi (dec.) -! geol (real*4), lengtegraad, labda (dec.) -! OUTPUTS : lamx (real*4), x-coordinaat, Lambert azimuthaal -! : lamy (real*4), y-coordinaat, Lambert azimuthaal +! INPUTS : geob (real), breedtegraad, phi (dec.) +! geol (real), lengtegraad, labda (dec.) +! OUTPUTS : lamx (real), x-coordinaat, Lambert azimuthaal +! : lamy (real), y-coordinaat, Lambert azimuthaal !------------------------------------------------------------------------------------------------------------------------------- INTERFACE geo2lam @@ -131,21 +131,21 @@ SUBROUTINE amc2geo(amcx, amcy, geol, geob) PARAMETER (ROUTINENAAM = 'amc2geo') ! SUBROUTINE ARGUMENTS - INPUT -REAL*4, INTENT(IN) :: amcx ! RDM x-coordinate (km) -REAL*4, INTENT(IN) :: amcy ! RDM y-coordinate (km) +real, INTENT(IN) :: amcx ! RDM x-coordinate (km) +real, INTENT(IN) :: amcy ! RDM y-coordinate (km) ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT) :: geol ! longitude [degrees] -REAL*4, INTENT(OUT) :: geob ! latitude [degrees] +real, INTENT(OUT) :: geol ! longitude [degrees] +real, INTENT(OUT) :: geob ! latitude [degrees] ! LOCAL VARIABLES INTEGER*4 :: tel ! iteration index -REAL*4 :: difx ! threshold value for dx -REAL*4 :: dify ! threshold value for dy -REAL*4 :: dx ! x - x0 -REAL*4 :: dy ! y - y0 -REAL*4 :: amcx0 ! RDM x-coordinate that corresponds with (gb,gl) -REAL*4 :: amcy0 ! RDM y-coordinate that corresponds with (gb,gl) +real :: difx ! threshold value for dx +real :: dify ! threshold value for dy +real :: dx ! x - x0 +real :: dy ! y - y0 +real :: amcx0 ! RDM x-coordinate that corresponds with (gb,gl) +real :: amcy0 ! RDM y-coordinate that corresponds with (gb,gl) ! SCCS-ID VARIABLES CHARACTER*81 :: sccsida ! @@ -228,24 +228,24 @@ SUBROUTINE geo2amc(geob, geol, amcx, amcy) PARAMETER (ROUTINENAAM = 'geo2amc') ! CONSTANTS -REAL*4 :: AMFI ! longitude (phi) of Amersfoort (centre of RDM grid) -REAL*4 :: AMLA ! latitude (lambda) of Amersfoort (centre of RDM grid) +real :: AMFI ! longitude (phi) of Amersfoort (centre of RDM grid) +real :: AMLA ! latitude (lambda) of Amersfoort (centre of RDM grid) PARAMETER (AMFI = 18.7762) PARAMETER (AMLA = 1.9395) ! 1 degree = 3600 seconds; AMFI, AMLA in units of 10000 seconds; conversion factor to degrees = 10000/3600: ! 10000*[AMFI, AMLA]/3600 = [AMFI, AMLA]/0.36 = [18.7762 1.9395]/0.36 = [52.1561 5.3875] = [Lat, Lon]_Amersfoort ! SUBROUTINE ARGUMENTS - INPUT -REAL*4, INTENT(IN) :: geol ! longitude (phi) [degrees] -REAL*4, INTENT(IN) :: geob ! latitude (lambda) [degrees] +real, INTENT(IN) :: geol ! longitude (phi) [degrees] +real, INTENT(IN) :: geob ! latitude (lambda) [degrees] ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT) :: amcx ! RDM x-coordinate (km) -REAL*4, INTENT(OUT) :: amcy ! RDM y-coordinate (km +real, INTENT(OUT) :: amcx ! RDM x-coordinate (km) +real, INTENT(OUT) :: amcy ! RDM y-coordinate (km ! LOCAL VARIABLES -REAL*4 :: f1 ! -REAL*4 :: l1 ! +real :: f1 +real :: l1 ! SCCS-ID VARIABLES CHARACTER*81 :: sccsida ! @@ -278,16 +278,16 @@ SUBROUTINE amc2lam(amcx, amcy, lamx, lamy) ! CONSTANTS ! SUBROUTINE ARGUMENTS - INPUT -REAL*4, INTENT(IN) :: amcx ! amersfoortse x-coordinaat (km) -REAL*4, INTENT(IN) :: amcy ! amersfoortse y-coordinaat (km) +real, INTENT(IN) :: amcx ! amersfoortse x-coordinaat (km) +real, INTENT(IN) :: amcy ! amersfoortse y-coordinaat (km) ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT) :: lamx ! lambert azimuthal x-coordinaat (km) -REAL*4, INTENT(OUT) :: lamy ! lambert azimuthal y-coordinaat (km) +real, INTENT(OUT) :: lamx ! lambert azimuthal x-coordinaat (km) +real, INTENT(OUT) :: lamy ! lambert azimuthal y-coordinaat (km) ! LOCAL VARIABLES -REAL*4 :: geol ! hulpvariabele voor phi -REAL*4 :: geob ! hulpvariabele voor lambda +real :: geol ! hulpvariabele voor phi +real :: geob ! hulpvariabele voor lambda ! SCCS-ID VARIABLES CHARACTER*81 :: sccsida ! @@ -321,12 +321,12 @@ SUBROUTINE geo2lam(geob, geol, lamx, lamy) PARAMETER (ROUTINENAAM = 'geo2lam') ! CONSTANTS -REAL*8 :: false_east ! linear value added to the x-coordinate values (longitude) -REAL*8 :: false_north ! linear value added to the y-coordinate values (latitude) -REAL*8 :: R ! radius of the earth (equatorial) -REAL*8 :: degtorad ! degrees to radians -REAL*8 :: cen_med ! central median or central longitude -REAL*8 :: lat_ori ! latitude of origen or standard parallel +double precision :: false_east ! linear value added to the x-coordinate values (longitude) +double precision :: false_north ! linear value added to the y-coordinate values (latitude) +double precision :: R ! radius of the earth (equatorial) +double precision :: degtorad ! degrees to radians +double precision :: cen_med ! central median or central longitude +double precision :: lat_ori ! latitude of origen or standard parallel PARAMETER (false_east = 4321000) PARAMETER (false_north = 3210000) @@ -336,27 +336,27 @@ SUBROUTINE geo2lam(geob, geol, lamx, lamy) PARAMETER (lat_ori = 52) ! SUBROUTINE ARGUMENTS - INPUT -REAL*4, INTENT(IN) :: geob ! breedtegraad (lambda) (dec.) (lat) -REAL*4, INTENT(IN) :: geol ! lengtegraad (phi) (dec.) (lon) +real, INTENT(IN) :: geob ! breedtegraad (lambda) (dec.) (lat) +real, INTENT(IN) :: geol ! lengtegraad (phi) (dec.) (lon) ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT) :: lamx ! lambert azimuthal x-coordinaat (km) -REAL*4, INTENT(OUT) :: lamy ! lambert azimuthal y-coordinaat (km) +real, INTENT(OUT) :: lamx ! lambert azimuthal x-coordinaat (km) +real, INTENT(OUT) :: lamy ! lambert azimuthal y-coordinaat (km) ! LOCAL VARIABLES -real*8 :: ksp -real*8 :: lon ! longitude of the original grid -real*8 :: lat ! latitude of the original grid -real*8 :: sin_lat -real*8 :: cos_lat -real*8 :: sin_lon -real*8 :: cos_lon -real*8 :: sin_lat_ori -real*8 :: cos_lat_ori -real*8 :: sin_lon_delta -real*8 :: cos_lon_delta -real*8 :: x -real*8 :: y +double precision :: ksp +double precision :: lon ! longitude of the original grid +double precision :: lat ! latitude of the original grid +double precision :: sin_lat +double precision :: cos_lat +double precision :: sin_lon +double precision :: cos_lon +double precision :: sin_lat_ori +double precision :: cos_lat_ori +double precision :: sin_lon_delta +double precision :: cos_lon_delta +double precision :: x +double precision :: y ! SCCS-ID VARIABLES CHARACTER*81 :: sccsida ! diff --git a/m_getkey.f90 b/m_getkey.f90 index 2542ab4..77927cb 100644 --- a/m_getkey.f90 +++ b/m_getkey.f90 @@ -62,7 +62,7 @@ MODULE m_getkey ! REMARK : GetKeyValue is generic for the following types: ! strings (character*(*)) ! integer*4 -! real*4 +! real ! logical !------------------------------------------------------------------------------------------------------------------------------- INTERFACE GetKeyValue @@ -86,7 +86,7 @@ MODULE m_getkey ! RESULT : Logical. False if an error was detected. ! REMARK : GetCheckedKey is generic for the following types: ! integer*4 -! real*4 +! real ! REMARK2 : A special checked key instance checks filepaths and has a different profile (isrequired is not passed): ! : parname (character*(*)). Name of the parameter. checkdefine(logical). If flag is set: test whether name was ! entered. @@ -230,7 +230,7 @@ FUNCTION get_key_real(parname, value, error) CHARACTER*(*), INTENT(IN) :: parname ! ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT) :: value ! +real, INTENT(OUT) :: value TYPE (TError), INTENT(OUT) :: error ! Error handling record ! RESULT @@ -529,12 +529,12 @@ FUNCTION check_range_real(parname,lower,upper,isrequired, value, error) ! SUBROUTINE ARGUMENTS - INPUT CHARACTER*(*), INTENT(IN) :: parname ! -REAL*4, INTENT(IN) :: lower ! lower limit of value -REAL*4, INTENT(IN) :: upper ! upper limit of value +real, INTENT(IN) :: lower ! lower limit of value +real, INTENT(IN) :: upper ! upper limit of value LOGICAL, INTENT(IN) :: isrequired ! whether a value is required ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT) :: value ! real value extracted +real, INTENT(OUT) :: value ! real value extracted TYPE (TError), INTENT(OUT) :: error ! error handling record ! RESULT diff --git a/m_ops_building.f90 b/m_ops_building.f90 index 90ef777..3518b22 100644 --- a/m_ops_building.f90 +++ b/m_ops_building.f90 @@ -576,14 +576,14 @@ SUBROUTINE ops_building_get_factor(buildingType, angle_SR_xaxis, dist, buildingF ! SUBROUTINE ARGUMENTS - INPUT INTEGER, INTENT(IN) :: buildingType ! = 0 -> no building effect (factor = 1) -REAL*4, INTENT(IN) :: angle_SR_xaxis ! angle between source-receptor vector and x-axis (needed for building effect) [degrees] -REAL*4, INTENT(IN) :: dist ! distance between source and receptor -REAL*4, INTENT(IN) :: buildingFactDistances(:) ! distances for which building effect function has been computed -REAL*4, INTENT(IN) :: buildingFactAngleSRxaxis(:) ! source receptor angles (w.r.t. x-axis) for which building effect function has been computed -REAL*4, INTENT(IN) :: buildingFactFunction(:,:) ! 2D building effect function (function of angle, distance) +real, INTENT(IN) :: angle_SR_xaxis ! angle between source-receptor vector and x-axis (needed for building effect) [degrees] +real, INTENT(IN) :: dist ! distance between source and receptor +real, INTENT(IN) :: buildingFactDistances(:) ! distances for which building effect function has been computed +real, INTENT(IN) :: buildingFactAngleSRxaxis(:) ! source receptor angles (w.r.t. x-axis) for which building effect function has been computed +real, INTENT(IN) :: buildingFactFunction(:,:) ! 2D building effect function (function of angle, distance) ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT) :: buildingFact ! building effect factor interpolated between (angle, distance) values in buildingFactFunction +real, INTENT(OUT) :: buildingFact ! building effect factor interpolated between (angle, distance) values in buildingFactFunction ! LOCAL VARIABLES REAL :: distcor ! corrected distance for distances below cut-off distance; for these distances take the effect at the cut-off distance diff --git a/m_ops_emis.f90 b/m_ops_emis.f90 index 8d76f9d..8d966db 100644 --- a/m_ops_emis.f90 +++ b/m_ops_emis.f90 @@ -413,11 +413,11 @@ SUBROUTINE check_source(nr, varnaam, onder, boven, varwaarde, error) ! SUBROUTINE ARGUMENTS - INPUT INTEGER*4, INTENT(IN) :: nr ! record number of source file CHARACTER*(*), INTENT(IN) :: varnaam ! variable to be checked -REAL*4, INTENT(IN) :: onder ! lower limit -REAL*4, INTENT(IN) :: boven ! upper limit +real, INTENT(IN) :: onder ! lower limit +real, INTENT(IN) :: boven ! upper limit ! SUBROUTINE ARGUMENTS - I/O -REAL*4, INTENT(INOUT) :: varwaarde ! (adapted) value of variable +real, INTENT(INOUT) :: varwaarde ! (adapted) value of variable TYPE (TError), INTENT(INOUT) :: error ! error handling record ! LOCAL VARIABLES @@ -515,7 +515,7 @@ SUBROUTINE check_isource(nr, varnaam, onder, boven, varwaarde, error) TYPE (TError), INTENT(INOUT) :: error ! error handling record ! LOCAL VARIABLES -REAL*4 :: var ! help variable (= float(varwaarde)) +real :: var ! help variable (= float(varwaarde)) var = FLOAT(varwaarde) CALL check_source(nr, varnaam, FLOAT(onder), FLOAT(boven), var, error) @@ -541,9 +541,9 @@ SUBROUTINE check_source2(varnaam, onder, boven, varwaarde, error) ! SUBROUTINE ARGUMENTS - INPUT CHARACTER*(*), INTENT(IN) :: varnaam ! variable to be checked -REAL*4, INTENT(IN) :: onder ! lower limit -REAL*4, INTENT(IN) :: boven ! upper limit -REAL*4, INTENT(IN) :: varwaarde ! value of variable +real, INTENT(IN) :: onder ! lower limit +real, INTENT(IN) :: boven ! upper limit +real, INTENT(IN) :: varwaarde ! value of variable ! SUBROUTINE ARGUMENTS - I/O TYPE (TError), INTENT(INOUT) :: error ! error handling record @@ -589,9 +589,9 @@ SUBROUTINE check_source3(warning1, varnaam, onder, boven, varwaarde, error) ! SUBROUTINE ARGUMENTS - INPUT CHARACTER*(*), INTENT(IN) :: warning1 ! first part of warning CHARACTER*(*), INTENT(IN) :: varnaam ! variable to be checked -REAL*4, INTENT(IN) :: onder ! lower limit -REAL*4, INTENT(IN) :: boven ! upper limit -REAL*4, INTENT(IN) :: varwaarde ! value of variable +real, INTENT(IN) :: onder ! lower limit +real, INTENT(IN) :: boven ! upper limit +real, INTENT(IN) :: varwaarde ! value of variable ! SUBROUTINE ARGUMENTS - I/O TYPE (TError), INTENT(INOUT) :: error ! error handling record diff --git a/m_utils.f90 b/m_utils.f90 index 31c1d54..5db5b21 100644 --- a/m_utils.f90 +++ b/m_utils.f90 @@ -302,7 +302,7 @@ SUBROUTINE allocreal0(dim, arr, error) INTEGER*4, INTENT(IN) :: dim ! ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT), DIMENSION(:), POINTER :: arr ! +real, INTENT(OUT), DIMENSION(:), POINTER :: arr TYPE (TError), INTENT(OUT) :: error ! Error handling record ! CONSTANTS @@ -324,11 +324,11 @@ SUBROUTINE allocreal(dim, defvalue, arr, error) !DEC$ ATTRIBUTES DLLEXPORT:: allocreal ! SUBROUTINE ARGUMENTS - INPUT -INTEGER*4, INTENT(IN) :: dim ! -REAL*4, INTENT(IN) :: defvalue ! +INTEGER*4, INTENT(IN) :: dim +real, INTENT(IN) :: defvalue ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT), DIMENSION(:), POINTER :: arr ! +real, INTENT(OUT), DIMENSION(:), POINTER :: arr TYPE (TError), INTENT(OUT) :: error ! Error handling record ! LOCAL VARIABLES @@ -387,7 +387,7 @@ SUBROUTINE allocdouble(dim, defvalue, arr, error) ! SUBROUTINE ARGUMENTS - INPUT INTEGER*4, INTENT(IN) :: dim ! -REAL*4, INTENT(IN) :: defvalue ! +real, INTENT(IN) :: defvalue ! SUBROUTINE ARGUMENTS - OUTPUT DOUBLE PRECISION, INTENT(OUT), DIMENSION(:), POINTER :: arr ! @@ -427,7 +427,7 @@ SUBROUTINE allocreal2(dim1, dim2, arr, error) INTEGER*4, INTENT(IN) :: dim2 ! ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT), DIMENSION(:,:), POINTER :: arr ! +real, INTENT(OUT), DIMENSION(:,:), POINTER :: arr TYPE (TError), INTENT(OUT) :: error ! Error handling record ! LOCAL VARIABLES @@ -462,7 +462,7 @@ SUBROUTINE allocreal2a(dim1, dim2, arr, error) INTEGER*4, INTENT(IN) :: dim2 ! ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT), DIMENSION(:,:), ALLOCATABLE :: arr ! +real, INTENT(OUT), DIMENSION(:,:), ALLOCATABLE :: arr TYPE (TError), INTENT(OUT) :: error ! Error handling record ! LOCAL VARIABLES @@ -535,7 +535,7 @@ SUBROUTINE allocreal3(dim1, dim2, dim3, arr, error) INTEGER*4, INTENT(IN) :: dim3 ! ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT), DIMENSION(:,:,:), POINTER :: arr ! +real, INTENT(OUT), DIMENSION(:,:,:), POINTER :: arr TYPE (TError), INTENT(OUT) :: error ! Error handling record ! LOCAL VARIABLES @@ -737,7 +737,7 @@ SUBROUTINE deallocreal(arr) !DEC$ ATTRIBUTES DLLEXPORT:: deallocreal ! SUBROUTINE ARGUMENTS - I/O -REAL*4, INTENT(INOUT), DIMENSION(:), POINTER :: arr ! +real, INTENT(INOUT), DIMENSION(:), POINTER :: arr ! CONSTANTS CHARACTER*512 :: ROUTINENAAM ! @@ -776,7 +776,7 @@ SUBROUTINE deallocreal2(arr) !DEC$ ATTRIBUTES DLLEXPORT:: deallocreal2 ! SUBROUTINE ARGUMENTS - I/O -REAL*4, INTENT(INOUT), DIMENSION(:,:), POINTER :: arr ! +real, INTENT(INOUT), DIMENSION(:,:), POINTER :: arr ! CONSTANTS CHARACTER*512 :: ROUTINENAAM ! @@ -816,7 +816,7 @@ SUBROUTINE deallocreal3(arr) !DEC$ ATTRIBUTES DLLEXPORT:: deallocreal3 ! SUBROUTINE ARGUMENTS - I/O -REAL*4, INTENT(INOUT), DIMENSION(:,:,:), POINTER :: arr ! +real, INTENT(INOUT), DIMENSION(:,:,:), POINTER :: arr ! CONSTANTS CHARACTER*512 :: ROUTINENAAM ! @@ -916,7 +916,7 @@ SUBROUTINE getreal (string, value, nopart, error) CHARACTER*(*), INTENT(IN) :: string ! String with real number, starting at pos. 1. ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT) :: value ! +real, INTENT(OUT) :: value LOGICAL, INTENT(OUT) :: nopart ! TRUE als er geen real is gelezen TYPE (TError), INTENT(OUT) :: error ! Error handling record @@ -924,7 +924,7 @@ SUBROUTINE getreal (string, value, nopart, error) INTEGER*4 :: beyondpos ! First position beyond integer in string INTEGER*4 :: morepos ! First position beyond integer in substring INTEGER*4 :: intpart ! Extracted integer from string -REAL*4 :: decpart ! Extracted decimal part from string +real :: decpart ! Extracted decimal part from string LOGICAL :: nodecpart ! TRUE als er geen real is gelezen LOGICAL :: negative ! Of getal negatief is CHARACTER :: testchar ! Character looked at @@ -1089,7 +1089,7 @@ END SUBROUTINE getint !------------------------------------------------------------------------------------------------------------------------------- SUBROUTINE byteswap1(ishort, shortdim) -!DEC$ ATTRIBUTES DLLEXPORT:: byteswap1 +!DEC$ ATTRIBUTES DLLEXPORT:: byteswap1 ! SUBROUTINE ARGUMENTS - INPUT INTEGER*4, INTENT(IN) :: shortdim ! number of elements in ishort @@ -1641,14 +1641,14 @@ SUBROUTINE SortMatrix (matrix, nobs, column) INTEGER*4, INTENT(IN) :: column ! ! SUBROUTINE ARGUMENTS - I/O -REAL*4, INTENT(INOUT) :: matrix(:,:) ! +real, INTENT(INOUT) :: matrix(:,:) ! LOCAL VARIABLES INTEGER*4 :: i ! INTEGER*4 :: j ! INTEGER*4 :: ctr ! INTEGER*4 :: isize ! -REAL*4, ALLOCATABLE :: tmp(:) ! +real, ALLOCATABLE :: tmp(:) isize=SIZE(matrix,DIM=1) ALLOCATE(tmp(isize)) diff --git a/ops_bgcon.f90 b/ops_bgcon.f90 index 038de0b..18fc366 100644 --- a/ops_bgcon.f90 +++ b/ops_bgcon.f90 @@ -55,13 +55,13 @@ SUBROUTINE ops_bgcon(x, y, bgdata, bgcon, fieldnumber) PARAMETER (ROUTINENAAM = 'ops_bgcon') ! SUBROUTINE ARGUMENTS - INPUT -REAL*4, INTENT(IN) :: x ! x coordinate of specific location -REAL*4, INTENT(IN) :: y ! y coordinate of specific location +real, INTENT(IN) :: x ! x coordinate of specific location +real, INTENT(IN) :: y ! y coordinate of specific location TYPE (TApsGridReal), INTENT(IN) :: bgdata ! APS-grid with background concentrations INTEGER, OPTIONAL :: fieldnumber ! field number in APS-grid ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT) :: bgcon ! background concentration at (x,y) +real, INTENT(OUT) :: bgcon ! background concentration at (x,y) ! LOCAL VARIABLES LOGICAL :: iscell ! whether (x,y) is inside APS-grid bgdata diff --git a/ops_bgcon_tra.f90 b/ops_bgcon_tra.f90 index 3668114..412180b 100644 --- a/ops_bgcon_tra.f90 +++ b/ops_bgcon_tra.f90 @@ -55,20 +55,20 @@ SUBROUTINE ops_bgcon_tra(xr, yr, xb, yb, bgdata, bgcon) PARAMETER (ROUTINENAAM = 'ops_bgcon_tra') ! SUBROUTINE ARGUMENTS - INPUT -REAL*4, INTENT(IN) :: xr ! x coordinate receptor -REAL*4, INTENT(IN) :: yr ! y coordinate receptor -REAL*4, INTENT(IN) :: xb ! x coordinate source (b << "bron" = source) -REAL*4, INTENT(IN) :: yb ! y coordinate source +real, INTENT(IN) :: xr ! x coordinate receptor +real, INTENT(IN) :: yr ! y coordinate receptor +real, INTENT(IN) :: xb ! x coordinate source (b << "bron" = source) +real, INTENT(IN) :: yb ! y coordinate source TYPE (TApsGridReal), INTENT(IN) :: bgdata ! grid with background concentrations ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT) :: bgcon ! background concentration averaged over trajecory +real, INTENT(OUT) :: bgcon ! background concentration averaged over trajecory ! between source and receptor ! LOCAL VARIABLES -REAL*4 :: x ! x coordinate of intermediate point between source and receptor -REAL*4 :: y ! y coordinate of intermediate point between source and receptor -REAL*4 :: total ! summed total of background concentration in intermediate points +real :: x ! x coordinate of intermediate point between source and receptor +real :: y ! y coordinate of intermediate point between source and receptor +real :: total ! summed total of background concentration in intermediate points INTEGER*4 :: ns ! number of trajectory sectors between intermediate points INTEGER*4 :: i ! index of intermediate point !------------------------------------------------------------------------------------------------------------------------------- diff --git a/ops_bron_rek.f90 b/ops_bron_rek.f90 index e3521c5..1de04ec 100644 --- a/ops_bron_rek.f90 +++ b/ops_bron_rek.f90 @@ -58,32 +58,32 @@ SUBROUTINE ops_bron_rek(emtrend, buildingEffect, landmax, emis, nsbuf, bnr, bx, PARAMETER (ROUTINENAAM = 'ops_bron_rek') ! SUBROUTINE ARGUMENTS - INPUT -REAL*4, INTENT(IN) :: emtrend +real, INTENT(IN) :: emtrend type(TbuildingEffect) :: buildingEffect ! structure with building effect tables ! SUBROUTINE ARGUMENTS - I/O INTEGER*4, INTENT(INOUT) :: landmax -REAL*4, INTENT(INOUT) :: emis(6,NLANDMAX) +real, INTENT(INOUT) :: emis(6,NLANDMAX) ! SUBROUTINE ARGUMENTS - OUTPUT INTEGER*4, INTENT(OUT) :: nsbuf INTEGER*4, INTENT(OUT) :: bnr(LSBUF) INTEGER*4, INTENT(OUT) :: bx(LSBUF) INTEGER*4, INTENT(OUT) :: by(LSBUF) -REAL*4, INTENT(OUT) :: bdiam(LSBUF) -REAL*4, INTENT(OUT) :: bsterkte(LSBUF) -REAL*4, INTENT(OUT) :: bwarmte(LSBUF) -REAL*4, INTENT(OUT) :: bhoogte(LSBUF) -REAL*4, INTENT(OUT) :: bsigmaz(LSBUF) -REAL*4, INTENT(OUT) :: bD_stack(LSBUF) ! diameter of the stack [m] -REAL*4, INTENT(OUT) :: bV_stack(LSBUF) ! exit velocity of plume at stack tip [m/s] -REAL*4, INTENT(OUT) :: bTs_stack(LSBUF) ! temperature of effluent from stack [K] +real, INTENT(OUT) :: bdiam(LSBUF) +real, INTENT(OUT) :: bsterkte(LSBUF) +real, INTENT(OUT) :: bwarmte(LSBUF) +real, INTENT(OUT) :: bhoogte(LSBUF) +real, INTENT(OUT) :: bsigmaz(LSBUF) +real, INTENT(OUT) :: bD_stack(LSBUF) ! diameter of the stack [m] +real, INTENT(OUT) :: bV_stack(LSBUF) ! exit velocity of plume at stack tip [m/s] +real, INTENT(OUT) :: bTs_stack(LSBUF) ! temperature of effluent from stack [K] LOGICAL, INTENT(OUT) :: bemis_horizontal(LSBUF) ! horizontal outflow of emission type(Tbuilding), INTENT(OUT) :: bbuilding(LSBUF) ! array with structures with building parameters INTEGER*4, INTENT(OUT) :: btgedr(LSBUF) INTEGER*4, INTENT(OUT) :: bdegr(LSBUF) -REAL*4, INTENT(OUT) :: bqrv(LSBUF) -REAL*4, INTENT(OUT) :: bqtr(LSBUF) +real, INTENT(OUT) :: bqrv(LSBUF) +real, INTENT(OUT) :: bqtr(LSBUF) INTEGER*4, INTENT(OUT) :: bcatnr(LSBUF) INTEGER*4, INTENT(OUT) :: blandnr(LSBUF) LOGICAL, INTENT(OUT) :: eof ! end of file has been reached @@ -96,22 +96,22 @@ SUBROUTINE ops_bron_rek(emtrend, buildingEffect, landmax, emis, nsbuf, bnr, bx, INTEGER*4 :: idgr ! INTEGER*4 :: iland ! country code INTEGER*4 :: index ! index of country code iland, in list of country codes -REAL*4 :: gl ! -REAL*4 :: gb ! -REAL*4 :: qtr ! -REAL*4 :: qob ! -REAL*4 :: x ! -REAL*4 :: y ! -REAL*4 :: diameter ! -REAL*4 :: qww ! -REAL*4 :: hbron ! -REAL*4 :: szopp ! -REAL*4 :: D_stack ! diameter of the stack [m] -REAL*4 :: V_stack ! exit velocity of plume at stack tip [m/s] -REAL*4 :: Ts_stack ! temperature of effluent from stack [K] +real :: gl +real :: gb +real :: qtr +real :: qob +real :: x +real :: y +real :: diameter +real :: qww +real :: hbron +real :: szopp +real :: D_stack ! diameter of the stack [m] +real :: V_stack ! exit velocity of plume at stack tip [m/s] +real :: Ts_stack ! temperature of effluent from stack [K] LOGICAL :: emis_horizontal ! horizontal outflow of emission type(Tbuilding) :: building ! structure with building paramaters -REAL*4 :: qrv ! +real :: qrv CHARACTER*512 :: cbuf ! character buffer REAL :: valueArray(buildingEffect%nParam) ! array with parameters needed to compute building effect INTEGER :: iParam ! index of building parameter diff --git a/ops_brondepl.f90 b/ops_brondepl.f90 index 80b0baa..47efa8d 100644 --- a/ops_brondepl.f90 +++ b/ops_brondepl.f90 @@ -59,75 +59,75 @@ SUBROUTINE ops_brondepl(disx, xg, c, ux0, ueff, sigz, vg50trans, xl, istab, xloc PARAMETER (ROUTINENAAM = 'ops_brondepl') ! SUBROUTINE ARGUMENTS - INPUT -REAL*4, INTENT(IN) :: disx ! -REAL*4, INTENT(IN) :: xg ! -REAL*4, INTENT(IN) :: c ! undepleted concentration at z = 0 m +real, INTENT(IN) :: disx +real, INTENT(IN) :: xg +real, INTENT(IN) :: c ! undepleted concentration at z = 0 m ! (without part of plume above mixing layer) -REAL*4, INTENT(IN) :: ux0 ! wind speed near source at plume height (m/s) -REAL*4, INTENT(IN) :: ueff ! wind speed at effective transport height heff (m/s); +real, INTENT(IN) :: ux0 ! wind speed near source at plume height (m/s) +real, INTENT(IN) :: ueff ! wind speed at effective transport height heff (m/s); ! for short distances heff = plume height; ! for large distances heff = 1/2 mixing height; ! heff is interpolated for intermediate distances. -REAL*4, INTENT(IN) :: sigz ! -REAL*4, INTENT(IN) :: vg50trans ! -REAL*4, INTENT(IN) :: xl ! +real, INTENT(IN) :: sigz +real, INTENT(IN) :: vg50trans +real, INTENT(IN) :: xl INTEGER*4, INTENT(IN) :: istab ! -REAL*4, INTENT(IN) :: xloc ! -REAL*4, INTENT(IN) :: xl100 ! -REAL*4, INTENT(IN) :: vw10 ! -REAL*4, INTENT(IN) :: pcoef ! -REAL*4, INTENT(IN) :: virty ! -REAL*4, INTENT(IN) :: radius ! -REAL*4, INTENT(IN) :: ra4_rcp ! -REAL*4, INTENT(IN) :: raz_rcp ! EvdS: hoogte afhankelijkheid -REAL*4, INTENT(IN) :: rc_rcp ! -REAL*4, INTENT(IN) :: rb_rcp ! -REAL*4, INTENT(IN) :: z0_src ! roughness length at source; from z0-map [m] -REAL*4, INTENT(IN) :: ol_src ! -REAL*4, INTENT(IN) :: uster_src ! -REAL*4, INTENT(IN) :: htot ! -REAL*4, INTENT(IN) :: ra4src ! -REAL*4, INTENT(IN) :: rb_src ! -REAL*4, INTENT(IN) :: rcsrc ! -REAL*4, INTENT(IN) :: qbstf ! -REAL*4, INTENT(IN) :: vg0tra ! -REAL*4, INTENT(IN) :: onder ! +real, INTENT(IN) :: xloc +real, INTENT(IN) :: xl100 +real, INTENT(IN) :: vw10 +real, INTENT(IN) :: pcoef +real, INTENT(IN) :: virty +real, INTENT(IN) :: radius +real, INTENT(IN) :: ra4_rcp +real, INTENT(IN) :: raz_rcp ! EvdS: hoogte afhankelijkheid +real, INTENT(IN) :: rc_rcp +real, INTENT(IN) :: rb_rcp +real, INTENT(IN) :: z0_src ! roughness length at source; from z0-map [m] +real, INTENT(IN) :: ol_src +real, INTENT(IN) :: uster_src +real, INTENT(IN) :: htot +real, INTENT(IN) :: ra4src +real, INTENT(IN) :: rb_src +real, INTENT(IN) :: rcsrc +real, INTENT(IN) :: qbstf +real, INTENT(IN) :: vg0tra +real, INTENT(IN) :: onder INTEGER*4, INTENT(IN) :: flag ! stable meteo class and stack emitting above mixing layer -REAL*4, INTENT(IN) :: vchem ! -REAL*4, INTENT(IN) :: vnatpri ! -REAL*4, INTENT(IN) :: diameter ! -REAL*4, INTENT(IN) :: dispg(NSTAB) ! -REAL*4, INTENT(IN) :: zm ! z-coordinate of receptor points (RDM) +real, INTENT(IN) :: vchem +real, INTENT(IN) :: vnatpri +real, INTENT(IN) :: diameter +real, INTENT(IN) :: dispg(NSTAB) +real, INTENT(IN) :: zm ! z-coordinate of receptor points (RDM) ! SUBROUTINE ARGUMENTS - I/O -REAL*4, INTENT(INOUT) :: cgt ! -REAL*4, INTENT(INOUT) :: cgt_z ! height dependent cgt +real, INTENT(INOUT) :: cgt +real, INTENT(INOUT) :: cgt_z ! height dependent cgt TYPE (TError), INTENT(INOUT) :: error ! error handling record ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT) :: cdn ! -REAL*4, INTENT(OUT) :: ugem ! average wind speed depending on phase of plume development (m/s) -REAL*4, INTENT(OUT) :: hf ! -REAL*4, INTENT(OUT) :: a ! -REAL*4, INTENT(OUT) :: cq1 ! -REAL*4, INTENT(OUT) :: cq2 ! -REAL*4, INTENT(OUT) :: uxr ! wind speed representative for plume over area source (m/s) -REAL*4, INTENT(OUT) :: zu ! representative plume height (m), taking into account reflection +real, INTENT(OUT) :: cdn +real, INTENT(OUT) :: ugem ! average wind speed depending on phase of plume development (m/s) +real, INTENT(OUT) :: hf +real, INTENT(OUT) :: a +real, INTENT(OUT) :: cq1 +real, INTENT(OUT) :: cq2 +real, INTENT(OUT) :: uxr ! wind speed representative for plume over area source (m/s) +real, INTENT(OUT) :: zu ! representative plume height (m), taking into account reflection ! at the top of the mixing layer and at the ground surface -REAL*4, INTENT(OUT) :: sigzr ! -REAL*4, INTENT(OUT) :: dxeff ! +real, INTENT(OUT) :: sigzr +real, INTENT(OUT) :: dxeff ! LOCAL VARIABLES -REAL*4 :: cxx ! representative concentration (undepleted) for plume in phase 2 -REAL*4 :: xx ! representative distance for plume in phase 2 -REAL*4 :: sigzxg ! sigma_z at xx -REAL*4 :: xlxg ! -REAL*4 :: uxg ! -REAL*4 :: s2 ! -REAL*4 :: vdoppb ! -REAL*4 :: sh ! -REAL*4 :: al ! +real :: cxx ! representative concentration (undepleted) for plume in phase 2 +real :: xx ! representative distance for plume in phase 2 +real :: sigzxg ! sigma_z at xx +real :: xlxg +real :: uxg +real :: s2 +real :: vdoppb +real :: sh +real :: al ! SUBROUTINE AND FUNCTION CALLS EXTERNAL ops_vertdisp diff --git a/ops_calc_stats.f90 b/ops_calc_stats.f90 index 7d4cf47..be0858a 100644 --- a/ops_calc_stats.f90 +++ b/ops_calc_stats.f90 @@ -53,12 +53,12 @@ SUBROUTINE ops_calc_stats(nrrcp, nsubsec, frac, cpri, csec, drydep, wetdep, gemr ! SUBROUTINE ARGUMENTS - INPUT INTEGER*4, INTENT(IN) :: nrrcp ! number of receptor points INTEGER*4, INTENT(IN) :: nsubsec ! number of sub-secondary species -REAL*4, INTENT(IN) :: frac(nrrcp) ! fraction per cell inside NL -REAL*4, INTENT(IN) :: cpri(nrrcp) ! primary concentration [ug/m3] -REAL*4, INTENT(IN) :: csec(nrrcp) ! secondary concentration [ug/m3] -REAL*4, INTENT(IN) :: drydep(nrrcp) ! dry deposition -REAL*4, INTENT(IN) :: wetdep(nrrcp) ! wet deposition -REAL*4, INTENT(IN) :: gemre ! yearly mean precipitation from meteo statistics [mm/h] +real, INTENT(IN) :: frac(nrrcp) ! fraction per cell inside NL +real, INTENT(IN) :: cpri(nrrcp) ! primary concentration [ug/m3] +real, INTENT(IN) :: csec(nrrcp) ! secondary concentration [ug/m3] +real, INTENT(IN) :: drydep(nrrcp) ! dry deposition +real, INTENT(IN) :: wetdep(nrrcp) ! wet deposition +real, INTENT(IN) :: gemre ! yearly mean precipitation from meteo statistics [mm/h] DOUBLE PRECISION, INTENT(IN) :: sdrypri ! DOUBLE PRECISION, INTENT(IN) :: sdrysec ! DOUBLE PRECISION, INTENT(IN) :: somvnpri ! @@ -67,47 +67,47 @@ SUBROUTINE ops_calc_stats(nrrcp, nsubsec, frac, cpri, csec, drydep, wetdep, gemr DOUBLE PRECISION, INTENT(IN) :: vtel ! DOUBLE PRECISION, INTENT(IN) :: telvnpri ! DOUBLE PRECISION, INTENT(IN) :: telvnsec ! -REAL*4, INTENT(IN) :: grid ! -REAL*4, INTENT(IN) :: conc_cf ! -REAL*4, INTENT(IN) :: amol21 ! -REAL*4, INTENT(IN) :: ugmoldep ! -REAL*4, INTENT(IN) :: csubsec(nrrcp,nsubsec) ! concentration of sub-secondary species [ug/m3] +real, INTENT(IN) :: grid +real, INTENT(IN) :: conc_cf +real, INTENT(IN) :: amol21 +real, INTENT(IN) :: ugmoldep +real, INTENT(IN) :: csubsec(nrrcp,nsubsec) ! concentration of sub-secondary species [ug/m3] ! SUBROUTINE ARGUMENTS - I/O DOUBLE PRECISION, INTENT(INOUT) :: snatpri ! DOUBLE PRECISION, INTENT(INOUT) :: snatsec ! ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT) :: gemcpri ! grid mean for primary concentration [ug/m3] -REAL*4, INTENT(OUT) :: gemcsec ! grid mean for secondary concentration [ug/m3] -REAL*4, INTENT(OUT) :: totddep ! grid total dry deposition (g/s) -REAL*4, INTENT(OUT) :: gemddep ! grid mean for dry deposition ["depeh"] -REAL*4, INTENT(OUT) :: gemddpri ! grid mean for dry deposition of primary component ["depeh"] -REAL*4, INTENT(OUT) :: gemddsec ! grid mean for dry deposition of secondary component ["depeh"] -REAL*4, INTENT(OUT) :: ddrpri ! effective dry deposition velocity (primary component) [cm/s] -REAL*4, INTENT(OUT) :: ddrsec ! effective dry deposition velocity (secondary component) [cm/s] -REAL*4, INTENT(OUT) :: totwdep ! grid total wet deposition (g/s) -REAL*4, INTENT(OUT) :: gemwdep ! grid mean for wet deposition ["depeh"] -REAL*4, INTENT(OUT) :: gemwdpri ! grid mean for wet deposition of primary component ["depeh"] -REAL*4, INTENT(OUT) :: gemwdsec ! grid mean for wet deposition of secondary component ["depeh"] -REAL*4, INTENT(OUT) :: wdrpri ! effective wet deposition rate (primary component) [%/h] -REAL*4, INTENT(OUT) :: wdrsec ! effective wet deposition rate (secondary component) [%/h] -REAL*4, INTENT(OUT) :: gemprec ! grid mean yearly precipitation [mm] -REAL*4, INTENT(OUT) :: tottdep ! grid total of total deposition (g/s) -REAL*4, INTENT(OUT) :: gemtdep ! grid mean of total deposition ["depeh"] -REAL*4, INTENT(OUT) :: ccr ! effective chemical conversion rate [%/h] -REAL*4, INTENT(OUT) :: gem_subsec(nsubsec) ! grid mean for concentration of sub-secondary species [ug/m3] +real, INTENT(OUT) :: gemcpri ! grid mean for primary concentration [ug/m3] +real, INTENT(OUT) :: gemcsec ! grid mean for secondary concentration [ug/m3] +real, INTENT(OUT) :: totddep ! grid total dry deposition (g/s) +real, INTENT(OUT) :: gemddep ! grid mean for dry deposition ["depeh"] +real, INTENT(OUT) :: gemddpri ! grid mean for dry deposition of primary component ["depeh"] +real, INTENT(OUT) :: gemddsec ! grid mean for dry deposition of secondary component ["depeh"] +real, INTENT(OUT) :: ddrpri ! effective dry deposition velocity (primary component) [cm/s] +real, INTENT(OUT) :: ddrsec ! effective dry deposition velocity (secondary component) [cm/s] +real, INTENT(OUT) :: totwdep ! grid total wet deposition (g/s) +real, INTENT(OUT) :: gemwdep ! grid mean for wet deposition ["depeh"] +real, INTENT(OUT) :: gemwdpri ! grid mean for wet deposition of primary component ["depeh"] +real, INTENT(OUT) :: gemwdsec ! grid mean for wet deposition of secondary component ["depeh"] +real, INTENT(OUT) :: wdrpri ! effective wet deposition rate (primary component) [%/h] +real, INTENT(OUT) :: wdrsec ! effective wet deposition rate (secondary component) [%/h] +real, INTENT(OUT) :: gemprec ! grid mean yearly precipitation [mm] +real, INTENT(OUT) :: tottdep ! grid total of total deposition (g/s) +real, INTENT(OUT) :: gemtdep ! grid mean of total deposition ["depeh"] +real, INTENT(OUT) :: ccr ! effective chemical conversion rate [%/h] +real, INTENT(OUT) :: gem_subsec(nsubsec) ! grid mean for concentration of sub-secondary species [ug/m3] ! LOCAL VARIABLES -REAL*4 :: somcsec ! sum of secondary concentrations [ug/m3] -REAL*4 :: somddep ! sum of dry depositions ["depeh"] -REAL*4 :: somwdep ! sum of wet depositions ["depeh"] +real :: somcsec ! sum of secondary concentrations [ug/m3] +real :: somddep ! sum of dry depositions ["depeh"] +real :: somwdep ! sum of wet depositions ["depeh"] ! LOCAL VARIABLES -REAL*4 :: cf ! conversion factor -REAL*4 :: somcpri ! sum of primary concentrations [ug/m3] -REAL*4 :: som_subsec(nsubsec) ! sum of concentrations of sub-secondary species [ug/m3] -REAL*4 :: somfrac ! sum of frac +real :: cf ! conversion factor +real :: somcpri ! sum of primary concentrations [ug/m3] +real :: som_subsec(nsubsec) ! sum of concentrations of sub-secondary species [ug/m3] +real :: somfrac ! sum of frac INTEGER*4 :: isubsec ! index of sub-secondary species ! SCCS-ID VARIABLES diff --git a/ops_conc_ini.f90 b/ops_conc_ini.f90 index dce9451..044f321 100644 --- a/ops_conc_ini.f90 +++ b/ops_conc_ini.f90 @@ -51,47 +51,47 @@ SUBROUTINE ops_conc_ini(gasv, vw10, htt, pcoef, disx, kdeel, qbpri, z0_src, szop ! SUBROUTINE ARGUMENTS - INPUT LOGICAL, INTENT(IN) :: gasv ! -REAL*4, INTENT(IN) :: vw10 ! -REAL*4, INTENT(IN) :: htt ! plume height, excluding plume descent due to heavy particles [m] -REAL*4, INTENT(IN) :: pcoef ! -REAL*4, INTENT(IN) :: disx ! +real, INTENT(IN) :: vw10 +real, INTENT(IN) :: htt ! plume height, excluding plume descent due to heavy particles [m] +real, INTENT(IN) :: pcoef +real, INTENT(IN) :: disx INTEGER*4, INTENT(IN) :: kdeel ! -REAL*4, INTENT(IN) :: qbpri ! -REAL*4, INTENT(IN) :: z0_src ! roughness length at source; from z0-map [m] -REAL*4, INTENT(IN) :: szopp ! +real, INTENT(IN) :: qbpri +real, INTENT(IN) :: z0_src ! roughness length at source; from z0-map [m] +real, INTENT(IN) :: szopp INTEGER*4, INTENT(IN) :: rond ! -REAL*4, INTENT(IN) :: uster_src ! -REAL*4, INTENT(IN) :: ol_src ! +real, INTENT(IN) :: uster_src +real, INTENT(IN) :: ol_src INTEGER*4, INTENT(IN) :: istab ! INTEGER*4, INTENT(IN) :: iwd ! -REAL*4, INTENT(IN) :: qww ! -REAL*4, INTENT(IN) :: hbron ! -REAL*4, INTENT(IN) :: dispg(NSTAB) ! +real, INTENT(IN) :: qww +real, INTENT(IN) :: hbron +real, INTENT(IN) :: dispg(NSTAB) ! SUBROUTINE ARGUMENTS - I/O -REAL*4, INTENT(INOUT) :: radius ! -REAL*4, INTENT(INOUT) :: xl ! -REAL*4, INTENT(INOUT) :: onder ! +real, INTENT(INOUT) :: radius +real, INTENT(INOUT) :: xl +real, INTENT(INOUT) :: onder TYPE (TError), INTENT(INOUT) :: error ! error handling record ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT) :: htot ! plume height, including plume descent due to heavy particles [m] +real, INTENT(OUT) :: htot ! plume height, including plume descent due to heavy particles [m] ! htot = htt - pldaling -REAL*4, INTENT(OUT) :: grof ! -REAL*4, INTENT(OUT) :: c ! -REAL*4, INTENT(OUT) :: sigz ! -REAL*4, INTENT(OUT) :: ueff ! wind speed at effective transport height heff; +real, INTENT(OUT) :: grof +real, INTENT(OUT) :: c +real, INTENT(OUT) :: sigz +real, INTENT(OUT) :: ueff ! wind speed at effective transport height heff; ! for short distances heff = plume height; ! for large distances heff = 1/2 mixing height; ! heff is interpolated for intermediate distances. -REAL*4, INTENT(OUT) :: virty ! -REAL*4, INTENT(OUT) :: ccc ! +real, INTENT(OUT) :: virty +real, INTENT(OUT) :: ccc ! LOCAL VARIABLES -REAL*4 :: ff ! -REAL*4 :: pldaling ! +real :: ff +real :: pldaling ! SCCS-ID VARIABLES CHARACTER*81 :: sccsida ! diff --git a/ops_conc_rek.f90 b/ops_conc_rek.f90 index 7b52ae6..c431ac6 100644 --- a/ops_conc_rek.f90 +++ b/ops_conc_rek.f90 @@ -55,60 +55,60 @@ SUBROUTINE ops_conc_rek(ueff, qbpri, isec, rcsec, routsec, ccc, amol1, amol2, si PARAMETER (ROUTINENAAM = 'ops_conc_rek') ! SUBROUTINE ARGUMENTS - INPUT -REAL*4, INTENT(IN) :: ueff ! -REAL*4, INTENT(IN) :: qbpri ! +real, INTENT(IN) :: ueff +real, INTENT(IN) :: qbpri LOGICAL, INTENT(IN) :: isec ! -REAL*4, INTENT(IN) :: rcsec ! -REAL*4, INTENT(IN) :: routsec ! in-cloud scavenging ratio for secondary component +real, INTENT(IN) :: rcsec +real, INTENT(IN) :: routsec ! in-cloud scavenging ratio for secondary component ! (rout << rain-out = in-cloud) [-] -REAL*4, INTENT(IN) :: ccc ! -REAL*4, INTENT(IN) :: amol1 ! -REAL*4, INTENT(IN) :: amol2 ! -REAL*4, INTENT(IN) :: sigz ! -REAL*4, INTENT(IN) :: utr ! average wind speed over the trajectory (m/s) -REAL*4, INTENT(IN) :: rc_sec_rcp ! -REAL*4, INTENT(IN) :: ra4_rcp ! -REAL*4, INTENT(IN) :: ra50_rcp ! -REAL*4, INTENT(IN) :: rb_rcp ! -REAL*4, INTENT(IN) :: amol21 ! -REAL*4, INTENT(IN) :: ugmoldep ! -REAL*4, INTENT(IN) :: cch ! -REAL*4, INTENT(IN) :: cgt ! -REAL*4, INTENT(IN) :: cgt_z ! height dependent cgt -REAL*4, INTENT(IN) :: grof ! -REAL*4, INTENT(IN) :: percvk ! -REAL*4, INTENT(IN) :: onder ! -REAL*4, INTENT(IN) :: regenk ! -REAL*4, INTENT(IN) :: virty ! -REAL*4, INTENT(IN) :: ri ! -REAL*4, INTENT(IN) :: vw10 ! -REAL*4, INTENT(IN) :: hbron ! -REAL*4, INTENT(IN) :: pcoef ! -REAL*4, INTENT(IN) :: rkc ! -REAL*4, INTENT(IN) :: disx ! -REAL*4, INTENT(IN) :: vnatpri ! -REAL*4, INTENT(IN) :: vchem ! -REAL*4, INTENT(IN) :: radius ! -REAL*4, INTENT(IN) :: xl ! -REAL*4, INTENT(IN) :: xloc ! -REAL*4, INTENT(IN) :: htot ! -REAL*4, INTENT(IN) :: twt ! -REAL*4, INTENT(IN) :: rb ! -REAL*4, INTENT(IN) :: ra50 ! -REAL*4, INTENT(IN) :: xvghbr ! -REAL*4, INTENT(IN) :: xvglbr ! -REAL*4, INTENT(IN) :: grad ! -REAL*4, INTENT(IN) :: frac ! fraction of this grid cell that is relevant -REAL*4, INTENT(IN) :: ra50tra ! -REAL*4, INTENT(IN) :: rb_tra ! -REAL*4, INTENT(IN) :: rclocal ! -REAL*4, INTENT(IN) :: vgpart ! -REAL*4, INTENT(IN) :: buildingFact ! Building Effect interpolated from building table +real, INTENT(IN) :: ccc +real, INTENT(IN) :: amol1 +real, INTENT(IN) :: amol2 +real, INTENT(IN) :: sigz +real, INTENT(IN) :: utr ! average wind speed over the trajectory (m/s) +real, INTENT(IN) :: rc_sec_rcp +real, INTENT(IN) :: ra4_rcp +real, INTENT(IN) :: ra50_rcp +real, INTENT(IN) :: rb_rcp +real, INTENT(IN) :: amol21 +real, INTENT(IN) :: ugmoldep +real, INTENT(IN) :: cch +real, INTENT(IN) :: cgt +real, INTENT(IN) :: cgt_z ! height dependent cgt +real, INTENT(IN) :: grof +real, INTENT(IN) :: percvk +real, INTENT(IN) :: onder +real, INTENT(IN) :: regenk +real, INTENT(IN) :: virty +real, INTENT(IN) :: ri +real, INTENT(IN) :: vw10 +real, INTENT(IN) :: hbron +real, INTENT(IN) :: pcoef +real, INTENT(IN) :: rkc +real, INTENT(IN) :: disx +real, INTENT(IN) :: vnatpri +real, INTENT(IN) :: vchem +real, INTENT(IN) :: radius +real, INTENT(IN) :: xl +real, INTENT(IN) :: xloc +real, INTENT(IN) :: htot +real, INTENT(IN) :: twt +real, INTENT(IN) :: rb +real, INTENT(IN) :: ra50 +real, INTENT(IN) :: xvghbr +real, INTENT(IN) :: xvglbr +real, INTENT(IN) :: grad +real, INTENT(IN) :: frac ! fraction of this grid cell that is relevant +real, INTENT(IN) :: ra50tra +real, INTENT(IN) :: rb_tra +real, INTENT(IN) :: rclocal +real, INTENT(IN) :: vgpart +real, INTENT(IN) :: buildingFact ! Building Effect interpolated from building table ! SUBROUTINE ARGUMENTS - I/O -REAL*4, INTENT(INOUT) :: cdn ! -REAL*4, INTENT(INOUT) :: cq2 ! -REAL*4, INTENT(INOUT) :: c ! +real, INTENT(INOUT) :: cdn +real, INTENT(INOUT) :: cq2 +real, INTENT(INOUT) :: c DOUBLE PRECISION, INTENT(INOUT) :: sdrypri ! DOUBLE PRECISION, INTENT(INOUT) :: sdrysec ! DOUBLE PRECISION, INTENT(INOUT) :: snatsec ! @@ -124,31 +124,31 @@ SUBROUTINE ops_conc_rek(ueff, qbpri, isec, rcsec, routsec, ccc, amol1, amol2, si DOUBLE PRECISION, INTENT(INOUT) :: wetdep ! ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT) :: qsec ! -REAL*4, INTENT(OUT) :: consec ! -REAL*4, INTENT(OUT) :: pr ! -REAL*4, INTENT(OUT) :: vg50trans ! +real, INTENT(OUT) :: qsec +real, INTENT(OUT) :: consec +real, INTENT(OUT) :: pr +real, INTENT(OUT) :: vg50trans ! LOCAL VARIABLES -REAL*4 :: qpri_depl ! depleted source strength = integrated mass flux [g/s] -REAL*4 :: vv ! -REAL*4 :: drypri ! -REAL*4 :: ddrup ! -REAL*4 :: vdrup ! -REAL*4 :: umid ! -REAL*4 :: virnat ! -REAL*4 :: dn ! -REAL*4 :: dnatpri ! -REAL*4 :: xvg ! factor not used; xvg = 1 -REAL*4 :: cgtsec ! -REAL*4 :: vgsec ! -REAL*4 :: vg_sec_rcp ! -REAL*4 :: vnatsec ! -REAL*4 :: drysec ! -REAL*4 :: dnatsec ! -REAL*4 :: vg4lok ! -REAL*4 :: c_z ! bewaren van de hoogte afhankelijke c -REAL*4 :: xg +real :: qpri_depl ! depleted source strength = integrated mass flux [g/s] +real :: vv +real :: drypri +real :: ddrup +real :: vdrup +real :: umid +real :: virnat +real :: dn +real :: dnatpri +real :: xvg ! factor not used; xvg = 1 +real :: cgtsec +real :: vgsec +real :: vg_sec_rcp +real :: vnatsec +real :: drysec +real :: dnatsec +real :: vg4lok +real :: c_z ! bewaren van de hoogte afhankelijke c +real :: xg ! SUBROUTINE AND FUNCTION CALLS diff --git a/ops_conltexp.f90 b/ops_conltexp.f90 index 3c0ac0a..8a1cb63 100644 --- a/ops_conltexp.f90 +++ b/ops_conltexp.f90 @@ -57,69 +57,69 @@ SUBROUTINE ops_conltexp(rond, ol, qbron, szopp, uster, z0, htt, onder, vw10, pco PARAMETER (ROUTINENAAM = 'ops_conltexp') ! CONSTANTS -REAL*4 :: ZWCOR(NSTAB) ! correctie voor vallende bronnen -REAL*4 :: PICON ! = fac/[pi * sqrt(2*pi)], fac = conversion factor g -> ug; fac = 1e6 -REAL*4 :: PS ! = fac/(2*pi), fac = conversion factor g -> ug; fac = 1e6 +real :: ZWCOR(NSTAB) ! correctie voor vallende bronnen +real :: PICON ! = fac/[pi * sqrt(2*pi)], fac = conversion factor g -> ug; fac = 1e6 +real :: PS ! = fac/(2*pi), fac = conversion factor g -> ug; fac = 1e6 PARAMETER (PICON = 126987.) PARAMETER (PS = 159155.) ! SUBROUTINE ARGUMENTS - INPUT INTEGER*4, INTENT(IN) :: rond ! -REAL*4, INTENT(IN) :: ol ! Monin-Obukhov lengte -REAL*4, INTENT(IN) :: qbron ! -REAL*4, INTENT(IN) :: szopp ! initial vertical dispersion of source -REAL*4, INTENT(IN) :: uster ! frictiesnelheid -REAL*4, INTENT(IN) :: z0 ! ruwheidslengte (m) -REAL*4, INTENT(IN) :: htt ! -REAL*4, INTENT(IN) :: onder ! -REAL*4, INTENT(IN) :: vw10 ! -REAL*4, INTENT(IN) :: pcoef ! +real, INTENT(IN) :: ol ! Monin-Obukhov lengte +real, INTENT(IN) :: qbron +real, INTENT(IN) :: szopp ! initial vertical dispersion of source +real, INTENT(IN) :: uster ! frictiesnelheid +real, INTENT(IN) :: z0 ! ruwheidslengte (m) +real, INTENT(IN) :: htt +real, INTENT(IN) :: onder +real, INTENT(IN) :: vw10 +real, INTENT(IN) :: pcoef INTEGER*4, INTENT(IN) :: istab ! -REAL*4, INTENT(IN) :: disx ! -REAL*4, INTENT(IN) :: grof ! +real, INTENT(IN) :: disx +real, INTENT(IN) :: grof INTEGER*4, INTENT(IN) :: iwd ! -REAL*4, INTENT(IN) :: qww ! -REAL*4, INTENT(IN) :: hbron ! -REAL*4, INTENT(IN) :: dispg(NSTAB) ! +real, INTENT(IN) :: qww +real, INTENT(IN) :: hbron +real, INTENT(IN) :: dispg(NSTAB) ! SUBROUTINE ARGUMENTS - I/O -REAL*4, INTENT(INOUT) :: radius ! -REAL*4, INTENT(INOUT) :: htot ! +real, INTENT(INOUT) :: radius +real, INTENT(INOUT) :: htot TYPE (TError), INTENT(INOUT) :: error ! error handling record ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT) :: c ! long-term concentation at receptor at z = 0; excluding removal processes -REAL*4, INTENT(OUT) :: sigz ! -REAL*4, INTENT(OUT) :: ueff ! wind speed at effective transport height heff; +real, INTENT(OUT) :: c ! long-term concentation at receptor at z = 0; excluding removal processes +real, INTENT(OUT) :: sigz +real, INTENT(OUT) :: ueff ! wind speed at effective transport height heff; ! for short distances heff = plume height; ! for large distances heff = 1/2 mixing height; ! heff is interpolated for intermediate distances. -REAL*4, INTENT(OUT) :: xl ! -REAL*4, INTENT(OUT) :: virty ! +real, INTENT(OUT) :: xl +real, INTENT(OUT) :: virty ! LOCAL VARIABLES -REAL*4 :: a ! reflection term source-surface-mixing height-surface -REAL*4 :: b ! reflection term source-mixing height-surface -REAL*4 :: cls ! -REAL*4 :: disp ! -REAL*4 :: f ! -REAL*4 :: f1 ! -REAL*4 :: f2 ! -REAL*4 :: h ! -REAL*4 :: hf ! effective transport height [m] -REAL*4 :: pld ! pluimdaling -REAL*4 :: pp ! -REAL*4 :: qq ! -REAL*4 :: rr ! -REAL*4 :: sz ! -REAL*4 :: tl ! -REAL*4 :: u1 ! -REAL*4 :: utl ! +real :: a ! reflection term source-surface-mixing height-surface +real :: b ! reflection term source-mixing height-surface +real :: cls +real :: disp +real :: f +real :: f1 +real :: f2 +real :: h +real :: hf ! effective transport height [m] +real :: pld ! pluimdaling +real :: pp +real :: qq +real :: rr +real :: sz +real :: tl +real :: u1 +real :: utl ! FUNCTIONS -REAL*4 :: ops_virtdist ! +real :: ops_virtdist !DATA DATA ZWCOR/1.2, 1.1, 0.8, 0.6, 0.75, 0.6/ @@ -397,38 +397,38 @@ SUBROUTINE par_oppbr(rond, iwd, disx, istab, disp, htt, grof, dispg, zwcor, radi ! SUBROUTINE ARGUMENTS - INPUT INTEGER*4, INTENT(IN) :: rond ! INTEGER*4, INTENT(IN) :: iwd ! -REAL*4, INTENT(IN) :: disx ! +real, INTENT(IN) :: disx INTEGER*4, INTENT(IN) :: istab ! -REAL*4, INTENT(IN) :: disp ! -REAL*4, INTENT(IN) :: htt ! -REAL*4, INTENT(IN) :: grof ! -REAL*4, INTENT(IN) :: dispg(NSTAB) ! -REAL*4, INTENT(IN) :: zwcor(NSTAB) ! +real, INTENT(IN) :: disp +real, INTENT(IN) :: htt +real, INTENT(IN) :: grof +real, INTENT(IN) :: dispg(NSTAB) +real, INTENT(IN) :: zwcor(NSTAB) ! SUBROUTINE ARGUMENTS - I/O -REAL*4, INTENT(INOUT) :: radius ! -REAL*4, INTENT(INOUT) :: sz ! +real, INTENT(INOUT) :: radius +real, INTENT(INOUT) :: sz ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT) :: virty ! -REAL*4, INTENT(OUT) :: rr ! -REAL*4, INTENT(OUT) :: sigz ! -REAL*4, INTENT(OUT) :: pld ! -REAL*4, INTENT(OUT) :: htot ! +real, INTENT(OUT) :: virty +real, INTENT(OUT) :: rr +real, INTENT(OUT) :: sigz +real, INTENT(OUT) :: pld +real, INTENT(OUT) :: htot ! LOCAL VARIABLES -REAL*4 :: cr ! -REAL*4 :: radr ! -REAL*4 :: dx ! -REAL*4 :: dy ! -REAL*4 :: sta1 ! -REAL*4 :: sta2 ! -REAL*4 :: s1 ! -REAL*4 :: s2 ! -REAL*4 :: dsx ! +real :: cr +real :: radr +real :: dx +real :: dy +real :: sta1 +real :: sta2 +real :: s1 +real :: s2 +real :: dsx ! FUNCTIONS -REAL*4 :: ops_virtdist ! +real :: ops_virtdist ! SCCS-ID VARIABLES CHARACTER*81 :: sccsida ! @@ -506,20 +506,20 @@ SUBROUTINE par_puntbr(qww, istab, disx, disp, htt, htot, hbron, dispg, sigz, hf, PARAMETER (ROUTINENAAM = 'par_puntbr') ! SUBROUTINE ARGUMENTS - INPUT -REAL*4, INTENT(IN) :: qww ! +real, INTENT(IN) :: qww INTEGER*4, INTENT(IN) :: istab ! -REAL*4, INTENT(IN) :: disx ! -REAL*4, INTENT(IN) :: disp ! -REAL*4, INTENT(IN) :: htt ! -REAL*4, INTENT(IN) :: htot ! -REAL*4, INTENT(IN) :: hbron ! -REAL*4, INTENT(IN) :: dispg(NSTAB) ! +real, INTENT(IN) :: disx +real, INTENT(IN) :: disp +real, INTENT(IN) :: htt +real, INTENT(IN) :: htot +real, INTENT(IN) :: hbron +real, INTENT(IN) :: dispg(NSTAB) ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT) :: sigz ! -REAL*4, INTENT(OUT) :: hf ! -REAL*4, INTENT(OUT) :: a ! -REAL*4, INTENT(OUT) :: virty ! +real, INTENT(OUT) :: sigz +real, INTENT(OUT) :: hf +real, INTENT(OUT) :: a +real, INTENT(OUT) :: virty ! SCCS-ID VARIABLES CHARACTER*81 :: sccsida ! diff --git a/ops_convec.f90 b/ops_convec.f90 index de313c8..9dccf42 100644 --- a/ops_convec.f90 +++ b/ops_convec.f90 @@ -50,28 +50,28 @@ SUBROUTINE ops_convec(z0, zi, ol, uster, h, x, uh, zu, szc) PARAMETER (ROUTINENAAM = 'ops_convec') ! CONSTANTS -REAL*4 :: K ! von Karmanconstante +real :: K ! von Karmanconstante PARAMETER (K = 0.4) ! SUBROUTINE ARGUMENTS - INPUT -REAL*4, INTENT(IN) :: z0 ! roughness length (m) -REAL*4, INTENT(IN) :: zi ! mixing height (m) -REAL*4, INTENT(IN) :: ol ! Monin-Obukhov length (m) -REAL*4, INTENT(IN) :: uster ! friction velocity (m) -REAL*4, INTENT(IN) :: h ! source height (including plume rise) (m) -REAL*4, INTENT(IN) :: x ! downwind distance (m) +real, INTENT(IN) :: z0 ! roughness length (m) +real, INTENT(IN) :: zi ! mixing height (m) +real, INTENT(IN) :: ol ! Monin-Obukhov length (m) +real, INTENT(IN) :: uster ! friction velocity (m) +real, INTENT(IN) :: h ! source height (including plume rise) (m) +real, INTENT(IN) :: x ! downwind distance (m) ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT) :: uh ! windspeed at representative plume height (m/s) -REAL*4, INTENT(OUT) :: zu ! representative plume height (m), taking into account reflection +real, INTENT(OUT) :: uh ! windspeed at representative plume height (m/s) +real, INTENT(OUT) :: zu ! representative plume height (m), taking into account reflection ! at the top of the mixing layer and at the ground surface -REAL*4, INTENT(OUT) :: szc ! convective vertical dispersion coefficient (m) +real, INTENT(OUT) :: szc ! convective vertical dispersion coefficient (m) ! LOCAL VARIABLES INTEGER*4 :: last ! -REAL*4 :: s ! -REAL*4 :: wster ! -REAL*4 :: xs ! +real :: s +real :: wster +real :: xs LOGICAL :: finished ! ! SCCS-ID VARIABLES diff --git a/ops_depoparexp.f90 b/ops_depoparexp.f90 index d47e03d..93a5bfe 100644 --- a/ops_depoparexp.f90 +++ b/ops_depoparexp.f90 @@ -79,123 +79,123 @@ SUBROUTINE ops_depoparexp(kdeel, c, ol, qbstf, ra4_rcp, ra50_rcp, raz_rcp, rb_rc PARAMETER (ROUTINENAAM = 'ops_depoparexp') ! CONSTANTS -REAL*4 :: RCDEEL(NPARTCLASS) ! waarden van rc per deeltjesklasse -REAL*4 :: RDS(NSTAB) ! grenslaagweerstand per stab. klasse -REAL*4 :: RORATIO(NPARTCLASS) ! (geschatte) waarden scavenging ratio per deeltjesklasse -REAL*4 :: VGDEEL(NPARTCLASS) ! -REAL*4 :: RA4S(NSTAB) ! +real :: RCDEEL(NPARTCLASS) ! waarden van rc per deeltjesklasse +real :: RDS(NSTAB) ! grenslaagweerstand per stab. klasse +real :: RORATIO(NPARTCLASS) ! (geschatte) waarden scavenging ratio per deeltjesklasse +real :: VGDEEL(NPARTCLASS) +real :: RA4S(NSTAB) ! SUBROUTINE ARGUMENTS - INPUT INTEGER*4, INTENT(IN) :: kdeel ! -REAL*4, INTENT(IN) :: c ! -REAL*4, INTENT(IN) :: ol ! Monin-Obukhov lengte -REAL*4, INTENT(IN) :: qbstf ! source strength current source (for current particle class) -REAL*4, INTENT(IN) :: ra4_rcp ! ra at receptor (4m) -REAL*4, INTENT(IN) :: ra50_rcp ! ra at receptor (50m) -REAL*4, INTENT(IN) :: raz_rcp ! height dependent ra on receptor -REAL*4, INTENT(IN) :: rb_rcp ! -REAL*4, INTENT(IN) :: sigz ! -REAL*4, INTENT(IN) :: ueff ! wind speed at effective transport height heff; +real, INTENT(IN) :: c +real, INTENT(IN) :: ol ! Monin-Obukhov lengte +real, INTENT(IN) :: qbstf ! source strength current source (for current particle class) +real, INTENT(IN) :: ra4_rcp ! ra at receptor (4m) +real, INTENT(IN) :: ra50_rcp ! ra at receptor (50m) +real, INTENT(IN) :: raz_rcp ! height dependent ra on receptor +real, INTENT(IN) :: rb_rcp +real, INTENT(IN) :: sigz +real, INTENT(IN) :: ueff ! wind speed at effective transport height heff; ! for short distances heff = plume height; ! for large distances heff = 1/2 mixing height; ! heff is interpolated for intermediate distances. -REAL*4, INTENT(IN) :: uster -REAL*4, INTENT(IN) :: z0 -REAL*4, INTENT(IN) :: virty ! +real, INTENT(IN) :: uster +real, INTENT(IN) :: z0 +real, INTENT(IN) :: virty LOGICAL, INTENT(IN) :: gasv ! INTEGER*4, INTENT(IN) :: itra ! -REAL*4, INTENT(IN) :: rb ! -REAL*4, INTENT(IN) :: ra4 ! +real, INTENT(IN) :: rb +real, INTENT(IN) :: ra4 INTEGER*4, INTENT(IN) :: istab ! -REAL*4, INTENT(IN) :: grof ! -REAL*4, INTENT(IN) :: ra50 ! -REAL*4, INTENT(IN) :: xvghbr ! -REAL*4, INTENT(IN) :: xvglbr ! -REAL*4, INTENT(IN) :: regenk ! -REAL*4, INTENT(IN) :: rint ! -REAL*4, INTENT(IN) :: buil ! -REAL*4, INTENT(IN) :: zf ! +real, INTENT(IN) :: grof +real, INTENT(IN) :: ra50 +real, INTENT(IN) :: xvghbr +real, INTENT(IN) :: xvglbr +real, INTENT(IN) :: regenk +real, INTENT(IN) :: rint +real, INTENT(IN) :: buil +real, INTENT(IN) :: zf INTEGER*4, INTENT(IN) :: isek ! INTEGER*4, INTENT(IN) :: iseiz ! INTEGER*4, INTENT(IN) :: mb ! -REAL*4, INTENT(IN) :: disx ! -REAL*4, INTENT(IN) :: radius ! -REAL*4, INTENT(IN) :: xl ! -REAL*4, INTENT(IN) :: onder ! -REAL*4, INTENT(IN) :: dg ! +real, INTENT(IN) :: disx +real, INTENT(IN) :: radius +real, INTENT(IN) :: xl +real, INTENT(IN) :: onder +real, INTENT(IN) :: dg INTEGER*4, INTENT(IN) :: knatdeppar ! -REAL*4, INTENT(IN) :: scavcoef ! +real, INTENT(IN) :: scavcoef LOGICAL, INTENT(IN) :: irev ! -REAL*4, INTENT(IN) :: htt ! -REAL*4, INTENT(IN) :: xloc ! -REAL*4, INTENT(IN) :: xl100 ! -REAL*4, INTENT(IN) :: vw10 ! -REAL*4, INTENT(IN) :: pcoef ! -REAL*4, INTENT(IN) :: vchem ! -REAL*4, INTENT(IN) :: dispg(NSTAB) ! -REAL*4, INTENT(IN) :: z0_src ! roughness length at source; from z0-map [m] -REAL*4, INTENT(IN) :: ol_src ! -REAL*4, INTENT(IN) :: uster_src ! -REAL*4, INTENT(IN) :: z0_tra ! roughness length representative for trajectory [m] -REAL*4, INTENT(IN) :: ra4src ! -REAL*4, INTENT(IN) :: rb_src ! -REAL*4, INTENT(IN) :: ra50src ! -REAL*4, INTENT(IN) :: ra4tra ! -REAL*4, INTENT(IN) :: rb_tra ! -REAL*4, INTENT(IN) :: ra50tra ! -REAL*4, INTENT(IN) :: xm -REAL*4, INTENT(IN) :: ym -REAL*4, INTENT(IN) :: zm ! z-coordinate of receptor points (RDM) +real, INTENT(IN) :: htt +real, INTENT(IN) :: xloc +real, INTENT(IN) :: xl100 +real, INTENT(IN) :: vw10 +real, INTENT(IN) :: pcoef +real, INTENT(IN) :: vchem +real, INTENT(IN) :: dispg(NSTAB) +real, INTENT(IN) :: z0_src ! roughness length at source; from z0-map [m] +real, INTENT(IN) :: ol_src +real, INTENT(IN) :: uster_src +real, INTENT(IN) :: z0_tra ! roughness length representative for trajectory [m] +real, INTENT(IN) :: ra4src +real, INTENT(IN) :: rb_src +real, INTENT(IN) :: ra50src +real, INTENT(IN) :: ra4tra +real, INTENT(IN) :: rb_tra +real, INTENT(IN) :: ra50tra +real, INTENT(IN) :: xm +real, INTENT(IN) :: ym +real, INTENT(IN) :: zm ! z-coordinate of receptor points (RDM) INTEGER*4, INTENT(IN) :: bx INTEGER*4, INTENT(IN) :: by ! SUBROUTINE ARGUMENTS - I/O -REAL*4, INTENT(INOUT) :: rctra_0 ! -REAL*4, INTENT(INOUT) :: htot ! -REAL*4, INTENT(INOUT) :: rcsrc ! +real, INTENT(INOUT) :: rctra_0 +real, INTENT(INOUT) :: htot +real, INTENT(INOUT) :: rcsrc TYPE (TError), INTENT(INOUT) :: error ! error handling record ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT) :: pr ! -REAL*4, INTENT(OUT) :: twt ! -REAL*4, INTENT(OUT) :: cratio ! -REAL*4, INTENT(OUT) :: rc_rcp ! -REAL*4, INTENT(OUT) :: grad ! -REAL*4, INTENT(OUT) :: rc -REAL*4, INTENT(OUT) :: utr ! average wind speed over the trajectory (m/s) -REAL*4, INTENT(OUT) :: vg50_rcp ! -REAL*4, INTENT(OUT) :: vgpart ! -REAL*4, INTENT(OUT) :: routpri ! in-cloud scavenging ratio for primary component +real, INTENT(OUT) :: pr +real, INTENT(OUT) :: twt +real, INTENT(OUT) :: cratio +real, INTENT(OUT) :: rc_rcp +real, INTENT(OUT) :: grad +real, INTENT(OUT) :: rc +real, INTENT(OUT) :: utr ! average wind speed over the trajectory (m/s) +real, INTENT(OUT) :: vg50_rcp +real, INTENT(OUT) :: vgpart +real, INTENT(OUT) :: routpri ! in-cloud scavenging ratio for primary component ! (rout << rain-out = in-cloud) [-] -REAL*4, INTENT(OUT) :: vg50trans ! -REAL*4, INTENT(OUT) :: rkc ! -REAL*4, INTENT(OUT) :: ri ! -REAL*4, INTENT(OUT) :: vnatpri ! wet deposition loss rate for primary components [%/h] -REAL*4, INTENT(OUT) :: cgt ! -REAL*4, INTENT(OUT) :: cgt_z ! height dependent cgt -REAL*4, INTENT(OUT) :: cq2 ! -REAL*4, INTENT(OUT) :: cdn ! -REAL*4, INTENT(OUT) :: cch ! +real, INTENT(OUT) :: vg50trans +real, INTENT(OUT) :: rkc +real, INTENT(OUT) :: ri +real, INTENT(OUT) :: vnatpri ! wet deposition loss rate for primary components [%/h] +real, INTENT(OUT) :: cgt +real, INTENT(OUT) :: cgt_z ! height dependent cgt +real, INTENT(OUT) :: cq2 +real, INTENT(OUT) :: cdn +real, INTENT(OUT) :: cch ! LOCAL VARIABLES INTEGER*4 :: flag ! stable meteo class and stack emitting above mixing layer -REAL*4 :: a ! -REAL*4 :: cq1 ! -REAL*4 :: diameter ! -REAL*4 :: dxeff ! effective distance over which deposition takes place within an area source -REAL*4 :: grad_z ! height dependent grad -REAL*4 :: hf ! -REAL*4 :: p1 ! -REAL*4 :: p2 ! -REAL*4 :: pldaling ! -REAL*4 :: sigzr ! -REAL*4 :: ux0 ! wind speed near source at plume height (m/s) -REAL*4 :: uxr ! wind speed representative for plume over area source (m/s) -REAL*4 :: ugem ! average wind speed depending on phase of plume development (m/s) -REAL*4 :: vg0tra ! -REAL*4 :: vg50tra ! -REAL*4 :: xg ! -REAL*4 :: zu ! +real :: a +real :: cq1 +real :: diameter +real :: dxeff ! effective distance over which deposition takes place within an area source +real :: grad_z ! height dependent grad +real :: hf +real :: p1 +real :: p2 +real :: pldaling +real :: sigzr +real :: ux0 ! wind speed near source at plume height (m/s) +real :: uxr ! wind speed representative for plume over area source (m/s) +real :: ugem ! average wind speed depending on phase of plume development (m/s) +real :: vg0tra +real :: vg50tra +real :: xg +real :: zu LOGICAL :: ops_openlog ! function for opening log file ! @@ -617,64 +617,64 @@ SUBROUTINE par_nat(regenk, rint, buil, zf, isek, iseiz, mb, disx, radius, diamet & knatdeppar, scavcoef, routpri, kdeel, irev, c, qbstf, virty, twt, pr, cratio, ri, a, vnatpri) ! CONSTANTS -REAL*4 :: PS ! +real :: PS PARAMETER (PS = 1.e6/(2.*PI)) -REAL*4 :: TWETZ(NSEK) ! duration of rain shower in summer -REAL*4 :: TWETW(NSEK) ! duration of rain shower in winter -REAL*4 :: RIW(NSEK) ! rain intensity winter -REAL*4 :: RIZ(NSEK) ! rain intensity summer -REAL*4 :: CMND(NMONTH) ! monthly correction shower duration -REAL*4 :: EPSILON(NPARTCLASS) ! +real :: TWETZ(NSEK) ! duration of rain shower in summer +real :: TWETW(NSEK) ! duration of rain shower in winter +real :: RIW(NSEK) ! rain intensity winter +real :: RIZ(NSEK) ! rain intensity summer +real :: CMND(NMONTH) ! monthly correction shower duration +real :: EPSILON(NPARTCLASS) ! SUBROUTINE ARGUMENTS - INPUT -REAL*4, INTENT(IN) :: regenk ! -REAL*4, INTENT(IN) :: rint ! -REAL*4, INTENT(IN) :: buil ! -REAL*4, INTENT(IN) :: zf ! +real, INTENT(IN) :: regenk +real, INTENT(IN) :: rint +real, INTENT(IN) :: buil +real, INTENT(IN) :: zf INTEGER*4, INTENT(IN) :: isek ! INTEGER*4, INTENT(IN) :: iseiz ! INTEGER*4, INTENT(IN) :: mb ! -REAL*4, INTENT(IN) :: disx ! -REAL*4, INTENT(IN) :: radius ! -REAL*4, INTENT(IN) :: diameter ! -REAL*4, INTENT(IN) :: ueff ! wind speed at effective transport height heff; +real, INTENT(IN) :: disx +real, INTENT(IN) :: radius +real, INTENT(IN) :: diameter +real, INTENT(IN) :: ueff ! wind speed at effective transport height heff; ! for short distances heff = plume height; ! for large distances heff = 1/2 mixing height; ! heff is interpolated for intermediate distances. -REAL*4, INTENT(IN) :: xl ! -REAL*4, INTENT(IN) :: onder ! -REAL*4, INTENT(IN) :: sigz ! -REAL*4, INTENT(IN) :: htot ! +real, INTENT(IN) :: xl +real, INTENT(IN) :: onder +real, INTENT(IN) :: sigz +real, INTENT(IN) :: htot LOGICAL, INTENT(IN) :: gasv ! -REAL*4, INTENT(IN) :: dg ! +real, INTENT(IN) :: dg INTEGER*4, INTENT(IN) :: knatdeppar ! -REAL*4, INTENT(IN) :: scavcoef ! -REAL*4, INTENT(IN) :: routpri ! in-cloud scavenging ratio for primary component +real, INTENT(IN) :: scavcoef +real, INTENT(IN) :: routpri ! in-cloud scavenging ratio for primary component ! (rout << rain-out = in-cloud) [-] INTEGER*4, INTENT(IN) :: kdeel ! LOGICAL, INTENT(IN) :: irev ! -REAL*4, INTENT(IN) :: c ! -REAL*4, INTENT(IN) :: qbstf ! -REAL*4, INTENT(IN) :: virty ! +real, INTENT(IN) :: c +real, INTENT(IN) :: qbstf +real, INTENT(IN) :: virty ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT) :: twt ! -REAL*4, INTENT(OUT) :: pr ! -REAL*4, INTENT(OUT) :: cratio ! -REAL*4, INTENT(OUT) :: ri ! -REAL*4, INTENT(OUT) :: a ! -REAL*4, INTENT(OUT) :: vnatpri ! wet deposition loss rate for primary components [%/h] +real, INTENT(OUT) :: twt +real, INTENT(OUT) :: pr +real, INTENT(OUT) :: cratio +real, INTENT(OUT) :: ri +real, INTENT(OUT) :: a +real, INTENT(OUT) :: vnatpri ! wet deposition loss rate for primary components [%/h] ! LOCAL VARIABLES -REAL*4 :: twet ! -REAL*4 :: treis ! -REAL*4 :: h ! thickness over which wet deposition takes place [m] -REAL*4 :: hl ! -REAL*4 :: vnatrain ! wet deposition loss rate for rainout (in-cloud) [%/h] -REAL*4 :: epsi ! -REAL*4 :: beta ! -REAL*4 :: lambda0 ! -REAL*4 :: vnatwash ! wet deposition loss rate for washout (below-cloud) [%/h] +real :: twet +real :: treis +real :: h ! thickness over which wet deposition takes place [m] +real :: hl +real :: vnatrain ! wet deposition loss rate for rainout (in-cloud) [%/h] +real :: epsi +real :: beta +real :: lambda0 +real :: vnatwash ! wet deposition loss rate for washout (below-cloud) [%/h] ! DATA figure 4.1 OPS-report (depends on particle class) and ! Slinn W.G.N (1983) Predictions for particle deposition to vegetative surfaces. Atmospheric Environment 16, 1785-1794. diff --git a/ops_depos_rc.f90 b/ops_depos_rc.f90 index 358bc80..d681d2e 100644 --- a/ops_depos_rc.f90 +++ b/ops_depos_rc.f90 @@ -56,39 +56,39 @@ SUBROUTINE ops_depos_rc(icm, iseiz, mb, gym ,temp_C, uster, glrad, hum, nwet, ra INTEGER*4, INTENT(IN) :: iseiz ! INTEGER*4, INTENT(IN) :: mb ! INTEGER*4, INTENT(IN) :: nwet ! -REAL*4, INTENT(IN) :: hum ! -REAL*4, INTENT(IN) :: uster ! friction velocity [m/s] -REAL*4, INTENT(IN) :: temp_C ! temperature at height zmet_T [C] -REAL*4, INTENT(IN) :: gym ! -REAL*4, INTENT(IN) :: glrad ! -REAL*4, INTENT(IN) :: ratns ! -REAL*4, INTENT(IN) :: catm -REAL*4, INTENT(IN) :: c_ave_prev_nh3 -REAL*4, INTENT(IN) :: c_ave_prev_so2 -REAL*4, INTENT(IN) :: ra -REAL*4, INTENT(IN) :: rb -REAL*4, INTENT(IN) :: lu_per(NLU) ! land use percentages for all land use classes +real, INTENT(IN) :: hum +real, INTENT(IN) :: uster ! friction velocity [m/s] +real, INTENT(IN) :: temp_C ! temperature at height zmet_T [C] +real, INTENT(IN) :: gym +real, INTENT(IN) :: glrad +real, INTENT(IN) :: ratns +real, INTENT(IN) :: catm +real, INTENT(IN) :: c_ave_prev_nh3 +real, INTENT(IN) :: c_ave_prev_so2 +real, INTENT(IN) :: ra +real, INTENT(IN) :: rb +real, INTENT(IN) :: lu_per(NLU) ! land use percentages for all land use classes ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT) :: rc_eff_pos ! canopy resistance, no re-emission [s/m] -REAL*4, INTENT(OUT) :: rc_eff ! canopy resistance, re-emission allowed [s/m]; +real, INTENT(OUT) :: rc_eff_pos ! canopy resistance, no re-emission [s/m] +real, INTENT(OUT) :: rc_eff ! canopy resistance, re-emission allowed [s/m]; ! LOCAL VARIABLES INTEGER*4 :: day_of_year ! INTEGER*4 :: mnt ! INTEGER*4, DIMENSION(2) :: mnt_select ! INTEGER*4 :: luclass ! -REAL*4 :: som_vd_month ! summed vd over representative months -REAL*4 :: som_vd_eff_ave ! summed vd over land use classes (vd = 1/Ra + Rb + Rc_eff) -REAL*4 :: som_vd_eff_ave_pos ! summed vd over land use classes (vd = 1/Ra + Rb + Rc_eff_pos) -REAL*4 :: telmaand -REAL*4 :: rc_eff_ave ! canopy resistance, re-emission allowed, averaged over representative months -REAL*4 :: rc_eff_ave_pos ! canopy resistance, no re-emission, averaged over representative months -REAL*4 :: rc_tot -REAL*4 :: sinphi -REAL*4 :: ccomp_tot -REAL*4, PARAMETER :: catm_min = 0.1E-05 -REAL*4 :: rc_eff_depac ! canopy resistance from depac, re-emission allowed [s/m]; +real :: som_vd_month ! summed vd over representative months +real :: som_vd_eff_ave ! summed vd over land use classes (vd = 1/Ra + Rb + Rc_eff) +real :: som_vd_eff_ave_pos ! summed vd over land use classes (vd = 1/Ra + Rb + Rc_eff_pos) +real :: telmaand +real :: rc_eff_ave ! canopy resistance, re-emission allowed, averaged over representative months +real :: rc_eff_ave_pos ! canopy resistance, no re-emission, averaged over representative months +real :: rc_tot +real :: sinphi +real :: ccomp_tot +real, PARAMETER :: catm_min = 0.1E-05 +real :: rc_eff_depac ! canopy resistance from depac, re-emission allowed [s/m]; ! SCCS-ID VARIABLES CHARACTER*81 :: sccsida ! diff --git a/ops_depu.f90 b/ops_depu.f90 index 775990c..f18d500 100644 --- a/ops_depu.f90 +++ b/ops_depu.f90 @@ -75,9 +75,9 @@ SUBROUTINE ops_depu(icnr, z0, zra, d, rc, ol, uster, vg, ra, rb) PARAMETER (ROUTINENAAM = 'ops_depu') ! CONSTANTS -REAL*4 :: P ! exponent (experimenteel bepaald) -REAL*4 :: PR ! Prandtl number -REAL*4 :: VONK ! Von Karman constante +real :: P ! exponent (experimenteel bepaald) +real :: PR ! Prandtl number +real :: VONK ! Von Karman constante PARAMETER (VONK = 0.4 ) PARAMETER (P = 2./3.) @@ -85,21 +85,21 @@ SUBROUTINE ops_depu(icnr, z0, zra, d, rc, ol, uster, vg, ra, rb) ! SUBROUTINE ARGUMENTS - INPUT INTEGER*4, INTENT(IN) :: icnr ! component number for calculation of rb -REAL*4, INTENT(IN) :: z0 ! surface roughness length in meters. -REAL*4, INTENT(IN) :: zra ! height for which deposition velocity is calculated (m) -REAL*4, INTENT(IN) :: d ! displacement height (usually 0.7 * vegetation height) (m) -REAL*4, INTENT(IN) :: rc ! canopy resistance in (s/m) -REAL*4, INTENT(IN) :: ol ! monin-obukhov length (m) -REAL*4, INTENT(IN) :: uster ! friction velocity u* (m/s) +real, INTENT(IN) :: z0 ! surface roughness length in meters. +real, INTENT(IN) :: zra ! height for which deposition velocity is calculated (m) +real, INTENT(IN) :: d ! displacement height (usually 0.7 * vegetation height) (m) +real, INTENT(IN) :: rc ! canopy resistance in (s/m) +real, INTENT(IN) :: ol ! monin-obukhov length (m) +real, INTENT(IN) :: uster ! friction velocity u* (m/s) ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT) :: vg ! depositin velocity at zra (m/s) -REAL*4, INTENT(OUT) :: ra ! aerodynamic resistance at zra (s/m) -REAL*4, INTENT(OUT) :: rb ! laminar layer resistance for component incr (s/m) +real, INTENT(OUT) :: vg ! depositin velocity at zra (m/s) +real, INTENT(OUT) :: ra ! aerodynamic resistance at zra (s/m) +real, INTENT(OUT) :: rb ! laminar layer resistance for component incr (s/m) ! LOCAL VARIABLES -REAL*4 :: sc ! Schmidt number -REAL*4 :: zru ! correction for displacement height +real :: sc ! Schmidt number +real :: zru ! correction for displacement height ! SCCS-ID VARIABLES CHARACTER*81 :: sccsida ! @@ -161,13 +161,13 @@ REAL FUNCTION fpsih(eta) PARAMETER (ROUTINENAAM = 'fpsih') ! SUBROUTINE ARGUMENTS - INPUT -REAL*4, INTENT(IN) :: eta ! stabiliteitsparameter z/l +real, INTENT(IN) :: eta ! stabiliteitsparameter z/l ! OUTPUT ! Return value ! ! LOCAL VARIABLES -REAL*4 :: y ! hulpvariabele bij de berekening +real :: y ! hulpvariabele bij de berekening ! SCCS-ID VARIABLES CHARACTER*81 :: sccsida ! diff --git a/ops_gen_precip.f90 b/ops_gen_precip.f90 index 5cd6e34..c84af97 100644 --- a/ops_gen_precip.f90 +++ b/ops_gen_precip.f90 @@ -53,12 +53,12 @@ SUBROUTINE ops_gen_precip(uurtot, astat, trafst, precip, error) PARAMETER (ROUTINENAAM = 'ops_gen_precip') ! SUBROUTINE ARGUMENTS - INPUT -REAL*4, INTENT(IN) :: uurtot -REAL*4, INTENT(IN) :: astat(NTRAJ, NCOMP, NSTAB, NSEK) -REAL*4, INTENT(IN) :: trafst(NTRAJ) +real, INTENT(IN) :: uurtot +real, INTENT(IN) :: astat(NTRAJ, NCOMP, NSTAB, NSEK) +real, INTENT(IN) :: trafst(NTRAJ) ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT) :: precip ! array with precipitation per receptorpoint +real, INTENT(OUT) :: precip ! array with precipitation per receptorpoint TYPE (TError), INTENT(OUT) :: error ! error handling record ! LOCAL VARIABLES @@ -68,47 +68,47 @@ SUBROUTINE ops_gen_precip(uurtot, astat, trafst, precip, error) INTEGER*4 :: istab ! index of stability class INTEGER*4 :: iwd ! wind direction [degrees] INTEGER*4 :: itra ! dummy output of ops_statparexp -REAL*4 :: hbron ! source height, dummy input for ops_statparexp -REAL*4 :: disx ! distance source receptor, dummy input for ops_statparexp -REAL*4 :: disxx ! dummy output of ops_statparexp -REAL*4 :: radius ! source diameter, dummy input for ops_statparexp -REAL*4 :: qww ! heat content of source, dummy input for ops_statparexp; +real :: hbron ! source height, dummy input for ops_statparexp +real :: disx ! distance source receptor, dummy input for ops_statparexp +real :: disxx ! dummy output of ops_statparexp +real :: radius ! source diameter, dummy input for ops_statparexp +real :: qww ! heat content of source, dummy input for ops_statparexp; ! setting it to 0 prevents unnecessary computation of plume rise ! in ops_statparexp -REAL*4 :: V_stack ! here a dummy -REAL*4 :: Ts_stack ! here a dummy +real :: V_stack ! here a dummy +real :: Ts_stack ! here a dummy LOGICAL :: emis_horizontal ! here a dummy -REAL*4 :: D_stack ! here a dummy -REAL*4 :: vw10 ! here a dummy -REAL*4 :: aksek(12) ! here a dummy -REAL*4 :: h0 ! here a dummy -REAL*4 :: hum ! here a dummy -REAL*4 :: ol ! here a dummy -REAL*4 :: shear ! here a dummy -REAL*4 :: rcaerd ! here a dummy -REAL*4 :: rcnh3d ! here a dummy -REAL*4 :: rcno2d ! here a dummy -REAL*4 :: temp_C ! here a dummy -REAL*4 :: uster ! here a dummy -REAL*4 :: pcoef ! here a dummy -REAL*4 :: htot ! here a dummy -REAL*4 :: htt ! here a dummy -REAL*4 :: aant ! here a dummy -REAL*4 :: xl ! here a dummy -REAL*4 :: rb ! here a dummy -REAL*4 :: ra4 ! here a dummy -REAL*4 :: ra50 ! here a dummy -REAL*4 :: xvglbr ! here a dummy -REAL*4 :: xvghbr ! here a dummy -REAL*4 :: xloc ! here a dummy -REAL*4 :: xl100 ! here a dummy -REAL*4 :: rad ! here a dummy -REAL*4 :: rcso2 ! here a dummy -REAL*4 :: coef_space_heating ! here a dummy -REAL*4 :: buil ! here a dummy -REAL*4 :: regenk -REAL*4 :: rint -REAL*4 :: percvk +real :: D_stack ! here a dummy +real :: vw10 ! here a dummy +real :: aksek(12) ! here a dummy +real :: h0 ! here a dummy +real :: hum ! here a dummy +real :: ol ! here a dummy +real :: shear ! here a dummy +real :: rcaerd ! here a dummy +real :: rcnh3d ! here a dummy +real :: rcno2d ! here a dummy +real :: temp_C ! here a dummy +real :: uster ! here a dummy +real :: pcoef ! here a dummy +real :: htot ! here a dummy +real :: htt ! here a dummy +real :: aant ! here a dummy +real :: xl ! here a dummy +real :: rb ! here a dummy +real :: ra4 ! here a dummy +real :: ra50 ! here a dummy +real :: xvglbr ! here a dummy +real :: xvghbr ! here a dummy +real :: xloc ! here a dummy +real :: xl100 ! here a dummy +real :: rad ! here a dummy +real :: rcso2 ! here a dummy +real :: coef_space_heating ! here a dummy +real :: buil ! here a dummy +real :: regenk +real :: rint +real :: percvk ! SCCS-ID VARIABLES CHARACTER*81 :: sccsida ! diff --git a/ops_gen_rcp.f90 b/ops_gen_rcp.f90 index 5b63db6..e5802d0 100644 --- a/ops_gen_rcp.f90 +++ b/ops_gen_rcp.f90 @@ -57,12 +57,12 @@ SUBROUTINE ops_gen_rcp(spgrid, igrens, masker, grid, nrcol, nrrow, nrrcp, xorg, INTEGER*4, INTENT(IN) :: spgrid LOGICAL, INTENT(IN) :: igrens TYPE (TApsGridReal), INTENT(IN) :: masker -REAL*4, INTENT(IN) :: grid +real, INTENT(IN) :: grid INTEGER*4, INTENT(IN) :: nrcol INTEGER*4, INTENT(IN) :: nrrow INTEGER*4, INTENT(IN) :: nrrcp ! number of receptor points -REAL*4, INTENT(IN) :: xorg -REAL*4, INTENT(IN) :: yorg +real, INTENT(IN) :: xorg +real, INTENT(IN) :: yorg LOGICAL, INTENT(IN) :: varz LOGICAL, INTENT(IN) :: perc LOGICAL, INTENT(IN) :: domlu @@ -70,11 +70,11 @@ SUBROUTINE ops_gen_rcp(spgrid, igrens, masker, grid, nrcol, nrrow, nrrcp, xorg, ! SUBROUTINE ARGUMENTS - OUTPUT INTEGER*4, INTENT(OUT) :: jump(nrrcp+1) INTEGER*4, INTENT(OUT) :: lu_rcp_dom_all(nrrcp) ! -REAL*4, INTENT(OUT) :: xm(nrrcp) ! x-coordinates -REAL*4, INTENT(OUT) :: ym(nrrcp) ! y-coordinates -REAL*4, INTENT(OUT) :: zm(nrrcp) ! z-coordinates -REAL*4, INTENT(OUT) :: frac(nrrcp) ! fraction of output cell on land surface -REAL*4, INTENT(OUT) :: z0_rcp_all(nrrcp) ! roughness lengths for all receptors; from z0-map or receptor file [m] +real, INTENT(OUT) :: xm(nrrcp) ! x-coordinates +real, INTENT(OUT) :: ym(nrrcp) ! y-coordinates +real, INTENT(OUT) :: zm(nrrcp) ! z-coordinates +real, INTENT(OUT) :: frac(nrrcp) ! fraction of output cell on land surface +real, INTENT(OUT) :: z0_rcp_all(nrrcp) ! roughness lengths for all receptors; from z0-map or receptor file [m] INTEGER, INTENT(OUT) :: lu_rcp_per_user_all(nrrcp,NLU) ! percentage of landuse for all receptors, used defined in receptor file CHARACTER*(*), INTENT(OUT) :: namrcp(nrrcp) ! receptor names TYPE (TError), INTENT(OUT) :: error ! error handling record @@ -92,13 +92,13 @@ SUBROUTINE ops_gen_rcp(spgrid, igrens, masker, grid, nrcol, nrrow, nrrcp, xorg, INTEGER*4 :: check_nwords ! number of words in string INTEGER*4 :: ix ! x coordinate of receptor point (read from file) INTEGER*4 :: iy ! y coordinate of receptor point (read from file) -REAL*4 :: zrcp ! z coordinate of receptor point (read from file) +real :: zrcp ! z coordinate of receptor point (read from file) INTEGER*4 :: p ! receptor point number (dummy) INTEGER*4 :: ierr ! error status -REAL*4 :: x_rcp ! x coordinate receptor point -REAL*4 :: y_rcp ! y coordinate receptor point -REAL*4 :: cellvalue ! value of masker grid cell at receptor point -REAL*4 :: z0 ! +real :: x_rcp ! x coordinate receptor point +real :: y_rcp ! y coordinate receptor point +real :: cellvalue ! value of masker grid cell at receptor point +real :: z0 INTEGER :: lu_rcp_per_user(NLU) ! percentages of landuse classes for this receptor LOGICAL :: iscell ! whether point is inside masker grid CHARACTER*12 :: namrp ! name of receptor point diff --git a/ops_get_dim.f90 b/ops_get_dim.f90 index f08b227..81d6cb6 100644 --- a/ops_get_dim.f90 +++ b/ops_get_dim.f90 @@ -55,9 +55,9 @@ SUBROUTINE ops_get_dim(spgrid, igrens, xc, yc, grid, nrcol, nrrow, nrrcp, xorg, ! SUBROUTINE ARGUMENTS - INPUT INTEGER*4, INTENT(IN) :: spgrid LOGICAL, INTENT(IN) :: igrens -REAL*4, INTENT(IN) :: xc -REAL*4, INTENT(IN) :: yc -REAL*4, INTENT(IN) :: grid +real, INTENT(IN) :: xc +real, INTENT(IN) :: yc +real, INTENT(IN) :: grid ! SUBROUTINE ARGUMENTS - I/O INTEGER*4, INTENT(INOUT) :: nrcol ! number of colums in grid @@ -65,18 +65,18 @@ SUBROUTINE ops_get_dim(spgrid, igrens, xc, yc, grid, nrcol, nrrow, nrrcp, xorg, ! SUBROUTINE ARGUMENTS - OUTPUT INTEGER*4, INTENT(OUT) :: nrrcp ! number of receptor points -REAL*4, INTENT(OUT) :: xorg -REAL*4, INTENT(OUT) :: yorg +real, INTENT(OUT) :: xorg +real, INTENT(OUT) :: yorg TYPE (TApsGridReal), INTENT(OUT) :: masker TYPE (TError), INTENT(OUT) :: error ! error handling record ! LOCAL VARIABLES -REAL*4, PARAMETER :: GRID_XSTART = 0.000 ! x-coordinate of left upper corner point of NL grid -REAL*4, PARAMETER :: GRID_YSTART = 620000.000 ! y-coordinate of left upper corner point of NL grid -REAL*4, PARAMETER :: NL_XLEFT = 13562.623 ! -REAL*4, PARAMETER :: NL_XRIGHT = 278018.313 ! -REAL*4, PARAMETER :: NL_YUPPER = 619122.750 ! -REAL*4, PARAMETER :: NL_YLOWER = 306838.813 ! +real, PARAMETER :: GRID_XSTART = 0.000 ! x-coordinate of left upper corner point of NL grid +real, PARAMETER :: GRID_YSTART = 620000.000 ! y-coordinate of left upper corner point of NL grid +real, PARAMETER :: NL_XLEFT = 13562.623 +real, PARAMETER :: NL_XRIGHT = 278018.313 +real, PARAMETER :: NL_YUPPER = 619122.750 +real, PARAMETER :: NL_YLOWER = 306838.813 ! LOCAL VARIABLES INTEGER*4 :: i ! grid index @@ -86,16 +86,16 @@ SUBROUTINE ops_get_dim(spgrid, igrens, xc, yc, grid, nrcol, nrrow, nrrcp, xorg, INTEGER*4 :: iy ! y coordinate of receptor point (read from file) INTEGER*4 :: p ! receptor point number (dummy) INTEGER*4 :: ierr ! error status -REAL*4 :: lower -REAL*4 :: xmax ! maximum x coordinate of receptor points -REAL*4 :: xmax2 -REAL*4 :: xmin ! minimum x coordinate of receptor points -REAL*4 :: ymax ! maximum y coordinate of receptor points -REAL*4 :: ymax2 -REAL*4 :: ymin ! minimum y coordinate of receptor points -REAL*4 :: x_rcp ! x coordinate receptor point -REAL*4 :: y_rcp ! y coordinate receptor point -REAL*4 :: cellvalue ! value of masker grid cell at receptor point +real :: lower +real :: xmax ! maximum x coordinate of receptor points +real :: xmax2 +real :: xmin ! minimum x coordinate of receptor points +real :: ymax ! maximum y coordinate of receptor points +real :: ymax2 +real :: ymin ! minimum y coordinate of receptor points +real :: x_rcp ! x coordinate receptor point +real :: y_rcp ! y coordinate receptor point +real :: cellvalue ! value of masker grid cell at receptor point LOGICAL :: iscell ! whether point is inside masker grid CHARACTER*12 :: namrp ! name of receptor point @@ -277,7 +277,7 @@ SUBROUTINE gen_mask(grid, maskergrid, error) PARAMETER (ROUTINENAAM = 'gen_mask') ! SUBROUTINE ARGUMENTS - INPUT -REAL*4, INTENT(IN) :: grid +real, INTENT(IN) :: grid ! SUBROUTINE ARGUMENTS - OUTPUT TYPE (TApsGridReal), INTENT(OUT) :: maskergrid ! APS-grid with fraction of area inside NL for each grid cell @@ -294,7 +294,7 @@ SUBROUTINE gen_mask(grid, maskergrid, error) INTEGER*4 :: land ! sum of 1's of base grid that lie inside a certain output mask grid cell INTEGER*4 :: nrcol ! number of columns in output mask grid INTEGER*4 :: nrrow ! number of rows in output mask grid -REAL*4 :: outputres ! resolution of output mask grid [km] +real :: outputres ! resolution of output mask grid [km] CHARACTER*1 :: gridname ! denotes direction 'x' or 'y' where error occurred when checking ! for grid resolution conformity diff --git a/ops_getlu.f90 b/ops_getlu.f90 index 0bcf067..6d1fbfb 100644 --- a/ops_getlu.f90 +++ b/ops_getlu.f90 @@ -48,8 +48,8 @@ SUBROUTINE ops_getlu(xr, yr, lugrid, landuse) PARAMETER (ROUTINENAAM = 'getlu') ! SUBROUTINE ARGUMENTS - INPUT -REAL*4, INTENT(IN) :: xr ! x-coordinate of point (RDM) -REAL*4, INTENT(IN) :: yr ! y-coordinate of point (RDM) +real, INTENT(IN) :: xr ! x-coordinate of point (RDM) +real, INTENT(IN) :: yr ! y-coordinate of point (RDM) TYPE (TApsGridInt), INTENT(IN) :: lugrid ! grid with landuse information ! SUBROUTINE ARGUMENTS - OUTPUT diff --git a/ops_getlu_tra.f90 b/ops_getlu_tra.f90 index b5a63c2..8d9a5da 100644 --- a/ops_getlu_tra.f90 +++ b/ops_getlu_tra.f90 @@ -51,19 +51,19 @@ SUBROUTINE ops_getlu_tra(xr, yr, xb, yb, lugrid, domlu, lu_tra_per) PARAMETER (ROUTINENAAM = 'ops_getlu_tra') ! SUBROUTINE ARGUMENTS - INPUT -REAL*4, INTENT(IN) :: xr ! x-coordinate receptor (RDM) -REAL*4, INTENT(IN) :: yr ! y-coordinate receptor (RDM) -REAL*4, INTENT(IN) :: xb ! x-coordinate source (RDM) (b << "bron" = source) -REAL*4, INTENT(IN) :: yb ! y-coordinate source (RDM) +real, INTENT(IN) :: xr ! x-coordinate receptor (RDM) +real, INTENT(IN) :: yr ! y-coordinate receptor (RDM) +real, INTENT(IN) :: xb ! x-coordinate source (RDM) (b << "bron" = source) +real, INTENT(IN) :: yb ! y-coordinate source (RDM) TYPE (TApsGridInt), INTENT(IN) :: lugrid ! grid with land use class information (1: dominant land use, 2:NLU+1: percentages land use class) LOGICAL, INTENT(IN) :: domlu ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT) :: lu_tra_per(NLU) ! percentages of land use classes over trajectorie (over intermediate points) +real, INTENT(OUT) :: lu_tra_per(NLU) ! percentages of land use classes over trajectorie (over intermediate points) ! LOCAL VARIABLES -REAL*4 :: x ! x-coordinate intermediate point -REAL*4 :: y ! y-coordinate intermediate point +real :: x ! x-coordinate intermediate point +real :: y ! y-coordinate intermediate point INTEGER*4 :: lu_tra_per_sum(NLU) ! sum of percentages of land use classes over trajectorie (over intermediate points) INTEGER*4 :: lu_tra_dom ! dominant land use class over trajectory source-receptor INTEGER*4 :: is ! index of intermediate point diff --git a/ops_getz0.f90 b/ops_getz0.f90 index 04e2fba..d5c2b27 100644 --- a/ops_getz0.f90 +++ b/ops_getz0.f90 @@ -49,21 +49,21 @@ SUBROUTINE ops_getz0(xr, yr, z0nlgrid, z0eurgrid, z0) PARAMETER (ROUTINENAAM = 'ops_getz0') ! SUBROUTINE ARGUMENTS - INPUT -REAL*4, INTENT(IN) :: xr ! x-coordinate of point (RDM) -REAL*4, INTENT(IN) :: yr ! y-coordinate of point (RDM) +real, INTENT(IN) :: xr ! x-coordinate of point (RDM) +real, INTENT(IN) :: yr ! y-coordinate of point (RDM) TYPE (TApsGridInt), INTENT(IN) :: z0nlgrid ! map of roughness lengths in NL [m] TYPE (TApsGridInt), INTENT(IN) :: z0eurgrid ! map of roughness lengths in Europe [m] ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT) :: z0 ! value of roughnes length z0 [m] +real, INTENT(OUT) :: z0 ! value of roughnes length z0 [m] ! LOCAL VARIABLES INTEGER*4 :: i INTEGER*4 :: cellvalue ! value of z0 grid in grid cell -REAL*4 :: gxr ! x-coordinate of point (lon-lat) -REAL*4 :: gyr ! y-coordinate of point (lon-lat) -REAL*4 :: lamx ! x-coordinate of point (lambert) -REAL*4 :: lamy ! y-coordinate of point (lambert) +real :: gxr ! x-coordinate of point (lon-lat) +real :: gyr ! y-coordinate of point (lon-lat) +real :: lamx ! x-coordinate of point (lambert) +real :: lamy ! y-coordinate of point (lambert) LOGICAL :: iscell ! whether point is inside z0 grid !------------------------------------------------------------------------------------------------------------------------------- ! diff --git a/ops_getz0_tra.f90 b/ops_getz0_tra.f90 index f573f40..e2b7287 100644 --- a/ops_getz0_tra.f90 +++ b/ops_getz0_tra.f90 @@ -49,23 +49,23 @@ SUBROUTINE ops_getz0_tra(xr, yr, xb, yb, z0nlgrid, z0eurgrid, z0_tra) PARAMETER (ROUTINENAAM = 'ops_getz0_tra') ! SUBROUTINE ARGUMENTS - INPUT -REAL*4, INTENT(IN) :: xr ! x coordinate receptor (RDM) -REAL*4, INTENT(IN) :: yr ! y coordinate receptor (RDM) -REAL*4, INTENT(IN) :: xb ! x coordinate source (RDM) -REAL*4, INTENT(IN) :: yb ! y coordinate source (RDM) +real, INTENT(IN) :: xr ! x coordinate receptor (RDM) +real, INTENT(IN) :: yr ! y coordinate receptor (RDM) +real, INTENT(IN) :: xb ! x coordinate source (RDM) +real, INTENT(IN) :: yb ! y coordinate source (RDM) TYPE (TApsGridInt), INTENT(IN) :: z0nlgrid ! map of roughness lengths in NL [m] TYPE (TApsGridInt), INTENT(IN) :: z0eurgrid ! map of roughness lengths in Europe [m] ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT) :: z0_tra ! roughness length representative for trajectory [m] +real, INTENT(OUT) :: z0_tra ! roughness length representative for trajectory [m] ! LOCAL VARIABLES -REAL*4 :: x ! x-coordinate intermediate point (RDM) -REAL*4 :: y ! y-coordinate intermediate point (RDM) -REAL*4 :: gx ! x-coordinate intermediate point (lon-lat) -REAL*4 :: gy ! y-coordinate intermediate point (lon-lat) -REAL*4 :: total ! summed total of log(1/z0) over intermediate points -REAL*4 :: z0 ! roughness length in intermediate point +real :: x ! x-coordinate intermediate point (RDM) +real :: y ! y-coordinate intermediate point (RDM) +real :: gx ! x-coordinate intermediate point (lon-lat) +real :: gy ! y-coordinate intermediate point (lon-lat) +real :: total ! summed total of log(1/z0) over intermediate points +real :: z0 ! roughness length in intermediate point INTEGER*4 :: ns ! number of sub sectors between intermediate points INTEGER*4 :: i ! index of intermediate point !------------------------------------------------------------------------------------------------------------------------------- diff --git a/ops_init.f90 b/ops_init.f90 index c650551..756b12b 100644 --- a/ops_init.f90 +++ b/ops_init.f90 @@ -59,54 +59,53 @@ SUBROUTINE ops_init (gasv, idep, building_present1, kdeppar, knatdeppar, ddeppar LOGICAL, INTENT(IN) :: idep LOGICAL, INTENT(IN) :: building_present1 ! at least one building is present in the source file INTEGER*4, INTENT(IN) :: kdeppar -REAL*4, INTENT(IN) :: ddeppar -REAL*4, INTENT(IN) :: wdeppar +real, INTENT(IN) :: ddeppar +real, INTENT(IN) :: wdeppar INTEGER*4, INTENT(IN) :: ideh INTEGER*4, INTENT(IN) :: icm LOGICAL, INTENT(IN) :: isec INTEGER*4, INTENT(IN) :: nsubsec ! number of sub-secondary species INTEGER*4, INTENT(IN) :: iseiz INTEGER*4, INTENT(IN) :: mb -REAL*4, INTENT(IN) :: astat(NTRAJ, NCOMP, NSTAB, NSEK) -REAL*4, INTENT(IN) :: dverl(NHRBLOCKS,MAXDISTR) -REAL*4, INTENT(IN) :: usdverl(NHRBLOCKS,MAXDISTR) +real, INTENT(IN) :: astat(NTRAJ, NCOMP, NSTAB, NSEK) +real, INTENT(IN) :: dverl(NHRBLOCKS,MAXDISTR) +real, INTENT(IN) :: usdverl(NHRBLOCKS,MAXDISTR) INTEGER*4, INTENT(IN) :: dv INTEGER*4, INTENT(IN) :: usdv ! SUBROUTINE ARGUMENTS - I/O INTEGER*4, INTENT(INOUT) :: knatdeppar -REAL*4, INTENT(INOUT) :: amol2 +real, INTENT(INOUT) :: amol2 CHARACTER*(*), INTENT(INOUT) :: namco -REAL*4, INTENT(INOUT) :: amol1 -REAL*4, INTENT(INOUT) :: dg +real, INTENT(INOUT) :: amol1 +real, INTENT(INOUT) :: dg LOGICAL, INTENT(INOUT) :: irev -REAL*4, INTENT(INOUT) :: vchemc -REAL*4, INTENT(INOUT) :: vchemv -REAL*4, INTENT(INOUT) :: emtrend +real, INTENT(INOUT) :: vchemc +real, INTENT(INOUT) :: vchemv +real, INTENT(INOUT) :: emtrend ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT) :: rc +real, INTENT(OUT) :: rc CHARACTER*(*), INTENT(OUT) :: coneh -REAL*4, INTENT(OUT) :: amol21 +real, INTENT(OUT) :: amol21 CHARACTER*(*), INTENT(OUT) :: depeh CHARACTER*(*), INTENT(OUT) :: namsec CHARACTER*(*), INTENT(OUT) :: namse3 -REAL*4, INTENT(OUT) :: ugmoldep -REAL*4, INTENT(OUT) :: scavcoef -REAL*4, INTENT(OUT) :: rcno -REAL*4, INTENT(OUT) :: rhno2 -REAL*4, INTENT(OUT) :: rchno3 -REAL*4, INTENT(OUT) :: routsec ! in-cloud scavenging ratio for secondary component +real, INTENT(OUT) :: ugmoldep +real, INTENT(OUT) :: scavcoef +real, INTENT(OUT) :: rcno +real, INTENT(OUT) :: rhno2 +real, INTENT(OUT) :: rchno3 +real, INTENT(OUT) :: routsec ! in-cloud scavenging ratio for secondary component ! (rout << rain-out = in-cloud) [-] -REAL*4, INTENT(OUT) :: routpri ! in-cloud scavenging ratio for primary component ! (rout << rain-out = in-cloud) [-] -REAL*4, INTENT(OUT) :: conc_cf -REAL*4, INTENT(OUT) :: koh -REAL*4, INTENT(OUT) :: croutpri ! constant (initial) in-cloud scavenging ratio [-] for primary component -REAL*4, INTENT(OUT) :: somcsec -REAL*4, INTENT(OUT) :: ar -REAL*4, INTENT(OUT) :: rno2nox -REAL*4, INTENT(OUT) :: ecvl(NSTAB, NTRAJ, *) +real, INTENT(OUT) :: routpri ! in-cloud scavenging ratio for primary component + ! (rout << rain-out = in-cloud) [-] +real, INTENT(OUT) :: conc_cf +real, INTENT(OUT) :: koh +real, INTENT(OUT) :: croutpri ! constant (initial) in-cloud scavenging ratio [-] for primary component +real, INTENT(OUT) :: somcsec +real, INTENT(OUT) :: ar CHARACTER*(*), INTENT(OUT) :: nam_subsec(nsubsec) type(TbuildingEffect), INTENT(OUT) :: buildingEffect ! structure with building effect tables TYPE (TError), INTENT(OUT) :: error ! error handling record @@ -119,8 +118,8 @@ SUBROUTINE ops_init (gasv, idep, building_present1, kdeppar, knatdeppar, ddeppar INTEGER*4 :: itraj INTEGER*4 :: istab INTEGER*4 :: iu -REAL*4 :: vgmax -REAL*4 :: som +real :: vgmax +real :: som CHARACTER*512 :: line ! SCCS-ID VARIABLES diff --git a/ops_main.f90 b/ops_main.f90 index ff8e4d8..d8c014c 100644 --- a/ops_main.f90 +++ b/ops_main.f90 @@ -125,8 +125,8 @@ PROGRAM ops_main INTEGER*4 :: mmm INTEGER*4 :: ndone INTEGER*4 :: lu_rcp_dom ! dominant landuse class at receptor point -REAL*4 :: lu_tra_per(NLU) ! percentages of landuse classes over trajectorie -REAL*4 :: lu_rcp_per(NLU) ! percentages of landuse classes at receptor points +real :: lu_tra_per(NLU) ! percentages of landuse classes over trajectorie +real :: lu_rcp_per(NLU) ! percentages of landuse classes at receptor points INTEGER*4 :: i1(NTRAJ-1) ! INTEGER*4 :: year INTEGER*4 :: memdone @@ -137,124 +137,124 @@ PROGRAM ops_main INTEGER*4 :: ntodo INTEGER*4 :: bottom -REAL*4 :: aind ! hourglass -REAL*4 :: amol2 -REAL*4 :: amol21 -REAL*4 :: z0_metreg_user ! roughness length of user specified meteo region [m] -REAL*4 :: z0_user ! roughness length specified by user [m] -REAL*4 :: z0_metreg_rcp ! roughness length at receptor; interpolated from meteo regions [m] -REAL*4 :: z0_rcp ! roughness length at receptor; from z0-map [m] -REAL*4 :: z0_src ! roughness length at source; from z0-map [m] -REAL*4 :: z0_tra ! roughness length representative for trajectory [m] -REAL*4 :: vchemc +real :: aind ! hourglass +real :: amol2 +real :: amol21 +real :: z0_metreg_user ! roughness length of user specified meteo region [m] +real :: z0_user ! roughness length specified by user [m] +real :: z0_metreg_rcp ! roughness length at receptor; interpolated from meteo regions [m] +real :: z0_rcp ! roughness length at receptor; from z0-map [m] +real :: z0_src ! roughness length at source; from z0-map [m] +real :: z0_tra ! roughness length representative for trajectory [m] +real :: vchemc INTEGER*4 :: iopt_vchem ! option for chemical conversion rate (0 = old OPS, 1 = EMEP) -REAL*4 :: vchemv -REAL*4 :: xc -REAL*4 :: yc -REAL*4 :: rc -REAL*4 :: ugmoldep -REAL*4 :: gemre -REAL*4 :: somcsec -REAL*4 :: gemcpri -REAL*4 :: gemcsec -REAL*4 :: totddep -REAL*4 :: gemddep -REAL*4 :: gemddpri -REAL*4 :: gemddsec -REAL*4 :: ddrpri -REAL*4 :: ddrsec -REAL*4 :: totwdep -REAL*4 :: gemwdep -REAL*4 :: gemwdpri -REAL*4 :: gemwdsec -REAL*4 :: wdrpri -REAL*4 :: wdrsec -REAL*4 :: tottdep -REAL*4 :: gemtdep -REAL*4 :: gemprec -REAL*4 :: ccr -REAL*4 :: xorg -REAL*4 :: yorg -REAL*4 :: bdiam(LSBUF) -REAL*4 :: bsterkte(LSBUF) -REAL*4 :: bwarmte(LSBUF) -REAL*4 :: bhoogte(LSBUF) -REAL*4 :: bsigmaz(LSBUF) -REAL*4 :: bD_stack(LSBUF) ! diameter of the stack [m] -REAL*4 :: bV_stack(LSBUF) ! exit velocity of plume at stack tip [m/s] -REAL*4 :: bTs_stack(LSBUF) ! temperature of effluent from stack [K] +real :: vchemv +real :: xc +real :: yc +real :: rc +real :: ugmoldep +real :: gemre +real :: somcsec +real :: gemcpri +real :: gemcsec +real :: totddep +real :: gemddep +real :: gemddpri +real :: gemddsec +real :: ddrpri +real :: ddrsec +real :: totwdep +real :: gemwdep +real :: gemwdpri +real :: gemwdsec +real :: wdrpri +real :: wdrsec +real :: tottdep +real :: gemtdep +real :: gemprec +real :: ccr +real :: xorg +real :: yorg +real :: bdiam(LSBUF) +real :: bsterkte(LSBUF) +real :: bwarmte(LSBUF) +real :: bhoogte(LSBUF) +real :: bsigmaz(LSBUF) +real :: bD_stack(LSBUF) ! diameter of the stack [m] +real :: bV_stack(LSBUF) ! exit velocity of plume at stack tip [m/s] +real :: bTs_stack(LSBUF) ! temperature of effluent from stack [K] LOGICAL :: bemis_horizontal(LSBUF) ! horizontal outflow of emission type(Tbuilding) :: bbuilding(LSBUF) ! array with structures with building parameters LOGICAL :: building_present1 ! at least one building is present in the source file -REAL*4 :: emis(6,NLANDMAX) -REAL*4 :: conc_cf -REAL*4 :: astat(NTRAJ, NCOMP, NSTAB, NSEK) -REAL*4 :: ar -REAL*4 :: rno2nox -REAL*4 :: uurtot -REAL*4 :: zf -REAL*4 :: trafst(NTRAJ) -REAL*4 :: bqrv(LSBUF) -REAL*4 :: bqtr(LSBUF) -REAL*4 :: cs(NTRAJ, NCOMP, NSTAB, NSEK, NMETREG) -REAL*4 :: rainreg(NMETREG) -REAL*4 :: z0_metreg(NMETREG) ! roughness lengths of NMETREG meteo regions; scale < 50 km [m] -REAL*4 :: xreg(NMETREG) -REAL*4 :: yreg(NMETREG) -REAL*4 :: hourreg(NMETREG) -REAL*4 :: ecvl(NSTAB, NTRAJ,2*MAXDISTR) -REAL*4 :: dverl(NHRBLOCKS,MAXDISTR) -REAL*4 :: usdverl(NHRBLOCKS,MAXDISTR) -REAL*4 :: pmd(NPARTCLASS,MAXDISTR) -REAL*4 :: uspmd(NPARTCLASS,MAXDISTR) -REAL*4 :: amol1 -REAL*4 :: emtrend -REAL*4 :: grid -REAL*4 :: wdeppar -REAL*4 :: scavcoef -REAL*4 :: routsec ! in-cloud scavenging ratio for secondary component +real :: emis(6,NLANDMAX) +real :: conc_cf +real :: astat(NTRAJ, NCOMP, NSTAB, NSEK) +real :: ar +real :: rno2nox +real :: uurtot +real :: zf +real :: trafst(NTRAJ) +real :: bqrv(LSBUF) +real :: bqtr(LSBUF) +real :: cs(NTRAJ, NCOMP, NSTAB, NSEK, NMETREG) +real :: rainreg(NMETREG) +real :: z0_metreg(NMETREG) ! roughness lengths of NMETREG meteo regions; scale < 50 km [m] +real :: xreg(NMETREG) +real :: yreg(NMETREG) +real :: hourreg(NMETREG) +real :: ecvl(NSTAB, NTRAJ,2*MAXDISTR) +real :: dverl(NHRBLOCKS,MAXDISTR) +real :: usdverl(NHRBLOCKS,MAXDISTR) +real :: pmd(NPARTCLASS,MAXDISTR) +real :: uspmd(NPARTCLASS,MAXDISTR) +real :: amol1 +real :: emtrend +real :: grid +real :: wdeppar +real :: scavcoef +real :: routsec ! in-cloud scavenging ratio for secondary component ! (rout << rain-out = in-cloud) [-] -REAL*4 :: routpri ! in-cloud scavenging ratio for primary component +real :: routpri ! in-cloud scavenging ratio for primary component ! (rout << rain-out = in-cloud) [-] -REAL*4 :: croutpri ! constant (initial) in-cloud scavenging ratio [-] for primary component -REAL*4 :: rcno -REAL*4 :: rhno2 -REAL*4 :: rchno3 -REAL*4 :: dg -REAL*4 :: dispg(NSTAB) -REAL*4 :: ddeppar -REAL*4 :: koh -REAL*4 :: so2sek(NSEK) -REAL*4 :: no2sek(NSEK) -REAL*4, DIMENSION(:), POINTER :: gem_subsec ! grid mean for concentration of sub-secondary species [ug/m3] -REAL*4 :: scale_con -REAL*4 :: scale_sec -REAL*4, DIMENSION(:), POINTER :: scale_subsec -REAL*4 :: scale_dep -REAL*4 :: so2bgtra ! -REAL*4 :: no2bgtra ! -REAL*4 :: nh3bgtra ! +real :: croutpri ! constant (initial) in-cloud scavenging ratio [-] for primary component +real :: rcno +real :: rhno2 +real :: rchno3 +real :: dg +real :: dispg(NSTAB) +real :: ddeppar +real :: koh +real :: so2sek(NSEK) +real :: no2sek(NSEK) +real, DIMENSION(:), POINTER :: gem_subsec ! grid mean for concentration of sub-secondary species [ug/m3] +real :: scale_con +real :: scale_sec +real, DIMENSION(:), POINTER :: scale_subsec +real :: scale_dep +real :: so2bgtra +real :: no2bgtra +real :: nh3bgtra type(Tvchem) :: vchem2 -REAL*8, DIMENSION(:), POINTER :: sdrypri_arr -REAL*8 :: sdrypri -REAL*8, DIMENSION(:), POINTER :: snatpri_arr -REAL*8 :: snatpri -REAL*8, DIMENSION(:), POINTER :: somvnpri_arr -REAL*8 :: somvnpri -REAL*8, DIMENSION(:), POINTER :: telvnpri_arr -REAL*8 :: telvnpri -REAL*8, DIMENSION(:), POINTER :: sdrysec_arr -REAL*8 :: sdrysec -REAL*8, DIMENSION(:), POINTER :: snatsec_arr -REAL*8 :: snatsec -REAL*8, DIMENSION(:), POINTER :: somvnsec_arr -REAL*8 :: somvnsec -REAL*8, DIMENSION(:), POINTER :: telvnsec_arr -REAL*8 :: telvnsec -REAL*8, DIMENSION(:), POINTER :: vvchem_arr -REAL*8 :: vvchem -REAL*8, DIMENSION(:), POINTER :: vtel_arr -REAL*8 :: vtel +double precision, DIMENSION(:), POINTER :: sdrypri_arr +double precision :: sdrypri +double precision, DIMENSION(:), POINTER :: snatpri_arr +double precision :: snatpri +double precision, DIMENSION(:), POINTER :: somvnpri_arr +double precision :: somvnpri +double precision, DIMENSION(:), POINTER :: telvnpri_arr +double precision :: telvnpri +double precision, DIMENSION(:), POINTER :: sdrysec_arr +double precision :: sdrysec +double precision, DIMENSION(:), POINTER :: snatsec_arr +double precision :: snatsec +double precision, DIMENSION(:), POINTER :: somvnsec_arr +double precision :: somvnsec +double precision, DIMENSION(:), POINTER :: telvnsec_arr +double precision :: telvnsec +double precision, DIMENSION(:), POINTER :: vvchem_arr +double precision :: vvchem +double precision, DIMENSION(:), POINTER :: vtel_arr +double precision :: vtel CHARACTER*512 :: namco CHARACTER*80 :: project @@ -290,32 +290,33 @@ PROGRAM ops_main INTEGER*4, DIMENSION(:), POINTER :: lu_rcp_dom_all ! land use at receptor points INTEGER*4, DIMENSION(:), POINTER :: jump ! indices skipped because grid cell is outside NL -REAL*4, DIMENSION(:), POINTER :: xm -REAL*4, DIMENSION(:), POINTER :: ym -REAL*4, DIMENSION(:), POINTER :: zm -REAL*4, DIMENSION(:), POINTER :: frac ! fraction of output cell on land surface +real, DIMENSION(:), POINTER :: xm +real, DIMENSION(:), POINTER :: ym +real, DIMENSION(:), POINTER :: zm +real, DIMENSION(:), POINTER :: frac ! fraction of output cell on land surface INTEGER, DIMENSION(:,:), POINTER :: lu_rcp_per_user_all ! percentage of landuse for all receptors, used defined in receptor file -REAL*4, DIMENSION(:), POINTER :: gxm -REAL*4, DIMENSION(:), POINTER :: gym -REAL*4, DIMENSION(:), POINTER :: z0_rcp_all ! roughness lengths for all receptors; from z0-map or receptor file [m] -REAL*4, DIMENSION(:), POINTER :: rhno3_rcp -REAL*4, DIMENSION(:,:), ALLOCATABLE :: f_subsec_rcp ! fractions for sub-secondary species, HNO3/NO3_total, NO3_C/NO3_total, NO3_F/NO3_total [-] -REAL*4, DIMENSION(:), POINTER :: precip +real, DIMENSION(:), POINTER :: gxm +real, DIMENSION(:), POINTER :: gym +real, DIMENSION(:), POINTER :: z0_rcp_all ! roughness lengths for all receptors; from z0-map or receptor file [m] +real, DIMENSION(:), POINTER :: rhno3_rcp +real, DIMENSION(:,:), ALLOCATABLE :: f_subsec_rcp ! fractions for sub-secondary species, HNO3/NO3_total, NO3_C/NO3_total, NO3_F/NO3_total [-] +real, DIMENSION(:), POINTER :: precip DOUBLE PRECISION, DIMENSION(:,:), POINTER :: cpri_d ! concentration of primary component, double precision [ug/m3] -REAL*4, DIMENSION(:), POINTER :: cpri ! concentration of primary component [ug/m3] +real, DIMENSION(:), POINTER :: cpri ! concentration of primary component [ug/m3] DOUBLE PRECISION, DIMENSION(:,:), POINTER :: csec_d ! concentration of secondary component, double precision [ug/m3] -REAL*4, DIMENSION(:), POINTER :: csec ! concentration of secondary component [ug/m3] +real, DIMENSION(:), POINTER :: csec ! concentration of secondary component [ug/m3] DOUBLE PRECISION, DIMENSION(:,:), POINTER :: drydep_d -REAL*4, DIMENSION(:), POINTER :: drydep +real, DIMENSION(:), POINTER :: drydep DOUBLE PRECISION, DIMENSION(:,:), POINTER :: wetdep_d -REAL*4, DIMENSION(:), POINTER :: wetdep +real, DIMENSION(:), POINTER :: wetdep DOUBLE PRECISION, DIMENSION(:,:), POINTER :: ddepri_d -REAL*4, DIMENSION(:), POINTER :: ddepri -REAL*4, DIMENSION(:), POINTER :: totdep -REAL*4, DIMENSION(:,:), POINTER :: csubsec ! concentration of sub-secondary species [ug/m3] -REAL*4, DIMENSION(:), POINTER :: nh3bg_rcp -REAL*4, DIMENSION(:), POINTER :: so2bg_rcp -REAL*4, DIMENSION(:), POINTER :: rno2_nox_sum ! NO2/NOx ratio, weighed sum over classes +real, DIMENSION(:), POINTER :: ddepri +real, DIMENSION(:), POINTER :: totdep +real, DIMENSION(:,:), POINTER :: csubsec ! concentration of sub-secondary species [ug/m3] +real, DIMENSION(:), POINTER :: nh3bg_rcp +real, DIMENSION(:), POINTER :: so2bg_rcp +real, DIMENSION(:), POINTER :: rno2_nox_sum ! NO2/NOx ratio, weighed sum over classes +real:: r1mach CHARACTER*12, DIMENSION(:), POINTER :: namrcp ! receptor names diff --git a/ops_neutral.f90 b/ops_neutral.f90 index ff70a29..8a5777e 100644 --- a/ops_neutral.f90 +++ b/ops_neutral.f90 @@ -50,31 +50,31 @@ SUBROUTINE ops_neutral(z0, zi, ol, uster, h, x, uh, zu, szn) PARAMETER (ROUTINENAAM = 'ops_neutral') ! CONSTANTS -REAL*4 :: A ! correctiefactor to obtain equal limit values |L| > $ -REAL*4 :: K ! von Karmanconstante +real :: A ! correctiefactor to obtain equal limit values |L| > $ +real :: K ! von Karmanconstante PARAMETER (A = 1. ) PARAMETER (K = 0.4) ! SUBROUTINE ARGUMENTS - INPUT -REAL*4, INTENT(IN) :: z0 ! roughness length (m) -REAL*4, INTENT(IN) :: zi ! mixing height (m) -REAL*4, INTENT(IN) :: ol ! Monin-Obukhov length (m) -REAL*4, INTENT(IN) :: uster ! friction velocity (m) -REAL*4, INTENT(IN) :: h ! source heigth (including plume rise) (m) -REAL*4, INTENT(IN) :: x ! downwind distance (m) +real, INTENT(IN) :: z0 ! roughness length (m) +real, INTENT(IN) :: zi ! mixing height (m) +real, INTENT(IN) :: ol ! Monin-Obukhov length (m) +real, INTENT(IN) :: uster ! friction velocity (m) +real, INTENT(IN) :: h ! source heigth (including plume rise) (m) +real, INTENT(IN) :: x ! downwind distance (m) ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT) :: uh ! windspeed at downwind distance x and height zu (m/s) -REAL*4, INTENT(OUT) :: zu ! representative plume height (m), taking into account reflection +real, INTENT(OUT) :: uh ! windspeed at downwind distance x and height zu (m/s) +real, INTENT(OUT) :: zu ! representative plume height (m), taking into account reflection ! at the top of the mixing layer and at the ground surface -REAL*4, INTENT(OUT) :: szn ! vertical dispersion coefficient for near neutral upper layer (m) +real, INTENT(OUT) :: szn ! vertical dispersion coefficient for near neutral upper layer (m) ! LOCAL VARIABLES INTEGER*4 :: last ! -REAL*4 :: fz ! -REAL*4 :: s ! -REAL*4 :: sw ! -REAL*4 :: tl ! +real :: fz +real :: s +real :: sw +real :: tl LOGICAL :: finished ! ! SCCS-ID VARIABLES diff --git a/ops_outp_prep.f90 b/ops_outp_prep.f90 index b5e427d..795b142 100644 --- a/ops_outp_prep.f90 +++ b/ops_outp_prep.f90 @@ -48,23 +48,23 @@ SUBROUTINE ops_outp_prep(nrrcp, icm, nsubsec, conc_cf, rhno3_rcp, f_subsec_rcp, INTEGER*4, INTENT(IN) :: nrrcp ! INTEGER*4, INTENT(IN) :: icm ! INTEGER*4, INTENT(IN) :: nsubsec ! number of sub-secondary species -REAL*4, INTENT(IN) :: conc_cf ! -REAL*4, INTENT(IN) :: rhno3_rcp(nrrcp) ! -REAL*4, INTENT(OUT) :: f_subsec_rcp(nrrcp,nsubsec) ! fractions for sub-secondary species, HNO3/NO3_total, NO3_C/NO3_total, NO3_F/NO3_total [-] -REAL*4, INTENT(IN) :: csec(nrrcp) ! -REAL*4, INTENT(IN) :: drydep(nrrcp) ! -REAL*4, INTENT(IN) :: wetdep(nrrcp) ! +real, INTENT(IN) :: conc_cf +real, INTENT(IN) :: rhno3_rcp(nrrcp) +real, INTENT(OUT) :: f_subsec_rcp(nrrcp,nsubsec) ! fractions for sub-secondary species, HNO3/NO3_total, NO3_C/NO3_total, NO3_F/NO3_total [-] +real, INTENT(IN) :: csec(nrrcp) +real, INTENT(IN) :: drydep(nrrcp) +real, INTENT(IN) :: wetdep(nrrcp) ! SUBROUTINE ARGUMENTS - I/O -REAL*4, INTENT(INOUT) :: cpri(nrrcp) ! +real, INTENT(INOUT) :: cpri(nrrcp) ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT) :: totdep(nrrcp) ! -REAL*4, INTENT(OUT) :: csubsec(nrrcp,nsubsec) ! concentration of sub-secondary species [ug/m3] -REAL*4, INTENT(OUT) :: scale_con ! -REAL*4, INTENT(OUT) :: scale_sec ! -REAL*4, INTENT(OUT) :: scale_subsec(nsubsec) ! scaling factor for sub-secondary species -REAL*4, INTENT(OUT) :: scale_dep ! +real, INTENT(OUT) :: totdep(nrrcp) +real, INTENT(OUT) :: csubsec(nrrcp,nsubsec) ! concentration of sub-secondary species [ug/m3] +real, INTENT(OUT) :: scale_con +real, INTENT(OUT) :: scale_sec +real, INTENT(OUT) :: scale_subsec(nsubsec) ! scaling factor for sub-secondary species +real, INTENT(OUT) :: scale_dep ! LOCAL VARIABLES INTEGER*4 :: isubsec ! index of sub-secondary species diff --git a/ops_par_chem.f90 b/ops_par_chem.f90 index a281f71..f8c8c38 100644 --- a/ops_par_chem.f90 +++ b/ops_par_chem.f90 @@ -55,35 +55,35 @@ SUBROUTINE ops_par_chem (icm, iopt_vchem, isek, so2sek, no2sek, so2bgtra, no2bgt INTEGER*4, INTENT(IN) :: icm INTEGER*4, INTENT(IN) :: iopt_vchem ! option for chemical conversion rate (0 = old OPS, 1 = EMEP) INTEGER*4, INTENT(IN) :: isek -REAL*4, INTENT(IN) :: so2sek(NSEK) -REAL*4, INTENT(IN) :: no2sek(NSEK) -REAL*4, INTENT(IN) :: so2bgtra -REAL*4, INTENT(IN) :: no2bgtra -REAL*4, INTENT(IN) :: nh3bgtra +real, INTENT(IN) :: so2sek(NSEK) +real, INTENT(IN) :: no2sek(NSEK) +real, INTENT(IN) :: so2bgtra +real, INTENT(IN) :: no2bgtra +real, INTENT(IN) :: nh3bgtra type(Tvchem), INTENT(INOUT) :: vchem2 -REAL*4, INTENT(IN) :: disx -REAL*4, INTENT(IN) :: diameter +real, INTENT(IN) :: disx +real, INTENT(IN) :: diameter ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT) :: vchemnh3 -REAL*4, INTENT(OUT) :: rhno3 -REAL*4, INTENT(OUT) :: rrno2nox -REAL*4, INTENT(OUT) :: rations +real, INTENT(OUT) :: vchemnh3 +real, INTENT(OUT) :: rhno3 +real, INTENT(OUT) :: rrno2nox +real, INTENT(OUT) :: rations ! LOCAL VARIABLES -REAL*4 :: C1 ! -REAL*4 :: C2 ! -REAL*4 :: ch ! -REAL*4 :: cr ! -REAL*4 :: wdc_so2 ! -REAL*4 :: wdc_no2 ! -REAL*4 :: so2bgtra_corr ! -REAL*4 :: no2bgtra_corr ! -REAL*4 :: nh3bgtra_corr ! -REAL*4 :: nox_threshold ! threshold value for NOx in log-function in NOx -> NO2 conversion -REAL*4 :: no2_threshold ! threshold value for NO2 in exp-function in NO2 -> NOx conversion -REAL*4 :: alpha ! slope of linear function NOx -> NO2 conversion -REAL*4 :: noxbgtra_corr ! conversion of no2bgtra_corr to NOx +real :: C1 +real :: C2 +real :: ch +real :: cr +real :: wdc_so2 +real :: wdc_no2 +real :: so2bgtra_corr +real :: no2bgtra_corr +real :: nh3bgtra_corr +real :: nox_threshold ! threshold value for NOx in log-function in NOx -> NO2 conversion +real :: no2_threshold ! threshold value for NO2 in exp-function in NO2 -> NOx conversion +real :: alpha ! slope of linear function NOx -> NO2 conversion +real :: noxbgtra_corr ! conversion of no2bgtra_corr to NOx ! SCCS-ID VARIABLES CHARACTER*81 :: sccsida ! diff --git a/ops_plot_uitv.f90 b/ops_plot_uitv.f90 index d8aed11..ff9abe7 100644 --- a/ops_plot_uitv.f90 +++ b/ops_plot_uitv.f90 @@ -56,25 +56,25 @@ SUBROUTINE ops_plot_uitv(spgrid, isec, coneh, nrrcp, nsubsec, jump, xorg, yorg, INTEGER*4, INTENT(IN) :: nrrcp ! INTEGER*4, INTENT(IN) :: nsubsec ! number of sub-secondary species INTEGER*4, INTENT(IN) :: jump(nrrcp+1) ! distance between receptor points in grid units -REAL*4, INTENT(IN) :: xorg ! -REAL*4, INTENT(IN) :: yorg ! +real, INTENT(IN) :: xorg +real, INTENT(IN) :: yorg INTEGER*4, INTENT(IN) :: nrcol ! number of columns in grid INTEGER*4, INTENT(IN) :: nrrow ! number of row in grid -REAL*4, INTENT(IN) :: grid ! +real, INTENT(IN) :: grid LOGICAL, INTENT(IN) :: idep ! CHARACTER*(*), INTENT(IN) :: namco ! CHARACTER*(*), INTENT(IN) :: namse3 ! CHARACTER*(*), INTENT(IN) :: namsec ! CHARACTER*(*), INTENT(IN) :: depeh ! CHARACTER*(*), INTENT(IN) :: namrcp(nrrcp) ! -REAL*4, INTENT(IN) :: xm(nrrcp) ! -REAL*4, INTENT(IN) :: ym(nrrcp) ! -REAL*4, INTENT(IN) :: cpri(nrrcp) ! -REAL*4, INTENT(IN) :: csec(nrrcp) ! -REAL*4, INTENT(IN) :: drydep(nrrcp) ! -REAL*4, INTENT(IN) :: wetdep(nrrcp) ! +real, INTENT(IN) :: xm(nrrcp) +real, INTENT(IN) :: ym(nrrcp) +real, INTENT(IN) :: cpri(nrrcp) +real, INTENT(IN) :: csec(nrrcp) +real, INTENT(IN) :: drydep(nrrcp) +real, INTENT(IN) :: wetdep(nrrcp) INTEGER*4, INTENT(IN) :: icm ! -REAL*4, INTENT(IN) :: csubsec(nrrcp,nsubsec) ! concentration of sub-secondary species [ug/m3] +real, INTENT(IN) :: csubsec(nrrcp,nsubsec) ! concentration of sub-secondary species [ug/m3] CHARACTER*(*), INTENT(IN) :: nam_subsec(nsubsec) ! names of sub-secondary species ! SUBROUTINE ARGUMENTS - OUTPUT @@ -84,9 +84,9 @@ SUBROUTINE ops_plot_uitv(spgrid, isec, coneh, nrrcp, nsubsec, jump, xorg, yorg, INTEGER*4 :: ierr ! INTEGER*4 :: ls ! lengte textstring namse3 INTEGER*4 :: j ! -REAL*4 :: xlb ! -REAL*4 :: ylb ! -REAL*4 :: totdep(nrrcp) ! +real :: xlb +real :: ylb +real :: totdep(nrrcp) INTEGER*4 :: isubsec ! index of sub-secondary species ! CONSTANTS @@ -263,8 +263,8 @@ SUBROUTINE plot_mat(lun, value, nrrcp, jump, nrcol, nrrow, descco, compname, com CHARACTER*(*), INTENT(IN) :: compname ! name of component CHARACTER*(*), INTENT(IN) :: compunit ! component unit REAL, INTENT(IN) :: grid ! grid size in km -REAL*4, INTENT(IN) :: xlb ! aps-formatted x-origin (?) -REAL*4, INTENT(IN) :: ylb ! aps-formatted y-origin (?) +real, INTENT(IN) :: xlb ! aps-formatted x-origin (?) +real, INTENT(IN) :: ylb ! aps-formatted y-origin (?) ! SUBROUTINE ARGUMENTS - OUTPUT TYPE (TError), INTENT(OUT) :: error ! Error handling record @@ -274,7 +274,7 @@ SUBROUTINE plot_mat(lun, value, nrrcp, jump, nrcol, nrrow, descco, compname, com INTEGER :: m ! do loop counter INTEGER :: ierr ! error number INTEGER :: pointto ! current receptor point index on line -REAL*4 :: line(nrcol) ! value from each row +real :: line(nrcol) ! value from each row CHARACTER*80 :: formatstring ! format string in writing CHARACTER*10 :: OPSVERSIE ! format string in writing ! --- diff --git a/ops_plrise71.f90 b/ops_plrise71.f90 index f083f1e..979366c 100644 --- a/ops_plrise71.f90 +++ b/ops_plrise71.f90 @@ -56,26 +56,26 @@ SUBROUTINE ops_plrise71(z0, xl, ol, uster, hbron, qw, xloc, htt, onder) PARAMETER (ROUTINENAAM = 'ops_plrise71') ! SUBROUTINE ARGUMENTS - INPUT -REAL*4, INTENT(IN) :: z0 ! -REAL*4, INTENT(IN) :: xl ! -REAL*4, INTENT(IN) :: ol ! Monin-Obukhovlengte -REAL*4, INTENT(IN) :: uster ! frictiesnelheid -REAL*4, INTENT(IN) :: hbron ! -REAL*4, INTENT(IN) :: qw ! warmte inhoud van het rookgas (MW) -REAL*4, INTENT(IN) :: xloc ! +real, INTENT(IN) :: z0 +real, INTENT(IN) :: xl +real, INTENT(IN) :: ol ! Monin-Obukhovlengte +real, INTENT(IN) :: uster ! frictiesnelheid +real, INTENT(IN) :: hbron +real, INTENT(IN) :: qw ! warmte inhoud van het rookgas (MW) +real, INTENT(IN) :: xloc ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT) :: htt ! -REAL*4, INTENT(OUT) :: onder ! +real, INTENT(OUT) :: htt +real, INTENT(OUT) :: onder ! LOCAL VARIABLES -REAL*4 :: delh ! -REAL*4 :: f ! -REAL*4 :: us ! wind speed at effective plume height +real :: delh +real :: f +real :: us ! wind speed at effective plume height ! representative for the whole plume rise length -REAL*4 :: dtdz ! -REAL*4 :: hs ! -REAL*4 :: s ! +real :: dtdz +real :: hs +real :: s ! Iteration variables ! iteration converges if |delh - delh_prev| < epsa + epsr*delh diff --git a/ops_print_grid.f90 b/ops_print_grid.f90 index c984a13..11fb8d2 100644 --- a/ops_print_grid.f90 +++ b/ops_print_grid.f90 @@ -68,48 +68,48 @@ SUBROUTINE ops_print_grid (nrrcp, nsubsec, jump, project, icm, gasv, idep, isec, CHARACTER*(*), INTENT(IN) :: namse3 ! CHARACTER*(*), INTENT(IN) :: coneh ! concentration unit CHARACTER*(*), INTENT(IN) :: depeh ! deposition unit -REAL*4, INTENT(IN) :: conc_cf ! concentration correction factor -REAL*4, INTENT(IN) :: amol21 ! -REAL*4, INTENT(IN) :: ugmoldep ! +real, INTENT(IN) :: conc_cf ! concentration correction factor +real, INTENT(IN) :: amol21 +real, INTENT(IN) :: ugmoldep INTEGER*4, INTENT(IN) :: nrcol ! number of grid cells in X-dir INTEGER*4, INTENT(IN) :: nrrow ! number of grid cells in Y-dir -REAL*4, INTENT(IN) :: grid ! grid cell dimension -REAL*4, INTENT(IN) :: xorg ! X-coor of grid origin -REAL*4, INTENT(IN) :: yorg ! Y-coor of grid origin -REAL*4, INTENT(IN) :: precip(nrrcp) ! calculated precipitation -REAL*4, INTENT(IN) :: cpri(nrrcp) ! primary concentration -REAL*4, INTENT(IN) :: csec(nrrcp) ! secondary concentration -REAL*4, INTENT(IN) :: drydep(nrrcp) ! dry deposition -REAL*4, INTENT(IN) :: wetdep(nrrcp) ! wet deposition -REAL*4, INTENT(IN) :: ddepri(nrrcp) ! dry depo of primary comp. +real, INTENT(IN) :: grid ! grid cell dimension +real, INTENT(IN) :: xorg ! X-coor of grid origin +real, INTENT(IN) :: yorg ! Y-coor of grid origin +real, INTENT(IN) :: precip(nrrcp) ! calculated precipitation +real, INTENT(IN) :: cpri(nrrcp) ! primary concentration +real, INTENT(IN) :: csec(nrrcp) ! secondary concentration +real, INTENT(IN) :: drydep(nrrcp) ! dry deposition +real, INTENT(IN) :: wetdep(nrrcp) ! wet deposition +real, INTENT(IN) :: ddepri(nrrcp) ! dry depo of primary comp. INTEGER*4, INTENT(IN) :: lu_rcp_dom_all(nrrcp) ! land use -REAL*4, INTENT(IN) :: z0_rcp_all(nrrcp) ! roughness lengths for all receptors; from z0-map or receptor file [m] -REAL*4, INTENT(IN) :: gemcpri ! grid mean for prim. concentration -REAL*4, INTENT(IN) :: gemcsec ! grid mean for sec. concentration -REAL*4, INTENT(IN) :: ccr ! eff. chemical conversion rate -REAL*4, INTENT(IN) :: gemddep ! grid mean for dry deposition -REAL*4, INTENT(IN) :: gemddpri ! grid mean for dry deposition (pri) -REAL*4, INTENT(IN) :: gemddsec ! grid mean for dry deposition (sec) -REAL*4, INTENT(IN) :: totddep ! grid total dry deposition (g/s) -REAL*4, INTENT(IN) :: ddrpri ! eff. dry deposition rate (prim) -REAL*4, INTENT(IN) :: ddrsec ! eff. dry deposition rate (sec) -REAL*4, INTENT(IN) :: gemwdep ! grid mean for wet deposition (tot) -REAL*4, INTENT(IN) :: gemwdpri ! grid mean for wet deposition (pri) -REAL*4, INTENT(IN) :: gemwdsec ! grid mean for wet deposition (sec) -REAL*4, INTENT(IN) :: totwdep ! grid total wet deposition (g/s) -REAL*4, INTENT(IN) :: wdrpri ! effective wet deposition rate (primary component) [%/h] -REAL*4, INTENT(IN) :: wdrsec ! effective wet deposition rate (secondary component) [%/h] -REAL*4, INTENT(IN) :: gemprec ! grid mean annual precpitation from meteo -REAL*4, INTENT(IN) :: gemtdep ! grid mean for total deposition -REAL*4, INTENT(IN) :: tottdep ! grid total total deposition -REAL*4, INTENT(IN) :: csubsec(nrrcp,nsubsec) ! concentration of sub-secondary substance [ug/m3] -REAL*4, INTENT(IN) :: gem_subsec(nsubsec) ! grid mean for concentration of sub-secondary species [ug/m3] +real, INTENT(IN) :: z0_rcp_all(nrrcp) ! roughness lengths for all receptors; from z0-map or receptor file [m] +real, INTENT(IN) :: gemcpri ! grid mean for prim. concentration +real, INTENT(IN) :: gemcsec ! grid mean for sec. concentration +real, INTENT(IN) :: ccr ! eff. chemical conversion rate +real, INTENT(IN) :: gemddep ! grid mean for dry deposition +real, INTENT(IN) :: gemddpri ! grid mean for dry deposition (pri) +real, INTENT(IN) :: gemddsec ! grid mean for dry deposition (sec) +real, INTENT(IN) :: totddep ! grid total dry deposition (g/s) +real, INTENT(IN) :: ddrpri ! eff. dry deposition rate (prim) +real, INTENT(IN) :: ddrsec ! eff. dry deposition rate (sec) +real, INTENT(IN) :: gemwdep ! grid mean for wet deposition (tot) +real, INTENT(IN) :: gemwdpri ! grid mean for wet deposition (pri) +real, INTENT(IN) :: gemwdsec ! grid mean for wet deposition (sec) +real, INTENT(IN) :: totwdep ! grid total wet deposition (g/s) +real, INTENT(IN) :: wdrpri ! effective wet deposition rate (primary component) [%/h] +real, INTENT(IN) :: wdrsec ! effective wet deposition rate (secondary component) [%/h] +real, INTENT(IN) :: gemprec ! grid mean annual precpitation from meteo +real, INTENT(IN) :: gemtdep ! grid mean for total deposition +real, INTENT(IN) :: tottdep ! grid total total deposition +real, INTENT(IN) :: csubsec(nrrcp,nsubsec) ! concentration of sub-secondary substance [ug/m3] +real, INTENT(IN) :: gem_subsec(nsubsec) ! grid mean for concentration of sub-secondary species [ug/m3] CHARACTER*(*), INTENT(IN) :: nam_subsec(nsubsec) ! names of sub-secondary species -REAL*4, INTENT(IN) :: totdep(nrrcp) ! total deposition -REAL*4, INTENT(IN) :: scale_con ! scalefactor prim. concentration -REAL*4, INTENT(IN) :: scale_sec ! scalefactor sec. concentration -REAL*4, INTENT(IN) :: scale_subsec(nsubsec) ! scaling factor for sub-secondary species -REAL*4, INTENT(IN) :: scale_dep ! scalefactor deposition +real, INTENT(IN) :: totdep(nrrcp) ! total deposition +real, INTENT(IN) :: scale_con ! scalefactor prim. concentration +real, INTENT(IN) :: scale_sec ! scalefactor sec. concentration +real, INTENT(IN) :: scale_subsec(nsubsec) ! scaling factor for sub-secondary species +real, INTENT(IN) :: scale_dep ! scalefactor deposition ! SUBROUTINE ARGUMENTS - I/O LOGICAL, INTENT(INOUT) :: idep ! deposition taken into account @@ -121,7 +121,7 @@ SUBROUTINE ops_print_grid (nrrcp, nsubsec, jump, project, icm, gasv, idep, isec, ! LOCAL VARIABLES INTEGER :: j ! counter through receptro points -REAL*4 :: tmp(nrrcp) ! tempory array with values to be written +real :: tmp(nrrcp) ! tempory array with values to be written INTEGER*4 :: isubsec ! index of sub-secondary species diff --git a/ops_print_info.f90 b/ops_print_info.f90 index f20eb39..1975f27 100644 --- a/ops_print_info.f90 +++ b/ops_print_info.f90 @@ -58,24 +58,24 @@ SUBROUTINE ops_print_info (project, gasv, isec, intpol, spgrid, z0_rcp, namco, n LOGICAL, INTENT(IN) :: isec ! true when comp=SO2,NOx,NH3 INTEGER*4, INTENT(IN) :: intpol ! INTEGER*4, INTENT(IN) :: spgrid ! code for type of receptor points -REAL*4, INTENT(IN) :: z0_rcp ! roughness length at receptor; from z0-map [m] +real, INTENT(IN) :: z0_rcp ! roughness length at receptor; from z0-map [m] CHARACTER*(*), INTENT(IN) :: namco ! substance name INTEGER*4, INTENT(IN) :: nbron ! number of emission sources (after selection) INTEGER*4, INTENT(IN) :: bnr(LSBUF) ! buffer with source numbers INTEGER*4, INTENT(IN) :: bx(LSBUF) ! buffer with x-coordinates INTEGER*4, INTENT(IN) :: by(LSBUF) ! buffer with y-coordinates -REAL*4, INTENT(IN) :: bsterkte(LSBUF) ! buffer with source strengths (industrial) -REAL*4, INTENT(IN) :: bqrv(LSBUF) ! buffer with source strengths (space heating) -REAL*4, INTENT(IN) :: bqtr(LSBUF) ! buffer with source strengths (traffic) -REAL*4, INTENT(IN) :: bwarmte(LSBUF) ! buffer with heat contents -REAL*4, INTENT(IN) :: bhoogte(LSBUF) ! buffer with source heights -REAL*4, INTENT(IN) :: bdiam(LSBUF) ! buffer with source diameters -REAL*4, INTENT(IN) :: bsigmaz(LSBUF) ! buffer with source heigth variances +real, INTENT(IN) :: bsterkte(LSBUF) ! buffer with source strengths (industrial) +real, INTENT(IN) :: bqrv(LSBUF) ! buffer with source strengths (space heating) +real, INTENT(IN) :: bqtr(LSBUF) ! buffer with source strengths (traffic) +real, INTENT(IN) :: bwarmte(LSBUF) ! buffer with heat contents +real, INTENT(IN) :: bhoogte(LSBUF) ! buffer with source heights +real, INTENT(IN) :: bdiam(LSBUF) ! buffer with source diameters +real, INTENT(IN) :: bsigmaz(LSBUF) ! buffer with source heigth variances INTEGER*4, INTENT(IN) :: btgedr(LSBUF) ! buffer with diurnal variation codes INTEGER*4, INTENT(IN) :: bdegr(LSBUF) ! buffer with particle size distribution codes INTEGER*4, INTENT(IN) :: bcatnr(LSBUF) ! buffer with category codes INTEGER*4, INTENT(IN) :: blandnr(LSBUF) ! buffer with area codes -REAL*4, INTENT(IN) :: emtrend ! emission correction factor +real, INTENT(IN) :: emtrend ! emission correction factor INTEGER*4, INTENT(IN) :: jb ! starting year of meteo INTEGER*4, INTENT(IN) :: mb ! starting month of meteo INTEGER*4, INTENT(IN) :: idb ! starting day of meteo @@ -86,7 +86,7 @@ SUBROUTINE ops_print_info (project, gasv, isec, intpol, spgrid, z0_rcp, namco, n LOGICAL*4, INTENT(IN) :: f_z0user ! true if z0 is user specified ! SUBROUTINE ARGUMENTS - I/O -REAL*4, INTENT(INOUT) :: emis(6,NLANDMAX) +real, INTENT(INOUT) :: emis(6,NLANDMAX) INTEGER*4, INTENT(INOUT) :: landmax ! number of countries in emission file ! SUBROUTINE ARGUMENTS - OUTPUT @@ -101,7 +101,7 @@ SUBROUTINE ops_print_info (project, gasv, isec, intpol, spgrid, z0_rcp, namco, n INTEGER*4 :: indx ! INTEGER*4 :: jndx ! INTEGER*4 :: statclass ! -REAL*4 :: qb ! emission of individual source +real :: qb ! emission of individual source CHARACTER*1 :: statcode ! CHARACTER*30 :: climper(0:6) ! diff --git a/ops_print_recep.f90 b/ops_print_recep.f90 index adaffd5..69c484e 100644 --- a/ops_print_recep.f90 +++ b/ops_print_recep.f90 @@ -65,47 +65,47 @@ SUBROUTINE ops_print_recep (project, gasv, idep, isec, igrid, verb, namco, namse CHARACTER*(*), INTENT(IN) :: namse3 ! CHARACTER*(*), INTENT(IN) :: coneh ! CHARACTER*(*), INTENT(IN) :: depeh ! -REAL*4, INTENT(IN) :: conc_cf ! -REAL*4, INTENT(IN) :: amol21 ! -REAL*4, INTENT(IN) :: ugmoldep ! +real, INTENT(IN) :: conc_cf +real, INTENT(IN) :: amol21 +real, INTENT(IN) :: ugmoldep INTEGER*4, INTENT(IN) :: nrrcp ! number of receptor points INTEGER*4, INTENT(IN) :: nsubsec ! number of sub-secondary species CHARACTER*(*), INTENT(IN) :: namrcp (nrrcp) ! -REAL*4, INTENT(IN) :: xm(nrrcp) ! -REAL*4, INTENT(IN) :: ym(nrrcp) ! -REAL*4, INTENT(IN) :: precip(nrrcp) ! calculated precipitation -REAL*4, INTENT(IN) :: cpri(nrrcp) ! primary concentration -REAL*4, INTENT(IN) :: csec(nrrcp) ! secondary concentration -REAL*4, INTENT(IN) :: drydep(nrrcp) ! dry deposition -REAL*4, INTENT(IN) :: ddepri(nrrcp) ! dry depo of primary comp. -REAL*4, INTENT(IN) :: wetdep(nrrcp) ! wet deposition -REAL*4, INTENT(IN) :: rno2_nox_sum(nrrcp) ! NO2/NOx ratio, weighed sum over classes +real, INTENT(IN) :: xm(nrrcp) +real, INTENT(IN) :: ym(nrrcp) +real, INTENT(IN) :: precip(nrrcp) ! calculated precipitation +real, INTENT(IN) :: cpri(nrrcp) ! primary concentration +real, INTENT(IN) :: csec(nrrcp) ! secondary concentration +real, INTENT(IN) :: drydep(nrrcp) ! dry deposition +real, INTENT(IN) :: ddepri(nrrcp) ! dry depo of primary comp. +real, INTENT(IN) :: wetdep(nrrcp) ! wet deposition +real, INTENT(IN) :: rno2_nox_sum(nrrcp) ! NO2/NOx ratio, weighed sum over classes INTEGER*4, INTENT(IN) :: lu_rcp_dom_all(nrrcp) ! -REAL*4, INTENT(IN) :: z0_rcp_all(nrrcp) ! roughness lengths for all receptors; from z0-map or receptor file [m] -REAL*4, INTENT(IN) :: gemcpri ! mean for prim. concentration -REAL*4, INTENT(IN) :: gemcsec ! mean for sec. concentration -REAL*4, INTENT(IN) :: ccr ! eff. chemical conversion rate -REAL*4, INTENT(IN) :: gemddep ! mean for dry deposition -REAL*4, INTENT(IN) :: gemddpri ! mean for dry deposition (pri) -REAL*4, INTENT(IN) :: gemddsec ! mean for dry deposition (sec) -REAL*4, INTENT(IN) :: ddrpri ! eff. dry deposition rate (prim) -REAL*4, INTENT(IN) :: ddrsec ! eff. dry deposition rate (sec) -REAL*4, INTENT(IN) :: gemwdep ! mean for wet deposition -REAL*4, INTENT(IN) :: gemwdpri ! mean for wet deposition (pri) -REAL*4, INTENT(IN) :: gemwdsec ! mean for wet deposition (sec) -REAL*4, INTENT(IN) :: wdrpri ! eff. wet deposition rate (prim) -REAL*4, INTENT(IN) :: wdrsec ! eff. wet deposition rate (sec) -REAL*4, INTENT(IN) :: gemprec ! mean annual precpitation from meteo -REAL*4, INTENT(IN) :: gemtdep ! mean for total deposition +real, INTENT(IN) :: z0_rcp_all(nrrcp) ! roughness lengths for all receptors; from z0-map or receptor file [m] +real, INTENT(IN) :: gemcpri ! mean for prim. concentration +real, INTENT(IN) :: gemcsec ! mean for sec. concentration +real, INTENT(IN) :: ccr ! eff. chemical conversion rate +real, INTENT(IN) :: gemddep ! mean for dry deposition +real, INTENT(IN) :: gemddpri ! mean for dry deposition (pri) +real, INTENT(IN) :: gemddsec ! mean for dry deposition (sec) +real, INTENT(IN) :: ddrpri ! eff. dry deposition rate (prim) +real, INTENT(IN) :: ddrsec ! eff. dry deposition rate (sec) +real, INTENT(IN) :: gemwdep ! mean for wet deposition +real, INTENT(IN) :: gemwdpri ! mean for wet deposition (pri) +real, INTENT(IN) :: gemwdsec ! mean for wet deposition (sec) +real, INTENT(IN) :: wdrpri ! eff. wet deposition rate (prim) +real, INTENT(IN) :: wdrsec ! eff. wet deposition rate (sec) +real, INTENT(IN) :: gemprec ! mean annual precpitation from meteo +real, INTENT(IN) :: gemtdep ! mean for total deposition INTEGER*4, INTENT(IN) :: icm ! number of component -REAL*4, INTENT(IN) :: csubsec(nrrcp,nsubsec) ! concentration of sub-secondary species [ug/m3] -REAL*4, INTENT(IN) :: gem_subsec(nsubsec) ! grid mean for concentration of sub-secondary species [ug/m3] +real, INTENT(IN) :: csubsec(nrrcp,nsubsec) ! concentration of sub-secondary species [ug/m3] +real, INTENT(IN) :: gem_subsec(nsubsec) ! grid mean for concentration of sub-secondary species [ug/m3] CHARACTER*(*), INTENT(IN) :: nam_subsec(nsubsec) ! names of sub-secondary speciea -REAL*4, INTENT(IN) :: totdep(nrrcp) ! total deposition -REAL*4, INTENT(IN) :: scale_con ! -REAL*4, INTENT(IN) :: scale_sec ! -REAL*4, INTENT(IN) :: scale_subsec(nsubsec) ! scaling factor for sub-secondary species -REAL*4, INTENT(IN) :: scale_dep ! +real, INTENT(IN) :: totdep(nrrcp) ! total deposition +real, INTENT(IN) :: scale_con +real, INTENT(IN) :: scale_sec +real, INTENT(IN) :: scale_subsec(nsubsec) ! scaling factor for sub-secondary species +real, INTENT(IN) :: scale_dep ! SUBROUTINE ARGUMENTS - I/O LOGICAL, INTENT(INOUT) :: idep ! @@ -118,13 +118,13 @@ SUBROUTINE ops_print_recep (project, gasv, idep, isec, igrid, verb, namco, namse INTEGER*4 :: i ! INTEGER*4 :: j ! INTEGER*4 :: isubsec ! index of sub-secondary species -REAL*4 :: scalec ! -REAL*4 :: scaled ! -REAL*4 :: scalen ! -REAL*4 :: scalsc ! -REAL*4 :: vdpri(nrrcp) ! -REAL*4 :: vdsec(nrrcp) ! -REAL*4 :: tmp(nrrcp) ! dry+wet deposition +real :: scalec +real :: scaled +real :: scalen +real :: scalsc +real :: vdpri(nrrcp) +real :: vdsec(nrrcp) +real :: tmp(nrrcp) ! dry+wet deposition CHARACTER*4 :: vdeh ! CHARACTER*4 :: z0eh ! CHARACTER*4 :: lueh ! diff --git a/ops_print_table.f90 b/ops_print_table.f90 index fd7f986..f756327 100644 --- a/ops_print_table.f90 +++ b/ops_print_table.f90 @@ -147,36 +147,36 @@ SUBROUTINE print_values (nrrcp, namrcp, xm, ym, error, par1, spar1, par2, sp ! SUBROUTINE ARGUMENTS - INPUT INTEGER*4, INTENT(IN) :: nrrcp ! CHARACTER*(*), INTENT(IN) :: namrcp(nrrcp) ! -REAL*4, INTENT(IN) :: xm(nrrcp) ! -REAL*4, INTENT(IN) :: ym(nrrcp) ! -REAL*4, INTENT(IN), OPTIONAL :: par1(nrrcp) ! values of parameter -REAL*4, INTENT(IN), OPTIONAL :: spar1 ! factor in parameter -REAL*4, INTENT(IN), OPTIONAL :: par2(nrrcp) ! values of parameter -REAL*4, INTENT(IN), OPTIONAL :: spar2 ! factor in parameter -REAL*4, INTENT(IN), OPTIONAL :: par3(nrrcp) ! values of parameter -REAL*4, INTENT(IN), OPTIONAL :: spar3 ! factor in parameter -REAL*4, INTENT(IN), OPTIONAL :: par4(nrrcp) ! values of parameter -REAL*4, INTENT(IN), OPTIONAL :: spar4 ! factor in parameter -REAL*4, INTENT(IN), OPTIONAL :: par5(nrrcp) ! values of parameter -REAL*4, INTENT(IN), OPTIONAL :: spar5 ! factor in parameter -REAL*4, INTENT(IN), OPTIONAL :: par6(nrrcp) ! values of parameter -REAL*4, INTENT(IN), OPTIONAL :: spar6 ! factor in parameter -REAL*4, INTENT(IN), OPTIONAL :: par7(nrrcp) ! values of parameter -REAL*4, INTENT(IN), OPTIONAL :: spar7 ! factor in parameter -REAL*4, INTENT(IN), OPTIONAL :: par8(nrrcp) ! values of parameter -REAL*4, INTENT(IN), OPTIONAL :: spar8 ! factor in parameter -REAL*4, INTENT(IN), OPTIONAL :: par9(nrrcp) ! values of parameter -REAL*4, INTENT(IN), OPTIONAL :: spar9 ! factor in parameter -REAL*4, INTENT(IN), OPTIONAL :: par10(nrrcp) ! values of parameter -REAL*4, INTENT(IN), OPTIONAL :: spar10 ! factor in parameter -REAL*4, INTENT(IN), OPTIONAL :: par11(nrrcp) ! values of parameter -REAL*4, INTENT(IN), OPTIONAL :: spar11 ! factor in parameter -REAL*4, INTENT(IN), OPTIONAL :: par12(nrrcp) ! values of parameter -REAL*4, INTENT(IN), OPTIONAL :: spar12 ! factor in parameter -REAL*4, INTENT(IN), OPTIONAL :: par13(nrrcp) ! values of parameter -REAL*4, INTENT(IN), OPTIONAL :: spar13 ! factor in parameter -REAL*4, INTENT(IN), OPTIONAL :: par14(nrrcp) ! values of parameter -REAL*4, INTENT(IN), OPTIONAL :: spar14 ! factor in parameter +real, INTENT(IN) :: xm(nrrcp) +real, INTENT(IN) :: ym(nrrcp) +real, INTENT(IN), OPTIONAL :: par1(nrrcp) ! values of parameter +real, INTENT(IN), OPTIONAL :: spar1 ! factor in parameter +real, INTENT(IN), OPTIONAL :: par2(nrrcp) ! values of parameter +real, INTENT(IN), OPTIONAL :: spar2 ! factor in parameter +real, INTENT(IN), OPTIONAL :: par3(nrrcp) ! values of parameter +real, INTENT(IN), OPTIONAL :: spar3 ! factor in parameter +real, INTENT(IN), OPTIONAL :: par4(nrrcp) ! values of parameter +real, INTENT(IN), OPTIONAL :: spar4 ! factor in parameter +real, INTENT(IN), OPTIONAL :: par5(nrrcp) ! values of parameter +real, INTENT(IN), OPTIONAL :: spar5 ! factor in parameter +real, INTENT(IN), OPTIONAL :: par6(nrrcp) ! values of parameter +real, INTENT(IN), OPTIONAL :: spar6 ! factor in parameter +real, INTENT(IN), OPTIONAL :: par7(nrrcp) ! values of parameter +real, INTENT(IN), OPTIONAL :: spar7 ! factor in parameter +real, INTENT(IN), OPTIONAL :: par8(nrrcp) ! values of parameter +real, INTENT(IN), OPTIONAL :: spar8 ! factor in parameter +real, INTENT(IN), OPTIONAL :: par9(nrrcp) ! values of parameter +real, INTENT(IN), OPTIONAL :: spar9 ! factor in parameter +real, INTENT(IN), OPTIONAL :: par10(nrrcp) ! values of parameter +real, INTENT(IN), OPTIONAL :: spar10 ! factor in parameter +real, INTENT(IN), OPTIONAL :: par11(nrrcp) ! values of parameter +real, INTENT(IN), OPTIONAL :: spar11 ! factor in parameter +real, INTENT(IN), OPTIONAL :: par12(nrrcp) ! values of parameter +real, INTENT(IN), OPTIONAL :: spar12 ! factor in parameter +real, INTENT(IN), OPTIONAL :: par13(nrrcp) ! values of parameter +real, INTENT(IN), OPTIONAL :: spar13 ! factor in parameter +real, INTENT(IN), OPTIONAL :: par14(nrrcp) ! values of parameter +real, INTENT(IN), OPTIONAL :: spar14 ! factor in parameter ! SUBROUTINE ARGUMENTS - I/O TYPE (TError), INTENT(INOUT) :: error ! should not happen as format string is long enough @@ -185,8 +185,8 @@ SUBROUTINE print_values (nrrcp, namrcp, xm, ym, error, par1, spar1, par2, sp INTEGER*4 :: i ! INTEGER*4 :: j ! INTEGER*4 :: values(nrparam) ! -REAL*4 :: factors(nrparam) ! -REAL*4 :: factorscopy(nrparam) ! +real :: factors(nrparam) +real :: factorscopy(nrparam) INTEGER*4 :: nrpresent ! INTEGER*4 :: nrunit ! LOGICAL :: dummybool ! @@ -299,11 +299,11 @@ LOGICAL FUNCTION has_rcp_values(spar, nrpresent, factors) PARAMETER (ROUTINENAAM = 'has_rcp_values') ! SUBROUTINE ARGUMENTS - INPUT -REAL*4, INTENT(IN), OPTIONAL :: spar ! factor in parameter +real, INTENT(IN), OPTIONAL :: spar ! factor in parameter ! SUBROUTINE ARGUMENTS - I/O INTEGER*4, INTENT(INOUT) :: nrpresent ! -REAL*4, INTENT(INOUT) :: factors(:) ! +real, INTENT(INOUT) :: factors(:) has_rcp_values = PRESENT(spar) IF (has_rcp_values) THEN @@ -325,8 +325,8 @@ LOGICAL FUNCTION set_rcp_values(formatpar, factors, nrpresent, index, values) PARAMETER (ROUTINENAAM = 'set_rcp_values') ! SUBROUTINE ARGUMENTS - INPUT -REAL*4, INTENT(IN) :: formatpar ! -REAL*4, INTENT(IN) :: factors(nrpresent) ! +real, INTENT(IN) :: formatpar +real, INTENT(IN) :: factors(nrpresent) INTEGER*4, INTENT(IN) :: nrpresent ! ! SUBROUTINE ARGUMENTS - I/O diff --git a/ops_rcp_char_1.f90 b/ops_rcp_char_1.f90 index 330e8b7..7798ba4 100644 --- a/ops_rcp_char_1.f90 +++ b/ops_rcp_char_1.f90 @@ -59,32 +59,32 @@ SUBROUTINE ops_rcp_char_1(isec, ircp, nrrcp, intpol, gxm_rcp, gym_rcp, cs, z0_me INTEGER*4, INTENT(IN) :: ircp INTEGER*4, INTENT(IN) :: nrrcp INTEGER*4, INTENT(IN) :: intpol ! -REAL*4, INTENT(IN) :: gxm_rcp ! array met x-coordinaat van receptorpunten (lola) -REAL*4, INTENT(IN) :: gym_rcp ! array met y-coordinaat van receptorpunten (lola) -REAL*4, INTENT(IN) :: cs(NTRAJ, NCOMP, NSTAB, NSEK, NMETREG) ! -REAL*4, INTENT(IN) :: z0_metreg(NMETREG) ! roughness lengths of NMETREG meteo regions; scale < 50 km [m] -REAL*4, INTENT(IN) :: xreg(NMETREG) ! array met x-coordinaat van meteo-regios -REAL*4, INTENT(IN) :: yreg(NMETREG) ! array met y-coordinaat van meteo-regio's -REAL*4, INTENT(IN) :: z0_metreg_user ! roughness length of user specified meteo region [m] +real, INTENT(IN) :: gxm_rcp ! array met x-coordinaat van receptorpunten (lola) +real, INTENT(IN) :: gym_rcp ! array met y-coordinaat van receptorpunten (lola) +real, INTENT(IN) :: cs(NTRAJ, NCOMP, NSTAB, NSEK, NMETREG) +real, INTENT(IN) :: z0_metreg(NMETREG) ! roughness lengths of NMETREG meteo regions; scale < 50 km [m] +real, INTENT(IN) :: xreg(NMETREG) ! array met x-coordinaat van meteo-regios +real, INTENT(IN) :: yreg(NMETREG) ! array met y-coordinaat van meteo-regio's +real, INTENT(IN) :: z0_metreg_user ! roughness length of user specified meteo region [m] INTEGER*4, INTENT(IN) :: spgrid -REAL*4, INTENT(IN) :: x_rcp ! array met x-coordinaat van receptorpunten (RDM) -REAL*4, INTENT(IN) :: y_rcp ! array met y-coordinaat van receptorpunten (RDM) +real, INTENT(IN) :: x_rcp ! array met x-coordinaat van receptorpunten (RDM) +real, INTENT(IN) :: y_rcp ! array met y-coordinaat van receptorpunten (RDM) TYPE (TApsGridInt), INTENT(IN) :: lugrid ! grid with land use information LOGICAL*4, INTENT(IN) :: domlu ! index of dominant land use class LOGICAL*4, INTENT(IN) :: perc ! INTEGER, INTENT(IN) :: lu_rcp_per_user_all(nrrcp,NLU) ! percentage of landuse for all receptors, used defined in receptor file INTEGER*4, INTENT(IN) :: lu_rcp_dom_all(nrrcp) ! land use at receptor points LOGICAL*4, INTENT(IN) :: f_z0user -REAL*4, INTENT(IN) :: z0_rcp_all(nrrcp) ! roughness lengths for all receptors; from z0-map or receptor file [m] +real, INTENT(IN) :: z0_rcp_all(nrrcp) ! roughness lengths for all receptors; from z0-map or receptor file [m] ! SUBROUTINE ARGUMENTS - I/O INTEGER*4, INTENT (INOUT) :: i1(NTRAJ-1) ! -REAL*4, INTENT(INOUT) :: astat(NTRAJ,NCOMP,NSTAB,NSEK) ! +real, INTENT(INOUT) :: astat(NTRAJ,NCOMP,NSTAB,NSEK) ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT) :: uurtot ! -REAL*4, INTENT(OUT) :: z0_metreg_rcp ! roughness length at receptor; interpolated from meteo regions [m] +real, INTENT(OUT) :: uurtot +real, INTENT(OUT) :: z0_metreg_rcp ! roughness length at receptor; interpolated from meteo regions [m] INTEGER*4, INTENT(OUT) :: lu_rcp_dom ! dominant landuse class for receptor -REAL*4, INTENT(OUT) :: lu_rcp_per(NLU) ! percentages of landuse classes at receptor points -REAL*4, INTENT(OUT) :: z0_rcp ! roughness length at receptor; from z0-map [m] +real, INTENT(OUT) :: lu_rcp_per(NLU) ! percentages of landuse classes at receptor points +real, INTENT(OUT) :: z0_rcp ! roughness length at receptor; from z0-map [m] TYPE (TError) :: error ! LOCAL VARIABLES @@ -201,20 +201,20 @@ SUBROUTINE reginpo(x, y, cs, z0_metreg, xreg, yreg, i1, z0_metreg_xy, uurtot, as ! frequency of occurrence ! SUBROUTINE ARGUMENTS - INPUT -REAL*4, INTENT(IN) :: x ! x-coordinate (longitude; degrees) -REAL*4, INTENT(IN) :: y ! y-coordinate (latitude; degrees) -REAL*4, INTENT(IN) :: cs(NTRAJ, NCOMP, NSTAB, NSEK, NMETREG) ! -REAL*4, INTENT(IN) :: z0_metreg(NMETREG) ! roughness lengths of NMETREG meteo regions; scale < 50 km [m] -REAL*4, INTENT(IN) :: xreg(NMETREG) ! x-coordinate region centre (longitude; degrees) -REAL*4, INTENT(IN) :: yreg(NMETREG) ! y-coordinate region centre (latitude; degrees) +real, INTENT(IN) :: x ! x-coordinate (longitude; degrees) +real, INTENT(IN) :: y ! y-coordinate (latitude; degrees) +real, INTENT(IN) :: cs(NTRAJ, NCOMP, NSTAB, NSEK, NMETREG) +real, INTENT(IN) :: z0_metreg(NMETREG) ! roughness lengths of NMETREG meteo regions; scale < 50 km [m] +real, INTENT(IN) :: xreg(NMETREG) ! x-coordinate region centre (longitude; degrees) +real, INTENT(IN) :: yreg(NMETREG) ! y-coordinate region centre (latitude; degrees) ! SUBROUTINE ARGUMENTS - I/O INTEGER*4, INTENT(INOUT) :: i1(NTRAJ-1) ! indices of three regions nearest to the receptor ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT) :: z0_metreg_xy ! roughness length at (x,y), interpolated from meteo regions [m] -REAL*4, INTENT(OUT) :: uurtot ! -REAL*4, INTENT(OUT) :: astat(NTRAJ, NCOMP, NSTAB, NSEK) ! +real, INTENT(OUT) :: z0_metreg_xy ! roughness length at (x,y), interpolated from meteo regions [m] +real, INTENT(OUT) :: uurtot +real, INTENT(OUT) :: astat(NTRAJ, NCOMP, NSTAB, NSEK) TYPE (TError), INTENT(OUT) :: error ! error handling record ! LOCAL VARIABLES @@ -224,18 +224,18 @@ SUBROUTINE reginpo(x, y, cs, z0_metreg, xreg, yreg, i1, z0_metreg_xy, uurtot, as INTEGER*4 :: imin ! index of nearest region INTEGER*4 :: itraj ! index of distance class INTEGER*4 :: isek ! index of wind sector -REAL*4 :: a ! Set a = cos(y); needed in computation of distance +real :: a ! Set a = cos(y); needed in computation of distance ! dx = (x2 - x1)*cos(y) for geographical coordinates -REAL*4 :: r ! distance region - receptor -REAL*4 :: rmin ! distance nearest region - receptor -REAL*4 :: s ! sum of s1() -REAL*4 :: ss ! -REAL*4 :: rr ! -REAL*4 :: rrtot ! -REAL*4 :: r1(NTRAJ-1) ! distance of three nearest regions - receptor -REAL*4 :: s1(NTRAJ-1) ! inverse distance = 1/r1() -REAL*4 :: ss1(NTRAJ-1) ! +real :: r ! distance region - receptor +real :: rmin ! distance nearest region - receptor +real :: s ! sum of s1() +real :: ss +real :: rr +real :: rrtot +real :: r1(NTRAJ-1) ! distance of three nearest regions - receptor +real :: s1(NTRAJ-1) ! inverse distance = 1/r1() +real :: ss1(NTRAJ-1) ! DATA ! 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 diff --git a/ops_rcp_char_all.f90 b/ops_rcp_char_all.f90 index 198dd78..8ecf48a 100644 --- a/ops_rcp_char_all.f90 +++ b/ops_rcp_char_all.f90 @@ -59,10 +59,10 @@ subroutine ops_rcp_char_all(icm, iopt_vchem, isec, nsubsec, xm, ym, f_z0user, z0 INTEGER*4, INTENT(IN) :: iopt_vchem ! option for chemical conversion rate (0 = old OPS, 1 = EMEP) LOGICAL*4, INTENT(IN) :: isec INTEGER*4, INTENT(IN) :: nsubsec ! number of sub-secondary species -REAL*4, INTENT(IN) :: xm(nrrcp) ! x-coordinates of receptors -REAL*4, INTENT(IN) :: ym(nrrcp) ! y-coordinates of receptors +real, INTENT(IN) :: xm(nrrcp) ! x-coordinates of receptors +real, INTENT(IN) :: ym(nrrcp) ! y-coordinates of receptors LOGICAL*4, INTENT(IN) :: f_z0user -REAL*4, INTENT(IN) :: z0_user ! roughness length specified by user [m] +real, INTENT(IN) :: z0_user ! roughness length specified by user [m] TYPE (TApsGridInt), INTENT(IN) :: z0nlgrid ! map of roughness lengths in NL [m] TYPE (TApsGridInt), INTENT(IN) :: z0eurgrid ! map of roughness lengths in Europe [m] TYPE (TApsGridInt), INTENT(IN) :: lugrid ! grid with land use information @@ -73,12 +73,12 @@ subroutine ops_rcp_char_all(icm, iopt_vchem, isec, nsubsec, xm, ym, f_z0user, z0 LOGICAL*4, INTENT(IN) :: domlu ! index of dominant land use class ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT) :: gxm(nrrcp) -REAL*4, INTENT(OUT) :: gym(nrrcp) -REAL*4, INTENT(OUT) :: rhno3_rcp(nrrcp) -REAL*4, INTENT(OUT) :: nh3bg_rcp(nrrcp) -REAL*4, INTENT(OUT) :: so2bg_rcp(nrrcp) -REAL*4, INTENT(OUT) :: f_subsec_rcp(nrrcp,nsubsec) ! fractions for sub-secondary species, HNO3/NO3_total, NO3_C/NO3_total, NO3_F/NO3_total [-] +real, INTENT(OUT) :: gxm(nrrcp) +real, INTENT(OUT) :: gym(nrrcp) +real, INTENT(OUT) :: rhno3_rcp(nrrcp) +real, INTENT(OUT) :: nh3bg_rcp(nrrcp) +real, INTENT(OUT) :: so2bg_rcp(nrrcp) +real, INTENT(OUT) :: f_subsec_rcp(nrrcp,nsubsec) ! fractions for sub-secondary species, HNO3/NO3_total, NO3_C/NO3_total, NO3_F/NO3_total [-] ! SUBROUTINE ARGUMENTS - OUTPUT INTEGER*4 :: landuse(NLU+1) ! land-use value at receptor @@ -86,14 +86,14 @@ subroutine ops_rcp_char_all(icm, iopt_vchem, isec, nsubsec, xm, ym, f_z0user, z0 ! landuse(lu+1) = percentage of grid cell with landuse class lu, lu = 1,NLU ! For locations outside lugrid, a default land use class = 1 (grass) is taken. INTEGER*4, INTENT(INOUT) :: lu_rcp_dom_all(nrrcp) ! index of dominant land use for all receptor points -REAL*4, INTENT(INOUT) :: z0_rcp_all(nrrcp) ! roughness lengths for all receptors; from z0-map or receptor file [m] +real, INTENT(INOUT) :: z0_rcp_all(nrrcp) ! roughness lengths for all receptors; from z0-map or receptor file [m] TYPE (TError), INTENT(INOUT) :: error ! LOCAL VARIABLES INTEGER*4 :: ircp ! index of receptor INTEGER*4 :: isubsec ! index of sub-secondary species -REAL*4 :: so2bgconc ! background concentratie SO2 -REAL*4 :: nh3bgconc ! background concentration NH3 at receptor [ppb] +real :: so2bgconc ! background concentratie SO2 +real :: nh3bgconc ! background concentration NH3 at receptor [ppb] LOGICAL :: z0found INTEGER :: ifield ! field index in f_subsec_grid diff --git a/ops_read_bg.f90 b/ops_read_bg.f90 index 136dc38..aa0fac1 100644 --- a/ops_read_bg.f90 +++ b/ops_read_bg.f90 @@ -73,12 +73,12 @@ SUBROUTINE ops_read_bg(icm, iopt_vchem, nsubsec, year, so2bggrid, no2bggrid, nh3 INTEGER*4 :: mapnumber ! number of background map INTEGER*4 :: ji ! year index, i.e. the index in the trendfactor ! arrays tf_... of the current year -REAL*4 :: factor ! combined correction factor (calibration with +real :: factor ! combined correction factor (calibration with ! measurements and correction for year) LOGICAL*1 :: future ! TRUE if year is closer to FUTUREYEAR than to last ! historic year -REAL*4 :: nox_threshold ! threshold value for NOx in log-function in NOx -> NO2 conversion -REAL*4 :: alpha ! slope of linear function NOx -> NO2 conversion +real :: nox_threshold ! threshold value for NOx in log-function in NOx -> NO2 conversion +real :: alpha ! slope of linear function NOx -> NO2 conversion INTEGER :: i1 ! index of yyyy in filename CHARACTER*128 :: fnam ! filename TYPE (TApsGridReal) :: qq ! test grid output @@ -305,20 +305,20 @@ SUBROUTINE ops_read_bg(icm, iopt_vchem, nsubsec, year, so2bggrid, no2bggrid, nh3 ! ! character*10 modversie ! ! character*12 kname ! ! character*(*) namegr ! name of grid file (used for error message) - ! ! + ! ! ! character*12 quantity ! !subroutine saveaps(coord_sys,lu,namegr,xorg,yorg,gridx,gridy,matx,maty,cpri,namco,unit_conc,modversie,kname,quantity,ijg,img,idg,iug) ! call saveaps('RDM',34,'qq0',qq%gridheader%xorgl,qq%gridheader%yorgl,qq%gridheader%grixl,qq%gridheader%griyl,qq%gridheader%nrcol,qq%gridheader%nrrow,qq%value(:,:,1),'conv_rate ','%/h ','OPS_tst ','qq1 ','qq2 ',10,0,0,0) ! close(34) ! !! TYPE TGridHeader - ! !! REAL*4 :: xorgl ! x-origin of the grid [km] + ! !! real :: xorgl ! x-origin of the grid [km] ! !! ! (origin is left-upper corner of grid) - ! !! REAL*4 :: yorgl ! y-origin of the grid [km] + ! !! real :: yorgl ! y-origin of the grid [km] ! !! ! (origin is left-upper corner of grid) ! !! INTEGER*4 :: nrcol ! number of grid columns ! !! INTEGER*4 :: nrrow ! number of grid rows - ! !! REAL*4 :: grixl ! horizontal size of grid cell [km] - ! !! REAL*4 :: griyl ! vertical size of grid cell [km] + ! !! real :: grixl ! horizontal size of grid cell [km] + ! !! real :: griyl ! vertical size of grid cell [km] ! !! END TYPE TGridHeader ! ! END TEST write to APS file -------------------------------------------------------------------------------------------- diff --git a/ops_read_ctr.f90 b/ops_read_ctr.f90 index b801ee9..e5347dc 100644 --- a/ops_read_ctr.f90 +++ b/ops_read_ctr.f90 @@ -58,31 +58,31 @@ SUBROUTINE ops_read_ctr(project, runid, year, icm, namco, amol1, gasv, idep, kde INTEGER*4, INTENT(OUT) :: year ! year under consideration INTEGER*4, INTENT(OUT) :: icm CHARACTER*(*), INTENT(OUT) :: namco -REAL*4, INTENT(OUT) :: amol1 +real, INTENT(OUT) :: amol1 LOGICAL, INTENT(OUT) :: gasv ! type of component (0: particle; 1: gas) LOGICAL, INTENT(OUT) :: idep INTEGER*4, INTENT(OUT) :: kdeppar -REAL*4, INTENT(OUT) :: ddeppar +real, INTENT(OUT) :: ddeppar INTEGER*4, INTENT(OUT) :: knatdeppar -REAL*4, INTENT(OUT) :: wdeppar -REAL*4, INTENT(OUT) :: dg +real, INTENT(OUT) :: wdeppar +real, INTENT(OUT) :: dg LOGICAL, INTENT(OUT) :: irev -REAL*4, INTENT(OUT) :: vchemc ! chemical conversion rate [%/h] +real, INTENT(OUT) :: vchemc ! chemical conversion rate [%/h] INTEGER*4, INTENT(OUT) :: iopt_vchem ! option for chemical conversion rate (0 = old OPS, 1 = EMEP) -REAL*4, INTENT(OUT) :: vchemv -REAL*4, INTENT(OUT) :: emtrend +real, INTENT(OUT) :: vchemv +real, INTENT(OUT) :: emtrend INTEGER*4, INTENT(OUT) :: ncatsel INTEGER*4, INTENT(OUT) :: catsel(*) INTEGER*4, INTENT(OUT) :: nlandsel INTEGER*4, INTENT(OUT) :: landsel(*) INTEGER*4, INTENT(OUT) :: spgrid -REAL*4, INTENT(OUT) :: xc ! x-coordinate grid centre of user specified grid (spgrid = 1) -REAL*4, INTENT(OUT) :: yc ! y-coordinate grid centre of user specified grid (spgrid = 1) +real, INTENT(OUT) :: xc ! x-coordinate grid centre of user specified grid (spgrid = 1) +real, INTENT(OUT) :: yc ! y-coordinate grid centre of user specified grid (spgrid = 1) INTEGER*4, INTENT(OUT) :: nrcol INTEGER*4, INTENT(OUT) :: nrrow -REAL*4, INTENT(OUT) :: grid ! grid resolution [m] +real, INTENT(OUT) :: grid ! grid resolution [m] LOGICAL, INTENT(OUT) :: igrens -REAL*4, INTENT(OUT) :: z0_user ! roughness length specified by user [m] +real, INTENT(OUT) :: z0_user ! roughness length specified by user [m] INTEGER*4, INTENT(OUT) :: intpol INTEGER*4, INTENT(OUT) :: ideh LOGICAL, INTENT(OUT) :: igrid @@ -93,8 +93,8 @@ SUBROUTINE ops_read_ctr(project, runid, year, icm, namco, amol1, gasv, idep, kde TYPE (TError), INTENT(OUT) :: error ! error handling record ! LOCAL VARIABLES -REAL*4 :: lower ! lower limit (is used for checking variables read) -REAL*4 :: upper ! upper limit (is used for checking variables read) +real :: lower ! lower limit (is used for checking variables read) +real :: upper ! upper limit (is used for checking variables read) CHARACTER*(512) :: str1 ! string value read from control file ! SCCS-ID VARIABLES diff --git a/ops_read_emis.f90 b/ops_read_emis.f90 index da95dad..944b4b4 100644 --- a/ops_read_emis.f90 +++ b/ops_read_emis.f90 @@ -70,10 +70,10 @@ SUBROUTINE ops_read_emis(icm, gasv, ncatsel, catsel, nlandsel, landsel, numbron, ! SUBROUTINE ARGUMENTS - OUTPUT INTEGER*4, INTENT(OUT) :: numbron ! number of selected sources -REAL*4, INTENT(OUT) :: dverl(NHRBLOCKS,MAXDISTR) ! standard diurnal emission variations distributions -REAL*4, INTENT(OUT) :: usdverl(NHRBLOCKS,MAXDISTR)! user-defined diurnal emission variations distributions -REAL*4, INTENT(OUT) :: pmd(NPARTCLASS,MAXDISTR) ! standard particle size distributions -REAL*4, INTENT(OUT) :: uspmd(NPARTCLASS,MAXDISTR) ! user-defined particle size distributions +real, INTENT(OUT) :: dverl(NHRBLOCKS,MAXDISTR) ! standard diurnal emission variations distributions +real, INTENT(OUT) :: usdverl(NHRBLOCKS,MAXDISTR)! user-defined diurnal emission variations distributions +real, INTENT(OUT) :: pmd(NPARTCLASS,MAXDISTR) ! standard particle size distributions +real, INTENT(OUT) :: uspmd(NPARTCLASS,MAXDISTR) ! user-defined particle size distributions INTEGER*4, INTENT(OUT) :: dv ! maximum code diurnal emission variation dverl INTEGER*4, INTENT(OUT) :: usdv ! maximum code user specified diurnal emission variation usdverl LOGICAL, INTENT(OUT) :: presentcode(MAXDISTR,4) ! which distribution codes are present @@ -185,13 +185,13 @@ SUBROUTINE read_variation(distnam, fmt, nrclass, normalvalue, compdesc, fraction LOGICAL, INTENT(IN) :: fraction ! whether conversion to fractions is required (instead of %) ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT) :: distrib(nrclass,MAXDISTR) ! array with all distributions +real, INTENT(OUT) :: distrib(nrclass,MAXDISTR) ! array with all distributions INTEGER*4, INTENT(OUT) :: maxcode ! maximum code used for distribution LOGICAL, INTENT(OUT) :: presentcode(MAXDISTR) ! which distribution codes are present TYPE (TError), INTENT(OUT) :: error ! error handling record ! LOCAL VARIABLES -INTEGER*4 :: distcode ! code used for distribution; +INTEGER*4 :: distcode ! code used for distribution; ! read from the first column of the distributions file. ! (|distcode| = index into 2nd dimension of distrib(nclass, MAXDISTR)) @@ -199,9 +199,9 @@ SUBROUTINE read_variation(distnam, fmt, nrclass, normalvalue, compdesc, fraction INTEGER*4 :: i ! DO LOOP counter INTEGER*4 :: numdist ! Number of distributions read INTEGER*4 :: ierr ! value of IOSTAT -REAL*4 :: buffer(nrclass) ! array with the last distrib values read -REAL*4 :: som ! sum of row values -REAL*4 :: normalfactor ! normalisation factor +real :: buffer(nrclass) ! array with the last distrib values read +real :: som ! sum of row values +real :: normalfactor ! normalisation factor CHARACTER*80 :: readformat ! format used for reading LOGICAL :: ops_openlog ! function for opening log file diff --git a/ops_read_meteo.f90 b/ops_read_meteo.f90 index 5994f3d..a0a1ae0 100644 --- a/ops_read_meteo.f90 +++ b/ops_read_meteo.f90 @@ -64,28 +64,28 @@ SUBROUTINE ops_read_meteo(intpol, jb, mb, idb, jt, mt, idt, uurtot, iseiz, zf, a INTEGER*4, INTENT(OUT) :: jt INTEGER*4, INTENT(OUT) :: mt INTEGER*4, INTENT(OUT) :: idt -REAL*4, INTENT(OUT) :: uurtot +real, INTENT(OUT) :: uurtot INTEGER*4, INTENT(OUT) :: iseiz -REAL*4, INTENT(OUT) :: zf -REAL*4, INTENT(OUT) :: astat(NTRAJ, NCOMP, NSTAB, NSEK) -REAL*4, INTENT(OUT) :: trafst(NTRAJ) -REAL*4, INTENT(OUT) :: gemre -REAL*4, INTENT(OUT) :: z0_metreg_user ! roughness length of user specified meteo region [m] -REAL*4, INTENT(OUT) :: cs(NTRAJ, NCOMP, NSTAB, NSEK, NMETREG) -REAL*4, INTENT(OUT) :: rainreg(NMETREG) -REAL*4, INTENT(OUT) :: z0_metreg(NMETREG) ! roughness lengths of NMETREG meteo regions; scale < 50 km [m] -REAL*4, INTENT(OUT) :: xreg(NMETREG) -REAL*4, INTENT(OUT) :: yreg(NMETREG) -REAL*4, INTENT(OUT) :: hourreg(NMETREG) +real, INTENT(OUT) :: zf +real, INTENT(OUT) :: astat(NTRAJ, NCOMP, NSTAB, NSEK) +real, INTENT(OUT) :: trafst(NTRAJ) +real, INTENT(OUT) :: gemre +real, INTENT(OUT) :: z0_metreg_user ! roughness length of user specified meteo region [m] +real, INTENT(OUT) :: cs(NTRAJ, NCOMP, NSTAB, NSEK, NMETREG) +real, INTENT(OUT) :: rainreg(NMETREG) +real, INTENT(OUT) :: z0_metreg(NMETREG) ! roughness lengths of NMETREG meteo regions; scale < 50 km [m] +real, INTENT(OUT) :: xreg(NMETREG) +real, INTENT(OUT) :: yreg(NMETREG) +real, INTENT(OUT) :: hourreg(NMETREG) TYPE (TError), INTENT(OUT) :: error ! error handling record ! LOCAL VARIABLES INTEGER*4 :: iyr ! year of time stamp of meteo file; currently not used INTEGER*4 :: imon ! month of time stamp of meteo file; currently not used INTEGER*4 :: iday ! day of time stamp of meteo file; currently not used -REAL*4 :: xpos -REAL*4 :: ypos -REAL*4 :: z0_metreg1 ! rougness length of 1 meteo region [m] +real :: xpos +real :: ypos +real :: z0_metreg1 ! rougness length of 1 meteo region [m] ! SCCS-ID VARIABLES CHARACTER*81 :: sccsida ! @@ -131,8 +131,8 @@ SUBROUTINE ops_statfil(jb, mb, idb, jt, mt, idt, uurtot, iseiz, zf, astat, trafs IMPLICIT NONE ! CONSTANTS -REAL*4 :: XP(NMETREG) ! x-coordinate meteo regions in NL -REAL*4 :: YP(NMETREG) ! y-coordinate meteo regions in NL +real :: XP(NMETREG) ! x-coordinate meteo regions in NL +real :: YP(NMETREG) ! y-coordinate meteo regions in NL ! (XP,YP)~ centre of circle that encompasses a meteo region. ! (XP,YP) are used for interpolation of meteo parameters in a ! specific location @@ -146,17 +146,17 @@ SUBROUTINE ops_statfil(jb, mb, idb, jt, mt, idt, uurtot, iseiz, zf, astat, trafs INTEGER*4, INTENT(OUT) :: jt INTEGER*4, INTENT(OUT) :: mt INTEGER*4, INTENT(OUT) :: idt -REAL*4, INTENT(OUT) :: uurtot +real, INTENT(OUT) :: uurtot INTEGER*4, INTENT(OUT) :: iseiz -REAL*4, INTENT(OUT) :: zf -REAL*4, INTENT(OUT) :: astat(NTRAJ, NCOMP, NSTAB, NSEK) -REAL*4, INTENT(OUT) :: trafst(NTRAJ) -REAL*4, INTENT(OUT) :: cs(NTRAJ, NCOMP, NSTAB, NSEK, NMETREG) -REAL*4, INTENT(OUT) :: rainreg(NMETREG) -REAL*4, INTENT(OUT) :: z0_metreg(NMETREG) ! roughness lengths of NMETREG meteo regions; scale < 50 km [m] -REAL*4, INTENT(OUT) :: xreg(NMETREG) -REAL*4, INTENT(OUT) :: yreg(NMETREG) -REAL*4, INTENT(OUT) :: hourreg(NMETREG) +real, INTENT(OUT) :: zf +real, INTENT(OUT) :: astat(NTRAJ, NCOMP, NSTAB, NSEK) +real, INTENT(OUT) :: trafst(NTRAJ) +real, INTENT(OUT) :: cs(NTRAJ, NCOMP, NSTAB, NSEK, NMETREG) +real, INTENT(OUT) :: rainreg(NMETREG) +real, INTENT(OUT) :: z0_metreg(NMETREG) ! roughness lengths of NMETREG meteo regions; scale < 50 km [m] +real, INTENT(OUT) :: xreg(NMETREG) +real, INTENT(OUT) :: yreg(NMETREG) +real, INTENT(OUT) :: hourreg(NMETREG) TYPE (TError), INTENT(OUT) :: error ! error handling record ! LOCAL VARIABLES @@ -165,10 +165,10 @@ SUBROUTINE ops_statfil(jb, mb, idb, jt, mt, idt, uurtot, iseiz, zf, astat, trafs INTEGER*4 :: imon ! month of time stamp of meteo file; currently not used INTEGER*4 :: iyr ! year of time stamp of meteo file; currently not used INTEGER :: idx ! index of '.' in name of meteo statistics file -REAL*4 :: gemre ! average amount of precipitation (mm/h) -REAL*4 :: xpos -REAL*4 :: ypos -REAL*4 :: z0_metreg1 ! roughness length of 1 meteo region [m] +real :: gemre ! average amount of precipitation (mm/h) +real :: xpos +real :: ypos +real :: z0_metreg1 ! roughness length of 1 meteo region [m] CHARACTER*512 :: nfile ! filename for meteo statistics file ! DATA @@ -259,21 +259,21 @@ SUBROUTINE ops_readstexp(nfile, jb, mb, idb, gemre, iyr, imon, iday, xpos, ypos, INTEGER*4, INTENT(OUT) :: jb ! start year (meteo statistics period) ("b" << begin = start) INTEGER*4, INTENT(OUT) :: mb ! start month (meteo statistics period) ("b" << begin = start) INTEGER*4, INTENT(OUT) :: idb ! start day (meteo statistics period) ("b" << begin = start) -REAL*4, INTENT(OUT) :: gemre ! average precipitation amount [mm/h] +real, INTENT(OUT) :: gemre ! average precipitation amount [mm/h] INTEGER*4, INTENT(OUT) :: iyr ! year of time stamp of meteo file; currently not used INTEGER*4, INTENT(OUT) :: imon ! month of time stamp of meteo file; currently not used INTEGER*4, INTENT(OUT) :: iday ! day of time stamp of meteo file; currently not used -REAL*4, INTENT(OUT) :: xpos -REAL*4, INTENT(OUT) :: ypos -REAL*4, INTENT(OUT) :: z0_metreg1 ! rougness length of 1 meteo region [m] +real, INTENT(OUT) :: xpos +real, INTENT(OUT) :: ypos +real, INTENT(OUT) :: z0_metreg1 ! rougness length of 1 meteo region [m] INTEGER*4, INTENT(OUT) :: jt ! end year (meteo statistics period) ("t" << tot = until) INTEGER*4, INTENT(OUT) :: mt ! end month (meteo statistics period) ("t" << tot = until) INTEGER*4, INTENT(OUT) :: idt ! end day (meteo statistics period) ("t" << tot = until) -REAL*4, INTENT(OUT) :: uurtot ! total number of hours ("uur" = hour) +real, INTENT(OUT) :: uurtot ! total number of hours ("uur" = hour) INTEGER*4, INTENT(OUT) :: iseiz -REAL*4, INTENT(OUT) :: zf -REAL*4, INTENT(OUT) :: astat(NTRAJ, NCOMP, NSTAB, NSEK) -REAL*4, INTENT(OUT) :: trafst(NTRAJ) +real, INTENT(OUT) :: zf +real, INTENT(OUT) :: astat(NTRAJ, NCOMP, NSTAB, NSEK) +real, INTENT(OUT) :: trafst(NTRAJ) TYPE (TError), INTENT(OUT) :: error ! error handling record ! LOCAL VARIABLES @@ -438,7 +438,7 @@ SUBROUTINE ops_readdata(nfile, ishort, astat, error) ! SUBROUTINE ARGUMENTS - OUTPUT INTEGER*2, INTENT(OUT) :: ishort(NSTAB*NSEK) ! meta data of meteo statistics file -REAL*4, INTENT(OUT) :: astat(NTRAJ, NCOMP, NSTAB, NSEK) +real, INTENT(OUT) :: astat(NTRAJ, NCOMP, NSTAB, NSEK) TYPE (TError), INTENT(OUT) :: error ! error handling record ! LOCAL VARIABLES diff --git a/ops_read_source.f90 b/ops_read_source.f90 index cbcea4c..8d06b78 100644 --- a/ops_read_source.f90 +++ b/ops_read_source.f90 @@ -85,13 +85,13 @@ SUBROUTINE ops_read_source(icm, gasv, ncatsel, catsel, nlandsel, landsel, presen INTEGER*4 :: ierr ! error value LOGICAL*4 :: end_of_file ! end of file has been reached INTEGER*4 :: brn_version ! version of emission file -REAL*4 :: qob ! emission strength read from emission record [g/s] -REAL*4 :: qww ! heat content read from emission record [MW] -REAL*4 :: hbron ! emission height read from emission record [m] -REAL*4 :: diameter ! diameter area source read from emission record (NOT stack diameter) [m] -REAL*4 :: szopp ! deviation emission height for area source = initial sigma_z [m] -REAL*4 :: x ! x coordinate of source location (RDM [m]) -REAL*4 :: y ! y coordinate of source location (RDM [m]) +real :: qob ! emission strength read from emission record [g/s] +real :: qww ! heat content read from emission record [MW] +real :: hbron ! emission height read from emission record [m] +real :: diameter ! diameter area source read from emission record (NOT stack diameter) [m] +real :: szopp ! deviation emission height for area source = initial sigma_z [m] +real :: x ! x coordinate of source location (RDM [m]) +real :: y ! y coordinate of source location (RDM [m]) LOGICAL :: country_selected ! emission country has been selected LOGICAL :: category_selected ! emission category has been selected LOGICAL :: VsDs_opt ! read stack parameters Ds/Vs/Ts from source file diff --git a/ops_reken.f90 b/ops_reken.f90 index 924b375..65c1ceb 100644 --- a/ops_reken.f90 +++ b/ops_reken.f90 @@ -82,60 +82,60 @@ SUBROUTINE ops_reken(idep, isec, icm, gasv, intpol, vchemc, iopt_vchem, vchemv, ! 0 interpolate between all meteo regions at specified location ! 1 use meteo parameters from user specified meteo region ! 2? use meteo parameters from user specified meteo file -REAL*4, INTENT(IN) :: vchemc ! chemical conversion rate, independent of light [%/h] +real, INTENT(IN) :: vchemc ! chemical conversion rate, independent of light [%/h] INTEGER*4, INTENT(IN) :: iopt_vchem ! option for chemical conversion rate (0 = old OPS, 1 = EMEP) -REAL*4, INTENT(IN) :: vchemv ! chemical conversion rate, dependent on light [%/h] +real, INTENT(IN) :: vchemv ! chemical conversion rate, dependent on light [%/h] INTEGER*4, INTENT(IN) :: dv ! maximum code diurnal emission variation dverl -REAL*4, INTENT(IN) :: amol1 ! molar mass primary component [g/mol] -REAL*4, INTENT(IN) :: amol2 ! molar mass secondary component [g/mol] -REAL*4, INTENT(IN) :: amol21 ! (molar mass secondary component)/(molar mass primary component) [-] -REAL*4, INTENT(IN) :: ar ! proportionality constant in relation [OH] = ar Qr, with Qr = global radiation in W/m2 [(cm3 m2)/(molec W2)], see Egmond en Kesseboom (1983) -REAL*4, INTENT(IN) :: rno2nox ! season dependent component of [NO2]/[NOx] ratio [-] -REAL*4, INTENT(IN) :: ecvl(NSTAB, NTRAJ, *) ! average diurnal emission variation for each stability/distance class +real, INTENT(IN) :: amol1 ! molar mass primary component [g/mol] +real, INTENT(IN) :: amol2 ! molar mass secondary component [g/mol] +real, INTENT(IN) :: amol21 ! (molar mass secondary component)/(molar mass primary component) [-] +real, INTENT(IN) :: ar ! proportionality constant in relation [OH] = ar Qr, with Qr = global radiation in W/m2 [(cm3 m2)/(molec W2)], see Egmond en Kesseboom (1983) +real, INTENT(IN) :: rno2nox ! season dependent component of [NO2]/[NOx] ratio [-] +real, INTENT(IN) :: ecvl(NSTAB, NTRAJ, *) ! average diurnal emission variation for each stability/distance class INTEGER*4, INTENT(IN) :: iseiz ! season index (0=long term; 1=year; 2=winter; 3=summer; 4=month in winter; 5=month in summer) -REAL*4, INTENT(IN) :: zf ! interpolation factor between summer and winter (zf << "zomer fractie" = summer fraction) -REAL*4, INTENT(IN) :: trafst(NTRAJ) ! travel distances for each distance class [m] +real, INTENT(IN) :: zf ! interpolation factor between summer and winter (zf << "zomer fractie" = summer fraction) +real, INTENT(IN) :: trafst(NTRAJ) ! travel distances for each distance class [m] INTEGER*4, INTENT(IN) :: knatdeppar ! choice for parameterisation wet deposition ! knatdeppar = 1: read wdeppar = scavenging coefficient [%/h] ! knatdeppar = 2: read wdeppar = scavenging ratio, i.e. average ratio if rainwater concentrations and air concentration [-] ! knatdeppar = 3: if secondary components are present [SO2, NO2, NH3]. Wash-out and rain-out parameters are fixed in the OPS code (ops_init) [-] INTEGER*4, INTENT(IN) :: mb ! start month of meteo statistics period ("b" << begin = start) -REAL*4, INTENT(IN) :: ugmoldep ! conversion factor from ug/m2/h to each of the deposition units in DEPUNITS -REAL*4, INTENT(IN) :: dg ! diffusion coefficient in air [cm^2/s] +real, INTENT(IN) :: ugmoldep ! conversion factor from ug/m2/h to each of the deposition units in DEPUNITS +real, INTENT(IN) :: dg ! diffusion coefficient in air [cm^2/s] LOGICAL, INTENT(IN) :: irev ! TRUE for reversible wash-out -REAL*4, INTENT(IN) :: scavcoef ! scavenging rate [%/h] -REAL*4, INTENT(IN) :: koh ! second order reaction rate constant of reaction NO2 + OH -> HNO3 [cm3/(molec s)] -REAL*4, INTENT(IN) :: croutpri ! (wash-out + rain-out) ratio primary component, default value without correction for background concentration, season, stability class [-] +real, INTENT(IN) :: scavcoef ! scavenging rate [%/h] +real, INTENT(IN) :: koh ! second order reaction rate constant of reaction NO2 + OH -> HNO3 [cm3/(molec s)] +real, INTENT(IN) :: croutpri ! (wash-out + rain-out) ratio primary component, default value without correction for background concentration, season, stability class [-] ! icm = 1 (SO2): croutpri = wash out ratio at an N/S ratio of 1 ! icm = 2 (NOx): croutpri = wash out ratio at an NO2/NOx ratio of 1 ! icm = 3 (NH3): croutpri = wash out ratio (no correction) -REAL*4, INTENT(IN) :: rcno ! surface resistance Rc for NO [s/m] -REAL*4, INTENT(IN) :: rhno2 ! ratio [HNO2]/[NOx] -REAL*4, INTENT(IN) :: rchno3 ! surface resistance Rc for HNO3 [s/m] +real, INTENT(IN) :: rcno ! surface resistance Rc for NO [s/m] +real, INTENT(IN) :: rhno2 ! ratio [HNO2]/[NOx] +real, INTENT(IN) :: rchno3 ! surface resistance Rc for HNO3 [s/m] INTEGER*4, INTENT(IN) :: nrrcp ! number of receptor points INTEGER*4, INTENT(IN) :: ircp ! index of receptorpoint -REAL*4, INTENT(IN) :: gxm ! x-coordinate of receptors (lon-lat) [degrees] -REAL*4, INTENT(IN) :: gym ! y-coordinate of receptors (lon-lat) [degrees] -REAL*4, INTENT(IN) :: xm ! x-coordinate of receptor points (RDM) -REAL*4, INTENT(IN) :: ym ! y-coordinate of receptor points (RDM) -REAL*4, INTENT(IN) :: zm ! z-coordinate of receptor points (RDM) -REAL*4, INTENT(IN) :: frac ! fraction of grid cell inside NL -REAL*4, INTENT(IN) :: nh3bg_rcp ! NH3 background concentration (used in DEPAC) [ug/m3] -REAL*4, INTENT(IN) :: so2bg_rcp ! SO2 background concentration (used in DEPAC) [ug/m3] -REAL*4, INTENT(IN) :: rhno3_rcp ! ratio [HNO3]/[NO3]_total at receptor points, [NO3]_total = [HNO3] + [NO3_aerosol] -REAL*4, INTENT(IN) :: bqrv ! source strength of space heating source (rv << "ruimteverwarming" = space heating) [g/s] -REAL*4, INTENT(IN) :: bqtr ! source strength of traffic source [g/s] +real, INTENT(IN) :: gxm ! x-coordinate of receptors (lon-lat) [degrees] +real, INTENT(IN) :: gym ! y-coordinate of receptors (lon-lat) [degrees] +real, INTENT(IN) :: xm ! x-coordinate of receptor points (RDM) +real, INTENT(IN) :: ym ! y-coordinate of receptor points (RDM) +real, INTENT(IN) :: zm ! z-coordinate of receptor points (RDM) +real, INTENT(IN) :: frac ! fraction of grid cell inside NL +real, INTENT(IN) :: nh3bg_rcp ! NH3 background concentration (used in DEPAC) [ug/m3] +real, INTENT(IN) :: so2bg_rcp ! SO2 background concentration (used in DEPAC) [ug/m3] +real, INTENT(IN) :: rhno3_rcp ! ratio [HNO3]/[NO3]_total at receptor points, [NO3]_total = [HNO3] + [NO3_aerosol] +real, INTENT(IN) :: bqrv ! source strength of space heating source (rv << "ruimteverwarming" = space heating) [g/s] +real, INTENT(IN) :: bqtr ! source strength of traffic source [g/s] INTEGER*4, INTENT(IN) :: bx ! x-coordinate of source INTEGER*4, INTENT(IN) :: by ! y-coordinate of source -REAL*4, INTENT(IN) :: bdiam ! source diameter [m]; if bdiam < 0 -> circular source, bdiam > 0 -> square sourc -REAL*4, INTENT(IN) :: bsterkte ! source strength [g/s] -REAL*4, INTENT(IN) :: bwarmte ! heat content of source [MW] -REAL*4, INTENT(IN) :: bhoogte ! source height [m] -REAL*4, INTENT(IN) :: bsigmaz ! spread in source height to represent different sources in a area source; +real, INTENT(IN) :: bdiam ! source diameter [m]; if bdiam < 0 -> circular source, bdiam > 0 -> square sourc +real, INTENT(IN) :: bsterkte ! source strength [g/s] +real, INTENT(IN) :: bwarmte ! heat content of source [MW] +real, INTENT(IN) :: bhoogte ! source height [m] +real, INTENT(IN) :: bsigmaz ! spread in source height to represent different sources in a area source; ! also used for initial sigma_z (vertical dispersion) of emission (e.g. traffic, building influence) [m] -REAL*4, INTENT(IN) :: bD_stack ! diameter of the stack [m] -REAL*4, INTENT(IN) :: bV_stack ! exit velocity of plume at stack tip [m/s] -REAL*4, INTENT(IN) :: bTs_stack ! temperature of effluent from stack [K] +real, INTENT(IN) :: bD_stack ! diameter of the stack [m] +real, INTENT(IN) :: bV_stack ! exit velocity of plume at stack tip [m/s] +real, INTENT(IN) :: bTs_stack ! temperature of effluent from stack [K] LOGICAL, INTENT(IN) :: bemis_horizontal ! horizontal outflow of emission type(Tbuilding), INTENT(IN) :: bbuilding ! structure with building parameters type(TbuildingEffect), INTENT(IN) :: buildingEffect ! structure containing building effect tables @@ -143,49 +143,49 @@ SUBROUTINE ops_reken(idep, isec, icm, gasv, intpol, vchemc, iopt_vchem, vchemv, INTEGER*4, INTENT(IN) :: bdegr ! option for particle size distribution ! bdegr >= 0 -> standard particle size distribution pmd ! bdegr < 0 -> user-defined particle size distribution uspmd -REAL*4, INTENT(IN) :: z0_src ! roughness length at source; from z0-map [m] -REAL*4, INTENT(IN) :: z0_tra ! roughness length representative for trajectory [m] -REAL*4, INTENT(IN) :: z0_rcp ! roughness length at receptor; from z0-map [m] -REAL*4, INTENT(IN) :: z0_metreg_rcp ! roughness length at receptor; interpolated from meteo regions [m] -REAL*4, INTENT(IN) :: lu_tra_per(NLU) ! landuse (percentages) for all classes over trajectory -REAL*4, INTENT(IN) :: lu_rcp_per(NLU) ! landuse (percentages) for all classes for receptor -REAL*4, INTENT(IN) :: so2sek(NSEK) ! coefficient in correction factor for SO2 background concentration for each wind direction sector; derived from 24 regional LML stations over 2003 -REAL*4, INTENT(IN) :: no2sek(NSEK) ! coefficient in correction factor for NO2 background concentration for each wind direction sector; derived from 15 regional LML stations over 2004 -REAL*4, INTENT(IN) :: so2bgtra ! SO2 background concentration, trajectory averaged [ppb] -REAL*4, INTENT(IN) :: no2bgtra ! NO2 background concentration, trajectory averaged [ppb] -REAL*4, INTENT(IN) :: nh3bgtra ! NH3 background concentration, trajectory averaged [ppb] +real, INTENT(IN) :: z0_src ! roughness length at source; from z0-map [m] +real, INTENT(IN) :: z0_tra ! roughness length representative for trajectory [m] +real, INTENT(IN) :: z0_rcp ! roughness length at receptor; from z0-map [m] +real, INTENT(IN) :: z0_metreg_rcp ! roughness length at receptor; interpolated from meteo regions [m] +real, INTENT(IN) :: lu_tra_per(NLU) ! landuse (percentages) for all classes over trajectory +real, INTENT(IN) :: lu_rcp_per(NLU) ! landuse (percentages) for all classes for receptor +real, INTENT(IN) :: so2sek(NSEK) ! coefficient in correction factor for SO2 background concentration for each wind direction sector; derived from 24 regional LML stations over 2003 +real, INTENT(IN) :: no2sek(NSEK) ! coefficient in correction factor for NO2 background concentration for each wind direction sector; derived from 15 regional LML stations over 2004 +real, INTENT(IN) :: so2bgtra ! SO2 background concentration, trajectory averaged [ppb] +real, INTENT(IN) :: no2bgtra ! NO2 background concentration, trajectory averaged [ppb] +real, INTENT(IN) :: nh3bgtra ! NH3 background concentration, trajectory averaged [ppb] type(Tvchem), INTENT(INOUT) :: vchem2 ! INTEGER*4, INTENT(IN) :: maxidx ! max. number of particle classes (= 1 for gas) -REAL*4, INTENT(IN) :: pmd(NPARTCLASS,MAXDISTR) ! standard particle size distributions -REAL*4, INTENT(IN) :: uspmd(NPARTCLASS,MAXDISTR) ! user-defined particle size distributions +real, INTENT(IN) :: pmd(NPARTCLASS,MAXDISTR) ! standard particle size distributions +real, INTENT(IN) :: uspmd(NPARTCLASS,MAXDISTR) ! user-defined particle size distributions INTEGER*4, INTENT(IN) :: spgrid ! indicator for type of receptor points ! spgrid = 0: regular grid of receptors, NL ! spgrid = 1: rectangular regular grid of receptors, user defined ! spgrid = 2: receptors at specific locations, read from file ! spgrid = 3: receptors at user specific regular grid, not necessarily rectangular -REAL*4, INTENT(IN) :: grid ! grid resolution [m] +real, INTENT(IN) :: grid ! grid resolution [m] LOGICAL, INTENT(IN) :: subbron ! whether to create "subbrons" (sub-sources inside a area source) and "subareas" (sub receptors inside a grid cell) or not -REAL*4, INTENT(IN) :: uurtot ! total number of hours in meteo statistics period ("uur"= hour) [hours] -REAL*4, INTENT(IN) :: routsec ! in-cloud (rain-out) scavenging ratio for secondary component +real, INTENT(IN) :: uurtot ! total number of hours in meteo statistics period ("uur"= hour) [hours] +real, INTENT(IN) :: routsec ! in-cloud (rain-out) scavenging ratio for secondary component ! SUBROUTINE ARGUMENTS - I/O (INOUT) -REAL*4, INTENT(INOUT) :: rc ! surface resistance Rc [s/m] -REAL*8, INTENT(INOUT) :: somvnsec(NPARTCLASS) ! summed wet deposition flux secondary component [ug/m2/h] -REAL*8, INTENT(INOUT) :: telvnsec(NPARTCLASS) ! summed deposited mass per area for wet deposition of secondary component [ug/m2] -REAL*8, INTENT(INOUT) :: vvchem(NPARTCLASS) ! summed chemical conversion rate [%/h] -REAL*8, INTENT(INOUT) :: vtel(NPARTCLASS) ! weighing factors for averaging vvchem (i.e. deposited mass) -REAL*8, INTENT(INOUT) :: somvnpri(NPARTCLASS) ! summed wet deposition flux primary component [ug/m2/h] -REAL*8, INTENT(INOUT) :: telvnpri(NPARTCLASS) ! summed deposited mass per area for wet deposition of primary component [ug/m2] +real, INTENT(INOUT) :: rc ! surface resistance Rc [s/m] +double precision, INTENT(INOUT) :: somvnsec(NPARTCLASS) ! summed wet deposition flux secondary component [ug/m2/h] +double precision, INTENT(INOUT) :: telvnsec(NPARTCLASS) ! summed deposited mass per area for wet deposition of secondary component [ug/m2] +double precision, INTENT(INOUT) :: vvchem(NPARTCLASS) ! summed chemical conversion rate [%/h] +double precision, INTENT(INOUT) :: vtel(NPARTCLASS) ! weighing factors for averaging vvchem (i.e. deposited mass) +double precision, INTENT(INOUT) :: somvnpri(NPARTCLASS) ! summed wet deposition flux primary component [ug/m2/h] +double precision, INTENT(INOUT) :: telvnpri(NPARTCLASS) ! summed deposited mass per area for wet deposition of primary component [ug/m2] DOUBLE PRECISION, INTENT(INOUT) :: ddepri(nrrcp,NPARTCLASS) ! dry deposition of primary component at receptor points [mol/ha/y] -REAL*8, INTENT(INOUT) :: sdrypri(NPARTCLASS) ! summed dry deposition of primary component [ug/m2/h] -REAL*8, INTENT(INOUT) :: snatpri(NPARTCLASS) ! summed wet deposition of primary component [ug/m2/h] (<< "nat" = wet) -REAL*8, INTENT(INOUT) :: sdrysec(NPARTCLASS) ! summed dry deposition of secondary component [ug/m2/h] -REAL*8, INTENT(INOUT) :: snatsec(NPARTCLASS) ! summed wet deposition of secondary component [ug/m2/h] (<< "nat" = wet) +double precision, INTENT(INOUT) :: sdrypri(NPARTCLASS) ! summed dry deposition of primary component [ug/m2/h] +double precision, INTENT(INOUT) :: snatpri(NPARTCLASS) ! summed wet deposition of primary component [ug/m2/h] (<< "nat" = wet) +double precision, INTENT(INOUT) :: sdrysec(NPARTCLASS) ! summed dry deposition of secondary component [ug/m2/h] +double precision, INTENT(INOUT) :: snatsec(NPARTCLASS) ! summed wet deposition of secondary component [ug/m2/h] (<< "nat" = wet) DOUBLE PRECISION, INTENT(INOUT) :: cpri(nrrcp,NPARTCLASS) ! concentration of primary component at receptor points [ug/m3] DOUBLE PRECISION, INTENT(INOUT) :: csec(nrrcp,NPARTCLASS) ! concentration of secondary component ar receptor points [ug/m3] DOUBLE PRECISION, INTENT(INOUT) :: drydep(nrrcp,NPARTCLASS) ! dry deposition at receptor points [mol/ha/y] DOUBLE PRECISION, INTENT(INOUT) :: wetdep(nrrcp,NPARTCLASS) ! wet deposition at receptor points ["depeh"] -REAL*4, INTENT(INOUT) :: astat(NTRAJ,NCOMP,NSTAB,NSEK) ! meteo statistics for each distance class, stability/mixing height class, wind direction sector +real, INTENT(INOUT) :: astat(NTRAJ,NCOMP,NSTAB,NSEK) ! meteo statistics for each distance class, stability/mixing height class, wind direction sector ! 1. number of hours for which a certain combination of classes has occurred [hours] ! 2. maximal mixing height over transport distance [m] ! 3. wind speed (at 10 m height) [m/s] @@ -217,13 +217,13 @@ SUBROUTINE ops_reken(idep, isec, icm, gasv, intpol, vchemc, iopt_vchem, vchemv, ! 25. surface resistance Rc of NO2 [s/m] ! 26. surface resistance Rc of NH3 [s/m] ! 27. surface resistance Rc of NO3 aerosol [s/m] -REAL*4, INTENT(INOUT) :: rno2_nox_sum(nrrcp) ! NO2/NOx ratio, weighed sum over classes +real, INTENT(INOUT) :: rno2_nox_sum(nrrcp) ! NO2/NOx ratio, weighed sum over classes TYPE (TError), INTENT(INOUT) :: error ! error handling record ! SUBROUTINE ARGUMENTS - OUTPUT (OUT) -REAL*4, INTENT(OUT) :: precip ! precipitation amount [mm] -REAL*4, INTENT(OUT) :: routpri ! in-cloud (rain-out) scavenging ratio for primary component [-] -REAL*4, INTENT(OUT) :: dispg(NSTAB) ! dispersion coefficients for vertical dispersion; sigma_z = dispg*x^disph [-] +real, INTENT(OUT) :: precip ! precipitation amount [mm] +real, INTENT(OUT) :: routpri ! in-cloud (rain-out) scavenging ratio for primary component [-] +real, INTENT(OUT) :: dispg(NSTAB) ! dispersion coefficients for vertical dispersion; sigma_z = dispg*x^disph [-] ! LOCAL VARIABLES INTEGER*4 :: istab ! teller over stabiliteitsklassen @@ -244,132 +244,132 @@ SUBROUTINE ops_reken(idep, isec, icm, gasv, intpol, vchemc, iopt_vchem, vchemv, INTEGER*4 :: nb ! INTEGER*4 :: karea ! INTEGER*4 :: larea ! -REAL*4 :: aind ! voortgangsindicator -REAL*4 :: htot ! -REAL*4 :: c ! -REAL*4 :: ueff ! wind speed at effective transport height heff; +real :: aind ! voortgangsindicator +real :: htot +real :: c +real :: ueff ! wind speed at effective transport height heff; ! for short distances heff = plume height; ! for large distances heff = 1/2 mixing height; ! heff is interpolated for intermediate distances. -REAL*4 :: rations ! trajectory verhouding N/S -REAL*4 :: qbron ! -REAL*4 :: qtr ! -REAL*4 :: qruim ! -REAL*4 :: grad ! -REAL*4 :: qob ! -REAL*4 :: qww ! -REAL*4 :: hbron ! -REAL*4 :: percvk ! -REAL*4 :: grof ! -REAL*4 :: cgt ! -REAL*4 :: cgt_z ! hoogte afhankelijkelijke cgt -REAL*4 :: x ! -REAL*4 :: y ! -REAL*4 :: diam ! -REAL*4 :: diameter ! -REAL*4 :: szopp ! -REAL*4 :: D_stack ! diameter of the stack [m] -REAL*4 :: V_stack ! exit velocity of plume at stack tip [m/s] -REAL*4 :: Ts_stack ! temperature of effluent from stack [K] +real :: rations ! trajectory verhouding N/S +real :: qbron +real :: qtr +real :: qruim +real :: grad +real :: qob +real :: qww +real :: hbron +real :: percvk +real :: grof +real :: cgt +real :: cgt_z ! hoogte afhankelijkelijke cgt +real :: x +real :: y +real :: diam +real :: diameter +real :: szopp +real :: D_stack ! diameter of the stack [m] +real :: V_stack ! exit velocity of plume at stack tip [m/s] +real :: Ts_stack ! temperature of effluent from stack [K] LOGICAL :: emis_horizontal ! horizontal outflow of emission type(Tbuilding) :: building ! structure with building paramaters -REAL*4 :: buildingFact ! The interpolated building effect from the buildingTable -REAL*4 :: qrv ! -REAL*4 :: virty ! -REAL*4 :: consec ! -REAL*4 :: angle_SR_xaxis ! angle between source-receptor vector and x-axis (needed for building effect) [degrees] -REAL*4 :: disx ! linear distance between source and receptor [m] -REAL*4 :: disxx ! effective travel distance between source and receptor [m] -REAL*4 :: radius ! -REAL*4 :: uster_metreg_rcp ! -REAL*4 :: temp_C ! temperature at height zmet_T [C] -REAL*4 :: shear ! -REAL*4 :: ol_metreg_rcp ! -REAL*4 :: h0 ! -REAL*4 :: hum ! -REAL*4 :: rcno2d ! -REAL*4 :: rcnh3d ! -REAL*4 :: rcaerd ! -REAL*4 :: vw10 ! -REAL*4 :: pcoef ! -REAL*4 :: htt ! -REAL*4 :: aant ! -REAL*4 :: xl ! -REAL*4 :: rb ! -REAL*4 :: rbm ! -REAL*4 :: ra4 ! -REAL*4 :: ra4m ! -REAL*4 :: ra50 ! -REAL*4 :: ra50m ! -REAL*4 :: xvglbr ! -REAL*4 :: xvghbr ! -REAL*4 :: xloc ! -REAL*4 :: xl100 ! -REAL*4 :: rad ! -REAL*4 :: rcso2 ! -REAL*4 :: coef_space_heating ! space heating coefficient (degree-day values in combination with a wind speed correction) [C m^1/2 / s^1/2] -REAL*4 :: regenk ! -REAL*4 :: buil ! -REAL*4 :: rint ! -REAL*4 :: aksek(NSEK) ! .... (dummy output van ops_statparexp) -REAL*4 :: uster_rcp ! friction velocity at receptor; for z0 at receptor [m/s] -REAL*4 :: ol_rcp ! Monin-Obukhov length at receptor; for z0 at receptor [m/s] -REAL*4 :: uster_src ! -REAL*4 :: ol_src ! -REAL*4 :: uster_tra ! -REAL*4 :: ol_tra ! -REAL*4 :: uh ! -REAL*4 :: zu ! -REAL*4 :: onder ! -REAL*4 :: xlm ! -REAL*4 :: onderm ! -REAL*4 :: qbpri ! -REAL*4 :: qsec ! -REAL*4 :: sigz ! -REAL*4 :: ccc ! undepleted concentration including part above mixing layer; +real :: buildingFact ! The interpolated building effect from the buildingTable +real :: qrv +real :: virty +real :: consec +real :: angle_SR_xaxis ! angle between source-receptor vector and x-axis (needed for building effect) [degrees] +real :: disx ! linear distance between source and receptor [m] +real :: disxx ! effective travel distance between source and receptor [m] +real :: radius +real :: uster_metreg_rcp +real :: temp_C ! temperature at height zmet_T [C] +real :: shear +real :: ol_metreg_rcp +real :: h0 +real :: hum +real :: rcno2d +real :: rcnh3d +real :: rcaerd +real :: vw10 +real :: pcoef +real :: htt +real :: aant +real :: xl +real :: rb +real :: rbm +real :: ra4 +real :: ra4m +real :: ra50 +real :: ra50m +real :: xvglbr +real :: xvghbr +real :: xloc +real :: xl100 +real :: rad +real :: rcso2 +real :: coef_space_heating ! space heating coefficient (degree-day values in combination with a wind speed correction) [C m^1/2 / s^1/2] +real :: regenk +real :: buil +real :: rint +real :: aksek(NSEK) ! .... (dummy output van ops_statparexp) +real :: uster_rcp ! friction velocity at receptor; for z0 at receptor [m/s] +real :: ol_rcp ! Monin-Obukhov length at receptor; for z0 at receptor [m/s] +real :: uster_src +real :: ol_src +real :: uster_tra +real :: ol_tra +real :: uh +real :: zu +real :: onder +real :: xlm +real :: onderm +real :: qbpri +real :: qsec +real :: sigz +real :: ccc ! undepleted concentration including part above mixing layer; ! is needed for e.g. wet deposition. -REAL*4 :: rcsec ! -REAL*4 :: rc_sec_rcp ! -REAL*4 :: rb_rcp ! -REAL*4 :: ra50_rcp ! -REAL*4 :: raz_rcp ! -REAL*4 :: rc_rcp ! -REAL*4 :: ra4_rcp ! -REAL*4 :: vg50_rcp ! -REAL*4 :: pr ! -REAL*4 :: utr ! average wind speed over the trajectory (m/s) -REAL*4 :: vchem ! -REAL*4 :: vg50trans ! -REAL*4 :: vgpart ! -REAL*4 :: rkc ! -REAL*4 :: ri ! -REAL*4 :: twt ! -REAL*4 :: vnatpri ! -REAL*4 :: cq2 ! -REAL*4 :: cdn ! -REAL*4 :: cch ! -REAL*4 :: cratio ! -REAL*4 :: rhno3 ! -REAL*4 :: rrno2nox ! -REAL*4 :: vchemnh3 ! -REAL*4 :: dx ! -REAL*4 :: dy ! -REAL*4 :: dxsub ! -REAL*4 :: dysub ! -REAL*4 :: gbx ! -REAL*4 :: gby ! -REAL*4 :: rctra_0 -REAL*4 :: rctra_50 -REAL*4 :: rclocal -REAL*4 :: rcsrc -REAL*4 :: ra4src -REAL*4 :: rb_src -REAL*4 :: ra50src -REAL*4 :: ra4tra -REAL*4 :: ra50tra -REAL*4 :: rb_tra -REAL*4 :: rnox ! NO2/NOx ratio -REAL*4 :: xg +real :: rcsec +real :: rc_sec_rcp +real :: rb_rcp +real :: ra50_rcp +real :: raz_rcp +real :: rc_rcp +real :: ra4_rcp +real :: vg50_rcp +real :: pr +real :: utr ! average wind speed over the trajectory (m/s) +real :: vchem +real :: vg50trans +real :: vgpart +real :: rkc +real :: ri +real :: twt +real :: vnatpri +real :: cq2 +real :: cdn +real :: cch +real :: cratio +real :: rhno3 +real :: rrno2nox +real :: vchemnh3 +real :: dx +real :: dy +real :: dxsub +real :: dysub +real :: gbx +real :: gby +real :: rctra_0 +real :: rctra_50 +real :: rclocal +real :: rcsrc +real :: ra4src +real :: rb_src +real :: ra50src +real :: ra4tra +real :: ra50tra +real :: rb_tra +real :: rnox ! NO2/NOx ratio +real :: xg LOGICAL :: inc_rcp ! increase receptorpoints LOGICAL :: z0found ! Wel of geen z0 gevonden @@ -747,25 +747,25 @@ SUBROUTINE wind_rek(bx, by, bdiam, bsterkte, bwarmte, bhoogte, bsigmaz, bD_stack ! SUBROUTINE ARGUMENTS - INPUT INTEGER*4, INTENT(IN) :: bx ! INTEGER*4, INTENT(IN) :: by ! -REAL*4, INTENT(IN) :: bdiam ! -REAL*4, INTENT(IN) :: bsterkte ! -REAL*4, INTENT(IN) :: bwarmte ! -REAL*4, INTENT(IN) :: bhoogte ! -REAL*4, INTENT(IN) :: bsigmaz ! -REAL*4, INTENT(IN) :: bD_stack ! diameter of the stack [m] -REAL*4, INTENT(IN) :: bV_stack ! exit velocity of plume at stack tip [m/s] -REAL*4, INTENT(IN) :: bTs_stack ! temperature of effluent from stack [K] +real, INTENT(IN) :: bdiam +real, INTENT(IN) :: bsterkte +real, INTENT(IN) :: bwarmte +real, INTENT(IN) :: bhoogte +real, INTENT(IN) :: bsigmaz +real, INTENT(IN) :: bD_stack ! diameter of the stack [m] +real, INTENT(IN) :: bV_stack ! exit velocity of plume at stack tip [m/s] +real, INTENT(IN) :: bTs_stack ! temperature of effluent from stack [K] LOGICAL, INTENT(IN) :: bemis_horizontal ! horizontal outflow of emission type(Tbuilding), INTENT(IN) :: bbuilding ! structure with building parameters INTEGER*4, INTENT(IN) :: btgedr ! INTEGER*4, INTENT(IN) :: bdegr ! -REAL*4, INTENT(IN) :: bqrv ! -REAL*4, INTENT(IN) :: bqtr ! -REAL*4, INTENT(IN) :: gxm ! -REAL*4, INTENT(IN) :: gym ! -REAL*4, INTENT(IN) :: xm ! -REAL*4, INTENT(IN) :: ym ! -REAL*4, INTENT(IN) :: grid ! +real, INTENT(IN) :: bqrv +real, INTENT(IN) :: bqtr +real, INTENT(IN) :: gxm +real, INTENT(IN) :: gym +real, INTENT(IN) :: xm +real, INTENT(IN) :: ym +real, INTENT(IN) :: grid INTEGER*4, INTENT(IN) :: nk ! INTEGER*4, INTENT(IN) :: nr ! INTEGER*4, INTENT(IN) :: mrcp ! @@ -776,31 +776,31 @@ SUBROUTINE wind_rek(bx, by, bdiam, bsterkte, bwarmte, bhoogte, bsigmaz, bD_stack INTEGER*4, INTENT(IN) :: larea ! ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT) :: angle_SR_xaxis ! angle between source-receptor vector and x-axis (needed for building effect) [degrees] -REAL*4, INTENT(OUT) :: disx ! linear distance between source and receptor [m] -REAL*4, INTENT(OUT) :: x ! -REAL*4, INTENT(OUT) :: y ! -REAL*4, INTENT(OUT) :: qob ! -REAL*4, INTENT(OUT) :: qww ! -REAL*4, INTENT(OUT) :: hbron ! -REAL*4, INTENT(OUT) :: szopp ! -REAL*4, INTENT(OUT) :: D_stack ! diameter of the stack [m] -REAL*4, INTENT(OUT) :: V_stack ! exit velocity of plume at stack tip [m/s] -REAL*4, INTENT(OUT) :: Ts_stack ! temperature of effluent from stack [K] +real, INTENT(OUT) :: angle_SR_xaxis ! angle between source-receptor vector and x-axis (needed for building effect) [degrees] +real, INTENT(OUT) :: disx ! linear distance between source and receptor [m] +real, INTENT(OUT) :: x +real, INTENT(OUT) :: y +real, INTENT(OUT) :: qob +real, INTENT(OUT) :: qww +real, INTENT(OUT) :: hbron +real, INTENT(OUT) :: szopp +real, INTENT(OUT) :: D_stack ! diameter of the stack [m] +real, INTENT(OUT) :: V_stack ! exit velocity of plume at stack tip [m/s] +real, INTENT(OUT) :: Ts_stack ! temperature of effluent from stack [K] LOGICAL, INTENT(OUT) :: emis_horizontal ! horizontal outflow of emission type(Tbuilding), INTENT(OUT) :: building ! strucure with building parameters INTEGER*4, INTENT(OUT) :: ibtg ! INTEGER*4, INTENT(OUT) :: idgr ! -REAL*4, INTENT(OUT) :: qrv ! -REAL*4, INTENT(OUT) :: qtr ! +real, INTENT(OUT) :: qrv +real, INTENT(OUT) :: qtr INTEGER*4, INTENT(OUT) :: rond ! -REAL*4, INTENT(OUT) :: diameter ! +real, INTENT(OUT) :: diameter INTEGER*4, INTENT(OUT) :: iwd ! INTEGER*4, INTENT(OUT) :: isek ! ! LOCAL VARIABLES -REAL*4 :: dx ! -REAL*4 :: dy ! +real :: dx +real :: dy ! SCCS-ID VARIABLES CHARACTER*81 :: sccsida ! diff --git a/ops_resist_rek.f90 b/ops_resist_rek.f90 index e77fb1e..6440fed 100644 --- a/ops_resist_rek.f90 +++ b/ops_resist_rek.f90 @@ -58,97 +58,97 @@ SUBROUTINE ops_resist_rek(vchemc, iopt_vchem, vchemv, rad, isec, icm, rcso2, reg PARAMETER (ROUTINENAAM = 'ops_resist_rek') ! SUBROUTINE ARGUMENTS - INPUT -REAL*4, INTENT(IN) :: vchemc ! chemical conversion rate [%/h] +real, INTENT(IN) :: vchemc ! chemical conversion rate [%/h] INTEGER*4, INTENT(IN) :: iopt_vchem ! option for chemical conversion rate (0 = old OPS, 1 = EMEP) -REAL*4, INTENT(IN) :: vchemv ! -REAL*4, INTENT(IN) :: rad ! +real, INTENT(IN) :: vchemv +real, INTENT(IN) :: rad LOGICAL, INTENT(IN) :: isec ! TRUE als component=[SO2, NOx, NH3] INTEGER*4, INTENT(IN) :: icm ! -REAL*4, INTENT(IN) :: rcso2 ! -REAL*4, INTENT(IN) :: regenk ! -REAL*4, INTENT(IN) :: rcaerd ! surface resistance NO3_aerosol [s/m] +real, INTENT(IN) :: rcso2 +real, INTENT(IN) :: regenk +real, INTENT(IN) :: rcaerd ! surface resistance NO3_aerosol [s/m] INTEGER*4, INTENT(IN) :: iseiz ! INTEGER*4, INTENT(IN) :: istab ! INTEGER*4, INTENT(IN) :: itra ! -REAL*4, INTENT(IN) :: ar ! -REAL*4, INTENT(IN) :: rno2nox ! -REAL*4, INTENT(IN) :: rcnh3d ! -REAL*4, INTENT(IN) :: vchemnh3 +real, INTENT(IN) :: ar +real, INTENT(IN) :: rno2nox +real, INTENT(IN) :: rcnh3d +real, INTENT(IN) :: vchemnh3 type(Tvchem), INTENT(IN) :: vchem2 ! -REAL*4, INTENT(IN) :: hum ! -REAL*4, INTENT(IN) :: uster_rcp ! friction velocity at receptor; for z0 at receptor [m/s] -REAL*4, INTENT(IN) :: ol_rcp ! Monin-Obukhov length at receptor; for z0 at receptor [m/s] -REAL*4, INTENT(IN) :: uster_tra ! -REAL*4, INTENT(IN) :: ol_tra ! -REAL*4, INTENT(IN) :: z0_rcp ! roughness length at receptor; from z0-map [m] -REAL*4, INTENT(IN) :: z0_metreg_rcp ! roughness length at receptor; interpolated from meteo regions [m] -REAL*4, INTENT(IN) :: rcno2d ! +real, INTENT(IN) :: hum +real, INTENT(IN) :: uster_rcp ! friction velocity at receptor; for z0 at receptor [m/s] +real, INTENT(IN) :: ol_rcp ! Monin-Obukhov length at receptor; for z0 at receptor [m/s] +real, INTENT(IN) :: uster_tra +real, INTENT(IN) :: ol_tra +real, INTENT(IN) :: z0_rcp ! roughness length at receptor; from z0-map [m] +real, INTENT(IN) :: z0_metreg_rcp ! roughness length at receptor; interpolated from meteo regions [m] +real, INTENT(IN) :: rcno2d INTEGER*4, INTENT(IN) :: kdeel ! INTEGER*4, INTENT(IN) :: mb ! -REAL*4, INTENT(IN) :: vw10 ! -REAL*4, INTENT(IN) :: temp_C ! temperature at height zmet_T [C] -REAL*4, INTENT(IN) :: disx ! -REAL*4, INTENT(IN) :: zm ! -REAL*4, INTENT(IN) :: koh ! -REAL*4, INTENT(IN) :: rations ! -REAL*4, INTENT(IN) :: rhno3 ! -REAL*4, INTENT(IN) :: rcno ! surface resistance for NO [s/m] -REAL*4, INTENT(IN) :: rhno2 ! ration hno2/nox -REAL*4, INTENT(IN) :: rchno3 ! HNO3 -REAL*4, INTENT(IN) :: croutpri ! constant (initial) in-cloud scavenging ratio [-] for primary component -REAL*4, INTENT(IN) :: rrno2nox ! ruimtelijke variatie in no2/nox verhouding -REAL*4, INTENT(IN) :: rhno3_rcp ! -REAL*4, INTENT(IN) :: z0_src ! roughness length at source; from z0-map [m] -REAL*4, INTENT(IN) :: ol_src ! -REAL*4, INTENT(IN) :: uster_src ! -REAL*4, INTENT(IN) :: z0_tra ! roughness length representative for trajectory [m] -REAL*4, INTENT(IN) :: nh3bg_rcp ! -REAL*4, INTENT(IN) :: nh3bgtra ! -REAL*4, INTENT(IN) :: so2bg_rcp ! -REAL*4, INTENT(IN) :: so2bgtra ! -REAL*4, INTENT(IN) :: gym ! +real, INTENT(IN) :: vw10 +real, INTENT(IN) :: temp_C ! temperature at height zmet_T [C] +real, INTENT(IN) :: disx +real, INTENT(IN) :: zm +real, INTENT(IN) :: koh +real, INTENT(IN) :: rations +real, INTENT(IN) :: rhno3 +real, INTENT(IN) :: rcno ! surface resistance for NO [s/m] +real, INTENT(IN) :: rhno2 ! ration hno2/nox +real, INTENT(IN) :: rchno3 ! HNO3 +real, INTENT(IN) :: croutpri ! constant (initial) in-cloud scavenging ratio [-] for primary component +real, INTENT(IN) :: rrno2nox ! ruimtelijke variatie in no2/nox verhouding +real, INTENT(IN) :: rhno3_rcp +real, INTENT(IN) :: z0_src ! roughness length at source; from z0-map [m] +real, INTENT(IN) :: ol_src +real, INTENT(IN) :: uster_src +real, INTENT(IN) :: z0_tra ! roughness length representative for trajectory [m] +real, INTENT(IN) :: nh3bg_rcp +real, INTENT(IN) :: nh3bgtra +real, INTENT(IN) :: so2bg_rcp +real, INTENT(IN) :: so2bgtra +real, INTENT(IN) :: gym LOGICAL, INTENT(IN) :: gasv ! -REAL*4, INTENT(IN) :: lu_rcp_per(NLU) ! land use percentages for all land use classes of receptor -REAL*4, INTENT(IN) :: lu_tra_per(NLU) ! land use percentages for all land use classes over trajectory +real, INTENT(IN) :: lu_rcp_per(NLU) ! land use percentages for all land use classes of receptor +real, INTENT(IN) :: lu_tra_per(NLU) ! land use percentages for all land use classes over trajectory ! SUBROUTINE ARGUMENTS - I/O -REAL*4, INTENT(INOUT) :: rb ! -REAL*4, INTENT(INOUT) :: ra4 ! -REAL*4, INTENT(INOUT) :: ra50 ! +real, INTENT(INOUT) :: rb +real, INTENT(INOUT) :: ra4 +real, INTENT(INOUT) :: ra50 LOGICAL, INTENT(INOUT) :: depudone ! ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT) :: routpri ! in-cloud scavenging ratio for primary component +real, INTENT(OUT) :: routpri ! in-cloud scavenging ratio for primary component ! (rout << rain-out = in-cloud) [-] -REAL*4, INTENT(OUT) :: vchem ! chemical conversion rate [%/h] -REAL*4, INTENT(OUT) :: uh ! +real, INTENT(OUT) :: vchem ! chemical conversion rate [%/h] +real, INTENT(OUT) :: uh ! Canopy resistances ! Note: for particles, Rc is defined in ops_depoparexp -REAL*4, INTENT(OUT) :: rc ! -REAL*4, INTENT(OUT) :: rcsec ! -REAL*4, INTENT(OUT) :: rc_sec_rcp ! -REAL*4, INTENT(OUT) :: rcsrc ! canopy resistance at the source, no re-emission allowed [s/m]; is used for the computation of +real, INTENT(OUT) :: rc +real, INTENT(OUT) :: rcsec +real, INTENT(OUT) :: rc_sec_rcp +real, INTENT(OUT) :: rcsrc ! canopy resistance at the source, no re-emission allowed [s/m]; is used for the computation of ! cq1 = source depletion ratio for dry deposition for phase 1, area source -REAL*4, INTENT(OUT) :: rctra_0 ! canopy resistance representative for the trajectory, no re-emission allowed [s/m]; +real, INTENT(OUT) :: rctra_0 ! canopy resistance representative for the trajectory, no re-emission allowed [s/m]; ! is used for source depletion (loss over trajectory) -REAL*4, INTENT(OUT) :: rc_rcp ! canopy resistance at receptor, no re-emission allowed [s/m]; +real, INTENT(OUT) :: rc_rcp ! canopy resistance at receptor, no re-emission allowed [s/m]; ! is used for deposition gradient at receptor -REAL*4, INTENT(OUT) :: rclocal ! canopy resistance at receptor, re-emission allowed [s/m]; +real, INTENT(OUT) :: rclocal ! canopy resistance at receptor, re-emission allowed [s/m]; ! is used for the computation of drypri, the local depsosition at the receptor - -REAL*4, INTENT(OUT) :: rb_rcp ! -REAL*4, INTENT(OUT) :: ra4_rcp ! -REAL*4, INTENT(OUT) :: ra50_rcp ! -REAL*4, INTENT(OUT) :: ra4src ! -REAL*4, INTENT(OUT) :: rb_src ! -REAL*4, INTENT(OUT) :: ra50src ! -REAL*4, INTENT(OUT) :: ra4tra ! -REAL*4, INTENT(OUT) :: ra50tra ! -REAL*4, INTENT(OUT) :: rb_tra ! -REAL*4, INTENT(OUT) :: raz_rcp ! -REAL*4, INTENT(OUT) :: rnox ! NO2/NOx ratio - + +real, INTENT(OUT) :: rb_rcp +real, INTENT(OUT) :: ra4_rcp +real, INTENT(OUT) :: ra50_rcp +real, INTENT(OUT) :: ra4src +real, INTENT(OUT) :: rb_src +real, INTENT(OUT) :: ra50src +real, INTENT(OUT) :: ra4tra +real, INTENT(OUT) :: ra50tra +real, INTENT(OUT) :: rb_tra +real, INTENT(OUT) :: raz_rcp +real, INTENT(OUT) :: rnox ! NO2/NOx ratio + ! LOCAL VARIABLES INTEGER*4 :: day_of_year ! @@ -159,40 +159,40 @@ SUBROUTINE ops_resist_rek(vchemc, iopt_vchem, vchemv, rad, isec, icm, rcso2, reg INTEGER*4 :: nwet ! INTEGER*4 :: icnr ! INTEGER*4 :: luclass ! -REAL*4 :: percn ! -REAL*4 :: chemn ! -REAL*4 :: scno2nox ! -REAL*4 :: chemr ! -REAL*4 :: rcno2 ! -REAL*4 :: r ! -REAL*4 :: glrad ! -REAL*4 :: d ! -REAL*4 :: ratns ! -REAL*4 :: rcc ! -REAL*4 :: vdc ! -REAL*4 :: rcaer ! -REAL*4 :: vdaer ! -REAL*4 :: vg ! -REAL*4 :: rchno2 ! -REAL*4 :: dh ! -REAL*4 :: fx ! weegfactor -REAL*4 :: som_rc_rcp -REAL*4 :: som2_rc_rcp -REAL*4 :: som_rc_local -REAL*4 :: som2_rctra_0 -REAL*4 :: som_rctra_0 -REAL*4 :: som_rcsrc -REAL*4 :: telmaand -REAL*4 :: catm -REAL*4 :: c_ave_prev_nh3 -REAL*4 :: c_ave_prev_so2 -REAL*4 :: cfact -REAL*4 :: ccomp_tot -REAL*4 :: rc_tot -REAL*4 :: rc_sum -REAL*4 :: sinphi +real :: percn +real :: chemn +real :: scno2nox +real :: chemr +real :: rcno2 +real :: r +real :: glrad +real :: d +real :: ratns +real :: rcc +real :: vdc +real :: rcaer +real :: vdaer +real :: vg +real :: rchno2 +real :: dh +real :: fx ! weegfactor +real :: som_rc_rcp +real :: som2_rc_rcp +real :: som_rc_local +real :: som2_rctra_0 +real :: som_rctra_0 +real :: som_rcsrc +real :: telmaand +real :: catm +real :: c_ave_prev_nh3 +real :: c_ave_prev_so2 +real :: cfact +real :: ccomp_tot +real :: rc_tot +real :: rc_sum +real :: sinphi INTEGER :: i -REAL*4, PARAMETER :: catm_min = 0.1E-05 +real, PARAMETER :: catm_min = 0.1E-05 ! SCCS-ID VARIABLES CHARACTER*81 :: sccsida ! @@ -574,18 +574,18 @@ SUBROUTINE vdsecaer (ust, ol, vd, rh, nwet,Uh, ra, znul, icmp) ! SUBROUTINE ARGUMENTS - INPUT INTEGER*4, INTENT(IN) :: icmp ! INTEGER*4, INTENT(IN) :: nwet ! -REAL*4, INTENT(IN) :: ust ! -REAL*4, INTENT(IN) :: ol ! -REAL*4, INTENT(IN) :: rh ! -REAL*4, INTENT(IN) :: Uh ! -REAL*4, INTENT(IN) :: ra ! -REAL*4, INTENT(IN) :: znul ! +real, INTENT(IN) :: ust +real, INTENT(IN) :: ol +real, INTENT(IN) :: rh +real, INTENT(IN) :: Uh +real, INTENT(IN) :: ra +real, INTENT(IN) :: znul ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT) :: vd ! +real, INTENT(OUT) :: vd ! LOCAL VARIABLES -REAL*4 :: E ! +real :: E ! SCCS-ID VARIABLES CHARACTER*81 :: sccsida ! diff --git a/ops_scalefac.f90 b/ops_scalefac.f90 index 1ddaf3a..6d54851 100644 --- a/ops_scalefac.f90 +++ b/ops_scalefac.f90 @@ -53,34 +53,34 @@ SUBROUTINE ops_scalefac(nrrcp, nsubsec, cpri, csec, drydep, wetdep, scale_con, s ! SUBROUTINE ARGUMENTS - INPUT INTEGER*4, INTENT(IN) :: nrrcp ! number of receptor points INTEGER*4, INTENT(IN) :: nsubsec ! number sub-secondary species -REAL*4, INTENT(IN) :: cpri(nrrcp) ! array van primaire concentraties -REAL*4, INTENT(IN) :: csec(nrrcp) ! array van secundaire concentraties -REAL*4, INTENT(IN) :: drydep(nrrcp) ! array van droge depositie -REAL*4, INTENT(IN) :: wetdep(nrrcp) ! array van natte depositie -REAL*4, INTENT(IN), OPTIONAL :: csubsec(nrrcp,nsubsec) ! concentration of sub-secondary substance [ug/m3] +real, INTENT(IN) :: cpri(nrrcp) ! array van primaire concentraties +real, INTENT(IN) :: csec(nrrcp) ! array van secundaire concentraties +real, INTENT(IN) :: drydep(nrrcp) ! array van droge depositie +real, INTENT(IN) :: wetdep(nrrcp) ! array van natte depositie +real, INTENT(IN), OPTIONAL :: csubsec(nrrcp,nsubsec) ! concentration of sub-secondary substance [ug/m3] ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT) :: scale_con ! schaal vergr. concentratie -REAL*4, INTENT(OUT) :: scale_sec ! schaal vergr. secundaire concentratie -REAL*4, INTENT(OUT) :: scale_dep ! schaal vergr. droge depositie -REAL*4, INTENT(OUT), OPTIONAL :: scale_subsec(nsubsec) ! scaling factor for sub-secondary species +real, INTENT(OUT) :: scale_con ! schaal vergr. concentratie +real, INTENT(OUT) :: scale_sec ! schaal vergr. secundaire concentratie +real, INTENT(OUT) :: scale_dep ! schaal vergr. droge depositie +real, INTENT(OUT), OPTIONAL :: scale_subsec(nsubsec) ! scaling factor for sub-secondary species ! LOCAL VARIABLES INTEGER*4 :: i ! teller over schaalfactoren INTEGER*4 :: isubsec ! index of sub-secondary species -REAL*4 :: cmax ! grootst voorkomende primaire concentratie -REAL*4 :: csmax ! grootst voorkomende secundaire concentratie -REAL*4 :: csubsecmax(nsubsec) ! maximal value csubsec -REAL*4 :: ddepmax ! grootst voorkomende droge depositie -REAL*4 :: depntmax ! grootst voorkomende natte depositie -REAL*4 :: s ! schaalfactor -REAL*4 :: tc ! teller aantal te grote prim. conc. -REAL*4 :: td ! teller aantal te grote droge dep. -REAL*4 :: tn ! teller aantal te grote natte dep. -REAL*4 :: ts ! teller aantal te grote sec. conc. -REAL*4 :: tsubsec(nsubsec) ! number of sub-secondary species with too large concentrations -REAL*4 :: scale_dry ! schaal vergr. concentratie -REAL*4 :: scale_wet ! schaal vergr. concentratie +real :: cmax ! grootst voorkomende primaire concentratie +real :: csmax ! grootst voorkomende secundaire concentratie +real :: csubsecmax(nsubsec) ! maximal value csubsec +real :: ddepmax ! grootst voorkomende droge depositie +real :: depntmax ! grootst voorkomende natte depositie +real :: s ! schaalfactor +real :: tc ! teller aantal te grote prim. conc. +real :: td ! teller aantal te grote droge dep. +real :: tn ! teller aantal te grote natte dep. +real :: ts ! teller aantal te grote sec. conc. +real :: tsubsec(nsubsec) ! number of sub-secondary species with too large concentrations +real :: scale_dry ! schaal vergr. concentratie +real :: scale_wet ! schaal vergr. concentratie ! SCCS-ID VARIABLES CHARACTER*81 :: sccsida ! diff --git a/ops_seccmp.f90 b/ops_seccmp.f90 index 8c30083..07e68b4 100644 --- a/ops_seccmp.f90 +++ b/ops_seccmp.f90 @@ -52,72 +52,72 @@ SUBROUTINE ops_seccmp(qbpri, ueff, rcsec, routsec, ccc, vv, amol1, amol2, xvg, s PARAMETER (ROUTINENAAM = 'ops_seccmp') ! SUBROUTINE ARGUMENTS - INPUT -REAL*4, INTENT(IN) :: qbpri ! cross-wind integrated mass flux [g/s] of primary species emitted from source -REAL*4, INTENT(IN) :: ueff ! effective transport velocity of plume [m/s] -REAL*4, INTENT(IN) :: rcsec ! opp. weerstand sec. component -REAL*4, INTENT(IN) :: routsec ! in-cloud scavenging ratio for secondary component - ! (rout << rain-out = in-cloud) [-] -REAL*4, INTENT(IN) :: ccc ! undepleted concentration including part above mixing layer; +real, INTENT(IN) :: qbpri ! cross-wind integrated mass flux [g/s] of primary species emitted from source +real, INTENT(IN) :: ueff ! effective transport velocity of plume [m/s] +real, INTENT(IN) :: rcsec ! opp. weerstand sec. component +real, INTENT(IN) :: routsec ! in-cloud scavenging ratio for secondary component + ! (rout << rain-out = in-cloud) [-] +real, INTENT(IN) :: ccc ! undepleted concentration including part above mixing layer; ! is needed for e.g. wet deposition. -REAL*4, INTENT(IN) :: vv ! total source depletion factor for primary component -REAL*4, INTENT(IN) :: amol1 ! molgewicht primaire component -REAL*4, INTENT(IN) :: amol2 ! molgewicht secundaire component -REAL*4, INTENT(IN) :: xvg ! factor not used; xvg = 1 -REAL*4, INTENT(IN) :: sigz ! -REAL*4, INTENT(IN) :: grad ! -REAL*4, INTENT(IN) :: utr ! average wind speed over the trajectory (m/s) -REAL*4, INTENT(IN) :: radius ! -REAL*4, INTENT(IN) :: disx ! -REAL*4, INTENT(IN) :: xl ! -REAL*4, INTENT(IN) :: xloc ! -REAL*4, INTENT(IN) :: vw10 ! -REAL*4, INTENT(IN) :: pcoef ! -REAL*4, INTENT(IN) :: virty ! -REAL*4, INTENT(IN) :: regenk ! -REAL*4, INTENT(IN) :: htot ! -REAL*4, INTENT(IN) :: onder ! -REAL*4, INTENT(IN) :: twt ! -REAL*4, INTENT(IN) :: ri ! -REAL*4, INTENT(IN) :: rb ! -REAL*4, INTENT(IN) :: ra50 ! -REAL*4, INTENT(IN) :: cgt ! -REAL*4, INTENT(IN) :: xvghbr ! -REAL*4, INTENT(IN) :: xvglbr ! -REAL*4, INTENT(IN) :: vnatpri ! -REAL*4, INTENT(IN) :: vchem ! chemical conversion rate [%/h] -REAL*4, INTENT(IN) :: ra4_rcp ! -REAL*4, INTENT(IN) :: ra50_rcp ! -REAL*4, INTENT(IN) :: rb_rcp ! -REAL*4, INTENT(IN) :: rc_sec_rcp ! -REAL*4, INTENT(IN) :: ra50tra ! -REAL*4, INTENT(IN) :: rb_tra ! +real, INTENT(IN) :: vv ! total source depletion factor for primary component +real, INTENT(IN) :: amol1 ! molgewicht primaire component +real, INTENT(IN) :: amol2 ! molgewicht secundaire component +real, INTENT(IN) :: xvg ! factor not used; xvg = 1 +real, INTENT(IN) :: sigz +real, INTENT(IN) :: grad +real, INTENT(IN) :: utr ! average wind speed over the trajectory (m/s) +real, INTENT(IN) :: radius +real, INTENT(IN) :: disx +real, INTENT(IN) :: xl +real, INTENT(IN) :: xloc +real, INTENT(IN) :: vw10 +real, INTENT(IN) :: pcoef +real, INTENT(IN) :: virty +real, INTENT(IN) :: regenk +real, INTENT(IN) :: htot +real, INTENT(IN) :: onder +real, INTENT(IN) :: twt +real, INTENT(IN) :: ri +real, INTENT(IN) :: rb +real, INTENT(IN) :: ra50 +real, INTENT(IN) :: cgt +real, INTENT(IN) :: xvghbr +real, INTENT(IN) :: xvglbr +real, INTENT(IN) :: vnatpri +real, INTENT(IN) :: vchem ! chemical conversion rate [%/h] +real, INTENT(IN) :: ra4_rcp +real, INTENT(IN) :: ra50_rcp +real, INTENT(IN) :: rb_rcp +real, INTENT(IN) :: rc_sec_rcp +real, INTENT(IN) :: ra50tra +real, INTENT(IN) :: rb_tra ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT) :: pr ! -REAL*4, INTENT(OUT) :: vnatsec ! -REAL*4, INTENT(OUT) :: cgtsec ! -REAL*4, INTENT(OUT) :: vgsec ! deposition velocity secondary component [m/s[ -REAL*4, INTENT(OUT) :: qsec ! cross-wind integrated mass flux of secondary species [g/s] -REAL*4, INTENT(OUT) :: consec ! concentration secondary component [ug/m3] -REAL*4, INTENT(OUT) :: vg50trans ! +real, INTENT(OUT) :: pr +real, INTENT(OUT) :: vnatsec +real, INTENT(OUT) :: cgtsec +real, INTENT(OUT) :: vgsec ! deposition velocity secondary component [m/s[ +real, INTENT(OUT) :: qsec ! cross-wind integrated mass flux of secondary species [g/s] +real, INTENT(OUT) :: consec ! concentration secondary component [ug/m3] +real, INTENT(OUT) :: vg50trans ! LOCAL VARIABLES -REAL*4 :: a ! -REAL*4 :: diameter ! -REAL*4 :: h ! -REAL*4 :: hl ! -REAL*4 :: gradsec ! -REAL*4 :: qpri ! cross-wind integrated mass flux [g/s] of primary species of depleted source - -REAL*4 :: rcrs ! -REAL*4 :: s ! -REAL*4 :: sigzsec ! -REAL*4 :: vgsect ! -REAL*4 :: vnatrainv ! uitregensnelheid -REAL*4 :: vnatwashv ! uitwassnelheid -REAL*4 :: vw ! -REAL*4 :: qsec_uncorr ! uncorrected qsec (from seccd) -REAL*4 :: xg +real :: a +real :: diameter +real :: h +real :: hl +real :: gradsec +real :: qpri ! cross-wind integrated mass flux [g/s] of primary species of depleted source + +real :: rcrs +real :: s +real :: sigzsec +real :: vgsect +real :: vnatrainv ! uitregensnelheid +real :: vnatwashv ! uitwassnelheid +real :: vw +real :: qsec_uncorr ! uncorrected qsec (from seccd) +real :: xg ! SCCS-ID VARIABLES CHARACTER*81 :: sccsida ! @@ -368,32 +368,32 @@ SUBROUTINE seccd(qbpri, disx, radius, vw, xl, vgpri, vnatpri, vchem, vgsec, vnat PARAMETER (ROUTINENAAM = 'seccd') ! SUBROUTINE ARGUMENTS - INPUT -REAL*4, INTENT(IN) :: qbpri ! cross-wind integrated mass flux [g/s] of primary species emitted from source -REAL*4, INTENT(IN) :: disx ! -REAL*4, INTENT(IN) :: radius ! -REAL*4, INTENT(IN) :: vw ! average wind speed over trajectory [m/s] -REAL*4, INTENT(IN) :: xl ! -REAL*4, INTENT(IN) :: vgpri ! -REAL*4, INTENT(IN) :: vnatpri ! loss rate due to wet deposition of primary component [%/h] -REAL*4, INTENT(IN) :: vchem ! chemical conversion rate [%/h] -REAL*4, INTENT(IN) :: vgsec ! -REAL*4, INTENT(IN) :: vnatsec ! loss rate due to wet deposition of secondary component [%/h] -REAL*4, INTENT(IN) :: amol1 ! molecular weight primary component -REAL*4, INTENT(IN) :: amol2 ! molecular weight secondary component -REAL*4, INTENT(IN) :: diameter ! -REAL*4, INTENT(IN) :: sigz ! +real, INTENT(IN) :: qbpri ! cross-wind integrated mass flux [g/s] of primary species emitted from source +real, INTENT(IN) :: disx +real, INTENT(IN) :: radius +real, INTENT(IN) :: vw ! average wind speed over trajectory [m/s] +real, INTENT(IN) :: xl +real, INTENT(IN) :: vgpri +real, INTENT(IN) :: vnatpri ! loss rate due to wet deposition of primary component [%/h] +real, INTENT(IN) :: vchem ! chemical conversion rate [%/h] +real, INTENT(IN) :: vgsec +real, INTENT(IN) :: vnatsec ! loss rate due to wet deposition of secondary component [%/h] +real, INTENT(IN) :: amol1 ! molecular weight primary component +real, INTENT(IN) :: amol2 ! molecular weight secondary component +real, INTENT(IN) :: diameter +real, INTENT(IN) :: sigz ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT) :: qpri ! cross-wind integrated mass flux of primary species at receptor [g/s] -REAL*4, INTENT(OUT) :: qsec ! cross-wind integrated mass flux of secondary species at receptor [g/s] +real, INTENT(OUT) :: qpri ! cross-wind integrated mass flux of primary species at receptor [g/s] +real, INTENT(OUT) :: qsec ! cross-wind integrated mass flux of secondary species at receptor [g/s] ! LOCAL VARIABLES INTEGER*4 :: itim ! time step index INTEGER*4 :: ntim ! number of time steps -REAL*4 :: a ! effective transport distance over which conversion takes place -REAL*4 :: a1 ! -REAL*4 :: b ! -REAL*4 :: dt ! length of time step [s] +real :: a ! effective transport distance over which conversion takes place +real :: a1 +real :: b +real :: dt ! length of time step [s] integer :: it ! iteration count integer, parameter :: nit = 10 ! maximal number of iterations logical :: converged ! iteration procedure for Q(it) has converged : abs(Q(it-1) = Q(it)) < epsa + epsr * Q(it) @@ -409,8 +409,8 @@ SUBROUTINE seccd(qbpri, disx, radius, vw, xl, vgpri, vnatpri, vchem, vgsec, vnat real :: e3_pri_sec ! factor in production term of secondary species = (Msec/Mpri) * delta_t * k_chem real :: e1_pri ! source depletion factor for primary species, due to dry deposition, wet deposition and chemical conversion real :: e1_sec ! source depletion factor for secondary species, due to dry deposition, wet deposition and chemical conversion -REAL*4 :: xseg ! end point of plume segment [m] -REAL*4 :: dx ! travelled distance during one time step = length of plume segment [m] +real :: xseg ! end point of plume segment [m] +real :: dx ! travelled distance during one time step = length of plume segment [m] logical :: lfound_seg_depos ! plume segment where deposition starts has been found ! SCCS-ID VARIABLES diff --git a/ops_src_char.f90 b/ops_src_char.f90 index 8e56c0f..67dd72b 100644 --- a/ops_src_char.f90 +++ b/ops_src_char.f90 @@ -54,14 +54,14 @@ SUBROUTINE ops_src_char (f_z0user, z0_user, xb, yb, z0nlgrid, z0eurgrid, z0_src, ! SUBROUTINE ARGUMENTS - INPUT LOGICAL, INTENT(IN) :: f_z0user ! user overwrites z0 values from meteo input -REAL*4, INTENT(IN) :: z0_user ! roughness length specified by the user [m] +real, INTENT(IN) :: z0_user ! roughness length specified by the user [m] INTEGER*4, INTENT(IN) :: xb ! x-coordinaat van huidige bron in buffer INTEGER*4, INTENT(IN) :: yb ! y-coordinaat van huidige bron in buffer TYPE (TApsGridInt), INTENT(IN) :: z0nlgrid ! map of roughness lengths in NL [m] TYPE (TApsGridInt), INTENT(IN) :: z0eurgrid ! map of roughness lengths in Europe [m] ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT) :: z0_src ! roughness length at source; from z0-map [m] +real, INTENT(OUT) :: z0_src ! roughness length at source; from z0-map [m] TYPE (TError) :: error ! SCCS-ID VARIABLES diff --git a/ops_stab_rek.f90 b/ops_stab_rek.f90 index 344573c..91a7280 100644 --- a/ops_stab_rek.f90 +++ b/ops_stab_rek.f90 @@ -60,72 +60,72 @@ SUBROUTINE ops_stab_rek(icm, rb, temp_C, h0, z0_metreg_rcp, disx, z0_rcp, xl, ra ! SUBROUTINE ARGUMENTS - INPUT INTEGER*4, INTENT(IN) :: icm ! componentnummer -REAL*4, INTENT(IN) :: rb ! -REAL*4, INTENT(IN) :: temp_C ! temperature at height zmet_T [C] -REAL*4, INTENT(IN) :: h0 ! -REAL*4, INTENT(IN) :: z0_metreg_rcp ! roughness length at receptor; interpolated from meteo regions [m] -REAL*4, INTENT(IN) :: disx ! -REAL*4, INTENT(IN) :: z0_rcp ! roughness length at receptor; from z0-map [m] -REAL*4, INTENT(IN) :: xl ! -REAL*4, INTENT(IN) :: radius ! -REAL*4, INTENT(IN) :: qtr ! -REAL*4, INTENT(IN) :: qrv ! +real, INTENT(IN) :: rb +real, INTENT(IN) :: temp_C ! temperature at height zmet_T [C] +real, INTENT(IN) :: h0 +real, INTENT(IN) :: z0_metreg_rcp ! roughness length at receptor; interpolated from meteo regions [m] +real, INTENT(IN) :: disx +real, INTENT(IN) :: z0_rcp ! roughness length at receptor; from z0-map [m] +real, INTENT(IN) :: xl +real, INTENT(IN) :: radius +real, INTENT(IN) :: qtr +real, INTENT(IN) :: qrv INTEGER*4, INTENT(IN) :: dv ! -REAL*4, INTENT(IN) :: ecvl(NSTAB, NTRAJ, *) ! -REAL*4, INTENT(IN) :: coef_space_heating ! space heating coefficient (degree-day values in combination with a wind speed correction) [C m^1/2 / s^1/2] +real, INTENT(IN) :: ecvl(NSTAB, NTRAJ, *) +real, INTENT(IN) :: coef_space_heating ! space heating coefficient (degree-day values in combination with a wind speed correction) [C m^1/2 / s^1/2] INTEGER*4, INTENT(IN) :: ibtg ! -REAL*4, INTENT(IN) :: uster_metreg_rcp ! -REAL*4, INTENT(IN) :: hbron ! -REAL*4, INTENT(IN) :: qww ! -REAL*4, INTENT(IN) :: D_stack ! diameter of the stack [m] -REAL*4, INTENT(IN) :: V_stack ! exit velocity of plume at stack tip [m/s] -REAL*4, INTENT(IN) :: Ts_stack ! temperature of effluent from stack [K] +real, INTENT(IN) :: uster_metreg_rcp +real, INTENT(IN) :: hbron +real, INTENT(IN) :: qww +real, INTENT(IN) :: D_stack ! diameter of the stack [m] +real, INTENT(IN) :: V_stack ! exit velocity of plume at stack tip [m/s] +real, INTENT(IN) :: Ts_stack ! temperature of effluent from stack [K] LOGICAL, INTENT(IN) :: emis_horizontal ! horizontal outflow of emission INTEGER*4, INTENT(IN) :: istab ! INTEGER*4, INTENT(IN) :: itra ! -REAL*4, INTENT(IN) :: qob ! -REAL*4, INTENT(IN) :: xloc ! -REAL*4, INTENT(IN) :: regenk ! -REAL*4, INTENT(IN) :: ra4 ! -REAL*4, INTENT(IN) :: z0_tra ! roughness length representative for trajectory [m] -REAL*4, INTENT(IN) :: z0_src ! roughness length at source; from z0-map [m] +real, INTENT(IN) :: qob +real, INTENT(IN) :: xloc +real, INTENT(IN) :: regenk +real, INTENT(IN) :: ra4 +real, INTENT(IN) :: z0_tra ! roughness length representative for trajectory [m] +real, INTENT(IN) :: z0_src ! roughness length at source; from z0-map [m] ! SUBROUTINE ARGUMENTS - I/O -REAL*4, INTENT(INOUT) :: ol_metreg_rcp ! Monin-Obukhov length +real, INTENT(INOUT) :: ol_metreg_rcp ! Monin-Obukhov length TYPE (TError), INTENT(INOUT) :: error ! error handling record ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT) :: uster_rcp ! friction velocity at receptor; for z0 at receptor [m/s] -REAL*4, INTENT(OUT) :: ol_rcp ! Monin-Obukhov length at receptor; for z0 at receptor [m/s] -REAL*4, INTENT(OUT) :: uster_src ! friction velocity u* at source [m/s] -REAL*4, INTENT(OUT) :: ol_src ! Monin-Obukhov length at source [m] -REAL*4, INTENT(OUT) :: uster_tra ! friction velocity u*, trajectory averaged [m/s] -REAL*4, INTENT(OUT) :: ol_tra ! Monin-Obukhov length, trajectory averaged [m] -REAL*4, INTENT(OUT) :: htot ! -REAL*4, INTENT(OUT) :: htt ! -REAL*4, INTENT(OUT) :: onder ! -REAL*4, INTENT(OUT) :: uh ! -REAL*4, INTENT(OUT) :: zu ! -REAL*4, INTENT(OUT) :: qruim ! -REAL*4, INTENT(OUT) :: qbron ! -REAL*4, INTENT(OUT) :: dispg(NSTAB) ! +real, INTENT(OUT) :: uster_rcp ! friction velocity at receptor; for z0 at receptor [m/s] +real, INTENT(OUT) :: ol_rcp ! Monin-Obukhov length at receptor; for z0 at receptor [m/s] +real, INTENT(OUT) :: uster_src ! friction velocity u* at source [m/s] +real, INTENT(OUT) :: ol_src ! Monin-Obukhov length at source [m] +real, INTENT(OUT) :: uster_tra ! friction velocity u*, trajectory averaged [m/s] +real, INTENT(OUT) :: ol_tra ! Monin-Obukhov length, trajectory averaged [m] +real, INTENT(OUT) :: htot +real, INTENT(OUT) :: htt +real, INTENT(OUT) :: onder +real, INTENT(OUT) :: uh +real, INTENT(OUT) :: zu +real, INTENT(OUT) :: qruim +real, INTENT(OUT) :: qbron +real, INTENT(OUT) :: dispg(NSTAB) ! LOCAL VARIABLES -REAL*4 :: uster_metreg_from_rb_rcp ! friction velocity at receptor from Rb(SO2); for z0 interpolated from meteo regions [m/s] -REAL*4 :: ol_metreg_from_rb_rcp ! Monin-Obukhov length at receptor from Rb(SO2); for z0 interpolated from meteo regions [m/s] -REAL*4 :: dsx ! ratio disx/radius, i.e. +real :: uster_metreg_from_rb_rcp ! friction velocity at receptor from Rb(SO2); for z0 interpolated from meteo regions [m/s] +real :: ol_metreg_from_rb_rcp ! Monin-Obukhov length at receptor from Rb(SO2); for z0 interpolated from meteo regions [m/s] +real :: dsx ! ratio disx/radius, i.e. ! ! (source-receptor distance)/(radius of area source) -REAL*4 :: sz_rcp_stab_src ! vertical dispersion coefficient sigma_z at receptor with (z0,u*,L,uh,zu) of source site -REAL*4 :: uh_rcp ! -REAL*4 :: zu_rcp ! -REAL*4 :: sz_rcp ! -REAL*4 :: qobb ! -REAL*4 :: qvk ! -REAL*4 :: qrvv ! -REAL*4 :: tcor ! -REAL*4 :: rcor ! -REAL*4 :: dncor ! -REAL*4 :: emf ! +real :: sz_rcp_stab_src ! vertical dispersion coefficient sigma_z at receptor with (z0,u*,L,uh,zu) of source site +real :: uh_rcp +real :: zu_rcp +real :: sz_rcp +real :: qobb +real :: qvk +real :: qrvv +real :: tcor +real :: rcor +real :: dncor +real :: emf logical :: VsDs_opt ! read stack parameters Ds/Vs/Ts from source file ! SUBROUTINE AND FUNCTION CALLS diff --git a/ops_statparexp.f90 b/ops_statparexp.f90 index 22e8969..ae13e2b 100644 --- a/ops_statparexp.f90 +++ b/ops_statparexp.f90 @@ -60,57 +60,57 @@ SUBROUTINE ops_statparexp(istab, hbron, qww, D_stack, V_stack, Ts_stack, emis_ho ! SUBROUTINE ARGUMENTS - INPUT INTEGER*4, INTENT(IN) :: istab -REAL*4, INTENT(IN) :: hbron -REAL*4, INTENT(IN) :: qww -REAL*4, INTENT(IN) :: D_stack ! diameter of the stack [m] -REAL*4, INTENT(IN) :: V_stack ! exit velocity of plume at stack tip [m/s] -REAL*4, INTENT(IN) :: Ts_stack ! temperature of effluent from stack [K] +real, INTENT(IN) :: hbron +real, INTENT(IN) :: qww +real, INTENT(IN) :: D_stack ! diameter of the stack [m] +real, INTENT(IN) :: V_stack ! exit velocity of plume at stack tip [m/s] +real, INTENT(IN) :: Ts_stack ! temperature of effluent from stack [K] LOGICAL, INTENT(IN) :: emis_horizontal ! horizontal outflow of emission INTEGER*4, INTENT(IN) :: iwd -REAL*4, INTENT(IN) :: radius -REAL*4, INTENT(IN) :: uurtot -REAL*4, INTENT(IN) :: astat(NTRAJ, NCOMP, NSTAB, NSEK) -REAL*4, INTENT(IN) :: trafst(NTRAJ) -REAL*4, INTENT(IN) :: disx ! linear distance between source and receptor [m] +real, INTENT(IN) :: radius +real, INTENT(IN) :: uurtot +real, INTENT(IN) :: astat(NTRAJ, NCOMP, NSTAB, NSEK) +real, INTENT(IN) :: trafst(NTRAJ) +real, INTENT(IN) :: disx ! linear distance between source and receptor [m] INTEGER*4, INTENT(IN) :: isek ! ! SUBROUTINE ARGUMENTS - I/O TYPE (TError), INTENT(INOUT) :: error ! error handling record ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT) :: disxx ! effective travel distance between source and receptor [m] +real, INTENT(OUT) :: disxx ! effective travel distance between source and receptor [m] INTEGER*4, INTENT(OUT) :: isekt ! -REAL*4, INTENT(OUT) :: vw10 ! -REAL*4, INTENT(OUT) :: aksek(12) ! -REAL*4, INTENT(OUT) :: h0 ! -REAL*4, INTENT(OUT) :: hum ! -REAL*4, INTENT(OUT) :: ol_metreg_rcp ! -REAL*4, INTENT(OUT) :: shear ! -REAL*4, INTENT(OUT) :: rcaer ! -REAL*4, INTENT(OUT) :: rcnh3 ! -REAL*4, INTENT(OUT) :: rcno2 ! -REAL*4, INTENT(OUT) :: temp_C ! temperature at height zmet_T [C] -REAL*4, INTENT(OUT) :: uster_metreg_rcp ! -REAL*4, INTENT(OUT) :: pcoef ! -REAL*4, INTENT(OUT) :: htot ! -REAL*4, INTENT(OUT) :: htt ! +real, INTENT(OUT) :: vw10 +real, INTENT(OUT) :: aksek(12) +real, INTENT(OUT) :: h0 +real, INTENT(OUT) :: hum +real, INTENT(OUT) :: ol_metreg_rcp +real, INTENT(OUT) :: shear +real, INTENT(OUT) :: rcaer +real, INTENT(OUT) :: rcnh3 +real, INTENT(OUT) :: rcno2 +real, INTENT(OUT) :: temp_C ! temperature at height zmet_T [C] +real, INTENT(OUT) :: uster_metreg_rcp +real, INTENT(OUT) :: pcoef +real, INTENT(OUT) :: htot +real, INTENT(OUT) :: htt INTEGER*4, INTENT(OUT) :: itra ! -REAL*4, INTENT(OUT) :: aant ! -REAL*4, INTENT(OUT) :: xl ! -REAL*4, INTENT(OUT) :: rb ! -REAL*4, INTENT(OUT) :: ra4 ! -REAL*4, INTENT(OUT) :: ra50 ! -REAL*4, INTENT(OUT) :: xvglbr ! -REAL*4, INTENT(OUT) :: xvghbr ! -REAL*4, INTENT(OUT) :: xloc ! -REAL*4, INTENT(OUT) :: xl100 ! -REAL*4, INTENT(OUT) :: rad ! -REAL*4, INTENT(OUT) :: rcso2 ! -REAL*4, INTENT(OUT) :: coef_space_heating ! space heating coefficient (degree-day values in combination with a wind speed correction) [C m^1/2 / s^1/2] -REAL*4, INTENT(OUT) :: regenk ! -REAL*4, INTENT(OUT) :: buil ! -REAL*4, INTENT(OUT) :: rint ! -REAL*4, INTENT(OUT) :: percvk ! +real, INTENT(OUT) :: aant +real, INTENT(OUT) :: xl +real, INTENT(OUT) :: rb +real, INTENT(OUT) :: ra4 +real, INTENT(OUT) :: ra50 +real, INTENT(OUT) :: xvglbr +real, INTENT(OUT) :: xvghbr +real, INTENT(OUT) :: xloc +real, INTENT(OUT) :: xl100 +real, INTENT(OUT) :: rad +real, INTENT(OUT) :: rcso2 +real, INTENT(OUT) :: coef_space_heating ! space heating coefficient (degree-day values in combination with a wind speed correction) [C m^1/2 / s^1/2] +real, INTENT(OUT) :: regenk +real, INTENT(OUT) :: buil +real, INTENT(OUT) :: rint +real, INTENT(OUT) :: percvk ! LOCAL VARIABLES INTEGER*4 :: is ! @@ -120,28 +120,28 @@ SUBROUTINE ops_statparexp(istab, hbron, qww, D_stack, V_stack, Ts_stack, emis_ho INTEGER*4 :: itrx ! INTEGER*4 :: iwdd ! INTEGER*4 :: itraj ! index of distance class -REAL*4 :: ccor ! concentration correction factor for area sources -REAL*4 :: stt(NCOMP) ! -REAL*4 :: tal(NTRAJ) ! -REAL*4 :: dscor(NTRAJ) ! -REAL*4 :: phi ! -REAL*4 :: r ! -REAL*4 :: r4 ! -REAL*4 :: r50 ! -REAL*4 :: s ! interpolation factor (0-1) for the contribution of wind sector is - ! (i.e. the second interpolation sector), to the wind direction - ! from source to receptor - -REAL*4 :: s1(NTRAJ) ! interpolation factor for distance class (interpolates data between +real :: ccor ! concentration correction factor for area sources +real :: stt(NCOMP) +real :: tal(NTRAJ) +real :: dscor(NTRAJ) +real :: phi +real :: r +real :: r4 +real :: r50 +real :: s ! interpolation factor (0-1) for the contribution of wind sector is + ! (i.e. the second interpolation sector), to the wind direction + ! from source to receptor + +real :: s1(NTRAJ) ! interpolation factor for distance class (interpolates data between ! lower and upper class boundary). Note that if ids is the class index ! where the source-receptor distance lies in, then 0 <= s1(ids) <= 1 and ! s1(i) = 0 for i /= ids - -REAL*4 :: stta(NCOMP) ! -REAL*4 :: sttr(NCOMP) ! -REAL*4 :: sa ! -REAL*4 :: so ! -REAL*4 :: sp ! + +real :: stta(NCOMP) +real :: sttr(NCOMP) +real :: sa +real :: so +real :: sp real :: dum ! dummy output variable ! SCCS-ID VARIABLES @@ -341,16 +341,16 @@ SUBROUTINE bepafst(itra, s, trafst, disx, dscor, xl, disxx) ! SUBROUTINE ARGUMENTS - INPUT INTEGER*4, INTENT(IN) :: itra ! -REAL*4, INTENT(IN) :: s(NTRAJ) ! -REAL*4, INTENT(IN) :: trafst(NTRAJ) ! -REAL*4, INTENT(IN) :: disx ! linear distance between source and receptor ('as the crow flies') [m] +real, INTENT(IN) :: s(NTRAJ) +real, INTENT(IN) :: trafst(NTRAJ) +real, INTENT(IN) :: disx ! linear distance between source and receptor ('as the crow flies') [m] ! SUBROUTINE ARGUMENTS - I/O -REAL*4, INTENT(INOUT) :: dscor(NTRAJ) ! Note: dscor is not used anymore after this routine -REAL*4, INTENT(INOUT) :: xl ! +real, INTENT(INOUT) :: dscor(NTRAJ) ! Note: dscor is not used anymore after this routine +real, INTENT(INOUT) :: xl ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT) :: disxx ! effective travel distance between source and receptor [m] +real, INTENT(OUT) :: disxx ! effective travel distance between source and receptor [m] ! LOCAL VARIABLES INTEGER*4 :: ids ! @@ -446,27 +446,27 @@ END SUBROUTINE bepafst SUBROUTINE voorlpl(istab, isek, hbron, qww, astat, vw10, pcoef, htt) ! CONSTANTS -CHARACTER*512 :: ROUTINENAAM ! +CHARACTER*512 :: ROUTINENAAM PARAMETER (ROUTINENAAM = 'voorlpl') ! CONSTANTS -REAL*4 :: VWREP(NSTAB) ! +real :: VWREP(NSTAB) ! SUBROUTINE ARGUMENTS - INPUT INTEGER*4, INTENT(IN) :: istab ! INTEGER*4, INTENT(IN) :: isek ! -REAL*4, INTENT(IN) :: hbron ! -REAL*4, INTENT(IN) :: qww ! -REAL*4, INTENT(IN) :: astat(NTRAJ, NCOMP, NSTAB, NSEK) ! +real, INTENT(IN) :: hbron +real, INTENT(IN) :: qww +real, INTENT(IN) :: astat(NTRAJ, NCOMP, NSTAB, NSEK) ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT) :: vw10 ! -REAL*4, INTENT(OUT) :: pcoef ! -REAL*4, INTENT(OUT) :: htt ! +real, INTENT(OUT) :: vw10 +real, INTENT(OUT) :: pcoef +real, INTENT(OUT) :: htt ! LOCAL VARIABLES -REAL*4 :: delh ! -REAL*4 :: utop ! +real :: delh +real :: utop ! DATA DATA VWREP /2.6, 3.8, 4.0, 6.9, 1.4, 2.5/ @@ -550,24 +550,24 @@ SUBROUTINE ronafhpar(radius, disxx, istab, s, isek, astat, s1,ids, aksek, sa, ph PARAMETER (ROUTINENAAM = 'ronafhpar') ! SUBROUTINE ARGUMENTS - INPUT -REAL*4, INTENT(IN) :: radius ! -REAL*4, INTENT(IN) :: disxx ! +real, INTENT(IN) :: radius +real, INTENT(IN) :: disxx INTEGER*4, INTENT(IN) :: istab ! -REAL*4, INTENT(IN) :: s ! +real, INTENT(IN) :: s INTEGER*4, INTENT(IN) :: isek ! middle of contributing wind sectors; note that ronafhpar ! is called with isek = isekt, i.e. the first of the two ! interpolating wind sectors -REAL*4, INTENT(IN) :: astat(NTRAJ, NCOMP, NSTAB, NSEK) ! -REAL*4, INTENT(IN) :: s1(NTRAJ) ! +real, INTENT(IN) :: astat(NTRAJ, NCOMP, NSTAB, NSEK) +real, INTENT(IN) :: s1(NTRAJ) INTEGER*4, INTENT(IN) :: ids ! ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT) :: aksek(12) ! -REAL*4, INTENT(OUT) :: sa ! -REAL*4, INTENT(OUT) :: phi ! -REAL*4, INTENT(OUT) :: so ! -REAL*4, INTENT(OUT) :: stta(NCOMP) ! -REAL*4, INTENT(OUT) :: sttr(NCOMP) ! +real, INTENT(OUT) :: aksek(12) +real, INTENT(OUT) :: sa +real, INTENT(OUT) :: phi +real, INTENT(OUT) :: so +real, INTENT(OUT) :: stta(NCOMP) +real, INTENT(OUT) :: sttr(NCOMP) ! LOCAL VARIABLES INTEGER*4 :: i ! @@ -575,13 +575,13 @@ SUBROUTINE ronafhpar(radius, disxx, istab, s, isek, astat, s1,ids, aksek, sa, ph INTEGER*4 :: lpsek ! INTEGER*4 :: jsek ! INTEGER*4 :: scomp(14) ! -REAL*4 :: a ! -REAL*4 :: asek ! -REAL*4 :: statfactor ! -REAL*4 :: zz ! -REAL*4 :: p1 ! -REAL*4 :: p2 ! -REAL*4 :: pa ! +real :: a +real :: asek +real :: statfactor +real :: zz +real :: p1 +real :: p2 +real :: pa ! DATA ! De arrayelementen uit de meteostatistiek die hier gebruikt worden. @@ -758,24 +758,24 @@ SUBROUTINE windsek(istab, htt, disx, iwd, astat, isek, isekt, shear, htot, iwdd, ! SUBROUTINE ARGUMENTS - INPUT INTEGER*4, INTENT(IN) :: istab ! -REAL*4, INTENT(IN) :: htt ! -REAL*4, INTENT(IN) :: disx ! +real, INTENT(IN) :: htt +real, INTENT(IN) :: disx INTEGER*4, INTENT(IN) :: iwd ! -REAL*4, INTENT(IN) :: astat(NTRAJ, NCOMP, NSTAB, NSEK) ! +real, INTENT(IN) :: astat(NTRAJ, NCOMP, NSTAB, NSEK) INTEGER*4, INTENT(IN) :: isek ! ! SUBROUTINE ARGUMENTS - OUTPUT INTEGER*4, INTENT(OUT) :: isekt ! -REAL*4, INTENT(OUT) :: shear ! -REAL*4, INTENT(OUT) :: htot ! +real, INTENT(OUT) :: shear +real, INTENT(OUT) :: htot INTEGER*4, INTENT(OUT) :: iwdd ! INTEGER*4, INTENT(OUT) :: iss ! INTEGER*4, INTENT(OUT) :: is ! -REAL*4, INTENT(OUT) :: s ! +real, INTENT(OUT) :: s ! LOCAL VARIABLES -REAL*4 :: alpha ! -REAL*4 :: sek ! +real :: alpha +real :: sek ! SCCS-ID VARIABLES CHARACTER*81 :: sccsida ! @@ -904,20 +904,20 @@ SUBROUTINE windcorr(itra, istab, radius, disx, isek, iwdd, is, astat, iss, ispec ! SUBROUTINE ARGUMENTS - INPUT INTEGER*4, INTENT(IN) :: itra ! INTEGER*4, INTENT(IN) :: istab ! -REAL*4, INTENT(IN) :: radius ! -REAL*4, INTENT(IN) :: disx ! +real, INTENT(IN) :: radius +real, INTENT(IN) :: disx INTEGER*4, INTENT(IN) :: isek ! INTEGER*4, INTENT(IN) :: iwdd ! INTEGER*4, INTENT(IN) :: is ! -REAL*4, INTENT(IN) :: astat(NTRAJ, NCOMP, NSTAB, NSEK) ! +real, INTENT(IN) :: astat(NTRAJ, NCOMP, NSTAB, NSEK) ! SUBROUTINE ARGUMENTS - I/O INTEGER*4, INTENT(INOUT) :: iss ! ! SUBROUTINE ARGUMENTS - OUTPUT INTEGER*4, INTENT(OUT) :: ispecial ! -REAL*4, INTENT(OUT) :: phi ! is not used as output -REAL*4, INTENT(OUT) :: s ! +real, INTENT(OUT) :: phi ! is not used as output +real, INTENT(OUT) :: s ! LOCAL VARIABLES INTEGER*4 :: iwr ! @@ -1005,12 +1005,12 @@ SUBROUTINE interp_ctr(disx, trafst, itra, s, ids) PARAMETER (ROUTINENAAM = 'interp_ctr') ! SUBROUTINE ARGUMENTS - INPUT -REAL*4, INTENT(IN) :: disx ! -REAL*4, INTENT(IN) :: trafst(NTRAJ) ! +real, INTENT(IN) :: disx +real, INTENT(IN) :: trafst(NTRAJ) ! SUBROUTINE ARGUMENTS - OUTPUT INTEGER*4, INTENT(OUT) :: itra ! -REAL*4, INTENT(OUT) :: s(NTRAJ) ! +real, INTENT(OUT) :: s(NTRAJ) INTEGER*4, INTENT(OUT) :: ids ! ! LOCAL VARIABLES @@ -1099,17 +1099,17 @@ SUBROUTINE interp_tra(itra, s, ids, istab, iss, tal, astat, itrx, aant, stt) ! SUBROUTINE ARGUMENTS - INPUT INTEGER*4, INTENT(IN) :: itra ! -REAL*4, INTENT(IN) :: s(NTRAJ) ! +real, INTENT(IN) :: s(NTRAJ) INTEGER*4, INTENT(IN) :: ids ! index element in s dat niet 0 is. INTEGER*4, INTENT(IN) :: istab ! INTEGER*4, INTENT(IN) :: iss ! -REAL*4, INTENT(IN) :: tal(NTRAJ) ! -REAL*4, INTENT(IN) :: astat(NTRAJ, NCOMP, NSTAB, NSEK) ! +real, INTENT(IN) :: tal(NTRAJ) +real, INTENT(IN) :: astat(NTRAJ, NCOMP, NSTAB, NSEK) ! SUBROUTINE ARGUMENTS - OUTPUT INTEGER*4, INTENT(OUT) :: itrx ! -REAL*4, INTENT(OUT) :: aant ! -REAL*4, INTENT(OUT) :: stt(NCOMP) ! +real, INTENT(OUT) :: aant +real, INTENT(OUT) :: stt(NCOMP) ! LOCAL VARIABLES INTEGER*4 :: icomp ! @@ -1185,39 +1185,39 @@ SUBROUTINE interp_sek(istab, iss, itrx, is, s, isek, stt, astat, xl, vw10, rb, r INTEGER*4, INTENT(IN) :: iss ! INTEGER*4, INTENT(IN) :: itrx ! INTEGER*4, INTENT(IN) :: is ! -REAL*4, INTENT(IN) :: s ! +real, INTENT(IN) :: s INTEGER*4, INTENT(IN) :: isek ! -REAL*4, INTENT(IN) :: stt(NCOMP) ! -REAL*4, INTENT(IN) :: astat(NTRAJ, NCOMP, NSTAB, NSEK) ! +real, INTENT(IN) :: stt(NCOMP) +real, INTENT(IN) :: astat(NTRAJ, NCOMP, NSTAB, NSEK) ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT) :: xl ! -REAL*4, INTENT(OUT) :: vw10 ! -REAL*4, INTENT(OUT) :: rb ! -REAL*4, INTENT(OUT) :: ra4 ! -REAL*4, INTENT(OUT) :: ra50 ! -REAL*4, INTENT(OUT) :: xvglbr ! -REAL*4, INTENT(OUT) :: xvghbr ! -REAL*4, INTENT(OUT) :: uster_metreg_rcp ! -REAL*4, INTENT(OUT) :: temp_C ! temperature at height zmet_T [C] -REAL*4, INTENT(OUT) :: ol_metreg_rcp ! -REAL*4, INTENT(OUT) :: h0 ! -REAL*4, INTENT(OUT) :: xloc ! -REAL*4, INTENT(OUT) :: xl100 ! -REAL*4, INTENT(OUT) :: sp ! -REAL*4, INTENT(OUT) :: rad ! -REAL*4, INTENT(OUT) :: rcso2 ! -REAL*4, INTENT(OUT) :: hum ! -REAL*4, INTENT(OUT) :: pcoef ! -REAL*4, INTENT(OUT) :: rcnh3 ! -REAL*4, INTENT(OUT) :: rcno2 ! -REAL*4, INTENT(OUT) :: rcaer ! -REAL*4, INTENT(OUT) :: buil ! -REAL*4, INTENT(OUT) :: rint ! -REAL*4, INTENT(OUT) :: shear ! -REAL*4, INTENT(OUT) :: dscor(NTRAJ) ! -REAL*4, INTENT(OUT) :: coef_space_heating ! space heating coefficient (degree-day values in combination with a wind speed correction) [C m^1/2 / s^1/2] -REAL*4, INTENT(OUT) :: regenk ! +real, INTENT(OUT) :: xl +real, INTENT(OUT) :: vw10 +real, INTENT(OUT) :: rb +real, INTENT(OUT) :: ra4 +real, INTENT(OUT) :: ra50 +real, INTENT(OUT) :: xvglbr +real, INTENT(OUT) :: xvghbr +real, INTENT(OUT) :: uster_metreg_rcp +real, INTENT(OUT) :: temp_C ! temperature at height zmet_T [C] +real, INTENT(OUT) :: ol_metreg_rcp +real, INTENT(OUT) :: h0 +real, INTENT(OUT) :: xloc +real, INTENT(OUT) :: xl100 +real, INTENT(OUT) :: sp +real, INTENT(OUT) :: rad +real, INTENT(OUT) :: rcso2 +real, INTENT(OUT) :: hum +real, INTENT(OUT) :: pcoef +real, INTENT(OUT) :: rcnh3 +real, INTENT(OUT) :: rcno2 +real, INTENT(OUT) :: rcaer +real, INTENT(OUT) :: buil +real, INTENT(OUT) :: rint +real, INTENT(OUT) :: shear +real, INTENT(OUT) :: dscor(NTRAJ) +real, INTENT(OUT) :: coef_space_heating ! space heating coefficient (degree-day values in combination with a wind speed correction) [C m^1/2 / s^1/2] +real, INTENT(OUT) :: regenk ! DATA ! MENGH is default value for mixing height for 6 stability classes diff --git a/ops_surface.f90 b/ops_surface.f90 index 0e429a1..f61d56c 100644 --- a/ops_surface.f90 +++ b/ops_surface.f90 @@ -50,32 +50,32 @@ SUBROUTINE ops_surface(z0, zi, ol, uster, h, x, uh, zu, szs) PARAMETER (ROUTINENAAM = 'ops_surface') ! CONSTANTS -REAL*4 :: K ! von Karman constant +real :: K ! von Karman constant PARAMETER (K = 0.35) ! SUBROUTINE ARGUMENTS - INPUT -REAL*4, INTENT(IN) :: z0 ! roughness length (m) -REAL*4, INTENT(IN) :: zi ! mixing height (m) -REAL*4, INTENT(IN) :: ol ! Monin-Obukhov length (m) -REAL*4, INTENT(IN) :: uster ! friction velocity (m) -REAL*4, INTENT(IN) :: h ! source heigth, including plume rise (m) -REAL*4, INTENT(IN) :: x ! downwind distance (m) +real, INTENT(IN) :: z0 ! roughness length (m) +real, INTENT(IN) :: zi ! mixing height (m) +real, INTENT(IN) :: ol ! Monin-Obukhov length (m) +real, INTENT(IN) :: uster ! friction velocity (m) +real, INTENT(IN) :: h ! source heigth, including plume rise (m) +real, INTENT(IN) :: x ! downwind distance (m) ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT) :: uh ! wind speed at downwind distance x and height zu [m/s] -REAL*4, INTENT(OUT) :: zu ! representative plume height, taking into account reflection +real, INTENT(OUT) :: uh ! wind speed at downwind distance x and height zu [m/s] +real, INTENT(OUT) :: zu ! representative plume height, taking into account reflection ! at the top of the mixing layer and at the ground surface [m] -REAL*4, INTENT(OUT) :: szs ! vertical dispersion coefficient for surface layer [m] +real, INTENT(OUT) :: szs ! vertical dispersion coefficient for surface layer [m] ! LOCAL VARIABLES INTEGER*4 :: iter ! INTEGER*4 :: last ! -REAL*4 :: a ! -REAL*4 :: kz ! -REAL*4 :: phih ! -REAL*4 :: s ! -REAL*4 :: zw ! -REAL*4 :: zwold ! +real :: a +real :: kz +real :: phih +real :: s +real :: zw +real :: zwold ! SCCS-ID VARIABLES CHARACTER*81 :: sccsida ! diff --git a/ops_tra_char.f90 b/ops_tra_char.f90 index 6499114..5760bb4 100644 --- a/ops_tra_char.f90 +++ b/ops_tra_char.f90 @@ -60,10 +60,10 @@ SUBROUTINE ops_tra_char (icm, iopt_vchem, f_z0user, z0_user, nrrcp, x_rcp, y_rcp INTEGER*4, INTENT(IN) :: icm ! INTEGER*4, INTENT(IN) :: iopt_vchem ! option for chemical conversion rate (0 = old OPS, 1 = EMEP) LOGICAL, INTENT(IN) :: f_z0user ! user overwrites z0 values from meteo input -REAL*4, INTENT(IN) :: z0_user ! roughness length specified by the user [m] +real, INTENT(IN) :: z0_user ! roughness length specified by the user [m] INTEGER*4, INTENT(IN) :: nrrcp ! aantal receptorpunten -REAL*4, INTENT(IN) :: x_rcp ! array met x-coordinaat van receptorpunten (RDM) -REAL*4, INTENT(IN) :: y_rcp ! array met y-coordinaat van receptorpunten (RDM) +real, INTENT(IN) :: x_rcp ! array met x-coordinaat van receptorpunten (RDM) +real, INTENT(IN) :: y_rcp ! array met y-coordinaat van receptorpunten (RDM) INTEGER*4, INTENT(IN) :: x_src ! array met x-coordinaat van bronnen in buffer INTEGER*4, INTENT(IN) :: y_src ! array met y-coordinaat van bronnen in buffer TYPE (TApsGridInt), INTENT(IN) :: lugrid ! land use grid @@ -76,11 +76,11 @@ SUBROUTINE ops_tra_char (icm, iopt_vchem, f_z0user, z0_user, nrrcp, x_rcp, y_rcp LOGICAL, INTENT(IN) :: domlu ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT) :: z0_tra ! roughness length representative for trajectory [m] -REAL*4, INTENT(OUT) :: lu_tra_per(NLU) ! percentages of landuse classes over trajectorie (summed over intermediate points) -REAL*4, INTENT(OUT) :: so2bgtra ! -REAL*4, INTENT(OUT) :: no2bgtra ! -REAL*4, INTENT(OUT) :: nh3bgtra ! +real, INTENT(OUT) :: z0_tra ! roughness length representative for trajectory [m] +real, INTENT(OUT) :: lu_tra_per(NLU) ! percentages of landuse classes over trajectorie (summed over intermediate points) +real, INTENT(OUT) :: so2bgtra +real, INTENT(OUT) :: no2bgtra +real, INTENT(OUT) :: nh3bgtra TYPE (TError), INTENT(OUT) :: error ! error handling record ! LOCAL VARIABLES: diff --git a/ops_vertdisp.f90 b/ops_vertdisp.f90 index bf2fe96..9889008 100644 --- a/ops_vertdisp.f90 +++ b/ops_vertdisp.f90 @@ -50,29 +50,29 @@ SUBROUTINE ops_vertdisp(z0, zi, ol, uster, hh, x, uh, zu, sz, error) PARAMETER (ROUTINENAAM = 'ops_vertdisp') ! SUBROUTINE ARGUMENTS - INPUT -REAL*4, INTENT(IN) :: z0 ! roughness length (m) -REAL*4, INTENT(IN) :: zi ! mixing height (m) -REAL*4, INTENT(IN) :: ol ! Monin-Obukhov length (m) -REAL*4, INTENT(IN) :: uster ! friction velocity (m) -REAL*4, INTENT(IN) :: hh ! source heigth, including plume rise (m) -REAL*4, INTENT(IN) :: x ! downwind distance (m) +real, INTENT(IN) :: z0 ! roughness length (m) +real, INTENT(IN) :: zi ! mixing height (m) +real, INTENT(IN) :: ol ! Monin-Obukhov length (m) +real, INTENT(IN) :: uster ! friction velocity (m) +real, INTENT(IN) :: hh ! source heigth, including plume rise (m) +real, INTENT(IN) :: x ! downwind distance (m) ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT) :: uh ! windspeed at downwind distance x and height zu (m/s) -REAL*4, INTENT(OUT) :: zu ! representative plume height (m), taking into account reflection +real, INTENT(OUT) :: uh ! windspeed at downwind distance x and height zu (m/s) +real, INTENT(OUT) :: zu ! representative plume height (m), taking into account reflection ! at the top of the mixing layer and at the ground surface -REAL*4, INTENT(OUT) :: sz ! vertical dispersion coefficient (m) +real, INTENT(OUT) :: sz ! vertical dispersion coefficient (m) TYPE (TError), INTENT(INOUT) :: error ! error handling record ! LOCAL VARIABLES -REAL*4 :: h ! bronhoogte (m) -REAL*4 :: szc ! convexe dispersie (m) -REAL*4 :: szn ! neutrale dispersie -REAL*4 :: szs ! oppervlakte dispersie -REAL*4 :: fm ! -REAL*4 :: fs ! +real :: h ! bronhoogte (m) +real :: szc ! convexe dispersie (m) +real :: szn ! neutrale dispersie +real :: szs ! oppervlakte dispersie +real :: fm +real :: fs ! SUBROUTINE AND FUNCTION CALLS EXTERNAL ops_surface diff --git a/ops_virtdist.f90 b/ops_virtdist.f90 index 2d6cdd2..0d7053c 100644 --- a/ops_virtdist.f90 +++ b/ops_virtdist.f90 @@ -46,11 +46,11 @@ FUNCTION ops_virtdist (radius, rond) IMPLICIT NONE ! SUBROUTINE ARGUMENTS - INPUT -REAL*4, INTENT(IN) :: radius ! +real, INTENT(IN) :: radius INTEGER*4, INTENT(IN) :: rond ! ! RESULT -REAL*4 :: ops_virtdist ! +real :: ops_virtdist ! SCCS-ID VARIABLES CHARACTER*81 :: sccsida ! diff --git a/ops_write_progress.f90 b/ops_write_progress.f90 index 04b6e36..51d0a5a 100644 --- a/ops_write_progress.f90 +++ b/ops_write_progress.f90 @@ -50,7 +50,7 @@ SUBROUTINE ops_write_progress(progress, formatstring, numbs, memdone) PARAMETER (ROUTINENAAM = 'ops_write_progress') ! SUBROUTINE ARGUMENTS - INPUT -REAL*4, INTENT(IN) :: progress ! percentage of progress reached +real, INTENT(IN) :: progress ! percentage of progress reached CHARACTER*(*), INTENT(IN) :: formatstring ! formatstring for writing progress INTEGER*4, INTENT(IN) :: numbs ! number of characters which have to be backspaced ! in order to remain at the same position of the screen diff --git a/ops_wvprofile.f90 b/ops_wvprofile.f90 index 1160bf8..af2f26b 100644 --- a/ops_wvprofile.f90 +++ b/ops_wvprofile.f90 @@ -50,21 +50,21 @@ SUBROUTINE ops_wvprofile(z0, zu, uster, ol, uz) PARAMETER (ROUTINENAAM = 'ops_wvprofile') ! CONSTANTS -REAL*4 :: K ! von Karman constante +real :: K ! von Karman constante PARAMETER (K = 0.4) ! SUBROUTINE ARGUMENTS - INPUT -REAL*4, INTENT(IN) :: z0 ! roughness length (m) -REAL*4, INTENT(IN) :: zu ! -REAL*4, INTENT(IN) :: uster ! friction velocity (m) -REAL*4, INTENT(IN) :: ol ! Monin-Obukhov length (m) +real, INTENT(IN) :: z0 ! roughness length (m) +real, INTENT(IN) :: zu +real, INTENT(IN) :: uster ! friction velocity (m) +real, INTENT(IN) :: ol ! Monin-Obukhov length (m) ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT) :: uz ! wind velocity (m/s) +real, INTENT(OUT) :: uz ! wind velocity (m/s) ! LOCAL VARIABLES -REAL*4 :: phim ! -REAL*4 :: y ! hulpvariabele voor berekening phim +real :: phim +real :: y ! hulpvariabele voor berekening phim ! SCCS-ID VARIABLES CHARACTER*81 :: sccsida ! diff --git a/ops_z0corr.f90 b/ops_z0corr.f90 index 686446c..7491656 100644 --- a/ops_z0corr.f90 +++ b/ops_z0corr.f90 @@ -53,30 +53,30 @@ SUBROUTINE ops_z0corr(z01, uster1, ol1, z02, uster2, ol2) PARAMETER (ROUTINENAAM = 'ops_z0corr') ! CONSTANTS -REAL*4 :: C1 ! -REAL*4 :: Z ! +real :: C1 +real :: Z PARAMETER (C1 = 93500.) PARAMETER (Z = 50.) ! SUBROUTINE ARGUMENTS - INPUT -REAL*4, INTENT(IN) :: z01 ! standard roughness length [m] -REAL*4, INTENT(IN) :: uster1 ! friction velocity at standard roughness length -REAL*4, INTENT(IN) :: ol1 ! Monin-Obukhov length at standard roughness length [m] -REAL*4, INTENT(IN) :: z02 ! new roughness length [m] +real, INTENT(IN) :: z01 ! standard roughness length [m] +real, INTENT(IN) :: uster1 ! friction velocity at standard roughness length +real, INTENT(IN) :: ol1 ! Monin-Obukhov length at standard roughness length [m] +real, INTENT(IN) :: z02 ! new roughness length [m] ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT) :: uster2 ! friction velocity at new roughness length -REAL*4, INTENT(OUT) :: ol2 ! Monin-Obukhov length at standard roughness length [m] +real, INTENT(OUT) :: uster2 ! friction velocity at new roughness length +real, INTENT(OUT) :: ol2 ! Monin-Obukhov length at standard roughness length [m] ! LOCAL VARIABLES INTEGER*4 :: n ! iteration index -REAL*4 :: h0 ! -REAL*4 :: delta ! difference between old and new iterand for uster2 -REAL*4 :: phim ! -REAL*4 :: u50 ! wind speed at 50 m height -REAL*4 :: uold ! uster at previous iteration -REAL*4 :: delta_old ! old difference between old and new iterand for uster2 -REAL*4 :: ur ! ratio uster/uold +real :: h0 +real :: delta ! difference between old and new iterand for uster2 +real :: phim +real :: u50 ! wind speed at 50 m height +real :: uold ! uster at previous iteration +real :: delta_old ! old difference between old and new iterand for uster2 +real :: ur ! ratio uster/uold ! SCCS-ID VARIABLES CHARACTER*81 :: sccsida ! @@ -185,14 +185,14 @@ SUBROUTINE stabcm(h, ol, phim) PARAMETER (ROUTINENAAM = 'stabcm') ! SUBROUTINE ARGUMENTS - INPUT -REAL*4, INTENT(IN) :: h ! hoogte -REAL*4, INTENT(IN) :: ol ! Monin Obukhovlengte +real, INTENT(IN) :: h ! hoogte +real, INTENT(IN) :: ol ! Monin Obukhovlengte ! SUBROUTINE ARGUMENTS - OUTPUT -REAL*4, INTENT(OUT) :: phim ! correctiefactor +real, INTENT(OUT) :: phim ! correctiefactor ! LOCAL VARIABLES -REAL*4 :: y ! hulpvariabele voor berekening +real :: y ! hulpvariabele voor berekening ! SCCS-ID VARIABLES CHARACTER*81 :: sccsida !