Skip to content
New issue

Have a question about this project? # for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “#”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? # to your account

Add files via upload #17

Merged
Merged
Show file tree
Hide file tree
Changes from 2 commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
58 changes: 29 additions & 29 deletions src/model/src/AERO_PHOTDATA.F
Original file line number Diff line number Diff line change
Expand Up @@ -1396,8 +1396,8 @@ SUBROUTINE FASTER_OPTICS ( NR, NI, ALPHV, XLNSIG, BETA_EXT, BETA_SCAT, G )

REAL T1F1, T2F1, T1F2, T2F2, T1F3, T2F3
REAL T1G1, T2G1, T1G2, T2G2, T1G3, T2G3, T1G4, T2G4
REAL T1G5, T2G5
REAL(8) T1P1, T2P1 !(Wei Li)
REAL T1G5, T2G5
REAL(8) T1P1, T2P1

C***the following are for calculating the Penndorff Coefficients

Expand Down Expand Up @@ -1486,7 +1486,7 @@ SUBROUTINE FASTER_OPTICS ( NR, NI, ALPHV, XLNSIG, BETA_EXT, BETA_SCAT, G )
REAL QQSUM, QQF1,QQF2, QQF3, QQCORR

REAL, PARAMETER :: DEGTORAD = PI180
REAL(8), PARAMETER :: THREE_PI_TWO = 3.0 * PI / 2.0 !(Wei Li)
REAL(8), PARAMETER :: THREE_PI_TWO = 3.0 * PI / 2.0

C***FSB start calculation
SIGMA_G = EXP( XLNSIG )
Expand Down Expand Up @@ -1534,11 +1534,11 @@ SUBROUTINE FASTER_OPTICS ( NR, NI, ALPHV, XLNSIG, BETA_EXT, BETA_SCAT, G )
ALPHA_I = F2
BEXT = B
BSCAT = B
PENN1 = DBLE(0.0) !(Wei Li)
PENN2 = DBLE(0.0) !(Wei Li)
PENN1 = DBLE(0.0)
PENN2 = DBLE(0.0)

ALPHV2 = DBLE(ALPHV * ALPHV) !(Wei Li)
ALPHV3 = DBLE(ALPHV2 * ALPHV) !(Wei Li)
ALPHV2 = DBLE(ALPHV * ALPHV)
ALPHV3 = DBLE(ALPHV2 * ALPHV)

IF ( NI .GT. 0.0 ) THEN

Expand Down Expand Up @@ -1605,14 +1605,14 @@ SUBROUTINE FASTER_OPTICS ( NR, NI, ALPHV, XLNSIG, BETA_EXT, BETA_SCAT, G )
EXPFAC2 = EXP( 2.0 * XLNSIG2 )
EXPFAC3 = EXP( 4.5 * XLNSIG2 )

T1P1 = DBLE(A1 + A2 * ALPHV2 * EXPFAC2) !(Wei Li)
T2P1 = DBLE(A3 * ALPHV3 * EXPFAC3) !(Wei Li)
T1P1 = DBLE(A1 + A2 * ALPHV2 * EXPFAC2)
T2P1 = DBLE(A3 * ALPHV3 * EXPFAC3)

C***PENN1 is the analytic integral of the Pendorff formulae over
C*** a log normal particle size distribution.

PENN1 = DBLE(THREE_PI_TWO * ( T1P1 + T2P1 ) ) !(Wei Li)
PENN2 = DBLE(THREE_PI_TWO * T2P1) !(Wei Li)
PENN1 = DBLE(THREE_PI_TWO * ( T1P1 + T2P1 ))
PENN2 = DBLE(THREE_PI_TWO * T2P1)

END IF ! test for ni > 0.0

Expand Down Expand Up @@ -1852,7 +1852,7 @@ SUBROUTINE FAST_OPTICS( NR, NI, LAMBDA, DGN, SIGMA_G, BETA_EXT, BETA_SCAT, G )
REAL C, CEXT, CSCAT
REAL B, BEXT, BSCAT
REAL BBFAC
REAL(8) ALPHV !(Wei Li)
REAL(8) ALPHV
REAL ALPHA_I
REAL A, LOGX2, XLNSIG, XLNSIG2, MM1

Expand All @@ -1866,7 +1866,7 @@ SUBROUTINE FAST_OPTICS( NR, NI, LAMBDA, DGN, SIGMA_G, BETA_EXT, BETA_SCAT, G )
REAL LARGEEXT ! large sphere limit for extinction
REAL SMALL_G, LARGE_G

