source: LMDZ5/trunk/libf/phylmd/rrtm/rrtm_cmbgb9.F90 @ 3138

Last change on this file since 3138 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.7 KB
RevLine 
[1989]1!***************************************************************************
2SUBROUTINE RRTM_CMBGB9
3!***************************************************************************
4
5!     BAND 9:  1180-1390 cm-1 (low - H2O,CH4; high - CH4)
6!***************************************************************************
7
8! Parameters
9USE PARKIND1  ,ONLY : JPIM     ,JPRB
10USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
11
12USE YOERRTO9 , ONLY : KAO     ,KBO     ,SELFREFO   ,FRACREFAO  ,&
13 & FRACREFBO, ABSN2OO 
14USE YOERRTA9 , ONLY : KA      ,KB      ,SELFREF    ,FRACREFA  ,&
15 & FRACREFB , ABSN2O 
16USE YOERRTRWT, ONLY : FREFA    ,FREFB    ,FREFADF  ,RWGT
17USE YOERRTFTR, ONLY : NGC      ,NGS      ,NGN     
18
19IMPLICIT NONE
20
21INTEGER(KIND=JPIM) :: IGC, IPR, IPRSM, JN, JND, JNDC, JP, JT
22
23REAL(KIND=JPRB) :: Z_SUMF, Z_SUMK
24REAL(KIND=JPRB) :: ZHOOK_HANDLE
25
26IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB9',0,ZHOOK_HANDLE)
27DO JN = 1,11
28  DO JT = 1,5
29    DO JP = 1,13
30      IPRSM = 0
31      DO IGC = 1,NGC(9)
32        Z_SUMK = 0.0_JPRB
33        DO IPR = 1, NGN(NGS(8)+IGC)
34          IPRSM = IPRSM + 1
35
36          Z_SUMK = Z_SUMK + KAO(JN,JT,JP,IPRSM)*RWGT(IPRSM+128)
37        ENDDO
38
39        KA(JN,JT,JP,IGC) = Z_SUMK
40      ENDDO
41    ENDDO
42  ENDDO
43ENDDO
44
45DO JT = 1,5
46  DO JP = 13,59
47    IPRSM = 0
48    DO IGC = 1,NGC(9)
49      Z_SUMK = 0.0_JPRB
50      DO IPR = 1, NGN(NGS(8)+IGC)
51        IPRSM = IPRSM + 1
52
53        Z_SUMK = Z_SUMK + KBO(JT,JP,IPRSM)*RWGT(IPRSM+128)
54      ENDDO
55
56      KB(JT,JP,IGC) = Z_SUMK
57    ENDDO
58  ENDDO
59ENDDO
60
61DO JT = 1,10
62  IPRSM = 0
63  DO IGC = 1,NGC(9)
64    Z_SUMK = 0.0_JPRB
65    DO IPR = 1, NGN(NGS(8)+IGC)
66      IPRSM = IPRSM + 1
67
68      Z_SUMK = Z_SUMK + SELFREFO(JT,IPRSM)*RWGT(IPRSM+128)
69    ENDDO
70
71    SELFREF(JT,IGC) = Z_SUMK
72  ENDDO
73ENDDO
74
75DO JN = 1,3
76  IPRSM = 0
77  DO IGC = 1,NGC(9)
78    Z_SUMK = 0.0_JPRB
79    DO IPR = 1, NGN(NGS(8)+IGC)
80      IPRSM = IPRSM + 1
81      JND = (JN-1)*16
82
83      Z_SUMK = Z_SUMK + ABSN2OO(JND+IPRSM)*RWGT(IPRSM+128)
84    ENDDO
85    JNDC = (JN-1)*NGC(9)
86
87    ABSN2O(JNDC+IGC) = Z_SUMK
88  ENDDO
89ENDDO
90
91DO JP = 1,9
92  IPRSM = 0
93  DO IGC = 1,NGC(9)
94    Z_SUMF = 0.0_JPRB
95    DO IPR = 1, NGN(NGS(8)+IGC)
96      IPRSM = IPRSM + 1
97
98      Z_SUMF = Z_SUMF + FRACREFAO(IPRSM,JP)
99    ENDDO
100
101    FRACREFA(IGC,JP) = Z_SUMF
102  ENDDO
103ENDDO
104
105IPRSM = 0
106DO IGC = 1,NGC(9)
107  Z_SUMF = 0.0_JPRB
108  DO IPR = 1, NGN(NGS(8)+IGC)
109    IPRSM = IPRSM + 1
110
111    Z_SUMF = Z_SUMF + FRACREFBO(IPRSM)
112  ENDDO
113
114  FRACREFB(IGC) = Z_SUMF
115ENDDO
116
117DO JP = 1,9
118  DO IGC = 1,NGC(9)
119
120    FREFA(NGS(8)+IGC,JP) = FRACREFA(IGC,JP)
121  ENDDO
122ENDDO
123DO JP = 1,8
124  DO IGC = 1,NGC(9)
125
126    FREFADF(NGS(8)+IGC,JP) = FRACREFA(IGC,JP+1) -FRACREFA(IGC,JP)
127  ENDDO
128ENDDO
129DO IGC = 1,NGC(9)
130
131  FREFB(NGS(8)+IGC,1) = FRACREFB(IGC)
132ENDDO
133
134IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB9',1,ZHOOK_HANDLE)
135END SUBROUTINE RRTM_CMBGB9
Note: See TracBrowser for help on using the repository browser.