source: LMDZ5/trunk/libf/phylmd/rrtm/rrtm_cmbgb6.F90 @ 5224

Last change on this file since 5224 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.0 KB
Line 
1!***************************************************************************
2SUBROUTINE RRTM_CMBGB6
3!***************************************************************************
4
5!     BAND 6:  820-980 cm-1 (low - H2O; high - nothing)
6!***************************************************************************
7
8! Parameters
9USE PARKIND1  ,ONLY : JPIM     ,JPRB
10USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
11
12USE YOERRTO6 , ONLY : KAO     ,SELFREFO   ,FRACREFAO  ,&
13 & ABSCO2O ,CFC11ADJO,CFC12O 
14USE YOERRTA6 , ONLY : KA      ,SELFREF    ,FRACREFA   ,&
15 & ABSCO2  ,CFC11ADJ ,CFC12 
16USE YOERRTRWT, ONLY : FREFA    ,FREFB    ,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, Z_SUMK1, Z_SUMK2, Z_SUMK3
24REAL(KIND=JPRB) :: ZHOOK_HANDLE
25
26IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB6',0,ZHOOK_HANDLE)
27DO JT = 1,5
28  DO JP = 1,13
29    IPRSM = 0
30    DO IGC = 1,NGC(6)
31      Z_SUMK = 0.0_JPRB
32      DO IPR = 1, NGN(NGS(5)+IGC)
33        IPRSM = IPRSM + 1
34
35        Z_SUMK = Z_SUMK + KAO(JT,JP,IPRSM)*RWGT(IPRSM+80)
36      ENDDO
37
38      KA(JT,JP,IGC) = Z_SUMK
39    ENDDO
40  ENDDO
41ENDDO
42
43DO JT = 1,10
44  IPRSM = 0
45  DO IGC = 1,NGC(6)
46    Z_SUMK = 0.0_JPRB
47    DO IPR = 1, NGN(NGS(5)+IGC)
48      IPRSM = IPRSM + 1
49
50      Z_SUMK = Z_SUMK + SELFREFO(JT,IPRSM)*RWGT(IPRSM+80)
51    ENDDO
52
53    SELFREF(JT,IGC) = Z_SUMK
54  ENDDO
55ENDDO
56
57IPRSM = 0
58DO IGC = 1,NGC(6)
59  Z_SUMF = 0.0_JPRB
60  Z_SUMK1= 0.0_JPRB
61  Z_SUMK2= 0.0_JPRB
62  Z_SUMK3= 0.0_JPRB
63  DO IPR = 1, NGN(NGS(5)+IGC)
64    IPRSM = IPRSM + 1
65
66    Z_SUMF = Z_SUMF + FRACREFAO(IPRSM)
67    Z_SUMK1= Z_SUMK1+ ABSCO2O(IPRSM)*RWGT(IPRSM+80)
68    Z_SUMK2= Z_SUMK2+ CFC11ADJO(IPRSM)*RWGT(IPRSM+80)
69    Z_SUMK3= Z_SUMK3+ CFC12O(IPRSM)*RWGT(IPRSM+80)
70  ENDDO
71
72  FRACREFA(IGC) = Z_SUMF
73  ABSCO2(IGC) = Z_SUMK1
74  CFC11ADJ(IGC) = Z_SUMK2
75  CFC12(IGC) = Z_SUMK3
76ENDDO
77
78DO IGC = 1,NGC(6)
79
80  FREFA(NGS(5)+IGC,1) = FRACREFA(IGC)
81  FREFB(NGS(5)+IGC,1) = FRACREFA(IGC)
82ENDDO
83
84IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB6',1,ZHOOK_HANDLE)
85END SUBROUTINE RRTM_CMBGB6
Note: See TracBrowser for help on using the repository browser.