! $Id: soilnoxems.f,v 1.7 2006/11/07 19:02:03 bmy Exp $ MODULE SNOWNOX_MOD !****************************************************************************** ! Subroutine SNOWNOXEMS computes the emission of NOx from the Antarctic snowpack ! from photodenitrification for the GEOS-CHEM model. (bec, 10/06/11) ! ! Arguments as Input: ! ============================================================================ ! (1 ) SUNCOS (REAL*8) : Array for COSINE( solar zenith angle ) [unitless] ! ! Other Important variables (mostly via common blocks or F90 modules) ! ============================================================================ ! (1 ) IJLOOP (INTEGER) : Grid-box number ! (2 ) JLOP (INTEGER) : Index to IJLOOP; for a given I,J ! (13) SOILTEMP (REAL*8 ) : Temperature factor (external function) ! (14) TMMPK (REAL*8 ) : Local air temperature (K), w/ diurnal variation ! (18) BXHEIGHT (REAL*8 ) : Grid-box height [m] ! (19) SNOWNOX (REAL*8 ) : Output [molec NOx/cm2/s] ! ! References: ! ============================================================================ ! (1 ) France et al [2011] ! (2 ) Frey et al in prep ! ! NOTES: ! (1 ) Be sure to force double precision with the DBLE function and the "D" ! exponent, wherever necessary (bmy, 10/6/99) ! (2 ) Made JLOP a local variable, so as not to have to reference it from ! "comode.h". "comode.h" should be only for SMVGEAR. (bmy, 10/19/00) ! (3 ) Now save soil NOx into GEMISNOX2 array (bdf, bmy, 6/15/01) ! (4 ) Replaced IM with IIPAR and JM with JJPAR (bmy, 6/25/02) ! (5 ) Now reference BXHEIGHT from "dao_mod.f". Also updated comments and ! made cosmetic changes. (bmy, 9/18/02) !****************************************************************************** IMPLICIT NONE # include "define.h" !Make everything private... PRIVATE !Except these subroutines PUBLIC :: SNOWNOXEMS !================================================================= ! MODULE VARIABLES (see descriptions listed above) !================================================================= !Allocatable arrays (PUBLIC) REAL*8, PUBLIC, ALLOCATABLE :: DIRRAD289298(:,:) !Direct downwelling incident irradiance 289-298 nm (units of photons/cm^2*s) REAL*8, PUBLIC, ALLOCATABLE :: DIRRAD298307(:,:) !Direct downwelling incident irradiance 298-307 nm REAL*8, PUBLIC, ALLOCATABLE :: DIRRAD307312(:,:) !Direct downwelling incident irradiance 307-312 nm REAL*8, PUBLIC, ALLOCATABLE :: DIRRAD312320(:,:) !Direct downwelling incident irradiance 312-320 nm REAL*8, PUBLIC, ALLOCATABLE :: DIRRAD320345(:,:) !Direct downwelling incident irradiance 320-345 nm REAL*8, PUBLIC, ALLOCATABLE :: DIRRAD345412(:,:) !Direct downwelling incident irradiance 345-412 nm REAL*8, PUBLIC, ALLOCATABLE :: DIRRAD412850(:,:) !Direct downwelling incident irradiance 412-850 nm REAL*8, PUBLIC, ALLOCATABLE :: DIFRAD289298(:,:) !Diffuse downwelling incident irradiance 289-298 nm REAL*8, PUBLIC, ALLOCATABLE :: DIFRAD298307(:,:) !Diffuse downwelling incident irradiance 298-307 nm REAL*8, PUBLIC, ALLOCATABLE :: DIFRAD307312(:,:) !Diffuse downwelling incident irradiance 307-312 nm REAL*8, PUBLIC, ALLOCATABLE :: DIFRAD312320(:,:) !Diffuse downwelling incident irradiance 312-320 nm REAL*8, PUBLIC, ALLOCATABLE :: DIFRAD320345(:,:) !Diffuse downwelling incident irradiance 320-345 nm REAL*8, PUBLIC, ALLOCATABLE :: DIFRAD345412(:,:) !Diffuse downwelling incident irradiance 345-412 nm REAL*8, PUBLIC, ALLOCATABLE :: DIFRAD412850(:,:) !Diffuse downwelling incident irradiance 412-850 nm REAL*8, PUBLIC, ALLOCATABLE :: UO(:,:) !cosine of the solar zenith angle !Allocatable arrays (PRIVATE) REAL*8, ALLOCATABLE :: FTOT_298to307_A(:,:) !Total downwelling incident radiation for 298-307nm REAL*8, ALLOCATABLE :: FTOT_307to312_A(:,:) !Total downwelling incident radiation for 307-312nm REAL*8, ALLOCATABLE :: FTOT_312to320_A(:,:) !Total downwelling incident radiation for 312-320nm REAL*8, ALLOCATABLE :: FTOT_320to345_A(:,:) !Total downwelling incident radiation for 320-345nm REAL*8, ALLOCATABLE :: FTOT_298to307_G(:,:) !Total downwelling incident radiation for 298-307nm REAL*8, ALLOCATABLE :: FTOT_307to312_G(:,:) !Total downwelling incident radiation for 307-312nm REAL*8, ALLOCATABLE :: FTOT_312to320_G(:,:) !Total downwelling incident radiation for 312-320nm REAL*8, ALLOCATABLE :: FTOT_320to345_G(:,:) !Total downwelling incident radiation for 320-345nm REAL*8, ALLOCATABLE :: FDIF_298to307_A(:,:) !Fraction of diffuse to total downwelling incident radiation for 298-307nm REAL*8, ALLOCATABLE :: FDIF_307to312_A(:,:) !Fraction of diffuse to total downwelling incident radiation for 307-312nm REAL*8, ALLOCATABLE :: FDIF_312to320_A(:,:) !Fraction of diffuse to total downwelling incident radiation for 312-320nm REAL*8, ALLOCATABLE :: FDIF_320to345_A(:,:) !Fraction of diffuse to total downwelling incident radiation for 320-345nm REAL*8, ALLOCATABLE :: FDIF_298to307_G(:,:) !Fraction of diffuse to total downwelling incident radiation for 298-307nm REAL*8, ALLOCATABLE :: FDIF_307to312_G(:,:) !Fraction of diffuse to total downwelling incident radiation for 307-312nm REAL*8, ALLOCATABLE :: FDIF_312to320_G(:,:) !Fraction of diffuse to total downwelling incident radiation for 312-320nm REAL*8, ALLOCATABLE :: FDIF_320to345_G(:,:) !Fraction of diffuse to total downwelling incident radiation for 320-345nm REAL*8, ALLOCATABLE :: DIRRAD_298345_A(:,:) !Total downwelling incident radiation for 298-345 nm REAL*8, ALLOCATABLE :: DIFRAD_298345_A(:,:) !Total downwelling incident radiation for 298-345 nm REAL*8, ALLOCATABLE :: DIRRAD_298345_G(:,:) !Total downwelling incident radiation for 298-345 nm REAL*8, ALLOCATABLE :: DIFRAD_298345_G(:,:) !Total downwelling incident radiation for 298-345 nm REAL*8, ALLOCATABLE :: UO_A(:,:) !Solar zenith angle REAL*8, ALLOCATABLE :: UO_G(:,:) !Solar zenith angle REAL*8, ALLOCATABLE :: UO_1(:,:) !Solar zenith angle REAL*8, ALLOCATABLE :: FDIF_298to345_A(:,:) !Fraction of diffuse radiation for 298-345 nm REAL*8, ALLOCATABLE :: FDIF_298to345_G(:,:) !Fraction of diffuse radiation for 298-345 nm REAL*8, ALLOCATABLE :: FDIF_298to345(:,:) !Fraction of diffuse radiation for 298-345 nm REAL*8, ALLOCATABLE :: FTOT_298to345_A(:,:) !Fraction of diffuse radiation for 298-345 nm REAL*8, ALLOCATABLE :: FTOT_298to345_G(:,:) !Fraction of diffuse radiation for 298-345 nm REAL*8, ALLOCATABLE :: FTOT_298to345(:,:) !Fraction of diffuse radiation for 298-345 nm REAL*8, ALLOCATABLE :: ANNACC1(:,:,:) !Annual Accumulation REAL*8, ALLOCATABLE :: FRACPD1(:,:,:) !Fraction dry to total nitrate deposition (with photodenitrification) REAL*8, ALLOCATABLE :: FRACNOPD1(:,:,:) !Fraction dry to total nitrate deposition (without photodenitrification) REAL*8, ALLOCATABLE :: SNOWBC1(:,:,:) !Annual Average Snow BC conc. REAL*8, ALLOCATABLE :: NITRATE_ANN1(:,:,:) !Annual mean snow nitrate concentration (ppb) REAL*8, ALLOCATABLE :: CBC_A(:,:) !concentration of BC in remote Antarctica REAL*8, ALLOCATABLE :: CBC_G(:,:) !concentration of BC in remote Greenland REAL*8, ALLOCATABLE :: CBC(:,:) !concentration of BC for both Antarctica and Greenland REAL*8, ALLOCATABLE :: phi_vary_A(:,:) !Temperature dependent quantum yield for nitrate photolysis REAL*8, ALLOCATABLE :: phi_vary_G(:,:) !Temperature dependent quantum yield for nitrate photolysis REAL*8, ALLOCATABLE :: LmaxBC_A(:,:) !maximum BC filter loading in remote Antarctica (g/m^2) REAL*8, ALLOCATABLE :: LmaxBC_G(:,:) !maximum BC filter loading in remote Summit (g/m^2) REAL*8, ALLOCATABLE :: LBC_A(:,:) !BC filter loading in remote Antarctica (g/m^2 REAL*8, ALLOCATABLE :: LBC_G(:,:) !BC filter loading in remote Greenland (g/m^2) REAL*8, ALLOCATABLE :: tautot_A675(:,:) !total optical depth at 675 nm on filters in remote Antarctica REAL*8, ALLOCATABLE :: tautot_G675(:,:) !total optical depth at 675 nm on filters in remote Greenland REAL*8, ALLOCATABLE :: tauBC_A675(:,:) !BC optical depth at 675 nm on filters in remote Antarctica REAL*8, ALLOCATABLE :: tauBC_G675(:,:) !BC optical depth at 675 nm on filters in remote Greenland REAL*8, ALLOCATABLE :: taunonBC_A675(:,:) !nonBC optical depth at 675 nm on filters in remote Antarctica REAL*8, ALLOCATABLE :: taunonBC_G675(:,:) !nonBC optical depth at 675 nm on filters in remote Greenland REAL*8, ALLOCATABLE :: tauBC_A298(:,:) !BC optical depth in remote Antarctica for 298 nm REAL*8, ALLOCATABLE :: tauBC_A307(:,:) !BC optical depth in remote Antarctica for 307 nm REAL*8, ALLOCATABLE :: tauBC_A312(:,:) !BC optical depth in remote Antarctica for 312 nm REAL*8, ALLOCATABLE :: tauBC_A320(:,:) !BC optical depth in remote Antarctica for 320 nm REAL*8, ALLOCATABLE :: tauBC_A345(:,:) !BC optical depth in remote Antarctica for 345 nm REAL*8, ALLOCATABLE :: tauBC_G298(:,:) !BC optical depth in remote Greenland for 298 nm REAL*8, ALLOCATABLE :: tauBC_G307(:,:) !BC optical depth in remote Greenland for 307 nm REAL*8, ALLOCATABLE :: tauBC_G312(:,:) !BC optical depth in remote Greenland for 312 nm REAL*8, ALLOCATABLE :: tauBC_G320(:,:) !BC optical depth in remote Greenland for 320 nm REAL*8, ALLOCATABLE :: tauBC_G345(:,:) !BC optical depth in remote Greenland for 345 nm REAL*8, ALLOCATABLE :: taunonBC_A298(:,:) !nonBC optical depth in remote Antarctica for 298 nm REAL*8, ALLOCATABLE :: taunonBC_A307(:,:) !nonBC optical depth in remote Antarctica for 307 nm REAL*8, ALLOCATABLE :: taunonBC_A312(:,:) !nonBC optical depth in remote Antarctica for 312 nm REAL*8, ALLOCATABLE :: taunonBC_A320(:,:) !nonBC optical depth in remote Antarctica for 320 nm REAL*8, ALLOCATABLE :: taunonBC_A345(:,:) !nonBC optical depth in remote Antarctica for 345 nm REAL*8, ALLOCATABLE :: taunonBC_G298(:,:) !nonBC optical depth in remote Greenland for 298 nm REAL*8, ALLOCATABLE :: taunonBC_G307(:,:) !nonBC optical depth in remote Greenland for 307 nm REAL*8, ALLOCATABLE :: taunonBC_G312(:,:) !nonBC optical depth in remote Greenland for 312 nm REAL*8, ALLOCATABLE :: taunonBC_G320(:,:) !nonBC optical depth in remote Greenland for 320 nm REAL*8, ALLOCATABLE :: taunonBC_G345(:,:) !nonBC optical depth in remote Greenland for 345 nm REAL*8, ALLOCATABLE :: KextnonBC_A298(:,:,:) !Extinction coefficient of nonBC in remote Antarctica for 298 nm (1/m) REAL*8, ALLOCATABLE :: KextnonBC_A307(:,:,:) !Extinction coefficient of nonBC in remote Antarctica for 307 nm (1/m) REAL*8, ALLOCATABLE :: KextnonBC_A312(:,:,:) !Extinction coefficient of nonBC in remote Antarctica for 312 nm (1/m) REAL*8, ALLOCATABLE :: KextnonBC_A320(:,:,:) !Extinction coefficient of nonBC in remote Antarctica for 320 nm (1/m) REAL*8, ALLOCATABLE :: KextnonBC_A345(:,:,:) !Extinction coefficient of nonBC in remote Antarctica for 345 nm (1/m) REAL*8, ALLOCATABLE :: KextnonBC_G298(:,:,:) !Extinction coefficient of nonBC in remote Greenland for 298 nm (1/m) REAL*8, ALLOCATABLE :: KextnonBC_G307(:,:,:) !Extinction coefficient of nonBC in remote Greenland for 307 nm (1/m) REAL*8, ALLOCATABLE :: KextnonBC_G312(:,:,:) !Extinction coefficient of nonBC in remote Greenland for 312 nm (1/m) REAL*8, ALLOCATABLE :: KextnonBC_G320(:,:,:) !Extinction coefficient of nonBC in remote Greenland for 320 nm (1/m) REAL*8, ALLOCATABLE :: KextnonBC_G345(:,:,:) !Extinction coefficient of nonBC in remote Greenland for 345 nm (1/m) REAL*8, ALLOCATABLE :: KextBC_A298(:,:,:) !Extinction coefficient of BC in remote Antarctica for 298 nm (1/m) REAL*8, ALLOCATABLE :: KextBC_A307(:,:,:) !Extinction coefficient of BC in remote Antarctica for 307 nm (1/m) REAL*8, ALLOCATABLE :: KextBC_A312(:,:,:) !Extinction coefficient of BC in remote Antarctica for 312 nm (1/m) REAL*8, ALLOCATABLE :: KextBC_A320(:,:,:) !Extinction coefficient of BC in remote Antarctica for 320 nm (1/m) REAL*8, ALLOCATABLE :: KextBC_A345(:,:,:) !Extinction coefficient of BC in remote Antarctica for 345 nm (1/m) REAL*8, ALLOCATABLE :: KextBC_G298(:,:,:) !Extinction coefficient of BC in remote Greenland for 298 nm (1/m) REAL*8, ALLOCATABLE :: KextBC_G307(:,:,:) !Extinction coefficient of BC in remote Greenland for 307 nm (1/m) REAL*8, ALLOCATABLE :: KextBC_G312(:,:,:) !Extinction coefficient of BC in remote Greenland for 312 nm (1/m) REAL*8, ALLOCATABLE :: KextBC_G320(:,:,:) !Extinction coefficient of BC in remote Greenland for 320 nm (1/m) REAL*8, ALLOCATABLE :: KextBC_G345(:,:,:) !Extinction coefficient of BC in remote Greenland for 345 nm (1/m) REAL*8, ALLOCATABLE :: Kextsnow_A298(:,:,:) !Extinction coefficient of snow in remote Antarctica for 298 nm (1/m) REAL*8, ALLOCATABLE :: Kextsnow_A307(:,:,:) !Extinction coefficient of snow in remote Antarctica for 307 nm (1/m) REAL*8, ALLOCATABLE :: Kextsnow_A312(:,:,:) !Extinction coefficient of snow in remote Antarctica for 312 nm (1/m) REAL*8, ALLOCATABLE :: Kextsnow_A320(:,:,:) !Extinction coefficient of snow in remote Antarctica for 320 nm (1/m) REAL*8, ALLOCATABLE :: Kextsnow_A345(:,:,:) !Extinction coefficient of snow in remote Antarctica for 345 nm (1/m) REAL*8, ALLOCATABLE :: Kextsnow_G298(:,:,:) !Extinction coefficient of snow in remote Greenland for 298 nm (1/m) REAL*8, ALLOCATABLE :: Kextsnow_G307(:,:,:) !Extinction coefficient of snow in remote Greenland for 307 nm (1/m) REAL*8, ALLOCATABLE :: Kextsnow_G312(:,:,:) !Extinction coefficient of snow in remote Greenland for 312 nm (1/m) REAL*8, ALLOCATABLE :: Kextsnow_G320(:,:,:) !Extinction coefficient of snow in remote Greenland for 320 nm (1/m) REAL*8, ALLOCATABLE :: Kextsnow_G345(:,:,:) !Extinction coefficient of snow in remote Greenland for 345 nm (1/m) REAL*8, ALLOCATABLE :: Kexttot_A298(:,:,:) !Extinction coefficient in remote Antarctica for 298 nm (1/m) REAL*8, ALLOCATABLE :: Kexttot_A307(:,:,:) !Extinction coefficient in remote Antarctica for 307 nm (1/m) REAL*8, ALLOCATABLE :: Kexttot_A312(:,:,:) !Extinction coefficient in remote Antarctica for 312 nm (1/m) REAL*8, ALLOCATABLE :: Kexttot_A320(:,:,:) !Extinction coefficient in remote Antarctica for 320 nm (1/m) REAL*8, ALLOCATABLE :: Kexttot_A345(:,:,:) !Extinction coefficient in remote Antarctica for 345 nm (1/m) REAL*8, ALLOCATABLE :: Kexttot_G298(:,:,:) !Extinction coefficient in remote Greenland for 298 nm (1/m) REAL*8, ALLOCATABLE :: Kexttot_G307(:,:,:) !Extinction coefficient in remote Greenland for 307 nm (1/m) REAL*8, ALLOCATABLE :: Kexttot_G312(:,:,:) !Extinction coefficient in remote Greenland for 312 nm (1/m) REAL*8, ALLOCATABLE :: Kexttot_G320(:,:,:) !Extinction coefficient in remote Greenland for 320 nm (1/m) REAL*8, ALLOCATABLE :: Kexttot_G345(:,:,:) !Extinction coefficient in remote Greenland for 345 nm (1/m) REAL*8, ALLOCATABLE :: re_vert(:,:,:) !vertical profile of snow grain radius REAL*8, ALLOCATABLE :: re_vertG(:,:,:) !vertical profile of snow grain radius for Greenland REAL*8, ALLOCATABLE :: SNOWDENSITY_V(:,:,:) !vertical profile of snow density - average snow density at Dome C from Gallet et al. [2011] REAL*8, ALLOCATABLE :: zde(:,:,:) !depth REAL*8, ALLOCATABLE :: cweff_A298(:,:,:) !effective co-albedo of single scattering at 298 nm for Antarctica (unitless) REAL*8, ALLOCATABLE :: cweff_A307(:,:,:) !effective co-albedo of single scattering at 307 nm for Antarctica (unitless) REAL*8, ALLOCATABLE :: cweff_A312(:,:,:) !effective co-albedo of single scattering at 312 nm for Antarctica (unitless) REAL*8, ALLOCATABLE :: cweff_A320(:,:,:) !effective co-albedo of single scattering at 320 nm for Antarctica (unitless) REAL*8, ALLOCATABLE :: cweff_A345(:,:,:) !effective co-albedo of single scattering at 345 nm for Antarctica (unitless) REAL*8, ALLOCATABLE :: cweff_G298(:,:,:) !effective co-albedo of single scattering at 298 nm for Greenland (unitless) REAL*8, ALLOCATABLE :: cweff_G307(:,:,:) !effective co-albedo of single scattering at 307 nm for Greenland (unitless) REAL*8, ALLOCATABLE :: cweff_G312(:,:,:) !effective co-albedo of single scattering at 312 nm for Greenland (unitless) REAL*8, ALLOCATABLE :: cweff_G320(:,:,:) !effective co-albedo of single scattering at 320 nm for Greenland (unitless) REAL*8, ALLOCATABLE :: cweff_G345(:,:,:) !effective co-albedo of single scattering at 345 nm for Greenland (unitless) REAL*8, ALLOCATABLE :: Y_A298(:,:,:) !attenuation coefficient for diffuse radiation at 298 nm for Antarctica (unitless) REAL*8, ALLOCATABLE :: Y_A307(:,:,:) !attenuation coefficient for diffuse radiation at 307 nm for Antarctica (unitless) REAL*8, ALLOCATABLE :: Y_A312(:,:,:) !attenuation coefficient for diffuse radiation at 312 nm for Antarctica (unitless) REAL*8, ALLOCATABLE :: Y_A320(:,:,:) !attenuation coefficient for diffuse radiation at 320 nm for Antarctica (unitless) REAL*8, ALLOCATABLE :: Y_A345(:,:,:) !attenuation coefficient for diffuse radiation at 345 nm for Antarctica (unitless) REAL*8, ALLOCATABLE :: Y_G298(:,:,:) !attenuation coefficient for diffuse radiation at 298 nm for Greenland (unitless) REAL*8, ALLOCATABLE :: Y_G307(:,:,:) !attenuation coefficient for diffuse radiation at 307 nm for Greenland (unitless) REAL*8, ALLOCATABLE :: Y_G312(:,:,:) !attenuation coefficient for diffuse radiation at 312 nm for Greenland (unitless) REAL*8, ALLOCATABLE :: Y_G320(:,:,:) !attenuation coefficient for diffuse radiation at 320 nm for Greenland (unitless) REAL*8, ALLOCATABLE :: Y_G345(:,:,:) !attenuation coefficient for diffuse radiation at 345 nm for Greenland (unitless) REAL*8, ALLOCATABLE :: Y_A298to307(:,:,:) !attenuation coefficient for diffuse radiation at 298 nm for Antarctica (unitless) REAL*8, ALLOCATABLE :: Y_A307to312(:,:,:) !attenuation coefficient for diffuse radiation at 307 nm for Antarctica (unitless) REAL*8, ALLOCATABLE :: Y_A312to320(:,:,:) !attenuation coefficient for diffuse radiation at 312 nm for Antarctica (unitless) REAL*8, ALLOCATABLE :: Y_A320to345(:,:,:) !attenuation coefficient for diffuse radiation at 320 nm for Antarctica (unitless) REAL*8, ALLOCATABLE :: Y_G298to307(:,:,:) !attenuation coefficient for diffuse radiation at 298 nm for Greenland (unitless) REAL*8, ALLOCATABLE :: Y_G307to312(:,:,:) !attenuation coefficient for diffuse radiation at 307 nm for Greenland (unitless) REAL*8, ALLOCATABLE :: Y_G312to320(:,:,:) !attenuation coefficient for diffuse radiation at 312 nm for Greenland (unitless) REAL*8, ALLOCATABLE :: Y_G320to345(:,:,:) !attenuation coefficient for diffuse radiation at 320 nm for Greenland (unitless) REAL*8, ALLOCATABLE :: Io_z_A298to307(:,:,:) !Actinic flux below valid below zref for 298-307 nm (photons cm^-2 s^-1 nm^-1) REAL*8, ALLOCATABLE :: Io_z_A307to312(:,:,:) !Actinic flux below valid below zref for 307-312 nm (photons cm^-2 s^-1 nm^-1) REAL*8, ALLOCATABLE :: Io_z_A312to320(:,:,:) !Actinic flux below valid below zref for 312-320 nm (photons cm^-2 s^-1 nm^-1) REAL*8, ALLOCATABLE :: Io_z_A320to345(:,:,:) !Actinic flux below valid below zref for 320-345 nm (photons cm^-2 s^-1 nm^-1) REAL*8, ALLOCATABLE :: Io_z_G298to307(:,:,:) !Actinic flux below valid below zref for 298-307 nm (photons cm^-2 s^-1 nm^-1) REAL*8, ALLOCATABLE :: Io_z_G307to312(:,:,:) !Actinic flux below valid below zref for 307-312 nm (photons cm^-2 s^-1 nm^-1) REAL*8, ALLOCATABLE :: Io_z_G312to320(:,:,:) !Actinic flux below valid below zref for 312-320 nm (photons cm^-2 s^-1 nm^-1) REAL*8, ALLOCATABLE :: Io_z_G320to345(:,:,:) !Actinic flux below valid below zref for 320-345 nm (photons cm^-2 s^-1 nm^-1) REAL*8, ALLOCATABLE :: Io_0_A298to307(:,:,:) !Actinic flux at the snow surface (z=0)for 298-307 nm (photons cm^-2 s^-1 nm^-1) REAL*8, ALLOCATABLE :: Io_0_A307to312(:,:,:) !Actinic flux at the snow surface (z=0)for 307-312 nm (photons cm^-2 s^-1 nm^-1) REAL*8, ALLOCATABLE :: Io_0_A312to320(:,:,:) !Actinic flux at the snow surface (z=0)for 312-320 nm (photons cm^-2 s^-1 nm^-1) REAL*8, ALLOCATABLE :: Io_0_A320to345(:,:,:) !Actinic flux at the snow surface (z=0)for 320-345 nm (photons cm^-2 s^-1 nm^-1) REAL*8, ALLOCATABLE :: Io_0_G298to307(:,:,:) !Actinic flux at the snow surface (z=0)for 298-307 nm (photons cm^-2 s^-1 nm^-1) REAL*8, ALLOCATABLE :: Io_0_G307to312(:,:,:) !Actinic flux at the snow surface (z=0)for 307-312 nm (photons cm^-2 s^-1 nm^-1) REAL*8, ALLOCATABLE :: Io_0_G312to320(:,:,:) !Actinic flux at the snow surface (z=0)for 312-320 nm (photons cm^-2 s^-1 nm^-1) REAL*8, ALLOCATABLE :: Io_0_G320to345(:,:,:) !Actinic flux at the snow surface (z=0)for 320-345 nm (photons cm^-2 s^-1 nm^-1) REAL*8, ALLOCATABLE :: Io_0_A298to307_1(:,:) !Actinic flux at the snow surface (z=0)for 298-307 nm (photons cm^-2 s^-1 nm^-1) REAL*8, ALLOCATABLE :: Io_0_A307to312_1(:,:) !Actinic flux at the snow surface (z=0)for 307-312 nm (photons cm^-2 s^-1 nm^-1) REAL*8, ALLOCATABLE :: Io_0_A312to320_1(:,:) !Actinic flux at the snow surface (z=0)for 312-320 nm (photons cm^-2 s^-1 nm^-1) REAL*8, ALLOCATABLE :: Io_0_A320to345_1(:,:) !Actinic flux at the snow surface (z=0)for 320-345 nm (photons cm^-2 s^-1 nm^-1) REAL*8, ALLOCATABLE :: Io_0_G298to307_1(:,:) !Actinic flux at the snow surface (z=0)for 298-307 nm (photons cm^-2 s^-1 nm^-1) REAL*8, ALLOCATABLE :: Io_0_G307to312_1(:,:) !Actinic flux at the snow surface (z=0)for 307-312 nm (photons cm^-2 s^-1 nm^-1) REAL*8, ALLOCATABLE :: Io_0_G312to320_1(:,:) !Actinic flux at the snow surface (z=0)for 312-320 nm (photons cm^-2 s^-1 nm^-1) REAL*8, ALLOCATABLE :: Io_0_G320to345_1(:,:) !Actinic flux at the snow surface (z=0)for 320-345 nm (photons cm^-2 s^-1 nm^-1) REAL*8, ALLOCATABLE :: Io_1_A298to307(:,:,:) !Actinic flux at 1 cm depth for 298-307 nm (photons cm^-2 s^-1 nm^-1) REAL*8, ALLOCATABLE :: Io_1_A307to312(:,:,:) !Actinic flux at 1 cm depth for 307-312 nm (photons cm^-2 s^-1 nm^-1) REAL*8, ALLOCATABLE :: Io_1_A312to320(:,:,:) !Actinic flux at 1 cm depth for 312-320 nm (photons cm^-2 s^-1 nm^-1) REAL*8, ALLOCATABLE :: Io_1_A320to345(:,:,:) !Actinic flux at 1 cm depth for 320-345 nm (photons cm^-2 s^-1 nm^-1) REAL*8, ALLOCATABLE :: Io_1_G298to307(:,:,:) !Actinic flux at 1 cm depth for 298-307 nm (photons cm^-2 s^-1 nm^-1) REAL*8, ALLOCATABLE :: Io_1_G307to312(:,:,:) !Actinic flux at 1 cm depth for 307-312 nm (photons cm^-2 s^-1 nm^-1) REAL*8, ALLOCATABLE :: Io_1_G312to320(:,:,:) !Actinic flux at 1 cm depth for 312-320 nm (photons cm^-2 s^-1 nm^-1) REAL*8, ALLOCATABLE :: Io_1_G320to345(:,:,:) !Actinic flux at 1 cm depth for 320-345 nm (photons cm^-2 s^-1 nm^-1) REAL*8, ALLOCATABLE :: Io_1_A298to307_1(:,:) !Actinic flux at 1 cm depth for 298-307 nm (photons cm^-2 s^-1 nm^-1) REAL*8, ALLOCATABLE :: Io_1_A307to312_1(:,:) !Actinic flux at 1 cm depth for 307-312 nm (photons cm^-2 s^-1 nm^-1) REAL*8, ALLOCATABLE :: Io_1_A312to320_1(:,:) !Actinic flux at 1 cm depth for 312-320 nm (photons cm^-2 s^-1 nm^-1) REAL*8, ALLOCATABLE :: Io_1_A320to345_1(:,:) !Actinic flux at 1 cm depth for 320-345 nm (photons cm^-2 s^-1 nm^-1) REAL*8, ALLOCATABLE :: Io_1_G298to307_1(:,:) !Actinic flux at 1 cm depth for 298-307 nm (photons cm^-2 s^-1 nm^-1) REAL*8, ALLOCATABLE :: Io_1_G307to312_1(:,:) !Actinic flux at 1 cm depth for 307-312 nm (photons cm^-2 s^-1 nm^-1) REAL*8, ALLOCATABLE :: Io_1_G312to320_1(:,:) !Actinic flux at 1 cm depth for 312-320 nm (photons cm^-2 s^-1 nm^-1) REAL*8, ALLOCATABLE :: Io_1_G320to345_1(:,:) !Actinic flux at 1 cm depth for 320-345 nm (photons cm^-2 s^-1 nm^-1) REAL*8, ALLOCATABLE :: pefold_A298to307(:,:) !The value of the actinic flux at 1 efolding depth REAL*8, ALLOCATABLE :: pefold_A307to312(:,:) !The value of the actinic flux at 1 efolding depth REAL*8, ALLOCATABLE :: pefold_A312to320(:,:) !The value of the actinic flux at 1 efolding depth REAL*8, ALLOCATABLE :: pefold_A320to345(:,:) !The value of the actinic flux at 1 efolding depth REAL*8, ALLOCATABLE :: pefold_G298to307(:,:) !The value of the actinic flux at 1 efolding depth REAL*8, ALLOCATABLE :: pefold_G307to312(:,:) !The value of the actinic flux at 1 efolding depth REAL*8, ALLOCATABLE :: pefold_G312to320(:,:) !The value of the actinic flux at 1 efolding depth REAL*8, ALLOCATABLE :: pefold_G320to345(:,:) !The value of the actinic flux at 1 efolding depth REAL*8, ALLOCATABLE :: efold_A298to307(:,:) !e-folding depth of actinic flux in Antarctica at 298 to 307 nm REAL*8, ALLOCATABLE :: efold_A307to312(:,:) !e-folding depth of actinic flux in Antarctica at 307 to 312 nm REAL*8, ALLOCATABLE :: efold_A312to320(:,:) !e-folding depth of actinic flux in Antarctica at 312 to 320 nm REAL*8, ALLOCATABLE :: efold_A320to345(:,:) !e-folding depth of actinic flux in Antarctica at 320 to 345 nm REAL*8, ALLOCATABLE :: efold_G298to307(:,:) !e-folding depth of actinic flux in Greenland at 298 to 307 nm REAL*8, ALLOCATABLE :: efold_G307to312(:,:) !e-folding depth of actinic flux in Greenland at 307 to 312 nm REAL*8, ALLOCATABLE :: efold_G312to320(:,:) !e-folding depth of actinic flux in Greenland at 312 to 320 nm REAL*8, ALLOCATABLE :: efold_G320to345(:,:) !e-folding depth of actinic flux in Greenland at 320 to 345 nm REAL*8, ALLOCATABLE :: zvent_A298to307(:,:) !3 x e-folding depth of actinic flux in Antarctic snow for 298 to 307 nm REAL*8, ALLOCATABLE :: zvent_A307to312(:,:) !3 x e-folding depth of actinic flux in Antarctic snow for 307 to 312 nm REAL*8, ALLOCATABLE :: zvent_A312to320(:,:) !3 x e-folding depth of actinic flux in Antarctic snow for 312 to 320 nm REAL*8, ALLOCATABLE :: zvent_A320to345(:,:) !3 x e-folding depth of actinic flux in Antarctic snow for 320 to 345 nm REAL*8, ALLOCATABLE :: zvent_G298to307(:,:) !3 x e-folding depth of actinic flux in Antarctic snow for 298 to 307 nm REAL*8, ALLOCATABLE :: zvent_G307to312(:,:) !3 x e-folding depth of actinic flux in Antarctic snow for 307 to 312 nm REAL*8, ALLOCATABLE :: zvent_G312to320(:,:) !3 x e-folding depth of actinic flux in Antarctic snow for 312 to 320 nm REAL*8, ALLOCATABLE :: zvent_G320to345(:,:) !3 x e-folding depth of actinic flux in Antarctic snow for 320 to 345 nm REAL*8, ALLOCATABLE :: PhotolyticZoneA(:,:) !Photolytic zone averaged from 298-345 nm in Antarctica REAL*8, ALLOCATABLE :: PhotolyticZoneG(:,:) !Photolytic zone averaged from 298-345 nm in Greenland REAL*8, ALLOCATABLE :: PhotolyticZone(:,:) !Photolytic zone averaged from 298-345 nm for Antarctica and Greenland REAL*8, ALLOCATABLE :: Io_02_A298to307(:,:,:) ! Integrated Actinic Flux in top 2 cm for 298 to 307 nm in Antarctica (photons cm^-1 s^-1 nm^-1) REAL*8, ALLOCATABLE :: Io_02_A307to312(:,:,:) ! Integrated Actinic Flux in top 2 cm for 307 to 312 nm in Antarctica (photons cm^-1 s^-1 nm^-1) REAL*8, ALLOCATABLE :: Io_02_A312to320(:,:,:) ! Integrated Actinic Flux in top 2 cm for 312 to 320 nm in Antarctica (photons cm^-1 s^-1 nm^-1) REAL*8, ALLOCATABLE :: Io_02_A320to345(:,:,:) ! Integrated Actinic Flux in top 2 cm for 320 to 345 nm in Antarctica (photons cm^-1 s^-1 nm^-1) REAL*8, ALLOCATABLE :: Io_02_G298to307(:,:,:) ! Integrated Actinic Flux in top 2 cm for 298 to 307 nm in Greenland (photons cm^-1 s^-1 nm^-1) REAL*8, ALLOCATABLE :: Io_02_G307to312(:,:,:) ! Integrated Actinic Flux in top 2 cm for 307 to 312 nm in Greenland (photons cm^-1 s^-1 nm^-1) REAL*8, ALLOCATABLE :: Io_02_G312to320(:,:,:) ! Integrated Actinic Flux in top 2 cm for 312 to 320 nm in Greenland (photons cm^-1 s^-1 nm^-1) REAL*8, ALLOCATABLE :: Io_02_G320to345(:,:,:) ! Integrated Actinic Flux in top 2 cm for 320 to 345 nm in Greenland (photons cm^-1 s^-1 nm^-1) REAL*8, ALLOCATABLE :: Io_02_A298to307_1(:,:) ! Integrated Actinic Flux in top 2 cm for 298 to 307 nm in Antarctica (photons cm^-1 s^-1 nm^-1) REAL*8, ALLOCATABLE :: Io_02_A307to312_1(:,:) ! Integrated Actinic Flux in top 2 cm for 307 to 312 nm in Antarctica (photons cm^-1 s^-1 nm^-1) REAL*8, ALLOCATABLE :: Io_02_A312to320_1(:,:) ! Integrated Actinic Flux in top 2 cm for 312 to 320 nm in Antarctica (photons cm^-1 s^-1 nm^-1) REAL*8, ALLOCATABLE :: Io_02_A320to345_1(:,:) ! Integrated Actinic Flux in top 2 cm for 320 to 345 nm in Antarctica (photons cm^-1 s^-1 nm^-1) REAL*8, ALLOCATABLE :: Io_02_G298to307_1(:,:) ! Integrated Actinic Flux in top 2 cm for 298 to 307 nm in Greenland (photons cm^-1 s^-1 nm^-1) REAL*8, ALLOCATABLE :: Io_02_G307to312_1(:,:) ! Integrated Actinic Flux in top 2 cm for 307 to 312 nm in Greenland (photons cm^-1 s^-1 nm^-1) REAL*8, ALLOCATABLE :: Io_02_G312to320_1(:,:) ! Integrated Actinic Flux in top 2 cm for 312 to 320 nm in Greenland (photons cm^-1 s^-1 nm^-1) REAL*8, ALLOCATABLE :: Io_02_G320to345_1(:,:) ! Integrated Actinic Flux in top 2 cm for 320 to 345 nm in Greenland (photons cm^-1 s^-1 nm^-1) REAL*8, ALLOCATABLE :: FNOx2_A298to307(:,:) !Maximum flux of NOx in the top 2 cm for 298-307 nm in Antarctica (molecules cm^-2 s^-1) REAL*8, ALLOCATABLE :: FNOx2_A307to312(:,:) !Maximum flux of NOx in the top 2 cm for 307-312 nm in Antarctica (molecules cm^-2 s^-1) REAL*8, ALLOCATABLE :: FNOx2_A312to320(:,:) !Maximum flux of NOx in the top 2 cm for 312-320 nm in Antarctica (molecules cm^-2 s^-1) REAL*8, ALLOCATABLE :: FNOx2_A320to345(:,:) !Maximum flux of NOx in the top 2 cm for 320-345 nm in Antarctica (molecules cm^-2 s^-1) REAL*8, ALLOCATABLE :: FNOx2_G298to307(:,:) !Maximum flux of NOx in the top 2 cm for 298-307 nm in Greenland (molecules cm^-2 s^-1) REAL*8, ALLOCATABLE :: FNOx2_G307to312(:,:) !Maximum flux of NOx in the top 2 cm for 307-312 nm in Greenland (molecules cm^-2 s^-1) REAL*8, ALLOCATABLE :: FNOx2_G312to320(:,:) !Maximum flux of NOx in the top 2 cm for 312-320 nm in Greenland (molecules cm^-2 s^-1) REAL*8, ALLOCATABLE :: FNOx2_G320to345(:,:) !Maximum flux of NOx in the top 2 cm for 320-345 nm in Greenland (molecules cm^-2 s^-1) REAL*8, ALLOCATABLE :: PIntIz_A298to307(:,:,:) !Actinic flux integrated over 1 cm intervals (from 0-200 cm) REAL*8, ALLOCATABLE :: PIntIz_A307to312(:,:,:) !Actinic flux integrated over 1 cm intervals (from 0-200 cm) REAL*8, ALLOCATABLE :: PIntIz_A312to320(:,:,:) !Actinic flux integrated over 1 cm intervals (from 0-200 cm) REAL*8, ALLOCATABLE :: PIntIz_A320to345(:,:,:) !Actinic flux integrated over 1 cm intervals (from 0-200 cm) REAL*8, ALLOCATABLE :: PIntIz_G298to307(:,:,:) !Actinic flux integrated over 1 cm intervals (from 0-200 cm) REAL*8, ALLOCATABLE :: PIntIz_G307to312(:,:,:) !Actinic flux integrated over 1 cm intervals (from 0-200 cm) REAL*8, ALLOCATABLE :: PIntIz_G312to320(:,:,:) !Actinic flux integrated over 1 cm intervals (from 0-200 cm) REAL*8, ALLOCATABLE :: PIntIz_G320to345(:,:,:) !Actinic flux integrated over 1 cm intervals (from 0-200 cm) REAL*8, ALLOCATABLE :: IntIz_A298to307(:,:,:) !Sum of Actinic flux integrated over 1 cm intervals (from 0-3*efolding depth cm) REAL*8, ALLOCATABLE :: IntIz_A307to312(:,:,:) !Sum of Actinic flux integrated over 1 cm intervals (from 0-3*efolding depth cm) REAL*8, ALLOCATABLE :: IntIz_A312to320(:,:,:) !Sum of Actinic flux integrated over 1 cm intervals (from 0-3*efolding depth cm) REAL*8, ALLOCATABLE :: IntIz_A320to345(:,:,:) !Sum of Actinic flux integrated over 1 cm intervals (from 0-3*efolding depth cm) REAL*8, ALLOCATABLE :: IntIz_G298to307(:,:,:) !Sum of Actinic flux integrated over 1 cm intervals (from 0-3*efolding depth cm) REAL*8, ALLOCATABLE :: IntIz_G307to312(:,:,:) !Sum of Actinic flux integrated over 1 cm intervals (from 0-3*efolding depth cm) REAL*8, ALLOCATABLE :: IntIz_G312to320(:,:,:) !Sum of Actinic flux integrated over 1 cm intervals (from 0-3*efolding depth cm) REAL*8, ALLOCATABLE :: IntIz_G320to345(:,:,:) !Sum of Actinic flux integrated over 1 cm intervals (from 0-3*efolding depth cm) REAL*8, ALLOCATABLE :: IntIz_A298to307_1(:,:) !Sum of Actinic flux integrated over 1 cm intervals (from 0-3*efolding depth cm) REAL*8, ALLOCATABLE :: IntIz_A307to312_1(:,:) !Sum of Actinic flux integrated over 1 cm intervals (from 0-3*efolding depth cm) REAL*8, ALLOCATABLE :: IntIz_A312to320_1(:,:) !Sum of Actinic flux integrated over 1 cm intervals (from 0-3*efolding depth cm) REAL*8, ALLOCATABLE :: IntIz_A320to345_1(:,:) !Sum of Actinic flux integrated over 1 cm intervals (from 0-3*efolding depth cm) REAL*8, ALLOCATABLE :: IntIz_G298to307_1(:,:) !Sum of Actinic flux integrated over 1 cm intervals (from 0-3*efolding depth cm) REAL*8, ALLOCATABLE :: IntIz_G307to312_1(:,:) !Sum of Actinic flux integrated over 1 cm intervals (from 0-3*efolding depth cm) REAL*8, ALLOCATABLE :: IntIz_G312to320_1(:,:) !Sum of Actinic flux integrated over 1 cm intervals (from 0-3*efolding depth cm) REAL*8, ALLOCATABLE :: IntIz_G320to345_1(:,:) !Sum of Actinic flux integrated over 1 cm intervals (from 0-3*efolding depth cm) REAL*8, ALLOCATABLE :: nit_top2A(:,:) !maximum nitrate concentration in top 2 cm in East Antarctica REAL*8, ALLOCATABLE :: nit_top2G(:,:) !maximum nitrate concentration in top 2 cm in Summit REAL*8, ALLOCATABLE :: nit_top2A_1(:,:) !maximum nitrate concentration in top 2 cm in East Antarctica REAL*8, ALLOCATABLE :: nit_top2G_1(:,:) !maximum nitrate concentration in top 2 cm in Summit REAL*8, ALLOCATABLE :: nit_bl2A(:,:) !minimum nitrate concentration in top 2 cm in Coastal East Antarctica REAL*8, ALLOCATABLE :: nit_bl2A_1(:,:) !minimum nitrate concentration in top 2 cm in Coastal East Antarctica REAL*8, ALLOCATABLE :: nit_bl2A_2(:,:) !minimum nitrate concentration in top 2 cm in Coastal East Antarctica REAL*8, ALLOCATABLE :: nit_bl2G(:,:) !minimum nitrate concentration in top 2 cm in West Antarctica REAL*8, ALLOCATABLE :: nit_bl2G_1(:,:) !minimum nitrate concentration in top 2 cm in West Antarctica REAL*8, ALLOCATABLE :: nit_bl2G_2(:,:) !minimum nitrate concentration in top 2 cm in West Antarctica REAL*8, ALLOCATABLE :: FNOxz_A298to307(:,:) !Maximum flux of NOx from zref to zvent for 298-307 nm in Antarctica (molecules cm^-2 s^-1) REAL*8, ALLOCATABLE :: FNOxz_A307to312(:,:) !Maximum flux of NOx from zref to zvent for 307-312 nm in Antarctica (molecules cm^-2 s^-1) REAL*8, ALLOCATABLE :: FNOxz_A312to320(:,:) !Maximum flux of NOx from zref to zvent for 312-320 nm in Antarctica (molecules cm^-2 s^-1) REAL*8, ALLOCATABLE :: FNOxz_A320to345(:,:) !Maximum flux of NOx from zref to zvent for 320-345 nm in Antarctica (molecules cm^-2 s^-1) REAL*8, ALLOCATABLE :: FNOxz_G298to307(:,:) !Maximum flux of NOx from zref to zvent for 298-307 nm in Greenland (molecules cm^-2 s^-1) REAL*8, ALLOCATABLE :: FNOxz_G307to312(:,:) !Maximum flux of NOx from zref to zvent for 307-312 nm in Greenland (molecules cm^-2 s^-1) REAL*8, ALLOCATABLE :: FNOxz_G312to320(:,:) !Maximum flux of NOx from zref to zvent for 312-320 nm in Greenland (molecules cm^-2 s^-1) REAL*8, ALLOCATABLE :: FNOxz_G320to345(:,:) !Maximum flux of NOx from zref to zvent for 320-345 nm in Greenland (molecules cm^-2 s^-1) REAL*8, ALLOCATABLE :: FNOx_A298to307(:,:) !Integrated Maximum flux of NOx from z=0 to z=3efolds from 298-307 nm in Antarctica REAL*8, ALLOCATABLE :: FNOx_A307to312(:,:) !Integrated Maximum flux of NOx from z=0 to z=3efolds from 298-307 nm in Antarctica REAL*8, ALLOCATABLE :: FNOx_A312to320(:,:) !Integrated Maximum flux of NOx from z=0 to z=3efolds from 298-307 nm in Antarctica REAL*8, ALLOCATABLE :: FNOx_A320to345(:,:) !Integrated Maximum flux of NOx from z=0 to z=3efolds from 298-307 nm in Antarctica REAL*8, ALLOCATABLE :: FNOx_G298to307(:,:) !Integrated Maximum flux of NOx from z=0 to z=3efolds from 298-307 nm in Greenland REAL*8, ALLOCATABLE :: FNOx_G307to312(:,:) !Integrated Maximum flux of NOx from z=0 to z=3efolds from 298-307 nm in Greenland REAL*8, ALLOCATABLE :: FNOx_G312to320(:,:) !Integrated Maximum flux of NOx from z=0 to z=3efolds from 298-307 nm in Greenland REAL*8, ALLOCATABLE :: FNOx_G320to345(:,:) !Integrated Maximum flux of NOx from z=0 to z=3efolds from 298-307 nm in Greenland REAL*8, ALLOCATABLE :: FNOx_A(:,:) !Integrated Maximum flux of NOx from z=0 to z=3efolds from lambda = 298-345 nm in Antarctica REAL*8, ALLOCATABLE :: FNOx_G(:,:) !Integrated Maximum flux of NOx from z=0 to z=3efolds from lambda = 298-345 nm in Greenland REAL*8, ALLOCATABLE :: SNOWNOX(:,:) !Flux of NOx from the snow! !================================================================= ! MODULE ROUTINES -- follow below the "CONTAINS" statement !================================================================= CONTAINS SUBROUTINE SNOWNOXEMS ! Subroutine SNOWNOXEMS is the interface between the GEOS-CHEM model and the NOx emissions routines in "emissdr.F", which is used in emissions_mod.F (mcz 7/2/2012) ! References to F90 modules USE DAO_MOD, ONLY : BXHEIGHT, PBL USE DAO_MOD, ONLY : ALBD, LWI, SUNCOS, PREACC, T !bec (10/6/11), updated 4/19/2012 mcz USE DIAG_MOD, ONLY : AD32_ph !bec (10/6/11) USE DIAG_MOD, ONLY : AD64_pz, AD64_CSZA, AD64_FTOT USE DIAG_MOD, ONLY : AD64_FDIF !mcz 6/12/2013 USE GRID_MOD, ONLY : GET_XOFFSET, GET_YOFFSET USE UVALBEDO_MOD, ONLY : UVALBEDO !mcz 4/24/2012 USE TIME_MOD, ONLY : GET_ELAPSED_SEC, GET_MONTH USE ERROR_MOD, ONLY : ALLOC_ERR USE BPCH2_MOD, ONLY : READ_BPCH2, GET_RES_EXT USE BPCH2_MOD, ONLY : GET_TAU0, GET_NAME_EXT_2D USE CMN_SIZE_MOD ! Size parameters USE CMN_DIAG_MOD ! Diagnostic switches & arrays USE CMN_NOX_MOD ! GEMISNOX2 ! Arguments !INTEGER, INTENT(IN) :: MONTH !=============== INPUT PARAMETERS ====================================== ! Local variables ====================================================== LOGICAL, SAVE :: FIRSTEMISS = .TRUE. INTEGER :: AS, MONTH INTEGER :: K, II, JJ, M, L, MM INTEGER :: KBL, PP, QQ REAL*8 :: ZBL REAL*8, PARAMETER :: ZREF = 0.02d0 ! reference depth (m) REAL*8, PARAMETER :: SNOWDENSITY = 360000.d0 ! (g/m^3) REAL*8, PARAMETER :: ICEDENSITY = 917000 ! (g/m^3) REAL*8, PARAMETER :: FILTERAREA = 0.000254d0 ! area of the filter (m^2) REAL*8, PARAMETER :: CBC_AS = 0.6d-9 !BC concentration for remote Vostok (g/g) [Grenfell, 1994] REAL*8, PARAMETER :: CBC_GS = 1.42d-9 !BC concentration for remote Summit (g/g) REAL*8, PARAMETER :: fBC_A = 0.726d0 !Fraction of BC absorption compared to total absorption at 650-700 nm REAL*8, PARAMETER :: fBC_G = 0.712d0 !Fraction of BC absorption compared to total absorption at 650-700 nm INTEGER, PARAMETER :: P = 1 INTEGER, PARAMETER :: S = 300 !was 200 REAL*8, DIMENSION(2) :: MASSWATER !mass of meltwater passed through filter (g) REAL*8, DIMENSION(2) :: A !Angstrom exponent of BC (1) and nonBC (5) REAL*8, DIMENSION(6) :: B !Mass absorption efficiency for BC at 675 nm (Rich Brandt, 2010) REAL*8, DIMENSION(5) :: cwBCs !co-albedo of single scattering for BC REAL*8, DIMENSION(5) :: cwnonBCs !co-albedo of single scattering for nonBC REAL*8, DIMENSION(5) :: cwsnows !co-albedo of single scattering for snow REAL*8, DIMENSION(5) :: Qexts !extinction efficiency for snow REAL*8, DIMENSION(4) :: sigma !absorption coefficient (cm^2/molec) for 298-307, 307-312, 312-320, 320-345 nm from Burley and Johnston [1992] REAL*8, DIMENSION(2) :: phi !quantum yield (molec/photons) for Antarctica and Greenland from Chu and Anastasio (2003) !REAL*8, DIMENSION(6) :: nitrate_max !average of maximum observed nitrate concentrations in top 2 cm and below 2 cm to 3*e-folding depths (molec/cm^3) !REAL*8, DIMENSION(6) :: nitrate_min !average of minimum observed nitrate concentrations in top 2 cm and below 2 cm to 3*e-folding depths (molec/cm^3) !REAL*8, DIMENSION(6) :: nitrate_max_ppb !average of maximum observed nitrate concentrations in top 2 cm and below 2 cm to 3*e-folding depths (ppb) !REAL*8, DIMENSION(6) :: nitrate_min_ppb !average of minimum observed nitrate concentrations in top 2 cm and below 2 cm to 3*e-folding depths (ppb) REAL*8, DIMENSION(9) :: CORRUO1 REAL*8, DIMENSION(50) :: re_SOS_1 !Variable snow grain profile based on Gallet et al. [2011] average profile at Dome C. Used for start of summer conditions from Schneebli at DACA REAL*8, DIMENSION(250) :: re_SOS_2 !Variable snow grain profile based on Gallet et al. [2011] average profile at Dome C. Used for start of summer conditions from Schneebli at DACA REAL*8, DIMENSION(300) :: re_SOS !Variable snow grain profile based on Gallet et al. [2011] average profile at Dome C. . Used for start of summer conditions from Schneebli at DACA REAL*8, DIMENSION(50) :: re_MOS_1 !Variable snow grain profile for middle of summer conditions at Dronning Maud Land from Schneebli poster at DACA REAL*8, DIMENSION(250) :: re_MOS_2 !Variable snow grain profile for middle of summer conditions at Dronning Maud Land from Schneebli poster at DACA REAL*8, DIMENSION(300) :: re_MOS !Variable snow grain profile for middle of summer conditions at Dronning Maud Land from Schneebli poster at DACA REAL*8, DIMENSION(300) :: re_EOS_1 !Variable snow grain profile for middle of summer conditions at Dronning Maud Land from Schneebli poster at DACA REAL*8, DIMENSION(300) :: re_EOS !Variable snow grain profile for middle of summer conditions at Dronning Maud Land from Schneebli poster at DACA REAL*8, DIMENSION(80) :: re_SOS_G1 !May and June re data from Carmagnola et al. [2013] REAL*8, DIMENSION(220) :: re_SOS_G2 !May and June re data from Carmagnola et al. [2013] REAL*8, DIMENSION(300) :: re_SOS_G !May and June re data from Carmagnola et al. [2013] REAL*8, DIMENSION(300) :: re REAL*8, DIMENSION(300) :: reG REAL*8, DIMENSION(20) :: SNOWDENSITY_VARY1 REAL*8, DIMENSION(280) :: SNOWDENSITY_VARY2 REAL*8, DIMENSION(300) :: SNOWDENSITY_VARY REAL*8, DIMENSION(80) :: SNOWDENSITY_VARY1G REAL*8, DIMENSION(220) :: SNOWDENSITY_VARY2G REAL*8, DIMENSION(300) :: SNOWDENSITY_VARYG REAL*8, DIMENSION(4) :: efoldDC REAL*8, DIMENSION(4) :: efoldS REAL*4 :: ARRAY(IIPAR,JJPAR,1) REAL*4 :: ARRAY1(IIPAR,JJPAR,1) REAL*8 :: TAU0 REAL*8 :: TAU1 CHARACTER(LEN=80) :: FILENAME CHARACTER(LEN=85) :: FILENAME1 CHARACTER(LEN=76) :: FILENAME2 CHARACTER(LEN=78) :: FILENAME3 CHARACTER(LEN=76) :: FILENAME4 CHARACTER (LEN=43) :: DATA_DIR1 REAL*8, PARAMETER :: EF_A = 6.0d0 !Enhancement factor in top 2 cm of snow due to postdepositional processing. Base case=6, but do 1 and 10 for sensitivity bounds REAL*8, PARAMETER :: EF_G = 1.0d0 !Enhancement factor in top 2 cm of snow due to postdepositional processing in Greenland. !================================================================= !------------------------------------------------------------------------------ !Initalize Snow NOx Module !Do only on the first timestep IF ( FIRSTEMISS ) THEN ALLOCATE( DIRRAD289298(IIPAR, JJPAR), STAT=AS ) !This is 46x72 at 4x5 resolution (makes an array of 3312 values) IF ( AS /= 0 ) CALL ALLOC_ERR( 'DIRRAD289298' ) DIRRAD289298 = 0d0 ALLOCATE( DIRRAD298307(IIPAR, JJPAR), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'DIRRAD298307' ) DIRRAD298307 = 0d0 ALLOCATE( DIRRAD307312(IIPAR, JJPAR), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'DIRRAD307312' ) DIRRAD307312 = 0d0 ALLOCATE( DIRRAD312320(IIPAR, JJPAR), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'DIRRAD312320' ) DIRRAD312320 = 0d0 ALLOCATE( DIRRAD320345(IIPAR, JJPAR), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'DIRRAD320345' ) DIRRAD320345 = 0d0 ALLOCATE( DIRRAD345412(IIPAR, JJPAR), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'DIRRAD345412' ) DIRRAD345412 = 0d0 ALLOCATE( DIRRAD412850(IIPAR, JJPAR), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'DIRRAD412850' ) DIRRAD412850 = 0d0 ALLOCATE( DIFRAD289298(IIPAR, JJPAR), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'DIFRAD289298' ) DIFRAD289298 = 0d0 ALLOCATE( DIFRAD298307(IIPAR, JJPAR), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'DIFRAD298307' ) DIFRAD298307 = 0d0 ALLOCATE( DIFRAD307312(IIPAR, JJPAR), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'DIFRAD307312' ) DIFRAD307312 = 0d0 ALLOCATE( DIFRAD312320(IIPAR, JJPAR), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'DIFRAD312320' ) DIFRAD312320 = 0d0 ALLOCATE( DIFRAD320345(IIPAR, JJPAR), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'DIFRAD320345' ) DIFRAD320345 = 0d0 ALLOCATE( DIFRAD345412(IIPAR, JJPAR), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'DIFRAD345412' ) DIFRAD345412 = 0d0 ALLOCATE( DIFRAD412850(IIPAR, JJPAR), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'DIFRAD412850' ) DIFRAD412850 = 0d0 ALLOCATE( UO(IIPAR, JJPAR), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'UO' ) UO = 0d0 ALLOCATE( FTOT_298to307_A( IIPAR, JJPAR), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'FTOT_298to307_A' ) FTOT_298to307_A = 0d0 ALLOCATE( FTOT_307to312_A(IIPAR, JJPAR), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'FTOT_307to312_A' ) FTOT_307to312_A = 0d0 ALLOCATE( FTOT_312to320_A(IIPAR, JJPAR), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'FTOT_312to320_A' ) FTOT_312to320_A = 0d0 ALLOCATE( FTOT_320to345_A(IIPAR, JJPAR), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'FTOT_320to345_A' ) FTOT_320to345_A = 0d0 ALLOCATE( FTOT_298to307_G( IIPAR, JJPAR), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'FTOT_298to307_G' ) FTOT_298to307_G = 0d0 ALLOCATE( FTOT_307to312_G(IIPAR, JJPAR), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'FTOT_307to312_G' ) FTOT_307to312_G = 0d0 ALLOCATE( FTOT_312to320_G(IIPAR, JJPAR), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'FTOT_312to320_G' ) FTOT_312to320_G = 0d0 ALLOCATE( FTOT_320to345_G(IIPAR, JJPAR), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'FTOT_320to345_G' ) FTOT_320to345_G = 0d0 ALLOCATE( FDIF_298to307_A(IIPAR, JJPAR), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'FDIF_298to307_A' ) FDIF_298to307_A = 0d0 ALLOCATE( FDIF_307to312_A(IIPAR, JJPAR), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'FDIF_307to312_A' ) FDIF_307to312_A = 0d0 ALLOCATE( FDIF_312to320_A(IIPAR, JJPAR), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'FDIF_312to320_A' ) FDIF_312to320_A = 0d0 ALLOCATE( FDIF_320to345_A(IIPAR, JJPAR), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'FDIF_320to345_A' ) FDIF_320to345_A = 0d0 ALLOCATE( FDIF_298to307_G(IIPAR, JJPAR), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'FDIF_298to307_G' ) FDIF_298to307_G = 0d0 ALLOCATE( FDIF_307to312_G(IIPAR, JJPAR), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'FDIF_307to312_G' ) FDIF_307to312_G = 0d0 ALLOCATE( FDIF_312to320_G(IIPAR, JJPAR), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'FDIF_312to320_G' ) FDIF_312to320_G = 0d0 ALLOCATE( FDIF_320to345_G(IIPAR, JJPAR), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'FDIF_320to345_G' ) FDIF_320to345_G = 0d0 ALLOCATE( DIRRAD_298345_A(IIPAR, JJPAR), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'DIRRAD_298345_A' ) DIRRAD_298345_A = 0d0 ALLOCATE( DIFRAD_298345_A(IIPAR, JJPAR), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'DIFRAD_298345_A' ) DIFRAD_298345_A = 0d0 ALLOCATE( DIRRAD_298345_G(IIPAR, JJPAR), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'DIRRAD_298345_G' ) DIRRAD_298345_G = 0d0 ALLOCATE( DIFRAD_298345_G(IIPAR, JJPAR), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'DIFRAD_298345_G' ) DIFRAD_298345_G = 0d0 ALLOCATE( FDIF_298to345_A(IIPAR, JJPAR), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'FDIF_298to345_A' ) FDIF_298to345_A = 0d0 ALLOCATE( FDIF_298to345_G(IIPAR, JJPAR), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'FDIF_298to345_G' ) FDIF_298to345_G = 0d0 ALLOCATE( FDIF_298to345(IIPAR, JJPAR), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'FDIF_298to345' ) FDIF_298to345 = 0d0 ALLOCATE( FTOT_298to345_A(IIPAR, JJPAR), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'FTOT_298to345_A' ) FDIF_298to345_A = 0d0 ALLOCATE( FTOT_298to345_G(IIPAR, JJPAR), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'FTOT_298to345_G' ) FTOT_298to345_G = 0d0 ALLOCATE( FTOT_298to345(IIPAR, JJPAR), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'FTOT_298to345' ) FTOT_298to345 = 0d0 ALLOCATE( UO_A(IIPAR, JJPAR), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'UO_A' ) UO_A = 0d0 ALLOCATE( UO_G(IIPAR, JJPAR), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'UO_G' ) UO_G = 0d0 ALLOCATE( UO_1(IIPAR, JJPAR), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'UO_1' ) UO_1 = 0d0 ALLOCATE( CBC_A(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'CBC_A' ) CBC_A = 0d0 ALLOCATE( CBC_G(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'CBC_G' ) CBC_G = 0d0 ALLOCATE( CBC(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'CBC' ) CBC = 0d0 ALLOCATE( phi_vary_A(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'phi_vary_A' ) phi_vary_A = 0d0 ALLOCATE( phi_vary_G(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'phi_vary_G' ) phi_vary_G = 0d0 ALLOCATE( LmaxBC_A(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'LmaxBC_A' ) LmaxBC_A = 0d0 ALLOCATE( LmaxBC_G(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'LmaxBC_G' ) LmaxBC_G = 0d0 ALLOCATE( LBC_A(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'LBC_A' ) LBC_A = 0d0 ALLOCATE( LBC_G(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'LBC_G' ) LBC_G = 0d0 ALLOCATE( tautot_A675(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'tautot_A675' ) tautot_A675 = 0d0 ALLOCATE( tautot_G675(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'tautot_G675' ) tautot_G675 = 0d0 ALLOCATE( tauBC_A675(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'tauBC_A675' ) tauBC_A675 = 0d0 ALLOCATE( tauBC_G675(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'tauBC_G675' ) tauBC_G675 = 0d0 ALLOCATE( taunonBC_A675(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'taunonBC_A675' ) taunonBC_A675 = 0d0 ALLOCATE( taunonBC_G675(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'taunonBC_G675' ) taunonBC_G675 = 0d0 ALLOCATE( tauBC_A298(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'tauBC_A298' ) tauBC_A298 = 0d0 ALLOCATE( tauBC_A307(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'tauBC_A307' ) tauBC_A307 = 0d0 ALLOCATE( tauBC_A312(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'tauBC_A312' ) tauBC_A312 = 0d0 ALLOCATE( tauBC_A320(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'tauBC_A320' ) tauBC_A320 = 0d0 ALLOCATE( tauBC_A345(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'tauBC_A345' ) tauBC_A345 = 0d0 ALLOCATE( tauBC_G298(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'tauBC_G298' ) tauBC_G298 = 0d0 ALLOCATE( tauBC_G307(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'tauBC_G307' ) tauBC_G307 = 0d0 ALLOCATE( tauBC_G312(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'tauBC_G312' ) tauBC_G312 = 0d0 ALLOCATE( tauBC_G320(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'tauBC_G320' ) tauBC_G320 = 0d0 ALLOCATE( tauBC_G345(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'tauBC_G345' ) tauBC_G345 = 0d0 ALLOCATE( taunonBC_A298(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'taunonBC_A298' ) taunonBC_A298 = 0d0 ALLOCATE( taunonBC_A307(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'taunonBC_A307' ) taunonBC_A307 = 0d0 ALLOCATE( taunonBC_A312(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'taunonBC_A312' ) taunonBC_A312 = 0d0 ALLOCATE( taunonBC_A320(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'taunonBC_A320' ) taunonBC_A320 = 0d0 ALLOCATE( taunonBC_A345(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'taunonBC_A345' ) taunonBC_A345 = 0d0 ALLOCATE( taunonBC_G298(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'taunonBC_G298' ) taunonBC_G298 = 0d0 ALLOCATE( taunonBC_G307(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'taunonBC_G307' ) taunonBC_G307 = 0d0 ALLOCATE( taunonBC_G312(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'taunonBC_G312' ) taunonBC_G312 = 0d0 ALLOCATE( taunonBC_G320(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'taunonBC_G320' ) taunonBC_G320 = 0d0 ALLOCATE( taunonBC_G345(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'taunonBC_G345' ) taunonBC_G345 = 0d0 ALLOCATE( KextnonBC_A298(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'KextnonBC_A298' ) KextnonBC_A298 = 0d0 ALLOCATE( KextnonBC_A307(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'KextnonBC_A307' ) KextnonBC_A307 = 0d0 ALLOCATE( KextnonBC_A312(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'KextnonBC_A312' ) KextnonBC_A312 = 0d0 ALLOCATE( KextnonBC_A320(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'KextnonBC_A320' ) KextnonBC_A320 = 0d0 ALLOCATE( KextnonBC_A345(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'KextnonBC_A345' ) KextnonBC_A345 = 0d0 ALLOCATE( KextnonBC_G298(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'KextnonBC_G298' ) KextnonBC_G298 = 0d0 ALLOCATE( KextnonBC_G307(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'KextnonBC_G307' ) KextnonBC_G307 = 0d0 ALLOCATE( KextnonBC_G312(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'KextnonBC_G312' ) KextnonBC_G312 = 0d0 ALLOCATE( KextnonBC_G320(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'KextnonBC_G320' ) KextnonBC_G320 = 0d0 ALLOCATE( KextnonBC_G345(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'KextnonBC_G345' ) KextnonBC_G345 = 0d0 ALLOCATE( KextBC_A298(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'KextBC_A298' ) KextBC_A298 = 0d0 ALLOCATE( KextBC_A307(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'KextBC_A307' ) KextBC_A307 = 0d0 ALLOCATE( KextBC_A312(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'KextBC_A312' ) KextBC_A312 = 0d0 ALLOCATE( KextBC_A320(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'KextBC_A320' ) KextBC_A320 = 0d0 ALLOCATE( KextBC_A345(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'KextBC_A345' ) KextBC_A345 = 0d0 ALLOCATE( KextBC_G298(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'KextBC_G298' ) KextBC_G298 = 0d0 ALLOCATE( KextBC_G307(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'KextBC_G307' ) KextBC_G307 = 0d0 ALLOCATE( KextBC_G312(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'KextBC_G312' ) KextBC_G312 = 0d0 ALLOCATE( KextBC_G320(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'KextBC_G320' ) KextBC_G320 = 0d0 ALLOCATE( KextBC_G345(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'KextBC_G345' ) KextBC_G345 = 0d0 ALLOCATE( re_vert(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 're_vert' ) re_vert = 0d0 ALLOCATE( re_vertG(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 're_vertG' ) re_vertG = 0d0 ALLOCATE( SNOWDENSITY_V(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'SNOWDENSITY_V' ) SNOWDENSITY_V = 0d0 ALLOCATE( zde(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'zde' ) zde = 0d0 ALLOCATE( Kextsnow_A298(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Kextsnow_A298' ) Kextsnow_A298 = 0d0 ALLOCATE( Kextsnow_A307(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Kextsnow_A307' ) Kextsnow_A307 = 0d0 ALLOCATE( Kextsnow_A312(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Kextsnow_A312' ) Kextsnow_A312 = 0d0 ALLOCATE( Kextsnow_A320(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Kextsnow_A320' ) Kextsnow_A320 = 0d0 ALLOCATE( Kextsnow_A345(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Kextsnow_A345' ) Kextsnow_A345 = 0d0 ALLOCATE( Kextsnow_G298(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Kextsnow_G298' ) Kextsnow_G298 = 0d0 ALLOCATE( Kextsnow_G307(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Kextsnow_G307' ) Kextsnow_G307 = 0d0 ALLOCATE( Kextsnow_G312(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Kextsnow_G312' ) Kextsnow_G312 = 0d0 ALLOCATE( Kextsnow_G320(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Kextsnow_G320' ) Kextsnow_G320 = 0d0 ALLOCATE( Kextsnow_G345(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Kextsnow_G345' ) Kextsnow_G345 = 0d0 ALLOCATE( Kexttot_A298(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Kexttot_A298' ) Kexttot_A298 = 0d0 ALLOCATE( Kexttot_A307(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Kexttot_A307' ) Kexttot_A307 = 0d0 ALLOCATE( Kexttot_A312(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Kexttot_A312' ) Kexttot_A312 = 0d0 ALLOCATE( Kexttot_A320(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Kexttot_A320' ) Kexttot_A320 = 0d0 ALLOCATE( Kexttot_A345(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Kexttot_A345' ) Kexttot_A345 = 0d0 ALLOCATE( Kexttot_G298(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Kexttot_G298' ) Kexttot_G298 = 0d0 ALLOCATE( Kexttot_G307(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Kexttot_G307' ) Kexttot_G307 = 0d0 ALLOCATE( Kexttot_G312(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Kexttot_G312' ) Kexttot_G312 = 0d0 ALLOCATE( Kexttot_G320(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Kexttot_G320' ) Kexttot_G320 = 0d0 ALLOCATE( Kexttot_G345(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Kexttot_G345' ) Kexttot_G345 = 0d0 ALLOCATE( cweff_A298(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'cweff_A298' ) cweff_A298 = 0d0 ALLOCATE( cweff_A307(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'cweff_A307' ) cweff_A307 = 0d0 ALLOCATE( cweff_A312(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'cweff_A312' ) cweff_A312 = 0d0 ALLOCATE( cweff_A320(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'cweff_A320' ) cweff_A320 = 0d0 ALLOCATE( cweff_A345(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'cweff_A345' ) cweff_A345 = 0d0 ALLOCATE( cweff_G298(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'cweff_G298' ) cweff_G298 = 0d0 ALLOCATE( cweff_G307(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'cweff_G307' ) cweff_G307 = 0d0 ALLOCATE( cweff_G312(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'cweff_G312' ) cweff_G312 = 0d0 ALLOCATE( cweff_G320(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'cweff_G320' ) cweff_G320 = 0d0 ALLOCATE( cweff_G345(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'cweff_G345' ) cweff_G345 = 0d0 ALLOCATE( Y_A298(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Y_A298' ) Y_A298 = 0d0 ALLOCATE( Y_A307(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Y_A307' ) Y_A307 = 0d0 ALLOCATE( Y_A312(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Y_A312' ) Y_A312 = 0d0 ALLOCATE( Y_A320(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Y_A320' ) Y_A320 = 0d0 ALLOCATE( Y_A345(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Y_A345' ) Y_A345 = 0d0 ALLOCATE( Y_G298(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Y_G298' ) Y_G298 = 0d0 ALLOCATE( Y_G307(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Y_G307' ) Y_G307 = 0d0 ALLOCATE( Y_G312(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Y_G312' ) Y_G312 = 0d0 ALLOCATE( Y_G320(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Y_G320' ) Y_G320 = 0d0 ALLOCATE( Y_G345(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Y_G345' ) Y_G345 = 0d0 ALLOCATE( Y_A298to307(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Y_A298to307' ) Y_A298to307 = 0d0 ALLOCATE( Y_A307to312(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Y_A307to312' ) Y_A307to312 = 0d0 ALLOCATE( Y_A312to320(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Y_A312to320' ) Y_A312to320 = 0d0 ALLOCATE( Y_A320to345(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Y_A320to345' ) Y_A320to345 = 0d0 ALLOCATE( Y_G298to307(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Y_G298to307' ) Y_G298to307 = 0d0 ALLOCATE( Y_G307to312(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Y_G307to312' ) Y_G307to312 = 0d0 ALLOCATE( Y_G312to320(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Y_G312to320' ) Y_G312to320 = 0d0 ALLOCATE( Y_G320to345(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Y_G320to345' ) Y_G320to345 = 0d0 ALLOCATE( Io_z_A298to307(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Io_z_A298to307' ) Io_z_A298to307 = 0d0 ALLOCATE( Io_z_A307to312(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Io_z_A307to312' ) Io_z_A307to312 = 0d0 ALLOCATE( Io_z_A312to320(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Io_z_A312to320' ) Io_z_A312to320 = 0d0 ALLOCATE( Io_z_A320to345(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Io_z_A320to345' ) Io_z_A320to345 = 0d0 ALLOCATE( Io_z_G298to307(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Io_z_G298to307' ) Io_z_G298to307 = 0d0 ALLOCATE( Io_z_G307to312(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Io_z_G307to312' ) Io_z_G307to312 = 0d0 ALLOCATE( Io_z_G312to320(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Io_z_G312to320' ) Io_z_G312to320 = 0d0 ALLOCATE( Io_z_G320to345(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Io_z_G320to345' ) Io_z_G320to345 = 0d0 ALLOCATE( Io_0_A298to307(IIPAR,JJPAR,P), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Io_0_A298to307' ) Io_0_A298to307 = 0d0 ALLOCATE( Io_0_A298to307_1(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Io_0_A298to307_1' ) Io_0_A298to307_1 = 0d0 ALLOCATE( Io_0_A307to312(IIPAR,JJPAR,P), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Io_0_A307to312' ) Io_0_A307to312 = 0d0 ALLOCATE( Io_0_A307to312_1(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Io_0_A307to312_1' ) Io_0_A307to312_1 = 0d0 ALLOCATE( Io_0_A312to320(IIPAR,JJPAR,P), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Io_0_A312to320' ) Io_0_A312to320 = 0d0 ALLOCATE( Io_0_A312to320_1(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Io_0_A312to320_1' ) Io_0_A312to320_1 = 0d0 ALLOCATE( Io_0_A320to345(IIPAR,JJPAR,P), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Io_0_A320to345' ) Io_0_A320to345 = 0d0 ALLOCATE( Io_0_A320to345_1(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Io_0_A320to345_1' ) Io_0_A320to345_1 = 0d0 ALLOCATE( Io_0_G298to307(IIPAR,JJPAR,P), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Io_0_G298to307' ) Io_0_G298to307 = 0d0 ALLOCATE( Io_0_G298to307_1(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Io_0_G298to307_1' ) Io_0_G298to307_1 = 0d0 ALLOCATE( Io_0_G307to312(IIPAR,JJPAR,P), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Io_0_G307to312' ) Io_0_G307to312 = 0d0 ALLOCATE( Io_0_G307to312_1(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Io_0_G307to312_1' ) Io_0_G307to312_1 = 0d0 ALLOCATE( Io_0_G312to320(IIPAR,JJPAR,P), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Io_0_G312to320' ) Io_0_G312to320 = 0d0 ALLOCATE( Io_0_G312to320_1(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Io_0_G312to320_1' ) Io_0_G312to320_1 = 0d0 ALLOCATE( Io_0_G320to345(IIPAR,JJPAR,P), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Io_0_G320to345' ) Io_0_G320to345 = 0d0 ALLOCATE( Io_0_G320to345_1(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Io_0_G320to345_1' ) Io_0_G320to345_1 = 0d0 ALLOCATE( Io_1_A298to307(IIPAR,JJPAR,P), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Io_1_A298to307' ) Io_1_A298to307 = 0d0 ALLOCATE( Io_1_A298to307_1(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Io_1_A298to307_1' ) Io_1_A298to307_1 = 0d0 ALLOCATE( Io_1_A307to312(IIPAR,JJPAR,P), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Io_1_A307to312' ) Io_1_A307to312 = 0d0 ALLOCATE( Io_1_A307to312_1(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Io_1_A307to312_1' ) Io_1_A307to312_1 = 0d0 ALLOCATE( Io_1_A312to320(IIPAR,JJPAR,P), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Io_1_A312to320' ) Io_1_A312to320 = 0d0 ALLOCATE( Io_1_A312to320_1(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Io_1_A312to320_1' ) Io_1_A312to320_1 = 0d0 ALLOCATE( Io_1_A320to345(IIPAR,JJPAR,P), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Io_1_A320to345' ) Io_1_A320to345 = 0d0 ALLOCATE( Io_1_A320to345_1(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Io_1_A320to345_1' ) Io_1_A320to345_1 = 0d0 ALLOCATE( Io_1_G298to307(IIPAR,JJPAR,P), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Io_1_G298to307' ) Io_1_G298to307 = 0d0 ALLOCATE( Io_1_G298to307_1(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Io_1_G298to307_1' ) Io_1_G298to307_1 = 0d0 ALLOCATE( Io_1_G307to312(IIPAR,JJPAR,P), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Io_1_G307to312' ) Io_1_G307to312 = 0d0 ALLOCATE( Io_1_G307to312_1(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Io_1_G307to312_1' ) Io_1_G307to312_1 = 0d0 ALLOCATE( Io_1_G312to320(IIPAR,JJPAR,P), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Io_1_G312to320' ) Io_1_G312to320 = 0d0 ALLOCATE( Io_1_G312to320_1(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Io_1_G312to320_1' ) Io_1_G312to320_1 = 0d0 ALLOCATE( Io_1_G320to345(IIPAR,JJPAR,P), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Io_1_G320to345' ) Io_1_G320to345 = 0d0 ALLOCATE( Io_1_G320to345_1(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Io_1_G320to345_1' ) Io_1_G320to345_1 = 0d0 ALLOCATE( pefold_A298to307(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'pefold_A298to307' ) pefold_A298to307 = 0d0 ALLOCATE( pefold_A307to312(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'pefold_A307to312' ) pefold_A307to312 = 0d0 ALLOCATE( pefold_A312to320(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'pefold_A312to320' ) pefold_A312to320 = 0d0 ALLOCATE( pefold_A320to345(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'pefold_A320to345' ) pefold_A320to345 = 0d0 ALLOCATE( pefold_G298to307(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'pefold_G298to307' ) pefold_G298to307 = 0d0 ALLOCATE( pefold_G307to312(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'pefold_G307to312' ) pefold_G307to312 = 0d0 ALLOCATE( pefold_G312to320(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'pefold_G312to320' ) pefold_G312to320 = 0d0 ALLOCATE( pefold_G320to345(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'pefold_G320to345' ) pefold_G320to345 = 0d0 ALLOCATE( efold_A298to307(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'efold_A298to307' ) efold_A298to307 = 0d0 ALLOCATE( efold_A307to312(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'efold_A307to312' ) efold_A307to312 = 0d0 ALLOCATE( efold_A312to320(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'efold_A312to320' ) efold_A312to320 = 0d0 ALLOCATE( efold_A320to345(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'efold_A320to345' ) efold_A320to345 = 0d0 ALLOCATE( efold_G298to307(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'efold_G298to307' ) efold_G298to307 = 0d0 ALLOCATE( efold_G307to312(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'efold_G307to312' ) efold_G307to312 = 0d0 ALLOCATE( efold_G312to320(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'efold_G312to320' ) efold_G312to320 = 0d0 ALLOCATE( efold_G320to345(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'efold_G320to345' ) efold_G320to345 = 0d0 ALLOCATE( zvent_A298to307(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'zvent_A298to307' ) zvent_A298to307 = 0d0 ALLOCATE( zvent_A307to312(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'zvent_A307to312' ) zvent_A307to312 = 0d0 ALLOCATE( zvent_A312to320(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'zvent_A312to320' ) zvent_A312to320 = 0d0 ALLOCATE( zvent_A320to345(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'zvent_A320to345' ) zvent_A320to345 = 0d0 ALLOCATE( zvent_G298to307(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'zvent_G298to307' ) zvent_G298to307 = 0d0 ALLOCATE( zvent_G307to312(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'zvent_G307to312' ) zvent_G307to312 = 0d0 ALLOCATE( zvent_G312to320(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'zvent_G312to320' ) zvent_G312to320 = 0d0 ALLOCATE( zvent_G320to345(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'zvent_G320to345' ) zvent_G320to345 = 0d0 ALLOCATE( PhotolyticZoneA(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'PhotolyticZoneA' ) PhotolyticZoneA = 0d0 ALLOCATE( PhotolyticZoneG(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'PhotolyticZoneG' ) PhotolyticZoneG = 0d0 ALLOCATE( PhotolyticZone(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'PhotolyticZone' ) PhotolyticZone = 0d0 ALLOCATE( Io_02_A298to307(IIPAR,JJPAR,P), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Io_02_A298to307' ) Io_02_A298to307 = 0d0 ALLOCATE( Io_02_A307to312(IIPAR,JJPAR,P), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Io_02_A307to312' ) Io_02_A307to312 = 0d0 ALLOCATE( Io_02_A312to320(IIPAR,JJPAR,P), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Io_02_A312to320' ) Io_02_A312to320 = 0d0 ALLOCATE( Io_02_A320to345(IIPAR,JJPAR,P), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Io_02_A320to345' ) Io_02_A320to345 = 0d0 ALLOCATE( Io_02_G298to307(IIPAR,JJPAR,P), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Io_02_G298to307' ) Io_02_G298to307 = 0d0 ALLOCATE( Io_02_G307to312(IIPAR,JJPAR,P), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Io_02_G307to312' ) Io_02_G307to312 = 0d0 ALLOCATE( Io_02_G312to320(IIPAR,JJPAR,P), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Io_02_G312to320' ) Io_02_G312to320 = 0d0 ALLOCATE( Io_02_G320to345(IIPAR,JJPAR,P), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Io_02_G320to345' ) Io_02_G320to345 = 0d0 ALLOCATE( Io_02_A298to307_1(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Io_02_A298to307_1' ) Io_02_A298to307_1 = 0d0 ALLOCATE( Io_02_A307to312_1(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Io_02_A307to312_1' ) Io_02_A307to312_1 = 0d0 ALLOCATE( Io_02_A312to320_1(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Io_02_A312to320_1' ) Io_02_A312to320_1 = 0d0 ALLOCATE( Io_02_A320to345_1(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Io_02_A320to345_1' ) Io_02_A320to345_1 = 0d0 ALLOCATE( Io_02_G298to307_1(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Io_02_G298to307_1' ) Io_02_G298to307_1 = 0d0 ALLOCATE( Io_02_G307to312_1(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Io_02_G307to312_1' ) Io_02_G307to312_1 = 0d0 ALLOCATE( Io_02_G312to320_1(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Io_02_G312to320_1' ) Io_02_G312to320_1 = 0d0 ALLOCATE( Io_02_G320to345_1(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'Io_02_G320to345_1' ) Io_02_G320to345_1 = 0d0 ALLOCATE( FNOx2_A298to307(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'FNOx2_A298to307' ) FNOx2_A298to307 = 0d0 ALLOCATE( FNOx2_A307to312(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'FNOx2_A307to312' ) FNOx2_A307to312 = 0d0 ALLOCATE( FNOx2_A312to320(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'FNOx2_A312to320' ) FNOx2_A312to320 = 0d0 ALLOCATE( FNOx2_A320to345(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'FNOx2_A320to345' ) FNOx2_A320to345 = 0d0 ALLOCATE( FNOx2_G298to307(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'FNOx2_G298to307' ) FNOx2_G298to307 = 0d0 ALLOCATE( FNOx2_G307to312(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'FNOx2_G307to312' ) FNOx2_G307to312 = 0d0 ALLOCATE( FNOx2_G312to320(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'FNOx2_G312to320' ) FNOx2_G312to320 = 0d0 ALLOCATE( FNOx2_G320to345(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'FNOx2_G320to345' ) FNOx2_G320to345 = 0d0 ALLOCATE( PIntIz_A298to307(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'PIntIz_A298to307' ) PIntIz_A298to307 = 0d0 ALLOCATE( PIntIz_A307to312(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'PIntIz_A307to312' ) PIntIz_A307to312 = 0d0 ALLOCATE( PIntIz_A312to320(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'PIntIz_A312to320' ) PIntIz_A312to320 = 0d0 ALLOCATE( PIntIz_A320to345(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'PIntIz_A320to345' ) PIntIz_A320to345 = 0d0 ALLOCATE( PIntIz_G298to307(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'PIntIz_G298to307' ) PIntIz_G298to307 = 0d0 ALLOCATE( PIntIz_G307to312(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'PIntIz_G307to312' ) PIntIz_G307to312 = 0d0 ALLOCATE( PIntIz_G312to320(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'PIntIz_G312to320' ) PIntIz_G312to320 = 0d0 ALLOCATE( PIntIz_G320to345(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'PIntIz_G320to345' ) PIntIz_G320to345 = 0d0 ALLOCATE( IntIz_A298to307(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'IntIz_A298to307' ) IntIz_A298to307 = 0d0 ALLOCATE( IntIz_A307to312(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'IntIz_A307to312' ) IntIz_A307to312 = 0d0 ALLOCATE( IntIz_A312to320(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'IntIz_A312to320' ) IntIz_A312to320 = 0d0 ALLOCATE( IntIz_A320to345(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'IntIz_A320to345' ) IntIz_A320to345 = 0d0 ALLOCATE( IntIz_G298to307(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'IntIz_G298to307' ) IntIz_G298to307 = 0d0 ALLOCATE( IntIz_G307to312(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'IntIz_G307to312' ) IntIz_G307to312 = 0d0 ALLOCATE( IntIz_G312to320(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'IntIz_G312to320' ) IntIz_G312to320 = 0d0 ALLOCATE( IntIz_G320to345(IIPAR,JJPAR,S), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'IntIz_G320to345' ) IntIz_G320to345 = 0d0 ALLOCATE( IntIz_A298to307_1(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'IntIz_A298to307_1' ) IntIz_A298to307_1 = 0d0 ALLOCATE( IntIz_A307to312_1(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'IntIz_A307to312_1' ) IntIz_A307to312_1 = 0d0 ALLOCATE( IntIz_A312to320_1(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'IntIz_A312to320_1' ) IntIz_A312to320_1 = 0d0 ALLOCATE( IntIz_A320to345_1(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'IntIz_A320to345_1' ) IntIz_A320to345_1 = 0d0 ALLOCATE( IntIz_G298to307_1(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'IntIz_G298to307_1' ) IntIz_G298to307_1 = 0d0 ALLOCATE( IntIz_G307to312_1(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'IntIz_G307to312_1' ) IntIz_G307to312_1 = 0d0 ALLOCATE( IntIz_G312to320_1(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'IntIz_G312to320_1' ) IntIz_G312to320_1 = 0d0 ALLOCATE( IntIz_G320to345_1(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'IntIz_G320to345_1' ) IntIz_G320to345_1 = 0d0 ALLOCATE( nit_top2A(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'nit_top2A' ) nit_top2A = 0d0 ALLOCATE( nit_top2A_1(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'nit_top2A_1' ) nit_top2A_1 = 0d0 ALLOCATE( nit_bl2A(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'nit_bl2A' ) nit_bl2A = 0d0 ALLOCATE( nit_bl2A_1(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'nit_bl2A_1' ) nit_bl2A_1 = 0d0 ALLOCATE( nit_bl2A_2(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'nit_bl2A_2' ) nit_bl2A_2 = 0d0 ALLOCATE( nit_top2G(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'nit_top2G' ) nit_top2G = 0d0 ALLOCATE( nit_top2G_1(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'nit_top2G_1' ) nit_top2G_1 = 0d0 ALLOCATE( nit_bl2G(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'nit_bl2G' ) nit_bl2G = 0d0 ALLOCATE( nit_bl2G_1(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'nit_bl2G_1' ) nit_bl2G_1 = 0d0 ALLOCATE( nit_bl2G_2(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'nit_bl2G_2' ) nit_bl2G_2 = 0d0 ALLOCATE( FNOxz_A298to307(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'FNOxz_A298to307' ) FNOxz_A298to307 = 0d0 ALLOCATE( FNOxz_A307to312(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'FNOxz_A307to312' ) FNOxz_A307to312 = 0d0 ALLOCATE( FNOxz_A312to320(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'FNOxz_A312to320' ) FNOxz_A312to320 = 0d0 ALLOCATE( FNOxz_A320to345(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'FNOxz_A320to345' ) FNOxz_A320to345 = 0d0 ALLOCATE( FNOxz_G298to307(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'FNOxz_G298to307' ) FNOxz_G298to307 = 0d0 ALLOCATE( FNOxz_G307to312(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'FNOxz_G307to312' ) FNOxz_G307to312 = 0d0 ALLOCATE( FNOxz_G312to320(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'FNOxz_G312to320' ) FNOxz_G312to320 = 0d0 ALLOCATE( FNOxz_G320to345(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'FNOxz_G320to345' ) FNOxz_G320to345 = 0d0 ALLOCATE( FNOx_A298to307(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'FNOx_A298to307' ) FNOx_A298to307 = 0d0 ALLOCATE( FNOx_A307to312(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'FNOx_A307to312' ) FNOx_A307to312 = 0d0 ALLOCATE( FNOx_A312to320(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'FNOx_A312to320' ) FNOx_A312to320 = 0d0 ALLOCATE( FNOx_A320to345(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'FNOx_A320to345' ) FNOx_A320to345 = 0d0 ALLOCATE( FNOx_G298to307(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'FNOx_G298to307' ) FNOx_G298to307 = 0d0 ALLOCATE( FNOx_G307to312(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'FNOx_G307to312' ) FNOx_G307to312 = 0d0 ALLOCATE( FNOx_G312to320(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'FNOx_G312to320' ) FNOx_G312to320 = 0d0 ALLOCATE( FNOx_G320to345(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'FNOx_G320to345' ) FNOx_G320to345 = 0d0 ALLOCATE( FNOx_A(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'FNOx_A' ) FNOx_A = 0d0 ALLOCATE( FNOx_G(IIPAR,JJPAR), STAT=AS ) IF ( AS /=0 ) CALL ALLOC_ERR( 'FNOx_G' ) FNOx_G = 0d0 ALLOCATE( SNOWNOX (IIPAR, JJPAR), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'SNOWNOX' ) SNOWNOX = 0d0 ALLOCATE( ANNACC1 (IIPAR, JJPAR,P), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'ANNACC1' ) ANNACC1 = 0d0 ALLOCATE( FRACPD1 (IIPAR, JJPAR,P), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'FRACPD1' ) FRACPD1 = 0d0 ALLOCATE( FRACNOPD1 (IIPAR, JJPAR,P), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'FRACNOPD1' ) FRACNOPD1 = 0d0 ALLOCATE( SNOWBC1 (IIPAR, JJPAR,P), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'SNOWBC1' ) SNOWBC1 = 0d0 ALLOCATE( NITRATE_ANN1 (IIPAR, JJPAR,P), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'NITRATE_ANN1' ) NITRATE_ANN1 = 0d0 ! We have now gone thru the first timestep FIRSTEMISS = .FALSE. return ENDIF !--------------------------------------------------------------------------------------- ! Snowpack Actinic Flux Parameterization Starts here! !Inherent Optical Properties MASSWATER = (/1.52d3, 9.878d2/) !g A = (/1.0d0, 5.0d0/) !m^2 B = (/9.89d0, 9.81d0, 9.74d0, 9.66d0, 9.35d0, 4.97d0/) !(298,307,312,320,345,675 nm) !m^2/g cwBCs = (/0.5994d0, 0.6050d0, 0.6080d0, 0.6129d0, 0.6290d0/) !(298,307,312,320,345,675 nm) cwnonBCs = (/1, 1, 1, 1, 1/) !(298,307,312,320,345,675 nm) cwsnows = (/7.1486d-8, 6.9304d-8, 6.8175d-8, & 6.6460d-8, 6.1734d-8/) !(298,307,312,320,345,675 nm) Qexts = (/2.012d0, 2.012d0, 2.012d0, 2.013d0, 2.015d0 /) !(298,307,312,320,345,675 nm) sigma = (/2.7d-20, 2.4d-20, 1.9d-20, 2.3d-21/) !(298-307,307-312,312-320,320-345 nm) phi = (/0.00197d0, 0.0030d0/) !(Antarctica, Greenland) !phi = (/0.6d0, 0.6d0/) !(Antarctica, Greenland) !for sensitivity studies :) !For now, use Dome C (Frey et al., 2009), Summit (Dibb et al., 2007, 2010) , and WAIS-Divide (Masclin et al., 2013) profiles to scale nitrate. !nitrate_max_ppb = (/850.0d-9, 350.0d-9, 160.0d-9, 330.0d-9/) !top 2 cm A, top 2 cm G, below 2 cm A, below 2 cm G !nitrate_min_ppb = (/300d-9, 180d-9, 50d-9, 150d-9/) !top 2 cm A, top 2 cm G, below 2 cm A, below 2 cm G !nitrate_max_ppb = (/340.0d-9, 355.0d-9, 170.0d-9, 330.0d-9, !& 200.0d-9, 50.0d-9/) !top 2 cm DC, top 2 cm Sum, below 2 cm DC, below 2 cm Sum, top 2 cm WAIS-Divide, below 2 cm WAIS-Divide !nitrate_min_ppb = (/240.0d-9, 185.0d-9, 30.0d-9, 150.0d-9, !& 70.0d-9, 20.0d-9/) !top 2 cm DC, top 2 cm Sum, below 2 cm DC, below 2 cm Sum, top 2 cm WAIS-Divide, below 2 cm WAIS-Divide !nitrate_max = (nitrate_max_ppb)*(0.36d0)*(0.016d0)*(6.023d23) !convert ppb nitrate to molec/cm^3 !nitrate_min = (nitrate_min_ppb)*(0.36d0)*(0.016d0)*(6.023d23) !convert ppb nitrate to molec/cm^3 CORRUO1 = (/1.061d0, 1.063d0, 1.063d0, 1.063d0, 1.058d0, 1.047d0, & 1.023d0, 0.973d0, 6.993d0/) !10,20,30,40,50,60,70,80,85 !efoldDC = (/18.0d0,19.5d0,20.5d0,22.0d0/) !for remote Dome C (298-307nm,307-312nm,312-320nm,320-345nm) !efoldS = (/15.5d0,16.0d0,17.0d0,18.0d0/) !for remote Summit (298-307nm,307-312nm,312-320nm,320-345nm) *check this SNOWDENSITY_VARY1 = (/26.d4, 27.d4, 28.5d4, 30.d4, & 32.d4, 33.d4, 33.5d4, 34.d4, 34.5d4, & 35.d4, 35.5d4, 36.d4, 37.d4, 37.5d4, & 38.d4, 37.5d4, 37.d4, 36.5d4, 36.d4, 36.d4/) DO MM=1,280 SNOWDENSITY_VARY2 = 36.d4 ENDDO SNOWDENSITY_VARY = (/SNOWDENSITY_VARY1,SNOWDENSITY_VARY2/) !For testing of the snow density to see whether varying it makes a big difference !DO K=1,200 !SNOWDENSITY_VARY = 360000.d0 !ENDDO !Greenland snow density from Carmganola et al. [2013] SNOWDENSITY_VARY1G = (/3.1d5, 3.1d5, 3.1d5, 3.2d5, 3.1d5, & 3.1d5, 3.4d5, 3.4d5, 3.5d5, 3.5d5, 3.3d5, & 3.3d5, 3.3d5, 3.3d5, 3.3d5, 3.3d5, 3.3d5, & 3.3d5, 3.3d5, 3.3d5, 3.2d5, 3.2d5, 3.2d5, & 3.2d5, 3.2d5, 3.2d5, 3.2d5, 2.8d5, 2.8d5, & 2.8d5, 2.7d5, 3.2d5, 3.0d5, 3.0d5, 3.0d5, & 2.9d5, 2.9d5, 2.8d5, 2.8d5, 2.8d5, 3.0d5, & 3.0d5, 3.0d5, 3.0d5, 3.0d5, 3.0d5, 3.0d5, & 3.0d5, 3.0d5, 2.9d5, 3.0d5, 3.0d5, 3.0d5, & 3.0d5, 3.0d5, 3.0d5, 2.9d5, 2.7d5, 2.7d5, & 2.7d5, 2.4d5, 2.4d5, 2.4d5, 2.9d5, 2.9d5, & 2.9d5, 3.2d5, 3.2d5, 3.2d5, 3.2d5, 3.2d5, & 3.2d5, 3.2d5, 3.2d5, 2.9d5, 2.9d5, 2.9d5, & 2.9d5, 2.4d5, 2.4d5/) DO PP=1,220 SNOWDENSITY_VARY2G(PP) = 2.4d5 ENDDO SNOWDENSITY_VARYG = (/SNOWDENSITY_VARY1G,SNOWDENSITY_VARY2G/) re_SOS_1 = (/86.0d-6, 102.0d-6, 103.0d-6, 104.0d-6, 105.0d-6, & 108.0d-6, 113.0d-6, 118.0d-6, 123.0d-6, 128.0d-6, & 133.0d-6, 138.0d-6, 143.0d-6, 148.0d-6, 153.0d-6, & 153.0d-6, 154.0d-6, 155.0d-6, 156.0d-6, 157.0d-6, & 158.0d-6, 159.0d-6, 160.0d-6, 161.0d-6, 162.0d-6, & 163.0d-6, 164.0d-6, 165.0d-6, 166.0d-6, 167.0d-6, & 170.0d-6, 173.0d-6, 176.0d-6, 179.0d-6, 182.0d-6, & 185.0d-6, 188.0d-6, 191.0d-6, 194.0d-6, 198.0d-6, & 202.0d-6, 206.0d-6, 210.0d-6, 214.0d-6, 218.0d-6, & 222.0d-6, 226.0d-6, 230.0d-6, 234.0d-6, 235.0d-6/) DO M=1,250 re_SOS_2(M) = 235.0d-6 + 0.5d-6*M ENDDO re_SOS = (/re_SOS_1,re_SOS_2/) !For start of summer snow re_MOS_1 = (/198.0d-6, 200.0d-6, 205.0d-6, 207.0d-6, & 210.0d-6, 215.0d-6, 220.0d-6, 223.0d-6, & 225.0d-6, 228.0d-6, 230.0d-6, 232.0d-6, & 235.0d-6, 238.0d-6, 240.0d-6, 242.0d-6, & 245.0d-6, 247.0d-6, 250.0d-6, 253.0d-6, & 255.0d-6, 258.0d-6, 260.0d-6, 263.0d-6, & 265.0d-6, 267.0d-6, 270.0d-6, 272.0d-6, & 275.0d-6, 277.0d-6, 280.0d-6, 282.0d-6, & 285.0d-6, 288.0d-6, 290.0d-6, 292.0d-6, & 295.0d-6, 298.0d-6, 300.0d-6, 305.0d-6, & 310.0d-6, 312.0d-6, 315.0d-6, 318.0d-6, & 320.0d-6, 322.0d-6, 325.0d-6, 328.0d-6, & 330.0d-6, 332.0d-6/) DO M=1,250 re_MOS_2(M) = 332.0d-6 ENDDO re_MOS = (/re_MOS_1, re_MOS_2/) !For middle of summer snow DO K=1,300 re_EOS_1(K) = 332.0d-6 ENDDO re_EOS = re_EOS_1 !Greenland re profiles for Carmagnola et al. [2015], assume constant all year re_SOS_G1 = (/7.3d-5, 1.17d-4, 1.22d-4, 1.12d-4, & 1.13d-4, 1.14d-4, 1.15d-4, 1.15d-4, & 1.25d-4, 1.23d-4, 1.14d-4, 1.12d-4, & 1.12d-4, 1.03d-4, 1.03d-4, 1.04d-4, & 1.08d-4, 1.08d-4, 1.02d-4, 1.09d-4, & 1.08d-4, 1.08d-4, 1.02d-4, 1.04d-4, & 1.13d-4, 1.09d-4, 1.13d-4, 1.07d-4, & 1.18d-4, 1.17d-4, 1.17d-4, 1.12d-4, & 1.28d-4, 1.47d-4, 1.22d-4, 1.11d-4, & 1.17d-4, 1.17d-4, 1.21d-4, 1.34d-4, & 1.37d-4, 1.34d-4, 1.36d-4, 1.24d-4, & 1.21d-4, 1.29d-4, 1.29d-4, 1.34d-4, & 1.27d-4, 1.24d-4, 1.24d-4, 1.28d-4, & 1.26d-4, 1.28d-4, 1.40d-4, 1.37d-4, & 1.37d-4, 1.45d-4, 1.56d-4, 1.56d-4, & 1.52d-4, 1.52d-4, 1.60d-4, 1.83d-4, & 1.83d-4, 1.77d-4, 1.77d-4, 1.71d-4, & 1.71d-4, 1.65d-4, 1.65d-4, 1.71d-4, & 1.83d-4, 1.56d-4, 2.11d-4, 2.11d-4, & 2.11d-4, 2.11d-4, 2.11d-4, 2.11d-4/) DO QQ=1,220 re_SOS_G2(QQ) = 2.11d-4 ENDDO re_SOS_G = (/re_SOS_G1, re_SOS_G2/) !write(6,*), 'nitrate_max_Ant_top2cm', nitrate_max(1) !write(6,*), 'nitrate_min_Ant_top2cm', nitrate_min(1) !write(6,*), 'nitrate_max_Ant_bl2cm', nitrate_max(3) !write(6,*), 'nitrate_min_Ant_bl2cm', nitrate_min(3) !write(6,*), 'sigma_312320', sigma(3) !write(6,*), 'phi_Ant', phi(1) !write(6,*), 're', re ! Get current month MONTH = GET_MONTH() TAU0 = GET_TAU0( 5, 1, 2009 ) TAU1 = GET_TAU0( 3, 1, 2010 ) !Full New Filename-/home/disk/horton/mzatko/GEOS-Chem_photod/runs_v9_01_01_photod/annacc.bpch !Full New Filename-/home/disk/horton/mzatko/GEOS-Chem_photod/runs_v9_01_01_photod/annacc2x25.bpch !Data Directory - for annual averaged accumulation rate (mm/year) !DATA_DIR1='/home/disk/horton/mzatko/GEOS-Chem_photod/' !FILENAME=TRIM( DATA_DIR1 ) // 'runs_v9_01_01_photod/annacc' !For 4x5 DATA_DIR1='/home/disk/horton/mzatko/GEOS-Chem_photod/' FILENAME=TRIM( DATA_DIR1 ) // 'runs_v9_01_01_photod/annacc2x25' !For 2x2.5 CALL READ_BPCH2( FILENAME, 'ANNACC', 24, & TAU0, IIPAR, JJPAR, & 1, ARRAY, QUIET=.TRUE. ) ANNACC1 = ARRAY !annual surface accumulation (mm/year) !Sensitivity studies with dry deposited nitrate/total nitrate deposition with and without photodenitrification !FILENAME2=TRIM( DATA_DIR1 ) // 'runs_v9_01_01_photod/FRACPD' !For 2x2.5 FILENAME3=TRIM( DATA_DIR1 ) // 'runs_v9_01_01_photod/FRACNOPD' !For 2x2.5 FILENAME4=TRIM( DATA_DIR1 ) // 'runs_v9_01_01_photod/SNOWBC' !For 2x2.5 !CALL READ_BPCH2( FILENAME2, 'FRACPD', 25, !& TAU1, IIPAR, JJPAR, !& 1, ARRAY, QUIET=.TRUE. ) !FRACPD1 = ARRAY !fraction of dry deposition to total deposition of nitrate with photodenitrification CALL READ_BPCH2( FILENAME3, 'FRACNOPD', 25, & TAU0, IIPAR, JJPAR, & 1, ARRAY, QUIET=.TRUE. ) FRACNOPD1 = ARRAY !fraction of dry deposition to total deposition of nitrate without photodenitrification CALL READ_BPCH2( FILENAME4, 'SNOWBC', 26, & TAU0, IIPAR, JJPAR, & 1, ARRAY, QUIET=.TRUE. ) SNOWBC1 = ARRAY !fraction of dry deposition to total deposition of nitrate with photodenitrification !Data Directory - for annual averaged snow nitrate concentrations from previous run (ppb) !DATA_DIR1='/home/disk/horton/mzatko/GEOS-Chem_photod/' !FILENAME1=TRIM( DATA_DIR1 )//'runs_v9_01_01_photod/FNETAC' !For 4x5 !DATA_DIR1='/home/disk/horton/mzatko/GEOS-Chem_photod/' !FILENAME1=TRIM( DATA_DIR1 )//'runs_v9_01_01_photod/snownit_4x5' !For 4x5 !DATA_DIR1='/home/disk/horton/mzatko/GEOS-Chem_photod/' !FILENAME1=TRIM( DATA_DIR1 )//'runs_v9_01_01_photod/NITNEW' !For 4x5 !DATA_DIR1='/home/disk/horton/mzatko/GEOS-Chem_photod/' !FILENAME1=TRIM( DATA_DIR1 )//'runs_v9_01_01_photod/snownit_4x5_2' !For 4x5 !DATA_DIR1='/home/disk/horton/mzatko/GEOS-Chem_photod/' !FILENAME1=TRIM( DATA_DIR1 ) // 'runs_v9_01_01_photod/snownit_2x25' !For 2x25 !CALL READ_BPCH2( FILENAME1, 'FNETAC', 25, !& TAU0, IIPAR, JJPAR, !& 1, ARRAY1, QUIET=.TRUE. ) !NITRATE_ANN1 = ARRAY1 !annual mean snow nitrate (ppb) !CALL READ_BPCH2( FILENAME1, 'NITANN', 25, !& TAU0, IIPAR, JJPAR, !& 1, ARRAY1, QUIET=.TRUE. ) !NITRATE_ANN1 = ARRAY1 !annual mean snow nitrate (ppb) !CALL READ_BPCH2( FILENAME1, 'NITNEW', 25, !& TAU0, IIPAR, JJPAR, !& 1, ARRAY1, QUIET=.TRUE. ) !NITRATE_ANN1 = ARRAY1 !annual mean snow nitrate (ppb) !write(6,*), 'DIFRAD312320_SN_beforeloop', DIFRAD312320(116,7) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !Antarctica!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !DO JJ = 1, 8 !Latitude - 4x5 DO JJ = 1, 15 !Latitude - 2x2.5 DO II = 1, IIPAR !Longitude - 4x5 and 2x2.5 !write(6,*), 'UVALBEDO_Vostok', UVALBEDO(116,7) !write(6,*), 'NITRATE_ANN1(II,JJ,1)', II, JJ, NITRATE_ANN1(II,JJ,1) !Direct and Diffuse Downwelling Radiation FTOT_298to307_A(II,JJ) = DIRRAD298307(II,JJ) + DIFRAD298307(II,JJ) FTOT_307to312_A(II,JJ) = DIRRAD307312(II,JJ) + DIFRAD307312(II,JJ) FTOT_312to320_A(II,JJ) = DIRRAD312320(II,JJ) + DIFRAD312320(II,JJ) FTOT_320to345_A(II,JJ) = DIRRAD320345(II,JJ) + DIFRAD320345(II,JJ) FDIF_298to307_A(II,JJ)=DIFRAD298307(II,JJ)/FTOT_298to307_A(II,JJ) FDIF_307to312_A(II,JJ)=DIFRAD307312(II,JJ)/FTOT_307to312_A(II,JJ) FDIF_312to320_A(II,JJ)=DIFRAD312320(II,JJ)/FTOT_312to320_A(II,JJ) FDIF_320to345_A(II,JJ)=DIFRAD320345(II,JJ)/FTOT_320to345_A(II,JJ) UO_A(II,JJ) = UO(II,JJ) DIRRAD_298345_A(II,JJ)=DIRRAD298307(II,JJ)+DIRRAD307312(II,JJ) & + DIRRAD312320(II,JJ) + DIRRAD320345(II,JJ) DIFRAD_298345_A(II,JJ)=DIFRAD298307(II,JJ)+DIFRAD307312(II,JJ) & + DIFRAD312320(II,JJ) + DIFRAD320345(II,JJ) FDIF_298to345_A(II,JJ)=DIFRAD_298345_A(II,JJ)/ & (DIRRAD_298345_A(II,JJ)+DIFRAD_298345_A(II,JJ)) FTOT_298to345_A(II,JJ)=DIRRAD_298345_A(II,JJ)+ & DIFRAD_298345_A(II,JJ) !write(6,*), 'UO', UO(62,5) !write(6,*), 'UO_A', UO_A(42,21) !write(6,*), 'DIRRAD_298345_A', DIRRAD_298345_A(62,5) !write(6,*), 'DIFRAD_298345_A', DIFRAD_298345_A(62,5) !write(6,*), 'FTOT_298to345_A', FTOT_298to345_A(62,5) !write(6,*), 'DIRRAD298307_SN', DIRRAD298307(62,5) !write(6,*), 'DIRRAD307312_SN', DIRRAD307312(62,5) !write(6,*), 'DIRRAD312320_SN', DIRRAD312320(62,5) !write(6,*), 'DIRRAD320345_SN', DIRRAD320345(62,5) !write(6,*), 'DIFRAD298307_SN', DIFRAD298307(62,5) !write(6,*), 'DIFRAD307312_SN', DIFRAD307312(62,5) !write(6,*), 'DIFRAD312320_SN_insideloop', DIFRAD312320(116,7) !write(6,*), 'DIFRAD320345_SN', DIFRAD320345(62,5) !write(6,*),'DIRRAD312320_preloop_onelatlon',DIRRAD312320(II,JJ) !write(6,*),'DIFRAD312320_preloop_onelatlon',DIFRAD312320(II,JJ) !write(6,*),'FDIF_312320_preloop_onelatlon', FDIF_312to320s(II,JJ) !write(6,*),'FTOT_312320s_preloop_onelatlon',FTOT_312to320s(II,JJ) phi_vary_A(II,JJ) = exp(3.6d0 - (2400.d0/T(II,JJ,1))) !write(6,*), 'phi_vary_A_Vostok', phi_vary_A(116,7) !Snowpack Impurity Concentrations !CBC_A(II,JJ) = CBC_AS * (ANNACC1(62,5,1)/ ANNACC1(II,JJ,1)) !For Dome C at 4x5 (ng/g) !CBC_A(II,JJ) = CBC_AS * (ANNACC1(58,4,1)/ ANNACC1(II,JJ,1)) !For Vostok at 4x5 (ng/g) !CBC_A(II,JJ) = (-2.8d-11*ANNACC1(II,JJ,1) + 5.4d-10) !For CBC in g/g and accum in mm/year (l.w.e) annually averaged. Regression equation based on Bisiaux et al. [2012] mainly with 2x25 regression !CBC_A(II,JJ)=2.d0*(CBC_AS * (ANNACC1(116,7,1)/ ANNACC1(II,JJ,1))) !For Vostok at 2x25 (ng/g) - sensitivity study, double CBC concentrations !CBC_A(II,JJ)=0.5d0*(CBC_AS * (ANNACC1(116,7,1)/ ANNACC1(II,JJ,1))) !For Vostok at 2x25 (ng/g) - sensitivity study, half CBC concentrations !CBC_A(II,JJ) = CBC_AS * (ANNACC1(116,7,1)/ ANNACC1(II,JJ,1)) !For Vostok at 2x25 (ng/g) !CBC_A(II,JJ) = SNOWBC1(II,JJ,1)*1.d-9 !For when BC deposition rates are used (g/g)! !CBC_A(II,JJ) = CBC_AS * (ANNACC1(122,8,1)/ ANNACC1(II,JJ,1)) !For Dome C at 2x25 (ng/g) !CBC_A(II,JJ) = CBC_AS !For Dome C at 2x25 !IF ( II >= 37 .AND. JJ <= 5 ) THEN !4x5 IF ( CBC_A(II,JJ) <= 0.08d-9 ) THEN CBC_A(II,JJ) = 0.08d-9 ELSE CBC_A(II,JJ) = CBC_A(II,JJ) ENDIF !write(6,*), 'CBC_A', CBC_A(62,5) !Old Code!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !Change vertical snow grain profiles temporally (grains at surface get larger over summer) !IF ( UO(II,JJ) < 0.25d0 ) THEN !re = re_SOS !ELSEIF (UO(II,JJ) >= 0.25d0 .AND. UO(II,JJ) <= 0.4d0) THEN !re = re_MOS !ELSEIF (UO(II,JJ) > 0.40) THEN !re = re_EOS !ENDIF !write(6,*), 're', re !old snow grain vertical profile !IF (MONTH==12 .OR. MONTH==2) THEN !re = re_SOS !ELSEIF (MONTH == 1) THEN !re = re_SOS !ELSE !re = re_SOS !ENDIF !write(6,*), 're', re !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !(default) !IF (MONTH==12 .OR. MONTH==2) THEN !re = re_MOS !ELSEIF (MONTH == 1) THEN !re = re_EOS !ELSE !re = re_SOS !ENDIF !Sensitivity studies -use only start of summer values (do this for publication based on Steve Warren comments) IF (MONTH==12 .OR. MONTH==2) THEN re = re_SOS ELSEIF (MONTH == 1) THEN re = re_SOS ELSE re = re_SOS ENDIF !Sensitivity studies -use only start of middle of summer values !IF (MONTH==12 .OR. MONTH==2) THEN !re = re_MOS !ELSEIF (MONTH == 1) THEN !re = re_MOS !ELSE !re = re_MOS !ENDIF !Sensitivity studies -use only start of end of summer values !IF (MONTH==12 .OR. MONTH==2) THEN !re = re_EOS !ELSEIF (MONTH == 1) THEN !re = re_EOS !ELSE !re = re_EOS !ENDIF !write(6,*), 'ANNACC1(62,5,1)', ANNACC1(62,5,1) !For Dome C at 4x5 !write(6,*), 'ANNACC1(29,42,1)', ANNACC1(29,42,1) !For Summit at 4x5 !write(6,*), 'ANNACC1(62,5,1)', ANNACC1(122,8,1) !For Dome C at 2x25 !write(6,*), 'ANNACC1(29,42,1)', ANNACC1(29,42,1) !For Summit at 2x25 !write(6,*), 'PREACC(II,JJ)', PREACC(II,JJ) !write(6,*), 'CBC_A(II,JJ)', CBC_A(II,JJ) !write(6,*), 'CBC_AS', CBC_AS !write(6,*), 'CBC_GS', CBC_GS !write(6,*), 'CBC_SouthPole', CBC_A(37,1) !4x5 !write(6,*), 'CBC_Neumayer', CBC_A(35,6) !4x5 !write(6,*), 'CBC_Halley', CBC_A(32,5) !4x5 !write(6,*), 'CBC_Summit', CBC_G(29,42) !4x5 !write(6,*), 'CBC_WaisDivide', CBC_A(12,4) !4x5 !write(6,*), 'CBC_DomeC', CBC_A(62,5) !4x5 !write(6,*), 'CBC_G(II,JJ)', CBC_G(II,JJ) !4x5 !write(6,*), 'CBC_SouthPole', CBC_A(73,1) !2x25 !write(6,*), 'CBC_Summit', CBC_G(57,83) !2x25 !write(6,*), 'CBC_WaisDivide', CBC_A(28,6) !2x25 !write(6,*), 'CBC_DomeC', CBC_A(122,8) !2x25 !write(6,*), 'CBC_G(II,JJ)', CBC_G(II,JJ) !2x25 LmaxBC_A(II,JJ) = CBC_A(II,JJ)*(MASSWATER(1)/FILTERAREA) LBC_A(II,JJ) = LmaxBC_A(II,JJ)*fBC_A !write(6,*), 'LmaxBC_A', LmaxBC_A(II,JJ) !write(6,*), 'LBC_A', LBC_A(II,JJ) tautot_A675(II,JJ) = LmaxBC_A(II,JJ)*B(6) tauBC_A675(II,JJ) = LBC_A(II,JJ)*B(6) taunonBC_A675(II,JJ) = tautot_A675(II,JJ)-tauBC_A675(II,JJ) tauBC_A298(II,JJ)=(tauBC_A675(II,JJ)*((298.0d0/675.0d0)**-A(1))) tauBC_A307(II,JJ)=(tauBC_A675(II,JJ)*((307.0d0/675.0d0)**-A(1))) tauBC_A312(II,JJ)=(tauBC_A675(II,JJ)*((312.0d0/675.0d0)**-A(1))) tauBC_A320(II,JJ)=(tauBC_A675(II,JJ)*((320.0d0/675.0d0)**-A(1))) tauBC_A345(II,JJ)=(tauBC_A675(II,JJ)*((345.0d0/675.0d0)**-A(1))) taunonBC_A298(II,JJ) = (taunonBC_A675(II,JJ) * & ((298.0d0/675.0d0)**-A(2))) taunonBC_A307(II,JJ) = (taunonBC_A675(II,JJ) * & ((307.0d0/675.0d0)**-A(2))) taunonBC_A312(II,JJ) = (taunonBC_A675(II,JJ) * & ((312.0d0/675.0d0)**-A(2))) taunonBC_A320(II,JJ) = (taunonBC_A675(II,JJ) * & ((320.0d0/675.0d0)**-A(2))) taunonBC_A345(II,JJ) = (taunonBC_A675(II,JJ) * & ((345.0d0/675.0d0)**-A(2))) !write(6,*), 'tautot_A675(II,JJ)', tautot_A675(II,JJ) !write(6,*), 'tauBC_A675(II,JJ)', tauBC_A675(II,JJ) !write(6,*), 'taunonBC_A675(II,JJ)', taunonBC_A675(II,JJ) !write(6,*), 'tauBC_A312(II,JJ)', tauBC_A312(II,JJ) !write(6,*), 'tauBC_A320(II,JJ)', tauBC_A320(II,JJ) !write(6,*), 'taunonBC_A312(II,JJ)', taunonBC_A312(II,JJ) !write(6,*), 'taunonBC_A320(II,JJ)', taunonBC_A320(II,JJ) DO K = 1,300 re_vert(II,JJ,K) = re(K) !grain size profile at start of summer SNOWDENSITY_V(II,JJ,K) = SNOWDENSITY_VARY(K) !variable grain size profile zde(II,JJ,K) = (K-1.d0) / 100.0d0 !units: meters !write(6,*), 're_vert(1,1,K)', re_vert(1,1,K) !write(6,*), 're_vert(1)', re_vert(62,5,1) !write(6,*), 're_vert(15)', re_vert(62,5,15) !write(6,*), 'SNOWDENSITY_V(1)', SNOWDENSITY_V(62,5,1) !write(6,*), 'SNOWDENSITY_V(15)', SNOWDENSITY_V(62,5,15) !write(6,*), 'zde(1)', zde(62,5,1) !write(6,*), 'zde(15)', zde(62,5,15) !Inherent Optical Properties KextnonBC_A298(II,JJ,K) = (taunonBC_A298(II,JJ)* & SNOWDENSITY_V(II,JJ,K)* & (FILTERAREA/MASSWATER(1))) /cwnonBCs(1) KextnonBC_A307(II,JJ,K) = (taunonBC_A307(II,JJ)* & SNOWDENSITY_V(II,JJ,K)* & (FILTERAREA/MASSWATER(1)))/cwnonBCs(2) KextnonBC_A312(II,JJ,K) = (taunonBC_A312(II,JJ)* & SNOWDENSITY_V(II,JJ,K)* & (FILTERAREA/MASSWATER(1)))/cwnonBCs(3) KextnonBC_A320(II,JJ,K) = (taunonBC_A320(II,JJ)* & SNOWDENSITY_V(II,JJ,K)* & (FILTERAREA/MASSWATER(1)))/cwnonBCs(4) KextnonBC_A345(II,JJ,K) = (taunonBC_A345(II,JJ)* & SNOWDENSITY_V(II,JJ,K)* & (FILTERAREA/MASSWATER(1)))/cwnonBCs(5) !write(6,*), 'KextnonBC_A307(1)', KextnonBC_A307(62,5,1) !write(6,*), 'KextnonBC_A307(15)', KextnonBC_A307(62,5,15) !write(6,*), 'KextnonBC_A312(1)', KextnonBC_A312(62,5,1) !write(6,*), 'KextnonBC_A312(15)', KextnonBC_A312(62,5,15) !write(6,*), 'KextnonBC_A312(I,J,1)', KextnonBC_A312(II,JJ,1) !write(6,*), 'KextnonBC_A320(I,J,1)', KextnonBC_A320(II,JJ,1) !write(6,*), 'KextnonBC_A312(I,J,200)', KextnonBC_A312(II,JJ,200) !write(6,*), 'KextnonBC_A320(I,J,200)', KextnonBC_A320(II,JJ,200) KextBC_A298(II,JJ,K) = (B(1)*CBC_A(II,JJ)*SNOWDENSITY_V(II,JJ,K)) & /cwBCs(1) KextBC_A307(II,JJ,K) = (B(2)*CBC_A(II,JJ)*SNOWDENSITY_V(II,JJ,K)) & /cwBCs(2) KextBC_A312(II,JJ,K) = (B(3)*CBC_A(II,JJ)*SNOWDENSITY_V(II,JJ,K)) & /cwBCs(3) KextBC_A320(II,JJ,K) = (B(4)*CBC_A(II,JJ)*SNOWDENSITY_V(II,JJ,K)) & /cwBCs(4) KextBC_A345(II,JJ,K) = (B(5)*CBC_A(II,JJ)*SNOWDENSITY_V(II,JJ,K)) & /cwBCs(5) !write(6,*), 'KextBC_A307(1)', KextBC_A307(62,5,1) !write(6,*), 'KextBC_A307(15)', KextBC_A307(62,5,15) !write(6,*), 'KextBC_A312(1)', KextBC_A312(62,5,1) !write(6,*), 'KextBC_A312(15)', KextBC_A312(62,5,15) !write(6,*), 'KextBC_A312(II,JJ,1)', KextBC_A312(II,JJ,1) !write(6,*), 'KextBC_A320(II,JJ,1)', KextBC_A320(II,JJ,1) !write(6,*), 'KextBC_A312(II,JJ,200)', KextBC_A312(II,JJ,200) !write(6,*), 'KextBC_A320(II,JJ,200)', KextBC_A320(II,JJ,200) Kextsnow_A298(II,JJ,K) = (3.0d0*Qexts(1)*SNOWDENSITY_V(II,JJ,K))/ & (4.0d0*re_vert(II,JJ,K)*ICEDENSITY) Kextsnow_A307(II,JJ,K) = (3.0d0*Qexts(2)*SNOWDENSITY_V(II,JJ,K))/ & (4.0d0*re_vert(II,JJ,K)*ICEDENSITY) Kextsnow_A312(II,JJ,K) = (3.0d0*Qexts(3)*SNOWDENSITY_V(II,JJ,K))/ & (4.0d0*re_vert(II,JJ,K)*ICEDENSITY) Kextsnow_A320(II,JJ,K) = (3.0d0*Qexts(4)*SNOWDENSITY_V(II,JJ,K))/ & (4.0d0*re_vert(II,JJ,K)*ICEDENSITY) Kextsnow_A345(II,JJ,K) = (3.0d0*Qexts(5)*SNOWDENSITY_V(II,JJ,K))/ & (4.0d0*re_vert(II,JJ,K)*ICEDENSITY) !write(6,*), 'Kextsnow_A307(1)', Kextsnow_A307(62,5,1) !write(6,*), 'Kextsnow_A307(15)', Kextsnow_A307(62,5,15) !write(6,*), 'Kextsnow_A312(1)', Kextsnow_A312(62,5,1) !write(6,*), 'Kextsnow_A312(15)', Kextsnow_A312(62,5,15) !write(6,*), 'Kextsnow_A312(II,JJ,1)', Kextsnow_A312(II,JJ,1) !write(6,*), 'Kextsnow_A312(II,JJ,200)', Kextsnow_A312(II,JJ,200) !write(6,*), 'Kextsnow_A320(II,JJ,1)', Kextsnow_A320(II,JJ,1) !write(6,*), 'Kextsnow_A320(II,JJ,200)', Kextsnow_A320(II,JJ,200) Kexttot_A298(II,JJ,K) = KextnonBC_A298(II,JJ,K) + & KextBC_A298(II,JJ,K) + Kextsnow_A298(II,JJ,K) Kexttot_A307(II,JJ,K) = KextnonBC_A307(II,JJ,K) + & KextBC_A307(II,JJ,K) + Kextsnow_A307(II,JJ,K) Kexttot_A312(II,JJ,K) = KextnonBC_A312(II,JJ,K) + & KextBC_A312(II,JJ,K) + Kextsnow_A312(II,JJ,K) Kexttot_A320(II,JJ,K) = KextnonBC_A320(II,JJ,K) + & KextBC_A320(II,JJ,K) + Kextsnow_A320(II,JJ,K) Kexttot_A345(II,JJ,K) = KextnonBC_A345(II,JJ,K) + & KextBC_A345(II,JJ,K) + Kextsnow_A345(II,JJ,K) !Kexttot_A298(II,JJ,K) = 1.2 * (KextnonBC_A298(II,JJ,K) + !& KextBC_A298(II,JJ,K) + Kextsnow_A298(II,JJ,K)) !Sensitivity study, increase by 20% following Libios et al. 2013 !Kexttot_A307(II,JJ,K) = 1.2 * (KextnonBC_A307(II,JJ,K) + !& KextBC_A307(II,JJ,K) + Kextsnow_A307(II,JJ,K)) !Kexttot_A312(II,JJ,K) = 1.2 * (KextnonBC_A312(II,JJ,K) + !& KextBC_A312(II,JJ,K) + Kextsnow_A312(II,JJ,K)) !Kexttot_A320(II,JJ,K) = 1.2 * (KextnonBC_A320(II,JJ,K) + !& KextBC_A320(II,JJ,K) + Kextsnow_A320(II,JJ,K)) !Kexttot_A345(II,JJ,K) = 1.2 * (KextnonBC_A345(II,JJ,K) + !& KextBC_A345(II,JJ,K) + Kextsnow_A345(II,JJ,K)) !write(6,*), 'Kexttot_A307(1)', Kexttot_A307(62,5,1) !write(6,*), 'Kexttot_A307(15)', Kexttot_A307(62,5,15) !write(6,*), 'Kexttot_A312(1)', Kexttot_A312(62,5,1) !write(6,*), 'Kexttot_A312(15)', Kexttot_A312(62,5,15) !write(6,*), 'Kexttot_A312(II,JJ,1)', Kexttot_A312(II,JJ,1) !write(6,*), 'Kexttot_A312(II,JJ,200)', Kexttot_A312(II,JJ,200) !write(6,*), 'Kexttot_A320(II,JJ,1)', Kexttot_A320(II,JJ,1) !write(6,*), 'Kexttot_A320(II,JJ,200)', Kexttot_A320(II,JJ,200) cweff_A298(II,JJ,K) = (Kextsnow_A298(II,JJ,K)*cwsnows(1) & + KextBC_A298(II,JJ,K)*cwBCs(1) + & KextnonBC_A298(II,JJ,K)*cwnonBCs(1)) & /Kexttot_A298(II,JJ,K) cweff_A307(II,JJ,K) = (Kextsnow_A307(II,JJ,K)*cwsnows(2) & + KextBC_A307(II,JJ,K)*cwBCs(2) + & KextnonBC_A307(II,JJ,K)*cwnonBCs(2)) & /Kexttot_A307(II,JJ,K) cweff_A312(II,JJ,K) = (Kextsnow_A312(II,JJ,K)*cwsnows(3) & + KextBC_A312(II,JJ,K)*cwBCs(3) + & KextnonBC_A312(II,JJ,K)*cwnonBCs(3)) & /Kexttot_A312(II,JJ,K) cweff_A320(II,JJ,K) = (Kextsnow_A320(II,JJ,K)*cwsnows(4) & + KextBC_A320(II,JJ,K)*cwBCs(4) + & KextnonBC_A320(II,JJ,K)*cwnonBCs(4)) & /Kexttot_A320(II,JJ,K) cweff_A345(II,JJ,K) = (Kextsnow_A345(II,JJ,K)*cwsnows(5) & + KextBC_A345(II,JJ,K)*cwBCs(5) + & KextnonBC_A345(II,JJ,K)*cwnonBCs(5)) & /Kexttot_A345(II,JJ,K) !write(6,*), 'cweff_A312(II,JJ,1)', cweff_A312(II,JJ,1) !write(6,*), 'cweff_A312(II,JJ,200)', cweff_A312(II,JJ,200) !write(6,*), 'cweff_A320(II,JJ,1)', cweff_A320(II,JJ,1) !write(6,*), 'cweff_A320(II,JJ,200)', cweff_A320(II,JJ,200) !write(6,*), 'cweff_A307(1)', cweff_A307(62,5,1) !write(6,*), 'cweff_A307(15)', cweff_A307(62,5,15) !write(6,*), 'cweff_A312(1)', cweff_A312(62,5,1) !write(6,*), 'cweff_A312(15)', cweff_A312(62,5,15) Y_A298(II,JJ,K)=-0.6*(cweff_A298(II,JJ,K)**(0.5d0)) & *Kexttot_A298(II,JJ,K) Y_A307(II,JJ,K)=-0.6*(cweff_A307(II,JJ,K)**(0.5d0)) & *Kexttot_A307(II,JJ,K) Y_A312(II,JJ,K)=-0.6*(cweff_A312(II,JJ,K)**(0.5d0)) & *Kexttot_A312(II,JJ,K) Y_A320(II,JJ,K)=-0.6*(cweff_A320(II,JJ,K)**(0.5d0)) & *Kexttot_A320(II,JJ,K) Y_A345(II,JJ,K)=-0.6*(cweff_A345(II,JJ,K)**(0.5d0)) & *Kexttot_A345(II,JJ,K) Y_A298to307(II,JJ,K) = ( Y_A298(II,JJ,K) + Y_A307(II,JJ,K) )/2 Y_A307to312(II,JJ,K) = ( Y_A307(II,JJ,K) + Y_A312(II,JJ,K) )/2 Y_A312to320(II,JJ,K) = ( Y_A312(II,JJ,K) + Y_A320(II,JJ,K) )/2 Y_A320to345(II,JJ,K) = ( Y_A320(II,JJ,K) + Y_A345(II,JJ,K) )/2 !write(6,*), 'Y_A307to312(1)', Y_A307to312(62,5,1) !write(6,*), 'Y_A307to312_insideloop(15)', Y_A307to312(116,7,15) !write(6,*), 'Y_A307to312(100)', Y_A307to312(62,5,100) !write(6,*), 'Y_A307to312(200)', Y_A307to312(62,5,200) !write(6,*), 'Y_A312(II,JJ,1)', Y_A312(II,JJ,1) !write(6,*), 'Y_A312(II,JJ,200)', Y_A312(II,JJ,200) !write(6,*), 'Y_A320(II,JJ,1)', Y_A320(II,JJ,1) !write(6,*), 'Y_A320(II,JJ,200)', Y_A320(II,JJ,200) !write(6,*), 'Y_A312to320(II,JJ,K)', Y_A312to320(II,JJ,K) !Now calculate Actinic Flux for z=0 to z=300 cm, but only use from zref to zvent later Io_z_A298to307(II,JJ,K) = FTOT_298to307_A(II,JJ) * & ( (3.831d0 * FDIF_298to307_A(II,JJ) * exp(Y_A298to307(II,JJ,K) & *zde(II,JJ,K)))+(3.0d0*(0.577d0+UO_A(II,JJ))*CORRUO1(3)* & exp(Y_A298to307(II,JJ,K)*ZREF)*(1.0d0-FDIF_298to307_A(II,JJ))* & exp(Y_A298to307(II,JJ,K) * (zde(II,JJ,K)-ZREF) ) )) Io_z_A307to312(II,JJ,K) = FTOT_307to312_A(II,JJ) * & ( (3.831d0 * FDIF_307to312_A(II,JJ) * exp(Y_A307to312(II,JJ,K) & *zde(II,JJ,K)))+(3.0d0*(0.577d0+UO_A(II,JJ))*CORRUO1(3)* & exp(Y_A307to312(II,JJ,K)*ZREF)*(1.0d0-FDIF_307to312_A(II,JJ))* & exp(Y_A307to312(II,JJ,K) * (zde(II,JJ,K)-ZREF)))) !write(6,*), 'Io_z_A307to312(15)', Io_z_A307to312(62,5,15) !write(6,*), 'Io_z_A307to312(100)', Io_z_A307to312(62,5,100) !write(6,*), 'Io_A307to312(200)', Io_z_A307to312(62,5,200) !write(6,*), 'Io_z_A307to312(0)', Io_z_A307to312(42,21,1) !write(6,*), 'Io_z_A307to312(1)', Io_z_A307to312(42,21,2) !write(6,*), 'Io_z_A307to312(2)', Io_z_A307to312(42,21,3) Io_z_A312to320(II,JJ,K) = FTOT_312to320_A(II,JJ) * & ( (3.831d0 * FDIF_312to320_A(II,JJ) * exp(Y_A312to320(II,JJ,K) & *zde(II,JJ,K)))+(3.0d0*(0.577d0+UO_A(II,JJ))*CORRUO1(3)* & exp(Y_A312to320(II,JJ,K)*ZREF)*(1.0d0-FDIF_312to320_A(II,JJ))* & exp(Y_A312to320(II,JJ,K) * (zde(II,JJ,K)-ZREF)))) Io_z_A320to345(II,JJ,K) = FTOT_320to345_A(II,JJ) * & ( (3.831d0 * FDIF_320to345_A(II,JJ) * exp(Y_A320to345(II,JJ,K) & *zde(II,JJ,K)))+(3.0d0*(0.577d0+UO_A(II,JJ))*CORRUO1(3)* & exp(Y_A320to345(II,JJ,K)*ZREF)*(1.0d0-FDIF_320to345_A(II,JJ))* & exp(Y_A320to345(II,JJ,K) * (zde(II,JJ,K)-ZREF)))) ENDDO ! Actinic Flux for z = 0 cm Io_0_A298to307_1(II,JJ) = FTOT_298to307_A(II,JJ) * ((3.831d0* & FDIF_298to307_A(II,JJ) * exp(Y_A298to307(II,JJ,1)*0.0d0)) + & ((0.577d0+UO_A(II,JJ))/(0.577d0*UO_A(II,JJ))* & CORRUO1(3) * (1.0d0-FDIF_298to307_A(II,JJ)))) Io_0_A307to312_1(II,JJ) = FTOT_307to312_A(II,JJ) * ((3.831d0* & FDIF_307to312_A(II,JJ) * exp(Y_A307to312(II,JJ,1)*0.0d0)) + & ((0.577d0+UO_A(II,JJ))/(0.577d0*UO_A(II,JJ))* & CORRUO1(3) * (1.0d0-FDIF_307to312_A(II,JJ)))) Io_0_A312to320_1(II,JJ) = FTOT_312to320_A(II,JJ) * ((3.831d0* & FDIF_312to320_A(II,JJ) * exp(Y_A312to320(II,JJ,1)*0.0d0)) + & ((0.577d0+UO_A(II,JJ))/(0.577d0*UO_A(II,JJ))* & CORRUO1(3) * (1.0d0-FDIF_312to320_A(II,JJ)))) Io_0_A320to345_1(II,JJ) = FTOT_320to345_A(II,JJ) * ((3.831d0* & FDIF_320to345_A(II,JJ) * exp(Y_A320to345(II,JJ,1)*0.0d0)) + & ((0.577d0+UO_A(II,JJ))/(0.577d0*UO_A(II,JJ))* & CORRUO1(3) * (1.0d0-FDIF_320to345_A(II,JJ)))) !write(6,*), ' Io_0_A307to312(0)', Io_0_A307to312_1(42,21) ! Actinic Flux for z = 1 cm Io_1_A298to307_1(II,JJ) = (Io_0_A298to307_1(II,JJ) & + Io_z_A298to307(II,JJ,3))/2 Io_1_A307to312_1(II,JJ) = (Io_0_A307to312_1(II,JJ) & + Io_z_A307to312(II,JJ,3))/2 Io_1_A312to320_1(II,JJ) = (Io_0_A312to320_1(II,JJ) & + Io_z_A312to320(II,JJ,3))/2 Io_1_A320to345_1(II,JJ) = (Io_0_A320to345_1(II,JJ) & + Io_z_A320to345(II,JJ,3))/2 !write(6,*), 'Io_1_A307to312_1', Io_1_A307to312_1(42,21) !E-folding depth calculation !pefold_A298to307(II,JJ) = Io_0_A298to307_1(II,JJ)/exp(1.0d0) !pefold_A307to312(II,JJ) = Io_0_A307to312_1(II,JJ)/exp(1.0d0) !pefold_A312to320(II,JJ) = Io_0_A312to320_1(II,JJ)/exp(1.0d0) !pefold_A320to345(II,JJ) = Io_0_A320to345_1(II,JJ)/exp(1.0d0) pefold_A298to307(II,JJ) = Io_z_A298to307(II,JJ,1)/exp(1.0d0) pefold_A307to312(II,JJ) = Io_z_A307to312(II,JJ,1)/exp(1.0d0) pefold_A312to320(II,JJ) = Io_z_A312to320(II,JJ,1)/exp(1.0d0) pefold_A320to345(II,JJ) = Io_z_A320to345(II,JJ,1)/exp(1.0d0) !write(6,*), 'pefold_A307to312', pefold_A307to312(42,21) DO K = 1,300 IF ( Io_z_A298to307(II,JJ,K) <= pefold_A298to307(II,JJ) & .AND. Io_z_A298to307(II,JJ,K) & >= 0.95d0*pefold_A298to307(II,JJ) ) THEN efold_A298to307(II,JJ) = (K-1) ENDIF IF ( Io_z_A307to312(II,JJ,K) <= pefold_A307to312(II,JJ) & .AND. Io_z_A307to312(II,JJ,K) & >= 0.95d0*pefold_A307to312(II,JJ) ) THEN efold_A307to312(II,JJ) = (K-1) ENDIF IF ( Io_z_A312to320(II,JJ,K) <= pefold_A312to320(II,JJ) & .AND. Io_z_A312to320(II,JJ,K) & >= 0.95d0*pefold_A312to320(II,JJ) ) THEN efold_A312to320(II,JJ) = (K-1) ENDIF IF ( Io_z_A320to345(II,JJ,K) <= pefold_A320to345(II,JJ) & .AND. Io_z_A320to345(II,JJ,K) & >= 0.95d0*pefold_A320to345(II,JJ) ) THEN efold_A320to345(II,JJ) = (K-1) ENDIF zvent_A298to307(II,JJ) = 3.0d0*efold_A298to307(II,JJ) zvent_A307to312(II,JJ) = 3.0d0*efold_A307to312(II,JJ) zvent_A312to320(II,JJ) = 3.0d0*efold_A312to320(II,JJ) zvent_A320to345(II,JJ) = 3.0d0*efold_A320to345(II,JJ) !write(6,*), 'efold_A307to312(II,JJ)', efold_A307to312(42,21) !write(6,*), 'zvent_A307to312(II,JJ)', zvent_A307to312(62,5) PhotolyticZoneA(II,JJ)=(zvent_A298to307(II,JJ) + & zvent_A307to312(II,JJ) + zvent_A312to320(II,JJ) & + zvent_A320to345(II,JJ))/ 4.0d0 !units: cm !write(6,*),'PhotolyticZoneA(II,JJ)',II,JJ,PhotolyticZoneA(II,JJ) !write(6,*), 'Io_0_A298to307_1(II,JJ)', Io_0_A298to307_1(II,JJ) !write(6,*), 'efold_A312to320(II,JJ)', efold_A312to320(II,JJ) !Actinic Flux Depth Integration PIntIz_A298to307(II,JJ,K) = (( (Io_z_A298to307(II,JJ,K-1))/ & ((Y_A298to307(II,JJ,K)/100.0d0))) & *(exp(Y_A298to307(II,JJ,K)*zde(II,JJ,K))- & exp(Y_A298to307(II,JJ,K)*zde(II,JJ,K-1)))) PIntIz_A307to312(II,JJ,K) = (( (Io_z_A307to312(II,JJ,K-1))/ & ((Y_A307to312(II,JJ,K)/100.0d0))) & *(exp(Y_A307to312(II,JJ,K)*zde(II,JJ,K))- & exp(Y_A307to312(II,JJ,K)*zde(II,JJ,K-1)))) PIntIz_A312to320(II,JJ,K) = (( (Io_z_A312to320(II,JJ,K-1))/ & ((Y_A312to320(II,JJ,K)/100.0d0))) & *(exp(Y_A312to320(II,JJ,K)*zde(II,JJ,K))- & exp(Y_A312to320(II,JJ,K)*zde(II,JJ,K-1)))) PIntIz_A320to345(II,JJ,K) = (( (Io_z_A320to345(II,JJ,K-1))/ & ((Y_A320to345(II,JJ,K)/100.0d0))) & *(exp(Y_A320to345(II,JJ,K)*zde(II,JJ,K))- & exp(Y_A320to345(II,JJ,K)*zde(II,JJ,K-1)))) IntIz_A298to307(II,JJ,P) = & sum(PIntIz_A298to307(II,JJ,3:zvent_A298to307(II,JJ) ) ) IntIz_A307to312(II,JJ,P) = & sum(PIntIz_A307to312(II,JJ,3:zvent_A307to312(II,JJ) ) ) IntIz_A312to320(II,JJ,P) = & sum(PIntIz_A312to320(II,JJ,3:zvent_A312to320(II,JJ) ) ) IntIz_A320to345(II,JJ,P) = & sum(PIntIz_A320to345(II,JJ,3:zvent_A320to345(II,JJ) ) ) IntIz_A298to307_1(II,JJ) = IntIz_A298to307(II,JJ,P) IntIz_A307to312_1(II,JJ) = IntIz_A307to312(II,JJ,P) IntIz_A312to320_1(II,JJ) = IntIz_A312to320(II,JJ,P) IntIz_A320to345_1(II,JJ) = IntIz_A320to345(II,JJ,P) ENDDO !Integrate Actinic Flux in top 2 cm (use trapezoid rule, so divide and multiply by two) Io_02_A298to307(II,JJ,P) = Io_0_A298to307_1(II,JJ) + & Io_z_A298to307(II,JJ,3) Io_02_A298to307_1(II,JJ) = Io_02_A298to307(II,JJ,P) Io_02_A307to312(II,JJ,P) = Io_0_A307to312_1(II,JJ) + & Io_z_A307to312(II,JJ,3) Io_02_A307to312_1(II,JJ) = Io_02_A307to312(II,JJ,P) Io_02_A312to320(II,JJ,P) = Io_0_A312to320_1(II,JJ) + & Io_z_A312to320(II,JJ,3) Io_02_A312to320_1(II,JJ) = Io_02_A312to320(II,JJ,P) Io_02_A320to345(II,JJ,P) = Io_0_A320to345_1(II,JJ) + & Io_z_A320to345(II,JJ,3) Io_02_A320to345_1(II,JJ) = Io_02_A320to345(II,JJ,P) !write(6,*),'Io_02_A312to320_1(II,JJ)', Io_02_A312to320_1(II,JJ) !Nitrate Concentrations and NOx Flux Calculations for Antarctica !nit_bl2A_1(II,JJ) = -0.22d0*ANNACC1(II,JJ,1) + 52.d0 !ANNACC1 is in mm/year (annually averaged) and nit_bl2A is ppb from ITASE campaign (use for 2x25) !average nitrate conc. below 2 cm (without photodentrification) nit_bl2A_1(II,JJ) = 59.9 !ppb !nit_bl2A_1(II,JJ) = -0.2d0*ANNACC1(II,JJ,1) + 52.d0 !ANNACC1 is in mm/year (annually averaged) and nit_bl2A is ppb from ITASE campaign (use for 4x5) !average nitrate conc. below 2 cm (without photodentrification) !nit_bl2A_1(II,JJ) = NITRATE_ANN1(II,JJ,1) ! (units: ppb) This is snow nitrate calculated from nitrate deposition and accumulation from last run (use for 4x5 and 2x25) nit_top2A_1(II,JJ) = EF_A * nit_bl2A_1(II,JJ) ! (units: ppb). For now, assume nitrate in top 2 cm is a factor of 6 larger than below. The observed range is from 1.1-17 [Rothlisberger et al., 2000, Blunier et al., 2005, Frey et al., 2009, Dibb et al., 2004, Dibb et al., 2007., Jacobi et al., 2004., Masclin et al., 2013] nit_bl2A_2(II,JJ) = (nit_bl2A_1(II,JJ)*(PhotolyticZoneA(II,JJ) & -2.0d0) - (nit_bl2A_1(II,JJ)*EF_A - nit_bl2A_1(II,JJ))) & / (PhotolyticZoneA(II,JJ)-2.0d0) ! (ppb) new average nitrate conc. below 2 cm (with photodentrification. Thought is that if we enhance surface, the nitrate below surface must be depleted by an equal amount. !write(6,*),'nit_bl2A_2(II,JJ)', nit_bl2A_2(II,JJ) !nit_bl2A(II,JJ) = (nit_bl2A_2(II,JJ))*0.36d0*1.d-9*0.016d0 !& *6.023d23 !convert from ppb to molec cm^-3 !nit_bl2A(II,JJ) = (nit_bl2A_2(II,JJ))*0.36d0*1.d-9*0.016d0 & *6.023d23*(FRACNOPD1(II,JJ,1)) !Sensitivity study for frac dry dep/total dep !nit_bl2A(II,JJ) = 2 * (nit_bl2A_2(II,JJ))*0.36d0*1.d-9*0.016d0 !& *6.023d23 !convert from ppb to molec cm^-3 !Sensitivity study for 2 x nitrate concentrations below 2 cm !nit_bl2A(II,JJ) = 0.5 * (nit_bl2A_2(II,JJ))*0.36d0*1.d-9*0.016d0 !& *6.023d23 !convert from ppb to molec cm^-3 !Sensitivity study for 0.5 x nitrate concentrations below 2 cm !nit_top2A(II,JJ) = (nit_top2A_1(II,JJ))*0.36d0*1.d-9*0.016d0 !& *6.023d23 !convert from ppb to molec cm^-3 nit_top2A(II,JJ) = (nit_top2A_1(II,JJ))*0.36d0*1.d-9*0.016d0 & *6.023d23*(FRACNOPD1(II,JJ,1)) !Sensitivity study for frac dry dep/total dep !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!Unused sensitivity tests!! !nit_top2A(II,JJ) = (nit_top2A_1(II,JJ))*0.36d0*1.d-9*0.016d0 !& *6.023d23*(FRACPD1(II,JJ)) !Sensitivity study for frac dry dep/total dep (with photodenitrifcation) !nit_bl2A(II,JJ) = (nit_bl2A_2(II,JJ))*0.36d0*1.d-9*0.016d0 !& *6.023d23*(FRACPD1(II,JJ)) !Sensitivity study for frac dry dep/total dep (with photodenitrifcation) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !Default FNOx in top 2 cm value (constant phi across Antarctica) !FNOx2_A298to307(II,JJ) = sigma(1)*phi(1) !& *nit_top2A(II,JJ)*Io_02_A298to307_1(II,JJ) !FNOx2_A307to312(II,JJ) = sigma(2)*phi(1) !& *nit_top2A(II,JJ)*Io_02_A307to312_1(II,JJ) !FNOx2_A312to320(II,JJ) = sigma(3)*phi(1) !& *nit_top2A(II,JJ)*Io_02_A312to320_1(II,JJ) !FNOx2_A320to345(II,JJ) = sigma(4)*phi(1) !& *nit_top2A(II,JJ)*Io_02_A320to345_1(II,JJ) !Variable phi across Antarctica FNOx2_A298to307(II,JJ) = sigma(1)*phi_vary_A(II,JJ) & *nit_top2A(II,JJ)*Io_02_A298to307_1(II,JJ) FNOx2_A307to312(II,JJ) = sigma(2)*phi_vary_A(II,JJ) & *nit_top2A(II,JJ)*Io_02_A307to312_1(II,JJ) FNOx2_A312to320(II,JJ) = sigma(3)*phi_vary_A(II,JJ) & *nit_top2A(II,JJ)*Io_02_A312to320_1(II,JJ) FNOx2_A320to345(II,JJ) = sigma(4)*phi_vary_A(II,JJ) & *nit_top2A(II,JJ)*Io_02_A320to345_1(II,JJ) !For sensitivity study when large and small phi values both used to calculate FNOx !FNOx2_A298to307(II,JJ) = sigma(1)*nit_top2A(II,JJ)* !& Io_02_A298to307_1(II,JJ) * ( 0.6d0*FRACNOPD1(II,JJ,1) !& + phi(1)*(1-FRACNOPD1(II,JJ,1)) ) !FNOx2_A307to312(II,JJ) = sigma(2)*nit_top2A(II,JJ)* !& Io_02_A307to312_1(II,JJ) * ( 0.6d0*FRACNOPD1(II,JJ,1) !& + phi(1)*(1-FRACNOPD1(II,JJ,1)) ) !FNOx2_A312to320(II,JJ) = sigma(3)*nit_top2A(II,JJ)* !& Io_02_A312to320_1(II,JJ) * ( 0.6d0*FRACNOPD1(II,JJ,1) !& + phi(1)*(1-FRACNOPD1(II,JJ,1)) ) !FNOx2_A320to345(II,JJ) = sigma(4)*nit_top2A(II,JJ)* !& Io_02_A320to345_1(II,JJ) * ( 0.6d0*FRACNOPD1(II,JJ,1) !& + phi(1)*(1-FRACNOPD1(II,JJ,1)) ) !With constant phi across Antarctica !FNOxz_A298to307(II,JJ) = (nit_bl2A(II,JJ)*sigma(1)* !& phi(1))*IntIz_A298to307_1(II,JJ) !FNOxz_A307to312(II,JJ) = (nit_bl2A(II,JJ)*sigma(2)* !& phi(1))*IntIz_A307to312_1(II,JJ) !FNOxz_A312to320(II,JJ) = (nit_bl2A(II,JJ)*sigma(3)* !& phi(1))*IntIz_A312to320_1(II,JJ) !FNOxz_A320to345(II,JJ) = (nit_bl2A(II,JJ)*sigma(4)* !& phi(1))*IntIz_A320to345_1(II,JJ) !With variable phi across Antarctica FNOxz_A298to307(II,JJ) = (nit_bl2A(II,JJ)*sigma(1)* & phi_vary_A(II,JJ))*IntIz_A298to307_1(II,JJ) FNOxz_A307to312(II,JJ) = (nit_bl2A(II,JJ)*sigma(2)* & phi_vary_A(II,JJ))*IntIz_A307to312_1(II,JJ) FNOxz_A312to320(II,JJ) = (nit_bl2A(II,JJ)*sigma(3)* & phi_vary_A(II,JJ))*IntIz_A312to320_1(II,JJ) FNOxz_A320to345(II,JJ) = (nit_bl2A(II,JJ)*sigma(4)* & phi_vary_A(II,JJ))*IntIz_A320to345_1(II,JJ) !write(6,*),'FNOx2_A312to320(II,JJ)', FNOx2_A312to320(II,JJ) !write(6,*),'FNOx2_A312to320(II,JJ)', FNOx2_A312to320(II,JJ) FNOx_A298to307(II,JJ) = FNOx2_A298to307(II,JJ) & + FNOxz_A298to307(II,JJ) FNOx_A307to312(II,JJ) = FNOx2_A307to312(II,JJ) & + FNOxz_A307to312(II,JJ) FNOx_A312to320(II,JJ) = FNOx2_A312to320(II,JJ) & + FNOxz_A312to320(II,JJ) FNOx_A320to345(II,JJ) = FNOx2_A320to345(II,JJ) & + FNOxz_A320to345(II,JJ) !write(6,*),'FNOx_A312to320(II,JJ)',FNOx_A312to320(II,JJ) FNOx_A(II,JJ) = FNOx_A298to307(II,JJ) + & FNOx_A307to312(II,JJ) + & FNOx_A312to320(II,JJ) + & FNOx_A320to345(II,JJ) !write(6,*),'FNOx_A(II,JJ)',FNOx_A(II,JJ) !IF ( ANNACC1(II,JJ,1) <= 4 ) THEN !FNOx_A(II,JJ) = 0 !ELSE !FNOx_A(II,JJ) = FNOx_A(II,JJ) !ENDIF !write(6,*), 'PBL height' , 'II', 'JJ', PBL(II,JJ), II, JJ !write(6,*), 'HiFNOx' , 'II', 'JJ', FNOx_A312to320(II,JJ), II, JJ !write(6,*), 'Hi' , FNOx_A312to320(116,7) !write(6,*), 'Vostok PBL height' , PBL(116,7) !write(6,*), 'SP PBL height' , PBL(73,1) !write(6,*), 'Dome C PBL height' , PBL(122,8) !write(6,*), 'WAIS-Div PBL height' , PBL(28,6) !write(6,*), 'Halley PBL height' , PBL(63,8) !write(6,*), 'Neumay PBL height' , PBL(70,11) !write(6,*), 'Kohnen PBL height' , PBL(73,8) ENDDO ENDDO !write(6,*), 'Vostok pzone depth_298to307', zvent_A298to307(116,7) !write(6,*), 'Vostok FNOx_2_298to307' , FNOx2_A298to307(116,7) !write(6,*), 'Vostok FNOx_bl2cm_298to307' , FNOxz_A298to307(116,7) !write(6,*), 'Vostok pzone depth_307to312', zvent_A307to312(116,7) !write(6,*), 'Vostok FNOx_2_307to312' , FNOx2_A307to312(116,7) !write(6,*), 'Vostok FNOx_bl2cm_307to312' , FNOxz_A307to312(116,7) !write(6,*), 'Vostok pzone depth_312to320', zvent_A312to320(116,7) !write(6,*), 'Vostok FNOx_2_312to320' , FNOx2_A312to320(116,7) !write(6,*), 'Vostok FNOx_bl2cm_312to320' , FNOxz_A312to320(116,7) !write(6,*), 'Vostok pzone depth_320to345', zvent_A320to345(116,7) !write(6,*), 'Vostok FNOx_2_320to345' , FNOx2_A320to345(116,7) !write(6,*), 'Vostok FNOx_bl2cm_320to345' , FNOxz_A320to345(116,7) !write(6,*), 'SP pzone depth_298to307', zvent_A298to307(73,1) !write(6,*), 'SP pzone depth_307to312', zvent_A307to312(73,1) !write(6,*), 'SP pzone depth_312to320', zvent_A312to320(73,1) !write(6,*), 'SP pzone depth_320to345', zvent_A320to345(73,1) !write(6,*), 'SP FNOx_2_298to307' , FNOx2_A298to307(73,1) !write(6,*), 'SP FNOx_2_307to312' , FNOx2_A307to312(73,1) !write(6,*), 'SP FNOx_2_312to320' , FNOx2_A312to320(73,1) !write(6,*), 'SP FNOx_2_320to345' , FNOx2_A320to345(73,1) !write(6,*), 'SP FNOx_bl2cm_298to307' , FNOxz_A298to307(73,1) !write(6,*), 'SP FNOx_bl2cm_307to312' , FNOxz_A307to312(73,1) !write(6,*), 'SP FNOx_bl2cm_312to320' , FNOxz_A312to320(73,1) !write(6,*), 'SP FNOx_bl2cm_320to345' , FNOxz_A320to345(73,1) !write(6,*), 'Dome C pzone depth_298to307', zvent_A298to307(122,8) !write(6,*), 'Dome C pzone depth_307to312', zvent_A307to312(122,8) !write(6,*), 'Dome C pzone depth_312to320', zvent_A312to320(122,8) !write(6,*), 'Dome C pzone depth_320to345', zvent_A320to345(122,8) !write(6,*), 'Dome C FNOx_2_298to307' , FNOx2_A298to307(122,8) !write(6,*), 'Dome C FNOx_2_307to312' , FNOx2_A307to312(122,8) !write(6,*), 'Dome C FNOx_2_312to320' , FNOx2_A312to320(122,8) !write(6,*), 'Dome C FNOx_2_320to345' , FNOx2_A320to345(122,8) !write(6,*), 'Dome C FNOx_bl2cm_298to307' , FNOxz_A298to307(122,8) !write(6,*), 'Dome C FNOx_bl2cm_307to312' , FNOxz_A307to312(122,8) !write(6,*), 'Dome C FNOx_bl2cm_312to320' , FNOxz_A312to320(122,8) !write(6,*), 'Dome C FNOx_bl2cm_320to345' , FNOxz_A320to345(122,8) !write(6,*), 'WAIS-Div pzone depth_298to307', zvent_A298to307(28,6) !write(6,*), 'WAIS-Div pzone depth_307to312', zvent_A307to312(28,6) !write(6,*), 'WAIS-Div pzone depth_312to320', zvent_A312to320(28,6) !write(6,*), 'WAIS-Div pzone depth_320to345', zvent_A320to345(28,6) !write(6,*), 'WAIS-Div FNOx_2_298to307' , FNOx2_A298to307(28,6) !write(6,*), 'WAIS-Div FNOx_2_307to312' , FNOx2_A307to312(28,6) !write(6,*), 'WAIS-Div FNOx_2_312to320' , FNOx2_A312to320(28,6) !write(6,*), 'WAIS-Div FNOx_2_320to345' , FNOx2_A320to345(28,6) !write(6,*), 'WAIS-Div FNOx_bl2cm_298to307' , FNOxz_A298to307(28,6) !write(6,*), 'WAIS-Div FNOx_bl2cm_307to312' , FNOxz_A307to312(28,6) !write(6,*), 'WAIS-Div FNOx_bl2cm_312to320' , FNOxz_A312to320(28,6) !write(6,*), 'WAIS-Div FNOx_bl2cm_320to345' , FNOxz_A320to345(28,6) !write(6,*), 'Halley pzone depth_298to307', zvent_A298to307(63,8) !write(6,*), 'Halley pzone depth_307to312', zvent_A307to312(63,8) !write(6,*), 'Halley pzone depth_312to320', zvent_A312to320(63,8) !write(6,*), 'Halley pzone depth_320to345', zvent_A320to345(63,8) !write(6,*), 'Halley FNOx_2_298to307' , FNOx2_A298to307(63,8) !write(6,*), 'Halley FNOx_2_307to312' , FNOx2_A307to312(63,8) !write(6,*), 'Halley FNOx_2_312to320' , FNOx2_A312to320(63,8) !write(6,*), 'Halley FNOx_2_320to345' , FNOx2_A320to345(63,8) !write(6,*), 'Halley FNOx_bl2cm_298to307' , FNOxz_A298to307(63,8) !write(6,*), 'Halley FNOx_bl2cm_307to312' , FNOxz_A307to312(63,8) !write(6,*), 'Halley FNOx_bl2cm_312to320' , FNOxz_A312to320(63,8) !write(6,*), 'Halley FNOx_bl2cm_320to345' , FNOxz_A320to345(63,8) !write(6,*), 'Neumay pzone depth_298to307', zvent_A298to307(70,11) !write(6,*), 'Neumay pzone depth_307to312', zvent_A307to312(70,11) !write(6,*), 'Neumay pzone depth_312to320', zvent_A312to320(70,11) !write(6,*), 'Neumay pzone depth_320to345', zvent_A320to345(70,11) !write(6,*), 'Neumay FNOx_2_298to307' , FNOx2_A298to307(70,11) !write(6,*), 'Neumay FNOx_2_307to312' , FNOx2_A307to312(70,11) !write(6,*), 'Neumay FNOx_2_312to320' , FNOx2_A312to320(70,11) !write(6,*), 'Neumay FNOx_2_320to345' , FNOx2_A320to345(70,11) !write(6,*), 'Neumay FNOx_bl2cm_298to307' , FNOxz_A298to307(70,11) !write(6,*), 'Neumay FNOx_bl2cm_307to312' , FNOxz_A307to312(70,11) !write(6,*), 'Neumay FNOx_bl2cm_312to320' , FNOxz_A312to320(70,11) !write(6,*), 'Neumay FNOx_bl2cm_320to345' , FNOxz_A320to345(70,11) !write(6,*), 'Kohnen pzone depth_298to307', zvent_A298to307(73,8) !write(6,*), 'Kohnen pzone depth_307to312', zvent_A307to312(73,8) !write(6,*), 'Kohnen pzone depth_312to320', zvent_A312to320(73,8) !write(6,*), 'Kohnen pzone depth_320to345', zvent_A320to345(73,8) !write(6,*), 'Kohnen FNOx_2_298to307' , FNOx2_A298to307(73,8) !write(6,*), 'Kohnen FNOx_2_307to312' , FNOx2_A307to312(73,8) !write(6,*), 'Kohnen FNOx_2_312to320' , FNOx2_A312to320(73,8) !write(6,*), 'Kohnen FNOx_2_320to345' , FNOx2_A320to345(73,8) !write(6,*), 'Kohnen FNOx_bl2cm_298to307' , FNOxz_A298to307(73,8) !write(6,*), 'Kohnen FNOx_bl2cm_307to312' , FNOxz_A307to312(73,8) !write(6,*), 'Kohnen FNOx_bl2cm_312to320' , FNOxz_A312to320(73,8) !write(6,*), 'Kohnen FNOx_bl2cm_320to345' , FNOxz_A320to345(73,8) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !Greenland!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !DO JJ = 39, 44 !Latitude - 4x5 !DO II = 23, 44 !Longitude - 4x5 DO JJ = 76, 88 !Latitude -2x2.5 DO II = 45, 68 !Longitude - 2x2.5 !Direct and Diffuse Downwelling radiation FTOT_298to307_G(II,JJ) = DIRRAD298307(II,JJ) + DIFRAD298307(II,JJ) FTOT_307to312_G(II,JJ) = DIRRAD307312(II,JJ) + DIFRAD307312(II,JJ) FTOT_312to320_G(II,JJ) = DIRRAD312320(II,JJ) + DIFRAD312320(II,JJ) FTOT_320to345_G(II,JJ) = DIRRAD320345(II,JJ) + DIFRAD320345(II,JJ) FDIF_298to307_G(II,JJ)=DIFRAD298307(II,JJ)/FTOT_298to307_G(II,JJ) FDIF_307to312_G(II,JJ)=DIFRAD307312(II,JJ)/FTOT_307to312_G(II,JJ) FDIF_312to320_G(II,JJ)=DIFRAD312320(II,JJ)/FTOT_312to320_G(II,JJ) FDIF_320to345_G(II,JJ)=DIFRAD320345(II,JJ)/FTOT_320to345_G(II,JJ) UO_G(II,JJ) = UO(II,JJ) DIRRAD_298345_G(II,JJ)=DIRRAD298307(II,JJ)+DIRRAD307312(II,JJ) & + DIRRAD312320(II,JJ) + DIRRAD320345(II,JJ) DIFRAD_298345_G(II,JJ)=DIFRAD298307(II,JJ)+DIFRAD307312(II,JJ) & + DIFRAD312320(II,JJ) + DIFRAD320345(II,JJ) FDIF_298to345_G(II,JJ)=DIFRAD_298345_G(II,JJ)/ & (DIRRAD_298345_G(II,JJ)+DIFRAD_298345_G(II,JJ)) FTOT_298to345_G(II,JJ)=DIRRAD_298345_G(II,JJ)+ & DIFRAD_298345_G(II,JJ) phi_vary_G(II,JJ) = exp(3.6d0 - (2400.d0/T(II,JJ,1))) !Snowpack Impurity Concentrations !CBC_G(II,JJ) = CBC_GS * (ANNACC1(29,42,1)/ ANNACC1(II,JJ,1)) !For Summit 4x5 !CBC_G(II,JJ) = CBC_GS !CBC_G(II,JJ) = CBC_GS * (ANNACC1(57,83,1)/ ANNACC1(II,JJ,1)) !For Summit 2x25 CBC_G(II,JJ) = SNOWBC1(II,JJ,1)*1.d-9 !For when BC deposition rates are used (g/g)! IF ( CBC_G(II,JJ) <= 0.1d-9 ) THEN CBC_G(II,JJ) = 0.1d-9 ELSE CBC_G(II,JJ) = CBC_G(II,JJ) ENDIF IF (MONTH==8 .OR. MONTH==6) THEN reG = re_SOS_G ELSEIF (MONTH == 7) THEN reG = re_SOS_G ELSE reG = re_SOS_G ENDIF LmaxBC_G(II,JJ) = CBC_G(II,JJ)*(MASSWATER(2)/FILTERAREA) LBC_G(II,JJ) = LmaxBC_G(II,JJ)*fBC_G tautot_G675(II,JJ) = LmaxBC_G(II,JJ)*B(6) tauBC_G675(II,JJ) = LBC_G(II,JJ)*B(6) taunonBC_G675(II,JJ) = tautot_G675(II,JJ)-tauBC_G675(II,JJ) tauBC_G298(II,JJ)=(tauBC_G675(II,JJ)*((298.0d0/675.0d0)**-A(1))) tauBC_G307(II,JJ)=(tauBC_G675(II,JJ)*((307.0d0/675.0d0)**-A(1))) tauBC_G312(II,JJ)=(tauBC_G675(II,JJ)*((312.0d0/675.0d0)**-A(1))) tauBC_G320(II,JJ)=(tauBC_G675(II,JJ)*((320.0d0/675.0d0)**-A(1))) tauBC_G345(II,JJ)=(tauBC_G675(II,JJ)*((345.0d0/675.0d0)**-A(1))) taunonBC_G298(II,JJ) = (taunonBC_G675(II,JJ) * & ((298.0d0/675.0d0)**-A(2))) taunonBC_G307(II,JJ) = (taunonBC_G675(II,JJ) * & ((307.0d0/675.0d0)**-A(2))) taunonBC_G312(II,JJ) = (taunonBC_G675(II,JJ) * & ((312.0d0/675.0d0)**-A(2))) taunonBC_G320(II,JJ) = (taunonBC_G675(II,JJ) * & ((320.0d0/675.0d0)**-A(2))) taunonBC_G345(II,JJ) = (taunonBC_G675(II,JJ) * & ((345.0d0/675.0d0)**-A(2))) DO K = 1,300 re_vertG(II,JJ,K) = reG(K) SNOWDENSITY_V(II,JJ,K) = SNOWDENSITY_VARYG(K) !variable grain size profile zde(II,JJ,K) = (K-1.d0) / 100.0d0 !units: meters !Inherent Optical Properties KextnonBC_G298(II,JJ,K) = (taunonBC_G298(II,JJ)* & SNOWDENSITY_V(II,JJ,K)* & (FILTERAREA/MASSWATER(2))) /cwnonBCs(1) KextnonBC_G307(II,JJ,K) = (taunonBC_G307(II,JJ)* & SNOWDENSITY_V(II,JJ,K)* & (FILTERAREA/MASSWATER(2)))/cwnonBCs(2) KextnonBC_G312(II,JJ,K) = (taunonBC_G312(II,JJ)* & SNOWDENSITY_V(II,JJ,K)* & (FILTERAREA/MASSWATER(2)))/cwnonBCs(3) KextnonBC_G320(II,JJ,K) = (taunonBC_G320(II,JJ)* & SNOWDENSITY_V(II,JJ,K)* & (FILTERAREA/MASSWATER(2)))/cwnonBCs(4) KextnonBC_G345(II,JJ,K) = (taunonBC_G345(II,JJ)* & SNOWDENSITY_V(II,JJ,K)* & (FILTERAREA/MASSWATER(2)))/cwnonBCs(5) KextBC_G298(II,JJ,K) = (B(1)*CBC_G(II,JJ)*SNOWDENSITY_V(II,JJ,K)) & /cwBCs(1) KextBC_G307(II,JJ,K) = (B(2)*CBC_G(II,JJ)*SNOWDENSITY_V(II,JJ,K)) & /cwBCs(2) KextBC_G312(II,JJ,K) = (B(3)*CBC_G(II,JJ)*SNOWDENSITY_V(II,JJ,K)) & /cwBCs(3) KextBC_G320(II,JJ,K) = (B(4)*CBC_G(II,JJ)*SNOWDENSITY_V(II,JJ,K)) & /cwBCs(4) KextBC_G345(II,JJ,K) = (B(5)*CBC_G(II,JJ)*SNOWDENSITY_V(II,JJ,K)) & /cwBCs(5) Kextsnow_G298(II,JJ,K) = (3.0d0*Qexts(1)*SNOWDENSITY_V(II,JJ,K))/ & (4.0d0*re_vertG(II,JJ,K)*ICEDENSITY) Kextsnow_G307(II,JJ,K) = (3.0d0*Qexts(2)*SNOWDENSITY_V(II,JJ,K))/ & (4.0d0*re_vertG(II,JJ,K)*ICEDENSITY) Kextsnow_G312(II,JJ,K) = (3.0d0*Qexts(3)*SNOWDENSITY_V(II,JJ,K))/ & (4.0d0*re_vertG(II,JJ,K)*ICEDENSITY) Kextsnow_G320(II,JJ,K) = (3.0d0*Qexts(4)*SNOWDENSITY_V(II,JJ,K))/ & (4.0d0*re_vertG(II,JJ,K)*ICEDENSITY) Kextsnow_G345(II,JJ,K) = (3.0d0*Qexts(5)*SNOWDENSITY_V(II,JJ,K))/ & (4.0d0*re_vertG(II,JJ,K)*ICEDENSITY) Kexttot_G298(II,JJ,K) = KextnonBC_G298(II,JJ,K) + & KextBC_G298(II,JJ,K) + Kextsnow_G298(II,JJ,K) Kexttot_G307(II,JJ,K) = KextnonBC_G307(II,JJ,K) + & KextBC_G307(II,JJ,K) + Kextsnow_G307(II,JJ,K) Kexttot_G312(II,JJ,K) = KextnonBC_G312(II,JJ,K) + & KextBC_G312(II,JJ,K) + Kextsnow_G312(II,JJ,K) Kexttot_G320(II,JJ,K) = KextnonBC_G320(II,JJ,K) + & KextBC_G320(II,JJ,K) + Kextsnow_G320(II,JJ,K) Kexttot_G345(II,JJ,K) = KextnonBC_G345(II,JJ,K) + & KextBC_G345(II,JJ,K) + Kextsnow_G345(II,JJ,K) cweff_G298(II,JJ,K) = (Kextsnow_G298(II,JJ,K)*cwsnows(1) & + KextBC_G298(II,JJ,K)*cwBCs(1) + & KextnonBC_G298(II,JJ,K)*cwnonBCs(1)) & /Kexttot_G298(II,JJ,K) cweff_G307(II,JJ,K) = (Kextsnow_G307(II,JJ,K)*cwsnows(2) & + KextBC_G307(II,JJ,K)*cwBCs(2) + & KextnonBC_G307(II,JJ,K)*cwnonBCs(2)) & /Kexttot_G307(II,JJ,K) cweff_G312(II,JJ,K) = (Kextsnow_G312(II,JJ,K)*cwsnows(3) & + KextBC_G312(II,JJ,K)*cwBCs(3) + & KextnonBC_G312(II,JJ,K)*cwnonBCs(3)) & /Kexttot_G312(II,JJ,K) cweff_G320(II,JJ,K) = (Kextsnow_G320(II,JJ,K)*cwsnows(4) & + KextBC_G320(II,JJ,K)*cwBCs(4) + & KextnonBC_G320(II,JJ,K)*cwnonBCs(4)) & /Kexttot_G320(II,JJ,K) cweff_G345(II,JJ,K) = (Kextsnow_G345(II,JJ,K)*cwsnows(5) & + KextBC_G345(II,JJ,K)*cwBCs(5) + & KextnonBC_G345(II,JJ,K)*cwnonBCs(5)) & /Kexttot_G345(II,JJ,K) Y_G298(II,JJ,K)=-0.6*(cweff_G298(II,JJ,K)**(0.5d0)) & *Kexttot_G298(II,JJ,K) Y_G307(II,JJ,K)=-0.6*(cweff_G307(II,JJ,K)**(0.5d0)) & *Kexttot_G307(II,JJ,K) Y_G312(II,JJ,K)=-0.6*(cweff_G312(II,JJ,K)**(0.5d0)) & *Kexttot_G312(II,JJ,K) Y_G320(II,JJ,K)=-0.6*(cweff_G320(II,JJ,K)**(0.5d0)) & *Kexttot_G320(II,JJ,K) Y_G345(II,JJ,K)=-0.6*(cweff_G345(II,JJ,K)**(0.5d0)) & *Kexttot_G345(II,JJ,K) Y_G298to307(II,JJ,K) = ( Y_G298(II,JJ,K) + Y_G307(II,JJ,K) )/2 Y_G307to312(II,JJ,K) = ( Y_G307(II,JJ,K) + Y_G312(II,JJ,K) )/2 Y_G312to320(II,JJ,K) = ( Y_G312(II,JJ,K) + Y_G320(II,JJ,K) )/2 Y_G320to345(II,JJ,K) = ( Y_G320(II,JJ,K) + Y_G345(II,JJ,K) )/2 ! Actinic Flux for z=0-300 cm Io_z_G298to307(II,JJ,K) = FTOT_298to307_G(II,JJ) * & ( (3.831d0 * FDIF_298to307_G(II,JJ) * exp(Y_G298to307(II,JJ,K) & *zde(II,JJ,K)))+(3.0d0*(0.577d0+UO_G(II,JJ))*CORRUO1(3)* & exp(Y_G298to307(II,JJ,K)*ZREF)*(1.0d0-FDIF_298to307_G(II,JJ))* & exp(Y_G298to307(II,JJ,K) * (zde(II,JJ,K)-ZREF)))) Io_z_G307to312(II,JJ,K) = FTOT_307to312_G(II,JJ) * & ( (3.831d0 * FDIF_307to312_G(II,JJ) * exp(Y_G307to312(II,JJ,K) & *zde(II,JJ,K)))+(3.0d0*(0.577d0+UO_G(II,JJ))*CORRUO1(3)* & exp(Y_G307to312(II,JJ,K)*ZREF)*(1.0d0-FDIF_307to312_G(II,JJ))* & exp(Y_G307to312(II,JJ,K) * (zde(II,JJ,K)-ZREF)))) Io_z_G312to320(II,JJ,K) = FTOT_312to320_G(II,JJ) * & ( (3.831d0 * FDIF_312to320_G(II,JJ) * exp(Y_G312to320(II,JJ,K) & *zde(II,JJ,K)))+(3.0d0*(0.577d0+UO_G(II,JJ))*CORRUO1(3)* & exp(Y_G312to320(II,JJ,K)*ZREF)*(1.0d0-FDIF_312to320_G(II,JJ))* & exp(Y_G312to320(II,JJ,K) * (zde(II,JJ,K)-ZREF)))) Io_z_G320to345(II,JJ,K) = FTOT_320to345_G(II,JJ) * & ( (3.831d0 * FDIF_320to345_G(II,JJ) * exp(Y_G320to345(II,JJ,K) & *zde(II,JJ,K)))+(3.0d0*(0.577d0+UO_G(II,JJ))*CORRUO1(3)* & exp(Y_G320to345(II,JJ,K)*ZREF)*(1.0d0-FDIF_320to345_G(II,JJ))* & exp(Y_G320to345(II,JJ,K) * (zde(II,JJ,K)-ZREF)))) ENDDO ! Actinic Flux for z = 0 cm Io_0_G298to307_1(II,JJ) = FTOT_298to307_G(II,JJ) * ((3.831d0* & FDIF_298to307_G(II,JJ) * exp(Y_G298to307(II,JJ,1)*0.0d0)) + & ((0.577d0+UO_G(II,JJ))/(0.577d0*UO_G(II,JJ))* & CORRUO1(3) * (1.0d0-FDIF_298to307_G(II,JJ)))) Io_0_G307to312_1(II,JJ) = FTOT_307to312_G(II,JJ) * ((3.831d0* & FDIF_307to312_G(II,JJ) * exp(Y_G307to312(II,JJ,1)*0.0d0)) + & ((0.577d0+UO_G(II,JJ))/(0.577d0*UO_G(II,JJ))* & CORRUO1(3) * (1.0d0-FDIF_307to312_G(II,JJ)))) Io_0_G312to320_1(II,JJ) = FTOT_312to320_G(II,JJ) * ((3.831d0* & FDIF_312to320_G(II,JJ) * exp(Y_G312to320(II,JJ,1)*0.0d0)) + & ((0.577d0+UO_G(II,JJ))/(0.577d0*UO_G(II,JJ))* & CORRUO1(3) * (1.0d0-FDIF_312to320_G(II,JJ)))) Io_0_G320to345_1(II,JJ) = FTOT_320to345_G(II,JJ) * ((3.831d0* & FDIF_320to345_G(II,JJ) * exp(Y_G320to345(II,JJ,1)*0.0d0)) + & ((0.577d0+UO_G(II,JJ))/(0.577d0*UO_G(II,JJ))* & CORRUO1(3) * (1.0d0-FDIF_320to345_G(II,JJ)))) !Actinic Flux at 1 cm Io_1_G298to307_1(II,JJ) = (Io_0_G298to307_1(II,JJ) & + Io_z_G298to307(II,JJ,3))/2 Io_1_G307to312_1(II,JJ) = (Io_0_G307to312_1(II,JJ) & + Io_z_G307to312(II,JJ,3))/2 Io_1_G312to320_1(II,JJ) = (Io_0_G312to320_1(II,JJ) & + Io_z_G312to320(II,JJ,3))/2 Io_1_G320to345_1(II,JJ) = (Io_0_G320to345_1(II,JJ) & + Io_z_G320to345(II,JJ,3))/2 !e-folding depth calculation !pefold_G298to307(II,JJ) = Io_0_G298to307_1(II,JJ)/exp(1.0d0) !pefold_G307to312(II,JJ) = Io_0_G307to312_1(II,JJ)/exp(1.0d0) !pefold_G312to320(II,JJ) = Io_0_G312to320_1(II,JJ)/exp(1.0d0) !pefold_G320to345(II,JJ) = Io_0_G320to345_1(II,JJ)/exp(1.0d0) pefold_G298to307(II,JJ) = Io_z_G298to307(II,JJ,1)/exp(1.0d0) pefold_G307to312(II,JJ) = Io_z_G307to312(II,JJ,1)/exp(1.0d0) pefold_G312to320(II,JJ) = Io_z_G312to320(II,JJ,1)/exp(1.0d0) pefold_G320to345(II,JJ) = Io_z_G320to345(II,JJ,1)/exp(1.0d0) DO K = 1,300 IF ( Io_z_G298to307(II,JJ,K) <= pefold_G298to307(II,JJ) & .AND. Io_z_G298to307(II,JJ,K) & >= 0.95d0*pefold_G298to307(II,JJ) ) THEN efold_G298to307(II,JJ) = (K-1) ENDIF IF ( Io_z_G307to312(II,JJ,K) <= pefold_G307to312(II,JJ) & .AND. Io_z_G307to312(II,JJ,K) & >= 0.95d0*pefold_G307to312(II,JJ) ) THEN efold_G307to312(II,JJ) = (K-1) ENDIF IF ( Io_z_G312to320(II,JJ,K) <= pefold_G312to320(II,JJ) & .AND. Io_z_G312to320(II,JJ,K) & >= 0.95d0*pefold_G312to320(II,JJ) ) THEN efold_G312to320(II,JJ) = (K-1) ENDIF IF ( Io_z_G320to345(II,JJ,K) <= pefold_G320to345(II,JJ) & .AND. Io_z_G320to345(II,JJ,K) & >= 0.95d0*pefold_G320to345(II,JJ) ) THEN efold_G320to345(II,JJ) = (K-1) ENDIF zvent_G298to307(II,JJ) = 3.0d0*efold_G298to307(II,JJ) zvent_G307to312(II,JJ) = 3.0d0*efold_G307to312(II,JJ) zvent_G312to320(II,JJ) = 3.0d0*efold_G312to320(II,JJ) zvent_G320to345(II,JJ) = 3.0d0*efold_G320to345(II,JJ) PhotolyticZoneG(II,JJ)=(zvent_G298to307(II,JJ) + & zvent_G307to312(II,JJ) + zvent_G312to320(II,JJ) & + zvent_G320to345(II,JJ))/ 4.0d0 !Actinic flux integration - integration over each cm PIntIz_G298to307(II,JJ,K) = (( (Io_z_G298to307(II,JJ,K-1))/ & ((Y_G298to307(II,JJ,K)/100.0d0))) & *(exp(Y_G298to307(II,JJ,K)*zde(II,JJ,K))- & exp(Y_G298to307(II,JJ,K)*zde(II,JJ,K-1)))) PIntIz_G307to312(II,JJ,K) = (( (Io_z_G307to312(II,JJ,K-1))/ & ((Y_G307to312(II,JJ,K)/100.0d0))) & *(exp(Y_G307to312(II,JJ,K)*zde(II,JJ,K))- & exp(Y_G307to312(II,JJ,K)*zde(II,JJ,K-1)))) PIntIz_G312to320(II,JJ,K) = (( (Io_z_G312to320(II,JJ,K-1))/ & ((Y_G312to320(II,JJ,K)/100.0d0))) & *(exp(Y_G312to320(II,JJ,K)*zde(II,JJ,K))- & exp(Y_G312to320(II,JJ,K)*zde(II,JJ,K-1)))) PIntIz_G320to345(II,JJ,K) = (( (Io_z_G320to345(II,JJ,K-1))/ & ((Y_G320to345(II,JJ,K)/100.0d0))) & *(exp(Y_G320to345(II,JJ,K)*zde(II,JJ,K))- & exp(Y_G320to345(II,JJ,K)*zde(II,JJ,K-1)))) !Sum up actinic flux that has been integrated over each cm interval IntIz_G298to307(II,JJ,P) = & sum(PIntIz_G298to307(II,JJ,3:zvent_G298to307(II,JJ) ) ) IntIz_G307to312(II,JJ,P) = & sum(PIntIz_G307to312(II,JJ,3:zvent_G307to312(II,JJ) ) ) IntIz_G312to320(II,JJ,P) = & sum(PIntIz_G312to320(II,JJ,3:zvent_G312to320(II,JJ) ) ) IntIz_G320to345(II,JJ,P) = & sum(PIntIz_G320to345(II,JJ,3:zvent_G320to345(II,JJ) ) ) IntIz_G298to307_1(II,JJ) = IntIz_G298to307(II,JJ,P) IntIz_G307to312_1(II,JJ) = IntIz_G307to312(II,JJ,P) IntIz_G312to320_1(II,JJ) = IntIz_G312to320(II,JJ,P) IntIz_G320to345_1(II,JJ) = IntIz_G320to345(II,JJ,P) ENDDO !write(6,*),'PhotolyticZoneG(II,JJ)',II,JJ,PhotolyticZoneG(II,JJ) !Integrate Actinic Flux in top 2 cm (use trapezoid rule, so divide and multiply by two) Io_02_G298to307(II,JJ,P) = Io_0_G298to307_1(II,JJ) + & Io_z_G298to307(II,JJ,3) Io_02_G298to307_1(II,JJ) = Io_02_G298to307(II,JJ,P) Io_02_G307to312(II,JJ,P) = Io_0_G307to312_1(II,JJ) + & Io_z_G307to312(II,JJ,3) Io_02_G307to312_1(II,JJ) = Io_02_G307to312(II,JJ,P) Io_02_G312to320(II,JJ,P) = Io_0_G312to320_1(II,JJ) + & Io_z_G312to320(II,JJ,3) Io_02_G312to320_1(II,JJ) = Io_02_G312to320(II,JJ,P) Io_02_G320to345(II,JJ,P) = Io_0_G320to345_1(II,JJ) + & Io_z_G320to345(II,JJ,3) Io_02_G320to345_1(II,JJ) = Io_02_G320to345(II,JJ,P) !Nitrate Concentrations and NOx Flux !nit_bl2G_1(II,JJ) = -0.46d0*ANNACC1(II,JJ,1) + 1.5d2 !ANNACC1 is in mm/year (annually averaged) and nit_bl2G is ppb (nitrate data from Burkhart et al., 2009 (use for 2x25) nit_bl2G_1(II,JJ) = 132 !ppb or ng/g, from Burkhart et al. [2009] !nit_bl2G_1(II,JJ) = -0.24d0*ANNACC1(II,JJ,1) + 1.5d2 !ANNACC1 is in mm/year (annually averaged) and nit_bl2G is ppb (nitrate data from Burkhart et al., 2009 (use for 4x5) !nit_bl2G_1(II,JJ) = NITRATE_ANN1(II,JJ,1) !(units: ppb) This is snow nitrate from nitrate deposition and accumulation rates from last run (use for 4x5 and for 2x25) nit_top2G_1(II,JJ) = EF_G * nit_bl2G_1(II,JJ) ! (units: ppb). For now, assume nitrate in top 2 cm is a factor of 6 larger than below. The observed range is from 1.1-17 [Rothlisberger et al., 2000, Blunier et al., 2005, Frey et al., 2009, Dibb et al., 2004, Dibb et al., 2007., Jacobi et al., 2004., Masclin et al., 2013] nit_bl2G_2(II,JJ) = (nit_bl2G_1(II,JJ)*(PhotolyticZoneG(II,JJ) & -2.0d0) - (nit_bl2G_1(II,JJ)*EF_G - nit_bl2G_1(II,JJ))) & / (PhotolyticZoneG(II,JJ)-2.0d0) ! (ppb) new average nitrate conc. below 2 cm (with photodentrification. Thought is that if we enhance surface, the nitrate below surface must be depleted by an equal amount. !nit_bl2G(II,JJ) = (nit_bl2G_2(II,JJ))*0.36d0*1.d-9*0.016d0 !& *6.023d23 !convert from ppb to molec cm^-3 nit_bl2G(II,JJ) = (nit_bl2G_2(II,JJ))*0.36d0*1.d-9*0.016d0 & *6.023d23*(FRACNOPD1(II,JJ,1)) !convert from ppb to molec cm^-3 !nit_top2G(II,JJ) = (nit_top2G_1(II,JJ))*0.36d0*1.d-9*0.016d0 !& *6.023d23 !convert from ppb to molec cm^-3 nit_top2G(II,JJ) = (nit_top2G_1(II,JJ))*0.36d0*1.d-9*0.016d0 & *6.023d23*(FRACNOPD1(II,JJ,1)) !convert from ppb to molec cm^-3 !With constant phi across Greenland !FNOx2_G298to307(II,JJ) = sigma(1)*phi(2) !& *nit_top2G(II,JJ)*Io_02_G298to307_1(II,JJ) !FNOx2_G307to312(II,JJ) = sigma(2)*phi(2) !& *nit_top2G(II,JJ)*Io_02_G307to312_1(II,JJ) !FNOx2_G312to320(II,JJ) = sigma(3)*phi(2) !& *nit_top2G(II,JJ)*Io_02_G312to320_1(II,JJ) !FNOx2_G320to345(II,JJ) = sigma(4)*phi(2) !& *nit_top2G(II,JJ)*Io_02_G320to345_1(II,JJ) !With variable phi across Greenland FNOx2_G298to307(II,JJ) = sigma(1)*phi_vary_G(II,JJ) & *nit_top2G(II,JJ)*Io_02_G298to307_1(II,JJ) FNOx2_G307to312(II,JJ) = sigma(2)*phi_vary_G(II,JJ) & *nit_top2G(II,JJ)*Io_02_G307to312_1(II,JJ) FNOx2_G312to320(II,JJ) = sigma(3)*phi_vary_G(II,JJ) & *nit_top2G(II,JJ)*Io_02_G312to320_1(II,JJ) FNOx2_G320to345(II,JJ) = sigma(4)*phi_vary_G(II,JJ) & *nit_top2G(II,JJ)*Io_02_G320to345_1(II,JJ) !With constant phi across Greenland !FNOxz_G298to307(II,JJ) = (nit_bl2G(II,JJ)*sigma(1)* !& phi(2))*IntIz_G298to307_1(II,JJ) !FNOxz_G307to312(II,JJ) = (nit_bl2G(II,JJ)*sigma(2)* !& phi(2))*IntIz_G307to312_1(II,JJ) !FNOxz_G312to320(II,JJ) = (nit_bl2G(II,JJ)*sigma(3)* !& phi(2))*IntIz_G312to320_1(II,JJ) !FNOxz_G320to345(II,JJ) = (nit_bl2G(II,JJ)*sigma(4)* !& phi(2))*IntIz_G320to345_1(II,JJ) !With variable phi across Greenland FNOxz_G298to307(II,JJ) = (nit_bl2G(II,JJ)*sigma(1)* & phi_vary_G(II,JJ))*IntIz_G298to307_1(II,JJ) FNOxz_G307to312(II,JJ) = (nit_bl2G(II,JJ)*sigma(2)* & phi_vary_G(II,JJ))*IntIz_G307to312_1(II,JJ) FNOxz_G312to320(II,JJ) = (nit_bl2G(II,JJ)*sigma(3)* & phi_vary_G(II,JJ))*IntIz_G312to320_1(II,JJ) FNOxz_G320to345(II,JJ) = (nit_bl2G(II,JJ)*sigma(4)* & phi_vary_G(II,JJ))*IntIz_G320to345_1(II,JJ) FNOx_G298to307(II,JJ) = FNOx2_G298to307(II,JJ) & + FNOxz_G298to307(II,JJ) FNOx_G307to312(II,JJ) = FNOx2_G307to312(II,JJ) & + FNOxz_G307to312(II,JJ) FNOx_G312to320(II,JJ) = FNOx2_G312to320(II,JJ) & + FNOxz_G312to320(II,JJ) FNOx_G320to345(II,JJ) = FNOx2_G320to345(II,JJ) & + FNOxz_G320to345(II,JJ) FNOx_G(II,JJ) = FNOx_G298to307(II,JJ) + & FNOx_G307to312(II,JJ) + & FNOx_G312to320(II,JJ) + & FNOx_G320to345(II,JJ) !write(6,*), 'Summit PBL height' , PBL(58,82) !write(6,*), 'Camp Century PBL height' , PBL(49,85) !write(6,*), 'Dye 3 PBL height' , PBL(56,79) !write(6,*), 'PBL height' , 'II', 'JJ', PBL(II,JJ), II, JJ !write(6,*), 'HiFNOx' , 'II', 'JJ', FNOx_A312to320(II,JJ), II, JJ ENDDO ENDDO !Put NOx flux into GEOS-Chem now !------------------------------------------------------------------------ !Use appropriate FNOx for the flux that gets archived DO JJ = 1, JJPAR DO II = 1, IIPAR !write(6,*), 'UVALBEDO_Vostok_outsideloop', UVALBEDO(116,7) !write(6,*), 'phi_vary_A_Vostok_outsideloop', phi_vary_A(116,7) !IF ( JJ >= 39 .AND. UVALBEDO(II,JJ) > 0.99d0 !& .AND. UO(II,JJ) > 0.d0) THEN !4x5 !IF ( JJ >= 39 .AND. UVALBEDO(II,JJ) > 0.99d0 ) THEN !4x5 !IF ( JJ >= 76 .AND. UVALBEDO(II,JJ) > 0.99d0 !& .AND. UO(II,JJ) > 0.d0) THEN !2x2.5 !Uncomment this (below) !IF ( JJ >= 76 .AND. UVALBEDO(II,JJ) > 0.99d0 ) THEN !2x2.5 (default for Greenland) IF ( JJ >= 76 ) THEN !2x2.5 (default for Greenland) !IF ( JJ >= 76 .AND. UVALBEDO(II,JJ) > 0.99d0 !& .AND. T(II,JJ,1) <= 248.2d0 ) THEN !Sensitivty study - FNOx is 0 if T > = -25*C (for Greenland) SNOWNOX(II,JJ) = FNOx_G(II,JJ) !NOx flux for Greenland PhotolyticZone(II,JJ) = PhotolyticZoneG(II,JJ) !Photolytic zone in Antarctic snow UO_1(II,JJ) = UO_G(II,JJ) FTOT_298to345(II,JJ) = FTOT_298to345_G(II,JJ) FDIF_298to345(II,JJ) = FDIF_298to345_G(II,JJ) !ELSEIF ( JJ <= 8 .AND. UVALBEDO(II,JJ) > 0.99d0 !& .AND. UO_A(II,JJ) > 0.d0) THEN !4x5 !ELSEIF ( JJ <= 8 .AND. UVALBEDO(II,JJ) > 0.99d0 ) THEN !4x5 !ELSEIF ( JJ <= 15 .AND. UVALBEDO(II,JJ) > 0.99d0 !& .AND. UO(II,JJ) > 0.d0) THEN !2x2.5 !Uncomment this (below) !ELSEIF ( JJ <= 15 .AND. UVALBEDO(II,JJ) > 0.99d0 ) THEN !2x2.5 (default for Antarctica) ELSEIF ( JJ <= 15 ) THEN !ELSEIF ( JJ <= 15 .AND. UVALBEDO(II,JJ) > 0.99d0 !& .AND. ANNACC1(II,JJ,1) >= 4.d0 ) THEN !Sensitivty study - FNOx is 0 on plateau !ELSEIF ( JJ <= 15 .AND. UVALBEDO(II,JJ) > 0.99d0 !& .AND. II >= 73 ) THEN !Sensitivty study - FNOx is 0 in West Antarctica !ELSEIF ( JJ <= 15 .AND. UVALBEDO(II,JJ) > 0.99d0 !& .AND. II < 73 ) THEN !Sensitivty study - FNOx is 0 in East Antarctica !ELSEIF ( JJ <= 15 .AND. UVALBEDO(II,JJ) > 0.99d0 !& .AND. T(II,JJ,1) <= 248.2d0 ) THEN !Sensitivty study - FNOx is 0 if T > = -25*C (for Antarctica) !SNOWNOX(II,JJ) = FNOx_A(II,JJ) !NOx flux for Antarctica SNOWNOX(II,JJ) = DIRRAD312320(II,JJ) !Tester NOx flux PhotolyticZone(II,JJ) = PhotolyticZoneA(II,JJ) !Photolytic zone in Greenland snow UO_1(II,JJ) = UO_A(II,JJ) FTOT_298to345(II,JJ) = FTOT_298to345_A(II,JJ) FDIF_298to345(II,JJ) = FDIF_298to345_A(II,JJ) ELSE SNOWNOX(II,JJ) = 0.d0 !Set SNOWNOX equal to 0 in non-polar regions PhotolyticZone(II,JJ) = 0.d0 UO_1(II,JJ) = 0.d0 FTOT_298to345(II,JJ) = 0.d0 FDIF_298to345(II,JJ) = 0.d0 ENDIF !write(6,*), 'SnowNOx_Vostok_insideloop', SNOWNOX(116,7) !write(6,*), 'SNOWNOX(II,JJ)', II, JJ, SNOWNOX(II,JJ) !write(6,*), 'PhotolyticZone(II,JJ)', II, JJ, PhotolyticZone(II,JJ) !write(6,*), 'max(UO)', II, JJ, UO_1(II,JJ) !-------------------------------------------------------------------------- ! Archive snow NOx emissions [molec NOx/cm2/s] IF ( ND32 > 0 .AND. SNOWNOX(II,JJ) > 1.d0) THEN !IF ( ND32 > 0 ) THEN AD32_ph(II,JJ) = AD32_ph(II,JJ) + SNOWNOX(II,JJ) ENDIF ! Archive photolytic zones [cm], IF ( ND64 > 0 ) THEN AD64_pz(II,JJ) = PhotolyticZone(II,JJ) AD64_CSZA(II,JJ) = UO_1(II,JJ) AD64_FTOT(II,JJ) = FTOT_298to345(II,JJ) AD64_FDIF(II,JJ) = FDIF_298to345(II,JJ) ENDIF ! Spread NOx emission into the boundary layer ! NOTE: BXHEIGHT is in m, so BXHEIGHT * 100 is in cm. ZBL = 0.D0 KBL = 1 DO L = 1, KBL ZBL = ZBL + BXHEIGHT(II,JJ,L)*100.D0 ENDDO ! Store soil NOx in GEMISNOX2, the global NOx emissions array, which ! gets passed to SMVGEAR. GEMISNOX2 has units of [molec NOx/cm3/s]. GEMISNOX2(II,JJ) = GEMISNOX2(II,JJ) + ( SNOWNOX(II,JJ) / ZBL ) ENDDO ENDDO !write(6,*), 'SnowNOx_Vostok_outsideloop', SNOWNOX(116,7) !write(6,*), 'DIFRAD312320_SN_outsideloop', DIFRAD312320(116,7) END SUBROUTINE SNOWNOXEMS ! !-=============================================================== ! !This is the original code that put a set amount of NOx into the atmosphere from the snow, !!before I added the parameterization to calculate the flux of NOx ! ! !================================================================= ! ! SNOWNOXEMS begins here! ! !================================================================= ! !write(6,*) 'in SNOWNOXEMS' ! ! Get nested-grid offsets (bmy, 2/11/03) ! !I0 = GET_XOFFSET() ! !J0 = GET_YOFFSET() ! ! ! Initalize ! !IJLOOP = 0 ! !DO J = 1, JJPAR ! !DO I = 1, IIPAR ! ! SNOWNOX(I,J) = 0.D0 ! !ENDDO ! !ENDDO ! ! !SNOWNOX calculates NOx emissions in [molec NOx/cm2/s] ! ! !Antarctica and Greenland ======================================== ! !DO J = 1, 7 !only compute snow NOx emissions at latitudes south of ~60 deg S ! DO J = 1, JJPAR ! DO I = 1, IIPAR ! ! write(6,*),'1' ! !IJLOOP is the 1-D grid box index for SUNCOS ! IJLOOP = ( (J-1) * IIPAR ) + I ! write(6,*),'2' ! ! IF ( SUNCOS(IJLOOP) > 0.d0 ! & .and. UVALBEDO(I,J) > 0.99d0) THEN ! write(6,*),'3' ! ! !write(6,*) 'in Antarctica and Greenland' ! !write(6,*) 'SUNCOS = ', SUNCOS(IJLOOP) ! !write(6,*) 'J = ', J ! ! SNOWNOX(I,J) = 5.0d8 !low value from Frey et al. manuscript in prep! ! ELSE ! write(6,*),'4' ! ! SNOWNOX(I,J) = 0.0d0! ! ENDIF ! write(6,*),'5' ! ! ! Archive snow NOx emissions [molec NOx/cm2/s] ! IF ( ND32 > 0 ) THEN ! AD32_ph(I,J) = AD32_ph(I,J) + SNOWNOX(I,J) ! ENDIF ! write(6,*),'6' ! ! ! Spread NOx emission into the boundary layer ! ! NOTE: BXHEIGHT is in m, so BXHEIGHT * 100 is in cm. ! ZBL = 0.D0 ! KBL = 1 ! DO L = 1, KBL ! ZBL = ZBL + BXHEIGHT(I,J,L)*100.D0 ! ENDDO ! write(6,*),'7' ! ! ! Store soil NOx in GEMISNOX2, the global NOx emissions array, which ! ! gets passed to SMVGEAR. GEMISNOX2 has units of [molec NOx/cm3/s]. ! GEMISNOX2(I,J) = GEMISNOX2(I,J) + ( SNOWNOX(I,J) / ZBL ) ! write(6,*),'8' ! ! ENDDO ! ENDDO !----------------------------------------------------------------------------------------------------------- SUBROUTINE CLEANUP_SNOWNOXEMS IF ( ALLOCATED( DIRRAD289298 ) ) DEALLOCATE( DIRRAD289298 ) IF ( ALLOCATED( DIRRAD298307 ) ) DEALLOCATE( DIRRAD298307 ) IF ( ALLOCATED( DIRRAD307312 ) ) DEALLOCATE( DIRRAD307312 ) IF ( ALLOCATED( DIRRAD312320 ) ) DEALLOCATE( DIRRAD312320 ) IF ( ALLOCATED( DIRRAD320345 ) ) DEALLOCATE( DIRRAD320345 ) IF ( ALLOCATED( DIRRAD345412 ) ) DEALLOCATE( DIRRAD345412 ) IF ( ALLOCATED( DIRRAD412850 ) ) DEALLOCATE( DIRRAD412850 ) IF ( ALLOCATED( DIFRAD289298 ) ) DEALLOCATE( DIFRAD289298 ) IF ( ALLOCATED( DIFRAD298307 ) ) DEALLOCATE( DIFRAD298307 ) IF ( ALLOCATED( DIFRAD307312 ) ) DEALLOCATE( DIFRAD307312 ) IF ( ALLOCATED( DIFRAD312320 ) ) DEALLOCATE( DIFRAD312320 ) IF ( ALLOCATED( DIFRAD320345 ) ) DEALLOCATE( DIFRAD320345 ) IF ( ALLOCATED( DIFRAD345412 ) ) DEALLOCATE( DIFRAD345412 ) IF ( ALLOCATED( DIFRAD412850 ) ) DEALLOCATE( DIFRAD412850 ) IF ( ALLOCATED( UO ) ) DEALLOCATE( UO ) IF (ALLOCATED(FTOT_298to307_A)) DEALLOCATE(FTOT_298to307_A) IF (ALLOCATED(FTOT_307to312_A)) DEALLOCATE(FTOT_307to312_A) IF (ALLOCATED(FTOT_312to320_A)) DEALLOCATE(FTOT_312to320_A) IF (ALLOCATED(FTOT_320to345_A)) DEALLOCATE(FTOT_320to345_A) IF (ALLOCATED(FTOT_298to307_G)) DEALLOCATE(FTOT_298to307_G) IF (ALLOCATED(FTOT_307to312_G)) DEALLOCATE(FTOT_307to312_G) IF (ALLOCATED(FTOT_312to320_G)) DEALLOCATE(FTOT_312to320_G) IF (ALLOCATED(FTOT_320to345_G)) DEALLOCATE(FTOT_320to345_G) IF (ALLOCATED(FDIF_298to307_A)) DEALLOCATE(FDIF_298to307_A) IF (ALLOCATED(FDIF_307to312_A)) DEALLOCATE(FDIF_307to312_A) IF (ALLOCATED(FDIF_312to320_A)) DEALLOCATE(FDIF_312to320_A) IF (ALLOCATED(FDIF_320to345_A)) DEALLOCATE(FDIF_320to345_A) IF (ALLOCATED(FDIF_298to307_G)) DEALLOCATE(FDIF_298to307_G) IF (ALLOCATED(FDIF_307to312_G)) DEALLOCATE(FDIF_307to312_G) IF (ALLOCATED(FDIF_312to320_G)) DEALLOCATE(FDIF_312to320_G) IF (ALLOCATED(FDIF_320to345_G)) DEALLOCATE(FDIF_320to345_G) IF (ALLOCATED(DIRRAD_298345_A)) DEALLOCATE(DIRRAD_298345_A) IF (ALLOCATED(DIFRAD_298345_A)) DEALLOCATE(DIFRAD_298345_A) IF (ALLOCATED(DIRRAD_298345_G)) DEALLOCATE(DIRRAD_298345_G) IF (ALLOCATED(DIFRAD_298345_G)) DEALLOCATE(DIFRAD_298345_G) IF (ALLOCATED(FDIF_298to345_A)) DEALLOCATE(FDIF_298to345_A) IF (ALLOCATED(FDIF_298to345_G)) DEALLOCATE(FDIF_298to345_G) IF (ALLOCATED(FDIF_298to345)) DEALLOCATE(FDIF_298to345) IF (ALLOCATED(FTOT_298to345_A)) DEALLOCATE(FTOT_298to345_A) IF (ALLOCATED(FTOT_298to345_G)) DEALLOCATE(FTOT_298to345_G) IF (ALLOCATED(FTOT_298to345)) DEALLOCATE(FTOT_298to345) IF ( ALLOCATED( UO_A ) ) DEALLOCATE( UO_A ) IF ( ALLOCATED( UO_G ) ) DEALLOCATE( UO_G ) IF ( ALLOCATED( UO_1 ) ) DEALLOCATE( UO_1 ) IF ( ALLOCATED( CBC_A ) ) DEALLOCATE( CBC_A ) IF ( ALLOCATED( CBC_G ) ) DEALLOCATE( CBC_G ) IF ( ALLOCATED( CBC ) ) DEALLOCATE( CBC ) IF ( ALLOCATED( phi_vary_A ) ) DEALLOCATE( phi_vary_A ) IF ( ALLOCATED( phi_vary_G ) ) DEALLOCATE( phi_vary_G ) IF ( ALLOCATED( LmaxBC_A ) ) DEALLOCATE( LmaxBC_A ) IF ( ALLOCATED( LmaxBC_G ) ) DEALLOCATE( LmaxBC_G ) IF ( ALLOCATED( LBC_A ) ) DEALLOCATE( LBC_A ) IF ( ALLOCATED( LBC_G ) ) DEALLOCATE( LBC_G ) IF ( ALLOCATED( tautot_A675 ) ) DEALLOCATE( tautot_A675 ) IF ( ALLOCATED( tautot_G675 ) ) DEALLOCATE( tautot_G675 ) IF ( ALLOCATED( tauBC_A675 ) ) DEALLOCATE( tauBC_A675 ) IF ( ALLOCATED( tauBC_G675 ) ) DEALLOCATE( tauBC_G675 ) IF ( ALLOCATED( taunonBC_A675 ) ) DEALLOCATE( taunonBC_A675 ) IF ( ALLOCATED( taunonBC_G675 ) ) DEALLOCATE( taunonBC_G675 ) IF ( ALLOCATED( tauBC_A298 ) ) DEALLOCATE( tauBC_A298 ) IF ( ALLOCATED( tauBC_A307 ) ) DEALLOCATE( tauBC_A307 ) IF ( ALLOCATED( tauBC_A312 ) ) DEALLOCATE( tauBC_A312 ) IF ( ALLOCATED( tauBC_A320 ) ) DEALLOCATE( tauBC_A320 ) IF ( ALLOCATED( tauBC_A345 ) ) DEALLOCATE( tauBC_A345 ) IF ( ALLOCATED( tauBC_G298 ) ) DEALLOCATE( tauBC_G298 ) IF ( ALLOCATED( tauBC_G307 ) ) DEALLOCATE( tauBC_G307 ) IF ( ALLOCATED( tauBC_G312 ) ) DEALLOCATE( tauBC_G312 ) IF ( ALLOCATED( tauBC_G320 ) ) DEALLOCATE( tauBC_G320 ) IF ( ALLOCATED( tauBC_G345 ) ) DEALLOCATE( tauBC_G345 ) IF ( ALLOCATED( taunonBC_A298 ) ) DEALLOCATE( taunonBC_A298 ) IF ( ALLOCATED( taunonBC_A307 ) ) DEALLOCATE( taunonBC_A307 ) IF ( ALLOCATED( taunonBC_A312 ) ) DEALLOCATE( taunonBC_A312 ) IF ( ALLOCATED( taunonBC_A320 ) ) DEALLOCATE( taunonBC_A320 ) IF ( ALLOCATED( taunonBC_A345 ) ) DEALLOCATE( taunonBC_A345 ) IF ( ALLOCATED( taunonBC_G298 ) ) DEALLOCATE( taunonBC_G298 ) IF ( ALLOCATED( taunonBC_G307 ) ) DEALLOCATE( taunonBC_G307 ) IF ( ALLOCATED( taunonBC_G312 ) ) DEALLOCATE( taunonBC_G312 ) IF ( ALLOCATED( taunonBC_G320 ) ) DEALLOCATE( taunonBC_G320 ) IF ( ALLOCATED( taunonBC_G345 ) ) DEALLOCATE( taunonBC_G345 ) IF ( ALLOCATED( KextnonBC_A298 ) ) DEALLOCATE( KextnonBC_A298 ) IF ( ALLOCATED( KextnonBC_A307 ) ) DEALLOCATE( KextnonBC_A307 ) IF ( ALLOCATED( KextnonBC_A312 ) ) DEALLOCATE( KextnonBC_A312 ) IF ( ALLOCATED( KextnonBC_A320 ) ) DEALLOCATE( KextnonBC_A320 ) IF ( ALLOCATED( KextnonBC_A345 ) ) DEALLOCATE( KextnonBC_A345 ) IF ( ALLOCATED( KextnonBC_G298 ) ) DEALLOCATE( KextnonBC_G298 ) IF ( ALLOCATED( KextnonBC_G307 ) ) DEALLOCATE( KextnonBC_G307 ) IF ( ALLOCATED( KextnonBC_G312 ) ) DEALLOCATE( KextnonBC_G312 ) IF ( ALLOCATED( KextnonBC_G320 ) ) DEALLOCATE( KextnonBC_G320 ) IF ( ALLOCATED( KextnonBC_G345 ) ) DEALLOCATE( KextnonBC_G345 ) IF ( ALLOCATED( KextBC_A298 ) ) DEALLOCATE( KextBC_A298 ) IF ( ALLOCATED( KextBC_A307 ) ) DEALLOCATE( KextBC_A307 ) IF ( ALLOCATED( KextBC_A312 ) ) DEALLOCATE( KextBC_A312 ) IF ( ALLOCATED( KextBC_A320 ) ) DEALLOCATE( KextBC_A320 ) IF ( ALLOCATED( KextBC_A345 ) ) DEALLOCATE( KextBC_A345 ) IF ( ALLOCATED( KextBC_G298 ) ) DEALLOCATE( KextBC_G298 ) IF ( ALLOCATED( KextBC_G307 ) ) DEALLOCATE( KextBC_G307 ) IF ( ALLOCATED( KextBC_G312 ) ) DEALLOCATE( KextBC_G312 ) IF ( ALLOCATED( KextBC_G320 ) ) DEALLOCATE( KextBC_G320 ) IF ( ALLOCATED( KextBC_G345 ) ) DEALLOCATE( KextBC_G345 ) IF ( ALLOCATED( re_vert ) ) DEALLOCATE( re_vert ) IF ( ALLOCATED( re_vertG ) ) DEALLOCATE( re_vertG ) IF ( ALLOCATED(SNOWDENSITY_V)) DEALLOCATE(SNOWDENSITY_V) IF ( ALLOCATED( zde ) ) DEALLOCATE( zde ) IF ( ALLOCATED( Kextsnow_A298 ) ) DEALLOCATE( Kextsnow_A298 ) IF ( ALLOCATED( Kextsnow_A307 ) ) DEALLOCATE( Kextsnow_A307 ) IF ( ALLOCATED( Kextsnow_A312 ) ) DEALLOCATE( Kextsnow_A312 ) IF ( ALLOCATED( Kextsnow_A320 ) ) DEALLOCATE( Kextsnow_A320 ) IF ( ALLOCATED( Kextsnow_A345 ) ) DEALLOCATE( Kextsnow_A345 ) IF ( ALLOCATED( Kextsnow_G298 ) ) DEALLOCATE( Kextsnow_G298 ) IF ( ALLOCATED( Kextsnow_G307 ) ) DEALLOCATE( Kextsnow_G307 ) IF ( ALLOCATED( Kextsnow_G312 ) ) DEALLOCATE( Kextsnow_G312 ) IF ( ALLOCATED( Kextsnow_G320 ) ) DEALLOCATE( Kextsnow_G320 ) IF ( ALLOCATED( Kextsnow_G345 ) ) DEALLOCATE( Kextsnow_G345 ) IF ( ALLOCATED( Kexttot_A298 ) ) DEALLOCATE( Kexttot_A298 ) IF ( ALLOCATED( Kexttot_A307 ) ) DEALLOCATE( Kexttot_A307 ) IF ( ALLOCATED( Kexttot_A312 ) ) DEALLOCATE( Kexttot_A312 ) IF ( ALLOCATED( Kexttot_A320 ) ) DEALLOCATE( Kexttot_A320 ) IF ( ALLOCATED( Kexttot_A345 ) ) DEALLOCATE( Kexttot_A345 ) IF ( ALLOCATED( Kexttot_G298 ) ) DEALLOCATE( Kexttot_G298 ) IF ( ALLOCATED( Kexttot_G307 ) ) DEALLOCATE( Kexttot_G307 ) IF ( ALLOCATED( Kexttot_G312 ) ) DEALLOCATE( Kexttot_G312 ) IF ( ALLOCATED( Kexttot_G320 ) ) DEALLOCATE( Kexttot_G320 ) IF ( ALLOCATED( Kexttot_G345 ) ) DEALLOCATE( Kexttot_G345 ) IF ( ALLOCATED( cweff_A298 ) ) DEALLOCATE( cweff_A298 ) IF ( ALLOCATED( cweff_A307 ) ) DEALLOCATE( cweff_A307 ) IF ( ALLOCATED( cweff_A312 ) ) DEALLOCATE( cweff_A312 ) IF ( ALLOCATED( cweff_A320 ) ) DEALLOCATE( cweff_A320 ) IF ( ALLOCATED( cweff_A345 ) ) DEALLOCATE( cweff_A345 ) IF ( ALLOCATED( cweff_G298 ) ) DEALLOCATE( cweff_G298 ) IF ( ALLOCATED( cweff_G307 ) ) DEALLOCATE( cweff_G307 ) IF ( ALLOCATED( cweff_G312 ) ) DEALLOCATE( cweff_G312 ) IF ( ALLOCATED( cweff_G320 ) ) DEALLOCATE( cweff_G320 ) IF ( ALLOCATED( cweff_G345 ) ) DEALLOCATE( cweff_G345 ) IF ( ALLOCATED( Y_A298 ) ) DEALLOCATE( Y_A298 ) IF ( ALLOCATED( Y_A307 ) ) DEALLOCATE( Y_A307 ) IF ( ALLOCATED( Y_A312 ) ) DEALLOCATE( Y_A312 ) IF ( ALLOCATED( Y_A320 ) ) DEALLOCATE( Y_A320 ) IF ( ALLOCATED( Y_A345 ) ) DEALLOCATE( Y_A345 ) IF ( ALLOCATED( Y_G298 ) ) DEALLOCATE( Y_G298 ) IF ( ALLOCATED( Y_G307 ) ) DEALLOCATE( Y_G307 ) IF ( ALLOCATED( Y_G312 ) ) DEALLOCATE( Y_G312 ) IF ( ALLOCATED( Y_G320 ) ) DEALLOCATE( Y_G320 ) IF ( ALLOCATED( Y_G345 ) ) DEALLOCATE( Y_G345 ) IF ( ALLOCATED( Y_A298to307 ) ) DEALLOCATE( Y_A298to307 ) IF ( ALLOCATED( Y_A307to312 ) ) DEALLOCATE( Y_A307to312 ) IF ( ALLOCATED( Y_A312to320 ) ) DEALLOCATE( Y_A312to320 ) IF ( ALLOCATED( Y_A320to345 ) ) DEALLOCATE( Y_A320to345 ) IF ( ALLOCATED( Y_G298to307 ) ) DEALLOCATE( Y_G298to307 ) IF ( ALLOCATED( Y_G307to312 ) ) DEALLOCATE( Y_G307to312 ) IF ( ALLOCATED( Y_G312to320 ) ) DEALLOCATE( Y_G312to320 ) IF ( ALLOCATED( Y_G320to345 ) ) DEALLOCATE( Y_G320to345 ) IF ( ALLOCATED( Io_z_A298to307 ) ) DEALLOCATE( Io_z_A298to307 ) IF ( ALLOCATED( Io_z_A307to312 ) ) DEALLOCATE( Io_z_A307to312 ) IF ( ALLOCATED( Io_z_A312to320 ) ) DEALLOCATE( Io_z_A312to320 ) IF ( ALLOCATED( Io_z_A320to345 ) ) DEALLOCATE( Io_z_A320to345 ) IF ( ALLOCATED( Io_z_G298to307 ) ) DEALLOCATE( Io_z_G298to307 ) IF ( ALLOCATED( Io_z_G307to312 ) ) DEALLOCATE( Io_z_G307to312 ) IF ( ALLOCATED( Io_z_G312to320 ) ) DEALLOCATE( Io_z_G312to320 ) IF ( ALLOCATED( Io_z_G320to345 ) ) DEALLOCATE( Io_z_G320to345 ) IF ( ALLOCATED( Io_0_A298to307 ) ) DEALLOCATE( Io_0_A298to307 ) IF ( ALLOCATED( Io_0_A307to312 ) ) DEALLOCATE( Io_0_A307to312 ) IF ( ALLOCATED( Io_0_A312to320 ) ) DEALLOCATE( Io_0_A312to320 ) IF ( ALLOCATED( Io_0_A320to345 ) ) DEALLOCATE( Io_0_A320to345 ) IF ( ALLOCATED( Io_0_G298to307 ) ) DEALLOCATE( Io_0_G298to307 ) IF ( ALLOCATED( Io_0_G307to312 ) ) DEALLOCATE( Io_0_G307to312 ) IF ( ALLOCATED( Io_0_G312to320 ) ) DEALLOCATE( Io_0_G312to320 ) IF ( ALLOCATED( Io_0_G320to345 ) ) DEALLOCATE( Io_0_G320to345 ) IF ( ALLOCATED(Io_0_A298to307_1)) DEALLOCATE(Io_0_A298to307_1) IF ( ALLOCATED(Io_0_A307to312_1)) DEALLOCATE(Io_0_A307to312_1) IF ( ALLOCATED(Io_0_A312to320_1)) DEALLOCATE(Io_0_A312to320_1) IF ( ALLOCATED(Io_0_A320to345_1)) DEALLOCATE(Io_0_A320to345_1) IF ( ALLOCATED(Io_0_G298to307_1)) DEALLOCATE(Io_0_G298to307_1) IF ( ALLOCATED(Io_0_G307to312_1)) DEALLOCATE(Io_0_G307to312_1) IF ( ALLOCATED(Io_0_G312to320_1)) DEALLOCATE(Io_0_G312to320_1) IF ( ALLOCATED(Io_0_G320to345_1)) DEALLOCATE(Io_0_G320to345_1) IF ( ALLOCATED(Io_1_A298to307)) DEALLOCATE( Io_1_A298to307 ) IF ( ALLOCATED(Io_1_A307to312)) DEALLOCATE( Io_1_A307to312 ) IF ( ALLOCATED(Io_1_A312to320)) DEALLOCATE( Io_1_A312to320 ) IF ( ALLOCATED(Io_1_A320to345)) DEALLOCATE( Io_1_A320to345 ) IF ( ALLOCATED(Io_1_G298to307)) DEALLOCATE( Io_1_G298to307 ) IF ( ALLOCATED(Io_1_G307to312)) DEALLOCATE( Io_1_G307to312 ) IF ( ALLOCATED(Io_1_G312to320)) DEALLOCATE( Io_1_G312to320 ) IF ( ALLOCATED(Io_1_G320to345)) DEALLOCATE( Io_1_G320to345 ) IF ( ALLOCATED(Io_1_A298to307_1)) DEALLOCATE(Io_1_A298to307_1) IF ( ALLOCATED(Io_1_A307to312_1)) DEALLOCATE(Io_1_A307to312_1) IF ( ALLOCATED(Io_1_A312to320_1)) DEALLOCATE(Io_1_A312to320_1) IF ( ALLOCATED(Io_1_A320to345_1)) DEALLOCATE(Io_1_A320to345_1) IF ( ALLOCATED(Io_1_G298to307_1)) DEALLOCATE(Io_1_G298to307_1) IF ( ALLOCATED(Io_1_G307to312_1)) DEALLOCATE(Io_1_G307to312_1) IF ( ALLOCATED(Io_1_G312to320_1)) DEALLOCATE(Io_1_G312to320_1) IF ( ALLOCATED(Io_1_G320to345_1)) DEALLOCATE(Io_1_G320to345_1) IF ( ALLOCATED(pefold_A298to307)) DEALLOCATE(pefold_A298to307) IF ( ALLOCATED(pefold_A307to312)) DEALLOCATE(pefold_A307to312) IF ( ALLOCATED(pefold_A312to320)) DEALLOCATE(pefold_A312to320) IF ( ALLOCATED(pefold_A320to345)) DEALLOCATE(pefold_A320to345) IF ( ALLOCATED(pefold_G298to307)) DEALLOCATE(pefold_G298to307) IF ( ALLOCATED(pefold_G307to312)) DEALLOCATE(pefold_G307to312) IF ( ALLOCATED(pefold_G312to320)) DEALLOCATE(pefold_G312to320) IF ( ALLOCATED(pefold_G320to345)) DEALLOCATE(pefold_G320to345) IF ( ALLOCATED(efold_A298to307)) DEALLOCATE(efold_A298to307) IF ( ALLOCATED(efold_A307to312)) DEALLOCATE(efold_A307to312) IF ( ALLOCATED(efold_A312to320)) DEALLOCATE(efold_A312to320) IF ( ALLOCATED(efold_A320to345)) DEALLOCATE(efold_A320to345) IF ( ALLOCATED(efold_G298to307)) DEALLOCATE(efold_G298to307) IF ( ALLOCATED(efold_G307to312)) DEALLOCATE(efold_G307to312) IF ( ALLOCATED(efold_G312to320)) DEALLOCATE(efold_G312to320) IF ( ALLOCATED(efold_G320to345)) DEALLOCATE(efold_G320to345) IF ( ALLOCATED(zvent_A298to307 ) ) DEALLOCATE( zvent_A298to307 ) IF ( ALLOCATED(zvent_A307to312 ) ) DEALLOCATE( zvent_A307to312 ) IF ( ALLOCATED(zvent_A312to320 ) ) DEALLOCATE( zvent_A312to320 ) IF ( ALLOCATED(zvent_A320to345 ) ) DEALLOCATE( zvent_A320to345 ) IF ( ALLOCATED(zvent_G298to307 ) ) DEALLOCATE( zvent_G298to307 ) IF ( ALLOCATED(zvent_G307to312 ) ) DEALLOCATE( zvent_G307to312 ) IF ( ALLOCATED(zvent_G312to320 ) ) DEALLOCATE( zvent_G312to320 ) IF ( ALLOCATED(zvent_G320to345 ) ) DEALLOCATE( zvent_G320to345 ) IF ( ALLOCATED(PhotolyticZoneA ) ) DEALLOCATE( PhotolyticZoneA ) IF ( ALLOCATED(PhotolyticZoneG ) ) DEALLOCATE( PhotolyticZoneG ) IF ( ALLOCATED(PhotolyticZone ) ) DEALLOCATE( PhotolyticZone ) IF (ALLOCATED(Io_02_A298to307)) DEALLOCATE(Io_02_A298to307) IF (ALLOCATED(Io_02_A307to312)) DEALLOCATE(Io_02_A307to312) IF (ALLOCATED(Io_02_A312to320)) DEALLOCATE(Io_02_A312to320) IF (ALLOCATED(Io_02_A320to345)) DEALLOCATE(Io_02_A320to345) IF (ALLOCATED(Io_02_G298to307)) DEALLOCATE(Io_02_G298to307) IF (ALLOCATED(Io_02_G307to312)) DEALLOCATE(Io_02_G307to312) IF (ALLOCATED(Io_02_G312to320)) DEALLOCATE(Io_02_G312to320) IF (ALLOCATED(Io_02_G320to345)) DEALLOCATE(Io_02_G320to345) IF (ALLOCATED(Io_02_A298to307_1)) DEALLOCATE(Io_02_A298to307_1) IF (ALLOCATED(Io_02_A307to312_1)) DEALLOCATE(Io_02_A307to312_1) IF (ALLOCATED(Io_02_A312to320_1)) DEALLOCATE(Io_02_A312to320_1) IF (ALLOCATED(Io_02_A320to345_1)) DEALLOCATE(Io_02_A320to345_1) IF (ALLOCATED(Io_02_G298to307_1)) DEALLOCATE(Io_02_G298to307_1) IF (ALLOCATED(Io_02_G307to312_1)) DEALLOCATE(Io_02_G307to312_1) IF (ALLOCATED(Io_02_G312to320_1)) DEALLOCATE(Io_02_G312to320_1) IF (ALLOCATED(Io_02_G320to345_1)) DEALLOCATE(Io_02_G320to345_1) IF (ALLOCATED(FNOx2_A298to307)) DEALLOCATE(FNOx2_A298to307) IF (ALLOCATED(FNOx2_A307to312)) DEALLOCATE(FNOx2_A307to312) IF (ALLOCATED(FNOx2_A312to320)) DEALLOCATE(FNOx2_A312to320) IF (ALLOCATED(FNOx2_A320to345)) DEALLOCATE(FNOx2_A320to345) IF (ALLOCATED(FNOx2_G298to307)) DEALLOCATE(FNOx2_G298to307) IF (ALLOCATED(FNOx2_G307to312)) DEALLOCATE(FNOx2_G307to312) IF (ALLOCATED(FNOx2_G312to320)) DEALLOCATE(FNOx2_G312to320) IF (ALLOCATED(FNOx2_G320to345)) DEALLOCATE(FNOx2_G320to345) IF (ALLOCATED(PIntIz_A298to307)) DEALLOCATE(PIntIz_A298to307) IF (ALLOCATED(PIntIz_A307to312)) DEALLOCATE(PIntIz_A307to312) IF (ALLOCATED(PIntIz_A312to320)) DEALLOCATE(PIntIz_A312to320) IF (ALLOCATED(PIntIz_A320to345)) DEALLOCATE(PIntIz_A320to345) IF (ALLOCATED(PIntIz_G298to307)) DEALLOCATE(PIntIz_G298to307) IF (ALLOCATED(PIntIz_G307to312)) DEALLOCATE(PIntIz_G307to312) IF (ALLOCATED(PIntIz_G312to320)) DEALLOCATE(PIntIz_G312to320) IF (ALLOCATED(PIntIz_G320to345)) DEALLOCATE(PIntIz_G320to345) IF (ALLOCATED(IntIz_A298to307)) DEALLOCATE(IntIz_A298to307) IF (ALLOCATED(IntIz_A307to312)) DEALLOCATE(IntIz_A307to312) IF (ALLOCATED(IntIz_A312to320)) DEALLOCATE(IntIz_A312to320) IF (ALLOCATED(IntIz_A320to345)) DEALLOCATE(IntIz_A320to345) IF (ALLOCATED(IntIz_G298to307)) DEALLOCATE(IntIz_G298to307) IF (ALLOCATED(IntIz_G307to312)) DEALLOCATE(IntIz_G307to312) IF (ALLOCATED(IntIz_G312to320)) DEALLOCATE(IntIz_G312to320) IF (ALLOCATED(IntIz_G320to345)) DEALLOCATE(IntIz_G320to345) IF (ALLOCATED(IntIz_A298to307_1)) DEALLOCATE(IntIz_A298to307_1) IF (ALLOCATED(IntIz_A307to312_1)) DEALLOCATE(IntIz_A307to312_1) IF (ALLOCATED(IntIz_A312to320_1)) DEALLOCATE(IntIz_A312to320_1) IF (ALLOCATED(IntIz_A320to345_1)) DEALLOCATE(IntIz_A320to345_1) IF (ALLOCATED(IntIz_G298to307_1)) DEALLOCATE(IntIz_G298to307_1) IF (ALLOCATED(IntIz_G307to312_1)) DEALLOCATE(IntIz_G307to312_1) IF (ALLOCATED(IntIz_G312to320_1)) DEALLOCATE(IntIz_G312to320_1) IF (ALLOCATED(IntIz_G320to345_1)) DEALLOCATE(IntIz_G320to345_1) IF (ALLOCATED(nit_top2A)) DEALLOCATE(nit_top2A) IF (ALLOCATED(nit_top2A_1)) DEALLOCATE(nit_top2A_1) IF (ALLOCATED(nit_bl2A)) DEALLOCATE(nit_bl2A) IF (ALLOCATED(nit_bl2A_1)) DEALLOCATE(nit_bl2A_1) IF (ALLOCATED(nit_bl2A_2)) DEALLOCATE(nit_bl2A_2) IF (ALLOCATED(nit_top2G)) DEALLOCATE(nit_top2G) IF (ALLOCATED(nit_top2G_1)) DEALLOCATE(nit_top2G_1) IF (ALLOCATED(nit_bl2G)) DEALLOCATE(nit_bl2G) IF (ALLOCATED(nit_bl2G_1)) DEALLOCATE(nit_bl2G_1) IF (ALLOCATED(nit_bl2G_2)) DEALLOCATE(nit_bl2G_2) IF (ALLOCATED(FNOxz_A298to307)) DEALLOCATE(FNOxz_A298to307) IF (ALLOCATED(FNOxz_A307to312)) DEALLOCATE(FNOxz_A307to312) IF (ALLOCATED(FNOxz_A312to320)) DEALLOCATE(FNOxz_A312to320) IF (ALLOCATED(FNOxz_A320to345)) DEALLOCATE(FNOxz_A320to345) IF (ALLOCATED(FNOxz_G298to307)) DEALLOCATE(FNOxz_G298to307) IF (ALLOCATED(FNOxz_G307to312)) DEALLOCATE(FNOxz_G307to312) IF (ALLOCATED(FNOxz_G312to320)) DEALLOCATE(FNOxz_G312to320) IF (ALLOCATED(FNOxz_G320to345)) DEALLOCATE(FNOxz_G320to345) IF (ALLOCATED(FNOx_A298to307)) DEALLOCATE(FNOx_A298to307) IF (ALLOCATED(FNOx_A307to312)) DEALLOCATE(FNOx_A307to312) IF (ALLOCATED(FNOx_A312to320)) DEALLOCATE(FNOx_A312to320) IF (ALLOCATED(FNOx_A320to345)) DEALLOCATE(FNOx_A320to345) IF (ALLOCATED(FNOx_G298to307)) DEALLOCATE(FNOx_G298to307) IF (ALLOCATED(FNOx_G307to312)) DEALLOCATE(FNOx_G307to312) IF (ALLOCATED(FNOx_G312to320)) DEALLOCATE(FNOx_G312to320) IF (ALLOCATED(FNOx_G320to345)) DEALLOCATE(FNOx_G320to345) IF ( ALLOCATED( FNOx_A ) ) DEALLOCATE( FNOx_A ) IF ( ALLOCATED( FNOx_G ) ) DEALLOCATE( FNOx_G ) IF ( ALLOCATED( SNOWNOX )) DEALLOCATE( SNOWNOX ) IF ( ALLOCATED( ANNACC1 )) DEALLOCATE( ANNACC1 ) IF ( ALLOCATED( FRACPD1 )) DEALLOCATE( FRACPD1 ) IF ( ALLOCATED( FRACNOPD1 )) DEALLOCATE( FRACNOPD1 ) IF ( ALLOCATED( SNOWBC1 )) DEALLOCATE( SNOWBC1 ) IF ( ALLOCATED( NITRATE_ANN1 )) DEALLOCATE( NITRATE_ANN1 ) END SUBROUTINE CLEANUP_SNOWNOXEMS !-------------------------------------------------------------------------------------------------------- ! Return to calling program END MODULE SNOWNOX_MOD