Commit | Line | Data |
---|---|---|
81e70d48 PH |
1 | C -+-+-+-+-+ \ e H A E S C M . F T \ e -+-+-+-+-+\r |
2 | C\r | |
3 | C COMPUTE SOME VALUES IN THE X Y AREA\r | |
4 | C\r | |
5 | C UP 2-MAR-84 ADDS ANGULAR DISTRBUTION HISTOGRAM\r | |
6 | C UP 4-MAR-84 PLOTS THE ANGULAR DISTRIBUTION HISTOGRAM\r | |
7 | C\r | |
8 | SUBROUTINE SCMPUT\r | |
9 | INCLUDE HAEBUF.FI\r | |
10 | INCLUDE HAETTY.FI\r | |
11 | INCLUDE HAEGSA.FI\r | |
12 | INCLUDE HAEPTI.FI\r | |
13 | INCLUDE HAPPEN.FI\r | |
14 | INCLUDE HAECSZ.FI\r | |
15 | INCLUDE HABRK.FI\r | |
16 | REAL XYSAM,TIME,ATAN2,COND\r | |
17 | INTEGER TOASCI,NCOND\r | |
18 | EXTERNAL XYSAM,TIME,TOASCI,NCOND,ATAN2,COND\r | |
19 | C\r | |
20 | \f REAL DELX,DELY,XY\r | |
21 | REAL XAMED,YAMED, @ ARITHMETISCHER MITTELWERT ALLER PUNKTE\r | |
22 | * CPUTIM, @ HERE WE STORE THE COMPUTERS TIME NEEDED\r | |
23 | * MERADI,DMERAD, @ MITTLERE GEOMETRISCHE ENTFERNUNG (XAMED,YAMED) ZU ALLEN PUNKTEN \r | |
24 | C @ DAS IST EIN KREIS UM DEN MITTELPUNKT MIT RADIUS MERADI, \r | |
25 | C @ DMERAD IST DIE STANDARTABWEICHUNG DAZU\r | |
26 | * MEXY, @ MITTLERER WEG ZWISCHEN ZWEI MESSPUNKTEN\r | |
27 | * DEMEXY, @ STANDARTABWEICHUNG DAZU\r | |
28 | * PERIOD, @ 1/SAMRAT\r | |
29 | * FLACH @ MERADI**2 * 3.1416 : DIE FLAECHE DES KREISES UM XAMED,YAMED\r | |
30 | * ,ANGHIS(36),WINK(36) @ ANGULAR DISTRIBUTION HISTOGRAM\r | |
31 | INTEGER I,J,POS1,POSIT,\r | |
32 | * S0,S1, @ BEGIN, END OF EXAMINATION\r | |
33 | * MM,SS,MMM,SSS,TE, @ SOME TEMPS\r | |
34 | * CA,CO @ CHANNEL OF ABZISSE, ORDINATE\r | |
35 | C\r | |
36 | C STATEMENT FUNCTIONS:\r | |
37 | C\r | |
38 | XSAM(IP1)=XYSAM(IP1,CA)\r | |
39 | YSAM(IP1)=XYSAM(IP1,CO)\r | |
40 | ANGLE(IP3)=MOD(INT((ABS(ATAN2(YSAM(IP3)-YAMED,XSAM(IP3)-XAMED))\r | |
41 | * +COND(YSAM(IP3)-YAMED.LT.0,3.1416))*5.7297+.5),36)+1 @ THIS REALLY WORKS\r | |
42 | PHYTAG(P1,P2)=SQRT(P1*P1+P2*P2)\r | |
43 | DIST (IP3) =PHYTAG(XAMED-XSAM(IP3),YAMED-YSAM(IP3))\r | |
44 | XCON(IP4)=COND(ABS(XSAM(IP4)-XSAM(IP4-1)).GT.3,\r | |
45 | * XSAM(IP4)-XSAM(IP4-1))\r | |
46 | YCON(IP4)=COND(ABS(YSAM(IP4)-YSAM(IP4-1)).GT.3,\r | |
47 | * YSAM(IP4)-YSAM(IP4-1))\r | |
48 | C\r | |
49 | IF (SAMCNT.EQ.0) RETURN @ NO SAMPLE TOKEN, RETURN\r | |
50 | IF (OPTION.NE.12) CALL ASKHIM(4) @ IF SC* THEN DO NOT ASK FOR BEGIN,SPAN\r | |
51 | IF (BREAK(11)) GOTO 70 @ USER GETS RID OF PROGRAM\r | |
52 | CPUTIM=TIME(I) @ GET THE TIME OF START\r | |
53 | C\r | |
54 | WRITE (3,2) \r | |
55 | CA=0\r | |
56 | CO=1\r | |
57 | DO 50 POS1=BEGIN*SAMRAT,ENDS*SAMRAT-1,OVRLAP*SAMRAT\r | |
58 | POSIT=POS1+SPAN*SAMRAT @ THIS IS THE END OF THE ACTUAL SCAN\r | |
59 | IF (POSIT.GT.ENDS*SAMRAT) GOTO 60 @ SKIP LAST OVERLAPPING COMPUTATION\r | |
60 | S0=POS1\r | |
61 | S1=S0+SPAN*SAMRAT\r | |
62 | XAMED=XSAM(S0)\r | |
63 | YAMED=YSAM(S0)\r | |
64 | C\r | |
65 | DO 10 I=S0+1,S1,1\r | |
66 | XAMED=XSAM(I)+XAMED\r | |
67 | YAMED=YSAM(I)+YAMED\r | |
68 | 10 CONTINUE\r | |
69 | YAMED=YAMED/(S1-S0) @ ARITHMETISCHER MITTELWERT\r | |
70 | XAMED=XAMED/(S1-S0)\r | |
71 | C\r | |
72 | C BERECHNE DIE WEGLAENGE\r | |
73 | C\r | |
74 | XY=0\r | |
75 | IF(BREAK(11)) GOTO 70\r | |
76 | DO 15 I=S0+1,S1 @ S1-S0 PUNKTE\r | |
77 | \r | |
78 | 15 XY=XY+PHYTAG(XCON(I),YCON(I))\r | |
79 | C\r | |
80 | C MITTLERE WEGLAENGE IM EINEM MESSINTERVALL (1/SAMRAT SEC.)\r | |
81 | C\r | |
82 | MEXY=XY/(S1-S0) @ MITTLERE WEGLAENGE ZWISCHEN ZWEI PUNKTEN --> MEXY\r | |
83 | DEMEXY=0 @ UND JETZT BERECHNEN WIR DIE STANDARTABWEICHUNG\r | |
84 | DO 17 I=S0+1,S1 @ S1-S0 PUNKTE\r | |
85 | 17 DEMEXY=(MEXY-PHYTAG(XCON(I),YCON(I)))**2+DEMEXY @ S1-S0-1 PUNKTE NUR!\r | |
86 | DEMEXY=SQRT(DEMEXY/(S1-S0-1)) @ STANDARTABWEICHUNG --> DEMEXY\r | |
87 | C\r | |
88 | C MITTLERER KREIS UM (XAMED,YAMED)\r | |
89 | C\r | |
90 | MERADI=0\r | |
91 | DO 20 I=S0,S1 @ S1-S0+1 PUNKTE\r | |
92 | 20 MERADI=MERADI+DIST(I)\r | |
93 | MERADI=MERADI/(1+S1-S0) @ MITTLERER KREIS\r | |
94 | C\r | |
95 | C STANDARTABWEICHUNG ZU MERADI\r | |
96 | C\r | |
97 | DMERAD=0\r | |
98 | DO 30 I=S0,S1 @ S1-S0+1 PKT\r | |
99 | 30 DMERAD=(MERADI-DIST(I))**2+DMERAD\r | |
100 | DMERAD=SQRT(DMERAD/(S1-S0))\r | |
101 | C\r | |
102 | C ANGULAR DISTRIBUTION HISTOGRAM ( HUFSCHMIDT ET AL.)\r | |
103 | IF (BREAK(11)) GOTO 70\r | |
104 | CALL MOVE (-36,0,ANGHIS)\r | |
105 | DO 35 I=S0,S1 @ ANOTHER SCAN \r | |
106 | TE=ANGLE(I)\r | |
107 | 35 ANGHIS(TE)=ANGHIS(TE)+1 @ HERE WE COMPUTE THE HISTOGRAM\r | |
108 | \fC\r | |
109 | C\r | |
110 | C PREPARE THE OUTPUT LINE\r | |
111 | C\r | |
112 | MM=TOASCI(S0/SAMRAT/60)\r | |
113 | SS=TOASCI(MOD(S0/SAMRAT,60))\r | |
114 | MMM=TOASCI((S1/SAMRAT)/60)\r | |
115 | SSS=TOASCI(MOD(S1/SAMRAT,60))\r | |
116 | C\r | |
117 | PERIOD=1./SAMRAT\r | |
118 | FLACH =MERADI**2*3.141593\r | |
119 | WRITE (3,1) LABEL,MM,SS,MMM,SSS,\r | |
120 | * XAMED,YAMED,MERADI,FLACH,DMERAD,XY,PERIOD,MEXY,DEMEXY\r | |
121 | WRITE (3,4) ((ANGHIS(I+J),J=1,28,9),I=0,8)\r | |
122 | C\r | |
123 | C HERE WE PLOT THE SWAY DIRECTION HISTOGRAM\r | |
124 | DO 110 I=1,36\r | |
125 | 110 WINK(I)=(I*10.-5.)*.017453 @ FILL 0 TO 2*PI IN 5 DEGREE STEPS\r | |
126 | IF (BREAK(11)) GOTO 70\r | |
127 | CALL TWAIT (10000) @ WAIT FOR THE PRINTER TO COMPLETE\r | |
128 | CALL STPLT\r | |
129 | CALL XYPLOT (XOFSET,YOFSET,-PENUP)\r | |
130 | CALL XYPLOT (XLEN/2.,(YLEN-1.)/2.,-PENUP) @ SET ORIGIN FOR POLAR PLOT RTN\r | |
131 | CALL POLAR (ANGHIS,WINK,36,1,0,3,0,(YLEN-1.)/200.)\r | |
132 | CALL XYPLOT(-XLEN/2.,-(YLEN-1.)/2.,-PENUP)\r | |
133 | CALL LABPLT(0,-YOFSET,ENDS)\r | |
134 | IF (BREAK(11)) GOTO 120\r | |
135 | CALL SYMBOL (-YZ,2*YZ,YZ,'SWAY DIRECTION HISTOGRAM',90.,25)\r | |
136 | CALL SYMBOL(YZ,YLEN+YZ,YZ,LABEL,0,MIN0(42,LABCNT*6)) @ PLOT 42 CHARACTERS INTO THE FIRST LINE OF LABEL\r | |
137 | IF (LABCNT.GT.7)\r | |
138 | * CALL SYMBOL (YZ,YLEN,YZ,LABEL(8),0,LABCNT*6-42) @ AND THE REMAINING INTO THE NEXT LINE\r | |
139 | 120 CALL XYPLOT (38.,25.,PENUP)\r | |
140 | CALL EXPLT\r | |
141 | IF (BREAK(11)) GOTO 70 @ USER GET'S RID OF PLOTTER\r | |
142 | C\r | |
143 | C\r | |
144 | 50 CONTINUE\r | |
145 | 60 CONTINUE\r | |
146 | CPUTIM=TIME(I)-CPUTIM @ COMPUTE EXECUTION TIME\r | |
147 | WRITE (TTO,3) CPUTIM\r | |
148 | 70 RETURN\r | |
149 | 1 FORMAT (1X,10A6,T100,A2,1H:,A2,' --> ',A2,1H:,A2,\r | |
150 | * /' MITTE X',F7.1,' Y',F7.1,5X,\r | |
151 | * 'RADIUS',F6.1,' FLAECHE',F8.0,' S.A.',F5.1,\r | |
152 | * 3X,'WEG',F7.0,3X,'FUER',F6.3,' SEC. WEG',F6.3,' S.A.',F6.2)\r | |
153 | 2 FORMAT (/50(2H -)/1X,13A6)\r | |
154 | 3 FORMAT (' RECHENZEIT:',F6.1,' SEC')\r | |
155 | 4 FORMAT ('0 HISTOGRAMM DER WINKELVERTEILUNG: ARCTAN (YI/XI)',\r | |
156 | * ' POSITION HISTOGRAM',//,22X,\r | |
157 | * ,' 1. QUADRANT 2. QUADRANT 3. QUADRANT 4. QUADRANT '//\r | |
158 | * ,2(5(21X,4F12.0/)/))\r | |
159 | END\r | |
160 | \1a\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0 |