26-may-2003 06: 54: 04 cpmej90all. For;1


Download 1.4 Mb.
Name26-may-2003 06: 54: 04 cpmej90all. For;1
page1/20
A typeDocumentation
manual-guide.com > manual > Documentation
  1   2   3   4   5   6   7   8   9   ...   20
ATCHQF 3-JUN-2003 08:04:46 Digital Fortran 77 V7.0-6 Page 1

26-MAY-2003 06:54:04 CPMEJ90ALL.FOR;1
1 C*******************************************************************

2 C* *

3 C* Program Name: Cpmej90 *

4 C* *

5 C* This is a revised version of CPMEJ. Problems occurred *

6 C* when tapes for 1990 began to be processed after the decade *

7 C* changes were made in the code. Errors occurred in linking *

8 C* the old source library to the modified routine, because of *

9 C* changes in the IBM system support. *

10 C* The revised version was written in November 1990. Some *

11 C* software that could not be found had to be rewritten without*

12 C* any specific guidelines. These routines were ANYDAT, OCTAL,*

13 C* DATMOD and READIN. Minor changes were made for compilation *

14 C* under FORTRAN 77. A new library will be created from this *

15 C* code to continue processing IMP data on the IBM. *

16 C* *

17 C* Revisions made by Michelle Grimes *

18 C* *

19 C*******************************************************************

20

21 C MAIN PROGRAM FOR IMP J PROCESSING,TPA,6/1/74

22 C

23 C SPECIAL EVENTS & CALIBRATE DATA----FT02

24 C

25 C DATA INPUT---FT05

26 C

27 C ERROR & SUMMARY MESSAGES----FT06

28 C

29 C GENERAL PUNCH OUTPUT---FT07

30 C

31 C SUMMARY SHEET ---FT08

32 C

33 C QUICK-LOOK---FT09

34 C

35 C ARCHIVE OUTPUT---FT10

36 C

37 C MASTER SCIENCE TAPE---FT11

38 C

39 C DUPLICATE ARCHIVE TAPE FOR GSFC (CHUCK WENDY)----WRTOUT

40 C

41 C INPUT DECOMMUTATED TAPE---READIN

42 C

43 C

44 COMMON /IDREC/ ID(24)

45 INTEGER BRI

46 EQUIVALENCE(ID(13),BRI)

47 C

48 COMMON /ARCHIV/YEAR(8),DAY(8),MILSEC(8),TQF(8),SC(8),

49 * SCQF(8),PSC(8),

50 2 E1(9,16),E1UN(9,16),E1QF(16),

51 2 E3(9,32),E3UN(9,32),E3QF(32),

52 * E2A(9,16),E2AUN(9,16),E2AQF(16),

53 * P1(9,16),P1UN(9,16),P1QF(16),

54 * E4(9,16),E4UN(9,16),E4QF(16),

55 * A3(9,8),A3UN(9,8),A3QF(8),

56 * A1(9,8),A1UN(9,8),A1QF(8),

57 * Z1(9,8),Z1UN(9,8),Z1QF(8),
CPMEJ90ALL$MAIN 3-JUN-2003 08:04:46 Digital Fortran 77 V7.0-6 Page 2

26-MAY-2003 06:54:04 CPMEJ90ALL.FOR;1
58 * Z2(9,8),Z2UN(9,8),Z2QF(8),

59 * R4(32,7),R4UN(32,7),R4QF(32,7),

60 * R2(16,18),R2UN(16,18),R2QF(16,18),

61 * CALENB,CALQF,OAI,OAIQF,

62 * APP(8),APPQF(8),

63 * OADATA(6,8),OADQF(8),EPHEMR(33,2)

64 C

65 LOGICAL*1 TQF,SCQF,E1QF,E3QF,E2AQF,P1QF,E4QF,A3QF,A1QF,Z1QF,

66 * Z2QF,R4QF,R2QF,CALQF,OAIQF,APPQF,OADQF

67 LOGICAL * 1 CALENB,OAI

68 C

69 INTEGER*2 YEAR,DAY,OADATA

70 C

71 C INTEGER*4 MILSEC,SC,PSC

72 INTEGER*4 MILSEC,SC,PSC,ITEM3

73 C

74 REAL ARCOUT(3627)

75 EQUIVALENCE (YEAR(1),ARCOUT(1) )

76 INTEGER DATA(20)

77 C

78 COMMON /DECOM/LIN(4797)

79 C

80 LOGICAL*1 LIN

