source: LMDZ5/trunk/libf/phylmd/rrtm/rrtm_cmbgb3.F90 @ 5001

Last change on this file since 5001 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: 3.0 KB
RevLine 
[1989]1!***************************************************************************
2SUBROUTINE RRTM_CMBGB3
3!***************************************************************************
4
5!     BAND 3:  500-630 cm-1 (low - H2O,CO2; high - H2O,CO2)
6!***************************************************************************
7
8! Parameters
9USE PARKIND1  ,ONLY : JPIM     ,JPRB
10USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
11
12USE YOERRTO3 , ONLY : KAO     ,KBO     ,SELFREFO   ,FRACREFAO  ,&
13 & FRACREFBO  ,FORREFO    ,ABSN2OAO   ,ABSN2OBO 
14USE YOERRTA3 , ONLY : KA      ,KB      ,SELFREF    ,FRACREFA   ,&
15 & FRACREFB   ,FORREF    ,ABSN2OA   ,ABSN2OB 
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, Z_SUMK1, Z_SUMK2, Z_SUMK3
24REAL(KIND=JPRB) :: ZHOOK_HANDLE
25
26IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB3',0,ZHOOK_HANDLE)
27DO JN = 1,10
28  DO JT = 1,5
29    DO JP = 1,13
30      IPRSM = 0
31      DO IGC = 1,NGC(3)
32        Z_SUMK = 0.0_JPRB
33        DO IPR = 1, NGN(NGS(2)+IGC)
34          IPRSM = IPRSM + 1
35
36          Z_SUMK = Z_SUMK + KAO(JN,JT,JP,IPRSM)*RWGT(IPRSM+32)
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(3)
49        Z_SUMK = 0.0_JPRB
50        DO IPR = 1, NGN(NGS(2)+IGC)
51          IPRSM = IPRSM + 1
52
53          Z_SUMK = Z_SUMK + KBO(JN,JT,JP,IPRSM)*RWGT(IPRSM+32)
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(3)
65    Z_SUMK = 0.0_JPRB
66    Z_SUMF = 0.0_JPRB
67    DO IPR = 1, NGN(NGS(2)+IGC)
68      IPRSM = IPRSM + 1
69
70      Z_SUMK = Z_SUMK + SELFREFO(JT,IPRSM)*RWGT(IPRSM+32)
71      Z_SUMF = Z_SUMF + FRACREFAO(IPRSM,JT)
72    ENDDO
73
74    SELFREF(JT,IGC) = Z_SUMK
75    FRACREFA(IGC,JT) = Z_SUMF
76  ENDDO
77ENDDO
78
79DO JP = 1,5
80  IPRSM = 0
81  DO IGC = 1,NGC(3)
82    Z_SUMF = 0.0_JPRB
83    DO IPR = 1, NGN(NGS(2)+IGC)
84      IPRSM = IPRSM + 1
85
86      Z_SUMF = Z_SUMF + FRACREFBO(IPRSM,JP)
87    ENDDO
88
89    FRACREFB(IGC,JP) = Z_SUMF
90  ENDDO
91ENDDO
92
93IPRSM = 0
94DO IGC = 1,NGC(3)
95  Z_SUMK1= 0.0_JPRB
96  Z_SUMK2= 0.0_JPRB
97  Z_SUMK3= 0.0_JPRB
98  DO IPR = 1, NGN(NGS(2)+IGC)
99    IPRSM = IPRSM + 1
100
101    Z_SUMK1= Z_SUMK1+ FORREFO(IPRSM)*RWGT(IPRSM+32)
102    Z_SUMK2= Z_SUMK2+ ABSN2OAO(IPRSM)*RWGT(IPRSM+32)
103    Z_SUMK3= Z_SUMK3+ ABSN2OBO(IPRSM)*RWGT(IPRSM+32)
104  ENDDO
105
106  FORREF(IGC) = Z_SUMK1
107  ABSN2OA(IGC) = Z_SUMK2
108  ABSN2OB(IGC) = Z_SUMK3
109ENDDO
110
111DO JP = 1,10
112  DO IGC = 1,NGC(3)
113
114    FREFA(NGS(2)+IGC,JP) = FRACREFA(IGC,JP)
115  ENDDO
116ENDDO
117DO JP = 1,9
118  DO IGC = 1,NGC(3)
119
120    FREFADF(NGS(2)+IGC,JP) = FRACREFA(IGC,JP+1) -FRACREFA(IGC,JP)
121  ENDDO
122ENDDO
123DO JP = 1,5
124  DO IGC = 1,NGC(3)
125
126    FREFB(NGS(2)+IGC,JP) = FRACREFB(IGC,JP)
127  ENDDO
128ENDDO
129DO JP = 1,4
130  DO IGC = 1,NGC(3)
131
132    FREFBDF(NGS(2)+IGC,JP) = FRACREFB(IGC,JP+1) -FRACREFB(IGC,JP)
133  ENDDO
134ENDDO
135
136IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB3',1,ZHOOK_HANDLE)
137END SUBROUTINE RRTM_CMBGB3
Note: See TracBrowser for help on using the repository browser.