GCC Code Coverage Report

Directory: ./
File: rad/susat.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 0 67 0.0%
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
226