81 EQUIVALENCE ( LIN(1),DATA(1) )

82 DATA IDRECR/ZFFFFFFFF/,MAXALB/5/,NUMALB/0/

83 INTEGER DECIDE,STATCD,IU/5/,MAXQL,RECFRQ,MAXP,IPRNT/1/,AO/10/,

84 * OUTARC,ON/1/,OFF/0/,FIRSTA/0/,FROMID,XPERON/1/,WOFLAG

85 * ,CRDEOF/0/,

86 * QL(100,3),NFILEP/-1/,CURCRD /0/

87 * ,OUTMS,OUTMIC,OUTDAR

88 INTEGER MSO/11/,DAO/14/

89 INTEGER SEF/0/

90 INTEGER IHRS,OUTLTA/0/

91 INTEGER*2 FILLQF/2/ ! FORTRAN 77 change

92 C LOGICAL*1 FILTQF/0/

93 C LOGICAL*1 Byte(2) ! Correct invalid mode combination

94 INTEGER*2 IByte ! in FORTRAN 77

95 C EQUIVALENCE (Byte, IByte)

96 C

97 COMMON /BEGEND/FYEAR,FDAY,FMILSE,LYEAR,LDAY,LMILSE,LSC,

98 * STARTY,STARTD,STARTM,STOPY,STOPD,STOPM

99 INTEGER FYEAR,FDAY,FMILSE,LYEAR,LDAY,LMILSE,LSC,

100 * STARTY,STARTD,STARTM,STOPY,STOPD,STOPM

101 C

102 COMMON /CNTRS/IFILEN,OFILEN,LRECN,IDRECN,IALBN,OALBN,

103 * OVRLAP,XPEROF,TIMFIL,SEQFIL,RECFIL

104 INTEGER IFILEN,OFILEN,LRECN,IDRECN,IALBN,OALBN,

105 * OVRLAP,XPEROF,TIMFIL,SEQFIL,RECFIL

106 C

107 C

108 COMMON /MSDATA/MIDYR,MIDDAY,MIDMIL,MIDSC,MIDPSC,

109 * AVDATA(131,4),AVAPPS(8),MSEPHM(33),EXTRA(330)

110 REAL AVDATA,AVAPPS,MSEPHM,EXTRA

111 INTEGER MIDYR,MIDDAY,MIDMIL,MIDSC,MIDPSC

112 C

113 REAL MST(900)

114 EQUIVALENCE(MST(1),MIDYR)
CPMEJ90ALL$MAIN 3-JUN-2003 08:04:46 Digital Fortran 77 V7.0-6 Page 3

26-MAY-2003 06:54:04 CPMEJ90ALL.FOR;1
115 INTEGER FTO/1/

116 DATA NUMERR/0/

117 DATA IFFT/0/

118

119 C Initialize

120 MAXP = 0

121 RECFRQ = 0

122 C

123 C

124 C WRITE(6,904)

125 WRITE(2,904)

126 904 FORMAT(1H1)

127 C

128 C Get user input

129 CALL UInput (IU, OUTARC, OUTMS, OUTDAR, QL, I)

130 MAXQL = I-1

131 C

132 LYEAR = STARTY

133 LDAY = STARTD

134 LMILSE= STARTM

135 C

136 35 CONTINUE

137 C

138 FROMID = OFF

139 CALL READIN(DATA,*1000,*999)

140 C

141 LRECN = LRECN + 1

142 IF(DATA(1) .NE. IDRECR) GO TO 50

143 C

144 C*****ID RECORD*****

145 C

146 350 CONTINUE

147 C

148 C IS THIS THE FIRST RECORD ON THE TAPE. IF SO, THERE ISN'T

149 C A PREVIOUS FILE OF DATA TO SUMMARIZE IN PRTSUM.

150 C

151 IF( LRECN .EQ. 1 ) GO TO 36

152 C

153 C PRINT SUMMARY OF LAST FILE

154 C

155 CALL PRTSUM

156 36 CONTINUE

157 C

158 C RESET COUNTERS

159 C

160 IDRECN = LRECN

161 IFILEN = IFILEN + 1

162 IALBN = 0

163 OALBN = 0

164 OVRLAP = 0

165 XPEROF = 0

166 TIMFIL = 0

167 SEQFIL = 0

168 C

169 C WAS THE LAST FILE BEING PRINTED; I.E., HAS THE CURRENT

170 C INPUT CARD BEEN USED?

171 C
CPMEJ90ALL$MAIN 3-JUN-2003 08:04:46 Digital Fortran 77 V7.0-6 Page 4

