home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / FORTRAN / SUPERT87.ZIP / RATING.FOR < prev    next >
Encoding:
Text File  |  1986-12-15  |  6.0 KB  |  168 lines
  1.       SUBROUTINE RATING(IR)
  2. C     ...END OF GAME ROUTINE.
  3.  
  4. c    include 'tcommon.for'
  5.     %include tcommon.for
  6.  
  7.       DIMENSION PWIN(3,4),PLOSE(3,4)
  8.       DATA PWIN/1.,2.,3.,2.,4.,6.,3.,6.,9.,5.,10.,15./
  9.       DATA PLOSE/3*1.,3*2.,3*3.,3*5./
  10.       DATA ILOSE/0/
  11.       GO TO (10,20,30,40,50,60,60),IR 
  12. 10    write(*,1)
  13. 1     FORMAT(' Collision with Star!  Ship Destroyed')
  14.       GO TO 100
  15. 20    ENERGY=ENERGY+DEFL
  16.       DEFL=0.
  17.       IF(ENERGY.LE.0.)GO TO 4000
  18.       write(*,5000)
  19. 5000    FORMAT(' Defectors automatically dropped to obtain energy')
  20.       RETURN
  21. 4000    write(*,2)
  22. 2     FORMAT(' Out of energy')
  23.       GO TO 100
  24. 30    write(*,3)
  25. 3     FORMAT(' Time''s Up!')
  26.       GO TO 100
  27. 40    write(*,4)
  28. 4     FORMAT(' Congratulations!!')
  29.       GO TO 100
  30. 50    write(*,5)
  31. 5     FORMAT(' Crew wiped out!')
  32.       GO TO 100
  33. 60    write(*,6)
  34. 6     FORMAT(' Warp drive explosion!...everything in quadrant destroyed!
  35.      1!')
  36.       IF(PSP.GE.1.)GO TO 100
  37.       IF(KLNGNS.EQ.0)GO TO 90
  38.       DO 80 J=1,KLNGNS
  39.       IF(XKL(J,1).EQ.0.)GO TO 80
  40.       LEFTK=LEFTK-1
  41. 80    CONTINUE
  42. 90    IF(NROM.EQ.0)GO TO 100
  43.       DO 70    J=1,NROM
  44.       IF(XROM(J,1).EQ.0.)GO TO 70
  45.       LEFTR=LEFTR-1
  46. 70    CONTINUE
  47. 100   R=LEFTK+LEFTR
  48.       S=NKL+MROM
  49.       R=(S-R)/S
  50.       KR=R*1000.
  51.       IF(KR.GE.1000)GO TO 999
  52.       IF(KR.GE.900)GO TO 998
  53.       IF(KR.GE.750)GO TO 997
  54.       IF(KR.GE.500)GO TO 996
  55.       IF(KR.GE.250)GO TO 995
  56.       write(*,94)
  57. 94    FORMAT(' You really blew it. the incumbent will lose by'/      ' a3576
  58.      1 landslide and don''t be surprised if they rename the Vulcan Bowl'3577
  59.      1/      ' the Klingon Bowl!')
  60.       GO TO 994
  61. 995   write(*,95)
  62. 95    FORMAT(' Starfleet command hangs you in effigy.'/      ' at least 
  63.      1you won''t be called upon to testify at the stargate hearings!')
  64.       GO TO 994
  65. 996   write(*,96)
  66. 96    FORMAT(' You seem to be getting the hang of it.'/      ' the presi3585
  67.      1dent may be able to pull the election out by referring to'/      '3586
  68.      1 your efforts as a "tactical redeployment in certain non-'/      '3587
  69.      1 critical sectors of the galaxy."')
  70.       GO TO 994
  71. 997   write(*,97)
  72. 97    FORMAT(' A most valiant effort. your name will long be remembered 3591
  73.      1with fear'/      ' by the pitiful remnants of the once mighty Klin3592
  74.      1gon-Romulan Empire'/      ' the president would have appointed you3593
  75.      1 attorney general at least..')
  76.       GO TO 994
  77. 998   write(*,98)
  78. 98    FORMAT(' congratulations!! you have overcome incredible odds'/    3597
  79.      1  ' to come within a hair of victory. your children will be well'/3598
  80.      1      ' provided for.')
  81.       GO TO 994
  82. 999   IF(IR.EQ.7)GO TO 993
  83.       write(*,99)
  84. 99    FORMAT(' Victory, total and complete, is yours!!!'/      ' your fa3603
  85.      1me will spread throughout the entire  universe! unfortunately,'/  3604
  86.      1    '  the president doesn''t like being knocked off the front pag3605
  87.      1e'/      ' so he has appointed you as permanent ambassador to the 3606
  88.      1outer stotinki'/      ' colonies.')
  89.       GO TO 994
  90. 993   write(*,92)
  91. 92    FORMAT(' Your place in Valhalla is assured. you have eliminated th3610
  92.      1e last'/      ' major threat to the federation in this era. you ma3611
  93.      1y even inspire'/      ' a new television series!?!?')
  94. 994   write(*,93)
  95. 93    FORMAT(///)
  96.       write(*,7)KR
  97. 7     FORMAT(' Rating = ',I5)
  98. C     ...DETERMINE POINT GAIN OR LOSS FACTOR.
  99.       IF(NRW.EQ.0)GO TO 661
  100.       IWIN=1
  101.       IF(KR.LT.750)IWIN=-1
  102.       IF(KR.LT.900.AND.IRANK.GE.10)IWIN=-1
  103. C     ...DETERMINE INDICES FOR PWIN OR PLOSE. S IS TOTAL ENEMY AT START.3622
  104.       IL=4
  105.       IF(S.LT.100.)IL=3
  106.       IF(S.LT.50.)IL=2
  107.       IF(S.LT.25)IL=1
  108.       IF(IRANK.EQ.NRANKS)GO TO 3005
  109.       IF(LEVEL.EQ.1.AND.IRANK.GE.7.AND.IWIN.GT.0)write(*,6601 )
  110. 6601  format(' if you want to gain rank you''ll have to play at a higher3629
  111.      1 level')
  112.       IF(LEVEL.EQ.1.AND.IRANK.GE.7.AND.IWIN.GT.0)IWIN=0
  113.       IF(IL.EQ.1.AND.IRANK.GE.9.AND.IWIN.GT.0)write(*,6602 )
  114. 6602  format(' sir if you want to gain rank you''ll have to play against3633
  115.      1 more enemies')
  116.       IF(IL.EQ.1.AND.IRANK.GE.9.AND.IWIN.GT.0)IWIN=0
  117.       IF(IRANK.GE.11.AND.IL.LT.3.AND.IWIN.GT.0)write(*,6602 )
  118.       IF(IRANK.GE.11.AND.IL.LT.3.AND.IWIN.GT.0)IWIN=0
  119.       IF(IRANK.EQ.NRANKS-1.AND.(S.LT.198.OR.LEVEL.LT.3.OR.KR.NE.1000.OR.3638
  120.      1  ITFCTR.GT.10).AND.IWIN.GT.0)write(*,6603 )
  121.  
  122. 6603  FORMAT(' Admiral sir: if you want to become a Fleet Admiral you''l3640
  123.      1l have'/' to play a level 3 game with 198 enemies and a timing fac3641
  124.      1tor of 10 or less.')
  125.       IF(IRANK.EQ.NRANKS-1.AND.(S.LT.198.OR.LEVEL.LT.3.OR.KR.NE.1000.OR.3643
  126.      1  ITFCTR.GT.10).AND.IWIN.GT.0)IWIN=0
  127. 3005  IF(IRANK.EQ.NRANKS.AND.IWIN.LT.0)GO TO 1999
  128.       IF(IWIN)1000,1999,3000
  129. C     ...LOSS. DEMOTION.
  130. 1000  XPTS=-IWIN*PLOSE(LEVEL,IL)
  131.       XPTS=XPTS-XPTS*R
  132.       XPTS=AMIN1(XPTS,POINTS)
  133.       IF(XPTS.EQ.0.)GO TO 1999
  134.       write(*,1001)XPTS
  135. 1001  FORMAT(' Well, you blew',f5.2,' points on that one, meathead.')
  136.       IF(POINTS.GE.1.)POINTS=AMAX1(1.,POINTS-XPTS)
  137.       IF(POINTS.GE.1.)GO TO 1002
  138.       POINTS=AMAX1(0.,POINTS-XPTS)
  139. 1002  IF(POINTS.GE.RANKPT(IRANK))GO TO 1003
  140.       IRANK=IRANK-1
  141.       GO TO 1002
  142. 1003  write(*,1004)RANKS(1,IRANK),RANKS(2,IRANK),POINTS 
  143. 1004  FORMAT(' your present rank is ',2a8,'. # points = ',f6.2) 
  144.       GO TO 2000
  145. C     ...WIN. PROMOTION.
  146. 3000  XPTS=IWIN*PWIN(LEVEL,IL)
  147.       XPTS=XPTS*R
  148.       IF(IR.EQ.7)XPTS=XPTS/2.
  149.       write(*,3001)XPTS
  150. 3001  format(' you gained ',f5.2,' points on that one.')
  151.       POINTS=POINTS+XPTS
  152.       IF(IRANK.EQ.NRANKS)GO TO 1003
  153.       IF(POINTS.LT.RANKPT(IRANK+1))GO TO 1003
  154.       IRANK=IRANK+1
  155.       IF(IRANK.EQ.NRANKS)GO TO 1003
  156.       POINTS=AMIN1(POINTS,RANKPT(IRANK+1)-1.)
  157.       GO TO 1003
  158. 1999  write(*,1998)
  159. 1998  FORMAT(' No change in status this time.')
  160.       GO TO 661
  161. 2000  READ(3,REC=MMKEY)MNAME,X,MPASS,X6,X7
  162.       WRITE(3,REC=MMKEY)MNAME,POINTS,MPASS,X6,X7
  163. 661   WRITE(9,REC=1)MNAME,POINTS,MPASS,ILOSE
  164.     close(3)
  165.     close(9)
  166.       STOP
  167.       END
  168.