source: LMDZ5/branches/LMDZ5_SPLA/libf/phylmd/rrtm/rrtm_cmbgb14.F90

Last change on this file 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_CMBGB14
3!***************************************************************************
4
5!     BAND 14:  2250-2380 cm-1 (low - CO2; high - CO2)
6!***************************************************************************
7
8! Parameters
9USE PARKIND1  ,ONLY : JPIM     ,JPRB
10USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
11
12USE YOERRTO14, ONLY : KAO     ,KBO     ,SELFREFO   ,FRACREFAO  ,FRACREFBO
13USE YOERRTA14, ONLY : KA      ,KB      ,SELFREF    ,FRACREFA   ,FRACREFB
14USE YOERRTRWT, ONLY : FREFA    ,FREFB    ,RWGT
15USE YOERRTFTR, ONLY : NGC      ,NGS      ,NGN     
16
17IMPLICIT NONE
18
19INTEGER(KIND=JPIM) :: IGC, IPR, IPRSM, JP, JT
20
21REAL(KIND=JPRB) :: Z_SUMF1, Z_SUMF2, Z_SUMK
22REAL(KIND=JPRB) :: ZHOOK_HANDLE
23
24IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB14',0,ZHOOK_HANDLE)
25DO JT = 1,5
26  DO JP = 1,13
27    IPRSM = 0
28    DO IGC = 1,NGC(14)
29      Z_SUMK = 0.0_JPRB
30      DO IPR = 1, NGN(NGS(13)+IGC)
31        IPRSM = IPRSM + 1
32
33        Z_SUMK = Z_SUMK + KAO(JT,JP,IPRSM)*RWGT(IPRSM+208)
34      ENDDO
35
36      KA(JT,JP,IGC) = Z_SUMK
37    ENDDO
38  ENDDO
39ENDDO
40
41DO JT = 1,5
42  DO JP = 13,59
43    IPRSM = 0
44    DO IGC = 1,NGC(14)
45      Z_SUMK = 0.0_JPRB
46      DO IPR = 1, NGN(NGS(13)+IGC)
47        IPRSM = IPRSM + 1
48
49        Z_SUMK = Z_SUMK + KBO(JT,JP,IPRSM)*RWGT(IPRSM+208)
50      ENDDO
51
52      KB(JT,JP,IGC) = Z_SUMK
53    ENDDO
54  ENDDO
55ENDDO
56
57DO JT = 1,10
58  IPRSM = 0
59  DO IGC = 1,NGC(14)
60    Z_SUMK = 0.0_JPRB
61    DO IPR = 1, NGN(NGS(13)+IGC)
62      IPRSM = IPRSM + 1
63
64      Z_SUMK = Z_SUMK + SELFREFO(JT,IPRSM)*RWGT(IPRSM+208)
65    ENDDO
66
67    SELFREF(JT,IGC) = Z_SUMK
68  ENDDO
69ENDDO
70
71IPRSM = 0
72DO IGC = 1,NGC(14)
73  Z_SUMF1= 0.0_JPRB
74  Z_SUMF2= 0.0_JPRB
75  DO IPR = 1, NGN(NGS(13)+IGC)
76    IPRSM = IPRSM + 1
77
78    Z_SUMF1= Z_SUMF1+ FRACREFAO(IPRSM)
79    Z_SUMF2= Z_SUMF2+ FRACREFBO(IPRSM)
80  ENDDO
81
82  FRACREFA(IGC) = Z_SUMF1
83  FRACREFB(IGC) = Z_SUMF2
84ENDDO
85
86DO IGC = 1,NGC(14)
87
88  FREFA(NGS(13)+IGC,1) = FRACREFA(IGC)
89  FREFB(NGS(13)+IGC,1) = FRACREFB(IGC)
90ENDDO
91
92IF (LHOOK) CALL DR_HOOK('RRTM_CMBGB14',1,ZHOOK_HANDLE)
93END SUBROUTINE RRTM_CMBGB14
Note: See TracBrowser for help on using the repository browser.