GCC Code Coverage Report
Directory: ./ Exec Total Coverage
File: phylmd/rrtm/srtm_cmbgb27.F90 Lines: 0 24 0.0 %
Date: 2023-06-30 12:51:15 Branches: 0 22 0.0 %

Line Branch Exec Source
1
SUBROUTINE SRTM_CMBGB27
2
3
!     BAND 27:  29000-38000 cm-1 (low - O3; high - O3)
4
!-----------------------------------------------------------------------
5
6
USE PARKIND1  ,ONLY : JPIM , JPRB
7
USE YOMHOOK   ,ONLY : LHOOK, DR_HOOK
8
9
USE YOESRTWN , ONLY : NGC, NGS, NGN, RWGT
10
USE YOESRTA27, ONLY : KA, KB, SFLUXREF, RAYL, &
11
                    & KAC, KBC, SFLUXREFC, RAYLC
12
13
IMPLICIT NONE
14
15
! Local variables
16
INTEGER(KIND=JPIM) :: JT, JP, IGC, IPR, IPRSM
17
REAL(KIND=JPRB)    :: ZSUMK, ZSUMF1, ZSUMF2
18
19
REAL(KIND=JPRB) :: ZHOOK_HANDLE
20
!     ------------------------------------------------------------------
21
IF (LHOOK) CALL DR_HOOK('SRTM_CMBGB27',0,ZHOOK_HANDLE)
22
23
DO JT = 1,5
24
  DO JP = 1,13
25
    IPRSM = 0
26
    DO IGC = 1,NGC(12)
27
      ZSUMK = 0.
28
      DO IPR = 1, NGN(NGS(11)+IGC)
29
        IPRSM = IPRSM + 1
30
        ZSUMK = ZSUMK + KA(JT,JP,IPRSM)*RWGT(IPRSM+176)
31
      ENDDO
32
      KAC(JT,JP,IGC) = ZSUMK
33
    ENDDO
34
  ENDDO
35
36
  DO JP = 13,59
37
    IPRSM = 0
38
    DO IGC = 1,NGC(12)
39
      ZSUMK = 0.
40
      DO IPR = 1, NGN(NGS(11)+IGC)
41
        IPRSM = IPRSM + 1
42
        ZSUMK = ZSUMK + KB(JT,JP,IPRSM)*RWGT(IPRSM+176)
43
      ENDDO
44
      KBC(JT,JP,IGC) = ZSUMK
45
    ENDDO
46
  ENDDO
47
ENDDO
48
49
IPRSM = 0
50
DO IGC = 1,NGC(12)
51
  ZSUMF1 = 0.
52
  ZSUMF2 = 0.
53
  DO IPR = 1, NGN(NGS(11)+IGC)
54
    IPRSM = IPRSM + 1
55
    ZSUMF1 = ZSUMF1 + SFLUXREF(IPRSM)
56
    ZSUMF2 = ZSUMF2 + RAYL(IPRSM)*RWGT(IPRSM+176)
57
  ENDDO
58
  SFLUXREFC(IGC) = ZSUMF1
59
  RAYLC(IGC) = ZSUMF2
60
ENDDO
61
62
!     -----------------------------------------------------------------
63
IF (LHOOK) CALL DR_HOOK('SRTM_CMBGB27',1,ZHOOK_HANDLE)
64
END SUBROUTINE SRTM_CMBGB27
65