GCC Code Coverage Report


Directory: ./
File: rad/srtm_taumol22.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 0 34 0.0%
Branches: 0 20 0.0%

Line Branch Exec Source
1 SUBROUTINE SRTM_TAUMOL22 &
2 & ( KLEV,&
3 & P_FAC00 , P_FAC01 , P_FAC10 , P_FAC11,&
4 & K_JP , K_JT , K_JT1 , P_ONEMINUS,&
5 & P_COLH2O , P_COLMOL , P_COLO2,&
6 & K_LAYTROP , P_SELFFAC, P_SELFFRAC, K_INDSELF , P_FORFAC, P_FORFRAC, K_INDFOR,&
7 & P_SFLUXZEN, P_TAUG , P_TAUR &
8 & )
9
10 ! Written by Eli J. Mlawer, Atmospheric & Environmental Research.
11
12 ! BAND 22: 7700-8050 cm-1 (low - H2O,O2; high - O2)
13
14 ! Modifications
15 ! M.Hamrud 01-Oct-2003 CY28 Cleaning
16
17 ! JJMorcrette 2003-02-24 adapted to ECMWF environment
18
19 ! PARAMETER (MG=16, MXLAY=203, NBANDS=14)
20
21 USE PARKIND1 ,ONLY : JPIM ,JPRB
22 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
23
24 USE PARSRTM , ONLY : JPLAY, JPG, NG22
25 USE YOESRTA22, ONLY : ABSA, ABSB, FORREFC, SELFREFC &
26 & , SFLUXREFC, RAYL &
27 & , LAYREFFR, STRRAT
28 USE YOESRTWN , ONLY : NSPA, NSPB
29
30 IMPLICIT NONE
31
32 !-- Output
33 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
34 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC00(JPLAY)
35 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC01(JPLAY)
36 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC10(JPLAY)
37 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC11(JPLAY)
38 INTEGER(KIND=JPIM),INTENT(IN) :: K_JP(JPLAY)
39 INTEGER(KIND=JPIM),INTENT(IN) :: K_JT(JPLAY)
40 INTEGER(KIND=JPIM),INTENT(IN) :: K_JT1(JPLAY)
41 REAL(KIND=JPRB) ,INTENT(IN) :: P_ONEMINUS
42 REAL(KIND=JPRB) ,INTENT(IN) :: P_COLH2O(JPLAY)
43 REAL(KIND=JPRB) ,INTENT(IN) :: P_COLMOL(JPLAY)
44 REAL(KIND=JPRB) ,INTENT(IN) :: P_COLO2(JPLAY)
45 INTEGER(KIND=JPIM),INTENT(IN) :: K_LAYTROP
46 REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFAC(JPLAY)
47 REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFRAC(JPLAY)
48 INTEGER(KIND=JPIM),INTENT(IN) :: K_INDSELF(JPLAY)
49 REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFAC(JPLAY)
50 REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFRAC(JPLAY)
51 INTEGER(KIND=JPIM),INTENT(IN) :: K_INDFOR(JPLAY)
52
53 REAL(KIND=JPRB) ,INTENT(OUT) :: P_SFLUXZEN(JPG)
54 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUG(JPLAY,JPG)
55 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUR(JPLAY,JPG)
56 !- from INTFAC
57 !- from INTIND
58 !- from PRECISE
59 !- from PROFDATA
60 !- from SELF
61 INTEGER(KIND=JPIM) :: IG, IND0, IND1, INDS, INDF, JS, I_LAY, I_LAYSOLFR, I_NLAYERS
62
63 REAL(KIND=JPRB) :: Z_FAC000, Z_FAC001, Z_FAC010, Z_FAC011, Z_FAC100, Z_FAC101,&
64 & Z_FAC110, Z_FAC111, Z_FS, Z_SPECCOMB, Z_SPECMULT, Z_SPECPARM, &
65 & Z_TAURAY, Z_O2ADJ , Z_O2CONT
66 REAL(KIND=JPRB) :: ZHOOK_HANDLE
67
68 IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL22',0,ZHOOK_HANDLE)
69 I_NLAYERS = KLEV
70
71 ! The following factor is the ratio of total O2 band intensity (lines
72 ! and Mate continuum) to O2 band intensity (line only). It is needed
73 ! to adjust the optical depths since the k's include only lines.
74 Z_O2ADJ = 1.6_JPRB
75
76 ! Compute the optical depth by interpolating in ln(pressure),
77 ! temperature, and appropriate species. Below LAYTROP, the water
78 ! vapor self-continuum is interpolated (in temperature) separately.
79
80 I_LAYSOLFR = K_LAYTROP
81
82 DO I_LAY = 1, K_LAYTROP
83 IF (K_JP(I_LAY) < LAYREFFR .AND. K_JP(I_LAY+1) >= LAYREFFR) &
84 & I_LAYSOLFR = MIN(I_LAY+1,K_LAYTROP)
85 Z_O2CONT = 4.35e-4*P_COLO2(I_LAY)/(350.0*2.0)
86 Z_SPECCOMB = P_COLH2O(I_LAY) + Z_O2ADJ*STRRAT*P_COLO2(I_LAY)
87 Z_SPECPARM = P_COLH2O(I_LAY)/Z_SPECCOMB
88 IF (Z_SPECPARM >= P_ONEMINUS) Z_SPECPARM = P_ONEMINUS
89 Z_SPECMULT = 8.*(Z_SPECPARM)
90 ! ODADJ = SPECPARM + O2ADJ * (1. - SPECPARM)
91 JS = 1 + INT(Z_SPECMULT)
92 Z_FS = MOD(Z_SPECMULT, 1.0_JPRB )
93 ! Z_FAC000 = (1. - Z_FS) * P_FAC00(I_LAY)
94 ! Z_FAC010 = (1. - Z_FS) * P_FAC10(I_LAY)
95 ! Z_FAC100 = Z_FS * P_FAC00(I_LAY)
96 ! Z_FAC110 = Z_FS * P_FAC10(I_LAY)
97 ! Z_FAC001 = (1. - Z_FS) * P_FAC01(I_LAY)
98 ! Z_FAC011 = (1. - Z_FS) * P_FAC11(I_LAY)
99 ! Z_FAC101 = Z_FS * P_FAC01(I_LAY)
100 ! Z_FAC111 = Z_FS * P_FAC11(I_LAY)
101 IND0 = ((K_JP(I_LAY)-1)*5+(K_JT(I_LAY)-1))*NSPA(22) + JS
102 IND1 = (K_JP(I_LAY)*5+(K_JT1(I_LAY)-1))*NSPA(22) + JS
103 INDS = K_INDSELF(I_LAY)
104 INDF = K_INDFOR(I_LAY)
105 Z_TAURAY = P_COLMOL(I_LAY) * RAYL
106
107 ! DO IG = 1, NG(22)
108 DO IG = 1 , NG22
109 P_TAUG(I_LAY,IG) = Z_SPECCOMB * &
110 ! & (Z_FAC000 * ABSA(IND0,IG) + &
111 ! & Z_FAC100 * ABSA(IND0+1,IG) + &
112 ! & Z_FAC010 * ABSA(IND0+9,IG) + &
113 ! & Z_FAC110 * ABSA(IND0+10,IG) + &
114 ! & Z_FAC001 * ABSA(IND1,IG) + &
115 ! & Z_FAC101 * ABSA(IND1+1,IG) + &
116 ! & Z_FAC011 * ABSA(IND1+9,IG) + &
117 ! & Z_FAC111 * ABSA(IND1+10,IG)) + &
118 & (&
119 & (1. - Z_FS) * ( ABSA(IND0,IG) * P_FAC00(I_LAY) + &
120 & ABSA(IND0+9,IG) * P_FAC10(I_LAY) + &
121 & ABSA(IND1,IG) * P_FAC01(I_LAY) + &
122 & ABSA(IND1+9,IG) * P_FAC11(I_LAY) ) + &
123 & Z_FS * ( ABSA(IND0+1,IG) * P_FAC00(I_LAY) + &
124 & ABSA(IND0+10,IG) * P_FAC10(I_LAY) + &
125 & ABSA(IND1+1,IG) * P_FAC01(I_LAY) + &
126 & ABSA(IND1+10,IG) * P_FAC11(I_LAY) ) &
127 & ) + &
128 & P_COLH2O(I_LAY) * &
129 & (P_SELFFAC(I_LAY) * (SELFREFC(INDS,IG) + &
130 & P_SELFFRAC(I_LAY) * &
131 & (SELFREFC(INDS+1,IG) - SELFREFC(INDS,IG))) + &
132 & P_FORFAC(I_LAY) * (FORREFC(INDF,IG) + &
133 & P_FORFRAC(I_LAY) * &
134 & (FORREFC(INDF+1,IG) - FORREFC(INDF,IG)))) &
135 & + Z_O2CONT
136 ! & + TAURAY
137 ! SSA(LAY,IG) = TAURAY/TAUG(LAY,IG)
138 IF (I_LAY == I_LAYSOLFR) P_SFLUXZEN(IG) = SFLUXREFC(IG,JS) &
139 & + Z_FS * (SFLUXREFC(IG,JS+1) - SFLUXREFC(IG,JS))
140 P_TAUR(I_LAY,IG) = Z_TAURAY
141 ENDDO
142 ENDDO
143
144 DO I_LAY = K_LAYTROP+1, I_NLAYERS
145 Z_O2CONT = 4.35e-4*P_COLO2(I_LAY)/(350.0*2.0)
146 IND0 = ((K_JP(I_LAY)-13)*5+(K_JT(I_LAY)-1))*NSPB(22) + 1
147 IND1 = ((K_JP(I_LAY)-12)*5+(K_JT1(I_LAY)-1))*NSPB(22) + 1
148 Z_TAURAY = P_COLMOL(I_LAY) * RAYL
149
150 ! DO IG = 1, NG(22)
151 DO IG = 1 , NG22
152 P_TAUG(I_LAY,IG) = P_COLO2(I_LAY) * Z_O2ADJ * &
153 & (P_FAC00(I_LAY) * ABSB(IND0,IG) + &
154 & P_FAC10(I_LAY) * ABSB(IND0+1,IG) + &
155 & P_FAC01(I_LAY) * ABSB(IND1,IG) + &
156 & P_FAC11(I_LAY) * ABSB(IND1+1,IG)) + &
157 & Z_O2CONT
158 ! & + TAURAY
159 ! SSA(LAY,IG) = TAURAY/TAUG(LAY,IG)
160 P_TAUR(I_LAY,IG) = Z_TAURAY
161 ENDDO
162 ENDDO
163
164 !-----------------------------------------------------------------------
165 IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL22',1,ZHOOK_HANDLE)
166 END SUBROUTINE SRTM_TAUMOL22
167
168