diff --git a/src/LIB/MEGAN/emproc.F90 b/src/LIB/MEGAN/emproc.F90
index 508a9265c037e86dbc638f01da77eacdd8a2b3b9..7cb60b64fe78f2edf40e1ed4266b6fce9b213d96 100644
--- a/src/LIB/MEGAN/emproc.F90
+++ b/src/LIB/MEGAN/emproc.F90
@@ -1,5 +1,5 @@
-SUBROUTINE EMPROC(KTIME, KDATE, PPFD_D, PTEMP_D, PDI, PRECADJ, &
+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 )
@@ -67,7 +67,7 @@ SUBROUTINE EMPROC(KTIME, KDATE, PPFD_D, PTEMP_D, PDI, PRECADJ, &
!
! FINAL EQUATION
! EMISSION = [EF][GAMMA_LAI][GAMMA_AGE]*
-! { (1-LDF)[GAMMA_TLI] + [LDF][GAMMA_P][GAMMA_TLD] } !FOR MEGAN2.1
+! { (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
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -85,8 +85,8 @@ 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, INTENT(IN) :: PTEMP_D !I DAILY TEMPERATURE (K)
+!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
!
@@ -121,16 +121,17 @@ 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
+!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 ! COUNTERS
+INTEGER :: JT, JS, JI, JJ , JK, JN, INP, JL ! COUNTERS
INTEGER :: INMAP ! INDEX
INTEGER :: INVARS3D
@@ -144,6 +145,7 @@ INTEGER :: INVARS3D
!.....1) INITIALIZATION
!-----------------------------------------------------------------------
!
+
INVARS3D = N_MGN_SPC + 7
!
DO JS = 1,N_MGN_SPC
@@ -204,7 +206,7 @@ INP = SIZE(PLAT)
! 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 = PPFD_D
+!ZPFD_D = PPFD24
!PPFD = PPFD * 4.5
!UPG PT end bug
@@ -225,31 +227,34 @@ DO JS = 1, N_MGN_SPC
PCFNOG = 1.
CALL GAMMA_LAI(PLAIC, ZGAM_LHT)
+
+! IF (JS == 1) print*, "ZGAM_LHT", ZGAM_LHT
- CALL GAMMA_A(KDATE, KTIME, NTSTLEN, YVNAME3D(JS), PTEMP_D, PLAIP, PLAIC, ZGAM_AGE)
+ CALL GAMMA_A(KDATE, KTIME, NTSTLEN, YVNAME3D(JS), T24, PLAIP, PLAIC, ZGAM_AGE)
- CALL GAMMA_S(ZGAM_SMT)
+! 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
+ 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), &
- ZPFD_D, ZPFD_D, PTEMP_D, PTEMP_D, PDI, &
+ 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_LI(:) = ZADJUST_FACTOR_LI(:) + 0.01 * PFTF(I_PFT,:) * 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.)
@@ -259,22 +264,25 @@ DO JS = 1, N_MGN_SPC
ZGAM_TLD(:) = 1.
ZGAM_TLI(:) = 1.
END WHERE
-
- INMAP = INDEX1(YVNAME3D(JS), CMGN_SPC)
+
+ !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
- ENDWHERE
-
+ END WHERE
+
ENDDO
-
+
!... ESTIATE CFNO AND CFNOG
CALL SOILNOX(KDATE, KTIME, OSOIL, KSLTYP, PRECADJ, &
PLAT, PTEMP, PSOILM, PSOILT, PLAIC, PCFNO, PCFNOG )
diff --git a/src/LIB/MEGAN/mgn2mech.F90 b/src/LIB/MEGAN/mgn2mech.F90
index 9758d3c711f1ef97f5f01ddfa06df9c22f2bdf89..f6c19ec072edb64c51c7edee483edd230aa6d4aa 100644
--- a/src/LIB/MEGAN/mgn2mech.F90
+++ b/src/LIB/MEGAN/mgn2mech.F90
@@ -95,7 +95,7 @@ REAL, DIMENSION(:,:),INTENT(INOUT) :: PFLUX !IO EMISSION FLUX IN MOL/M2/S
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
+REAL, DIMENSION(SIZE(PLAT)) :: ZTMP1, ZTMP2, ZTMP3, ZTMP4
REAL :: ZTMO1, ZTMO2, ZTMO3
REAL :: Z2CRATIO
@@ -168,10 +168,18 @@ DO JS = 1, N_SMAP_SPC
!... 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.
+ !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
- ZTMPER(JMPSP,:) = PCFSPEC(JMPMG,:) * ZTMP3(:)
+ WHERE( ZTMP4(:).EQ.0. )
+ ZTMPER(JMPSP,:) = 0.
+ ELSEWHERE
+ ZTMPER(JMPSP,:) = PCFSPEC(JMPMG,:) * ZTMP3(:) / ZTMP4(:)
+ ENDWHERE
+
ENDIF
diff --git a/src/LIB/MEGAN/mode_gamma_etc.F90 b/src/LIB/MEGAN/mode_gamma_etc.F90
index 098c29df77b9adbd49a254a729978157ebe9afba..04a1b209106bbb8b2f8f99a5a2b731cc65fe9041 100644
--- a/src/LIB/MEGAN/mode_gamma_etc.F90
+++ b/src/LIB/MEGAN/mode_gamma_etc.F90
@@ -185,7 +185,7 @@ IMPLICIT NONE
! INPUT
INTEGER, INTENT(IN) :: KDATE, KTIME, KTSTLEN
CHARACTER(LEN=16), INTENT(IN) :: HSPC_NAME
-REAL, INTENT(IN) :: PTEMP_D
+REAL, DIMENSION(:), INTENT(IN) :: PTEMP_D
REAL, DIMENSION(:), INTENT(IN) :: PLAIARP, PLAIARC
! OUTPUT
REAL,DIMENSION(:),INTENT(OUT) :: PGAM_A
@@ -207,14 +207,15 @@ IAINDX = NREA_INDEX(ISPCNUM)
!
!---------------------------------------------------
! LOCAL PARAMETER ARRAYS
-IF ( PTEMP_D.LE.303. ) THEN
- ZTI = 5.0 + 0.7*(300.-PTEMP_D)
-ELSE
- ZTI = 2.9
-ENDIF
-ZTM = 2.3 * ZTI
-!
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
diff --git a/src/LIB/MEGAN/mode_megan.F90 b/src/LIB/MEGAN/mode_megan.F90
index b2a1ac5235872e412a7b3bd3bb3324d19feb331b..584fda604460f5e9520796307a6719c89100c482 100644
--- a/src/LIB/MEGAN/mode_megan.F90
+++ b/src/LIB/MEGAN/mode_megan.F90
@@ -95,7 +95,7 @@ CONTAINS
SUBROUTINE GAMME_CE(KDATE, KTIME, PCANOPYCHAR, KCANTYPE, HSPCNAME, &
PPFD24, PPFD240, PT24, PT240, PDI, &
PPFD0, PLAT, PLONG, PTC, PWIND, PHUMIDITY, &
- PLAI, PRES, PEA1CANOPY, PEATICANOPY )
+ PLAI, PRES, PEA1CANOPY, PEATICANOPY) !!
!
IMPLICIT NONE
! INPUT
@@ -103,8 +103,8 @@ INTEGER,INTENT(IN) :: KDATE, KTIME, KCANTYPE
REAL,DIMENSION(:,:),INTENT(IN) :: PCANOPYCHAR
CHARACTER(LEN=16), INTENT(IN) :: HSPCNAME
!
-REAL, INTENT(IN) :: PPFD24, PPFD240
-REAL, INTENT(IN) :: PT24, PT240, PDI
+REAL, DIMENSION(:), INTENT(IN) :: PT24, PT240, PPFD24, PPFD240
+REAL, INTENT(IN) :: PDI
!
REAL, DIMENSION(:), INTENT(IN) :: PPFD0
REAL, DIMENSION(:), INTENT(IN) :: PLONG, PLAT
@@ -119,7 +119,7 @@ REAL, DIMENSION(NLAYERS) :: ZVPGAUSWT, ZVPGAUSDIS2, ZVPGAUSDIS
REAL, DIMENSION(SIZE(PLONG),NLAYERS) :: ZEA1LAYER, ZEATILAYER, ZVPSLWWT
REAL, DIMENSION(SIZE(PLONG),NLAYERS) :: ZSUNFRAC, ZSUNQV, ZSHADEQV, ZSUNQN, ZSHADEQN, &
ZSUNPPFD, ZSHADEPPFD, ZSUNLEAFTK, ZSHADELEAFTK, &
- ZSUNLEAFSH, ZSHADELEAFSH
+ ZSUNLEAFSH, ZSHADELEAFSH, Z_PPFD, Z_ALPHAP
!
REAL, DIMENSION(SIZE(PLONG)) :: ZHOUR, ZSINBETA, ZSOLAR, &
ZMAXSOLAR, ZQDIFFV, ZQBEAMV, ZQDIFFN, ZQBEAMN, &
@@ -146,6 +146,7 @@ ELSEWHERE ( ZHOUR.GT.24. )
END WHERE
!
CALL SOLARANGLE(IDAY, ZHOUR, PLAT, ZSINBETA)
+
!
ZSOLAR (:) = PPFD0(:)/2.25
ZMAXSOLAR(:) = ZSINBETA(:) * XSOLARCONSTANT * CALCECCENTRICITY(IDAY(:))
@@ -184,7 +185,7 @@ DO JI = 1,SIZE(ZEA1LAYER,2)
! PSTD = 50 FOR SHADE LEAVES
!ZEA1PLAYER(:,JI) = EA1P99(ZSUNPPFD(:,JI), PPFD24*0.5, PPFD240*0.5, XPSTD_SUN) * ZSUNFRAC(:,JI) + &
! EA1P99(ZSHADEPPFD(:,JI), PPFD24*0.16, PPFD240*0.16, XPSTD_SHADE) * (1.-ZSUNFRAC(:,JI))
-
+
ZEA1LAYER(:,JI) = EA1T99(HSPCNAME , PT24 , PT240 , ZSUNLEAFTK (:,JI)) * &
EA1P99(XPSTD_SUN , PPFD24*0.5 , PPFD240*0.5 , ZSUNPPFD (:,JI)) * ZSUNFRAC(:,JI) + &
EA1T99(HSPCNAME , PT24 , PT240 , ZSHADELEAFTK(:,JI)) * &
@@ -193,6 +194,14 @@ DO JI = 1,SIZE(ZEA1LAYER,2)
ZEATILAYER(:,JI) = EALTI99(HSPCNAME, ZSUNLEAFTK (:,JI)) * ZSUNFRAC(:,JI) + &
EALTI99(HSPCNAME, ZSHADELEAFTK(:,JI)) * (1-ZSUNFRAC(:,JI))
+ Z_PPFD(:,JI) = ZSUNPPFD(:,JI) * ZSUNFRAC(:,JI) + ZSHADEPPFD(:,JI) * (1.-ZSUNFRAC(:,JI))
+
+ Z_ALPHAP(:,JI) = EA1P99(XPSTD_SUN , PPFD24*0.5 , PPFD240*0.5 , ZSUNPPFD (:,JI)) * ZSUNFRAC(:,JI) + &
+ EA1P99(XPSTD_SHADE, PPFD24*0.16, PPFD240*0.16, ZSHADEPPFD (:,JI) ) * (1.-ZSUNFRAC(:,JI)) !!
+ ! IF (KCANTYPE == 15) THEN
+ ! PRINT*, JI, ZSUNPPFD(:,JI)
+ !ENDIF
+
ENDDO
CALL WEIGHTSLW(ZVPGAUSDIS, PLAI, ZVPSLWWT)
@@ -207,8 +216,10 @@ DO JJ = 1,SIZE(PEA1CANOPY)
! ZSHADELEAFSH(JJ,:) * (1 - ZSUNFRAC(:,JJ))) * PLAI(:) * ZVPGAUSWT(:) )
ENDDO
+
PEA1CANOPY(:) = PEA1CANOPY(:) * XCCE * PLAI(:)
+
END SUBROUTINE GAMME_CE
!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
@@ -362,7 +373,7 @@ DO JJ = 1,SIZE(PSOLAR)
IF (ZPPFDDIFFRAC > 1.0) ZPPFDDIFFRAC = 1.0
ZQV = ZPPFDFRAC * PSOLAR(JJ)
- PQDIFFV(JJ) = ZQV * ZPPFDDIFFRAC
+ PQDIFFV(JJ) = ZQV * ZPPFDDIFFRAC
PQBEAMV(JJ) = ZQV - PQDIFFV(JJ)
ZQN = PSOLAR(JJ) - ZQV
PQDIFFN(JJ) = ZQN * ZFRACDIFF
@@ -438,12 +449,14 @@ DO JI = 1,NLAYERS
!FRACTION OF LEAVES THAT ARE SUNLIT
PSUNFRAC(:,JI) = EXP(-ZKB(:) * ZLAIDEPTH(:))
- CALL CALCRADCOMPONENTS(ZSCATV, ZREFLDV, PQDIFFV, PQBEAMV, ZKDPV, ZKBPV, ZKB, &
+
+ CALL CALCRADCOMPONENTS(ZSCATV, ZREFLDV, PQDIFFV, PQBEAMV, ZKDPV, ZKBPV, ZKB, &
ZREFLBV, ZLAIDEPTH, ZQDABSVL, ZQSABSVL)
CALL CALCRADCOMPONENTS(ZSCATN, ZREFLDN, PQDIFFN, PQBEAMN, ZKDPN, ZKBPN, ZKB, &
ZREFLBN, ZLAIDEPTH, ZQDABSNL, ZQSABSNL)
+
PSHADEPPFD(:,JI) = (ZQDABSVL(:) + ZQSABSVL(:)) * XCONVERTSHADEPPFD / (1. - ZSCATV)
PSUNPPFD (:,JI) = PSHADEPPFD(:,JI) + (ZQBABSV(:) * XCONVERTSUNPPFD / (1. - ZSCATV))
PSHADEQV (:,JI) = ZQDABSVL(:) + ZQSABSVL(:)
@@ -454,13 +467,15 @@ DO JI = 1,NLAYERS
IF (PRESENT(PQSABSV)) PQSABSV (:,JI) = ZQSABSVL(:)
IF (PRESENT(PQDABSN)) PQDABSN (:,JI) = ZQDABSNL(:)
IF (PRESENT(PQSABSN)) PQSABSN (:,JI) = ZQSABSNL(:)
+!
ENDDO
+
DO JJ = 1,SIZE(PQBEAMV)
IF ( (PQBEAMV(JJ)+PQDIFFV(JJ))<=0.001 .OR. PSINBETA(JJ)<=0.00002 .OR. PLAI(JJ)<=0.001 ) THEN
- ! DAYTIME
+ ! NIGHT TIME
ZQBABSV(JJ) = 0.
ZQBABSN(JJ) = 0.
@@ -527,7 +542,7 @@ END SUBROUTINE CALCEXTCOEFF
!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
SUBROUTINE CALCRADCOMPONENTS(PSCAT, PREFLD, PQDIFF, PQBEAM, PKDP, PKBP, PKB, &
- PREFLB, PLAIDEPTH, PQDABS, PQSABS)
+ PREFLB, PLAIDEPTH, PQDABS, PQSABS)
IMPLICIT NONE
@@ -537,6 +552,7 @@ REAL, DIMENSION(:), INTENT(OUT) :: PQDABS, PQSABS
!-------------------------------------------------------------------
PQDABS(:) = PQDIFF(:) * PKDP(:) * (1. - PREFLD) * EXP(-PKDP(:) * PLAIDEPTH(:))
+
PQSABS(:) = PQBEAM(:) * ((PKBP(:) * (1. - PREFLB(:)) * EXP(-PKBP(:) * PLAIDEPTH(:))) &
- (PKB(:) * (1. - PSCAT) * EXP(-PKB (:) * PLAIDEPTH(:))))
@@ -1123,8 +1139,7 @@ USE MODI_INDEX1
IMPLICIT NONE
CHARACTER(LEN=16),INTENT(IN) :: HSPC_NAME
-REAL, INTENT(IN) :: PT24, PT240
-REAL, DIMENSION(:), INTENT(IN) :: PT1
+REAL, DIMENSION(:), INTENT(IN) :: PT1, PT24, PT240
REAL, DIMENSION(SIZE(PT1)) :: PEA1T99
REAL :: ZTOPT, ZX, ZEOPT
INTEGER :: ISPCNUM
@@ -1134,17 +1149,17 @@ INTEGER :: JJ
ISPCNUM = INDEX1(HSPC_NAME, CMGN_SPC)
!
DO JJ = 1,SIZE(PT1)
-
IF ( PT1(JJ)<260. ) THEN
PEA1T99(JJ) = 0.
ELSE
! ENERGY OF ACTIVATION AND DEACTIVATION
! TEMPERATURE AT WHICH MAXIMUM EMISSION OCCURS
- ZTOPT = 312.5 + 0.6 * (PT240 - 297)
+ ZTOPT = 312.5 + 0.6 * (PT240(JJ) - 297)
ZX = ((1 / ZTOPT) - (1 / PT1(JJ))) / 0.00831
! MAXIMUM EMISSION (RELATIVE TO EMISSION AT 30 C)
- ZEOPT = XCLEO(ISPCNUM) * EXP(0.05 * (PT24 - 297)) * EXP(0.05*(PT240-297))
+ ZEOPT = XCLEO(ISPCNUM) * EXP(0.05 * (PT24(JJ) - 297)) * EXP(0.05*(PT240(JJ)-297))
+
PEA1T99(JJ) = ZEOPT * XCTM2 * EXP(XCTM1(ISPCNUM)*ZX) / &
(XCTM2 - XCTM1(ISPCNUM) * (1.-EXP(XCTM2*ZX)))
ENDIF
@@ -1165,8 +1180,8 @@ FUNCTION EA1P99(PSTD, PPFD24, PPFD240, PPFD1) RESULT(PEA1P99)
IMPLICIT NONE
-REAL, INTENT(IN) :: PSTD, PPFD24, PPFD240
-REAL, DIMENSION(:), INTENT(IN) :: PPFD1
+REAL, INTENT(IN) :: PSTD
+REAL, DIMENSION(:), INTENT(IN) :: PPFD1, PPFD24, PPFD240
REAL, DIMENSION(SIZE(PPFD1)) :: PEA1P99
REAL :: ZALPHA, ZC1
INTEGER :: JJ
@@ -1174,11 +1189,11 @@ INTEGER :: JJ
DO JJ = 1,SIZE(PPFD1)
- IF ( PPFD240<0.01 ) THEN
+ IF ( PPFD240(JJ)<0.01 ) THEN
PEA1P99(JJ) = 0.
ELSE
- ZALPHA = 0.004 - 0.0005 * LOG(PPFD240)
- ZC1 = 0.0468 * EXP(0.0005 * (PPFD24 - PSTD)) * (PPFD240**0.6)
+ ZALPHA = 0.004 - 0.0005 * LOG(PPFD240(JJ))
+ ZC1 = 0.0468 * EXP(0.0005 * (PPFD24(JJ) - PSTD)) * (PPFD240(JJ)**0.6)
PEA1P99(JJ) = (ZALPHA * ZC1 * PPFD1(JJ)) / ((1 + ZALPHA**2. * PPFD1(JJ)**2.)**0.5)
ENDIF