source: LMDZ6/trunk/libf/phylmd/ecrad/ifsrrtm/rrtm_cmbgb9.F90 @ 5408

Last change on this file since 5408 was 4773, checked in by idelkadi, 12 months ago
  • Update of Ecrad in LMDZ The same organization of the Ecrad offline version is retained in order to facilitate the updating of Ecrad in LMDZ and the comparison between online and offline results. version 1.6.1 of Ecrad (https://github.com/lguez/ecrad.git)
  • Implementation of the double call of Ecrad in LMDZ


File size: 3.3 KB
Line 
1!***************************************************************************
2SUBROUTINE RRTM_CMBGB9
3!***************************************************************************
4
5!     BAND 9:  1180-1390 cm-1 (low - H2O,CH4; high - CH4)
6!     ABozzo 201306 updated to rrtmg v4.85
7!     band 9:  1180-1390 cm-1 (low key - h2o,ch4; low minor - n2o)
8!                             (high key - ch4; high minor - n2o)!
9!***************************************************************************
10
11! Parameters
12USE PARKIND1  ,ONLY : JPIM     ,JPRB
13USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK, JPHOOK
14
15USE YOERRTO9 , ONLY : KAO     ,KBO     ,SELFREFO, FORREFO   ,FRACREFAO  ,&
16 & FRACREFBO, KAO_MN2O, KBO_MN2O 
17USE YOERRTA9 , ONLY : KA      ,KB      ,SELFREF, FORREF    ,FRACREFA  ,&
18 & FRACREFB , KA_MN2O,  KB_MN2O
19USE YOERRTRWT, ONLY : RWGT
20USE YOERRTFTR, ONLY : NGC      ,NGS      ,NGN     
21
22IMPLICIT NONE
23
24INTEGER(KIND=JPIM) :: IGC, IPR, IPRSM, JN, JP, JT
25
26
27REAL(KIND=JPRB) :: Z_SUMF, Z_SUMK
28REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
29
30IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB9',0,ZHOOK_HANDLE)
31DO JN = 1,9
32  DO JT = 1,5
33    DO JP = 1,13
34      IPRSM = 0
35      DO IGC = 1,NGC(9)
36        Z_SUMK = 0.0_JPRB
37        DO IPR = 1, NGN(NGS(8)+IGC)
38          IPRSM = IPRSM + 1
39
40          Z_SUMK = Z_SUMK + KAO(JN,JT,JP,IPRSM)*RWGT(IPRSM+128)
41        ENDDO
42
43        KA(JN,JT,JP,IGC) = Z_SUMK
44      ENDDO
45    ENDDO
46  ENDDO
47ENDDO
48
49DO JT = 1,5
50  DO JP = 13,59
51    IPRSM = 0
52    DO IGC = 1,NGC(9)
53      Z_SUMK = 0.0_JPRB
54      DO IPR = 1, NGN(NGS(8)+IGC)
55        IPRSM = IPRSM + 1
56
57        Z_SUMK = Z_SUMK + KBO(JT,JP,IPRSM)*RWGT(IPRSM+128)
58      ENDDO
59
60      KB(JT,JP,IGC) = Z_SUMK
61    ENDDO
62  ENDDO
63ENDDO
64
65   DO JN = 1,9
66         DO JT = 1,19
67            IPRSM = 0
68            DO IGC = 1,NGC(9)
69              Z_SUMK = 0.0_JPRB
70               DO IPR = 1, NGN(NGS(8)+IGC)
71                  IPRSM = IPRSM + 1
72                  Z_SUMK = Z_SUMK + KAO_MN2O(JN,JT,IPRSM)*RWGT(IPRSM+128)
73               ENDDO
74               KA_MN2O(JN,JT,IGC) = Z_SUMK
75            ENDDO
76         ENDDO
77      ENDDO
78
79      DO JT = 1,19
80         IPRSM = 0
81         DO IGC = 1,NGC(9)
82            Z_SUMK = 0.0_JPRB
83            DO IPR = 1, NGN(NGS(8)+IGC)
84               IPRSM = IPRSM + 1
85               Z_SUMK = Z_SUMK + KBO_MN2O(JT,IPRSM)*RWGT(IPRSM+128)
86            ENDDO
87            KB_MN2O(JT,IGC) = Z_SUMK
88         ENDDO
89      ENDDO
90
91
92
93DO JT = 1,10
94  IPRSM = 0
95  DO IGC = 1,NGC(9)
96    Z_SUMK = 0.0_JPRB
97    DO IPR = 1, NGN(NGS(8)+IGC)
98      IPRSM = IPRSM + 1
99
100      Z_SUMK = Z_SUMK + SELFREFO(JT,IPRSM)*RWGT(IPRSM+128)
101    ENDDO
102
103    SELFREF(JT,IGC) = Z_SUMK
104  ENDDO
105ENDDO
106
107   DO JT = 1,4
108         IPRSM = 0
109         DO IGC = 1,NGC(9)
110            Z_SUMK = 0.0_JPRB
111            DO IPR = 1, NGN(NGS(8)+IGC)
112               IPRSM = IPRSM + 1
113               Z_SUMK = Z_SUMK + FORREFO(JT,IPRSM)*RWGT(IPRSM+128)
114            ENDDO
115            FORREF(JT,IGC) = Z_SUMK
116         ENDDO
117      ENDDO
118
119
120DO JP = 1,9
121  IPRSM = 0
122  DO IGC = 1,NGC(9)
123    Z_SUMF = 0.0_JPRB
124    DO IPR = 1, NGN(NGS(8)+IGC)
125      IPRSM = IPRSM + 1
126
127      Z_SUMF = Z_SUMF + FRACREFAO(IPRSM,JP)
128    ENDDO
129
130    FRACREFA(IGC,JP) = Z_SUMF
131  ENDDO
132ENDDO
133
134IPRSM = 0
135DO IGC = 1,NGC(9)
136  Z_SUMF = 0.0_JPRB
137  DO IPR = 1, NGN(NGS(8)+IGC)
138    IPRSM = IPRSM + 1
139
140    Z_SUMF = Z_SUMF + FRACREFBO(IPRSM)
141  ENDDO
142
143  FRACREFB(IGC) = Z_SUMF
144ENDDO
145
146
147IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB9',1,ZHOOK_HANDLE)
148END SUBROUTINE RRTM_CMBGB9
Note: See TracBrowser for help on using the repository browser.