-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathENVELOP.SRC
2242 lines (2239 loc) · 172 KB
/
ENVELOP.SRC
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
PROGRAM ENVELOPE
C
C ROUTINE TO CREATE CONSTANT-VALUE ENVELOPES FROM THE
C CUBES OF DATA PRODUCED BY THE ROUTINE CUBE
C
CHARACTER*80 TITLE
CHARACTER*40 WQUB,WENV
CHARACTER*4 FQUB,FENV
DIMENSION T(50,50,50),EYE(3),SLAB(52,52)
DATA IFLAG /7/, FQUB /'.qub'/, FENV /'.env'/
C
CALL PLOTS (53,0,2)
CALL PLOT (0.0,0.0,3)
C
C FOR UNIX IMPLEMENTATION
C
C CALL MAKNAME(1,WQUB,ILEN,FQUB)
C CALL MAKNAME(1,WENV,ILEN,FENV)
C IF (ILEN .EQ. 0) STOP ' usage: envelope qubfile '
C
OPEN (30,FILE=WQUB)
OPEN (2,FILE=WENV)
C
WRITE (6,100)
100 FORMAT(' EYE POSITION ',$)
READ (5,*) (EYE(I),I=1,3)
WRITE (6,110)
110 FORMAT(' OUTER CONTOUR VALUE ',$)
READ (5,*) TISO
WRITE (6,130)
130 FORMAT(' LARGER VALUES INSIDE OR OUTSIDE ENVELOPE ',$)
READ (5,*) INO
C
IFLAG = IFLAG*INO
C
OPEN (30)
READ (30,*) IX,IY,IZ
DO 1000 I = 1,IX
DO 1000 J = 1,IY
READ (30,*) (T(I,J,K),K=1,IZ)
1000 CONTINUE
C
CALL ISOSRF(T,50,IX,50,IY,IZ,EYE,52,SLAB,TISO,IFLAG)
C
CALL PLOT(0.,0.,999)
END SUBROUTINE DRAWI (IXA,IYA,IXB,IYB) ISO02076
C ISO02077
C INCLUDED FOR USE BY PWRZ ISO02078
C ISO02079
CALL FRSTC (IXA,IYA,1) ISO02080
CALL FRSTC (IXB,IYB,2) ISO02081
RETURN ISO02082
END ISO02083
SUBROUTINE DRCNTR (Z,L,MM,NN) ISO00933
C ISO00934
DIMENSION Z(L,NN) ISO00935
C ISO00936
C THIS ROUTINE TRACES A CONTOUR LINE WHEN GIVEN THE BEGINNING BY STLINE.ISO00937
C TRANSFORMATIONS CAN BE ADDED BY DELETING THE STATEMENT FUNCTIONS FOR ISO00938
C FX AND FY IN DRLINE AND MINMAX AND ADDING EXTERNAL FUNCTIONS. ISO00939
C X=1. AT Z(1,J), X=FLOAT(M) AT Z(M,J). X TAKES ON NON-INTEGER VALUES. ISO00940
C Y=1. AT Z(I,1), Y=FLOAT(N) AT Z(I,N). Y TAKES ON NON-INTEGER VALUES. ISO00941
C ISO00942
COMMON /ISOSR6/ IX ,IY ,IDX ,IDY , ISO00943
1 IS ,ISS ,NP ,CV , ISO00944
2 INX(8) ,INY(8) ,IR(500) ,NR ISO00945
COMMON /ISOSR9/ BIG ,IXBIT ISO00946
C ISO00947
LOGICAL IPEN ,IPENO ISO00948
C ISO00949
DATA IOFFP,SPVAL/0,0./ ISO00950
DATA IPEN,IPENO/.TRUE.,.TRUE./ ISO00951
C ISO00952
C PACK X AND Y ISO00953
C ISO00954
IPXY(I1,J1) = ISHFT(I1,IXBIT)+J1 ISO00955
FX(X1,Y1) = X1 ISO00956
FY(X1,Y1) = Y1 ISO00957
C(P11,P21) = (P11-CV)/(P11-P21) ISO00958
C ISO00959
M = MM ISO00960
N = NN ISO00961
IF (IOFFP .EQ. 0) GO TO 10 ISO00962
ASSIGN 100 TO JUMP1 ISO00963
ASSIGN 150 TO JUMP2 ISO00964
GO TO 20 ISO00965
10 ASSIGN 120 TO JUMP1 ISO00966
ASSIGN 160 TO JUMP2 ISO00967
20 IX0 = IX ISO00968
IY0 = IY ISO00969
IS0 = IS ISO00970
IF (IOFFP .EQ. 0) GO TO 30 ISO00971
IX2 = IX+INX(IS) ISO00972
IY2 = IY+INY(IS) ISO00973
IPEN = Z(IX,IY).NE.SPVAL .AND. Z(IX2,IY2).NE.SPVAL ISO00974
IPENO = IPEN ISO00975
30 IF (IDX .EQ. 0) GO TO 40 ISO00976
Y = IY ISO00977
ISUB = IX+IDX ISO00978
X = C(Z(IX,IY),Z(ISUB,IY))*FLOAT(IDX)+FLOAT(IX) ISO00979
GO TO 50 ISO00980
40 X = IX ISO00981
ISUB = IY+IDY ISO00982
Y = C(Z(IX,IY),Z(IX,ISUB))*FLOAT(IDY)+FLOAT(IY) ISO00983
50 IF (IPEN) CALL FRSTS (FX(X,Y),FY(X,Y),1) ISO00984
60 IS = IS+1 ISO00985
IF (IS .GT. 8) IS = IS-8 ISO00986
IDX = INX(IS) ISO00987
IDY = INY(IS) ISO00988
IX2 = IX+IDX ISO00989
IY2 = IY+IDY ISO00990
IF (ISS .NE. 0) GO TO 70 ISO00991
IF (IX2.GT.M .OR. IY2.GT.N .OR. IX2.LT.1 .OR. IY2.LT.1) GO TO 190 ISO00992
70 IF (CV-Z(IX2,IY2)) 80, 80, 90 ISO00993
80 IS = IS+4 ISO00994
IX = IX2 ISO00995
IY = IY2 ISO00996
GO TO 60 ISO00997
90 IF (IS/2*2 .EQ. IS) GO TO 60 ISO00998
GO TO JUMP1,(100,120) ISO00999
100 ISBIG = IS+(8-IS)/6*8 ISO01000
IX3 = IX+INX(ISBIG-1) ISO01001
IY3 = IY+INY(ISBIG-1) ISO01002
IX4 = IX+INX(ISBIG-2) ISO01003
IY4 = IY+INY(ISBIG-2) ISO01004
IPENO = IPEN ISO01005
IF (ISS .NE. 0) GO TO 110 ISO01006
IF (IX3.GT.M .OR. IY3.GT.N .OR. IX3.LT.1 .OR. IY3.LT.1) GO TO 190 ISO01007
IF (IX4.GT.M .OR. IY4.GT.N .OR. IX4.LT.1 .OR. IY4.LT.1) GO TO 190 ISO01008
110 IPEN = Z(IX,IY).NE.SPVAL .AND. Z(IX2,IY2).NE.SPVAL .AND. ISO01009
1 Z(IX3,IY3).NE.SPVAL .AND. Z(IX4,IY4).NE.SPVAL ISO01010
120 IF (IDX .EQ. 0) GO TO 130 ISO01011
Y = IY ISO01012
ISUB = IX+IDX ISO01013
X = C(Z(IX,IY),Z(ISUB,IY))*FLOAT(IDX)+FLOAT(IX) ISO01014
GO TO 140 ISO01015
130 X = IX ISO01016
ISUB = IY+IDY ISO01017
Y = C(Z(IX,IY),Z(IX,ISUB))*FLOAT(IDY)+FLOAT(IY) ISO01018
140 GO TO JUMP2,(150,160) ISO01019
150 IF (.NOT.IPEN) GO TO 170 ISO01020
IF (IPENO) GO TO 160 ISO01021
C ISO01022
C END OF LINE SEGMENT ISO01023
C ISO01024
CALL FRSTS (D1,D2,3) ISO01025
CALL FRSTS (FX(XOLD,YOLD),FY(XOLD,YOLD),1) ISO01026
C ISO01027
C CONTINUE LINE SEGMENT ISO01028
C ISO01029
160 CALL FRSTS (FX(X,Y),FY(X,Y),2) ISO01030
170 XOLD = X ISO01031
YOLD = Y ISO01032
IF (IS .NE. 1) GO TO 180 ISO01033
NP = NP+1 ISO01034
IF (NP .GT. NR) GO TO 190 ISO01035
IR(NP) = IPXY(IX,IY) ISO01036
180 IF (ISS .EQ. 0) GO TO 60 ISO01037
IF (IX.NE.IX0 .OR. IY.NE.IY0 .OR. IS.NE.IS0) GO TO 60 ISO01038
C ISO01039
C END OF LINE ISO01040
C ISO01041
190 CALL FRSTS (D1,D2,3) ISO01042
RETURN ISO01043
END ISO01044
SUBROUTINE FILLIN ISO01994
C ISO01995
COMMON /ISOSR2/ LX ,NX ,NY ,ISCR(8,128), ISO01996
1 ISCA(8,128) ISO01997
COMMON /ISOSR5/ NBPW ,MASK(16) ,GENDON ISO01998
LOGICAL GENDON ISO01999
COMMON /ISOSR7/ IENTRY ,IONES ISO02000
LOGICAL YCHANG ,HBFLAG ,FIRST ,IHF ISO02001
C ISO02002
IF (IENTRY .EQ. 0) RETURN ISO02003
C ISO02004
C THIS IS A SHADING ALGORITHM IT IS USED TO DETERMINE CONTOUR LINES ISO02005
C THAT ARE HIDDEN BY THE PRESENT LINE. THE ALGORITHM PROCESSES ISO02006
C HORIZONTAL ROWS. IT ASSUMES THAT THE BIT PATTERN PASSED TO IT ISO02007
C HAS ONLY BITS SET TO MARK THE START AND END OF SHADING. THE ISO02008
C ALGORITHM ALSO ASSUMES THAT WHEN AN ON BIT IS ENCOUNTERED THAT A ISO02009
C CORRESPONDING OFF BIT IS INCLUDED IN THE SAME ROW. ISO02010
C ISO02011
C ISO02012
C PULL OUT ROWS OF THE CONTOUR PATTERN ISO02013
C ISO02014
IBVAL = 0 ISO02015
DO 80 IYNOW=1,NY ISO02016
DO 40 IXNOW=1,LX ISO02017
C ISO02018
C IF NO ACTIVATED BITS BRANCH ISO02019
C ISO02020
ICRWD = ISCR(IXNOW,IYNOW) ISO02021
IF (ICRWD .EQ. 0) GO TO 30 ISO02022
C ISO02023
C ACTIVATED BITS IN WORD SET SHADING FLAG ISO02024
C ISO02025
C CHECK BIT BY BIT FOR ON/OFF FLAGS ISO02026
C ISO02027
DO 20 IB=1,NBPW ISO02028
IBIT = (NBPW+1)-IB ISO02029
C ISO02030
C ISO02031
C PULL OUT THE CURRENT GRID POINT VALUE ISO02032
C ISO02033
IVAL = IAND(ICRWD,MASK(IBIT)) ISO02034
C ISO02035
C IF IVAL SET, THIS IS AN ON/OFF FLAG ISO02036
C ISO02037
IF (IVAL .EQ. 0) GO TO 10 ISO02038
C ISO02039
C FLAG BIT, ALWAYS SET ISO02040
C ISO02041
IBVAL = MOD(IBVAL+1,2) ISO02042
GO TO 20 ISO02043
C ISO02044
C SHADE THE SCREEN ACCORDING TO THE STATUS OF IBVAL ISO02045
C ISO02046
10 IF (IBVAL .NE. 0) ICRWD = IOR(ICRWD,MASK(IBIT)) ISO02047
C ISO02048
20 CONTINUE ISO02049
C ISO02050
C ZERO OUT THE SCREEN ISO02051
C ISO02052
ISCR(IXNOW,IYNOW) = 0 ISO02053
ISCA(IXNOW,IYNOW) = IOR(ICRWD,ISCA(IXNOW,IYNOW)) ISO02054
GO TO 40 ISO02055
C ISO02056
30 IF (IBVAL .NE. 0) ISCA(IXNOW,IYNOW) = IONES ISO02057
40 CONTINUE ISO02058
C ISO02059
C FIX FOR NONCORRECTABLE RUNAWAYS ISO02060
C ISO02061
IF (IBVAL .EQ. 0) GO TO 80 ISO02062
IBVAL = 0 ISO02063
DO 70 K=1,LX ISO02064
ITEST = 0 ISO02065
IF (IYNOW .EQ. 1) GO TO 50 ISO02066
ITEST = ISCA(K,IYNOW-1) ISO02067
IF (IYNOW .EQ. NY) GO TO 60 ISO02068
50 ITEST = IOR(ITEST,ISCA(K,IYNOW+1)) ISO02069
60 ISCA(K,IYNOW) = ITEST ISO02070
70 CONTINUE ISO02071
C ISO02072
80 CONTINUE ISO02073
RETURN ISO02074
END ISO02075
SUBROUTINE FRSTC (MX,MY,IENT) ISO01710
C ISO01711
COMMON /ISOSR2/ LX ,NX ,NY ,ISCR(8,128), ISO01712
1 ISCA(8,128) ISO01713
COMMON /ISOSR4/ RX ,RY ISO01714
COMMON /ISOSR5/ NBPW ,MASK(16) ,GENDON ISO01715
LOGICAL GENDON ISO01716
COMMON /ISOSR8/ NMASK(16) ,IXOLD ,IYOLD ,IBTOLD , ISO01717
1 HBFLAG ,IOSLSN ,LRLX ,IFSX , ISO01718
2 IFSY ,FIRST ,IYDIR ,IHX , ISO01719
3 IHB ,IHS ,IHV ,IVOLD , ISO01720
4 IVAL ,IHRX ,YCHANG ,ITPD , ISO01721
5 IHF ISO01722
LOGICAL YCHANG ,HBFLAG ,FIRST ,IHF ISO01723
C ISO01724
C ISO01725
C DRAW LINE TO THE POINT MX,MY ISO01726
C ISO01727
C ENTER THE POINT INTO THE CURRENT SCREEN, ISCR, IF THE POINT CONFORMS ISO01728
C TO THE SHADING ALGORITHM. ISO01729
C THE POINT IS NOT ENTERED WHEN; ISO01730
C 1. IT IS THE SAME POINT USED IN THE LAST CALL, RESOLUTION PROBLEM ISO01731
C 2. IT IS PART OF A HORIZONTAL LINE BUT NOT AN END POINT ISO01732
C 3. THE ENTIRE CONTOUR RESTS ON A HORIZONTAL PLANE ISO01733
C ISO01734
C WHEN DRAWING A HORIZONTAL LINE THREE CONDITIONS EXIST; ISO01735
C 1. WHEN THE LINE IS A HORIZONTAL STEP ENTER ONLY THE OUTSIDE POINT. ISO01736
C A HORIZONTAL STEP IS DEFINED BY THE ENTERING AND EXITING Y ISO01737
C DIRECTION THAT IS THE SAME. ISO01738
C 2. ENTER BOTH END POINTS OF A HORIZONTAL TURNING POINT. A HORIZONTAL ISO01739
C TURNING POINT IS A LINE WITH GREATER THAN 1 HORIZONTAL BITS ISO01740
C AND THE ENTERING AND EXITING Y DIRECTION IS DIFFIRENT. ISO01741
C 3. WHEN THE ENTIRE CONTOUR IS A HORIZONTAL LINE NO POINTS ARE ISO01742
C ENTERED. THIS CONDITION IS DETECTED BY THE STATUS OF YCHANG. ISO01743
C IF IT IS TRUE THEN THE CONTOUR IS NOT A SINGLE HORIZONTAL LINE. ISO01744
C ISO01745
C THE PREVIOUS POINT IS ERASED IF IT IS A VERTICAL TURNING POINT. ISO01746
C A VERTICAL TURNING POINT IS A HORIZONTAL LINE WITH ONLY 1 POINT ISO01747
C AND THE ENTERING AND EXITING Y DIRECTION DIFFERS.THIS DATA IS ISO01748
C IN THE VARIABLES IOSLSN-OLD SLOPE AND ISLSGN-NEW SLOPE. ISO01749
C THE CHANGE IN SLOPE MUST BE -1 TO 1 OR 1 TO -1. ISO01750
C ISO01751
C OTHERWISE THE POINT IS ENTERED INTO ISCR. ISO01752
C ISO01753
C THE TWO ENTRY POINTS ARE REQUIRED BY THE HARDWARE DRAWING ROUTINES. ISO01754
C FIRSTC IS USED FOR THE FIRST POINT ON THE CONTOUR. THE REMAINING ISO01755
C POINTS ON THE SAME CONTOUR ARE ENTERED VIA VECTC. ISO01756
C ISO01757
DATA IONE/1/ ISO01758
AVE(A,B) = (A+B)*.5 ISO01759
C ISO01760
C COMPUTE VISIBILITY OF THIS POINT ISO01761
C ISO01762
C WARNING ISO01763
C IF X OR Y PLOTTER MAXIMUM VALUE RANGES FALL BELOW 101 THEN THE ISO01764
C FOLLOWING TWO STATEMENTS WHICH SET IX AND IY MUST BE CHANGED. ISO01765
C REPLACE THE CONSTANT 1.0 BY 0.5 IN THE STATEMENTS WHERE THE ISO01766
C MAXIMUM PLOTTER VALUE IS LESS THAN 101 FOR THAT DIRECTION. THE ISO01767
C PLOTTER CORDINATE RANGES ARE SET IN SET32. ISO01768
C ISO01769
IX = FLOAT(MX-1)*RX+1.0 ISO01770
NRLX = IX ISO01771
IY = FLOAT(MY-1)*RY+1.0 ISO01772
IBIT = NBPW-MOD(IX,NBPW) ISO01773
IX = IX/NBPW+1 ISO01774
IVNOW = IAND(ISHFT(ISCA(IX,IY),1-IBIT),IONE) ISO01775
C ISO01776
C DECIDE IF FRSTC OR VECTC CALL ISO01777
C ISO01778
IF (IENT .NE. 1) GO TO 10 ISO01779
C ISO01780
XOLD = MX ISO01781
YOLD = MY ISO01782
C ISO01783
C ISO01784
C SET INITIAL VALUES ISO01785
C ISO01786
IHF = .FALSE. ISO01787
IYDIR = 0 ISO01788
ITPD = 0 ISO01789
IVAL = 0 ISO01790
IOSLSN = 0 ISO01791
IFSX = NRLX ISO01792
IFSY = IY ISO01793
LASTV = IVNOW ISO01794
HBFLAG = .FALSE. ISO01795
YCHANG = .FALSE. ISO01796
CALL PLOTIT (IFIX(XOLD),IFIX(YOLD),0) ISO01797
GO TO 180 ISO01798
C ISO01799
C**************************** ENTRY VECTC ****************************ISO01800
C ENTRY VECTC (MX,MY) ISO01801
C ISO01802
10 XNOW = MX ISO01803
YNOW = MY ISO01804
JUMP = IVNOW*2+LASTV+1 ISO01805
GO TO ( 20, 30, 40, 50),JUMP ISO01806
C ISO01807
C BOTH VISIBLE ISO01808
C ISO01809
20 CALL PLOTIT (IFIX(XNOW),IFIX(YNOW),1) ISO01810
GO TO 50 ISO01811
C ISO01812
C JUST TURNED VISIBLE ISO01813
C ISO01814
30 CALL PLOTIT (IFIX(AVE(XNOW,XOLD)),IFIX(AVE(YNOW,YOLD)),0) ISO01815
GO TO 50 ISO01816
C ISO01817
C JUST TURNED INVISIBLE ISO01818
C ISO01819
40 CALL PLOTIT (IFIX(AVE(XNOW,XOLD)),IFIX(AVE(YNOW,YOLD)),1) ISO01820
C ISO01821
C BOTH INVISIBLE ISO01822
C ISO01823
50 XOLD = XNOW ISO01824
YOLD = YNOW ISO01825
LASTV = IVNOW ISO01826
C ISO01827
C TEST FOR RESOLUTION PROBLEM ISO01828
C ISO01829
IF (NRLX.EQ.LRLX .AND. IY.EQ.IYOLD) RETURN ISO01830
C ISO01831
C TEST FOR HORIZONTAL BITS ISO01832
C ISO01833
IF (IYOLD .NE. IY) GO TO 70 ISO01834
C ISO01835
C HORIZONTAL BITS DETECTED. SET FLAG AND EXIT. ISO01836
C THIS AND THE NEXT HORIZONTAL BIT TEST IS NECESSARY FOR ISCR TO ISO01837
C CONFORM TO THE SHADING ALGORITHM IN SUBROUTINE FILLIN ISO01838
C ISO01839
C ISO01840
C IF HORIZONTAL LINE PREVIOUSLY DETECTED EXIT ISO01841
C ISO01842
IF (.NOT.HBFLAG) GO TO 60 ISO01843
C ISO01844
C IF END OF CONTOUR ON A HORIZONTAL LINE BRANCH FOR SPECIAL PROCESSING.ISO01845
C ISO01846
IF (NRLX.EQ.IFSX .AND. IY.EQ.IFSY) GO TO 210 ISO01847
GO TO 200 ISO01848
C ISO01849
C SAVE SLOPE PRIOR TO HORIZONTAL LINE ISO01850
C ISO01851
60 IHX = IXOLD ISO01852
IHB = IBTOLD ISO01853
IHS = IOSLSN ISO01854
IOSLSN = 0 ISO01855
HBFLAG = .TRUE. ISO01856
IHRX = LRLX ISO01857
IHV = IVOLD ISO01858
IF (LRLX.EQ.IFSX .AND. IYOLD.EQ.IFSY) IHF = .TRUE. ISO01859
C ISO01860
C THIS IS THE SECOND TRAP FOR END OF CONTOUR ON A HORIZONTAL LINE. ISO01861
C ISO01862
IF (NRLX.EQ.IFSX .AND. IY.EQ.IFSY) GO TO 210 ISO01863
GO TO 200 ISO01864
C ISO01865
C COMPUTE THE SLOPE TO THIS POINT ISO01866
C ISO01867
70 IF (IY-IYOLD) 80, 90,100 ISO01868
80 ISLSGN = 1 ISO01869
GO TO 110 ISO01870
90 ISLSGN = 0 ISO01871
GO TO 120 ISO01872
100 ISLSGN = -1 ISO01873
110 IF (IYDIR .EQ. 0) IYDIR = ISLSGN ISO01874
120 CONTINUE ISO01875
C ISO01876
C IF PROCESS REACHES THIS CODE THE CONTOUR IS NOT CONTAINED ON A SINGLEISO01877
C HORIZONTAL PLANE, SO RECORD THIS FACT BY SETTING Y CHANGE FLAG. ISO01878
C ISO01879
YCHANG = .TRUE. ISO01880
C ISO01881
C TEST FOR END OF HORIZONTAL LINE ISO01882
C ISO01883
IF (.NOT.HBFLAG) GO TO 160 ISO01884
HBFLAG = .FALSE. ISO01885
C ISO01886
C HORIZONTAL LINE JUST ENDED ISO01887
C ISO01888
C TEST FOR REDRAW ISO01889
C ISO01890
ITEMP = IAND(ISCR(IXOLD,IYOLD),MASK(IBTOLD)) ISO01891
IF ((IHV .EQ. 0) .AND. (ITEMP .EQ. 0)) GO TO 130 ISO01892
C ISO01893
C REDRAWING ERASE THIS POINT ISO01894
C ISO01895
ISCR(IXOLD,IYOLD) = IAND(ISCR(IXOLD,IYOLD),NMASK(IBTOLD)) ISO01896
ISCR(IHX,IYOLD) = IAND(ISCR(IHX,IYOLD),NMASK(IHB)) ISO01897
GO TO 170 ISO01898
C ISO01899
C TEST FOR STEP PROBLEM ISO01900
C ISO01901
130 IF (IHS .NE. ISLSGN) GO TO 140 ISO01902
C ISO01903
C STEP PROBLEM ISO01904
C ISO01905
GO TO 170 ISO01906
C ISO01907
C TURNING PROBLEM HORIZONTAL LINE IS A TURNING POINT ISO01908
C ISO01909
140 CONTINUE ISO01910
C ISO01911
C ENTER THE TURNING POINT ONLY IF IT IS NOT THE SECOND SUCCEEDING ISO01912
C EVENT IN A ROW ISO01913
C ISO01914
ICTPD = 1 ISO01915
IF (IHRX .GT. NRLX) ICTPD = -1 ISO01916
IF (ICTPD .NE. ITPD) GO TO 150 ISO01917
ITPD = 0 ISO01918
C ISO01919
C ERASE THE FIRST POINT ISO01920
C ISO01921
ISCR(IHX,IYOLD) = IAND(ISCR(IHX,IYOLD),NMASK(IHB)) ISO01922
GO TO 170 ISO01923
C ISO01924
C ENTER THE TURNING POINT ISO01925
C ISO01926
150 CONTINUE ISO01927
ITPD = ICTPD ISO01928
C ISO01929
C ENTER THE SECOND POINT ISO01930
C ISO01931
ISCR(IXOLD,IYOLD) = IOR(ISCR(IXOLD,IYOLD),MASK(IBTOLD)) ISO01932
GO TO 170 ISO01933
C ISO01934
C CHECK IF PREVIOUS ENTRY WAS A VERTICAL TURNING POINT. ISO01935
C IF SO ERASE IT. ISO01936
C ISO01937
160 IF (ISLSGN.EQ.IOSLSN .OR. (IOSLSN.EQ.0 .OR. ISLSGN.EQ.0)) ISO01938
1 GO TO 170 ISO01939
ITPD = 0 ISO01940
ISCR(IXOLD,IYOLD) = IAND(ISCR(IXOLD,IYOLD),NMASK(IBTOLD)) ISO01941
C ISO01942
170 IOSLSN = ISLSGN ISO01943
C ISO01944
C CHECK IF THIS GRID POINT PREVIOUSLY ACTIVATED ISO01945
C ISO01946
IVAL = IAND(ISCR(IX,IY),MASK(IBIT)) ISO01947
C ISO01948
C IF GRID POINTS ACTIVATED BRANCH ISO01949
C ISO01950
IF (IVAL .NE. 0) GO TO 190 ISO01951
C ISO01952
C GRID POINT NOT ACTIVATED SET AND EXIT ISO01953
C ISO01954
180 CONTINUE ISO01955
ISCR(IX,IY) = IOR(ISCR(IX,IY),MASK(IBIT)) ISO01956
GO TO 200 ISO01957
C ISO01958
C THIS POINT IS BEING REDRAWN SO ERASE IT. ISO01959
C (THIS IS TO CONFORM WITH THE SHADING ALGORITHM, FILLIN. ISO01960
C HOWEVER IF BACK TO STARTING POINT DO NOT ERASE ISO01961
C ISO01962
190 IF (NRLX.EQ.IFSX .AND. IY.EQ.IFSY) RETURN ISO01963
ISCR(IX,IY) = IAND(ISCR(IX,IY),NMASK(IBIT)) ISO01964
C ISO01965
C ISO01966
200 IXOLD = IX ISO01967
LRLX = NRLX ISO01968
IYOLD = IY ISO01969
IBTOLD = IBIT ISO01970
IVOLD = IVAL ISO01971
RETURN ISO01972
C ISO01973
C PERFORM THIS OPERATION WHEN A CONTOUR STARTS OR ENDS ON A HORIZONTAL ISO01974
C LINE. ISO01975
C ISO01976
210 CONTINUE ISO01977
C ISO01978
C ERASE THE FIRST POINT OF A CONTOUR WHEN IT IS PART OF A HORIZONTAL ISO01979
C LINE SEGMENT AND IS NOT THE ENDPOINT OF THE SEGMENT ISO01980
C ISO01981
IF (.NOT.IHF) GO TO 220 ISO01982
ISCR(IX,IY) = IAND(ISCR(IX,IY),NMASK(IBIT)) ISO01983
220 CONTINUE ISO01984
C ISO01985
C ERASE THE FIRST POINT OF A HORIZONTAL LINE SEGMENT WHEN IT ENDS ISO01986
C THE CONTOUR AND IS NOT THE HIGHEST LINE SEG ON THS SIDE. ISO01987
C ISO01988
IF (.NOT.YCHANG) GO TO 230 ISO01989
IF (IYDIR .NE. IHS) GO TO 200 ISO01990
230 ISCR(IHX,IY) = IAND(ISCR(IHX,IY),NMASK(IHB)) ISO01991
GO TO 200 ISO01992
END ISO01993
SUBROUTINE FRSTS (XX,YY,IENT) ISO01067
C ISO01068
C THIS IS A SPECIAL VERSION OF THE SMOOTHING DASHED LINE PACKAGE. LINESISO01069
C ARE SMOOTHED IN THE SAME WAY, BUT NO SOFTFARE DASHED LINES ARE USED. ISO01070
C CONDITIONAL PLOTTING ROUTINES ARE CALL WHICH DETERMINE THE VISIBILITY ISO01071
C OF A LINE SEGMENT BEFORE PLOTTING. ISO01072
C ISO01073
DIMENSION XSAVE(70) ,YSAVE(70) ,XP(70) ,YP(70) , ISO01074
1 TEMP(70) ISO01075
C ISO01076
COMMON /ISOSR7/ IENTRY ,IONES ISO01077
C ISO01078
DATA NP/150/ ISO01079
DATA L1/70/ ISO01080
DATA TENSN/2.5/ ISO01081
DATA PI/3.14159265358/ ISO01082
DATA SMALL/128./ ISO01083
C ISO01084
AVE(A,B) = .5*(A+B) ISO01085
C ISO01086
C DECIDE IF FRSTS,VECTS,LASTS CALL ISO01087
C ISO01088
GO TO ( 10, 20, 40),IENT ISO01089
10 DEG = 180./PI ISO01090
X = XX ISO01091
Y = YY ISO01092
LASTFL = 0 ISO01093
SSLP1 = 0.0 ISO01094
SSLPN = 0.0 ISO01095
XSVN = 0.0 ISO01096
YSVN = 0.0 ISO01097
C ISO01098
C INITIALIZE THE POINT AND SEGMENT COUNTER ISO01099
C N COUNTS THE NUMBER OF POINTS/SEGMENT ISO01100
C ISO01101
N = 0 ISO01102
C ISO01103
C NSEG = 0 FIRST SEGMENT ISO01104
C NSEG = 1 MORE THAN ONE SEGMENT ISO01105
C ISO01106
NSEG = 0 ISO01107
CALL TR32 (X,Y,MX,MY) ISO01108
C ISO01109
C SAVE THE X,Y COORDINATES OF THE FIRST POINT ISO01110
C XSV1 CONTAINS THE X COORDINATE OF THE FIRST POINT ISO01111
C OF A LINE ISO01112
C YSV1 CONTAINS THE Y COORDINATE OF THE FIRST POINT ISO01113
C OF A LINE ISO01114
C ISO01115
XSV1 = MX ISO01116
YSV1 = MY ISO01117
GO TO 30 ISO01118
C ISO01119
C ************************* ENTRY VECTS ************************* ISO01120
C ENTRY VECTS (XX,YY) ISO01121
C ISO01122
20 X = XX ISO01123
Y = YY ISO01124
C ISO01125
C VECTS SAVES THE X,Y COORDINATES OF THE ACCEPTED ISO01126
C POINTS ON A LINE SEGMENT ISO01127
C ISO01128
CALL TR32 (X,Y,MX,MY) ISO01129
C ISO01130
CIF THE NEW POINT IS TOO CLOSE TO THE PREVIOUS POINT, IGNORE IT ISO01131
C ISO01132
IF (ABS(FLOAT(IFIX(XSVN)-MX))+ABS(FLOAT(IFIX(YSVN)-MY)) .LT. ISO01133
1 SMALL) RETURN ISO01134
IFLAG = 0 ISO01135
30 N = N+1 ISO01136
C ISO01137
C SAVE THE X,Y COORDINATES OF EACH POINT OF THE SEGMENT ISO01138
C XSAVE THE ARRAY OF X COORDINATES OF LINE SEGMENT ISO01139
C YSAVE THE ARRAY OF Y COORDINATES OF LINE SEGMENT ISO01140
C ISO01141
XSAVE(N) = MX ISO01142
YSAVE(N) = MY ISO01143
XSVN = XSAVE(N) ISO01144
YSVN = YSAVE(N) ISO01145
IF (N .GE. L1-1) GO TO 50 ISO01146
RETURN ISO01147
C ISO01148
C ************************* ENTRY LASTS ************************* ISO01149
C ENTRY LASTS ISO01150
C ISO01151
40 LASTFL = 1 ISO01152
C ISO01153
C LASTS CHECKS FOR PERIODIC LINES AND SETS UP ISO01154
C THE CALLS TO KURV1S AND KURV2S ISO01155
C ISO01156
C IFLAG = 0 OK TO CALL LASTS DIRECTLY ISO01157
C IFLAG = 1 LASTS WAS JUST CALLED FROM BY VECTS ISO01158
C IGNORE CALL TO LASTS ISO01159
C ISO01160
IF (IFLAG .EQ. 1) RETURN ISO01161
C ISO01162
C COMPARE THE LAST POINT OF SEGMENT WITH FIRST POINT OF LINE ISO01163
C ISO01164
50 IFLAG = 1 ISO01165
C ISO01166
C IPRD = 0 PERIODIC LINE ISO01167
C IPRD = 1 NON-PERIODIC LINE ISO01168
C ISO01169
IPRD = 1 ISO01170
IF (ABS(XSV1-XSVN)+ABS(YSV1-YSVN) .LT. SMALL) IPRD = 0 ISO01171
C ISO01172
C TAKE CARE OF THE CASE OF ONLY TWO DISTINCT P0INTS ON A LINE ISO01173
C ISO01174
IF (NSEG .GE. 1) GO TO 70 ISO01175
IF (N-2) 160,150, 60 ISO01176
60 IF (N .GE. 4) GO TO 70 ISO01177
DX = XSAVE(2)-XSAVE(1) ISO01178
DY = YSAVE(2)-YSAVE(1) ISO01179
SLOPE = ATAN2(DY,DX)*DEG+90. ISO01180
IF (SLOPE .GE. 360.) SLOPE = SLOPE-360. ISO01181
IF (SLOPE .LE. 0.) SLOPE = SLOPE+360. ISO01182
SLP1 = SLOPE ISO01183
SLPN = SLOPE ISO01184
ISLPSW = 0 ISO01185
SIGMA = TENSN ISO01186
GO TO 110 ISO01187
70 SIGMA = TENSN ISO01188
IF (IPRD .GE. 1) GO TO 90 ISO01189
IF (NSEG .GE. 1) GO TO 80 ISO01190
C ISO01191
C SET UP FLAGS FOR A 1 SEGMENT, PERIODIC LINE ISO01192
C ISO01193
ISLPSW = 4 ISO01194
XSAVE(N) = XSV1 ISO01195
YSAVE(N) = YSV1 ISO01196
GO TO 110 ISO01197
C ISO01198
C SET UP FLAGS FOR AN N-SEGMENT, PERIODIC LINE ISO01199
C ISO01200
80 SLP1 = SSLPN ISO01201
SLPN = SSLP1 ISO01202
ISLPSW = 0 ISO01203
GO TO 110 ISO01204
90 IF (NSEG .GE. 1) GO TO 100 ISO01205
C ISO01206
C SET UP FLAGS FOR THE 1ST SEGMENT OF A NON-PERIODIC LINE ISO01207
C ISO01208
ISLPSW = 3 ISO01209
GO TO 110 ISO01210
C ISO01211
C SET UP FLAGS FOR THE NTH SEGMENT OF A NON-PERIODIC LINE ISO01212
C ISO01213
100 SLP1 = SSLPN ISO01214
ISLPSW = 1 ISO01215
C ISO01216
C CALL THE SMOOTHING ROUTINES ISO01217
C ISO01218
110 CALL KURV1S (N,XSAVE,YSAVE,SLP1,SLPN,XP,YP,TEMP,S,SIGMA,ISLPSW) ISO01219
IF (IPRD.EQ.0 .AND. NSEG.EQ.0 .AND. S.LT.70.) GO TO 170 ISO01220
IENTRY = 1 ISO01221
C ISO01222
C DETERMINE THE NUMBER OF POINTS TO INTERPOLATE FOR EACH SEGMENT ISO01223
C ISO01224
IF (NSEG.GE.1 .AND. N.LT.L1-1) GO TO 120 ISO01225
NPRIME = FLOAT(NP)-(S*FLOAT(NP))/(2.*32768.) ISO01226
IF (S .GE. 32768.) NPRIME = .5*FLOAT(NP) ISO01227
NPL = FLOAT(NPRIME)*S/32768. ISO01228
IF (NPL .LT. 2) NPL = 2 ISO01229
120 DT = 1./FLOAT(NPL) ISO01230
IF (NSEG .LE. 0) CALL FRSTC (IFIX(XSAVE(1)),IFIX(YSAVE(1)),1) ISO01231
T = 0.0 ISO01232
NSLPSW = 1 ISO01233
IF (NSEG .GE. 1) NSLPSW = 0 ISO01234
NSEG = 1 ISO01235
CALL KURV2S (T,XS,YS,N,XSAVE,YSAVE,XP,YP,S,SIGMA,NSLPSW,SLP) ISO01236
C ISO01237
C SAVE SLOPE AT THE FIRST POINT OF THE LINE ISO01238
C ISO01239
IF (NSLPSW .GE. 1) SSLP1 = SLP ISO01240
NSLPSW = 0 ISO01241
XSOLD = XSAVE(1) ISO01242
YSOLD = YSAVE(1) ISO01243
DO 130 I=1,NPL ISO01244
T = T+DT ISO01245
TT = -T ISO01246
IF (I .EQ. NPL) NSLPSW = 1 ISO01247
CALL KURV2S (TT,XS,YS,N,XSAVE,YSAVE,XP,YP,S,SIGMA,NSLPSW,SLP) ISO01248
C ISO01249
C SAVE THE LAST SLOPE OF THIS LINE SEGMENT ISO01250
C ISO01251
IF (NSLPSW .GE. 1) SSLPN = SLP ISO01252
C ISO01253
C DRAW EACH PART OF THE LINE SEGMENT ISO01254
C ISO01255
CALL FRSTC (IFIX(AVE(XSOLD,XS)),IFIX(AVE(YSOLD,YS)),2) ISO01256
CALL FRSTC (IFIX(XS),IFIX(YS),2) ISO01257
XSOLD = XS ISO01258
YSOLD = YS ISO01259
130 CONTINUE ISO01260
IF (IPRD .NE. 0) GO TO 140 ISO01261
C ISO01262
C CONNECT THE LAST POINT WITH THE FIRST POINT OF A PERIODIC LINE ISO01263
C ISO01264
CALL FRSTC (IFIX(AVE(XSOLD,XS)),IFIX(AVE(YSOLD,YS)),2) ISO01265
CALL FRSTC (IFIX(XSV1),IFIX(YSV1),2) ISO01266
C ISO01267
C BEGIN THE NEXT LINE SEGMENT WITH THE LAST POINT OF THIS SEGMENT ISO01268
C ISO01269
140 XSAVE(1) = XS ISO01270
YSAVE(1) = YS ISO01271
N = 1 ISO01272
150 CONTINUE ISO01273
160 RETURN ISO01274
170 N = 0 ISO01275
RETURN ISO01276
END ISO01277
BLOCKDATA ISOSRB ISO02084
C ISO02085
C BLOCK DATA ISO02086
C ISO02087
COMMON /ISOSR2/ LX ,NX ,NY ,ISCR(8,128), ISO02088
1 ISCA(8,128) ISO02089
COMMON /ISOSR4/ RX ,RY ISO02090
COMMON /ISOSR5/ NBPW ,MASK(16) ,GENDON ISO02091
LOGICAL GENDON ISO02092
COMMON /ISOSR6/ IX ,IY ,IDX ,IDY , ISO02093
1 IS ,ISS ,NP ,CV , ISO02094
2 INX(8) ,INY(8) ,IR(500) ,NR ISO02095
COMMON /ISOSR7/ IENTRY ,IONES ISO02096
COMMON /ISOSR8/ NMASK(16) ,IXOLD ,IYOLD ,IBTOLD , ISO02097
1 HBFLAG ,IOSLSN ,LRLX ,IFSX , ISO02098
2 IFSY ,FIRST ,IYDIR ,IHX , ISO02099
3 IHB ,IHS ,IHV ,IVOLD , ISO02100
4 IVAL ,IHRX ,YCHANG ,ITPD , ISO02101
5 IHF ISO02102
COMMON /ISOSR9/ BIG ,IXBIT ISO02103
COMMON /TEMPR/ RZERO ISO02104
LOGICAL YCHANG ,HBFLAG ,FIRST ,IHF ISO02105
C ISO02106
DATA LX,NX,NY/8,128,128/ ISO02107
DATA INX(1),INX(2),INX(3),INX(4),INX(5),INX(6),INX(7),INX(8)/ ISO02108
1 -1 , -1 , 0 , 1 , 1 , 1 , 0 , -1 / ISO02109
DATA INY(1),INY(2),INY(3),INY(4),INY(5),INY(6),INY(7),INY(8)/ ISO02110
1 0 , 1 , 1 , 1 , 0 , -1 , -1 , -1 / ISO02111
DATA NR/500/ ISO02112
DATA NBPW/16/ ISO02113
DATA IHF/.FALSE./ ISO02114
C ISO02115
DATA GENDON /.FALSE./ ISO02116
DATA RZERO/0./ ISO02117
C ISO02118
C ISO02119
C RX = (NX-1)/SCREEN WIDTH FROM TRN32I ISO02120
C RY = (NY-1)/SCREEN HEIGHT FROM TRN32I ISO02121
C ISO02122
DATA RX,RY/.00389,.00389/ ISO02123
C ISO02124
END ISO02125
SUBROUTINE ISOSRF (T,LU,MU,LV,MV,MW,EYE,MUVWP2,SLAB,TISO,IFLAG) ISO00001
C ISO00002
C ISO00003
C DIMENSION OF T(LU,LV,MW),EYE(3),SLAB(MUVWP2,MUVWP2) ISO00004
C ARGUMENTS ISO00005
C ISO00006
C JUNE 1980 ISO00007
C ISO00008
C PURPOSE ISOSRF DRAWS AN APPROXIMATION OF AN ISO-VALUED ISO00009
C SURFACE FROM A THREE-DIMENSIONAL ARRAY WITH ISO00010
C HIDDEN LINES REMOVED. ISO00011
C ISO00012
C ACCESS CARDS *FORTRAN,S=ULIB,N=ISOSRF ISO00013
C ISO00014
C ISO00015
C USAGE IF THE FOLLOWING ASSUMPTIONS ARE MET, USE ISO00016
C CALL EZISOS (T,MU,MV,MW,EYE,SLAB,TISO) ISO00017
C ASSUMPTIONS: ISO00018
C ALL OF THE T ARRAY IS TO BE USED. ISO00019
C IFLAG IS CHOSEN INTERNALLY. ISO00020
C FRAME IS CALLED BY EZISOS. ISO00021
C IF THE ASSUMPTIONS ARE NOT MET, USE ISO00022
C CALL ISOSRF (T,LU,MU,LV,MV,MW,EYE,MUVWP2, ISO00023
C SLAB,TISO,IFLAG) ISO00024
C ISO00025
C ARGUMENTS ISO00026
C ISO00027
C ON INPUT T ISO00028
C THREE DIMENSIONAL ARRAY OF DATA THAT IS USED ISO00029
C TO DETERMINE THE ISO-VALUED SURFACE. ISO00030
C ISO00031
C LU ISO00032
C FIRST DIMENSION OF T IN THE CALLING PROGRAM. ISO00033
C ISO00034
C MU ISO00035
C THE NUMBER OF DATA VALUES OF T TO BE ISO00036
C PROCESSED IN THE U DIRECTION (THE FIRST ISO00037
C SUBSCRIPT DIRECTION). WHEN PROCESSING THE ISO00038
C ENTIRE ARRAY, LU = MU (AND LV = MV). SEE ISO00039
C APPENDIX 1 OF THE GRAPHICS CHAPTER FOR AN ISO00040
C EXPLANATION OF USING THIS ARGUMENT LIST TO ISO00041
C PROCESS ANY PART OF AN ARRAY. ISO00042
C ISO00043
C LV ISO00044
C SECOND DIMENSION OF T IN THE CALLING PROGRAM.ISO00045
C ISO00046
C MV ISO00047
C THE NUMBER OF DATA VALUES OF T TO BE ISO00048
C PROCESSED IN THE V DIRECTION (THE SECOND ISO00049
C SUBSCRIPT DIRECTION). ISO00050
C ISO00051
C MW ISO00052
C THE NUMBER OF DATA VALUES OF T TO BE ISO00053
C PROCESSED IN THE W DIRECTION (THE THIRD ISO00054
C SUBSCRIPT DIRECTION). ISO00055
C ISO00056
C EYE ISO00057
C THE POSITION OF THE EYE IN THREE-SPACE. T ISISO00058
C CONSIDERED TO BE IN A BOX WITH OPPOSITE ISO00059
C CORNERS (1,1,1) AND (MU,MV,MW). THE EYE IS ISO00060
C AT (EYE(1),EYE(2),EYE(3)), WHICH MUST BE ISO00061
C OUTSIDE THE BOX THAT T IS IN. WHILE GAINING ISO00062
C EXPERIENCE WITH THE ROUTINE, A GOOD CHOICE ISO00063
C FOR EYE MIGHT BE (5.0*MU,3.5*MV,2.0*MW). ISO00064
C ISO00065
C MUVWP2 ISO00066
C THE MAXIMUM OF (MU,MV,MW)+2 ISO00067
C (MUVWP2 = MAX0(MU,MV,MW)+2). ISO00068
C ISO00069
C SLAB ISO00070
C A WORK SPACE USED FOR INTERNAL STORAGE. SLABISO00071
C MUST BE AT LEAST MUVWP2*MUVWP2 WORDS LONG. ISO00072
C ISO00073
C TISO ISO00074
C THE ISO-VALUE USED TO DEFINE THE SURFACE; THEISO00075
C SURFACE DRAWN WILL SEPARATE VOLUMES OF T THATISO00076
C HAVE VALUE GREATER THAN TISO FROM VOLUMES OF ISO00077
C T THAT HAVE VALUE LESS THAN TISO. ISO00078
C ISO00079
C IFLAG ISO00080
C A FLAG WHICH SERVES TWO PURPOSES. ISO00081
C . FIRST, THE ABSOLUTE VALUE OF IFLAG ISO00082
C DETERMINES WHICH TYPES OF LINES ARE DRAWN ISO00083
C TO APPROXIMATE THE SURFACE. THREE TYPES ISO00084
C OF LINES ARE CONSIDERED: LINES OF ISO00085
C CONSTANT U, LINES OF CONSTANT V AND LINES ISO00086
C OF CONSTANT W. THE FOLLOWING TABLE LISTS ISO00087
C THE TYPES OF LINES DRAWN. ISO00088
C ISO00089
C LINES OF CONSTANT ISO00090
C ----------------- ISO00091
C IABS(IFLAG) U V W ISO00092
C 1 NO NO YES ISO00093
C 2 NO YES NO ISO00094
C 3 NO YES YES ISO00095
C 4 YES NO NO ISO00096
C 5 YES NO YES ISO00097
C 6 YES YES NO ISO00098
C 0, 7 OR MORE YES YES YES ISO00099
C ISO00100
C . SECOND, THE SIGN OF IFLAG DETERMINES WHAT ISO00101
C IS INSIDE AND WHAT IS OUTSIDE, HENCE, ISO00102
C WHICH LINES ARE VISIBLE AND WHAT IS DONE ISO00103
C AT THE BOUNDARY OF T. FOR IFLAG: ISO00104
C ISO00105
C POSITIVE T VALUES GREATER THAN TISO ARE ISO00106
C ASSUMED TO BE INSIDE THE SOLID ISO00107
C FORMED BY THE DRAWN SURFACE. ISO00108
C NEGATIVE T VALUES LESS THAN TISO ARE ISO00109
C ASSUMED TO BE INSIDE THE SOLID ISO00110
C FORMED BY THE DRAWN SURFACE. ISO00111
C IF THE ALGORITHM DRAWS A CUBE, REVERSE THEISO00112
C SIGN OF IFLAG. ISO00113
C ISO00114
C ON OUTPUT T,LU,MU,LV,MV,MW,EYE,MUVWP2,TISO AND IFLAG ARE ISO00115
C UNCHANGED. SLAB HAS BEEN WRITTEN IN. ISO00116
C ISO00117
C NOTE . THIS ROUTINE IS FOR LOWER RESOLUTION ARRAYSISO00118
C THAN ISOSRFHR. 40 BY 40 BY 30 IS A ISO00119
C PRACTICAL MAXIMUM. ISO00120
C . TRANSFORMATIONS CAN BE ACHIEVED BY ISO00121
C ADJUSTING SCALING STATEMENT FUNCTIONS IN ISO00122
C ISOSRF, SET3D AND TR32. ISO00123
C . THE HIDDEN-LINE ALGORITHM IS NOT EXACT, SO ISO00124
C VISIBILITY ERRORS CAN OCCUR. ISO00125
C ISO00126
C ENTRY POINTS ISOSRF, EZISOS, SET3D, TRN32I, ZEROSC, ISO00127
C STCNTR, DRCNTR, TR32, FRSTS, KURV1S, KURV2S, ISO00128
C FRSTC, FILLIN, DRAWI, ISOSRB, MMASK ISO00129
C ISO00130
C COMMON BLOCKS NAME LENGTH ISO00131
C ----- ------ ISO00132
C ISOSR1 4 ISO00133
C ISOSR2 4003 (OCTAL) ISO00134
C ISOSR3 7 ISO00135
C ISOSR4 2 ISO00136
C ISOSR5 22 (OCTAL) ISO00137
C ISOSR6 1015 (OCTAL) ISO00138
C ISOSR7 2 ISO00139
C ISOSR8 44 (OCTAL) ISO00140
C ISOSR9 2 ISO00141
C TEMPR 1 ISO00142
C PWRZ1I 12 (OCTAL) ISO00143
C ISO00144
C I/O PLOTS SURFACE ISO00145
C ISO00146
C PRECISION SINGLE ISO00147
C ISO00148
C REQUIRED ULIB NONE ISO00149
C ROUTINES ISO00150
C ISO00151
C ISO00152
C LANGUAGE FORTRAN ISO00153
C ISO00154
C HISTORY DEVELOPED FOR USERS OF ISOSRFHR WITH SMALLER ISO00155
C ARRAYS. ISO00156
C ISO00157
C ALGORITHM CUTS THROUGH THE THREE-DIMENSIONAL ARRAY ARE ISO00158
C CONTOURED WITH A SMOOTHING CONTOURER WHICH ALSOISO00159
C MARKS A MODEL OF THE PLOTTING PLANE. INTERIORSISO00160
C OF BOUNDARIES ARE FILLED IN AND THE RESULT IS ISO00161
C .OR.ED INTO ANOTHER MODEL OF THE PLOTTING PLANEISO00162
C WHICH IS USED TO TEST SUBSEQUENT CONTOUR LINES ISO00163
C FOR VISIBILITY. ISO00164
C ISO00165
C SPACE REQUIRED ABOUT 11000 (OCTAL) NOT INCLUDING THE SYSTEM ISO00166
C PLOT PACKAGE. ISO00167
C ISO00168
C TIMING VARIES WIDELY WITH SIZE OF T AND THE VOLUME OF ISO00169
C THE SPACE ENCLOSED BY THE SURFACE DRAWN. THE ISO00170
C SAMPLE PICTURE TOOK ABOUT 1 SECOND OF 7600 ISO00171
C TIME. ISO00172
C ISO00173
C IMPLEMENTATION ISO00174
C THE IMPLEMENTATION OF ISOSRF REQUIRES THE CODING OF ISO00175
C SOME LOCAL ROUTINES LISTED BELOW: ISO00176
C ISO00177
C SUBROUTINE PLOTIT(IX,IY,IPEN) ISO00178
C MOVE TO INTEGER IX,IY COORDINATES BASED ON A ISO00179
C 0 TO 32767 COORDINATE GRID. ISO00180
C IPEN=0 MOVE ONLY (PEN UP) ISO00181
C IPEN=1 DRAW (PEN DOWN) ISO00182
C ISO00183
C FUNCTION ISHFT(IWORD,N) ISO00184
C IWORD IS SHIFTED N BITS ISO00185
C IF N.GT.0 LEFT CIRCULAR SHIFT ISO00186
C IF N.LT.0 RIGHT END OFF SHIFT ISO00187
C (LOGICAL OR SIGN EXTEND) ISO00188
C IF N=0 NO ACTION ISO00189
C RETURN SHIFTED RESULT AS FUNCTION VALUE ISO00190
C ISO00191
C FUNCTION IAND(I1,I2) ISO00192
C LOGICAL AND OF I1 AND I2 ISO00193
C RETURN RESULT AS FUNCTION VALUE ISO00194
C ISO00195
C FUNCTION IOR(I1,I2) ISO00196
C ISO00197
C LOGICAL OR OF I1 TO I2 ISO00198
C RETURN RESULT AS FUNCTION VALUE ISO00199
C ISO00200
C FUNCTION R1MACH(IARG) ISO00201
C THIS IS FROM THE PORT LIBRARY (A BELL LABS ISO00202
C PRODUCT). IF YOU DO NOT HAVE THE PORT ROUTINES ISO00203
C THE FUNCTION OF R1MACH IN ISOSRF IS TO RETURN ISO00204
C THE LARGEST FLOATING POINT NUMBER USEABLE ON THEISO00205
C MACHINE RUNNING ISOSRF. RETURN THIS FLOATING ISO00206
C POINT VALUE AS THE FUNCTION VALUE AND IGNORE ISO00207
C THE INPUT PARAMETER. ISO00208
C ISO00209
C SUBROUTINE ULIBER(IERR,MESS,LMESS) ISO00210
C PRINTS ERROR MESSAGE OR PRINTS ERROR NUMBER AND ISO00211
C ERROR MESSAGE. ISO00212
C IERR=ERROR NUMBER (NOT PRINTED IF 0) ISO00213
C MESS=MESSAGE TO BE PRINTED INCLUDING CARRIAGE ISO00214