home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / FORTRAN / D2SOURCE.ZIP / QLIST.FOR < prev    next >
Encoding:
Text File  |  1985-11-18  |  3.6 KB  |  79 lines
  1.       SUBROUTINE QLIST(IQ,IRT)
  2.       CHARACTER*1 MTC,AA1,AB1
  3.       CHARACTER*2 AGNT,AA2,WT
  4.       CHARACTER*3      MUNT,REL,LOCT,SEAT,SUR,SYM
  5.       CHARACTER*12 ADH
  6.       CHARACTER*30 QTAB
  7.       COMMON NQI,QT(6),TWL(6),D(10),DL(10)
  8.       COMMON PR(1),DXT,HT,HML,SXS,SYS,SZS,TIVCH,UT,BR,SF,TMP,ALFA,SY100,
  9.      +  BETA,SZ100,Z,RC,V,QS
  10.       COMMON TEVP,SA,FL,FMW,FMV,VP,BP
  11.       COMMON HS,DS,TSC,VS,RDE,FP,HR,CR
  12.       COMMON SLA,SLO,CC,CH,AE,PMM,Z0
  13.       COMMON LOCT(1),SEAT,MUNT,AGNT,AA1,REL,MTC,AA2,
  14.      $       SUR,WT,AB1,ADH,ADR,AD2
  15.       COMMON IPR(1),ND,IPO,I2MC,IMA,IPC,IMM,IDD,IHR,NOV,INP,MRL,NMU,ID2,
  16.      +  IDEP,IMTCH,IM,IR,IL,IRL,ISM,IVD,K33,K42
  17.       DIMENSION IQM(36),IQR(36),QTAB(37),SYM(37)
  18.       DATA IQR /63,43,44,4,45,46,0,47,48,9,13,12,0,24,0,41,49,21,
  19.      +         22,23,24,1,59,28,29,30,31,32,33,34,35,36,60,38,40,50/
  20.       DATA IQM / 10*1,4,9*1,4,10*1,2,3,2,1,1/
  21.       DATA QTAB/
  22.      $'YOUR NOVICE LEVEL: 3,2,1 OR 0 ','LOCATION                      ',
  23.      $'SEASON                        ','HEIGHT OF MIXING LAYER        ',
  24.      $'MUNITION TYPE                 ','AGENT TYPE                    ',
  25.      $'SPILL OR AIRBORNE SOURCE (mg) ','RELEASE TYPE                  ',
  26.      $'STABILITY TYPE                ','WINDSPEED (m/sec)             ',
  27.      $'ALF, SYR(m), BTA, SZR(m)      ','TEMPERATURE (deg C)           ',
  28.      $'Q()(mg), TQ()(min)            ','MOLECULAR WEIGHT              ',
  29.      $'ALL OTHER INPUT               ','ATMOSPHERIC PRESSURE (mm Hg)  ',
  30.      $'SURFACE CODE                  ','TIME OF EVAPORATION (min)     ',
  31.      $'AREA OF WETTED SURFACE (sq m) ','LENGTH OF SURFACE DOWNWIND (m)',
  32.      $'FMW,FMV,VAP(mm Hg),BPT(deg K) ','TIME AFTER FUNCTIONING (min)  ',
  33.      $'OUTPUT CONTROL CODE           ','HEIGHT OF STACK (m)           ',
  34.      $'DIAMETER OF STACK (m)         ','TEMPERATURE OF STACK (deg C)  ',
  35.      $'VELOCITY OF EFFLUENT (m/sec)  ','RELATIVE DENSITY OF EFFLUENT  ',
  36.      $'FROST PROFILE EXPONENT        ','HEAT RELEASED (cal)           ',
  37.      $'CLOUD RADIUS (m)              ','STATION LATITUDE AND LONGITUDE',
  38.      $'MONTH,DAY,HOUR: (JAN,01,1200) ','CLOUD COVER(1/10),CLOUD HT(ft)',
  39.      $'SUN ELEVATION ANGLE (deg)     ','WOODS TYPE                    ',
  40.      +'AND ROUGHNESS LENGTH (cm)     '/ 
  41.       DATA SYM/ 
  42.      $'NOV','LOC','SEA','HML','MUN','AGN','QQQ','REL','STB','WND',  
  43.      $'   ','TMP','   ','FMW','   ','PMM','SUR','TEV','ARE','LEN',  
  44.      $'   ','TIM','OPC','HST','DST','TST','VST','RDE','FRO','HRL',
  45.      $'CRD','   ','   ','   ','SUN','WOO','ZZO'/
  46.       IF (IQ.GT.36) RETURN
  47.       IF (IQ.EQ.17.OR.IQ.EQ.22.OR.IQ.EQ.16.OR.IQ.EQ.23.OR.
  48.      +IQ.EQ.29.OR.IQ.EQ.36) WRITE(*,*)
  49.       IF (IRT.EQ.1) GO TO 10
  50.       IF (IQ.EQ.13.AND.IR.NE.3) THEN
  51.       WRITE(*,104) IQ,QTAB(IQ),SYM(IQ)
  52.       RETURN
  53.       ENDIF
  54.       WRITE(*,100) IQ,QTAB(IQ),SYM(IQ)
  55.       IF (IQ.EQ.29.AND.IVD.EQ.1) WRITE(*,106) QTAB(37),SYM(37)
  56.       RETURN
  57.    10 IF(IQ.EQ.13.OR.IQ.EQ.7) THEN
  58.       WRITE(*,105) IQ,QTAB(IQ),(QT(I),TWL(I),I=1,NQI)
  59.       RETURN
  60.       ENDIF
  61.       IC=IQR(IQ)
  62.       IN=IQM(IQ)
  63.       IF (IC.LT.43) WRITE(*,101) IQ,QTAB(IQ),SYM(IQ),
  64.      $(PR(IC+I-1),I=1,IN)
  65.       IF(IC.GT.42.AND.IC.LT.54) WRITE(*,102) IQ,QTAB(IQ),SYM(IQ),
  66.      $(LOCT(IC-42+I-1),I=1,IN)
  67.       IF (IC.GT.54) WRITE(*,103) IQ,QTAB(IQ),SYM(IQ),
  68.      $(IPR(IC-53+I-1),I=1,IN)
  69.       IF(IQ.EQ.29.AND.IVD.EQ.1)WRITE(*,106)QTAB(37),SYM(37),Z0
  70.       RETURN
  71.   100 FORMAT(1X,I2,'. ',A30,A3)
  72.   101 FORMAT(1X,I2,'. ',A30,A3,4F10.2)
  73.   102 FORMAT(1X,I2,'. ',A30,A3,2X,A3)
  74.   103 FORMAT(1X,I2,'. ',A30,A3,3I7)
  75.   104 FORMAT(1X,I2,'. NQI,',A30,A3)
  76.   105 FORMAT(1X,I2,'. ',A30,1P2E10.3,/(35X,2E10.3))
  77.   106 FORMAT(5X,A30,A3,F10.2)
  78.       END
  79.