source: LMDZ5/branches/IPSLCM6.0.12/libf/phylmd/rrtm/srtm_init.F90 @ 4400

Last change on this file since 4400 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: 3.2 KB
Line 
1SUBROUTINE SRTM_INIT
2
3!-- read in the basic coefficients to configure RRTM_SW
4!- creates module YOESRTWN with BG, NSPA, NSPB, WAVENUM1, WAVENUM2,
5!  DELWAVE, PREF, PREFLOG, TREF
6
7USE PARKIND1  ,ONLY : JPIM , JPRB
8USE YOMHOOK   ,ONLY : LHOOK, DR_HOOK
9
10USE PARSRTM  , ONLY : JPG, JPSW
11USE YOESRTWN , ONLY : NG, NGM, WT, NGC, NGN, RWGT, WTSM
12
13IMPLICIT NONE
14
15! Local variables
16INTEGER(KIND=JPIM) :: IGC, IGCSM, IBND, IG, IND, IPR, IPRSM
17REAL(KIND=JPRB)    :: ZWTSUM
18
19REAL(KIND=JPRB) :: ZHOOK_HANDLE
20
21#include "susrtm.intfb.h"
22#include "srtm_kgb16.intfb.h"
23#include "srtm_kgb17.intfb.h"
24#include "srtm_kgb18.intfb.h"
25#include "srtm_kgb19.intfb.h"
26#include "srtm_kgb20.intfb.h"
27#include "srtm_kgb21.intfb.h"
28#include "srtm_kgb22.intfb.h"
29#include "srtm_kgb23.intfb.h"
30#include "srtm_kgb24.intfb.h"
31#include "srtm_kgb25.intfb.h"
32#include "srtm_kgb26.intfb.h"
33#include "srtm_kgb27.intfb.h"
34#include "srtm_kgb28.intfb.h"
35#include "srtm_kgb29.intfb.h"
36!#include "susrtop.intfb.h"
37
38#include "srtm_cmbgb16.intfb.h"
39#include "srtm_cmbgb17.intfb.h"
40#include "srtm_cmbgb18.intfb.h"
41#include "srtm_cmbgb19.intfb.h"
42#include "srtm_cmbgb20.intfb.h"
43#include "srtm_cmbgb21.intfb.h"
44#include "srtm_cmbgb22.intfb.h"
45#include "srtm_cmbgb23.intfb.h"
46#include "srtm_cmbgb24.intfb.h"
47#include "srtm_cmbgb25.intfb.h"
48#include "srtm_cmbgb26.intfb.h"
49#include "srtm_cmbgb27.intfb.h"
50#include "srtm_cmbgb28.intfb.h"
51#include "srtm_cmbgb29.intfb.h"
52
53IF (LHOOK) CALL DR_HOOK('SRTM_INIT',0,ZHOOK_HANDLE)
54
55CALL SUSRTM
56
57!-- read in the molecular absorption coefficients
58
59CALL SRTM_KGB16
60CALL SRTM_KGB17
61CALL SRTM_KGB18
62CALL SRTM_KGB19
63CALL SRTM_KGB20
64CALL SRTM_KGB21
65CALL SRTM_KGB22
66CALL SRTM_KGB23
67CALL SRTM_KGB24
68CALL SRTM_KGB25
69CALL SRTM_KGB26
70CALL SRTM_KGB27
71CALL SRTM_KGB28
72CALL SRTM_KGB29
73
74!-- read in the cloud optical properties
75!- creates module YOESRTOP with EXTLIQ1, SSALIQ1, ASYLIQ1,
76!  EXTICE3, SSAICE3, ASYICE3, FDLICE3 
77
78!-- RRTM_SW cloud optical properties are not used
79!   SRTM_CLDPROP is not called
80!   no need to call SUSRTOP
81
82!CALL SUSRTOP ( -1 )
83
84
85!Mike Iacono 20050804
86!-- Perform g-point reduction from 16 per band (224 total points) to
87!-- a band dependent number (112 total points) for all absorption
88!-- coefficient input data and Planck fraction input data.
89!-- Compute relative weighting for new g-point combinations.
90
91IGCSM = 0
92DO IBND = 1,JPSW
93  IPRSM = 0
94  IF (NGC(IBND) < JPG) THEN
95    DO IGC = 1,NGC(IBND)
96      IGCSM = IGCSM + 1
97      ZWTSUM = 0.
98      DO IPR = 1, NGN(IGCSM)
99        IPRSM = IPRSM + 1
100        ZWTSUM = ZWTSUM + WT(IPRSM)
101      ENDDO
102      WTSM(IGC) = ZWTSUM
103    ENDDO
104
105    DO IG = 1,NG(IBND+15)
106      IND = (IBND-1)*JPG + IG
107      RWGT(IND) = WT(IG)/WTSM(NGM(IND))
108    ENDDO
109  ELSE
110    DO IG = 1,NG(IBND+15)
111      IGCSM = IGCSM + 1
112      IND = (IBND-1)*JPG + IG
113      RWGT(IND) = 1.0
114    ENDDO
115  ENDIF
116ENDDO
117
118CALL SRTM_CMBGB16
119CALL SRTM_CMBGB17
120CALL SRTM_CMBGB18
121CALL SRTM_CMBGB19
122CALL SRTM_CMBGB20
123CALL SRTM_CMBGB21
124CALL SRTM_CMBGB22
125CALL SRTM_CMBGB23
126CALL SRTM_CMBGB24
127CALL SRTM_CMBGB25
128CALL SRTM_CMBGB26
129CALL SRTM_CMBGB27
130CALL SRTM_CMBGB28
131CALL SRTM_CMBGB29
132
133!-----------------------------------------------------------------------
134IF (LHOOK) CALL DR_HOOK('SRTM_INIT',1,ZHOOK_HANDLE)
135END SUBROUTINE SRTM_INIT
136
Note: See TracBrowser for help on using the repository browser.