source: LMDZ5/trunk/libf/phylmd/rrtm/rrtm_cmbgb5.F90 @ 5075

Last change on this file since 5075 was 1990, checked in by Laurent Fairhead, 11 years ago

Corrections à la version r1989 pour permettre la compilation avec RRTM
Inclusion de la licence CeCILL_V2 pour RRTM

Changes to revision r1989 to enable RRTM code compilation
RRTM part put under CeCILL_V2 licence
  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
File size: 2.8 KB
RevLine 
[1989]1!***************************************************************************
2SUBROUTINE RRTM_CMBGB5
3!***************************************************************************
4
5!     BAND 5:  700-820 cm-1 (low - H2O,CO2; high - O3,CO2)
6!***************************************************************************
7
8! Parameters
9USE PARKIND1  ,ONLY : JPIM     ,JPRB
10USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
11
12USE YOERRTO5 , ONLY : KAO     ,KBO     ,SELFREFO   ,FRACREFAO  ,&
13 & FRACREFBO, CCL4O 
14USE YOERRTA5 , ONLY : KA      ,KB      ,SELFREF    ,FRACREFA   ,&
15 & FRACREFB , CCL4 
16USE YOERRTRWT, ONLY : FREFA    ,FREFB    ,FREFADF  ,FREFBDF   ,RWGT
17USE YOERRTFTR, ONLY : NGC      ,NGS      ,NGN     
18
19IMPLICIT NONE
20
21INTEGER(KIND=JPIM) :: IGC, IPR, IPRSM, JN, JP, JT
22
23REAL(KIND=JPRB) :: Z_SUMF, Z_SUMK
24REAL(KIND=JPRB) :: ZHOOK_HANDLE
25
26IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB5',0,ZHOOK_HANDLE)
27DO JN = 1,9
28  DO JT = 1,5
29    DO JP = 1,13
30      IPRSM = 0
31      DO IGC = 1,NGC(5)
32        Z_SUMK = 0.0_JPRB
33        DO IPR = 1, NGN(NGS(4)+IGC)
34          IPRSM = IPRSM + 1
35
36          Z_SUMK = Z_SUMK + KAO(JN,JT,JP,IPRSM)*RWGT(IPRSM+64)
37        ENDDO
38
39        KA(JN,JT,JP,IGC) = Z_SUMK
40      ENDDO
41    ENDDO
42  ENDDO
43ENDDO
44DO JN = 1,5
45  DO JT = 1,5
46    DO JP = 13,59
47      IPRSM = 0
48      DO IGC = 1,NGC(5)
49        Z_SUMK = 0.0_JPRB
50        DO IPR = 1, NGN(NGS(4)+IGC)
51          IPRSM = IPRSM + 1
52
53          Z_SUMK = Z_SUMK + KBO(JN,JT,JP,IPRSM)*RWGT(IPRSM+64)
54        ENDDO
55
56        KB(JN,JT,JP,IGC) = Z_SUMK
57      ENDDO
58    ENDDO
59  ENDDO
60ENDDO
61
62DO JT = 1,10
63  IPRSM = 0
64  DO IGC = 1,NGC(5)
65    Z_SUMK = 0.0_JPRB
66    DO IPR = 1, NGN(NGS(4)+IGC)
67      IPRSM = IPRSM + 1
68
69      Z_SUMK = Z_SUMK + SELFREFO(JT,IPRSM)*RWGT(IPRSM+64)
70    ENDDO
71
72    SELFREF(JT,IGC) = Z_SUMK
73  ENDDO
74ENDDO
75
76DO JP = 1,9
77  IPRSM = 0
78  DO IGC = 1,NGC(5)
79    Z_SUMF = 0.0_JPRB
80    DO IPR = 1, NGN(NGS(4)+IGC)
81      IPRSM = IPRSM + 1
82
83      Z_SUMF = Z_SUMF + FRACREFAO(IPRSM,JP)
84    ENDDO
85
86    FRACREFA(IGC,JP) = Z_SUMF
87  ENDDO
88ENDDO
89
90DO JP = 1,5
91  IPRSM = 0
92  DO IGC = 1,NGC(5)
93    Z_SUMF = 0.0_JPRB
94    DO IPR = 1, NGN(NGS(4)+IGC)
95      IPRSM = IPRSM + 1
96
97      Z_SUMF = Z_SUMF + FRACREFBO(IPRSM,JP)
98    ENDDO
99
100    FRACREFB(IGC,JP) = Z_SUMF
101  ENDDO
102ENDDO
103
104IPRSM = 0
105DO IGC = 1,NGC(5)
106  Z_SUMK = 0.0_JPRB
107  DO IPR = 1, NGN(NGS(4)+IGC)
108    IPRSM = IPRSM + 1
109
110    Z_SUMK = Z_SUMK + CCL4O(IPRSM)*RWGT(IPRSM+64)
111  ENDDO
112
113  CCL4(IGC) = Z_SUMK
114ENDDO
115
116DO JP = 1,9
117  DO IGC = 1,NGC(5)
118
119    FREFA(NGS(4)+IGC,JP) = FRACREFA(IGC,JP)
120  ENDDO
121ENDDO
122DO JP = 1,8
123  DO IGC = 1,NGC(5)
124
125    FREFADF(NGS(4)+IGC,JP) = FRACREFA(IGC,JP+1) -FRACREFA(IGC,JP)
126  ENDDO
127ENDDO
128DO JP = 1,5
129  DO IGC = 1,NGC(5)
130
131    FREFB(NGS(4)+IGC,JP) = FRACREFB(IGC,JP)
132  ENDDO
133ENDDO
134DO JP = 1,4
135  DO IGC = 1,NGC(5)
136
137    FREFBDF(NGS(4)+IGC,JP) = FRACREFB(IGC,JP+1) -FRACREFB(IGC,JP)
138  ENDDO
139ENDDO
140
141IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB5',1,ZHOOK_HANDLE)
142END SUBROUTINE RRTM_CMBGB5
Note: See TracBrowser for help on using the repository browser.