--- trunk/phylmd/Radlwsw/lwtt.f 2013/11/15 18:45:49 76 +++ trunk/phylmd/Radlwsw/lwtt.f90 2014/03/05 14:38:41 81 @@ -1,175 +1,173 @@ - SUBROUTINE LWTT(PGA,PGB,PUU, PTT) - use dimens_m - use dimphy - use raddim - use raddimlw - IMPLICIT none -C -C----------------------------------------------------------------------- -C PURPOSE. -C -------- -C THIS ROUTINE COMPUTES THE TRANSMISSION FUNCTIONS FOR ALL THE -C ABSORBERS (H2O, UNIFORMLY MIXED GASES, AND O3) IN ALL SIX SPECTRAL -C INTERVALS. -C -C METHOD. -C ------- -C -C 1. TRANSMISSION FUNCTION BY H2O AND UNIFORMLY MIXED GASES ARE -C COMPUTED USING PADE APPROXIMANTS AND HORNER'S ALGORITHM. -C 2. TRANSMISSION BY O3 IS EVALUATED WITH MALKMUS'S BAND MODEL. -C 3. TRANSMISSION BY H2O CONTINUUM AND AEROSOLS FOLLOW AN -C A SIMPLE EXPONENTIAL DECREASE WITH ABSORBER AMOUNT. -C -C REFERENCE. -C ---------- -C -C SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND -C ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS -C -C AUTHOR. -C ------- -C JEAN-JACQUES MORCRETTE *ECMWF* -C -C MODIFICATIONS. -C -------------- -C ORIGINAL : 88-12-15 -C -C----------------------------------------------------------------------- - DOUBLE PRECISION O1H, O2H - PARAMETER (O1H=2230.) - PARAMETER (O2H=100.) - DOUBLE PRECISION RPIALF0 - PARAMETER (RPIALF0=2.0) -C -C* ARGUMENTS: -C - DOUBLE PRECISION PUU(KDLON,NUA) - DOUBLE PRECISION PTT(KDLON,NTRA) - DOUBLE PRECISION PGA(KDLON,8,2) - DOUBLE PRECISION PGB(KDLON,8,2) -C -C* LOCAL VARIABLES: -C - DOUBLE PRECISION zz, zxd, zxn - DOUBLE PRECISION zpu, zpu10, zpu11, zpu12, zpu13 - DOUBLE PRECISION zeu, zeu10, zeu11, zeu12, zeu13 - DOUBLE PRECISION zx, zy, zsq1, zsq2, zvxy, zuxy - DOUBLE PRECISION zaercn, zto1, zto2, zxch4, zych4, zxn2o, zyn2o - DOUBLE PRECISION zsqn21, zodn21, zsqh42, zodh42 - DOUBLE PRECISION zsqh41, zodh41, zsqn22, zodn22, zttf11, zttf12 - DOUBLE PRECISION zuu11, zuu12, za11, za12 - INTEGER jl, ja -C ------------------------------------------------------------------ -C -C* 1. HORNER'S ALGORITHM FOR H2O AND CO2 TRANSMISSION -C ----------------------------------------------- -C - 100 CONTINUE -C -C - DO 130 JA = 1 , 8 - DO 120 JL = 1, KDLON - ZZ =SQRT(PUU(JL,JA)) -c ZXD(JL,1)=PGB( JL, 1,1) + ZZ(JL, 1)*(PGB( JL, 1,2) + ZZ(JL, 1)) -c ZXN(JL,1)=PGA( JL, 1,1) + ZZ(JL, 1)*(PGA( JL, 1,2) ) -c PTT(JL,1)=ZXN(JL,1)/ZXD(JL,1) - ZXD =PGB( JL,JA,1) + ZZ *(PGB( JL,JA,2) + ZZ ) - ZXN =PGA( JL,JA,1) + ZZ *(PGA( JL,JA,2) ) - PTT(JL,JA)=ZXN /ZXD - 120 CONTINUE - 130 CONTINUE -C -C ------------------------------------------------------------------ -C -C* 2. CONTINUUM, OZONE AND AEROSOL TRANSMISSION FUNCTIONS -C --------------------------------------------------- -C - 200 CONTINUE -C - DO 201 JL = 1, KDLON - PTT(JL, 9) = PTT(JL, 8) -C -C- CONTINUUM ABSORPTION: E- AND P-TYPE -C - ZPU = 0.002 * PUU(JL,10) - ZPU10 = 112. * ZPU - ZPU11 = 6.25 * ZPU - ZPU12 = 5.00 * ZPU - ZPU13 = 80.0 * ZPU - ZEU = PUU(JL,11) - ZEU10 = 12. * ZEU - ZEU11 = 6.25 * ZEU - ZEU12 = 5.00 * ZEU - ZEU13 = 80.0 * ZEU -C -C- OZONE ABSORPTION -C - ZX = PUU(JL,12) - ZY = PUU(JL,13) - ZUXY = 4. * ZX * ZX / (RPIALF0 * ZY) - ZSQ1 = SQRT(1. + O1H * ZUXY ) - 1. - ZSQ2 = SQRT(1. + O2H * ZUXY ) - 1. - ZVXY = RPIALF0 * ZY / (2. * ZX) - ZAERCN = PUU(JL,17) + ZEU12 + ZPU12 - ZTO1 = EXP( - ZVXY * ZSQ1 - ZAERCN ) - ZTO2 = EXP( - ZVXY * ZSQ2 - ZAERCN ) -C -C-- TRACE GASES (CH4, N2O, CFC-11, CFC-12) -C -C* CH4 IN INTERVAL 800-970 + 1110-1250 CM-1 -C -c NEXOTIC=1 -c IF (NEXOTIC.EQ.1) THEN - ZXCH4 = PUU(JL,19) - ZYCH4 = PUU(JL,20) - ZUXY = 4. * ZXCH4*ZXCH4/(0.103*ZYCH4) - ZSQH41 = SQRT(1. + 33.7 * ZUXY) - 1. - ZVXY = 0.103 * ZYCH4 / (2. * ZXCH4) - ZODH41 = ZVXY * ZSQH41 -C -C* N2O IN INTERVAL 800-970 + 1110-1250 CM-1 -C - ZXN2O = PUU(JL,21) - ZYN2O = PUU(JL,22) - ZUXY = 4. * ZXN2O*ZXN2O/(0.416*ZYN2O) - ZSQN21 = SQRT(1. + 21.3 * ZUXY) - 1. - ZVXY = 0.416 * ZYN2O / (2. * ZXN2O) - ZODN21 = ZVXY * ZSQN21 -C -C* CH4 IN INTERVAL 1250-1450 + 1880-2820 CM-1 -C - ZUXY = 4. * ZXCH4*ZXCH4/(0.113*ZYCH4) - ZSQH42 = SQRT(1. + 400. * ZUXY) - 1. - ZVXY = 0.113 * ZYCH4 / (2. * ZXCH4) - ZODH42 = ZVXY * ZSQH42 -C -C* N2O IN INTERVAL 1250-1450 + 1880-2820 CM-1 -C - ZUXY = 4. * ZXN2O*ZXN2O/(0.197*ZYN2O) - ZSQN22 = SQRT(1. + 2000. * ZUXY) - 1. - ZVXY = 0.197 * ZYN2O / (2. * ZXN2O) - ZODN22 = ZVXY * ZSQN22 -C -C* CFC-11 IN INTERVAL 800-970 + 1110-1250 CM-1 -C - ZA11 = 2. * PUU(JL,23) * 4.404E+05 - ZTTF11 = 1. - ZA11 * 0.003225 -C -C* CFC-12 IN INTERVAL 800-970 + 1110-1250 CM-1 -C - ZA12 = 2. * PUU(JL,24) * 6.7435E+05 - ZTTF12 = 1. - ZA12 * 0.003225 -C - ZUU11 = - PUU(JL,15) - ZEU10 - ZPU10 - ZUU12 = - PUU(JL,16) - ZEU11 - ZPU11 - ZODH41 - ZODN21 - PTT(JL,10) = EXP( - PUU(JL,14) ) - PTT(JL,11) = EXP( ZUU11 ) - PTT(JL,12) = EXP( ZUU12 ) * ZTTF11 * ZTTF12 - PTT(JL,13) = 0.7554 * ZTO1 + 0.2446 * ZTO2 - PTT(JL,14) = PTT(JL,10) * EXP( - ZEU13 - ZPU13 ) - PTT(JL,15) = EXP ( - PUU(JL,14) - ZODH42 - ZODN22 ) - 201 CONTINUE -C - RETURN - END +SUBROUTINE lwtt(pga, pgb, puu, ptt) + USE dimens_m + USE dimphy + USE raddim + USE raddimlw + IMPLICIT NONE + + ! ----------------------------------------------------------------------- + ! PURPOSE. + ! -------- + ! THIS ROUTINE COMPUTES THE TRANSMISSION FUNCTIONS FOR ALL THE + ! ABSORBERS (H2O, UNIFORMLY MIXED GASES, AND O3) IN ALL SIX SPECTRAL + ! INTERVALS. + + ! METHOD. + ! ------- + + ! 1. TRANSMISSION FUNCTION BY H2O AND UNIFORMLY MIXED GASES ARE + ! COMPUTED USING PADE APPROXIMANTS AND HORNER'S ALGORITHM. + ! 2. TRANSMISSION BY O3 IS EVALUATED WITH MALKMUS'S BAND MODEL. + ! 3. TRANSMISSION BY H2O CONTINUUM AND AEROSOLS FOLLOW AN + ! A SIMPLE EXPONENTIAL DECREASE WITH ABSORBER AMOUNT. + + ! REFERENCE. + ! ---------- + + ! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND + ! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS + + ! AUTHOR. + ! ------- + ! JEAN-JACQUES MORCRETTE *ECMWF* + + ! MODIFICATIONS. + ! -------------- + ! ORIGINAL : 88-12-15 + + ! ----------------------------------------------------------------------- + DOUBLE PRECISION o1h, o2h + PARAMETER (o1h=2230.) + PARAMETER (o2h=100.) + DOUBLE PRECISION rpialf0 + PARAMETER (rpialf0=2.0) + + ! * ARGUMENTS: + + DOUBLE PRECISION puu(kdlon, nua) + DOUBLE PRECISION ptt(kdlon, ntra) + DOUBLE PRECISION pga(kdlon, 8, 2) + DOUBLE PRECISION pgb(kdlon, 8, 2) + + ! * LOCAL VARIABLES: + + DOUBLE PRECISION zz, zxd, zxn + DOUBLE PRECISION zpu, zpu10, zpu11, zpu12, zpu13 + DOUBLE PRECISION zeu, zeu10, zeu11, zeu12, zeu13 + DOUBLE PRECISION zx, zy, zsq1, zsq2, zvxy, zuxy + DOUBLE PRECISION zaercn, zto1, zto2, zxch4, zych4, zxn2o, zyn2o + DOUBLE PRECISION zsqn21, zodn21, zsqh42, zodh42 + DOUBLE PRECISION zsqh41, zodh41, zsqn22, zodn22, zttf11, zttf12 + DOUBLE PRECISION zuu11, zuu12, za11, za12 + INTEGER jl, ja + ! ------------------------------------------------------------------ + + ! * 1. HORNER'S ALGORITHM FOR H2O AND CO2 TRANSMISSION + ! ----------------------------------------------- + + + + DO ja = 1, 8 + DO jl = 1, kdlon + zz = sqrt(puu(jl,ja)) + ! ZXD(JL,1)=PGB( JL, 1,1) + ZZ(JL, 1)*(PGB( JL, 1,2) + ZZ(JL, 1)) + ! ZXN(JL,1)=PGA( JL, 1,1) + ZZ(JL, 1)*(PGA( JL, 1,2) ) + ! PTT(JL,1)=ZXN(JL,1)/ZXD(JL,1) + zxd = pgb(jl, ja, 1) + zz*(pgb(jl,ja,2)+zz) + zxn = pga(jl, ja, 1) + zz*(pga(jl,ja,2)) + ptt(jl, ja) = zxn/zxd + END DO + END DO + + ! ------------------------------------------------------------------ + + ! * 2. CONTINUUM, OZONE AND AEROSOL TRANSMISSION FUNCTIONS + ! --------------------------------------------------- + + + DO jl = 1, kdlon + ptt(jl, 9) = ptt(jl, 8) + + ! - CONTINUUM ABSORPTION: E- AND P-TYPE + + zpu = 0.002*puu(jl, 10) + zpu10 = 112.*zpu + zpu11 = 6.25*zpu + zpu12 = 5.00*zpu + zpu13 = 80.0*zpu + zeu = puu(jl, 11) + zeu10 = 12.*zeu + zeu11 = 6.25*zeu + zeu12 = 5.00*zeu + zeu13 = 80.0*zeu + + ! - OZONE ABSORPTION + + zx = puu(jl, 12) + zy = puu(jl, 13) + zuxy = 4.*zx*zx/(rpialf0*zy) + zsq1 = sqrt(1.+o1h*zuxy) - 1. + zsq2 = sqrt(1.+o2h*zuxy) - 1. + zvxy = rpialf0*zy/(2.*zx) + zaercn = puu(jl, 17) + zeu12 + zpu12 + zto1 = exp(-zvxy*zsq1-zaercn) + zto2 = exp(-zvxy*zsq2-zaercn) + + ! -- TRACE GASES (CH4, N2O, CFC-11, CFC-12) + + ! * CH4 IN INTERVAL 800-970 + 1110-1250 CM-1 + + ! NEXOTIC=1 + ! IF (NEXOTIC.EQ.1) THEN + zxch4 = puu(jl, 19) + zych4 = puu(jl, 20) + zuxy = 4.*zxch4*zxch4/(0.103*zych4) + zsqh41 = sqrt(1.+33.7*zuxy) - 1. + zvxy = 0.103*zych4/(2.*zxch4) + zodh41 = zvxy*zsqh41 + + ! * N2O IN INTERVAL 800-970 + 1110-1250 CM-1 + + zxn2o = puu(jl, 21) + zyn2o = puu(jl, 22) + zuxy = 4.*zxn2o*zxn2o/(0.416*zyn2o) + zsqn21 = sqrt(1.+21.3*zuxy) - 1. + zvxy = 0.416*zyn2o/(2.*zxn2o) + zodn21 = zvxy*zsqn21 + + ! * CH4 IN INTERVAL 1250-1450 + 1880-2820 CM-1 + + zuxy = 4.*zxch4*zxch4/(0.113*zych4) + zsqh42 = sqrt(1.+400.*zuxy) - 1. + zvxy = 0.113*zych4/(2.*zxch4) + zodh42 = zvxy*zsqh42 + + ! * N2O IN INTERVAL 1250-1450 + 1880-2820 CM-1 + + zuxy = 4.*zxn2o*zxn2o/(0.197*zyn2o) + zsqn22 = sqrt(1.+2000.*zuxy) - 1. + zvxy = 0.197*zyn2o/(2.*zxn2o) + zodn22 = zvxy*zsqn22 + + ! * CFC-11 IN INTERVAL 800-970 + 1110-1250 CM-1 + + za11 = 2.*puu(jl, 23)*4.404E+05 + zttf11 = 1. - za11*0.003225 + + ! * CFC-12 IN INTERVAL 800-970 + 1110-1250 CM-1 + + za12 = 2.*puu(jl, 24)*6.7435E+05 + zttf12 = 1. - za12*0.003225 + + zuu11 = -puu(jl, 15) - zeu10 - zpu10 + zuu12 = -puu(jl, 16) - zeu11 - zpu11 - zodh41 - zodn21 + ptt(jl, 10) = exp(-puu(jl,14)) + ptt(jl, 11) = exp(zuu11) + ptt(jl, 12) = exp(zuu12)*zttf11*zttf12 + ptt(jl, 13) = 0.7554*zto1 + 0.2446*zto2 + ptt(jl, 14) = ptt(jl, 10)*exp(-zeu13-zpu13) + ptt(jl, 15) = exp(-puu(jl,14)-zodh42-zodn22) + END DO + + RETURN +END SUBROUTINE lwtt