source: LMDZ6/trunk/libf/phylmd/rrtm/rrtm_cmbgb13.F90 @ 5075

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