GCC Code Coverage Report
Directory: ./ Exec Total Coverage
File: phylmd/rrtm/rrtm_cmbgb6.F90 Lines: 31 31 100.0 %
Date: 2023-06-30 12:56:34 Branches: 22 24 91.7 %

Line Branch Exec Source
1
!***************************************************************************
2
1
SUBROUTINE RRTM_CMBGB6
3
!***************************************************************************
4
5
!     BAND 6:  820-980 cm-1 (low - H2O; high - nothing)
6
!***************************************************************************
7
8
! Parameters
9
USE PARKIND1  ,ONLY : JPIM     ,JPRB
10
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
11
12
USE YOERRTO6 , ONLY : KAO     ,SELFREFO   ,FRACREFAO  ,&
13
 & ABSCO2O ,CFC11ADJO,CFC12O
14
USE YOERRTA6 , ONLY : KA      ,SELFREF    ,FRACREFA   ,&
15
 & ABSCO2  ,CFC11ADJ ,CFC12
16
USE YOERRTRWT, ONLY : FREFA    ,FREFB    ,RWGT
17
USE YOERRTFTR, ONLY : NGC      ,NGS      ,NGN
18
19
IMPLICIT NONE
20
21
INTEGER(KIND=JPIM) :: IGC, IPR, IPRSM, JP, JT
22
23
REAL(KIND=JPRB) :: Z_SUMF, Z_SUMK, Z_SUMK1, Z_SUMK2, Z_SUMK3
24
REAL(KIND=JPRB) :: ZHOOK_HANDLE
25
26
1
IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB6',0,ZHOOK_HANDLE)
27
6
DO JT = 1,5
28
71
  DO JP = 1,13
29
    IPRSM = 0
30
590
    DO IGC = 1,NGC(6)
31
      Z_SUMK = 0.0_JPRB
32
1560
      DO IPR = 1, NGN(NGS(5)+IGC)
33
1040
        IPRSM = IPRSM + 1
34
35
1560
        Z_SUMK = Z_SUMK + KAO(JT,JP,IPRSM)*RWGT(IPRSM+80)
36
      ENDDO
37
38
585
      KA(JT,JP,IGC) = Z_SUMK
39
    ENDDO
40
  ENDDO
41
ENDDO
42
43
11
DO JT = 1,10
44
  IPRSM = 0
45
91
  DO IGC = 1,NGC(6)
46
    Z_SUMK = 0.0_JPRB
47
240
    DO IPR = 1, NGN(NGS(5)+IGC)
48
160
      IPRSM = IPRSM + 1
49
50
240
      Z_SUMK = Z_SUMK + SELFREFO(JT,IPRSM)*RWGT(IPRSM+80)
51
    ENDDO
52
53
90
    SELFREF(JT,IGC) = Z_SUMK
54
  ENDDO
55
ENDDO
56
57
IPRSM = 0
58
9
DO IGC = 1,NGC(6)
59
  Z_SUMF = 0.0_JPRB
60
  Z_SUMK1= 0.0_JPRB
61
  Z_SUMK2= 0.0_JPRB
62
  Z_SUMK3= 0.0_JPRB
63
24
  DO IPR = 1, NGN(NGS(5)+IGC)
64
16
    IPRSM = IPRSM + 1
65
66
16
    Z_SUMF = Z_SUMF + FRACREFAO(IPRSM)
67
16
    Z_SUMK1= Z_SUMK1+ ABSCO2O(IPRSM)*RWGT(IPRSM+80)
68
16
    Z_SUMK2= Z_SUMK2+ CFC11ADJO(IPRSM)*RWGT(IPRSM+80)
69
24
    Z_SUMK3= Z_SUMK3+ CFC12O(IPRSM)*RWGT(IPRSM+80)
70
  ENDDO
71
72
8
  FRACREFA(IGC) = Z_SUMF
73
8
  ABSCO2(IGC) = Z_SUMK1
74
8
  CFC11ADJ(IGC) = Z_SUMK2
75
9
  CFC12(IGC) = Z_SUMK3
76
ENDDO
77
78
9
DO IGC = 1,NGC(6)
79
80
8
  FREFA(NGS(5)+IGC,1) = FRACREFA(IGC)
81
9
  FREFB(NGS(5)+IGC,1) = FRACREFA(IGC)
82
ENDDO
83
84
1
IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB6',1,ZHOOK_HANDLE)
85
1
END SUBROUTINE RRTM_CMBGB6