source: LMDZ5/trunk/libf/phymar/rrtm_cmbgb10.F90 @ 4116

Last change on this file since 4116 was 2089, checked in by Laurent Fairhead, 10 years ago

Inclusion de la physique de MAR


Integration of MAR physics

File size: 2.9 KB
Line 
1!***************************************************************************
2SUBROUTINE RRTM_CMBGB10
3!***************************************************************************
4
5!     BAND 10:  1390-1480 cm-1 (low - H2O; high - H2O)
6!***************************************************************************
7
8! Parameters
9#include "tsmbkind.h"
10
11USE PARRRTM  , ONLY : JPBAND   ,JPG      ,JPXSEC   ,JPGPT
12
13USE YOERRTO10, ONLY : KAO     ,KBO      ,FRACREFAO   ,FRACREFBO
14USE YOERRTA10, ONLY : KA      ,KB       ,FRACREFA    ,FRACREFB             &
15             &      , ABSA    ,ABSB     ,NG10
16USE YOERRTRWT, ONLY : FREFA    ,FREFB    ,FREFADF  ,FREFBDF   ,RWGT
17USE YOERRTFTR, ONLY : NGC      ,NGS      ,NGN      ,NGB       ,NGM     , WT
18
19IMPLICIT NONE
20
21!     LOCAL INTEGER SCALARS
22INTEGER_M :: IGC, IPR, IPRSM, JP, JT
23INTEGER_M :: MEQ, NEQ                ! To force equivalence, HG, 13-DEC-2003
24
25!     LOCAL REAL SCALARS
26REAL_B :: SUMF1, SUMF2, SUMK
27
28
29DO JT = 1,5
30  DO JP = 1,13
31    IPRSM = 0
32    DO IGC = 1,NGC(10)
33      SUMK = _ZERO_
34      DO IPR = 1, NGN(NGS(9)+IGC)
35        IPRSM = IPRSM + 1
36
37        SUMK = SUMK + KAO(JT,JP,IPRSM)*RWGT(IPRSM+144)
38      ENDDO
39
40      KA(JT,JP,IGC) = SUMK
41    ENDDO
42  ENDDO
43ENDDO
44DO JT = 1,5
45  DO JP = 13,59
46    IPRSM = 0
47    DO IGC = 1,NGC(10)
48      SUMK = _ZERO_
49      DO IPR = 1, NGN(NGS(9)+IGC)
50        IPRSM = IPRSM + 1
51
52        SUMK = SUMK + KBO(JT,JP,IPRSM)*RWGT(IPRSM+144)
53      ENDDO
54
55      KB(JT,JP,IGC) = SUMK
56    ENDDO
57  ENDDO
58ENDDO
59
60IPRSM = 0
61DO IGC = 1,NGC(10)
62  SUMF1= _ZERO_
63  SUMF2= _ZERO_
64  DO IPR = 1, NGN(NGS(9)+IGC)
65    IPRSM = IPRSM + 1
66
67
68    SUMF1= SUMF1+ FRACREFAO(IPRSM)
69    SUMF2= SUMF2+ FRACREFBO(IPRSM)
70  ENDDO
71
72
73  FRACREFA(IGC) = SUMF1
74  FRACREFB(IGC) = SUMF2
75ENDDO
76
77DO IGC = 1,NGC(10)
78
79
80  FREFA(NGS(9)+IGC,1) = FRACREFA(IGC)
81  FREFB(NGS(9)+IGC,1) = FRACREFB(IGC)
82ENDDO
83
84
85! +--Force the equivalence: BEGIN (HG, 13-DEC-2003)
86! +  ============================
87
88! +--ABSA
89! +  ^^^^
90         JT  = 0
91         JP  = 1
92         IGC = 1
93      DO NEQ=1,NG10
94      DO MEQ=1,65
95             JT =  JT  + 1
96       IF  ( JT == 5   + 1 )                                        THEN
97             JT =  1
98             JP =  JP  + 1
99        IF ( JP == 13  + 1 )                                        THEN
100             JP =  1
101             IGC=  IGC + 1
102        END IF
103       END IF
104             ABSA(MEQ,NEQ) = KA(JT,JP,IGC)
105      ENDDO
106      ENDDO
107
108! +--ABSB
109! +  ^^^^
110         JT  = 0
111         JP  = 13
112         IGC = 1
113      DO NEQ=1,NG10
114      DO MEQ=1,235
115             JT =  JT  + 1
116       IF  ( JT == 5   + 1 )                                        THEN
117             JT =  1
118             JP =  JP  + 1
119        IF ( JP == 59  + 1 )                                        THEN
120             JP =  13
121             IGC=  IGC + 1
122        END IF
123       END IF
124             ABSB(MEQ,NEQ) = KB(JT,JP,IGC)
125      ENDDO
126      ENDDO
127
128! +--Force the equivalence: END   (HG, 13-DEC-2003)
129! +  ==========================
130
131
132RETURN
133END SUBROUTINE RRTM_CMBGB10
Note: See TracBrowser for help on using the repository browser.