26-MAY-2003 06:54:04 CPMEJ90ALL.FOR;1
172 IF( IFILEN .LE. NFILEP ) GO TO 38

173 C

174 C STEP TO NEXT DATA CARD

175 C

176 37 CONTINUE

177 CURCRD = CURCRD+1

178 IF( CURCRD .GT. MAXQL ) GO TO 997

179 NFILEP= QL(CURCRD,1)

180 RECFRQ = QL(CURCRD,2)

181 MAXP = QL(CURCRD,3)

182 C

183 C IF NFILEP IS BEFORE CURRENT FILE, DISCARD & READ NEXT CARD.

184 C

185 IF( NFILEP .LT. IFILEN ) GO TO 37

186 IPRNT = 1

187 38 CONTINUE

188 C

189 C MOVE ID RECORD TO SAVE AREA.

190 C

191 DO 40 I=1,20

192 40 ID(I) = DATA(I)

193 ID(13) = ID(13) + 1

194 C***

195 C***

196 C

197 41 CONTINUE

198 FROMID = ON

199 C

200 C READ DATA RECORDS UNTIL ONE IF FOUND THAT WILL BE INCLUDED,

201 C OR UNTIL ANOTHER ID RECORD IS ENCOUNTERED.

202 C IF THE FIRST CASE, THEN CURRENT ID RECORD CAN

203 C BE WRITTEN TO TAPE.

204 C

205 CALL READIN(DATA,*1000,*999)

206 LRECN = LRECN + 1

207 C

208 C IS IT AN ID RECORD ?

209 C

210 IF( DATA(1) .EQ. IDRECR) GO TO 350

211 IALBN = IALBN + 1

212 C

213 CALL EXPAND

214 C

215 C BRANCH TO "DECIDE" TO INSPECT ALBUM. A RETURN CODE, "STATCD",

216 C IS SET AS FOLLOWS:

217 C = -1: OMIT DATA BECAUSE X OFF, TIME FILL, OR TIME OVERLAP.

218 C = 0: OMIT DATA BECAUSE END TIME OCCURRED.

219 C = +1: INCLUDE DATA.

220 C

221 ASSIGN 43 TO DECIDE

222 GO TO 500

223 43 IF( STATCD )41,1000,44

224 44 CONTINUE

225 OFILEN = OFILEN + 1

226 C

227 C SAVE FIRST TIME IN ANALOG FILE FOR PRINT OUT

228 C
CPMEJ90ALL$MAIN 3-JUN-2003 08:04:46 Digital Fortran 77 V7.0-6 Page 5

26-MAY-2003 06:54:04 CPMEJ90ALL.FOR;1
229 ID(21) = LYEAR

230 ID(22) = LDAY

231 ID(23) = LMILSE

232 ID(24) = LSC

233 C

234 C OUTPUT ID RECORD TO TAPE

235 C

236 IF( OUTARC .EQ. OFF) GO TO 45

237 C WRITE(AO) ID

238 CALL VxIdOut ! Output archive on VAX

239 45 CONTINUE

240 IF(OUTDAR.EQ.ON) WRITE(20)ID

241 C IF(OUTDAR .EQ. ON) CALL WRTOUT(ID)

242 C

243 C BRANCH TO SECTION THAT PROCESSES DATA RECORD.

244 C

245 GO TO 65

246 C

247 C

248 C

249 C

250 50 CONTINUE

251 C

252 C*****DATA RECORD*****

253 C

254 IALBN = IALBN + 1

255 C

256 CALL EXPAND

257 C

258 C BRANCH TO "DECIDE" TO INSPECT ALBUM. A RETURN CODE, "STATCD",

259 C IS SET AS FOLLOWS:

260 C = -1: OMIT DATA BECAUSE X OFF, TIME FILL, OR TIME OVERLAP.

261 C = 0: OMIT DATA BECAUSE END TIME OCCURRED.

262 C = +1: INCLUDE DATA.

263 C

264 ASSIGN 60 TO DECIDE

265 GO TO 500

266 C

267 60 CONTINUE

268 IF(STATCD)35,1000,65

269 65 CONTINUE

270 C

271 C INCLUDE THIS DATA.

272 C

273 C

274 C QUICK-LOOK PRINT-OUT DESIRED ?

275 C

276 IF(IFILEN .NE. NFILEP) GO TO 70

277 C

278 C HAVE "MAXP" RECORDS BEEN PRINTED ?

279 C

