| 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 |
|---|