source: LMDZ5/branches/testing/libf/phylmd/rrtm/susat.F90 @ 5215

Last change on this file since 5215 was 1999, checked in by Laurent Fairhead, 11 years ago

Merged trunk changes r1920:1997 into testing branch
  • 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: 6.2 KB
RevLine 
[1989]1SUBROUTINE SUSAT
2
3!**** *SUSAT*   - INITIALIZE COMMON YOESAT
4
5!     PURPOSE.
6!     --------
7!           INITIALIZE YOESAT, THE COMMON THAT CONTROLS THE
8!           SIMULATION OF SATELLITE RADIANCES
9
10!**   INTERFACE.
11!     ----------
12!        *CALL* *SUSAT
13
14!        EXPLICIT ARGUMENTS :
15!        --------------------
16!            NONE
17
18!        IMPLICIT ARGUMENTS :
19!        --------------------
20!        COMMON YOESAT
21
22!     METHOD.
23!     -------
24!        SEE DOCUMENTATION
25
26!     EXTERNALS.
27!     ----------
28!        NONE
29
30!     REFERENCE.
31!     ----------
32!        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE
33!     "IN CORE MODEL"
34
35!     AUTHOR.
36!     -------
37!        JEAN-JACQUES MORCRETTE  *ECMWF*
38
39!     MODIFICATIONS.
40!     --------------
41!        ORIGINAL : 88-12-15
42!        M.Hamrud      01-Oct-2003 CY28 Cleaning
43!     ------------------------------------------------------------------
44
45USE PARKIND1        ,ONLY : JPIM     ,JPRB
46USE YOMHOOK         ,ONLY : LHOOK,   DR_HOOK
47
48USE YOMLUN_IFSAUX   , ONLY : NULOUT
49USE YOMCST          , ONLY : RPI
50USE YOESAT          , ONLY : NGEO     ,RGALT    ,RGNAD    ,RGNOR    ,&
51 & RGSOU    ,RGWST    ,RGEAS    ,LGEOSE   ,LGEOSW   ,&
52 & LGMS     ,LINDSA   ,LMTO 
53
54IMPLICIT NONE
55
56INTEGER(KIND=JPIM) :: ISATEL, JSATEL
57
58REAL(KIND=JPRB) :: ZDEGRAD
59REAL(KIND=JPRB) :: ZHOOK_HANDLE
60
61!*CALL COMDOC
62!----------------------------------------------------------------------
63
64!*       1.    SET DEFAULT VALUES.
65!              -------------------
66
67IF (LHOOK) CALL DR_HOOK('SUSAT',0,ZHOOK_HANDLE)
68ISATEL=5
69DO JSATEL = 1 , ISATEL
70  RGALT(JSATEL) = 0.0_JPRB
71  RGNAD(JSATEL) = 0.0_JPRB
72  RGNOR(JSATEL) = 0.0_JPRB
73  RGSOU(JSATEL) = 0.0_JPRB
74  RGWST(JSATEL) = 0.0_JPRB
75  RGEAS(JSATEL) = 0.0_JPRB
76ENDDO
77
78IF (NGEO /= 0) THEN
79
80!      ----------------------------------------------------------------
81
82!*       2.    MODIFY DEFAULT VALUES FOR THE VARIOUS GEO.SATELLITES
83!              ----------------------------------------------------
84
85  ISATEL = 0
86  ZDEGRAD = RPI / 180._JPRB
87
88  WRITE(UNIT=NULOUT,FMT='('' COMMON YOESAT '')')
89  WRITE(UNIT=NULOUT,FMT='('' NGEO  = '',I1 )') NGEO
90!      ----------------------------------------------------------------
91
92!*       2.1   GOES EAST SATELLITE
93!              -------------------
94
95  IF (LGEOSE) THEN
96    ISATEL = ISATEL + 1
97    RGALT(ISATEL) = 0.0_JPRB
98    RGALT(ISATEL) = 35793000._JPRB
99    RGNAD(ISATEL) = 285._JPRB * ZDEGRAD
100    RGNOR(ISATEL) = +70._JPRB * ZDEGRAD
101    RGSOU(ISATEL) = -70._JPRB * ZDEGRAD
102    RGWST(ISATEL) = RGNAD(ISATEL) -70._JPRB * ZDEGRAD
103    RGEAS(ISATEL) = RGNAD(ISATEL) +70._JPRB * ZDEGRAD
104    WRITE(UNIT=NULOUT,FMT='('' LGOESE = '',L5 &
105     & ,'' ALTITUDE  ='',F10.0 &
106     & ,'' LONG.NADIR='',F9.6 &
107     & ,'' LIMFOV N. ='',F9.6 &
108     & ,'' S. ='',F9.6 &
109     & ,'' W. ='',F9.6 &
110     & ,'' E. ='',F9.6 &
111     & )')&
112     & LGEOSE,RGALT(ISATEL),RGNAD(ISATEL)&
113     & ,RGNOR(ISATEL),RGSOU(ISATEL),RGWST(ISATEL),RGEAS(ISATEL) 
114  ENDIF
115
116!      ----------------------------------------------------------------
117
118!*       2.2   GOES WEST SATELLITE
119!              -------------------
120
121  IF (LGEOSW) THEN
122    ISATEL = ISATEL + 1
123    RGALT(ISATEL) = 0.0_JPRB
124    RGALT(ISATEL) = 35793000._JPRB
125    RGNAD(ISATEL) = 225._JPRB * ZDEGRAD
126    RGNOR(ISATEL) = +70._JPRB * ZDEGRAD
127    RGSOU(ISATEL) = -70._JPRB * ZDEGRAD
128    RGWST(ISATEL) = RGNAD(ISATEL) -70._JPRB * ZDEGRAD
129    RGEAS(ISATEL) = RGNAD(ISATEL) +70._JPRB * ZDEGRAD
130    WRITE(UNIT=NULOUT,FMT='('' LGEOSW = '',L5 &
131     & ,'' ALTITUDE  ='',F10.0 &
132     & ,'' LONG.NADIR='',F9.6 &
133     & ,'' LIMFOV N. ='',F9.6 &
134     & ,'' S. ='',F9.6 &
135     & ,'' W. ='',F9.6 &
136     & ,'' E. ='',F9.6 &
137     & )')&
138     & LGEOSW,RGALT(ISATEL),RGNAD(ISATEL)&
139     & ,RGNOR(ISATEL),RGSOU(ISATEL),RGWST(ISATEL),RGEAS(ISATEL) 
140  ENDIF
141
142!      ----------------------------------------------------------------
143
144!*       2.3   G.M.S. SATELLITE
145!              ----------------
146
147  IF (LGMS) THEN
148    ISATEL = ISATEL + 1
149    RGALT(ISATEL) = 0.0_JPRB
150    RGALT(ISATEL) = 35793000._JPRB
151    RGNAD(ISATEL) = 140._JPRB * ZDEGRAD
152    RGNOR(ISATEL) = +70._JPRB * ZDEGRAD
153    RGSOU(ISATEL) = -70._JPRB * ZDEGRAD
154    RGWST(ISATEL) = RGNAD(ISATEL) -70._JPRB * ZDEGRAD
155    RGEAS(ISATEL) = RGNAD(ISATEL) +70._JPRB * ZDEGRAD
156    WRITE(UNIT=NULOUT,FMT='('' LGMS   = '',L5 &
157     & ,'' ALTITUDE  ='',F10.0 &
158     & ,'' LONG.NADIR='',F9.6 &
159     & ,'' LIMFOV N. ='',F9.6 &
160     & ,'' S. ='',F9.6 &
161     & ,'' W. ='',F9.6 &
162     & ,'' E. ='',F9.6 &
163     & )')&
164     & LGMS,RGALT(ISATEL),RGNAD(ISATEL)&
165     & ,RGNOR(ISATEL),RGSOU(ISATEL),RGWST(ISATEL),RGEAS(ISATEL) 
166  ENDIF
167
168!      ----------------------------------------------------------------
169
170!*       2.4   INDSAT SATELLITE
171!              ----------------
172
173  IF (LINDSA) THEN
174    ISATEL = ISATEL + 1
175    RGALT(ISATEL) = 0.0_JPRB
176    RGALT(ISATEL) = 35793000._JPRB
177! ????      RGNAD(ISATEL) = 70. * ZDEGRAD
178    RGNAD(ISATEL) = 0.0_JPRB
179    RGNOR(ISATEL) = +70._JPRB * ZDEGRAD
180    RGSOU(ISATEL) = -70._JPRB * ZDEGRAD
181    RGWST(ISATEL) = 0.0_JPRB
182    RGEAS(ISATEL) = 0.0_JPRB
183    WRITE(UNIT=NULOUT,FMT='('' LINDSA = '',L5 &
184     & ,'' ALTITUDE  ='',F10.0 &
185     & ,'' LONG.NADIR='',F9.6 &
186     & ,'' LIMFOV N. ='',F9.6 &
187     & ,'' S. ='',F9.6 &
188     & ,'' W. ='',F9.6 &
189     & ,'' E. ='',F9.6 &
190     & )')&
191     & LINDSA,RGALT(ISATEL),RGNAD(ISATEL)&
192     & ,RGNOR(ISATEL),RGSOU(ISATEL),RGWST(ISATEL),RGEAS(ISATEL) 
193  ENDIF
194
195!      ----------------------------------------------------------------
196
197!*       2.5   METEOSAT SATELLITE
198!              ------------------
199
200  IF (LMTO) THEN
201    ISATEL = ISATEL + 1
202    RGALT(ISATEL) = 35793000._JPRB
203    RGNAD(ISATEL) = 0.0_JPRB * ZDEGRAD
204    RGNOR(ISATEL) = +70._JPRB * ZDEGRAD
205    RGSOU(ISATEL) = -70._JPRB * ZDEGRAD
206    RGWST(ISATEL) = 2.0_JPRB * RPI - 70._JPRB * ZDEGRAD
207    RGEAS(ISATEL) = +70._JPRB * ZDEGRAD
208    WRITE(UNIT=NULOUT,FMT='('' LMTO   = '',L5 &
209     & ,'' ALTITUDE  ='',F10.0 &
210     & ,'' LONG.NADIR='',F9.6 &
211     & ,'' LIMFOV N. ='',F9.6 &
212     & ,'' S. ='',F9.6 &
213     & ,'' W. ='',F9.6 &
214     & ,'' E. ='',F9.6 &
215     & )')&
216     & LMTO,RGALT(ISATEL),RGNAD(ISATEL)&
217     & ,RGNOR(ISATEL),RGSOU(ISATEL),RGWST(ISATEL),RGEAS(ISATEL) 
218  ENDIF
219
220ENDIF
221
222!     -----------------------------------------------------------------
223
224IF (LHOOK) CALL DR_HOOK('SUSAT',1,ZHOOK_HANDLE)
225END SUBROUTINE SUSAT
Note: See TracBrowser for help on using the repository browser.