280 IF(IPRNT .GT. MAXP) GO TO 70

281 C

282 C NO, BUT IS THIS RECORD NUMBER DIVISIBLE BY RECFRQ?

283 C

284 IF( MOD(OALBN-1,RECFRQ) .NE. 0) GO TO 70

285 IPRNT = IPRNT + 1
CPMEJ90ALL$MAIN 3-JUN-2003 08:04:46 Digital Fortran 77 V7.0-6 Page 6

26-MAY-2003 06:54:04 CPMEJ90ALL.FOR;1
286 C

287 C PRINT THE DATA.

288 C

289 CALL KWIKLK

290 C

291 70 CONTINUE

292 C

293 C MAKE ARCHIVE TAPE ?

294 C

295 IF( OUTARC .EQ. OFF) GO TO 75

296 C

297 C OUTPUT THE DATA RECORD TO THE ARCHIVE TAPE.

298 C

299 C WRITE(AO) ARCOUT

300 CALL VxArcOut ! Output archive on VAX

301 75 CONTINUE

302 C IF(OUTDAR .EQ. ON) CALL WRTOUT(ARCOUT)

303 IF(OUTDAR.EQ.ON) WRITE(20)ARCOUT

304 C

305 C CONVERT APP'S TO ENGINEERING UNITS.

306 CALL CVTAPS

307 C

308 C

309 C DOES THIS DATA INDICATE A CALIBRATION SEQUENCE ?

310 C

311 C IByte = 0

312 C Byte(1) = CALENB

313 CALL BytToInt (CALENB, IByte)

314 IF( IByte .EQ. OFF) GO TO 80

315 CALL CALBRA

316 C

317 80 CONTINUE

318 C

319 C

320 C SEARCH FOR SPECIAL EVENTS.

321 C

322 C THE FOLLOWING CARD WAS CHANGED ON 04,22,74 BY J.L.GUNTHER. THIS WAS

323 C TO BYPASS THE SPCEVT AND ONSET SUBROUTINES THAT WERE STOPPING THE

324 C PROGRAM FROM EXECUTING PROPERLY.

325 C CALL SPCEVT(SEF,1,BRI)

326 C

327 C AVERAGE ALBUM #1.

328 C

329 CALL AVERGE(1,0,BRI,*83)

330 C CALL DETAIL

331 SEF = 1

332 C

333 IF(OUTMS .EQ. ON) WRITE(MSO) MST

334 C IF(OUTMS.EQ.ON) WRITE(19)MST

335 C

336 83 CONTINUE

337 C

338 C

339 C SEARCH FOR SPECIAL EVENTS.

340 C

341 C THE FOLLOWING CARD WAS CHANGED ON 04,22,74 BY J.L.GUNTHER. THIS WAS

342 C TO BYPASS THE SPCEVT AND ONSET SUBROUTINES THAT WERE STOPPING THE
CPMEJ90ALL$MAIN 3-JUN-2003 08:04:46 Digital Fortran 77 V7.0-6 Page 7

26-MAY-2003 06:54:04 CPMEJ90ALL.FOR;1
343 C PROGRAM FROM EXECUTING PROPERLY.

344 C CALL SPCEVT(SEF,2,BRI)

345 C

346 C AVERAGE ALBUM #2.

347 C

348 CALL AVERGE(2,0,BRI,*85)

349 C

350 SEF = 1

351 C CALL DETAIL

352 C

353 IF(OUTMS .EQ. ON) WRITE(MSO) MST

354 C IF(OUTMS.EQ.ON) WRITE(19)MST

355 C

356 85 CONTINUE

357 90 CONTINUE

358 C

359 C BRANCH BACK TO READ NEXT DATA RECORD.

360 C

361 GO TO 35

362 C

363 C

364 C****DECIDE****

365 C

366 C DECIDE WHETHER THIS DATA SHOULD BE INCLUDED OR OMITTED.

367 C "STATCD" IS SET TO +1 TO INCLUDE DATA, TO -1 TO OMIT DATA

368 C AND CONTINUE, & TO 0 TO OMIT DATA AND STOP. THIS THIRD

369 C CASE WILL ONLY OCCUR IF THE TAPES ARE PROCESSED OUT OF ORDER

370 C AND IT BECOMES NECESSARY TO RUN TAPE "N" AFTER TAPE "N+1".

371 C

372 500 CONTINUE

373 C

374 IF( FROMID .EQ. OFF ) GO TO 510

375 C

