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 / vehic4.for < prev    next >
Text File  |  1995-05-28  |  10KB  |  353 lines
  1. C
  2. C         VEHICLE MAINTENANCE PRGM        by Bruce W. Roeckel
  3. C       *--------------------------*                         
  4. C           OPTION #4 - REPORTS   
  5. C
  6. C
  7. $STORAGE:2
  8. C
  9. C
  10.       SUBROUTINE REPORT 
  11. C
  12. C           GENERATE ALL VEHICLE REPORTS
  13. C
  14.       IMPLICIT INTEGER (A-Z)
  15. C
  16.       COMMON /REVNO/ PGM,AUTHOR,YEAR,DATE2,REV
  17.       CHARACTER PGM*21,AUTHOR*21,YEAR*4,DATE2*8,REV*2
  18. C
  19.       COMMON/MONTHS/ IMON
  20.       CHARACTER*4 IMON(13)
  21. C
  22.       COMMON/MAIN1/ NAME,IDNUM,DATE,RFILE,MFILE
  23.       CHARACTER NAME(25)*20,IDNUM(25)*20,DATE(2,25)*8
  24.       CHARACTER RFILE(25)*11,MFILE(25)*11
  25. C
  26.       COMMON/MAIN2/ COST,ODOM,VNUM
  27.       INTEGER VNUM
  28.       REAL COST(2,25),ODOM(2,25)
  29. C
  30.       COMMON/REPAR1/ RDESC,RDATE
  31.       CHARACTER RDESC(500)*25,RDATE(500)*8
  32. C
  33.       COMMON/REPAR2/ RCODE,RCOST,RODOM,RNUM
  34.       INTEGER RCODE(500),RNUM
  35.       REAL RCOST(500),RODOM(500)
  36. C
  37.       COMMON/MILE1/ MDESC,MDATE
  38.       CHARACTER MDESC(500)*25,MDATE(500)*8
  39. C
  40.       COMMON/MILE2/ MCODE,MCOST,MODOM,MNUM
  41.       INTEGER MCODE(500),MNUM
  42.       REAL MCOST(500),MODOM(500)
  43. C
  44.       REAL MSINCE,TMPG,TTLCST,MAX,AVE,LOIL,MPG,GNDAVE,GNDTTL
  45.       REAL TPLOT(34),TTL1,TTL2,AVE1,AVE2
  46.       CHARACTER OPTION*25,DESCR(9)*25
  47.       CHARACTER SUBT1*8,SUBT2*8,TITLE*40
  48.       CHARACTER ICODE*1,RAMDSK*80,KIND*6
  49. C
  50.       DESCR(1) =            'Oil Change w/ Filter     ' 
  51.       DESCR(2) =            'Lubricated Front End     ' 
  52.       DESCR(3) =            'Replaced Air Filter      ' 
  53.       DESCR(4) =            'Replaced Distibutor Pnts ' 
  54.       DESCR(5) =            'New Spark Plugs          ' 
  55.       DESCR(6) =            'Front End Alignment      ' 
  56.       DESCR(7) =            'Replaced Front Brakes    ' 
  57.       DESCR(8) =            'Replaced Rear Brakes     ' 
  58.       DESCR(9) =            'Rotated Tires            ' 
  59. C
  60. C           LIST ALL CARS, SELECT ONE TO WORK WITH
  61. C
  62.       TYPE=0
  63.       OPTION='Vehicle Reports & Graphs '
  64.       CALL HEADER(OPTION)
  65.       CALL LISTEM(TYPE,SEL)
  66.       IF(SEL.EQ.0) GOTO 9900
  67.       CALL RDREPS(SEL)
  68.       CALL RDMILE(SEL)
  69. C
  70. C           CALCULATE MILES SINCE OIL CHANGE
  71. C
  72.       DO 10 I=1,RNUM
  73.       IF(RCODE(I).EQ.1) THEN
  74.          LOIL = MODOM(MNUM) - RODOM(I) 
  75.          GOTO 50
  76.       ENDIF
  77.    10 CONTINUE
  78. C
  79. C            DISPLAY MENU
  80. C
  81.    50 CONTINUE
  82.       CALL HEADER(OPTION)
  83.       CALL DNAME(SEL)
  84.          WRITE(*,100) LOIL
  85.   100    FORMAT(//,22X,F7.2,' Miles Since Last Oil Change',
  86.      A         //,21X,'1. Maintenance & Repair Summary Report',
  87.      B          /,21X,'2. City & Trip MPG Summary Report     ',
  88.      C          /,21X,'3. Graph *Trip* Miles per Gallon Data ',
  89.      D          /,21X,'4. Graph *City* Miles per Gallon Data ')
  90.   125 CONTINUE
  91.       CALL BOLD
  92.       CALL MOVEIT(1,23)
  93.       WRITE(*,'(5X,A37,\)') '     Enter Choice (H=Help, Q=Quit) : '
  94.       READ(*,'(A1)',ERR=125) ICODE
  95.       CALL OFF
  96. C
  97. C           BRANCH ON REQUEST
  98. C
  99.       IF(ICODE.EQ.'Q' .OR. ICODE.EQ.'q') THEN
  100. C
  101.          GOTO 9900
  102. C
  103.       ELSEIF(ICODE.EQ.'H' .OR. ICODE.EQ.'h') THEN
  104. C
  105.          ICODE='4'
  106.          IUNIT=15
  107.          CALL HELP(ICODE,IUNIT)
  108.          GOTO 50
  109. C
  110.       ELSEIF(ICODE.EQ.'1' .OR. ICODE.EQ.'2' .OR.
  111.      A       ICODE.EQ.'3' .OR. ICODE.EQ.'4') THEN
  112. C
  113.          WRITE(RAMDSK,'(A1)') ICODE
  114.          READ(RAMDSK,'(I1)') KCODE
  115.          CALL POINT(KCODE)
  116. C
  117.       ELSE
  118. C
  119.          CALL BELL
  120.          GOTO 125
  121. C
  122.       ENDIF
  123. C
  124. C      =======================  START OF REPORTS  ==========================
  125. C
  126.       IF(KCODE.EQ.1 .AND. RNUM.GT.0) THEN
  127. C
  128.          UNIT=3
  129.          OPEN(UNIT,FILE='OUTPUT.TMP',STATUS='NEW')
  130.          CALL MOVEIT(1,23)
  131.          CALL BOLD
  132.          CALL BLINK
  133.             WRITE(*,'(5X,A33,\)') 'Please Wait ... Generating Report'
  134.          CALL OFF
  135.          LINE=0
  136.          PAGE=0
  137.          TTLCST=0.0
  138.          DO 300 I=1,RNUM
  139.          IF(LINE.LE.0) THEN
  140.             CALL PHEAD(PAGE,UNIT,PGM,DATE2,YEAR,REV)
  141.             WRITE(UNIT,'(//,18X,2A20)') '   Repair Log for : ',NAME(SEL)
  142.             WRITE(UNIT,150)
  143.   150       FORMAT(/,5X,'                                   ',
  144.      A                  '             Odometer  Miles Since',
  145.      B             /,5X,'  Description of Repair     Dated  ',
  146.      C                  '    Cost$     Reading    Repair  ',
  147.      D             /,5X,'-------------------------  --------',
  148.      E                  '  ---------  ---------  ---------')
  149.             LINE=40
  150.          ENDIF
  151.          LINE=LINE-1
  152.          IF(MNUM.GT.0) MSINCE=MODOM(MNUM)-RODOM(I)
  153.             IF(RCODE(I).EQ.98) THEN
  154.                WRITE(UNIT,200) RDESC(I),RDATE(I),RCOST(I),
  155.      A                         RODOM(I),MSINCE
  156.   200          FORMAT(5X,A25,2X,A8,2X,F9.2,2X,F9.1,2X,F9.1)
  157.             ELSE
  158.                WRITE(UNIT,250) DESCR(RCODE(I)),RDATE(I),RCOST(I),
  159.      A                         RODOM(I),MSINCE
  160.   250          FORMAT(3X,'* ',A25,2X,A8,2X,F9.2,2X,F9.1,2X,F9.1)
  161.                IF(RDESC(I).NE.' ') THEN
  162.                   WRITE(UNIT,275) RDESC(I)
  163.   275             FORMAT(5X,'   Note: ',A25)
  164.                ENDIF
  165.             ENDIF
  166.             TTLCST=TTLCST + RCOST(I)
  167.   300    CONTINUE
  168.          WRITE(UNIT,'(42X,A9,/,42X,A1,F8.2)') '=========','$',TTLCST
  169.          WRITE(UNIT,325)
  170.   325    FORMAT(///,5X,'NOTE: "*" Indicates Recurring ',
  171.      A                 'Maintenance Items')
  172.          CALL SHOWIT(UNIT)
  173.          CLOSE(UNIT,STATUS='DELETE')
  174. C
  175.       ELSEIF(KCODE.EQ.2 .AND. MNUM.GT.0) THEN
  176. C
  177.          UNIT=3
  178.          OPEN(UNIT,FILE='OUTPUT.TMP',STATUS='NEW')
  179.          CALL MOVEIT(1,23)
  180.          CALL BOLD
  181.          CALL BLINK
  182.             WRITE(*,'(5X,A33,\)') 'Please Wait ... Generating Report'
  183.          CALL OFF
  184.          LINE=0
  185.          PAGE=0
  186.          GNDTTL=0.0
  187.          TTL1=0.0
  188.          TTL2=0.0
  189.          INUM1=0
  190.          INUM2=0
  191.          DO 500 I=2,MNUM
  192.          IF(LINE.LE.0) THEN
  193.             CALL PHEAD(PAGE,UNIT,PGM,DATE2,YEAR,REV)
  194.             WRITE(UNIT,'(//,18X,2A20)') ' Mileage Data for : ',NAME(SEL)
  195.             WRITE(UNIT,350)
  196.   350       FORMAT(
  197.      A            /,3X,'                     Odometer   City   Trip ',
  198.      B            /,3X,'  Date     Gallons    Reading    MPG    MPG ',
  199.      C                 '     Description of Trip   ',
  200.      D            /,3X,'--------  ---------  ---------  -----  -----',
  201.      E                 '  -------------------------')
  202.             LINE=40
  203.          ENDIF
  204.          LINE=LINE-1
  205.          MPG = (MODOM(I)-MODOM(I-1)) / MCOST(I)
  206.          GNDTTL = GNDTTL + MPG
  207.             IF(MCODE(I).EQ.1) THEN
  208.                TTL1=TTL1 + MPG
  209.                INUM1 = INUM1 + 1
  210.                WRITE(UNIT,400) MDATE(I),MCOST(I),
  211.      A                         MODOM(I),MPG,MDESC(I)
  212.   400          FORMAT(3X,A8,2X,F9.2,2X,F9.1,9X,F5.1,2X,A25)
  213.             ELSE
  214.                TTL2=TTL2 + MPG
  215.                INUM2 = INUM2 + 1
  216.                WRITE(UNIT,450) MDATE(I),MCOST(I),
  217.      A                         MODOM(I),MPG
  218.   450          FORMAT(3X,A8,2X,F9.2,2X,F9.1,2X,F5.1)
  219.             ENDIF
  220.   500    CONTINUE
  221.          IF(INUM1.GT.0) AVE1 = TTL1 / REAL(INUM1)
  222.          IF(INUM2.GT.0) AVE2 = TTL2 / REAL(INUM2)
  223.          IF((INUM1.GT.0) .OR. (INUM2.GT.0)) THEN
  224.             GNDAVE = GNDTTL / (REAL(INUM1) + REAL(INUM2))
  225.          ENDIF
  226.          WRITE(UNIT,550) AVE2,AVE1,GNDAVE
  227.   550    FORMAT(35X,'=====  =====',
  228.      A        /, 9X,'Trip / City Average MPG : ',F5.1,2X,F5.1,
  229.      B       //, 9X,'      TOTAL Average MPG : ',F5.1)
  230.          CALL SHOWIT(UNIT)
  231.          CLOSE(UNIT,STATUS='DELETE')
  232. C
  233.       ELSEIF(KCODE.EQ.3 .AND. MNUM.GT.0) THEN
  234. C
  235.          CALL MOVEIT(1,23)
  236.          CALL BOLD
  237.          CALL BLINK
  238.             WRITE(*,'(5X,A17,\)') 'Please Wait .... '
  239.          CALL OFF
  240. C
  241. C              MOVE DATA INTO TEMPORARY ARRAY
  242. C
  243.          IFRST=0
  244.          ILST=0
  245.          K=0
  246.          DO 600 I=MNUM,2,-1
  247.          IF(MCODE(I).EQ.1) THEN
  248.             K=K+1
  249.             IF(K.GT.34) THEN
  250.                K=34
  251.                GOTO 650
  252.             ENDIF
  253.             IF(ILST.EQ.0) ILST=I
  254.             IFRST=I
  255.             TPLOT(K)=(MODOM(I)-MODOM(I-1))/MCOST(I)
  256.          ENDIF
  257.   600    CONTINUE
  258.   650    CONTINUE
  259. C
  260. C              NOW LOAD FILE WITH DATA
  261. C
  262.          IUNIT=2
  263.          OPEN(IUNIT,FILE='PLOT.TMP',STATUS='NEW')
  264. C
  265.          DO 750 I=K,1,-1
  266.          WRITE(IUNIT,700) TPLOT(I)
  267.   700    FORMAT(12X,F12.2)
  268.   750    CONTINUE
  269.          ENDFILE IUNIT
  270. C
  271. C               DISPLAY THE GRAPH ...........  
  272. C
  273.          IF((IFRST.LE.0).AND.(ILST.LE.0)) GOTO 50
  274.          TLEN=40
  275.          TATTR=2
  276.          SUBT1=' '
  277.          SUBT2='Trip MPG'
  278.          WRITE(TITLE,850) NAME(SEL),MDATE(IFRST),MDATE(ILST)
  279.   850    FORMAT(A20,1X,A8,' - ',A8)
  280.          CALL MOVEIT(1,5)
  281.          CALL PLTSCR(IUNIT,TITLE,TLEN,TATTR,SUBT1,SUBT2)
  282.          CLOSE(IUNIT,STATUS='DELETE')
  283.          READ(*,'(A1)') ICODE
  284. C
  285.       ELSEIF(KCODE.EQ.4 .AND. MNUM.GT.0) THEN
  286. C
  287.          CALL MOVEIT(1,23)
  288.          CALL BOLD
  289.          WRITE(*,'(5X,A17,\)') 'Please Wait .... '
  290.          CALL OFF
  291. C
  292. C              MOVE DATA INTO TEMPORARY ARRAY
  293. C
  294.          IFRST=0
  295.          ILST=0
  296.          K=0
  297.          DO 1600 I=MNUM,2,-1
  298.          IF(MCODE(I).EQ.2) THEN
  299.             K=K+1
  300.             IF(K.GT.34) THEN
  301.                K=34
  302.                GOTO 1650
  303.             ENDIF
  304.             IF(ILST.EQ.0) ILST=I
  305.             IFRST=I
  306.             TPLOT(K)=(MODOM(I)-MODOM(I-1))/MCOST(I)
  307.          ENDIF
  308.  1600    CONTINUE
  309.  1650    CONTINUE
  310. C
  311. C              NOW LOAD FILE WITH DATA
  312. C
  313.          IUNIT=2
  314.          OPEN(IUNIT,FILE='PLOT.TMP',STATUS='NEW')
  315.  
  316.          DO 1750 I=K,1,-1
  317.          WRITE(IUNIT,700) TPLOT(I)
  318.  1750    CONTINUE
  319.          ENDFILE IUNIT
  320. C
  321. C               DISPLAY THE GRAPH ...........  
  322. C
  323.          IF((IFRST.LE.0).AND.(ILST.LE.0)) GOTO 50
  324.          TLEN=40
  325.          TATTR=2
  326.          SUBT1=' '
  327.          SUBT2='City MPG'
  328.          WRITE(TITLE,850) NAME(SEL),MDATE(IFRST),MDATE(ILST)
  329.          CALL MOVEIT(1,5)
  330.          CALL PLTSCR(IUNIT,TITLE,TLEN,TATTR,SUBT1,SUBT2)
  331.          CLOSE(IUNIT,STATUS='DELETE')
  332.          READ(*,'(A1)') ICODE
  333. C
  334.       ENDIF
  335.       GOTO 50
  336.  9900 CONTINUE
  337.       RETURN
  338.       END
  339. C
  340. C
  341. C
  342.       SUBROUTINE POINT(KCODE)
  343. C
  344.       IH=17
  345.       IV=13+KCODE
  346.       CALL UPTOP(IH,IV)
  347.       CALL BOLD
  348.       CALL BLINK
  349.          WRITE(*,'(A3)') '==>'
  350.       CALL OFF
  351.       RETURN
  352.       END
  353.