source: LMDZ5/trunk/libf/phylmd/rrtm/rrtm_cmbgb8.F90 @ 5192

Last change on this file since 5192 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.8 KB
RevLine 
[1989]1!***************************************************************************
2SUBROUTINE RRTM_CMBGB8
3!***************************************************************************
4
5!     BAND 8:  1080-1180 cm-1 (low (i.e.>~300mb) - H2O; high - O3)
6!***************************************************************************
7
8! Parameters
9USE PARKIND1  ,ONLY : JPIM     ,JPRB
10USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
11
12USE YOERRTO8 , ONLY : KAO     ,KBO     ,SELFREFO   ,FRACREFAO  ,&
13 & FRACREFBO, ABSCO2AO,ABSCO2BO,ABSN2OAO   ,ABSN2OBO   ,&
14 & CFC12O   , CFC22ADJO 
15USE YOERRTA8 , ONLY : KA      ,KB      ,SELFREF    ,FRACREFA   ,&
16 & FRACREFB , ABSCO2A ,ABSCO2B ,ABSN2OA    ,ABSN2OB    ,&
17 & CFC12    , CFC22ADJ 
18USE YOERRTRWT, ONLY : FREFA    ,FREFB    ,RWGT
19USE YOERRTFTR, ONLY : NGC      ,NGS      ,NGN     
20
21IMPLICIT NONE
22
23INTEGER(KIND=JPIM) :: IGC, IPR, IPRSM, JP, JT
24
25REAL(KIND=JPRB) :: Z_SUMF1, Z_SUMF2, Z_SUMK, Z_SUMK1, Z_SUMK2, Z_SUMK3, Z_SUMK4, Z_SUMK5, Z_SUMK6
26REAL(KIND=JPRB) :: ZHOOK_HANDLE
27
28IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB8',0,ZHOOK_HANDLE)
29DO JT = 1,5
30  DO JP = 1,7
31    IPRSM = 0
32    DO IGC = 1,NGC(8)
33      Z_SUMK = 0.0_JPRB
34      DO IPR = 1, NGN(NGS(7)+IGC)
35        IPRSM = IPRSM + 1
36        Z_SUMK = Z_SUMK + KAO(JT,JP,IPRSM)*RWGT(IPRSM+112)
37      ENDDO
38      KA(JT,JP,IGC) = Z_SUMK
39    ENDDO
40  ENDDO
41ENDDO
42DO JT = 1,5
43  DO JP = 7,59
44    IPRSM = 0
45    DO IGC = 1,NGC(8)
46      Z_SUMK = 0.0_JPRB
47      DO IPR = 1, NGN(NGS(7)+IGC)
48        IPRSM = IPRSM + 1
49        Z_SUMK = Z_SUMK + KBO(JT,JP,IPRSM)*RWGT(IPRSM+112)
50      ENDDO
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(8)
59    Z_SUMK = 0.0_JPRB
60    DO IPR = 1, NGN(NGS(7)+IGC)
61      IPRSM = IPRSM + 1
62      Z_SUMK = Z_SUMK + SELFREFO(JT,IPRSM)*RWGT(IPRSM+112)
63    ENDDO
64    SELFREF(JT,IGC) = Z_SUMK
65  ENDDO
66ENDDO
67
68IPRSM = 0
69DO IGC = 1,NGC(8)
70  Z_SUMF1= 0.0_JPRB
71  Z_SUMF2= 0.0_JPRB
72  Z_SUMK1= 0.0_JPRB
73  Z_SUMK2= 0.0_JPRB
74  Z_SUMK3= 0.0_JPRB
75  Z_SUMK4= 0.0_JPRB
76  Z_SUMK5= 0.0_JPRB
77  Z_SUMK6= 0.0_JPRB
78  DO IPR = 1, NGN(NGS(7)+IGC)
79    IPRSM = IPRSM + 1
80    Z_SUMF1= Z_SUMF1+ FRACREFAO(IPRSM)
81    Z_SUMF2= Z_SUMF2+ FRACREFBO(IPRSM)
82    Z_SUMK1= Z_SUMK1+ ABSCO2AO(IPRSM)*RWGT(IPRSM+112)
83    Z_SUMK2= Z_SUMK2+ ABSCO2BO(IPRSM)*RWGT(IPRSM+112)
84    Z_SUMK3= Z_SUMK3+ ABSN2OAO(IPRSM)*RWGT(IPRSM+112)
85    Z_SUMK4= Z_SUMK4+ ABSN2OBO(IPRSM)*RWGT(IPRSM+112)
86    Z_SUMK5= Z_SUMK5+ CFC12O(IPRSM)*RWGT(IPRSM+112)
87    Z_SUMK6= Z_SUMK6+ CFC22ADJO(IPRSM)*RWGT(IPRSM+112)
88  ENDDO
89  FRACREFA(IGC) = Z_SUMF1
90  FRACREFB(IGC) = Z_SUMF2
91  ABSCO2A(IGC) = Z_SUMK1
92  ABSCO2B(IGC) = Z_SUMK2
93  ABSN2OA(IGC) = Z_SUMK3
94  ABSN2OB(IGC) = Z_SUMK4
95  CFC12(IGC) = Z_SUMK5
96  CFC22ADJ(IGC) = Z_SUMK6
97ENDDO
98
99DO IGC = 1,NGC(8)
100  FREFA(NGS(7)+IGC,1) = FRACREFA(IGC)
101  FREFB(NGS(7)+IGC,1) = FRACREFB(IGC)
102ENDDO
103
104IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB8',1,ZHOOK_HANDLE)
105END SUBROUTINE RRTM_CMBGB8
Note: See TracBrowser for help on using the repository browser.