source: LMDZ6/branches/LMDZ_ECRad/libf/phylmd/ecrad/ifsrrtm/rrtm_cmbgb3.F90 @ 5134

Last change on this file since 5134 was 4728, checked in by idelkadi, 14 months ago

Update of ecrad in the LMDZ_ECRad branch of LMDZ:

  • version 1.6.1 of ecrad
  • files are no longer grouped in the same ecrad directory.
  • the structure of ecrad offline is preserved to facilitate updating in LMDZ
  • cfg.bld modified to take into account the new added subdirectories.
  • the interface routines and those added in ecrad are moved to the phylmd directory
File size: 3.6 KB
Line 
1!***************************************************************************
2SUBROUTINE RRTM_CMBGB3
3!***************************************************************************
4
5!     BAND 3:  500-630 cm-1 (low - H2O,CO2; high - H2O,CO2)
6!      ABozzo 200130517 updated to rrtmg_lw_v4.85:
7!     band 3:  500-630 cm-1 (low key - h2o,co2; low minor - n2o)
8!                           (high key - h2o,co2; high minor - n2o)
9!***************************************************************************
10
11! Parameters
12USE PARKIND1  ,ONLY : JPIM     ,JPRB
13USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK, JPHOOK
14
15USE YOERRTO3 , ONLY : KAO     ,KBO     ,SELFREFO   ,FRACREFAO  ,&
16 & FRACREFBO  ,FORREFO    ,KAO_MN2O   ,KBO_MN2O 
17USE YOERRTA3 , ONLY : KA      ,KB      ,SELFREF    ,FRACREFA   ,&
18 & FRACREFB   ,FORREF    ,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
26REAL(KIND=JPRB) :: Z_SUMF, Z_SUMK
27REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
28
29IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB3',0,ZHOOK_HANDLE)
30DO JN = 1,9
31  DO JT = 1,5
32    DO JP = 1,13
33      IPRSM = 0
34      DO IGC = 1,NGC(3)
35        Z_SUMK = 0.0_JPRB
36        DO IPR = 1, NGN(NGS(2)+IGC)
37          IPRSM = IPRSM + 1
38
39          Z_SUMK = Z_SUMK + KAO(JN,JT,JP,IPRSM)*RWGT(IPRSM+32)
40        ENDDO
41
42        KA(JN,JT,JP,IGC) = Z_SUMK
43      ENDDO
44    ENDDO
45  ENDDO
46ENDDO
47DO JN = 1,5
48  DO JT = 1,5
49    DO JP = 13,59
50      IPRSM = 0
51      DO IGC = 1,NGC(3)
52        Z_SUMK = 0.0_JPRB
53        DO IPR = 1, NGN(NGS(2)+IGC)
54          IPRSM = IPRSM + 1
55
56          Z_SUMK = Z_SUMK + KBO(JN,JT,JP,IPRSM)*RWGT(IPRSM+32)
57        ENDDO
58
59        KB(JN,JT,JP,IGC) = Z_SUMK
60      ENDDO
61    ENDDO
62  ENDDO
63ENDDO
64
65    DO JN = 1,9
66         DO JT = 1,19
67            IPRSM = 0
68            DO IGC = 1,NGC(3)
69              Z_SUMK = 0.
70               DO IPR = 1, NGN(NGS(2)+IGC)
71                  IPRSM = IPRSM + 1
72                  Z_SUMK = Z_SUMK + KAO_MN2O(JN,JT,IPRSM)*RWGT(IPRSM+32)
73               ENDDO
74               KA_MN2O(JN,JT,IGC) = Z_SUMK
75            ENDDO
76         ENDDO
77      ENDDO
78
79      DO JN = 1,5
80         DO JT = 1,19
81            IPRSM = 0
82            DO IGC = 1,NGC(3)
83              Z_SUMK = 0.
84               DO IPR = 1, NGN(NGS(2)+IGC)
85                  IPRSM = IPRSM + 1
86                  Z_SUMK = Z_SUMK + KBO_MN2O(JN,JT,IPRSM)*RWGT(IPRSM+32)
87               ENDDO
88               KB_MN2O(JN,JT,IGC) = Z_SUMK
89            ENDDO
90         ENDDO
91      ENDDO
92
93
94
95DO JT = 1,10
96  IPRSM = 0
97  DO IGC = 1,NGC(3)
98    Z_SUMK = 0.0_JPRB
99    DO IPR = 1, NGN(NGS(2)+IGC)
100      IPRSM = IPRSM + 1
101      Z_SUMK = Z_SUMK + SELFREFO(JT,IPRSM)*RWGT(IPRSM+32)
102    ENDDO
103    SELFREF(JT,IGC) = Z_SUMK
104  ENDDO
105ENDDO
106
107      DO JT = 1,4
108         IPRSM = 0
109         DO IGC = 1,NGC(3)
110            Z_SUMK = 0.
111            DO IPR = 1, NGN(NGS(2)+IGC)
112               IPRSM = IPRSM + 1
113               Z_SUMK = Z_SUMK + FORREFO(JT,IPRSM)*RWGT(IPRSM+32)
114            ENDDO
115            FORREF(JT,IGC) = Z_SUMK
116         ENDDO
117      ENDDO
118
119      DO JP = 1,9
120         IPRSM = 0
121         DO IGC = 1,NGC(3)
122            Z_SUMF = 0.
123            DO IPR = 1, NGN(NGS(2)+IGC)
124               IPRSM = IPRSM + 1
125               Z_SUMF = Z_SUMF + FRACREFAO(IPRSM,JP)
126            ENDDO
127            FRACREFA(IGC,JP) = Z_SUMF
128         ENDDO
129      ENDDO
130
131
132
133DO JP = 1,5
134  IPRSM = 0
135  DO IGC = 1,NGC(3)
136    Z_SUMF = 0.0_JPRB
137    DO IPR = 1, NGN(NGS(2)+IGC)
138      IPRSM = IPRSM + 1
139
140      Z_SUMF = Z_SUMF + FRACREFBO(IPRSM,JP)
141    ENDDO
142
143    FRACREFB(IGC,JP) = Z_SUMF
144  ENDDO
145ENDDO
146
147
148IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB3',1,ZHOOK_HANDLE)
149END SUBROUTINE RRTM_CMBGB3
Note: See TracBrowser for help on using the repository browser.