376 C FOR THE FIRST RECORD OF EACH ANALOG FILE, THE TIME FOR

377 C PAGE 0 MUST NOT BE FILL.

378 C

379 IF( YEAR(1) .NE. 0) GO TO 510

380 TIMFIL = TIMFIL + 1

381 STATCD = -1

382 GO TO 575

383 C

384 C CHECK IF BOTH THE GT & THE PET HIGH VOLTAGES ARE OFF.

385 C FIRST CHECK IF VALUE IS FILL. IF SO, ASSUME LATEST VALUE.

386 C

387 510 CONTINUE

388 C IByte = 0

389 C Byte(1) = APPQF(7)

390 CALL BytToInt (APPQF(7), IByte)

391 IF( IByte .EQ. FILLQF ) GO TO 520

392 XPERON = ON

393 IF( APP(7) .LT. 1.0 ) XPERON = OFF

394 520 CONTINUE

395 C

396 C

397 IF( XPERON .EQ. OFF) GO TO 522

398 IF( FTO .NE. 0) GO TO 525

399 FTO = 1
CPMEJ90ALL$MAIN 3-JUN-2003 08:04:46 Digital Fortran 77 V7.0-6 Page 8

26-MAY-2003 06:54:04 CPMEJ90ALL.FOR;1
400 GO TO 523

401 522 CONTINUE

402 FTO = 0

403 523 CONTINUE

404 XPEROF = XPEROF + 1

405 STATCD = -1

406 GO TO 575

407 C

408 525 CONTINUE

409 C

410 C FIND FIRST VALID TIME

411 C

412 DO 530 II=1,8

413 I=II

414 IF( YEAR(I) .NE. 0) GO TO 533

415 530 CONTINUE

416 C

417 C ALL TIMES ARE FILL ( SHOULD NEVER OCCUR ). OMIT RECORD

418 C

419 TIMFIL = TIMFIL + 1

420 STATCD = -1

421 GO TO 575

422 C

423 C CHECK IF THIS TIME IS IN THE TIME INTERVAL.

424 C

425 533 CONTINUE

426 ITEMP1 = YEAR(I)
  1   2   3   4   5   6   7   8   9   ...   20

Share in:

Related:

26-may-2003 06: 54: 04 cpmej90all. For;1 iconResearch has confirmed that a good sense of humor is an important...

26-may-2003 06: 54: 04 cpmej90all. For;1 iconReport 2003

26-may-2003 06: 54: 04 cpmej90all. For;1 iconUses for FrontPage 2003

26-may-2003 06: 54: 04 cpmej90all. For;1 iconLast Updated: 14-May-2003

26-may-2003 06: 54: 04 cpmej90all. For;1 iconFrom TravelWeekly. Com©, August 4, 2003

26-may-2003 06: 54: 04 cpmej90all. For;1 icon2003-2007 cummins 9L

26-may-2003 06: 54: 04 cpmej90all. For;1 iconPeace and Love Ritual 2003-02-24

26-may-2003 06: 54: 04 cpmej90all. For;1 iconMicrosoft Office Outlook 2003

26-may-2003 06: 54: 04 cpmej90all. For;1 icon2003 Honda Accord Overview

26-may-2003 06: 54: 04 cpmej90all. For;1 iconUser Manual April 2003

26-may-2003 06: 54: 04 cpmej90all. For;1 iconArsenic lullabies june 2003 #3

26-may-2003 06: 54: 04 cpmej90all. For;1 iconInformation Centre Guide May 2003 introduction

26-may-2003 06: 54: 04 cpmej90all. For;1 icon© 1977, 1998, 2003 by Colleen McCullough

26-may-2003 06: 54: 04 cpmej90all. For;1 iconUser’s Guide September 23, 2003 Introduction

26-may-2003 06: 54: 04 cpmej90all. For;1 iconFor the Fiscal Year Ended December 31, 2003

26-may-2003 06: 54: 04 cpmej90all. For;1 iconScripting dll 221,260 07/24/2003

26-may-2003 06: 54: 04 cpmej90all. For;1 iconA narcissus Publications Imprint, Skopje 2003

26-may-2003 06: 54: 04 cpmej90all. For;1 iconA narcissus Publications Imprint, Skopje 2003

26-may-2003 06: 54: 04 cpmej90all. For;1 iconUser manual belgrade, July 2003

26-may-2003 06: 54: 04 cpmej90all. For;1 iconThis page was last updated on Tuesday, April 29, 2003




manual


When copying material provide a link © 2017
contacts
manual-guide.com
search