source: LMDZ5/trunk/libf/phylmd/rrtm/rrtm_cmbgb1.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.4 KB
Line 
1!***************************************************************************
2SUBROUTINE RRTM_CMBGB1
3!***************************************************************************
4
5!  The subroutines CMBGB1->CMBGB16 input the absorption coefficient
6!  data for each band, which are defined for 16 g-points and 16 spectral
7!  bands. The data are combined with appropriate weighting following the
8!  g-point mapping arrays specified in RRTMINIT.  Plank fraction data
9!  in arrays FRACREFA and FRACREFB are combined without weighting.  All
10!  g-point reduced data are put into new arrays for use in RRTM.
11
12!  BAND 1:  10-250 cm-1 (low - H2O; high - H2O)
13!***************************************************************************
14
15! Parameters
16USE PARKIND1  ,ONLY : JPIM     ,JPRB
17USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
18
19USE YOERRTO1 , ONLY : KAO, KBO, SELFREFO, FORREFO, FRACREFAO,FRACREFBO
20USE YOERRTA1 , ONLY : KA , KB , SELFREF , FORREF , FRACREFA ,FRACREFB
21USE YOERRTRWT, ONLY : FREFA    ,FREFB    ,RWGT
22USE YOERRTFTR, ONLY : NGC      ,NGN     
23
24IMPLICIT NONE
25
26INTEGER(KIND=JPIM) :: IGC, IPR, IPRSM, JP, JT
27
28REAL(KIND=JPRB) :: Z_SUMF1, Z_SUMF2, Z_SUMK
29REAL(KIND=JPRB) :: ZHOOK_HANDLE
30
31IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB1',0,ZHOOK_HANDLE)
32DO JT = 1,5
33  DO JP = 1,13
34    IPRSM = 0
35    DO IGC = 1,NGC(1)
36      Z_SUMK = 0.0_JPRB
37      DO IPR = 1, NGN(IGC)
38        IPRSM = IPRSM + 1
39
40        Z_SUMK = Z_SUMK + KAO(JT,JP,IPRSM)*RWGT(IPRSM)
41      ENDDO
42
43      KA(JT,JP,IGC) = Z_SUMK
44    ENDDO
45  ENDDO
46  DO JP = 13,59
47    IPRSM = 0
48    DO IGC = 1,NGC(1)
49      Z_SUMK = 0.0_JPRB
50      DO IPR = 1, NGN(IGC)
51        IPRSM = IPRSM + 1
52
53        Z_SUMK = Z_SUMK + KBO(JT,JP,IPRSM)*RWGT(IPRSM)
54      ENDDO
55
56      KB(JT,JP,IGC) = Z_SUMK
57    ENDDO
58  ENDDO
59ENDDO
60
61DO JT = 1,10
62  IPRSM = 0
63  DO IGC = 1,NGC(1)
64    Z_SUMK = 0.0_JPRB
65    DO IPR = 1, NGN(IGC)
66      IPRSM = IPRSM + 1
67
68      Z_SUMK = Z_SUMK + SELFREFO(JT,IPRSM)*RWGT(IPRSM)
69    ENDDO
70
71    SELFREF(JT,IGC) = Z_SUMK
72  ENDDO
73ENDDO
74
75IPRSM = 0
76DO IGC = 1,NGC(1)
77  Z_SUMK = 0.0_JPRB
78  Z_SUMF1 = 0.0_JPRB
79  Z_SUMF2 = 0.0_JPRB
80  DO IPR = 1, NGN(IGC)
81    IPRSM = IPRSM + 1
82
83    Z_SUMK = Z_SUMK + FORREFO(IPRSM)*RWGT(IPRSM)
84    Z_SUMF1= Z_SUMF1+ FRACREFAO(IPRSM)
85    Z_SUMF2= Z_SUMF2+ FRACREFBO(IPRSM)
86  ENDDO
87
88  FORREF(IGC) = Z_SUMK
89  FRACREFA(IGC) = Z_SUMF1
90  FRACREFB(IGC) = Z_SUMF2
91ENDDO
92
93DO IGC = 1,NGC(1)
94
95  FREFA(IGC,1) = FRACREFA(IGC)
96  FREFB(IGC,1) = FRACREFB(IGC)
97ENDDO
98
99IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB1',1,ZHOOK_HANDLE)
100END SUBROUTINE RRTM_CMBGB1
Note: See TracBrowser for help on using the repository browser.