REAL(8) ALPHV2, ALPHV3 !(Wei Li)
REAL(8) ALPHV2, ALPHV3
REAL X_ALPHA, X_ALPHA2, X_ALPHA3
REAL FCORR
REAL EXPFAC2, EXPFAC3
Expand All @@ -1879,12 +1879,12 @@ SUBROUTINE FAST_OPTICS( NR, NI, LAMBDA, DGN, SIGMA_G, BETA_EXT, BETA_SCAT, G )
REAL T1F1, T2F1, T1F2, T2F2, T1F3, T2F3
REAL T1G1, T2G1, T1G2, T2G2, T1G3, T2G3, T1G4, T2G4
REAL T1G5, T2G5
REAL(8) T1P1, T2P1 !(Wei Li)
REAL(8) T1P1, T2P1

C***the following are for calculating the Penndorff Coefficients

REAL A1, A2, A3
REAL(8) PENN1, PENN2 !(Wei Li)
REAL(8) PENN1, PENN2
REAL XNR, XNI, XNR2, XNI2, XNRI, XNRI2, XNRMI
REAL XRI, XRI2, XRI36, XNX, XNX2
REAL Z1, Z12, Z2, XC1
Expand Down Expand Up @@ -1969,7 +1969,7 @@ SUBROUTINE FAST_OPTICS( NR, NI, LAMBDA, DGN, SIGMA_G, BETA_EXT, BETA_SCAT, G )
REAL QQSUM, QQF1,QQF2, QQF3, QQCORR

REAL, PARAMETER :: DEGTORAD = PI180
REAL(8), PARAMETER :: THREE_PI_TWO = 3.0 * PI / 2.0 !(Wei Li)
REAL(8), PARAMETER :: THREE_PI_TWO = 3.0 * PI / 2.0


REAL, PARAMETER :: SCALE = 1.00E+9
Expand All @@ -1982,9 +1982,9 @@ SUBROUTINE FAST_OPTICS( NR, NI, LAMBDA, DGN, SIGMA_G, BETA_EXT, BETA_SCAT, G )
C***FSB start calculation
XLNSIG = LOG( SIGMA_G )

ALPHV = DBLE(SCALE * PI * DGN * EXP( 3.0 * XLNSIG * XLNSIG ) / LAMBDA) !(Wei Li)
ALPHV2 = DBLE(ALPHV * ALPHV) !(Wei Li)
ALPHV3 = DBLE(ALPHV * ALPHV * ALPHV) !(Wei Li)
ALPHV = DBLE(SCALE * PI * DGN * EXP( 3.0 * XLNSIG * XLNSIG ) / LAMBDA)
ALPHV2 = DBLE(ALPHV * ALPHV)
ALPHV3 = DBLE(ALPHV * ALPHV * ALPHV)

XLNSIG2 = XLNSIG * XLNSIG
A = 0.5 / XLNSIG2
Expand Down Expand Up @@ -2024,8 +2024,8 @@ SUBROUTINE FAST_OPTICS( NR, NI, LAMBDA, DGN, SIGMA_G, BETA_EXT, BETA_SCAT, G )
ALPHA_I = F2
BEXT = B
BSCAT = B
PENN1 = DBLE(0.0) !(Wei Li)
PENN2 = DBLE(0.0) !(Wei Li)
PENN1 = DBLE(0.0)
PENN2 = DBLE(0.0)

IF ( NI .GT. 0.0 ) THEN

Expand Down Expand Up @@ -2079,25 +2079,25 @@ SUBROUTINE FAST_OPTICS( NR, NI, LAMBDA, DGN, SIGMA_G, BETA_EXT, BETA_SCAT, G )
Z12 = Z1 * Z1
Z2 = 4.0 * XNRI2 + 12.0 * XNRMI + 9.0
XC1 = 8.0 / ( 3.0 * Z12 )
A1 = DBLE(24.0 * XRI / Z1) !(Wei Li)
A1 = DBLE(24.0 * XRI / Z1)

A2 = DBLE(44.0 * XRI / 15.0 + 20.0 * XRI / ( 3.0 * Z2 ) +
A2 = DBLE(4.0 * XRI / 15.0 + 20.0 * XRI / ( 3.0 * Z2 ) +
& 4.8 * XRI * ( 7.0 * XNRI2 +
& 4.0 * ( XNRMI - 5.0 ) ) / Z12 ) !(Wei Li)
& 4.0 * ( XNRMI - 5.0 ) ) / Z12)

