Skip to content
Snippets Groups Projects
Commit 901eefb8 authored by RODIER Quentin's avatar RODIER Quentin
Browse files

Quentin 17/08/2022: Begin history cleanly of MEGAN : remove MEGAN folder added by P.Tulet + tar.gz

parent 3233d927
No related branches found
No related tags found
No related merge requests found
Expand all Hide whitespace changes
Inline Side-by-side
Showing
with 0 additions and 4720 deletions
src/LIB/MEGAN/.arbre2.txt.swp deleted 100644 → 0
+ 0
− 0
View file @ 3233d927
File deleted
src/LIB/MEGAN/emproc.F90 deleted 100644 → 0
+ 0
− 292
View file @ 3233d927
SUBROUTINE EMPROC(KTIME, KDATE, PPFD24, T24, PDI, PRECADJ, &
PLAT, PLONG, PLAIP, PLAIC, PTEMP, PPFD, &
PWIND, PRES, PQV, KSLTYP, PSOILM, PSOILT, &
PFTF, OSOIL, PCFNO, PCFNOG, PCFSPEC )
!***********************************************************************
! THIS PROGRAM COMPUTES BIOGENIC EMISSION USING INPUT EMISSION
! CAPACITY MAPS AND MCIP OUTPUT VARIABLES.
! THE EMISSION CAPACITY MAP (INPNAME) ARE GRIDDED IN NETCDF-IOAPI FORMAT
! WITH ALL THE DAILY AVERAGE PPFD AND DAILY AVERAGE TEMPERATURE.
!
! NOTE: THE PROJECTION AND INPUT GRIDS OF THE TWO FILES MUST BE
! IDENTICAL.
!
!
! CALL:
! CHECKMEM
! MODULE GAMMA_ETC
! GAMMA_LAI
! GAMMA_P
! GAMMA_TLD
! GAMMA_TLI
! GAMMA_A
! GAMMA_S
!
! HISTORY:
! CREATED BY JACK CHEN 11/04
! MODIFIED BY TAN 11/21/06 FOR MEGAN V2.0
! MODIFIED BY XUEMEI WANG 11/04/2007 FOR MEGAN2.1
! MODIFIED BY JULIA LEE-TAYLOR 03/18/2008 FOR MEGAN2.1
! MODIFIED BY XUEMEI WANG 09/30/2008 FOR MEGAN2.1
! MODIFIED BY TAN 07/28/2011 FOR MEGAN2.1
! MODIFIED BY P. TULET 01/11/2014 FOR COUPLING WITH ISBA (MESONH)
! MODIFIED BY J. PIANEZZEJ 13/02/2019 BUG in FARCE case
!
!***********************************************************************
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! SCIENTIFIC ALGORITHM
!
! EMISSION = [EF][GAMMA][RHO]
! WHERE [EF] = EMISSION FACTOR (UG/M2H)
! [GAMMA] = EMISSION ACTIVITY FACTOR (NON-DIMENSION)
! [RHO] = PRODUCTION AND LOSS WITHIN PLANT CANOPIES
! (NON-DIMENSIONAL)
! ASSUMPTION: [RHO] = 1 (11/27/06) (SEE PDT_LOT_CP.EXT)
!
! GAMMA = [GAMMA_CE][GAMMA_AGE][GAMMA_SM]
! WHERE [GAMMA_CE] = CANOPY CORRECTION FACTOR
! [GAMMA_AGE] = LEAF AGE CORRECTION FACTOR
! [GAMMA_SM] = SOIL MOISTURE CORRECTION FACTOR
! ASSUMPTION: [GAMMA_SM] = 1 (11/27/06)
! GAMMA_CE = [GAMMA_LAI][GAMMA_P][GAMMA_T]
! WHERE [GAMMA_LAI] = LEAF AREA INDEX FACTOR
! [GAMMA_P] = PPFD EMISSION ACTIVITY FACTOR
! [GAMMA_T] = TEMPERATURE RESPONSE FACTOR
!
! EMISSION = [EF][GAMMA_LAI][GAMMA_P][GAMMA_T][GAMMA_AGE]
! DERIVATION:
! EMISSION = [EF][GAMMA](1-LDF) + [EF][GAMMA][LDF][GAMMA_P]
! EMISSION = [EF][GAMMA]{ (1-LDF) + [LDF][GAMMA_P] }
! EMISSION = [EF][GAMMA]{ (1-LDF) + [LDF][GAMMA_P] }
! WHERE LDF = LIGHT DEPENDENT FUNCTION (NON-DIMENSION)
! (SEE LD_FCT.EXT)
!
! FINAL EQUATION
! EMISSION = [EF][GAMMA_LAI][GAMMA_AGE]*
! { (1-LDF)[GAMMA_TLI] + [LDF][GAMMA_P][GAMMA_TLD] } !FOR MEGAN2.1 ZER(:) = ZGAM_AGE * ZGAM_SMT * ZRHO * ((1.-ZLDF) * ZGAM_TLI * ZGAM_LHT + ZLDF * ZGAM_TLD)
! WHERE GAMMA_TLI IS LIGHT INDEPENDENT
! GAMMA_TLD IS LIGHT DEPENDENT
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
USE MODD_MEGAN
USE MODI_INDEX1
USE MODI_SOILNOX
!
USE MODE_MEGAN
USE MODE_GAMMA_ETC ! MODULE CONTAINING GAMMA FUNCTIONS
!
IMPLICIT NONE
INTEGER, INTENT(IN) :: KTIME !I TIME OF THE DAY HHMMSS
INTEGER, INTENT(IN) :: KDATE !I DATE YYYYDDD
!
!REAL, INTENT(IN) :: PPFD_D !I DAILY PAR (UMOL/M2.S)
REAL, DIMENSION(:), INTENT(IN) :: T24, PPFD24 !I DAILY TEMPERATURE (K)
REAL, INTENT(IN) :: PDI !I DROUGHT INDEX (0 NORMAL, -2 MODERATE DROUGHT, -3 SEVERE DROUGHT, -4 EXTREME DROUGHT)
REAL, INTENT(IN) :: PRECADJ !I RAIN ADJUSTMENT FACTOR
!
REAL, DIMENSION(:), INTENT(IN) :: PLAT !I LATITUDE OF GRID CELL
REAL, DIMENSION(:), INTENT(IN) :: PLONG !I LONGITUDE OF GRID CELL
REAL, DIMENSION(:), INTENT(IN) :: PLAIP !I PREVIOUS MONTHLY LAI
REAL, DIMENSION(:), INTENT(IN) :: PLAIC !I CURRENT MONTHLY LAI
REAL, DIMENSION(:), INTENT(IN) :: PTEMP !I TEMPERATURE (K)
REAL, DIMENSION(:), INTENT(INOUT) :: PPFD !I CALCULATED PAR (UMOL/M2.S)
REAL, DIMENSION(:), INTENT(IN) :: PWIND !I WIND VELOCITY (M/S)
REAL, DIMENSION(:), INTENT(IN) :: PRES !I ATMOSPHERIC PRESSURE (PA)
REAL, DIMENSION(:), INTENT(IN) :: PQV !I AIR HUMIDITY (KG/KG)
INTEGER,DIMENSION(:),INTENT(IN) :: KSLTYP !I SOIL CATEGORY (FUNCTION OF SILT, CLAY AND SAND))
REAL, DIMENSION(:), INTENT(IN) :: PSOILM !I SOIL MOISTURE (M3/M3)
REAL, DIMENSION(:), INTENT(IN) :: PSOILT !I SOIL TEMPERATURE (K)
REAL, DIMENSION(:,:),INTENT(IN) :: PFTF ! PFT FACTOR ARRAY (NRTYP 1-16 IN THE FIRST DIM)
LOGICAL, INTENT(IN) :: OSOIL !I LOGICAL FOR ACTIVE NO CORRECTION FACTOR
REAL, DIMENSION(:), INTENT(INOUT) :: PCFNO !O NO CORRECTION FACTOR
REAL, DIMENSION(:), INTENT(INOUT) :: PCFNOG !O NO CORRECTION FACTOR FOR GRASS
REAL, DIMENSION(:,:),INTENT(INOUT) :: PCFSPEC !O OUTPUT EMISSION BUFFER
! LOCAL VARIABLES AND THEIR DESCRIPTIONS:
REAL, DIMENSION(SIZE(PSOILM)) :: ZGAM_LHT ! LAI CORRECTION FACTOR
REAL, DIMENSION(SIZE(PSOILM)) :: ZGAM_AGE ! LEAF AGE CORRECTION FACTOR
REAL, DIMENSION(SIZE(PSOILM)) :: ZGAM_SMT ! SOIL MOISTURE CORRECTION FACTOR
REAL, DIMENSION(SIZE(PSOILM)) :: ZER ! EMISSION BUFFER
! NUMBER OF LAT, LONG, AND PFT FACTOR VARIABLES
REAL, DIMENSION(SIZE(PSOILM)) :: ZGAM_TLD
REAL, DIMENSION(SIZE(PSOILM)) :: ZGAM_TLI
!
CHARACTER(LEN=100), DIMENSION(N_MGN_SPC+7) :: YVNAME3D
!
REAL, DIMENSION(SIZE(PSOILM)) :: ZADJUST_FACTOR_LD, ZADJUST_FACTOR_LI
REAL, DIMENSION(SIZE(PSOILM)) :: ZGAMMA_TD, ZGAMMA_TI, ZTOTALPFT
REAL :: ZLDF ! LIGHT DEPENDENT FACTOR
REAL :: ZRHO ! PRODUCTION AND LOSS WITHIN CANOPY
!REAL :: ZPFD_D
!
INTEGER :: I_PFT
INTEGER :: ILAIP_DY, ILAIP_HR, ILAIC_DY, ILAIC_HR
INTEGER :: IMXPFT, IMXLAI
! LOOP INDICES
INTEGER :: JT, JS, JI, JJ , JK, JN, INP, JL ! COUNTERS
INTEGER :: INMAP ! INDEX
INTEGER :: INVARS3D
!***********************************************************************
!--=====================================================================
!... BEGIN PROGRAM
!--=====================================================================
!-----------------------------------------------------------------------
!.....1) INITIALIZATION
!-----------------------------------------------------------------------
!
INVARS3D = N_MGN_SPC + 7
!
DO JS = 1,N_MGN_SPC
YVNAME3D(JS) = TRIM( CMGN_SPC(JS) )
! VDESC3D(S) = 'ENVIRONMENTAL ACTIVITY FACTOR FOR '//
! & TRIM( MGN_SPC(S) )
! UNITS3D(S) = 'NON-DIMENSION '
! VTYPE3D(S) = M3REAL
ENDDO
YVNAME3D(N_MGN_SPC+1) = 'D_TEMP'
! UNITS3D(N_MGN_SPC+1) = 'K'
! VTYPE3D(N_MGN_SPC+1) = M3REAL
! VDESC3D(N_MGN_SPC+1) = 'VARIABLE '//'K'
YVNAME3D(N_MGN_SPC+2) = 'D_PPFD'
! UNITS3D(N_MGN_SPC+2) = 'UMOL/M2.S'
! VTYPE3D(N_MGN_SPC+2) = M3REAL
! VDESC3D(N_MGN_SPC+2) = 'VARIABLE '//'UMOL/M2.S'
YVNAME3D(N_MGN_SPC+3) = 'LAT'
! UNITS3D(N_MGN_SPC+3) = ' '
! VTYPE3D(N_MGN_SPC+3) = M3REAL
! VDESC3D(N_MGN_SPC+3) = ' '
YVNAME3D(N_MGN_SPC+4) = 'LONG'
! UNITS3D(N_MGN_SPC+4) = ' '
! VTYPE3D(N_MGN_SPC+4) = M3REAL
! VDESC3D(N_MGN_SPC+4) = ' '
YVNAME3D(N_MGN_SPC+5) = 'CFNO'
! UNITS3D(N_MGN_SPC+5) = ' '
! VTYPE3D(N_MGN_SPC+5) = M3REAL
! VDESC3D(N_MGN_SPC+5) = ' '
YVNAME3D(N_MGN_SPC+6) = 'CFNOG'
! UNITS3D(N_MGN_SPC+6) = ' '
! VTYPE3D(N_MGN_SPC+6) = M3REAL
! VDESC3D(N_MGN_SPC+6) = ' '
YVNAME3D(N_MGN_SPC+7) = 'SLTYP'
! UNITS3D(N_MGN_SPC+7) = ' '
! VTYPE3D(N_MGN_SPC+7) = M3INT
! VDESC3D(N_MGN_SPC+7) = ' '
!-----------------------------------------------------------------------
!.....2) PROCESS EMISSION RATES
!-----------------------------------------------------------------------
!
INP = SIZE(PLAT)
!
! ************************************************************************************************
! PPFD: SRAD - SHORT WAVE FROM SUN (W/M2)
! ASSUMING 4.766 (UMOL M-2 S-1) PER (W M-2)
! ASSUME 1/2 OF SRAD IS IN 400-700NM BAND
!D_PPFD = D_PPFD * 4.766 * 0.5
! UPG PT bug: SURFEX give PAR in UMOL M-2 S-1 : comment the lines above
!ZPFD_D = PPFD_D * 4.5 * 0.5
!ZPFD_D = PPFD24
!PPFD = PPFD * 4.5
!UPG PT end bug
! *****************************************************************************************
! GO OVER ALL THE CHEMICAL SPECIES
DO JS = 1, N_MGN_SPC
! INITIALIZE VARIABLES
ZER = 0.
ZGAM_LHT = 1.
ZGAM_AGE = 1.
ZGAM_SMT = 1.
ZGAM_TLD = 1.
ZGAM_TLI = 1.
PCFNO = 1.
PCFNOG = 1.
CALL GAMMA_LAI(PLAIC, ZGAM_LHT)
! IF (JS == 1) print*, "ZGAM_LHT", ZGAM_LHT
CALL GAMMA_A(KDATE, KTIME, NTSTLEN, YVNAME3D(JS), T24, PLAIP, PLAIC, ZGAM_AGE)
! IF (JS == 1) print*, "ZGAM_AGE", ZGAM_AGE
CALL GAMMA_S(ZGAM_SMT)
ZADJUST_FACTOR_LD(:) = 0.0
ZADJUST_FACTOR_LI(:) = 0.0
ZGAMMA_TD(:) = 0.0
ZGAMMA_TI(:) = 0.0
ZTOTALPFT(:) = 0.0
DO I_PFT = 1,N_MGN_PFT !CANOPY TYPES
ZTOTALPFT(:) = ZTOTALPFT(:) + PFTF(I_PFT,:) * 0.01 !!la division par 100 ZTOTALPFT(:) = ZTOTALPFT(:) + PFTF(I_PFT,:) * 0.01
ENDDO ! ENDDO I_PFT
DO I_PFT = 1,N_MGN_PFT !CANOPY TYPES
CALL GAMME_CE(KDATE, KTIME, XCANOPYCHAR, I_PFT, YVNAME3D(JS), &
PPFD24, PPFD24, T24, T24, PDI, &
PPFD, PLAT, PLONG, PTEMP, PWIND, PQV, PLAIC, &
PRES, ZGAMMA_TD, ZGAMMA_TI)
ZADJUST_FACTOR_LD(:) = ZADJUST_FACTOR_LD(:) + 0.01 * PFTF(I_PFT,:) * ZGAMMA_TD(:) !!ZADJUST_FACTOR_LD(:) = ZADJUST_FACTOR_LD(:) + 0.01 * PFTF(I_PFT,:) * ZGAMMA_TD(:)
ZADJUST_FACTOR_LI(:) = ZADJUST_FACTOR_LI(:) + 0.01 * PFTF(I_PFT,:) * ZGAMMA_TI(:) !! attention le 0.01 ZADJUST_FACTOR_LI(:) = ZADJUST_FACTOR_LI(:) + 0.01 * PFTF(I_PFT,:) * ZGAMMA_TI(:)
ENDDO ! ENDDO I_PFT
WHERE (ZTOTALPFT(:).GT.0.)
ZGAM_TLD(:) = ZADJUST_FACTOR_LD(:) / ZTOTALPFT(:)
ZGAM_TLI(:) = ZADJUST_FACTOR_LI(:) / ZTOTALPFT(:)
ELSEWHERE
ZGAM_TLD(:) = 1.
ZGAM_TLI(:) = 1.
END WHERE
!IF (JS == 1) print*, "ZGAM_TLD(:)", ZGAM_TLD(:)
INMAP = INDEX1(YVNAME3D(JS), CMGN_SPC)
ZLDF = XLDF_FCT(INMAP)
INMAP = INDEX1(YVNAME3D(JS), CMGN_SPC)
ZRHO = XMGN_MWT(INMAP)
!... CALCULATE EMISSION
ZER(:) = ZGAM_AGE * ZGAM_SMT * ZRHO * ((1.-ZLDF) * ZGAM_TLI * ZGAM_LHT + ZLDF * ZGAM_TLD)
WHERE( ZER(:).GT.0. )
PCFSPEC(JS,:) = ZER(:)
ELSEWHERE
PCFSPEC(JS,:) = 0.0
END WHERE
ENDDO
!... ESTIATE CFNO AND CFNOG
CALL SOILNOX(KDATE, KTIME, OSOIL, KSLTYP, PRECADJ, &
PLAT, PTEMP, PSOILM, PSOILT, PLAIC, PCFNO, PCFNOG )
!--=====================================================================
END SUBROUTINE EMPROC
src/LIB/MEGAN/index1.F90 deleted 100644 → 0
+ 0
− 104
View file @ 3233d927
FUNCTION INDEX1 (HNAME, HLIST) RESULT(KINDEX1)
!***********************************************************************
! Version "$Id: index1.f 45 2014-09-12 20:05:29Z coats $"
! EDSS/Models-3 I/O API.
! Copyright (C) 1992-2002 MCNC and Carlie J. Coats, Jr., and
! (C) 2003-2010 Baron Advanced Meteorological Systems, LLC.
! Distributed under the GNU LESSER GENERAL PUBLIC LICENSE version 2.1
! See file "LGPL.txt" for conditions of use.
!.........................................................................
! INDEX1 subroutine body starts at line 53
! INDEXINT1 subroutine body starts at line 99
!
! FUNCTION:
!
! Search for character-string or integer key NAME or IKEY in list NLIST
! and return the subscript (1...N) at which it is found, or return 0
! when not found in NLIST
!
! PRECONDITIONS REQUIRED:
! none
!
! SUBROUTINES AND FUNCTIONS CALLED:
! none
!
! REVISION HISTORY:
! INDEX1:
! 5/1988 Modified for ROMNET
! 9/1994 Modified for Models-3 by CJC
! INDEXINT1:
! Prototype 11/2004 by CJC: MODULE M3UTILIO for I/O API v3
! Modified 3/2006 by CJC: moved INDEXINT1() to file "index1.f"
!
! Modified 03/2010 by CJC: F9x changes for I/O API v3.1
!***********************************************************************
IMPLICIT NONE
!....... Arguments and their descriptions:
CHARACTER(LEN=*), INTENT(IN) :: HNAME ! Character string being searched for
CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HLIST ! array to be searched
INTEGER :: KINDEX1
!....... Local variable:
INTEGER :: JI ! loop counter
!.....................................................................
!....... begin body of INDEX1()
KINDEX1 = 0
!
DO JI = 1, SIZE(HLIST)
IF ( HNAME.EQ.HLIST(JI) ) THEN ! Found NAME in NLIST
KINDEX1 = JI
EXIT
ENDIF
END DO
END FUNCTION INDEX1
! --=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
!FUNCTION INDEXINT1(KEY, KEYLIST ) RESULT(KINDEXINT1)
!
!!-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
!! Look up integer key IKEY in unsorted list <NLIST,KEYLIST>
!! of integer keys. Return the subscript at which IKEY
!! occurs, or 0 in case of failure
!!
!! PRECONDITIONS REQUIRED:
!! none
!!
!! REVISION HISTORY:
!! Prototype 11/2004 by CJC
!!-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
!
!IMPLICIT NONE
!
!!!........ Arguments:
!
!INTEGER, INTENT(IN) :: KEY
!INTEGER, DIMENSION(:), INTENT(IN) :: KEYLIST
!
!INTEGER :: KINDEXINT1
!
!!!........ Local Variables:
!
!INTEGER :: JI
!
!!!........ begin body ........................................
!
!KINDEXINT1 = 0
!
!DO JI = 1, SIZE(KEYLIST)
! IF ( KEY .EQ. KEYLIST(JI) ) THEN
! KINDEXINT1 = JI
! EXIT
! END IF
!END DO
!
!END FUNCTION INDEXINT1
src/LIB/MEGAN/init_mgn2mech.F90 deleted 100644 → 0
+ 0
− 208
View file @ 3233d927
!! ###############################
SUBROUTINE INIT_MGN2MECH(HMECHANISM, OCONVERSION, HVNAME3D, HMECH_SPC, &
KSPMH_MAP, KMECH_MAP, PCONV_FAC, PMECH_MWT, &
KVARS3D, K_SCON_SPC)
!!
!!*** *BVOCEM*
!!
!! PURPOSE
!! -------
!! CALCULATE THE BIOGENIC EMISSION FLUXES UPON THE MEGAN CODE
!! HTTP://LAR.WSU.EDU/MEGAN/
!!
!! METHOD
!! ------
!!
!!
!! AUTHOR
!! ------
! ORIGINALLY CREATED BY JACK CHEN 11/04 FOR MEGAN V.0
! FOR MEGAN V2.0 CREATED BY TAN 12/01/06
! FOR MEGAN V2.1 CREATED BY XUEMEI WANG 11/04/07
! FOR MEGAN V2.1 TO USE 150 SPECIES CREATED BY XUEMEI WANG 09/30/09
!
! HISTORY:
! 08/14/07 TAN - MOVE TO MEGANV2.02 WITH NO UPDATE
! 08/29/07 MODIFIED BY A. GUENTHER TO CORRECT ERROR IN ASSIGNING
! EMISSION FACTOR. THIS VERSION IS CALLED MEGANV2.03
! 10/29/07 MODIFIED BY A. GUENTHER TO CORRECT OMISSION OF DIURNAL VARIATION
! FACTOR. THIS VERSION IS CALLED MEGANV2.04
! 11/04/07 MODIFIED BY XUEMEI WANG TO GIVE TWO OPTIONS FOR MAP OR LOOKUP TABLE FOR
! THE EMISSION FACTORS. ALSO GIVES OPTIONS FOR DIFFERENT CHEMICAL MECHANISMS
! IN THE CODE: USER MODIFIES THE EXTERNAL SCRIPT TO ASSIGN MECHANISM.
! THIS VERSION IS CALLED MEGANV2.1.0
! 06/04/08 MODIFIED BY J. LEE-TAYLOR TO ACCEPT VEGETATION-DEPENDENT SPECIATION FACTORS
! IN TABLE FORMAT (RESHAPE TABLES) RATHER THAN FROM DATA STATEMENTS.
! 09/30/08 MODIFIED BY XUEMEI WANG TO GIVE OPTIONS FOR INPUT FILE AND TEST DIFFERENT MECHANISMS
! 09/27/11 TAN&XUEMEI MEGANV2.10 INCLUDES SOIL NOX ADJUSTMENT AND A LOT OF UPDATES
! 20/12/14 P. TULET - ON-LINE COUPLING IN THE ISBA/SURFEX SCHEME. ALL INIT VARIABLES HAS BEEN
! MOVED IN INIT_MEGANN.F90.
!!
!! MODIFICATIONS
!! -------------
!! ORIGINAL: 25/10/14
!!
!!
!! EXTERNAL
!! --------
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!
!------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! -----------------
!
USE MODD_MGN2MECH
!
IMPLICIT NONE
CHARACTER(LEN=16), INTENT(IN) :: HMECHANISM !I MECHANISM NAME
LOGICAL, INTENT(IN) :: OCONVERSION !I
!
CHARACTER(LEN=16),DIMENSION(:), POINTER :: HMECH_SPC!I MECHANISM NAME
CHARACTER(LEN=16),DIMENSION(:), POINTER :: HVNAME3D !I MECHANISM NAME
INTEGER,DIMENSION(:), POINTER :: KSPMH_MAP
INTEGER,DIMENSION(:), POINTER :: KMECH_MAP
REAL,DIMENSION(:), POINTER :: PCONV_FAC
REAL,DIMENSION(:), POINTER :: PMECH_MWT
INTEGER, INTENT(INOUT) :: KVARS3D
INTEGER, INTENT(INOUT) :: K_SCON_SPC
!... INCLUDES:
!
!* 0.1 DECLARATION OF LOCAL VARIABLES
!
! SET ATTRIBUTE AND VARIABLES FOR OUTPUT
SELECT CASE ( TRIM(HMECHANISM) )
CASE ('CB05')
K_SCON_SPC = N_CB05
KVARS3D = N_CB05_SPC
CASE ('CB6')
K_SCON_SPC = N_CB6
KVARS3D = N_CB6_SPC
CASE ('SAPRCII')
K_SCON_SPC = N_SAPRCII
KVARS3D = N_SAPRCII_SPC
CASE ('RADM2')
K_SCON_SPC = N_RADM2
KVARS3D = N_RADM2_SPC
CASE ('RACM')
K_SCON_SPC = N_RACM
KVARS3D = N_RACM_SPC
CASE ('CBMZ')
K_SCON_SPC = N_CBMZ
KVARS3D = N_CBMZ_SPC
CASE ('SAPRC99')
K_SCON_SPC = N_SAPRC99
KVARS3D = N_SAPRC99_SPC
CASE ('SAPRC99Q')
K_SCON_SPC = N_SAPRC99_Q
KVARS3D = N_SAPRC99_Q_SPC
CASE ('SAPRC99X')
K_SCON_SPC = N_SAPRC99_X
KVARS3D = N_SAPRC99_X_SPC
CASE ('SOAX')
K_SCON_SPC = N_SOAX
KVARS3D = N_SOAX_SPC
CASE DEFAULT
CALL ABOR1_SFX("ERROR: MECHANISM CONVERSION, INVALID MECHANISM: "//TRIM(HMECHANISM))
ENDSELECT
! PRINT*,'SHAPE(SPMH_MAP) =',SHAPE(SPMH_MAP)
IF (ASSOCIATED(KSPMH_MAP)) DEALLOCATE(KSPMH_MAP)
ALLOCATE(KSPMH_MAP(K_SCON_SPC))
IF (ASSOCIATED(KMECH_MAP)) DEALLOCATE(KMECH_MAP)
ALLOCATE(KMECH_MAP(K_SCON_SPC))
IF (ASSOCIATED(PCONV_FAC)) DEALLOCATE(PCONV_FAC)
ALLOCATE(PCONV_FAC(K_SCON_SPC))
IF (ASSOCIATED(HMECH_SPC)) DEALLOCATE(HMECH_SPC)
ALLOCATE(HMECH_SPC(KVARS3D))
IF (ASSOCIATED(PMECH_MWT)) DEALLOCATE(PMECH_MWT)
ALLOCATE(PMECH_MWT(KVARS3D))
IF (ASSOCIATED(HVNAME3D)) DEALLOCATE(HVNAME3D)
ALLOCATE(HVNAME3D(KVARS3D))
IF ( OCONVERSION ) THEN
SELECT CASE ( TRIM(HMECHANISM) )
CASE ('CB05')
KSPMH_MAP(:) = NSPMH_MAP_CB05(:)
KMECH_MAP(:) = NMECH_MAP_CB05(:)
PCONV_FAC(:) = XCONV_FAC_CB05(:)
HMECH_SPC(:) = CMECH_SPC_CB05(:)
PMECH_MWT(:) = XMECH_MWT_CB05(:)
CASE ('CB6')
KSPMH_MAP(:) = NSPMH_MAP_CB6(:)
KMECH_MAP(:) = NMECH_MAP_CB6(:)
PCONV_FAC(:) = XCONV_FAC_CB6(:)
HMECH_SPC(:) = CMECH_SPC_CB6(:)
PMECH_MWT(:) = XMECH_MWT_CB6(:)
CASE ('SAPRCII')
KSPMH_MAP(:) = NSPMH_MAP_SAPRCII(:)
KMECH_MAP(:) = NMECH_MAP_SAPRCII(:)
PCONV_FAC(:) = XCONV_FAC_SAPRCII(:)
HMECH_SPC(:) = CMECH_SPC_SAPRCII(:)
PMECH_MWT(:) = XMECH_MWT_SAPRCII(:)
CASE ('RADM2')
KSPMH_MAP(:) = NSPMH_MAP_RADM2(:)
KMECH_MAP(:) = NMECH_MAP_RADM2(:)
PCONV_FAC(:) = XCONV_FAC_RADM2(:)
HMECH_SPC(:) = CMECH_SPC_RADM2(:)
PMECH_MWT(:) = XMECH_MWT_RADM2(:)
CASE ('RACM')
KSPMH_MAP(:) = NSPMH_MAP_RACM(:)
KMECH_MAP(:) = NMECH_MAP_RACM(:)
PCONV_FAC(:) = XCONV_FAC_RACM(:)
HMECH_SPC(:) = CMECH_SPC_RACM(:)
PMECH_MWT(:) = XMECH_MWT_RACM(:)
CASE ('CBMZ')
KSPMH_MAP(:) = NSPMH_MAP_CBMZ(:)
KMECH_MAP(:) = NMECH_MAP_CBMZ(:)
PCONV_FAC(:) = XCONV_FAC_CBMZ(:)
HMECH_SPC(:) = CMECH_SPC_CBMZ(:)
PMECH_MWT(:) = XMECH_MWT_CBMZ(:)
CASE ('SAPRC99')
KSPMH_MAP(:) = NSPMH_MAP_SAPRC99(:)
KMECH_MAP(:) = NMECH_MAP_SAPRC99(:)
PCONV_FAC(:) = XCONV_FAC_SAPRC99(:)
HMECH_SPC(:) = CMECH_SPC_SAPRC99(:)
PMECH_MWT(:) = XMECH_MWT_SAPRC99(:)
CASE ('SAPRC99Q')
KSPMH_MAP(:) = NSPMH_MAP_SAPRC99_Q(:)
KMECH_MAP(:) = NMECH_MAP_SAPRC99_Q(:)
PCONV_FAC(:) = XCONV_FAC_SAPRC99_Q(:)
HMECH_SPC(:) = CMECH_SPC_SAPRC99_Q(:)
PMECH_MWT(:) = XMECH_MWT_SAPRC99_Q(:)
CASE ('SAPRC99X')
KSPMH_MAP(:) = NSPMH_MAP_SAPRC99_X(:)
KMECH_MAP(:) = NMECH_MAP_SAPRC99_X(:)
PCONV_FAC(:) = XCONV_FAC_SAPRC99_X(:)
HMECH_SPC(:) = CMECH_SPC_SAPRC99_X(:)
PMECH_MWT(:) = XMECH_MWT_SAPRC99_X(:)
CASE ('SOAX')
KSPMH_MAP(:) = NSPMH_MAP_SOAX(:)
KMECH_MAP(:) = NMECH_MAP_SOAX(:)
PCONV_FAC(:) = XCONV_FAC_SOAX(:)
HMECH_SPC(:) = CMECH_SPC_SOAX(:)
PMECH_MWT(:) = XMECH_MWT_SOAX(:)
ENDSELECT
HVNAME3D(:) = HMECH_SPC(:)
ELSE
KVARS3D = N_SPCA_SPC
HVNAME3D(:) = CSPCA_SPC(:)
ENDIF
!---------------------------------------------------------------------------
!
END SUBROUTINE INIT_MGN2MECH
src/LIB/MEGAN/julian.F90 deleted 100644 → 0
+ 0
− 92
View file @ 3233d927
FUNCTION JULIAN (KYEAR, KMNTH, KMDAY) RESULT(KJULIAN)
!***********************************************************************
! Version "$Id: julian.F 45 2014-09-12 20:05:29Z coats $"
! EDSS/Models-3 I/O API.
! Copyright (C) 1992-2002 MCNC and Carlie J. Coats, Jr.,
! (C) 2003-2010 by Baron Advanced Meteorological Systems.
! Distributed under the GNU LESSER GENERAL PUBLIC LICENSE version 2.1
! See file "LGPL.txt" for conditions of use.
!.........................................................................
! function body starts at line 68
!
! FUNCTION: returns the Julian day (1...365,366) corresponding to
! the date MNTH-MDAY-YEAR.
! NOTE: This is NOT the Julian DATE -- only the
! day-number. To get the Julian date:
!
! JDATE = 1000 * YEAR + JULIAN ( YEAR , MNTH , MDAY )
!
! ARGUMENT LIST DESCRIPTION:
!
! Input arguments:
!
! YEAR Calendar year
! MNTH Month of year 1, 12
! MDAY Day of month 1, 31
!
! Output arguments: none
!
! RETURN VALUE:
!
! JULIAN The Julian DAY of the input arguments combined
!
! REVISION HISTORY:
!
! 5/1988 Modified for ROMNET
!
! 8/1990 Modified for ROM 2.2 by Carlie J. Coats, Jr., CSC
! improved comments; improved Zeller's Congruence algorithm
! and using IF-THEN ... ELSE IF ... construction.
!
! 8/1999 Version for global-climate IO_360, which uses 360-day "year"
!
! 2/2002 Unification by CJC with global-climate JULIAN
!
! Modified 03/2010 by CJC: F9x changes for I/O API v3.1
!***********************************************************************
IMPLICIT NONE
!........... ARGUMENTS and their descriptions:
INTEGER, INTENT(IN) :: KYEAR ! year YYYY
INTEGER, INTENT(IN) :: KMNTH ! month 1...12
INTEGER, INTENT(IN) :: KMDAY ! day-of-month 1...28,29,30,31
INTEGER :: KJULIAN
!........... SCRATCH LOCAL VARIABLES:
INTEGER :: JM, JN, JL
!***********************************************************************
! begin body of function JULIAN
#ifdef IO_360
KJULIAN = KMDAY + 30 * ( KMNTH - 1 )
#else
JM = MOD ((KMNTH + 9), 12)
JN = (JM * 153 + 2) / 5 + KMDAY + 58
IF ( MOD(KYEAR,4).NE.0 ) THEN
JL = 365
ELSE IF ( MOD(KYEAR,100).NE.0 ) THEN
JL = 366
JN = 1 + JN
ELSE IF ( MOD(KYEAR,400).NE.0 ) THEN
JL = 365
ELSE
JL = 366
JN = 1 + JN
END IF
KJULIAN = 1 + MOD(JN,JL)
#endif
END FUNCTION JULIAN
src/LIB/MEGAN/mgn2mech.F90 deleted 100644 → 0
+ 0
− 323
View file @ 3233d927
SUBROUTINE MGN2MECH(KDATE, PLAT, PEF, PPFT, PCFNO, PCFNOG, PCFSPEC, &
KSPMH_MAP, KMECH_MAP, PCONV_FAC, OCONVERSION, PFLUX)
!***********************************************************************
! THIS PROGRAM DOES CHEMICAL SPECIATION AND MECHANISM CONVERSION.
! THE OUTPUT FROM MEGAN.F IS CONVERTED FROM 20 TO 150 SPECIES WHICH
! ARE THEN LUMPED ACCORDING TO THE MECHANISM ASSIGNED IN THE RUN SCRIPT.
! THE PROGRAM LOOPS THROUGH ALL TIMESTEPS OF THE INPUT FILE.
!
! PROCEDURE
! 1) FILE SET UP AND ASSIGN I/O PARAMETERS
! 2) CONVERSION FROM MGN 20 TO SPECIATED 150
! 3) CONVERSION FROM SPECIATED SPECIES TO MECHANISM SPECIES
! 4) CONVERT TO TONNE/HOUR IF NEEDED
!
! THE INPUT FILE GIVES VARIABLES IN UNITS OF G-SPECIES/SEC.
! ALL OUTPUTS ARE IN MOLE/SEC OR TONNE/HR DEPENDING ON ASSIGNMENT.
!
!
! INPUT:
! 1) MEGAN OUTPUT (NETCDF-IOAPI)
!
! OUTPUT:
! 1) MEGAN SPECIATION OR MECHANISM SPECIES (NETCDF-IOAPI)
!
! REQUIREMENT:
! REQUIRES LIBNETCDF.A AND LIBIOAPI.A TO COMPILE
!
! SETENV MGERFILE <DEFANGED_INPUT MEGAN OUTPUT FOR EMISSION ACTIVITY FACTORS>
! SETENV OUTPFILE <OUTPUT SPECIATED EMISSION>
!
! CALLS: CHECKMEM
!
! ORIGINALLY CREATED BY JACK CHEN 11/04 FOR MEGAN V.0
! FOR MEGAN V2.0 CREATED BY TAN 12/01/06
! FOR MEGAN V2.1 CREATED BY XUEMEI WANG 11/04/07
! FOR MEGAN V2.1 TO USE 150 SPECIES CREATED BY XUEMEI WANG 09/30/09
!
! HISTORY:
! 08/14/07 TAN - MOVE TO MEGANV2.02 WITH NO UPDATE
! 08/29/07 MODIFIED BY A. GUENTHER TO CORRECT ERROR IN ASSIGNING
! EMISSION FACTOR. THIS VERSION IS CALLED MEGANV2.03
! 10/29/07 MODIFIED BY A. GUENTHER TO CORRECT OMISSION OF DIURNAL VARIATION
! FACTOR. THIS VERSION IS CALLED MEGANV2.04
! 11/04/07 MODIFIED BY XUEMEI WANG TO GIVE TWO OPTIONS FOR MAP OR LOOKUP TABLE FOR
! THE EMISSION FACTORS. ALSO GIVES OPTIONS FOR DIFFERENT CHEMICAL MECHANISMS
! IN THE CODE: USER MODIFIES THE EXTERNAL SCRIPT TO ASSIGN MECHANISM.
! THIS VERSION IS CALLED MEGANV2.1.0
! 06/04/08 MODIFIED BY J. LEE-TAYLOR TO ACCEPT VEGETATION-DEPENDENT SPECIATION FACTORS
! IN TABLE FORMAT (RESHAPE TABLES) RATHER THAN FROM DATA STATEMENTS.
! 09/30/08 MODIFIED BY XUEMEI WANG TO GIVE OPTIONS FOR INPUT FILE AND TEST DIFFERENT MECHANISMS
! 09/27/11 TAN&XUEMEI MEGANV2.10 INCLUDES SOIL NOX ADJUSTMENT AND A LOT OF UPDATES
! 20/12/14 P. TULET - ON-LINE COUPLING IN THE ISBA/SURFEX SCHEME. ALL INIT VARIABLES HAS BEEN
! MOVED IN INIT_MEGANN.F90.
!***********************************************************************
USE MODD_MGN2MECH
USE MODD_MEGAN
USE MODE_SOILNOX
USE MODI_INDEX1
IMPLICIT NONE
INTEGER, INTENT(IN) :: KDATE ! DATE YYYYDDD
REAL, DIMENSION(:), INTENT(IN) :: PLAT !I LATITUDE OF GRID CELL
REAL, DIMENSION(:,:),INTENT(IN) :: PPFT !I PFT FACTOR ARRAY (NRTYP 1-16 IN THE FIRST DIM)
REAL, DIMENSION(:,:),INTENT(IN) :: PEF !I PFT FACTOR ARRAY (NRTYP 1-16 IN THE FIRST DIM)
REAL, DIMENSION(:), INTENT(IN) :: PCFNO !I NO CORRECTION FACTOR
REAL, DIMENSION(:), INTENT(IN) :: PCFNOG !I NO CORRECTION FACTOR FOR GRASS
REAL, DIMENSION(:,:), INTENT(IN) :: PCFSPEC
LOGICAL, INTENT(IN) :: OCONVERSION
INTEGER, DIMENSION(:), INTENT(IN) :: KSPMH_MAP
INTEGER, DIMENSION(:), INTENT(IN) :: KMECH_MAP
REAL, DIMENSION(:), INTENT(IN) :: PCONV_FAC
REAL, DIMENSION(:,:),INTENT(INOUT) :: PFLUX !IO EMISSION FLUX IN MOL/M2/S
!***********************************************************************
! THIS PROGRAM DOES CHEMICAL SPECIATION AND MECHANISM CONVERSION.
!... PROGRAM I/O FILES
! PROGRAM NAME
! INPUT MEGAN ER FILE
! CHARACTER*16 :: MGNERS = 'MGNERS' ! INPUT MEGAN ER FILE LOGICAL NAME
! NETCDF FILE
! CHARACTER*16 :: EFMAPS = 'EFMAPS' ! EFMAP INPUT FILE NAME
! CHARACTER*16 :: PFTS16 = 'PFTS16' ! INPUT PFT FILE LOGICAL
! OUTPUT FILE
! CHARACTER*16 :: MGNOUT = 'MGNOUT' ! OUTPUT FILE LOGICAL NAME
! PARAMETERS FOR FILE UNITS
! INTEGER :: LOGDEV ! LOGFILE UNIT NUMBER
!... PROGRAM I/O PARAMETERS
!... EXTERNAL PARAMETERS
REAL, DIMENSION(N_SPCA_SPC,SIZE(PFLUX,2)) :: ZTMPER ! TEMP EMISSION BUFFER
REAL, DIMENSION(SIZE(PFLUX,1),SIZE(PFLUX,2)) :: ZOUTER ! OUTPUT EMISSION BUFFER
REAL, DIMENSION(SIZE(PLAT)) :: ZTMP1, ZTMP2, ZTMP3, ZTMP4
REAL :: ZTMO1, ZTMO2, ZTMO3
REAL :: Z2CRATIO
!... INTERNAL PARAMETERS
! INTERNAL PARAMTERS (STATUS AND BUFFER)
INTEGER, DIMENSION(SIZE(PLAT)) :: ILEN, IDAY
INTEGER :: JS, JJ, JI, JM, JN ! COUNTERS
INTEGER :: JMPMG, JMPSP, JMPMC ! COUNTERS
INTEGER :: INO
INTEGER :: INP, IN_SCON_SPC
!***********************************************************************
!=======================================================================
!... BEGIN PROGRAM
!=======================================================================
INP = SIZE(PLAT)
IN_SCON_SPC = SIZE(KSPMH_MAP)
! CHANGE THE UNIT ACCORDING TO TONPHR FLAG
! IF ( TONPHR ) THEN
! UNITS3D(1:NVARS3D) = 'TONS/HR'
! ELSE
! UNITS3D(1:NVARS3D) = 'MG/M*M/H'
! ENDIF
!
! DO S = 1, NVARS3D
! PRINT*,'OUTPUT VARIABLE:',VNAME3D(S),UNITS3D(S)
! ENDDO
! CALL NAMEVAL ( MGNERS , MESG ) ! GET INPUT FILE NAME AND PATH
! FDESC3D( 2 ) = 'INPUT MEGAN FILE: '//TRIM(MESG)
!... ALLOCATE MEMORY
!.....2) CONVERSION FROM MGN 20 TO SPECIATED 150
!-----------------------------------------------------------------------
ZTMPER = 0.
ZOUTER = 0.
INO = INDEX1('NO',CMGN_SPC)
!... LOOP THROUGH TIME
DO JS = 1, N_SMAP_SPC
JMPMG = NMG20_MAP(JS)
JMPSP = NSPCA_MAP(JS)
! PRINT*,'CONVERT '//MGN_SPC(NMPMG)//' TO '//SPCA_SPC(NMPSP)
IF ( JMPMG.NE.INO ) THEN
!... NOT NO
IF ( XEF_ALL(1,JMPMG).LT.0. ) THEN
!... USE EFMAPS
ZTMP1(:) = 0.
ZTMP2(:) = 0.
DO JM = 1,N_MGN_PFT
ZTMP1 = ZTMP1 + PPFT(JM,:)
ZTMP2 = ZTMP2 + XEFFS_ALL(JM,JMPSP) * PPFT(JM,:)
ENDDO
WHERE( ZTMP1(:).EQ.0. )
ZTMPER(JMPSP,:) = 0.
ELSEWHERE
ZTMPER(JMPSP,:) = PCFSPEC(JMPMG,:) * PEF(JMPMG,:) * ZTMP2(:)/ZTMP1(:)
ENDWHERE
ELSE
!... USE PFT-EF
ZTMP3(:) = 0.0
ZTMP4(:) = 0.0
DO JM = 1,N_MGN_PFT
!ZTMP3 = ZTMP3 + XEF_ALL(JM,JMPMG) * XEFFS_ALL(JM,JMPSP) * PPFT(JM,:)/100.
ZTMP4(:) = ZTMP4(:) + PPFT(JM,:)
ZTMP3(:) = ZTMP3(:) + XEF_ALL(JM,JMPMG) * XEFFS_ALL(JM,JMPSP) * PPFT(JM,:) ! bug S. Oumami
ENDDO
WHERE( ZTMP4(:).EQ.0. )
ZTMPER(JMPSP,:) = 0.
ELSEWHERE
ZTMPER(JMPSP,:) = PCFSPEC(JMPMG,:) * ZTMP3(:) / ZTMP4(:)
ENDWHERE
ENDIF
ELSE IF ( JMPMG.EQ.INO ) THEN
!!-----------------NO STUFF-----------------------
CALL GROWSEASON(KDATE, PLAT, IDAY, ILEN)
DO JJ = 1,SIZE(PPFT,2)
! CHECK FOR GROWING SEASON
IF ( IDAY(JJ).EQ.0 ) THEN
! NON GROWING SEASON
! CFNOG FOR EVERYWHERE
! OVERRIDE CROP WITH GRASS WARM = 14
IF ( XEF_ALL(1,INO).LT.0. ) THEN
! WITH EFMAPS
ZTMO1 = 0.
ZTMO2 = 0.
DO JM = 1,14
ZTMO1 = ZTMO1 + PPFT(JM,JJ)
ZTMO2 = ZTMO2 + XEFFS_ALL(JM,JMPSP) * PPFT(JM,JJ)
ENDDO
DO JM = 15,N_MGN_PFT
ZTMO1 = ZTMO1 + PPFT(JM,JJ)
Z2CRATIO = XEF_ALL(14,INO)/XEF_ALL(JM,INO)
ZTMO2 = ZTMO2 + XEFFS_ALL(JM,JMPSP) * PPFT(JM,JJ) * Z2CRATIO
ENDDO
IF ( ZTMO1.EQ.0. ) THEN
ZTMPER(JMPSP,JJ) = 0.
ELSE
!ZTMPER(JMPSP,JJ) = &
! PCFSPEC(INO,JJ) * PEF(INO,JJ) * PCFNOG(JJ) * ZTMO2/ZTMO1
ZTMPER(JMPSP,JJ) = &
PCFSPEC(INO,JJ) * PEF(INO,JJ) * PCFNOG(JJ) * ZTMO2/ZTMO1 * XN2NO
ENDIF
ELSE
! WITHOUT EFMAPS
ZTMO3 = 0.0
DO JM = 1,14
ZTMO3 = ZTMO3 + XEF_ALL(JM,INO) * XEFFS_ALL(JM,JMPSP) * PPFT(JM,JJ)/100.
ENDDO
DO JM = 15,N_MGN_PFT
ZTMO3 = ZTMO3 + XEF_ALL(14,INO) * XEFFS_ALL(JM,JMPSP) * PPFT(JM,JJ)/100.
ENDDO
!ZTMPER(JMPSP,JJ) = PCFSPEC(INO,JJ) * PCFNOG(JJ) * ZTMO3
ZTMPER(JMPSP,JJ) = PCFSPEC(INO,JJ) * PCFNOG(JJ) * ZTMO3 * XN2NO
ENDIF
ELSE IF ( IDAY(JJ).GT.0 .AND. IDAY(JJ).LE.366 ) THEN
! GROWING SEASON
! CFNOG FOR EVERYWHERE EXCEPT CROPS
! CFNO FOR CROP AND CORN
IF ( XEF_ALL(1,INO).LT.0. ) THEN
! WITH EFMAPS
ZTMO1 = 0.
ZTMO2 = 0.
DO JM = 1,14
ZTMO1 = ZTMO1 + PPFT(JM,JJ)
ZTMO2 = ZTMO2 + XEFFS_ALL(JM,JMPSP) * PPFT(JM,JJ) * PCFNOG(JJ)
ENDDO
DO JM = 15,N_MGN_PFT
ZTMO1 = ZTMO1 + PPFT(JM,JJ)
ZTMO2 = ZTMO2 + XEFFS_ALL(JM,JMPSP) * PPFT(JM,JJ) * PCFNO(JJ)
ENDDO
IF ( ZTMO1.EQ.0. ) THEN
ZTMPER(JMPSP,JJ) = 0.
ELSE
!ZTMPER(JMPSP,JJ) = PCFSPEC(INO,JJ) * PEF(INO,JJ) * ZTMO2/ZTMO1
ZTMPER(JMPSP,JJ) = PCFSPEC(INO,JJ) * PEF(INO,JJ) * ZTMO2/ZTMO1 * XN2NO
ENDIF
ELSE
! WITHOUT EFMAPS
ZTMO3 = 0.0
DO JM = 1,14
ZTMO3 = ZTMO3 + &
XEF_ALL(JM,INO) * XEFFS_ALL(JM,JMPSP) * PPFT(JM,JJ)/100. * PCFNOG(JJ)
ENDDO
DO JM = 15,N_MGN_PFT
ZTMO3 = ZTMO3 + &
XEF_ALL(JM,INO) * XEFFS_ALL(JM,JMPSP) * PPFT(JM,JJ)/100. * PCFNO(JJ)
ENDDO
!ZTMPER(JMPSP,JJ) = PCFSPEC(INO,JJ) * ZTMO3
ZTMPER(JMPSP,JJ) = PCFSPEC(INO,JJ) * ZTMO3 * XN2NO
ENDIF
ELSE
WRITE(*,*) "MGN2MECH: BAD IDAY"
STOP
ENDIF
ENDDO !DO R = 1,NROWS
!-----------------END OF NO----------------------
ENDIF !IF ( NMPMG .NE. INO ) THEN
ENDDO ! END SPECIES LOOP
!-----------------------------------------------------------------------
!.....3) CONVERSION FROM SPECIATED SPECIES TO MECHANISM SPECIES
!-----------------------------------------------------------------------
! ! CONVERT FROM UG/M^2/HR TO MOL/M^2/S USING THEIR MW
DO JS = 1, N_SPCA_SPC
ZTMPER(JS,:) = ZTMPER(JS,:) / XSPCA_MWT(JS) * XUG2G / XHR2SEC
ENDDO
!
! LUMPING TO MECHANISM SPECIES
!
IF ( OCONVERSION ) THEN
DO JS = 1, IN_SCON_SPC
JMPSP = KSPMH_MAP(JS) ! MAPPING VALUE FOR SPCA
JMPMC = KMECH_MAP(JS) ! MAPPING VALUE FOR MECHANISM
ZOUTER(JMPMC,:) = ZOUTER(JMPMC,:) + ( ZTMPER(JMPSP,:) * PCONV_FAC(JS) )
! ! UNITS OF THESE SPECIES ARE IN MOLE/S ------> MOLE/M²/S
ENDDO ! END SPECIES LOOP
ELSE
! ! GET ALL 150 SPECIES INTO THE OUTPUT ARRAY
ZOUTER(:,:) = ZTMPER(:,:)
! ! UNITS OF THESE SPECIES ARE IN MOLE/M2/S
ENDIF
PFLUX(:,:) = ZOUTER(:,:)
END SUBROUTINE MGN2MECH
src/LIB/MEGAN/modd_megan.F90 deleted 100644 → 0
+ 0
− 145
View file @ 3233d927
MODULE MODD_MEGAN
!
INTEGER, PARAMETER :: NLAYERS = 5
! LENGTH OF THE TIME STEP (DAYS)
INTEGER, PARAMETER :: NTSTLEN = 30
INTEGER, PARAMETER :: NMAXSTYPES = 11
!
REAL, PARAMETER :: XSOLARCONSTANT = 1367, & ! SOLAR CONSTANT [W/M2]
XWATERAIRRATIO = 18.016/28.97 ! RATIO BETWEEN WATER AND AIR MOLECULES
!
REAL, PARAMETER :: XPSTD_SUN=200.0, XPSTD_SHADE=50.0
REAL ,PARAMETER :: XCCE=0.56
!
REAL,PARAMETER :: XSB = 0.0000000567
!
! REAL,PARAMETER :: CONVERTPPFD = 4.766
REAL,PARAMETER :: XCONVERTSHADEPPFD = 4.6
REAL,PARAMETER :: XCONVERTSUNPPFD = 4.0
!
REAL,PARAMETER :: XPI = 3.14159, XRPI180 = 57.29578
!
REAL,PARAMETER :: XDIHIGH = -0.5, XDILOW = -5
!
REAL,PARAMETER :: XCTM2 = 230
REAL,PARAMETER :: XCT2 =200.0
!
REAL,PARAMETER :: XTS = 303.15
!
! PARAMETER FOR UNIT CONVERSION
REAL, PARAMETER :: XUG2TONNE = 1E-12 ! CONVERT MICROGRAM TO METRIC TONNE
REAL, PARAMETER :: XHR2SEC = 3600 ! CONVERT HR TO SECOND
REAL, PARAMETER :: XUG2G = 1E-6 ! CONVERT MICROGRAM TO GRAM
REAL, PARAMETER :: XN2NO = 2.142857 ! CONVERT HR TO SECOND
!
REAL, DIMENSION(NMAXSTYPES) :: XSATURATION=&
(/0.395, 0.410, 0.435, 0.485, 0.451, 0.420, 0.477, 0.476, 0.426, 0.482, 0.482/)
!
REAL, PARAMETER :: XISMAX=1.344, XH=1.4614
REAL, PARAMETER :: XCSTAR=585
!=======================================================================
! CANOPY.EXT
! THIS INCLUDE FILE CONTAINS MEGAN SPECIES
!
! WHO WHEN WHAT
! ---------------------------------------------------------------------
! XUEMEI WANG 06/16/2009 - CREATES THIS FILE
!=======================================================================
INTEGER, PARAMETER :: N_MGN_SPC = 20
CHARACTER(LEN=6), DIMENSION(N_MGN_SPC) :: &
CMGN_SPC=(/'ISOP ','MYRC ','SABI ','LIMO ','A_3CAR','OCIM ','BPIN ','APIN ','OMTP ',&
'FARN ','BCAR ','OSQT ','MBO ','MEOH ','ACTO ','CO ','NO ','BIDER ',&
'STRESS','OTHER '/)
REAL, DIMENSION(N_MGN_SPC), PARAMETER :: &
XCLEO=(/2.,1.83,1.83,1.83,1.83,1.83,1.83,1.83,1.83,2.37,2.37,2.37,2.,1.6,1.83,1.6,1.86,2.,1.83,1.83/)
REAL, DIMENSION(N_MGN_SPC), PARAMETER :: &
XCTM1=(/95.,80.,80.,80.,80.,80.,80.,80.,80.,130.,130.,130.,95.,60.,80.,60.,80.,95.,80.,80./)
REAL, DIMENSION(N_MGN_SPC), PARAMETER :: &
XTDF_PRM=(/0.13,0.1,0.1,0.1,0.1,0.1,0.1,0.1,0.1,0.17,0.17,0.17,0.13,0.08,0.1,0.08,0.1,0.13,0.1,0.1/)
REAL, DIMENSION(N_MGN_SPC), PARAMETER :: &
XLDF_FCT=(/0.999,0.6,0.6,0.4,0.4,0.4,0.4,0.6,0.4,0.5,0.5,0.5,0.999,0.8,0.2,0.999,0.,0.8,0.8,0.2/)
REAL, DIMENSION(N_MGN_SPC), PARAMETER :: &
XMGN_MWT=(/1.,1.,1.,1.,1.,1.,1.,1.,1.,1.,1.,1.,1.,1.,1.,1.,1.,1.,1.,1./)
!
INTEGER, DIMENSION(N_MGN_SPC), PARAMETER :: &
NREA_INDEX=(/5,2,2,2,2,2,2,2,2,3,3,3,5,4,1,1,1,1,1,1/)
!
!**************************************************************************************************************
!
INTEGER,PARAMETER :: N_MGN_PFT = 16
!
!CHARACTER(LEN=10), DIMENSION(N_MGN_PFT), PARAMETER :: &
! CMGN_PFT=(/'NT_EG_TEMP','NT_DC_BORL','NT_EG_BORL','BT_EG_TROP','BT_EG_TEMP','BT_DC_TROP',&
! 'BT_DC_TEMP','BT_DC_BORL','SG_EG_TEMP','SB_DC_TEMP','SB_DC_BORL',&
! 'GS_C3_COLD','GS_C3_COOL','GS_C3_WARM','CORN ','CROP '/)
!
!CHARACTER(LEN=35), DIMENSION(N_MGN_PFT), PARAMETER :: &
! CMGN_NAM=(/'Needleaf evergreen temperate tree ','Needleaf deciduous boreal tree ',&
! 'Needleaf evergreen boreal tree ','Broadleaf evergreen tropical tree ',&
! 'Broadleaf evergreen tropical tree ','Broadleaf deciduous tropical tree ',&
! 'Broadleaf deciduous temperate tree ','Broadleaf deciduous boreal tree ',&
! 'Broadleaf evergreen temperate shrub','Broadleaf deciduous temperate shrub',&
! 'Broadleaf deciduous boreal shrub ','Cold C3 grass ',&
! 'Cool C3 grass ','Warm C3 grass ',&
! 'Corn ','Other crops '/)
!
INTEGER,PARAMETER :: N_CAT = 5
!
REAL, DIMENSION(N_CAT) :: XANEW=(/1.,2. ,0.4 ,3.5,0.05/)
REAL, DIMENSION(N_CAT) :: XAGRO=(/1.,1.8 ,0.6 ,3. ,0.6 /)
REAL, DIMENSION(N_CAT) :: XAMAT=(/1.,1. ,1. ,1. ,1. /)
REAL, DIMENSION(N_CAT) :: XAOLD=(/1.,1.05,0.95,1.2,0.9 /)
!
!**********************************************************************************************************
INTEGER, PARAMETER :: NRCHA = 16
! 1 = canopy depth
! 2 = leaf width
! 3 = leaf length
! 4 = canopy height
! 5 = scattering coefficient for PPFD
! 6 = scattering coefficient for near IR
! 7 = reflection coefficient for diffuse PPFD
! 8 = reflection coefficient for diffuse near IR
! 9 = clustering coefficient (accounts for leaf clumping influence on mean
! projected leaf area in the direction of the suns beam)
! use 0.85 for default, corn=0.4-0.9; Pine=0.6-1.0; oak=0.53-0.67;
! tropical rainforest=1.1
! 10 = leaf IR emissivity
! 11 = leaf stomata and cuticle factor: 1=hypostomatous, 2=amphistomatous,
! 1.25=hypostomatous but with some transpiration through cuticle
! 12 = daytime temperature lapse rate (K m-1)
! 13 = nighttime temperature lapse rate (K m-1)
! 14 = warm (>283K) canopy total humidity change (Pa)
! 15 = cool (>= 283K) canopy total humidity change (Pa)
! 16 = normalized canopy depth where wind is negligible
! NT NT NT TF BT TF BT BT SB SB SB HB HB HB CR CR
REAL,DIMENSION(NRCHA,N_MGN_PFT) :: XCANOPYCHAR = RESHAPE(&
(/ 16., 16., 16., 16., 16., 16., 16., 16., 1., 1., 1., 0.756, 0.756, 0.756, 1., 1., &
0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.015, 0.015, 0.015, 0.015, 0.015, 0.015, 0.02, 0.02, &
0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.15, 0.15, 0.15, 0.15, 0.15, &
24., 24., 24., 24., 24., 24., 24., 24., 2., 2., 2., 0.75, 0.75, 0.75, 1., 1., &
0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, &
0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, &
0.057, 0.057, 0.057, 0.057, 0.057, 0.057, 0.057, 0.057, 0.057, 0.057, 0.057, 0.057, 0.057, 0.057, 0.057, 0.057, &
0.389, 0.389, 0.389, 0.389, 0.389, 0.389, 0.389, 0.389, 0.389, 0.389, 0.389, 0.389, 0.389, 0.389, 0.389, 0.389, &
0.85, 0.85, 0.85, 1.1, 0.95, 1.1, 0.95, 0.95, 0.85, 0.85, 0.85, 0.76, 0.76, 0.76, 0.65, 0.65, &
0.95, 0.95, 0.95, 0.95, 0.95, 0.95, 0.95, 0.95, 0.95, 0.95, 0.95, 0.95, 0.95, 0.95, 0.95, 0.95, &
1.25, 1.25, 1.25, 1.25, 1.25, 1.25, 1.25, 1.25, 1.00, 1.00, 1.00, 1.25, 1.25, 1.25, 1.25, 1.25, &
0.06, 0.06, 0.06, 0.06, 0.06, 0.06, 0.06, 0.06, 0.06, 0.06, 0.06, 0.06, 0.06, 0.06, 0.06, 0.06, &
-0.06, -0.06, -0.06, -0.06, -0.06, -0.06, -0.06, -0.06, -0.06, -0.06, -0.06, -0.06, -0.06, -0.06, -0.06, -0.06, &
700., 700., 700., 700., 700., 700., 700., 700., 700., 700., 700., 700., 700., 700., 700., 700., &
150., 150., 150., 150., 150., 150., 150., 150., 150., 150., 150., 150., 150., 150., 150., 150., &
0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7/)&
,SHAPE=(/NRCHA,N_MGN_PFT/) ,ORDER=(/2,1/) )
END MODULE MODD_MEGAN
src/LIB/MEGAN/modd_mgn2mech.F90 deleted 100644 → 0
+ 0
− 1275
View file @ 3233d927
This diff is collapsed.
src/LIB/MEGAN/mode_gamma_etc.F90 deleted 100644 → 0
+ 0
− 554
View file @ 3233d927
!=======================================================================
! MODULE GAMMA
!
! THIS MODULE CONTAIN FUNCTIONS TO CALCULATE
! GAMMA_P, GAMMA_T, GAMMA_L, GAMMA_A FOR BVOCS.
!
! CONTAINS: 1)GAMMA_LAI
! 2)GAMMA_P
! 3)GAMMA_TLD
! 4)GAMMA_TLI
! 5)GAMMA_A
! 6)GAMMA_S
! 7)GAMMA_CO2
! 8)GAMMA_LAIBIDIR
!
! NOTE:
!
! REQUIREMENT:
!
! CALLS: SOLARANGLE
!
! CREATED BY TAN 11/21/06 FOR MEGAN V2.0
!
! HISTORY:
! 08/01/07 GUENTHER A. - MOVE TO MEGANV2.02 WITH MODIFICATION TO
! CORRECT CALCULATION OF GAMMA_P
!
!=======================================================================
MODULE MODE_GAMMA_ETC
!
USE MODD_MEGAN
!
!USE MODI_SOLARANGLE
USE MODI_INDEX1
!
IMPLICIT NONE
!... PROGRAM I/O PARAMETERS
!... EXTERNAL PARAMETERS
CONTAINS
!***********************************************************************
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! SCIENTIFIC ALGORITHM
!
! EMISSION = [EF][GAMMA][RHO]
! WHERE [EF] = EMISSION FACTOR (UG/M2H)
! [GAMMA] = EMISSION ACTIVITY FACTOR (NON-DIMENSION)
! [RHO] = PRODUCTION AND LOSS WITHIN PLANT CANOPIES
! (NON-DIMENSINO)
! ASSUMPTION: [RHO] = 1 (11/27/06) (SEE PDT_LOT_CP.EXT)
!
! GAMMA = [GAMMA_CE][GAMMA_AGE][GAMMA_SM]
! WHERE [GAMMA_CE] = CANOPY CORRECTION FACTOR
! [GAMMA_AGE] = LEAF AGE CORRECTION FACTOR
! [GAMMA_SM] = SOIL MOISTURE CORRECTION FACTOR
! ASSUMPTION: [GAMMA_SM] = 1 (11/27/06)
!
! GAMMA_CE = [GAMMA_LAI][GAMMA_P][GAMMA_T]
! WHERE [GAMMA_LAI] = LEAF AREA INDEX FACTOR
! [GAMMA_P] = PPFD EMISSION ACTIVITY FACTOR
! [GAMMA_T] = TEMPERATURE RESPONSE FACTOR
!
! EMISSION = [EF][GAMMA_LAI][GAMMA_P][GAMMA_T][GAMMA_AGE][GAMMA_SM]
! DERIVATION:
! EMISSION = [EF][GAMMA_ETC](1-LDF) + [EF][GAMMA_ETC][LDF][GAMMA_P]
! EMISSION = [EF][GAMMA_ETC]{ (1-LDF) + [LDF][GAMMA_P] }
! EMISSION = [EF][GAMMA_ECT]{ (1-LDF) + [LDF][GAMMA_P] }
! WHERE LDF = LIGHT DEPENDENT FUNCTION (NON-DIMENSION)
!
! FOR ISOPRENE
! ASSUMPTION: LDF = 1 FOR ISOPRENE (11/27/06)
!
! FINAL EQUATION
! EMISSION = [EF][GAMMA_LAI][GAMMA_P][GAMMA_T][GAMMA_AGE][GAMMA_SM]
!
! FOR NON-ISOPRENE
! FINAL EQUATION
! EMISSION = [EF][GAMMA_LAI][GAMMA_T][GAMMA_AGE][GAMMA_SM]*
! { (1-LDF) + [LDF][GAMMA_P] }
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!=======================================================================
!... BEGIN MODULE
!=======================================================================
!-----------------------------------------------------------------------
!.....1) CALCULATE GAM_L (GAMMA_LAI)
!-----------------------------------------------------------------------
! 0.49[LAI]
! GAMMA_LAI = ---------------- (NON-DIMENSION)
! (1+0.2LAI^2)^0.5
!
! SUBROUTINE GAMMA_LAI RETURNS THE GAMMA_LAI VALUES
!-----------------------------------------------------------------------
SUBROUTINE GAMMA_LAI(PLAI, PGAM_L)
IMPLICIT NONE
! INPUT
REAL,DIMENSION(:),INTENT(IN) :: PLAI
! OUTPUT
REAL,DIMENSION(:),INTENT(OUT) :: PGAM_L
PGAM_L(:) = (0.49*PLAI(:)) / ( (1.+0.2*(PLAI(:)**2))**0.5 )
END SUBROUTINE GAMMA_LAI
!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
!.....5) CALCULATE GAM_A (GAMMA_AGE)
!-----------------------------------------------------------------------
!
! GAMMA_AGE = FNEW*ANEW + FGRO*AGRO + FMAT*AMAT + FOLD*AOLD
! WHERE FNEW = NEW FOLIAGE FRACTION
! FGRO = GROWING FOLIAGE FRACTION
! FMAT = MATURE FOLIAGE FRACTION
! FOLD = OLD FOLIAGE FRACTION
! ANEW = RELATIVE EMISSION ACTIVITY FOR NEW FOLIAGE
! AGRO = RELATIVE EMISSION ACTIVITY FOR GROWING FOLIAGE
! AMAT = RELATIVE EMISSION ACTIVITY FOR MATURE FOLIAGE
! AOLD = RELATIVE EMISSION ACTIVITY FOR OLD FOLIAGE
!
!
! FOR FOLIAGE FRACTION
! CASE 1) LAIC = LAIP
! FNEW = 0.0 , FGRO = 0.1 , FMAT = 0.8 , FOLD = 0.1
!
! CASE 2) LAIP > LAIC
! FNEW = 0.0 , FGRO = 0.0
! FMAT = 1-FOLD
! FOLD = (LAIP-LAIC)/LAIP
!
! CASE 3) LAIP < LAIC
! FNEW = 1-(LAIP/LAIC) T <= TI
! = (TI/T) * ( 1-(LAIP/LAIC) ) T > TI
!
! FMAT = LAIP/LAIC T <= TM
! = (LAIP/LAIC) +
! ( (T-TM)/T ) * ( 1-(LAIP/LAIC) ) T > TM
!
! FGRO = 1 - FNEW - FMAT
! FOLD = 0.0
!
! WHERE
! TI = 5 + (0.7*(300-TT)) TT <= 303
! = 2.9 TT > 303
! TM = 2.3*TI
!
! T = LENGTH OF THE TIME STEP (DAYS)
! TI = NUMBER OF DAYS BETWEEN BUDBREAK AND THE INDUCTION OF
! EMISSION
! TM = NUMBER OF DAYS BETWEEN BUDBREAK AND THE INITIATION OF
! PEAK EMISSIONS RATES
! TT = AVERAGE TEMPERATURE (K) NEAR TOP OF THE CANOPY DURING
! CURRENT TIME PERIOD (DAILY AVE TEMP FOR THIS CASE)
!
!
! FOR RELATIVE EMISSION ACTIVITY
! CASE 1) CONSTANT
! ANEW = 1.0 , AGRO = 1.0 , AMAT = 1.0 , AOLD = 1.0
!
! CASE 2) MONOTERPENES
! ANEW = 2.0 , AGRO = 1.8 , AMAT = 0.95 , AOLD = 1.0
!
! CASE 3) SESQUITERPENES
! ANEW = 0.4 , AGRO = 0.6 , AMAT = 1.075, AOLD = 1.0
!
! CASE 4) METHANOL
! ANEW = 3.0 , AGRO = 2.6 , AMAT = 0.85 , AOLD = 1.0
!
! CASE 5) ISOPRENE
! ANEW = 0.05 , AGRO = 0.6 , AMAT = 1.125, AOLD = 1.0
!
! SUBROUTINE GAMMA_A RETURNS GAMMA_A
!-----------------------------------------------------------------------
SUBROUTINE GAMMA_A(KDATE, KTIME, KTSTLEN, HSPC_NAME, PTEMP_D, PLAIARP, PLAIARC, PGAM_A)
IMPLICIT NONE
! INPUT
INTEGER, INTENT(IN) :: KDATE, KTIME, KTSTLEN
CHARACTER(LEN=16), INTENT(IN) :: HSPC_NAME
REAL, DIMENSION(:), INTENT(IN) :: PTEMP_D
REAL, DIMENSION(:), INTENT(IN) :: PLAIARP, PLAIARC
! OUTPUT
REAL,DIMENSION(:),INTENT(OUT) :: PGAM_A
! LOCAL PARAMETERS
REAL :: ZFNEW, ZFGRO, ZFMAT, ZFOLD
REAL :: ZTI, ZTM ! NUMBER OF DAYS BETWEEN BUDBREAK
! AND INDUCTION OF EMISSION,
! INITIATION OF PEAK EMISSIONS RATES
INTEGER :: IAINDX ! RELATIVE EMISSION ACITIVITY INDEX
INTEGER :: ISPCNUM
INTEGER :: JJ
!... CHOOSE RELATIVE EMISSION ACTIVITY
!--------CODE BY XUEMEI WANG 11/04/2007----------------
!
ISPCNUM = INDEX1(HSPC_NAME, CMGN_SPC)
IAINDX = NREA_INDEX(ISPCNUM)
!
!---------------------------------------------------
! LOCAL PARAMETER ARRAYS
DO JJ = 1,SIZE(PLAIARP)
IF ( PTEMP_D(JJ).LE.303. ) THEN
ZTI = 5.0 + 0.7*(300.-PTEMP_D(JJ))
ELSE
ZTI = 2.9
ENDIF
ZTM = 2.3 * ZTI
!
!... CALCULATE FOLIAGE FRACTION
! PRINT*,'LAIP,LAIC, TT=',MINVAL(LAIP), MAXVAL(LAIP),
! S MINVAL(LAIC), MAXVAL(LAIC), MINVAL(TT), MAXVAL(TT)
! WHERE (LAIP .LT. LAIC)
! CALCULATE TI AND TM
IF ( PLAIARP(JJ).EQ.PLAIARC(JJ) ) THEN
ZFNEW = 0.0
ZFGRO = 0.1
ZFMAT = 0.8
ZFOLD = 0.1
ELSEIF ( PLAIARP(JJ).GT.PLAIARC(JJ) ) THEN
ZFNEW = 0.0
ZFGRO = 0.0
ZFOLD = ( PLAIARP(JJ)-PLAIARC(JJ) ) / PLAIARP(JJ)
ZFMAT = 1. - ZFOLD
ELSE
ZFMAT = PLAIARP(JJ)/PLAIARC(JJ)
! CALCULATE FNEW AND FMAT, THEN FGRO AND FOLD
! FNEW
IF ( ZTI.GE.KTSTLEN ) THEN
ZFNEW = 1.0 - ZFMAT
ELSE
ZFNEW = (ZTI/KTSTLEN) * ( 1. - ZFMAT )
ENDIF
! FMAT
IF ( ZTM.LT.KTSTLEN ) THEN
ZFMAT = ZFMAT + ( (KTSTLEN-ZTM)/KTSTLEN ) * ( 1.-ZFMAT )
ENDIF
ZFGRO = 1.0 - ZFNEW - ZFMAT
ZFOLD = 0.0
ENDIF
!... CALCULATE GAMMA_A
PGAM_A(JJ) = ZFNEW * XANEW(IAINDX) + ZFGRO * XAGRO(IAINDX) + &
ZFMAT * XAMAT(IAINDX) + ZFOLD * XAOLD(IAINDX)
ENDDO
END SUBROUTINE GAMMA_A
!-----------------------------------------------------------------------
!.....6) CALCULATE GAM_SMT (GAMMA_SM)
!-----------------------------------------------------------------------
!
! GAMMA_SM = 1.0 (NON-DIMENSION)
!
!
! SUBROUTINE GAMMA_S RETURNS THE GAMMA_SM VALUES
!-----------------------------------------------------------------------
SUBROUTINE GAMMA_S( PGAM_S )
IMPLICIT NONE
REAL,DIMENSION(:) :: PGAM_S
PGAM_S = 1.0
END SUBROUTINE GAMMA_S
!-----------------------------------------------------------------------
!.....2) CALCULATE GAM_P (GAMMA_P)
!-----------------------------------------------------------------------
! GAMMA_P = 0.0 A<=0, A>=180, SIN(A) <= 0.0
!
! GAMMA_P = SIN(A)[ 2.46*(1+0.0005(PDAILY-400))*PHI - 0.9*PHI^2 ]
! 0<A<180, SIN(A) > 0.0
! WHERE PHI = ABOVE CANOPY PPFD TRANSMISSION (NON-DIMENSION)
! PDAILY = DAILY AVERAGE ABOVE CANOPY PPFD (UMOL/M2S)
! A = SOLAR ANGLE (DEGREE)
!
! NOTE: AAA = 2.46*BBB*PHI - 0.9*PHI^2
! BBB = (1+0.0005(PDAILY-400))
! GAMMA_P = SIN(A)*AAA
!
! PAC
! PHI = -----------
! SIN(A)*PTOA
! WHERE PAC = ABOVE CANOPY PPFD (UMOL/M2S)
! PTOA = PPFD AT THE TOP OF ATMOSPHERE (UMOL/M2S)
!
! PAC = SRAD * 4.766 MMMOL/M2-S * 0.5
!
! PTOA = 3000 + 99*COS[2*3.14-( DOY-10)/365 )]
! WHERE DOY = DAY OF YEAR
!
! SUBROUTINE GAMMA_P RETURNS THE GAMMA_P VALUES
!-----------------------------------------------------------------------
!SUBROUTINE GAMMA_P( KDATE, KTIME, PLAT, PLONG, PPFD, PPFD_D, PGAM_P )
!
!IMPLICIT NONE
!
!! INPUT
!INTEGER,INTENT(IN) :: KDATE, KTIME
!
!REAL,DIMENSION(:),INTENT(IN) :: PLAT, PLONG
!! PHOTOSYNTHETIC PHOTON FLUX DENSITY: INSTANTANEOUS, DAILY
!REAL,DIMENSION(:),INTENT(IN) :: PPFD, PPFD_D
!! OUTPUT
!REAL,DIMENSION(:),INTENT(OUT) :: PGAM_P ! GAMMA_P
!
!! LOCAL PARAMETERS
!REAL, DIMENSION(SIZE(PLAT)) :: ZHOUR, ZSINBETA ! HOUR IS SOLAR HOUR
!INTEGER, DIMENSION(SIZE(PLAT)) :: IDAY ! DAY IS DOY (JDATE)
!
!REAL :: ZPTOA, ZPHI
!REAL :: ZAAA, ZBBB
!REAL :: ZBETA ! SOLAR ZENITH ANGLE
!INTEGER :: JJ
!
!!... BEGIN ESTIMATING GAMMA_P
!
!!... CONVERT DATE AND TIME FORMAT TO LOCAL TIME
!! DAY IS JULIAN DAY
!IDAY(:) = MOD(KDATE,1000)
!
!! CONVERT FROM XXXXXX FORMAT TO XX.XX (SOLAR HOUR)
!! HOUR = 0 -> 23.XX
!! SOLAR HOUR
!ZHOUR(:) = KTIME/10000. + PLONG(:)/15.
!
!WHERE ( ZHOUR(:).LT.0. )
! ZHOUR(:) = ZHOUR(:) + 24.0
! IDAY(:) = IDAY(:) - 1.
!ENDWHERE
!
!! GET SOLAR ELEVATION ANGLE
!CALL SOLARANGLE(IDAY, ZHOUR, PLAT, ZSINBETA)
!
!DO JJ = 1,SIZE(ZSINBETA)
!
! IF ( ZSINBETA(JJ).LE.0. ) THEN
!
! PGAM_P(JJ) = 0.
!
! ELSE IF ( ZSINBETA(JJ).GT.0. ) THEN
!
! ZPTOA = 3000.0 + 99.0 *COS(2. * 3.14 * (IDAY(JJ)-10.)/365.)
!
! ZPHI = PPFD(JJ) / (ZSINBETA(JJ) * ZPTOA)
!
! ZBBB = 1. + 0.0005 * (PPFD_D(JJ)-400. )
! ZAAA = ( 2.46 * ZBBB * ZPHI ) - ( 0.9 * ZPHI**2 )
!
! PGAM_P(JJ) = ZSINBETA(JJ) * ZAAA
!
! ZBETA = ASIN(ZSINBETA(JJ)) * XRPI180 ! DEGREE
!
! ! SCREENING THE UNFORCED ERRORS
! ! IF SOLAR ELEVATION ANGLE IS LESS THAN 1 THEN
! ! GAMMA_P CAN NOT BE GREATER THAN 0.1.
! IF ( ZBETA.LT.1.0 .AND. PGAM_P(JJ).GT.0.1 ) THEN
! PGAM_P(JJ) = 0.0
! ENDIF
!
! ELSE
!
! WRITE(*,*) "ERROR: SOLAR ANGLE IS INVALID - FATAL ERROR GAMMA_P, STOP"
! STOP
!
! ENDIF
! ! END LOOP FOR NROWS
!ENDDO ! END LOOP FOR NCOLS
!
!END SUBROUTINE GAMMA_P
!!-----------------------------------------------------------------------
!
!
!!-----------------------------------------------------------------------
!!.....3) CALCULATE GAM_T (GAMMA_T) FOR ISOPRENE
!!-----------------------------------------------------------------------
!! EOPT*CT2*EXP(CT1*X)
!! GAMMA_T = ------------------------
!! [CT2-CT1*(1-EXP(CT2*X))]
!! WHERE X = [ (1/TOPT)-(1/THR) ] / 0.00831
!! EOPT = 1.75*EXP(0.08(TDAILY-297)
!! CT1 = 80
!! CT2 = 200
!! THR = HOURLY AVERAGE AIR TEMPERATURE (K)
!! TDAILY = DAILY AVERAGE AIR TEMPERATURE (K)
!! TOPT = 313 + 0.6(TDAILY-297)
!!
!! NOTE: AAA = EOPT*CT2*EXP(CT1*X)
!! BBB = [CT2-CT1*(1-EXP(CT2*X))]
!! GAMMA_T = AAA/BBB
!!
!! SUBROUTINE GAMMA_TLD RETURNS THE GAMMA_T VALUE FOR ISOPRENE
!!-----------------------------------------------------------------------
!SUBROUTINE GAMMA_TLD( PTEMP, PTEMP_D, PGAM_T, HSPC_NAME )
!
!IMPLICIT NONE
!
!! INPUT
!REAL,DIMENSION(:),INTENT(IN) :: PTEMP, PTEMP_D ! DAILY, HOURLY SURFACE TEMPERATURE
!! OUTPUT
!REAL,DIMENSION(:),INTENT(OUT) :: PGAM_T ! GAMMA_T
!CHARACTER(LEN=16),INTENT(IN) :: HSPC_NAME
!!
!! LOCAL PARAMETERS
!REAL :: ZEOPT, ZTOPT, ZX, ZAAA, ZBBB
!INTEGER :: ISPCNUM, JJ
!
!ISPCNUM = INDEX1(HSPC_NAME, CMGN_SPC)
!
!DO JJ = 1,SIZE(PTEMP)
!
! ZEOPT = XCLEO(ISPCNUM) * EXP(0.08*(PTEMP_D(JJ)-297.))
! ZTOPT = 313.0 + ( 0.6*(PTEMP_D(JJ)-297.) )
! ZX = ( (1/ZTOPT)-(1/PTEMP(JJ)) ) / 0.00831
!
! ZAAA = ZEOPT * XCT2 * EXP(XCTM1(ISPCNUM)*ZX)
! ZBBB = ( XCT2- XCTM1(ISPCNUM)*( 1.-EXP(XCT2*ZX) ) )
! PGAM_T(JJ) = ZAAA/ZBBB
!
!ENDDO
!
!END SUBROUTINE GAMMA_TLD
!!-----------------------------------------------------------------------
!
!
!!-----------------------------------------------------------------------
!!.....4) CALCULATE GAM_T (GAMMA_T) FOR NON-ISOPRENE
!!-----------------------------------------------------------------------
!!
!! GAMMA_T = EXP[TDP_FCT*(T-TS)]
!! WHERE TDP_FCT = TEMPERATURE DEPENDENT PARAMETER ('BETA')
!! TS = STANDARD TEMPERATURE (NORMALLY 303K, 30C)
!!
!! SUBROUTINE GAMMA_TLI RETURNS THE GAMMA_T VALUE FOR NON-ISOPRENE
!!-----------------------------------------------------------------------
!SUBROUTINE GAMMA_TLI(HSPCNAM, PTEMP, PGAM_T)
!
!IMPLICIT NONE
!
!CHARACTER(LEN=16), INTENT(IN) :: HSPCNAM
!REAL,DIMENSION(:), INTENT(IN):: PTEMP
!REAL, DIMENSION(:), INTENT(OUT) :: PGAM_T
!!
!INTEGER :: ISPCNUM ! SPECIES NUMBER
!
!!--END OF DECLARATIONS--
!
!ISPCNUM = INDEX1(HSPCNAM, CMGN_SPC)
!!
!PGAM_T = EXP( XTDF_PRM(ISPCNUM) * (PTEMP-XTS) )
!
!END SUBROUTINE GAMMA_TLI
!!-----------------------------------------------------------------------
!
!!=======================================================================
!!-----------------------------------------------------------------------
!!.....7) CALCULATE GAM_CO2(GAMMA_CO2)
!!-----------------------------------------------------------------------
!!
!! GAMMA_CO2 = 1.0 (NON-DIMENSION)
!! WHEN CO2 =400PPM
!!
!! SUBROUTINE GAM_CO2 RETURNS THE GAMMA_CO2 VALUES
!! XUEMEI WANG-2009-06-22
!!-----------------------------------------------------------------------
!SUBROUTINE GAMMA_CO2(PCO2, PGAM_CO2)
!
!IMPLICIT NONE
!
!REAL, DIMENSION(:), INTENT(IN) :: PCO2
!REAL, DIMENSION(:), INTENT(OUT) :: PGAM_CO2
!
!REAL :: ZCI
!INTEGER :: JJ
!
!DO JJ = 1,SIZE(PCO2)
!
! IF ( PCO2(JJ).EQ.400. ) THEN
! PGAM_CO2(JJ) = 1.0
! ELSE
! ZCI = 0.7* PCO2(JJ)
! PGAM_CO2(JJ) = XISMAX - ((XISMAX*ZCI**XH) /(XCSTAR**XH+ZCI**XH))
! ENDIF
!
!ENDDO
!
!END SUBROUTINE GAMMA_CO2
!
!!=======================================================================
!!=======================================================================
!!-----------------------------------------------------------------------
!!.....8) CALCULATE GAMMA_LAIBIDIR(GAM_LAIBIDIR,LAI)
!!-----------------------------------------------------------------------
!!FROM ALEX GUENTHER 2010-01-26
!!IF LAI < 2 THEN
!!GAMMALAIBIDIR= 0.5 * LAI
!!ELSEIF LAI <= 6 THEN
!!GAMMALAIBIDIR= 1 - 0.0625 * (LAI - 2)
!!ELSE
!!GAMMALAIBIDIR= 0.75
!!END IF
!!
!! SUBROUTINE GAMMA_LAIBIDIR RETURNS THE GAM_LAIBIDIR VALUES
!! XUEMEI WANG-2010-01-28
!!
!!-----------------------------------------------------------------------
!SUBROUTINE GAMMA_LAIBIDIR(PLAI, PGAM_LAIBIDIR)
!
!IMPLICIT NONE
!
!REAL,DIMENSION(:),INTENT(IN) :: PLAI
!REAL,DIMENSION(:),INTENT(OUT) :: PGAM_LAIBIDIR
!
!INTEGER :: JJ
!!
!DO JJ = 1,SIZE(PLAI)
!
! IF ( PLAI(JJ)<2. ) THEN
! PGAM_LAIBIDIR(JJ) = 0.5 * PLAI(JJ)
! ELSEIF ( PLAI(JJ).GE.2. .AND. PLAI(JJ).LE.6. ) THEN
! PGAM_LAIBIDIR(JJ) = 1. - 0.0625 * ( PLAI(JJ)-2. )
! ELSE
! PGAM_LAIBIDIR(JJ) = 0.75
! ENDIF
!
!ENDDO
!
!END SUBROUTINE GAMMA_LAIBIDIR
!!=======================================================================
!
END MODULE MODE_GAMMA_ETC
src/LIB/MEGAN/mode_megan.F90 deleted 100644 → 0
+ 0
− 1235
View file @ 3233d927
This diff is collapsed.
src/LIB/MEGAN/mode_soilnox.F90 deleted 100644 → 0
+ 0
− 255
View file @ 3233d927
!=======================================================================
! MODULE SOILNOX_FX
!
! This module contain functions to assist soil NOx calculation.
!
!
! CONTAINS: 1)FERTLZ_ADJ
! 2)VEG_ADJ
! 3)GROWSEASON
!
! Note:
!
! Requirement:
!
!
! Imported from SMOKE-BEIS v3.14 and modified
! by Tan 07/21/11 for MEGAN v2.10
!
! Function PRECADJ is moved to MET2MGN
! PULSETYPE is moved to MET2MGN
! PRECIPFAC is moved to MET2MGN
!
! History:
!
!=======================================================================
MODULE MODE_SOILNOX
USE MODI_JULIAN
IMPLICIT NONE
!... Program I/O parameters
!... External parameters
CONTAINS
!=======================================================================
!=======================================================================
FUNCTION FERTLZ_ADJ(KDATE, PLAT) RESULT(PFERTLZ_ADJ)
!***********************************************************************
! DESCRIPTION:
! This internal function computes a fertilizer adjustment factor
! for the given date in yyyyddd format. If it is not growing
! season, the adjustment factor is 0; otherwise, it ranges from
! 0.0 to 1.0.
!
! CALL:
! GROWSEASON
!
! HISTORY:
! 07/21/11 : Imported from SMOKE-BEIS v3.14 and modified (Tan)
!***********************************************************************
IMPLICIT NONE
!.... Function arguments
INTEGER, INTENT(IN) :: KDATE
REAL, DIMENSION(:), INTENT(IN) :: PLAT
REAL, DIMENSION(SIZE(PLAT)) :: PFERTLZ_ADJ
!.... Local variables
INTEGER, DIMENSION(SIZE(PLAT)) :: IDAY, ILEN
!-----------------------------------------------------------------------------
CALL GROWSEASON(KDATE, PLAT, IDAY, ILEN)
IF (ANY(IDAY(:)<0).OR.ANY(IDAY(:)>366)) THEN
WRITE(*,*) "MODE_SOILNOX: FERTLZ_ADJ: Invalid date specified"
STOP
ENDIF
WHERE ( IDAY(:)==0 )
PFERTLZ_ADJ(:) = 0.
ELSE WHERE( IDAY(:)>=1 .AND. IDAY(:)<30 )
! first month of growing season
PFERTLZ_ADJ(:) = 1.
ELSE WHERE( IDAY(:)>=30 .AND. IDAY(:)<=366 )
! later month of growing season
PFERTLZ_ADJ(:) = 1. + (30.-FLOAT(IDAY(:)))/(FLOAT(ILEN(:)))
END WHERE
END FUNCTION FERTLZ_ADJ
!=======================================================================
!=======================================================================
!=======================================================================
!=======================================================================
FUNCTION VEG_ADJ(PLAI) RESULT(PVEG_ADJ)
!***********************************************************************
! DESCRIPTION
! This internal function computes a vegetation adjustment factor
! based on LAIv. See Yienger and Levy 1995
! VEG_ADJ = (EXP(-0.24*LAIv)+EXP(-0.0525*LAIv))*0.5
!
! CALL
! NONE
!
! HISTORY:
!***********************************************************************
IMPLICIT NONE
!... Function arguments
REAL, DIMENSION(:), INTENT(IN) :: PLAI
!
REAL, DIMENSION(SIZE(PLAI)) :: PVEG_ADJ
!
!-----------------------------------------------------------------------------
PVEG_ADJ = (EXP(-0.24*PLAI)+EXP(-0.0525*PLAI))*0.5
!****************** FORMAT STATEMENTS ******************************
END FUNCTION VEG_ADJ
!=======================================================================
!=======================================================================
!=======================================================================
!=======================================================================
SUBROUTINE GROWSEASON(KDATE, PLAT, KDAY, KLEN)
!***********************************************************************
! DESCRIPTION
! This internal function computes the day of the growing season
! corresponding to the given date in yyyyddd format.
!
! CALL
! JULIAN
!
! HISTORY:
! 07/21/11 : Imported from SMOKE-BEIS v3.14 and modified (Tan)
! Variation of growing season depends on latitude
! (Guenther)
!***********************************************************************
IMPLICIT NONE
!....... Function arguments
INTEGER, INTENT(IN) :: KDATE
REAL, DIMENSION(:), INTENT(IN) :: PLAT
!
INTEGER, DIMENSION(:), INTENT(OUT) :: KDAY
INTEGER, DIMENSION(:), INTENT(OUT) :: KLEN
!....... Local parameters
INTEGER :: ISEASON_START
INTEGER :: ISEASON_END
!....... Local variables
INTEGER, DIMENSION(SIZE(PLAT)) :: ISJULIAN_START, ISJULIAN_END
INTEGER :: ISJULIAN_START0, ISJULIAN_START1, ISJULIAN_START2
INTEGER :: ISJULIAN_END1, ISJULIAN_END2
INTEGER :: IYEAR, IDAY, IDAY_ADD
!
!-----------------------------------------------------------------------------
IYEAR = INT(KDATE/1000.)
IDAY = KDATE - IYEAR*1000.
IF( IDAY.LT.1 .OR. IDAY.GT.366 ) THEN
WRITE(*,*) "MODE_SOILNOX: GROWSEASON: Invalid date specified"
STOP
ENDIF
ISJULIAN_START1 = G2J(IYEAR, 0101)
ISJULIAN_END1 = G2J(IYEAR, 0531)
ISJULIAN_START2 = G2J(IYEAR, 1101)
ISJULIAN_END2 = G2J(IYEAR, 1231)
IF ( IDAY.GE.1101 .AND. IDAY.LE.1231 ) THEN
ISJULIAN_START0 = ISJULIAN_START2
IDAY_ADD = 0
ELSE IF ( IDAY.GE.0101 .AND. IDAY.LE.0531 ) THEN
ISJULIAN_START0 = ISJULIAN_START1
IDAY_ADD = 61
ELSE
ISJULIAN_START0 = IDAY
IDAY_ADD = -1
ENDIF
WHERE ( PLAT(:).LT.-60. .OR. PLAT(:).GT.65. )
! antarctic start = 0 end = 0, no growing
KDAY(:) = 0
KLEN(:) = 0
ELSE WHERE ( PLAT(:).LE.23. .AND. PLAT(:).GE.-23. )
! tropical regions, year round
KDAY(:) = IDAY - ISJULIAN_START1 + 1
KLEN(:) = ISJULIAN_END2 - ISJULIAN_START1 + 1
ELSE WHERE ( PLAT(:).LT.-23. )
! southern hemisphere
KDAY(:) = IDAY - ISJULIAN_START0 + 1 + IDAY_ADD
KLEN(:) = 30 + 31 + ISJULIAN_END1 - ISJULIAN_START1 + 1
ELSE WHERE ( PLAT.GT.23. )
! northern hemisphere temperate
! start= (lat-23)*4.5 189
! end = 365 -((lat-23)*3.3) 226
ISJULIAN_START(:) = INT( (PLAT(:)-23.0)*4.5 )
ISJULIAN_END (:) = ISJULIAN_END2 - INT( (PLAT(:)-23.0)*3.3 )
WHERE ( IDAY.GE.ISJULIAN_START(:) .AND. IDAY.LE.ISJULIAN_END(:) )
KDAY(:) = IDAY - ISJULIAN_START(:) + 1
ELSE WHERE
KDAY(:) = 0
END WHERE
KLEN(:) = ISJULIAN_END(:) - ISJULIAN_START(:) + 1
END WHERE
!****************** FORMAT STATEMENTS ******************************
END SUBROUTINE GROWSEASON
!=======================================================================
!=======================================================================
!=======================================================================
!=======================================================================
FUNCTION G2J(KYYYY, KMMDD) RESULT(KG2J)
IMPLICIT NONE
!....... Function arguments
INTEGER, INTENT(IN) :: KYYYY
INTEGER, INTENT(IN) :: KMMDD
INTEGER :: KG2J
!....... Local parameters
INTEGER :: IMM
INTEGER :: IDD
IMM = INT(KMMDD/100.)
IDD = KMMDD - IMM*100
KG2J = JULIAN(KYYYY, IMM, IDD)
END FUNCTION G2J
!=======================================================================
!=======================================================================
END MODULE MODE_SOILNOX
src/LIB/MEGAN/soilnox.F90 deleted 100644 → 0
+ 0
− 172
View file @ 3233d927
SUBROUTINE SOILNOX(KDATE, KTIME, OSOIL, KSLTYP, PRECADJ, &
PLAT, PTA, PSOILM, PSOILT, PLAIC, PCFNO, PCFNOG )
!***********************************************************************
! DESCRIPTION:
!
! Uses new NO algorithm NO = Normalized*Tadj*Padj*Fadj*Cadj
! to estimate NO emissions
! Information needed to estimate NO emissions
! Julian Day (integer) JDATE
! Surface Temperature (MCIP field) TA (K)
! Soil Moisture (MCIP field) SOILM (M**3/M**3) (LSOIL)
! (ratio of volume of water per volume of soil)
! Soil Temperature (MCIP field) SOILT (K) (LSOIL)
! Soil Type (MCIP field) ISLTYP (LSOIL)
!
! saturation values for soil types (constants) (LSOIL)
! FOR PX Version, the Temperature adjustment factor accounts for wet and dry soils
! and the precipitation adjustment factor accounts for saturated soils
! FOR the non-PX version, the basic algorithm remains with a temperature adjustment factor (dry soil)
! and no adjustment for saturated soils
!
!
! The following arrays are updated after each call to SOILNOX
! PULTYPE type of NO emission pulse
! PULSEDATE julian date for the beginning of an NO pulse
! PULSETIME time for the beginning of an NO pulse
!
! The calculation are based on the following paper by J.J. Yienger and H. Levy II
! J.J. Yienger and H. Levy II, Journal of Geophysical Research, vol 100,11447-11464,1995
!
! The Temperature Adjustment Factor is based on section 4.2 for wet and dry soils with
! the following modification (PX version):
! Instead of classifying soils as either 'wet' or 'dry', the wet and dry adjustment is
! calculated at each grid cell. A linear interpolation between the wet and dry adjustment
! factor is made using the relative amount of soil moisture in the top layer (1cm)
! as the interpolating factor. The relative amount of soil moisture is determined by
! taking the MCIP soil moisture field and dividing by the saturation value defined for each
! soil type in the PX version of MCIP
! the soil temperature is used in PX version
!
! The Precipation Adjustment factor is based on section 4.1 with the following modifications.
! The rainrate is computed from the MCIP directly using a 24 hr daily total.
! THe types of Pulses as described in YL95 were used to estimate the NO emission
! rate.
!
! Also see the following paper for more information:
! Proceedings of the Air and Waste Management Association/U.S. Environmental Protection
! Agency EMission Inventory Conference, Raleigh October 26-28, 1999 Raleigh NC
! by Tom Pierce and Lucille Bender
!
! REFERENCES
!
! JACQUEMIN B. AND NOILHAN J. (1990), BOUND.-LAYER METEOROL., 52, 93-134.
! J.J. Yienger and H. Levy II, Journal of Geophysical Research, vol 100,11447-11464,1995
! T. Pierce and L. Bender, Examining the Temporal Variability of Ammonia and Nitric Oxide Emissions from Agricultural Processes
! Proceedings of the Air and Waste Management Association/U.S. Environmental Protection
! Agency EMission Inventory Conference, Raleigh October 26-28, 1999 Raleigh NC
!
! PRECONDITIONS REQUIRED:
! Normalized NO emissions, Surface Temperature, Soil Moisture, Soil type,
! NO emission pulse type, soil moisture from previous time step, julian date
! of NO emission pulse start, time of NO emission pulse start,
! soil type, SOIL TYPES, Land use data
!
! SUBROUTINES AND FUNCTIONS CALLED (directly or indirectly):
! FERTILIZER_ADJ computes fertlizer adjustment factor
! VEG_ADJ computes vegatation adjustment factor
! GROWSEASON computes day of growing season
!
! REVISION HISTORY:
! 10/01 : Prototype by GAP
! 10/03 : modified transition to non growing season for jul-oct of the year
! 08/04 : Converted to SMOKE code style by C. Seppanen
! 07/21/11 : Imported form SMOKE-BEIS v3.14 for MEGAN v2.10
!
!***********************************************************************
USE MODE_SOILNOX
USE MODD_MEGAN
IMPLICIT NONE
!......... ARGUMENTS and their descriptions
INTEGER, INTENT(IN) :: KDATE ! current simulation date (YYYYDDD)
INTEGER, INTENT(IN) :: KTIME ! current simulation time (HHMMSS)
LOGICAL, INTENT(IN) :: OSOIL ! true: using PX version of MCIP
!
INTEGER, DIMENSION(:), INTENT(IN) :: KSLTYP ! soil type
!
REAL, INTENT(IN) :: PRECADJ ! precip adjustment
!
REAL, DIMENSION(:), INTENT(IN) :: PLAT ! Latitude
REAL, DIMENSION(:), INTENT(IN) :: PTA ! air temperature (K)
REAL, DIMENSION(:), INTENT(IN) :: PSOILM ! soil moisture (m3/m3)
REAL, DIMENSION(:), INTENT(IN) :: PSOILT ! soil temperature (K)
REAL, DIMENSION(:), INTENT(IN) :: PLAIC ! soil temperature (K)
REAL, DIMENSION(:), INTENT(INOUT) :: PCFNO ! NO correction factor
REAL, DIMENSION(:), INTENT(INOUT) :: PCFNOG ! NO correction factor for grass
!....... Local ARRAYS
! Saturation values for 11 soil types from pxpbl.F (MCIP PX version)
! PLEIM-XIU LAND-SURFACE AND PBL MODEL (PX-LSM)
! See JACQUEMIN B. AND NOILHAN J. (1990), BOUND.-LAYER METEOROL., 52, 93-134.
!......... SCRATCH LOCAL VARIABLES and their descriptions:
REAL, DIMENSION(SIZE(PLAT)) :: ZCF ! NO correction factor
REAL :: ZTAIR ! surface temperature
REAL :: ZTSOI ! soil temperature
REAL :: ZCFNOWET, ZCFNODRY, ZRATIO
INTEGER :: JJ, JL ! counters
INTEGER :: ISOILCAT ! soil category
!HARACTER(256) MESG ! message buffer
!HARACTER(16) :: PROGNAME = 'SOILNOX' ! program name
!***********************************************************************
!..... Loop through cells
DO JJ = 1,SIZE(PTA)
ZTAIR = MIN(PTA(JJ),303.) ! unit in degree K
IF ( ZTAIR>268.8690 ) THEN
PCFNOG(JJ) = EXP( 0.04686 * ZTAIR - 14.30579 ) ! grass (from BEIS2)
ELSE
PCFNOG(JJ) = 0.0
END IF
!....... CFNO
IF( .NOT.OSOIL ) THEN
ZTSOI = 0.72 * ZTAIR + 82.28
ELSE
ZTSOI = PSOILT(JJ)
ENDIF
ZTSOI = MIN(MAX(ZTSOI,273.16),303.16)
ZCFNODRY = (1./3.) * (1./30.) * (ZTSOI-273.16) ! see YL 1995 Equa 9a p. 11452
IF ( ZTSOI<=283.16 ) THEN ! linear cold case
ZCFNOWET = (ZTSOI-273.16)*EXP(-0.103*30.0)*0.28 ! see YL 1995 Equ 7b
ELSE ! exponential case
ZCFNOWET = EXP(0.103 * (ZTSOI-273.16)) * EXP(-0.103 * 30.0)
END IF
IF( .NOT.OSOIL ) THEN
ZCF(JJ) = 0.5 * ZCFNOWET + 0.5 * ZCFNODRY
ELSE
! soil
ISOILCAT = KSLTYP(JJ)
IF( ISOILCAT>0 .AND. ISOILCAT<=NMAXSTYPES ) THEN
ZRATIO = PSOILM(JJ) / XSATURATION(ISOILCAT)
ZCF(JJ) = ZRATIO * ZCFNOWET + (1.-ZRATIO) * ZCFNODRY
ELSE
ZCF(JJ) = 0.
END IF
END IF ! Endif LSOIL
ENDDO
PCFNO(:) = ZCF(:) * FERTLZ_ADJ(KDATE,PLAT) * VEG_ADJ(PLAIC) * PRECADJ
!****************** FORMAT STATEMENTS ******************************
END SUBROUTINE SOILNOX
src/LIB/MEGAN/solarangle.F90 deleted 100644 → 0
+ 0
− 56
View file @ 3233d927
!-----------------------------------------------------------------------
! SUBROUTINE: SOLARANGLE
!
! DESCRIPTION: TO CALCULATE THE SOLAR ZENITH ANGLE. THIS WILL GIVE
! SIN(BETA), NOT THE BETA.
!
! CALL: NONE
!
! REQUIRE: NONE
!
! INPUT:
! 1) DAY OF YEAR
! 2) LATITUDE
! 3) HOUR
!
! OUTPUT: CALCBETA (SOLAR ZENITH ANGLE)
!
! CREATED BY TAN 11/15/06 (BASED ON XXXX'S PROGRAM)
!
!-----------------------------------------------------------------------
SUBROUTINE SOLARANGLE(KDAY, PSHOUR, PLAT, PSINBETA)
USE MODD_MEGAN
IMPLICIT NONE
! INPUT
INTEGER, DIMENSION(:), INTENT(IN) :: KDAY ! DOY OR JULIAN DAY
REAL, DIMENSION(:), INTENT(IN) :: PSHOUR ! SOLAR HOUR
REAL, DIMENSION(:), INTENT(IN) :: PLAT ! LATITUDE
! OUTPUT
REAL, DIMENSION(:), INTENT(OUT) :: PSINBETA
! LOCAL
!REAL :: ZBETA ! SOLAR ELEVATION ANGLE
REAL :: ZSINDELTA, ZCOSDELTA, ZA, ZB
! CONSTANTS
INTEGER :: JJ
! CALCULATION
DO JJ = 1,SIZE(KDAY)
ZSINDELTA = -SIN(0.40907) * COS( 6.28*(KDAY(JJ)+10.)/365. )
ZCOSDELTA = (1.-ZSINDELTA**2)**0.5
ZA = SIN( PLAT(JJ) / XRPI180 ) * ZSINDELTA
ZB = COS( PLAT(JJ) / XRPI180 ) * ZCOSDELTA
PSINBETA(JJ) = ZA + ZB * COS( 2 * XPI * (PSHOUR(JJ)-12.)/24. ) ! THIS WILL BE TRANSFERED
! TO GAMMA_P FUNCTION
!ZBETA = ASIN(PSINBETA(JJ)) * XRPI180 ! THIS IS NOT USED.
ENDDO
END SUBROUTINE SOLARANGLE
!-----------------------------------------------------------------------
src/LIB/megan.tar.gz deleted 100644 → 0 LFS
+ 0
− 3
View file @ 3233d927
File deleted
src/configure
+ 0
− 6
View file @ 901eefb8
...@@ -551,12 +551,6 @@ if [ "x${VER_OASIS}" == "xOASISAUTO" ] ; then ...@@ -551,12 +551,6 @@ if [ "x${VER_OASIS}" == "xOASISAUTO" ] ; then
( cd $LOCAL/src/LIB ; [ ! -d oasis3-${VERSION_OASIS} ] && tar xvfz oasis3-${VERSION_OASIS}.tar.gz ; [ ! -d toy_${VERSION_TOY} ] && tar xvfz toy_${VERSION_TOY}.tar.gz ) ( cd $LOCAL/src/LIB ; [ ! -d oasis3-${VERSION_OASIS} ] && tar xvfz oasis3-${VERSION_OASIS}.tar.gz ; [ ! -d toy_${VERSION_TOY} ] && tar xvfz toy_${VERSION_TOY}.tar.gz )
fi fi
# #
# Install MEGAN if MNH_MEGAN=1
#
if [ "x${MNH_MEGAN}" == "x1" ] ; then
( cd $LOCAL/src/LIB ; [ ! -d MEGAN ] && tar xvfz megan.tar.gz )
fi
#
# Install GRIBAPI or ecCodes # Install GRIBAPI or ecCodes
# #
if [ "x${MNH_GRIBAPI}" == "xyes" ] ; then if [ "x${MNH_GRIBAPI}" == "xyes" ] ; then
......
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment

Documentation | Mentions légales | CGU | Accessibilité : non conforme