source: LMDZ5/trunk/libf/phylmd/rrtm/rrtm_cmbgb4.F90 @ 3469

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