home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / FORTRAN / D2SOURCE.ZIP / DEF.FOR < prev    next >
Encoding:
Text File  |  1985-11-18  |  14.0 KB  |  307 lines
  1.       SUBROUTINE DEF(IQ,IRT)
  2.       COMMON DDM(95),NOV,DD1(7),IR,DD2(6)
  3.       DIMENSION IQT(40),IQI(7)
  4.       DATA IQI/2,3,5,6,8,9,10/
  5.       IF (IQ) 10,20,50
  6.    10 IQQ=(-IQ)
  7.       IQT(IQQ)=0
  8.       RETURN
  9.    20 DO 40 I=1,40
  10.    30 IQT(I)=0
  11.    40 CONTINUE
  12.       RETURN
  13.    50 IF (IQ.EQ.80) GO TO 140
  14.       IF (IQ.GT.40) GO TO 110
  15.       IF (IQ.EQ.40) GO TO 120
  16.       IF (IQ.EQ.39) GO TO 130
  17.       IF (IQT(IQ).EQ.0) GO TO 60
  18.       IRT=1
  19.       CALL QLIST(IQ,IRT)
  20.       RETURN
  21.   60  IRT=0
  22.       IF(IQ.NE.12.AND.IR.NE.2) WRITE(*,*)
  23.       CALL QLIST(IQ,IRT)
  24.       IQT(IQ)=1
  25.       IF (NOV-1) 70,90,100
  26.    70 WRITE(*,80)
  27.    80 FORMAT('  INPUT:'\)
  28.       RETURN
  29.    90 IF (IQ.EQ.2) WRITE(*,1001)
  30.       IF (IQ.EQ.3) WRITE(*,1007)
  31.       IF (IQ.EQ.5) WRITE(*,1003)
  32.       IF (IQ.EQ.6) WRITE(*,1004)
  33.       IF (IQ.EQ.8) WRITE(*,1005)
  34.       IF (IQ.EQ.9) WRITE(*,1006)
  35.       IF (IQ.EQ.17) WRITE(*,1012)   
  36.       IF (IQ.EQ.36) WRITE(*,1024)   
  37.       GO TO 70
  38.  100  IF (IQ.EQ.1) WRITE(*,2000)
  39.       IF (IQ.EQ.2) WRITE(*,2005)
  40.       IF (IQ.EQ.3) WRITE(*,2010)
  41.       IF (IQ.EQ.5) WRITE(*,2020)
  42.       IF (IQ.EQ.6) WRITE(*,2030)
  43.       IF (IQ.EQ.8) WRITE(*,2040)
  44.       IF (IQ.EQ.9) WRITE(*,2050)
  45.       IF (IQ.EQ.13.AND.IR.NE.3) WRITE(*,2060)
  46.       IF (IQ.EQ.13) WRITE(*,2070)   
  47.       IF (IQ.EQ.17) WRITE(*,2080)   
  48.       IF (IQ.EQ.21) WRITE(*,2090)   
  49.       IF (IQ.EQ.23) WRITE(*,2095)
  50.       IF (IQ.EQ.36) WRITE(*,2110)   
  51.       GO TO 70  
  52.   110 IQQ=IQ-40 
  53.       IQT(IQQ)=0
  54.       IF (NOV.GT.1) RETURN  
  55.   115 IF (IQQ.EQ.1) WRITE(*,2000)   
  56.       IF (IQQ.EQ.2) WRITE(*,2005)   
  57.       IF (IQQ.EQ.3) WRITE(*,2010)   
  58.       IF (IQQ.EQ.5) WRITE(*,2020)   
  59.       IF (IQQ.EQ.6) WRITE(*,2030)   
  60.       IF (IQQ.EQ.8) WRITE(*,2040)
  61.       IF (IQQ.EQ.9) WRITE(*,2050)   
  62.       IF (IQQ.EQ.17) WRITE(*,2080)  
  63.       IF (IQQ.EQ.21) WRITE(*,2090)  
  64.       IF (IQQ.EQ.23) WRITE(*,2095)  
  65.       IF (IQQ.EQ.36) WRITE(*,2110)  
  66.       RETURN
  67.   120 IQQ=IRT   
  68.       IF (IQQ.GT.0) GO TO 115
  69.       IF (IRT.EQ.-1) WRITE(*,601)   
  70.       IF (IRT.EQ.-2) WRITE(*,602)   
  71.       IF (IRT.EQ.-3) WRITE(*,603)   
  72.       IF (IRT.EQ.-4) THEN
  73.       WRITE(*,604)
  74.       PAUSE
  75.       WRITE(*,605)
  76.       PAUSE
  77.       WRITE(*,606)
  78.       PAUSE
  79.       WRITE(*,607)
  80.       PAUSE 
  81.       ENDIF 
  82.       WRITE(*,600)  
  83.       RETURN
  84.   130 WRITE(*,500)
  85.       PAUSE
  86.       WRITE(*,501)
  87.       PAUSE
  88.       RETURN
  89.   140 WRITE(*,*) ' LOC,SEA,MUN,AGN,REL,STB,WND'
  90.       DO 145 I=1,7
  91.   145 IQT(IQI(I))=1
  92.       RETURN
  93. C-------------------------------------------------
  94. C CONTROL OPTION AND QUESTION FORMAT STATEMENTS 
  95. C-------------------------------------------------
  96.   600 FORMAT(// 
  97.      +' TABLE DISPLAY CODES  1 CONTROL OPTIONS',5X, 
  98.      +'2 ASSESSMENT OPTIONS'/,22X,'3 OUTPUT OPTIONS'
  99.      +,6X,'4 ALPHABETIC LISTING'/)  
  100.   601 FORMAT(// 
  101.      +14X,'CONTROL OPTIONS'//,6X,'RST  RESTART'/,6X,'RSN  RESCAN'/, 
  102.      +6X,'ALL  EXECUTE'/,6X,'STP  STOP'//,6X,'GTO  GO TO '  
  103.      +'QUESTION NO. (GTO 3)'/,6X,'IRT  RETURN TO QUESTION NO.'/,
  104.      +6X,'INP  INPUT QUESTION NO.'//,6X,'HLD  HOLD VARIABLE '   
  105.      +'(HLD HML)'/,6X,'RLS  RELEASE VARIABLE'//,6X,'TAB  DISPLAY'   
  106.      +' TABLE'/,6X,'DSP  DISPLAY QUESTION DEFINITION'/,6X,'??? '
  107.      +' LIST OF DISPLAY CODES'/)
  108.   602 FORMAT(///
  109.      +16X,'ASSESSMENT CONTROLS'//,5X,'IMA=0  DOSAGE (DEFAULT)'/,
  110.      +9X,'1  CONCENTRATION (MG/CU M)'/,9X,'2  CONCENTRATION (PPM)'  
  111.      +/,9X,'3  FUMIGATION CONCENTRATION'//,5X,'2MC=0  DO NOT'   
  112.      +'USE 2-MINUTE CORRECTION'/,12X,'WITH GB AND VX VAPOR'/,   
  113.      +9X,'2  USE 2-MINUTE CORRECTION WITH'/,12X,'GB AND VX' 
  114.      +' VAPOR (DEFAULT)'//,5X,'MNR=0  NO EFFECTS, NO DEATHS'
  115.      +', 1% LETHALITY'/,9X,'1  NO DEATHS, 1% LETHALITY'/,   
  116.      +9X,'2  1% LETHALITY'//,5X,'VDP=0  W/O VAPOR DEPLETION '   
  117.      +'(DEFAULT)'/,9X,'1  W/VAPOR DEPLETION'/)  
  118.  603  FORMAT(//
  119.      +15X,'OUTPUT CONTROLS'//,5X,'NOV=0  LIST QUESTIONS ONLY'/,9X,  
  120.      +'1  LIST QUESTIONS AND OPTIONS'/,9X,'2  LIST OPTIONS WITH'
  121.      +' DEFINITIONS'//,5X,'OPO=0  OUTPUT SHORT HEADING (DEFAULT)'/, 
  122.      +9X,'1  LIST DOSAGE AND DISTANCE'/,9X,'2  ABOVE PLUS COMPON'   
  123.      +'ENTS OF D'/,9X,'3  CLOUD HALF-WIDTH WITH X'//,5X,
  124.      +'OPC=0  USE HT MAX FROM PLRS'/,9X,'1  LIST F(X), USE '
  125.      +'HT MAX'/,9X,'2  USE HT=F(X)'/,9X,'3  LIST AND USE F(X)'/)
  126.   604 FORMAT(// 
  127.      +' CODE                          INPUT VARIABLE'/  
  128.      +'  AGN   AGENT, SEE  DSP 6'/  
  129.      +'  ALL   CONTROL WORD,EXECUTE PROGRAM'/
  130.      +'  ALF   SLOPE OF THE SIGMA-Y VERSUS X CURVE'/
  131.      +'  ARE   AREA OF PUDDLE                    (M^2)'/
  132.      +'  BPT   BOILING POINT                     (DEG C)'/
  133.      +'  BRT   BREATHING RATE                    (L/MIN)'/
  134.      +'  BTA   SLOPE OF THE SIGMA-Z VERSUS X CURVE'/
  135.      +'  CHT   CLOUD HEIGHT                      (FT)'/
  136.      +'  CRD   CLOUD RADIUS                      (M)'/
  137.      +'  DLX   CHANGE IN X (FIRST CYCLE)         (M)'/
  138.      +'  DOW   DOWNWIND LENGTH OF PUDDLE         (M)'/
  139.      +'  DST   DIAMETER OF STACK                 (M)'/
  140.      +'  FMV   MOLECULAR VOLUME                  (CM^3 /GM MOLE)'/
  141.      +'  FMW   MOLECULAR WEIGHT'/
  142.      +'  FRO   SLOPE OF THE FROST WIND PROFILE'/
  143.      +'  GTO   CONTROL  GO TO SPECIFIED QUESTION'/
  144.      +'  HML   HEIGHT OF MIXING LAYER        (M)')
  145.   605 FORMAT(//
  146.      +'  HLD   HOLD VALUE OF  SYMBOL'/
  147.      +'  HRL   HEAT RELEASED                 (CAL)'/
  148.      +'  HRS   LOCAL STANDARD MILITARY TIME  (HRS)'/
  149.      +'  HST   HEIGHT OF STACK               (M)'/
  150.      +'  HTS   HEIGHT OF SOURCE              (M)'/
  151.      +'  ICC   CLOUD COVER                   (1/10)'/
  152.      +'  IDD   NUMBER OF THE DAY'/
  153.      +'  IMA   METHOD OF ASSESSMENT, SEE TAB 2'/
  154.      +'  IMM   NUMBER OF THE MONTH'/
  155.      +'  INP   CONTROL.  CLEAR INPUT BLOCK FOR QUESTION'/
  156.      +'  IRT   CONTROL.  RETURN TO SPECIFIED QUESTION'/
  157.      +'  LOC   LOCATION, SEE DSP 2'/
  158.      +'  MNR   MINIMUN RESPONSE LEVEL, SEE TAB 2'/
  159.      +'  MUN   MUNITION, SEE DSP 5'/
  160.      +'  NCI   NUMBER OF CONCENTRATIONS OF INTEREST'/
  161.      +'  NDI   NUMBER OF DOSAGES OF INTEREST'/
  162.      +'  NMU   NUMBER OF MUNITIONS'/
  163.      +'  NOV   NOVICE LEVEL'/
  164.      +'  NQI   NUMBER OF SOURCE INTERVALS')
  165.   606 FORMAT(//
  166.      +'  OPC   OUTPUT FOR STACK, SEE TAB 3'/
  167.      +'  OPO   OUTPUT CONTROL, SEE TAB 3'/
  168.      +'  PMM   ATOMOSPHERIC PRESSURE             (MM HG)'/
  169.      +'  QQQ   AIRBORNE SOURCE                   (MG)   '/
  170.      +'  RDE   RELATIVE DENSITY OF EFFLUENT'/
  171.      +'  REF   REFLECTION COEFFICIENT (DEFAULT=1)'/
  172.      +'  REL   METHOD OF RELEASE, SEE DSP 8'/
  173.      +'  RLS   RELEASE HOLD OF SYMBOL VALUE'/   
  174.      +'  RSN   RESCAN FROM QUESTION 2'/ 
  175.      +'  RST   CONTROL.  RESTART'/  
  176.      +'  SEA   SEASON, SEE DSP 3'/  
  177.      +'  SKF   SKIN FACTOR FOR SUBJECT CLOTHING'/   
  178.      +'  SLA   LATITUDE                          (DEG)'/
  179.      +'  SLO   LONGITUDE                         (DEG)'/
  180.      +'  SMH   SAMPLING HEIGHT                   (M)'/
  181.      +'  STB   STABILITY, SEE DSP 9'/
  182.      +'  SUN   SUN ELEVATION ANGLE               (DEG)'/
  183.      +'  SUR   SURFACE TYPE, SEE DSP 13')
  184.   607 FORMAT(//
  185.      +'  SEV   SETTLING VELOCITY OF CLOUD CENTROID (DEFAULT=0) (M/SEC)'/
  186.      +'  SXS   SOURCE SIGMA -X                   (M)'/
  187.      +'  SYR   REFERENCE SIGMA -Y AT 100M        (M)'/
  188.      +'  SYS   SOURCE SIGMA -Y                   (M)'/
  189.      +'  SZR   REFERNCE SIGMA -Z AT 100M         (M)'/
  190.      +'  SZS   SOURCE SIGMA -Z                   (M)'/
  191.      +'  TEV   TIME OF EVAPORATION               (MIN)'/
  192.      +'  TIM   TIME AFTER FUNCTIONING (INS,HD)   (MIN)'/
  193.      +'  TMC   TIME TO MET CHANGE                (MIN)'/
  194.      +'  TMP   TEMPERATURE                       (DEG C)'/
  195.      +'  TST   TEMPERATURE OF STACK              (DEG C)'/
  196.      +'  VAP   VAPOR PRESSURE                    (MM HG)'/  
  197.      +'  CDP   VAPOR DEPLETION INDICATOR, SEE TAB 2'/   
  198.      +'  VST   VELOCITY OF EFFLUENT FROM STACK   (M/SEC)'/  
  199.      +'  WND   TRANSPORT WIND SPEED              (M/SEC)'/  
  200.      +'  WOO   WOODS TYPE, SEE DSP 36'/ 
  201.      +'  ZZO   ROUGHNESS LENGHT                  (CM)'/ 
  202.      +'  2MC   TWO MINUTE CONNECTIONS CONTROL, SEE TAB 2')  
  203. C------------------------   
  204. C NOV=1 FORMAT STATEMENTS   
  205. C-------------------------  
  206.  1001 FORMAT(8X,'AAD,DPG,EWA,JHI,LBG,NAP,PBA,PAD,RMA,UAD,EUR,NDF')  
  207.  1007 FORMAT(8X,'WIN,SPR,SUM,FAL')  
  208.  1003 FORMAT(8X,'105,155,8IN,500,750,M55,525,139,M23,4.2,NON')  
  209.  1004 FORMAT(8X,'GA,GB,GD,GF,VX,BZ,HY,UD,HD,H1,H3,HT,LL,AC,CG,CK',  
  210.      +           'DM,NA')
  211.  1005 FORMAT(8X,'INS,EVP,SEM,VAR,STK,STJ,FLS,FIR')  
  212.  1006 FORMAT(8X,'A,B,C,D,E,F,U,S,W')
  213.  1012 FORMAT(8X,'GRA,NPR,NDF')  
  214.  1024 FORMAT(8X,'DW,MW,CF,MS,RF')   
  215. C-------------------------  
  216. C NOV=2 FORMAT STATEMENTS   
  217. C-------------------------  
  218.  2000 FORMAT(8X,'0  SHORT LISTING FOR THE EXPERT'/,8X,'1  LISTS'
  219.      $' OPTIONS FOR MULTIPLE CHOISE QUESTIONS'/,8X,'2  DEFINES' 
  220.      $' ALL OPTIONS FOR MULTIPLE CHOISE QUESTIONS'/,8X,'3  EXPL'
  221.      $'AINS PROGRAM INPUTS'/)   
  222.  2005 FORMAT(8X,'AAD    ANNISTON ARMY DEPOT'/8X,
  223.      $'DPG    DUGWAY PROVING GROUND AND TOOELE ARMY DEPOT'/ 8X, 
  224.      $'EWA    EDGEWOOD AREA,APG'/8X,'JHI    JOHNSTON ISLAND'/ 8X,   
  225.      $'LBG    LEXINGTON-BLUE GRASS ARMY DEPOT'/ 8X, 
  226.      $'NAP    NEWPORT AMMUNITION PLANT'/ 8X,'PBA    PINE BLUFF ARSENAL' 
  227.      $/8X,'PAD    PUEBLO ARMY DEPOT'/ 8X,'RMA    ROCKY MOUNTAIN ARSENAL'
  228.      $/8X,'UAD    UMATILLA ARMY DEPOT'/8X,'EUR    USAEUR'/8X,   
  229.      $'NDF    NOT DEFINED') 
  230.  2010 FORMAT(8X,'WIN    WINTER'/8X,'SPR    SPRING'/8X,'SUM    SUMMER'/  
  231.      $8X,'FAL    FALL') 
  232.  2020 FORMAT(8X,'105    105-MM CARTRIDGE,M60,M360'/8X,  
  233.      $'155    155-MM PROJECTILE,M110,M121A1'/8X,
  234.      $'8IN    8-INCH PROJECTILE,M126'/8X,'500    500-LB BOMB,MK94'/8X,  
  235.      $'750    750-LB BOMB,MC-1'/8X,'M55    115-MM ROCKET,M55'/8X,   
  236.      $'525    525-LB BOMB,MK116'/8X,'139    BOMBLET,M139'/8X,   
  237.      $'M23    LAND MINE,M23'/8X,'4.2    4.2-INCH CARTRIDGE,M2A4'/8X,
  238.      $'NON    NONMUNITION') 
  239.  2030 FORMAT (8X,'GA  TABUN',15X,'H1  HN-1,NITROGEN MUSTARD'/ 8X,'GB  SA
  240.      $RIN',15X,'H3  HN-3,NITROGEN MUSTARD'/ 8X,'GD  SOMAN',15X,'HT  60% 
  241.      $HD & 40% T' /8X,'GF  EA 1212',13X,'LL  LEWISITE'/ 8X,'VX  EA 1701'
  242.      $,13X,'AC  HYDROGEN CYANIDE'/ 8X,'BZ  INCAP AGENT', 9X,'CG  PHOSGEN
  243.      $E'/ 8X,'HY  HYDRAZINE',11X,'CK  CYANOGEN CHLORIDE'/ 8X,'UH  UDMH',
  244.      $16X,'DM  ADAMSITE'/ 8X,'HD  DISTILLED MUSTARD', 3X,'NA  NOT AN AGE
  245.      $NT')  
  246.  2040 FORMAT(8X,'INS    INSTANTANEOUS(EXPLOSIVE)'/8X,'EVP    EVAPORATION
  247.      $ FROM A PUDDLE FORMED BY A SPILL'/8X,'SEM    UNIFORM RELEASE FOR A
  248.      $FINITE TIME'/8X,'VAR    SOURCE DEFINED AS A NUMBER OF UNIFORM RELE
  249.      $ASES(MAX 6)'/8X,'STK    RELEASE OF HEATED EFFLUENT FROM STACK'/8X,
  250.      $'STJ    RELEASE FROM STACK WITH JET EFFECT'/8X,'FLS    FLASH FIRE 
  251.      $FROM GROUND LEVEL'/8X,'FIR    FIRE BURNING FOR FINITE TIME')  
  252.  2050 FORMAT(8X,'A',5X,'VERY UNSTABLE'/ 8X,'B',5X,'UNSTABLE'/8X, 'C',5X,
  253.      $       'SLIGHTLY UNSTABLE'/,8X,'D',5X,'NEUTRAL'/,8X,'E',5X,   
  254.      $       'SLIGHTLY STABLE'/,8X,'F',5X,'STABLE'/,8X,'U',5X,  
  255.      $       'UNDEFINED'/,8X,'S',5X,'SELECT(PASQUILL)'/,8X,'W',5X,  
  256.      $       'WOODS')
  257.  2060 FORMAT(8X,'NQI  NUMBER OF TIME INTERVALS')
  258.  2070 FORMAT(8X,'Q()  SOURCE FOR EACH INTERVAL'/,   
  259.      $7X,'TQ()  CUMULATIVE TIME FROM BEGINNING OF FIRST')   
  260.  2080 FORMAT(8X,'GRA  GRAVEL'/8X,'NPR  NONPOROUS(CONCRETE)'/8X,'NDF  NOT
  261.      $ DEFINED')
  262.  2090 FORMAT(8X,'FMW  MOLECULAR WEIGHT',/8X,'FMV  MOLECULAR'
  263.      $' VOLUME'/8X,'VAP  VAPOR PRESSURE (MM HG)'/8X,
  264.      $'BPT  BOILING POINT (DEG K)'/)
  265.  2095 FORMAT(8X,'0  USE HT MAX FROM PLRS'/,8X,'1  LIST F(X),'   
  266.      $' USE HT MAX'/,8X,'2  USE HT=F(X)'/,8X,'3  LIST F(X),'
  267.      $' USE HT=F(X/)')  
  268.  2100 FORMAT(8X,'GRA     GRAVEL, LOOSE EARTH'/8X,'NPR     NONPOROUS,
  269.      $ CONCRETE, BLACKTOP'/8X,'NDF     NOT DEFINED'/' NOTE: THIS CODE   
  270.      $ ONLY DETERMINES THE SIZE OF THE WETTED SURFACE') 
  271.  2110 FORMAT(8X,'DW  DECIDUOUS, WINTER'/ 8X,'MW  MIXED, WINTER'/ 8X,
  272.      $'CF  CONIFEROUS FOREST'/ 8X,'MS  MIXED SUMMER'/ 8X,   
  273.      $'RF  RAIN FOREST')
  274.   500 FORMAT(// 
  275.      $'     The operator may control the length of the questions by'/   
  276.      $' specifying the novice level. Level 2 will define all options,'/ 
  277.      $' level 1 will list the options and level 0 will only state the'/ 
  278.      $' questions. Responding with question marks provides the level'/  
  279.      $' 2 list and the question is repeated.'/
  280.      $'      The sequence of questions is determined by the answers'/   
  281.      $' given.  Units are stated for numeric inputs. "Foreign" units'/  
  282.      $' may be converted by preceeding the number with the character  '/
  283.      $' code identifying the units. Two question marks will cause the '/
  284.      $' code list to be displayed.'/
  285.      $'      The questions terminate with ALL OTHER INPUT.'/
  286.      $' Here only control options or data changes may be entered.'/ 
  287.      $' Again question marks will display the options list. Control '/  
  288.      $' options include restart(RST), stop(STP) and go to(GTO) any'/
  289.      $' question number. The code ALL will complete this input and'/
  290.      $' cause the downwind hazard to be computed.'////) 
  291.   501 FORMAT(/  
  292.      $'     If the changes made in the ALL questions cause the'/
  293.      $' program to reaccess its data base the input logic is re-'/  
  294.      $' scanned. This is shown by a display of the input questions,'/   
  295.      $' but no input is required unless new questions are asked. The'/  
  296.      $' program again stops at the ALL question, and will proceed'/ 
  297.      $' with the answer ALL.'/'      When the downwind hazard esti-'/   
  298.      $' mate has been made the program will terminate at the ALL'/  
  299.      $' question. The operator may change individual parameter values'/ 
  300.      $' [including NOV] and repeat the run or restart or stop.'/
  301.      $' A hold[HLD] may be placed on any variable if you do not wish'/  
  302.      $' its value to be changed by rescan of the data base. Input HLD'/
  303.      $' and the variable code(eg. HLD HML). RLS will release the hold.'/
  304.      $' For more information see Chemical Systems Technical Report'/
  305.      $' ARCSL-TR-82014.'///////)
  306.       END
  307.