source: LMDZ6/trunk/libf/phymar/rrtm_cmbgb6.F90 @ 3472

Last change on this file since 3472 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_CMBGB6
3!***************************************************************************
4
5!     BAND 6:  820-980 cm-1 (low - H2O; high - nothing)
6!***************************************************************************
7
8! Parameters
9#include "tsmbkind.h"
10
11USE PARRRTM  , ONLY : JPBAND  ,JPG        ,JPXSEC     ,JPGPT
12
13USE YOERRTO6 , ONLY : KAO     ,SELFREFO   ,FRACREFAO  ,&
14           &ABSCO2O ,CFC11ADJO,CFC12O
15USE YOERRTA6 , ONLY : KA      ,SELFREF    ,FRACREFA   ,&
16             &        ABSCO2  ,CFC11ADJ   ,CFC12      ,&
17             &        ABSA    ,NG6
18USE YOERRTRWT, ONLY : FREFA    ,FREFB    ,FREFADF  ,FREFBDF   ,RWGT
19USE YOERRTFTR, ONLY : NGC      ,NGS      ,NGN      ,NGB       ,NGM     , WT
20
21IMPLICIT NONE
22
23!     LOCAL INTEGER SCALARS
24INTEGER_M :: IGC, IPR, IPRSM, JN, JP, JT
25INTEGER_M :: MEQ, NEQ                    ! To force equivalence, HG, 13-DEC-2003
26
27!     LOCAL REAL SCALARS
28REAL_B :: SUMF, SUMK, SUMK1, SUMK2, SUMK3
29
30
31DO JT = 1,5
32  DO JP = 1,13
33    IPRSM = 0
34    DO IGC = 1,NGC(6)
35      SUMK = _ZERO_
36      DO IPR = 1, NGN(NGS(5)+IGC)
37        IPRSM = IPRSM + 1
38
39        SUMK = SUMK + KAO(JT,JP,IPRSM)*RWGT(IPRSM+80)
40      ENDDO
41
42      KA(JT,JP,IGC) = SUMK
43    ENDDO
44  ENDDO
45ENDDO
46
47DO JT = 1,10
48  IPRSM = 0
49  DO IGC = 1,NGC(6)
50    SUMK = _ZERO_
51    DO IPR = 1, NGN(NGS(5)+IGC)
52      IPRSM = IPRSM + 1
53
54      SUMK = SUMK + SELFREFO(JT,IPRSM)*RWGT(IPRSM+80)
55    ENDDO
56
57    SELFREF(JT,IGC) = SUMK
58  ENDDO
59ENDDO
60
61IPRSM = 0
62DO IGC = 1,NGC(6)
63  SUMF = _ZERO_
64  SUMK1= _ZERO_
65  SUMK2= _ZERO_
66  SUMK3= _ZERO_
67  DO IPR = 1, NGN(NGS(5)+IGC)
68    IPRSM = IPRSM + 1
69
70
71
72
73    SUMF = SUMF + FRACREFAO(IPRSM)
74    SUMK1= SUMK1+ ABSCO2O(IPRSM)*RWGT(IPRSM+80)
75    SUMK2= SUMK2+ CFC11ADJO(IPRSM)*RWGT(IPRSM+80)
76    SUMK3= SUMK3+ CFC12O(IPRSM)*RWGT(IPRSM+80)
77  ENDDO
78
79
80
81
82  FRACREFA(IGC) = SUMF
83  ABSCO2(IGC) = SUMK1
84  CFC11ADJ(IGC) = SUMK2
85  CFC12(IGC) = SUMK3
86ENDDO
87
88DO IGC = 1,NGC(6)
89
90
91  FREFA(NGS(5)+IGC,1) = FRACREFA(IGC)
92  FREFB(NGS(5)+IGC,1) = FRACREFA(IGC)
93ENDDO
94
95
96! +--Force the equivalence: BEGIN (HG, 13-DEC-2003)
97! +  ============================
98
99! +--ABSA
100! +  ^^^^
101         JN  = 0
102         JT  = 1
103         JP  = 1
104      DO NEQ=1,NG6
105      DO MEQ=1,65
106             JN =  JN  + 1
107      IF   ( JN == 5   + 1)                                         THEN
108             JN =  1
109             JT =  JT  + 1
110       IF  ( JT == 13  + 1 )                                        THEN
111             JT =  1
112             JP =  JP  + 1
113       END IF
114      END IF
115             ABSA(MEQ,NEQ) = KA(JN,JT,JP)
116      ENDDO
117      ENDDO
118
119! +--Force the equivalence: END   (HG, 13-DEC-2003)
120! +  ==========================
121
122
123RETURN
124END SUBROUTINE RRTM_CMBGB6
Note: See TracBrowser for help on using the repository browser.