source: LMDZ5/trunk/libf/phymar/rrtm_cmbgb12.F90 @ 3605

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

Inclusion de la physique de MAR


Integration of MAR physics

File size: 2.7 KB
Line 
1!***************************************************************************
2SUBROUTINE RRTM_CMBGB12
3!***************************************************************************
4
5!     BAND 12:  1800-2080 cm-1 (low - H2O,CO2; high - nothing)
6!***************************************************************************
7
8! Parameters
9#include "tsmbkind.h"
10
11USE PARRRTM  , ONLY : JPBAND   ,JPG      ,JPXSEC   ,JPGPT
12
13USE YOERRTO12, ONLY : KAO     ,SELFREFO   ,FRACREFAO
14USE YOERRTA12, ONLY : KA      ,SELFREF    ,FRACREFA                        &
15             &      , ABSA    ,NG12
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, JN, JP, JT
23INTEGER_M :: MEQ, NEQ                ! To force equivalence, HG, 13-DEC-2003
24
25!     LOCAL REAL SCALARS
26REAL_B :: SUMF, SUMK
27
28
29DO JN = 1,9
30  DO JT = 1,5
31    DO JP = 1,13
32      IPRSM = 0
33      DO IGC = 1,NGC(12)
34        SUMK = _ZERO_
35        DO IPR = 1, NGN(NGS(11)+IGC)
36          IPRSM = IPRSM + 1
37
38          SUMK = SUMK + KAO(JN,JT,JP,IPRSM)*RWGT(IPRSM+176)
39        ENDDO
40
41        KA(JN,JT,JP,IGC) = SUMK
42      ENDDO
43    ENDDO
44  ENDDO
45ENDDO
46
47DO JT = 1,10
48  IPRSM = 0
49  DO IGC = 1,NGC(12)
50    SUMK = _ZERO_
51    DO IPR = 1, NGN(NGS(11)+IGC)
52      IPRSM = IPRSM + 1
53
54      SUMK = SUMK + SELFREFO(JT,IPRSM)*RWGT(IPRSM+176)
55    ENDDO
56
57    SELFREF(JT,IGC) = SUMK
58  ENDDO
59ENDDO
60
61DO JP = 1,9
62  IPRSM = 0
63  DO IGC = 1,NGC(12)
64    SUMF = _ZERO_
65    DO IPR = 1, NGN(NGS(11)+IGC)
66      IPRSM = IPRSM + 1
67
68      SUMF = SUMF + FRACREFAO(IPRSM,JP)
69    ENDDO
70
71    FRACREFA(IGC,JP) = SUMF
72  ENDDO
73ENDDO
74
75DO JP = 1,9
76  DO IGC = 1,NGC(12)
77
78    FREFA(NGS(11)+IGC,JP) = FRACREFA(IGC,JP)
79  ENDDO
80ENDDO
81DO JP = 1,8
82  DO IGC = 1,NGC(12)
83
84
85    FREFADF(NGS(11)+IGC,JP) = FRACREFA(IGC,JP+1) -FRACREFA(IGC,JP)
86  ENDDO
87ENDDO
88
89
90! +--Force the equivalence: BEGIN (HG, 13-DEC-2003)
91! +  ============================
92
93! +--ABSA
94! +  ^^^^
95         JN  = 0
96         JT  = 1
97         JP  = 1
98         IGC = 1
99      DO NEQ=1,NG12
100      DO MEQ=1,585
101             JN =  JN  + 1
102      IF   ( JN == 9   + 1)                                         THEN
103             JN =  1
104             JT =  JT  + 1
105       IF  ( JT == 5   + 1 )                                        THEN
106             JT =  1
107             JP =  JP  + 1
108        IF ( JP == 13  + 1 )                                        THEN
109             JP =  1
110             IGC=  IGC + 1
111        END IF
112       END IF
113      END IF
114             ABSA(MEQ,NEQ) = KA(JN,JT,JP,IGC)
115      ENDDO
116      ENDDO
117
118! +--Force the equivalence: END   (HG, 13-DEC-2003)
119! +  ==========================
120
121
122RETURN
123END SUBROUTINE RRTM_CMBGB12
Note: See TracBrowser for help on using the repository browser.