X-Git-Url: http://gitweb.hachti.de/?a=blobdiff_plain;f=sw%2Frescue%2Flab8e_goettingen%2Fdisk2_11%2Frkb%2Fparoff%2Fhaepal.ft;fp=sw%2Frescue%2Flab8e_goettingen%2Fdisk2_11%2Frkb%2Fparoff%2Fhaepal.ft;h=13a819df5e33abcea34762645e23f44d22da9d0d;hb=81e70d488b71bf995c459ca3a02c025993460ffa;hp=0000000000000000000000000000000000000000;hpb=07ec0278333ed187ac242dedcff13c56cf1b0b91;p=pdp8.git diff --git a/sw/rescue/lab8e_goettingen/disk2_11/rkb/paroff/haepal.ft b/sw/rescue/lab8e_goettingen/disk2_11/rkb/paroff/haepal.ft new file mode 100644 index 0000000..13a819d --- /dev/null +++ b/sw/rescue/lab8e_goettingen/disk2_11/rkb/paroff/haepal.ft @@ -0,0 +1,227 @@ +C -+-+-+-+-+  H A E P A L . F T  -+-+-+-+-+ +C +C HERE WE PLOT THE ABSOLUT INTENSITIES OF THE 5 FREQUENCY BANDS +C FROM THE POWER SPECTRA STORED ON SCRATCH UNIT 5. +C + SUBROUTINE PALOT + INCLUDE HAEBUF.FI + INCLUDE HAEGSA.FI + INCLUDE HAEPTI.FI + INCLUDE HABRK.FI + INCLUDE HAEI85.FI + INCLUDE HAECSZ.FI + INCLUDE HAETTY.FI + INCLUDE HAPPEN.FI +C + C + LOGICAL MLTPLE + REAL COND + INTEGER NCOND + EXTERNAL MLTPLE,COND,NCOND +C + REAL ORD,ABZ,TEMSET, + * ABMAX(2,5), @ ABSOLUT/ RELATIVE MAXIMUM OF THE BAND INTENSITY DATA + * TE1,TE2,TE3, @ TEMPORARY STORAGE + * INTFAC,ORDMAX @ FACTOR TO SCALE THE INTENSITY OF EACH BAND, MAXIMUM OF THE ORDINATE + INTEGER I,BAND,N, + * RELABS, @ ABS INTENSITY =1, REL INTENSITY =2 + * PNT, @ MOD(I,4)+1 TEMP STORAGE + * SKIPIT @ STARTING LOCATION OF THE DATA SET WANTED + LOGICAL F1, @ SAMPLE BUFFER IS EMPTY FLAG + * L1, @ TEMPORARY STORAGE + * ABISMI @ TIME AXIS SCALING IS IF ABISMI THEN MINUTES ELSE SECONDS FI + INTEGER PENPOS @ TEMPORARY PEN STATUS +C +C STATEMENT FUNCTIONS ARE: +C + INTEGER DATTIM @ STARTING TIME OF THIS POWER SPECTRUM DATA RECORD WITHIN THE SAMPLE + DATTIM(IP1)=INTE(3,1,MOD(IP1,4)+1) + LOGICAL MUSTRD @ MUSTRD DECIDES IF WE HAVE TO READ THE NEXT INTE RECORD + MUSTRD(IP1)=MOD(IP1,4).EQ.0 +C +C OPEN THE INPUT DATA FILE UNIT 5 +C READ THE FIRST BLOCK OF THE FILE HEADER AND +C THE DATA HEADER I.E. COMMON CEGSA THE SECOND BLOCK OF UNIT 5 +C + IF (REC5.LT.1) DEFINE FILE5(MAXBL5,85,U,REC5) + REC5=1 + F1=SAMCNT.EQ.0 .OR. .NOT. COMP @ HEADER OF FILE 5 DOES NOT MATCH THE HEADER OF THE ACTUAL SAMPLE BUFFER + READ (5'REC5) (RCRD0(I),I=1,85) @ READ THE FILE HEADER + IF (F1) SAMCNT=0 @ CLEAR THE ACTUAL SAMPLE BUFFER + IF (F1) COMP=.FALSE. @ AND THE COMPUTATIONS FLAG TOO + IF (REDVAL.NE.6H2DPWLD) GOTO 20 @ RECORD IS EMPTY + REDVAL=0 @ FOR SAVETY ONLY + WRITE (TTO,3) (LABEL(I),I=1,LABCNT) @ TYPE OUT THE LABEL OF THIS DATA SET + READ (5'REC5) LCEGSA(1),(LCEGSA(I),I=2,LCEGSA(1)) @ READ THE DATA HEADER BLOCK ( COMMON CEGESA) + SETNUM=SETNU5 @ INSERT THE NUMBER OF THE ACTUAL DATA SET + CHANEL=CHANE5 @ AND THE NUMBER OF THE CHANNEL INVESTIGATED TOO +C + C HERE WE PLOT THE INTENSITY / TIME +C + BEGIN=NCOND(PZBEG,PZBEG,BEGIN) + ENDS=NCOND(PZEND,PZEND,BEGFFT+SPAN) + IF (OPTION.NE.12) CALL ASKHIM(2) @ ASK FOR BEGIN AND ENDS + PZBEG=BEGIN + PZEND=ENDS +C +C COMPUTE THE MAXIMA OF THE ORDINATE (INTENSITIES) +C + DO 33 BAND=1,5 +33 ABMAX(1,BAND)=0 + N=0 +C READ THE STARTING TIME OF THE INTENSITY DATA COMPUTED AND +C THEN WE COMPUTE THE RECORD NUMBER OF THE INTENSITY DATA WE WANT TO PLOT + REC5=STSCAN @ READ THE FIRST INTENSITY DATA RECORD + READ (5'REC5) INTE85 + SKIPIT=(BEGIN-INTE(3,1,1))/OVRLAP @ THE NUMBER OF DATA POINT TO SKIP --> SKIPIT + IF (SKIPIT.LT.DATCNT) GOTO 25 @ IF THE PLOT EXCEEDS THE DATA COMPUTED + REC5=STSCAN+(DATCNT-1)/4 @ THEN WE PRINT AN ERROR MSG ELSE WE CONTINUE AT 25 + READ (5'REC5) INTE85 @ READ THE LAST RECORD OF THE UNIT 5 + WRITE (TTO,2) PZBEG,PZEND,INTE(3,1,MOD(DATCNT-1,4)) @ AND TYPE THE ERROR MSG +C +25 CONTINUE + REC5=STSCAN+SKIPIT/4 @ READ THE FIRST RECORD WANTED + READ (5'REC5) INTE85 @ +C +C COMPUTE THE MAXIMUM OF EACH BAND +C + DO 35 I=0,DATCNT-1 @ LOOP FOR EACH POWER SPECTRUM + IF (BREAK(11)) RETURN + REC5=STSCAN+I/4 + IF (MUSTRD(I)) READ (5'REC5) INTE85 + IF (DATTIM(I).LT.BEGIN) GOTO 35 @ GO AND FETCH THE NEXT DATA WORDS + IF (DATTIM(I).GT.ENDS) GOTO 34 @ WE MAY LEAVE THIS LOOP - WORK IS DONE + N=N+1 + PNT=MOD(I,4)+1 @ TEMP STORAGE + DO 30 BAND=1,5 @ LOOP FOR EACH BAND +30 ABMAX(1,BAND)=ABMAX(1,BAND)+INTE(1,BAND,PNT) +35 CONTINUE +34 CONTINUE + DO 36 BAND=1,5 +36 ABMAX(1,BAND)=ABMAX(1,BAND)/N*2. +C +C CHECK THE MAXIMUM +C + DO 40 BAND=1,5 +43 TE1=0 @ COUNTS ALL POINTS PLOTTED + TE2=0 @ COUNTS ALL POINTS .GT. MAXIMUM OF PLOT + DO 45 I=0,DATCNT-1 @ WE SCAN ALL DATA ENTRIES + IF (BREAK(11)) RETURN + REC5=STSCAN+I/4 + IF (MUSTRD(I)) READ (5'REC5) INTE85 + IF (DATTIM(I).LT.BEGIN) GOTO 45 @ FETCH THE NEXT DATA WORDS + IF (DATTIM(I).GT.ENDS) GOTO 44 @ THE WORK IS DONE, SO WE LEAVE THE LOOP + TE1=TE1+1. @ COUNTS ALL POINTS HERE + IF (INTE(1,BAND,MOD(I,4)+1).GT.ABMAX(1,BAND)) TE2=TE2+1. @ COUNT ALL POINTS .GT. MAXIMUM +45 CONTINUE +44 CONTINUE +CX WRITE (4,49) TE1,TE2,ABMAX(1,BAND) @ PRINT SOME DIAGNOSTIC MSG +CX49 FORMAT (' TE1:',1P,E8.1,' TE2:',E8.1,' ABMAX:',E8.1) + IF (TE2/TE1.LT.0.02) GOTO 40 @ IF 98% OF ALL POINTS ARE PLOTTED THEN WE PROCEED TO THE NEXT BAND + ABMAX(1,BAND)=ABMAX(1,BAND)*SQRT(2.) + GOTO 43 @ CHECK AGAIN +40 CONTINUE + C +C OPEN THE PLOTTER +C + CALL STPLT @ START THE PLOTTER ( CALL PLOTS) + CALL XYPLOT (XOFSET,YOFSET,-PENUP) +C +C THE LOOP FOR EACH BAND AND THE TOTAL INTENSITY +C + DO 120 BAND=1,5 + IF BREAK(11) GOTO 140 + TEMSET=(YLEN+YSTEP)/5.*FLOAT(5-BAND) + CALL XYPLOT (0,TEMSET,-PENUP) @ SET THE NEW ORIGIN FOR THIS STAMP HERE + RELABS=1 @ WE PLOT THE ABSOLUT INTENSITIES + TE1=ABMAX(RELABS,1) + INTFAC=COND(ABMAX(RELABS,BAND).GT.TE1/2.,1., + * ABMAX(RELABS,BAND).GT.TE1/5., 0.5, + * ABMAX(RELABS,BAND).GT.TE1/10.,0.2 ,0.1) @ NORM TO NEW MAXIMUM + ORDMAX=ABMAX(RELABS,1)*INTFAC @ COMPUTE MAXIMUM OF ORDINATE + CALL FACTOR (XLEN/(ENDS-BEGIN),(YLEN-4.*YSTEP)/5./ORDMAX) +C +C THE LOOP FOR EACH POWER SPECTRUM +C + PENPOS=PENUP + L1=.FALSE. + DO 130 I=0,DATCNT-1 + IF BREAK(11) GOTO 131 @ IF THE USER GETS RID OF THIS TASK THEN EXIT VIA 131 + REC5=STSCAN+I/4 @ COMPUTE THE NUMBER OF THE NEXT RECORD WHERE TO READ INTE85 (4 DATA SETS PER RECORD) + IF (MUSTRD(I)) READ (5'REC5) INTE85 + ORD=INTE(1,BAND,MOD(I,4)+1) @ THE INTENSITY OF THIS BAND --> ORD + PENPOS=NCOND(ORD.GT.ORDMAX.AND.L1,PENUP,PENPOS) @ WE DON'T PLOT POINTS .GT. ORDMAX + L1=ORD.GT.ORDMAX + ORD=AMIN1(ORD,ORDMAX) +C @ THE TIME AXIS STARTS AT BEGIN+SPAN/2. SO WE + ABZ=DATTIM(I) @ INSERT THE TIME SCALE [SECONDS] --> ABZ + IF (ABZ.LT.BEGIN) GOTO 130 @ SKIP ALL THE POINTS BEFORE THE BEGIN TIME + IF (ABZ.GT.ENDS) GOTO 131 @ IF WE PASSED THE END OF THE PLOT THEN WE TERMINATE THE LOOP + + ABZ=ABZ-BEGIN @ ELSE WE PLOT THIS DATA POINT ( THE FIRST ONE WITH PEN UP) RELATIVE TO THE BEGIN OF THE PLOT + CALL XYPLOT (ABZ,ORD,PENPOS) + PENPOS=PENDWN @ 'PEN DOWN' FROM NOW ON + +130 CONTINUE @ LOOP TO FETCH THE NEXT DATA POINT +131 CONTINUE @ ALL THE WORK DONE FOR THE ACTUAL BAND +C +C PLOT THE INTENSITY SCALE +C + IF (BREAK(11)) GOTO 140 @ IF THE USER GET'S RID OF PLOT THEN WE EXIT + CALL WHERE (TE1,TE1,TE1,TE1) @ GET THE ACTUAL Y FACTOR + CALL FACTOR (1.,TE1) @ AND SWITCH X FACTOR TO 1. + CALL XYPLOT (-.5,0,-PENUP) @ LOWER LEFT CORNER + PENPOS=PENUP + DO 132 I=0,10 + TE1=ORDMAX/INTFAC*I/10. + IF (TE1.GT.ORDMAX+ORDMAX/500.) GOTO 133 @ AXIS IS COMPLETE + CALL XYPLOT (0,TE1,PENPOS) + IF (.NOT.(I.EQ.INT(10.*INTFAC+.5) .OR. + * I.EQ.0)) GOTO 110 +C MARK THE START AND THE END OF THE SCALE + CALL WHERE (TE2,TE2,TE2,TE3) @ GET THE X AND Y FACTOR + CALL FACTOR (1.,1.) + CALL NUMBER (-.7-YN*INT(I/10),TE3*TE1-YN*.3,YN,I,0,-1) + CALL FACTOR (TE2,TE3) + CALL XYPLOT (0,TE1,PENUP) +110 PENPOS=PENDWN + TE2=COND(INTFAC.EQ.1. .AND. I.EQ.5,-0.5,-0.3) @ A SMALL BAR TO THE LEFT + CALL XYPLOT (TE2,TE1,PENDWN) +132 CALL XYPLOT (0,TE1,PENDWN) +133 CALL XYPLOT (.5,0,-PENUP) @ RESET CORRECT LOWER LEFT CORNER +C + CALL FACTOR (1.,1.) @ RESET ORIGIN TO XOFSET,YOFSET + CALL SYMBOL (-XOFSET,YLEN*.1,YN,'P',0,1) + IF (GENAM(BAND).NE.2H ) + * CALL GREEK(-XOFSET+YN*.3,YLEN*0.1-.3,YN*0.75,GENAM(BAND),0) +C +C PLOT THE FREQUENCY RANGE OF THIS BAND +C + CALL NUMBER (XLEN+YN*.6,0,YN*.5,FREQU(BAND,1),90.,1) + CALL SYMBOL (999.,999.,YN*.5,'-',90.,1) + CALL NUMBER (999.,999.,YN*.5,FREQU(BAND,2),90.,1) +C + CALL XYPLOT (0.,-TEMSET,-PENUP) +120 CONTINUE + C + CALL PLALRL @ AND NOW WE PLOT THE TIME AXIS + RETURN +C +140 CONTINUE @ USER ABORTS THE PLOT + CALL FACTOR (1.) + CALL XYPLOT (38.,25.,PENUP) @ DRIVE PEN INTO THE UPPER RIGHT CORNER + CALL EXPLT + RETURN +C +20 CONTINUE @ FILE 5 IS EMPTY + COMPUT=0 + SAMCNT=0 + WRITE (TTO,1) @ NO DATA TO PLOT + RETURN +C +1 FORMAT (' KEINE DATEN IN DER DATEI 5') +2 FORMAT (' DER PLOT SOLL VON',I5,' BIS',I5,' SEK. DAMIT UEBER ', + * 'DAS DATENENDE',I5,' SEK. HINAUSGEHEN.') +3 FORMAT (1X,14A6) + END + \ No newline at end of file