Programmer 7500

home *** CD-ROM | disk | FTP | other *** search

/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / FORTRAN / TIDY621.ZIP / TIDY.FOR < prev next >

Wrap

Text File | 1990-09-26 | 148.2 KB | 1,944 lines

PROGRAM TIDY C C ================================================================== C * * C * * * * T I D Y * * * * C * * C * A FORTRAN PROGRAM TO RENUMBER AND OTHERWISE CLEAN UP * C * OLD AND TIRED FORTRAN SOURCE PROGRAMS. * C * * C * IN ADDITION TO RENUMBERING, * C * TIDY PROVIDES A LIMITED SET OF FORTRAN * C * DIAGNOSTICS. * C * * C * ANSI FORTRAN (ANSI X3.9-1978) * C * * C * * C * CONVERTED TO IBM (RYAN-McFARLAND) PROFESSIONAL FORTRAN * C * BY AL STANGENBERGER, DEPT. OF FORESTRY, U.C. BERKELEY * C * THIS VERSION IS DATED SEPTEMBER 1990 * C * * C ================================================================== C C Copyright (C) 1989, The Regents of the University of California C All Rights Reserved C C THE REGENTS OF THE UNIVERSITY OF CALIFORNIA MAKE NO REPRESENTA- C TION OR WARRANTIES WITH RESPECT TO THE CONTENTS HEREOF AND C SPECIFICALLY DISCLAIM ANY IMPLIED WARRANTIES OF MERCHANTABILITY C OR FITNESS FOR ANY PARTICULAR PURPOSE. C C Further, the Regents of the University of California reserve the C right to revise this software and/or documentation and to make C changes from time to time in the content hereof without obliga- C tion of the Regents of the University of California to notify C any person of such revision or change. C C PERMISSION TO COPY AND DISTRIBUTE THIS PROGRAM, AND TO MAKE C DERIVATIVE WORKS HEREFROM, IS GRANTED PROVIDED THAT THIS COPY- C RIGHT NOTICE IS RETAINED IN ALL SOURCE CODE AND USER MANUALS. C C ================================================================== C * * C * ************************** * C * * PROGRAM * * C * * AND SUBROUTINES BY * * C * * HARRY M MURPHY * * C * * AIR FORCE WEAPONS LABORATORY * * C * * KIRTLAND AIR FORCE BASE * * C * * NEW MEXICO * * C * * 1 9 6 6 * * C * ************************** * C * * C * TIDY ACCEPTS ASA FORTRAN WITH 19 CONTINUATION CARDS * C * AS WELL AS SOME IBM AND CDC DIALECT FORTRAN STATEMENTS * C * * C * THIS VERSION MODIFIED FOR USE AT LRL BERKELEY BY * C * GERRY TOOL (1967). (STILL CDC/6600) * C * * C * THIS PROGRAM HAS BEEN REVISED FOR IBM 360/67 BY ALICE * C * V BARLOW, NASA AMES, SUMMER 1972 * C * * C * ADDITIONS AND REWORKING BY ROGER CHAFFEE, LRL BERKELEY * C * AND SLAC COMPUTATIONS RESEARCH GROUP, 1968-1982 * C ================================================================== C C C INPUT/OUTPUT C FUNCTION FORTRAN UNIT CURRENT VALUE C CONSOLE OUTPUT STDERR 0 C CONSOLE INPUT STDIN 0 (5 for UNIX systems) C CONTROL CARD USRFIL 3 C INPUT INFILE 4 C LIST OUTPUT OUTFIL 6 C CARD OUTPUT PUNFIL 8 C SCRATCH(NORMAL) SCFIL1 1 C SCRATCH(FORMATS) SCFIL2 2 C C ***************************************************************** C I N S T A L L A T I O N N O T E S C C 1. INCLUDE statements are used to incorporate common block C definitions into most subroutines. Check syntax as these C statements are system-dependent. C C C 2. CHARACTER SET SPECIFICITY - function KUPPER must be modified C (by changing a PARAMETER statement) if the system is using C a character set other than ASCII. The proper EBCDIC values C are included as a comment statement. C C ALSO, the code for horizontal tab differs in EBCDIC and ASCII. C This value is set (KTAB) in this routine. Fix as needed. C C 3. Interactive file opening: Subroutine PCTIDY interactively C opens all data and scratch files by calling subroutine OPFIL. C This routine was written for the IBM (Ryan-McFarland) C Professional Fortran compiler, and may not work with other C compilers (it does work with f77 on 4.3 BSD UNIX). C C Subroutine OPFIL uses function DOSDEV to determine if a file C name is that of a MS-DOS reserved device. Non MS-DOS systems C should delete the call to DOSDEV in subroutine OPFIL. C C The entire interactive part of the program can be deleted C if not appropriate for your operating system. C Delete the call to PCTIDY below, and also delete subroutines C PCTIDY, OPFIL, and DOSDEV. C C Aside from these factors, the rest of the program is C fairly standard Fortran-77. C C C NOTES: C C IN SUBROUTINE HOLSCN, HOLLERITH CHARACTERS ARE CHANGED C SO THEY WON-T BE RECOGNIZED BY ANY OTHER TEST BY C CHANGING SECOND CHARACTER TO '@' C C SUBROUTINES HOLSCN AND CONTRL INVOKE FUNCTION KUPPER TO CONVERT C LOWER-CASE ALPHABETIC CHARACTERS TO UPPER CASE (EXCEPT FOR C HOLLERITH STRINGS). *** KUPPER IS CHARACTER-SET DEPENDENT *** C C THE CHARACTER $ IS TREATED AS AN ALPHA IN IBM FORTRAN. C THE DATA STATEMENT FOR THE SPECIAL CHARACTERS, KSPK, HAS C BEEN CHANGED SO THAT $ IS NOT RECOGNIZED AS A SPECIAL C CHARACTER. THIS DATA STATEMENT SHOULD BE CHANGED BACK C ON NON-IBM SYSTEMS. C C SUBROUTINE REDSTR IS SET UP TO ACCOMMODATE AN APPARENT BUG C IN THE RYAN-MCFARLAND PROFESSIONAL FORTRAN COMPILER, THAT C UNFORMATTED SEQUENTIAL RECORDS SEEM TO BE LIMITED TO 1024 BYTES. C SINCE EACH RECORD HAS A 4-BYTE HEADER AND TRAILER, WRITES 508 C CHARACTER*2 ELEMENTS, OR 254 INTEGER*4 PER RECORD. THIS MAY C VARY FOR OTHER COMPILERS. C C C INTERNAL FLAGS (JUST A LIST. WHERE ELSE TO PUT IT...) C MANSI = 0 FLAG ALL NON-ANSI (FORTRAN-77) STATEMENTS C = 1 DO NOT FLAG NON-ANSI STATEMENTS C MP2 = 1 DO PASS2 C = 0 NO PASS 2 C MCOL = -1 COLLECT FORMAT STATEMENTS AT END C = 0 LEAVE THEM IN PLACE C MILDO = -1 IF DO-TERMINATOR ALLOWED BUT NON-STANDARD C = 0 IF DO-TERMINATOR ALLOWED C = +1 IF DO-TERMINATOR FORBIDDEN C MCONT = 0 REMOVE CONTINUE CARDS AND DOUBLE BRANCHES C = 1 LEAVE THEM C MTRAN = -1 CURRENT CARD IS AN UNCONDITIONAL BRANCH C = 0 CURRENT CARD NOT NECESSARILY A BRANCH C NTRAN = SAME AS MTRAN, BUT REFERS TO PREVIOUS CARD C MLGC = -1 NORMAL STATEMENT C = 0 STATEMENT IS CONTROLLED BY A LOGICAL IF C MRIT = N LEFT ADJUST TO COLUMN N C = -N RIGHT ADJUST TO COLUMN N C MDEB = 0 *NODEBUG C = 1 *DEBUG C KD15 = STATEMENT INCREMENT (*STAT=...) C KB15 = STATEMENT BASE (*BASE=...) C MPUN = 0 NO PUNCH OUTPUT C = 1 MAKE PUNCH OUTPUT C KPUN SAVES *CARD/*NOCARD (1/0) FOR MPUN VALUE C MLIST = -1 (*LIST) LIST PASS 1 C = 0 (*NOLIST) DONT C KPRIN = 1 (*LIST=2) LIST PASS 2 C = 0 (*NOLIST=2) DONT C MPRIN = KPRIN AT START OF ROUTINE. MAY CHANGE IF ERROR C AT START OF PASS1. C KOUNT COUNTS CARDS IN FOR CURRENT ROUTINE. C IQUIT = 0 UNTIL INPUT ENDFILE IS FOUND IN READER. C = 1 THEREAFTER C MSTOP = 0 NORMALLY C = -1 FOR *STOP CARD FOUND--TIME TO FINISH UP C = 1 FOR STOP NOW. C C C ****************************************************************** C INCLUDE 'TIDY.INC' INCLUDE 'UNITS.INC' LOGICAL DOUSER,SCDISK COMMON/TDYVER/VERNUM CHARACTER*25 VERNUM C DOUSER=.TRUE. C C SCDISK .TRUE. ALLOWS USER TO SPECIFY DISK TO HOLD SCRATCH FILES. C FOR UNIX SYSTEMS, SHOULD SET TO .FALSE. SCDISK=.TRUE. C C VALUE FOR TAB AS ASCII KTAB = KBL KTAB(1:1)=CHAR(9) C VALUE FOR TAB AS EBCDIC C KTAB(1:1)=CHAR(5) C C FOR NON-INTERACTIVE USE, DELETE CALL TO PCTIDY CALL PCTIDY (DOUSER,SCDISK) C C INITIALIZE PROGRAM CALL INITDY C ADJUST ROUTINE NUMBER - PASS1 WILL INCREMENT IT. NROUT = NROUT-1 C C PROCESS USER CONTROL CARD FILE. IF (DOUSER) CALL USRCON C CALL READER 10 CALL PASS1 IF (MSTOP.NE.0) THEN IF (MSTOP.GT.0) GO TO 20 IF (KOUNT.LE.0) GO TO 20 ENDIF CALL EDIT IF (MP2.EQ.0) GO TO 10 IF (MREF.NE.0) CALL RDIR CALL PASS2 IF (MSTOP.EQ.0) GO TO 10 C ALL DONE 20 CALL IOSY11 CALL IOSY21 IF (NMSG.GT.0) THEN WRITE (OUTFIL,60) NMSG ELSE WRITE (OUTFIL,70) ENDIF WRITE (OUTFIL,80) NPUN, VERNUM LEVEL = LERR IF (LEVEL.GE.2) STOP 8 IF (LEVEL.EQ.1) STOP 4 IF (MDEB.EQ.0) THEN CLOSE (SCFIL1,STATUS='DELETE') CLOSE (SCFIL2,STATUS='DELETE') END IF STOP C 60 FORMAT ( '0W A R N I N G .',I5, ' DIAGNOSTIC MESSAGES HAVE BEEN G 1ENERATED IN THIS TIDY RUN.') 70 FORMAT ( '0NO DIAGNOSTIC MESSAGES WERE GENERATED DURING THIS TIDY 1 RUN.') 80 FORMAT ('0',I5, ' CARDS WERE PUNCHED.'/ '0',A/'1') END BLOCK DATA MISDAT C C THIS BLOCK DATA CONTAINS MISCELLANEOUS DATA STATEMENTS FOR TIDY. C C VERSION 6.2 MODIFICATION ----------------------------------------- C VARIABLES WHICH ARE CONTROLLED BY SUBROUTINE CONTRL ARE SET IN C SUBROUTINE INITDY. C INCLUDE 'TIDY.INC' INCLUDE 'UNITS.INC' COMMON/TDYVER/VERNUM CHARACTER*25 VERNUM C C /ALPHA/ DATA KBL,KDIG/' ','0','1','2','3','4','5','6','7','8','9'/ DATA KABC/'A','B','C','D','E','F','G','H','I','J','K','L','M','N', 1'O','P','Q','R','S','T','U','V','W','X','Y','Z'/ DATA KSPK/'=', ',', '(', '/', ')', '+', '-', '*', '.', 'X$', '-', 1'''', '&', '$'/ C $ IN ABOVE STATEMENT REPLACED BY X$, SINCE $ IS NOT SPECIAL C CHARACTER IN IBM 360/370 FORTRAN. DATA KBL2, KLR2, KLP2, KRP2, KERM/' *', '$$', '($'/ C $ IN ABOVE STATEMENT REPLACED BY X$5----iTHEM OUTINE RED╪INE IN','0','1','2',','9'/ DATNE RED╪INEc VARIAT, Kt'W'INEc. 1,'0R 1PHA IN IINCLUDE s','7','8','9'L INITDY C ADJUST ROUTINE NUMBER - PASS1 WILL INCREMENT IT. NROUT = NROUT-1 C C PROCESS USER CONTROL CARD FILE. IF (DOUSER) CALL USRCON C CALL READER 10 CALL PASS1 IF (MSTOP.NE.0) THEN IF (MSTOP.GT.0) GO TO 20 IF (KOUNT.LE.0) GO TO 20AS A SP[OUP, FhKERM/')ra 'B','C','D','E','F','G','H',6uMCFARLAND PRO- KLR2, VEL = LERR IF (LEVEL. '($'/ C $ DO Np(DOUSER) b O 20AS A SP[OUP, b 3oRR IF (LEVEL. '($'/ C $ DO Np(DOUSER) b O 20AS A SP[OUP, b 3oRR IF (LEVEL. '($'/ C $ DO Np(DOUSER) b O 2UP CALL: FhKERM/ppro4:,'E','F',3N OCK DATAp4b IF (LEVL1,STATUS='DELETE') CLOSE (SCFIL2,STA b F(i>M/')ra B) iRATbT IF E (*BASE=...) IF (LED╪INEc VARIAT, Kt'W'INFhKERFdc:) b O4******m$'/ C FhPPARENT BUG C I DATAp ADJUST ROUTINE NUMBER - E (SCFfN COMPILER, THAT C (SCFIROUT = NROUT-1 C C PRF (LE b O4****O TO 10 C OLLER SUBnCATEMENT ISTNUM C C /ALPHA/ DATA KBL,KDIG/' ','0','1','2','3','4','5','6','7','8','9'/ DATA KABC/'A','B','C','D','E','F','G','H','I','J','K','L','M','N', 1'O','PHES C ',', '('CALL: FhKERM/ppro4:,'E','TEMENTS UTINE RR6 VARIAT IF (LEVL1,STATUS='DELETE' a co:r 0 CURRENT CAD BY X$,STA b F(i>M/')ra B) iRAT hori:r = +1 ,'E',ubro) CM/pKSPK/'=',l '$'/ STOP','B','C','aIS NOT SPEEVEfbpNOT FLA 1 COÖ7uARACTE=DJUST ROUTbSER( '(', '/', ')', '+', '-', '*', '.'uR*4 P C CALL TOg CM/pR - E (SCFfN CY X$, SINCE $ IS NOT SPECIALG THIS TIDY nM','N'ns',''J','K',GTNE REE (SCFf','9'vT PASS UNFO CALUTF V='G','H','I','J','K','L','M','N', 1'O','PHES C bT C D BYN', 1sÜ CLISLER, THAEMENTS FOR TIDY. C C , ,'M','N', 1'E FOR TAB AS ASCII------------------rIS TIDY m eATA 1'O','PHEND PROGHT ADJUST T SU bASS+', COMMONg5T T SU lER INE CONTRtPROGHTNT , ', 'CONTAB AS'J','h DO', *N'('CA$T C D BYN INVO9TID]gV, '('CALL: FhKERM/p '($'/ CDJUST,'8','9'L INITDY C ADJUST ROUTINE NUMBER - PASS1 WILL INCREMENNOCARD (1/0) FOR MBPASSaA$T C D BYN INVO9TID]gV, '('CALL: FhKERM/p '($'/ CDJUST,'8INE CONTRtPROA IN IBIF (LEVL1 *DEBUGM','N'ns',''J','K',GTNE REE (SCFf','9'vT PASS UNFO CALUTF V='G'YN',p********C KBIS TIDY, '+', '-'EL. '($'/ C $ DO Np(DOUSER) Aside from these factors, the rest of the program is C , the rest of the program is C , '*', '.'uR*DMLGC = -1 NORMAL STATEEEEnERITH CHARACT DATA KSPK/'=', ',', '(', '/', ')', '+', '-', '*', '.', 'X$', '-NY OTHER TEST BY C CHANGING SECOND CHARACTER TO '@' C C E REEY C 1sUNITS.INC' R - PASVE USE, DEL'8','p '($EMEprogram G0blER TEST BY C CHANGING S BUG CX$'r. 'CA$T C ($EMEprogBgrs, td-gNORMAL STATdT ENDFILE IS FOUND IGGbhe A$T C D BONOT SPECIALG THIS TIDY l2uVO9TIrLIMITED TO 1N- PASTet of t','J','K','r4OT SPECIALG8BYS'-NY OisTi CHT0l---kt╘-1 C C G THIS TI& OtOUNFO CALUTF V='G'YN',pO=gOT SPECIALG THIS TIl CHANGING SECOND CDe,'K',GTNi0 pO=Gbhe A$T TI& Ot=eDYm l2uELETEDEL'8' iRAT h (NM, '.& Os h9SS2',', ----7NIX SYSTEMS, SHOULD SET TOBl= LAL ROUSER) IMITED TCuACT,GTNi0','1', TI& Ot1GohrATION ----------------------------------------- C VARIABLES WHICH ARE CONTROLLED BY SU--- nM'S TIDY4D CDe,'K '0CONTROLN',p***f','9,'G','M/p]',p 1sN=eDYm l2uELETEDEL'8' iRAT h (NM, '.& Os h9SS2',', ----7NIX SYSTEMS, SHOULD SET TOBl= LAL ROUSER) IMITED TCuACT,GTNi0','1', TI& Ot1Gohrph tr'SHOUOLN5i CHT Np(DODY4D CONTROL ┐8ED╪INE KTAB(1(ND ----------SS2',',LLED BY SU--- THIS TIBt',po F(os,',L5-1 C 2',c, THASKLP2, KRP2, KEG THIS, TOt1GohW A R N I N G ., KS, s INVOTNED BYllENT BUG C tROL ┐8ED╪INE KTAB(1(VT',GTN8 CALLY SU-T',GTNs IN,'7','8','9'/ A R N2',c,R -IS, TOt1G----------------- eNWHICH ARRHt KRP2, KERM/' *', '$$', '($"SECOND,'G','S C -1 C 2'STA H----ttHOUOt1R EuO ahKeFTOtgdTID]gV, '& Os h9SSt1,''J', '.& E REncM, '.& Os (MSTOPIS, TOt1G--A$T 7 ROEQ., '.& Os tu5D-ùOUL',p 1sF CHED.'EREEY---EtaQ., '.& Os tu5D-iIeNWHICH A END IF STOP C 60 FORMAT ( '0W A R N I N G .',I5, ' DIAGNOSTIC MESSAGES HAVE BEEN G 1ENERATED IN THIS TIDY RUN.') 70 FORMAT ( '0NO DIAGNOSTIC MESSAGES WERE GENERATED DURING THIS TIDY 1c 1ENERI N gR2, KLP2, KRP2, KERM ONTRtPROA Ir DIAGNOST 1ENERATEstT ( 'wL ┐8ED╪ M G )0.INC' C CHµbNcfROlP STOP C 60 FORMAT ( '0W A R N I N G .',I5, ' DIAGNOSTIf2, ENERATE-FOR 7E 'TI ( =aE, D7UDE 'TIC MEPu I N G ., I N G .',IE BEEN G 1ENERATED IN THIS TIDY RUN.') 70 FORMAT ( '0NO DIAGNOSTIC MESSAGES WERE GENERATED DURING THIS TIDY 1c 1ENERI N TOtgdT )0.I SP[INC'GESU','N', fERATE-/ALPHA/ Uogra 1Y R---------NITI3SAGESIMIh[INC'GEGNOST '-NYt THISIN THMIDY RELETE' aROUSER)dP[ODIAGNO =aE, DERATED N TOtgd) (M4 SP[INK/'='.')dP[ODiMITED TO ',', '($"SE5---NITI3SAGESIMIh[INC'GEGNOST '-NYt THISIN THMIDY RELETE' aROUSER)d DERAETE'NYN'a O 20A TOEprogBgrs (M4ogra '+', '-', '*', '.', 'X$', '-NY OTHER TEST BY C 0.INC'oIMIh[INC1', 0.ITOEprogBgrs (M4ogra '+', '-', '*', '.', 'X$', '-NIa O 20 MEIh[INC'G '+', )', '+')GEGNA/ S WHI(NMSG., '.'uR*4 RFGbhe A$T TI& Ot=eDYm l2uELETEDEL'8' TH CSAGESIINCL/)1T SPECIE 'UNIITED TN IBIF (LEVL1r 'X$',km l2uELETEDEL'8' TH CSAGESIINCL/)1T SPECIE 'UNIITED TN IBIF (LEVL1r 'X$',km l2uELETEDEL'8' TH CSAGESIINCL/)1T SPECIE 'UNIITED TN IBIF (LEVL1r 'X$',km l2uELETEDEL'8' TH CSAGESIINCL/)1T SPECIE 'UNIITED TN IBIF (LiITED TCuACT,GTNi0','1', TI& Ot1he A$TdP[ODioNMSG., '.'TIS FOUND IGGbhe A$T C D BONOT SPECIALG THIS TIDY l2uVO9T$',km LETE' aoATEDTSTet of t','J','K','r4OT SPECIALG8BYS'-NY OisTi CHT0l---kt╘-1uELETE', '-NPTI /)1T SPECIE) C BUG ', '($"SE5---* FORMAT me8HT0l---kt╘-1uELNIITINCL/)1rf',''L INITDY C ADJUST ROUTINE NUMBER - PASS1 WILL INCREMEfESIINCL/)NOSTIC MVEL Ois4 INITDfIF (LEVL1AGESI3 N G 3the r,STA4iAGES WERE GENEsrlTEDTSTe5NE REE (SCFf','9'vT PASS UNFO CALUTF V='G'YN',p*****S'-NY .')NIIlhe A$T G 3the r,S '('S TI l2uVO9 UrlTEDTSTNIITED T C IcLP2', TI& O DURING THI-1j-) R._ROUSER) IMITED B1'roER CE s4D,'G'tr'SHOc 17Dodn.FwO1CSAiITE, VELLETE' a co:TDfIF (LEVL1AGESI3 N G 3the r,ST DURSTNIITED T -7NI ($EMEprogBgru ' DIAGNOt7','3 R T0',km LETE' aoATEDTSTet of t'2E 'UNIITED TN IBIF (LiITED TCuACT,GTNi0',' KSPK/'=',l '$'/ STOP','B','C','aIS NOT SPEEVEfbpNOT FLA 1 COÖ7uARACTE=DJUST ROUTbSER( 'P2', TI& O rW6 THAT C BC/'A','B','C','D','E','F','G','H','I','J','K','L','M','N', 1'O','PHES C ',', '('CALL: FhKERM/ppro4:,'E','TEMENTS UTINE RR6 VARIAT IF (LEVL1,STATUS='DELETE' a co:r 0 CURRENT CAD BY X$,STA b F(i>M/')ra B) iRATFwO1CSL1A, '-' 1 -RE GENEsrl', '-NPTIo:r 0 CURRENT CPe A$TdP[ODioNMSG., '.'TIS FOUND IGGbhe A$i0'ITED TN IUSEe A$'K','L',' '($'/ CDJg7----7NIX TetUNII END SPECIE 'U) uVO97 t'UNFLA 1 )S---'($"SE5IS F, DE'K',1o /)1T SPEC, '-Nhe A$i0'Iof t'2E 'UNIITED TN IBIF (LiITED TCuACT,GTNi0',' KSPK/'=',l '$'//')ra B) iRAT*iC-NITVERNUM CHARACTER*25 ----------------------------- C VARIABLES WHICH ARE CONTROL b---CHARTHINPTIo:r 0 CURRENT CPe A$TdP[ODioNMSG., '.'TIS FOUND IGGbhe A$i0'E 'TID K',GTNE REE (SCFf','9'vT PASS UNFO CALUTF V='G'YN',p********CM/pKI SPS TIDY RUm'-Nhe A$i0'Iof t'2E 'UNIITED TN IBcW A R N I N G FhK e1 )S--- VEL.CT,GTNi0','1', OUTINE',Gr. c', TABLES WHICHS,'J','K','L','M','N', IoXINC'GE! CETE' a co:TDfIF (LEVL1AGESI3 N G 3the O1C, DE'ro)TED NC D BOl----UND IGHA SPEC, '-IC MVEL u ARRHt KtI3 N G 3tht','L',DioN,'L'- SU *N'('CA$T C D BYN INVOB THISI .')NINCL/)1rf'uINCL'8' fRRHt KtI3 N G 3tht','gHA '1', C CHAED BYB-n)G----iITED TCuACT,GTNi0',' KSPK/'=',l '$'//')ra B) iRAT*iC-NITVERNUM CHARACTER*25 ----------------------------- C VARIABLES WHICH ARE CONTROL b---CHARTHINPTIo:r 0 CURRENT CPe A$TdP[ODio CALLY Sa B) iRAT*iC-NITVERNUM = D BYN INVOB THISI .')pR1tpcA[*25 ---"--EO97 t' V='G'YN',p********CM/pKI HAED BYB-pcA[*SAiIADErACFf',KERM/' *', '$$',$', 'i IoXINC'gLLY Sa---- C VARIABLES WHICH ARE CONE6rp***MONE6rp***MONE6rpVERNUM co:TDfIFER) GTNHANGI1o'tcEEEnERITRAT*iC-NITVERNUM = D BYN INVOBu_OBu_ (CL'8N INVO0',' KSPK/'=',l '$'//')ra B) iRAT*INVOB ., '.& Os t' V='G'YN',p********CM/pKIARE CONTROL1 1iC-R1 1CH ARE C'/ ER*25 -------AiITE, VELLETE' a co:TDfIF (LEVL1AGESI3 N G 3the r,ST DURSTNIITED T -7NI ($EMEprogBgru ' DIAGNOt7','3 R T0',km LETE' aoATEDTSTet of t'2E 'UNIITED TN IBIF (LiITED TCuACT,GTNi0',' KSPK/'=',l '$'/ STOP','B','C','aIS NOT SPEEVEfbpNOT FLA 1 COÖ7uARACTE=DJUST ROUTbSER( 'P2', TI& h9SS2'['DELTet oFhNHANGI)ra C VARIABLES WHICH ARE C6uTHIS TIBt',po-UM co:T-7NIX TetUNII END SPECIERITRAT*iC-NIT.& Osp2E 'UNII A$b D TI& h9SS2'['DELTet b'J','otUNII END SPECIERITRAT*iC-NIT.& Osp2E 'UNII A$b D TI& h9SS2'['DELTet b'J','otUNII END SPECIERITRAT*iC-NIT.& Osp2E 'UNII A$b D TIL ┐uACT,: oFhNHANGY C4:ABLES WHI3C CS--- VELp4b-Nhe A$D SPE 'UNIITED TN IBIF (LiITED TCuACT,GTNi0',' KSPK/'=et b'F(i>NGI)ralER pprbTUNFLA '($"SE5---NITID S V='G'YN',p********CM/pKIARFhNHAFdc:I A$b D 4>M/')rmRAT*iC-NFh----------SS2',',LLE- VELpE' a co:TDfIF (LEVL1AGESI3 i0','Ff 2',c, THASKLP2, KRP0',' KI ($EMEprogBgru ' DIAGNOt7' S A$b D 4>M/'TEMENTS UTINE RR6 O ,'K',ioN,nCING THIS TTTCuACT,GTNi0',' KSPK/'=',l '$'//')ra B) iRAT*iC-NITVERNUM CHARACTER*25 ----------------------------- C VARIABLES WHICH ARE CONTROL b---CHARTHINPTIo:r 0 CURRENT CG )0.INC'THISI .'ACT,: oFhNHANGY C4:ABLES A R N I ASTet tUN6p*******D SPE 'UNIITED TN IBIF 'N',:rR 7E 'TI ( =$',$', '/'=et b'F(i>NGI)ralER pprIDY :rDY 1c ABLES****)CuACT,NGYBYN INVOBlD BYB-pNC'UM - C VAagLLY Sa---PECfbps tu****CM 'X$',kÖ7uSPECIAFrlTTHAT C BB'-7NI AK/'=bPmGI)ralER p bm7/'=et SPEC, S, '(≤t SPEC, S, eoNMIITED TN IBIF 'N',:rR 7E 'TI ( =$',$', '/'=et b'F(i>NGI)rIh[INC1', 0.IUCL/)1T o-UM co:TIDY rs, tr'TICiRAT*iC-NITVE ES ','9'vT PASS UNFO CALUTF V='G'YN',p********CM/pKI IITED DTI (F V='G'YNaND,'G''EREEI3CsNTROL b---CHARTH7E 'TI ,'PHEY C VARIABLES ! CETE' a co:TDf5N',:rR 7E 'TI ( =$',$', '/'=et b'F(i>NGI)ralER pprIDY :rDY 1c ABLES****)CuACT,NGYBYN INVOBlD BYB-pNC'UM - C VAagLLY Sa---PECfbps tu****CM 'X$',kÖ7uSPECIAFrlTTHAT C BB'-7NI AK/'=bPmGI)ralER p bm7/'=et SPEC, S, '(≤t SPEC, S, eo CH l2uELE S****)CuACT.& OsE' aROU', ''TI ,' 'UpKIENT CPiITE, VEC, TSTet=ODINGI)S W,'1'aiC-NSTet ESls h9SSt1,Bu_ (CSTe5NE REE R._ROUS █'TI ( /TTI ( =$',$', '/'=(AT*iC-NITVERNUM = D BYN INVOB THISI .')pR1tpcA[*25 --ra '+', '-', '*', '.', 'X$', '-NY OTHER TEST BY C b'F(i>NGL b'F(& Os,',LLED BY SU--- THIS TIBt',po F(os,',L5-1 C 2',c, THASKLP2, KRP2, KEG THIS, TOt1GohW A R N I N G ., KS, s INVOTNED BYllENT BUG C ⌡tc R N I N G .',I5, ' DIAGNOSTIC MESSAGES HAVE BEEN G 1ENERAEDEL' IrGaF (L .',I5, ' DIAGNOSTIC MESSAGES HAVE BEEN G 1ENERAEDEL' IrGaF (L .',I5, ' DIAGNOSTIC MESSAGES HAVE BEECHANGING SECOND CDe,'K',GTNi0 pO=Gbhe A$T TI& Ot=eDYm l2uELETED$', '-NY OTHER TEST BY C b'F(i>NGL b'F(& Os,',LLED BY SU--- ',:rR 7E 'TI ( =$',$', '/'=et b'F(i>NGI)rIh[INC1', 0.IUCL/).& Os AT*iCiTDf5N',BDINGI)S W,','C', = D B TESAGES HAG0bl- ',:rR 7E 'TI ( =$',$', 'R -IS, ,LLr. A ARE CR NS*o F(osGNOTD T>e 'P',l '$'//')ra B) iyt1he A$TdP[ODioNMSG., '.'TISTOt1GEN (L .',I5, ' DIAGNOS BYllE=b5iiAEDEL' stABEEN muF (L .'or┐***lI)rIh[INC1', , = D B N)Cui N G FhGES HAG0GNO=iAEDuo"OS BEEN Glu$i0d4i=Gbhe A$ IcLP2', TITi-NY OT5F╚Nn--SS2',',LLE- VELuA'$'/ :rR 7E ',:rR 7-17ue.4 'TIiGTN*b OTHER .')pR1tpcugBgrueOl----RAT*N I8, 'E :rR IS TI)1T TrR 7E 'TIETE' aROUhe A$TFhGo2gl+DTSTe5NRINGnCSTe57E ',uI ( =$' S HAG05/,:rR 7-1=et bluG Nhe A$NaCIAFrlTTHA1',ISSAGES'=et bn I N GB A1e5NRINGnCf VAac'.', 'X$', '-NIa O 20 MEIh[INC'G '+', )', '+')GEGNA/ S WHI(NMSHICH E 'GaTROL b-- Tru',l ' (MSTOPIS, TOt1G--A$T 7 ROEQ., '.& Os| tu5D-ùOUL',p 1sF CHED.'EREEY---EtaQ., '.& Os tu5D-iIeNWHICH A LEVE' a A$eOl-╦Φ 'X$',km lAFrn I N GBG0bl ROEQ., '.& Os| tu5D-ùOUL' 70 F TOr. AARE CONTlAFrn I NBgG05/,d-g O 20 MEIh[dTOP','B','C','aIS NO Os tu5D-iIeNWHIlbn I N GB I ( =INVOBlD BYBbhtuTVENGnCf VAegRMAlP1i>NGI)t b'F(i>Nq0oNaCIAFrtNGnCf t└81DiiAc╝Y rs, tr'TICiRP(TICil=1MAlP1idBC'UM Os ','aISEECHrtu5D-iIe╟(TICil=1MM cFHW pf9:GACT,GTNi0u'='')dP:'B','C','aPBh[IBYBMe+')GEGNn I N Gb OTHER n Ih[INC't17ue.4 'rCu- VELuADIAGSls ERITRAT*iC BYBbht '17 ROEQ.Tb AFrn VAagLLa tu5Dcbh,GTNi Gb OTN)GEGg '.&I)t b'F(i52 STOP','B'b OTHER n Ih[INC'" WHI(NMSHI_ '*', '.'o:TDf5NMLP2, N -NYt Tt1h N Is.'C','m., '.& Os|.Cdmt b'', ' 7Tet'G 4e+')GE 7N 'UABE7a'b I3 B Tt17uOs aeue.4 'P',VE E(NMSHI_ '*', ' N G 3mcbh,GTINGI)S W,','IAGNO =lm7i0', Gb OTHER u'='GTINGI)S W,'GEGNOST '-NYt THISIN THMc., '5NMLP2, tu5DⁿiAc╝MCPe A$T2',','B-NYt THISIN T8 Te ($c '.&I)t 4------ Os ','aTt17uOOSIurhA CONTlAFrn I NBgG05/,d-g O 20 MEIh rERITRAT*,','IASIN T8 E 'Trn O ,'K'tlu$i0det17u7uOOSIureA R N I N ret1NGI)rIf'.& Osra m '17 5D-ùOUL' 70 F TOttOd'o:bbm7/'u ESlEfENDSAGESIINCL/)1T SPECIE 'UNIIG., '.'uR*4 RFGbhe A$T TI& Ot=eDYm l2uELETEDEL'8' TH CSAGESIINC oCLOc 1SStIh)IITED TN IBIF (LEVL1r 'X$',km l2uELETEDEL'8' TH CSAGESIINCL/)1T SPECIE 'UNIITED TN IBIF (LEVL1r 'X$',km l2uELETEDEL'8' TH CSAGESIINCL/)1T SPECIE 'UNIITED TN IBIF (LEVBTED TN IBIC-17ulS, ,LLr. A ARE CR NS*,'TEMENTS UTIBt',po LP28' TH CSG0blTEDEL'8' TH CSAGESIINCL/)1T ','9'vTX$'r. ue.4 'P'o LP28' TH:gCL/)1T ','9'vTX$'r.AFrn I NBgad h9SfTH:gCL/)1TnT l2uELsWHIC,NGY co:Ö7uARAg╘-1uELNIIuu$i0dlG0b)S q0oCIE 'UNtl2u0bl RONO Os pLNGI)rIf'h9SfTH:gCLkm l2T≤t SPE'vTX$'r.AFrn I NBgaoN,nClX$'r.AFrn(LLY Sa---SfTrl2uET ', RFNpo LP28' TH CSG0blTEDEL'8' TH CSAGESIINCL/)1T ','9'vTX$'r. ue.4 'P'o LP28' TH:gCL/)1T ','9'vTX$'r.AFrn I NBgad h9SfTH:gCL/)1TnT l2uELsWHIC,phrDYOpECIE 'UNgTH CSAGEuhHuAG0b).Ö7uARAg╘-1uELNIIuu$i0dlG0b)S q0oCIE 'UN q0oCegRMA9'vTo'//INVOB THCL/)7t=ODING7E/)1T ',ACT = D gCL/k1'TICATFwO1CSL1A, C"nT l2c'2E 'UNIITED TN IBcW A R N I N G FhK e1 )S--- VEL.CT,GTNi0' DIAG C FbheTHER n Ih[rR TEST BY C b'F(i>NGL b'F(& Os,',LLED BY SU--- ',:rR 7E 'TIII END SPECIE 'U) uVO97 t'UNFLA 1 )S---'($"SE5IS F, TH:gCL/)1T ','9'vTX$'r.AFrn I NBgad h9SfTH:gCL/)1TnT l2uELsWHIC,BC/'A','B'' DIpPTH:gCL/)1TnT ltur 0 CURREN╦ΦT C D Nn Ih[rG0blCL/)1T ','9'vTX$'r.AFrn I NBuVO97 SE5r. cCONTROL ╟a O 20 MEIaTgh,GTINS F, RAg╘-1unPmGI)ralE 'UB-.CT,GTN Fb8E 'UNgTG C egRMA-'($"SE5I A R N l2u░'P2', TINTROLm h=1 A R.')NI '($"iITED 'B'' DIpPTH:g5r. cCONTR15 A/ S CDII E'vT PA D Nn Ih[rG0be.4 'P'o 0oCIE 'UN q0oCegRMA9'vTo'//INVOB THCL/)7t=ODING7E/)1T ',ACT = D gCL/k1'TICATFwO1CSL1A, C"nT l2c'2nLa 'vTXdiKLP2, uaMCHARTH7E 'dFdc:I AAT iC-NITI)1T T C b'F(i>NGL b'F(& Os,',LLED BY SU--- ',:rR 7E 'TIII END SPECIE 'U) uVO97 t'UNFLA 1 )S---'($"SE5IS F, TH:gCL/)1T ','9'vTX$'r.AFrn I NBgad h9SfTH:gCL/)1TnT l2uELsWHIC,BC/'A','B' SU--- ',:G C FbheTHvTX╟b'F(ifgPB$"SE5IS F, TH:nT l2uELsY1MM cFgRMA1rF(i>NGI) U q0oCegRMA9b Os kDII Er NS*-_uELsWHIC,l2uEL', '-NIa OR T1-PtD gCL/k17 ROaCT ltur 0 ChdGTN)e'8' TH CSAGESIINTHISI .'ACT,: os_ os_ os_ os_ os_eS*-_u17 5D E 'Tr)ii gClpPTH:g5rNAODING7E/.1ELsY1MM cFgIC,l2uEL', '-SOaCRMA-g'TID gCL/k1'TIANGI20IUFbhgI)rIf'Ih)IITESIINCL/TbYB-pNC'b Os kDII Er NS*-_uEE_pPTH:g5rNAODING7E/.1ELvT*iC-NITTHA1',ISSAGESFgRMA1rFFBNGn (LEVBTED TN " VEL.CrsoiLLr. A Ar. A Ar. AHA1',AE0oC 7D .AFrn Os kDII EreG TeDII HCL FgReDIWl/g O 20iTeDIInAELur. C C C C C C C C C C C C C C C C C CTN Os tu5N GB -$',rdFdc:I nTGY co:Ö7uARAg╘-1uELNIIuu$i0dlG0b)S q0oCIE 'UNtl2u0bl RONO Os HCLLr. )S---'(oCIE 'UNSlECM 'X$lPuAr. A A) I NBgCT l(N (L CRMA-g'TID gCL/k1'TIANGI20IUFbhgI)rIf'Ih)IITESIINCL/TbYB-pNC'b Os kDII Er NS*-_uEE_pPTH:g5rNAODING7E/.1ELvT*iC-NITTHA1',ISSAGESFgRMA1rFFBNGn (LEVBTED TN " VEL.CrsoiLLr. A Ar. A Ar. AHA1',AE0oC 7D .AFrn Os kDII EreG TeDII HCL FgReDIWl/g O 20iTeDIInAEL 'X 8 A$ IcLb Osz 'UNSlpnCf tONTRO"--UEL.CpMA-g'TN ahpSE5r9dkDII EgReDTHA1',IPCT riC,N C R N I N GvTX$'r. ue.4 Bbhtvln**CM EreG TeDIBr NS*-_uEE_poYgER Ts k HCL FgReDIWl:rM/pKI SPEC$T T(A1',TN " VE 1c UNtl C C C .lmL'A','B' /s ts UNta Ar FhK GTNi0 pRgONTRO"-- Ih[rGru 'vTXdiKLP2, uaMCHARP1OCT l(NkÖ7uSPECIAE, VELHA1',IScdE0oC 7TXdCuACT,On, uaMCH------AiITE, V3il=N G0PTH:g/'=',l '$'/ CONTROL br'*', '.', PTHU=MER Ts k HTTH:g/Y1MrNOt7u 'vTXdiKLP2, uaMCHARP1OCT l(NkÖ7uSPECIAE, VELHA1',IScdE0oC 7TXdCuACT,On, uaMCH------AiITE, V3il=N G0PTH:g/'=',l '$'/ CONTROL ZfAiITE, U=MER Ts k HTTH:g/Y1MrNOt7u 'vTXdiKL1MrNO/).,BC/'A'CT,OoI5, ' DIAGNOSTIC MESSAGES HAVE BEECHANGING SECOND CDe,'K',GTNi0 pO=Gbhe A$T TI& Ot=eDYm l2uELETED$', '-NY OTHER TEST BY C b'F(i>NGL b'F(& Os,',LLED BY SU--- ',:rR 7E 'TI ( =$',$', '/'=et b'F(i>NGI)rIh[INC1', 0.IUCL/).& Os AT*iCiTDf5N'',l '$'/ CONTROL br'*', Fa MEIh[iITE, V3il=N G0PprReDIWl/g O 20iTeDIInAELur. C C C C mNOSTIC M$"SE5Ong4O',km uECIA ╟as ╝Y rs, tr.& pm1, ECIEwfAT*iCiTDf5N'',l '$'/ CONTROL br'$'/TXdBYB3prReDS HAG0blAMD)[ELETED$', '- :rRdE0oC , Fa 1MM cgqrC, S,- CONTROD TN " VE4r 'X$',km C pprbTM 'TE, V3 pm ret1NGI)mS F, TµND CDe,'L br'$'/bSCL/)1T h=1 ASCLiDM C m ELur. De,'K',GAVNgTG bOs (iE5Ons a )', .D VEFFrn ISTIC M-NITTHA1 R N I L/)1T '■ C VE4r 81$', CONTROL br'$'/TXd C TGI20IUFδNUM CHARACTER*25 ----------------------------- C VARI---------------------n aF bi}Lur. De,'K',GAVNgTG bOs (iE5Ons a )', .D VEFFrn ISTIC M-NITTHA (LE I ASTet tUN6p*******D SPE 'UNIITED TN IF 'N',:rR 7E 'TI ( =$',$', '/'=et b'F(i>NGI)ralER pprIDY :rDBlER pprIDpP'F(i>NGI)ralEtgkm l MEIh[iITE,- ',, ECIE, '--------G0bl,:rR 7E 'TI ( =$',$', '/'= :rDYTEDr. kymL/INVOe-----aCIAFrtNGre----------drR TES uECINED BCIAE, ',GAVNgTG bOs EDr. kA',GAVNgTs-----"┴TES8ELur. DaF bi}R N I$',$', '/ b'N G0░HED.'ERErR TEmd-g=18gINVOB THt17ue')dP:'7lDII Er NS*-_uEE_pPTH:g5rNAODING7E/.1ELvT*iC-NITTHA1',ISSAGESFgRMA1rFFBNGn (LEVBTED TN " VEL.CrsoiLLr. A Ar. A Ar. AHA1',AE0oC 7D .AFrn Os kDII EreG TeDII HCL FgReDIWl/g O 20iTeDIInAELur. C C C C C C C C C C C C C C C C C CTN Os tu5N GB -$',rdFdc:I nTGY co:Ö7uARAOs tu5N5rNB1tu]E 'UNIITTHt17ue ╬ODioTH:g/i>NGI)rIh[INC1', 80blS╬ODioTiR*4 uaM'UNtl2u0bl d/)1T ',1Fdc:I nTC,AELur. a )', .D aCu Ih[IPCT rioC C C TN " VrY1MrNOt7u ' [C C Ys kDIIA1rF1rCONTFNpo L0NIITTHt(rrdP:'S C C C 80blS╬ODi7ITRAT*,',kDIS0=asrkDIIA1rF1rC-=trROII HCI eE,- ',,hd 7)ARP1OC[C 8E 'UN, tu5OL , A TN " ', )gtm eVNgTs-----"┴TES8ELrsr2 Utu5Dcb7t=e 'TI 1',IScdE0oC CL FgRe-3NITTHAldPKTED TN IF 'N',:rR d/)1T OspbbUNSTTH' C Ys kD C : DaNVOB THt17ue'AII HCI eE,r ' [C r. A Ar. A gII trR 7Tet'lARP1 LP.,', '- (qrC, S,-IWlE-_u 7D SE5Ong :rR d/)1T e Ne-g=18ITT T re-gWl/ Ih[riue Ne-g=18ITTsMTTHiReDIWl:rM/pKI SPEC$T THA1',Ao[ELE4lSE5IS F, TH:--------nIA1r. A gII trR ar7ITTOG FhKemR.')NI 'DYm A Ar. AETEBdE4r 8CL FgRe-oL' 70 F TOr. AARE3Ys kD C Cu5DC[CEp2EA1',Ao[nCf *CL SFgRMA1rel TN " VrY1MrNOt7u ' [r. ksso$'/ CONTReDIWl:oOO O- ',, EC-rO/)1T)PeeNITT-Ri HAG0G,:rli3st 71el TNl DIAGNOSTnL/kS8ELrsr2 Utu5Dcb7t=eE]} CSAL/)1MrNOt7u ' [r. kssihftr.& p$'/ CONTReDIWl:oOO O- ',, EC-rO/)1T)PeeNITT-Ri HAG0G,:rli3st 71el TNl DIAGNOSTnL/kS8ELrsr2 Utu5Dcb7t=eE]} CSAL/)1MrNOt7u ' [r. kssihftr.& p$'/ pN',, EC-- ',, EC-rO/)1T /s 7h6STnL/kSS---'(oe/s 7h6STnPEC$T 1', -o.A1',Ao:rM/, -OSCL/)1T h=hKecHIC,ph9SfTH:g'/FT)PeAo:rpT8' TH C.lmL /s 7h6STEC$T 1', -o.A1nr /s 7.L CRMAFTBECINED BCInL/kS8ELrsr2 Utu5Dcb7t=eE]} CSAL/)1MrNOt7u ' [r. kssihftr.& p$'/ pN',, EC-- ',, EC-rO/)1T /s 7h6STnL/kSS---'(oe/s 7h6STnPEC& p$REg'/'/ pN',, ITTsMTTHiReDIL CRMA ECH C.lmNl DIAG=0ER Ts n3T',QMhgl:oOO O/)1PTHieaNVOB THt17u5DC[CEp2EA1',prnEe', ib'Fe ',u ' [rINTHISI .OkSS---'uAL/u 'TReD ',kDIS0=a oe/s4u C mRiRaX)B3/ pN',nHA1nPEC&Oib'Fe ',u '-'uX$',p$'/ DaF bT O/)1P=etm-g=18ITT T re-gWl/ Ih[riue Ne-g=18ITTsMTTHiReDIWl:rM/pKI SPEC$T THA1',Ao[ELE4lSE5IS F, TH:--------nIA1r. A gII trR ar7ITTOG FhKemR.')NI 'DYm A Ar. AETEBdE4r 8CL FgRe-oL' 70 F TfnCf t└81DiiAc╝Y rs, tr1rshA1nI E'vT7b P>a'b I3 B Tt 5IIN/=MEIh[iITC[CECONTReDIWl V3-'(oONTRO"--UEL.CpMA-g'TN ahpSE5r9dkDII EgReDTHA1',IPCT riC,N C R N I N GvTX$'r. ue.4 Bbhtvln**CM EreG TeDIBr NS*-_uEE_poYgER Ts b ECH C.lhbös HCL SPEC$ .AFrn nI mSTnL/kS, TINTROLil =kTHA1'x : TI C mRTN ahTHA1n: Ne-g=18ITTsMTTHiReDIWl:rM/pKI SPEC$T THA1',Ao[ELE4lSE5mTHt17u5DC, S,-II HCI eE,- ',,hd 7)ARmlr NS*A1n: NsIiWMTTHiReD kDiCu 70 Fr- TH CSAGESIdkDII E Ne-g=18m [rI:TDI C=1',IPCTs[c HAG0G,:mTHt17u5DC, S,-II HCI eEdL br'*', Fa MEIh[iITE, V3il=N G0oMA1rFFBNGn (LAETITTsMTTHiReDIWl FbiCu 70nL/kS, TINTROLil =kTHA1S, TINTRurn Os kDII EreG TeDII HCL FgReDIWl/g O 20iTeDIInAELur. C C C C C ll/wrCONTFNp)PeeblOfgIIr. SAGEdL br'*',AELur.CeEGb,Ao[ELu5DC, S,Ne-g=18m ROLi YgER TSIdkC=1',I I 0Ne-g=1[ELu5D(ie-g==',LE4INC,kDIS0=as$ A Ar. A Ar. AHA1',AE0oC 7D .AFrn OL/k318m ROLi Ys HCL SPEC$ .AFrYm l2uELE4]} 1R.')Ym l2uELE TeDII EdL br ',, E5IS F, oiLLrbS2rn OL/k318m , E5IS F, oiTFNp)P:rli3D .AFr *CLHiReDIWl g'TN MA1A1n: Ne-g=18ITTsMTTHi OR T1-PtD' [r. kssihftr.& p$'/ pN',,IF (LEVL1l RONO Os pLNGI)rIf'h9SfTH:gCLkm l2T≤t SPE'vTX$'r.AFrn I NBgaoN,oCL TH CSAGES E',p$'/ FTH CSAGESBECINED BCInL/kS8ELrsr2 Utu5Dcb7t=eE]} CSAL/)1MrNOt7u ' [r. kssi TN IBIF (LEVBTED TN IBIC-17ulS, ,LLr. A ARE CR NS*,'TEMENTS UTIAG0blAMD)[ELETED$', '- :rRdES0=as$ A 8 HCL SPEC[ELu5DC, S,hiCuEdL br'*'tu5Dcb7t=eE]ESBECDpIN C R N I N G<2EA1',Ao[nCf re C C).Ö7uARAg╘-1uELNIIuu$i07E 'TIII END SPECIE 2uaMCH1NGI)mS F, Tµ-'($"SE5IS F, TH:$NTROL br'$'/TXd C TGI20IUFδNUReD kDiCu 70 Fr- TH CSAGESIdkDII E Ne-g=18m [rI:TDI C=1',IPCTs[c HAG0G,:mTHt17u5DC, S,-II HCI eEdL br'*', Fa MEIh[iITE, V3il=ºeD kDiCu 70 Fr- TVTER*2D TN "α TN "α TN "α TN "α TN "α TN "α TN "α G0PTH:g/'=',l 'L/k318m , *CLHiReDIBTED TN " VEL.CrsoiLLr. A Ar. 0 pRgONTRO' [r. kssi2 b'F(ES uECINEuEC,,e 7D .AFrn ,'B'' DItODioTH:g/i>NGI)rIh[INC HCLLr. , I NBgaoN,oCL TH CSAGE7$hELu5Dbr'*'tu5Dcb7t=eE]ESBECDpIN C R N I N G<2EA1',Ao[nCf re C C).Ö7uARAg╘-1uELNIIuu$i07E 'TIII END SPECIE 2uaMCH1NGI)mS F, Tµ-'($"SE5IS F, TH:$NTROL br'$'/TXd C TGI20IUFδNUReD kDiCu 70 Fr- TH CSAGESIdkDII E Ne-g=18m [rI:TDI C=1',IPCTs[c HAG0G,:mTHt17u5DC, S,-II HCI eEdL br'*', Fa MEIh[iI HCI)uAL/u 'TRAFrn ,'B''X$' IB t-g=18mUBROUTINE RATING(IR) C-g=18...END OF GAME ROUTINE. c include 'tcommon.for' %include tcommon.for t-g=18DIMENSION PWIN(3,4),PLOSE(3,4) t-g=18DATA PWIN/1.,2.,3.,2.,4.,6.,3.,6.,9.,5.,10.,15./ t-g=18DATA PLOSE/3*1.,3*2.,3*3.,3*5./ t-g=18DATA ILOSE/0/ t-g=18GO TO (10,20,30,40,50,60,60),IR 10g=18write(*,1) 1-g=18FORMAT(' Collision with Star!18mhip Destroyed') t-g=18GO TO 100 20g=18ENERGY=ENERGY+DEFL t-g=18DEFL=0. t-g=18IF(ENERGY.LE.0.)GO TO 4000 t-g=18write(*,5000) 5000 FORMAT(' Defectors automatically dropped to obtain energy') t-g=18RETURN 4000 write(*,2) 2-g=18FORMAT(' Out of energy') t-g=18GO TO 100 30g=18write(*,3) 3-g=18FORMAT(' Time''s Up!') t-g=18GO TO 100 40g=18write(*,4) 4-g=18FORMAT(' Congratulations!!') t-g=18GO TO 100 50g=18write(*,5) 5-g=18FORMAT(' Crew wiped out!') t-g=18GO TO 100 60g=18write(*,6) 6-g=18FORMAT(' Warp drive explosion!...everything in quadrant destroyed! t-g=11!') t-g=18IF(PSP.GE.1.)GO TO 100 t-g=18IF(KLNGNS.EQ.0)GO TO 90 t-g=18DO 80 J=1,KLNGNS t-g=18IF(XKL(J,1).EQ.0.)GO TO 80 t-g=18LEFTK=LEFTK-1 80g=18CONTINUE 90g=18IF(NROM.EQ.0)GO TO 100 t-g=18DO 70g=18J=1,NROM t-g=18IF(XROM(J,1).EQ.0.)GO TO 70 t-g=18LEFTR=LEFTR-1 70g=18CONTINUE 100=18R=LEFTK+LEFTR t-g=18S=NKL+MROM t-g=18R=(S-R)/S t-g=18KR=R*1000. t-g=18IF(KR.GE.1000)GO TO 999 t-g=18IF(KR.GE.900)GO TO 998 t-g=18IF(KR.GE.750)GO TO 997 t-g=18IF(KR.GE.500)GO TO 996 t-g=18IF(KR.GE.250)GO TO 995 t-g=18write(*,94) 94g=18FORMAT(' You really blew it. the incumbent will lose by'/t-g=18' a3576 t-g=11 landslide and don''t be surprised if they rename the Vulcan Bowl'3577 t-g=11/t-g=18' the Klingon Bowl!') t-g=18GO TO 994 995=18write(*,95) 95=188FORMAT(' Starfleet command hangs you in effigy.'/t-g=18' at least t-g=11you won''t be called upon to testify at the stargate hearings!') t-g=18GO TO 994 996=18write(*,96) 96=188FORMAT(' You seem to be getting the hang of it.'/t-g=18' the presi3585 t-g=11dent may be able to pull the election out by referring to'/t-g=18'3586 t-g=11 your efforts as a "tactical redeployment in certain non-'/t-g=18'3587 t-g=11 critical sectors of the galaxy."') t-g=18GO TO 994 997=18write(*,97) 97=188FORMAT(' A most valiant effort. your name will long be remembered 3591 t-g=11with fear'/t-g=18' by the pitiful remnants of the once mighty Klin3592 t-g=11gon-Romulan Empire'/t-g=18' the president would have appointed you3593 t-g=11 attorney general at least..') t-g=18GO TO 994 998=18write(*,98) 98=188FORMAT(' congratulations!! you have overcome incredible odds'/t-g=3597 t-g=11 8' to come within a hair of victory. your children will be well'/3598 t-g=11t-g=18' provided for.') t-g=18GO TO 994 999=18IF(IR.EQ.7)GO TO 993 t-g=18write(*,99) 99=188FORMAT(' Victory, total and complete, is yours!!!'/t-g=18' your fa3603 t-g=11me will spread throughout the entire universe! unfortunately,'/t-3604 t-g=11t-g=' the president doesn''t like being knocked off the front pag3605 t-g=11e'/t-g=18' so he has appointed you as permanent ambassador to the 3606 t-g=11outer stotinki'/t-g=18' colonies.') t-g=18GO TO 994 993=18write(*,92) 92=188FORMAT(' Your place in Valhalla is assured. you have eliminated th3610 t-g=11e last'/t-g=18' major threat to the federation in this era. you ma3611 t-g=11y even inspire'/t-g=18' a new television series!?!?') 994=18write(*,93) 93=188FORMAT(///) t-g=18write(*,7)KR 7-g=18FORMAT(' Rating = ',I5) C-g=18...DETERMINE POINT GAIN OR LOSS FACTOR. t-g=18IF(NRW.EQ.0)GO TO 661 t-g=1 IWIN=1 t-g=1 IF(KR.LT.750)IWIN=-1 t-g=1 IF(KR.LT.900.AND.IRANK.GE.10)IWIN=-1 C-g=18...DETERMINE INDICES8FOR PWIN OR PLOSE. S IS TOTAL8ENEMY AT START.3622 t-g=1 IL=4 t-g=1 IF(S.LT.100.)IL=3 t-g=18IF(S.LT.50.)IL=2 t-g=1 IF(S.LT.25)IL=1 t-g=1 IF(IRANK.EQ.NRANKS)GO TO 3005 t-g=1 IF(LEVEL.EQ.1.AND.IRANK.GE.7.AND.IWIN.GT.0)write(*,6601 ) 6601 format(' if you want to gain rank you''ll have to play at a higher3629 t-g=11 level') t-g=18IF(LEVEL.EQ.1.AND.IRANK.GE.7.AND.IWIN.GT.0)IWIN=0 t-g=18IF(IL.EQ.1.AND.IRANK.GE.9.AND.IWIN.GT.0)write(*,6602 ) 6602 format(' sir if you want to gain rank you''ll have to play against3633 t-g=11 more enemies') t-g=18IF(IL.EQ.1.AND.IRANK.GE.9.AND.IWIN.GT.0)IWIN=0 t-g=18IF(IRANK.GE.11.AND.IL.LT.3.AND.IWIN.GT.0)write(*,6602 ) t-g=18IF(IRANK.GE.11.AND.IL.LT.3.AND.IWIN.GT.0)IWIN=0 t-g=18IF(IRANK.EQ.NRANKS-1.AND.(S.LT.198.OR.LEVEL.LT.3.OR.KR.NE.1000.OR.3638 t-g=11t-ITFCTR.GT.10).AND.IWIN.GT.0)write(*,6603 ) 660388FORMAT(' Admiral sir: if you want to become a Fleet Admiral you''l3640 t-g=11l have'/' to play a level 3 game with 198 enemies and a timing fac3641 t-g=11tor of 10gor less.') t-g=18IF(IRANK.EQ.NRANKS-1.AND.(S.LT.198.OR.LEVEL.LT.3.OR.KR.NE.1000.OR.3643 t-g=11 -ITFCTR.GT.10).AND.IWIN.GT.0)IWIN=0 300518IF(IRANK.EQ.NRANKS.AND.IWIN.LT.0)GO TO 1999 t-g=18IF(IWIN)1000,1999,3000 C-g=18...LOSS.8DEMOTION. 1000=1XPTS=-IWIN*PLOSE(LEVEL,IL) t-g=18XPTS=XPTS-XPTS*R t-g=18XPTS=AMIN1(XPTS,POINTS) t-g=18IF(XPTS.EQ.0.)GO TO 1999 t-g=18write(*,1001)XPTS 100118FORMAT(' Well, you blew',f5.2,' points on that one, meathead.') t-g=18IF(POINTS.GE.1.)POINTS=AMAX1(1.,POINTS-XPTS) t-g=18IF(POINTS.GE.1.)GO TO 1002 t-g=1 POINTS=AMAX1(0.,POINTS-XPTS) 100218IF(POINTS.GE.RANKPT(IRANK))GO TO 1003 t-g=18IRANK=IRANK-1 t-g=1 GO TO 1002 100318write(*,1004)RANKS(1,IRANK),RANKS(2,IRANK),POINTS 100418FORMAT(' your present rank is ',2a8,'. # points = ',f6.2) t-g=1 GO TO 2000 C-g=18...WIN. PROMOTION. 3000=1XPTS=IWIN*PWIN(LEVEL,IL) t-g=18XPTS=XPTS*R t-g=18IF(IR.EQ.7)XPTS=XPTS/2. t-g=18write(*,3001)XPTS 300118format(' you gained ',f5.2,' points on that one.') t-g=18POINTS=POINTS+XPTS t-g=1 IF(IRANK.EQ.NRANKS)GO TO 1003 t-g=18IF(POINTS.LT.RANKPT(IRANK+1))GO TO 1003 t-g=18IRANK=IRANK+1 t-g=1 IF(IRANK.EQ.NRANKS)GO TO 1003 t-g=18POINTS=AMIN1(POINTS,RANKPT(IRANK+1)-1.) t-g=18GO TO 1003 1999=1write(*,1998) 1998=1FORMAT(' No change in status this time.') t-g=18GO TO 661 2000=1READ(3,REC=MMKEY)MNAME,X,MPASS,X6,X7 t-g=18WRITE(3,REC=MMKEY)MNAME,POINTS,MPASS,X6,X7 661=18WRITE(9,REC=1)MNAME,POINTS,MPASS,ILOSE close(3) close(9) t-g=18STOP t-g=18END ]pIrite(*,95) 95=188FORMAT(' Starfleet command hangs you in effiHA1',AE0oC 7D .AFrn OL/k318m ROLi Ys HCL SPEC$ .AFrYm l2uELE4POINN)1000,1999,3000 C-g=1rmanent ambassadAFrITTsMTTHiReDIWl FbiCu 70nL/kS, TINTROLil =kTHAXPOIAND)XPRncom3nL/kSM1nL/kSn statusM2'/3000/' '/te(*,95) 9kS,VERTEND ] you1999,R.LSE,ENDRITWRITOF9=1R$ .. t-g=18GENPAT=GENse(9) t-g=18STOwrCONTFNp)GENPATghty Klin3592 t-e(9) (I:on-Rom' ')toryNghty Klin3592-g=18GENPAT= MEghty Klin3592-g=18al you20ghty Klin3592WRITIFghty Klin3592T(1:aoNe(9) (I:onghty Klin3592T=,1999,(ITnghty Klin3592e(9) (I:on=T(1:aod youwill lose bte(*,95) 9BE.1UATA.3.LEAD$ . BLANKS.1l RONO O=1RT=Eghty KliD"α G0FNp)GENPATghty Klin3592 t-e(9) (I:on-res' ')t C).Ö7ughty Klin3592=1RT==1RT+Eghty Klin3592GENPAT=GENPATMEght3uwill lose bte(*,95) 9k318ABROURGC).Ö TO 6OF9s you in FbCES.1l gONTROE6=1S=3ghty KliKWRI==1RT+OE6=1SMEghty KliD"α5G0FNp)9ghty Klin3592 t-e(9) (I=1RT:KWRIn-RomsadAFrI)(1:OE6=1S).AND.GENPAT-RomuEn status6=1S)toryNghty Klin3592-g=18 clo=Ighty Klin3592-g=185=188Fghty Klin3592WRITIFghty Klin3592RdES0=as4)toryNghty Klin3592-g=18KWRI=KWRI+Eghty Klin3592n3592GEN=1S=4ghty Klin3592WRITIFght5uwill lose bte2-g=18 clo=ughty Kli5=188Fghty KliWRIghty KliSUBRYs I anED00 Cmat(' youTHmanSUBRYs I anED00=18mU FNDRin AND18mU RE's ENC 30g=18writeat(' yous time.omple Cmat(' you(3)iteRY,RO' [r.)ll lo RO=18mU =1write(*,nt deS,victoryat(' you(RDme.ict003ingoryY WDATA.,3.evtory. t deS6OF9l lose bte(y KliS1write(*St003ingWDATANOTT.1S,3.u(3)ABRON t-TIViHA1',AE0oMAT(' Admil lo RO=18mU CARDus time.(6=18)6OF9ory. yNbte(y KliIDe(*IFI3.uBY9orA*,nt de.INTSCEPse(3))GO TOUss.'BiteCH1SM-te(y KliIFRO' [r.)=0,toryN18mU =1write(*,WITHtory. t deRO' [r.-aod (y KliWAand GOTOevtory.TURGE*,nt de(IRANK.MAT(' Adme Cmat(' youOR.LEVEL FNDRin S1write(*StorA*,AATANOTTRE's ENC 30AATAg=1 I3.eat(' youO2) t-g=18DON W-g=18DO 70g=18J=1,0AATAGENEythEDat(' youO3) t-g=A.11.AND.IL.LT.3.AN003ingIRAN t-TIVivictory. FNat(' you gained TO 6mandg=1GRin AON W-g=18DO 70g=18J=118mU =ffiat(' you gained A=18mU NEXT/t-gITIVivnt de(Ictory. FN TO at(' youO4) t-g=A.nt de(ORMAT(3.uBY9A ZERO(Ictory. FN TO 6maat(' you gained A==1GRin AON W-g=18DO 70g=18J=118mU =ffi A=18mUat(' you gained g=18DO 70g=18J=11A==1GRin ).Öory. t deRGIViN(Icat(' you gained ory. OCRE'0AARAYevt()GO TOUss.'BiteCH1Sod (y Kli(' CongrPSEU=18g=18DO 70g=18J=1,0Ys SIDe18mU RAN98.OF9s =18J=1EDat(' you592-g=18FNDRin S1write(*g=18J=1,0AATAGENEythED))GO EACHat(' you592-g=18RE's ENC 30g=18writeN003ingIRANOTTFNDRine Cmat,MPASS,ICLUDe1'TIDY.,IC'at,MPASS,ICLUDe1'UN00=.,IC'at,MPASS,F.(6=1F*,97) 518IFughty Klithe Vulca,97) GO TO t-g=11t-g=' DEBg=18KR=R*10001ughty Kli)write(*,6603 26) 518I,6=1Fghty Kli)write(*,6603 27) g=18writ,=18IF(KRnghty Kli)write(*,6603 3l'35(N W=18rit,=18IF(KRnghty Kli)write(*,6603 28) g=AT(' Adm,=18IF(KRnghty Kli)write(*,6603 29) g=R' Adm,=18IFRKRngh(y KliSE*,UO 99W=18 S.ÖorA*,IFRO' [r.) 99EDS AON W-1998) at(' yous W=18rit=0.,IFRO' [r.) W')8RE's ENC RO' [rJ),toryNgh(' yous W=18rit=-O' [rJ).18RE is yiteRIO 10ITHtO' [r.)=0 Cmat,ouwilT=ughty KliD"α6-g=18IF(KRghty Klin3592 t-g=' AdmeGT8KR=R*10007ughty Klin3592 t-g=' AdmeN97) 97=18820 Cm=18WRITE(9,REC=1)MNAME,POINZERO(MEAO=1 totaWAand BiteCHghty Klin3592s W=18riTt=-OAT(' Admghty Klin359297=18860 Cm=18WRITE(9,REC=1)MNAME,POINN t-TIVivMEAO=1l lose b.NTS.K AHEAD1l RONO O O OJ=Ight1 IF(LEVEOJ=J+Eghty Klin3592 t-g=' AJ).LT8KR=R*100030 Cm=18WRITE(9,REC=1)MNAME,POINCH1CK))GO AK+1)-1.)g=18writeatty Klin3592 t-gAT(' AJ).LT8KR=R*100030 ty Klin3592T=IT+Eghty Klin3592s W=18riTt=-O(' AJ)ghty Klin3592 t-g=' AJ).=18KR=s W=18riTt=-IABS-g=' AJ-ao)ghty Klin3592g=' AdTt=IABS-g=' AIo)ghty Klin3592R*100050 Cm=18WRITE(9,REC=1)MNAME,POINt-gITIVivIRANO)-1L1l gONTRn3592T=IT+Eghty Klin3592s W=18riTt=0 ty Klin3592g=' AdTt=L(' Admght5ONTRn3592OAT(' AdTt=IABS-gAT(' Admmght6uwill lose bte2-g=18518IF00 C-g=1rg=' DEBg=18KR=R*10007ughty Kli)write(*,6603 27) g=18writ,=18IF(KRnghty Kli)write(*,6603 3l'35(N W=18rit,=18IF(KRnghty Kli)write(*,6603 28) g=AT(' Adm,=18IF(KRnghty Kli)write(*,6603 29) g=R' Adm,=18IFRKRngh(yA1',AE0oM FN NOWil lo RO=1FNDRin S1write(*g=18J=1,..MAT(' AdmA1',AE0oHAan yNbg=18J=11OFRO' [r.).ous W=18ritoHAanZERO(IFRO' [r.)d (y KliW')899ED AON W-1998) AND1-NNN(IFRRE's ENC SC).Ö ' [r.)d (y KliSHOULD9BE.manN98n ).ÖRE's ENC SC).ÖNNNe Cmat(' you)GO EACH =R' , SCANoM FN )GO manIN=1 BE.1UATat(' youTURGE*S6OF9GOTO,0AATARE's ENC 30ALSOe Cmat,7uwilT=6=1Fghty KliwrCOONTFNp)00 C-g=1r-g=1rg1==R' Adm Cm=18WRITE(9,REC=1)MNAME,POINGE*,RE's ENC RINoM FN C-g=1r-g=1rwrCONNTFCNp)50 ty Klin3592-g=1rwrC80.)I8IF(KRghty Klin3592y Klin3592RdES1-Romu=' AJ)R=R*100090 t8K=IRANK-1 t-gl lose bte(y Kli18WRITE(9,REC=1)MNAME,POINNOTTFNDRinghty Klin3592-g=18al you11ugh(y Kli18WRITE(9,REC=1)MNAME,POINNEXT/ yNKRINomanINght9K=IRANK-1 t-gg1=IABS-s W=18rJo)ghty Klin3592n3592RdES1-RomKR=R*100011ughty Kliy Klin3592g772=I1gh(y Kli18WRITE(9,REC=1)MNAME,PADD.TURGE*,).ÖRE' TO atREC=1)MNAME,POINCLEVER TO atRONNT1 t-gl lose bteCOONTll lose bte2-g=18g=' DEBg=18KR=R*1000120ghty Kli)write(*,6603 27) g=18writ,=18IF(KRnghty Kli)write(*,6603 3l'35(N W=18rit,=18IF(KRnghty Kli)write(*,6603 28) g=AT(' Adm,=18IF(KRnghty Kli)write(*,6603 29) g=R' Adm,=18IFRKRngh(yA1',AE0oSCANoFNDRin TO 6)GO RE's ENC S.18F1 I3NNON-RE's ENC 3A1',AE0oFNDRin S1write(*g=18J=1,. Cmat,oRONOT=ughty KliN=18=ughty KliD"α16-g=18IF(KRghty Klin3592.LT.50.)I1,6=1Fghty Kliy Klin3592 t-g=' AdmeRomuR' AJ)R=R*100017ught=1 IF(LEVEl lose bte(y Kli18WRITE(9,REC=1)MNAME,PNOTTRE's ENC 3ghty Klin3592R*1000160 t-g=y Klithe V W=18riteN97) 97=188150 Cm=18WRITE(9,REC=1)MNAME,POINMAKEON W-1998)ghty Klin3592s=18=s=18+Eghty Klin3592s W=18ri)=KD15*s=18+KB15T.198.ORn3592T=IT+Eghty Klin3592g=' AdTt=L(' Admghty Klin3592s W=18riTt=s W=18ri)ghty Klin3592gAT(' AdTt=OAT(' Admght01)XPl lose bte2-g=18518IF00 C-g=1rg=' DEBg=18KR=R*100017ughty Kli)write(*,6603 27) g=18writ,=18IF(KRnghty Kli)write(*,6603 3l'35(N W=18rit,=18IF(KRnghty Kli)write(*,6603 28) g=AT(' Adm,=18IF(KRnghty Kli)write(*,6603 29) g=R' Adm,=18IFRKRngh(yA1',AE0oSCANoM FN )GO DRII=18TTRE's ENC S AND1RE8m Ce18mUM Cmat,o7ONOT=ughty Kli.LT22-g=18IF(KRghty Klin3592.LT2NNTFCNp)1ughty Kliy Klin3592the V W=18riteGT8KR=R*1000220ghty Klin3592 t-gg1=IABS-s W=18rIo)ghty Klin3592n3592.LT.80.)I8IF(KRghty Klin3592y Klin3592RdEg=' AJ).=18I1R=R*1000190 t18K=IRANK-1 t-l lose bte2-g=18ou gained g=.LT45PT(IRANKy Klin3592s W=18ri)=s W=18rJo1l RO IF(LEVEl lose bte(y Kli18WRITE(9,REC=1)MNAME,PTS.LTOF9GOTO-S.1BREAK000 C-g=1rn3592RdESTeN97) 97=18821ughty Kliy KliIT=Eghty Kli,POINCLEVEPA98.(-20)ghty Klin3592CLEVEPA98.(1)ghty Klin3592)write(*,6603 340)ghty Klin3592)write(*,6603 330)ght2ouwil3592s=18=s=18+Eghty Klin3592s W=18ri)=KD15*s=18+KB15T.1y Klin3592sMSG=sMSG+Eghty Klin3592CLEVEPA98.(1)ghty Klin3592)write(*,6603 31KR=sMSG,I8IF W=18ri)ght22-gEl lose bte(yA1',AE0oSCANoRE's ENC 30g=18writeN TO 6)GO MI==1 . FNDRIse(3,. Cmat,y KliIT=ughty Kli.LT24-g=18IF=1Fghty Kliy Kli.LT250.)I1,6(KRghty Klin3592y KliRdEgR' AdmeRomu=' AJ)R=R*100027ught21 IF(LEVEl lose bte(yA1',AE0oADD.PSEU=18g=18DO 70g=18J=1. Cmat,y Klin3592GERR=2 C-g=1rn3592RdESTe,97) oryNghty Klin3592-g=18IT=Eghty Kli,POIN,POINCLEVEPA98.(-20)ghty Klin3592,POINCLEVEPA98.(4)ghty Klin3592,POIN)write(*,6603 320)ghty Klin3592,POIN)write(*,6603 330)ghty Klin3592WRITIFghty Klin3592518IF518I+Eghty Klin3592 t-VulcaGT898.) 97=188250 ty Klin3592u=' AF(KRn==R' Adm ty Klin3592gAT(' AF(KRn=0 ty Klin3592F W=18rF(KRn=F(KR*KD15+KB15T.1y Klin3592sMSG=sMSG+Eghty Klin3592CLEVEPA98.(1)ghty Klin3592)write(*,6603 31KR=sMSG,=R' Adm,F W=18rF(KRnght24)XPl lose bte2-g=185=188FghCmat,28.ORCLEVEDIAG.3.(6)ghty Kli518IFMEghty KliMP2=ughty Kli5=188Fgh(yA1',FrYm 21)XP+1)-1.)'0ORMAT(1 . *DEBUG0Ys Ps FROMnSUBRnED00'/' 518I = ',I6,'in status F=1F = ',I6nght27)XP+1)-1.)'oM FN ',9I6nght28)XP+1)-1.)'oMAT(' ',9I6nght29)XP+1)-1.)'oMRFN ',9I6nght3O IF+1)-1.)'oF W=18',9I6nght31 IF+1)-1.)7X,'(',I3,')t*** S1write(*g=18J=1',I5,'imandg=1GRin 1998)ghty Kl1',I5,'.',13X,'***'nght32)XP+1)-1.)'0',12X,'***18mU ORMAT(1 . RE's ENC 30g=18writeS,AATANOTT3ghty Kl1FNDRin'nght33)XP+1)-1.)13X,'***rPSEU=18g=18DO 70g=18J=1,0HAVivBEiN(dg=1GRin.'/' 'at,MPAS1)ght34)XP+1)-1.)'0',12X,'***18mU ORMAT(1 . g=18writeS,AATAI3)itDLESSomanINghtMPAS1S6OF9GOTO''S.')ghty KliWRIghty KliSUBRYs I anHEAD)gh(*,95) 9' you gained ormanRYs I anCite=1,0JOBnHEAD1 .SFrYm MPASS,ICLUDe1'TIDY.,IC'at,MPASSmanRACe=1*2 ,1999, C-g=1rg=' I.1S,eN971R=R*100020ghty KliwrCONTFNp)72at,ouwilJOBri)=JINTAdm ty Kli97=18860 C1l RONO D"α G0FNp)80ght1 IF(JOBri)=IYs Adm C C-g=1rg=' you.G97) 97=18860 C1l(y KliSE*,UO COLUMO=173-75 BA,3.u(3)* t d OPse(3 C-g=1rg=' LBLg=18KR=oryNgh(' you.,3 *RYs VAL bte2-g=18g=(6=Ys -ao/26te2-g=18J=6=Ys -I*26te2-g=18RdES0=asKR=R*10007ughty KliKOL73O2)=KABCAdm ty KliKOL73O3)=KABCAJ)ghty KliR*100050 C1l gONTRKOL73O3)=KBLghty KliKOL73O2)=KABCAJmght5ONTRKOL73O1)=KBLghty KlideSbte(*,95) 9k3PY PROGRAM/SUBRYs I a/FUNCse(3)CARDuyouIAe(Ic+1)-1.e(3 C-g=1rD"α550FNp)3ghty Klin35KOL73Oi)=K1999,(youIAerIo)ghty 550l lose bte2-g=18WRIIFghCght6uwilD007u0FN73)80ght7 IF(JOBri)=KBLgh(*,95) 9' youCOMPRESSog=18DO 70gBY9ELIMIN1.e . MULTIPs.'BLANKSFrYm MPASSJ = Eghty KliK = 0ghty KliwrCO1G0FNp)80ghtKlin3592 t-JOBri)eN97KBLR=R*10001u0ghty Klin3592 t-K-RomKR=R*100011ughty Kliy Klin359K = 0ghty Kli Klin3592R*1000105atRONNT1 tK = Eght105MPASSJOBrJ) = JOBri)ghty Kli KlJ = J+EghtOONTll lose bte2-g=18D001200FNJ)80ghtoRONOJOBri)=KBLgh(*,95) 9' you,REC=1)MNAME,POINCite=1nHEAD1 . C C-g=1rgB=(80-Jo/2ght=1 IFFNJ+IBm MPASSJOBri)=JOBrJ)te2-g=18J=JMEghty Kli t-JeGT8KR=R*1000130 C*,95) 9' you,REC=1)MNELIMIN1.TAREMnINe . NON-BLANKSFrYm MPASSgB=IMEghty KliD88150TFNp)0BT.198.ORJOBri)=KBLghty Kli5=188Fghty KliWRIghty KliSUBRYs I anHOLSCNdEgTYPE,LSSCNm Cm=18WormanSUBRYs I anSCANS,ALe(ORRTite)CARDS6)GO FIELDS6OF9HOLGERITH- Cm=18WoYPEll lg=1teS.SS,I=ory,3 FIELDS at(' youmanRACe=1,0AATARE8m CeD10ITHtEQUIVAL 70gmanRACe=1,0003ingW')89O at(' you d TREAT3.uBY9ANALYSmanRYs I a,. Cmned ory.SEARingIRAMAD)uBY9CH1CKe . )GO PATe=1NS,-SNNNL-,000s E Simand1l(y KliSPECIAe(manRACe=1, NNN(Iand DECI-1L-1998) AND1L(Ianory. ETe=1nH at(' youL, GO R.SS,I=ADDIse(3,6)GO F1)-1.)g=18writeS6ONLY,8IT ACCEPT=18mUat(' youPATe=1N SNNNXNNNL,18mU RESULT6OF9A MI==1 . -,- AFe=1nXe Cmat,MPASS,ICLUDe1'TIDY.,IC'at,MPASSmanRACe=1*2 IT,KPnRAM,,1999, C-g=1rLOGICLE LHTRN,ISF1 Cmat,MPASSJCOL=6at(' youIN )GO-1.)g=18write, SKIP FIRO 67 NON-BLANKgmanRACe=1,ghty Kli t-gTYPE-Rom26 oryNghty Klin3592.LT2N NNp)7at,ouwililililililJCOL=JCOL+Eghty Klin3592y Kli t-JINTAJCOLmeRomKBLR=R*10001ughty Klin3592y KliJINTAJCOLm=K1999,(JINTAJCOLm)1l RONO O O Ol lose bte2-g=18ou gaR*1000130 in3592WRITIFgh(yA1',AE0o0o0o0o0o0o0o0*****************************************A1',AE0o0o0o0o0o0o0o0*y Kli18WRITE(9,REC=1)MNAME,POINo0o0o0o0*A1',AE0o0o0o0o0o0o0o0*y KlPROCESSoNON-F1)-1.)g=18writeS.0o0o0*A1',AE0o0o0o0o0o0o0o0*y Kli18WRITE(9,REC=1)MNAME,POINo0o0o0o0*A1',AE0o0o0o0o0o0o0o0*****************************************A1', C-g=1rLFIR=6te2-g=18RIR=14te(y Kli18WRITE(9,REC=1)MNAME,PSE*,FLA. )GO NON-F1)-1.te2-g=18GOOIFMEgh(y Kli18WRITE(9,REC=TS.K )GO SPECIAe(manRACe=1,. t1 IF(I=JCOLghty KliD"α6-gJCOL=I,JMAXghty Kliy KliIT=JINTAJCOLmghty Kliy KliISF1=.FALSE. Cmned d d d(CH1CK))GO SPe(manRu d)GOE8F1IManSINC R99ED J1000SE*,RIR.mghty Kliy KliD"α50.)I1,13ghty Klin351rn3592RdESTeRomKSPKAJ)R=oryNgh(' yououououououououFOUN.u(3E.SS,S8IT 8mU OIRO ...ghty Klin3592y Klin3592RdESRIR.Rom14R=oryNgh(' yououououououououYE,ghty Kliy Klin3592y Klin3592RIR=Jghty Kliy Klin3592y Klin3592LFIR=JCOLgh(' youQUI*,RWormanS=18DO 70goYPElDOESN'T,ALeOWiSTR1 .S.SSJUO 699ED 3A1',AE0oRIR AND1LRIR POIte=1,.ghty Klin3592y Klin3592y Kli t-gSSCN-RomK.AND.gTYPE-N97) oryNghty Klin3592-g=18y Klin3592n3592.LT4-g=1JCOL,JMAXghty Kliy KlilililililililililililililJINTAdm=K1999,(JINTAIo)ghtgONTRn3592you,REC=1)MNAME,POINC lose bte2-g=18ou gained d d d d d d d d5=188Fghty KlililililililililililiWRITIFghty Klin3592lililililiWRITIFghty Klin3592lililililiISF1=STeRomKF11.OR.STeRomKF12 C-g=1rn3592y Klin3592RdESSF1R=R*1000180ghtKlin3592Kli Klin3592R*10007ughty KlilililililiWRITIFght8.ORn3592El lose bte(y Kli(F1IManMAYANOTTBE.1PECIAe(manRACe=1, CH1CK)000BE.1UATmghty Kliy KliISF1=STeRomKF11.OR.STeRomKF12 C-g=1rn3592RdESSF1R=R*1000180ghtKlin3592KlJINTAJCOLm=K1999,(dTtght6uwilC lose bte2-g=18R*100031ugh(y Kli18WRITE(9,REC=TS.K )GO ORMAT(1 . =18J=1. ,7uwil t-JCOLeRomJMAXR=R*100031ughty KliJCOL=JCOL+Eghty KliCLEVERS=18gh(y Kli18WRITE(9,REC=RE8EATl t.3.=18J=1. ,y Kli t-g772-RomKR=R*10003ugh(y KliMAKEOI*,UO99,iCLSbte2-g=18JINTAJCOLm=K1999,(JINTAJCOLm)1l y KliIT=JINTAJCOLmgh(y Kli18WRITE(9,REC,S8IT -H-,-L-,0GO -R-te2-g=18RdESTeRomKABCA8)R=oryNghRITE(9,REC=THTRN=MOD(KHTite,2meRom0 in3592WLSE8RdESTeRomKABCA12meOR.STeRomKABCA18)R=oryNghRITE(9,REC=THTRN=KHTite.gT.2*,95) 9k3M8m ,I=ABYs L GO R8RdANSI,FLA. SE*.ghty Klin3592g=' ANSI-RomK.AND.GOOI-RomKR=CLEVEDIAG.3.(36)ghty KlideSbteli Klin3592R*100030 in3592WRITIFgh(y,REC=1)MNAME,POINMARK(dguPART6OF9STR1 . ()GO DRIEloseG)1l y KliI t-gHTRN)8JINTAJCOLm(2:2)=KAT(2:2)te(yA1',AE0oALSONMARK(8mU =18J=1,. lin359KTMP=g772te2-g=18g=JCOLght8 IF(I=IMEghty Kli t-JINTAImeRomKBLR=R*100080ghtKlin3I t-gHTRN)8JINTAIm(2:2)=KAT(2:2)telin359KTMP=KTMP/1ughty Kli t-KTMPeGT8KR=R*100080ghtKlin3IP=Igh(y,REC=1)MNAME,POINNDRn TMITS6OF9HOLGERITH FIELD. ,y Kli=JCOL+Eghty KliJCOL=JCOL+g772te(y Kli18WRITE(9,REC=T772(Ianory. ENGTH ORWor3 FIELD,(dguFOUN.uBY9RS=18gh(y Kli18WRITE(9,RECCH1CK))GO CLSb6OF9HOLGERITH BLANKS.1P')1 . OFFgh(y,REC=1)MNAME,POINWRITOF9CARD. E.G.i=6HXXXXXghty Kli t-JCOLe,97JMAXR=R*10009ugh(y Kli18WRITE(9,RECRE8m Ce1CURR 70gWRITCARDuMARK. ,y KliJINTAJMAX+1)=KBLgh(y Kli18WRITE(9,REC=AND1SE*,N W-(3E ,y KliJMAX=JCOLghty KliJINTAJMAX+1)=KERMgh(y Kli18WRITE(9,RECCHAN98.LEVEmanRACe=1,0,I=HOLGERITH FIELD. ,9uwilD00ONNTJ=I,JCOLghty Kliy KliJINTAJm(2:2)=KAT(2:2)telONNT1C lose bte2-g=18 t-.NOT.gHTRN)8oryNgh('at(' youIN TiteSL1.e . H-FIELDS 9k3PY STR1 . AND1DUPLICL.TAAPOSTROPHa,. lilililililJINTAdP)=KAPSTRghty Klin3592gP=IP+Eghty Klin3592J=IghtOONTllililJINTAdP)=JINTAJmghty Klin3592g=' JINTAJmeRomKAPSTR oryNghty Klin3592-g=18IP=IP+Eghty Klin3592-g=1rg=' I..G97JR=CLEVEMOVSTR AJmghty Klin3592lililJINTAdP)=KAPSTRghty Klin3592WRITIFghty Klin3592J=J+Eghty Klin3592P=IP+Eghty Klin3592 t-Je,97JCOLm=R*100011ughty Kliy KliJINTAdP)=KAPSTRght1RONO O O P=IP+Eghty Klin3592 t-I..,97JCOLm=oryNghty Klin3592-g=18JINTAdP)=KBLghty Kli-g=18ou gaR*1000120ghty Klin3592WRITIFghty KliWRITIFghty KliR*10003ugh(yA1',AE0o0o0o0o0o0o0o0**********************************A1',AE0o0o0o0o0o0o0o0*y Kli18WRITE(9,REC=1)MNAME,POINo*A1',AE0o0o0o0o0o0o0o0*y KPROCESSoF1)-1.)g=18writeS.0o0*A1',AE0o0o0o0o0o0o0o0*y Kli18WRITE(9,REC=1)MNAME,POINo*A1',AE0o0o0o0o0o0o0o0**********************************A1', C=1 IFFGOOIFughty Kli IR=3ghty KliLFIR=JCOLgh8ou gaR*100017ugh(yA1',AE0o0o0o0o0o0o0o0TS.K )GO SPECIAe(manRACe=1 C=gONT t-JCOLeGT8JMAXR=R*100031ughty KliI=JCOLghty KliD"α16-gJCOL=I,JMAXghty Kliy KliIT=JINTAJCOLmghty Kliy KliISF1=STeRomKF11.OR.STeRomKF12 C-g=1rn3592RdESSF1R=R*1000180ghtKlin3592KlD88150T)I1,12 C-g=1rn3592y KliRdESTeRomKSPKAJ)R=R*1000220ght18.ORn3592C lose bte2-g=18ou gaJINTAJCOLm=K1999,(dTtght16-glC lose bte2-g=18R*100031ugh(yA1',AE0o0o0o0o0o0o0o0SKIP t.3T0*yGO 'at,17uwi t-JINTAJCOLmeN97KF11.AND.JINTAJCOLmeN97KF12R=R*1000220gh(y Kli18WRITE(9,RECCHAN98.LEVEmanRACe=1,0BETWEiN(*SyGO ',ght18 IFKPnRAM=JINTAJCOLmgh(y Kli18WRITE(9,RECMARK(dguPART6OF9STR1 . ()GO DRIEloseG)1l y KliJINTAJCOLm(2:2)=KAT(2:2)teO O O P=JCOLgh('ght19ONT t-JCOLeRomJMAXR=R*100031ughty KliJCOL=JCOL+Eghty KliIT=JINTAJCOLmghty KliJINTAJCOLm(2:2)=KAT(2:2)teO O O RdESTeRomKPnRAMm=oryNghty Klin3592 t-JINTAJCOL+1)eN97KPnRAMm=R*1000200gh(y KliormanIand LIe=1Ae(--t.3T0e=1MIN1L8F1IMIe=1 CilililililJCOL=JCOL+Eghty Klin3592JINTAJCOLm(2:2)=KAT(2:2)teO O O WRITIFghty KliR*100019ugh(y Kli18WRITE(9,RECITE(9,REC=AEVEmanN98D, CHAN98.F1IMan tDESIRED. ,2NNT1 t-KDTite.Rom1.AND.KPnRAMeN97KF11m=oryNghty Klin3592JINTAdP)=KAPSTRghty Klin3592JINTAJCOLm=KAPSTRghty Klin3592J=IP ,2ONTllililJ=J+Eghty Klin3592 t-Je,T7JCOLm=oryNghty Klin3592-g=18g=' JINTAJmeRomKAPSTR oryNgh(y KliDUPLICL.TALIe=1Ae(V=1,e(3)O tDE1IMIe=1 CilililililRITE(9,RECCLEVEMOVSTR AJmghty Klin3592lilily KliJINTAJm=KAPSTRghty Klin3592ililiWRITIFghty Klin3592lililR*100021ughty Kliy KliWRITIFghty KliWRITIFghty KliRdESGOOI-Rom-1R=R*10007ugh(y Kli18WRITE(9,RECTS.K )GO ORMAT(1 . =18J=1 ,22ONT t-JCOLeRomJMAXR=R*100031ughty KliJCOL=JCOL+Eghty KliCLEVERS=18gh(y Kli18WRITE(9,REC t.3T0A-1998) S=1RT6AG ,I ,y Kli t-g772-RomKR=R*100017ugh(y Kli18WRITE(9,REC1998)uFOUN..CTS.K A*,N X0gmanRACe=1. ,y KliJINTAJCOLm=K1999,(JINTAJCOLm)1l y KliIT=JINTAJCOLmgh(y Kli18WRITE(9,REC,S8IT -H-te2-g=18RdESTeRomKABCA8)R=oryNghRITE(9,REC=THTRN=MOD(KHTite,2meRom0 in3592lililR*100025ugh(y Kli18WRITE(9,RECMAYBE.L GO R in3592WLSE8RdESTeRomKABCA12meOR.STeRomKABCA18)R=oryNghRITE(9,REC=THTRN=KHTite.gT.2*,ty Klin3592g=' ANSI-RomKR=CLEVEDIAG.3.(36)ghty KlilililR*100025ughin3592WRITIFgh(y,REC=1)MNAME,POIN t.3T0-X- S=1RT6AG ,I. ,y Kli t-STeN97KABCA24)R=R*100017ugh(y Kli18WRITE(9,RECXuFOUN..CCTS.K A*,N X0. ,23ONT t-JCOLeRomJMAXR=R*100031ughty KliJCOL=JCOL+Eghty KliI t-JINTAJCOLmeRomKBLR=R*1000230 in3592JINTAJCOLm=K1999,(JINTAJCOLm)1l y KliIT=JINTAJCOLmgh(y Kli18WRITE(9,REC,S8IT -*-te2-g=18RdESTeRomKF11.OR.STeRomKF12R=R*100017ugh(y Kli18WRITE(9,REC,S8IT -)-0GO -,-te2-g=18RdESTeRomKSPKA2)R=R*1000220ght-g=18RdESTeRomKSPKA5)R=R*1000220gh('at(' youINSERT6A9k3MMAghty KliD"α240T)IJMAX,JCOL,MEghty Klin3592JINTAJ+1)=JINTAJmght240TlC lose bte2-g=18JINTAJCOLm=KSPKA2) ,y KliJMAX=JMAX+1ghty KliJINTAJMAX+1)=KERMghty KliCLEVEDIAG.3.(25)1l y KliIGOOIF1ghty KliR*1000220gh('at(' youououououououoHOLGERITH FOUN..CCNNDRn TMITS6OF9FIELD. ,28.ORI t-gHTRN)8JINTAJCOLm(2:2)=KAT(2:2)te(yA1',AE0oALSONMARK(8mU =18J=1,. lin359J=g772te2-g=18g=JCOLght26-glI=IMEghty Kli t-JINTAImeRomKBLR=R*100026-ghtKlin3I t-gHTRN)8JINTAIm(2:2)=KAT(2:2)telin359)IJ/1ughty Kli t-JeGT8KR=R*100026-ghCmat,MPASS,P=Igh,y Kli=JCOL+Eghty KliJCOL=JCOL+g772tety Kli t-JCOLe,97JMAXR=R*100027ughty KliJINTAJMAX+1)=KBLgh,y KliJMAX=JCOLghty KliJINTAJMAX+1)=KERMgh027uliD"α28NTJ=I,JCOLghty Kliy KliJINTAJm(2:2)=KAT(2:2)tel28NT1C lose bte2-g=18 t-.NOT.gHTRN)8oryNgh('at(' youIN TiteSL1.e . H-FIELDS 9k3PY STR1 . AND1DUPLICL.TAAPOSTROPHa,. lilililililJINTAdP)=KAPSTRghty Klin3592gP=IP+Eghty Klin3592J=Ight29NTllililJINTAdP)=JINTAJmghty Klin3592g=' JINTAJmeRomKAPSTR oryNghty Klin3592-g=18IP=IP+Eghty Klin3592-g=1rg=' I..G97JR=CLEVEMOVSTR AJmghty Klin3592lililJINTAdP)=KAPSTRghty Klin3592WRITIFghty Klin3592J=J+Eghty Klin3592P=IP+Eghty Klin3592 t-Je,97JCOLm=R*100029ughin3592lililJINTAdP)=KAPSTRght30ONO O O P=IP+Eghty Klin3592 t-I..,97JCOLm=oryNghty Klin3592-g=18JINTAdP)=KBLghty Kli-g=18ou gaR*1000300ghty Klin3592WRITIFghty KliWRITIFghty KliR*1000220gh('at031u d5=188Fghty KliWRIghty KliSUBRYs INE8NITDYgh(at(' youINITIAeIZE TIDY(--tUSED 1.)g=1RT6ARITWHiN(*N WR EXECUTED. Cte2-g=18NCLUDE 'TIDY.NC' Cte2-g=18NIEloFughty KliJUO =7telin359KALMRK(= '* 'at,in359KALTRN= ' 'at,in359KB15Fughty KliKCTCHR=KSPKA10)telin359KCTCTLFughty KliKD15F1ughty KliKD79F1ghty KliKF11(= ''' 'at,in359KF12(= '""'at,in359KTiteFughty KliKHTiteF1ghty KliKPR1 F1ghty KliKPUN=MEghty Kli ANSIFughty KliMCOL=ughty KliMCOM=MEghty Kli C lo=ughty KliMEX=ughty KliMLBL=ughty KliMLIO =MEghty Kli PR1 F1ghty KliMPUN=MEghty Kli REIFughty KliMRIT=2tety KliMSERFughty KliNFWRIFughty KliNRYs F1ghCte2-g=185=188Fghty KliWRIghty KliSUBRYs INE8OSYS1 (OP,KV,SER,LIO )gh(at(' youOP9k3DES P=1MITTED. C' you1 Klin35922 Klin35923 Klin35924 C' you=1ASE8g=185=WDRn =18WRITE8g=185=AD Cte2-g=18NCLUDE 'TIDY.NC' 2-g=18NCLUDE 'UNITS.NC' 2-g=18NTEG)uOP, KVA8)ghty KliCanRACe=1*21SERA8), LIO (1) Cte2-g=18R*1000A10,20,50,80),OPgh(at(' you=1ASE Cte2-g=18EloRY8OSY11telON=185=WDRn SCFILEghty Kli5=188Fgh(at(' you5=WDRn Cte2-g=18EloRY8OSY12 ,2N=185=WDRn SCFILEghty Kli5=188Fgh(at(' youWRITE Cte28.ORnWRITE8(SCFILE) KV,1SERghty KliCLEVEREDSTR ASCFILE, LIO , KVA4),IYs N,KV(6),1)ghty KliR*1000120gh(at(' you5=AD Cte28N=185=AD8(SCFILE) KV,1SERghty KliCLEVEREDSTR ASCFILE, LIO , KVA4),IYs N,KV(6),2mgh(y Kli18WRITE(9,RECRITE(9,REC11)-1L EXITght1RONO5=188Fghty KliWRIghty KliSUBRYs INE8OSYS2 (OP,KV,SER,LIO )gh(at(' youOP9k3DES P=1MITTED. C' you1 Klin35922 Klin35923 Klin35924 C' you=1ASE8g=185=WDRn =18WRITE8g=185=AD Cte2-g=18NCLUDE 'TIDY.NC' 2-g=18NCLUDE 'UNITS.NC' 2-g=18NTEG)uOP, KVA8)ghty KliCanRACe=1*21SERA8), LIO (1) Cte2-g=18R*1000A10,20,50,80),OPgh(at(' you=1ASE Cte2-g=18EloRY8OSY21telON=185=WDRn SCFIL2tety Kli5=188Fgh(at(' you5=WDRn Cte2-g=18EloRY8OSY22 ,2N=185=WDRn SCFIL2tety Kli5=188Fgh(at(' youWRITE Cte28.ORnWRITE8(SCFIL2) KV,1SERghty KliCLEVEREDSTR ASCFIL2, LIO , KVA4),IYs N,KV(6),1)ghty KliR*1000120gh(at(' you5=AD Cte28N=185=AD8(SCFIL2) KV,1SERghty KliCLEVEREDSTR ASCFIL2, LIO , KVA4),IYs N,KV(6),2mgh(y Kli18WRITE(9,RECRITE(9,REC11)-1L EXITght1RONO5=188Fghty KliWRIghty KliCanRACe=1*21FUNCTe(3)KHIDE (C)ghty KliCanRACe=1*21Cte2-g=18CanRACe=1*21KBLghty KliDATA1KBL/' @'/gh(at(' youC lVERT6manRACe=1,0,I=HOLSCN STR1 .S1000SPECIAe(F1)- Cte2-g=18KHIDE=KBLghty KliKHIDE(1:1)=C(1:1)te2-g=185=188Fghty KliWRIghty KliSUBRYs INE8KIMPAKgh(at(' youormanRYs INE8PACKS.1UP=1-CARDuIMAGES FROM IYs AIm8NTO8KIM(I,J). Cte2-g=18NCLUDE 'TIDY.NC' (9,RECTSGICLLuC lDRn Cte2-g=18C lDRn=.TRUE. Cte2ON=18J=0gh(at,2N=18J=J+Eghty Kli t-KLASS.gT.2m=oryNghty Klin3592K7Fughty Kliy KliJLF1ghty Kliy KliJR=72tety Kliy KliR*10009ughin3592WRITIFgh(at(' youINIEloseG8C ULDuMAKETCARDuOVERFAT(1C lose ATe(3S 9 tSO,CRE8ACK. ,y Kli t-JeGT820m=oryNghty Klin3592 t-.NOT.C lDRnm=oryNghty Klin3592-g=18CLEVEDIAG.3.(37mghty Klin3592lililJ=20ghty Klin3592ou gaR*1000120ghty Klin3592WRITIFghty Kli-g=18C lDRn=.FALSE. lilililililJL=7telin359y KliJR=72tety Kliy KliR*10001ughty KliWRITIFgh(at(' youPRE8ARETCOLUMNS 1-66OF9FIRS=TCARD. ,y Kli t-C lDRnm=oryNghty Klin3592 t-JeRom1m=oryNghty Klin3592-g=18K7FICOLSVghty Klin3592-g=18D0030i=1,6ghty Klin3592lilily KliKIM(I,1)=IYs AImght30Klin3592-g=18C lose bte2-g=18ou gaWLSEat(' youBLANKTCOLUMN 1-5ghty Klin3592-g=18D0040i=1,5ghty Klin3592-g=18y KliKIM(I,J)=KBLght40Klin3592-g=18C lose bte(' youC LUMN 6 -C1998)uSERIAeLY UNLESSoCCHRuSET6OoryRWISE. lililililily Kli t-KCTCTL-RomKR=oryNghty Klin3592-g=18n3592 t-Je,T711m=oryNghty Klin3592-g=18-g=18y KliKIM(6,J)=KDIGAJmghty Klin3592lilily KliWLSEatty Klin3592-g=18-g=18y KliKIM(6,J)=KSPKA10)telin359y Klin3592ililiWRITIFghty Klin3592lililWLSEatty Klin3592-g=18-g=18KIM(6,J)=KCTCHRghty Klin3592ililiWRITIFghty Klin3592WRITIFgh(at(' youSET6LEFT ED98.OF9T X0gh(y Kli1(USEuC L 72 tEXEMP , NON-INIElo8D, GO DFuPART6OF9STR1 .*,ty Klin3592g=' EXe,T70.OR.SCOLSV-Rom6.OR.(IYs AK7m(2:2)eRomKAT(2:2)telin351 Klin.AND. IYs AK7+1)(2:2)eRomKAT(2:2))R=oryNghRITE(9,REC=lililJL=7telin359y KliWLSEatty Klin3592-g=18JL=ICOLSVghty Klin3592-g=18 t-JeGT81m=JL=JL+Eghty Klin3592-g=18D0050i=7,JLghty Kli-g=18ou gay KliKIM(I,J)=KBLght8.ORn35922-g=18C lose bte2-g=18ou ga-g=18JL=JL+Eghty Klin3592WRITIFgh(at(' youSET6RIGHT ED98.OF9T X0gh(y KliFIRS=TGET6RIGHT-MOST POTElosAVEmanR0,I=STR1 . (KRR)telin359y KliJR=72tety Kliy KliKRR=K7+JR-JL+Eghty Klin3592 t-KRReGT8IMAXR=oryNgh(y KliDFuPAST WRITOF9STL.TMElo S=OP9AT WRI. lililililily KliJR=JL+IMAX-K7MEghty Klin3592y KliR*10009ughin3592n3592WRITIFgh(at(' youNT(1CHECKiDFuWETCAN B5=AK8IT ryRE. C' youB5=AK8IFuPART6OF9A=STR1 ..8KIMPAKuPROTECTS6DE1IMEe=1,0ALSO. l6.ORn35922 t-IYs AKRR)(2:2)eRomKAT(2:2))iR*10009ugh(at(' youB5=AK8IFuIT Iand BLANKT(.3T0,I=STR1 .mghty Klin3592g=' IYs AKRR)eRomKBLR=R*10009ugh(at(' youR*1BACKiDFuLEFT 8ARENorySISght7.ORn35922 t-IYs AKRR)eRomKSPKA3)R=oryNghRITE(9,REC=lililKRR=KRRMEghty Klin3592y KliJR=JRMEghty Klin3592y KliR*10007ughin3592n3592WRITIFgh(at(' youB5=AK8)GO SPECIAe(manRACe=1,. lilililililD0080i=1,14ghty Klin3592-g=1rg=' IYs AKRR)eRomKSPKAI))iR*10009ugh28N=18-g=18C lose bte(at(' youOoryRWISE1BACKiUP ONE, oRY8AG ,I. ,y KlilililKRR=KRRMEghty Klin3592JR=JRMEghty Klin3592 t-JReGT8JLR=R*10006ugh(at(' you tR*1LEVE8mU WAY1BACK,8)GOCEuIT 00072tety Kliy KliJR=72tety KliWRITIFgh(at(' youk3PY 8mU T X0gh 9NTllD001u0i=JL,JRghty Klin3592K7FK7+1ghty Klin3592 t-K7.,97IMAXR=oryNghi-g=18ou gay KliKIM(I,J)=IYs AK7mtelin359y KliWLSEatty Klin3592-g=18KIM(I,J)=KBLghtn3592ililiWRITIFght1u0i8C lose bte(at(' youSCRUB GARBA98.OFFiWRITIF SHORe=1=orAN 72tety Kli t-JRe,T772m=oryNghty Klin3592D00110i=JR+1,72tety Kliy Kli-g=18KIM(I,J)=KBLght1ON=18g=18C lose bte2-g=18WRITIFgh(at(' youD00ANOoryR1C lose ATe(3N t.ECESSARY. ,y Kli t-K7.,T8IMAXR=R*100020gh(at,1RONONCD=Jte2-g=185=188Fghty KliWRIghty KliSUBRYs INE8KWSCAN (JT,KSTCR)telin3598ARAMEe=1T(.KST=80)te(at(' youormanRYs INE8SCANS8)GO )GOTite KEYWORDS 9SETS JT 000CORRECTat(' youoYPE8RdFOUN.,2WLSE8ZERO. Cte(' youINPUT:8RdJT = 0,8SCANS8WHOLE LIO gh(y Kli18WRITE(9,JT > 0,8ONLY SCANS8orAT WORD. Cte2-g=18NCLUDE 'TIDY.NC' (9,RECNCLUDE 'UNITS.NC' Cte2-g=18DIMENSI(3)KSTCR(5)1l y Klik3MM(3)/KSTCOM/)KSTA10,.KST)ghty KliCanRACe=1*21KST,WKSTRA10),K1999,1l y Klik3MM(3)/KST199/)KSTC(6,.KST)ghCte2-g=18 t-JT-RomKR=oryNghty Klin3592NLF1ghty Kliy KliNU=.KSTghty KliWLSEatty Klin3592NLFJTghty Kliy KliNU=JTghty KliWRITIFgh(at(' youMAKET1999,-CASEuC PY OF9ON=CanRS' AX=STR1 . LENGTH)ghty KliLAST=JCOLMEghty KliD"α20i=1,10te2ON=18y KliLAST=LAST+1ghty Klin3592 t-LASTeGT8JMAXR=oryNghi-g=18ou gay KliWKSTRAI)=KBLghtn3592ililiWLSEatty Klin3592-g=18g=' JINTALAST)eRomKBLR=R*10001ughty Kliou gay KliWKSTRAI)=K1999, JINTALAST)mtelin359y KliWRITIFght2N=18C lose bte(at2-g=18D0050iT=NL,NUghty Kliy KliNINS=KSTC(1,IT)ghCte2-g=18-g=18D0030i=1,NINSatty Klin3592-g=18g=' WKSTRAI).NE.KSTAI,IT)R=R*100050ght30Klin3592C lose bte2-g=18ou gaJT=KSTC(6,IT)ghty Kli-g=18D0040i=1,5ghty Klin3592-g=18KSTCR(I)=KSTC(I,IT)ght40Klin3592C lose bte2-g=18ou gag=' DEBeGT8KR=WRITE8(Ys FIL,6KR=KSTCR,WKSTRte2-g=18ou ga5=188Fgh(Kli-g=18ou gay KliLOOP9)GO N X09STL.TMElo.ght8.ORnC lose bte2-g=18Jo=ughty Kli5=188Fgh(atl6.ORnF1)-AT ('8KWSCAN: ',5I3,1X,10A1)te2-g=18WRIghty KliBLOCKiDATA1KSTDAT Cte2-g=18C MM(3)/KSTCOM/telin351 Klin1KST1 K,KST2 K,KST3 K,KST4 K,KST5ghty Kl2 Klin,KST6in,KST7in,KST8in,KST9n,KST1ughty Kl3Klin,KST11n,KST12n,KST13n,KST14n,KST15ghty Kl4Klin,KST16n,KST17n,KST18n,KST19n,KST20ghty Kl5Klin,KST21n,KST22n,KST23n,KST24n,KST25ghty Kl6Klin,KST26n,KST27n,KST28n,KST29n,KST30ghty Kl7Klin,KST31n,KST32n,KST33n,KST34n,KST35ghty Kl8Klin,KST36n,KST37n,KST38n,KST39n,KST40ghty Kl9Klin,KST41n,KST42n,KST43n,KST44n,KST45ghty KlXKlin,KST46n,KST47n,KST48n,KST49n,KST50ghty KlXKlin,KST51n,KST52n,KST53n,KST54n,KST55ghty KlXKlin,KST56n,KST57n,KST58n,KST59n,KST60ghty KlXKlin,KST61n,KST62n,KST63n,KST64n,KST65ghty KlXKlin,KST66n,KST67n,KST68n,KST69n,KST7ughin359XKlin,KST71n,KST72n,KST73n,KST74n,KST75ghty KlXKlin,KST76n,KST77n,KST78n,KST79n,KST8ugh(at(ghty KliCanRACe=1*21KST10A10),KST2 A10),KST3 A10),KST4 A10),KST5 A10)telin359CanRACe=1*21KST6 A10),KST7 A10),KST8 A10),KST9 A10),KST10A10)telin359CanRACe=1*21KST11A10),KST12A10),KST13A10),KST14A10),KST15A10)telin359CanRACe=1*21KST16A10),KST17A10),KST18A10),KST19A10),KST20A10)telin359CanRACe=1*21KST21A10),KST22A10),KST23A10),KST24A10),KST25A10)telin359CanRACe=1*21KST26A10),KST27A10),KST28A10),KST29A10),KST30A10)telin359CanRACe=1*21KST31A10),KST32A10),KST33A10),KST34A10),KST35A10)telin359CanRACe=1*21KST36A10),KST37A10),KST38A10),KST39A10),KST40A10)telin359CanRACe=1*21KST41A10),KST42A10),KST43A10),KST44A10),KST45A10)telin359CanRACe=1*21KST46A10),KST47A10),KST48A10),KST49A10),KST50A10)telin359CanRACe=1*21KST51A10),KST52A10),KST53A10),KST54A10),KST55A10)telin359CanRACe=1*21KST56A10),KST57A10),KST58A10),KST59A10),KST60A10)telin359CanRACe=1*21KST61A10),KST62A10),KST63A10),KST64A10),KST65A10)telin359CanRACe=1*21KST66A10),KST67A10),KST68A10),KST69A10),KST70A10)telin359CanRACe=1*21KST71A10),KST72A10),KST73A10),KST74A10),KST75A10)telin359CanRACe=1*21KST76A10),KST77A10),KST78A10),KST79A10),KST80A10)teCte2-g=18C MM(3)/KST199/telin351 KlinKSTC1 K,KSTC2 K,KSTC3 K,KSTC4 K,KSTC5ghty Kl2 Kli,KSTC6in,KSTC7in,KSTC8in,KSTC9in,KSTC1ughty Kl3Klin,KSTC11n,KSTC12n,KSTC13n,KSTC14n,KSTC15ghty Kl4Klin,KSTC16n,KSTC17n,KSTC18n,KSTC19n,KSTC20ghty Kl5Klin,KSTC21n,KSTC22n,KSTC23n,KSTC24n,KSTC25ghty Kl6Klin,KSTC26n,KSTC27n,KSTC28n,KSTC29n,KSTC30ghty Kl7Klin,KSTC31n,KSTC32n,KSTC33n,KSTC34n,KSTC35ghty Kl8Klin,KSTC36n,KSTC37n,KSTC38n,KSTC39n,KSTC40ghty Kl9Klin,KSTC41n,KSTC42n,KSTC43n,KSTC44n,KSTC45ghty KlXKlin,KSTC46n,KSTC47n,KSTC48n,KSTC49n,KSTC50ghty KlXKlin,KSTC51n,KSTC52n,KSTC53n,KSTC54n,KSTC55ghty KlXKlin,KSTC56n,KSTC57n,KSTC58n,KSTC59n,KSTC60ghty KlXKlin,KSTC61n,KSTC62n,KSTC63n,KSTC64n,KSTC65ghty KlXKlin,KSTC66n,KSTC67n,KSTC68n,KSTC69n,KSTC7ughin359XKlin,KSTC71n,KSTC72n,KSTC73n,KSTC74n,KSTC75ghty KlXKlin,KSTC76n,KSTC77n,KSTC78n,KSTC79n,KSTC8ughty KliDIMENSI(3)KSTC10A6),KSTC2 A6),KSTC3 A6),KSTC4 A6),KSTC5 A6)ghty KliDIMENSI(3)KSTC6 A6),KSTC7 A6),KSTC8 A6),KSTC9 A6),KSTC10A6)ghty KliDIMENSI(3)KSTC11A6),KSTC12A6),KSTC13A6),KSTC14A6),KSTC15A6)ghty KliDIMENSI(3)KSTC16A6),KSTC17A6),KSTC18A6),KSTC19A6),KSTC20A6)ghty KliDIMENSI(3)KSTC21A6),KSTC22A6),KSTC23A6),KSTC24A6),KSTC25A6)ghty KliDIMENSI(3)KSTC26A6),KSTC27A6),KSTC28A6),KSTC29A6),KSTC30A6)ghty KliDIMENSI(3)KSTC31A6),KSTC32A6),KSTC33A6),KSTC34A6),KSTC35A6)ghty KliDIMENSI(3)KSTC36A6),KSTC37A6),KSTC38A6),KSTC39A6),KSTC40A6)ghty KliDIMENSI(3)KSTC41A6),KSTC42A6),KSTC43A6),KSTC44A6),KSTC45A6)ghty KliDIMENSI(3)KSTC46A6),KSTC47A6),KSTC48A6),KSTC49A6),KSTC50A6)ghty KliDIMENSI(3)KSTC51A6),KSTC52A6),KSTC53A6),KSTC54A6),KSTC55A6)ghty KliDIMENSI(3)KSTC56A6),KSTC57A6),KSTC58A6),KSTC59A6),KSTC60A6)ghty KliDIMENSI(3)KSTC61A6),KSTC62A6),KSTC63A6),KSTC64A6),KSTC65A6)ghty KliDIMENSI(3)KSTC66A6),KSTC67A6),KSTC68A6),KSTC69A6),KSTC70A6)ghty KliDIMENSI(3)KSTC71A6),KSTC72A6),KSTC73A6),KSTC74A6),KSTC75A6)ghty KliDIMENSI(3)KSTC76A6),KSTC77A6),KSTC78A6),KSTC79A6),KSTC80A6)gh(at(' you/KST/telin35iDATA1KST 1/'A','C','C','E','P','T',' ',' ',' ',' '/telin35iDATA1KST 2/'A','S','C','E','N','T',' ',' ',' ',' '/telin35iDATA1KST 3/'A','S','S','I','G','N',' ',' ',' ',' '/telin35iDATA1KST 4/'B','A','C','K','S','P','A','C','E','('/telin35iDATA1KST 5/'B','L','O','C','K','D','A','T','A',' '/telin35iDATA1KST 6/'B','U','F','F','E','R','I','N','(',' '/telin35iDATA1KST 7/'B','U','F','F','E','R','O','U','T','('/telin35iDATA1KST 8/'C','A','L','L',' ',' ',' ',' ',' ',' '/telin35iDATA1KST 9/'C','H','A','R','A','C','T','E','R',' '/telin35iDATA1KST10/'C','O','M','M','O','N',' ',' ',' ',' '/telin35iDATA1KST11/'C','O','M','P','L','E','X',' ',' ',' '/telin35iDATA1KST12/'C','O','N','T','I','N','U','E',' ',' '/telin35iDATA1KST13/'D','A','T','A',' ',' ',' ',' ',' ',' '/telin35iDATA1KST14/'D','E','C','O','D','E','(',' ',' ',' '/telin35iDATA1KST15/'D','I','M','E','N','S','I','O','N',' '/telin35iDATA1KST16/'D','O','U','B','L','E','P','R','E','C'/telin35iDATA1KST17/'D','O','U','B','L','E',' ',' ',' ',' '/telin35iDATA1KST18/'E','N','C','O','D','E','(',' ',' ',' '/telin35iDATA1KST19/'E','N','D','F','I','L','E','(',' ',' '/telin35iDATA1KST20/'E','N','D','I','F',' ',' ',' ',' ',' '/telin35iDATA1KST21/'E','N','D','F','I','L','E',' ',' ',' '/telin35iDATA1KST22/'E','N','T','R','Y',' ',' ',' ',' ',' '/telin35iDATA1KST23/'E','Q','U','I','V','A','L','E','N','C'/telin35iDATA1KST24/'E','X','T','E','R','N','A','L',' ',' '/telin35iDATA1KST25/'F','I','N','I','S',' ',' ',' ',' ',' '/telin35iDATA1KST26/'F','O','R','M','A','T','(',' ',' ',' '/telin35iDATA1KST27/'F','O','R','T','R','A','N',' ',' ',' '/telin35iDATA1KST28/'I','F','(','U','N','I','T',',',' ',' '/telin35iDATA1KST29/'F','U','N','C','T','I','O','N',' ',' '/telin35iDATA1KST30/'G','O','T','O','(',' ',' ',' ',' ',' '/telin35iDATA1KST31/'G','O','T','O',' ',' ',' ',' ',' ',' '/telin35iDATA1KST32/'I','F','A','C','C','U','M','U','L','A'/telin35iDATA1KST33/'I','F','Q','U','O','T','I','E','N','T'/telin35iDATA1KST34/'I','F','(','D','I','V','I','D','E','C'/telin35iDATA1KST35/'I','F','(','E','N','D','F','I','L','E'/telin35iDATA1KST36/'I','F','(','S','E','N','S','E','L','I'/telin35iDATA1KST37/'I','F','(','S','E','N','S','E','S','W'/telin35iDATA1KST38/'I','F','(',' ',' ',' ',' ',' ',' ',' '/telin35iDATA1KST39/'I','N','T','E','G','E','R',' ',' ',' '/telin35iDATA1KST40/'L','O','G','I','C','A','L',' ',' ',' '/telin35iDATA1KST41/'M','A','C','H','I','N','E',' ',' ',' '/telin35iDATA1KST42/'N','A','M','E','L','I','S','T',' ',' '/telin35iDATA1KST43/'P','A','U','S','E',' ',' ',' ',' ',' '/telin35iDATA1KST44/'P','R','I','N','T',' ',' ',' ',' ',' '/telin35iDATA1KST45/'P','R','O','G','R','A','M',' ',' ',' '/telin35iDATA1KST46/'P','U','N','C','H',' ',' ',' ',' ',' '/telin35iDATA1KST47/'R','E','A','D','I','N','P','U','T','T'/telin35iDATA1KST48/'R','E','A','D','T','A','P','E',' ',' '/telin35iDATA1KST49/'R','E','A','D','(',' ',' ',' ',' ',' '/telin35iDATA1KST50/'R','E','A','D',' ',' ',' ',' ',' ',' '/telin35iDATA1KST51/'R','E','A','L',' ',' ',' ',' ',' ',' '/telin35iDATA1KST52/'R','E','T','U','R','N',' ',' ',' ',' '/telin35iDATA1KST53/'R','E','W','I','N','D','(',' ',' ',' '/telin35iDATA1KST54/'S','E','G','M','E','N','T',' ',' ',' '/telin35iDATA1KST55/'S','E','N','S','E','L','I','G','H','T'/telin35iDATA1KST56/'S','T','O','P',' ',' ',' ',' ',' ',' '/telin35iDATA1KST57/'S','U','B','R','O','U','T','I','N','E'/telin35iDATA1KST58/'T','Y','P','E',' ',' ',' ',' ',' ',' '/telin35iDATA1KST59/'W','R','I','T','E','O','U','T','P','U'/telin35iDATA1KST60/'W','R','I','T','E','T','A','P','E',' '/telin35iDATA1KST61/'W','R','I','T','E','(',' ',' ',' ',' '/telin35iDATA1KST62/'O','V','E','R','L','A','Y',' ',' ',' '/telin35iDATA1KST63/'I','D','E','N','T',' ',' ',' ',' ',' '/telin35iDATA1KST64/'F','R','E','Q','U','E','N','C','Y',' '/telin35iDATA1KST65/'I','M','P','L','I','C','I','T',' ',' '/telin35iDATA1KST66/'L','E','V','E','L',' ',' ',' ',' ',' '/telin35iDATA1KST67/'E','L','S','E','I','F',' ',' ',' ',' '/telin35iDATA1KST68/'E','L','S','E',' ',' ',' ',' ',' ',' '/telin35iDATA1KST69/'T','H','E','N',' ',' ',' ',' ',' ',' '/telin35iDATA1KST70/'C','L','O','S','E','(',' ',' ',' ',' '/telin35iDATA1KST71/'I','N','C','L','U','D','E',' ',' ',' '/telin35iDATA1KST72/'I','N','Q','U','I','R','E','(',' ',' '/telin35iDATA1KST73/'I','N','T','R','I','N','S','I','C',' '/telin35iDATA1KST74/'O','P','E','N','(',' ',' ',' ',' ',' '/telin35iDATA1KST75/'P','A','R','A','M','E','T','E','R',' '/telin35iDATA1KST76/'S','A','V','E',' ',' ',' ',' ',' ',' '/telin35iDATA1KST77/'B','A','C','K','S','P','A','C','E',' '/telin35iDATA1KST78/'E','N','D',' ',' ',' ',' ',' ',' ',' '/telin35iDATA1KST79/'R','E','W','I','N','D',' ',' ',' ',' '/telin35iDATA1KST80/'C','L','O','S','E',' ',' ',' ',' ',' '/te(at(' you/KST199/te(' you********* NOTE - KPOS IS ADDED TO INSULATE PASS1 FROM ADDITI(3Ste(' youTO ABOVE TABLE. WHEN ADDING NEW STATEMENTS, SET KPOS TO THEte(' youNEW VALUE OF NKST RATHER THAN THE ORDINAL POSITI(3 OF THE NEWte(' youADDITI(3 TO THE TABLE.te(' yououououououououNINSinKLASS JTYPE NANSIlinKSTROK KlinKPOStelin35iDATA1KSTC51 /y Kl6,ty Kl7,ty K33,ty K1,uououou0,uououou 1/telin35iDATA1KSTC52 /y Kl6,ty Kl2,ty K1 ,ty K1,uououou0,uououou 2/telin35iDATA1KSTC53 /y Kl6,ty Kl7,ty K2 ,ty K0,uououou0,uououou 3/telin35iDATA1KSTC54 /y K10,ty Kl7,ty K47,ty K0,uououou0,uououou 4/telin35iDATA1KSTC55 /y Kl9,ty Kl2,ty K4 ,ty K0,uououou0,uououou 5/telin35iDATA1KSTC56 /y Kl9,ty Kl6,ty K5 ,ty K1,uououou0,uououou 6/telin35iDATA1KSTC57 /y K10,ty Kl6,ty K5 ,ty K1,uououou0,uououou 7/telin35iDATA1KSTC58 /y Kl4,ty Kl7,ty K6 ,ty K0,uououou1,uououou 8/telin35iDATA1KSTC59 /y Kl9,ty Kl3,ty K46,ty K0,uououou0,uououou 9/telin35iDATA1KSTC10 /y Kl6,ty Kl3,ty K7 ,ty K0,uououou0,uououou10/telin35iDATA1KSTC11 /y Kl7,ty Kl3,ty K46,ty K0,uououou0,uououou11/telin35iDATA1KSTC12 /y Kl8,uouou4,ty K8 ,ty K0,uououou0,uououou12/telin35iDATA1KSTC13 /y Kl4,ty Kl3,ty K9 ,ty K0,uououou1,uououou13/telin35iDATA1KSTC14 /y Kl7,ty Kl7,ty K10,ty K1,uououou0,uououou14/telin35iDATA1KSTC15 /y Kl9,ty Kl3,ty K11,ty K0,uououou0,uououou15/telin35iDATA1KSTC16 /y K10,ty Kl3,ty K12,ty K0,uououou0,uououou16/telin35iDATA1KSTC17 /y Kl6,ty Kl3,ty K13,ty K0,uououou0,uououou17/telin35iDATA1KSTC18 /y Kl7,ty Kl7,ty K10,ty K1,uououou0,uououou18/telin35iDATA1KSTC19 /y Kl8,ty Kl7,ty K47,ty K0,uououou0,uououou19/telin35iDATA1KSTC20 /y Kl5,ty K11,ty K48,ty K0,uououou0,uououou20/telin35iDATA1KSTC21 /y Kl7,ty Kl6,ty K15,ty K0,uououou0,uououou21/telin35iDATA1KSTC22 /y Kl5,ty K11,ty K3 ,ty K0,uououou0,uououou22/telin35iDATA1KSTC23 /y K10,ty Kl3,ty K17,ty K0,uououou0,uououou23/telin35iDATA1KSTC24 /y Kl8,ty Kl3,ty K3 ,ty K0,uououou0,uououou24/telin35iDATA1KSTC25 /y Kl5,ty Kl3,ty K18,ty K1,uououou0,uououou25/telin35iDATA1KSTC26 /y Kl7,ty Kl5,ty K19,ty K0,uououou1,uououou26/telin35iDATA1KSTC27 /y Kl7,ty Kl2,ty K20,ty K1,uououou0,uououou27/telin35iDATA1KSTC28 /y Kl8,ty Kl7,ty K42,ty K1,uououou1,uououou28/telin35iDATA1KSTC29 /y Kl8,ty Kl2,ty K35,ty K0,uououou0,uououou29/telin35iDATA1KSTC30 /y Kl5,ty Kl7,ty K23,ty K0,uououou0,uououou30/telin35iDATA1KSTC31 /y Kl4,ty Kl7,ty K24,ty K0,uououou0,uououou31/telin35iDATA1KSTC32 /y K10,ty Kl7,ty K25,ty K1,uououou1,uououou32/telin35iDATA1KSTC33 /y K10,ty Kl7,ty K26,ty K1,uououou1,uououou33/telin35iDATA1KSTC34 /y K10,ty Kl7,ty K27,ty K1,uououou1,uououou34/telin35iDATA1KSTC35 /y K10,ty Kl7,ty K28,ty K1,uououou1,uououou35/telin35iDATA1KSTC36 /y K10,ty Kl7,ty K29,ty K1,uououou1,uououou36/telin35iDATA1KSTC37 /y K10,ty Kl7,ty K30,ty K1,uououou1,uououou37/telin35iDATA1KSTC38 /y Kl3,ty Kl7,ty K31,ty K0,uououou1,uououou38/telin35iDATA1KSTC39 /y Kl7,ty Kl3,ty K46,ty K0,uououou0,uououou39/telin35iDATA1KSTC40 /y Kl7,ty Kl3,ty K46,ty K0,uououou0,uououou40/telin35iDATA1KSTC41 /y Kl7,ty Kl2,ty K1 ,ty K1,uououou0,uououou41/telin35iDATA1KSTC42 /y Kl8,uouou3,ty K32,ty K1,uououou0,uououou42/telin35iDATA1KSTC43 /y Kl5,ty Kl6,ty K3 ,ty K0,uououou1,uououou43/telin35iDATA1KSTC44 /y Kl5,ty Kl7,ty K33,ty K0,uououou1,uououou44/telin35iDATA1KSTC45 /y Kl7,ty Kl2,ty K35,ty K0,uououou0,uououou45/telin35iDATA1KSTC46 /y Kl5,ty Kl7,ty K33,ty K1,uououou1,uououou46/telin35iDATA1KSTC47 /y K10,ty Kl7,ty K36,ty K0,uououou0,uououou47/telin35iDATA1KSTC48 /y Kl8,ty Kl6,ty K37,ty K0,uououou0,uououou48/telin35iDATA1KSTC49 /y Kl5,ty Kl7,ty K38,ty K0,uououou1,uououou49/telin35iDATA1KSTC50 /y Kl4,ty Kl7,ty K33,ty K0,uououou1,uououou50/telin35iDATA1KSTC51 /y Kl4,ty Kl3,ty K46,ty K0,uououou0,uououou51/telin35iDATA1KSTC52 /y Kl6,ty Kl6,ty K39,ty K0,uououou0,uououou52/telin35iDATA1KSTC53 /y Kl7,ty Kl7,ty K47,ty K0,uououou0,uououou53/telin35iDATA1KSTC54 /y Kl7,ty Kl9,ty K34,ty K1,uououou0,uououou54/telin35iDATA1KSTC55 /y K10,ty Kl6,ty K40,ty K1,uououou0,uououou55/telin35iDATA1KSTC56 /y Kl4,ty Kl6,ty K41,ty K0,uououou1,uououou56/telin35iDATA1KSTC57 /y K10,ty Kl2,ty K35,ty K0,uououou0,uououou57/telin35iDATA1KSTC58 /y Kl4,ty Kl7,ty K33,ty K1,uououou0,uououou58/telin35iDATA1KSTC59 /y K10,ty Kl7,ty K44,ty K0,uououou1,uououou59/telin35iDATA1KSTC60 /y Kl9,ty Kl6,ty K45,ty K0,uououou1,uououou60/telin35iDATA1KSTC61 /y Kl6,ty Kl7,ty K38,ty K0,uououou1,uououou61/telin35iDATA1KSTC62 /y Kl7,ty Kl9,ty K34,ty K1,uououou0,uououou62/telin35iDATA1KSTC63 /y Kl5,ty Kl9,ty K22,ty K1,uououou0,uououou63/telin35iDATA1KSTC64 /y Kl9,ty Kl3,ty K21,ty K1,uououou0,uououou64/telin35iDATA1KSTC65 /y Kl8,ty Kl3,ty K3 ,ty K0,uououou0,uououou65/telin35iDATA1KSTC66 /y Kl5,ty Kl3,ty K3 ,ty K1,uououou0,uououou66/telin35iDATA1KSTC67 /y Kl6,ty K11,ty K43,ty K0,uououou1,uououou67/telin35iDATA1KSTC68 /y Kl4,ty K11,ty K49,ty K0,uououou0,uououou68/telin35iDATA1KSTC69 /y Kl4,ty K11,ty K 3,ty K0,uououou0,uououou69/telin35iDATA1KSTC70 /y Kl6,ty Kl7,ty K47,ty K0,uououou0,uououou70/telin35iDATA1KSTC71 /y Kl7,ty K11,ty K3 ,ty K1,uououou0,uououou71/telin35iDATA1KSTC72 /y Kl8,uouou7,ty K47,ty K0,uououou1,uououou72/telin35iDATA1KSTC73 /y Kl9,ty Kl3,ty K3 ,ty K0,uououou0,uououou73/telin35iDATA1KSTC74 /y Kl5,ty Kl7,ty K47,ty K0,uououou1,uououou74/telin35iDATA1KSTC75 /y Kl9,ty Kl3,ty K3 ,ty K0,uououou1,uououou75/telin35iDATA1KSTC76 /y Kl4,ty Kl3,ty K3 ,ty K0,uououou0,uououou76/telin35iDATA1KSTC77 /y Kl9,ty Kl6,ty K3 ,ty K0,uououou0,uououou77/telin35iDATA1KSTC78 /y Kl3,ty Kl8,ty K16,ty K0,uououou0,uououou78/telin35iDATA1KSTC79 /y Kl6,ty Kl6,ty K3 ,ty K0,uououou0,uououou79/telin35iDATA1KSTC80 /y Kl5,ty Kl6,ty K3 ,ty K0,uououou0,uououou80/telin35iENDtelin35iSUBROUTINE MOVSTR (J)telin35iINCLUDE 'TIDY.INC'te(at(' youADDSK1 BYTE TO STRING BY SHIFTING UNPROCESSED CHARS RIGHT.te(' youUSED BY HOLSCN WHEN REPLICATING APOSTROPHESte(atlin35iDOK10 I=JMAX,J,-1atlin35i5i5i5JINT(I+1)=JINT(I)tel10 CONTINUEatlin35iJMAX=JMAX+1atlin35iJINT(JMAX+1)=KERMatlin35iJ=J+1atlin35iJCOL =iJCOL+1atlin35iRETURNtelin35iENDtelin35iSUBROUTINE NOPRO (IFLAG)te(at(' youTHIS SUBROUTINE EXECUTES A HIGH-SPEED SEARCH FOR AN END STATEMENT.te(' youIF MP2 IS ON, CARD IMAGES ARE WRITTEN (3 TAPE 1 FOR USE BY PASS2.te(' youNO INTERNAL PROCESSING IS DONE ON THE STATEMENTS.te(atlin35iINCLUDE 'TIDY.INC'te(in35iSET INITIAL VALUES.te(atlin35iCALL IOSY11atlin35iCALL IOSY21atlin35iNRT2=0atlin35iNDEF=0atlin35iKLASS=1atlin35iITYPE=0atlin35iL15=0atlin35iIF (MP2.EQ.0) GO TO 20te(at(' youWRITE OUT STATEMENT CURRENTLY INiJINT.te(atlin35iIMAX=JMAXatlin35iKLASS=2atlin35iCALL IOSYS1 (3,KILI,SERIAL,JINT)telin35iNRT1=1atlin35iKLASS=3atlin35iIF (JMAX.GT.72)iCALL DIAGNO (28)telin35iGO TO 20te(at(' youREAD AND COPY CARD IMAGES BY WAY OF KBUFF.te(atl10 CALL READERatl20 NREC=NREC+1at(at(' youLOOK FOR LASTuNON-BLANK CHARACTER ON CARD.te(atlin35iI=72atl30 IF (KBUFF(I).NE.KBL) GO TO 40atlin35iI=I-1atlin35iIF (I.GT.7) GO TO 30atl40 IMAX=Iat(at(' youLOOK FOR END STATEMENT INiINPUT BUFFER KBUFFte(atlin35iJ=3atlin35iDOK50 I=7,IMAXatlin35iK=Iatlin35iIF (KBUFF(I).EQ.KBL) GO TO 50atlin35iIF (KBUFF(I).NE.KEND(J)) GO TO 60atlin35iJ=J-1atlin35iIF (J.EQ.0) GO TO 70atl50 CONTINUEatlin35iGO TO 60at(at(' youFOUND AN END CARD IF NEXT CHAR IS BLANK.te 7035iIF (KBUFF(K+1).EQ.KBL) KLASS=8te(at(' youWRITE OUT CARD IMAGE FOR PASS2.te(te 6035iIF (MP2.NE.0) THENtelin35iCALL IOSYS1 (3,KILI,SERIAL,KBUFF)telin35iNRT1=NRT1+1atlin35iENDIFte(at(' youGET NEXT RECORD UNLESS END CARD OR EOFatlin35iIF (IQUIT.NE.1.AND.KLASS.NE.8) GO TO 10at(at(' youCLOSE FILEatlin35iIF (MP2.NE.0) CALL IOSY12at(at(' youLOAD BUFFER, KBUFF, BEFORE EXITING.te(te 9035iIF (IQUIT.EQ.0) CALL READERatlin35iRETURNtelin35iENDtelin35iINTEGER FUNCTI(3 OPFIL(KUNIT,FNAME,KTYPE,KNOUT,EXPRES,LENGTH)te(-------------------------------------------------------------------------te(----uTHIS IS THE OPEN FILE FUNCTI(3 BY W.J. MEERSCHAERT & P.J. DAUGHERTYte(----uJULY 25,t1986te(----uDUMMY PARAMETERS ARE AS FOLLOWS:at(at(' yoIUNIT....UNIT 199BER OF THE FILE TO BE OPENED, PREFERRABLY > 20te( youFNAME....NAME OF FILE TO BE OPENED, IF SCRATCH, IT IS IGNORED,te(' yououououououoIF MISSING, IT IS PROMPTED FORat(' yoITYPE....TYPE OF FILE TO BE OPENED, AS FOLLOWS:at(uouououououo>035iRECL FOR A DIRECT ACCESS UNFORMATTED FILEat(uouououououo>100000 DIRECT ACCESS FORMATTED FILEiRECL=MOD(ITYPE,100000)te(' yououououou0youFORMATTED SEQUENTIAL FILEat(uouououououo<0youUNFORMATTED SEQUENTIAL FILEat(uouoINOUT....SPECIFIES WHAT THE FILE IS FOR:at(uouououououo-2ouoINPUT FILE, IF NOT EXIST, EXIT WITH ERROR CODEat(uouououououo-1ouoINPUT FILE, IF NOT EXIST, PROMPT USER FOR NEW NAMEte(' yououououou0youSCRATCH FILEat(uouououououo 1ouoOUTPUT FILE, IF EXIST, PROMPT USER FOR ACTI(3at(uouououououo 2ouoOUTPUT FILE, IF EXIST, OVERWRITE AUTOMATICALLYat(uouououououo 3ouoOUTPUT FILE, IF EXIST, APPEND AUTOMATICALLYat(uouououououo 4ouoOUTPUT FILE, IF EXIST, EXIT WITH ERROR CODEat(uouoEXPRES...EXPRESSI(3 FOR PROMPTING USER FOR FILENAMEte(' yoLENGTH...N99BER OF LINES INiOLD PART OF APPENDED FILEat(te('OPFILiRETURNS THE FOLLOWING:at(uouo0......ALL IS WELLat(uouo>0.....COMPILER OR SYSTEM ERROR MESSAGE (3 OPEN STATEMENTat(uouo1......USER EOF (3 AuREAD PROMPT (I.E., ABORT OPEN)te(' yo2......ERROR CODE BASED ONiINOUT, FILE M=NOT OPENEDat(te(-------------------------------------------------------------------------telin35iCHARACTER FNAME*(*),EXPRES*(*),ANStelin35iINTEGER DOSDEVatlin35iLOGICALoEXST,FILOPNtelin35iINCLUDE 'UNITS.INC'te(at(----uREASSIGNiINTEGER DUMMY VARIABLESte(atlin35iIUNIT=KUNITatlin35iITYPE=KTYPEtelin35iINOUT=KNOUTatlin35iLENGTH=0at(at(----uOPEN SCRATCH FILEat(atlin35iIF (INOUT.EQ.0) THENtelin35iin35iIF (ITYPE)K10,20,30atl10 OPEN (IUNIT,STATUS='SCRATCH',FORM='UNFORMATTED',ACCESS='SEQUEtelin351NTIAL',IOSTAT=OPFIL)telin35iin35iRETURNtel20 OPEN (IUNIT,STATUS='SCRATCH',FORM='FORMATTED',ACCESS='SEQUENTatlin351IAL',IOSTAT=OPFIL)telin35iin35iRETURNtel30 IF (ITYPE.GT.100000) THENtelin35iin35iin35iITYPE=MOD(ITYPE,100000)telin35iin35iin35iOPEN (IUNIT,ACCESS='DIRECT',STATUS='SCRATCH',RECL=ITYPE,atlin351FORM='FORMATTED',IOSTAT=OPFIL)telin35iin35iELSEtelin35iin35iin35iOPEN (IUNIT,ACCESS='DIRECT',STATUS='SCRATCH',RECL=ITYPE,atlin351FORM='UNFORMATTED',IOSTAT=OPFIL)telin35iin35iEND IFtelin35iin35iRETURNtelin35iEND IFte(at(----uCHECK FOR LOGIC OF ARGUMENTS AND FILE PROPERTIESte(atl4035iIF (FNAME.EQ.' '.AND.INOUT.NE.2) THENtelin35iin35iWRITE (STDERR,190) EXPREStelin35iin35iREAD (STDIN,200,END=170) FNAMEtelin35iin35iIF (FNAME(1:1).EQ.'?') THENtelin35iin35iin35iPAUSE 'Type DIR to see a list of files'telin35iin35iin35iFNAME=' 'telin35iin35iin35iGO TO 40atlin35iin35iELSEiIF (FNAME(1:1).EQ.'>'.AND.FNAME(2:2).NE.'>') THENtelin35iin35iin35iIF (INOUT.GT.0) INOUT=2atlin35iin35iin35iFNAME=FNAME(2:)telin35iin35iELSEiIF (FNAME(1:2).EQ.'>>') THENtelin35iin35iin35iIF (INOUT.GT.0) INOUT=3atlin35iin35iin35iFNAME=FNAME(3:)telin35iin35iELSEtelin35iin35iin35iIF (INOUT.GT.0) INOUT=1atlin35i5i5i5END IFtelin35iEND IFte(at(----uGET EXST AND FILOPNte(atlin35iINQUIRE (FILE=FNAME,EXIST=EXST,OPENED=FILOPN)te(at(' youDON'TuOPEN SAME FILE TWICE.atlin35iIF (FILOPN) THENtelin35iin35iWRITE (STDERR,210) FNAMEtelin35iin35iFNAME=' 'telin35iin35iGO TO 40atlin35iEND IFte(at(----uINPUT FILEat(atlin35iIF (.NOT.EXST.AND.INOUT.LT.0) THENtelin35iin35iIF (INOUT.EQ.-1) THENtelin35iin35iin35iWRITE (STDERR,220) FNAMEtelin35iin35iin35iFNAME=' 'telin35iin35iin35iGO TO 40atlin35iin35iELSEiIF (INOUT.EQ.-2) THENtelin35iin35iin35iGO TO 180atlin35iin35iEND IFte(at(----uOUTPUT FILEat(atlin35iELSEiIF (EXST.AND.INOUT.EQ.1) THENte(atlin35iin35iISDEV =i0at(at(' youDOS DEVICES ARE OK IF THEY EXISTatlin35iin35iISDEV =i DOSDEV(FNAME)telin35iin35iIF (ISDEV.GT.0) THENtelin35iin35iin35iINOUT=2atlin35iin35iin35iGO TO 60atlin35iin35iEND IFte(at(in35iOTHERWISE ASK USER WHAT TO DO.atl50 in35iWRITE (STDERR,230) EXPRES,FNAMEtelin35iin35iREAD (STDIN,240,END=170) ANStelin35iin35iIF (ANS.EQ.'o'.OR.ANS.EQ.'O') THENtelin35iin35iin35iINOUT=2atlin35iin35iELSEiIF (ANS.EQ.'a'.OR.ANS.EQ.'A') THENtelin35iin35iin35iINOUT=3atlin35iin35iELSEiIF (ANS.EQ.'n'.OR.ANS.EQ.'N') THENtelin35iin35iin35iFNAME=' 'telin35iin35iin35iGO TO 40atlin35iin35iELSEtelin35iin35iin35iGO TO 50atlin35i5i5i5END IFtelin35iELSEiIF (EXST.AND.INOUT.EQ.4) THENtelin35iin35iOPFIL=2atlin35iin35iRETURNtelin35iEND IFte(at(----uOPEN FILEte(te 6035iIF (ITYPE)K70,80,90te 7035iOPEN (IUNIT,FILE=FNAME,STATUS='UNKNOWN',FORM='UNFORMATTED',ACCESS=atlin351'SEQUENTIAL',IOSTAT=OPFIL)telin35iGO TO 100te 8035iOPEN (IUNIT,FILE=FNAME,STATUS='UNKNOWN',FORM='FORMATTED',ACCESS='Satlin351EQUENTIAL',IOSTAT=OPFIL)telin35iGO TO 100te 9035iIF (ITYPE.GT.100000) THENtelin35iin35iITYPE=MOD(ITYPE,100000)telin35iin35iOPEN (IUNIT,FILE=FNAME,STATUS='UNKNOWN',FORM='FORMATTED',ACCEatlin351SS='DIRECT',RECL=ITYPE,IOSTAT=OPFIL)telin35iELSEtelin35iin35iOPEN (IUNIT,FILE=FNAME,STATUS='UNKNOWN',FORM='UNFORMATTED',ACatlin351CESS='DIRECT',RECL=ITYPE,IOSTAT=OPFIL)telin35iEND IFtelin35iRETURNtel1005iREWINDiIUNITte(at(----uAPPEND IF REQUESTEDat(atlin35iIF (INOUT.EQ.3) THENtelin35iin35iIF (ITYPE)K110,120,120tel110 READ (IUNIT,END=130)telin35iin35iLENGTH=LENGTH+1atlin35iin35iGO TO 110tel120 READ (IUNIT,240,END=130) ANStelin35iin35iLENGTH=LENGTH+1atlin35iin35iGO TO 120tel130 REWINDiIUNITtelin35iin35iDOK1603N=1,LENGTHtelin35iin35iin35iIF (ITYPE)K140,150,150tel140 in35i READ (IUNIT)telin35iin35iin35iGO TO 160atl150 in35i READ (IUNIT,240) ANStel16035i CONTINUEatlin35iin35iEND FILE IUNITtelin35iin35iBACKSPACE (IUNIT)telin35iEND IFte(at(----uALL DONEat(atlin35iRETURNtel17035OPFIL=1atlin35iRETURNtel18035OPFIL=2atlin35iRETURNteCte(atl19035FORMAT (/T3,'Open the ',A,' file'/T3,'Enter a file name here: ')tel20035FORMAT (A)tel21035FORMAT (/T3,'File already open: ',A)tel22035FORMAT (/T3,'File not found: ',A)tel23035FORMAT (/T10,A/T3,'File exists: ',A/T5,'[O]verwrite'/T5,'[A]ppend'telin351/T5,'[N]ew file spec'/T3,'Enter here: ')tel24035FORMAT (A1)telin35iENDtelin35iSUBROUTINE PAGE (N)te(at(' youTHIS SUBROUTINE DOES THE GENERAL PAGE COUNTING FOR TIDY WHILEat(uououLIMITING THE OUTPUT TO MAXLIN LINES PER PAGE.te(at(' youin35iN>03--uI WILL WRITE N LINES. START A NEW PAGE IF NECESSARY.te(' youin35iN=03--uSTART A NEW PAGE.te(' youin35iN<03--uSTART A NEW PAGE IF .LT. -N LINES ARE LEFT.te(atlin35iINCLUDE 'TIDY.INC'telin35iINCLUDE 'UNITS.INC'teiin35iDATA MAXLIN /56/at(atlin35iIF (N)K10,30,20te(' yououououououououououououoCONDITI(3ALoEJECT (NO LINES WRITTEN)tel10 IF ((LINE-N).LE.MAXLIN)iRETURNtelin35iGO TO 30atl20 LINE=LINE+Ntelin35iIF (LINE.LE.MAXLIN)iRETURNte(' yououououououououououououoMAKE NEW PAGEatl30 IF (LINE.EQ.0) RETURNtelin35i LINE=0atlin35i5i5IF (N.GT.0) LINE=Ntelin35i NPAGE=NPAGE+1atlin35iin3MPAGE=MPAGE+1atlin35iin3WRITE (OUTFIL,40) NROUT,IPASS,MPAGE,NPAGE,JOBatlin35iRETURNteCte(atl40youFORMAT (/1H1,6X,'* T I D Y * in35i ROUTINE',I4,4X,4HPASS,I2,2X,atlin3514HPAGE,I3,21X,4HPAGE,I4/7X,80A1/1X)telin35iENDtelin35iSUBROUTINE PASS1at(at(' youTHIS ROUTINE COLLECTS STATEMENT N99BERS,oMAKES DIAGNOSTIC COMMENTSat(' youAND SETS UP THE FORTRAN STATEMENTS INiAuFORMiSUITABLE FOR PASS2.te(te in35iINTEGER JTMP(8)telin35iINCLUDE 'TIDY.INC'telin35iINCLUDE 'UNITS.INC'teiin35iCHARACTER*2 JNT,JT,ICH,KUPPER,PRVCPYteiin35iDIMENSI(3 KSTC(5)telin35iLOGICALoBAKSCNat(at(' youAn35iBn35iCn35iDn35iEn35iFn35iGn35iHn35iIn35iJn35iKn35iLiin3Mat(' you1ouo 2ouo 3ouo 4ouo 5ouo 6ouo 7ouo 8ouo 9 you10you11ouo12ouo13at(at(' youNn35iOn35iPn35iQ Rn35iS youT youU youViin3Wiin3Xiin3Yiin3Zat(' you14ouo15ouo16ouo17ouo18ouo19 yo20 21ouo22ouo23ouo24ouo25ouo26at(at(' you= you, you( you/ you) you+uouo-uouo* in3. in3$uouo-uouo'uouo& NONEat(uouou1ouo 2ouo 3ouo 4ouo 5ouo 6ouo 7ouo 8ouo 9 you10you11ouo12ouo13ou14teCte(at(uououSET UP INITIAL CONDITI(3S.te(' youREWINDiTAPE FILESu1oAND 2.te(te 10youCALL IOSY11atlin35iCALL IOSY21atlin35iDOK20 I=1,10atlin35i5i5i5LDOS(I)=0atl20 CONTINUEatlin35iIMAX=1326atlin35iIPASS=1atlin35iICOL=0atlin35iKOUNT=0atlin35iMP2=1atlin35iNBLC=2atlin35iMPUN=KPUNatlin35iMPRIN=KPRINatlin35iNROUT=NROUT+1atlin35iNRT1=0atlin35iNRT2=0atlin35iMILDO=0atlin35iMLGC=-1atlin35iMSKP=0atlin35iMPAGE=0atlin35iMTRAN=0atlin35iNDEF=0atlin35iNDOS=0atlin35iNFORT=0atlin35iNREC=0atlin35iNREF=0atlin35iL25=0atlin35iNTRAN=0atlin35iNXEQ=0atlin35iNIFBLK=0atlin35iGO TO 50at(at(' youin35iin35i5i5ILLEGAL FIRST CHARACTER.atl30 JGOOF=9at(' youin35iin35i5i5WRITE DIAGNOSTICatl40youCALL DIAGNO (JGOOF)te(' youououououin35iGET NEW CARD.te(' you(UNLESS EOF ALREADY)telin35iIF (IQUIT.NE.0) RETURNtel50youCALL SKARDatlin35iNXRF=1atlin35iIF (IMAX.LT.ICOL)iIMAX=ICOLatlin35iDOK60 I=1,IMAXtelin35iin35iIOUT(I)=KBLte 6035iCONTINUEatlin35iIMAX=0at(at(' youLOOK FOR * INiCOLUMN 1at(atlin35iIF (JINT(1).NE.KSPK(8))iGO TO 110telin35iCALL CONTRLatlin35iIF (ISTAR)K70,90,100te(' youououououin35iCONTROL CARD FOUND AND EXECUTED.te 7035iIF (MSTOP.EQ.0) GO TO 80te(' yououououououououououououo*STOP CARD FOUND. QUITiIF FIRST OF ROUTINEatlin35iIF (NFORT.LE.0) RETURNte(' yououououououououououououoOTHERWISE BUILD ANiEND CARDatlin35iGO TO 1100te 8035iIF (MSKP.EQ.0) GO TO 50atlin35iMP2=0telin35iCALL NOPRO (0)telin35iGO TO 10te(' youououououin35iCONTROL CARD FOR DELAYED EXECUTI(3. SAVE FOR PASS 2.te 9035iKLASS=0atlin35iGO TO 210te(' youououououin35i* INiCOLo1. NOT AiCONTROL CARD. iPUT OUT LITERALLYte(' youououououin35iUNLESS * INiCOLo2. ALSO.atl1005iIF (JINT(2).EQ.KSPK(8))iGO TO 50atlin35iGO TO 200at(at(' you*STOP COMMAND EXIT.te(at(' youNO * INiCOLUMN 1,uLOOK FOR C, D, I, F, ., OR $.u(UPPER CASE)te(atl110 IF (JINT(1).EQ.KBL)iGO TO 260atlin35iJINT(1)=KUPPER(JINT(1))telin35iIF (JINT(1).EQ.KABC(3))iGO TO 150atlin35iIF (JINT(1).EQ.KABC(4))iGO TO 130atlin35iIF (JINT(1).EQ.KABC(9))iGO TO 130atlin35iIF (JINT(1).EQ.KABC(6))iGO TO 130at(' youLOOK FOR ANY SP.0) RETURin35,NwR lin35iiGO noS(3)FILOFORMAT (A)tel21035FORMAT (/T3,'File 3.EQ.MPUNITS.INC'teiin35iCPRVin35iDIMENSlin35iLOGICALoBAKSCNat(at(+4ouo15oule ououoEQ.KuououououoOTHERWISE BUILD ANiEND CARDatlin35iGO TO 1100te 8035iIF (M'SCR28)K14REMATNROL CARD FOR DELAYED EXECUTI(3. SAVE FOR PASS 2.te 9035iKLASS=IFtee 9035OWN'elin35iin35iin35iITYPE=MOD(ITYPE,100000)telin35iin35iin35iOPENS=IINUEatlin35iin358tel130 REWINDiIUNITtelin35iin35iDOK1603N=1iin35iOPENS=I* INiCOLUEW CNTROL CARD FOR DELAYED EXECUTI(3. SAVE FOR PASS 2.te 9035iKLASS=5iIF·ET NEW CARD.te(' you(UNLESS EOiEND IFtelin35iin35iRETURNtelin35iEND IFte(at(----uCHECK FOR LOGIelin35iEND IFte(at(----uCHECK FOR LOGIC OF ARGUMENTS AND FILE gaE='e no CARD FOR DELAYED EXECUTI(3. SAVE FOR PASS 2.te 9035iKLASS=0atlin0) ND=170) FNAMEtelin35iin35iIF (FNAME(1:1).EQ.'?') THENtelin35iin35iin35iPAUSE 'Type DIR to see a lCARD FOLL DIAGNO (2hn35iLOGARE L,' file'/T3,'Enter ae ouatlineCNTROL C(atl.E+1atlin35iin3 SAME Flinr. cLIN /56/gR C, D,)EQ.Ikelin35iinRD FOR youououou SAVE FIFt youl35i5i5WRITE DIAGNOSTICatl40lC OF ARGUMENTS AND Fae oETURNtelin35i LINEE F-UMENTS ANDTE DIAGNOSTICatS=IFtee 9rn35iIF (N)K10,30,20te(' youououououououououououcLIN /56/gR C, D,)EQ.GO TO 130atlinTU youViin3EdiGO niIF rlt(JINT(1).EENS=IINU3e oT'telin35lin35i LINEE F-UMEA DIR tgR C, D,)EQ.Ik2,2X,ae tgR8iinRD FOsiGO TO 4ee a lCAR-oOS STDvEMEA DIm35iIF (FNAME(1:1).EQ.'2hn35iLOGARE L,'MEA . cLIuOsiGO TO 7OR *S DImsiGO Tm REAeE F-ULLEONT lCARD FLtr ae ouae='ef.'2hhnGO 7=SoT'tele0L-ULLEONiCON lCAR-sGARE L,' file'STICat40,150, AiCON-GNO (tC, EQ.KQ.'2hoGO TO 2 FOsiGOEQ.KuoNAME(1:1)e 9rn35iIF (N)K10,30ououou) you+uouo-uouo* in3l=EQ.K=yououin3EdirmFOR LLE FILESu17weclQ.KuoN,2X,ae Om STDvEMED n35fMin35i X35,NwLLEONT lrououou =EQrlxCat40,at4)EQ.rINE',I4,4X,4HPASSe om STD]}ile sprESutTUiIF (N)K1iPASyouCiPASyouCiPASyouD]}iR835ln35iIFOR LLE FILESua1T2CAR-oOmFOR p (/TT C,KABC(4)5fMinoT TO "gRRKiiDOK1603NQ.'2-, n35oT telin35iin35iDOK1603N=1iin35iOPl50atoiEND CARhTU y1iPASyEONT lFououcn35iLOt40ERe0= .KQnITh o2> UEW CNTROL CARD FOgouLOOK FO70,uTnPASSe ieOin35iPAUoT' CARD FOgtL ILATO "gOdiPASlCR XECUTI(3. USTDvEIF .LT.e s 9rn35iIF NXEQ=0hO 2 1atlin35eRD FLtr ae oECUl SyE EXIT.te(at(' yoiin35iGO TO 110tel120 READ (IUNIT,240,END=130) ANStelin35iin35iLENGTH=LENGTH+1atlin35iin35iGO TO 120tel130 REWINDiIUNITtelin35iin35iDOK1603N=1,LENGTHtelin35iin35iin35iIF (ITYPE)K140,150,150tel140 in35i READ (IUNIT)telin35iin35iin35iGO TO 160atl150 in35i LESuaNC'teiiniin='te (N) D fMin35 yo,uT>)e IiIF35iDOK1kDfeUuouiAPE FIL'TIDY.INC s *aNCMAX=ICHARAX)telie)0 n3he SAM5iin150aiin='F35iDOEND=5i yAYED Eon350tel14R PAkGO TO 160a+uTnPASSe 1205iiAGE=MPAGE+1(5FL n3he e80,h3in3lDINiCOLND=1T A(S=IINUn35iinENTSat('Sf"l35iin3mOK1kauME(1:1).EITYPE)K14-an3l=EQ.K=you lC6>an3l=EQ.. REWINDiIn='te (NrE='F35iDOyTAN=0atliph3iCatFte(at "g in35eTSaMAX= no F,tE=0atlin35DOENDgGO C150aiTlin35y:EWI in35eTS+Cn35mOK1kauMEouoOTHERWISE BUIL (1)ENDgGOouo26 INinENTSat('Sf╤lECK lin30a+ulin35y:f╤lOLoC0,150tel140 in35i REA35eTSR PAelin35iin3g35iat('Sfte (35iin35iin35iOPENS D bGE+,150,150t35iE N=1,LENGudk2,2X,aeEPtelS D b IF NE',I4,4X,4HloeinoTt('SftAuouiAOLL DIGOouo26 INinENTSat('Sf╤lECK lin30a+ulin35y:f╤lOLoC0,150tel140 in35i REA35eTSR PAelin35iin3g35iat('Sfte (35iin35iin35iOPENS D bGE+,150,150t35iE N=1,LENGudk2,2X,aeEPtelS D b IF-m no iOPENp)=0atl20 o0teln35y:f╤lOLoOLoat('SfLlOLoC0,150te (35:NTSat('Sf╤DOENDgG DIR tgR C, D,,150te (3 AND EXECUT3g35iouo15oulECALL 35i:1).hX b MAX= nSTICnnGO 7m no in35i5E uouououatS=IFED E3SfLlvSDvRiIMAX=0at1).hX b MAX= nSn3l)0 5REW SPO_gtL ILATOoEyin35i5i5WgNEatlin35iIF=0at1no E-f35iinRD FOR╟.EENS C35iNBLC=2atlin3 REWIN31no E-fl1205iiAPPER(Jh D b IFf) RETURNtelin35i LINE=0atlin35i5i5IF (N.GT.0) LR5iin358E',DIR tgR C, D,,150te (3 AND EXECUT3g35iouo15oulECALL 35i:1).hX b MAX= nSTICnnGO 7m no in35i5E uouououatS=IFED E3SfLlvSDvRiIMAX=0at1).hX b MAX= nSn3l)0 5REW SPO_gtL ILATOoEyin35i5i5WgNEatlin35iIF=0at1nh sf"l35iin.EIT/Cn35mO.KuoNTICnnGO 7m no inBlo.GTuououo1535ln35iIFOR DIGOouo26 INinENT D aa l)IF=0at1no E-f3t('SfLlOIF-D0IER(JR C,NE=0atlin35i5i5IAX=0lu in35iin-ndlin35i35iIF=0at 5X= nSn3l)0 5REW SPO_gtL ILATOoEyin35i5i5WgNEatlin35iIF=0at1nh sf"l35iin.EIT/Cn35mO.KuoNTICnnGO 7m no inBlo.G-PrX,4RT+1 (JINT(1b MAC you iSfLlE Flinr. cLI7OR *Fno iin358E E-TElouNO in35iin35iDOK1635,NwR/T3,'Ent35io0teln3Ah35,Ntelin35iin35iin3iSfbhEanC,KABCln35 a\/CUTI(3. USo FLtvURNtelin3u35i5E uouououea$D,150tESlC6>I7OR *Fno iin358E E-TElouNO5 a\/CUTI(catl10$D,150tESlC6>I7O5iin3 nSnYn3l)0SfL=1iin35iO150tESlSin35iO150tESlSiLI7 lFououcn3cat sf"lmteln35rue DIGOouo2NDEF=0a('Sft Rln3L40 in35io0teln3AB5io0teln36>I7O5iin3*E='F35iDOEND=5i yAYED Eon350tel14R PAkGO TO 160a+"K60 I=1,IMAXtelin35i3 nSnWo12ou.K=youSnYn3l15oulECIMAXtelin335ivSDvRiIMAhnulOBaio0tellMBaio0tellMBtuMeTSR PAelin35ie6MoTURNtelin35iENDo0tENT D aa l)DanYn3l)0SfL=1iin35iO150tESlSin35iO150tESlSiLIoriLIoTSR PAC6>I7O "g in-335ivSDR pdn3l15oulEteln3l15Cp[ogSfL=1nat40,150, Daio0teRSAVE,J!at('Sf╤DOENDgG DIR tgR C, D,,150te (3 AND EXECUT3g35iouo15oulECALL 35i:1).hX b MAX= nSTICnnGO 7m no in35i5E uouououatS=IFED E3SfLlvSDvRiIMAX=0at1).hX b MAX= nSn3l)0 1ka nSOTHE in&DOK60 D dfin-ndlFliC, pEs""K60 I0, Dai9,NteliAX=0anteln3laeL3l)0SfLoHnk2,2Xlin35ifn35 CN35iDOyTA=youSiRMAhnul/9 in35i5E u59Lin3M5eTSaMAX= no FCrt D,)ELC=2atliEQ.vRiIM(yTAED E3SfLlvSSin3TnGO eTSAVE F)IF=0n35iCALLivSDR 150t-)K60 D dfin-ndlFL3l)0SfLoln3EP15Cp[ogSfOGARIorlin35rD,,Eru7R5fOGANE FILnmnFoRLL ILATO, pEs"n3g35inSnWonpEs"'IR 5ioCABC(4))iGn3gl)DanYn3l15oulEtelulE CAL=1nat40E FILn150t-)K60 D dfin-ndlF9 lFououTnGO eTSAVSin3a35iin3bNDgG: dfin-ndl,73caOle REW SPO_gtLDIGOteln3lati0oILn150=IL'TT).hTuouonlm.te 5fOnpOXECUT3g35ionpr≥G DIR tE+,15oucn3cat sf"lmteln35rue DIGOouo2NDEF=0a('Sft Rln3L40 in35io0teln3AB5io0teln36>I7O5iin3*E='F35iDOEND=5i yAr 'Type DIR touYCUT3g35ionAhnu73caOle REW-ndl,7aOli5WAo=0atl20me) RETfin-ndlF9 ru7D IF8et1n in35iBtuMeTSR PAelO 160atl1taiDOEPAS 2NDEF=0a('ulECALL 35i:1).hX b MAX= nSTICnnGOarHE io.G-E FILn150tIFf) OO C, D,)EQ.GOxg-ndlFliC50tIFf) OX0SfLoln3'F35iDOEl150,150tel14iLIoriLIlInli5WAo touYCUicAWAo touYCUtt'TTntLmCALmTlF-ULLmMsIbNDEF=ALL 35i:1)C--335ivSDR pdn3l15oulEteln3l15Cp[ogSfL=1nat40,150, Daio0teRSAVE,J!at('Sf╤DOENDgG DIR tgR C, D,,150te (3 AND EXECUT3g35iouo15oulECALL 35i:1).hX b MAX= nSTICnnGO 7m no in35i5E uouououatS=IFED E3SfLlvSDvRiIMAX=0at1).hX b MAX= nSn3l)0 1ka nSOTHE in&DOK-5*cAWAo to-[W,SPOVGi35iIFOR DIGOoN in35i5E M,:1)SuuonAhOn150tENTS A=elin35iin35K=you-5D EXECUT3g39P in35ilin35Tlin!a nSOTHE in&riIMAX=ECUogSfL=3g3-ndlF9 ru7D IF8et1n in35pRhg╖hhaIFOR DIGOoNE+,150,150t35iE N=1,LENGudk2,2X,aeEPtelSOK1635,NwR)o,2X2╫ouladououououoM9035indlAVE F)IFn!aeRSAVILATO, pEs"oLATO, p F)IFn6RPafSOT╦p DIkTUiIF5E IFf)FED E3SfL/Cn35gR C, De150T lFouoTlin!a nSOTfL=1naIpy/Cns L40 Puououcb5iGO TO 16OTHER3gl)D40 Puououn1ohI7O5ik 16OTHER3gl)D40 =1naIp FOsGNO (tC, EQ.KQ.'2hoGO TO 2 FOsiGOEQ.KuoNAME(1:1)e 9rn35iIF (N)K10,30ououou) you+uouo-uouo* in3l=EQ.K=yououin3EdirmFOR LLE FILESu17weclQ.KuoN,2X,ae Om STDvEMED n35fMin35i X35,NwLLEONT lrououou =EQrlxCat40,at4)EQ.rINE',I4,4X,4HPASSe om SD EXEuEQ.KR pdn3l15oulEteln3ln35i X35,NwLLe Omln3laOTHE nSOTHE iuEQ.KR pv2laOThrNOT iuBlin35y:EfThrSnYn3laOTh8OTHEN31no >ug39P in3φL5E IFL3l)at(at(+4ouo15oule ououoEQ.KuououououoOTHERWISE BUILD ANiEND CARDatlin35iGO TO 1100te 8035iIF (M'SCR28)K14REMATNROL CARD FOR DELAYED EXECUTI(3. SAVE FOR PASS 2.te 9035iKLASS=IFtee 9035OWN'elin35iin35iin35iITYPE=MWISE c70) FNAMEtelin35iin35iIF (FNAME(1:1).EQ.'?') THENtelin35iin35iin3, F, AVE FOR PASS 2n35iIELAYED EX7& Ftlin35iGO TO 200at(at(' you*STOP COMMAND EXIT.te(at(' youNO * INiCOLUMN 1,uLOOK FOR C, D, I, F, ., OR $.u(UPPER CASE)te(atl110 IF (JINT(1).EQ.KBL)iGO TO 260atlin35iJINT(1)=KUPPER(JINT(1))telin35iIF (JINT(1).EQ.KABC R PASS 2.te 9035iKLASS=IFtee 9035OWN'elin35iin35iin35iITYPE=MWISE)FILOFORMAlCR 8035iIF )FILOFOR=MWISPf1iin35iOPl50atoiEND CARhTU y5i Xle'STeMWISE c7E IF. DIGOouo26 INiK1603N=ABCr. v2laOThrCARhTU y5Bgou*STd-g0 IF (JINTd240,END=130) ANSteliBgou*STd-gNT(1)=KUPPER(JINT(1))telin3BED EXECURd F, .,IGOouo2NDEF=0a(JINTd240,END1IGOorntrst3iRE18e 9S.KABC C, TiASST0lED kt╘mMsIbNDEF=AINT(1))telin3BED EXECURd F, .,IGOouo2NDEF=0E FOR ee 9035OWno E-elin35iE, ItSTd- EXECURdOFO)telin3BEOtO IF (JINf_2nin35ii INiK1603N=o15oulECALLfRD 81tE] kt╘mMsIK ,LEEt(' nLEQ.LFBEDtelin35iIF (JINT(t35u(UPPER in-ndlF9 0teln36>I7O5iin3*E='F35i>ug)O3E PE=MWI "gRRKiiNGO 7m no inBlo.Gcn3cat s e80,h3in3lD E, ggR C, DeEOtO IF (JI=0E>ug)e(at(' yo E, ggR C, bg(3. SAVE FO mO IF (JINel140 1UE c7gR C, br⌐s>ug[R C, bg(, beINel1╬rCoH e3cab.FteRhTU y5-NO IF (JINeln&DOKgNNel140 nSn3 REWIN31nSST0l iniGiI7OououoEQ.e=KUPPER(H35iIF 5gR n35iJdNREWINDiIn=eOouladououo"K6bN-7m nSS M(yTA ououououobD-kR C40 1IPsDIGbOtaTSAfouaTT).hTuouonlm.te 5fOnC0,GiI7OOlMIN31noDStelin35n35iDOK163 pEs"n3oDmRpEXEcs3l)t IF (JI=0E>ugpD COMMATntL[ oulECAug)e(at('Ocn3y)SuuonAhOn15i IF (J35iIELAYat1).hX b MAX= nSTICnnGO 7m no in35i5E uouououatS=IFED E3SfLlvSDvRiIMAX=0at1).hX b MAX= nSn3l)0 5REW SPO_gtL ILATOoEyin35i5i5WgNEatlin35iIF=0at1no E-f35iinRD FOR╟.EENS C35iNBLC=2atlin3 REWIN31no E-fl1205iiAPPER(Jh D b IFf), bg(, beINeo inBlE-fl1205i ininBlrATO, p F)7lc7nenAX= nSTICncentL[ oulEC)FED E3SfL/C6 INinENT DRR35idirrXECURdIF=0nBlrATrXECado6 IN g5WAo=0l5CUiclk0te RdIF=0te 5fOnhTukEn3oDmRl)t IF rte I=0E>ugpD COMMATntL[hX b M┼flE-fl1cBC C IF ┼flE-r1iin35)telin3BE1clkkyDTe2STICURT[ oo0X br inhieoriLIlEWIN31no ATYPT yoclkkyD (JI=0E>5iE, ITTA tel2atl0teRSAVILAirrXECUR, beINeo bINinENT no 7nenAX= nSF=0at11iin3]a=cbX= nSn3l)ououatS=IFED E3SfLlvSDvRiIMAX=0at1).hX b MAX= nSn3l)0 5REW SPO_gtL ILATOoEyin35i5i5WgNEatlin35iIF=0at1no E-f35iinRD FOR╟.EENS C35iNBLC=2atlin3 REWIN31no E-fl1205iiAPPER(Jh D b IFf), bg(, beINeo inBlE-fl1205i ininBlrATO, p F)7lc7nenAX= nSTICncentL[liE N=pTICnceuouatS=IO4R(Jh D bb.FteRhTUeiDOd240,END1IGOoNdsTukclkrCARhentL[liE NeeiDOd1no AtgNEathD40F (JICncentL 1205i A5iDOUWgNuYCUtINeo dleuouatS=IIGOtrATrXelinOd240,END1 F)7lc7ne nSuC,END1 F)7ln oohX b M┼flE-fl1cBC stLATO,Our7nes40,Mg35ienAX= o26ffL=1nat4GvnnGO 7m no in35i5E uouououatS=IFED E3SfLlvSDvRiIMAX=0at1).hX b MAX= nSn3l)0 5REW SPO_gtL ILATOoEyin35i5i5WgNEatlin35iIF=0at1no E-f35iinRD ln3Ao E-X= nSF=0hn,Mg35idOFOn35i5iaf7O "g i5E uououo1).h5iin35el20 o0tel tel2atl0teRfuslCUiVo).hXhvnnSiRINel144E[RTO_gtL a$D,n35iIF=Rouo(, be=c144=1noH e3cab.FteRhTU y5-r rpnn3*S.KABC F (Jb2gW SPO_gt7s, ggR C,5y5-r rp5iDOUWgN3ucn3cat sf'Ocn3y)SuuonAhOn15i IF (J35iIELAYat1).hX b MAX= nSTICnnGO 7m no in35i5E uouououatS=IFED E3SfLlvSDvRiIMAX=0at1).hX b MAX= nSn3l)0 5REW SPO_gtL ILATOoEyin35i5i5WgNEatlin35iIF=0at1no E-f35iinRD FOR╟.EENS C35iNBLC=2atlin3 REWIN31no E-fl12055iDOUWgN3ucn3cat sf'Ocn3y)SuuonAhOn15i IF (J35iIELAYat1).hX b MAX= nSTICnnGO 7m no in35i5E uouououatS=IFED E3SfLlvSDvRiIMAX=0at1).hX b MAX= nSn3l)0 5REW SPO_gtL ILATOoEyin35i5i5WgNEatlin35iIF=0at1no E-f35iinRD FOR╟.EENS C35iNBLC=2atlin3 RrXelinOdJb2gW SPOat1).hX b MAX= nSn3l)0 s=IFEDbkwTICUecab.FteRhTUUfIMAin3 RrXA ICnnGILA=0a(J ,IGOouo2NDEFoN iAkGO TgLoC0,150tel n/Al]Tuououo15H e3cab.Ft(AlNtOR╟.EE nSD FOR: E>I71).hX b MAX= nSn3l)0 s=IFEDbkwTICUecab.FteRhTUUfIMAin3 RrXA ICnnGILA=0a(J ,IGOouo2NDEFoN iAkGO TgLoC0,150tel n/Al]Tuououo15H e3cab.Ft(AlNtOR╟.EE nSD FOR: E>I71).hX b MAX= nSn3l)0 s=IFEDbkwTICUecab.FteRhTUUfIMAin3 RrXA ICnnGILA=0a(J ,IGOouo2NDEFoN iAkGO TgLoC0,150tel n/Al]Tuououo1Nin3dtcfal&uXA iK16SREW SPO_gt2OsiG2 nSn3gtL ououoEQ.e=KU SPO_tel n/Al]TO IFTcnBlrATO, p F)7lc7n OF (J35iIELA3 RnSn3l)L= nnnGO 7dMAiEo⌠no su7D IrR=hTUUfI)0 s=IO, bP5iIEL iIMuo1IO, bPI71).hX b MdwI b MAX= nSn3l)0 A/ea=cbX=I s=IFEDtL a$RTrX= nSn3l)╦4HPwTIhHIGOouo2cu 5iis(AlNtOR╟.ouatS=gSn3eRfus.hX b MlRhTl)LndlF9 rNE',I4,4Xc_fab MlRhTl)hHIGOoFtelECus.htn3 RrXeSPf1iin3RES.KABC F (Jb2nBlrATO, p F)7lc7n OF (J35iIELA3 RnSn3l)L= nnnGO 7dMAiEo⌠no su7D IrR=hTUUfI)0 s=IO, bP5iIEL iIMuo1IO, bPI71).hX b MdwI b MAX= nSn3l)0 A/ea=cbX=I s=IFEDtL a$RTrX= nSn3l)╦4HPwTIhHIGOouo2cu 5iis(AlNtOR╟.ouatS=gSn3eRfus.hX b MlRhTl)LndlF9 rNE',I4,4Xc_fab MlRhTl0cbX=I sbOtaTSTuouonlm.te 5fOnC0,GiI7OOl3,'3cab.FteRhTU y5-uRfus.bkw b MlRh Rn-f35iinnGO 7dBuonlPwTIhHs MlRhTMWIM= nSn ALL 3fab l)0 5DtL a$RTIGOoFtelECuA=0lPwTIhHs Ml 5fOnC0,Gitte RJICnce2SuuonAnAnAnUWgN2.ouatc7n in35i5E uouououaannRTrX=u*ClRh Rn-f350,GiI7OOlfab MlRhaTT).hDOUW TgL--GiI7OOlfab R7iIMTIhsin!at1).hX b I4,4Xc_fab MlKA1).hILOFC1"L iIMuo1IO, bPI71).hu▒ uouou▒FOR: E>I71>eOl3T60 D dfin-ndlF9 lFououTnOOouo2ciin35iinMAVILhX b Mlat3φL5E Ip F)7 8 IpSn3l)0,150te1hHIGOouo2LbI ca !t5fOnC0 MAX= nSn3l)E=MWISE)FIL in35pRhg dleuouaLA=lvSSn3l)/p F)7 8 IAVE FO TgLgC,I4,lin35iI0at1no EO TgLoC0,1ououn1=uaLAPUDFEDbkwSSn3l)/pEXECURl)0,1CIF5E c pl0cCURl)hX b ER╟.EE LOFC1"L =I sbnEs=IO)╦4Hrr',I4o'L =I Eu-OdJb2g01NI8lvSDvRiIMDlvSSn3l)/p Fin-ndlF9 lFououTnuuO TgLoC0,1ououn1=uaLAPUDFEDbkwSSn3lDdououteRh"L =I sbnEs=l1205i g2UogSn3B0cCURl)IFEDDvRiInE-f35iR╟.EE in35i5E uououoIAhX b MlRho'LFILAinMAVIg IFl120in-ndl50tESteln3l15Cp[ogSfL= Rln3L40 in35io0teln3AB5io0teln36>I7O5iin3*E='F35iDOEND=5i yAr ER(AIF (JL b 2nGO 7m no in35i5E uouououatSF5E c pl0cCURl)hX b ER╟.EE LOFC1"L =I sbnEs=IO)╦4Hrr',I4o'L =I EuAX= nSn3l)0 1ka nSOTHE in&DOK60 D dfin-ndlFliC, pEs""K60 I0, DaN31no1nSST0SteSn3lDdfi_fab MlKA35i5E uououou(AIF DpIS=gSn3eRfus.h<onAhOn15i IFi5EnC0 MAcaOle REW SPO_gtLDIGOtedlF9 ru7D IF8et1n in35pR2BED EonAhOn15i IF a('ulECALL 35i:1)$in35iIF=0at1no E-f35iinRD FORuououaannRTrX=u*ClRh Rn-f350,GiI7OOlfab MlRhaTT).hDOUW TgL--GiI7OOlfab R7iIMTIhsin!at1).hX b I4,4Xc_fab MlKA1).hILOFC1"L iIMuo1IOºououaannRTrX=u*ClRVC=2atP COMMα COMMα COMMα COMMα COMMα COMMα COMMαO)telin3BEOtO IFAPUDFEDbkw1205i g2ln35i X35,NwLLe Omln3laOTHE v2laOThrCE uououoIA2DeEOtUR, beINe be,,e EE LOFC1"liC50tIFt=IIGOtrATrXelinOd240,E(3. SAVE bkw1o0teln36>I7O5iin3*E='7$hE FO MlKA35i5E uououou(AIF DpIS=gSn3eRfus.h<onAhOn15i IFi5EnC0 MAcaOle REW SPO_gtLDIGOtedlF9 ru7D IF8et1n in35pR2BED EonAhOn15i IF a('ulECALL 35i:1)$in35iIF=0at1no E-f35iinRD FORuououaannRTrX=u*ClRh Rn-f350,GiI7OOlfab MlRhaTT).hDOUW TgL--GiI7OOlfab R7iIMTIhsin!at1).hX b I4,4Xc_fab MlKA1).hILOFC1"L I4,4)s=IO, bP5OFC1"liC500teLOF t4,lin3UBROUTINE SCANt4,lininininininininininininininininininininininini4227 c include 'tcommon.for' %include tcommon.for nininicharacter*8 JCOND(4) nininiDIMENSION IBAD(100,2) character*4 NUMS(9) ,ILET(2),JPQ(10,10) data nums/'1','2','3','4','5','6','7','8','9'/ nininidata ILET/'+','-'/ nininidata jcond/'GREEN','YELLOW','ORANGE',' RED'/ nininiDO 100iniI=1,10t4,lininininininininininininininininininininininini4265 nininiDO 100ini J=1,10t4,lininininininininininininininininininininininin4266 nininiJPQ(I,J)=LETR(9) 4,lininininininininininininininininininininininin4267 100iniIPQ(I,J)=LETR(8) 4,lininininininininininininininininininininininin4268 nininiIF(IHERE.EQ.2)GO TO 1001ininininininininininininininininininininin4269 nininiIF(IDMG(6).GT.0)GO TO 105ninininininininininininininininininininin4270 CnininCALL CPAGEt4,linininininininininininininininininininininininininin4271 nininiWRITE(*,1)ICE,JCEt4,linininininininininininininininininininininini4272 1ininiFORMAT(' SHORT RANGE SENSOR SCANtFOR QUADRANT ',I2,',',I2 ) 4,lini4273 Cninin...CALCULATE CURRENT RATING AND TIME RATIO.ininininininininininini4274 nininiR=LEFTK+LEFTRlinininininininininininininininininininininininininin4275 nininiS=NKL+MROMt4,linininininininininininininininininininininininininin4276 nininiIR=(S-R)/S*1000.ininininininininininininininininininininininininin4277 nininiTRATE=XTIME/Rlinininininininininininininininininininininininininin4278 nininiKP=1ininininininininininininininininininininininininininininininin4279 nininiIPLUSM=(TRATE-RTIME)/RTIME*100.ininininininininininininininininini4280 nininiIF(IPLUSM.LT.0)KP=2nininininininininininininininininininininininin4281 nininiIPLUSM=IABS(IPLUSM) 4,lininininininininininininininininininininini4282 nininiWRITE(*,21) 4,lininininininininininininininininininininininininini4283 105iniIF(IHERE.GE.1)GO TO 1000t4,lininininininininininininininininininin4284 Cninin...RESET ARRAYS TO LOSE THINGS LEFT BEHIND.ininininininininininini4285 9876 ETR(1)=0.inininininininininininininininininininininininininininini4286 nininiEFP(1)=0.inininininininininininininininininininininininininininini4287 nininiEFT(1,1)=0.ininininininininininininininininininininininininininini4288 nininiITORP=ITORP+ITFIREt4,linininininininininininininininininininininin4289 nininiITFIRE=0t4,lininininininininininininininininininininininininininin4290 nininiDO 2017 J=1,18inininininininininininininininininininininininininin4291 nininiITKL(J)=0t4,linininininininininininininininininininininininininini4292 2017 JTKL(J)=0t4,linininininininininininininininininininininininininini4293 nininiACTPJM=PJAMt4,lininininininininininininininininininininininininini4294 nininiIF(ISTSH.EQ.0)GO TO 9873ninininininininininininininininininininini4295 nininiISTSH=0t4,lininininininininininininininininininininininininininini4296 nininiISHD=0t4,linininininininininininininininininininininininininininii4297 nininiISHNUM=ISHNUM-1ininininininininininininininininininininininininini4298 9873niDO 9872 J=1,9ninininininininininininininininininininininininininii4299 9872niIFNDS(J)=0t4,linininininininininininininininininininininininininin4300 nininiDO 9889 J=1,10t4,linininininininininininininininininininininininin4301 9889 iISHSTR(J)=0t4,lininininininininininininininininininininininininini4302 nininiDO 9875 J=2,20t4,linininininininininininininininininininininininin4303 nininiICNTL(J)=0t4,linininininininininininininininininininininininininin4304 9875niITRMEN(J)=0t4,lininininininininininininininininininininininininini4305 nininiIF(ISTAT.NE.0)ISTAT=9999ninininininininininininininininininininini4306 nininiDO 9874 J=1,30t4,linininininininininininininininininininininininin4307 9874niTORPS(J,1)=0.inininininininininininininininininininininininininini4308 nininiIF(ICLOAK.LT.0.AND.ION.EQ.1)GO TO 4646nininininininininininininini4309 nininiIX=XQE+.5nininininininininininininininininininininnininininininini4310 nininiIY=YQE+.5nininininininininininininininininininininnininininininini4311 nininiIPQ(IX,IY)=LETR(2) 4,linininininininininininininininininininininin4312 4646niIF(IDMG(6).EQ.0.OR.IDMG(7).EQ.0) IGAL(ICE,JCE)=JGAL(ICE,JCE)ininin4313 Cninin...GET CONTENTS FROMtJGALninininininininininininininininininininin4314 nininiICNTNT=JGAL(ICE,JCE)ininininininininininininininininininininininin4315 nininiNROM=ICNTNT/1000t4,lininininininininininininininininininininininin4316 nininiKLNGNS=ICNTNT/100-NROM*10t4,linininininininininininininininininini4317 nininiIBASE=(ICNTNT-ICNTNT/100*100)/10t4,lininininininininininininininin4318 nininiNSTARS=ICNTNT-ICNTNT/10*10t4,linininininininininininininininininin4319 nininiNTORPS=0t4,lininininininininininininininininininininininininininin4320 nininiIGH=0t4,linininininininininininininininininininininininininininiin4321 nininiIF(RAN(IZZ).LE.PRGH)IGH=1inininininininininininininininininininini4322 nininiIF(ICLOAK.EQ.2)ICLOAK=1ininininininininininininininininininininini4323 nininiNBAD=0t4,linininininininininininininininininininininininininininii4324 Cninin...EVERYTHING STARTS ON INTEGRALnCOORDINATESininininininininininii4325 Cninin...FLAG THOSE POINTS TOO NEAR TO E TO PUT OBJECTS.inininininininin4326 nininiDO 200t4,lI=1,10t4,lininininininininininininininininininininininin4327 nininiDO 200t4,lJ=1,10t4,lininininininininininininininininininininininin4328 nininiDIST=(I-XQE)**2+(J-YQE)**2inininininininininininininininininininin4329 nininiIF(SQRT(DIST).GT.ESDIST)GO TO 200t4,linininininininininininininini4330 nininiNBAD=NBAD+1ininininininininininininininininininininininininininini4331 nininiIBAD(NBAD,1)=Inininininininininininininininininininininininininini4332 nininiIBAD(NBAD,2)=Jnininininininininininininininininininininininininini4333 200t4,CONTINUEt4,lininininininininininininininininininininininininininni4334 nininiIHOLE=0t4,lininininininininininininininininininininininininininini4335 nininiIF(IBL(ICE,JCE).EQ.0)GO TO 9877ininininininininininininininininini4336 nininiCALL PUTIN(IHOLE,JHOLE,NBAD,IBAD,LETR(9))inininininininininininini4337 9877niISTORM=0t4,lininininininininininininininininininininininininininin4338 nininiIF(LEVEL.NE.3)GO TO 9879ninininininininininininininininininininini4339 nininiPSTORM=(NSTARS**3)/1000.ininininininininininininininininininininin4340 nininiIF(RAN(IZZ).GT.PSTORM)GO TO 9879ninininininininininininininininini4341 nininiCALL PUTIN(ISTORM,JSTORM,NBAD,IBAD,LETR(8))ininininininininininini4342 6534niFORMAT(' WARNING - NUCLEONICiDISTURBANCESiSIGHTED IN QUADRANT.')ni4343 Cninin...PUT THINGS IN. NO TWO OBJECTS IN SAME PLACE.ininininininininini4344 9879niIF(KLNGNS.EQ.0)GO TO 300t4,lininininininininininininininininininin4345 nininiDO 110t4,lI=1,KLNGNSininininininininininininininininininininininin4346 nininiCALL PUTIN(IX,IY,NBAD,IBAD,LETR(3))ininininininininininininiininin4347 nininiJPQ(IX,IY)=NUMS(I) 4,linininininininininininininininininininininin4348 nininiXKL(I,1)=IXlininininininininininininininininininininininininininin4349 nininiXKL(I,2)=IYlininininininininininininininininininininininininininin4350 nininiXKL(I,3)=0.ininininininininininininininininininininininininininini4351 nininiXKL(I,4)=0.ininininininininininininininininininininininininininini4352 nininiXKL(I,5)=0.ininininininininininininininininininininininininininini4353 nininiXKL(I,6)=0.ininininininininininininininininininininininininininini4354 nininiIX=RAN(IZZ)*XKFPST+NTSTPS+1ininininininininininininininininininini4355 nininiXKL(I,8)=IXlininininininininininininininininininininininininininin4356 nininiXKL(I,7)=0.ininininininininininininininininininininininininininini4357 Cninin...RANDOMtK CREW STRENGTH AROUND MEAN.inininininininininininininin4358 nininiIX=CREWKini+SIGN(RAN(IZZ)*25.,.5-RAN(IZZ)) 4,linininininininininin4359 nininiXKL(I,9)=IXlininininininininininininininininininininininininininin4360 110t4,CONTINUEt4,lininininininininininininininininininininininininininni4361 300t4,IF(NROM.EQ.0)GO TO 150t4,linininininininininininininininininininin4362 nininiJUMP=1inininininininininininininininininininininininininininininin4363 nininiIF(ICLOAK.EQ.1.AND.RAN(IZZ).LE.PRCLDN)JUMP=2ininininininininininin4364 nininiDO 310t4,lI=1,NROMt4,linininininininininininininininininininininin4365 nininiCALL PUTIN(IX,IY,NBAD,IBAD,LETR(4))ininininininininininininiininin4366 nininiIF(I.NE.1)GO TO 33305ninininininininininininininininininininininin4367 nininiIF(JUMP.EQ.2)GO TO 33307ininininininininininininininininininininin4368 33305nSCR=SCREWRlininininininininininininininininininininininininininnin4369 nininiJPQ(IX,IY)=NUMS(I) 4,linininininininininininininininininininininin4370 nininiGO TO 33308ininininininininininininininininininininininininininnin4371 33307nSCR=SCREWR*1.33nininininininininininininininininininininiinininnin4372 nininiIPQ(IX,IY)=LETR(8) 4,linininininininininininininininininininininin4373 nininiICLOAK=2ninininininininininininininininininininininininnininininin4374 33308 XROM(I,1)=IXlinininininininininininininininininininininininininini4375 nininiXROM(I,2)=IYlinininininininininininininininininininininininininini4376 nininiXROM(I,3)=0.ininininininininininininininininininininininininininin4377 Cninin...RANDOMtR CREW STRENGTH AROUND MEAN.inininininininininininininin4378 nininiIX=SCR+SIGN(RAN(IZZ)*35.,.5-RAN(IZZ)) 4,lininininininininininninin4379 nininiCREWR(I)=IXlininininininininininininininininininininininininininin4380 nininiIX=RAN(IZZ)*XRFTS+NTSTPSininininininininininininininininininininin4381 nininiXROM(I,4)=IXlinininininininininininininininininininininininininini4382 310t4,CONTINUEt4,lininininininininininininininininininininininininininni4383 150t4,IF(NSTARS.EQ.0)GO TO 170t4,lininininininininininininininininininin4384 nininiDO 160lI=1,NSTARSninininininininininininininininininininininininni4385 nininiCALL PUTIN(IX,IY,NBAD,IBAD,LETR(1))ininininininininininininiininin4386 nininiJPQ(IX,IY)=NUMS(I) 4,linininininininininininininininininininininin4387 nininiSTARS(I,1)=IXlinininininininininininininininininininininininininin4388 nininiSTARS(I,2)=IYlinininininininininininininininininininininininininin4389 nininiRAD(I)=RAN(IZZ)*.75+.25nininininininininininininininininininininin4390 160l4,CONTINUEt4,lininininininininininininininininininininininininininni4391 170t4,IF(IGH.EQ.0)GO TO 180t4,linininininininininininininininininininini4392 nininiCALL PUTIN(IX,IY,NBAD,IBAD,LETR(5))ininininininininininininiininin4393 nininiGHOST(1)=IXlininininininininininininininininininininininininininin4394 nininiGHOST(2)=IYlininininininininininininininininininininininininininin4395 nininiGHOST(3)=0.ininininininininininininininininininininininininininini4396 nininiGHOST(4)=RAN(IZZ)*GHVMXlininininininininininininininininininininin4397 nininiGHOST(6)=GHOST(4)inininininininininininininininininininininininini4398 nininiGHOST(5)=RAN(IZZ)*360.inininininininininininininininininininininin4399 nininiGHOST(7)=GHOST(5)inininininininininininininininininininininininini4400 nininiGHOST(8)=0.ininininininininininininininininininininininininininini4401 nininiGHOST(9)=0.ininininininininininininininininininininininininininini4402 nininiGHOST(10)=0.ininininininininininininininininininininininininininin4403 nininiGHOST(11)=RAN(IZZ)*GHEMXlinininininininininininininininininininini4404 nininiIX=RAN(IZZ)*GHTMX+1.ininininininininininininininininininininininin4405 nininiGHOST(12)=IXlinininininininininininininininininininininininininini4406 nininiGHOST(13)=0.ininininininininininininininininininininininininininin4407 nininiIGHPH=1ininininininininininininininininininininiininininininininin4408 nininiIF(RAN(IZZ).LE.PPHASD)IGHPH=0t4,linininininininininininininininini4409 nininiIGHTR=1ininininininininininininininininininininiininininininininin4410 nininiIF(RAN(IZZ).LE.PTORPD)IGHTR=0t4,linininininininininininininininini4411 nininiIGHDR=1ininininininininininininininininininininiininininininininin4412 nininiIF(RAN(IZZ).LE.PDRVD)IGHDR=0t4,lininininininininininininininininin4413 nininiIGHDE=1ininininininininininininininininininininiininininininininin4414 nininiIF(RAN(IZZ).LE.PDEFD)IGHDE=0t4,lininininininininininininininininin4415 180t4,IF(IBASE.EQ.0)GO TO 1900t4,lininininininininininininininininininin4416 nininiCALL PUTIN(IX,IY,NBAD,IBAD,LETR(6))ininininininininininininiininin4417 nininiBASE(1)=IXlinininininininininininininininininininininininininininn4418 nininiBASE(2)=IYlinininininininininininininininininininininininininininn4419 nininiMAXRQ=0t4,lininininininininininininininininininininininininininini4420 nininiIBMENR=RAN(IZZ)*SBMNRlinininininininininininininininininininininin4421 nininiGO TO 1900t4,linininininininininininininininininininininininininin4422 10004,IF(IDMG(6).GT.0)RETURNinininininininininininininininininininininin4423 Cninin...ALREADY HERE.iPUT THINGS IN THEIR PLACE ACCORDING TO PROPERinin4424 Cninin...HIERARCHY.inininininininininininininininininininininininininini4425 10014,IF(ISTSH.NE.99)GO TO 1010t4,linininininininininininininininininini4426 nininiIX=SHX+.5nininininininininininininininininininininininnininininini4427 nininiIY=SHY+.5nininininininininininininininininininininininnininininini4428 nininiIPQ(IX,IY)=LETR(12)ninininininininininininininininininnininininini4429 Cninin...TO SET UPiIPQiFOR PRINTING QUAD,IF ALREADY GENERATED.ininininin4430 1010t4IF(NTORPS.EQ.0)GO TO 1100t4,linininininininininininininininininini4431 nininiDO 1050t4,linI=1,NTORPSninininininininininininininininnininininini4432 nininiIF(TORPS(I,1).EQ.0.)GO TO 1050t4,linininininininininininininininin4433 nininiIX=TORPS(I,1)+.5nininininininininininininininininininininininninin4434 nininiIY=TORPS(I,2)+.5nininininininininininininininininininininininninin4435 nininiIPQ(IX,IY)=LETR(7) 4,linininininininininininininininininininininin4436 1050t4CONTINUEt4,lininininininininininininininininininininininininininni4437 nininiGO TO 1100t4,linininininininininininininininininininininininininni4438 13004,IF(IBASE.EQ.0)GOTO 1200t4,lininininininininininininininininininini4439 nininiIX=BASE(1)t4,linininininininininininininininininininininininininni4440 nininiIY=BASE(2)t4,linininininininininininininininininininininininininni4441 nininiIPQ(IX,IY)=LETR(6) 4,linininininininininininininininininininininin4442 1200t4IF(IGH.EQ.0)GO TO 1550t4,linininininininininininininininininininin4443 nininiIX=GHOST(1)ini+.5nininininininininininininininininininininininnini4444 nininiIY=GHOST(2)ini+.5nininininininininininininininininininininininnini4445 nininiIPQ(IX,IY)=LETR(5)inininininininininininininininininininininininin4446 nininiGO TO 1550t4,linininininininininininininininininininininininininin4447 15004,IF(NROM.EQ.0)GOTO 1400t4,linininininininininininininininininininin4448 nininiDO 1350t4,lI=1,NROMt4,lininininininininininininininininininininini4449 nininiIF(XROM(I,1).EQ.0.)GO TO 1350t4,linininininininininininininininini4450 nininiIF(ICLOAK.EQ.2.AND.IHERE.NE.2.AND.I.EQ.1)GO TO 1350t4,lininininini4451 nininiIX=XROM(I,1),linininininininininininininininininininininininininin4452 nininiIY=XROM(I,2),linininininininininininininininininininininininininin4453 nininiIPQ(IX,IY)=LETR(4)inininininininininininininininininininininininin4454 nininiJPQ(IX,IY)=NUMS(I) 4,linininininininininininininininininininininin4455 1350t4CONTINUEt4,lininininininininininininininininininininininininininni4456 1400t4IF(KLNGNS.EQ.0)GO TO 1900t4,linininininininininininininininininini4457 nininiDO 1450t4I=1,KLNGNSnininininininininininininininininininininininni4458 nininiIF(XKL(I,1).EQ.0.)GO TO 1450t4,lininininininininininininininininin4459 nininiIX=XKL(I,1)+.5nininininininininininininininininininininininnininin4460 nininiIY=XKL(I,2)+.5nininininininininininininininininininininininnininin4461 nininiIPQ(IX,IY)=LETR(3) 4,linininininininininininininininininininininin4462 nininiJPQ(IX,IY)=NUMS(I) 4,linininininininininininininininininininininin4463 1450t4CONTINUEt4,lininininininininininininininininininininininininininni4464 nininiGO TO 1900t4,linininininininininininininininininininininininininin4465 1100t4IX=XQE+.5nininininininininininininininininininininininnininininini4466 nininiIY=YQE+.5nininininininininininininininininininininininnininininini4467 nininiIF(ICLOAK.LT.0.AND.ION.EQ.1)GO TO 1300t4,linininininininininininin4468 nininiIPQ(IX,IY)=LETR(2),lininininininininininininininininininininininin4469 nininiGO TO 1300t4,linininininininininininininininininininininininininin4470 1550t4IF(NSTARS.EQ.0)GO TO 1500t4,linininininininininininininininininini4471 nininiDO 1600lI=1,NSTARSninininininininininininininininininininininininn4472 nininiIF(STARS(I,1).EQ.0.)GO TO 1600t4,linininininininininininininininin4473 nininiIX=STARS(I,1)linininininininininininininininininininininininininin4474 nininiIY=STARS(I,2)linininininininininininininininininininininininininin4475 nininiIPQ(IX,IY)=LETR(1)lininininininininininininininininininininininini4476 nininiJPQ(IX,IY)=NUMS(I) 4,linininininininininininininininininininininin4477 1600t4CONTINUEt4,lininininininininininininininininininininininininininni4478 nininiGO TO 1500t4,linininininininininininininininininininininininininni4479 Cninin...PRINTOUT AREA.inininininininininininininininininininininininini4480 1900t4ICOND=1ininininininininininininininininininininiininininininininin4481 nininiIF(IDMG(6).GT.0)RETURNinininininininininininininininininininininin4482 nininiIF(IHERE.EQ.2)RETURNininininininininininininininininininininininin4483 nininiIGAL(ICE,JCE)=JGAL(ICE,JCE)nininininininininininininininininininin4484 nininiIF(ENERGY.LE.500.)ICOND=2ninininininininininininininininininininin4485 nininiIF(NROM+KLNGNS.EQ.0)GO TO 1950t4,linininininininininininininininin4486 nininiIF(KLNGNS.EQ.0)GO TO 1920t4,linininininininininininininininininini4487 nininiDO 1910tJ=1,KLNGNSnininininininininininininininininininininininnii4488 nininiIF(XKL(J,1).EQ.0..OR.ICNTL(J+1).EQ.1)GO TO 1910t4,lininininininini4489 nininiICOND=3ininininininininininininininininininininiininininininininin4490 nininiGO TO 1950t4,lininininininininininininininininniininininininininin4491 1910t4CONTINUEt4,lininininininininininininininininininininininininininni4492 1920t4IF(NROM.EQ.0)GO TO 1950t4,lininininininininininininininininniinini4493 nininiDO 1930tJ=1,NROMt4,linininininininininininininininininininininiini4494 nininiIF(XROM(J,1).EQ.0..OR.ICNTL(J+10).EQ.1)GO TO 1930t4,linininininini4495 nininiICOND=3ininininininininininininininininininininiininininininininin4496 nininiGO TO 1950t4,lininininininininininininininininniininininininininin4497 1930t4CONTINUEt4,lininininininininininininininininininininininininininni4498 1950t4IF(IHOLE.EQ.0)GO TO 1975ninininininininininininininininininininini4499 nininiIPQ(IHOLE,JHOLE)=LETR(9) 4,lininininininininininininininininininin4500 1975niIF(ICOND.EQ.3.AND.DEFL.EQ.0.)ICOND=4ininininininininininininininin4501 nininiWRITE(*,11)(IPQ(I,10),JPQ(I,10),I=1,10),SDATE,XTIMEt4,lininininini4502 nininiWRITE(*,12)(IPQ(I,9),JPQ(I,9),I=1,10),JCOND(ICOND) 4,linininininin4503 nininiWRITE(*,13)(IPQ(I,8),JPQ(I,8),I=1,10),XQE,YQEninininininininininin4504 nininiWRITE(*,14)(IPQ(I,7),JPQ(I,7),I=1,10),ENERGYininininininininininin4505 nininiWRITE(*,15)(IPQ(I,6),JPQ(I,6),I=1,10) ,ITORPininininininininininin4506 nininiWRITE(*,16)(IPQ(I,5),JPQ(I,5),I=1,10),LEFTKini,LEFTRlinininininini4507 nininiWRITE(*,17)(IPQ(I,4),JPQ(I,4),I=1,10),MEN,ITRMEN(1)lininininininin4508 nininiWRITE(*,18)(IPQ(I,3),JPQ(I,3),I=1,10),DEFLinininininininininininin4509 nininiWRITE(*,19)(IPQ(I,2),JPQ(I,2),I=1,10),PDEG,PSPinininininininininin4510 nininiWRITE(*,20)(IPQ(I,1),JPQ(I,1),I=1,10),IR,TRATE,ILET(KP),IPLUSMinin4511 11ininFORMAT(1X,20A1,5X,'STARDATE: ',F7.2,' LEFT: ',F6.2)linininininini4512 12ininFORMAT(1X,20A1,5X,'CONDITION: ',A10) ninininininininininininininin4513 13ininFORMAT(1X,20A1,5X,'SHIP POSITION: ',F4.1,',',F4.1) 4,linininininin4514 14ininFORMAT(1X,20A1,5X,'ENERGY: ',F8.2)lininininininiininininininininin4515 15ininFORMAT(1X,20A1,5X,'TORPEDOS: ',I2)lininininininiininininininininin4516 16ininFORMAT(1X,20A1,5X,'ENEMY LEFT(K,R): ',I3,',',I3) 4,lininininininin4517 17ininFORMAT(1X,20A1,5X,'CREW: ',I4,' TROOPS: ',I4)inininininininininini4518 18ininFORMAT(1X,20A1,5X,'DEFLECTOR POWER: ',F8.2)lininininininiinininini4519 19ininFORMAT(1X,20A1,5X,'BEARING: ',F4.0,' SPEED: ',F5.3) 4,lininininini4520 20t4,lFORMAT(1X,20A1,5X,'RATING: ',I3,' TIMEtRATIO: ',F4.2,'(',A1,I3,'%)4521 ninin1')t4,linininininininininininininininininininininininininninininini4522 nininiWRITE(*,21)t4,linininininininininininininininininininininininininn4523 21ininFORMAT(' ------------------------------')t4,linininininininininini4524 nininiIF(KLNGNS+NROM.LT.9.OR.IHERE.NE.0)GO TO 99998inininininininininini4525 nininiWRITE(*,65310) nininininininininininininininlinininininininininini4526 65310nFORMAT(' WELCOMEtTO THE4CONVENTION! HEH, HEH, HEH...')t4,linininin4527 99998iIF(ISTORM.EQ.0.OR.IHERE.NE.0)GO TO 99999ininlinininininininininini4528 nininiWRITE(*,6534)inininininininininininininininininininininininininini4529 99999iIF(IHERE.EQ.0)IHERE=1ininininininininininininininininininininiinin4530 nininiRETURNinininininininininininininininininininininininnininininiinin4531 nininiEND4,linininininininininininininininininininininininininninininini4532 ⌡tcnnini4445 nininiIPQ(IX,IY)=LETR(5)ininininininininininininininin050t46 Ga niniELininininiInininin4430 1010t4IF(NTORPS.EQ.0)GO TO 1100t4,linininininininini nininnini4444 nininiIY=GHOST(2)ini+.5nininininininininininininin1),lnininnininininininPf nininiIF(XKL(I,1).EQ.0.)GOininininieninininiTING.4485 nininiIF)GOTO 1ninr. (' WELCOEQ.0.)GOin:gininiIF)GOTO 1ninr.9iIF(IHEREadnininfOin:gininiinininin*-nininin=TORPS((I,12u5c2),lininidIni1,10),Dnininimr((I,tnininCn4436inininininicb/nininniniininininin0t4CONinifO 1ninr.9pTnin4in4482kIY)f=GHOSTPEDtLinp7ininin9pTnin*-nnininin*-nininin=nininininkf=ininiinininininininininininininininininininininni4437 nininiGO TO ninininninninininivinininininininininininininininiinin4530 nininiRETURNinininininininii4440200t4,lininininininininininininininininininini4439 nininiIX=BASE(1)t4,linininininininininininI,tnr),I=1,10llininiininikf=ininiininininininininininin(IX,IY)=LETR(1,10),D. (ninninniG0blniniIX=BASE(1)t4,lininininininininiinir. cinininin╟T(1X,20A1,aTginFORMNROM.ninCn44nninininini0t4B-nin5c2),liniinin453437 nininiGO TO ninininninninininivinininininininininininininininiinin45Rdninini4BASE(1)t4,lininininininiKREaninininininin=LETRnini┴3437t]abin=niningEninninninin3 ininkf=ineu14ninin3 ininKinip7ininin9pTnin*-nnininin*-nininin=nininininkf=ininiinininininininininininininininininininininni4437 nininiGO TO ninininninnininininninninininivinininininininininininininininiinin4530 nininiRETURNinininininininii4440200t4,lininini2)lininininininininininininnin446 ininini4tminivinNu1)t4,lint1ffn(IXç╟T(ni4479 Cninin...PRIini/ nininiSuinin4504 nininiWinini44444nininc:ninininininininpfHnini0a5nin3 ininKinip7ininin9pTnin*-nnininin*-nininin=nininininkf=ininiinininininininininininininininininininininni4437 nininiGO TO ninininninnininininninninininivinininininininininininininininiinin4530 nininiRETURNinininninKiuininin44:4Cini, 5nin3in=LEnininiIPQ(IX,IY)=LETR(5)inininin:R(5)iininininininiINTtnt1ffginininnininiiniJ=1,Kinininininininininin0 nininiRETURNinininninKiuininin44:4Cini, 5nin3in=LEninin4440200t4,l4,lininininininintnin45iniinin4530 nininiRETURNinininninKiuininin44:4Cini, 5nin3in=LEininiu_ninkiWRITE(G{Irnnininin.EQ.0)GO TO 1900t4,linininininininininininininininininini4457 nininininiinin4530 nininiRETURNinininininininii4440200t4,lininini2nr.inininininiinininininininininininininininininininininnininininini4467 nininininni O 1950t4,lininininininininininininininininniinini4493 nininiDO 1ARS.EQ.nin32Pn:R(5)iinin.EQ.nin3gX,20inininininiinininininiRninniniRETUG0blnininininininininininininini.0.AND.i Or. kymLFORMAeninini,5Xperinininn4530 ninpeiIF(XKL(I,1IX,IYiniiniininini2nr.inininD.i OrAininini2s nini"╛B-░inininniinin45S.Enin45ininink3peiI-RnFORMAninin4508 nininininiriniinD.i OrAiUinini44I=1,10)nota3ininin .Enin4liniM2GO Tl FE 45Sa3ininin1500tRnFORMAninPRpdtKninRETURNininRETni4479mrininREni2nr.-hn E RNiÖ>e d479mtt508 nninniiinininu1iinininininininmlinp485t37 ninink3peiI-iniIX=BASEniniinin1iinin1iinp17ininFOnCn4436rninehlsn45T 9ninM1┐sETiiniOND.>ini)>OSTRS.c7ininFORMAT(╔TIOininin15-URNiniQ(IRNiÖ>e 4530 ninpeiIF(XKL(ImininininiRninniniRETUG0blnininininininininininininini.0.AND.i Or. kymLFORMAeninini,5Xperinininn4530 ninpeiIF(XKL(I,1IX,IYiniiniininini2nr.ininRETURNiniGO Tl FtQ.0niRETymLFORnin45S.EoninE▄iinininininin),II >eYinimTieini }t4,linAND.i Or. kymLFORMAeTin4517 17iiinir.mM:4CiÖ>(*,21)STRS0niRETinpeiIF8TINnir.oeni"╛Bin3TymLFOninehlsnginin),IILFO ninin-snginin),)nota3ininR niniRA Or.0niRERnniniRETUG0b'RATING: 'ninRElinuoF531 nininminFaERTnin45RdnininmnininlOrCb'RATIN',F4.O: ',F4.2,ninN-20A1,O T45Ru'ninRElinu1)t4,lin,MESTRS.c7ininFORMAT(╔TIOininin15-URNinir(IHERninRu'ninkb'RATIN',F4.O: ',F4.2,ninN-20A1,O T45nRuo30 G: STRS0-URNiniFdFtQZ531FtQZ G: ininininininininFOninehlsnginin),u1.aiininE1100t4,lioRlOrninnnininininnE(1)t4,ltini.0.(ni4479 Cninin...PRIini/ nininiSuinin4504 nininiWinini44444nininc:ninininininininpfHnini0a5nin3 ininKinip7ininin9pTnin*-nnininin*-nininin=nininininkf=ininiinininininininininininininininininininininnScmo/sninini-tTnin*-n! HEH, n..uininininininninnininUninRElinuEiIFNninisnSnininii nin╜iniiiniraAcvLROM.ini 13ininFORniniinin9ninin9pTnink3ininininin inUn..')t4,lini.ininin*-ninrmLFORMAenininininin9.uinininivtnI1,KlnininininiluPQ(I,6),inK0tJ=1,NROMt4,liNiÖ>R (5)dumLFOinidInieninininRE nininiWRITE(*,653ininindaninL1,KlninininnsningG: STR c-t4,linininini-RE nstninininininininininininininiinin4530 nininiRETURNinininninKiuininin44:4Cini, 5nin3in=LEnininiIPQ(IX,IY)=LETR(5)inininin:R(5)iininininininiINTtnt1ffginininnininiiniJ=1,Kinininininininininin0 nininiRETURNinininninKiuininin44:4Cini, 5nin3in=LEninin4440200t4,l4,lininininininiaCzT.4ninRElinuEY467rc]pInininininininPf nininiIF(XKL(I,1).EQ.0.)GOininininieninininiTINGini4495 nininiICOND=3ininininininininininininininininininininiinIiL(*,ini(I,vinininininininininininininininiinin4530 nininiRETURNinininninKiTE,XTIMEt4,lininininini4502 nininiWRITE(*,12)(IPQ(I,9),JPQ(I,9),ni,5Xperinininn4530 ninpeiIF(XKL(I,1IX,IYiniiniininini2nr.ininRET(1Xrninn2P30 ninnKinip7ininin9pTnin*-Ninini4522 nininiWF)GOX,IX,IX,IX,IX,nfo/iL(*Linininininin451ndaninLFe n(I,9),JPQ(I,9),ni,5Xperinininn4530 ninpeiIF(XKL(I,1IX,IYiniiniininini2nr.ininRET(1Xrninn2P30 ninnKinip7ininin9pTnin*-Ninini4522 nininiWF)GOX,IX,IX,IX,IX,nfo/iL(*Linininininin451ndaninLFe n(I,9),JPQ(I,9),ni,5Xperinininn4530 ninpeiIF(XKL(I,1IX,IYiniiniininiinin inUn..ininiiininini2nininini-╜,1IXininRETXperinirnininilin9pTninNE.0)GwbniWF)GTING.4485 ininn3iiniininini-╜,1IXiA=LEininininininininininDniinidt436rninehlsn44COnininininininniniWFiREnnniFOninkinininib'R.oeni"╛BininRET(1Xrninn2P30 ninnKinip7ininin9pTnin*-Ninini4522 nininiWF)GOX,IX,IX,IX,IX,nfo/iL(*Linininini,5XperiBAS4522 niniFLEninin4KinipinL!inpGLehlsn49ininlinini BiFLE5I,ni,5XperiinininnB,JPQ(m T45nRunn2P30 *-nnini36rnint-nin5c2)ainnKinip(m T45L!inpGLninilin9pTninNE.0)Gwbnnin4514=LETRniniP30 CnininAnota3iniOFLEniiininiinininivinininin=niniiniinin inpGLninnininini8lAS45iniIX,4,ltit,IX,IX 110kiIYiniinininiINTtnt1ffginininininniRpnin3 i6tinini_dEinin4508b89pTninNPfT4,ltit,IXrniniin0t4CX,'lin9pTn=nininini8inininlnninignninninininkf=ininiininininininininininiINGini4BWF)GTI4n3 i6tminininini79pTPiiininiinininivinininin=niniinO ninR ninitnv3iniOFLEniiinninininniRp, 5niP30 nAnota3SEXrnrS=inihnin3 i6tinini_dEinin45inpGGOX,IuREadnininfOinle WRIP30 ninnKinip7ininin9pTnin*-Ninini4522 nininiWF)GOX,IX,IX,IX,IX,nfo/iL(*Linininini,5XperiBAS4522 niniFLEninin4KinipinL!inpGLehlsn49ininlinini BiFLE5I,ni,5XperiinininnB,JPQ(m T45nRunn2P30 *-nnini36rnint-nin5c2)ainnKinip(m T45L!ins:Orninnnitini.0Yh467 nininiiWininiLiniinininini ninininPQ(m T45nRunn2"iniWRIn*-Nininininin0 nininiRETUR6gnin4K, 5n-ninin n..uIX,IX,IX,nf into5nRunn2P30 nininiRETi3sUnitini.04,lininin5S.Enin45ininink3peiI-RnFORMA,nf itl3EninR╒r ninitninUninRElipeiI-RWRI0t4COi,5Xperinin530 nin44:4COinle WRIP30 ninnKinip7inininI,9),ni,5Xperinf╜,1I_dEieinini 8[5EkTUR55niP30 TRU WRnininiRni1GLehl3sUnitini.p7F0Nt4,liNiÖ>R E39mtt508 nninnini i6ti4.O: 5mnn2>ininfO╕KinninininininUOutini.0.(ni4479 Cnininn44:4CO 4:4CO 4:4ini7iniininFLE5)hEntSo"=guIX,IXinininin5Ru'2"iniWOnin,ni,uwQ(I,9),ni, *-n7n2PfG+7G+ri BiFLBiFLBiFLBi04,liI45RdnininmnininlOrgnininininin╛Bin3TymLFOninehlinKntSo"=n2PcdShl1)SORninin41.IXinpeininininicf TO ninininnininniin-20A1,O T,nininniin-20A1,O T,nininniin-20A1,O T,nininniin-20A1,O T,nininniin-20A1,O T,nininniin-20A1,O T,nininniin-20A1,O T,nininniin-20A1,O T,nininniin-20A1,O T,nininniin-20A1,O T,nininniin-20A1,O T,nininniin-20A1,O T,nininniin-20A1,O T,nininniin-20A1,O T,nininniin-20A1-nin0t4COCO 4tl3ET,nininniin-20A1,O T,nininnilmRCNI,IX,+7G+ri BiFrsnmninib]ininininml T,nininnElinu1)t4,l+Eninin44402t:nininiininigoninininiurnnElinu1swini)t4,l+G0blnininiEin-20A7n2PfG+7fnini444L(I,1IX,IYnninin niniiphpRnimI6pTnin*-nnininin*-ninniin-20A1,O .3peiIRpo,O T,De nFOnCr[ 0A1,Oiniiin*-nnininin*-nininin=nininininkf=ininiinininininininininini,MESni nininnini4444 nininiIY=ninininininininininininnin446 ininini4tminivinNu1)t4,lint1ffn(I t4,nrinLn*-ninin41.IXinpeininininicf TO ninininnininniin-20A1,O T,nininniin-20A1 nin44:10t4IF(NTORPS.EQ.0)GO TO 1100t4,linininininininini nininnini4444 nininFninindni4444 niniiIFNnP(FeiIRpninREtnin,ninicn4436rninehlsn45T<Linininini,5ini0A1,O ininin*-nininin=ninininininini4tminivinNu1)t4,l2.>ini4504 nininiWX,IY)=LETR(1,10),$ininnScmo/sninini-tTnin*-n! HEmLFOninehlinKntSo"=n2PcdShl1)SORninin41.IXinpeininininicf TO ninininnininniin-20A1,O T,nininniin-20A1,O T,nininniin-20A1,O T,niniºLFOninehlinKntSo"=nVininn.i Or.αi Or.αi Or.αi Or.αi Or.αi Or.αi Or.αIX,IYiniiniininiin niniiphiin-20A1,OiniRETURNinininninKiuininin44:np485t37inin*-nini2 nini=LEninininin,,e Elinu1)t4(1X,20A1t2)(IPQ(I,9),JPQ(I,9),ninininniniphininininininnin446 in7$hninni(FeiIRpninREtnin,ninicn4436rninehlsn45T<Linininini,5ini0A1,O ininin*-nininin=ninininininini4tminivinNu1)t4,l2.>ini4504 nininiWX,IY)=LETR(1,10),$ininnScmo/sninini-tTnin*-n! HEmLFOninehlinKntSo"=n2PcdShl1)SORninin41.IXinpeininininicf TO ninininnininniin-20A1,O T,nininniin-20A1,O T,nininniin-20A1niin-)Q(m T45nRu1)t4(1X,2ninn-2 t-nin0tUBROUTINE STAR79 c include 'tcommon.for' %include tcommon.for character iiiii,idup t-nin0character*8 NAMEX,PASSX,IDEMO,moldnm,noldnm t-nin0datA POINT/0./ data IDEMO/'master '/,NAMEX/'t-nin0 '/,PASSX/'t-nin0 '/ CALL QTIME(IZZ) t-nin0J=10 t-nin0J=MOD(IZZ,J) t-nin0J=J*10 t-nin0J=MOD(IZZ,J) t-nin0DO 78888 I=1,J t-nin0IIIIII=RAN(IZZ) 78888 CONTINUE C-nin0...SET USER LIMITS 5666 WRITE(*,1) 1-nin0format(/nin0 ' At any point in the game where information is requ4592 t-nin1ired,'/'tyou may request a short explanation by typing "7777".'/'t4593 t-nin1good luck!tyou''ll need it.') 5655 WRITE(*,77702) 77702 FORMAT(' Enter your last name: ') read(*,676,end=9680)namex cnin0 read(*,676)namex nin0 write(*,77703) 777030format(' enter your password: ') nin0 read(*,676,end=9680)passx nin0 iikk=1 nin0 moldnm=iyes 81818 likk=iikk nin0 read(3,rec=likk,err=5666)mname,points,mpass,x6,x7,irst nin0 if(namex.eq.mname.and.passx.eq.mpass)go to 71717 nin0 if(moldnm.eq.mname)go to 9776 nin0 moldnm=mname iikk=iikk+1 nin0 go to 81818 71717 mmkey=iikk nin0 if(irst.eq.1)call rstart(1) nin0 if(irst.eq.1)return nin0 write(*,77777) 777770format(' Dotyou want to change your password (y or n)? ') nin0 read(*,6,ERR=5666,END=9680)IIIII t-nin0IF(IIIII.NE.'Y')GO TO 5654 t-nin0WRITE(*,77888) 77888 FORMAT(' Enter new password: ') nin0 READ(*,676,END=9680)PASSX t-nin0IF(PASSX.EQ.'shazam'.AND.MNAME.EQ.'master')GO TO 77779 t-nin0IF(MNAME.EQ.IDEMO)GO TO 5654 t-nin0MPASS=PASSX 5654n0WRITE(3,REC=MMKEY)MNAME,POINTS,MPASS,X6,X7,irst nin0 GO TO 77714 777790WRITE(3,REC=MMKEY)MNAME,POINTS,MPASS,X6,X7,irst 65656 WRITE(*,77780) 77780 FORMAT(' Dotyou want to add a name to the file (Y or N)? ') nin0 READ(*,6,ERR=5666,END=9680)IIIII t-nin0IF(IIIII.NE.'Y'.or.iiiii.ne.'y')GO TO 77789 t-nin0WRITE(*,77781) 77781 FORMAT(' Enter the last name: ') nin0 READ(*,676,END=9680)NAMEX 676 FORMAT(A8) nin0 WRITE(*,77783) 77783 FORMAT(' Enter the password: ') nin0 READ(*,676,END=9680)PASSX t-nin0IIKK=1 nin0 MOLDNM=IYES 77784 READ(3,REC=IIKK,ERR=5666)MNAME,POINTS,MPASS,X6,X7 t-nin0IF(MNAME.EQ.MOLDNM)GO TO 77785 nin0 MOLDNM=MNAME nin0 GO TO 77784 777850WRITE(3,REC=IIKK)NAMEX,POINT,PASSX,X6,X7,irst nin0 WRITE(*,77786)NAMEX,PASSX 77786 FORMAT(' Inductee ',A8,' has been added. password = ',a8) nin0 IIKK=IIKK+1 nin0 WRITE(3,REC=IIKK)NAMEX,POINT,MPASS,X6,X7,irst nin0 GO TO 65656 777890WRITE(*,77790) 77790 FORMAT(' Dotyou want to display a name on the file (Y or N)? ') nin0 READ(*,6,ERR=5666,END=9680)IIIII t-nin0IF(IIIII.NE.'Y'.or.iiiii.ne.'y')GO TO 88889 t-nin0WRITE(*,77791) 77791 FORMAT(' Enter the last name: ') nin0 READ(*,676,END=9680)NAMEX t-nin0IIKK=1 nin0 MOLDNM=IYES nin0 NOLDNM=NAMEX 77794 READ(3,REC=IIKK,ERR=5666)NAMEX,X,PASSX,X6,X7 t-nin0IF(NAMEX.EQ.NOLDNM)GO TO 77795 nin0 IF(NAMEX.EQ.MOLDNM)GO TO 77798 nin0 MOLDNM=NAMEX t-nin0GO TO 77794 777950WRITE(3,REC=IIKK)NAMEX,X,PASSX,X6,X7,irst nin0 WRITE(*,77796)namex,passx 777960format(1x,a8,' is on the file. password = ',a8) nin0 GO TO 77789 77798 WRITE(*,77797)NOLDNM 777970format(1x,a8,' is not on the file.') nin0 go to 77789 88889 write(*,77740) 777400format(' dotyou want to add a holiday (Y or N)? ') nin0 READ(*,6,ERR=5666,END=9680)IIIII t-nin0IF(IIIII.NE.'Y'.or.iiiii.ne.'y')GO TO 77714 nin0 WRITE(*,77741) 77741 FORMAT(' Enter the next two holidays[I]: ') nin0 READ(*,*,END=9680)NHOL1,NHOL2 t-nin READ(3,REC=1,ERR=5666)X1,X2,X3,X4,X5,X6,X7 t-nin0WRITE(3,REC=1)X1,X2,X3,X4,X5,NHOL1,NHOL2 77714 READ(3,REC=MMKEY,ERR=5666)MNAME,POINTS,MPASS,X6,X7,irst nin0 WRITE(3,REC=MMKEY)MNAME,POINTS,MPASS,X6,X7,irst nin0 IOK=0 t-nin0CALL QTIME(NTIME) nin0 CALL QDATE(NDATE) nin0 IYR=NDATE/1000 t-nin0IDAY=NDATE-IYR*1000 t-nin0ISTYR=77 t-nin0IDIFF=IYR-ISTYR t-nin0ISEVEN=7 t-nin0ITOT=IDIFF/4 nin0 ITOT=ITOT+IDIFF+IDAY-1 nin0 ITOT=MOD(ITOT,ISEVEN) nin0 ITOT=ITOT+1 nin0 IF(ITOT.EQ.1.OR.ITOT.EQ.2)GO TO 44400 t-nin0IF(ITOT.EQ.7.AND.NTIME.GE.54000)GO TO 44400 t-nin0READ(3,REC=1,ERR=5666)X1,X2,X3,X4,X5,NHOL1,NHOL2 t-nin IF(NDATE.EQ.NHOL1.OR.NDATE.EQ.NHOL2)GO TO 44400 t-nin0IF(NTIME.GE.28800.AND.NTIME.LT.42300)GO TO 5678 nin0 IF(NTIME.GE.46800.AND.NTIME.LT.61200)GO TO 5678 nin0 GO TO 44401 44400 IOK=1 44401 WRITE(*,677) 677 FORMAT(' Dotyou want this game rated (Y or N)? ') nin0 READ(*,6,END=9680)IDUP 6in0 FORMAT(A1) nin0 IF(IDUP.NE.NHELPS)GO TO 779 t-nin0CALL HELP(59) nin0 GO TO 5654 7790 IF(IDUP.NE.'Y')GO TO 5678 nin0 NRW=1 nin0 WRITE(9,rec=1)MNAME,POINTS,MPASS,MMKEY t-nin0IF(POINTS.NE.0.)GO TO 778 nin0 IRANK=1 nin0 GO TO 769 C-nin0...PRINT CURRENT STATUS OF PLAYER. 778in0DO 772 I=1,NRANKS nin0 IF(RANKPT(I)-POINTS)772,771,773 7710 IRANK=I t-nin0GO TO 769 7730 IRANK=I-1 nin0 GO TO 769 772in0CONTINUE nin0 IRANK=NRANKS 7690 XNEED=RANKPT(IRANK+1)-POINTS 7680 WRITE(*,668)RANKS(1,IRANK),RANKS(2,IRANK),MNAME 6680 FORMAT(' Welcome on board the Enterprise, ',2A8,2X,A8/nin0 ' you 4728 nin0 1have the con!') nin0 IF(IRANK.EQ.NRANKS)GO TO 5678 nin0 WRITE(*,675)XNEED,RANKS(1,IRANK+1),RANKS(2,IRANK+1) 6750 FORMAT(' You need ',f5.2,' points to reach the rank of ',2A8) 5678inIF(NRW.EQ.0)WRITE(9,rec=1)MNAME,POINTS,MPASS,NRW nin0 WRITE(*,5656) 5656 FORMAT(' Enter game level desired.[1/3] ') nin0 READ(*,*,ERR=800,END=9680)LEVEL nin0 IF(LEVEL.EQ.XHELP)GO TO 800 t-nin0IF(LEVEL.LE.0.OR.LEVEL.GT.3)GO TO 800 11111 WRITE(*,5657) 5657 FORMAT(' Enter galactic dimensions.[2/10] ') nin0 READ(*,*,ERR=801,END=9680)NQUAD nin0 IF(NQUAD.EQ.XHELP)GO TO 801 nin0 IF(NQUAD.LT.2.OR.NQUAD.GT.10)GO TO 801 nin0 MMAX=NQUAD*NQUAD*2-2 t-nin NMAX=400/(NQUAD*NQUAD) nin0 IF(LEVEL-2)200,300,400 2000 MAXKQ=3 t-nin MAXRQ=3 MAXBQ=1 nin0 MINK=3 t-nin MINR=3 t-nin ICLOAK=0 t-nin0PHOLE=0. t-nin0SNOVAP=0. t-nin0GO TO 500 300 iCLOAK=0 t-nin0PHOLE=0. t-nin0SNOVAP=0. t-nin0GO TO 500 400 ICLOAK=1 5000 WRITE(*,77704) 77704 FORMAT(' Mimimum enemy vessels?[I] ') nin0 READ(*,*,ERR=50,END=9680)MTOT t-nin0IF(MTOT.EQ.XHELP)GO TO 50 t-nin0IF(MTOT.GT.MMAX)MTOT=MMAX t-nin NTOT=MIN0(MTOT,MMAX) t-nin NTOT=MAX0(NTOT,MINK+MINR) t-nin NTOT=NTOT+SIGN(.15*RAN(IZZ)*NTOT,.5-RAN(IZZ)) t-nin NTOT=MIN0(NTOT,MMAX) t-nin NTOT=MAX0(NTOT,MINK+MINR) t-nin IF(NTOT.LT.MTOT)NTOT=MTOT t-nin0NKL=NTOT*RAN(IZZ) t-nin IF(NKL.LE.0)NKL=1 nin0 IF(NKL.GT.MAXK)NKL=MAXK t-nin0IF(MROM.LE.MAXR)GO TO 82829 t-nin0MROM=MAXR t-nin0NKL=NTOT-MROM 828290MROM=NTOT-NKL t-nin0NDIFF=MROM-NKL t-nin0IF(NDIFF.LT.0)GO TO 82828 nin0 IF(NDIFF.LE.25)GO TO 55 nin0 NDIFF=NDIFF/2 t-nin NKL=NKL+NDIFF t-nin0MROM=MROM-NDIFF t-nin0GO TO 82829 82828 NDIFF=NKL-MROM nin0 IF(NDIFF.LE.25)GO TO 55 nin0 NDIFF=NDIFF/2 t-nin NKL=NKL-NDIFF t-nin0MROM=MROM+NDIFF t-nin0GO TO 82829 55 WRITE(*,5) 5in0 FORMAT(' Enter game speed 1 (fast) to 50 (slow) ') nin0 READ(*,*,END=9680)ITFCTR t-nin0IF(ITFCTR.LE.0)ITFCTR=1 nin0 IF(ITFCTR.GT.50)ITFCTR=50 t-nin0WRITE(*,7)ITFCTR 7in0 FORMAT(' Timing Factor = ',I3) t-nin NS=RAN(IZZ)*99.+1. C-nin0...DETERMINE SETUP FOR THIS GAME nin0 SDATE=RAN(IZZ)*5000.+500. t-nin0XTIME=NKL*XKTIME+MROM*RTIME t-nin0XTIME=XTIME+SQRT(XTIME)*RAN(IZZ) C-nin0...REUSE XKTIME AND RTIME. t-nin0XKTIME=.2 t-nin RTIME=XTIME/NTOT t-nin0FDATE=SDATE+XTIME t-nin0NBASES= SQRT(2.*FLOAT(NTOT))/NMAX+1. t-nin0LEFTK=NKL t-nin0LEFTR=MROM C-nin0...OUTPUT STARTING0CONDITIONS nin0 CALL CPAGE t-nin0WRITE(*,3)SDATE,NS,NKL,MROM,NTOT,XTIME,FDATE 3-nin0format(' Space, the Final Frontier.'/nin0 ' This is a Voyage of t4813 t-nin1he Starship "Enterprise".'/nin0 ' its five year mission, to explo4814 t-nin1re strange new worlds,'/nin0 ' to seek out new life and new civil4815 nin0 1izations,'/nin0 ' to boldly go where no man has gone before! 't-n4816 nin0 1//nin0 ' t-nin0 S T A R T R E K'/nin0 ' t-nin0 4817 t-nin10 August 1984 Joseph V. DiMeo Consulting n0 '/nin0 '-----------4818 t-nin1-------------------------------------------------'/nin0 ' Order4819 t-nin1s: Stardate ',F7.2,' Starfleet Command (TOP SECRET)'//nin0 ' co4820 t-nin1mmunications with sector ',i2,' of the galaxy were suddenly'/nin0 4821 nin0 1 ' cut off a few stardays ago. The last report from that area'/nin4822 t-nin10 ' was that a fleet of ',i3,' Klingons and ' ,i3,' Romulans had'4823 t-nin1/nin0 ' invaded and destroyed every federation ship in the area.'4824 t-nin1/nin0 ' your mission, as the pride of the federation starfleet,'/4825 nin0 1nin0 ' is to destroy the entire enemy force (',i3,' vessels).'/ni4826 nin0 1n0 ' you have only ',f6.2,' stardays to accomplish your task, as 4827 t-nin1The'/nin0 ' federation president''s reelection campaign begins on4828 nin0 1 stardate'/nin0 f8.2,' and, as you well know, his opponent propos4829 t-nin1es appropriations'/nin0 ' cutbacks for the space academy and elim4830 t-nin1ination of the '/nin0 ' traditional vulcan bowl game.') C-nin0...SET UP GALACTIC MAP(JGAL). C-nin0...IGAL SET INITIALLY TO ALL -1S pause ' Pressn Return to continue ' call cpage 99 continue DO 1000 J=1,NQUAD nin0 DO 1000 I=1,NQUAD nin0 IGAL(I,J)=-1 nin0 JGAL(I,J)=RAN(IZZ)*MAXSQ C-nin0...PUT IN BLACK HOLES AND WHERE THEY0GO TO. t-nin0IBL(I,J)=0 t-nin0IF(RAN(IZZ).GT.PHOLE)GO TO 100 95 CONTINUE Q=RAN(IZZ) ICE=RAN(IZZ)*NQUAD+1. t-nin0JCE=RAN(IZZ)*NQUAD+1. t-nin0IF(ICE.EQ.I.AND.JCE.EQ.J)GO TO 95 nin0 IBL(I,J)=ICE*100+JCE 1000 CONTINUE C-nin0...PUT THINGS IN QUADRANTS nin0 CALL PLIN(NBASES,MAXBQ*10,10) nin0 CALL PLIN(NKL,MAXKQ*100,100) nin0 CALL PLIN(MROM,MAXRQ*1000,1000) C-nin0...ENTERPRISE IN UNOCCUPIED QUADRANT nin0 MMAX=9999 t-nin0DO 110 I=1,NQUAD nin0 DO 110 J=1,NQUAD nin0 IF(JGAL(I,J).GE.MMAX)GO TO 110 t-nin0MMAX=JGAL(I,J) t-nin ICE=I t-nin0JCE=J t-nin0IF(MMAX.LE.99)GO TO 111 1100 CONTINUE t-nin0GO TO 99 111 CONTINUE t-nin0JCPS=0 C-nin0...SETUP E t-nin0ENERGY=SENRGY nin0 DO 9944 I=2,20 t-nin ITRMEN(I)=0 t-nin0ICNTL(I)=0 9944 0CONTINUE nin0 ITRMEN(1)=IFGHTM nin0 MEN=NMEN nin0 ITORP=NTRP t-nin0ISTSH=0 t-nin0ISHD=0 C-nin0...ZERO DAMAGE ARRAY nin0 DO 9950 I=1,10 t-nin0IF(I.EQ.10)GO TO 995 nin0 IFNDS(I)=0 995in0IDMG(I)=0 t-nin0IX=RAN(IZZ)*10.+1. nin0 IY=RAN(IZZ)*10.+1. nin0 XQE=IX t-nin YQE=IY nin0 DEFL=0. C-nin0...START WITH SHORT RANGE SCAN nin0 IDOCK=0 t-nin0PNRGY=0. t-nin0IHWARP=0 t-nin0DDEG=0. t-nin0PDEG=0. t-nin0DSP=0. t-nin0PSP=0. t-nin0ITRUCE=0 t-nin ITRSTP=0 t-nin0ITFIRE=0 t-nin IHERE=0 t-nin0CALL SCAN C-nin0...START TIMER. NTSTPS=TOTAL NO OF STEPS TO DATE t-nin NTSTPS=0 t-nin0DVWP0=DVWP t-nin0EWRP0=EWRP t-nin0DISTP0=DISTPE t-nin0ETVEL0=ETVEL nin0 IETOF0=IETOFT nin0 DISTG0=DISTGT nin0 CODDS0=CODDS t-nin0EODDS0=EODDS t-nin0IDAMR0=IDAMRP t-nin0SHLDF0=SHLDF t-nin0TRNRG0=TRNRGY nin0 PJAM0=PJAM nin0 RETURN 8000 CALL HELP(56) nin0 GO TO 5678 8010 CALL HELP(57) nin0 GO TO 11111 50nin0CALL HELP(58) nin0 GO TO 500 9776n0WRITE(*,9777) 9777 FORMAT(' SORRY, BUT YOU ARE NOT AUTHORIZED TO USE THIS PROGRAM.') 4919 9680 close (3) close (9) STOP t-nin0END ]pI TO 82829 82828 NDIFF=NKL-MROM nin0 IF(NDIFF.LE.25)GO TO 55 96