home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / FORTRAN / D2SOURCE.ZIP / UNT.FOR < prev    next >
Encoding:
Text File  |  1985-11-13  |  1.7 KB  |  46 lines
  1.       SUBROUTINE UNT(UM,IA,PRT)
  2.       DIMENSION UMT(25),UC(25),DN25(18),MNE(34),IK(25)  
  3.       CHARACTER*2 UM,UMT
  4.       CHARACTER*6 MNE   
  5.       DATA UMT/'AT','BR','CM','DF','FT','SF','GM','HR','IN',
  6.      $ 'KT', 'LB','MT','PM','M3','MH','MB','OZ','SC','TM',  
  7.      $ 'TN','GL', 'LT','ML','PT','QT'/  
  8.       DATA UC/760.,750.,.01,1.,.3048,.0929,1000.,60.,.0254, 
  9.      $ .5148, 4.53592E5,3.281,.01667,.001,.447,.75,28349.5, 
  10.      $ .01667, 1.E9,9.0718E8,3.785E6,1.E6,1000.,4.732E5,
  11.      $ 9.464E5/ 
  12.       DATA DN25/1.0887,1.0083,1.268,.687,1.37,1.18,1.073,   
  13.      $ 1.0222,1.12765,1.09,1.24,1.66,1.89,1.011,.7914,  
  14.      $ .51,1.65,0./ 
  15.       DATA MNE/'   ATM','   BAR','    CM',' DEG F','    FT',
  16.      $ ' SQ FT','    GM','    HR','    IN','    KT','    LB'
  17.      $,'     M',' M/MIN','C M/MN',' MI/HR','    MB','    OZ'
  18.      $,'   SEC','TON(M)','   TON','   GAL','     L','    ML'
  19.      $,'    PT','    QT','MM HG','DEG C','SQ M','MG','MIN', 
  20.      $'M/SEC','L/MIN','M', 'FT'/
  21.       DATA IK/26,26,33,27,33,28,29,30,33,31,29,34,31,32,31, 
  22.      $ 26,29,30,7*29/   
  23.    15 DO 1 IC=1,25
  24.       IF (UM.EQ.UMT(IC)) GO TO 2
  25.     1 CONTINUE  
  26.       WRITE(*,6)
  27.     6 FORMAT (' UNIT CODES')
  28.       DO 9 I=1,5
  29.     9 WRITE(*,10) (MNE(II),UMT(II),II=I,25,5)   
  30.    10 FORMAT (1X,5(A6,'=',A2,3X))   
  31.       UM='ND'   
  32.       RETURN
  33.     2 PRT=PRT*UC(IC)
  34.       IF (IC.EQ.4) PRT=(PRT-32)/1.8 
  35.       IF (IC.LT.21) GO TO 8 
  36.       IF (IA.LT.18) GO TO 3 
  37.       WRITE(*,4)
  38.     4 FORMAT (' INPUT: AGENT DENSITY')  
  39.       READ(*,*) DN25(18)
  40.     3 PRT=PRT*DN25(IA)  
  41.     8 IO=IK(IC) 
  42.       WRITE(*,7) MNE(IC),MNE(IO),PRT
  43.     7 FORMAT (1X,A6,' TO ',A5,E9.3)
  44.    14 RETURN
  45.       END
  46.