sw/rescue/lab8e_goettingen/disk2_11/rkb/paroff/haeadc.ft

   1 C       -+-+-+-+-+ \ e  H A E A D C . F T  \ e -+-+-+-+-+
   2 C
   3 C       * UP  6-OCT-82
   4 C       * UP 25-OCT-82
   5 C       * UP 11-MAY-83
   6 C       * UP 15-JUL-83 IMPROVED FILE OVERFLOW PROTECTION
   7 C       * UP 22-NOV-83 IMPROVED FILE OVERFLOW MESSAGE
   8 C       * UP  1-JUL-85  SCHMITT TRIGGER INPUT
   9 C
  10 C       ANALOG --> DIGITAL CONVERSION AND DATA ACQUISITION
  11         SUBROUTINE ADCON
  12         INCLUDE HAEBUF.FI
  13         INCLUDE HAEHAS.FI
  14         INCLUDE HAEPTI.FI
  15         INCLUDE HABRK.FI
  16         INCLUDE HAETTY.FI
  17         INTEGER TOASCI,NCOND,LOG2
  18         LOGICAL BETW
  19         EXTERNAL TOASCI,NCOND,LOG2,BETW
  20 C
  21 \fC
  22         INTEGER PARMS(4),CSTART         @ THRUPT PARAMETER VECTOR, STARTCHANNEL
  23         EQUIVALENCE (PARMS(1),CSTART)
  24         INTEGER BUFF1(85),BUFF2(85),    @ THRUPT BUFFERS
  25      *  I,TEMP1,TEMP2,TEMP3,C,CH,SS, @ TEMPORARY STORAGE
  26      *  STARTR                          @ BLOCK NUMBER OF THE HEADER FOR THE ACTUAL DATA SET (UNIT 6)
  27      *   ,CLKPRM(4)             @ FIRST PARAMETER TO CLOCK4 (STRIGG CHANNEL BIT PATTERN),
  28         REAL STAT1,STAT2                @ THRUPT STATUS WORDS
  29         EXTERNAL STAT1,STAT2            @ SET BY ADBUFF SAMPLING PROCEDURE
  30         DATA CSTART /0/, CLKPRM /0,1,3,7/
  31 C
  32 C       PREPARE THE DEFAULT VALUES FOR SAMRAT,SAMCNT,CSTART
  33 C        AND READ THE NEW VALUES
  34 C
  35         IF (XSAML.EQ.0) RETURN          @ NO OUTPUT FILE SPACE, SKIP ADCON
  36         PARMS(2)=CHNLS                  @ INSERT THE NUMBER OF INPUT CHANNELS INTO THRUPT PARAMETER VECTOR
  37         TEMP2=0                         @ WE USE IF WE DO A JUMP TO 40
  38         TEMP3=2H00                      @ ""    ""    ""    ""    ""
  39         LABCNT=0                        @ FORCE IDENTIFICATION TO SPACES
  40         SAMCNT=NCOND(SAMCNT,SAMCNT,32*SAMRAT) @ 32 SEC IS THE DEFAULT SAMPLING TIME
  41 C
  42         IF (OPTION.EQ.12) GOTO 22       @ IF 'AD*' THEN WE ASSUME THE DEFAULT PARAMETERS
  43         IF (.NOT.(OPTION.GE.2 .AND. OPTION.LE.10)) GOTO 10
  44         SAMCNT=(OPTION-1)*60*SAMRAT     @ AD1 ... AD9  FROM 1 TO 9 MINUTES TIME
  45         GOTO 20                         @ READ THE DATA SET IDENTIFICATION ONLY
  46 C
  47 10      CONTINUE                        @ COMPUTE THE DEFAULT SAMPLE TIME
  48         I=SAMCNT/SAMRAT                 @ SAMPLE TIME IN SECONDS --> I
  49         CH=NCOND(I.GE.3600,1HH,1HM)     @ COMPUTE THE CORRECT SUFFIX: HOURS OR MINUTES
  50         I=I/NCOND(I.GE.3600,60,1)       @ IF THE SAMPLING TIME EXCEEDS ONE HOUR THEN WE CONVERT INTO MINUTES
  51         MM=TOASCI(I/60)                 @ AND CONVERT INTO ASCII CHARACTERS
  52         SS=TOASCI(MOD(I,60))            @  FOR MINUTES AND SECONDS OR HOURS AND MINUTES
  53         WRITE (TTO,101) MM,CH,SS
  54         READ (TTI,102) MM,C,SS          @ GET THE SAMPLING TIME
  55         IF (BREAK(11)) RETURN           @ USER GET'S RID OF PROGRAM
  56         SS=NCOND(MM+SS,MM*60+SS,I)*
  57      *  NCOND(C.EQ.1HH,60,C.EQ.1HM,1,CH.EQ.1HH,60,1)
  58         WRITE (TTO,103) SAMRAT          @ AND ASK FOR THE SAMPLING FREQUENCY
  59         READ (TTI,104) TEMP1
  60         SAMRAT=NCOND(TEMP1,TEMP1,SAMRAT)
  61         WRITE (TTO,107) SPEED           @  AND ASK FOR THE TAPE SPEED FACTOR
  62         READ (TTI,1) TEMP1
  63         SPEED=NCOND(TEMP1,TEMP1,SPEED.GT.0,SPEED,1)
  64         CSTART=0
  65 CX      WRITE (TTO,105)                 @ ASK FOR START CHANNEL WHERE TO SAMPLE
  66 CX      READ (TTI,104) CSTART
  67         WRITE (TTO,106) CHNLS
  68         READ (TTI,1) I
  69         CHNLS=NCOND(I,I,CHNLS)
  70         PARMS(2)=CHNLS                  @ THE NUMBER OF CHANNELS TO SAMPLE
  71 C
  72         DO 35 I=1,CHNLS
  73         TEMP1=SAMRAT/PACK(I)            @ HERE WE ASK FOR THE SAMPLE RATE OF EACH CHANNEL
  74 36      WRITE (TTO,108) I,TEMP1         @ TYPE CHANNEL NUMBER AND DEFAULT SAMPLE RATE
  75         READ (TTI,104) TEMP2            @ READ THE SAMPLE FREQUENCY
  76         TEMP1=NCOND(TEMP2,TEMP2,TEMP1)  @ IF NO INPUT, THEN WE INSERT THE DEFAULT VALUE
  77         PACK(I)=SAMRAT/TEMP1            @ RATIO (MAX SAMPLE RATE)/(CHANNEL SAMPLE RATE) --> PACK
  78         IF (PACK(I).LT.1) GOTO 36
  79         IF (LOG2(PACK(I)).GE.0) GOTO 35 @ THE RATIO MUST BE A POWER OF TWO, IF SO ASK FOR NEXT CHANNEL
  80         WRITE (TTO,109)                 @  ELSE WE PRINT A MESSAGE AND
  81         TEMP1=SAMRAT                    @  MAKE A NEW DEFAULT VALUE END THEN
  82         GOTO 36                         @  WE ASK AGAIN
  83 35      CONTINUE
  84 C
  85 42      WRITE (TTO,2) STRIGS            @ ASK FOR NUMBER OF SCHMITT TRIGGER INPUTS
  86         READ (TTI,202) I
  87         I=NCOND(I.EQ.1H0,0,I.EQ.1H1,1,I.EQ.1H2,2,I.EQ.1H3,3,STRIGS)
  88         IF (BREAK(11)) RETURN           @ SWITCH 11: RETURN
  89         IF (BETW(0,I,4).AND.CHNLS+I.LE.7) @ WE ALLOW 0 TO 3 BUT NOT MORE THAN 7 CHANNELS AT ALL!
  90      *    GOTO 41
  91         I=MIN0(7-CHNLS,3)               @ COMPUTE CHANNELS LEFT FOR S"TRIGG
  92         WRITE (TTO,201) I
  93         GOTO 42                         @ AND ASK AGAIN
  94 41      STRIGS=I                        @ NUMBER OF STRIG INPUTS --> STRIGS
  95         CALL MOVE (-STRIGS,1,PACK(CHNLS+1))  @ HIGHEST SAMPLE RATE FOR TRIGGERED EVENTS!
  96         SAMCNT=SAMRAT*SS                @ NUMBER OF SAMPLES TO TAKE FOR THE 'SAMRAT' FREQUENCY CHANNEL
  97 \fC
  98 22      CONTINUE                        @ HERE WE COME IF AD* SWITCHED ON
  99         PCKMAX=0
 100         DO 38 C=1,CHNLS+STRIGS          @ FETCH DIVIDER FOR SLOWEST FREQUENCY
 101 38      PCKMAX=MAX0(PCKMAX,PACK(C))
 102 C
 103         HSHDON=.FALSE.                  @ DESTROY HASH CODE TABLE (USED BY ESAM)
 104         CALL MKHASH                     @ MAKE A HASH TABLE TO SEE IF POSSIBLE
 105         IF (.NOT.HSHDON) GOTO 10        @ HASH TABLE TOO LONG, SO WE ASK AGAIN FOR NEW PARAMETERS
 106         HSHDON=.FALSE.                  @ AND NOW WE DESTROY THE HASH CODE TABLE SINCE WE
 107         J=0                             @  WE BUILD THE "SAMPLE VALID" TABLE FOR ADBUFF ROUTINE
 108         DO 39 I=1,PCKMAX                @  INTO THE HASH CODE TABLE IN ORDER TO SAVE CORE
 109         DO 39 C=1,CHNLS+STRIGS
 110         J=J+1
 111 39      HASHV(J)=NCOND(MOD(I,PACK(C)),0,1)
 112 C
 113         TOTSAM=SAMCNT*HSHSIG/PCKMAX     @ TOTAL NUMBER OF SAMPLES (PACKED AND FOR ALL CHANNELS) --> TOTSAM
 114         IF (XSAML.GT.TOTSAM) GOTO 20    @ TEST: SAMCNT MAY NOT EXCEED THE REMAINING FILE SPACE ON UNIT 6
 115 25      CONTINUE                        @ THE BUFFER IS TOO SMALL FOR THIS SAMPLE COUNT, ASK FOR A NEW ONE
 116         TEMP1=XSAML/(HSHSIG*SAMRAT/PCKMAX)/60 @ MINUTES STILL FITTING INTO THE BUFFER --> TEMP1
 117         WRITE (TTO,3) XSAML,TOTSAM,TEMP1,REC6,LASREC @ NUMBER TOO LARGE, BUFFER WILL OVERFLOW
 118         SAMCNT=XSAML/HSHSIG*PCKMAX      @ INSERT THE MAXIMUM SAMPLE COUNT --> SAMCNT
 119         IF (BREAK(11)) RETURN           @ USER GET'S RID OF PROGRAM
 120         GOTO 10                         @ AND ASK AGAIN
 121 C
 122 20      CONTINUE
 123 C       READ THE DATA SET IDENTIFICATION
 124 C
 125 17      CONTINUE
 126         IF (BREAK(11)) RETURN           @ USER GET'S RID OF PROGRAM
 127         WRITE (TTO,5) SIXCNT            @ DATASET IDENTIFICATION?
 128         READ (TTI,6) LABEL
 129         IF (BREAK(11)) RETURN           @ USER GET'S RID OF PROGRAM
 130         DO 15 I=1,10                    @ STRIP OFF THE TRAILING SPACES
 131         IF (LABEL(11-I).NE. 1H ) GOTO 16
 132 15      CONTINUE
 133         GOTO 17                         @ SPACES ARE NO VALID INPUT AT ALL
 134 16      LABCNT=11-I
 135 C
 136 C       PREPARE THE SAMPLING
 137 C
 138 50      CONTINUE
 139         COMP=.FALSE.                    @ WE GET A NEW DATA SET SO THERE ARE NO COMPUTATIONS DONE SO FAR
 140         IF (SAMCNT.EQ.0) GOTO 40        @ NOTHING TO DO, SKIP THE SAMPLING
 141         WRITE (TTO,9)                   @ SKIP A LINE (USED BY ETIME OUTPUT)
 142         COMP=.FALSE.                    @ RESET COMPUT FLAG
 143         PARMS(3)=SAMCNT*(CHNLS+STRIGS)  @ TOTAL NUMBER OF SAMPLES INCLUDING INVALID ONES
 144         PARMS(4)=PCKMAX*(CHNLS+STRIGS) @ LENGTH OF VALID VECTOR
 145         CALL THRUPT (BUFF1,BUFF2,PARMS,HASH,STRIGS
 146      *   ,1.E5/FLOAT(SAMRAT)/FLOAT(SPEED)/12.) @ SET UP BUFFERED A/D CONVERSION AND TRIGGERED EVENTS
 147 C       LAST PARAMTER:
 148 C       TRIGGER FREQUENCY/(AD FREQUENCY)/(# OF SLOTS)
 149 C          1.E5   REQUIRES CLOCK4 WITH RATE OF 30 HZ
 150 C       THIS IS THE RATIO BETWEEN TRIGGER CLOCK AND A/D CLOCK.
 151 C       AT CLOCK1 INTERRUPT FOR A/D SAMPLING WE CLEAR THE CLOCK4 COUNTER.
 152 C       THE TIME OF THE TRIGGER INPUT - TOKEN WITH CLOCK4 - IS DIVIDED BY THE
 153 C       LAST PARAMETER TO THRUPT. THE RESULT IS BETWEEN 0 AND THE # OF SLOTS-1.
 154 C       WITH 12 SLOTS (ONE 8-WORD) WE GET AN ACCURACY OF 1/SAMRAT/12 HZ FOR
 155 C       THE TIME OF THE EVENT. (FOR 64 HZ APPROX 1.3 MILLI SEC
 156 C                               FOR 256 HZ       0.3 MILLI SEC.
 157 C       MAX SAMRAT IS 512 HZ I THINK.
 158 C
 159 C
 160 C       OPEN THE OUTPUT FILE, WRITE THE DATA SET HEADER BLOCK
 161 C
 162         STARTR=REC6                     @ ADR. OF HEADER BLOCK --> STARTR
 163         REDVAL=6HDLWPD2                 @ SET THE READ VALID FLAG
 164         LASREC=(SAMCNT*HSHSIG/PCKMAX+254)/255+REC6+1 @ COMPUTE THE NUMBER OF BLOCKS FOR THIS SAMPLE
 165         WRITE (6'REC6) (RCRD0(I),I=1,85)@ WRITE THE NEW HEADER BLOCK
 166         REDVAL=0                        @ RESET THE READ VALID FLAG
 167         OFFSET=REC6                     @ START ADR. OF THE DATA BUFFER SPACE --> OFFSET
 168 \fC
 169 C       START THE SAMPLING
 170 C
 171         CALL CLOCK1 (8,SAMRAT*SPEED)    @ A/D CONVERSION ENABLED FROM SECOND DK8-EP CLOCK!
 172         CALL CLOCK4 (CLKPRM(STRIGS+1),30.) @ ENABLE TRIGGERED INPUT VIA FIRST CLOCK-100K HZ FREQUENCY
 173         IF BREAK(11) GOTO 60            @ USER DOES NOT KNOW WHAT HE WANTS
 174 100     CALL MARK (SPEED)               @ TYPE OUT THE TIME ELAPSED
 175 111     IF(STAT1-0.5) 100,110,120
 176 110     WRITE (6'REC6) BUFF1            @ TRANSFER 255 SAMPLES ONTO MASS STORAGE
 177         CALL RELEAS (1)
 178         IF (REC6 .EQ. LASREC) GOTO 30   @ LOOK IF THE WORK IS DONE
 179 CX      IF (REC6.LT.LASREC-1 .AND.BREAK(11)) GOTO 60 @ USER ABORT ONLY IF THERE ARE AT LEAST 256 SAMPLES LEFT
 180         GOTO 211
 181 200     CALL MARK (SPEED)               @ TYPE OUT THE TIME ELAPSED
 182 211     IF (STAT2-0.5) 200,210,220
 183 210     WRITE (6'REC6) BUFF2            @ TRANSFER 255 SAMPLES ONTO MASS STORAGE
 184         CALL RELEAS (2)
 185         IF (REC6 .EQ. LASREC) GOTO 30   @ LOOK IF THE WORK IS DONE
 186         IF (REC6.LT.LASREC-1 .AND.BREAK(11)) GOTO 60 @ USER ABORT ONLY IF THERE ARE AT LEAST 256 SAMPLES LEFT
 187         GOTO 111                        @ GO AND WAIT FOR BUFFER # 1
 188 120     TEMP1=1                         @ BUFFER 1 OVERFLOW
 189         GOTO 125
 190 220     TEMP1=2                         @ BUFFER TWO OVERFLOW
 191 125     WRITE (TTO,7) I,TEMP1           @ SAMPLING TOO FAST
 192         GOTO 10                         @ TRY ONCE MORE
 193 C
 194 C       SAMPLING FINISHED
 195 C
 196 60      CONTINUE                        @ USER SWITCHED SW 11
 197         TEMP2=MAX1(0,TIME(TEMP2)+0.5)*SPEED @ GET SAMPLING TIME PRIOR TO ANY OUTPUT
 198         SAMCNT=(REC6-STARTR-1)*255*PCKMAX/HSHSIG @ COMPUTE NUMBER OF SAMPLES TOKEN
 199         LASREC=REC6-1                   @ INSERT THE NEW SAMCNT AND LASREC INTO THE HEADER BLOCK
 200         REC6=STARTR                     @ ADR. OF HEADER BLOCK --> REC6
 201         REDVAL=6HDLWPD2                 @ SET THE READ VALID FLAG
 202         WRITE (6'REC6) (RCRD0(I),I=1,85) @ AND WRITE THE NEW HEADER BLOCK
 203         REDVAL=0                        @ RESET THE READ VALID FLAG
 204         WRITE (TTO,8)                   @ PRINT A MESSAGE
 205 61      IF (STAT1.LE.0.6 .AND. STAT2.LE.0.6) GOTO 61 @ BUFF1 & BUFF2 MAY BE OVERLAYS, SO WE HAVE TO WAIT UNTIL THRUPT ABORTS
 206         GOTO 62                         @ SAMPLING TIME ALREADY TOKEN
 207 30      CONTINUE                        @ WE COME HERE IF ALL SAMPLES TOKEN, SO THE WORK IS DONE
 208         TEMP2=INT(MAX0(0,TIME(TEMP2))+0.5)*SPEED @ COMPUTE THE TIME ELAPSED
 209 62      CONTINUE                        @ ABORT COMES HERE
 210         TEMP3=TOASCI(MOD(TEMP2,60))     @ ASCII SECONDS
 211         TEMP2=TEMP2/60                  @ MINUTES
 212 40      CONTINUE
 213         TEMP1=PARMS(2)+CSTART-1         @ TO FORM A PRETTY LIST: LAST CHANNEL WE SAMPLED --> TEMP1
 214         C=2H &
 215         WRITE (TTO,4) SAMCNT,TEMP2,TEMP3,(I,C,I=CSTART,TEMP1)
 216         IF (STRIGS.EQ.0) RETURN         @ NO SCHMITT TRIGGER INPUT - NO MSG
 217         WRITE (TTO,203) (I,C,I=1,STRIGS) @ MAKE A PRETTY LIST
 218         RETURN
 219 101     FORMAT (' MESSDAUER         (',A2,A1,A2,')? ',$)
 220 102     FORMAT (I2,A1,I2)
 221 103     FORMAT (' MESSRATE-MAXIMAL (',I3,' HZ)? ',$)
 222 104     FORMAT (I3)
 223 105     FORMAT (' STARTKANAL         (0)   ? ',$)
 224 106     FORMAT (' ANZAHL KANAELE     (',I1,')   ? ',$)
 225 107     FORMAT (' VERVIELFACHER      (',I1,')   ? ',$)
 226 108     FORMAT (' MESSRATE KANAL',I2,' (',I3,' HZ)?',$)
 227 109     FORMAT (' (MESSRATE MAXIMAL)/(KANALMESS RATE) MUSS EINE ZWEIER'
 228 201     FORMAT (' FALSCHE EINGABE - NUR 0 BIS',I2,', ZULAESSIG.')
 229      *   ,'-POTENZ SEIN!')
 230 202     FORMAT (A1)
 231 203     FORMAT (3X,'UND VON DEN SCHMITT TRIGGER EINGAENGEN :',3(I2,A2))
 232 1       FORMAT (I1)
 233 2       FORMAT (' ANZAHL SCHMITT TRIGGER EINGAENGE? (',I1,') ',$)
 234 3       FORMAT (' MEHR ALS',2P,E9.1,' MESSWERTE:',E9.1,
 235      *  ' NUR NOCH FUER',I4,' MINUTEN PLATZ.'/1X,E10.2,'/',E10.2)
 236 4       FORMAT (I8,' PUNKTE IN',I4,':',A2,' MINUTEN VON KANAL',
 237      *   7(I2,A2))
 238 5       FORMAT (' DATENSATZ',I3,' BEZEICHNUNG ? ',$)
 239 6       FORMAT (10A6)
 240 7       FORMAT (' WORT',I5,' PUFFER',I2,' MESSFREQUENZ ZU HOCH:',
 241      *  /' MESSRATE VERKLEINERN.')
 242 8       FORMAT (' MESSUNG ABGEBROCHEN.')
 243 9       FORMAT (1X)
 244         END
 245 \1a