A3 = DBLE(XC1 * ( XNX2 - XRI36 )) !(Wei Li)
A3 = DBLE(XC1 * ( XNX2 - XRI36 ))

EXPFAC2 = EXP( 2.0 * XLNSIG2 )
EXPFAC3 = EXP( 4.5 * XLNSIG2 )

T1P1 = DBLE(A1 + A2 * ALPHV2 * EXPFAC2) !(Wei Li)
T2P1 = DBLE(A3 * ALPHV3 * EXPFAC3) !(Wei Li)
T1P1 = DBLE(A1 + A2 * ALPHV2 * EXPFAC2)
T2P1 = DBLE(A3 * ALPHV3 * EXPFAC3)

C***PENN1 is the analytic integral of the Pendorff formulae over
C*** a log normal particle size distribution.

PENN1 = DBLE(THREE_PI_TWO * ( T1P1 + T2P1 )) !(Wei Li)
PENN2 = DBLE(THREE_PI_TWO * T2P1 ) !(Wei Li)
PENN1 = DBLE(THREE_PI_TWO * ( T1P1 + T2P1 ))
PENN2 = DBLE(THREE_PI_TWO * T2P1)

END IF ! test of ni > 0.0

Expand Down
110 changes: 29 additions & 81 deletions src/model/src/ASX_DATA_MOD.F
Original file line number Diff line number Diff line change
Expand Up @@ -129,24 +129,14 @@ Module ASX_DATA_MOD
Integer, Allocatable :: LPBL ( :,: ) ! PBL layer
Logical, Allocatable :: CONVCT ( :,: ) ! convection flag
Real, Allocatable :: PBL ( :,: ) ! pbl height (m)
! Real, Allocatable :: NACL_EMIS( :,: ) ! NACL mass emission rate of particles with d <10 um (g/m2/s)

!Real, Allocatable :: NACL_EMIS( :,: ) ! NACL mass emission rate of particles with d <10 um (g/m2/s)
Real, Allocatable :: COSZEN ( :,: ) ! Cosine of the zenith angle
Real, Allocatable :: CFRAC ( :,: ) ! cloud fraction

!> Inline Canopy Processes (Wei Li)
Real, Allocatable :: FCH ( :,: ) ! Forest Canopy Height (m)
Real, Allocatable :: FRT ( :,: ) ! Forest Fraction
Real, Allocatable :: CLU ( :,: ) ! Clumping Index
Real, Allocatable :: POPU ( :,: ) ! Population Density (people/10km2)
Real, Allocatable :: LAIE ( :,: ) ! ECCC BELD3 Derived LAI (m2/m2)
Real, Allocatable :: C1R ( :,: ) ! cumulative LAI fraction hc to 0.75 * hc
Real, Allocatable :: C2R ( :,: ) ! cumulative LAI fraction hc to 0.50 * hc
Real, Allocatable :: C3R ( :,: ) ! cumulative LAI fraction hc to 0.35 * hc
Real, Allocatable :: C4R ( :,: ) ! cumulative LAI fraction hc to 0.20 * hc

!> FENGSHA option (Wei Li)
Real, Allocatable :: CLAYF ( :,: ) ! Fractional Clay Content
Real, Allocatable :: SANDF ( :,: ) ! Fractional Sand Content
!> FENGSHA option
Real, Allocatable :: CLAYF ( :,: ) ! Fractional Clay Content
Real, Allocatable :: SANDF ( :,: ) ! Fractional Sand Content
Real, Allocatable :: DRAG ( :,: ) ! Drag Partion
Real, Allocatable :: UTHR ( :,: ) ! Dry Threshold Friction Velocity

