home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / FORTRAN / SUPERT87.ZIP / RANKING.UTF < prev    next >
Encoding:
Text File  |  1986-12-15  |  2.3 KB  |  43 lines
  1.     program ranking
  2.       character*8 RANKS(2,14),MNAME,MOLDNM                              0001
  3.       DIMENSION RANKPT(14)                                              0002
  4.       data ranks/'        ','Inductee','        ',                      0003
  5.      1  ' Recruit','        ','   Cadet','      Mi','dshipman',         0004
  6.      1  '        ','  Ensign',' Lieuten','ant J.G.','      Li',         0005
  7.      1  'eutenant','   Lt. C','ommander','       C','ommander',         0006
  8.      1  '        ',' Captain','    Rear',' Admiral','    Vice',         0007
  9.      1  ' Admiral','        ',' Admiral','   Fleet',' Admiral'/         0008
  10.       DATA RANKPT/0.,1.,10.,20.,30.,40.,50.,60.,70.,80.,95.,110.,125.,  0009
  11.      1  140./                                                           0010
  12.     call cpage
  13.     write(*,'('' Suprtrek Player Ranking Program V. 1.0 '')')
  14.     pause ' Press Return to Display current Rankings '
  15.       CALL CPAGE                                                        0011
  16.       WRITE(*,30341)                                                    0012
  17.       OPEN(3,FILE='KEYFILE.TRK',ACCESS='DIRECT',RECL=600)
  18.  
  19. 30341 FORMAT(' Communique from Starfleet Command! '/'  The current ranks0014
  20.      1 have been obtained by the following officers:')                  0015
  21.       IIKK=0                                                            0016
  22. 30342 IRNK=14                                                           0017
  23.       IIKK=IIKK+1                                                       0018
  24.       READ(3,rec=IIKK,ERR=30347)MNAME,POINT                             0019
  25.       IF(MNAME.EQ.MOLDNM)GO TO 30347                                    0020
  26.       MOLDNM=MNAME                                                      0021
  27. 30344 IF(POINTS.GE.RANKPT(IRNK))GO TO 30345                             0022
  28.       IRNK=IRNK-1
  29.       GO TO 30344                                                       0024
  30. 30345 WRITE(*,30346)RANKS(1,IRNK),RANKS(2,IRNK),MNAME,POINTS            0025
  31. 30346 FORMAT(2A8,' ',A8,' Currently has Points = ',F6.2)                0026
  32.     iikk=iikk+4
  33.       GO TO 30342                                                       0027
  34. 30347 STOP                                                              0028
  35.       END                                                               0029
  36.     SUBROUTINE CPAGE
  37.     call cls
  38.     CALL HOME
  39.     RETURN
  40.     END
  41.  
  42.  
  43.