source: LMDZ6/branches/LMDZ-COSP/libf/phylmd/rrtm/rrtm_cmbgb2.F90 @ 3847

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