Expand All @@ -156,7 +146,7 @@ Module ASX_DATA_MOD
!> 3-D meteorological fields:
Real, Allocatable :: KZMIN ( :,:,: ) ! minimum Kz [m**2/s]
Real, Allocatable :: PRES ( :,:,: ) ! pressure [Pa]
Real, Allocatable :: PRESF ( :,:,: ) ! full layer pressure [Pa] (Wei Li)
Real, Allocatable :: PRESF ( :,:,: ) ! full layer pressure [Pa]
Real, Allocatable :: QV ( :,:,: ) ! water vapor mixing ratio
Real, Allocatable :: QC ( :,:,: ) ! cloud water mixing ratio
Real, Allocatable :: THETAV ( :,:,: ) ! potential temp
Expand All @@ -169,8 +159,8 @@ Module ASX_DATA_MOD
Real, Allocatable :: RJACM ( :,:,: ) ! reciprocal mid-layer Jacobian
Real, Allocatable :: RJACF ( :,:,: ) ! reciprocal full-layer Jacobian
Real, Allocatable :: RRHOJ ( :,:,: ) ! reciprocal density X Jacobian
Real, Allocatable :: UWINDA ( :,:,: ) ! [m/s] (Wei Li)
Real, Allocatable :: VWINDA ( :,:,: ) ! [m/s] (Wei Li)
Real, Allocatable :: UWINDA ( :,:,: ) ! [m/s]
Real, Allocatable :: VWINDA ( :,:,: ) ! [m/s]
End Type MET_Type

Type :: GRID_Type
Expand Down Expand Up @@ -261,13 +251,9 @@ Module ASX_DATA_MOD
Real, allocatable, private :: BUFF2D( :,: ) ! 2D temp var
Real, allocatable, private :: BUFF3D( :,:,: ) ! 3D temp var

! Canopy option control (Wei Li)
CHARACTER( 20 ), SAVE :: CTM_CANOPY_SHADE = 'CTM_CANOPY_SHADE '! env var for in-line
LOGICAL, PUBLIC, SAVE :: CANOPY_SHADE ! flag in-lining canopy shading

! FENGSHA option control (Wei Li)
! FENGSHA option control
CHARACTER( 18 ), SAVE :: CTM_WBDUST_FENGSHA = 'CTM_WBDUST_FENGSHA' ! env var for in-line
LOGICAL, PUBLIC, SAVE :: FENGSHA ! flag for fengsha option
LOGICAL, PUBLIC, SAVE :: FENGSHA ! flag for fengsha option

INTEGER IOSX ! i/o and allocate memory status

Expand Down Expand Up @@ -623,15 +609,15 @@ Subroutine INIT_MET ( JDATE, JTIME )
& Met_Data%CONVCT ( NCOLS,NROWS ),
& Met_Data%PBL ( NCOLS,NROWS ),
! & Met_Data%NACL_EMIS( NCOLS,NROWS ),
& Met_Data%UWINDA ( NCOLS,NROWS,NLAYS ),
& Met_Data%VWINDA ( NCOLS,NROWS,NLAYS ),
& Met_Data%COSZEN ( NCOLS,NROWS ),
& Met_Data%CFRAC ( NCOLS,NROWS ),
& Met_Data%UWINDA ( NCOLS,NROWS,NLAYS ), !(Wei Li)
& Met_Data%VWINDA ( NCOLS,NROWS,NLAYS ), !(Wei Li)
& Met_Data%UWIND ( NCOLS+1,NROWS+1,NLAYS ),
& Met_Data%VWIND ( NCOLS+1,NROWS+1,NLAYS ),
& Met_Data%KZMIN ( NCOLS,NROWS,NLAYS ),
& Met_Data%PRESF ( NCOLS,NROWS,1:NLAYS+1 ), !(Wei Li)
& Met_Data%PRES ( NCOLS,NROWS,NLAYS ),
& Met_Data%PRESF ( NCOLS,NROWS,1:NLAYS+1 ),
& Met_Data%QV ( NCOLS,NROWS,NLAYS ),
& Met_Data%QC ( NCOLS,NROWS,NLAYS ),
& Met_Data%THETAV ( NCOLS,NROWS,NLAYS ),
Expand Down Expand Up @@ -716,33 +702,7 @@ Subroutine INIT_MET ( JDATE, JTIME )
Grid_Data%BSLP = 0.0
End If

!> ccccccccccccccccccccc canopy shade option!ccccccccccccccccccccc (Wei Li)
CANOPY_SHADE = ENVYN( 'CTM_CANOPY_SHADE',
& 'Flag for in-line canopy shading',
& .FALSE., IOSX )

