home *** CD-ROM | disk | FTP | other *** search
/ ftp.update.uu.se / ftp.update.uu.se.2014.03.zip / ftp.update.uu.se / pub / rainbow / msdos / decus / RB117 / vehicle.for < prev    next >
Text File  |  1995-05-28  |  14KB  |  593 lines
  1. C
  2. C         VEHICLE MAINTENANCE PRGM        by Bruce W. Roeckel
  3. C       *--------------------------*                         
  4. C
  5. $STORAGE:2
  6. C
  7.       COMMON/MONTHS/ IMON
  8.       CHARACTER*4 IMON(13)
  9. C
  10.       COMMON /REVNO/ PGM,AUTHOR,YEAR,DATE,REV
  11.       CHARACTER PGM*21,AUTHOR*21,YEAR*4,DATE*8,REV*2
  12. C
  13.       CHARACTER OPTION*25,TEST*8,SEL*1
  14.       LOGICAL*2 CHECK
  15. C
  16.       IMON(1)='    '
  17.       IMON(2)='Jan '
  18.       IMON(3)='Feb '
  19.       IMON(4)='Mar '
  20.       IMON(5)='Apr '
  21.       IMON(6)='May '
  22.       IMON(7)='June'
  23.       IMON(8)='July'
  24.       IMON(9)='Aug '
  25.       IMON(10)='Sept'
  26.       IMON(11)='Oct '
  27.       IMON(12)='Nov '
  28.       IMON(13)='Dec '
  29. C
  30. C           DISPLAY ROCKSOFT HEADER
  31. C
  32.       PGM='Vehicle Records '
  33.       AUTHOR='Bruce W. Roeckel'
  34.       YEAR='1986'
  35.       REV='11'
  36.       CALL MHEAD(PGM,AUTHOR,YEAR,REV,DATE)
  37.       CALL TOP(PGM,DATE)
  38. C
  39. C           READ DATABASE INTO CORE
  40. C
  41.       CALL RDMAST
  42. C
  43. C           CHECK FOR HELP FILE
  44. C
  45.       IHLP=0
  46.       INQUIRE(FILE='VEHICLE.HLP',EXIST=CHECK)
  47.       IF(CHECK .EQV. .TRUE.) THEN
  48.          IHLP=1
  49.          OPEN(UNIT=15,FILE='VEHICLE.HLP')
  50.       ENDIF
  51. C
  52. C           NOW DISPLAY MAIN MENU
  53. C
  54.   100 CONTINUE
  55.       OPTION='Main Menu'
  56.       CALL HEADER(OPTION)
  57.       CALL MOVEIT(1,5)
  58.       WRITE(*,200) 
  59.   200 FORMAT(//,
  60.      A       /,15X,'1. Update Master File ....... Buy/Sell a Vehicle',
  61.      B       /,15X,'                              Edit Vehicle Data ',
  62.      C      //,15X,'2. Update Repair Log ........ Std. Maintenance  ',
  63.      D       /,15X,'                              Special Repairs   ',
  64.      E      //,15X,'3. Update Mileage Data ...... Around Town       ',
  65.      F       /,15X,'                              Trip Mileage      ',
  66.      G      //,15X,'4. Select Vehicle Reports ... Repair Summary    ',
  67.      H       /,15X,'                              Mileage Summary   ',
  68.      I       /,15X,'                              Graph"s           ')
  69. C
  70. C            ASK FOR SELECTION
  71. C
  72.   300 CONTINUE
  73.       CALL MOVEIT(1,23)
  74.       CALL BOLD
  75.       WRITE(*,'(5X,A33,\)') 'Enter Choice (H=Help,Q=Quit) : '
  76.       READ(*,'(A1)',ERR=300) SEL 
  77.       CALL OFF
  78. C
  79. C            BRANCH BASED ON INPUT 
  80. C
  81.          IF (SEL.EQ.' ') THEN
  82.             CALL BELL
  83.             GOTO 300
  84.          ELSEIF (SEL.EQ.'H' .OR. SEL.EQ.'h') THEN
  85.             SEL=' '
  86.             IUNIT=15
  87.             CALL HELP(SEL,IUNIT)
  88.             GOTO 100
  89.          ELSEIF (SEL.EQ.'Q' .OR. SEL.EQ.'q') THEN
  90.             IF(IHLP.EQ.1) CLOSE(15)
  91.             CALL WRMAST
  92.             CALL CLS
  93.             STOP
  94.          ELSEIF (SEL.EQ.'1') THEN
  95.             CALL MASTER
  96.          ELSEIF (SEL.EQ.'2') THEN
  97.             CALL REPAIR
  98.          ELSEIF (SEL.EQ.'3') THEN
  99.             CALL MILES
  100.          ELSEIF (SEL.EQ.'4') THEN
  101.             CALL REPORT
  102.          ELSE
  103.             CALL BELL
  104.             GOTO 300
  105.          ENDIF
  106.       GOTO 100
  107.       END
  108. C
  109. C
  110. C
  111.       SUBROUTINE LISTEM(TYPE,SEL)
  112. C
  113. C
  114. C          IF TYPE=0, LIST ALL VEHICLES
  115. C          IF TYPE=1, LIST ONLY OWNED VEHICLES (NOT SOLD)
  116. C
  117. C
  118.       COMMON/MAIN1/ NAME,IDNUM,DATE,RFILE,MFILE
  119.       CHARACTER NAME(25)*20,IDNUM(25)*20,DATE(2,25)*8
  120.       CHARACTER RFILE(25)*11,MFILE(25)*11
  121. C
  122.       COMMON/MAIN2/ COST,ODOM,VNUM
  123.       INTEGER VNUM
  124.       REAL COST(2,25),ODOM(2,25)
  125. C
  126.       INTEGER TYPE,SEL,PICK(25)
  127. C
  128.       IV=6
  129.       IH=1
  130.       CALL UPTOP (IH,IV)
  131. C
  132. C            SET UP STARTING POINTERS
  133. C
  134.       IV=9
  135.       IH=3
  136.       IF (VNUM.LE.20) IH=15
  137.       IF (VNUM.LE.10) IH=30
  138.       ICNT=0
  139.          CALL BOLD
  140.          WRITE(*,'(//,25X,A17)') 'Vehicles on file:'
  141.          CALL OFF
  142. C
  143. C            NOW LIST ALL VEHICLES
  144. C
  145.       DO 80 K=1,25
  146.       PICK(K)=0
  147.    80 CONTINUE
  148.       DO 300 I=1,VNUM,10
  149.          DO 200 J=I,I+9
  150.          IF(J.GT.VNUM) GOTO 200
  151.          IF((TYPE.EQ.1) .AND. (DATE(2,J).NE.' ')) GOTO 200
  152.             IV=IV+1
  153.             ICNT=ICNT+1
  154.             PICK(J)=1
  155.             CALL UPTOP(IH,IV)
  156.             WRITE(*,100) J,NAME(J)
  157.   100       FORMAT(1X,I2,'-',A20)
  158.             IF(ICNT.GE.10) THEN
  159.                IH=IH+25
  160.                IV=9
  161.                ICNT=0
  162.             ENDIF
  163.   200    CONTINUE
  164.   300 CONTINUE
  165.   350 CONTINUE
  166.       IH=1
  167.       IV=23
  168.       CALL MOVEIT(IH,IV)
  169.       CALL BOLD
  170.       WRITE(*,400)
  171.   400 FORMAT(8X,'Please Select Vehicle #  [ ]',\)
  172.       CALL OFF
  173.       INUM=3
  174.       CALL CURLT(INUM)
  175.          READ(*,'(I1)',ERR=500) SEL
  176.          IF(SEL.EQ.0) RETURN
  177.          IF((SEL.GT.VNUM) .OR. (PICK(SEL).NE.1)) GOTO 500
  178.          RETURN
  179.   500 CONTINUE
  180.       CALL BELL
  181.       GOTO 350
  182.       END
  183. C
  184. C
  185. C
  186.       SUBROUTINE RDMAST
  187. C
  188.       COMMON/MAIN1/ NAME,IDNUM,DATE,RFILE,MFILE
  189.       CHARACTER NAME(25)*20,IDNUM(25)*20,DATE(2,25)*8
  190.       CHARACTER RFILE(25)*11,MFILE(25)*11
  191. C
  192.       COMMON/MAIN2/ COST,ODOM,VNUM
  193.       INTEGER VNUM
  194.       REAL COST(2,25),ODOM(2,25)
  195. C
  196.       CHARACTER*25 OPTION
  197. C
  198.       OPTION='Loading Vehicle Desc.'
  199.       CALL HEADER(OPTION)
  200.       CALL KEYOFF
  201. C
  202. C            OPEN FILE FOR INPUT
  203. C
  204.       OPEN(20,FILE='VEHICLE.MAS')
  205. C
  206. C            READ ALL DATA FROM MASTER LOOKUP FILE
  207. C
  208.       I=0
  209.   100 CONTINUE
  210.       I=I+1
  211.       IF(I.GT.25) THEN
  212.          CALL BELL
  213.          WRITE(*,'(A33)') 'Program Aborted Reading Master   '
  214.          STOP
  215.       ENDIF
  216.       READ(20,200,END=300) NAME(I),IDNUM(I),DATE(1,I),COST(1,I),
  217.      A    ODOM(1,I),DATE(2,I),COST(2,I),ODOM(2,I),RFILE(I),MFILE(I)
  218.   200 FORMAT(A20,A20,A8,F9.2,F8.1,A8,F9.2,F8.1,A11,A11)
  219.       GOTO 100
  220.   300 CONTINUE
  221.       VNUM=I-1
  222.       CLOSE(20)
  223.       CALL KEYON
  224.       RETURN
  225.       END
  226. C
  227. C
  228. C
  229.       SUBROUTINE WRMAST
  230. C
  231.       COMMON/MAIN1/ NAME,IDNUM,DATE,RFILE,MFILE
  232.       CHARACTER NAME(25)*20,IDNUM(25)*20,DATE(2,25)*8
  233.       CHARACTER RFILE(25)*11,MFILE(25)*11
  234. C
  235.       COMMON/MAIN2/ COST,ODOM,VNUM
  236.       INTEGER VNUM
  237.       REAL COST(2,25),ODOM(2,25)
  238. C
  239.       CHARACTER*25 OPTION
  240. C
  241.       OPTION='Storing Vehicle Desc.'
  242.       CALL HEADER(OPTION)
  243.       CALL KEYOFF
  244. C
  245. C            OPEN FILE FOR OUTPUT
  246. C
  247.       OPEN(20,FILE='VEHICLE.MAS')
  248. C
  249. C            WRITE ALL DATA TO MASTER LOOKUP FILE
  250. C
  251.       DO 300 I=1,VNUM
  252.       WRITE(20,200) NAME(I),IDNUM(I),DATE(1,I),COST(1,I),
  253.      A    ODOM(1,I),DATE(2,I),COST(2,I),ODOM(2,I),RFILE(I),MFILE(I)
  254.   200 FORMAT(A20,A20,A8,F9.2,F8.1,A8,F9.2,F8.1,A11,A11)
  255.   300 CONTINUE
  256.       ENDFILE 20
  257.       CLOSE(20)
  258.       CALL KEYON
  259.       RETURN
  260.       END
  261. C
  262. C
  263. C
  264.       SUBROUTINE RDREPS(SEL)
  265. C
  266. C         READ INDIVIDUAL REPAIR DATA
  267. C
  268.       COMMON/MAIN1/ NAME,IDNUM,DATE,RFILE,MFILE
  269.       CHARACTER NAME(25)*20,IDNUM(25)*20,DATE(2,25)*8
  270.       CHARACTER RFILE(25)*11,MFILE(25)*11
  271. C
  272.       COMMON/MAIN2/ COST,ODOM,VNUM
  273.       INTEGER VNUM
  274.       REAL COST(2,25),ODOM(2,25)
  275. C
  276.       COMMON/REPAR1/ RDESC,RDATE
  277.       CHARACTER RDESC(500)*25,RDATE(500)*8
  278. C
  279.       COMMON/REPAR2/ RCODE,RCOST,RODOM,RNUM
  280.       INTEGER RCODE(500),RNUM
  281.       REAL RCOST(500),RODOM(500)
  282. C
  283.       CHARACTER TDESC*25,TDATE*8,OPTION*25
  284.       INTEGER TCODE,KEEP
  285.       REAL TCOST,TODOM,MIN
  286. C
  287.       LOGICAL*2 CHECK
  288.       INTEGER SEL  
  289. C
  290. C            LOAD IN THE REPAIR DATA
  291. C
  292.       RNUM=0
  293.       IF(SEL.GT.VNUM) GOTO 500
  294.       IF(RFILE(SEL).EQ.'           ') GOTO 500
  295. C
  296. C            MAKE SURE THE AUTO FILE EXISTS
  297. C
  298.       INQUIRE(FILE=RFILE(SEL),EXIST=CHECK)
  299.       IF(CHECK.EQV..FALSE.) GOTO 500
  300. C
  301. C            OPEN FILE, GRAB ALL DATA
  302. C
  303. C
  304.       OPTION='Loading Repair Data .....'
  305.       CALL HEADER(OPTION)
  306.       CALL KEYOFF
  307.       OPEN(20,FILE=RFILE(SEL))
  308.          K=0
  309.   100    CONTINUE
  310.          K=K+1
  311.          IF(K.GT.500) THEN
  312.             CALL BELL
  313.             WRITE(*,'(A33)') 'Program Aborted Reading Repairs  '
  314.             STOP
  315.          ENDIF
  316.          READ(20,200,END=300) RCODE(K),RDESC(K),RDATE(K),
  317.      A                        RCOST(K),RODOM(K)
  318.   200    FORMAT(I3,A25,A8,F9.2,F8.1)
  319.          GOTO 100
  320.   300    CONTINUE
  321.          RNUM=K-1
  322.          CLOSE(20)
  323.          CALL KEYON
  324. C
  325. C         NOW SORT THE DATA
  326. C
  327.       K=0
  328.   400 MIN=999999.9
  329.       K=K+1
  330.       IF(K.GE.RNUM) GOTO 500
  331.       DO 450 I=K,RNUM
  332.       IF(RODOM(I).LT.MIN) THEN
  333.          MIN=RODOM(I)
  334.          KEEP=I
  335.       ENDIF
  336.   450 CONTINUE
  337.       TCODE=RCODE(K)
  338.       TDESC=RDESC(K)
  339.       TDATE=RDATE(K)
  340.       TCOST=RCOST(K)
  341.       TODOM=RODOM(K)
  342.          RCODE(K)=RCODE(KEEP)
  343.          RDESC(K)=RDESC(KEEP)
  344.          RDATE(K)=RDATE(KEEP)
  345.          RCOST(K)=RCOST(KEEP)
  346.          RODOM(K)=RODOM(KEEP)
  347.             RCODE(KEEP)=TCODE
  348.             RDESC(KEEP)=TDESC
  349.             RDATE(KEEP)=TDATE
  350.             RCOST(KEEP)=TCOST
  351.             RODOM(KEEP)=TODOM
  352.       GOTO 400
  353.   500 CONTINUE
  354.       RETURN
  355.       END
  356. C
  357. C
  358. C
  359.       SUBROUTINE WRREPS(SEL)
  360. C
  361. C        WRITE INDIVIDUAL REPAIR DATA
  362. C
  363.       COMMON/MAIN1/ NAME,IDNUM,DATE,RFILE,MFILE
  364.       CHARACTER NAME(25)*20,IDNUM(25)*20,DATE(2,25)*8
  365.       CHARACTER RFILE(25)*11,MFILE(25)*11
  366. C
  367.       COMMON/MAIN2/ COST,ODOM,VNUM
  368.       INTEGER VNUM
  369.       REAL COST(2,25),ODOM(2,25)
  370. C
  371.       COMMON/REPAR1/ RDESC,RDATE
  372.       CHARACTER RDESC(500)*25,RDATE(500)*8
  373. C
  374.       COMMON/REPAR2/ RCODE,RCOST,RODOM,RNUM
  375.       INTEGER RCODE(500),RNUM
  376.       REAL RCOST(500),RODOM(500)
  377. C
  378.       CHARACTER*25 OPTION
  379.       LOGICAL*2 CHECK
  380.       INTEGER SEL
  381. C
  382. C            IF FILE DOES NOT EXIST, BUT DATA DOES, THEN CREATE
  383. C
  384.       IF(SEL.GT.VNUM) GOTO 500
  385.       IF(RFILE(SEL).EQ.'           ') GOTO 500
  386. C
  387. C         FIGURE OUT IF FILE SHOULD BE CREATED
  388. C
  389.       INQUIRE(FILE=RFILE(SEL),EXIST=CHECK)
  390.       IF((CHECK.EQV..FALSE.) .AND. (RNUM.GT.0)) THEN
  391.          OPEN(20,FILE=RFILE(SEL),STATUS='NEW')
  392.       ELSEIF(CHECK.EQV..FALSE.) THEN
  393.          GOTO 500
  394.       ELSEIF(CHECK.EQV..TRUE.) THEN
  395.          OPEN(20,FILE=RFILE(SEL))
  396.       ENDIF
  397. C
  398. C          WRITE ALL DATA TO FILE
  399. C
  400.       OPTION='Storing Repair Data .....'
  401.       CALL HEADER(OPTION)
  402.       CALL KEYOFF
  403.          DO 300 K=1,RNUM
  404.          WRITE(20,200) RCODE(K),RDESC(K),RDATE(K),
  405.      A                 RCOST(K),RODOM(K)
  406.   200    FORMAT(I3,A25,A8,F9.2,F8.1)
  407.   300    CONTINUE
  408.          ENDFILE 20
  409.          CLOSE(20,STATUS='KEEP')
  410.          CALL KEYON
  411.   500 CONTINUE
  412.       RETURN
  413.       END
  414. C
  415. C
  416. C
  417.       SUBROUTINE RDMILE(SEL)
  418. C
  419. C         READ MILEAGE DATA
  420. C
  421.       COMMON/MAIN1/ NAME,IDNUM,DATE,RFILE,MFILE
  422.       CHARACTER NAME(25)*20,IDNUM(25)*20,DATE(2,25)*8
  423.       CHARACTER RFILE(25)*11,MFILE(25)*11
  424. C
  425.       COMMON/MAIN2/ COST,ODOM,VNUM
  426.       INTEGER VNUM
  427.       REAL COST(2,25),ODOM(2,25)
  428. C
  429.       COMMON/MILE1/ MDESC,MDATE
  430.       CHARACTER MDESC(500)*25,MDATE(500)*8
  431. C
  432.       COMMON/MILE2/ MCODE,MCOST,MODOM,MNUM
  433.       INTEGER MCODE(500),MNUM
  434.       REAL MCOST(500),MODOM(500)
  435. C
  436.       CHARACTER TDESC*25,TDATE*8,OPTION*25
  437.       INTEGER TCODE,KEEP
  438.       REAL TCOST,TODOM,MIN
  439. C
  440.       INTEGER SEL
  441.       LOGICAL*2 CHECK
  442. C
  443. C            LOAD IN THE MILEAGE DATA
  444. C
  445.       MNUM=0
  446.       IF(SEL.GT.VNUM) GOTO 500
  447.       IF(MFILE(SEL).EQ.'           ') GOTO 500
  448. C
  449. C            CHECK IF AUTO FILE EXISTS
  450. C
  451.       INQUIRE(FILE=MFILE(SEL),EXIST=CHECK)
  452.       IF(CHECK.EQV..FALSE.) GOTO 500
  453. C
  454. C             EXISTS, SO READ IN DATA
  455. C
  456.       OPTION='Loading Mileage Data ....'
  457.       CALL HEADER(OPTION)
  458.       CALL KEYOFF
  459.       OPEN(20,FILE=MFILE(SEL))
  460.          K=0
  461.   100    CONTINUE
  462.          K=K+1
  463.          IF(K.GT.500) THEN
  464.             CALL BELL
  465.             WRITE(*,'(A33)') 'Program Aborted Reading Mileage  '
  466.             STOP
  467.          ENDIF
  468.          READ(20,200,END=300) MCODE(K),MDESC(K),MDATE(K),MCOST(K),
  469.      A                        MODOM(K)
  470.   200    FORMAT(I3,A25,A8,F9.2,F8.1)
  471.          GOTO 100
  472.   300    CONTINUE
  473.          MNUM=K-1
  474.          CLOSE(20)
  475.          CALL KEYON
  476. C
  477. C         NOW SORT THE DATA
  478. C
  479.       K=0
  480.   400 MIN=999999.9
  481.       K=K+1
  482.       IF(K.GE.MNUM) GOTO 500
  483.       DO 450 I=K,MNUM
  484.       IF(MODOM(I).LT.MIN) THEN
  485.          MIN=MODOM(I)
  486.          KEEP=I
  487.       ENDIF
  488.   450 CONTINUE
  489.       TCODE=MCODE(K)
  490.       TDESC=MDESC(K)
  491.       TDATE=MDATE(K)
  492.       TCOST=MCOST(K)
  493.       TODOM=MODOM(K)
  494.          MCODE(K)=MCODE(KEEP)
  495.          MDESC(K)=MDESC(KEEP)
  496.          MDATE(K)=MDATE(KEEP)
  497.          MCOST(K)=MCOST(KEEP)
  498.          MODOM(K)=MODOM(KEEP)
  499.             MCODE(KEEP)=TCODE
  500.             MDESC(KEEP)=TDESC
  501.             MDATE(KEEP)=TDATE
  502.             MCOST(KEEP)=TCOST
  503.             MODOM(KEEP)=TODOM
  504.       GOTO 400
  505.   500 CONTINUE
  506.       RETURN
  507.       END
  508. C
  509. C
  510. C
  511.       SUBROUTINE WRMILE(SEL)
  512. C
  513. C        WRITE MILEAGE DATA
  514. C
  515.       COMMON/MAIN1/ NAME,IDNUM,DATE,RFILE,MFILE
  516.       CHARACTER NAME(25)*20,IDNUM(25)*20,DATE(2,25)*8
  517.       CHARACTER RFILE(25)*11,MFILE(25)*11
  518. C
  519.       COMMON/MAIN2/ COST,ODOM,VNUM
  520.       INTEGER VNUM
  521.       REAL COST(2,25),ODOM(2,25)
  522. C
  523.       COMMON/MILE1/ MDESC,MDATE
  524.       CHARACTER MDESC(500)*25,MDATE(500)*8
  525. C
  526.       COMMON/MILE2/ MCODE,MCOST,MODOM,MNUM
  527.       INTEGER MCODE(500),MNUM
  528.       REAL MCOST(500),MODOM(500)
  529. C
  530.       CHARACTER*25 OPTION
  531.       LOGICAL*2 CHECK
  532.       INTEGER SEL
  533. C
  534. C            STORE THE MILEAGE DATA
  535. C
  536.       IF(SEL.GT.VNUM) GOTO 500
  537.       IF(MFILE(SEL).EQ.'           ') GOTO 500
  538. C
  539. C            IF FILE DOES NOT EXIST, BUT DATA DOES, THEN CREATE
  540. C
  541.       INQUIRE(FILE=MFILE(SEL),EXIST=CHECK)
  542.       IF((CHECK.EQV..FALSE.) .AND. (MNUM.GT.0)) THEN
  543.          OPEN(20,FILE=MFILE(SEL),STATUS='NEW')
  544.       ELSEIF(CHECK.EQV..FALSE.) THEN
  545.          GOTO 500
  546.       ELSEIF(CHECK.EQV..TRUE.) THEN
  547.          OPEN(20,FILE=MFILE(SEL))
  548.       ENDIF
  549. C
  550. C         WRITE ALL DATA TO FILE
  551. C
  552.       OPTION='Storing Mileage Data ....'
  553.       CALL HEADER(OPTION)
  554.       CALL KEYOFF
  555.          DO 300 K=1,MNUM
  556.          WRITE(20,200) MCODE(K),MDESC(K),MDATE(K),MCOST(K),
  557.      A                 MODOM(K)
  558.   200    FORMAT(I3,A25,A8,F9.2,F8.1)
  559.   300    CONTINUE
  560.          ENDFILE 20
  561.          CLOSE(20,STATUS='KEEP')
  562.          CALL KEYON
  563.   500 CONTINUE
  564.       RETURN
  565.       END
  566. C
  567. C
  568. C
  569.       SUBROUTINE DNAME(SEL)
  570. C
  571. C           PRINT NAME AT TOP OF SCREEN
  572. C
  573.       COMMON/MAIN1/ NAME,IDNUM,DATE,RFILE,MFILE
  574.       CHARACTER NAME(25)*20,IDNUM(25)*20,DATE(2,25)*8
  575.       CHARACTER RFILE(25)*11,MFILE(25)*11
  576. C
  577.       INTEGER SEL
  578.       CHARACTER TYPE*6,TEMP*80
  579. C
  580.       CALL UPTOP(1,7)
  581.          WRITE(*,'(30X,A20)') ' Vehicle Selected : '
  582.       TEMP=NAME(SEL)
  583.       TYPE='CENTER'
  584.       CALL JUSTIF(TYPE,TEMP,20)
  585.       CALL BOLD
  586.       CALL DHTOP
  587.          WRITE(*,'(10X,A20)') TEMP
  588.       CALL DHBOT
  589.          WRITE(*,'(10X,A20)') TEMP
  590.       CALL OFF
  591.       RETURN
  592.       END
  593.