GCC Code Coverage Report
Directory: ./ Exec Total Coverage
File: phylmd/rrtm/susat.F90 Lines: 0 67 0.0 %
Date: 2023-06-30 12:56:34 Branches: 0 18 0.0 %

Line Branch Exec Source
1
SUBROUTINE 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
45
USE PARKIND1        ,ONLY : JPIM     ,JPRB
46
USE YOMHOOK         ,ONLY : LHOOK,   DR_HOOK
47
48
USE YOMLUN_IFSAUX   , ONLY : NULOUT
49
USE YOMCST          , ONLY : RPI
50
USE YOESAT          , ONLY : NGEO     ,RGALT    ,RGNAD    ,RGNOR    ,&
51
 & RGSOU    ,RGWST    ,RGEAS    ,LGEOSE   ,LGEOSW   ,&
52
 & LGMS     ,LINDSA   ,LMTO
53
54
IMPLICIT NONE
55
56
INTEGER(KIND=JPIM) :: ISATEL, JSATEL
57
58
REAL(KIND=JPRB) :: ZDEGRAD
59
REAL(KIND=JPRB) :: ZHOOK_HANDLE
60
61
!*CALL COMDOC
62
!----------------------------------------------------------------------
63
64
!*       1.    SET DEFAULT VALUES.
65
!              -------------------
66
67
IF (LHOOK) CALL DR_HOOK('SUSAT',0,ZHOOK_HANDLE)
68
ISATEL=5
69
DO 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
76
ENDDO
77
78
IF (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
220
ENDIF
221
222
!     -----------------------------------------------------------------
223
224
IF (LHOOK) CALL DR_HOOK('SUSAT',1,ZHOOK_HANDLE)
225
END SUBROUTINE SUSAT