! IF ( CANOPY_SHADE ) THEN
! XMSG = 'Using in-line canopy shading option'
! CALL M3MSG2( XMSG )
! END IF
If ( CANOPY_SHADE ) Then
ALLOCATE( Met_Data%FCH ( NCOLS,NROWS ),
& Met_Data%FRT ( NCOLS,NROWS ),
& Met_Data%CLU ( NCOLS,NROWS ),
& Met_Data%POPU ( NCOLS,NROWS ),
& Met_Data%LAIE ( NCOLS,NROWS ),
& Met_Data%C1R ( NCOLS,NROWS ),
& Met_Data%C2R ( NCOLS,NROWS ),
& Met_Data%C3R ( NCOLS,NROWS ),
& Met_Data%C4R ( NCOLS,NROWS ),
& STAT = ALLOCSTAT )
If ( ALLOCSTAT .Ne. 0 ) Then
XMSG = 'Failure allocating Canopy Shade variables'
Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 )
End If
End If

!> ccccccccccccccccccccc Fengsha option!ccccccccccccccccccccc (Wei Li)
!> ccccccccccccccccccccc Fengsha option!ccccccccccccccccccccc
FENGSHA = ENVYN( CTM_WBDUST_FENGSHA,
& 'Flag for in-line fengsha ',
& .FALSE., IOSX )
Expand All @@ -761,9 +721,9 @@ Subroutine INIT_MET ( JDATE, JTIME )
If ( ALLOCSTAT .Ne. 0 ) Then
XMSG = 'Failure allocating Fengsha variables'
Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 )
End If
End If

End If
End If

!> ccccccccccccccccccccc enable backward compatiblity ccccccccccccccccccccc

Expand Down Expand Up @@ -911,11 +871,7 @@ Subroutine GET_MET ( JDATE, JTIME, TSTEP )

call interpolate_var ('PRES', jdate, jtime, Met_Data%PRES)

call interpolate_var ('PRESF', jdate, jtime, Met_Data%PRESF) !(Wei Li)

call interpolate_var ('UWINDA', jdate, jtime, Met_Data%UWINDA) !(Wei Li)

call interpolate_var ('VWINDA', jdate, jtime, Met_Data%VWINDA) !(Wei Li)
call interpolate_var ('PRESF', jdate, jtime, Met_Data%PRESF)

call interpolate_var ('ZF', jdate, jtime, Met_Data%ZF)

Expand All @@ -941,36 +897,28 @@ Subroutine GET_MET ( JDATE, JTIME, TSTEP )

call interpolate_var ('QC', jdate, jtime, Met_Data%QC)

call interpolate_var ('UWINDA', jdate, jtime, Met_Data%UWINDA)

call interpolate_var ('VWINDA', jdate, jtime, Met_Data%VWINDA)
C-------------------------------- MET_CRO_2D --------------------------------
C Vegetation and surface vars

call interpolate_var ('LAI', jdate, jtime, Met_Data%LAI)

call interpolate_var ('VEG', jdate, jtime, Met_Data%VEG)

call interpolate_var ('ZRUF', jdate, jtime, Met_Data%Z0)

C Canopy vars (Wei Li)
If ( CANOPY_SHADE ) Then
call interpolate_var ('FCH', jdate, jtime, Met_Data%FCH)
call interpolate_var ('FRT', jdate, jtime, Met_Data%FRT)
call interpolate_var ('CLU', jdate, jtime, Met_Data%CLU)
call interpolate_var ('POPU', jdate, jtime, Met_Data%POPU)
call interpolate_var ('LAIE', jdate, jtime, Met_Data%LAIE)
call interpolate_var ('C1R', jdate, jtime, Met_Data%C1R)
call interpolate_var ('C2R', jdate, jtime, Met_Data%C2R)
call interpolate_var ('C3R', jdate, jtime, Met_Data%C3R)
call interpolate_var ('C4R', jdate, jtime, Met_Data%C4R)
End If
C FENGSHA vars
If ( FENGSHA ) Then
call interpolate_var ('CLAYF', jdate, jtime, Met_Data%CLAYF)

C FENGSHA vars (Wei Li)
If ( CANOPY_SHADE ) Then
call interpolate_var ('CLAYF', jdate, jtime, Met_Data%CLAYF)
call interpolate_var ('SANDF', jdate, jtime, Met_Data%SANDF)
call interpolate_var ('DRAG', jdate, jtime, Met_Data%DRAG)
call interpolate_var ('UTHR', jdate, jtime, Met_Data%UTHR)
End If
call interpolate_var ('SANDF', jdate, jtime, Met_Data%SANDF)

call interpolate_var ('DRAG', jdate, jtime, Met_Data%DRAG)

call interpolate_var ('UTHR', jdate, jtime, Met_Data%UTHR)
End If
C Soil vars
call interpolate_var ('SOIM1', jdate, jtime, Met_Data%SOIM1)

Expand Down
Loading