!******************************************************************************* SUBROUTINE RRTM_TAUMOL8 (KLEV,P_TAU,P_WX,& & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,K_JP,K_JT,K_JT1,& & P_COLH2O,P_COLO3,P_COLN2O,P_CO2MULT,K_LAYSWTCH,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC) ! BAND 8: 1080-1180 cm-1 (low (i.e.>~300mb) - H2O; high - O3) ! Modifications ! M.Hamrud 01-Oct-2003 CY28 Cleaning ! D Salmond 2000-05-15 speed-up ! JJMorcrette 2000-05-17 speed-up USE PARKIND1 ,ONLY : JPIM ,JPRB USE YOMHOOK ,ONLY : LHOOK, DR_HOOK USE PARRRTM , ONLY : JPLAY ,JPBAND ,JPGPT ,JPXSEC ,NG8 ,NGS7 USE YOERRTWN , ONLY : NSPA ,NSPB USE YOERRTA8 , ONLY : ABSA ,ABSB ,FRACREFA, FRACREFB,SELFREF,ABSCO2A , ABSCO2B ,& & ABSN2OA , ABSN2OB,CFC12 ,CFC22ADJ, H2OREF ,& & N2OREF , O3REF ! Input !#include "yoeratm.h" IMPLICIT NONE INTEGER(KIND=JPIM),INTENT(IN) :: KLEV REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAU(JPGPT,JPLAY) REAL(KIND=JPRB) ,INTENT(IN) :: P_WX(JPXSEC,JPLAY) ! Amount of trace gases REAL(KIND=JPRB) ,INTENT(IN) :: P_TAUAERL(JPLAY,JPBAND) REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC00(JPLAY) REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC01(JPLAY) REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC10(JPLAY) REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC11(JPLAY) INTEGER(KIND=JPIM),INTENT(IN) :: K_JP(JPLAY) INTEGER(KIND=JPIM),INTENT(IN) :: K_JT(JPLAY) INTEGER(KIND=JPIM),INTENT(IN) :: K_JT1(JPLAY) REAL(KIND=JPRB) ,INTENT(IN) :: P_COLH2O(JPLAY) REAL(KIND=JPRB) ,INTENT(IN) :: P_COLO3(JPLAY) REAL(KIND=JPRB) ,INTENT(IN) :: P_COLN2O(JPLAY) REAL(KIND=JPRB) ,INTENT(IN) :: P_CO2MULT(JPLAY) INTEGER(KIND=JPIM),INTENT(IN) :: K_LAYSWTCH REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFAC(JPLAY) REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFRAC(JPLAY) INTEGER(KIND=JPIM),INTENT(IN) :: K_INDSELF(JPLAY) REAL(KIND=JPRB) ,INTENT(OUT) :: PFRAC(JPGPT,JPLAY) ! Output !- from AER !- from INTFAC !- from INTIND !- from PROFDATA !- from SELF !- from SP INTEGER(KIND=JPIM) :: IND0(JPLAY),IND1(JPLAY),INDS(JPLAY) ! REAL TAUAER(JPLAY) REAL(KIND=JPRB) :: Z_N2OMULT(JPLAY) INTEGER(KIND=JPIM) :: IG, I_LAY REAL(KIND=JPRB) :: Z_COLREF1, Z_COLREF2, Z_CURRN2O, Z_FP, Z_RATIO, Z_WCOMB1, Z_WCOMB2 REAL(KIND=JPRB) :: ZHOOK_HANDLE ! EQUIVALENCE (TAUAERL(1,8),TAUAER) ! Compute the optical depth by interpolating in ln(pressure) and ! temperature. IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL8',0,ZHOOK_HANDLE) DO I_LAY = 1, K_LAYSWTCH Z_FP = P_FAC01(I_LAY) + P_FAC11(I_LAY) IND0(I_LAY) = ((K_JP(I_LAY)-1)*5+(K_JT(I_LAY)-1))*NSPA(8) + 1 IND1(I_LAY) = (K_JP(I_LAY)*5+(K_JT1(I_LAY)-1))*NSPA(8) + 1 INDS(I_LAY) = K_INDSELF(I_LAY) Z_COLREF1 = N2OREF(K_JP(I_LAY)) Z_COLREF2 = N2OREF(K_JP(I_LAY)+1) Z_WCOMB1 = 1.0_JPRB/H2OREF(K_JP(I_LAY)) Z_WCOMB2 = 1.0_JPRB/H2OREF(K_JP(I_LAY)+1) Z_RATIO = (Z_COLREF1*Z_WCOMB1)+Z_FP*((Z_COLREF2*Z_WCOMB2)-(Z_COLREF1*Z_WCOMB1)) Z_CURRN2O = P_COLH2O(I_LAY) * Z_RATIO Z_N2OMULT(I_LAY) = P_COLN2O(I_LAY) - Z_CURRN2O ENDDO !-- DS_000515 DO IG = 1, NG8 DO I_LAY = 1, K_LAYSWTCH !-- DS_000515 P_TAU (NGS7+IG,I_LAY) = P_COLH2O(I_LAY) *& & (P_FAC00(I_LAY) * ABSA(IND0(I_LAY) ,IG) +& & P_FAC10(I_LAY) * ABSA(IND0(I_LAY)+1,IG) +& & P_FAC01(I_LAY) * ABSA(IND1(I_LAY) ,IG) +& & P_FAC11(I_LAY) * ABSA(IND1(I_LAY)+1,IG) +& & P_SELFFAC(I_LAY) * (SELFREF(INDS(I_LAY),IG) + & & P_SELFFRAC(I_LAY) *& & (SELFREF(INDS(I_LAY)+1,IG) - SELFREF(INDS(I_LAY),IG))))& & + P_WX(3,I_LAY) * CFC12(IG)& & + P_WX(4,I_LAY) * CFC22ADJ(IG)& & + P_CO2MULT(I_LAY) * ABSCO2A(IG)& & + Z_N2OMULT(I_LAY) * ABSN2OA(IG)& & + P_TAUAERL(I_LAY,8) PFRAC(NGS7+IG,I_LAY) = FRACREFA(IG) ENDDO ENDDO DO I_LAY = K_LAYSWTCH+1, KLEV Z_FP = P_FAC01(I_LAY) + P_FAC11(I_LAY) IND0(I_LAY) = ((K_JP(I_LAY)-7)*5+(K_JT(I_LAY)-1))*NSPB(8) + 1 IND1(I_LAY) = ((K_JP(I_LAY)-6)*5+(K_JT1(I_LAY)-1))*NSPB(8) + 1 Z_COLREF1 = N2OREF(K_JP(I_LAY)) Z_COLREF2 = N2OREF(K_JP(I_LAY)+1) Z_WCOMB1 = 1.0_JPRB/O3REF(K_JP(I_LAY)) Z_WCOMB2 = 1.0_JPRB/O3REF(K_JP(I_LAY)+1) Z_RATIO = (Z_COLREF1*Z_WCOMB1)+Z_FP*((Z_COLREF2*Z_WCOMB2)-(Z_COLREF1*Z_WCOMB1)) Z_CURRN2O = P_COLO3(I_LAY) * Z_RATIO Z_N2OMULT(I_LAY) = P_COLN2O(I_LAY) - Z_CURRN2O ENDDO !-- JJM_000517 DO IG = 1, NG8 DO I_LAY = K_LAYSWTCH+1, KLEV !-- JJM_000517 P_TAU (NGS7+IG,I_LAY) = P_COLO3(I_LAY) *& & (P_FAC00(I_LAY) * ABSB(IND0(I_LAY) ,IG) +& & P_FAC10(I_LAY) * ABSB(IND0(I_LAY)+1,IG) +& & P_FAC01(I_LAY) * ABSB(IND1(I_LAY) ,IG) +& & P_FAC11(I_LAY) * ABSB(IND1(I_LAY)+1,IG)) & & + P_WX(3,I_LAY) * CFC12(IG)& & + P_WX(4,I_LAY) * CFC22ADJ(IG)& & + P_CO2MULT(I_LAY) * ABSCO2B(IG)& & + Z_N2OMULT(I_LAY) * ABSN2OB(IG)& & + P_TAUAERL(I_LAY,8) PFRAC(NGS7+IG,I_LAY) = FRACREFB(IG) ENDDO ENDDO IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL8',1,ZHOOK_HANDLE) END SUBROUTINE RRTM_TAUMOL8