Changeset 5144 for LMDZ6/branches/Amaury_dev/libf/phylmd/methox.F90
- Timestamp:
- Jul 29, 2024, 11:01:04 PM (3 months ago)
- File:
-
- 1 edited
-
LMDZ6/branches/Amaury_dev/libf/phylmd/methox.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/Amaury_dev/libf/phylmd/methox.F90
r5101 r5144 1 SUBROUTINE METHOX(KIDIA, KFDIA, KLON, KLEV,PQ, PTENQ, PAP)1 SUBROUTINE METHOX(KIDIA, KFDIA, KLON, KLEV, PQ, PTENQ, PAP) 2 2 3 !**** *METHOX* - Calculate humidity tendencies from methane4 ! oxidation and photolysis3 !**** *METHOX* - Calculate humidity tendencies from methane 4 ! oxidation and photolysis 5 5 6 !** INTERFACE.7 ! ----------8 ! CALL *METHOX* FROM *CALLPAR*9 ! ------ -------6 !** INTERFACE. 7 ! ---------- 8 ! CALL *METHOX* FROM *CALLPAR* 9 ! ------ ------- 10 10 11 ! EXPLICIT ARGUMENTS :12 ! --------------------13 ! PARAMETER DESCRIPTION UNITS14 ! --------- ----------- -----15 ! INPUT PARAMETERS (INTEGER):11 ! EXPLICIT ARGUMENTS : 12 ! -------------------- 13 ! PARAMETER DESCRIPTION UNITS 14 ! --------- ----------- ----- 15 ! INPUT PARAMETERS (INTEGER): 16 16 17 ! *KIDIA* START POINT18 ! *KFDIA* END POINT19 ! *KLON* NUMBER OF GRID POINTS PER PACKET20 ! *KLEV* NUMBER OF LEVELS17 ! *KIDIA* START POINT 18 ! *KFDIA* END POINT 19 ! *KLON* NUMBER OF GRID POINTS PER PACKET 20 ! *KLEV* NUMBER OF LEVELS 21 21 22 ! INPUT PARAMETERS (REAL):22 ! INPUT PARAMETERS (REAL): 23 23 24 ! *PAP* PRESSURE PA25 ! *PQ* SPECIFIC HUMIDITY KG/KG24 ! *PAP* PRESSURE PA 25 ! *PQ* SPECIFIC HUMIDITY KG/KG 26 26 27 ! UPDATED PARAMETERS (REAL):27 ! UPDATED PARAMETERS (REAL): 28 28 29 ! *PTENQ* TENDENCY OF SPECIFIC HUMIDITY KG/(KG*S)29 ! *PTENQ* TENDENCY OF SPECIFIC HUMIDITY KG/(KG*S) 30 30 31 ! NONE31 ! NONE 32 32 33 ! IMPLICIT ARGUMENTS :34 ! --------------------35 ! MODULE YOEMETH36 ! MODULE YOMCST33 ! IMPLICIT ARGUMENTS : 34 ! -------------------- 35 ! MODULE YOEMETH 36 ! MODULE YOMCST 37 37 38 ! METHOD.39 ! -------40 ! SEE RD-MEMO R60.1/AJS/3138 ! METHOD. 39 ! ------- 40 ! SEE RD-MEMO R60.1/AJS/31 41 41 42 ! EXTERNALS.43 ! ----------44 ! NONE42 ! EXTERNALS. 43 ! ---------- 44 ! NONE 45 45 46 ! REFERENCE.47 ! ----------48 ! SEE RD-MEMO R60.1/AJS/3146 ! REFERENCE. 47 ! ---------- 48 ! SEE RD-MEMO R60.1/AJS/31 49 49 50 ! AUTHOR.51 ! -------52 ! C.JAKOB *ECMWF*50 ! AUTHOR. 51 ! ------- 52 ! C.JAKOB *ECMWF* 53 53 54 ! MODIFICATIONS.55 ! --------------56 ! ORIGINAL : 98-04-0757 ! M.Hamrud 01-Oct-2003 CY28 Cleaning58 ! D. Cugnet 24-Feb-2012 Adapted for LMDZ59 ! ------------------------------------------------------------------54 ! MODIFICATIONS. 55 ! -------------- 56 ! ORIGINAL : 98-04-07 57 ! M.Hamrud 01-Oct-2003 CY28 Cleaning 58 ! D. Cugnet 24-Feb-2012 Adapted for LMDZ 59 ! ------------------------------------------------------------------ 60 60 61 USE YOEMETH , ONLY: RALPHA1 ,RALPHA2 ,RQLIM ,& 62 RPBOTOX, RPBOTPH ,RPTOPOX ,RPTOPPH ,& 63 RALPHA3, RLOGPPH 61 USE YOEMETH, ONLY: RALPHA1, RALPHA2, RQLIM, & 62 RPBOTOX, RPBOTPH, RPTOPOX, RPTOPPH, & 63 RALPHA3, RLOGPPH 64 USE lmdz_yomcst 64 65 65 IMPLICIT NONE66 IMPLICIT NONE 66 67 67 INCLUDE "YOMCST.h" 68 INTEGER, INTENT(IN) :: KLON 69 INTEGER, INTENT(IN) :: KLEV 70 INTEGER, INTENT(IN) :: KIDIA 71 INTEGER, INTENT(IN) :: KFDIA 72 REAL, INTENT(IN) :: PQ(KLON, KLEV) 73 REAL, INTENT(INOUT) :: PTENQ(KLON, KLEV) 74 REAL, INTENT(IN) :: PAP(KLON, KLEV) 75 LOGICAL :: LLOXID, LLPHOTO 68 76 69 INTEGER,INTENT(IN) :: KLON 70 INTEGER,INTENT(IN) :: KLEV 71 INTEGER,INTENT(IN) :: KIDIA 72 INTEGER,INTENT(IN) :: KFDIA 73 REAL ,INTENT(IN) :: PQ(KLON,KLEV) 74 REAL ,INTENT(INOUT) :: PTENQ(KLON,KLEV) 75 REAL ,INTENT(IN) :: PAP(KLON,KLEV) 76 LOGICAL :: LLOXID, LLPHOTO 77 INTEGER :: JK, JL 77 78 78 INTEGER :: JK, JL 79 REAL :: ZARG, ZPRATIO, ZTAU1, ZTAU2, ZTDAYS 79 80 80 REAL :: ZARG, ZPRATIO, ZTAU1, ZTAU2, ZTDAYS 81 DO JK = 1, KLEV 82 DO JL = KIDIA, KFDIA 81 83 82 DO JK=1,KLEV 83 DO JL=KIDIA,KFDIA84 LLOXID = PAP(JL, JK) < RPBOTOX.AND.PQ(JL, JK) < RQLIM 85 LLPHOTO = PAP(JL, JK) < RPBOTPH 84 86 85 LLOXID=PAP(JL,JK) < RPBOTOX.AND.PQ(JL,JK) < RQLIM 86 LLPHOTO=PAP(JL,JK) < RPBOTPH 87 ! METHANE OXIDATION 87 88 88 ! METHANE OXIDATION 89 IF(LLOXID) THEN 90 IF(PAP(JL, JK) <= RPTOPOX) THEN 91 ZTDAYS = 100. 92 ELSE 93 ZPRATIO = (LOG(PAP(JL, JK) / RPTOPOX))**4. / LOG(RPBOTOX / PAP(JL, JK)) 94 ZTDAYS = 100. * (1 + RALPHA1 * ZPRATIO) 95 ENDIF 96 ZTAU1 = 86400. * ZTDAYS 97 PTENQ(JL, JK) = PTENQ(JL, JK) + (RQLIM - PQ(JL, JK)) / ZTAU1 98 ENDIF 89 99 90 IF(LLOXID) THEN 91 IF(PAP(JL,JK) <= RPTOPOX) THEN 92 ZTDAYS=100. 93 ELSE 94 ZPRATIO=(LOG(PAP(JL,JK)/RPTOPOX))**4./LOG(RPBOTOX/PAP(JL,JK)) 95 ZTDAYS=100.*(1+RALPHA1*ZPRATIO) 100 ! PHOTOLYSIS 101 102 IF(LLPHOTO) THEN 103 IF(PAP(JL, JK) <= RPTOPPH) THEN 104 ZTDAYS = 3. 105 ELSE 106 ZARG = RALPHA2 - RALPHA3 * (1 + COS((RPI * LOG(PAP(JL, JK) / RPBOTPH)) / RLOGPPH)) 107 ZTDAYS = 1.0 / (EXP(ZARG) - 0.01) 108 ENDIF 109 ZTAU2 = 86400. * ZTDAYS 110 PTENQ(JL, JK) = PTENQ(JL, JK) - PQ(JL, JK) / ZTAU2 96 111 ENDIF 97 ZTAU1=86400.*ZTDAYS 98 PTENQ(JL,JK)=PTENQ(JL,JK)+(RQLIM-PQ(JL,JK))/ZTAU1 99 ENDIF 100 101 ! PHOTOLYSIS 102 103 IF(LLPHOTO) THEN 104 IF(PAP(JL,JK) <= RPTOPPH) THEN 105 ZTDAYS=3. 106 ELSE 107 ZARG=RALPHA2-RALPHA3*(1+COS((RPI*LOG(PAP(JL,JK)/RPBOTPH))/RLOGPPH)) 108 ZTDAYS=1.0/(EXP(ZARG)-0.01) 109 ENDIF 110 ZTAU2=86400.*ZTDAYS 111 PTENQ(JL,JK)=PTENQ(JL,JK)-PQ(JL,JK)/ZTAU2 112 ENDIF 112 ENDDO 113 113 ENDDO 114 ENDDO115 114 116 115 END SUBROUTINE METHOX
Note: See TracChangeset
for help on using the changeset viewer.
