C C FORTRAN FPRGRAM TO READ IBM MAG TAPE C C HOW TO USE C CREATE FILE "COGO" C FIND THE NO. OF BYTES PER RECORD C AND SET NBYTES=TO THAT NUMBER C NBYTES=40 FOR IBM MAG TAPE SOMETIMES C NBYTES=84 FOR MOVIE.BYU DIMENSION INARY(4096) CALL OPRDS(4,"COGO",IERR) NBYTES=84 NWORD=NBYTES/2 NCARRIAG=NWORD+1 CALL MTOPD(5,"MT0:0",0,IERR) IF(IERR.EQ.1) GO TO 1 TYPE "IER=",IERR STOP 1 C C FORM THE I/0 COMMAND WORD C 1 ICOM=0 CALL MTDIO(5,ICOM,INARY,ISTAT,IER,IREC) IF(IER.EQ.1) GO TO 2 TYPE "IER=",IER IF(IER.EQ.6) STOP 3 TYPE "IREC=",IREC GO TO 1 2 IF(IREC.EQ.NWORD) GO TO 3 TYPE "IREC1=",IREC IF(IREC.EQ.2) CALL FBACK IF(IREC.GT.39) GO TO 3 GO TO 1 3 INARY(NCARRIAG)="<15> " CALL WRITSQ(4,INARY,81,IER) GO TO 1 END b  @@@sb@@O#q9N郜c! áCD D9(;    OCD#tOGX"G*   C + KDD1ePK'TM:00XH$pJ' $ #PEȒ$59F EI=R GD2C 1 CX$$I  #PD"+$+ W] EI=RDȬ$e# t "G$$^s3 RICE=FD$"+r#+ D$92RICE=1# D@(XȒ$j2 # @ E+$:F   "Gc GX(  F Q' D$ąT@($I&eC~!bJ(lIҡ u8 _:J\  5 % M   T L  4 D   IGRzD?@Dum%z D& 16COGO U 3 KC K+ HKPKLMT0:0 U "I #P^k )IER=  Q1 KC UI #P )IER=# L Q3 )IREC=k#+ )IREC1=# L U # LՐ@ k F  KG U k XQ' T c G#P7/ ?XPҠWX c G#P7 ?XPҠWXCOPYRIGHT (C) DGC,1971,1972,1973,1974,1975ALL RIGHTS RESERVED.8 Pp3 !)Z@j#C@n\nn)k=k  C)h )i)d@l9bX)aHq  PP " Y9MT Q jC`CS0 2GHk1APm@1PjB0j) :JBӀ@ (p0 2Hp!A (p kPP   U+ Q >w  ! " !  MEMORY OVERFLOW OR NO F$COM.$$ $TTOF$COM.$$8 ;    WWP WWPCK!TPCC!V`CA!NPC!N`C!HCCCCCCCCCCCC!;CPCC2S g"C'C  3 g)%" PS# a+ +3  @S"') +K1  @c{F 3 #C#%d# 7C!C# `K1 # 1N+"\m "KS 7C3"K 7C32IEDFGOAPLS(,y/Z! )HXHT""'H#Ƃ +# (#++¦) 3S#)3 ,%+3 s#PSPSP3 B4 # #Ƃ 3 3 =|3!+ ! !  a##C .1J >|3Z*}I#C 6G1+ J#+ҋ 13"")''B3") ZG+`P2` I3" "*'G+#K,3*K1B)J - \n)83;"B84n3 #C3 @()#3 #C @k# h#+A Z aC#+A Z)w a#3 ?CP ; 3+ J#B3ҜCSK 3 "C < #Ă#ł  3#  =PC =3#  >  > Zl!C#C+#3J # a3C#+P I_ 3#P =US#)3A ,CM3#  =|S#)3A ,C ) a3ҝ1+P1 I.3)J S#)3A ,C)#P =# a# `1 1 1 G ZmFT 3# 3#S)3A ,+A Z)? ) aC'C3 gCPC+r ; 7") !ZS g*3J+JR3C g"GK3B3" )3 gC!33 g"/ǎDnODŽP3 g"/4nZ3"C3 gC3 gC < ) 3K g;+J3 gCǓ gC3 g EC")K1"C1"C3#)J PS >  l#P+ -CS >C#Á `1S #+A Z) a# ` 3ǂC 3#+ ?4CK ]P# GKPC3"C g23#B# # ##Ƃ X# X#+A Z) a#3 ?X#) # 3BX Z#C#C#C%CLA7gS#Ƃ N#  #) C) ) #+K+KO3B#BPB#`3` I3'N)%B"C 5C#C# #) ) 9+3K)# ^) ZYFDG+3 s#SPSPP3 AIE' 8+3 +K 9#+C+m#+K+#BC#3 9+ë3K :#)ō 1 )#S3A ,C *3)#S)K+#!J3# 9+3K :#+A Z+ a#C#Â# 8)֒ 9#C#))K)K3J#+1\nnLn8S3̕ Z,n an4n\n8n3#Dn"+Bn8n4n\nn8C3#B)`PB)ZBCBCC#C# `Ѫ 61R 1J 1H # `Ѫ '1C );1; .19 +17 $15 &13 #!+3#̂ 3S / 3؀ Z3#B# 1#n4n̅C 6+ΦC@0+-.ED \n8+3SɶS3/ sO4n\n8#C#C3Ʌ/ t4nO\nn83JJ$CʅPC#ʂ S / 33#Ђ6C sC#ʂPC%Cʭ 23PC#ʂ S 0 23#ЂC sC#ʂPC 4n4n8\nn83"(:\nXpp$pLpn")&B"9!p$pLp9n")B:\nPp"Z) C OUTPUT FORM FEED IF FOUND NLINE=NLINE+1 GO TO 100 C C END HERE C 4000 WRITE(10,200) NLINES 200 FORMAT(" NUMBER OF LINES=",I6) STOP NORMAL STOP END b  @@@sb @@T #q9cLN郜7c CD D$Ȼd   HXE d  NEY$Dc G  )D '"GȢD}+G C K 6D"(D$$'߿9E TNREI PNTUF LI"E)Z! MDD$G SS(31!) D:U X($X #P"K$$f} O EP NREOR RNII PND$tTUF LI=E H$$"(E TNREO TUUP TIFELZ"!)"Y$(  S(31!)DbXF   Y($] Y#P"K$$ PONEE RRROI NUOPTD$(TUF LI=ET$OT@-YH$5n #P"K$$ REOR RNIT OTO EP=ND mX$D5n  # DD$|#P H$$ERDA LREOR=R"G$X@# , NOI RE"Gx+R CX($M/  #CPCXHN:  X$$B  #P`Y$$P REOR RNIW IRLT=D ^X)"'`   #C D$+%jnx x~"(" D$H|)Z!#PC D$$]Њ"(N MUEB RFOL NISE"=I,D$Q)6! ONMRLAS OTP HD$ d@P$I@ TᒠzAOaX0_xcHHu$;C8 _ 1 B Z A  j i 3 o  v:6UWY[`bhm  3<=QMgmt%d D&  D* d9 F BEN J@G F ND JLG JC KK )[i(" ENTER INPUT FILE"Z)! (r x(S13)! F  T ̀#P ) OPEN ERROR IN INPUT FILE= )(" ENTER OUTPUT FILE"Z)! ( (S13)! T\ F  T Ҁ#P )OPEN ERROR IN OUTPUT FILE=$TTO T #P )ERROR IN TTO OPEN= TK̀ # Kʍ+#PB )READL ERROR=# KˍQ PON IERR JC T- #CPC TdҀ  TҀ #P )ERROR IN WRITL= T ǀ #C Kȍ )(" "Z)!#PC )(" NUMBER OF LINES=",I6)! PNORMAL STOP W H d gG'CC/K7S W')DK#C+ W3*!5 W#!0 )# PC+K+K#3")K+K# W3") # #G W  g3GC'C W+K' W")  W! #G  g'0iPP2!#P ?PGOW `GW? b'C/K7S[ W[ W W3*!K#K3*!#! #J#C+ g'0iPP2!#P ?PGW `GW?COPYRIGHT (C) DGC,1971,1972,1973,1974,1975ALL RIGHTS RESERVED.8 Po3 !)Z@i#C@m\mm)k=k  C)h )i)d@k9bX)aHp  PP " Y9MT Q iC`CS0 2GHj1APl@1PiB0i) :JBӀ@ (o0 2Ho!A (o jPP   T/ P w  ! " !  MEMORY OVERFLOW OR NO F$COM.$$ $TTOF$COM.$$8 ;    VVP VVPCK!TPCC!V`CA!NPC!N`C!HCCCCCCCCCCCC!;CPCC2S f"C'C  3 f)%" PS# `+ +3  @S"') +K1 7 @A Kr3 #C#%d#  7C!C# _K1 # 1N+"\m "KS 7C3"K 7C324IEDFGOAPLS([, /5Z> ! )mHXT"' HXH#Ƃ +# (#++¦) 3JS#)3 ,%+3 r#PSPSP3 B4 7# #Ƃ 3 3 =|3!+ ! !  `##C .1J >|3 *#C 6G1+ J#+ҋ 13"")''B3") YG+`P2` H3" "*'G+#K,3*K1B)J - \m)83;"B84m3 #C3 @(#3 #C @k# h#+A Y `C#+A Y)w `#3 ?CP77 ; 3+ J#B3ҜCSK 3 "C < #Ă#ł   3#  =PC =3#  >  > Y!C#C+#3J # `3C#+P H_ 3#P =US#)3A ,CM3#  =|S#)3A ,C ) `3ҝ1+P1 H.3)J S#)3A ,C)#P =# `# _1 1 1 G YFT 3# 3#S)3A ,+A Y)? ) `C'C3 fCPC+r ; 7") !ZS f*3J+JR3C f"Gg3B3" )3 fC!33 f"/ǎDmODŽP3 f"/4mZ3"C3 fC3 fC < ) 3K f;+J3 fCǓ fC3 f EC")K1"C1"C3#)J PS   #P+ -CS >C#Á _1S #+A Y) `# _ 3ǂC 3#+ ?4C \P# GKPC3"C f23#B# # ##Ƃ W# W#+A Y) `#3 ?W#) # 3BW Y#C#C#C%C5HLAS#Ƃ N#  #) C) ) #+K+KO3B#BPB#`3` H3'N)%B"C 5C#C# #) ) 9+3K)# ^) YY  'F(DG+3 r#SPSPP3 A7E' 8+3 +K 9#+C+#+K+#BC#3 9+ë3K :#)ō 1 )#S3A ,C *3)#S)K+#!J3# 9+3K :#+A Y+ `#C#Â# 8)֒ 9#C#))K)K3J#+1\mmLm8S3̕ Y,m `m4m\m8m3#Dm"+Bm8m4m\mm8C3#B)`PB)ZBCBCC#C# _Ѫ 61R 1J 1H # _Ѫ '1C );1; .19 +17 $15 &13 #!+3#̂ 3S / 3؀ Y3#B# 1#m4m̅C 6+ΦC@0+-.ED \m8+3SɶS3/ rO4m\m8#C#C3Ʌ/ s4mO\mm83JJ$CʅPC#ʂ S / 33#6C rC#ʂPC%Cʭ 23PC#ʂ S 0 23#ЂC rC#ʂPC 4m4m8\mm83"(:\mXoo$oLom")&B"9!o$oLo9m")B:\mPo ENTER THE GEOMETRY FILENAME.EXT. IF THE EXTENTION IS OMITTED, THE DEFAULT EXTENSION DAT WILL BE USED. A ZERO FILE DESIGNATION WILL SKIP OVER THE GEOMETRY FILE AND REQUEST INFORMATION ABOUT THE DISPLACEMENT FILE. THIS IS HELPFUL WHEN USING SEVERAL DIFFERENT DISPLACEMENT OR SCALAR FUNCTION FILES WITH THE SAME GEOMETRY.(1)  THE GEOMETRY FILE IS NOW READ USING THE FOLLOWING FORTRAN STATEMENTS. READ(IDTA,10) NP,NJ,NPT READ(IDTA,10) ((NPL(I,J),I=1,2),J=1,NP) READ(IDTA,20) ((X(I,J),I=1,3),J=1,NJ) READ(IDTA,10) ((IP(I,J),I=1,4),J=1,NPT) 10 FORMAT(20I4) 20 FORMAT(6E12.5) (1) THE MANNER IN WHICH DATA FILES ARE INITIALIZED IS AN INSTALLATION DEPENDENT FEATURE. APPROPRIATE MODIFICATIONS SHOULD BE MADE IN THE SOURCE PROGRAM TO ACCOMMODATE YOUR SYSTEM. MOVIE USER'S MANUAL Page 1-2 THE VARIABLES ARE DEFINED AS FOLLOWS: NP = THE NUMBER OF PARTS NJ = THE NUMBER OF NODES OR JOINTS NPT = THE NUMBER OF ELEMENTS OR POLYGONS NPL = THE PARTS LIST ELEMENTS ARE GROUPED TOGETHER FOR CURVED  SURFACE SIMULATION AND COLOR DEFINITION. THE PARTS LIST CONTAINS THE ELEMENT NUMBERS OF THE LOWER AND UPPER BOUNDS OF THE ELEMENT GROUPING. BY REPEATING THE ELEMENT GROUP LIMIT NUMBERS IN THE PARTS LIST AND THEN USING THE EXPLODE AND PIVOT COMMANDS TO SEPARATE THE PARTS, COMPLEX PICTURES CAN BE DEVELOPED FROM RATHER SIMPLE DATA FILES. X = THE COORDINATES OF THE NODES IP = THE CONNECTIVITY OF THE ELEMENTS OR POLYGONS ENTER THE NAME OF THE DISPLACEMENT FILE IN THE SAME FORMAT USED ABOVE. A ZERO FILE DESIGNATION WILL SKIP THE DISPLACEMENT FILE AND REQUEST INFORMATION FOR THE SCALAR FUNCTION FILE. AT THIS POINT THE DISPLACEMENT FILE IS READ USING THE FOLLOWING FORTRAN STATEMENTS.  READ(IDTA,10) ((U(I,J),I=1,3),J=1,NJ) 10 FORMAT(6E12.5) THE VARIABLE, U, IS THE VALUE OF THE DISPLACEMENTS AT THE NODES ENTER THE NAME OF THE SCALAR FUNCTION FILE IN THE FORM DESCRIBED ABOVE. A ZERO FILE DESIGNATION WILL SKIP OVER THE SCALAR FUNCTION AND PROMPT THE USER TO ENTER THE NEXT COMMAND.  AT THIS POINT THE SCALAR FUNCTION WILL BE READ USING THE FOLLOWING FORTRAN STATEMENTS. READ(IDTA,10) (S(I),I=1,NJ) 10 FORMAT(6E12.5) MOVIE USER'S MANUAL Page 1-3 THE VARIABLE, S, IS THE VALUE OF THE SCALAR FUNCTION AT THE NODES. COMMAND PROMPT BEFORE ISSUING THE COMMAND PROMPT, SEVERAL PROGRAM VARIABLES ARE INITIALIZED SO THAT THE MODEL CAN BE DISPLAYED IMMEDIATELY. THE PROGRAM WILL ALSO REQUEST A DISPLAY DEVICE (SEE DEVICE) AND INFORMATION ABOUT DATA ORDERING (SEE FAST). >> THE PROGRAM IS NOW READY TO ACCEPT ONE OF THE ALLOWABLE COMMANDS. THE COMMANDS ARE LISTED IN ALPHABETICAL ORDER, AND THE INFORMATION THEY REQUEST IS DISCUSSED IN THE FOLLOWING PARAGRAPHS.  CENTER THE CENTER COMMAND INVOKES THE SUMMARY COMMAND, TRANSLATES THE ORIGIN TO THE CENTER OF THE MODEL, AND CALCULATES VALUES FOR DISTANCE TO THE ORIGIN, ANGLE OF VIEW, Z MIN., AND Z MAX. (SEE COMMANDS DISTANCE AND FIELD.) THE CALCULATED VALUES WILL BE TYPED ON THE USER'S TERMINAL. COLOR THE COLOR COMMAND ALLOWS THE USER TO SPECIFY THE  COLORS FOR THE BACKGROUND, FOR THE VARIOUS PARTS OF THE MODEL, AND FOR THE COLOR FRINGES. ENTER THE RED, BLUE, AND GREEN COLOR COMPONENTS OF THE BACKGROUND. THE LIGHT INTENSITY VARIES FROM 0 (NONE) TO 1 (FULL INTENSITY). MOVIE USER'S MANUAL Page 1-4 ENTER THE RED, BLUE, AND GREEN COLOR COMPONENTS OF EACH PART OF THE MODEL. IF I2 IS GREATER THAN I1, ALL PARTS I1 THROUGH I2 WILL BE THE SAME COLOR. A LINE OF ZEROES TERMINATES THIS COMMAND. ENTER Y OR YES IF STANDARD FRINGE COLORS ARE DESIRED (THE STANDARD COLORS ARE BLUE, TURQUOISE, GREEN, YELLOW, RED.) ANY OTHER RESPONSE WILL SKIP THE NEXT REQUEST. ENTER Y OR YES TO REFLECT THE COLORS ABOUT A WHITE MIDPOINT (I.E. RED, YELLOW, GREEN, TURQUOISE, BLUE, WHITE, BLUE, TURQUOISE, ETC.) AND TO SKIP THE NEXT REQUEST. IF STANDARD FRINGE COLORS ARE NOT DESIRED, THEN ENTER THE FRINGE NUMBER AND THE COLOR COMPONENTS FOR THAT FRINGE. A LINE OF ZEROES TERMINATES THIS COMMAND. THIS REQUEST IS SKIPPED IF STANDARD FRINGES ARE USED. CONTOUR THE CONTOUR COMMAND ALLOWS THE USER TO PLOT CONTOUR LINES ON HIS HIDDEN LINE DRAWING OUTPUT. SINCE THE LINES ARE PLOTTED USING RASTER SCAN LOGIC, THE CONTOURS WILL CURVE ACROSS THE MODEL. <# OF CONTOURS, LABEL SPACING>  ENTER THE NUMBER OF CONTOUR LINES (26 MAXIMUM) AND THE LABEL SPACING (THE NUMBER OF RASTER LINES BETWEEN LABELS). ENTER THE MINIMUM AND MAXIMUM CONTOUR VALUES TO BE PLOTTED. MOVIE USER'S MANUAL Page 1-5 DEVICE THE DEVICE COMMAND IS A SUBSET OF THE SCOPE COMMAND.  IT ALLOWS THE USER TO CHANGE DISPLAY DEVICES WITHOUT CHANGING OTHER SCOPE PARAMETERS. ENTER ONE OF THE FOLLOWING ALLOWABLE DISPLAY DEVICE ABBREVIATIONS: HPLT (HP PLOTTER), CPLT (CALCOMP PLOTTER), TEKT (TEKTRONIX), OR COMT (COMTAL). DIFUSE THE DIFUSE COMMAND ALLOWS THE USER TO SPECIFY THE AMOUNT OF DIFUSED LIGHT IN THE PICTURE BY PARTS. A LINE OF ZEROES TERMINATES THIS COMMAND. ENTER THE PART NUMBER AND THE VALUE OF DIFUSE FOR THAT PART. IF I2 IS GREATER THAN I1, THEN ALL PARTS I1 THROUGH I2 WILL HAVE THE SAME DIFUSED LIGHT. DISTANCE THE DISTANCE COMMAND ALLOWS THE USER TO SPECIFY THE DISTANCE BETWEEN THE MODEL AND OBSERVER. ENTER THE DISTANCE FROM THE OBSERVER TO THE MODEL ORIGIN. DRAW THE DRAW COMMAND SENDS THE PICTURE DEFINED BY ALL PREVIOUS COMMANDS TO THE DISPLAY DEVICE SELECTED IN THE SCOPE OR DEVICE COMMANDS. WHEN THIS DISPLAY OPTION IS USED MOVIE USER'S MANUAL Page 1-6 WITH LINE DRAWING OUTPUT, THE WATKIN'S HIDDEN LINE ALGORITHM IS NOT CALLED. EXIT THE EXIT COMMAND PROVIDES A CONTROLED TERMINATION OF THE PROGRAM (INCLUDING DUMPING OF THE OUTPUT BUFFER). EXPLODE THE EXPLODE COMMAND ALLOWS THE USER TO SPECIFY LOCAL MOTION (EXPLOSION) PATTERNS FOR ANY GROUP OF ELEMENTS.  ENTER THE PART NUMBERS AND THE LOCAL MOTION PATTERN IN THE X, Y, AND Z DIRECTIONS. IF I2 IS GREATER THAN I1, ALL PARTS I1 THROUGH I2 WILL HAVE THE SAME PATTERN. A LINE OF ZEROES TERMINATES THIS COMMAND. ENTER THE SCALE FACTOR TO BE USED IN SCALING THE ABOVE MOTION PATTERN PRIOR TO THEIR BEING ADDED TO THE NODAL COORDINATES. FAST THE FAST COMMAND ALLOWS THE USER TO DEFINE THE DATA ORGANIZATION AND INVOKE THE POOR MAN'S HIDDEN SURFACE PROCEDURE. ENTER Y OR YES IF THE POLYGONAL VERTICES IN THE GEOMETRY FILE ARE NOT ORDERED IN A CONSISTANT CLOCKWISE OR COUNTER-CLOCKWISE DIRECTION AND CAUSE THE NEXT TWO REQUESTS TO BE SKIPPED. THE POOR MAN'S HIDDEN SURFACE PROCEDURE CAN NOT BE USED UNLESS THE DATA IS CONSISTANT. MOVIE USER'S MANUAL Page 1-7 ENTER Y OR YES TO INVOKE THE POOR MAN'S HIDDEN SURFACE PROCEDURE. THE POOR MAN'S PROCEDURE WILL NOT SEND TO THE WATKIN'S ALGORITHM ANY POLYGON THE IS FACING AWAY FROM THE OBSEVER. THIS  SIGNIFICATLY REDUCES THE TIME NEEDED TO SOLVE THE HIDDEN SURFACE PROBLEM. USE IT WHEN EVER POSSIBLE. ENTER Y OR YES TO INDICATE A CLOCKWISE ORIENTATION OF THE POLYGONAL VERTICES WHEN VIEWING THE ELEMENT ON ITS OUTSIDE FACE. A COUNTER-CLOCKWISE ORIENTATION IS ASSUMED OTHERWISE. FIELD  THE FIELD COMMAND ALLOWS THE USER TO DEFINE THE FRUSTRUM OF VISION. ENTER THE ANGLE OF VIEW, THE DISTANCE TO THE FRONT CLIPPING PLANE, AND THE DISTANCE TO THE BACK CLIPPING PLANE. THE FRONT AND BACK CLIPPING PLANES SHOULD BE PLACED FAR ENOUGH AWAY FROM THE MODEL TO ALLOW FOR ALL ROTATIONS AND TRANSLATIONS TO WHICH THE MODEL WILL BE SUBJECTED. A SMALL ANGLE OF VIEW WILL REDUCE THE PERSPECTIVE WHILE A LARGE ANGLE OF VIEW WILL EXAGGERATE THE PERSPECTIVE. FLAT THE FLAT COMMAND WILL INVOKE FLAT ELEMENT SHADING. THE LIGHT INTENSITY WILL VARY AS THE COSINE SQUARE OF THE NORMAL BETWEEN THE LIGHT SOURCE AND THE NORMAL TO THE ELEMENT, BUT THE LIGHT INTENSITIES WILL NOT (IN GENERAL) MATCH AT THE ELEMENT BOUNDARIES. MOVIE USER'S MANUAL Page 1-8 FRINGE THE FRINGE COMMAND ALLOWS THE USER TO SPECIFY COLOR FRINGES TO REPRESENT THE DISPLACEMENT SYSTEM OR A SCALAR FUNCTION. <# OF FRINGES> ENTER THE NUMBER OF COLOR FRINGES. THIS NUMBER SHOULD NOT EXCEED THE NUMBER OF FRINGES SPECIFIED IN THE COLOR COMMAND. ENTER Y OR YES IF DISPLACEMENT FRINGES ARE DESIRED. ANY OTHER RESPONSE WILL SKIP OVER FURTHER REQUEST FOR DISPLACEMENT FRINGE INFORMATION. ENTER THE DIRECTION COSINES FOR THE DIRECTION IN WHICH THE DISPLACEMENTS ARE TO BE MONITORED AND DISPLAYED IN TERMS OF COLOR FRINGES. ENTER THE PART NUMBERS AND THE MINIMUM AND MAXIMUM FRINGE VALUE FOR THOSE PARTS. VALUES LESS THAN THE MINIMUM WILL HAVE THE MINIMUM FRINGE COLOR, AND VALUES GREATER THAN THE MAXIMUM WILL HAVE THE MAXIMUM FRINGE COLOR. IF I2 IS GREATER THAN I1, THEN ALL PARTS I1 THROUGH I2 WILL HAVE THE SAME FRINGE RANGE. A LINE OF ZEROES TERMINATES THIS COMMAND. LINEAR THE LINEAR COMMAND ALONG WITH THE TRANSIENT DATA OPTION IN THE MOVIE COMMAND ALLOWS THE USER TO LINEARLY  INTERPOLATE BETWEEN TWO DISPLACEMENT AND/OR SCALAR FUNCTION FILES. ENTER Y OR YES IF THE NODAL GEOMETRY IS TO BE MODIFIED BY THE PREVIOUSLY READ DISPLACEMENTS MULTIPLIED BY THE SCALE FACTOR SPECIFIED IN THE SCALE COMMAND AND IF THE FIRST SCALAR FUNCTION IS TO BE INCREMENTED TO THE SECOND SCALAR FUNCTION. ENTER THE FILENAME.EXT OF THE DISPLACEMENT FILE AT TIME=I. IF THE EXTENTION IS OMITTED, THE DEFAULT EXTENSION DAT WILL BE USED. A NULL FILE DESIGNATION WILL SKIP TO THE NEXT REQUEST WITHOUT READING A FILE. THE DISPLACMENTS ARE READ IN THE SAME FORMAT AS DESCRIBED PREVIOUSLY. ENTER THE NAME OF THE DISPLACEMENT FILE AT TIME=I+1 IN THE SAME FORMAT AS ABOVE. ENTER THE NAME OF THE SCALAR FUNCTION FILE AT TIME=I IN THE SAME FORMAT AS ABOVE. ENTER THE NAME OF THE SCALAR FUNCTION FILE AT TIME=I+1 IN THE SAME FORMAT AS ABOVE. MOVIE USER'S MANUAL Page 1-10 MOVIE THE MOVIE COMMAND ALLOWS THE USER  TO SPECIFY A ANIMATED SEQUENCE OF FRAMES. A SIMULATION OF HARMONIC STRUCTURAL VIBRATION IS POSSIBLE USING THIS OPTION AND SPECIFYING A DISPLACEMENT SCALE FACTOR. <# OF FRAMES> ENTER THE NUMBER OF FRAMES. THIS OPTION IS NOT ONLY USEFUL WHEN GENERATING LONG SEGUENCES OF FRAMES FOR MOVIES BUT ALSO FOR AS FEW AS TWO OR THREE FRAMES TO VIEW THE MODEL FROM DIFFERENT POSITIONS. ENTER THE NUMBERS OF THE FIRST AND LAST FRAMES TO ACTUALLY BE DISPLAYED. THIS OPTION IS USEFUL WHEN THE SYSTEM CRASHES WHILE IN THE MIDDLE OF A LONG SEQUENCE. INSTEAD OF REGENERATING ALL FRAMES OF THE SEQUENCE, IT IS ONLY NECESSARY TO GIVE THE NUMBERS OF THE FRAMES WANTED. IF A ZERO NUMBER  OF FRAMES IS GIVEN, THE PROGRAM SENDS ALL THE FRAMES TO THE DISPLAY DEVICE. ENTER Y OR YES IF A LINEAR INTERPOLATION BETWEEN TWO DISPLACEMENT OR SCALAR FUNCTION FILES IS DESIRED OVER THE NUMBER OF FRAMES SPECIFIED ABOVE. IF THIS OPTION IS USED, THE NEXT REQUEST WILL BE SKIPPED IF A NON-ZERO DISPLACEMENT SCALE FACTOR WAS ENTERED, THIS COMMAND WILL BE TYPED ON THE USER'S TERMINAL. ENTER THE NUMBER OF VIBRATION CYCLES PER FRAME FOR SIMULATION OF HARMONIC VIBRATION. ENTER THE TOTAL CHANGE IN THE TRANSLATION OF THE ORIGIN IN THE X, Y, AND Z DIRECTIONS. ENTER THE TOTAL CHANGE IN ROTATION ABOUT THE TRANSLATED ORIGIN IN THE GLOBAL X, Y, AND Z DIRECTIONS. THE INCREMENTAL ROTATIONS WILL BE MADE IN THE X, Y, Z ORDER. REMEMBER, FINITE ROTATIONS DO MOVIE USER'S MANUAL Page 1-11 NOT ADD AS VECTORS! ENTER THE PART NUMBERS AND THE ROTATIONS IN THE X, Y, AND Z DIRECTIONS ABOUT THE RELATIVE ORIGINS SPECIFIED IN THE PIVOT COMMAND. THIS COMMAND IS TERMINATED WITH A LINE OF ZEROES. ENTER THE CHANGE IN THE DISTANCE TO THE ORIGIN. A NEGATIVE VALUE WILL BRING THE MODEL TOWARDS THE OBSERVER. ENTER THE CHANGE IN THE DISPLACEMENT SCALE FACTOR. ENTER THE CHANGE IN THE LOCAL MOTION SCALE FACTOR. THIS COMMAND WILL PRODUCE SMOOTH ANIMATION OF THE EXPLOSION PATTERNS DEFINED IN THE EXPLODE COMMAND. ENTER Y OR YES TO SEND PICTURES TO THE DISPLAY DEVICE. ANY OTHER CHARACTER WILL CAUSE THE NEXT DISPLAY COMMAND TO PERFORM THE ANIMATION BUT  WILL NOT SEND THE PICTURES TO THE DISPLAY DEVICE. THIS IS HELPFUL IN CHECKING KEY FRAMES IN A MOVIE SINCE THE FINAL SCENE CAN BE DISPLAYED BY ISSUING A SECOND DISPLAY COMMANDS. PARTS THE PARTS COMMAND ALLOWS THE USER TO SELECT ALL OF THE MODEL OR A SUBSET OF THE MODEL FOR DISPLAY. ENTER Y OR YES TO DISPLAY ALL PARTS IN THE MODEL AND TO SKIP THE NEXT REQUEST. MOVIE USER'S MANUAL Page 1-12 ENTER THE NUMBERS OF THE PARTS THAT ARE TO BE DISPLAYED. IF I2 IS GREATER THAN I1, ALL PARTS I1 THROUGH I2 WILL BE DISPLAYED. A LINE OF ZEROES TERMINATES THIS COMMAND. PIVOT THE PIVOT COMMAND ALLOWS THE USER TO ROTATE INDIVIDUAL PARTS OF THE MODEL ABOUT AN ORIGIN DEFINED FOR THAT PART IN THE ORIGINAL AXIS DIRECTIONS OF THE MODEL. ENTER THE PART NUMBERS, THE AXIS (X, Y, OR Z), AND THE ANGLE OF ROTATION. IF I2 IS GREATER THAN I1, ALL PARTS I1 THROUGH I2 WILL BE PIVOTED. A LINE OF ZEROES TERMINATES THIS COMMAND. ENTER THE PART NUMBERS AND THE RELATIVE ORIGIN OF THE PARTS. THE RELATIVE ORIGIN SPECIFIES THE POINT ABOUT WHICH THE ROTATIONS WILL TAKE PLACE. ROTATIONS ARE ABOUT AXES PARALLEL TO THE ORIGINAL AXES OF THE MODEL. A LINE OF ZEROES TERMINATES THIS COMMAND. READ THE READ COMMAND RETURNS CONTROL TO THE BEGINNING OF THE PROGRAM SO THE USER MAY READ IN NEW GEOMETRY, DISPLACEMENT, AND SPECIAL FUNCTION FILES. RESTORE THE RESTORE COMMAND ZEROES ALL ROTATIONS AND TRANSLATIONS AND INTIALIZES THE ROTATION TRANSFORMATION MATRIX. MOVIE USER'S MANUAL Page 1-13 ROTATE THE COMMAND ROTATE ALLOWS THE USER TO ROTATE THE MODEL ABOUT THE TRANSLATED ORIGIN. ENTER ONE OF THE AXES (X, Y, OR Z) AND THE ANGLE OF ROTATION IN DEGREES. SCALE THE SCALE COMMAND ALLOWS THE USER TO SELECT A SCALE FACTOR FOR THE DISPLACEMENTS. THE DISPLACEMENTS WILL BE MULTIPLIED BY THE SCALE FACTOR BEFORE THEY ARE ADDED TO THE NODAL COORDINATES. ENTER THE DISPLACEMENT SCALE FACTOR. SCOPE THE SCOPE COMMAND REQUESTS INFORMATION NECESSARY TO DEFINE CERTAIN PICTURE VARIABLES. ENTER ONE OF THE FOLLOWING ALLOWABLE DISPLAY DEVICE ABBREVIATIONS: HPLT (HP PLOTTER), CPLT (CALCOMP PLOTTER), TEKT (TEKTRONIX), OR COMT (COMTAL).  THIS REQUEST IS ISSUED FOR CONTINUOUS-TONE DISPLAY DEVICES ONLY. ENTER C OR COLOR TO DISPLAY THE SCENE IN COLOR. THE DEFAULT DISPLAY MODE IS BLACK AND WHITE. ENTER THE RESOLUTION IN THE HORIZONTAL AND VERTICAL DIRECTIONS. IF ONLY THE XRESOL IS GIVEN, YRESOL IS ASSUMED TO HAVE THE SAME VALUE. IF BOTH MOVIE USER'S MANUAL Page 1-14 ARE ZERO, THE MAXIMUM VALUE OF 512 IS USED. SMOOTH THE SMOOTH COMMAND WILL INVOKE SMOOTH ELEMENT SHADING. THE LIGHT INTENSITY WILL MATCH AT ELEMENT BOUNDARIES PROVIDING CURVED SURFACE SIMULATION. THE DERIVATIVE OF THE LIGHT INTENSITY MAY NOT MATCH AT ELEMENT BOUNDARIES CAUSING MACH BAND EFFECTS (WHICH MAY OR MAY NOT BE NOTICABLE). SUMMARY THE SUMMARY COMMAND CALCULATES THE MINIMUM AND MAXIMUM VALUES OF THE COORDINATES, DISPLACEMENTS, AND SCALAR FUNCTIONS AND TYPES THEM ON THE USER'S TERMINAL FOR THE PARTS SPECIFIED IN CONTENT. TRANSLATE THE TRANSLATE COMMAND ALLOWS THE USER TO SHIFT THE ORIGIN OF THE MODEL TO A NEW LOCATION. ENTER THE COORDINATES OF THE NEW ORIGIN. UNIFORM THE UNIFORM COMMAND INVOKES UNIFORM SHADING OF THE ELEMENT FACES. THE SHADING WILL REMAIN CONSTANT OVER EACH INDIVIDUAL ELEMENT. THE VALUE USED IS THE AVERAGE OF THE NODAL VALUES BASED UPON FLAT SHADING. MOVIE USER'S MANUAL Page 1-15  VIEW THE VIEW COMMAND SENDS THE PICTURE DEFINED BY ALL PREVIOUS COMMANDS TO THE DISPLAY DEVICE SELECTED IN THE SCOPE OR DEVICE COMMANDS. THIS DISPLAY COMMAND WILL INVOKE WATKIN'S ALGORITHM TO REMOVE HIDDEN LINES OR SURFACES. THE PROGRAM WILL TYPE THE COLOR OPTION IN EFFECT IF THE OUTPUT IS A CONTINUOUS TONE PICTURE ELSE IT WILL TYPE THE NAME OF THE LINE DRAWING OUTPUT DEVICE.  WARP THE WARP COMMAND ALLOWS THE USER TO SPECIFY THE SCALE FACTORS IN THE X, Y, AND Z DIRECTIONS OF THE MODEL BY WHICH THE SCALAR FUNCTIONS WILL BE MODIFIED BEFORE THEY ARE ADDED TO THE NODAL COORDINATES. THIS IS USEFUL OVER LARGE PLANAR AREAS WHEN THE SCALE FACTORS ARE A MULTIPLE OF THE DIRECTIONS COSINES OF A NORMAL TO THE PLANAR AREA.  ENTER THE WARPING SCALE FACTORS FOR THE MODEL PARTS. ERROR MESSAGES IF A COMMAND IS NOT RECOGNIZED DURING THE EXECUTION OF THE PROGRAM, THE ILLEGAL COMMAND IS TYPED ON THE USER'S TERMINAL AS FOLLOWS. IF THE USER WISHES TO SEE A LIST OF THE AVAILABLE COMMANDS, HE SHOULD ANSWER Y OR YES TO THIS ERROR MESSAGE. Page Index-1 MOVIE USER'S MANUAL INDEX Animated sequence . . . . . . 1-10 Center . . . . . . . . . . . . 1-3 Color . . . . . . . . . . . . 1-3 Command prompt . . . . . . . . 1-3 Contour . . . . . . . . . . . 1-4 Device . . . . . . . . . . . . 1-5 Difuse . . . . . . . . . . . . 1-5 Displacement file . . . . . . 1-2  Distance . . . . . . . . . . . 1-5 Draw . . . . . . . . . . . . . 1-5 Error messages . . . . . . . . 1-15 Exit . . . . . . . . . . . . . 1-6 Explode . . . . . . . . . . . 1-6 Fast . . . . . . . . . . . . . 1-6 Field . . . . . . . . . . . . 1-7 Flat . . . . . . . . . . . . . 1-7 Fringe . . . . . . . . . . . . 1-8 Geometry file . . . . . . . . 1-1 Help . . . . . . . . . . . . . 1-8 Ip . . . . . . . . . . . . . . 1-2 Linear . . . . . . . . . . . . 1-9 Movie . . . . . . . . . . . . 1-10 Nj . . . . . . . . . . . . . . 1-2 Np . . . . . . . . . . . . . . 1-2 Npl . . . . . . . . . . . . . 1-2 Npt . . . . . . . . . . . . . 1-2 Parts . . . . . . . . . . . . 1-11 Pivot . . . . . . . . . . . . 1-12 Read . . . . . . . . . . . . . 1-12 Restore . . . . . . . . . . . 1-12 Rotate . . . . . . . . . . . . 1-13 S . . . . . . . . . . . . . . 1-2 Scalar function file . . . . . 1-2 Scale . . . . . . . . . . . . 1-13 Scope . . . . . . . . . . . . 1-13 Smooth . . . . . . . . . . . . 1-14 Structural vibration . . . . . 1-10 Summary . . . . . . . . . . . 1-14 Translate . . . . . . . . . . 1-14 U . . . . . . . . . . . . . . 1-2 Uniform . . . . . . . . . . . 1-14 View . . . . . . . . . . . . . 1-15 Warp . . . . . . . . . . . . . 1-15 X . . . . . . . . . . . . . . 1-2 CHAPTER 2 UTILITY USER'S MANUAL INTRODUCTION UTILITY IS A ROUTINE DESIGNED TO EDIT FORTRAN DATA FILES IN A FORMAT WHICH IS COMPATIBLE WITH MOVIE (PANEL DATA) OR SECTION (SOLID DATA). THE PROGRAM IS BASED UPON A FOUR LETTER KEY WORD SYSTEM WHICH ALLOWS THE USER TO SPECIFY COMMANDS TO READ, WRITE, OR CHANGE DATA FILES, TO PERFORM SYMMETRY OPERATIONS (E. G. TO CREATE A MODEL OF A COMPLETE SPHERE BASED UPON A MODEL OF 1/8 OF THE SPHERE LOCATED IN THE FIRST QUADRANT), TO ORDER PANEL DATA CONSISTENTLY, OR TO EXIT FROM THE PROGRAM IN A CONTROLLED MANNER. WHILE THE FOLLOWING INSTRUCTIONS ARE RATHER LENGTHY, USERS WILL NORMALLY NOT FIND MUCH REASON TO REFER TO THEM. THE SYSTEM IS EASILY LEARNED SINCE THE PROGRAM ASKS SPECIFIC QUESTIONS OR GIVES ONE OF THE FOLLOWING PROMPTS (> FOR LEVEL 1, >> FOR LEVEL 2, OR >>> FOR LEVEL 3). WHEN THESE PROMPTS ARE ENCOUNTERED, A LISTING OF THE AVAILABLE OPTIONS MAY BE OBTAINED BY ENTERING ? OR HELP. ESCAPE FROM REPEATED REQUESTS (IF ESCAPE IS APPROPRIATE) IS ACCOMPLISHED WITH A CARRIAGE RETURN. A CARRIAGE RETURN FOLLOWING THE PROMPT (>>>) FOR LEVEL 3 WILL TRANSFER CONTROL TO LEVEL 2 AND GIVE THE PROMPT (>>). ESCAPE TO LEVEL 1 IS ALSO OBTAINED BY A CARRIAGE RETURN. SINCE UTILITY IS APPLICABLE TO BOTH SOLID DATA (8 NODE BRICKS) AND PANEL DATA (TRIANGLES AND QUADRILATERALS), THE PROGRAM ISSUES THE FOLLOWING REQUEST. ENTER S OR SOLID FOR SOLID DATA MANIPULATION. ANY OTHER RESPONSE WILL DEFAULT TO PANEL DATA. UTILITY USER'S MANUAL Page 2-2 LEVEL 1 THE PROGRAM IS ENTERED AT LEVEL 1 AND THE CORRESPONDING PROMPT (>) IS GIVEN. AT THIS POINT THE USER SHOULD ENTER ONE OF THE FOLLOWING COMMANDS: GEOMETRY, DISPLACEMENT, FUNCTION, SYMMETRY, ORDER, OR EXIT. ACTUALLY ONLY THE FIRST FOUR LETTERS OF THE COMMANDS ARE REQUIRED. IF ANY OTHER COMMAND IS GIVEN, THE ABOVE OPTIONS ARE LISTED AND THE PROMPT IS REPEATED. IF THE COMMAND GIVEN IS GEOM, DISP, OR SPEC THE PROGRAM ENTERS LEVEL 2. IF THE COMMAND IS SYMM, SYMMETRY OPERATIONS ARE PERFORMED AS SPECIFIED. IF THE COMMAND IS ORDER AND THE PROGRAM IS IN PANEL MODE, THE ELMENTS OR PANELS ARE CONSISTENTLY ORDERED WITHIN EACH ELEMEMT GROUP. FOR THE COMMAND EXIT, THE BUFFERS ARE DUMPED AND CONTROL IS RETURNED TO THE MONITOR. LEVEL 2 THE LEVEL 2 ALGORITHM ENTERED DEPENDS UPON THE COMMAND GIVEN IN LEVEL 1. HOWEVER, THEY ALL SHARE THE SAME FUNCTIONAL COMMANDS WHICH ARE READ, WRITE, CHANGE, PRINT AND EXIT. IF THE COMMAND GIVEN IS UNACCEPTABLE, THE LEVEL 2 OPTIONS ARE LISTED AND THE PROMPT IS REPEATED. THE RESPONSE TO THE FIVE  ACCEPTABLE COMMANDS DEPENDS UPON THE COMMANDS GIVEN AT BOTH LEVEL 1 AND LEVEL 2. THIS RESPONSE WILL NOW BE DISCUSSED ACCORDING TO THE VARIOUS COMBINATIONS OF LEVEL 1 - LEVEL 2 COMMANDS. GEOM-READ ENTER THE INPUT GEOMETRY FILENAME.EXT. THE FILENAME SHOULD NOT EXCEED SIX CHARACTERS, AND THE EXTENSION SHOULD NOT EXCEED THREE. IF THE EXTENSION IS OMITTED, THE DEFAULT EXTENSION DAT WILL BE ASSUMED.(1) (1) THE MANNER IN WHICH DATA FILES ARE INITIALIZED IS AN INSTALLATION DEPENDENT FEATURE. APPROPRIATE MODIFICATIONS SHOULD BE MADE IN THE SOURCE PROGRAM TO ACCOMMODATE YOUR SYSTEM. UTILITY USER'S MANUAL Page 2-3 AT THIS POINT THE GEOMETRY FILE WILL BE READ USING THE FOLLOWING FORTRAN STATEMENTS. READ(IDTA,10) NP,NJ,NPT READ(IDTA,10) ((NPL(I,J),I=1,2),J=1,NP) READ(IDTA,20) ((X(I,J),I=1,3),J=1,NJ) READ(IDTA,10) ((IP(I,J),I=1,N),J=1,NPT) 10 FORMAT(20I4) 20 FORMAT(6E12.5) THE VARIABLES ARE DEFINED AS FOLLOWS: NP = THE NUMBER OF PARTS NJ = THE NUMBER OF NODES OR JOINTS NPT = THE NUMBER OF ELEMENTS  NPL = THE PARTS ARRAY(2) X = THE COORDINATES OF THE NODES IP = THE CONNECTIVITY OF THE ELEMENTS AFTER READING THE GEOMETRY FILE THE PROGRAM REQUEST VERIFICATION THAT THE PARTS ARRAY IS DEFINED PROPERLY. (LIST OF TOTAL NPL ARRAY) (LIST OF DIFFERENCED NPL ARRAY) ENTER Y OR YES IF THE PARTS ARRAY IS DEFINED  PROPERLY. ANY OTHER RESPONSE WILL REQUEST THE USER TO REDEFINE THE PARTS ARRAY. (2) THE PARTS ARRAY IS DEFINED IN ONE OF TWO WAYS. THE FIRST DEFINITION ASSUMS THAT THE ARRAY IS ONE DIMENSIONAL. EACH STORAGE LOCATION IN THE ARRAY CONTAINS THE NUMBER OF ELEMENTS IN THE ELEMENT GROUP THAT CORRESPONDS WITH THAT LOCATION. THE SECOND DEFINITION ASSUMS THAT THE ARRAY IS TWO DIMENSIONAL. THE  ARRAY CONTAINS THE LOWER AND UPPER LIMIT NUMBERS OF THE ELEMENTS ASSOCIATED WITH THAT PART. THESE DEFINITIONS ARE NOT NECESSARILY INTERCHANGABLE. THE SECOND DEFINITION ALLOWS PARTS TO OVERLAP WHILE THE FIRST DOES NOT. UTILITY REQUIRES THE NPL ARRAY BE DEFINED AS IN THE FIRST DEFINITION INTERNALLY ALTHOUGHT THE NPL ARRAY IS READ AND WRITTEN ACCORDING TO THE SECOND DEFINITION. UTILITY USER'S MANUAL  Page 2-4 THIS MESSAGE IS PRINTED IF THE PROGRAM DETECTS MULTIPLY DEFINED PARTS WHILE ATTEMPTING TO CONSTRUCT THE PARTS ARRAY. THE PROGRAM WILL REQUEST THE USER TO SUPPLY THE CORRECT PARTS ARRAY. ENTER THE NUMBER OF ELEMENT GROUPINGS ENTER THE NUMBER OF ELEMENTS IN EACH GROUP. GEOM-WRITE ENTER THE OUTPUT GEOMETRY FILENAME.EXT. THE FILENAME SHOULD NOT EXCEED SIX CHARACTERS, AND THE EXTENSION SHOULD NOT EXCEED THREE. IF THE EXTENSION IS OMITTED, THE DEFAULT EXTENSION DAT WILL BE ASSUMED. BEFORE WRITING THE GEOMETRY FILE, THE PROGRAM ALLOWS THE USER TO VERIFIY THE PARTS ARRAY AND TO CHANGE IT IF DESIRED. (LIST OF NPL ARRAY) ENTER Y OR YES IF THE LOWER AND UPPER LIMITS OF THE PARTS ARRAY ARE CORRECT. ANY OTHER RESPONSE WILL REQUEST NEW ELEMENT LIMIT INFORMATION. ENTER THE NUMBER OF PARTS. ENTER THE LOWER AND UPPER LIMIT NUMBERS OF THE BOUNDING ELEMENTS FOR EACH PART. (REMEMBER, THIS MAY BE AN OVERLAPPING DEFINITION.) UTILITY USER'S MANUAL Page 2-5 AT THIS POINT THE GEOMETRY FILE WILL BE WRITTEN USING THE FOLLOWING FORTRAN STATEMENTS. WRITE(IDTA,10) NP,NJ,NPT WRITE(IDTA,10) ((NPL(I,J),I=1,2),J=1,NP) WRITE(IDTA,20) ((X(I,J),I=1,3),J=1,NJ) WRITE(IDTA,10) ((IP(I,J),I=1,N),J=1,NPT) 10 FORMAT(20I4) 20 FORMAT(1P6E12.5) FOR VARIABLE DESCIPTIONS, SEE GEOM-READ. GEOM-CHANGE THIS COMMAND RESULTS IN THE PROGRAM ENTERING LEVEL 3 WITH THE USER RECEIVING THE PROMPT (>>>). THE ALLOWABLE COMMANDS IN THIS INSTANCE ARE GROUP, COORDINATES, ELEMENTS, MOVE, AND EXIT AN UNACCEPTABLE COMMAND WILL RESULT IN A LISTING OF THE FIVE LEGITIMATE COMMANDS AND THE PROMPT (>>>). ISSUE OF AN ACCEPTABLE COMMAND RESULTS IN THE FOLLOWING ACTIONS. GEOM-CHAN-GROUP ENTER THE NUMBER OF ELEMENT GROUPS (NP). ENTER THE COMPLETE ELEMENT GROUP LIST (NPL(1,I),I=1,NP). GEOM-CHAN-COORDINATES  ENTER Y OR YES TO CHANGE THE TOTAL NUMBER OF NODES (NJ) IN THE MODEL. ANY OTHER RESPONSE WILL SKIP THE NEXT REQUEST. UTILITY USER'S MANUAL Page 2-6 ENTER THE NEW NUMBER OF NODES. ENTER THE APPROPRIATE NODE NUMBER AND CORRESPONDING X, Y, AND Z COORDINATE VALUES (RIGHT HANDED SYSTEM) ACCORDING TO THE FORMAT (I,3E). IF THE NODE NUMBER IS LARGER THAN THE CURRENT TOTAL NUMBER OF NODES, THE TOTAL NUMBER OF NODES IS INCREASED TO THE VALUE OF THE ENTERED NODE NUMBER. GEOM-CHAN-ELEMENT ENTER A OR ADD TO ADD NEW ELEMENTS; ENTER D OR DELETE TO DELETE OLD ELEMENTS.  ENTER THE PART NUMBER AND ELEMENT NUMBERS (IN APPROPRIATE ORDER) ACCORDING TO THE FORMAT (5I) FOR QUADRILATERAL ELEMENTS, (4I) FOR TRIANGULAR ELEMENTS AND (9I) FOR SOLID ELEMENTS. ELEMENTS ARE INSERTED INTO THE ELEMENT LIST AT THE END OF THE GROUP OF ELEMENTS FOR THE INDICATED PART. THE APPROPRIATE PART GROUP NUMBER (NPL(1,I)) WILL BE INCREASED. IF THE USER WISHES TO ENTER ELEMENTS IN A NEW PART GROUP, HE SHOULD FIRST USE THE LEVEL 3 COMMAND PART TO INCREASE THE TOTAL NUMBER OF PARTS BY ONE AND ENTER THE VECTOR (NPL(1,I)) WITH THE LAST VALUE (FOR THE NEW GROUP) SET EQUAL TO ZERO. APPROPRIATE MODIFICATION IS MADE IN (NPL(1,I)) IF AN ELEMENT IS DELETED. HOWEVER, IF AN ENTIRE PART IS DELETED, THE COMMAND PART SHOULD BE EXECUTED (AFTER THE COMPLETION OF THE DELETION PROCESS) TO REDUCE THE TOTAL NUMBER OF PARTS. IF AN ELEMENT IS SPECIFIED TO BE DELETED FROM THE LIST AND CANNOT BE FOUND IN THE LIST, THE PROGRAM RESPONDS WITH THE MESSAGE %. IF AN ELEMENT HAS BEEN ENTERED WITH AN INCORRECT NODE  NUMBER, THE CORRECTION WILL REQUIRE THAT THE ELEMENT BE DELETED AND THE CORRECT ONE ENTERED (I. E. THERE IS NO REPLACE FEATURE!). UTILITY USER'S MANUAL Page 2-7 GEOM-CHAN-MOVE ENTER THE APPROPRIATE VALUES FOR I1, I2, AND I3. TO ILLUSTRATE THE USE OF THIS COMMAND, CONSIDER THE FOLLOWING EXAMPLE. SUPPOSE THAT WE WISH TO REORDER A LIST OF SIX ELEMENTS SUCH THAT THE FIRST TWO ELEMENTS REMAIN WHERE THEY ARE, THE FIFTH ELEMENT BECOMES THE THIRD ELEMENT, THE THIRD AND FOURTH ELEMENTS BECOME THE FOURTH AND FIFTH ELEMENTS AND THE SIXTH ELEMENT RETAINS ITS POSITION. THIS REORDERING MAY BE ACHIEVED BY THE MOVE COMMAND (2,3,5) OR (1,5,2). MOVE COMMANDS DO NOT AUTOMATICALLY RESULT IN CHANGES TO THE (NPL(1,I)) LIST. THE USER MAY MODIFY (NPL(1,I)) AS APPROPRIATE, EITHER BEFORE OR AFTER USING THE MOVE COMMAND. CAUTION SHOULD BE EXERCISED IN THE USE OF REPEATED MOVE COMMANDS TO AVOID GETTING ALL MIXED UP. USE OF PRIN COMMANDS BETWEEN MOVE COMMANDS TO ESTABLISH ELEMENT GROUP LIMIT LOCATIONS IS RECOMMENDED. GEOM-PRINT THIS COMMAND PAIR IS STRUCTURED SO AS TO FACILITATE QUICK CHECKS OF SUBSETS OF THE DATA. THESE COMMANDS RESULT IN THE PROGRAM ENTERING A LEVEL 3 OPERATION WITH THE PROMPT (>>>) WHICH IS SIMILAR TO THAT DISCUSSED IN GEOM-CHAN. THE ACCEPTABLE COMMANDS AT THIS LEVEL ARE GROUP, COORDINATES, ELEMENTS, AND EXIT. ISSUE OF ONE OF THESE COMMANDS RESULTS IN THE FOLLOWING ACTION. GEOM-PRIN-GROUP THE COMPLETE PART LIST (NPL(1,I),I=1,NP) IS PRINTED. GEOM-PRIN-COORDINATE ENTER I1 AND I2 WITH I1 BEING THE LOWER LIMIT AND I2 BEING THE UPPER LIMIT NODE NUMBERS (2I FORMAT). TO OBTAIN THE COORDINATES OF A SINGLE NODE SIMPLY ENTER JUST THE DESIRED NODE AS I1 AND DO NOT  ENTER I2. I2 WILL BE ADJUSTED TO BE NOT GREATER THAN (NJ). UTILITY USER'S MANUAL Page 2-8 GEOM-PRIN-ELEMENT ENTER I1 AND I2 WITH I1 BEING THE LOWER LIMIT AND I2 BEING THE UPPER LIMIT ELEMENT NUMBERS (2I FORMAT). TO OBTAIN THE NODE NUMBERS OF A SINGLE ELEMENT SIMPLY ENTER JUST THE DESIRED ELEMENT AS I1  AND DO NOT ENTER I2. I2 WILL BE ADJUSTED TO BE NOT GREATER THAN (NPT). DISP-READ ENTER THE INPUT DISPLACEMENT FILENAME.EXT. THE FILENAME SHOULD NOT EXCEED SIX CHARACTERS, AND THE EXTENSION SHOULD NOT EXCEED THREE. IF THE EXTENSION IS OMITTED, THE DEFAULT EXTENSION DAT WILL BE ASSUMED.  AT THIS POINT THE DISPLACEMENT FILE WILL BE READ USING THE FOLLOWING FORTRAN STATEMENTS. READ(IDTA,20) ((U(I,J),I=1,3),J=1,NJ) 20 FORMAT(6E12.5) THE VARIABLE, U, IS THE DISPLACEMENTS AT THE NODES. DISP-WRITE ENTER THE OUTPUT DISPLACEMENT FILENAME.EXT. THE FILENAME SHOULD NOT EXCEED SIX CHARACTERS, AND  THE EXTENSION SHOULD NOT EXCEED THREE. IF THE EXTENSION IS OMITTED, THE DEFAULT EXTENSION DAT WILL BE ASSUMED. AT THIS POINT THE DISPLACEMENT FILE WILL BE WRITTEN USING THE FOLLOWING FORTRAN STATEMENTS. UTILITY USER'S MANUAL Page 2-9 WRITE(IDTA,20) ((U(I,J),I=1,3),J=1,NJ) 20 FORMAT(1P6E12.5) FOR VARIABLE DESCIPTIONS, SEE DISP-READ. DISP-CHANGE ENTER THE NODE NUMBER AND THE X, Y, AND Z COORDINATE DIRECTION DISPLACEMENT COMPONENTS IN AN (I,3E) FORMAT. DISP-PRINT ENTER I1 AND I2 WITH I1 BEING THE LOWER LIMIT AND I2 BEING THE UPPER LIMIT NODE NUMBERS (2I FORMAT). TO OBTAIN THE DISPLACEMENTS OF A SINGLE NODE SIMPLY ENTER JUST THE DESIRED NODE AS I1 AND DO NOT ENTER I2. I2 WILL BE ADJUSTED TO BE NOT GREATER THAN (NJ). FUNC-READ ENTER THE INPUT SCALAR FUNCTION FILENAME.EXT. THE FILENAME SHOULD NOT EXCEED SIX CHARACTERS, AND THE EXTENSION SHOULD NOT EXCEED THREE. IF THE EXTENSION IS OMITTED, THE DEFAULT EXTENSION DAT WILL BE ASSUMED. AT THIS POINT THE SCALAR FUNCTION FILE WILL BE READ USING THE FOLLOWING FORTRAN STATEMENTS. READ(IDTA,20) (S(I),I=1,NJ) 20 FORMAT(6E12.5) UTILITY USER'S MANUAL Page 2-10 THE VARIABLE, S, IS THE SCALAR FUNCTION AT THE NODE. FUNC-WRITE ENTER THE OUTPUT SCALAR FUNCTION FILENAME.EXT. THE FILENAME SHOULD NOT EXCEED SIX CHARACTERS, AND THE EXTENSION SHOULD NOT EXCEED THREE. IF THE EXTENSION IS OMITTED, THE DEFAULT EXTENSION DAT WILL BE ASSUMED. AT THIS POINT THE SCALAR FUNCTION FILE WILL BE WRITTEN USING THE FOLLOWING FORTRAN STATEMENTS.  WRITE(IDTA,20) (S(I),I=1,NJ) 20 FORMAT(1P6E12.5) FOR VARIABLE DESCIPTIONS, SEE FUNC-READ. FUNC-CHANGE ENTER THE NODE NUMBER AND THE SCALAR FUNCTION VALUE. FUNC-PRINT ENTER I1 AND I2 WITH I1 BEING THE LOWER LIMIT AND I2 BEING THE UPPER LIMIT NODE NUMBERS (2I FORMAT). TO OBTAIN THE SCALAR FUNCTION OF A SINGLE NODE SIMPLY ENTER JUST THE DESIRED NODE AS I1 AND DO NOT ENTER I2. I2 WILL BE ADJUSTED TO BE NOT GREATER THAN (NJ). THIS COMPLETES THE DISCUSSION OF THE LEVEL 1-LEVEL 2 COMMAND COMBINATIONS. THE FOLLOWING PARAGRAPHS DESCRIBE THE OTHER LEVEL 1 COMMANDS WHICH ARE SYMMETRY AND ORDER.  UTILITY USER'S MANUAL Page 2-11 SYMMETRY THE SYMMETRY COMMAND PROVIDES MODIFICATION TO THE GEOMETRY, DISPLACEMENT, AND SPECIAL FUNCTION FILES. THE SYMMETRY OPERATION WILL DOUBLE THE NUMBER OF PARTS AND ELEMENTS, BUT THE NUMBER OF NODES WILL NOT DOUBLE DUE TO THE PRESENCE OF NODES ON THE PLANE OF SYMMETRY (WHICH ARE NOT REPEATED). IF BEFORE THE SYMMETRY OPERATION THERE WERE (NP) PARTS, THE SYMMETRICAL COUNTERPART TO THE NTH PART IS FOUND TO BE THE NP+NTH PART. ENTER ONE OF THE ACCEPTABLE SYMMETRY PLANES XY, XZ, OR YZ, OR A CARRIAGE RETURN TO PROVIDE ESCAPE. ENTER Y OR YES TO PREFORM THE SYMMETRY OPERATION ON MULTIPLE DISPLACEMENT OR SCALAR FUNCTION FILES. ANY OTHER REPONSE WILL SKIP THE REMAINING REQUESTS. ENTER THE NUMBER OF DISPLACEMENT FILES FOR WHICH SYMMETRY OPERATINS ARE DESIRED. A ZERO OR CARRIAGE RETURN WILL SKIP FURTHER REQUEST FOR DISPLACEMENT FILE INFORMATION. SEE DISP-READ FOR FORMAT INFORMATION.  SEE DISP-WRIT FOR FORMAT INFORMATION THE TWO REQUEST ABOVE ARE REPEATED FOR THE NUMBER OF DISPLACEMENT FILES SPECIFIED. ENTER THE NUMBER OF SCALAR FUNCTION FILES FOR WHICH SYMMETRY OPERATINS ARE DESIRED. A ZERO OR CARRIAGE RETURN WILL SKIP FURTHER REQUEST FOR DISPLACEMENT FILE INFORMATION. UTILITY USER'S MANUAL Page 2-12 SEE FUNC-READ FOR FORMAT INFORMATION. SEE FUNC-WRIT FOR FORMAT INFORMATION THE TWO REQUEST ABOVE ARE REPEATED FOR THE NUMBER OF SCALAR FUNCTION FILES SPECIFIED. ORDER THE ORDER COMMAND ATTEMPTS TO CONSISTENTLY ORDER THE PANEL DATA OF THE IP ARRAY IN A CLOCKWISE OR COUNTER-CLOCKWISE MANNER. THE FIRST ELEMENT IN EACH GROUP IS ASSUMED TO BE ORDERED CORRECTLY. ALL OTHER ELEMENTS IN THAT GROUP ARE MATCHED AGAINST PREVIOUSLY ORDERED ELEMENTS UNTIL THE PROCESS IS COMPLETE. IF AN ELEMENT CAN NOT BE MATCHED, THE MESSAGE % IS TYPED ON THE USERS TERMINAL. THIS ALGORITHM IS NOT AVAILABLE FOR USE WITH SOLID DATA. IF THE USER ATTEMPTS TO USE IT WITH SOLID DATA, THE MESSAGE % WILL BE TYPED ON HIS TERMINAL. UTILITY USER'S MANUAL Page 2-13 ERROR MESSAGES THERE ARE THREE WARNING AND THREE ERROR MESSAGES THAT MAY BE ISSUED DURING A SESSION. THE ERROR MESSAGES ARE CONSIDERED FATAL AND WILL CAUSE PROGRAM EXECUTION TO TERMINATE. THE MESSAGES ARE: % ATTEMPT TO DELETE AN ELEMENT THAT WAS NOT FOUND. SEE GEOM-CHAN-ELEM. % THE USER ATTEMPTED TO ORDER SOLID DATA, AN OPERATION THAT IS UNDEFINED. SEE ORDER. % WHILE ATTEMPTING TO ORDER PANEL DATA, AN ELEMENT WAS FOUND IN AN ELEMENT GROUPING THAT DID NOT HAVE A COMMON EDGE WITH ANY OTHER ELEMENT IN THAT GROUP. SEE ORDER. ? THE USER ATTEMPTED TO EXCEED THE MAXIMUM DIMENSION OF NPMAX. INCREASE THE VALUE OF NPMAX IN THE MAIN PROGRAM AND TRY AGAIN. ?  THE USER ATTEMPTED TO EXCEED THE MAXIMUM DIMENSION OF NJMAX. INCREASE THE VALUE OF NJMAX IN THE MAIN PROGRAM AND TRY AGAIN. ? THE USER ATTEMPTED TO EXCEED THE MAXIMUM DIMENSION OF NPTMAX. INCREASE THE VALUE OF NPTMAX IN THE MAIN PROGRAM AND TRY AGAIN. Page Index-1  UTILITY USER'S MANUAL INDEX Disp-change . . . . . . . . . 2-9 Disp-print . . . . . . . . . . 2-9 Disp-read . . . . . . . . . . 2-8 Disp-write . . . . . . . . . . 2-8 Displacement file . . . . . . 2-8 Error messages . . . . . . . . 2-13 Func-change . . . . . . . . . 2-10 Func-print . . . . . . . . . . 2-10 Func-read . . . . . . . . . . 2-9 Func-write . . . . . . . . . . 2-10 Geom-chan-coordinates . . . . 2-5 Geom-chan-element . . . . . . 2-6 Geom-chan-group . . . . . . . 2-5 Geom-chan-move . . . . . . . . 2-7 Geom-change . . . . . . . . . 2-5 Geom-prin-coordinate . . . . . 2-7 Geom-prin-element . . . . . . 2-8 Geom-prin-group . . . . . . . 2-7 Geom-print . . . . . . . . . . 2-7 Geom-read . . . . . . . . . . 2-2 Geom-write . . . . . . . . . . 2-4 Geometry file . . . . . . . . 2-2, 2-4 Ip . . . . . . . . . . . . . . 2-3 Level 1 . . . . . . . . . . . 2-2 Level 2 . . . . . . . . . . . 2-2 Nj . . . . . . . . . . . . . . 2-3 Np . . . . . . . . . . . . . . 2-3 Npl . . . . . . . . . . . . . 2-3 Npt . . . . . . . . . . . . . 2-3 Order . . . . . . . . . . . . 2-12 Panal data . . . . . . . . . . 2-1 S . . . . . . . . . . . . . . 2-9 Scalar function file . . . . . 2-9 Solid data . . . . . . . . . . 2-1 Symmetry . . . . . . . . . . . 2-11 U . . . . . . . . . . . . . . 2-8 X . . . . . . . . . . . . . . 2-3 CHAPTER 3 SECTION USER'S MANUAL SECTION IS AN INTERACTIVE PROGRAM. IT WILL PROMPT THE USER FOR ALL THE NECESSARY INFORMATION WITH THE FOLLOWING REQUESTS.  ENTER THE INPUT GEOMETRY FILENAME.EXT. THE FILENAME SHOULD NOT EXCEED SIX CHARACTERS. IF THE EXTENSION IS OMITTED, THE DEFAULT EXTENSION DAT WILL BE USED.(1) AT THIS POINT THE GEOMETRY FILE WILL BE READ USING THE FOLLOWING FORTRAN STATEMENTS. READ(IDTA,10) NP,NJ,NPT READ(IDTA,10) ((NPL(I,J),I=1,2),J=1,NP) READ(IDTA,20) ((X(I,J),I=1,3),J=1,NJ) READ(IDTA,10) ((IP(I,J),I=1,8),J=1,NPT) 10 FORMAT(20I4) 20 FORMAT(6E12.5) THE VARIABLES ARE DEFINED AS FOLLOWS: NP = THE NUMBER OF PARTS NJ = THE NUMBER OF NODES OR JOINTS NPT = THE NUMBER OF ELEMENTS NPL = THE PARTS LIST ELEMENTS ARE GROUPED TOGETHER FOR SMOOTH SURFACE SIMULATION AND COLOR DEFINITION. THE PARTS LIST CONTAINS THE ELEMENT NUMBERS OF THE LOWER AND UPPER BOUNDS OF THE ELEMENTS IN EACH GROUPING. (1) THE MANNER IN WHICH DATA FILES ARE INITIALIZED IS AN INSTALLATION DEPENDENT FEATURE. APPROPRIATE MODIFICATIONS SHOULD BE MADE IN THE SOURCE PROGRAM TO ACCOMMODATE YOUR SYSTEM. SECTION USER'S MANUAL Page 3-2 X = THE COORDINATES OF THE NODES THE COORDINATES ARE LISTED IN THE X, Y, AND Z DIRECTIONS BY NODE NUMBER. IP = THE CONNECTIVITY OF THE HEXAHEDRON ELEMENTS AN ELEMENT IS DEFINED BY SPECIFYING THE NODE NUMBERS ON TWO OPPOSITE FACES IN THE SAME CLOCKWISE OR COUNTER-CLOCKWISE DIRECTION. THE FIRST AND FIFTH NODE NUMBERS DEFINE AN EDGE JOINING THE FRONT AND BACK FACES.  ENTER THE NUMBER OF PLANES ON WHICH THE MODEL IS TO BE CLIPPED. IF ZERO STEPS ARE SPECIFIED, THE MODEL IS NOT CLIPPED BUT IS SWEPT FREE OF REDUNDANT INTERIOR DATA LEAVING ONLY POTENTIALLY VISIBLE SURFACES AND THE FOLLOWING TWO REQUEST ARE SKIPPED. ENTER THE CLIPPING PLANE DEFINITION FOR EACH PART. IF I2 IS GREATER THAN I1, ALL PARTS I1 THROUGH I2 WILL BE CLIPPED ON THE SAME PLANE. IF NO CLIPPING PLANE IS DEFINED FOR A PART, IT WILL NOT BE CLIPPED. POINT1 AND NORMAL1 ARE THE CARTESIAN COORDINATES OF THE POINT IN THE PLANE AND THE DIRECTION COSINES OF THE NORMAL TO THE PLANE OF THE INITIAL CLIPPING PLANE RESPECTIVELY. POINT2 AND NORMAL2 ARE THE POINT AND NORMAL DATA OF THE FINAL CLIPPING PLANE. IF THE NUMBER OF STEPS IS GREATER THAN TWO, A LINEAR INTERPOLATION BETWEEN THE INITIAL AND FINAL PLANES WILL BE USED TO CALCULATE INTERMEDIATE PLANES. A LINE OF ZEROS TERMINATES THIS REQUEST. ENTER FRONT, BACK OR BOTH TO SAVE ONLY POLYGONS THAT ARE IN FRONT OF THE CLIPPING PLANE, ONLY POLYGONS THAT ARE BEHIND THE CLIPPING PLANE, OR BOTH POLYGONS IN FRONT OF AND BEHIND THE CLIPPING PLANE. ENTER THE OUTPUT GEOMETRY FILENAME.EXT. THE FILENAME SHOULD NOT EXCEED SIX CHARACTERS. IF THE  EXTENSION IS OMITTED, THE DEFAULT EXTENSION DAT WILL BE USED. SECTION USER'S MANUAL Page 3-3 AT THIS POINT THE GEOMETRY FILE WILL BE WRITTEN USING THE FOLLOWING FORTRAN STATEMENTS. WRITE(IDTA,10) NP,NJ,NPT WRITE(IDTA,10) ((NPL(I,J),I=1,2),J=1,NP) WRITE(IDTA,20) ((X(I,J),I=1,3),J=1,NJ) WRITE(IDTA,10) ((IP(I,J),I=1,8),J=1,NPT) 10 FORMAT(20I4) 20 FORMAT(1P6E12.5) ENTER THE NUMBER OF DISPLACEMENT FILES TO BE TRANSFORMED TO REFLECT THE NEW GEOMETRY DEFINITION. A ZERO WILL SKIP OVER ANY FURTHER REQUEST FOR DISPLACEMENT FILE INFORMATION. ENTER THE INPUT DISPLACEMENT FILENAME.EXT. THE FILENAME SHOULD NOT EXCEED SIX CHARACTERS. IF THE EXTENSION IS OMITTED, THE DEFAULT EXTENSION DAT WILL BE USED. AT THIS POINT THE DISPLACEMENT FILE WILL BE READ USING THE FOLLOWING FORTRAN STATEMENTS. READ(IDTA,20) ((U(I,J),I=1,3),J=1,NJ) 20 FORMAT(6E12.5) THE VARIABLE, U, IS THE DISPLACEMENT AT THE NODE. ENTER THE OUTPUT DISPLACEMENT FILENAME.EXT.  THE FILENAME SHOULD NOT EXCEED SIX CHARACTERS. IF THE EXTENSION IS OMITTED, THE DEFAULT EXTENSION DAT WILL BE USED. AT THIS POINT THE DISPLACEMENT FILE WILL BE WRITTEN USING THE FOLLOWING FORTRAN STATEMENTS. WRITE(IDTA,20) ((U(I,J),I=1,3),J=1,NJ) 20 FORMAT(1P6E12.5) THE TWO REQUEST ABOVE ARE REPEATED FOR EACH DISPLACEMENT FILE SPECIFIED. SECTION USER'S MANUAL Page 3-4 ENTER THE NUMBER OF SCALAR FUNCTION FILES TO BE TRANSFORMED TO REFLECT THE NEW GEOMETRY. A ZERO WILL SKIP OVER FURTHER REQUEST FOR INFORMATION ABOUT SCALAR FUNCTION FILES. ENTER THE INPUT SCALAR FUNCTION FILENAME.EXT. THE FILENAME SHOULD NOT EXCEED SIX CHARACTERS. IF THE EXTENSION IS OMITTED, THE DEFAULT EXTENSION DAT WILL BE USED. AT THIS POINT THE SCALAR FUNCTION FILE WILL BE READ USING THE FOLLOWING FORTRAN STATEMENTS. READ(IDTA,20) (S(I),I=1,NJ) 20 FORMAT(6E12.5) THE VARIABLE, S, IS THE SCALAR FUNCTION AT THE NODE. ENTER THE OUTPUT SCALAR FUNTION FILENAME.EXT. THE FILENAME SHOULD NOT EXCEED SIX CHARACTERS. IF THE EXTENSION IS OMITTED, THE DEFAULT EXTENSION DAT WILL BE USED. AT THIS POINT THE SCALAR FUNCTION FILE WILL BE WRITTEN USING THE FOLLOWING FORTRAN STATEMENTS. WRITE(IDTA,20) (S(I),I=1,NJ) 20 FORMAT(1P6E12.5) THE TWO REQUESTS ABOVE ARE REPEATED FOR EACH SCALAR FUNCTION FILE SPECIFIED. SECTION USER'S MANUAL Page 3-5 ERROR MESSAGES THREE ERROR MESSAGES MAY BE ISSUED DURING THE EXECUTION OF THE PROGRAM. ALL THREE ARE CONSIDERED FATAL ERRORS AND WILL TERMINATE PROGRAM EXECUTION. ? THIS MESSAGE INDICATES THAT ALL THE AVAILABLE FREE STORAGE HAS BEEN USED PRIOR TO THE COMPLETION OF PROCESSING. INCREASE THE SIZE OF BLANK COMMON IN THE MAIN PROGRAM. ? THIS MESSAGE RESULTS WHEN THE LINE SEGMENTS STORED FOR THE ON-PLANE POLYGONS DO NOT FORM A CLOSED FIGURE. IF THIS HAPPENS, CHECK THE INPUT DATA FOR IMPROPERLY DEFINED ELEMENTS. ?  THIS MESSAGE OCCURS WHEN A WARPED QUADRILATERAL FACE APPEARS TO STILL BE WARPED AFTER THE FACE IS DIVIDED INTO TWO TRIANGLES. THIS GENERALLY INDICATES A PROBLEM ELSEWHERE IN THE PROGRAM. PLEASE REPORT THIS ERROR. ? THIS MESSAGE IS PRINTED IF THE END OF THE OVERFLOW LIST IS FOUND WHILE TRYING TO DELETE A  POLYGON FROM THE HASH TABLE. PLEASE REPORT THIS ERROR. Page Index-1 SECTION USER'S MANUAL INDEX Clipping plane . . . . . . . . 3-2 Displacement file . . . . . . 3-3 Error messages . . . . . . . . 3-5 Geometry file . . . . . . . . 3-1 Ip . . . . . . . . . . . . . . 3-2 Nj . . . . . . . . . . . . . . 3-1 Np . . . . . . . . . . . . . . 3-1 Npl . . . . . . . . . . . . . 3-1 Npt . . . . . . . . . . . . . 3-1 S . . . . . . . . . . . . . . 3-4 Scalar function file . . . . . 3-4 U . . . . . . . . . . . . . . 3-3 X . . . . . . . . . . . . . . 3-2 CHAPTER 4 TITLE USER'S MANUAL TITLE.FOR GENERATES TWO AND THREE DIMENSIONAL CHARACTER STRINGS IN A FORM THAT IS COMPATIBLE WITH MOVIE.BYU. THE PROGRAM IS INTERACTIVE, AND PROPMTS THE USER FOR ALL NECESSARY INPUT. THE PROGRAM PROCEEDS AS FOLLOWS: ENTER UP TO 70 CHARACTERS CONSISTING OF ONLY THE LETTERS OF THE ALPHABET, SPACES, THE INTEGERS 0 THRU 9 AND SPECIAL CHARACTERS . / - = $ . TO END A PARTICULAR TITLE, USE A CARRIAGE RETURN. <3-D?> ANSWER Y OR YES FOR THREE-DIMENSIONAL CHARACTERS AND CARRIAGE RETURN FOR TWO-DIMENSIONAL CHARACTERS. ENTER COORDINATES OF THER LOWER LEFT EDGE OF THE LINE OF TEXT. SINCE FOR NORMALIZED SPACING PURPOSES THE FRONT FACE OF A CHARACTER IS CENTERED IN A UNIT SQUARE, THE LEFT COORDINATES OF THE FIRST CHARACTER WILL BE SLIGHTLY GREATER THAN THE X-VALUE INPUT. SPACING: IS MULTIPLIED BY THE WIDTH SCALE FACTOR TO POSITION THE NEXT CHARACTER. A 1.0 GIVES A REASONALBE SPACING FOR TWO-DIMENSIONAL CHARACTERS, BUT THREE-DIMENSIONAL CHARACTERS WITH OFFSET (SEE NEXT INPUT) REQUIRE A LARGER VALUE. WIDTH: ACTUAL DISTANCE BETWEEN THE CENTER OF ADJACENT CHARACTERS IF SPACING = 1.0. THE ACTUAL WIDTH OF EACH CHARACTER (WITH THE EXCEPTION OF 1 AND THE SPECIAL CHARACTERS) IS 5/7 OF THE VALUE TITLE USER'S MANUAL Page 4-2 SPECIFIED FOR WIDTH. HEIGHT: ACTUAL HEIGHT OF THE CHARACTERS. DEPTH: NOT REQUIRED FOR TWO-DIMENSIONAL  CHARACTERS. POSITION OF BACK FACE OF CHARACTERS HAS A NEGATIVE Z-POSITION WITH RESPECT TO THE FRONT FACE (RIGHT-HANDED COORDINATE SYSTEM) FOR POSITIVE VALUE OF DEPTH. STRANGE EFFECTS CAN BE OBTAINED WITH NEGATIVE DEPTH. CHARACTERS ARE GENERATED IN COUNTERCLOCKWISE ORDERING FOR POSITIVE DEPTH. NOT REQUIRED FOR TWO-DIMENSIONAL CHARACTERS.  FOR THREE-DIMENSIONAL CHARACTERS, ENTER OFFSET COORDINATES FOR BACK FACE OF CHARACTER RELATIVE TO FRONT FACE. THIS SKEWING OF THE CHARACTERS PRODUCES THE EFFECT OF THE FRONT FACE BEING BRIGHT (LOOKING DIRECTLY AT THE OBSERVER) WITH THE SIDES OF THE CHARACTERS VISIBLE. THE COMBINATION OF OFFSET AND A SHARP PERSPECTIVE MAY BE QUITE CONFUSING. WITH NEAR-ZERO PRESPECTIVE, THE EFFECT (WHICH IS COMMONLY USED ON THREE-DIMENSIONAL CHARACTERS) IS QUITE GOOD. FOR SPACING, WIDTH, HEIGHT, DEPTH OF 1.5, 1., 1., 1.5 REASONABLE VALUES OF OFFSETS ARE .25, .25. OFFSETS MAY BE POSITIVE OR NEGATIVE. PRINTED IF NO CHARACTERS OR ONLY SPACES ARE ENCOUNTERED IN LINE OF TEXT. ENTER Y OR YES TO END TITLE OR CARRIAGE RETURN TO ENTER MORE LINES (PARTS). ENTER THE TITLE FILENAME.EXT. IF THE EXTENTION IS OMITTED, THE DEFAULT EXTENSION DAT WILL BE USED. A ZERO FILE DESIGNATION WILL NOT WRITE THE FILE, BUT WILL ASK IF THE USER WISHES TO START A NEW TITLE. THIS IS HELPFUL IF THE USER DISCOVERS AN ERROR IN HIS TITLE AT THE LAST MINUTE.(1) (1) THE MANNER IN WHICH DATA FILES ARE INITIALIZED IS AN INSTALLATION DEPENDENT FEATURE. APPROPRIATE MODIFICATIONS SHOULD BE MADE IN THE SOURCE PROGRAM TO ACCOMMODATE YOUR SYSTEM. TITLE USER'S MANUAL Page 4-3 THE GEOMETRY FILE IS NOW WRITTEN USING THE FOLLOWING FORTRAN STATEMENTS. WRITE(IDTA,10) NP,NJ,NPT WRITE(IDTA,10) ((NPL(I,J),I=1,2),J=1,NP) WRITE(IDTA,20) ((X(I,J),I=1,3),J=1,NJ) WRITE(IDTA,10) ((IP(I,J),I=1,4),J=1,NPT) 10 FORMAT(20I4) 20 FORMAT(6E12.5) ENTER Y OR YES IF THE USER WISHES TO BEGIN A NEW TITLE. ANY OTHER RESPONSE WILL RETURN CONTROL TO THE MONITOR. AFTER GENERATION OF THE DATA FOR A LINE OF TEXT, THE ROUTINE PRINTS THE NOMINAL X-COORDINATE FOR THE RIGHT EDGE OF THE TEXT (USEFUL FOR POSITIONING PURPOSES), AND ALSO INDICATES THE CURRENT TOTAL NUMBERS OF PARTS, ELEMENTS, AND NODES. ERROR MESSAGES ? UNACCPETABLE CHARACTER ENCOUNTERED IN THE LINE OF TEXT. ABORTS LINE OF TEXT AND ASKS FOR NEW LINE OF TEXT.  CHAPTER 5 INSTALLING MOVIE.BYU THE FOLLOWING COMMENTS ARE INTENDED AS A GUIDE TO INSTALLING MOVIE.BYU ON ANY HOST COMPUTER. THE PROGRAMS ARE MOSTLY WRITTEN IN MACHINE INDEPENDENT FORTRAN. BEGINNING WITH MOVIE.FOR, EACH PROGRAM AND SUBPROGRAM WILL BE EXAMINED ALONG WITH SUGGESTED CHANGES THAT MIGHT BE CALLED FOR FILE 1: USER.DOC USER.DOC IS THE DOCUMENTATION YOU ARE NOW READING. NO CHANGES ARE NECESSARY. FILE 2: MOVIE.FOR MOVIE.FOR IS THE FORTRAN SOURCE FILE FOR THE DRIVING PACKAGE. IT INCLUDES THE MAIN PROGRAM AND SUBROUTINES THAT POSITION THE MODEL IN THE VIEWING WINDOW AND CALCULATE LIGHT INTENSITY AND SHADING. MAIN PROGRAM: FUNCTION: READS DATA FILES AND CALLS INTERACTIVE PICTURE ROUTINE.  IT MAY BE NECESSARY TO CHANGE THE I/0 UNIT NUMBERS ASSOCIATED WITH THE VARIABLES INPUT, OUTPUT, AND ERROR. INPUT GETS THE UNIT NUMBER OF THE INPUT DEVICE, OUTPUT GETS THE UNIT NUMBER OF THE OUTPUT DEVICE, AND ERROR GETS THE NUMBER OF THE ERROR MESSAGE REPORTING DEVICE. TYPICALLY INPUT AND OUTPUT REFER TO THE USER'S TERMINAL AND ERROR EITHER TO THE TERMINAL OR LINE PRINTER. INSTALLING MOVIE.BYU  Page 5-2 REMEMBER THAT VARIABLES NPL, X, IP, U, AND SPEC MUST BE DIMENSIONED TO ACCOMMODATE THE MAXIMUM EXPECTED NUMBER OF PARTS, COORDINATES, OR ELEMENTS WHICH EVER IS APPROPRIATE. THE VARIABLES NPMAX, NJMAX, AND NPTMAX MUST ALSO BE SET TO REFLECT THE MAXIMUM DIMENSIONS. SUBROUTINE OPEN: FUNCTION: REQUEST DATA FILE NAMES AND OPENS I/O CHANNEL SUBROUTINE OPEN MAY NEED TO BE COMPLETELY REWRITTEN TO ACCOMMODATE YOUR PARTICULAR OPERATING SYSTEM. THE ROUTINE IS ENTERED WITH FILEID CONTAINING THE ALPHANUMERIC FILE IDENTIFICATION (GEOM., DISP., OR FUNC.) IT REQUESTS THE FILE NAME, AND OPENS THE FILE FOR INPUT IF IOP=1 AND FOR OUTPUT IF IOP=-1. A BLANK FILE SPECIFICATION WILL SET IERROR TO 0. THE ROUTINE RETURNS WITH THE DEVICE UNIT NUMBER IN IUNIT AND IERROR SET TO 1 ON SUCCESSFUL COMPLETION, 0 ON BLANK FILE, AND -1 ON FAILURE. SUBROUTINE ROTAT: FUNCTION: CALCULATES ROTATION TRANSFORMATION MATRIX NO CHANGES NECESSARY. SUBROUTINE PICTUR: FUNCTION: INTERACTIVELY ACCEPTS COMMANDS FROM THE USER AND PERFORMS THE APPROPRIATE TASK. BEFORE DISCUSSING CHANGES, REMEMBER THAT VARIABLES DA, DD, DIF, ICOL, NFR, NPLS, RORG, SPEC1, XNORM, AND XX MUST BE DIMENSIONED TO ACCOMMODATE THE MAXIMUM EXPECTED NUMBER OF PARTS, COORDINATES, OR ELEMENTS WHICH EVER IS APPROPRIATE. IN PARTICULAR, XNORM SHOULD BE DIMENSIONED AS THE GREATER OF THE MAXIMUM NUMBER OF COORDINATES OR THE MAXIMUM NUMBER OF ELEMENTS. IF THE FORTRAN OPERATING SYSTEM YOU ARE RUNNING DOES NOT ALLOW FREE FORMATED READS, MOST OF THE FORMAT STATEMENTS ASSOCIATED WITH INTERACTIVE READ STATEMENTS WILL NEED TO BE MODIFIED. THIS IS THE ONE MOST PREVALENT CHANGE THROUGHOUT THE PROGRAM. AT THE STATEMENT LABELED 80, THE PROGRAM ENTERS A SECTION OF CODE THAT SELECTS SCOPE PARAMETERS INCLUDING THE PICTURE DEVICE NUMBER. PICTURE DEVICES GREATER THAN 0 ARE CONTINUOUS-TONE DEVICES WHILE DEVICES LESS THAN 0 ARE LINE DRAWING DEVICES. THE ALLOWABLE DEVICES ARE CURRENTLY COMTAL, TEKTRONIX, HPLT (HEWLETT-PACKARD PLOTTER), AND CPLT (CALCOMP PLOTTER). BY ADDING AND/OR DELETING DEVICES, THIS INSTALLING MOVIE.BYU Page 5-3 SECTION OF CODE SHOULD REFLECT THE PICTURE DEVICES AT YOUR INSTALLATION. AT APPROXIMATELY THE STATEMENTS LABELED 242, THE PROGRAM ENTERS CODE THAT WRITES TO THE USER'S OUTPUT DEVICE THE NAME OF THE DISPLAY DEVICE WHICH JUST RECEIVED A PICTURE. IF YOU CHANGED THE ALLOWABLE DEVICES, YOU NEED TO CHANGE THIS SECTION OF CODE TO REFLECT THE DEVICES AVAILABLE. CHANGES THAT MAY BE REQUIRED TO THIS SUBROUTINE WHEN USING A 5 BIT DATA PACKING SCHEME FOR LIGHT INTENSITY AND COLOR ON 16 BIT MACHINES IS GIVEN BELOW. THE EXISTING CODE FOR 32 AND 36 BIT MACHINES IS FOLLOWED BY THE CORRESPONDING CODE WITH CHANGES FOR 16 BIT MACHINES. 32 AND 36 BIT MACHINES IPH=63 IF(IDVICE.LT.0) GO TO 86 16 BIT MACHINES IPH=31 IF(IDVICE.LT.0) GO TO 86 32 AND 36 BIT MACHINES IC1=PB3*63.0 IC2=PB2*63.0 IC3=PB1*63.0 IF(IC.EQ.1) GO TO 163 16 BIT MACHINES IC1=PB3*31.0 IC2=PB2*31.0 IC3=PB1*31.0 IF(IC.EQ.1) GO TO 163 32 AND 36 BIT MACHINES  163 IPB=IC1*2**12+IC2*2**6+IC3 WRITE(OUTPUT,164) (WORDS(I,IC),I=1,3) 16 BIT MACHINES 163 IPB=IC1*2**10+IC2*2**5+IC3 WRITE(OUTPUT,164) (WORDS(I,IC),I=1,3) 32 AND 36 BIT MACHINES IC1=X3*63.0 IC2=X2*63.0 IC3=X1*63.0 INSTALLING MOVIE.BYU Page 5-4 IF(IC.EQ.1) GO TO 167 16 BIT MACHINES IC1=X3*31.0 IC2=X2*31.0 IC3=X1*31.0 IF(IC.EQ.1) GO TO 167 32 AND 36 BIT MACHINES 167 ICC=IC1*2**12+IC2*2**6+IC3 DO 168 K=I1,I2 16 BIT MACHINES 167 ICC=IC1*2**10+IC2*2**5+IC3 DO 168 K=I1,I2 SUBROUTINE MULTDD: FUNCTION: MULTIPLYS COORDINATES BY LOCAL ROTATIONS NO CHANGES NECESSARY. FUNCTION AINTEN: FUNCTION: CLACULATES LIGHT INTENSITY AT A NODE NO CHANGES NECESSARY. FUNCTION IVSBLE: FUNCTION: COMPUTES NUMBER OF VISIBLE NODES. NO CHANGES NECESSARY. SUBROUTINE MULTDC: FUNCTION: MULTIPLYS COORDINATES BY GLOBAL ROTATIONS. NO CHANGES NECESSARY. FUNCTION ISHADE: FUNCTION: COMPUTES COLOR INTENSITY AT NODE FOR FRINGES. INSTALLING MOVIE.BYU Page 5-5 CHANGES THAT MAY BE REQUIRED TO THIS SUBROUTINE WHEN USING A 5 BIT DATA PACKING SCHEME FOR LIGHT INTENSITY AND COLOR ON 16 BIT MACHINES IS GIVEN BELOW. THE EXISTING CODE FOR 32 AND 36 BIT MACHINES IS FOLLOWED BY THE CORRESPONDING CODE WITH CHANGES FOR 16 BIT MACHINES. 32 AND 36 BIT MACHINES IC1=(F(1,I1)*X+F(1,I)*X1)*63.0 IC2=(F(2,I1)*X+F(2,I)*X1)*63.0 IC3=(F(3,I1)*X+F(3,I)*X1)*63.0 GO TO 4 2 X=X-1.0 IC1=F(1,NFRING)*63.0 IC2=F(2,NFRING)*63.0 IC3=F(3,NFRING)*63.0 GO TO 4 3 IC1=F(1,1)*63.0 IC2=F(2,1)*63.0 IC3=F(3,1)*63.0 4 ISHADE=IC1*2**12+IC2*2**6+IC3 RETURN 16 BIT MACHINES IC1=(F(1,I1)*X+F(1,I)*X1)*31.0 IC2=(F(2,I1)*X+F(2,I)*X1)*31.0  IC3=(F(3,I1)*X+F(3,I)*X1)*31.0 GO TO 4 2 X=X-1.0 IC1=F(1,NFRING)*31.0 IC2=F(2,NFRING)*31.0 IC3=F(3,NFRING)*31.0 GO TO 4 3 IC1=F(1,1)*31.0 IC2=F(2,1)*31.0 IC3=F(3,1)*31.0 4 ISHADE=IC1*2**10+IC2*2**5+IC3 RETURN SUBROUTINE DRAW: FUNCTION: CLIPS LINE SEGMENTS AND DOES QUICK PLOT.  NO CHANGES NECESSARY. SUBROUTINE INTHID: FUNCTION: INTIALIZES HIDDEN PROCESSOR. THE VARIABLES MAXFRE, MAXRES, AND MAXINT SHOULD BE CHANGED TO REFLECT THE DIMENSION OF IFREE(MAXFRE), THE DIMENSION OF IB(MAXRES), AND THE MAXIMUM ALLOWABLE LIGHT INSTALLING MOVIE.BYU Page 5-6 INTENSITY. CHANGES THAT MAY BE REQUIRED TO THIS SUBROUTINE WHEN  USING A 5 BIT DATA PACKING SCHEME FOR LIGHT INTENSITY AND COLOR ON 16 BIT MACHINES IS GIVEN BELOW. THE EXISTING CODE FOR 32 AND 36 BIT MACHINES IS FOLLOWED BY THE CORRESPONDING CODE WITH CHANGES FOR 16 BIT MACHINES. 32 AND 36 BIT MACHINES MAXINT=63 C INITIALIZE FREE STORAGE 16 BIT MACHINES MAXINT=31 C INITIALIZE FREE STORAGE FILE 3: HIDDEN.FOR HIDDEN.FOR IS THE FORTRAN SOURCE FILE FOR THE HIDDEN PROCESS. THE VARIOUS SUBROUTINES IN THIS FILE ARE AGAIN WRITTEN IN ANSI FORTRAN ALTHOUGH CERTAIN CHANGES WILL HAVE TO BE MADE TO ACCOMODATE THE WORD SIZE OF YOUR MACHINE. SUBROUTINE GETVAR: FUNCTION: GETS VARIABLE LENGTH BLOCK OF FREE STORAGE. NO CHANGES NECESSARY. SUBROUTINE LSTSET: FUNCTION: SET BLOCK SIZE AND LINKS SEGMENTS.  NO CHANGES NECESSARY. SUBROUTINE GETBLK: FUNCTION: GETS FIXED LENGTH BLOCK OF FREE STORAGE. NO CHANGES NECESSARY. SUBROUTINE RETBLK: FUNCTION: RETURNS FIXED LENGTH BLOCK TO FREE STORAGE. INSTALLING MOVIE.BYU Page 5-7 NO CHANGES NECESSARY. SUBROUTINE INTCLP: FUNCTION: INITIALIZES PARAMETERS USED IN HIDDEN ALGORITHM. NO CHANGES NECESSARY. SUBROUTINE POLMAK: FUNCTION: BEGINS NEW POLYGON IN PICTURE. CHANGES THAT MAY BE REQUIRED TO THIS SUBROUTINE WHEN USING A 5 BIT DATA PACKING SCHEME FOR LIGHT INTENSITY AND COLOR ON 16 BIT MACHINES IS GIVEN BELOW. THE EXISTING CODE FOR 32 AND 36 BIT MACHINES IS FOLLOWED BY THE CORRESPONDING CODE WITH CHANGES FOR 16 BIT MACHINES. 32 AND 36 BIT MACHINES COMMON/COMNIO/ICNT,IDUM(121) IPOLY=IPOLY+1 16 BIT MACHINES COMMON/COMNIO/ICNT,IDUM(141) IPOLY=IPOLY+1 SUBROUTINE EDGMAK: FUNCTION: STORES POLYGON EDGES FOR LATTER PROCESSING. CHANGES THAT MAY BE REQUIRED TO THIS SUBROUTINE WHEN USING A 5 BIT DATA PACKING SCHEME FOR LIGHT INTENSITY AND COLOR ON 16 BIT MACHINES IS GIVEN BELOW. THE EXISTING CODE FOR 32 AND 36 BIT MACHINES IS FOLLOWED BY THE CORRESPONDING CODE WITH CHANGES FOR 16 BIT MACHINES. 32 AND 36 BIT MACHINES COMMON/COMNIO/ICNT,NT,VX(10),VY(10),VZ(10),VN(10) 1,IC(10),VC(10),VTX(10),VTY(10),VTZ(10),VTN(10),VTC(10) 2,ITC(10) LOGICAL LASEDG,IBAD,ISHARE 16 BIT MACHINES COMMON/COMNIO/ICNT,NT,VX(10),VY(10),VZ(10),VN(10) 1,IC(10),IS(10),VC(10),VTX(10),VTY(10),VTZ(10),VTN(10) 2,VTC(10),ITC(10),ITS(10)  LOGICAL LASEDG,IBAD,ISHARE INSTALLING MOVIE.BYU Page 5-8 32 AND 36 BIT MACHINES C SET 18TH BIT IF EDGE IS SHARED C SET 19TH BIT IF EDGE IS VISIBLE FLAG I=524288 IF(ISHARE) I=786432 C PUT BEGIN POINT INTO EDGE STACK 16 BIT MACHINES C SET 0TH BIT IF EDGE IS SHARED C SET 1ST BIT IF EDGE IS VISIBLE FLAG I=1 IF(ISHARE) I=3 C PUT BEGIN POINT INTO EDGE STACK 32 AND 36 BIT MACHINES IC(ICNT)=I+MOD(K1,262144) VC(ICNT)=C1 16 BIT MACHINES IC(ICNT)=K1 IS(ICNT)=I VC(ICNT)=C1 32 AND 36 BIT MACHINES IC(ICNT)=I+MOD(K2,262144) VC(ICNT)=C2 16 BIT MACHINES IC(ICNT)=K2 IS(ICNT)=I VC(ICNT)=C2 SUBROUTINE POLSNP: FUNCTION: CLIPS POLYGONS AGAINST VIEWING WINDOW. CHANGES THAT MAY BE REQUIRED TO THIS SUBROUTINE WHEN USING A 5 BIT DATA PACKING SCHEME FOR LIGHT INTENSITY AND COLOR ON 16 BIT MACHINES IS GIVEN BELOW. THE EXISTING CODE FOR 32 AND 36 BIT MACHINES IS FOLLOWED BY THE CORRESPONDING CODE WITH CHANGES FOR 16 BIT MACHINES. 32 AND 36 BIT MACHINES COMMON/COMNIO/ICNT,NT,VX(10),VY(10),VZ(10),VN(10)  1,IC(10),VC(10),VTX(10),VTY(10),VTZ(10),VTN(10),VTC(10) 2,ITC(10) COMMON/EDGARG/IY,IX1,IX2,IZ1,IZ2,IS1,IS2,IPG,IDY INSTALLING MOVIE.BYU Page 5-9 1,KOL1,ISHR,IS1,IS2,KOL2 16 BIT MACHINES COMMON/COMNIO/ICNT,NT,VX(10),VY(10),VZ(10),VN(10) 1,IC(10),IS(10),VC(10),VTX(10),VTY(10),VTZ(10),VTN(10) 2,VTC(10),ITC(10),ITS(10) COMMON/EDGARG/IY,IX1,IX2,IZ1,IZ2,IS1,IS2,IPG,IDY 1,KOL1,ISHR,IS1,IS2,KOL2 32 AND 36 BIT MACHINES IF(IC(I).LT.524288) GO TO 10 K=I+1 16 BIT MACHINES IF(IS(I).LT.1) GO TO 10 K=I+1 32 AND 36 BIT MACHINES ISHR=MOD(IC(I),524288).GT.262144 C GET THE Z VALUES AND GIVE THEM 15 BITS 16 BIT MACHINES ISHR=IS(I).GT.1 C GET THE Z VALUES AND GIVE THEM 15 BITS 32 AND 36 BIT MACHINES C GET THE INTENSITY AND GIVE IT 6 BITS IS2=VN(L)*63. IS1=VN(K)*63. C************ COLOR ************ KOL1=MOD(IC(K),262144) KOL2=MOD(IC(L),262144) C RESET THE INTENSITY IF IT IS OUTSIDE THE RANGE IF(IS1.GT.63) IS1=63 IF(IS2.GT.63) IS2=63 IF(IS1.LT.0) IS1=0 16 BIT MACHINES  C GET THE INTENSITY AND GIVE IT 5 BITS IS2=VN(L)*31. IS1=VN(K)*31. C************ COLOR ************ KOL1=IC(K) KOL2=IC(L) C RESET THE INTENSITY IF IT IS OUTSIDE THE RANGE IF(IS1.GT.31) IS1=31 IF(IS2.GT.31) IS2=31 IF(IS1.LT.0) IS1=0 INSTALLING MOVIE.BYU Page 5-10 SUBROUTINE CLIP:  FUNCTION: DOES ACTUAL CLIPPING OF EDGES AGAINST PLANE. CHANGES THAT MAY BE REQUIRED TO THIS SUBROUTINE WHEN USING A 5 BIT DATA PACKING SCHEME FOR LIGHT INTENSITY AND COLOR ON 16 BIT MACHINES IS GIVEN BELOW. THE EXISTING CODE FOR 32 AND 36 BIT MACHINES IS FOLLOWED BY THE CORRESPONDING CODE WITH CHANGES FOR 16 BIT MACHINES. 32 AND 36 BIT MACHINES COMMON/COMNIO/ICNT,NT,VX(10),VY(10),VZ(10),VN(10)  1,IC(10),VC(10),VTX(10),VTY(10),VTZ(10),VTN(10),VTC(10) 2,ITC(10) COMMON/SNPDAT/T1,T2,I 16 BIT MACHINES COMMON/COMNIO/ICNT,NT,VX(10),VY(10),VZ(10),VN(10) 1,IC(10),IS(10),VC(10),VTX(10),VTY(10),VTZ(10),VTN(10) 2,VTC(10),ITC(10),ITS(10) COMMON/SNPDAT/T1,T2,I 32 AND 36 BIT MACHINES IF(IC(I).LT.524288) GO TO 30 IF(IBAD) GO TO 30 16 BIT MACHINES IF(IS(I).LT.1) GO TO 30 IF(IBAD) GO TO 30 32 AND 36 BIT MACHINES IC(I1)=IC(I) GO TO 101 100 C1=FLOAT(MOD(IC(I)/4096,64)) C2=FLOAT(MOD(IC(I+1)/4096,64)) KOLAVG=MOD(INT(ALPHA*(C2-C1)+C1+.5),64)*4096 C2=FLOAT(MOD(IC(I+1)/64,64)) KOLAVG=KOLAVG+MOD(INT(ALPHA*(C2-C1)+C1+.5),64)*64 C1=FLOAT(MOD(IC(I),64)) C2=FLOAT(MOD(IC(I+1),64)) KOLAVG=KOLAVG+MOD(INT(ALPHA*(C2-C1)+C1+.5),64) IC(I1)=KOLAVG+(IC(I)/524288)*524288 101 CONTINUE 16 BIT MACHINES IC(I1)=IC(I) GO TO 101 100 C1=FLOAT(MOD(IC(I)/1024,32)) INSTALLING MOVIE.BYU Page 5-11 C2=FLOAT(MOD(IC(I+1)/1024,32)) KOLAVG=MOD(INT(ALPHA*(C2-C1)+C1+.5),32)*32 C1=FLOAT(MOD(IC(I)/32,32)) C2=FLOAT(MOD(IC(I+1)/32,32)) KOLAVG=KOLAVG+MOD(INT(ALPHA*(C2-C1)+C1+.5),32)*32 C1=FLOAT(MOD(IC(I),32)) C2=FLOAT(MOD(IC(I+1),32)) KOLAVG=KOLAVG+MOD(INT(ALPHA*(C2-C1)+C1+.5),32) IC(I1)=KOLAVG 101 CONTINUE 32 AND 36 BIT MACHINES IC(ICNT)=MOD(IC(I1),262144)+524288 VC(ICNT)=VC(I1) 16 BIT MACHINES IC(ICNT)=IC(I1) IS(ICNT)=1 VC(ICNT)=VC(I1) 32 AND 36 BIT MACHINES 50 IC(I)=0 IC(I+1)=0 RETURN 16 BIT MACHINES 50 IS(I)=0 IS(I+1)=0 RETURN SUBROUTINE FACMAK: FUNCTION: STORES ZMIN CLIPPED EDGES FOR LATTER CAP POLYGON GENERATION. NOT IMPLEMENTED YET. SUBROUTINE HIDDEN: FUNCTION: DETERMINES VISIBLE SEGEMENTS AND SENDS THEM TO LINE DRAWING OR CONTINOUS-TONE SHADING ROUTINES. CHANGES THAT MAY BE REQUIRED TO THIS SUBROUTINE WHEN USING A 5 BIT DATA PACKING SCHEME FOR LIGHT INTENSITY AND COLOR ON 16 BIT MACHINES IS GIVEN BELOW. THE EXISTING CODE FOR 32 AND 36 BIT MACHINES IS FOLLOWED BY THE CORRESPONDING CODE WITH CHANGES FOR 16 BIT MACHINES. 32 AND 36 BIT MACHINES INSTALLING MOVIE.BYU  Page 5-12 SR1=FLOAT(MOD(ICOL1,64))*S1/63. SB1=FLOAT(MOD(ICOL1/64,64))*S1/63. SG1=FLOAT(MOD(ICOL1/4096,64))*S1/63. SR2=FLOAT(MOD(ICOL2,64))*S2/63. SB2=FLOAT(MOD(ICOL2/64,64))*S2/63. SG2=FLOAT(MOD(ICOL2/4096,64))*S2/63. 213 CONTINUE 16 BIT MACHINES 2)11 SR1=FLOAT(MOD(ICOL1,32))*S1/31. SB1=FLOAT(MOD(ICOL1/32,32))*S1/31. SG1=FLOAT(MOD(ICOL1/1024,32))*S1/31. SR2=FLOAT(MOD(ICOL2,32))*S2/31. SB2=FLOAT(MOD(ICOL2/32,32))*S2/31. SG2=FLOAT(MOD(ICOL2/1024,32))*S2/31. 213 CONTINUE 32 AND 36 BIT MACHINES A = FLOAT(ISEG(I+5))*63. RSEG(IJ+1) = (SR1-SR2)/A 16 BIT MACHINES 2)11 A = FLOAT(ISEG(I+5))*31. RSEG(IJ+1) = (SR1-SR2)/A 32 AND 36 BIT MACHINES  RSEG(IJ ) = (SR1/63.)+RSEG(IJ+1)*.5 RSEG(IJ+4) = (SB1/63.)+RSEG(IJ+5)*.5 RSEG(IJ+8) = (SG1/63.)+RSEG(IJ+9)*.5 IJ = IJ + 8 16 BIT MACHINES 2)11 RSEG(IJ ) = (SR1/31.)+RSEG(IJ+1)*.5 RSEG(IJ+4) = (SB1/31.)+RSEG(IJ+5)*.5 RSEG(IJ+8) = (SG1/31.)+RSEG(IJ+9)*.5 IJ = IJ + 8 SUBROUTINE DRAWIT: FUNCTION: SEND LINE TO BE DISPLAYED TO DEVICE AND CLEARS LINE STARTING POSITION. NO CHANGES NECESSARY. SUBROUTINE LINSHO: FUNCTION: UPDATES LINE INFORMATION UNTIL LINE CAN BE DRAWN. INSTALLING MOVIE.BYU Page 5-13 NO CHANGES NECESSARY. SUBROUTINE SHOW: FUNCTION: EVALUATES SHADING INFORMATION FOR VISIBLE SEGMENTS. CHANGES THAT MAY BE REQUIRED TO THIS SUBROUTINE WHEN USING A 5  BIT DATA PACKING SCHEME FOR LIGHT INTENSITY AND COLOR ON 16 BIT MACHINES IS GIVEN BELOW. THE EXISTING CODE FOR 32 AND 36 BIT MACHINES IS FOLLOWED BY THE CORRESPONDING CODE WITH CHANGES FOR 16 BIT MACHINES. 32 AND 36 BIT MACHINES STR=FLOAT(MOD(IBACKG,64)) STB=FLOAT(MOD(IBACKG/64,64)) STG=FLOAT(MOD(IBACKG/4096,64)) ENDR = STR 16 BIT MACHINES 2)14 STR=FLOAT(MOD(IBACKG,32)) STB=FLOAT(MOD(IBACKG/32,32)) STG=FLOAT(MOD(IBACKG/1024,32)) ENDR = STR SUBROUTINE PACKER: FUNCTION: PACKS DATA INTO STORAGE BLOCK FOR LATTER USE BY HIDDEN. SUBROUTINE PACKER MAY REQUIRE MANY CHANGES DEPENDING UPON THE WORD SIZE OF YOUR MACHINE AND YOUR DESIRE FOR SPEED OF OPERATION. THE ROUTINE YOU RECEIVED ON TAPE IS WRITTEN FOR A 36 BIT MACHINE IN ANSI FORTRAN. THEREFORE, IF YOU ARE RUNNING ON A MACHINE WITH LESS THAN A 36 BIT WORD, YOU WILL NEED TO MAKE MODIFICATIONS. ALSO, IF YOUR MACHINE SUPPORTS BIT MANIPULATION IN FORTRAN, YOU MAY WANT TO USE IT TO SPEED COMPUTATION. FIRST, THE PACKING SCHEME FOR THE 36 BIT WORD WILL BE PRESENTED, AND THEN, SUGGESTED PACKING SCHEMES FOR BOTH 16 AND 32 BIT WORDS WILL FOLLOW. 36 BIT WORD  TO STORE THE INFORMATION PASSED TO SUBROUTINE PACKER, FIVE 36 BIT WORDS ARE NEEDED. THE INFORMATION THAT EACH RECEIVES (ALONG WITH THE NUMBER OF BITS IT OCCUPIES DELIMITED BY SLASHES) IS OUTLINED BELOW. INSTALLING MOVIE.BYU Page 5-14 IFREE(IPT) = IC1/5/,IX1/10/,IX2/10/,IDY/10/ IFREE(IPT+1) = IC2/5/,IZ1/15/,IZ2/15/ IFREE(IPT+2) = IS1/6/,IS2/6/,NXTEDG/18/  IFREE(IPT+3) = ICOL1/18/,IP/13/ IFREE(IPT+4) = ICOL2/18/,IPS/13/ THE DATA IS STORED RIGHT JUSTIFIED WITHIN EACH WORD. THE VARIABLES ARE DEFINED AS FOLLOWS: IFREE = FREE STORAGE IPT = FREE STORAGE POINTER IC1 = BEGIN CONTOUR VALUE IX1 = BEGIN X COORDINATE IX2 = END X COORDINATE IDY = DELTA Y IC2 = END CONTOUR VALUE  IZ1 = BEGIN Z COORDINATE IZ2 = END Z COORDINATE IS1 = BEGIN INTENSITY IS2 = END INTENSITY NXTEDG = NEXT EDGE POINTER (IBUCKY(IY)) ICOL1 = BEGIN COLOR IP = POLYGON NUMBER ICOL2 = END COLOR IPS = IP OF SHARED POLYGON 16 BIT WORD CONVERSION OF THE HIDDEN PROCESSOR TO 16 BIT MACHINES WILL PROVE TO BE THE MOST INVOLVED. AS PREVIOUSLY NOTED, THERE ARE SEVERAL SUBROUTINES THAT WILL REQUIRE CHANGES. APPENDIX A CONTIANS SUGGESTED CODING OF SUBROUTINE PACKER USING THE SCHEME BELOW. SUBROUTINE PACKER REQUIRES ELEVEN 16 BIT WORDS TO STORE THE DATA SENT TO IT. IFREE(IPT) = IC1/5/,IX1/10/ IFREE(IPT+1) = IC2/5/,IX2/10/ IFREE(IPT+2) = IDY/10/ IFREE(IPT+3) = IZ1/15/  IFREE(IPT+4) = IZ2/15/ IFREE(IPT+5) = IS1/5/,IS2/5/ IFREE(IPT+6) = NXTEDG/15/ IFREE(IPT+7) = ICOL1/15/ IFREE(IPT+8) = ICOL2/15/ IFREE(IPT+9) = IP/13/ IFREE(IPT+10) = IPS/13/ INSTALLING MOVIE.BYU Page 5-15 NOTICE THAT THE NUMBER OF BITS USED FOR BOTH INTENSITY INFORMATION AND COLOR HAVE BEEN REDUCED. THIS IS THE REASON CHANGES MUST BE MADE TO THE SUBROUTINES MENTIONED ABOVE. EVERYWHERE INTENSITY AND COLOR RECEIVED MULTIPLES OF 6 BITS, THEY NOW WILL GET MULTIPLES OF 5 BITS. ALSO, NXTEDG NOW GETS 15 BITS INSTEAD OF 18. BY SUBTRACTING 2**15-1 OR 32767 FROM THE POINTER, A LARGER SEGMENT OF FREE STORAGE MAY BE MAPPED. 32 BIT WORD CONVERSION TO 32 BIT WORDS SHOULD BE OF RELATIVELY LITTLE TROUBLE. FIVE 32 BIT WORDS WILL BE REQUIRED TO STORE THE INFORMATION SENT TO SUBROUTINE PACKER IF CONTOURS ARE NOT REQUESTED. SIX 36 BIT WORDS WILL BE REQUIRED TO SUPPORT CONTOURING. A SIMPLE IF STATEMENT IS USED IN THE SUGGESTED SUBROUTINE TO CHOSE BETWEEN THE TWO. AS WITH THE 16 BIT SCHEME, A SUGGESTED ANSI FORTRAN SUBROUTINE TO IMPLEMENT THE PACKING SCHEME BELOW IS FOUND IN APPENDIX B. IFREE(IPT) = IX1/10/,IX2/10/,IDY/10/ IFREE(IPT+1) = IZ1/15/,IZ2/15/ IFREE(IPT+2) = IS1/6/,IS2/6/,NXTEDG/18/ IFREE(IPT+3) = ICOL1/18/,IP/13/ IFREE(IPT+4) = ICOL2/18/,IPS/13/ IFREE(IPT+6) = IC1/5/,IC2/5/ THE ONLY CHANGE NECESSARY IS THE PACKING OF THE CONTOUR INFORMATION IN THE SIXTH WORD INSTEAD OF THE FIRST AND SECOND AND CHANGING THE NUMBER OF WORDS ACCORDINGLY. SUBROUTINE UNPACK: FUNCTION: PERFORMS THE OPPOSITE FUNCTION OF PACKER. SINCE SUBROUTINE UNPACK REFORMS THE OPPOSITE FUNCTION OF PACKER, ANY CHANGES YOU MADE TO SUBROUTINE PACKER MUST ALSO BE REFLECTED IN CHANGES MADE TO SUBROUTINE UNPACK. APPENDICES A AND B CONTAIN SUGGESTED ANSI FORTRAN SUBROUTINES THAT PERFORM THIS FUNCTION FOR BOTH 16 AND 32 BIT MACHINES. SUBROUTINE ERRMSG: FUNCTION: WRITES ERROR MESSAGES TO ERROR OUTPUT DEVICE. NO CHANGES NECESSARY. INSTALLING MOVIE.BYU Page 5-16 SUBROUTINE CONSHO: FUNCTION: EVALUATES CONTOUR INFORMATION FOR VISIBLE SEGMENT. NO CHANGES NECESSARY. FILE 4: DEVICE.FOR DEVICE.FOR CONTAINS THE PICTURE DEVICE DEPENDENT CODE FOR DISPLAYING THE PICTURE. THESE ROUTINES WILL  GENERALLY NEED TO BE MODIFIED TO ACCOMMODATE YOUR DISPLAY DEVICES. SUBROUTINE BGNFRM: FUNCTION: INITIALIZES AN OUTPUT DEVICE TO RECEIVE A PICTURE. REMEMBER THAT THE DEVICE NUMBERS OF CONTINUOUS-TONE DEVICES ARE GREATER THAN 0 AND FOR LINE DRAWING DEVICES, THEY ARE LESS THAN ZERO. THE GENERAL EFFECT OF THIS ROUTINE ON ALL DEVICES IS AREA FOR LINE DRAWING DEVICES.  SUBROUTINE ENDFRM: FUNCTION: TERMINATES OUTPUT TO A DISPLAY DEVICE. SUBROUTINE ENDFRM DUMPS THE REMAINDER OF THE OUTPUT BUFFER AND RETURNS CONTROL TO THE USER TERMINAL. SUBROUTINE PLTLIN: FUNCTION: DRAWS A LINE FROM (A,B) TO (C,D) ON THE DISPLAY DEVICE. SUBROUTINE PLTLIN CONVERTS THE A, B, C, AND D COORDINATES FROM THERE RANGE OF 0 T0 IFX (THE X RESOLUTION) TO THE RANGE OF THE CHOSEN DISPLAY DEVICE. THE APPROPRIATE CALLS ARE THEN MADE TO THE PARTICULAR DEVICE TO DISPLAY THE LINE. SUBROUTINE LABEL: INSTALLING MOVIE.BYU Page 5-17 FUNCTION: PLOTS A LABEL ON THE DISPLAY DEVICE. SUBROUTINE LABEL PRINTS ALPHANUMIC INFORMATION ON THE DISPLAY DEVICE. THE LABEL, CHR, BEGINS AT (X,Y) AND IS NCNT CHARACTERS IN LENGTH. THIS ROUTINE IS USED TO PLACE  LABELS ON CONTOUR LINES. SUBROUTINE SRL: FUNCTION: CALCULATES SHADED LINE INFORMATION AND PASSES IT TO CONTINOUS-TONE DEVICE. SUBROUTINE SRL RECEIVES THE BEGINNING AND ENDING INTENSITIES AND COLORS OF LINE SEGMENTS. IT CALCULATES THE INTENSITY AND COLOR OF INTERMEDIATE POINTS. WHEN AN ENTIRE LINE HAS BEEN PROCESSED, IT IS SENT TO THE DEVICE. THERE ARE PRESENTLY NO CALLS TO DISPLAY THE PICTURE INCLUDED WITH SRL. THESE MUST BE SUPPLIED BY THE HOST SYSTEM. FILE 5: UTILITY.FOR UTILITY.FOR CONTAINS THE FORTRAN SOURCE FILE OF THE UTILITY ROUTINE. IT IS MOSTLY WRITTEN IN MACHINE INDEPENDENT FORTRAN. IF THE FORTRAN OPERATING SYSTEM YOU ARE RUNNING DOES NOT ALLOW FREE FORMATED READS, MOST OF THE FORMAT STATEMENTS ASSOCIATED WITH INTERACTIVE READ STATEMENTS WILL NEED TO BE MODIFIED. THIS SHOULD BE THE ONLY CHANGE THROUGHOUT THE PROGRAM. MAIN PROGRAM: FUNCTION: INTERACTIVELY CALLS SUBROUTINES TO PERFORM REQUESTED ACTIONS. IT MAY BE NECESSARY TO CHANGE THE I/0 UNIT NUMBERS ASSOCIATED WITH THE VARIABLES INPUT AND OUTPUT. INPUT GETS THE UNIT NUMBER OF THE INPUT DEVICE, AND OUTPUT GETS THE UNIT NUMBER OF THE OUTPUT DEVICE. TYPICALLY INPUT AND  OUTPUT REFER TO THE USER'S TERMINAL. REMEMBER THAT VARIABLES NPL, X, IP, JP, S, SX, AND U MUST BE DIMENSIONED TO ACCOMMODATE THE MAXIMUM EXPECTED NUMBER OF PARTS, COORDINATES, OR ELEMENTS WHICH EVER IS APPROPRIATE. THE VARIABLES NPMAX, NJMAX, AND NPTMAX MUST ALSO BE SET TO REFLECT THE MAXIMUM DIMENSIONS. FUNCTION CMD: INSTALLING MOVIE.BYU Page 5-18 FUNCTION: ISSUES COMMAND PROMPT FOR VARIOUS LEVELS AND ACCEPTS COMMAND. POSSIBLE I/O MODIFICATIONS (SEE INTRODUCTION ABOVE). SUBROUTINE HELP: FUNCTION: PRINTS HELP MESSAGE ON TERMINAL. POSSIBLE I/O MODIFICATIONS (SEE INTRODUCTION ABOVE). SUBROUTINE OVER: FUNCTION: PRINTS ERROR MESSAGE WHEN MAXIMUM DIMENSIONS EXCEEDED. POSSIBLE I/O MODIFICATIONS (SEE INTRODUCTION ABOVE). SUBROUTINE GEOM: FUNCTION: PERFORMS UTILTIY OPERATIONS READ, WRITE, PRINT, AND CHANGE ON GEOMETRY FILES. POSSIBLE I/O MODIFICATIONS (SEE INTRODUCTION ABOVE). SUBROUTINE DISP: FUNCTION: PERFORMS UTILITY OPERATIONS READ, WRITE, PRINT, AND CHANGE ON DISPLACEMENT FILES. POSSIBLE I/O MODIFICATIONS (SEE INTRODUCTION ABOVE). SUBROUTINE SFUN: FUNCTION: PERFORMS UTILITY OPERATIONS READ, WRITE, PRINT,  AND CHANGE ON SCALAR FUNCTION FILES. POSSIBLE I/O MODIFICATIONS (SEE INTRODUCTION ABOVE). SUBROUTINE SYMM: FUNCTION: PERFORMS SYMMETRY OPERATIONS ON FILES. POSSIBLE I/O MODIFICATIONS (SEE INTRODUCTION ABOVE). SUBROUTINE MOVE: FUNCTION: MOVES BLOCKS OF ELEMENTS. INSTALLING MOVIE.BYU Page 5-19 NO CHANGES NECESSARY. SUBROUTINE ORDER:  FUNCTION: PERFORMS ORDERING OF POLYGONAL VERTICES FOR PANEL SYSTEMS. POSSIBLE I/O MODIFICATIONS (SEE INTRODUCTION ABOVE). SUBROUTINE OPEN: FUNCTION: REQUEST DATA FILE NAMES AND OPENS I/O CHANNEL SUBROUTINE OPEN MAY NEED TO BE COMPLETELY REWRITTEN TO ACCOMMODATE YOUR PARTICULAR OPERATING SYSTEM. THE ROUTINE IS ENTERED WITH FILEID CONTAINING THE ALPHANUMERIC FILE IDENTIFICATION (GEOM., DISP., OR FUNC.) IT REQUESTS THE FILE NAME, AND OPENS THE FILE FOR INPUT IF IOP=1 AND FOR OUTPUT IF IOP=-1. A BLANK FILE SPECIFICATION WILL SET IERROR TO 0. THE ROUTINE RETURNS WITH THE DEVICE UNIT NUMBER IN IUNIT AND IERROR SET TO 1 ON SUCCESSFUL COMPLETION, 0 ON BLANK FILE, AND -1 ON FAILURE. SUBROUTINE RDGEOM: FUNCTION: READ GEOMETRY FILE FROM INPUT DEVICE. POSSIBLE I/O MODIFICATIONS (SEE INTRODUCTION ABOVE). SUBROUTINE WRGEOM: FUNCTION: WRITES GEOMETRY FILE TO OUTPUT DEVICE. POSSIBLE I/O MODIFICATINS (SEE INTRODUCTION ABOVE). SUBROUTINE RDSFUN: FUNCTION: READ SCALAR FUNCTION FILE FROM INPUT DEVICE. POSSIBLE I/O MODIFICATIONS (SEE INTRODUCTION ABOVE). SUBROUTINE WRSFUN: FUNCTION: WRITES SCALAR FUNCTION FILE TO OUTPUT DEVICE. NO CHANGES NECESSARY. SUBROUTINE RDDISP: INSTALLING MOVIE.BYU Page 5-20 FUNCTION: READS DISPLACEMENT FILE FROM INPUT DEVICE. NO CHANGES NECESSARY. SUBROUTINE WRDISP: FUNCTION: WRITES DISPLACEMENT FILE TO INPUT DEVICE. NO CHANGES NECESSARY. FILE 6: SECTION.FOR SECTION.FOR CONTAINS THE FORTRAN SOURCE FILE OF THE CLIPPING AND CAPPING ALGORITHM FOR 8 NODE BRICKS AS WELL AS THE CODE TO DELETE INTERIOR POLYGONS. IT IS MOSTLY WRITTEN IN MACHINE INDEPENDENT FORTRAN. IF THE FORTRAN OPERATING SYSTEM YOU ARE RUNNING DOES NOT ALLOW FREE FORMATED READS, MOST OF THE FORMAT STATEMENTS ASSOCIATED WITH INTERACTIVE READ STATEMENTS WILL NEED TO BE MODIFIED. THIS SHOULD BE THE MAJOR CHANGE THROUGHOUT THE PROGRAM. MAIN PROGRAM: FUNCTION: CONTROLS STORAGE ALLOCATION AND FLOW OF PROGRAM. IT MAY BE NECESSARY TO CHANGE THE I/0 UNIT NUMBERS ASSOCIATED WITH THE VARIABLES INPUT AND OUTPUT. INPUT GETS THE UNIT NUMBER OF THE INPUT DEVICE, AND OUTPUT GETS THE UNIT NUMBER OF THE OUTPUT DEVICE. THE DIMENSION OF VARIABLE A FOUND IN BLANK COMMON SHOULD BE ADJUSTED TO ACCOMMODATE THE PROBLEM TO BE RUN. THE DIMENSION OF IA SHOULD BE THE SAME AS A. THE VALUE ASSIGNED TO MTOT SHOULD ALSO BE THE SAME AS THE DIMENSION OF A. POSSIBLE I/O MODIFICATIONS (SEE INTRODUCTION ABOVE). BLOCK COMMON: FUNCTION: INITIALIZES THE POLYGON MAP OF THE HEXAHEDRON ELEMENT. NO CHANGES NECESSARY. SUBROUTINE OPEN: INSTALLING MOVIE.BYU Page 5-21 FUNCTION: REQUEST DATA FILE NAMES AND OPENS I/O CHANNEL SUBROUTINE OPEN MAY NEED TO BE COMPLETELY REWRITTEN TO ACCOMMODATE YOUR PARTICULAR OPERATING SYSTEM. THE ROUTINE IS ENTERED WITH FILEID CONTAINING THE ALPHANUMERIC FILE IDENTIFICATION (GEOM., DISP., OR FUNC.) IT REQUESTS THE FILE NAME, AND OPENS THE FILE FOR INPUT IF IOP=1 AND FOR OUTPUT IF IOP=-1. A BLANK FILE SPECIFICATION WILL SET IERROR TO 0. THE ROUTINE RETURNS WITH THE DEVICE UNIT NUMBER IN IUNIT AND IERROR SET TO 1 ON SUCCESSFUL COMPLETION, 0 ON BLANK FILE, AND -1 ON FAILURE. SUBROUTINE RDCNTL: FUNCTION: READS CONTROL INFORMATION FROM INPUT DEVICE NECESSARY TO ALLOCATE STORAGE. NO CHANGES NECESSARY. SUBROUTINE RDGEOM: FUNCTION: READS REMAINDER OF GEOMETRY FILE FROM INPUT DEVICE. NO CHANGES NECESSARY. SUBROUTINE WRGEOM: FUNCTION: WRITES GEOMETRY FILE TO OUTPUT DEVICE.  NO CHANGES NECESSARY. SUBROUTINE RDSFUN: FUNCTION: READS SCALAR FUNCTION FILE FROM INPUT DEVICE. POSSIBLE I/O MODIFICATIONS (SEE INTRODUCTION ABOVE). SUBROUTINE WRSFUN: FUNCTION: WRITES SCALAR FUNCTION FILE TO OUTPUT DEVICE. NO CHANGES NECESSARY. SUBROUTINE RDDISP: FUNCTION: READS DISPLACEMENT FILE FROM INPUT DEVICE. INSTALLING MOVIE.BYU Page 5-22  NO CHANGES NECESSARY. SUBROUTINE WRDISP: FUNCTION: WRITES DISPLACEMENT FILE TO OUTPUT DEVICE. NO CHANGES NECESSARY. SUBROUTINE PLFILE: FUNCTION: REQUESTS CLIPPING PLANE INFORMATION. POSSIBLE I/O MODIFICATIONS (SEE INTRODUCTION ABOVE). SUBROUTINE DIST: FUNCTION: CALCULATES DISTANCE TO FROM PLANE TO A POINT. NO CHANGES NECESSARY. SUBROUTINE SOLID:  FUNCTION: DISSEMBLES HEXAHEDRON INTO POLYGONS AND SENDS THEM TO CLIPPER. POSSIBLE I/O MODIFICATIONS (SEE INTRODUCTION ABOVE). SUBROUTINE SPLIT: FUNCTION: SPLITS POLYGONS ALONG PLANE AND SAVES ON-PLANE LINE SEGMENTS. NO CHANGES NECESSARY. SUBROUTINE LOOKUP: FUNCTION: PERFORMS HASH TABLE LOOKUP. NO CHANGES NECESSARY. SUBROUTINE ENTER: FUNCTION: PERFORMS HASH TABLE ENTER. NO CHANGES NECESSARY. SUBROUTINE DELETE: INSTALLING MOVIE.BYU Page 5-23 FUNCTION: PERFORMS HASH TABLE DELETE. POSSIBLE I/O MODIFICATIONS (SEE INTRODUCTION ABOVE). SUBROUTINE GETBLK: FUNCTION: GETS A BLOCK FROM FREE STORAGE. NO CHANGES NECESSARY. SUBROUTINE RETBLK: FUNCTION: RETURNS A BLOCK TO FREE STORAGE.  NO CHANGES NECESSARY. SUBROUTINE ORDER: FUNCTION: FORMS ON-PLANE POLYGONS FROM LINE SEGMENTS. POSSIBLE I/O MODIFICATIONS (SEE INTRODUCTION ABOVE). SUBROUTINE PLYSRT: FUNCTION: SORTS POLYGONS IN HASH TABLE AND STORES THEM. NO CHANGES NECESSARY. SUBROUTINE REDUCE: FUNCTION: CALCULATES NEW NODE NUMBERS. NO CHANGES NECESSARY. SUBROUTINE TRGEOM:  FUNCTION: TRANSFORMS OLD GEOMETRY TO NEW GEOMETRY. NO CHANGES NECESSARY. SUBROUTINE TRDISP: FUNCTION: TRANSFORMS OLD DISPLACEMENTS TO NEW DISPLACEMENTS. NO CHANGES NECESSARY. INSTALLING MOVIE.BYU Page 5-24 SUBROUTINE TRSFUN: FUNCTION: TRANSFORMS OLD SCALAR FUNCTIONS TO NEW SCALAR FUNCTIONS. NO CHANGES NECESSARY.  FILE 7: TITLE.FOR TITLE.FOR IS THE FORTRAN SOURCE FILE FOR THE TWO AND THREE DIMENSIONAL CHARACTER GENERATOR. THE DATA GENERATED IS COMPATIBLE WITH THE OTHER PROGRAMS IN MOVIE.BYU MAIN PROGRAM: FUNCTION: GENERATES CHARACTER STRINGS OF POLYGONS FOR DISPLAY. IT MAY BE NECESSARY TO CHANGE THE I/0 UNIT NUMBERS ASSOCIATED WITH THE VARIABLES INPUT AND OUTPUT. INPUT GETS  THE UNIT NUMBER OF THE INPUT DEVICE AND OUTPUT GETS THE UNIT NUMBER OF THE OUTPUT DEVICE. TYPICALLY INPUT AND OUTPUT REFER TO THE USER'S TERMINAL. REMEMBER THAT VARIABLES NPL, X, AND IP, MUST BE DIMENSIONED TO ACCOMMODATE THE MAXIMUM EXPECTED NUMBER OF PARTS, COORDINATES, OR ELEMENTS WHICH EVER IS APPROPRIATE. BLOCK DATA: FUNCTION: INITIALIZES ARRAYS WITH CHARACTER DEFINITIONS NO CHANGES NECESSARY. SUBROUTINE OPEN: FUNCTION: REQUEST DATA FILE NAMES AND OPENS I/O CHANNEL SUBROUTINE OPEN MAY NEED TO BE COMPLETELY REWRITTEN TO ACCOMMODATE YOUR PARTICULAR OPERATING SYSTEM. THE ROUTINE IS ENTERED WITH FILEID CONTAINING THE ALPHANUMERIC FILE IDENTIFICATION (GEOM., DISP., OR FUNC.) IT REQUESTS THE FILE NAME, AND OPENS THE FILE FOR INPUT IF IOP=1 AND FOR OUTPUT IF IOP=-1. A BLANK FILE SPECIFICATION WILL SET IERROR TO 0. THE ROUTINE RETURNS WITH THE DEVICE UNIT NUMBER IN IUNIT AND IERROR SET TO 1 ON SUCCESSFUL COMPLETION, 0 ON BLANK FILE, AND -1 ON FAILURE. INSTALLING MOVIE.BYU Page 5-25 SUBROUTINE WRGEOM: FUNCTION: WRITES GEOMETRY FILE TO OUTPUT DEVICE. POSSIBLE I/O MODIFICATINS (SEE INTRODUCTION ABOVE).  Page Index-1 INSTALLING MOVIE.BYU INDEX Ainten: . . . . . . . . . . . 5-4 Bgnfrm: . . . . . . . . . . . 5-16 Clip: . . . . . . . . . . . . 5-10 Cmd: . . . . . . . . . . . . . 5-17 Consho: . . . . . . . . . . . 5-16 Delete: . . . . . . . . . . . 5-22 Device.for . . . . . . . . . . 5-16 Disp: . . . . . . . . . . . . 5-18 Dist: . . . . . . . . . . . . 5-22 Draw: . . . . . . . . . . . . 5-5 Drawit: . . . . . . . . . . . 5-12 Edgmak: . . . . . . . . . . . 5-7 Endfrm: . . . . . . . . . . . 5-16 Enter: . . . . . . . . . . . . 5-22 Errmsg: . . . . . . . . . . . 5-15 Facmak: . . . . . . . . . . . 5-11 Geom: . . . . . . . . . . . . 5-18 Getblk: . . . . . . . . . . . 5-6, 5-23 Getvar: . . . . . . . . . . . 5-6 Help: . . . . . . . . . . . . 5-18  Hidden.for . . . . . . . . . . 5-6 Hidden: . . . . . . . . . . . 5-11 Intclp: . . . . . . . . . . . 5-7 Inthid: . . . . . . . . . . . 5-5 Ishade: . . . . . . . . . . . 5-4 Ivsble: . . . . . . . . . . . 5-4 Label: . . . . . . . . . . . . 5-16 Linsho: . . . . . . . . . . . 5-12 Lookup: . . . . . . . . . . . 5-22 Lstset: . . . . . . . . . . . 5-6 Move: . . . . . . . . . . . . 5-18 Movie.for . . . . . . . . . . 5-1 Multdc: . . . . . . . . . . . 5-4 Multdd: . . . . . . . . . . . 5-4 Open: . . . . . . . . . . . . 5-2, 5-19 to 5-20, 5-24 Order: . . . . . . . . . . . . 5-19, 5-23 Over: . . . . . . . . . . . . 5-18 Packer: . . . . . . . . . . . 5-13 Pictur: . . . . . . . . . . . 5-2 Plfile: . . . . . . . . . . . 5-22 Pltlin: . . . . . . . . . . . 5-16 Plysrt: . . . . . . . . . . . 5-23 Polmak: . . . . . . . . . . . 5-7 Polsnp: . . . . . . . . . . . 5-8 Rdcntl: . . . . . . . . . . . 5-21 Rddisp: . . . . . . . . . . . 5-19, 5-21 Rdgeom: . . . . . . . . . . . 5-19, 5-21 Rdsfun: . . . . . . . . . . . 5-19, 5-21 Reduce: . . . . . . . . . . . 5-23 Retblk: . . . . . . . . . . . 5-6, 5-23 Rotat: . . . . . . . . . . . . 5-2 Section.for . . . . . . . . . 5-20 Sfun: . . . . . . . . . . . . 5-18 Show: . . . . . . . . . . . . 5-13 Solid: . . . . . . . . . . . . 5-22 Split: . . . . . . . . . . . . 5-22 Srl: . . . . . . . . . . . . . 5-17 Symm: . . . . . . . . . . . . 5-18 Title.for . . . . . . . . . . 5-24 Trdisp: . . . . . . . . . . . 5-23 Trgeom: . . . . . . . . . . . 5-23 Trsfun: . . . . . . . . . . . 5-24 Unpack: . . . . . . . . . . . 5-15 User.doc . . . . . . . . . . . 5-1 Utility.for . . . . . . . . . 5-17 Wrdisp: . . . . . . . . . . . 5-20, 5-22 Wrgeom: . . . . . . . . . . . 5-19, 5-21, 5-25 Wrsfun: . . . . . . . . . . . 5-19, 5-21 APPENDIX A SUGGESTED 16 BIT MACHINE CODE SUBROUTINE PACKER C C SUBROUTINE PACKER FOR 16 BIT MACHINES IN ANSI FORTRAN C C THIS ROUTINE RECEIVES DATA THROUGH EDGARG AND PACKS IT C INTO A STORAGE BLOCK INSIDE FREE. IF THIS EDGE IS A C SHARED EDGE, THEN THE EDGE WILL BE COMPARED WITH EXISTING C EDGES ON THIS SCAN LINE TO FIND OUT WHICH IF ANY IT C MATCHES. IF THIS EDGE IS A HORIZONTAL EDGE, THEN IT WILL C BE STORED ON THE PREVIOUS SCAN LINE. COMMON/EDGARG/IY,IX1,IX2,IZ1,IZ2,IS1,IS2,IP,IDY,ICOL1, 1ISHR,IC1,IC2,ICOL2 COMMON/FREE/ IFREE(1) COMMON/EYES/XEY(3),IFY,ES(4) COMMON/BUCKY/IBUCKY(1) COMMON/QFORIO/CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC LOGICAL CONTRS,IBAD,ISHR C CHANGE IY IF THIS IS A HORIZONTAL EDGE IF(IDY.EQ.0) IY=IY+1 IF(IY.GT.IFY) IY=IFY IPT=IBUCKY(IY)+32767 C GENERATE THE EDGE DATA NUMWRD=11 C JUMP IF NO EDGE SHARING IF(.NOT.ISHR) GO TO 4 C TRACE THROUGH THE ENTRIES ON THIS SCAN LINE AND FIND OUT C IF THIS EDGE HAS ALREADY BEEN ENTERED. 1 IF(IPT.EQ.0) GO TO 4 IF(IX1.EQ.MOD(IFREE(IPT),1024) 1.AND.IX2.EQ.MOD(IFREE(IPT+1),1024) 2.AND.IDY.EQ.IFREE(IPT+2) 3.AND.IZ1.EQ.IFREE(IPT+3) 4.AND.IZ2.EQ.IFREE(IPT+4)) GO TO 3 C GET THE NEXT BLOCK IPT=IFREE(IPT+6)+32767 GO TO 1 C CHECK TO SEE IF THIS EDGE IS ALREADY SHARED C AND JUMP IF IT IS 3 IF(IFREE(IPT+10).NE.0) GO TO 4 C NOW PROVIDE THE SHARING POLYGON SUGGESTED 16 BIT MACHINE CODE Page A-2 IFREE(IPT+10)=IP GO TO 5 4 CONTINUE C GET ENOUGH FREE FOR EDGE BLOCK (176 BITS) CALL GETVAR(IPT,NUMWRD) IF(IBAD) RETURN C CBEG(5), XBEG(10) IFREE(IPT)=IX1 C CEND(5), XEND(10) IFREE(IPT+1)=IX2  C DELTA Y(10) IFREE(IPT+2)=IDY C ZBEG(15) IFREE(IPT+3)=IZ1 C ZEND(15) IFREE(IPT+4)=IZ2 C SBEG(5), SEND(5) IFREE(IPT+5)=IS1*32+IS2 C NEXT EDGE(16) IFREE(IPT+6)=IBUCKY(IY) C COLOR BEG(15) IFREE(IPT+7)=ICOL1 C COLOR END(15) IFREE(IPT+8)=ICOL2 C POLYGON NUMBER IFREE(IPT+9)=IP C SHARED POLYGON NUMBER IFREE(IPT+10)=0 IF(.NOT.CONTRS) GO TO 6 IFREE(IPT)=MOD(IFREE(IPT),1024)+IC1*1024 IFREE(IPT+1)=MOD(IFREE(IPT+1),1024)+IC2*1024 6 IBUCKY(IY)=IPT-32767 5 RETURN END SUBROUTINE UNPACK C C SUBROUTINE UNPACK FOR 16 BIT MACHINES IN ANSI FORTRAN C C UNPACK PERFORMS THE REVERSE OF PACKER. IT IS CALLED BY C HIDDEN WITH IEDGPT SET AND RETURNS DATA THROUGH EDGBLK. COMMON/FREE/IFREE(1) COMMON/EDGBLK/IPT,ICOL1,IDELY,X1,X2,Z1,Z2,S1,S2, 1IEDGPT,C1,C2,SHARED,IGTHRZ,ICOL2 COMMON/QFORIO/CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC LOGICAL CONTRS C GET DELTAY VALUE 15 IDELY=IFREE(IEDGPT+2) C JUMP IF A NON-HORIZONTAL LINE IF(IDELY.GT.0) GO TO 16 C JUMP IF WE ARE LOOKING FOR VERTICALS IF(IGTHRZ) 20,20,18  C JUMP IF WE ARE LOOKING FOR HORIZONTALS SUGGESTED 16 BIT MACHINE CODE Page A-3 16 IF(IGTHRZ) 19,19,20 C FLAG TO SAY THERE ARE HORIZONTAL EDGES ON THIS SCAN LINE 18 IGTHRZ=2 C GET NEXT EDGE BLOCK 19 IEDGPT=IFREE(IEDGPT+6)+32767 C GO HOME IF WE RAN OFF THE END OF THE LIST IF(IEDGPT) 3,3,15 C GET Z BEGIN 20 Z1=FLOAT(IFREE(IEDGPT+3)) C GET Z END AND MAKE IT REAL Z2=FLOAT(IFREE(IEDGPT+4)) C GET X BEGIN X1=FLOAT(MOD(IFREE(IEDGPT),1024)) C GET X END AND MAKE IT REAL X2=FLOAT(MOD(IFREE(IEDGPT+1),1024)) C GET SHADE BEGIN S1=FLOAT(MOD(IFREE(IEDGPT+5)/32,32)) C GET SHADE END AND MAKE IT REAL S2=FLOAT(MOD(IFREE+5),32)) C GET POINTER TO POLYGON IP=IFREE(IEDGPT+10) C GET THE COLOR OF THIS EDGE  ICOL1=IFREE(IEDGPT+7) ICOL2=IFREE(IEDGPT+8) C JUMP IF NO CONTOURING IF(.NOT.CONTRS) GO TO 4 C GET THE CONTOUR BEGIN C1=FLOAT(MOD(IFREE(IEDGPT)/1024,32)) C CET THE CONTOUR END C2=FLOAT(MOD(IFREE(IEDGPT+1)/1024,32)) 4 SHARED=-2. C IPT=IFREE(IEDGPT+9) C JUMP IF NOTHING IN THE TOP HALF IF(IP.EQ.0) GO TO 2 SHARED=-1.  IF(ISHARE.EQ.1) GO TO 1 ISHARE=1 GO TO 3 1 IPT=IP C GET POINTER TO NEXT EDGE ON SCAN LINE 2 IEDGPT=IFREE(IEDGPT+6)+32767 ISHARE=0 3 RETURN END APPENDIX B SUGGESTED 32 BIT MACHINE CHANGES SUBROUTINE PACKER C C SUBROUTINE PACKER FOR 32 BIT MACHINES IN ANSI FORTRAN C C THIS ROUTINE RECEIVES DATA THROUGH EDGARG AND PACKS IT C INTO A STORAGE BLOCK INSIDE FREE. IF THIS EDGE IS A C SHARED EDGE, THEN THE EDGE WILL BE COMPARED WITH EXISTING C EDGES ON THIS SCAN LINE TO FIND OUT WHICH IF ANY IT C MATCHES. IF THIS EDGE IS A HORIZONTAL EDGE, THEN IT WILL C BE STORED ON THE PREVIOUS SCAN LINE. COMMON/EDGARG/IY,IX1,IX2,IZ1,IZ2,IS1,IS2,IP,IDY,ICOL1, 1ISHR,IC1,IC2,ICOL2  COMMON/FREE/ IFREE(1) COMMON/EYES/XEY(3),IFY,ES(4) COMMON/BUCKY/IBUCKY(1) COMMON/QFORIO/CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC LOGICAL CONTRS,IBAD,ISHR C CHANGE IY IF THIS IS A HORIZONTAL EDGE IF(IDY.EQ.0) IY=IY+1 IF(IY.GT.IFY) IY=IFY IPT=IBUCKY(IY) C GENERATE THE EDGE DATA IT1=(IX1*1024+IX2)*1024+IDY IT2=IZ1*32768+IZ2 NUMWRD=5 C GET EXTRA WORD FOR CONTOURS IF(CONTRS) NUMWRD=6 C JUMP IF NO EDGE SHARING IF(.NOT.ISHR) GO TO 4 C TRACE THROUGH THE ENTRIES ON THIS SCAN LINE AND FIND OUT C IF THIS EDGE HAS ALREADY BEEN ENTERED. 1 IF(IPT.EQ.0) GO TO 4 IF(IT1.EQ.IFREE(IPT).AND.IT2.EQ.IFREE(IPT+1)) GO TO 3 C GET THE NEXT BLOCK IPT=MOD(IFREE(IPT+2),262144) GO TO 1 C CHECK TO SEE IF THIS EDGE IS ALREADY SHARED C AND JUMP IF IT IS 3 IF(MOD(IFREE(IPT+4),8192).NE.0) GO TO 4 C NOW PROVIDE THE SHARING POLYGON SUGGESTED 32 BIT MACHINE CHANGES Page B-2 IFREE(IPT+4)=IFREE(IPT+4)/8192*8192+IP GO TO 5 4 CONTINUE C GET ENOUGH FREE FOR EDGE BLOCK (160 OR 192 BITS) CALL GETVAR(IPT,NUMWRD) IF(IBAD) RETURN C XBEG(10), XEND(10), DELTA Y(10) IFREE(IPT)=IT1 C ZBEG(15), ZEND(15) IFREE(IPT+1)=IT2 C SBEG(6), SEND(6), NEXT EDGE(18) IFREE(IPT+2)=(IS1*64+IS2)*262144+IBUCKY(IY) C COLOR BEG(18), POLYGON NUMBER(13) IFREE(IPT+3)=ICOL1*8192+IP C COLOR END(18), SHARED POLYGON NUMBER(13) IFREE(IPT+4)=ICOL2*8192 C CONTOUR BEG(5), CONTOUR END(5) IFCONTRS) IFREE(IPT+5)=IC1*32+IC2 6 IBUCKY(IY)=IPT  5 RETURN END SUBROUTINE UNPACK C C SUBROUTINE UNPACK FOR 32 BIT MACHINES IN ANSI FORTRAN C C UNPACK PERFORMS THE REVERSE OF PACKER. IT IS CALLED BY C HIDDEN WITH IEDGPT SET AND RETURNS DATA THROUGH EDGBLK. COMMON/FREE/IFREE(1) COMMON/EDGBLK/IPT,ICOL1,IDELY,X1,X2,Z1,Z2,S1,S2, 1IEDGPT,C1,C2,SHARED,IGTHRZ,ICOL2 COMMON/QFORIO/CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC LOGICAL CONTRS C GET DELTAY VALUE 15 IDELY=MOD(IFREE(IEDGPT,1024) C JUMP IF A NON-HORIZONTAL LINE IF(IDELY.GT.0) GO TO 16 C JUMP IF WE ARE LOOKING FOR VERTICALS IF(IGTHRZ) 20,20,18 C JUMP IF WE ARE LOOKING FOR HORIZONTALS 16 IF(IGTHRZ) 19,19,20 C FLAG TO SAY THERE ARE HORIZONTAL EDGES ON THIS SCAN LINE 18 IGTHRZ=2 C GET NEXT EDGE BLOCK 19 IEDGPT=MOD(IFREE(IEDGPT+2),262144) C GO HOME IF WE RAN OFF THE END OF THE LIST IF(IEDGPT) 3,3,15 C GET Z BEGIN 20 Z1=FLOAT(MOD(IFREE(IEDGPT+1)/32768,32768)) C GET Z END AND MAKE IT REAL Z2=FLOAT(MOD(IFREE(IEDGPT+1),32768)) C GET X BEGIN X1=FLOAT(MOD(IFREE(IEDGPT)/1048576,1024)) SUGGESTED 32 BIT MACHINE CHANGES Page B-3 C GET X END AND MAKE IT REAL X2=FLOAT(MOD(IFREE(IEDGPT)/1024,1024)) C GET SHADE BEGIN S1=FLOAT(MOD(IFREE(IEDGPT+2)/16777216,64)) C GET SHADE END AND MAKE IT REAL S2=FLOAT(MOD(IFREE+2)/262144,64)) C GET POINTER TO POLYGON IP=MOD(IFREE(IEDGPT+4),8192) C GET THE COLOR OF THIS EDGE ICOL1=MOD(IFREE(IEDGPT+3)/8192,262144) ICOL2=MOD(IFREE(IEDGPT+4)/8192,262144) C JUMP IF NO CONTOURING IF(.NOT.CONTRS) GO TO 4 C GET THE CONTOUR BEGIN C1=FLOAT(MOD(IFREE(IEDGPT+5)/32,32)) C CET THE CONTOUR END C2=FLOAT(MOD(IFREE(IEDGPT+5),32)) 4 SHARED=-2. C IPT=MOD(IFREE(IEDGPT+3),8192) C JUMP IF NOTHING IN THE TOP HALF IF(IP.EQ.0) GO TO 2 SHARED=-1. IF(ISHARE.EQ.1) GO TO 1 ISHARE=1 GO TO 3 1 IPT=IP  C GET POINTER TO NEXT EDGE ON SCAN LINE 2 IEDGPT=MOD(IFREE(IEDGPT+2),262144) ISHARE=0 3 RETURN END C**********************************************************************C C C C MOVIE.FOR VERSION 2.0(A) SEPTEMBER 1976 C C C C A GENERAL PRUPOSE COMPUTER GRAPHICS DISPLAY PROGRAM FOR C C POLYGONAL DATA WITH LINE DRAWING AND C C CONTINUOUS-TONE PHOTOIMAGE OUTPUT. C C C C MIKE STEPHENSON HANK CHRISTIANSEN C C DEPARTMENT OF CIVIL ENGR. CIVIL ENGINEERING DEPT. C C AND ENGINEERING MECHANICS 368E ESTB C C THE UNIVERSITY OF ARIZONA BRIGHAM YOUNG UNIVERSITY C C TUCSON, ARIZONA 85721 PROVO, UTAH 84602 C C (602) 884-4803 (801) 374-1211 X2811 C C C C**********************************************************************C C MAIN PROGRAM READS DATA AND CALLS PICTURE ROUTINE C SUBPROGRAMS CALLED C OPEN = DATA FILE OPEN ROUTINE C PICTUR = INTERACTIVE PICTURE PROCESSING ROUINE C VARIABLES USED C NP = NUMBER OF PARTS C NJ = NUMBER OF JOINTS OR NODES C NPT = NUMBER OF ELEMENTS C NPL = PARTS ARRAY - 1ST ROW = FIRST ELEMENT OF PART C - 2ND ROW = LAST ELEMENT OF PART C X = COORDINATE ARRAY C IP = CONNECTIVITY ARRAY C U = DISPLACEMENT ARRAY C SPEC = SCALAR FUNCTION ARRAY C ISPEC = .TRUE. FOR SCALAR FUNCTION FILE INCLUDED C = .FALSE. FOR SCALAR FUNCTION FILE NOT INCLUDED C NFILE = .TRUE. TO READ NEW DATA FILES C = .FALSE. TO EXIT C NPMAX = MAXIMUM NUMBER OF PARTS C NJMAX = MAXIMUM NUMBER OF NODES C NPTMAX = MAXIMUM NUMBER OF ELEMENTS(POLYGONS) INTEGER OUTPUT,ERROR LOGICAL ISPEC,NFILE C DIMENSION NPL(2,NPMAX),X(3,NJMAX),IP(4,NPTMAX),U(3,NJMAX), C 1 SPEC(NJMAX) DIMENSION NPL(2,20),X(3,250),IP(4,250),U(3,250), 1 SPEC(250) COMMON/DEVI/ INPUT,OUTPUT,ERROR DATA NP/0/,NJ/0/,NPT/0/ DATA NPMAX/20/,NJMAX/250/,NPTMAX/250/ DATA IREAD/1/ C INPUT, OUTPUT AND ERROR ARE SET BELOW FOR THE DECSYSTEM-10 INPUT=-4 OUTPUT=-1 ERROR=3 WRITE(OUTPUT,1) 1 FORMAT(' '/) ICODE=63 C READ GEOMETRY FILE 10 CALL OPEN('GEOM.',IUNIT,IREAD,IERROR) IF(IERROR) 10,20,11 11 READ(IUNIT,1000) NP,NJ,NPT IF(NP.GT.NPMAX) WRITE(OUTPUT,1020) NP,NPMAX IF(NJ.GT.NJMAX) WRITE(OUTPUT,1030) NJ,NJMAX IF(NPT.GT.NPTMAX) WRITE(OUTPUT,1040) NPT,NPTMAX IF(NP.GT.NPMAX.OR.NJ.GT.NJMAX.OR.NPT.GT.NPTMAX) STOP READ(IUNIT,1000) ((NPL(I,J),I=1,2),J=1,NP) READ(IUNIT,1010) ((X(I,J),I=1,3),J=1,NJ) READ(IUNIT,1000) ((IP(I,J),I=1,4),J=1,NPT) WRITE(OUTPUT,1050) NP,NJ,NPT C READ DISPLACEMENT FILE 20 IF(NP.EQ.0) GO TO 10 CALL OPEN('DISP.',IUNIT,IREAD,IERROR) IF(IERROR) 20,30,21 21 READ(IUNIT,1010) ((U(I,J),I=1,3),J=1,NJ) C READ SPECIAL FUNCTION FILE 30 CALL OPEN('S. F.',IUNIT,IREAD,IERROR) ISPEC=.FALSE. IF(IERROR) 30,40,31 31 ISPEC=.TRUE. READ(IUNIT,1010) (SPEC(I),I=1,NJ) C SELECT OPTIONS AND VIEW SCENE 40 CALL PICTUR(NPL,X,IP,U,SPEC,NP,NJ,NPT,ISPEC,ICODE) GO TO 10 1000 FORMAT(20I) 1010 FORMAT(6E) 1020 FORMAT(' ') 1030 FORMAT(' ') 1040 FORMAT(' ') 1050 FORMAT(' ') END SUBROUTINE OPEN(FILEID,IUNIT,IOP,IERROR) C SUBROUTINE OPEN REQUEST FILENAME AND OPENS FILE FOR I/O C SUBPROGRAMS CALLED C OPEN = SYSTEM OPEN FILE ROUTINE C VARIABLES USED C FILEID = 5 ASCII CHARACTER ID C IUNIT = DEVICE LOGICAL NUMBER C IOP = 1 FOR INPUT FILE C = -1 FOR OUTPUT FILE C IERROR = 1 ON SUCCESSFUL COMPLETION C = 0 ON EMPTY FILE SPECIFICATION C = -1 ON FAILURE DOUBLE PRECISION ASEQ,BLANK,XNAME INTEGER OUTPUT,ERROR COMMON/DEVI/ INPUT,OUTPUT,ERROR DATA DSK/'DSK'/,MTA/'MTA'/ DATA BLANK/' '/ IERROR=0 1 WRITE(OUTPUT,2) FILEID 2 FORMAT(' <',A5,' FILE> ',$) READ(INPUT,3) XNAME 3 FORMAT(A10) IF(XNAME.EQ.BLANK) RETURN IERROR=1 IUNIT=10 IF(IOP.GT.0) ASEQ='SEQIN' IF(IOP.LT.0) ASEQ='SEQOUT' OPEN(UNIT=IUNIT,DEVICE=DSK,FILE=XNAME,ACCESS=ASEQ,MODE='ASCII') RETURN END SUBROUTINE ROTAT(X,IDIR,THETA,K) C SUBROUTINE ROTAT CALCULATES ROTATION TRANSFORMATION MATRIX C VARIABLES USED C X = TRANSFORMATION MATRIX C IDIR = ROTATION ABOUT 1=X1, 2=X2, 3=X3 AXIS C THETA = ANGLE OF ROTATION IN DEGREES DIMENSION X(3,3,1) C COMPUTE SINE AND COSINE CS=COSD(THETA) SS=SIND(THETA) GO TO (1,2,3),IDIR C X1 DIRECTION 1 DO 11 I=1,3 X2=X(I,2,K) X3=X(I,3,K) X(I,2,K)=CS*X2-SS*X3 11 X(I,3,K)=CS*X3+SS*X2 RETURN C X2 DIRECTION 2 DO 12 I=1,3 X1=X(I,1,K) X3=X(I,3,K) X(I,1,K)=CS*X1+SS*X3 12 X(I,3,K)=CS*X3-SS*X1 RETURN C X3 DIRECTION 3 DO 13 I=1,3  X1=X(I,1,K) X2=X(I,2,K) X(I,1,K)=CS*X1-SS*X2 13 X(I,2,K)=CS*X2+SS*X1 RETURN END SUBROUTINE PICTUR(NPL,X,IP,U,SPEC,NP,NJ,NPT,ISPEC,ICODE) C SUBROUTINE PICTUR - INTERACTIVE PICTURE PROCEESING ROUTINE. C PICTUR ACCEPTS COMMANDS FROM THE USER AND PERFORMS THE INDICATED C ACTION. C COMMANDS ARE C SCOPE = SET SCOPE PARAMETERS C RESTORE = RESTORE GEOMETRY TO INITIAL CONDITION C CONTENT = SELECT CONTENT OF A SCENE AND SET LOCAL MOTION C DIFUSE = SET DIFUSED LIGHT INTENSITY OF INDIVIDUAL PARTS C SUMMARY = GIVE MAXIMUM AND MINIMUM VALUES OF DATA FILES READ C FLAT = USE FLAT SHADING C SMOOTH = USE SMOOTH SHADING C COLOR = SELECT COLORS FOR BACKGROUND, PARTS, AND FRINGES C ROTATE = ROTATE MODEL ABOUT GLOBAL AXES C PIVOT = ROTATE MODEL ABOUT LOCAL AXES C TRANSLATE = TRANSLATE LOCAL ORIGIN OF MODEL C DISTANCE = SET DISTANCE FROM OBSERVER TO MODEL C FIELD = SPECIFY FRUSTRUM OF VISION C SCALE = SET SCALE FACTOR FOR DISPLACEMENT FUNCTIONS C WARP = SET SCALE FACTOR FOR SCALAR FUNCTIONS C MOVIE = SPECIFY ANIMATION SEQUENCE C DATA = SELECT POLYGON ORIENTATION AND POOR MAN'S HIDDEN SURFACE C DRAW = DISPLAY SCENE ON TEKTRONIX SCOPE - LINE DRAWING C VIEW = DISPLAY SCENE ON PRECISION DISPALY C READ = READ NEW DATA FILES C HELP = TYPE COMMANDS C EXIT = TERMINATE PROGRAM EXECUTION C SUBPROGRAMS CALLED C ROTAT = CALCULATE ROTATION TRANSFORMATION MATRIX C MULTDD = MULTIPLY COORDINATE BY LOCAL ROTATION C MULTDC = MULTIPLY COORDINATE BY GLOBAL ROTATION C IVSBLE = CALCULATE NUMBER VISIBLE NODES C AINTEN = CALCULATE LIGHT INTENSITY AT NODE C IPASS = DISPLAY SCENE ON DEVICE C VARIABLES USED C NPL = PARTS ARRAY C X = COORDINATE ARRAY C IP = CONNECTIVITY ARRAY C U = DISPLACEMENT ARRAY C SPEC = SCALAR FUNCTION ARRAY C XNORM = NORMALS ARRAY C NP = NUMBER OF PARTS C NJ = NUMBER OF JOINTS OR NODES C NPT = NUMBER OF ELEMENTS C ISPEC = .TRUE. FOR SCALAR FUNCTION FILE INCLUDED C = .FALSE. FOR NO SCALAR FUNCTION FILE INCLUDED C NFILE = .TRUE. TO READ NEW DATA FILES C = .FALSE. DO NOT READ NEW DATA FILES C DA = LOCAL ROTATIONS ARRAY BY PART C DC = GLOBAL TRANSFORMATION MATRIX C DD = LOCAL TRANSFORMATION MATRICES BY PART C FUNX, FUNY, FUNZ = WARPPING SCALE FACTORS (X1, X2, X3 DIRECTION) C COLOR = DATA ARRAY C NFR = FRINGE ARRAY - 1 DISPLAY FRINGES C - 0 DO NOT DISPLAY FRINGES C NPLS = DISPLAY PARTS ARRAY - 1 TO DISPLAY C - 0 NO DISPLAY C RORG = RELATIVE ORIGIN ARRAY FOR LOCAL ROTATIONS C WORDS = DATA ARRAY C ICOL= RED, BLUE, GREEN INTENSITY BY PARTS C XO = TRANSLATION ARRAY C XX = LOCAL MOTION TRANSLATION ARRAY C DIF = DIFUSED LIGHT ARRAY BY PART C TANAL = TANGENT OF PERSPECTIVE HALF ANGLE C CFRIN = RED, BLUE, GREEN, FRINGE INTENSITY BY FRINGE NUMBER C JFRING = .TRUE FOR FRINGES C = .FALSE. FOR NO FRINGES C DIRC = .TRUE. FOR CLOCKWISE ORIENTATION OF POLYGONS C = .FALSE. FOR COUNTER-CLOCKWISE ORIENTATION OF POLYGONS C NFRINGE = NUMBER OF FRINGES C CMD = COMMAND WORD C SKALE = DISPLACEMNT SCALE FACTOR C ISMOTH = -1 FOR SMOOTH SHADING C = 0 FOR FLAT SHADING C = 1 FOR UNIFORM SHADING C DOZ = DISTANCE TO ORIGIN C FIELD = ANGLE OF VIEW (FRUSTRUM OF VISION) C DELTA = LOCAL MOTION SCALE FACTOR C IC = 1 FOR COLOR C 2 FOR BLACK AND WHITE C IFR1, IFR2 = FIRST AND LAST SCENE IN SEQUENCE SENT TO DISPLAY C CPF = VIBRATIONS/FRAME C DT = TOTAL TRANSLATION IN ANIMATED SEQUENCE C DR = TOTAL ROTATION IN ANIMATED SEQENCE C DDOZ = CHANGE IN DISTANCE TO ORIGIN IN ANIMATED SEQUENCE C SFDEL = DISPLACEMENT SCALE FACTOR IN ANIMATED SEQUENCE C DDELTA = POSITION SCALE FACTOR IN ANIMATED SEQUENCE C IPM = .TRUE. DISPLAYS ALL PICTURES IN SEQUENCE C = .FALSE. MODIFIES GEOMETRY BUT DOES NOT DISPLAY C IPB = BACKGROUND COLOR C  IDVICE = DISPLAY DEVICE NUMBER C DAMP = DAMPING FACTOR FOR SMOOTH ANIMATION C IMIX = .TRUE. INCONSISTANT POLYGON VERTICE ORDERING C = .FALSE. CONSISTANT ORDERING (CLOCKWICE OR COUNTER-CLOCKWISE C NCNT = # OF VISIBLE NODES C IPOOR = .TRUE. FOR POOR MAN'S HIDDEN SURFACE REMOVAL C = .FALSE. FOR NO POOR MAN'S HIDDEN SURFACE REMOVAL DIMENSION NPL(2,1),X(3,1),IP(4,1),U(3,1),SPEC(1) DIMENSION DC(3,3),DR(3),DT(3),BFRIN(5),GFRIN(5),RFRIN(5) 1,WORDS(3,2),XO(3) C DIMENSION DA(3,NPMAX),DD(3,3,NPMAX),DIF(NPMAX),ICOL(NPMAX) C 1,NFR(NPMAX),NPLS(NPMAX),RORG(3,NPMAX),SPEC1(NJMAX) C 2,XNORM(3,.GT.NJMAX.OR.NPTMAX),XX(3,NPMAX) DIMENSION DA(3,20),DD(3,3,20),DIF(20),ICOL(20),NFR(20) 1,NPLS(20),RORG(3,20),SPEC1(250),XNORM(3,250),XX(3,20) COMMON/DEVI/ INPUT,OUTPUT,ERROR COMMON/VARB/ UFRING,DRC(3),FRING(2,20) COMMON/VCOL/ NFRING,CFRIN(3,11) C HIDDEN ROUTINE COMMON STORAGE COMMON/CLIP3/ XB,YB,ZB,BINT,KB,CB,XE,YE,ZE,EINT,KE,CE,LAS, 1 ISHARE,NTR COMMON/CONLEV/ CONHI,CONLO,NCONLV,CLEVEL(26) COMMON/INTENS/ IPH,IPL,IPB,IFX,IFY COMMON/QFORIO/ CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC COMMON/ZRANGE/ ZMIN,ZMAX LOGICAL CONTRS,SHOSHR,ISHARE,NTR,LAS,IBAD INTEGER OUTPUT,ERROR LOGICAL DIRC,IFRING,IHLR,IMIX,IPM,IPOOR,ISPEC,JFRING,LINEAR 1,NFILE,UFRING DATA BFRIN/1.,1.,0.,0.,0./ DATA GFRIN/0.,1.,1.,1.,0./ DATA RFRIN/0.,0.,0.,1.,1./ DATA IREAD/1/ DATA WORDS/'RED,B','LUE,G','REEN ', 1 'BLACK',' AND ','WHITE'/ C READ(INPUT,COMMAND STRING FOR PROCESSING 10 IBAD=.FALSE. NTR=.FALSE. 12 IF(ICODE.EQ.0) GO TO 15 IF(ICODE.EQ.63) GO TO 41 IF(ICODE.EQ.31) GO TO 71 IF(ICODE.EQ.15) GO TO 81 IF(ICODE.EQ.7) GO TO 112 IF(ICODE.EQ.3) GO TO 131 IF(ICODE.EQ.1) GO TO 271 DO 13 I=1,NP DIF(I)=0.15 13 ICOL(I)=262143 IPB=0 DO 14 I=1,5 CFRIN(1,I)=GFRIN(I) CFRIN(2,I)=BFRIN(I) 14 CFRIN(3,I)=RFRIN(I) 15 WRITE(OUTPUT,16) 16 FORMAT(' >> ',$) READ(INPUT,18) CMD 18 FORMAT(A4) C READ NEW DATA 20 IF(CMD.EQ.'READ') RETURN C RETURN CONTROL TO MONITOR IF(CMD.EQ.'EXIT') CALL EXIT C ROTATE MODEL ABOUT ORIGIN 30 IF(CMD.NE.'ROTA') GO TO 40 WRITE(OUTPUT,32) 32 FORMAT(' ',$) READ(INPUT,34) X1,X2 34 FORMAT(A1,1X,E) I1=0 IF(X1.EQ.'X') I1=1 IF(X1.EQ.'Y') I1=2 IF(X1.EQ.'Z') I1=3 IF(I1.GT.0) GO TO 38  WRITE(OUTPUT,36) X1 36 FORMAT(' <',A1,' AXIS?>') GO TO 12 38 CALL ROTAT(DC,I1,X2,1) GO TO 12 C RESTORE MODEL TO ORIGINAL COORDINATE SYSTEM C (KILL ROTATIONS AND TRANSLATIONS) 40 IF(CMD.NE.'REST') GO TO 50 41 ICODE=ICODE-32 DO 44 J=1,3 DO 42 I=1,3 42 DC(I,J)=0. XO(J)=0. 44 DC(J,J)=1.0 DO 48 K=1,NP DO 48 J=1,3 DO 46 I=1,3 46 DD(I,J,K)=0. RORG(J,K)=0. 48 DD(J,J,K)=1.0 GO TO 12 50 IF(CMD.NE.'TRAN') GO TO 60 WRITE(OUTPUT,51) 51 FORMAT(' ',$) READ(INPUT,400) (XO(I),I=1,3) GO TO 12 C SPECIFIY DISPLACEMENT SCALE FACTOR 60 IF(CMD.NE.'SCAL') GO TO 70 WRITE(OUTPUT,61) 61 FORMAT(' ',$) READ(INPUT,400) SKALE GO TO 12 C SELECT FLAT OR SMOOTH SHADING 70 IF(CMD.NE.'FLAT'.AND.CMD.NE.'SMOO'.AND.CMD.NE.'UNIF') 1 GO TO 80 71 ICODE=ICODE-16 ISMOTH=0 SHOSHR=.TRUE. IF(CMD.EQ.'SMOO') ISMOTH=-1 IF(CMD.EQ.'SMOO') SHOSHR=.FALSE. IF(CMD.EQ.'UNIF') ISMOTH=1 GO TO 12 C SET SCOPE PARAMETERS 80 IF(CMD.NE.'SCOP'.AND.CMD.NE.'DEVI') GO TO 90 81 WRITE(OUTPUT,82) 82 FORMAT(' ',$) READ(INPUT,18) DEV IDVICE=0 IF(DEV.EQ.'COMT') IDVICE=1 IF(DEV.EQ.'TEKT') IDVICE=-1 IF(DEV.EQ.'HPLT') IDVICE=-2 IF(DEV.EQ.'CPLT') IDVICE=-3 IF(IDVICE.NE.0) GO TO 84 WRITE(OUTPUT,83) 83 FORMAT(' --') GO TO 81 84 IF(CMD.EQ.'DEVI') GO TO 12 ICODE=ICODE-8 IPL=0 IPH=63 IF(IDVICE.LT.0) GO TO 86 WRITE(OUTPUT,85) 85 FORMAT(' ',$) READ(INPUT,401) ANS IC=2+(ANS.EQ.'C') 86 WRITE(OUTPUT,87) 87 FORMAT(' ',$) READ(INPUT,402) IFX,IFY IF(IFX.LT.1.OR.IFX.GT.512) IFX=512 IF(IFY.LT.1.OR.IFY.GT.IFX) IFY=IFX RES=IFX-1 GO TO 12 C SET DIFUSED LIGHT INTENSITY BY PART 90 IF(CMD.NE.'DIFU') GO TO 100 WRITE(OUTPUT,92) 92 FORMAT(' ') 94 READ(INPUT,403) I1,I2,X1 IF(I1.EQ.0) GO TO 12 DO 96 I=I1,I2 96 DIF(I)=X1 GO TO 94 C SPECIFIY DISTANCE TO COORDINATE ORIGIN 100 IF(CMD.NE.'DIST') GO TO 105 WRITE(OUTPUT,102) 102 FORMAT(' ',$) READ(INPUT,400) DOZ GO TO 12 C SPECIFY FRUSTRUM OF VISION 105 IF(CMD.NE.'FIEL') GO TO 110 WRITE(OUTPUT,108) 108 FORMAT(' ',$) READ(INPUT,400) FIELD,ZMIN,ZMAX FIELD=FIELD/2.0 TANAL=SIND(FIELD)/COSD(FIELD) GO TO 12 C SELECT CONTENT OF THIS SCENE AND SPECIFY LOCAL MOTION 110 IF(CMD.NE.'PART') GO TO 120 WRITE(OUTPUT,111) 111 FORMAT(' ',$) READ(INPUT,401) ANS IF(ANS.NE.'Y') GO TO 114 112 ICODE=ICODE-4 DO 113 I=1,NP NPLS(I)=0 113 IF(NPL(1,I).LE.NPL(2,I)) NPLS(I)=1 GO TO 12 114 DO 115 I=1,NP 115 NPLS(I)=0 WRITE(OUTPUT,116) 116 FORMAT(' ',/) 117 READ(INPUT,402) II1,II2 IF(II1.EQ.0) GO TO 12 DO 118 J=II1,II2 118 IF(NPL(1,J).LE.NPL(2,J)) NPLS(J)=1 GO TO 117 C EXPLOSION OF PARTS 120 IF(CMD.NE.'EXPL') GO TO 130 WRITE(OUTPUT,121) 121 FORMAT(' ',/) 122 READ(INPUT,403) I1,I2,X1,X2,X3 IF(I1.EQ.0) GO TO 124 DO 123 I=I1,I2 XX(1,I)=X1 XX(2,I)=X2 123 XX(3,I)=X3 GO TO 122 124 WRITE(OUTPUT,125) 125 FORMAT(' ',$) READ(INPUT,400) DELTA GO TO 12 C GIVE SUMMARY OF DATA READ WITH MIN./MAX. VALUES 130 IF(CMD.NE.'SUMM'.AND.CMD.NE.'CENT') GO TO 145 131 ICODE=ICODE-2 DO 132 II=1,NP IF(NPLS(II).NE.0) GO TO 133 132 CONTINUE GO TO 12 133 I1=NPL(1,II) I2=IP(1,I1) XL=X(1,I2)-XO(1) XS=XL YL=X(2,I2)-XO(2) YS=YL ZL=X(3,I2)-XO(3) ZS=ZL UL=U(1,I2) US=UL SL=SPEC(I2) SS=SL DO 135 I=II,NP IF(NPLS(I).EQ.0) GO TO 135 I1=NPL(1,I) I2=NPL(2,I) DO 135 J=I1,I2 DO 135 K=1,4 K1=IP(K,J) IF(K1.EQ.0) GO TO 135 X1=X(1,K1)-XO(1) Y1=X(2,K1)-XO(2) Z1=X(3,K1)-XO(3) IF(XL.LT.X1)XL=X1 IF(XS.GT.X1)XS=X1 IF(YL.LT.Y1)YL=Y1 IF(YS.GT.Y1)YS=Y1 IF(ZL.LT.Z1)ZL=Z1 IF(ZS.GT.Z1)ZS=Z1 DO 134 K2=1,3 X1=U(K2,K1) IF(UL.LT.X1)UL=X1 134 IF(US.GT.X1)US=X1 X1=SPEC(K1) IF(SL.LT.X1) SL=X1 IF(SS.GT.X1) SS=X1 135 CONTINUE WRITE(OUTPUT,136) XS,XL,YS,YL,ZS,ZL 136 FORMAT(' <',F9.4,' ') IF(US.NE.0.0.OR.UL.NE.0.0) WRITE(OUTPUT,137) US,UL 137 FORMAT(' <',1PE12.5,' ') IF(ISPEC) WRITE(OUTPUT,138) SS,SL 138 FORMAT(' <',1PE12.5,' ') IF(CMD.EQ.'SUMM') GO TO 12 XO(1)=XO(1)+(XS+XL)/2. XO(2)=XO(2)+(YS+YL)/2. XO(3)=XO(3)+(ZS+ZL)/2. XL=XL-XS IF(YL-YS.GT.XL) XL=YL-YS IF(ZL-ZS.GT.XL) XL=ZL-ZS DOZ=2.0*XL ZMIN=0.1 ZMAX=4.0*XL FIELD=45. TANAL=0.41421356 WRITE(OUTPUT,139) (XO(I),I=1,3) 139 FORMAT(' ') WRITE(OUTPUT,141) DOZ,FIELD,ZMIN,ZMAX 141 FORMAT(' ') GO TO 12 C SPECIFY OUT-OF-PLANE WARPPING SCALE FACTORS 145 IF(CMD.NE.'WARP') GO TO 150 WRITE(OUTPUT,146) 146 FORMAT(' ',$) READ(INPUT,400) FUNX,FUNY,FUNZ GO TO 12 C SELECT FRINGE OPTION AND SPECIFIY FRINGED PARTS 150 IF(CMD.NE.'FRIN') GO TO 160 WRITE(OUTPUT,151) 151 FORMAT(' <# FRINGES> ',$) READ(INPUT,402) NFRING IFRING=NFRING.GT.0 IF(.NOT.IFRING) GO TO 12 WRITE(OUTPUT,152) 152 FORMAT(' ',$) READ(INPUT,410) ANS UFRING=ANS.EQ.'Y' IF(.NOT.UFRING) GO TO 154 WRITE(OUTPUT,153) 153 FORMAT(' ',$) READ(INPUT,400) (DRC(I),I=1,3) X1=SQRT(DRC(1)*DRC(1)+DRC(2)*DRC(2)+DRC(3)*DRC(3)) DRC(1)=DRC(1)/X1 DRC(2)=DRC(2)/X1 DRC(3)=DRC(3)/X1 154 X3=NFRING-1 WRITE(OUTPUT,155) 155 FORMAT(' ') 156 READ(INPUT,403) I1,I2,X1,X2 IF(I1.LE.0) GO TO 158 DO 157 I=I1,I2 FRING(1,I)=X3/(X2-X1) 157 FRING(2,I)=X1*FRING(1,I) GO TO 156 158 WRITE(OUTPUT,159) 159 FORMAT(' ') 1501 READ(INPUT,402) I1,I2,I3 IF(I1.LE.0) GO TO 12 DO 1502 I=I1,I2 1502 NFR(I)=I3 GO TO 1501 C SPECIFY COLORS FOR VARIOUS PARTS 160 IF(CMD.NE.'COLO') GO TO 180 WRITE(OUTPUT,162) (WORDS(I,IC),I=1,3) 162 FORMAT(' ',$) READ(INPUT,400) PB1,PB2,PB3 IC1=PB3*63.0 IC2=PB2*63.0 IC3=PB1*63.0 IF(IC.EQ.1) GO TO 163 IC2=IC1 IC3=IC1 163 IPB=IC1*2**12+IC2*2**6+IC3 WRITE(OUTPUT,164) (WORDS(I,IC),I=1,3) 164 FORMAT(' ') 166 READ(INPUT,403) I1,I2,X1,X2,X3 IF(I1.EQ.0) GO TO 169 IC1=X3*63.0 IC2=X2*63.0 IC3=X1*63.0 IF(IC.EQ.1) GO TO 167 IC2=IC1 IC3=IC1 167 ICC=IC1*2**12+IC2*2**6+IC3 DO 168 K=I1,I2 168 ICOL(K)=ICC GO TO 166 169 WRITE(OUTPUT,170) 170 FORMAT(' ',$) READ(INPUT,401) ANS IF(ANS.NE.'Y') GO TO 175 WRITE(OUTPUT,171) 171 FORMAT(' ',$) READ(INPUT,401) ANS IF(ANS.NE.'Y') GO TO 173 CFRIN(1,6)=1. CFRIN(2,6)=1. CFRIN(3,6)=1. DO 172 I=1,5 I1=6-I I2=6+I CFRIN(1,I1)=GFRIN(I) CFRIN(1,I2)=GFRIN(I) CFRIN(2,I1)=BFRIN(I) CFRIN(2,I2)=BFRIN(I) CFRIN(3,I1)=RFRIN(I) 172 CFRIN(3,I2)=RFRIN(I) GO TO 12 173 DO 174 I=1,5 CFRIN(1,I)=GFRIN(I) CFRIN(2,I)=BFRIN(I) 174 CFRIN(3,I)=RFRIN(I) GO TO 12 175 WRITE(OUTPUT,176) (WORDS(I,IC),I=1,3) 176 FORMAT(' ') 177 READ(INPUT,404) I1,X1,X2,X3 IF(I1.EQ.0) GO TO 12 IF(IC.EQ.1) GO TO 178 X2=X1 X3=X1 178 CFRIN(1,I1)=X3 CFRIN(2,I1)=X2 CFRIN(3,I1)=X1 GO TO 177 C MOVIE OPTION--SELECT INCREMENTAL TRANSLATION,ROTATION,ETC. 180 IF(CMD.NE.'MOVI') GO TO 200 WRITE(OUTPUT,181) 181 FORMAT(' <# OF FRAMES> ',$) READ(INPUT,402) NFRAME IF(NFRAME.EQ.0) GO TO 12 DO 182 J=1,NP DO 182 I=1,3 182 DA(I,J)=0.0 IFR1=1 IFR2=NFRAME WRITE(OUTPUT,183) 183 FORMAT(' ',$) READ(INPUT,402) I1,I2 IF(I1.LE.0) GO TO 184 IFR1=I1 IFR2=I2 IF(IFR2.GT.IFR1) IFR2=IFR1 184 WRITE(OUTPUT,185) 185 FORMAT(' ',$) READ(INPUT,401) ANS LINEAR=ANS.EQ.'Y' CPF=0.0 IF(LINEAR) GO TO 188 IF(SKALE.EQ.0.0) GO TO 188 WRITE(OUTPUT,187) 187 FORMAT(' ',$) READ(INPUT,400) CPF 188 WRITE(OUTPUT,189) 189 FORMAT(' ') WRITE(OUTPUT,190) 190 FORMAT(' ',$) READ(INPUT,400) DT(1),DT(2),DT(3) WRITE(OUTPUT,191) 191 FORMAT(' ',$) READ(INPUT,400) DR(1),DR(2),DR(3) WRITE(OUTPUT,192) 192 FORMAT(' ') 193 READ(INPUT,403) I1,I2,X1,X2,X3 IF(I1.EQ.0) GO TO 195 DO 194 I=I1,I2 DA(1,I)=X1 DA(2,I)=X2 194 DA(3,I)=X3 GO TO 193 195 WRITE(OUTPUT,196) 196 FORMAT(' ',$) READ(INPUT,400) DDOZ WRITE(OUTPUT,197) 197 FORMAT(' ',$) READ(INPUT,400) SFDEL XFRAME=NFRAME SFDEL=SFDEL/XFRAME WRITE(OUTPUT,198) 198 FORMAT(' ',$) READ(INPUT,400) DDELTA WRITE(OUTPUT,199) 199 FORMAT(' ',$) READ(INPUT,401) ANS IPM=ANS.EQ.'Y' GO TO 12 C CALCULATE NOMALS, LIGHT INTENSITY, ETC, AND DISPLAY SCENE 200 IF(CMD.NE.'VIEW'.AND.CMD.NE.'DRAW') GO TO 270 IHLR=CMD.EQ.'VIEW' IF(IDVICE.GT.0) IHLR=.TRUE. ISHARE=IDVICE.LT.0 SLINR=0.0 XMAGN=SKALE AMPZ=1.0 XFRAME=NFRAME DO 265 IIMOVE=1,NFRAME IF(NFRAME.EQ.0) GO TO 203 C INCREMENT DISPLACEMENTS, ROTATIONS, TRANSLATIONS, ETC. FOR MOVIE XIMOVE=IIMOVE XMAGN=XMAGN+SFDEL SKALE=XMAGN IF(LINEAR) SLINR=XIMOVE/XFRAME IF(LINEAR) SKALE=XMAGN*SLINR IF(CPF.EQ.0.0) GO TO 201 ANG=360.0*CPF*XIMOVE SKALE=XMAGN*SIND(ANG) 201 AMP=180.0*XIMOVE/XFRAME AMP=COSD(AMP) DAMP=0.5*(AMPZ-AMP) AMPZ=AMP DOZ=DOZ+DDOZ*DAMP DELTA=DELTA+DDELTA*DAMP DO 202 I=1,3 ISAFE=I XO(I)=XO(I)+DT(I)*DAMP DDD=DR(I)*DAMP IF(DDD.NE.0.0) CALL ROTAT(DC,ISAFE,DDD,1) DO 202 J=1,NP JSAFE=J DDD=DA(I,J)*DAMP 202 IF(DDD.NE.0.0) CALL ROTAT(DD,ISAFE,DDD,JSAFE) IF(.NOT.IPM) GO TO 265 IF(IIMOVE.LT.IFR1.OR.IIMOVE.GT.IFR2) GO TO 265 C PROCESS PARTS INDIVIDUALY 203 CALL BGNFRM IF(IHLR) CALL INTHID IF(IBAD) GO TO 266 DO 240 I=1,NP ISAFE=I IF(NPLS(I).EQ.0) GO TO 240 I1=NPL(1,I) I2=NPL(2,I) C SET JFRING FOR FRINGES AND INCREMENT GLOBAL TRANSLATION JFRING=IFRING.AND.(NFR(I).EQ.1) XX1=XO(1)-DELTA*XX(1,I) XX2=XO(2)-DELTA*XX(2,I) XX3=XO(3)-DELTA*XX(3,I) IF(ISMOTH.GE.0.OR.IDVICE.LT.0) GO TO 220 C IF SMOOTH SHADING FIRST ZERO AND THEN CALCULATE AVERAGE NORMALS DO 204 K=1,NJ DO 204 J=1,3 204 XNORM(J,K)=0.0 DO 210 J=I1,I2 K4=3 IF(IP(4,J).GT.0) K4=4 DO 210 K=1,K4 K1=IP(K,J) IF((K+1)-K4) 205,206,207 205 K2=IP(K+1,J) K3=IP(K+2,J) GO TO 208 206 K2=IP(K4,J) K3=IP(1,J) GO TO 208 207 K2=IP(1,J) K3=IP(2,J) 208 X4=SPEC(K3)-SPEC(K2)+SLINR*(SPEC1(K3)-SPEC1(K2)) X5=SPEC(K1)-SPEC(K2)+SLINR*(SPEC1(K1)-SPEC1(K2)) X1=X(1,K3)-X(1,K2)+SKALE*(U(1,K3)-U(1,K2))+FUNX*X4 Y1=X(2,K3)-X(2,K2)+SKALE*(U(2,K3)-U(2,K2))+FUNY*X4 Z1=X(3,K3)-X(3,K2)+SKALE*(U(3,K3)-U(3,K2))+FUNZ*X4 X2=X(1,K1)-X(1,K2)+SKALE*(U(1,K1)-U(1,K2))+FUNX*X5 Y2=X(2,K1)-X(2,K2)+SKALE*(U(2,K1)-U(2,K2))+FUNY*X5 Z2=X(3,K1)-X(3,K2)+SKALE*(U(3,K1)-U(3,K2))+FUNZ*X5 CALL MULTDD(X1,Y1,Z1,DD,RORG,ISAFE) CALL MULTDC(X1,Y1,Z1,DC) CALL MULTDD(X2,Y2,Z2,DD,RORG,ISAFE) CALL MULTDC(X2,Y2,Z2,DC) U1=Y1*Z2-Y2*Z1 U2=X2*Z1-X1*Z2 U3=X1*Y2-X2*Y1 U4=SQRT(U1*U1+U2*U2+U3*U3) IF(.NOT.IMIX) GO TO 209 X1=U1*XNORM(1,K2)+U2*XNORM(2,K2)+U3*XNORM(3,K2) IF(X1.LT.0.0) U4=-U4 209 XNORM(1,K2)=XNORM(1,K2)+U1/U4 XNORM(2,K2)=XNORM(2,K2)+U2/U4 XNORM(3,K2)=XNORM(3,K2)+U3/U4 210 CONTINUE C NORMALIZE AVERAGE NORMALS DO 215 J=1,NJ X1=XNORM(1,J)*XNORM(1,J)+XNORM(2,J)*XNORM(2,J)+ 1 XNORM(3,J)*XNORM(3,J) IF(X1.LE.0.0) GO TO 215 X1=SQRT(X1) XNORM(1,J)=XNORM(1,J)/X1 XNORM(2,J)=XNORM(2,J)/X1 XNORM(3,J)=-XNORM(3,J)/X1 215 CONTINUE C CALCULATE DISPLACED COORDINATES 220 DO 230 J=I1,I2 K1=IP(1,J) K2=IP(2,J) K3=IP(3,J) K4=IP(4,J) IS1=K1 IS2=K2 IS3=K3 IS4=K4 C1=SPEC(K1)+SLINR*SPEC1(K1) U1=X(1,K1)+FUNX*C1+SKALE*U(1,K1)-XX1 V1=X(2,K1)+FUNY*C1+SKALE*U(2,K1)-XX2 W1=X(3,K1)+FUNZ*C1+SKALE*U(3,K1)-XX3 CALL MULTDD(U1,V1,W1,DD,RORG,ISAFE) CALL MULTDC(U1,V1,W1,DC) W1=DOZ-W1 C2=SPEC(K2)+SLINR*SPEC1(K2) U2=X(1,K2)+FUNX*C2+SKALE*U(1,K2)-XX1 V2=X(2,K2)+FUNY*C2+SKALE*U(2,K2)-XX2 W2=X(3,K2)+FUNZ*C2+SKALE*U(3,K2)-XX3 CALL MULTDD(U2,V2,W2,DD,RORG,ISAFE) CALL MULTDC(U2,V2,W2,DC) W2=DOZ-W2 C3=SPEC(K3)+SLINR*SPEC1(K3) U3=X(1,K3)+FUNX*C3+SKALE*U(1,K3)-XX1 V3=X(2,K3)+FUNY*C3+SKALE*U(2,K3)-XX2  W3=X(3,K3)+FUNZ*C3+SKALE*U(3,K3)-XX3 CALL MULTDD(U3,V3,W3,DD,RORG,ISAFE) CALL MULTDC(U3,V3,W3,DC) W3=DOZ-W3 IF(K4.NE.0) GO TO 221 U4=0.5*(U1+U3) V4=0.5*(V1+V3) W4=0.5*(W1+W3) GO TO 222 221 C4=SPEC(K4)+SLINR*SPEC1(K4) U4=X(1,K4)+FUNX*C4+SKALE*U(1,K4)-XX1 V4=X(2,K4)+FUNY*C4+SKALE*U(2,K4)-XX2 W4=X(3,K4)+FUNZ*C4+SKALE*U(3,K4)-XX3 CALL MULTDD(U4,V4,W4,DD,RORG,ISAFE) CALL MULTDC(U4,V4,W4,DC) W4=DOZ-W4 C CALCULATE NUMBER OF VISIBLE NODES 222 NCNT=IVSBLE(U1,V1,W1,U2,V2,W2,U3,V3,W3,U4,V4,W4,DIRC) IF(IPOOR.AND.NCNT.EQ.0) GO TO 230 C DRAW SIMPLE LINE DRAWING NOW IF(IHLR) GO TO 224 CALL DRAW(U1,V1,W1,U2,V2,W2,RES,TANAL) CALL DRAW(U2,V2,W2,U3,V3,W3,RES,TANAL) IF(K4.EQ.0) GO TO 223 CALL DRAW(U3,V3,W3,U4,V4,W4,RES,TANAL) CALL DRAW(U4,V4,W4,U1,V1,W1,RES,TANAL) GO TO 230 223 CALL DRAW(U3,V3,W3,U1,V1,W1,RES,TANAL) GO TO 230 C CALCULATE NORMALS FOR FLAT SHADING 224 IF(ISMOTH.LT.0) GO TO 225 CX=(V3-V1)*(W2-W4)-(V4-V2)*(W1-W3) CY=(U4-U2)*(W1-W3)-(U3-U1)*(W2-W4) CZ=(U4-U2)*(V3-V1)-(U3-U1)*(V4-V2) CD=SQRT(CX*CX+CY*CY+CZ*CZ) XNORM(1,K1)=CX/CD XNORM(2,K1)=CY/CD XNORM(3,K1)=CZ/CD K2=K1 K3=K1 K4=K1 C CALCULATE NODAL LIGHT INTENSITY C THEN CHECK FOR WATKIN'S WARPED POLYGON 225 AI1=AINTEN(U1,V1,W1,XNORM(1,K1),DIF(I)) AI2=AINTEN(U2,V2,W2,XNORM(1,K2),DIF(I)) AI3=AINTEN(U3,V3,W3,XNORM(1,K3),DIF(I)) IF(IS4.NE.0) AI4=AINTEN(U4,V4,W4,XNORM(1,K4),DIF(I)) IF(ISMOTH.LE.0) GO TO 2201 AI1=(AI1+AI2+AI3+AI4)/4.0 IF(IS4.EQ.0) AI1=(AI1+AI2+AI3)/3.0 AI2=AI1 AI3=AI1 AI4=AI1 2201 IF(IS4.EQ.0) GO TO 226 IF(NCNT.EQ.0.OR.NCNT.EQ.4) GO TO 226 CALL POLMAK IF(IBAD) GO TO 266 LAS=.FALSE. XB=U3 YB=V3 ZB=W3*TANAL IF(CONTRS) CB=C3 KB=ICOL(I) IF(JFRING) KB=ISHADE(U(1,IS3),C3,ISAFE) BINT=AI3 ZSTR=ZB  KSTR=KB XE=U4 YE=V4 ZB=W4*TANAL IF(CONTRS) CE=C4 KE=ICOL(I) IF(JFRING) KE=ISHADE(U(1,IS4),C4,ISAFE) EINT=AI4 CALL EDGMAK IF(IBAD) GO TO 266 XB=XE YB=YE ZB=ZE IF(CONTRS) CB=CE KB=KE BINT=EINT XE=U1 YE=V1 ZE=W1*TANAL IF(CONTRS) CE=C1 KE=ICOL(I) IF(JFRING) KE=ISHADE(U(1,IS1),C1,ISAFE) EINT=AI1 CALL EDGMAK IF(IBAD) GO TO 266 XB=XE YB=YE ZB=ZE  IF(CONTRS) CB=CE KB=KE BINT=EINT XE=U3 YE=V3 ZE=ZSTR IF(CONTRS) CE=C3 KB=KSTR EINT=AI3 LAS=.TRUE. CALL EDGMAK IF(IBAD) GO TO 266 226 CALL POLMAK IF(IBAD) GO TO 266 LAS=.FALSE. XB=U1 YB=V1 ZB=W1*TANAL IF(CONTRS) CB=C1 KB=ICOL(I) IF(JFRING) KB=ISHADE(U(1,IS1),C1,ISAFE) BINT=AI1 ZSTR=ZB KSTR=KB XE=U2 YE=V2 ZE=W2*TANAL IF(CONTRS) CE=C2 KE=ICOL(I) IF(JFRING) KE=ISHADE(U(1,IS2),C2,ISAFE) EINT=AI2 CALL EDGMAK IF(IBAD) GO TO 266 XB=XE YB=YE ZB=ZE IF(CONTRS) CB=CE KB=KE BINT=EINT XE=U3 YE=V3 ZE=W3*TANAL IF(CONTRS) CE=C3 KE=ICOL(I) IF(JFRING) KE=ISHADE(U(1,IS3),C3,ISAFE) EINT=AI3 CALL EDGMAK IF(IBAD) GO TO 266 IF(IS4.EQ.0) GO TO 229 IF(NCNT.GT.0.AND.NCNT.LT.4) GO TO 229 XB=XE YB=YE ZB=ZE IF(CONTRS) CB=CE KB=KE BINT=EINT XE=U4 YE=V4 ZE=W4*TANAL IF(CONTRS) CE=C4 KE=ICOL(I) IF(JFRING) KE=ISHADE(U(1,IS4),C4,ISAFE) EINT=AI4 CALL EDGMAK IF(IBAD) GO TO 266 229 XB=XE YB=YE ZB=ZE IF(CONTRS) CB=CE KB=KE BINT=EINT XE=U1 YE=V1 ZE=ZSTR IF(CONTRS) CE=C1 KE=KSTR EINT=AI1 LAS=.TRUE. CALL EDGMAK IF(IBAD) GO TO 266 230 CONTINUE 240 CONTINUE IF(IHLR) CALL HIDDEN  IF(IBAD) GO TO 266 CALL ENDFRM IF(IIMOVE.GT.1) GO TO 260 IF(IDVICE.GT.0) GO TO 250 IF(IDVICE.EQ.-1) WRITE(OUTPUT,242) 242 FORMAT(' ') IF(IDVICE.EQ.-2) WRITE(OUTPUT,244) 244 FORMAT(' ') IF(IDVICE.EQ.-3) WRITE(OUTPUT,246) 246 FORMAT(' ') GO TO 255 250 IF(IC.EQ.1) WRITE(OUTPUT,252) 252 FORMAT(' ') IF(IC.EQ.2) WRITE(OUTPUT,254) 254 FORMAT(' ') 255 IF(IFRING.AND.IHLR) WRITE(OUTPUT,256) 256 FORMAT(' ') IF(CONTRS.AND.IHLR) WRITE(OUTPUT,258) 258 FORMAT(' ') IF(NFRAME.LT.1) GO TO 265 260 IF(IDVICE.NE.-1) GO TO 263 WRITE(OUTPUT,261) IIMOVE,NFRAME,SKALE 261 FORMAT(' <',I3,'/',I3,F8.3,'>',$) READ(INPUT,401) ANS GO TO 265 263 WRITE(OUTPUT,264) IIMOVE,NFRAME,SKALE 264 FORMAT(' <',I3,'/',I3,F8.3,'>') 265 CONTINUE NFRAME=0 SKALE=XMAGN LINEAR=.FALSE. GO TO 12 266 CALL ENDFRM  WRITE(OUTPUT,268) 268 FORMAT(' ') NFRAME=0 SKALE=XMAGN LINEAR=.FALSE. GO TO 10 C SET DATA OPTIONS AND POOR MAN'S HIDDEN SURFACE REMOVAL 270 IF(CMD.NE.'FAST') GO TO 290 271 ICODE=ICODE-1 IPOOR=.FALSE. WRITE(OUTPUT,272) 272 FORMAT(' ',$) READ(INPUT,401) ANS IMIX=ANS.EQ.'Y' IF(IMIX) GO TO 12 WRITE(OUTPUT,274) 274 FORMAT(' ',$) READ(INPUT,401) ANS IPOOR=ANS.EQ.'Y' IF(.NOT.IPOOR) GO TO 12 WRITE(OUTPUT,276) 276 FORMAT(' ',$) READ(INPUT,401) ANS DIRC=ANS.EQ.'Y' GO TO 12 C SET LOCAL ROTATION ABOUT RELATIVE ORIGIN 290 IF(CMD.NE.'PIVO') GO TO 310 WRITE(OUTPUT,291) 291 FORMAT(' ') 292 READ(INPUT,293) I1,I2,X1,X2 293 FORMAT(2I,1X,A1,E) IF(I1.EQ.0) GO TO 296 IF(X1.EQ.'X') I3=1 IF(X1.EQ.'Y') I3=2 IF(X1.EQ.'Z') I3=3 DO 295 I=I1,I2 ISAFE=I 295 CALL ROTAT(DD,I3,X2,ISAFE) GO TO 292 296 WRITE(OUTPUT,297) 297 FORMAT(' ') 298 READ(INPUT,403) I1,I2,X1,X2,X3 IF(I1.EQ.0) GO TO 12 DO 299 I=I1,I2 RORG(1,I)=X1 RORG(2,I)=X2 299 RORG(3,I)=X3 GO TO 298 C COMMANDS 310 IF(CMD.NE.'HELP') GO TO 320 311 WRITE(OUTPUT,312) 312 FORMAT(' '/' '/' ',/) GO TO 12 314 WRITE(OUTPUT,316) CMD 316 FORMAT(' <',A4,'? HELP?> ',$) READ(INPUT,401) ANS IF(ANS.EQ.'Y') GO TO 311 GO TO 12 C ADD PREVIOUS DISPLACEMENTS AND SCALAR FUNCTIONS TO ARRAYS, C READ NEW ARRAYS, AND DIFFERENCE FOR TRANSIENT DATA 320 IF(CMD.NE.'LINE') GO TO 360 WRITE(OUTPUT,322) 322 FORMAT(' ',$) READ(INPUT,401) ANS IF(ANS.NE.'Y') GO TO 326 DO 324 J=1,NJ DO 323 I=1,3 X(I,J)=X(I,J)+SKALE*U(I,J) 323 U(I,J)=0. SPEC(J)=SPEC(J)+SPEC1(J) 324 SPEC1(J)=0. 326 CALL OPEN('DISP1',IUNIT,IREAD,IERROR) IF(IERROR) 326,330,328 328 READ(IUNIT,410) ((U(I,J),I=1,3),J=1,NJ) 330 CALL OPEN('DISP2',IUNIT,IREAD,IERROR) IF(IERROR) 330,340,332 332 READ(IUNIT,410) ((XNORM(I,J),I=1,3),J=1,NJ) 340 CALL OPEN('SPEC.',IUNIT,IREAD,IERROR) IF(IERROR) 340,344,342 342 READ(IUNIT,410) (SPEC1(J),J=1,NJ) 344 CALL OPEN('SPEC1',IUNIT,IREAD,IERROR) IF(IERROR) 344,350,346 346 READ(IUNIT,410) (SPEC(J),J=1,NJ) 350 DO 354 J=1,NJ DO 352 I=1,3 352 U(I,J)=XNORM(I,J)-U(I,J) 354 SPEC1(J)=SPEC(J)-SPEC1(J) GO TO 12 C SELECT CONTOUR OPTION AND SET CONTOUR LEVELS 360 IF(CMD.NE.'CONT') GO TO 314 WRITE(OUTPUT,361) 361 FORMAT(' <# OF CONTOURS, LABEL SPACING> ',$) READ(INPUT,403) NCONLV,LBLSPC CONTRS=NCONLV.GT.0 IF(.NOT.CONTRS) GO TO 12 IF(NCONLV.GT.26) NCONLV=26 WRITE(OUTPUT,363) 363 FORMAT(' ',$) READ(INPUT,400) CONLO,CONHI DELCON=(CONHI-CONLO)/(NCONLV-1) CLEVEL(1)=CONLO DO 365 I=2,NCONLV 365 CLEVEL(I)=CLEVEL(I-1)+DELCON GO TO 12 400 FORMAT(3E) 401 FORMAT(A1) 402 FORMAT(16I) 403 FORMAT(2I,3E) 404 FORMAT(I,3E) 410 FORMAT(6E) END SUBROUTINE MULTDD(X,Y,Z,DD,T,K) C SUBROUTINE MULTDD - MULTIPLYS COORDINATES BY LOCAL ROTATION C TRANSFORMATION MATRIX. C VARIABLES USED C X, Y, Z = CARTESIAN COORDINATES OF POINT C DD = TRANSFORMATION MATRIX C T = RELATIVE ORIGIN BY PART C I = PART NUMBER DIMENSION DD(3,3,1),T(3,1) X1=X-T(1,K) X2=Y-T(2,K) X3=Z-T(3,K) X=DD(1,1,K)*X1+DD(2,1,K)*X2+DD(3,1,K)*X3+T(1,K) Y=DD(1,2,K)*X1+DD(2,2,K)*X2+DD(3,2,K)*X3+T(2,K) Z=DD(1,3,K)*X1+DD(2,3,K)*X2+DD(3,3,K)*X3+T(3,K) RETURN END FUNCTION AINTEN(U,V,W,XNORM,DIF) C FUNCTION AINTEN - CALCULATES LIGHT INTENSITY AT A NODE. C LIGHT INTENSITY IS COMPUTED AS THE SEQUARE OF THE ANGLE C BETWEEN THE OBSERVER AND THE NORMAL DIRECTION AT A NODE. C VARIABLES USED C U, V, W, = CARTESIAN COORDINATES OF POINT C XNORM = NORMAL COMPONENTS AT NODE C DIF = DIFUSED LIGHT DIMENSION XNORM(3) AI=U*XNORM(1)+V*XNORM(2)+W*XNORM(3) AI=AI*AI/(U*U+V*V+W*W) AINTEN=(DIF+(1.0-DIF)*AI) RETURN END FUNCTION IVSBLE(U1,V1,W1,U2,V2,W2,U3,V3,W3,U4,V4,W4,DIRC) C FUNCTION IVSBLE - COMPUTES NUMBER OF VISIBLE NODES. C A NODE IS VISIBLE IF THE COSINE OF THE ANGLE BETWEEN C THE OBSERVER AND THE NORMAL AT THE NODE IS POSITIVE. C VARIABLES USED C IVSBLE = NUMBER OF VISIBLE NODES C U1, V1, W1, ETC. = CARTESTIAN COORDINATES OF NODES C DIRC = -1 FOR CLOCKWISE ORIENTATION OF NODES C = 0 FOR COUNTER-CLOCKWISE ORIENTATION OF NODES IVSBLE=0 X1=U1/W1 Y1=V1/W1 X2=U2/W2 Y2=V2/W2 X3=U3/W3 Y3=V3/W3 X4=U4/W4 Y4=V4/W4 XT=X1 YT=Y1 X5=X2-X4 X1=X1-X2 X2=X2-X3 X3=X3-X4 X4=X4-XT Y5=Y2-Y4 Y1=Y1-Y2 Y2=Y2-Y3 Y3=Y3-Y4 Y4=Y4-YT A1=X1*Y2-X2*Y1 A2=X2*Y3-X3*Y2 A3=X5*Y4-X4*Y5 A4=X4*Y1-X1*Y4 IF(A1.GE.0.0) IVSBLE=IVSBLE+1 IF(A2.GE.0.0) IVSBLE=IVSBLE+1 IF(A3.GE.0.0) IVSBLE=IVSBLE+1 IF(A4.GE.0.0) IVSBLE=IVSBLE+1 IF(DIRC) IVSBLE=4-IVSBLE RETURN END SUBROUTINE MULTDC(U1,V1,W1,DC) C SUBROUTINE MULTDC - MULTYPLS COORDINATES BY GLOBAL ROTATION C  TRANSFORMATION MATRIX. C VARIABLES USED C U1, V1, W1 = CARTESTIAN COORDINATES OF POINT C DC = GLOBAL TRANSFORMATION MATRIX DIMENSION DC(3,3) X1=U1 X2=V1 U1=DC(1,1)*X1+DC(2,1)*X2+DC(3,1)*W1 V1=DC(1,2)*X1+DC(2,2)*X2+DC(3,2)*W1 W1=DC(1,3)*X1+DC(2,3)*X2+DC(3,3)*W1 RETURN END FUNCTION ISHADE(U,S,J) C FUNCTION SHADE - COMPUTES COLOR INTENSITY AT NODES FOR FRINGES C VARIABLES USED C SHADE = FRINGE LIGHT INTENSITY C K = NODE NUMBER C S = SCALAR FUNCTION ARRAY C F = FRINGE COLOR INTENSITY ARRAY BY FRINGE NUMBER C IMODE = 1 FOR RED, 2 FOR BLUE, 3 FOR GREEN C NFRING = # OF FRINGES C FRING3 = FRINGE NORALIZATION FACTOR C FRING4 = LOWEST NORMALIZED FRINGE VALUE DIMENSION U(3) COMMON/VARB/ UFRING,DR(3),FRING(2,1) COMMON/VCOL/ NFRING,F(3,1) LOGICAL UFRING X=S IF(UFRING) X=U(1)*DR(1)+U(2)*DR(2)+U(3)*DR(3) X=FRING(1,J)*X-FRING(2,J) IF(X.LT.0.0) GO TO 3 N=NFRING-1  DO 2 I=1,N IF(X.GT.1.0) GO TO 2 X1=1.0-X I1=I+1 IC1=(F(1,I1)*X+F(1,I)*X1)*63.0 IC2=(F(2,I1)*X+F(2,I)*X1)*63.0 IC3=(F(3,I1)*X+F(3,I)*X1)*63.0 GO TO 4 2 X=X-1.0 IC1=F(1,NFRING)*63.0 IC2=F(2,NFRING)*63.0 IC3=F(3,NFRING)*63.0 GO TO 4 3 IC1=F(1,1)*63.0 IC2=F(2,1)*63.0 IC3=F(3,1)*63.0 4 ISHADE=IC1*2**12+IC2*2**6+IC3 RETURN END SUBROUTINE DRAW(X1,Y1,Z1,X2,Y2,Z2,RES,PER) R=0.5*RES D=R/(Z1*PER) U1=R+X1*D V1=R+Y1*D D=R/(Z2*PER) U2=R+X2*D V2=R+Y2*D C CLIP LEFT EDGE IF(U1.GE.0..AND.U2.GE.0.) GO TO 10 IF(U1.LT.0..AND.U2.LT.0.) RETURN IF(U1.GT.0.) GO TO 1 V1=(V1-V2)*U1/(U2-U1)+V1 U1=0. GO TO 10 1 V2=(V2-V1)*U2/(U1-U2)+V2 U2=0. C CLIP RIGHT EDGE 10 IF(U1.LE.RES.AND.U2.LE.RES) GO TO 20 IF(U1.GT.RES.AND.U2.GT.RES) RETURN IF(U1.GT.RES) GO TO 11 V2=(V2-V1)*(RES-U1)/(U2-U1)+V1 U2=RES  GO TO 20 11 V1=(V1-V2)*(RES-U2)/(U1-U2)+V2 U1=RES C CLIP BOTTOM EDGE 20 IF(V1.GE.0..AND.V2.GE.0.) GO TO 30 IF(V1.LT.0..AND.V2.LT.0.) RETURN IF(V1.GT.0.) GO TO 21 U1=(U1-U2)*V1/(V2-V1)+U1 V1=0. GO TO 30 21 U2=(U2-U1)*V2/(V1-V2)+U2 V2=0. C CLIP TOP EDGE 30 IF(V1.LE.RES.AND.V2.LE.RES) GO TO 40 IF(V1.GT.RES.AND.V2.GT.RES) RETURN IF(V1.GT.RES) GO TO 31 U2=(U2-U1)*(RES-V1)/(V2-V1)+U1 V2=RES GO TO 40 31 U1=(U1-U2)*(RES-V2)/(V1-V2)+U2 V1=RES 40 CALL PLTLIN(U1,V1,U2,V2) RETURN END SUBROUTINE INTHID C INTHID INITIALIZES THE HIDDEN PROCESS C AND ALLOCATES THE AMOUNT OF DATA STORAGE C THE VALUE OF MAXFRE MUST EQUAL THE SIZE OF IFREE C THE VALUE OF MAXRES MUST EQUAL THE SIZE OF IB C THE VALUE OF MAXINT IS THE MAXIMUM INTENSITY COMMON/MAXMUM/MAXFRE,MAXRES,MAXINT COMMON/CORE/IFREST,LEN,IFREPT COMMON/BUCKY/IB(512) COMMON/FREE/IFREE(4000) MAXFRE=4000 MAXRES=512 MAXINT=63 C INITIALIZE FREE STORAGE LEN = MAXFRE IFREST=1 C INITIALIZE THE POLYGON CLIPPER CALL INTCLP RETURN END C**********************************************************************C C C C HIDDEN.FOR VERSION 1.0(A) SEPTEMBER 1976 C C C C THIS FILE CONTAINS THE HIDDEN LINE AND HIDDEN SURFACE C C PROCESSOR USING WATKIN'S ALGORITHM. MIKE ARCHULETA C C CODED THE ALGORITHM WHILE A STUDENT AT THE UNIVERSITY OF C C OF UTAH AND LATER REFINED IT AT LAWRENCE LIVERMORE LAB. C C C C MIKE STEPHENSON HANK CHRISTIANSEN C C DEPARTMENT OF CIVIL ENGR. CIVIL ENGINEERING DEPT. C C AND ENGINEERING MECHANICS 368E ESTB C C THE UNIVERSITY OF ARIZONA BRIGHAM YOUNG UNIVERSITY C C TUCSON, ARIZONA 85721 PROVO, UTAH 84602 C C (602) 884-4803 (801) 374-1211 X2811 C C C C**********************************************************************C SUBROUTINE GETVAR(INDEX,LENGTH) C GET A BLOCK FROM FREE STORAGE OF SIZE LENGTH AT LOCATION INDEX COMMON/CORE/IFREST,LEN,IFREPT C COMMON/FREE/IFREE(1) COMMON/QFORIO/CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC LOGICAL IBAD IBAD=.FALSE. INDEX=IFREST C UP THE NEXT AVAILABLE LOCATION IN FREE. IFREST=IFREST+LENGTH C GO HOME IF THERE IS STILL ROOM LEFT. IF(IFREST.LT.LEN)RETURN CALL ERRMSG(6,0) RETURN END SUBROUTINE LSTSET(N) C SET THE SIZE OF THE BLOCK TO BE HANDLED BY GETBLK AND RETBLK COMMON/CORE/IFREST,LEN,IFREPT COMMON/FREE/IFREE(1) IFREPT=0 K=LEN-N+1 C RETURN IF NO ROOM LEFT FOR SEGMENT BLOCKS IF(K.LT.IFREST)RETURN IFREPT=IFREST C SET POINTERS THROUGH THE REMAINDER OF THE FREE LIST C LINKING THE SEGMENT BLOCKS TOGETHER. DO 1 I=IFREST,K,N M=I IFREE(I)=0 1 IFREE(I+1)=I+N C SET THE LAST POINTER TO ZERO INDICATING END OF SEGMENTS. IFREE(M+1)=0 RETURN END SUBROUTINE GETBLK(INDEX) C GET A BLOCK FROM THE FREE STORAGE LIST COMMON/CORE/IFREST,LEN,IFREPT COMMON/FREE/IFREE(1) COMMON/QFORIO/CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC LOGICAL IBAD IBAD=.FALSE. IF(IFREPT.EQ.0)GO TO 1 C RETURN THE POINTER TO NEXT AVAILABLE SEGMENT BLOCK INDEX=IFREPT IFREPT=IFREE(IFREPT+1) RETURN 1 CALL ERRMSG(6,0) RETURN END SUBROUTINE RETBLK(INDEX) C RETURN A BLOCK TO THE FREE STORAGE LIST COMMON/CORE/IFREST,LEN,IFREPT COMMON/FREE/IFREE(1) IFREE(INDEX)=0 IFREE(INDEX+1)=IFREPT IFREPT=INDEX RETURN END SUBROUTINE INTCLP C THIS ROUTINE INITIALIZES SOME SIMPLE PARAMETERS THAT C ARE USED BY THE ALGORITHM. IT SHOULD BE CALLED ONCE AT C THE BEGINNING OF EACH PICTURE TAKING SESSION. COMMON/PGNCNT/IPOLY COMMON/BUCKY/IBUCKY(1) COMMON/EYES/XR,YR,IXRES,IYRES,DELINT,DELCON,IFLRCO,ICLGCO COMMON/INTENS/ITENHI,ITENLO,IBACKG,IFX1,IFY1 COMMON/CONLEV/CONHI,CONLOW,NCONLV,CLEVEL(1) COMMON/QFORIO/CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC COMMON/MAXMUM/MAXFRE,MAXRES,MAXINT  COMMON/ZRANGE/ZMIN,ZMAX COMMON/ZFIXER/ZLOW,ZHI,ZSPRED,CURZEE COMMON/CORE/IFREST,LEN,IFREPT LOGICAL IBAD,CURZEE IBAD=.FALSE. CURZEE=.FALSE. IFREST=1 C JUMP TO 2 IF BAD RESOLUTION AND TO 3 IF BAD INTENSITY IF(IFX1.GT.MAXRES.OR.IFX1.LT.2) GO TO 2 IF(IFY1.GT.MAXRES.OR.IFY1.LT.2) GO TO 2 IF(ITENHI.GT.MAXINT.OR.ITENHI.LT.0) GO TO 3 IF(ITENLO.GT.MAXINT.OR.ITENLO.LT.0) GO TO 3 C THE INTENSITY IS ALSO BAD IF ITENHI IS LESS THAN ITENLO IF(ITENHI.LT.ITENLO) GO TO 3 C MAKE SURE THAT ZMIN AND ZMAX ARE GOOD GUYS ZLOW=ZMIN IF(ZLOW.LT.0) ZLOW=0. IF(ZMAX.LT.ZLOW) GO TO 4 ZHI=ZMAX ZSPRED=32767./(ZMAX-ZLOW) C CLEAR OUT THE BUCKET SORTING ARRAYS IPOLY=0 DO 1 I=1,IFY1 1 IBUCKY(I)=0 IXRES=IFX1-1 IYRES=IFY1 XR=IXRES/2. YR=(IFY1-1)/2. DELINT=ITENHI-ITENLO C DONT LET THE RANGE OF CONTOUR LEVELS EQUAL 0 IF(NCONLV.LE.0) NCONLV=1 DELCON=(CLEVEL(NCONLV)-CLEVEL(1))/31. IF(DELCON.EQ.0.0) DELCON=1. C FIND THE INDICES OF THE FLOOR AND CEILING FOR CONTOUR PLOTTING IFLRCO=1 DO 5 I=1,NCONLV J=I IF(CONLOW.GE.CLEVEL(I)) IFLRCO=I IF(CONHI.LE.CLEVEL(I)) GO TO 6 5 CONTINUE 6 ICLGCO=J RETURN C BAD RESOLUTION 2 CALL ERRMSG(7,0) RETURN C BAD INTENSITY 3 CALL ERRMSG(8,0) RETURN 4 CALL ERRMSG(11,0) RETURN END SUBROUTINE POLMAK C POLMAK SHOULD BE CALLED ONCE AT THE BEGINNING OF EACH C POLYGON IN THE PICTURE. COMMON/PGNCNT/IPOLY COMMON/COMNIO/ICNT,IDUM(121) IPOLY=IPOLY+1 IF(IPOLY.EQ.8192) CALL ERRMSG(2,0) ICNT=0 RETURN END SUBROUTINE EDGMAK C EDGMAK CAPTURES THE EDGES AND PUTS THEM INTO A STACK C FOR LATER PROCESSING BY POLSNP (WHICH DOES THE ACTUAL C CLIPPING). DATA COES IN THRU CLIP3 AND IS STORED IN COMNIO. COMMON/PGNCNT/IPOLY COMMON/CLIP3/X1,Y1,Z1,S1,K1,C1,X2,Y2,Z2,S2,K2,C2,LASEDG,ISHARE,NTR COMMON/QFORIO/CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC COMMON/COMNIO/ICNT,NT,VX(10),VY(10),VZ(10),VN(10),IC(10),VC(10) C 1 ,VTX(10),VTY(10),VTZ(10),VTN(10),VTC(10),ITC(10) LOGICAL LASEDG,IBAD,ISHARE IF(IBAD) GO TO 2 NT=NTR C JUMP IF EDGE STACK WILL OVERFLOW IF(ICNT.GE. 9) GO TO 1 C SET 18TH BIT IF EDGE IS SHARED AND SET 19TH BIT FOR EDGE IS C VISIBLE FLAG I=524288 IF(ISHARE) I=786432 C PUT BEGIN POINT INTO EDGE STACK ICNT=ICNT+1 VX(ICNT)=X1 VY(ICNT)=Y1 VZ(ICNT)=Z1 VN(ICNT)=S1 IC(ICNT)=I+MOD(K1,262144) VC(ICNT)=C1 C PUT END POINT INTO EDGE STACK ICNT=ICNT+1 VX(ICNT)=X2 VY(ICNT)=Y2 VZ(ICNT)=Z2 VN(ICNT)=S2 IC(ICNT)=I+MOD(K2,262144) VC(ICNT)=C2 C FLUSH THE EDGE STACK IF THIS WAS THE LAST EDGE IF(LASEDG) CALL POLSNP RETURN 1 CALL ERRMSG(12,IPOLY) RETURN 2 CALL ERRMSG(9,0) RETURN END SUBROUTINE POLSNP C THIS SUBROUTINE DOES THE POLYGON CLIPPING. IT FIRST CLIPS C ALL THE EDGES OF THE POLYGON TO A PLANE AND THEN SHIPS THAT C SET OF LINES TO THE NEXT PLANE TO BE CLIPPED. LINES WHICH C ARE OUTSIDE OF THE PLANE BEING CLIPPED TO ARE NOT PASSED THRU C THE PIPE SINCE THEY DO NOT HAVE AN EFFECT ON HOW TO CLOSE THE POLYGON C UP. THIS ROUTINE CLIPS TO SIX PLANES, PERFORMS THE PERSPECTIVE C TRANSFORMATION, AND PASSES THE DATA TO PACKER OR HORZED. COMMON/COMNIO/ICNT,NT,VX(10),VY(10),VZ(10),VN(10),IC(10),VC(10) C 1 ,VTX(10),VTY(10),VTZ(10),VTN(10),VTC(10),ITC(10) COMMON/EDGARG/IY,IX1,IX2,IZ1,IZ2,IS1,IS2,IPG,IDY,KOL1 ,ISHR, &IC1,IC2,KOL2 COMMON/EYES/XR,YR,IXRES,IYRES,DELINT,DELCON,IFLRCO,ICLGCO COMMON/CONLEV/CONHI,CONLOW,NCONLV,CLEVEL(1) COMMON/PGNCNT/IPOLY COMMON/QFORIO/CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC COMMON/SNPDAT/T1,T2,IDS COMMON/ZFIXER/ZMIN,ZMAX,ZSPRED,CURZEE LOGICAL IBAD,ISHR,CURZEE,NT IF(IBAD) GO TO 11 C JUMP IF CURRENT POLYGON IS THE ZMIN CLIPPED IF(CURZEE) GO TO 30 C CLIP TO THE PLANE Z=ZMIN J=ICNT DO 1 I=1,J,2 IDS=I T1=VZ(I)-ZMIN T2=VZ(I+1)-ZMIN 1 CALL CLIP C GO AND SEE IF THE CLIPPED EDGES ARE TO BE SAVED CALL FACMAK(J) C CLIP TO THE PLANE Z=ZMAX J=ICNT DO 2 I=1,J,2 IDS=I T1=ZMAX-VZ(I) T2=ZMAX-VZ(I+1) 2 CALL CLIP C CLIP TO THE PLANE Y=Z 30 J=ICNT DO 3 I=1,J,2 IDS=I T1=VZ(I)-VY(I) T2=VZ(I+1)-VY(I+1) 3 CALL CLIP C CLIP TO THE PLANE Y=-Z J=ICNT DO 4 I=1,J,2 IDS=I T1=VZ(I)+VY(I) T2=VZ(I+1)+VY(I+1) 4 CALL CLIP C CLIP TO THE PLANE X=Z J=ICNT DO 5 I=1,J,2 IDS=I T1=VZ(I)-VX(I) T2=VZ(I+1)-VX(I+1) 5 CALL CLIP C CLIP TO THE PLANE X=-Z J=ICNT DO 6 I=1,J,2 IDS=I T1=VZ(I)+VX(I) T2=VZ(I+1)+VX(I+1) 6 CALL CLIP C THE CLIPPING IS NOW COMPLETE. GO THROUGH THE LIST C OF EDGES AND SEE WHICH ARE OUTSIDE THE FRUSTUM OF VISION. IF(IBAD) GO TO 12 C GO HOME IF THAT WAS AN INTERNAL POLYGON IF(NT) GO TO 12 DO 10 I=1,ICNT,2 C JUMP IF EDGE IS OUTSIDE IF(IC(I).LT.524288) GO TO 10 K=I+1 L=I C ORDER THE END POINTS SO THAT I+1 HAS THE GREATEST Y VALUE VY(K)=VY(K)*YR/VZ(K)+YR VY(L)=VY(L)*YR/VZ(L)+YR IF(VY(L).LT.VY(K)) GO TO 7 K=I L=I+1 C GET DELTA Y 7 IDY=INT(VY(K)+.1)-INT(VY(L)+.1) IY=VY(K)+1.1 C GET THE PERSPECTIVE X AND GIVE IT 10 BITS IX1=VX(K)*XR/VZ(K)+XR+.1 IX2=VX(L)*XR/VZ(L)+XR+.1 IPG=IPOLY ISHR=MOD(IC(I),524288).GE.262144 C GET THE Z VALUES AND GIVE THEM 15 BITS IZ1=(VZ(K)-ZMIN)*ZSPRED+.1 IZ2=(VZ(L)-ZMIN)*ZSPRED+.1 C GET THE INTENSITY AND GIVE IT 6 BITS IS2=VN(L)*63. IS1=VN(K)*63. C************ COLOR************* KOL1=MOD(IC(K),262144) KOL2=MOD(IC(L),262144) C RESET THE INTENSITY IF IT IS OUTSIDE THE RANGE IF(IS1.GT.63) IS1=63  IF(IS2.GT.63) IS2=63 IF(IS1.LT.0) IS1=0 IF(IS2.LT.0) IS2=0 C GET THE CONTOUR VALUES AND GIVE THEM 5 BITS IC1=(VC(K)-CLEVEL(1))/DELCON IC2=(VC(L)-CLEVEL(1))/DELCON C RESET THE CONTOURS IF THEY ARE OUTSIDE THE RANGE IF(IC1.LE.0) IC1=0 IF(IC2.LE.0) IC2=0 IF(IC1.GT.31) IC1=31 IF(IC2.GT.31) IC2=31 C IF THIS IS A HORIZONTAL LINE, THEN SWAP END POINTS SO X1 IS MIN IF(IDY.NE.0) GO TO 9  IZ1=0 IZ2=0 IF(IX1.LT.IX2) GO TO 9 K=IX1 IX1=IX2 IX2=K C GO STORE THE DATA 9 CALL PACKER 10 CONTINUE RETURN 11 CALL ERRMSG(9,0) 12 RETURN END SUBROUTINE CLIP C THIS ROUTINE CLIPS THE EDGE TO A PLANE. THE EQUATION OF THE C PLANE IS IMPLICITLY DEFINED WITHIN T1 AND T2. IF THE EDGE IS C CLIPPED, THEN IT IS ADDED TO THE STACK OF EDGES. COMMON/COMNIO/ICNT,NT,VX(10),VY(10),VZ(10),VN(10),IC(10),VC(10) C 1 ,VTX(10),VTY(10),VTZ(10),VTN(10),VTC(10),ITC(10) COMMON/SNPDAT/T1,T2,I COMMON/QFORIO/CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC COMMON/PGNCNT/IPOLY C COMMON/CLIP2/KOLAVG LOGICAL IBAD C JUMP IF LINE IS OUTSIDE FRUSTRUM OF VISION IF(IC(I).LT.524288) GO TO 30 IF(IBAD) GO TO 30 C JUMP IF LINE DOES NOT INTERSECT PLANE IF(T1) 10,11,12 10 IF(T2) 50,13,13 11 IF(T2) 13,30,30 12 IF(T2) 13,30,30 C THE LINE IS TO BE CLIPPED 13 ALPHA=T1/(T1-T2) C DETERMINE WHICH INDEX WILL RECEIVE THE CLIPPED POINT I1=I+1 IF(T1.LT.0.0) I1=I C CLIP VX(I1)=ALPHA*(VX(I+1)-VX(I))+VX(I) VY(I1)=ALPHA*(VY(I+1)-VY(I))+VY(I) VZ(I1)=ALPHA*(VZ(I+1)-VZ(I))+VZ(I) VN(I1)=ALPHA*(VN(I+1)-VN(I))+VN(I) IF(IC(I).NE.IC(I+1)) GO TO 100 IC(I1)=IC(I) GO TO 101 100 C1=FLOAT(MOD(IC(I)/4096,64)) C2=FLOAT(MOD(IC(I+1)/4096,64)) KOLAVG=MOD(INT(ALPHA*(C2-C1)+C1+.5),64)*4096 C1=FLOAT(MOD(IC(I)/64,64))  C2=FLOAT(MOD(IC(I+1)/64,64)) KOLAVG=KOLAVG+MOD(INT(ALPHA*(C2-C1)+C1+.5),64)*64 C1=FLOAT(MOD(IC(I),64)) C2=FLOAT(MOD(IC(I+1),64)) KOLAVG=KOLAVG+MOD(INT(ALPHA*(C2-C1)+C1+.5),64) IC(I1)=KOLAVG+(IC(I)/524288)*524288 101 CONTINUE VC(I1)=ALPHA*(VC(I+1)-VC(I))+VC(I) C JUMP IF EDGE STACK IS FULL IF (ICNT.GE.10) GO TO 40 ICNT=ICNT+1 VX(ICNT)=VX(I1) VY(ICNT)=VY(I1) VZ(ICNT)=VZ(I1) VN(ICNT)=VN(I1) IC(ICNT)=MOD(IC(I1),262144)+524288 VC(ICNT)=VC(I1) 30 RETURN 40 CALL ERRMSG(12,IPOLY) C SET LINE TO OUTSIDE OF FRUSTUM 50 IC(I)=0 IC(I+1)=0 RETURN END SUBROUTINE FACMAK(ISTRT) C 15NOV73 M. ARCHULETA LLL X3361 C THIS ROUTINE STORES EDGES WHICH WERE CLIPPED AT THE Z=ZMIN C PLANE FOR FUTURE CAP POLYGON GENERATION. C IF ISTRT IS NEGATIVE, THERE WILL BE NO CAP POLYGONS C IF ISTRT IS ZERO, THERE WILL BE CAP POLYGONS C IF ISTRT IS POSITIVE, STORE THE EDGE INDEXED BY ISTRT AS C A POTENTIAL CAP POLYGON EDGE. COMMON/COMNIO/ICNT,NT,VX(10),VY(10),VZ(10),VN(10),IC(10),VC(10) & ,VTX(10),VTY(10),VTZ(10),VTN(10),VTC(10),ITC(10) COMMON/CLIP2/KOLAVG COMMON/ZFIXER/ZLOW,ZHI,ZSPRED,CURZEE LOGICAL CURZEE,KEEPIT,NT IF(ISTRT) 10,20,30 C NO POLYGON GENERATION 10 KEEPIT=.FALSE. RETURN C THERE WILL BE POLYGON GENERATION 20 KEEPIT=.TRUE. IBGIN=0 RETURN C RETURN IF NO POLYGON GENERATION 30 IF(.NOT.KEEPIT) RETURN C JUMP IF WE ARE GOING TO FLUSH THE STACK IF(ISTRT.EQ.1) GO TO 40 J=ICNT-ISTRT C JUMP IF CLIPPED STACK IS EMPTY IF(J.EQ.0) RETURN C ADD TO CLIPPED STACK FROM EDGE STACK NTT=64 IF(NT) NTT=96 DO 31 I=1,J VTX(I+IBGIN)=VX(I+ISTRT) VTY(I+IBGIN)=VY(I+ISTRT) VTZ(I+IBGIN)=VZ(I+ISTRT) VTN(I+IBGIN)=VN(I+ISTRT) VTC(I+IBGIN)=VC(I+ISTRT) ITC(I+IBGIN)=NTT 31 CONTINUE IBGIN=J+IBGIN RETURN C JUMP IF THERE ARE LESS THAN 3 CLIPPED EDGES 40 IF(IBGIN.LT.6) RETURN C THIS LOOP TAKES THE Z CLIPPED EDGES A PUTS THEM INTO THE EDGE STACK DO 41 I=1,IBGIN VX(I)=VTX(I) VY(I)=VTY(I) VZ(I)=VTZ(I) VN(I)=VTN(I) VC(I)=VTC(I) IC(I)=ITC(I)+KOLAVG 41 CONTINUE C CALL THE POLYGON INITIALIZER AND THEN THE POLYGON CLIPPER NT=.FALSE. CALL POLMAK ICNT=IBGIN CURZEE=.TRUE. CALL POLSNP CURZEE=.FALSE. RETURN END SUBROUTINE HIDDEN C THIS IS THE HIDDEN SURFACE ALGORITHM ORIGINALLY C DEVELOPED BY GARY WATKINS OF THE UNIVERSITY OF UTAH. THIS C ROUTINE ASSUMES THAT ALL OF THE SURFACES TO BE PROCESSED C HAVE BEEN PASSED THROUGH POLMAK AND EDGMAK. THE ALGORITHM C SCANS THROUGH A BUCKET TO SEE IF ANY EDGES BECOME ACTIVE C ON A SCAN LINE. IF THEY DO, THEY ARE STORED INTO WORKING C SEGMENTS. THESE SEGMENTS ARE THEN SORTED IN X AND THEN C IN Z TO DETERMINE WHICH SEGMENT IS VISIBLE ON THE CURRENT C SCAN LINE. WHEN A SCAN LINE HAS BEEN PROCESSED, ALL SEGMENTS C ARE UPDATED TO THE NEXT SCAN LINE AND THE PROCESS RESTARTS. COMMON/BUCKY/IBUCKY(1) COMMON/FREE/ISEG(1) COMMON/EYES/IQ(2),IFX,IFY COMMON/SHOWER/IES,IVBL,COLOR,XLEFT,XRIGHT,SHRL,SHRR,SAML,SAMR, & RXVALU,RRANGE,LSTERR,IY,ICON,SHBL,SHBR,SHGL,SHGR COMMON/EDGBLK/IPT,ICOL1,IDELY,X1,X2,Z1,Z2,S1,S2,IEDGPT,C1,C2 &,SHARED,IGTHRZ,ICOL2 COMMON/COMNIO/LINES COMMON/SEGPTR/ISEGST,ISEGS2,ISEGL2,NOGREY COMMON/YSCLIN/OLDLFT,IYMOD,YLAST,NOHRZ1,NOHRZ2 DIMENSION RSEG(1),ZS(5),SAM(4) EQUIVALENCE (ISEG,RSEG),(ZS,IZS) LOGICAL IES,LSTERR,ISPLIT,IFROM,IXTEND,ABLLE &,ABRLT,J0BOX,JBOXES,ABBCKL,ABBCKR,J1BOX,JINTER COMMON/QFORIO/CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC LOGICAL IBAD,INTSCT,LINDRW,SHADED,CONTRS,NOHRZ1,NOHRZ2 C INITIALIZATION IF(IBAD) GO TO 360 NOGREY=13 NOHRZ1=.TRUE. LENGTH=11 LINDRW=.TRUE. SHADED=.FALSE. STEP=.00001 C JUMP IF LINE DRAWING IF(IDVICE.LE.0) GO TO 202 NOGREY=NOGREY+12 LENGTH=LENGTH+12 SHADED=.TRUE. LINDRW=.FALSE. LINES=0 STEP=1. GO TO 203 202 LENGTH=LENGTH+4 203 IF(CONTRS) NOGREY=NOGREY+4 IF(CONTRS) LENGTH=LENGTH+4 I=0 IBAD=.FALSE. JBAD=0 JCNT=0 IY=IFY C GET THE RIGHT AMOUNT OF WORDS FOR A SEGMENT BLOCK CALL LSTSET(LENGTH+4) ISEGST=0 204 IEDGPT=IBUCKY(IY) IGTHRZ=1 210 IF(IEDGPT.EQ.0)GO TO 228 CALL UNPACK IF(IDELY.EQ.0) GO TO 210 C GET POINTER TO FIRST OF SEG LIST ISEGPT=ISEGST IPREV=0 ISPLIT=.FALSE. C GET A FREE SEGMENT BLOCK AND CALL GETBLK(I) IF(IBAD) RETURN C STORE EDGE DATA IN SEG BLOCK LEFT C SEG(I)=PREVIOUS SEGMENT POINTER C SEG(I+1)=NEXT SEGMENT POINTER C SEG(I+2)=POLYGON POINTER C SEG(I+3)=NEXT SEGMENT WITH THIS POLYGON POINTER C I+5 THROUGH I+16 ARE FOR THE LEFT EDGE OF SEGMENT C I+6 THROUGH I+18 ARE FOR THE RIGHT EDGE OF SEGMENT C SEG(I+5)=NUMBER OF SCAN LINES THARE EDGE ARE ACTIVE C SEG(I+7)=X SEG(I+8)=XSLOPE SEG(I+11)=Z SEG(I+12)=ZSLOPE C SEG(I+15)=INTENSITY SEG(I+16)=INTENSITY SLOPE C SEG(I+4)=RESERVED FOR LINE DRAWING INFORMATION C JUMP ACCORDING TO THE TYPE OF PICTURE TO BE DISPLAYED C JUMP IF LINE DRAWING IF(LINDRW) GO TO 213 SR1=FLOAT(MOD(ICOL1,64))*S1/63. SB1=FLOAT(MOD(ICOL1/64,64))*S1/63. SG1=FLOAT(MOD(ICOL1/4096,64))*S1/63. SR2=FLOAT(MOD(ICOL2,64))*S2/63. SB2=FLOAT(MOD(ICOL2/64,64))*S2/63. SG2=FLOAT(MOD(ICOL2/4096,64))*S2/63. 213 CONTINUE ISEG(I+2)=IPT ISEG(I+3)=0 ISEG(I+4)=0 ISEG(I+5)=-IDELY ISEG(I+6)=0 RSEG(I+9)=0 RSEG(I+8)=(X1-X2)/ISEG(I+5) RSEG(I+7)=X1+RSEG(I+8)*.5 RSEG(I+12)=(Z1-Z2)/ISEG(I+5) RSEG(I+11)=Z1+RSEG(I+12)*.5 IJ=I+11 IF(.NOT.SHADED) GO TO 214 IJ=IJ+4 A = FLOAT(ISEG(I+5))*63. RSEG(IJ+1) = (SR1-SR2)/A RSEG(IJ+5) = (SB1-SB2)/A RSEG(IJ+9) = (SG1-SG2)/A RSEG(IJ ) = (SR1/63.)+RSEG(IJ+1)*.5 RSEG(IJ+4) = (SB1/63.)+RSEG(IJ+5)*.5 RSEG(IJ+8) = (SG1/63.)+RSEG(IJ+9)*.5 IJ = IJ + 8 214 IF(.NOT.CONTRS) GO TO 215 IJ=IJ+4 RSEG(IJ+1)=(C1-C2)/(ISEG(I+5)) RSEG(IJ)=(C1)+RSEG(IJ+1)*.5 215 IF(.NOT.LINDRW) GO TO 216 IJ=IJ+4 RSEG(IJ)=-2. IF(.NOT.SHOSHR) RSEG(IJ)=SHARED RSEG(IJ+1)=0. C GO SEARCH X SORT LIST TO SEE WHERE NEW EDGE WILL GO 216 IF(ISEGPT.EQ.0) GO TO 226 TE1=RSEG(I+7)-RSEG(ISEGPT+7) TE2=RSEG(I+7)-RSEG(ISEGPT+9) C JUMP IF POLYGON DOES NOT MATCH IF(IPT.NE.ISEG(ISEGPT+2)) GO TO 220 C JUMP IF LEFT EDGE EXPIRED IF(ISEG(ISEGPT+5).GE.0) GO TO 221 C JUMP IF NEW ESEGMENT TO THE LEFT OF OLD SEGMENT IF(TE1.LT.0.0) GO TO 226 C SEE IF EXISTING SEGMENT MUST BE SPLIT FOR NEW EDGE IF(ISEG(ISEGPT+6).GE.0) GO TO 219 IF(TE2.GE.0.0) GO TO 219 IF(ISPLIT) GO TO 219 ISPLIT=.TRUE. C LOAD RIGHT EDGE OF SEGMENT INTO NEW BLOCK DO 218 J=9,LENGTH+2,4 RSEG(I+J)=RSEG(ISEGPT+J) RSEG(I+J+1)=RSEG(ISEGPT+J+1) 218 CONTINUE ISEG(I+4)=((ISEG(I+4)/2)*2)+MOD(ISEG(ISEGPT+4),2) ISEG(I+6)=ISEG(ISEGPT+6) ISEG(ISEGPT+6)=0 219 IPREV=ISEGPT C GET POINTER TO NEXT SEGMENT BLOCK ISEGPT=ISEG(ISEGPT+1) GO TO 216 C JUMP IF LEFT EDGE EXPIRED 220 IF(ISEG(ISEGPT+5).GE.0) GO TO 221 IF(TE1) 226,219,219 C JUMP IF RIGHT EDGE EXPIRED 221 IF(ISEG(ISEGPT+6).GE.0) GO TO 219 IF(TE2) 226,219,219 226 ISEG(I+1)=ISEGPT ISEG(I)=0 C INSERT THIS NEW SEGMENT BLOCK BETWEEN EXISTING SEGMENTS IF(IPREV.EQ.0) GO TO 227  ISEG(IPREV)=0 ISEG(IPREV+1)=I GO TO 210 C THIS SEGMENT IS THE FIRST IN THE X SORTED LIST 227 ISEGST=I GO TO 210 C DECREMENT SCAN LINE COUNT 228 YLAST=IY IY=IY-1 NOHRZ2=NOHRZ1 NOHRZ1=IGTHRZ.EQ.1 IYMOD=MOD(IY,2) OLDLFT=0.0 ISEGS2=0 ISEGL2=0 SAM(2)=0.0 ISEGAC=0 INTSCT=.FALSE. C GET NEXT LEFT SAMPLE POINT 229 SAM(1)=SAM(2)+STEP IZS=0 IFROM=.FALSE. ISEGPT=ISEGAC ISEGAC=0 LSTERR=.FALSE. IXTEND=.TRUE. C JUMP IF NO MORE SEGMENTS FOR THIS SCAN LINE 230 IF(ISEGPT.EQ.0) GO TO 231 NEXT=ISEG(ISEGPT+3) XLEFT=RSEG(ISEGPT+7)-RSEG(ISEGPT+8) XRIGHT=RSEG(ISEGPT+9)-RSEG(ISEGPT+10) ZLEFT=RSEG(ISEGPT+11)-RSEG(ISEGPT+12) ZRIGHT=RSEG(ISEGPT+13)-RSEG(ISEGPT+14) GO TO 315 231 ISEGPT=ISEGST IF(ISEGPT.EQ.0) GO TO 350 C JUMP IF SEGMENT BLOCK STILL HAS EDGE(S) IF(ISEG(ISEGPT+5).NE.0.OR.ISEG(ISEGPT+6).NE.0) GO TO 234 C RETURN TO FREE LIST IF BLOCK IS EMPTY ISEGST=ISEG(ISEGPT+1) CALL RETBLK(ISEGPT) GO TO 231 234 IF(ISEG(ISEGPT+5).LT.0) GO TO 236 C MOVE RIGHT EDGE OF SEGMENT TO LEFT EDGE DO 235 J=7,LENGTH,4 RSEG(ISEGPT+J)=RSEG(ISEGPT+J+2) RSEG(ISEGPT+J+1)=RSEG(ISEGPT+J+3) 235 CONTINUE ISEG(ISEGPT+4)=MOD(ISEG(ISEGPT+4),2)*2 ISEG(ISEGPT+5)=ISEG(ISEGPT+6) ISEG(ISEGPT+6)=0 C JUMP IF RIGHT EDGE HAS NOT EXPIRED 236 IF(ISEG(ISEGPT+6).LT.0) GO TO 305 IPT=ISEG(ISEGPT+2) C GET NEXT SEGMENT NEXT=ISEG(ISEGPT+1) C JUMP IF END OF SEGMENT LIST 237 IF(NEXT.EQ.0) GO TO 242 C JUMP IF POLYGONS DO NOT MATCH IF(ISEG(NEXT+2).NE.IPT) GO TO 241 C JUMP IF LEFT EDGE EXPIRED IF(ISEG(NEXT+5).GE.0) GO TO 239 C MOVE LEFT EDGE OF SEGMENT TO RIGHT EDGE DO 238 J=7,LENGTH,4 RSEG(ISEGPT+J+2)=RSEG(NEXT+J) RSEG(ISEGPT+J+3)=RSEG(NEXT+J+1) 238 CONTINUE ISEG(ISEGPT+4)=ISEG(NEXT+4)/2 ISEG(ISEGPT+6)=ISEG(NEXT+5) ISEG(NEXT+5)=0 GO TO 305 C JUMP IF RIGHT EDGE EXPIRED 239 IF(ISEG(NEXT+6).GE.0) GO TO 241 C MOVE RIGHT EDGE OF NEXT TO RIGHT EDGE OF CURRENT DO 240 J=9,LENGTH+2,4 RSEG(ISEGPT+J)=RSEG(NEXT+J) RSEG(ISEGPT+J+1)=RSEG(NEXT+J+1) 240 CONTINUE ISEG(ISEGPT+4)=(ISEG(ISEGPT+4)/2)*2+MOD(ISEG(NEXT+4),2) ISEG(ISEGPT+6)=ISEG(NEXT+6) ISEG(NEXT+5)=0 ISEG(NEXT+6)=0 GO TO 305 C GET THE NEXT SEGMENT 241 NEXT=ISEG(NEXT+1) GO TO 237 C AN UNCLOSED POLYGON EXISTS SO MAKE RIGHT EDGE SAME AS LEFT EDGE 242 DO 243 J=7,LENGTH,4 RSEG(ISEGPT+J+2)=RSEG(ISEGPT+J) RSEG(ISEGPT+J+3)=RSEG(ISEGPT+J+1) 243 CONTINUE ISEG(ISEGPT+6)=-1 C TRY TO WRITE THE UNCLOSED POLYGON NUMBER ONLY C ONCE FOR EACH POLYGON IF(JBAD.EQ.ISEG(ISEGPT+2)) GO TO 305 JBAD=ISEG(ISEGPT+2) JCNT=JCNT+1 C DONT TYPE MORE THAN 10 MESSAGES IF(JCNT.GT.10) GO TO 305 CALL ERRMSG(5,JBAD) 305 XLEFT=RSEG(ISEGPT+7) XRIGHT=RSEG(ISEGPT+9) C JUMP IF NO VISIBLE SEGMENT TO PROCESS IF((.NOT.IXTEND.OR.IZS.NE.0).AND.XLEFT.GE.SAM(2)) GO TO 350 IFROM=.TRUE. ISEGST=ISEG(ISEGPT+1) ZLEFT=RSEG(ISEGPT+11) ZRIGHT=RSEG(ISEGPT+13) C UPDATE SEGMENT TO NEXT SCAN LINE DO 306 J=7,NOGREY,2 RSEG(ISEGPT+J)=RSEG(ISEGPT+J)+RSEG(ISEGPT+J+1) 306 CONTINUE ISEG(ISEGPT+5)=ISEG(ISEGPT+5)+1 ISEG(ISEGPT+6)=ISEG(ISEGPT+6)+1 C JUMP IF SEGMENT BLOCK STILL HAS EDGE(S) IF(ISEG(ISEGPT+5).NE.0) GO TO 307 IF(ISEG(ISEGPT+6).NE.0) GO TO 307 C DONT RETURN THE BLOCK IF IN LINE DRAWING MODE IF(IDVICE.LE.0) GO TO 307 C SEGMENT EXITED SO RETURN BLOCK TO FREE CALL RETBLK(ISEGPT) GO TO 315 C BACK POINTERS NEEDED ON NEW LIST 307 X1=RSEG(ISEGPT+7) C X1=RIGHT X VALUE IF LEFT EDGE EXPIRED IF(ISEG(ISEGPT+5).GE.0) X1=RSEG(ISEGPT+9) IS2=0 IS1=ISEGL2 C JUMP IF NO MORE SEGMENTS ON THE BACK TRACE 308 IF(IS1.EQ.0) GO TO 309 X2=RSEG(IS1+7) C X2=RIGHT X VALUE IF LEFT EDGE EXPIRED IF(ISEG(IS1+5).GE.0) X2=RSEG(IS1+9) C JUMP IF CURRENT X IS TO RIGHT OF PREVIOUS SEGMENT IF(X1.GE.X2) GO TO 309 IS2=IS1 IS1=ISEG(IS1) GO TO 308 C SET THE BACK AND FORWARD POINTERS 309 IF(IS2.NE.0) ISEG(ISEGPT+1)=IS2 ISEG(ISEGPT)=IS1 IF(IS2.NE.0) ISEG(IS2)=ISEGPT IF(IS2.EQ.0) ISEGL2=ISEGPT IF(IS1.NE.0) ISEG(IS1+1)=ISEGPT IF(IS1.EQ.0) ISEGS2=ISEGPT 315 IF(SAM(1).GE.XRIGHT) GO TO 345 ABLLE=SAM(1).GE.XLEFT ABRLT=XRIGHT.LT.SAM(2) INTSCT=.FALSE. C GET XLEFT CLIP POINT XLCLIP=SAM(1) IF(.NOT.ABLLE) XLCLIP=XLEFT C GET XRIGHT CLIP POINT XRCLIP=SAM(2) IF(ABRLT) XRCLIP=XRIGHT J0BOX=.FALSE. JBOXES=.TRUE. C JUMP IF NO VISIBLE SEGMENT TO PROCESS IF((IZS .EQ.0).AND..NOT.ABLLE) GO TO 335 JBOXES=.FALSE. IF((IZS.EQ.0).AND.ABLLE) GO TO 331 C GET Z VALUES FOR NEW AND OLD LINES AT CLIP POINTS C JUMP SO ZERO DIVIDE WONT HAPPEN 323 IF(XLEFT.EQ.XRIGHT) GO TO 324 ZAL=((XLCLIP-XRIGHT)*(ZLEFT-ZRIGHT))/(XLEFT-XRIGHT)+ZRIGHT ZAR=((XRCLIP-XRIGHT)*(ZLEFT-ZRIGHT))/(XLEFT-XRIGHT)+ZRIGHT GO TO 325 324 ZAL=ZRIGHT ZAR=ZRIGHT C JUMP SO ZERO DIVIDE WONT HAPPEN 325 IF(ZS(2).EQ.ZS(3)) GO TO 326 ZCL=((XLCLIP-ZS(3))*(ZS(4)-ZS(5)))/(ZS(2)-ZS(3))+ZS(5) ZCR=((XRCLIP-ZS(3))*(ZS(4)-ZS(5)))/(ZS(2)-ZS(3))+ZS(5) GO TO 327 326 ZCL=ZS(5) ZCR=ZS(5) 327 ABBCKL=ZCL.LE.ZAL ABBCKR=ZCR.LE.ZAR J0BOX=ABBCKL.AND.ABBCKR C JUMP IF AB BACK ON LEFT AND RIGHT IF(J0BOX) GO TO 335 J1BOX=ABLLE.AND..NOT.ABBCKL.AND..NOT.ABBCKR C JUMP IF AB NOT BACK ON LEFT AND RIGHT IF(J1BOX) GO TO 331 JINTER=(ABBCKL.AND..NOT.ABBCKR).OR.(.NOT.ABBCKL.AND.ABBCKR.AND. &ABLLE) C JUMP IF THE TWO SURFACES INTERSECTED IF(JINTER) GO TO 328 JBOXES=.TRUE. C JBOXES=.NOT.ABLLE.AND..NOT.ABBCKL BY DEFAULT GO TO 335 C GET THE INTERSECTION POINT 328 SAM(2)=(XLCLIP*(ZAR-ZCR)-XRCLIP*(ZAL-ZCL))/(ZCL-ZAL-ZCR+ZAR) C RESET SAM(2) IF ARITHMETIC WAS A LITTLE OFF IF(SAM(2).LT.XLCLIP) SAM(2)=XLCLIP IF(SAM(2).GT.XRCLIP) SAM(2)=XRCLIP SAM(3)=SAM(2)*.25 SAM(4)=0 IXTEND=.FALSE. INTSCT=.TRUE. C JUMP IF LINE AB IS BACK ON THE RIGHT IF(ABBCKR) GO TO 332 GO TO 335 331 IF(IFROM.AND.(RRANGE.NE.RSEG(ISEGPT+8))) LSTERR=.TRUE. IF(IZS.NE.0.AND.ABRLT) IXTEND=.FALSE. IF(.NOT.ABRLT.AND..NOT.IXTEND) GO TO 332 SAM(2)=XRIGHT SAM(3)=XRIGHT*.25 SAM(4)=RSEG(ISEGPT+10) C SET PREVIOUS TEST SEGMENT TO CURRENT SEGMENT 332 IZS=ISEGPT ZS(2)=XLEFT  ZS(3)=XRIGHT ZS(4)=ZLEFT ZS(5)=ZRIGHT 335 IF(J0BOX.AND..NOT.(XRIGHT.LE.SAM(2))) IXTEND=.FALSE. IF(J0BOX.AND.(XRIGHT.LE.SAM(2))) GO TO 345 C LINK SEGMENT WHICH BELONGS TO COMMON POLYGON ISEG(ISEGPT+3)=ISEGAC ISEGAC=ISEGPT IF(.NOT.JBOXES) GO TO 345 IXTEND=.FALSE. C UPDATE NEXT SAMPLE POINT SAM(2)=XLEFT SAM(3)=XLEFT*.25 SAM(4)=RSEG(ISEGPT+8) 345 ISEGPT=NEXT IF(IFROM) GO TO 231 GO TO 230 C OUTPUT SEGMENTS 350 IF(IXTEND) ISEGAC=0 IES=(ISEGPT.EQ.0).AND.IXTEND C JUMP IF BACKGROUND SEGMENT IF(IZS.EQ.0) GO TO 355 C JUMP IF THERE WAS NOT AN INTERSECTION IF(.NOT.INTSCT) GO TO 351 IF(IDVICE.GT.0) GO TO 351 C THIS IS WHERE A POINT WOULD BE PLOTTED TO C SHOW WHERE AN INTERSECTION IS. THE COORDINATE IS (SAM(2),IY). 351 CONTINUE XLEFT=(RSEG(IZS+7)-RSEG(IZS+8)) XRIGHT=(RSEG(IZS+9)-RSEG(IZS+10)) IJ=IZS+11 IF(.NOT.SHADED) GO TO 352 IJ=IJ+4 SHRL = RSEG(IJ )-RSEG(IJ+1) SHBL = RSEG(IJ+4)-RSEG(IJ+5) SHGL = RSEG(IJ+8)-RSEG(IJ+9) SHRR = RSEG(IJ+2)-RSEG(IJ+3) SHBR = RSEG(IJ+6)-RSEG(IJ+7) SHGR = RSEG(IJ+10)-RSEG(IJ+11) IJ = IJ + 8 352 IF(.NOT.CONTRS) GO TO 355 IJ=IJ+4 ICON=IJ 355 SAML=SAM(1)-STEP SAMR=SAM(2) IVBL=IZS RXVALU=SAM(3) RRANGE=SAM(4) C JUMP TO CONSHO IF CONTOUR OUTPUT IF(CONTRS) CALL CONSHO C JUMP TO LINSHO IF LINE DRAWING OUTPUT IF(LINDRW) CALL LINSHO C JUMP TO SHOW IF SHADED OUTPUT  IF(SHADED) CALL SHOW IF(.NOT.IES) GO TO 229 C BACK POINTER NOT NEEDED NOW IF(ISEGL2.EQ.0) GO TO 356 ISEG(ISEGL2)=0 ISEG(ISEGL2+1)=0 356 ISEGST=ISEGS2 C JUMP IF STILL MORE SCAN LINES TO PROCESS IF(IY.GE.1) GO TO 204 IBAD=JBAD.OR.IBAD RETURN 360 CALL ERRMSG(9,0) RETURN END SUBROUTINE DRAWIT(X1,Y1,I) C DRAWIT SENDS THE LINE TO BE DISPLAYED TO THE APPROPRIATE C DRAWING SUBROUTINE. IT ALSO CLEARS OUT THE LINE STARTING C POSITION. COMMON/QFORIO/CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC COMMON/FREE/RSEG(1) COMMON/INTENS/ITENHI,ITENLO,IBACKG,IFX,IFY C JUMP IF THIS EDGE HAS ALREADY BEEN DRAWN IF(RSEG(I-1).LE.-1.) GO TO 3 A=X1 B=Y1 C=RSEG(I-1) D=RSEG(I) C JUMP TO 1 IF NEW LINE DOES NOT MATCH OLD LINE IF(A.NE.OX1) GO TO 1 IF(B.NE.OY1) GO TO 1 IF(C.NE.OX2) GO TO 1 IF(D.EQ.OY2) GO TO 2 C STORE THE NEW END POINT 1 OX1=A OY1=B OX2=C OY2=D CALL PLTLIN(A,B,C,D)  2 RSEG(I-1)=-3. RSEG(I)=0 3 RETURN END SUBROUTINE LINSHO C 04APR74 C LINSHO UPDATES THE INFORMATION WITHIN EACH OF THE C SEGMENT BLOCKS AS TO HOW MANY SCAN LINES EITHER THE LEFT OR C RIGHT EDGE OF THE SEGEMNT HAS BEEN VISIBLE. IF THE C EDGE IS EXITING ON THE NEXT SCAN LINE, THEN IT IS DRAWN. IF THE C EDGE WAS VISIBLE ON THE PREVIOUS SCAN LINE BUT NOT THIS SCAN LINE, C THEN IT IS DRAWN. THIS ROUTINE WILL CALL SUBROUTINE C DRAWIT WITH THE INFORMATION NECESSARY TO MAKE A LINE SEGMENT. COMMON/FREE/ISEG(1) COMMON/EDGBLK/IPT,ICOL,IYY,X1,X2,Z1,Z2,S1,S2,NEXT,C1,C2 &,SHARED,IGTHRZ,ICOL2 COMMON/QFORIO/CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC COMMON/SHOWER/IES,I,COLOR,XLEFT,XRIGHT,SHRL,SHRR,SAML,SAMR &,RXVALU,RRANGE,LSTERR,IY,ICON,SHBL,SHBR,SHGL,SHGR COMMON/INTENS/ITENHI,ITENLO,IBACKG,IFX,IFY COMMON/BUCKY/IBUCKY(1) COMMON/SEGPTR/ISEGST,ISEGS2,ISEGL2,NOGREY COMMON/YSCLIN/OLDLFT,IYMOD,YLAST,NOHRZ1,NOHRZ2 LOGICAL IES,SHOSHR,IBAD,LSTERR,LFTVIS,RGTVIS,MAYHRZ,LOAD &,NOHRZ1,NOHRZ2 DIMENSION RSEG(1) EQUIVALENCE (ISEG,RSEG) C JUMP IF THIS A BACKGROUND SEGMENT IF(I.EQ.0) GO TO 14 IJ=I+NOGREY+2 C CHECK TO SEE WHAT THE STATUS OF THE EDGE IS IF THIS C IS THE FIRST TIME THE EDGE IS VISIBLE. IF(ILAST.NE.I) MAYHRZ=.FALSE. LFTVIS=ABS(XLEFT-SAML).LT..001 RGTVIS=ABS(XRIGHT-SAMR).LT..001 I1=ISEG(I+4)/2 C JUMP IF LEFT EDGE NOT VISIBLE IF(.NOT.LFTVIS) GO TO 2 I1=IYMOD C JUMP IF LEFT EDGE NOT VISIBLE FOR FIRST TIME IF(RSEG(IJ).GE.-1.0) GO TO 1 MAYHRZ=.TRUE. RSEG(IJ)=SAML-RSEG(I+8)*(RSEG(IJ)+3.)*.5 RSEG(IJ+1)=YLAST C DRAW THE LEFT EDGE IF IT EXITS 1 IF(ISEG(I+5).NE.0) GO TO 2 MAYHRZ=.TRUE. CALL DRAWIT(SAML+RSEG(I+8)*.5,YLAST,IJ+1) C JUMP IF RIGHT SIDE NOT VISIBLE 2 IF(.NOT.RGTVIS) GO TO 4 I2=IYMOD C JUMP IF RIGHT EDGE NOT VISIBLE FOR FIRST TIME IF(RSEG(IJ+2).GE.-1.0) GO TO 3 MAYHRZ=.TRUE. RSEG(IJ+2)=SAMR-RSEG(I+10)*(RSEG(IJ+2)+3.)*.5 RSEG(IJ+3)=YLAST C DRAW THE RIGHT EDGE IF IT EXITS 3 IF(ISEG(I+6).NE.0) GO TO 4 MAYHRZ=.TRUE. CALL DRAWIT(SAMR+RSEG(I+10)*.5,YLAST,IJ+3) C SET THE THIS LINE IS VISIBLE FLAGS 4 ISEG(I+4)=I1*2+I2 OLDLFT=SAMR C NOW START THE PROCESSING OF THE HORIZONTAL EDGES IGTHRZ=-1 LOAD=.FALSE. C JUMP IF THIS POLYGON PROBABLY DOESNT HAVE HORIZONTAL EDGES IF(SHOSHR.AND..NOT.MAYHRZ) GO TO 14 C JUMP IF THERE WERE NO HORIZONTAL EDGES FOUND FOR THIS SCAN LINE IF(NOHRZ1) GO TO 12 NEXT=IBUCKY(IY+1) YA=YLAST C JUMP IF NO HORIZONTAL EDGES 10 IF(NEXT.LE.0) GO TO 12 CALL UNPACK IF(IYY.NE.0) GO TO 10 IF((SHARED.EQ.-1.).AND..NOT.SHOSHR) GO TO 10 IF(IPT.NE.ISEG(I+2)) GO TO 10 C GET THE FLOATING FLOOR OF SAML IF(FLOAT(INT(SAML)).GE.X2) GO TO 10 C GET THE FLOATING FLOOR OF SAMR IF(FLOAT(INT(SAMR)).LE.X1) GO TO 10 C GET THE TRUE HORIZONTAL SPAN IF(SAML.GT.X1) X1=SAML IF(SAMR.LT.X2) X2=SAMR CALL PLTLIN(X1,YA,X2,YA) LOAD=.TRUE. GO TO 10 C JUMP IF THERE WERE NO HORIZONTAL EDGES LAST SCAN LINE 12 IF(NOHRZ2) GO TO 14 C JUMP IF WEVE BEEN THRU HERE BEFORE IF(LOAD) GO TO 14 LOAD=.TRUE. YA=YLAST+1 NEXT=IBUCKY(IY+2) GO TO 10 C JUMP IF NOT END OF SCAN LINE 14 ILAST=I IF(.NOT.IES) RETURN C RESET BACK POINTER IF(ISEGL2.EQ.0) GO TO 15 ISEG(ISEGL2)=0 ISEG(ISEGL2+1)=0 15 ISEGST=ISEGS2 I=ISEGST IOLD=I XL=YLAST+1. C GO HOME IF END OF SEGMENTS REACHED 16 IF(I.EQ.0) RETURN INXT=I IF(ISEG(I+1).NE.0) INXT=ISEG(I+1) C DRAW IF LEFT EDGE WAS PREVIOUSLY VISIBLE IF(ISEG(I+4)/2.EQ.IYMOD) GO TO 17 X1=RSEG(I+7)-2.0*RSEG(I+8) CALL DRAWIT(X1,XL,I+NOGREY+3) C DRAW IF RIGHT EDGE WAS PREVIOUSLY VISIBLE 17 IF(MOD(ISEG(I+4),2).EQ.IYMOD) GO TO 18 X1=RSEG(I+9)-2.0*RSEG(I+10) CALL DRAWIT(X1,XL,I+NOGREY+5) 18 IOLD=I I=ISEG(I+1) GO TO 16 END SUBROUTINE SHOW C 04OCT73 C THIS ROUTINE EVALUATES THE SHADING INFORMATION FOR C A VISIBLE SEGMENT. DATA COMES THROUGH SHOWER AND GOES TO C SRL (SHADED RASTER LINE) COMMON/SHOWER/IES,IVBL,COLOR,XLEFT,XRIGHT,SHRL,SHRR,SAML,SAMR, & RXVALU,RRANGE,LSTERR,IY,ICON,SHBL,SHBR,SHGL,SHGR COMMON/INTENS/ITENHI,ITENLO,IBACKG,IFX,IFY C COMMON/CONLEV/CONHI,CONLOW,NCONLV,CLEVEL(1) COMMON/EYES/XR,YR,IXRES,IYRES,DELINT,DELCON,IFLRCO,ICLGCO LOGICAL IES,LSTERR IF(SAMR.GT.IXRES) SAMR=IXRES C GO HOME IF END OF SCAN LINE REACHED 2 IF(SAML.GE.IXRES) RETURN IF(SAML.GE.SAMR) GO TO 4 STR=FLOAT(MOD(IBACKG,64)) STB=FLOAT(MOD(IBACKG/64,64)) STG=FLOAT(MOD(IBACKG/4096,64)) ENDR = STR ENDB = STB ENDG = STG C JUMP IF BACKGROUND SEGMENT IF(IVBL.EQ.0) GO TO 3 RR = 0. RB = 0. RG = 0. IF ( XRIGHT.EQ.XLEFT ) GO TO 1 X = XRIGHT-XLEFT RR = (SHRR-SHRL)/X RB = (SHBR-SHBL)/X RG = (SHGR-SHGL)/X C C************ COLOR************* C EVALUATE THE START AND END INTENSITIES 1 X = SAML-XLEFT RTENLO = ITENLO STR = (X*RR+SHRL)*DELINT+RTENLO STB = (X*RB+SHBL)*DELINT+RTENLO STG = (X*RG+SHGL)*DELINT+RTENLO X = SAMR-XLEFT ENDR = (X*RR+SHRL)*DELINT+RTENLO ENDB = (X*RB+SHBL)*DELINT+RTENLO ENDG = (X*RG+SHGL)*DELINT+RTENLO 3 CALL SRL(SAML,STR,STB,STG,SAMR,ENDR,ENDB,ENDG,IY+1) C GO HOME IF THIS IS NOT THE END OF THE SCAN LINE 4 IF(.NOT.IES) RETURN IVBL=0 SAML=SAMR SAMR=IXRES GO TO 2 END SUBROUTINE PACKER C C SUBROUTINE PACKER FOR 36 BIT MACHINES IN ANSI FORTRAN C C THIS ROUTINE RECEIVES DATA THROUGH EDGARG AND PACKS IT INTO C A STORAGE BLOCK INSIDE FREE. IF THIS EDGE IS A SHARED EDGE, THEN C THE EDGE WILL BE COMPARED WITH EXISTING EDGES ON THIS SCAN LINE C TO FIND OUT WHICH IF ANY IT MATCHES. IF THIS EDGE IS A C HORIZONTAL EDGE, THEN IT WILL BE STORED ON THE PREVIOUS SCAN LINE. COMMON/EDGARG/IY,IX1,IX2,IZ1,IZ2,IS1,IS2,IP,IDY,ICOL1, ISHR, &IC1,IC2,ICOL2 COMMON/FREE/ IFREE(1) COMMON/EYES/XEY(3),IFY,ES(4) COMMON/BUCKY/IBUCKY(1) COMMON/QFORIO/CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC LOGICAL CONTRS,IBAD,ISHR C CHANGE IY IF THIS IS A HORIZONTAL EDGE IF(IDY.EQ.0) IY=IY+1 IF(IY.GT.IFY) IY=IFY IPT=IBUCKY(IY) C GENERATE THE EDGE DATA IT1=(IX1*1024+IX2)*1024+IDY IT2=IZ1*32768+IZ2 NUMWRD=5 C JUMP IF NO EDGE SHARING IF(.NOT.ISHR) GO TO 4 C TRACE THROUGH THE ENTRIES ON THIS SCAN LINE AND FIND OUT C IF THIS EDGE HAS ALREADY BEEN ENTERED. 1 IF(IPT.EQ.0) GO TO 4 IF(IT1.EQ.MOD(IFREE(IPT),1073741824) 1.AND.IT2.EQ.MOD(IFREE(IPT+1),1073741824)) GO TO 3 C GET THE NEXT BLOCK IPT=MOD(IFREE(IPT+2),262144) GO TO 1 C CHECK TO SEE IF THIS EDGE IS ALREADY SHARED C AND JUMP IF IT IS 3 IF(MOD(IFREE(IPT+4),8192).NE.0) GO TO 4 C NOW PROVIDE THE SHARING POLYGON IFREE(IPT+4)=IFREE(IPT+4)/8192*8192+IP GO TO 5 4 CONTINUE C GET ENOUGH FREE FOR EDGE BLOCK (180 BITS) CALL GETVAR(IPT,NUMWRD) IF(IBAD) RETURN C CBEG(5), XBEG(10), XEND(10), DELTA Y(10) IFREE(IPT)=IT1 C CEND(5), ZBEG(15), ZEND(15) IFREE(IPT+1)=IT2 C SBEG(6), SEND(6), NEXT EDGE(18) IFREE(IPT+2)=(IS1*64+IS2)*262144+IBUCKY(IY) C COLOR BEG(18), POLYGON NUMBER(13) IFREE(IPT+3)=ICOL1*8192+IP C COLOR END(18), SHARED POLYGON NUMBER(13) IFREE(IPT+4)=ICOL2*8192 IF(.NOT.CONTRS) GO TO 6 IFREE(IPT)=MOD(IFREE(IPT),1073741824)+IC1*1073741824 IFREE(IPT+1)=MOD(IFREE(IPT+1),1073741824)+IC2*1073741824 6 IBUCKY(IY)=IPT 5 RETURN END SUBROUTINE UNPACK C C SUBROUTINE UNPACK FOR 36 BIT MACHINES IN ANSI FORTRAN C C UNPACK PERFORMS THE REVERSE OF PACKER. IT IS CALLED BY C HIDDEN WITH IEDGPT SET AND RETURNS DATA THROUGH EDGBLK. COMMON/FREE/IFREE(1) COMMON/EDGBLK/IPT,ICOL1,IDELY,X1,X2,Z1,Z2,S1,S2,IEDGPT,C1,C2  &,SHARED,IGTHRZ,ICOL2 COMMON/QFORIO/CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC LOGICAL CONTRS C GET DELTAY VALUE 15 IDELY=MOD(IFREE(IEDGPT),1024) C JUMP IF A NON-HORIZONTAL LINE IF(IDELY.GT.0) GO TO 16 C JUMP IF WE ARE LOOKING FOR VERTICALS IF(IGTHRZ) 20,20,18 C JUMP IF WE ARE LOOKING FOR HORIZONTALS 16 IF(IGTHRZ) 19,19,20 C FLAG TO SAY THERE ARE HORIZONTAL EDGES ON THIS SCAN LINE 18 IGTHRZ=2 C GET NEXT EDGE BLOCK 19 IEDGPT=MOD(IFREE(IEDGPT+2),262144) C GO HOME IF WE RAN OFF THE END OF THE LIST IF(IEDGPT) 3,3,15 C GET Z BEGIN 20 Z1=FLOAT(MOD(IFREE(IEDGPT+1)/32768,32768)) C GET Z END AND MAKE IT REAL Z2=FLOAT(MOD(IFREE(IEDGPT+1),32768)) C GET X BEGIN X1=FLOAT(MOD(IFREE(IEDGPT)/1048576,1024)) C GET X END AND MAKE IT REAL X2=FLOAT(MOD(IFREE(IEDGPT)/1024,1024)) C GET SHADE BEGIN S1=FLOAT(MOD(IFREE(IEDGPT+2)/16777216,64)) C GET SHADE END AND MAKE IT REAL S2=FLOAT(MOD(IFREE(IEDGPT+2)/262144,64)) C GET POINTER TO POLYGON IP=MOD(IFREE(IEDGPT+4),8192) C GET THE COLOR OF THIS EDGE ICOL1=MOD(IFREE(IEDGPT+3)/8192,262144) ICOL2=MOD(IFREE(IEDGPT+4)/8192,262144) C JUMP IF NO CONTOURING IF(.NOT.CONTRS) GO TO 4 C GET THE CONTOUR BEGIN C1=FLOAT(MOD(IFREE(IEDGPT)/1073741824,32)) C CET THE CONTOUR END C2=FLOAT(MOD(IFREE(IEDGPT+1)/1073741824,32)) 4 SHARED=-2. C IPT=MOD(IFREE(IEDGPT+3),8192) C JUMP IF NOTHING IN THE TOP HALF IF(IP.EQ.0) GO TO 2 SHARED=-1. IF(ISHARE.EQ.1) GO TO 1  ISHARE=1 GO TO 3 1 IPT=IP C GET POINTER TO NEXT EDGE ON SCAN LINE 2 IEDGPT=MOD(IFREE(IEDGPT+2),262144) ISHARE=0 3 RETURN END SUBROUTINE ERRMSG(I,J) C THIS ROUTINE WILL WRITE OUT THE ERROR MESSAGE. ARGUMENT I C IS THE ERROR NUMBER AND ARGUMENT J IS THE VALUE WHICH IS IN ERROR. COMMON/DEVI/ INPUT,OUTPUT,ERROR COMMON/QFORIO/CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC INTEGER OUTPUT,ERROR LOGICAL IBAD IF(IDVICE.EQ.-1) CALL ALMODE  IBAD=.TRUE. C JUMP TO THE ERROR STRING GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13),I 1 WRITE(ERROR,30) J GO TO 25 2 WRITE(ERROR,31) GO TO 25 3 WRITE(ERROR,32) J GO TO 25 4 WRITE(ERROR,33) J GO TO 25 5 WRITE(ERROR,34) J GO TO 25 6 WRITE(ERROR,35) GO TO 25 7 WRITE(ERROR,36) GO TO 25 8 WRITE(ERROR,37) GO TO 25 9 WRITE(ERROR,38) GO TO 25 10 WRITE(ERROR,39) GO TO 25 11 WRITE(ERROR,40)  GO TO 25 12 WRITE(ERROR,41) J GO TO 25 13 WRITE(ERROR,42) CONTINUE 25 RETURN 30 FORMAT(' MAXFRE.LT.100',I6/) 31 FORMAT(' TOO MANY POLYGONS'/) 32 FORMAT(' BAD MAXRES',I6/) 33 FORMAT(' BAD MAXINT',I6/) 34 FORMAT(' UNCLOSED POLYGON',I6/) 35 FORMAT(' I NEED MORE FREE'/) 36 FORMAT(' BAD RESOLUTION'/) 37 FORMAT(' BAD INTENSITY'/) 38 FORMAT(' FIX YOUR DATA'/) 39 FORMAT(' BUFFER FULL'/) 40 FORMAT(' ZMAX.LE.0 OR ZMIN'/) 41 FORMAT(' EDG STK FUL 4 POL',I6/) 42 FORMAT(' BAD EDGE COUNT'/) END SUBROUTINE CONSHO C 04APR74 C THIS ROUTINE EVALUATES THE CONTOUR INFORMATION FOR C A VISIBLE SEGMENT. DATA COMES THROUGH SHOWER AND GOES TO C LINE AND CRTBCD (LLL GRAPHICS ROUTINES) COMMON/FREE/RSEG(1) COMMON/SHOWER/IES,I,COLOR,XLEFT,XRIGHT,SHRL,SHRR,SAML,SAMR &,RXVALU,RRANGE,LSTERR,IY,J,SHBL,SHBR,SHGL,SHGR COMMON/INTENS/ITENHI,ITENLO,IBACKG,IFX,IFY COMMON/CONLEV/CONHI,CONLOW,NCONLV,CLEVEL(1) COMMON/EYES/XR,YR,IXRES,IYRES,DELINT,DELCON,IFLRCO,ICLGCO COMMON/YSCLIN/OLDLFT,IYMOD,YLAST COMMON/QFORIO/CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC LOGICAL IES,LSTERR,SHOSHR C JUMP IF BACKGROUND SEGMENT IF(I.EQ.0) RETURN YY=YLAST/(IFY+1) ITEXTY=MOD(IY,NCONLV*LBLSPC) C GET THE DATA FOR HALF A SCAN LINE AGO XL1=XLEFT-RSEG(I+8)*.5 XR1=XRIGHT-RSEG(I+10)*.5 CL1=(RSEG(J)-RSEG(J+1)*1.5)*DELCON+CLEVEL(1) CR1=(RSEG(J+2)-RSEG(J+3)*1.5)*DELCON+CLEVEL(1) C GET THE DATA FOR HALF A SCAN LINE AHEAD XL2=XLEFT+RSEG(I+8)*.5 XR2=XRIGHT+RSEG(I+10)*.5 CL2=(RSEG(J)-RSEG(J+1)*.5)*DELCON+CLEVEL(1) CR2=(RSEG(J+2)-RSEG(J+3)*.5)*DELCON+CLEVEL(1) C GO THROUGH THE CONTOUR LOOP C THIS IS REALLY DIFFICULT TO EXPLAIN. THE HIDDEN SURFACE C ALGORITHM HAS DETERMINED THAT IT HAS A VISIBLE SEGMENT. C I WILL CREATE A QUADRILATERAL ABOUT THIS VISIBLE SEGMENT WHERE C THE COORDINATES ARE (XR1, Y-1/2), (XL1, Y-1/2), (XR2, Y+1/2), C (XL2, Y+1/2). IN GOING THROUGH THE CONTOUR LOOP I CHECK TO SEE C IF A GIVEN CONTOUR LINE INTERSECTS AN EDGE OF THE QUAD. C IF IT DOES, THEN I STORE THE COORDINATE. THE LINE THAT I WILL C DRAW MUST BE CONTAINED WITHIN THE VISIBLE SEGMENT. THE REASON I C DONT WORRY ABOUT THE Y INTERSECTION IS BECAUSE THE PICTURE C WHICH IM COMPUTING CANT EXIST BETWEEN SCAN LINES. DO 7 K=IFLRCO,ICLGCO XS=IFX XE=0. CC=CLEVEL(K) C CHECK THE LINE FROM TOP LEFT TO TOP RIGHT T1=CC-CL1 T2=CC-CR1 IF(T1*T2.GT.0.) GO TO 1 X=XL1 IF(T1.NE.T2) X=(T1/(T1-T2))*(XR1-XL1)+XL1 IF(X.LT.XS) XS=X IF(X.GT.XE) XE=X C CHECK THE LINE FROM TOP RIGHT TO BOTTOM RIGHT 1 T1=CC-CR1 T2=CC-CR2 IF(T1*T2.GT.0.) GO TO 2 X=XR1 IF(T1.NE.T2) X=(T1/(T1-T2))*(XR2-XR1)+XR1 IF(X.LT.XS) XS=X IF(X.GT.XE) XE=X C CHECK THE LINE FROM BOTTOM RIGHT TO BOTTOM LEFT 2 T1=CC-CR2  T2=CC-CL2 IF(T1*T2.GT.0.) GO TO 3 X=XR2 IF(T1.NE.T2) X=(T1/(T1-T2))*(XL2-XR2)+XR2 IF(X.LT.XS) XS=X IF(X.GT.XE) XE=X C CHECK THE LINE FROM BOTTOM LEFT TO TOP LEFT 3 T1=CC-CL2 T2=CC-CL1 IF(T1*T2.GT.0.) GO TO 4 X=XL1 IF(T1.NE.T2) X=(T1/(T1-T2))*(XL1-XL2)+XL2 IF(X.LT.XS) XS=X IF(X.GT.XE) XE=X C IF THE CONTOUR SEGMENT IS OUTSIDE THE RANGE OF THE C VISIBLE SEGMENT, THEN DONT DRAW IT 4 IF(XS.GT.SAMR) GO TO 7 IF(XE.LT.SAML) GO TO 7 IF(XS.LT.SAML) XS=SAML IF(XE.GT.SAMR) XE=SAMR CALL PLTLIN(XS,YLAST,XE,YLAST) C JUMP IF THIS ISNT THE TIME TO PLOT A LABEL IF((K-1)*LBLSPC.NE.ITEXTY) GO TO 7 CALL LABEL((XS+XE)/2.,YLAST,(64+K)*2**29,1) 7 CONTINUE RETURN END C**********************************************************************C C  C C DEVICE.FOR VERSION 1.0(A) SEPTEMBER 1976 C C C C THIS FILE CONTAINS DEVICE DEPENDENT CALLS TO INITIALIZE, C C WRITE, AND TERMINATE PICTURE TRANSMISSION TO THE C C SELECTED DISPLAY DEVICE. C C C C MIKE STEPHENSON HANK CHRISTIANSEN C C DEPARTMENT OF CIVIL ENGR. CIVIL ENGINEERING DEPT. C C AND ENGINEERING MECHANICS 368E ESTB C C THE UNIVERSITY OF ARIZONA BRIGHAM YOUNG UNIVERSITY C C TUCSON, ARIZONA 85721 PROVO, UTAH 84602 C C (602) 884-4803 (801) 374-1211 X2811 C C C C**********************************************************************C SUBROUTINE BGNFRM COMMON/DEVI/ INPUT,OUTPUT,ERROR COMMON/PLTTER/ PLTSIZ,XLAST,YLAST COMMON/INTENS/ IPH,IPL,IPB,IFX,IFY COMMON/QFORIO/ CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC INTEGER OUTPUT,ERROR LOGICAL IFIRST DATA IFIRST/.TRUE./ C IF CONTINUOUS-TONE THEN RETURN. C (NOTE: NO CONTINUOUS-TONE DEVICE CALL INCLUDED IN THIS VERSION.) IF(IDVICE.GT.0) RETURN C RES = MAXIMUM PICTURE COORDINATE (0.<=COOR.<=RES). C PLTSIZ = SCALE FACTOR TO CONVERT FROM INTERNAL COORDINATES C TO EXTERNAL PICTURE DEVICE COORDINATES. RES=IFX-1 IGO=IDVICE+2 IF(IGO) 10,20,30 C CALCOMP PLOTTER IS PICTURE DEVICE. 10 IF(IFIRST) CALL PLOTS(X,Y,I) IF(IFIRST) CALL PLOT(0.,0.5,-3) IFIRST=.FALSE. PLTSIZ=10./RES CALL PLOT(0.,10.,2) CALL PLOT(10.,10.,1) CALL PLOT(10.,0.,1) CALL PLOT(0.,0.,1) RETURN C HP PLOTTER IS PICTURE DEVICE. 20 WRITE(OUTPUT,21) 21 FORMAT(' ',$) READ(INPUT,22) ANS 22 FORMAT(A1) IF(ANS.NE.'Y') GO TO 20 PLTSIZ=6666./RES WRITE(OUTPUT,23) 23 FORMAT(' PLTL') IX=0 IY=0 WRITE(OUTPUT,24) IX,IY 24 FORMAT(1X,2I6,'^') DO 25 I=1,3 IX=IX+2222 25 WRITE(OUTPUT,29) IX,IY DO 26 I=1,3 IY=IY+3333 26 WRITE(OUTPUT,29) IX,IY DO 27 I=1,3 IX=IX-2222 27 WRITE(OUTPUT,29) IX,IY DO 28 I=1,3 IY=IY-3333 28 WRITE(OUTPUT,29) IX,IY 29 FORMAT(1X,2I6) XLAST=0. YLAST=0. RETURN C TEKTRONIX SCOPE IS PICTURE DEVICE. 30 PLTSIZ=779./RES CALL CLHOA CALL MVTO(244,779) CALL VCTO(1023,779) CALL VCTO(1023,0) CALL VCTO(244,0) CALL VCTO(244,779) XLAST=244. YLAST=779. RETURN END SUBROUTINE ENDFRM COMMON/DEVI/ INPUT,OUTPUT,ERROR COMMON/QFORIO/ CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC INTEGER OUTPUT,ERROR C IF CONTINUOUS-TONE THEN RETURN. C (NOTE: NO CONTINUOUS-TONE DEVICE CALL INCLUDED IN THIS VERSION.) IF(IDVICE.GT.0) RETURN IGO=IDVICE+2 IF(IGO) 10,20,30 C CALCOMP PLOTTER IS PICTURE DEVICE. 10 CALL PLOT(11.,0.,-3) RETURN C HP PLOTTER IS PICTURE DEVICE. 20 WRITE(OUTPUT,22) 22 FORMAT(' PLTT') RETURN C TEKTRONIX SCOPE IS PICTURE DEVICE. 30 CALL MVTO(0,767) CALL ALMODE RETURN END SUBROUTINE PLTLIN(A,B,C,D) COMMON/DEVI/ INPUT,OUTPUT,ERROR COMMON/PLTTER/ PLTSIZ,XLAST,YLAST COMMON/QFORIO/ CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC DIMENSION X(2),Y(2) INTEGER OUTPUT,ERROR C IF CONTINUOUS-TONE THEN RETURN. C (NOTE: NO CONTINUOUS-TONE DEVICE CALL INCLUDED IN THIS VERSION.) IF(IDVICE.GT.0) RETURN C SCALE INTERNAL COORDINATES TO DEVICE COORDINTES. X(1)=A*PLTSIZ Y(1)=B*PLTSIZ X(2)=C*PLTSIZ Y(2)=D*PLTSIZ C IF CONTINUOUS-TONE THEN RETURN. C (NOTE: NO CONTINUOUS-TONE DEVICE CALL INCLUDED IN THIS VERSION.) IGO=IDVICE+2 IF(IGO) 10,20,30 C CALCOMP PLOTTER IS PICTURE DEVICE. 10 CALL LINE(X,Y,2,1) RETURN C HP PLOTTER IS PICTURE DEVICE. 20 Y(1)=1.5*Y(1) Y(2)=1.5*Y(2) IF(XLAST.EQ.X(1).AND.YLAST.EQ.Y(1)) GO TO 24 IX=X(1) IY=Y(1) WRITE(OUTPUT,22) IX,IY 22 FORMAT(1X,2I6,'^') 24 X1=X(2)-X(1) Y1=Y(2)-Y(1) ITEST=SQRT(2.25*X1*X1+Y1*Y1) J=ITEST/3333 IF(J.LE.0) GO TO 27 IX=X1 IY=Y1  IDELX=IX/(J+1) IDELY=IY/(J+1) IX=X(1) IY=Y(1) DO 25 I=1,J IX=IX+IDELX IY=IY+IDELY 25 WRITE(OUTPUT,28) IX,IY 27 IX=X(2) IY=Y(2) WRITE(OUTPUT,28) IX,IY 28 FORMAT(1X,2I6) XLAST=X(2) YLAST=Y(2) RETURN C TEKTRONIX SCOPE IS PICTURE DEVICE. 30 X(1)=244.+X(1) X(2)=244.+X(2) IF(XLAST.EQ.X(1).AND.YLAST.EQ.Y(1)) GO TO 34 IX=X(1) IY=Y(1) CALL MVTO(IX,IY) 34 IX=X(2) IY=Y(2) CALL VCTO(IX,IY) XLAST=X(2) YLAST=Y(2) RETURN END SUBROUTINE LABEL(X,Y,CHR,NCNT) COMMON/DEVI/ INPUT,OUTPUT,ERROR COMMON/PLTTER/ PLTSIZ,XLAST,YLAST COMMON/QFORIO/ CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC C IF CONTINUOUS-TONE THEN RETURN. C (NOTE: NO CONTINUOUS-TONE DEVICE CALL INCLUDED IN THIS VERSION.) INTEGER OUTPUT,ERROR IF(IDVICE.GT.0) RETURN C SCALE INTERNAL COORDINATES TO EXTERNAL COORDINSTES. XC=X*PLTSIZ YC=Y*PLTSIZ IGO=IDVICE+2 IF(IGO) 10,20,30 C CALCOMP PLOTTER IS PICTURE DEVICE. 10 CALL SYMBOL(XC,YC,0.1,CHR,0.0,NCNT) RETURN C HP PLOTTER IS PICTURE DEVICE. 20 RETURN C TEKTRONIX SCOPE IS PICTURE DEVICE. 30 RETURN END SUBROUTINE SRL(X1,S1R,S1B,S1G,X2,S2R,S2B,S2G,IY) COMMON/CSAVIT/ISAVIT COMMON/QFORIO/CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC COMMON / CORE / IFREST, LEN, IFREPT COMMON / COMNIO / I CNT COMMON / PGNCNT / IPOLY DIMENSION LINEG(4),LINEB(4),LINER(4) COMMON/LINEF/ICR,LIN4R(128),ICG,LIN4G(128),ICB,LIN4B(128),IFORK DATA IFORK/0/ C PRINT 2, IY, X1,S1G,S1B,S1R, X2,S2G,S2B,S2R C (NOTE: NO CONTINUOUS-TONE DEVICE CALL INCLUDED IN THIS VERSION.) I1=X1+1.5 I2=X2+0.5 IF(I1.NE.1) GO TO 96 I3=1 I4=1 96 IF(I1-I2) 97,98,99 97 IF(S1R.EQ.S2R.AND.S1B.EQ.S2B.AND.S1G.EQ.S2G) GO TO 98 DX=I2-I1 DR=(S2R-S1R)/DX DB=(S2B-S1B)/DX DG=(S2G-S1G)/DX DO 200 I=I1,I2 LINER(I3)=ABS(S1R) LINEB(I3)=ABS(S1B) LINEG(I3)=ABS(S1G) S1R=S1R+DR S1B=S1B+DB S1G=S1G+DG IF(I3.NE.4) GO TO 200 LIN4R(I4)=LINER(1)*(2**28)+LINER(2)*(2**20) 1 +LINER(3)*(2**10)+LINER(4)*(2**2) LIN4B(I4)=LINEB(1)*(2**28)+LINEB(2)*(2**20) 1 +LINEB(3)*(2**10)+LINEB(4)*(2**2) LIN4G(I4)=LINEG(1)*(2**28)+LINEG(2)*(2**20) 1 +LINEG(3)*(2**10)+LINEG(4)*(2**2) I3=0 I4=I4+1 200 I3=I3+1 GO TO 99 98 IR=ABS(S1R) IG=ABS(S1G) IB=ABS(S1B) DO 300 I=I1,I2 LINER(I3)=IR LINEB(I3)=IB LINEG(I3)=IG IF(I3.NE.4) GO TO 300 LIN4R(I4)=LINER(1)*(2**28)+LINER(2)*(2**20) 1 +LINER(3)*(2**10)+LINER(4)*(2**2) LIN4B(I4)=LINEB(1)*(2**28)+LINEB(2)*(2**20) 1 +LINEB(3)*(2**10)+LINEB(4)*(2**2) LIN4G(I4)=LINEG(1)*(2**28)+LINEG(2)*(2**20) 1 +LINEG(3)*(2**10)+LINEG(4)*(2**2) I3=0 I4=I4+1 300 I3=I3+1 99 IF(I2.LT.511) RETURN I=512-IY I=I*(2**18) ICG="400000200000+I ICR="410000200000+I ICB="420000200000+I RETURN END C**********************************************************************C C C C UTILITY.FOR VERSION 1.0(A) SEPTEMBER 1976 C C C C A GENERAL UTILITY ROUTINE FOR BOTH 8 NODE BRICKS AND C C PANEL SYSTEMS.  C C C C MIKE STEPHENSON HANK CHRISTIANSEN C C DEPARTMENT OF CIVIL ENGR. CIVIL ENGINEERING DEPT. C C AND ENGINEERING MECHANICS 368E ESTB C C THE UNIVERSITY OF ARIZONA BRIGHAM YOUNG UNIVERSITY C C TUCSON, ARIZONA 85721 PROVO, UTAH 84602 C C (602) 884-4803 (801) 374-1211 X2811  C C C C**********************************************************************C INTEGER OUTPUT C DIMENSION NPL(2,NPMAX),X(3,NJMAX),IP(8,NPTMAX),U(3,NJMAX) C 1,S(NJMAX) DIMENSION NPL(2,10),X(3,100),IP(8,100),U(3,100),S(100) COMMON/CNTL/ NP,NJ,NPT COMMON/DEVI/ INPUT,OUTPUT C COMMON/FUNC/ SX(2,NJMAX) COMMON/FUNC/ SX(2,100) C COMMON/JUNK/ JNK(8,NPTMAX) COMMON/JUNK/ JNK(8,100)  COMMON/MAXI/ NPMAX,NJMAX,NPTMAX C INPUT AND OUTPUT ARE SET BELOW FOR THE DECSYSTEM-10 INPUT=-4 OUTPUT=-1 NPMAX=10 NJMAX=100 NPTMAX=100 C TYPE TITLE FOR USER INFORMATION WRITE(OUTPUT,10) 10 FORMAT(' ') C INITIALIZE CONTROL VARIABLES AND REQUEST DATA TYPE NJ=0 NP=0 NPT=0 NTYPE=4 WRITE(OUTPUT,20) 20 FORMAT(' '$) READ(INPUT,100) WORD IF(WORD.EQ.'S') NTYPE=8 IF(NTYPE.EQ.4) NPTMAX=2*NPTMAX C REQUEST COMMAND AND PROCEED 30 WORD=CMD(1) IF(WORD.EQ.'GEOM') CALL GEOM(NPL,X,IP,NTYPE) IF(WORD.EQ.'DISP') CALL DISP(U) IF(WORD.EQ.'FUNC') CALL SFUN(IP,S,NTYPE) IF(WORD.EQ.'SYMM') CALL SYMM(NPL,X,IP,U,S,NTYPE) IF(WORD.EQ.'ORDE') CALL ORDER(NPL,IP,NTYPE) IF(WORD.EQ.'HELP'.OR.WORD.EQ.'?'.OR.WORD.EQ.' ') CALL HELP(1) GO TO 30 100 FORMAT(A1) END FUNCTION CMD(INDX) INTEGER OUTPUT DIMENSION CHR(3) COMMON/DEVI/ INPUT,OUTPUT DATA CHR/' >',' >>',' >>>'/ C TYPE COMMAND PROMPT WRITE(OUTPUT,100) CHR(INDX) 100 FORMAT(A5,$) C ACCEPT COMMAND WORD READ(INPUT,200) CMD 200 FORMAT(A4) IF(CMD.EQ.'EXIT') CALL EXIT RETURN END SUBROUTINE HELP(INDX) INTEGER OUTPUT COMMON/DEVI/ INPUT,OUTPUT C JUMP TO APPROPRIATE HELP MESSAGE GO TO (100,200,300,400),INDX C LEVEL ONE HELP MESSAGE 100 WRITE(OUTPUT,110) 110 FORMAT(' ') RETURN C LEVEL TWO HELP MESSAGE 200 WRITE(OUTPUT,210) 210 FORMAT(' ') RETURN C LEVEL THREE HELP MESSAGE (ALL BUT GEOM-CHAN) 300 WRITE(OUTPUT,310) 310 FORMAT(' ') RETURN C LEVEL THREE HELP MESSAGE (GEOM-CHAN ONLY) 400 WRITE(OUTPUT,410) 410 FORMAT(' ') RETURN END SUBROUTINE OVER(INDX) INTEGER OUTPUT COMMON/DEVI/ INPUT,OUTPUT COMMON/MAXI/ NPMAX,NJMAX,NPTMAX C JUMP TO APPROPRIATE ERROR MESSAGE GO TO (500,600,700),INDX C ERROR: NP .GT. NPMAX 500 WRITE(OUTPUT,510) NPMAX 510 FORMAT(' ?') STOP C ERROR: NJ .GT. NJMAX 600 WRITE(OUTPUT,610) NJMAX 610 FORMAT(' ?') STOP C ERROR: NPTMAX .GT. NPTMAX 700 WRITE(OUTPUT,710) NPTMAX 710 FORMAT(' ?') STOP END SUBROUTINE GEOM(NPL,X,IP,NTYPE) INTEGER OUTPUT DIMENSION NPL(2,1),X(3,1),IP(NTYPE,1) DIMENSION II(8) COMMON/CNTL/ NP,NJ,NPT COMMON/DEVI/ INPUT,OUTPUT COMMON/JUNK/ JP(1) COMMON/MAXI/ NPMAX,NJMAX,NPTMAX C REQUEST COMMAND WORD. RETURN IF BLANK. 100 WORD=CMD(2) IF(WORD.EQ.' ') RETURN C READ GEOMETRY FILE IF(WORD.NE.'READ') GO TO 200 CALL RDGEOM(NPL,X,IP,NTYPE) GO TO 100 C WRITE GEOMETRY FILE 200 IF(WORD.NE.'WRIT') GO TO 300 CALL WRGEOM(NPL,X,IP,NTYPE) GO TO 100 C CHANGE GEOMETRY FILE 300 IF(WORD.NE.'CHAN') GO TO 800 310 WORD=CMD(3) IF(WORD.EQ.' ') GO TO 100 C MOVE ELEMENTS IF(WORD.NE.'MOVE') GO TO 400 330 WRITE(OUTPUT,340) 340 FORMAT(' '$) READ(INPUT,1000) I1,I2,I3 IF(I1.EQ.0) GO TO 310 IF(I2.EQ.1) GO TO 350 I5=I2-1 CALL MOVE(IP,JP,1,I5,1,NTYPE) 350 I5=I1+I2-1 J4=NPT-I1+1 CALL MOVE(IP,JP,I2,I5,J4,NTYPE) 360 I4=I1+I2 IF(I4.GT.NPT) GO TO 370 CALL MOVE(IP,JP,I4,NPT,I2,NTYPE) 370 IF(I3.EQ.0) GO TO 380 CALL MOVE(JP,IP,1,I3,1,NTYPE) 380 I4=I3+1 I5=NPT-I1 IF(I5.LT.I4) GO TO 390 J4=I1+I3+1 CALL MOVE(JP,IP,I4,I5,J4,NTYPE) 390 I4=NPT-I1+1 J4=I3+1 IF(I2.LT.I3) J4=J4-I1 CALL MOVE(JP,IP,I4,NPT,J4,NTYPE) GO TO 330 C  PART GROUPS 400 IF(WORD.NE.'GROU') GO TO 500 WRITE(OUTPUT,410) 410 FORMAT(' '$) READ(INPUT,1000) NP IF(NP.GT.NPMAX) CALL OVER(1) WRITE(OUTPUT,430) 430 FORMAT(' ') READ(INPUT,1000) (NPL(1,I),I=1,NP) NPT=0 DO 440 I=1,NP 440 NPT=NPT+NPL(1,I) IF(NPT.GT.NPTMAX) CALL OVER(3) GO TO 310 C COORDINATES 500 IF(WORD.NE.'COOR') GO TO 600 WRITE(OUTPUT,510) 510 FORMAT(' '$) READ(INPUT,520) ANS 520 FORMAT(A1) IF(ANS.NE.'Y') GO TO 540 WRITE(OUTPUT,530) 530 FORMAT(' '$) READ(INPUT,1000) NJ IF(NJ.GT.NJMAX) CALL OVER(2) 540 WRITE(OUTPUT,550) 550 FORMAT(' '$) READ(INPUT,560) I,X1,X2,X3 560 FORMAT(I,3E) IF(I.EQ.0) GO TO 310 IF(I.GT.NJMAX) CALL OVER(2) IF(I.GT.NJ) NJ=I X(1,I)=X1 X(2,I)=X2 X(3,I)=X3 GO TO 540 C ELEMENTS 600 IF(WORD.NE.'ELEM') GO TO 700 605 WRITE(OUTPUT,610) 610 FORMAT(' '$) READ(INPUT,615) WORD 615 FORMAT(A1) IF(WORD.EQ.'A') GO TO 620 IF(WORD.EQ.'D') GO TO 650 GO TO 605 C ADD ELEMENTS 620 WRITE(OUTPUT,625) 625 FORMAT(' '$) READ(INPUT,1000) J1,(II(I),I=1,NTYPE) IF(J1.EQ.0) GO TO 310 NP1=1 DO 630 I=1,J1 630 NP1=NP1+NPL(1,I) IF(NP1.GT.NPTMAX) CALL OVER(3) IF(NP1.GT.NPT) GO TO 640 J3=NPT+1 DO 638 J=NP1,NPT  J2=J3-1 DO 634 I=1,NTYPE 634 IP(I,J3)=IP(I,J2) 638 J3=J2 640 DO 645 I=1,NTYPE 645 IP(I,NP1)=II(I) NPT=NPT+1 NPL(1,J1)=NPL(1,J1)+1 GO TO 620 C DELETE ELEMENTS 650 WRITE(OUTPUT,625) READ(INPUT,1000) J1,(II(I),I=1,NTYPE) IF(J1.EQ.0) GO TO 310 NP2=0 DO 655 I=1,J1 655 NP2=NP2+NPL(1,I) NP1=NP2-NPL(1,J1)+1 DO 664 J=NP1,NP2 J2=J+1 J3=0 DO 660 I=1,NTYPE IF(IP(I,J).NE.II(I)) GO TO 664 J3=J3+1 IF(J3.EQ.NTYPE) GO TO 670 660 CONTINUE 664 CONTINUE WRITE(OUTPUT,668) 668 FORMAT(' %') GO TO 650 670 DO 675 I=J2,NPT J3=I-1 DO 675 J=1,NTYPE 675 IP(J,J3)=IP(J,I) NPT=NPT-1 NPL(1,J1)=NPL(1,J1)-1 GO TO 650 C TYPE HELP MESSAGE IF COMMAND NOT RECOGNIZED 700 CALL HELP(4) GO TO 310 C PRINT DATA ON TTY 800 IF(WORD.NE.'PRIN') GO TO 900 810 WORD=CMD(3) IF(WORD.EQ.' ') GO TO 100 C PART GROUPS IF(WORD.NE.'GROU') GO TO 840 WRITE(OUTPUT,820) (NPL(1,I),I=1,NP) 820 FORMAT(' '/(1X,10I4)) GO TO 810 C COORDINATES 840 IF(WORD.NE.'COOR') GO TO 860 845 WRITE(OUTPUT,850) 850 FORMAT(' '$) READ(INPUT,1000) I1,I2 IF(I2.GT.NJ) I2=NJ IF(I1.EQ.0) GO TO 810 WRITE(OUTPUT,855) (J,(X(I,J),I=1,3),J=I1,I2) 855 FORMAT(1X,I4,1P3E12.4) GO TO 845 C ELEMENTS 860 IF(WORD.NE.'ELEM') GO TO 890 865 WRITE(OUTPUT,870) 870 FORMAT(' '$) READ(INPUT,1000) I1,I2 IF(I2.GT.NPT) I2=NPT IF(I1.EQ.0) GO TO 810 IF(NTYPE.EQ.4) TYPE 875,(J,(IP(I,J),I=1,4),J=I1,I2) 875 FORMAT(1X,5I5) IF(NTYPE.EQ.8) TYPE 885,(J,(IP(I,J),I=1,8),J=I1,I2) 885 FORMAT(1X,9I5) GO TO 865 C TYPE HELP MESSAGE IF COMMAND NOT RECOGNIZED 890 CALL HELP(3) GO TO 810 C TYPE HELP MESSAGE IF COMMAND NOT RECOGNIZED 900 CALL HELP(2) GO TO 100 1000 FORMAT(20I) END SUBROUTINE DISP(U) INTEGER OUTPUT DIMENSION U(3,1) COMMON/CNTL/ NP,NJ,NPT COMMON/DEVI/ INPUT,OUTPUT COMMON/MAXI/ NPMAX,NJMAX,NPTMAX C REQUEST COMMAND WORD. RETURN IF BLANK. 100 WORD=CMD(2) IF(WORD.EQ.' ') RETURN C READ DISPLACEMENT FILE IF(WORD.NE.'READ') GO TO 200 CALL RDDISP(U,NJ) GO TO 100 C WRITE DISPLACEMENT FILE 200 IF(WORD.NE.'WRIT') GO TO 300 CALL WRDISP(U,NJ) GO TO 100 C CHANGE DISPLACEMENTS 300 IF(WORD.NE.'CHAN') GO TO 400  310 WRITE(OUTPUT,320) 320 FORMAT(' '$) READ(INPUT,330) I,X1,X2,X3 330 FORMAT(I,3E) IF(I.EQ.0) GO TO 100 IF(I.GT.NJMAX) CALL OVER(2) U(1,I)=X1 U(2,I)=X2 U(3,I)=X3 GO TO 310 C PRINT DISPLACEMENTS ON TTY 400 IF(WORD.NE.'PRIN') GO TO 500 405 WRITE(OUTPUT,410) 410 FORMAT(' '$) READ(INPUT,420) I1,I2 420 FORMAT(2I) IF(I1.EQ.0) GO TO 100 IF(I2.GT.NJ) I2=NJ WRITE(OUTPUT,430) (J,(U(I,J),I=1,3),J=I1,I2) 430 FORMAT(1X,I4,1PE12.4) GO TO 405 C TYPE HELP MESSAGE IF COMMAND NOT RECOGNIZED 500 CALL HELP(2) GO TO 100 END SUBROUTINE SFUN(IP,S,NTYPE) INTEGER OUTPUT DIMENSION IP(NTYPE,1),S(1) COMMON/CNTL/ NP,NJ,NPT COMMON/DEVI/ INPUT,OUTPUT COMMON/MAXI/ NPMAX,NJMAX,NPTMAX C REQUEST COMMAND WORD. RETURN IF BLANK. 100 WORD=CMD(2) IF(WORD.EQ.' ') RETURN C READ SCALAR FUNCTION FILE IF(WORD.NE.'READ') GO TO 200 CALL RDSFUN(IP,S,NTYPE) GO TO 100 C WRITE SCALAR FUNCTION FILE 200 IF(WORD.NE.'WRIT') GO TO 300 CALL WRSFUN(S) GO TO 100 C CHANGE SCALAR FUNCTIONS 300 IF(WORD.NE.'CHAN') GO TO 400 310 WRITE(OUTPUT,320) 320 FORMAT(' '$) READ(INPUT,330) I,X1 330 FORMAT(I,E) IF(I.EQ.0) GO TO 100 IF(I.GT.NJMAX) CALL OVER(2) S(I)=X1 GO TO 310 C PRINT SCALAR FUNCTIONS ON TTY 400 IF(WORD.NE.'PRIN') GO TO 500 410 WRITE(OUTPUT,420) 420 FORMAT(' '$) READ(INPUT,430) I1,I2 430 FORMAT(2I) IF(I1.EQ.0) GO TO 310 IF(I2.LT.I1) I2=I1 IF(I1.GT.NJ) GO TO 410 IF(I2.GT.NJ) I2=NJ WRITE(OUTPUT,440) (I,S(I),I=I1,I2) 440 FORMAT(1X,I4,1PE12.4) GO TO 410 C TYPE HELP MESSAGE IF COMMAND NOT RECOGNIZED 500 CALL HELP(2) GO TO 100 END SUBROUTINE SYMM(NPL,X,IP,U,S,NTYPE) INTEGER OUTPUT DIMENSION NPL(2,1),X(3,1),IP(NTYPE,1),U(3,1),S(1) COMMON/CNTL/ NP,NJ,NPT COMMON/DEVI/ INPUT,OUTPUT COMMON/JUNK/ IX(1) COMMON/MAXI/ NPMAX,NJMAX,NPTMAX LOGICAL MULTI C REQUEST SYMMETRY PLANE. RETURN IF BLANK. 100 WRITE(OUTPUT,110) 110 FORMAT(' '$) READ(INPUT,120) SYMP 120 FORMAT(A2) IF(SYMP.EQ.' ') RETURN ISYM=0 IF(SYMP.EQ.'XY') ISYM=3 IF(SYMP.EQ.'XZ') ISYM=2 IF(SYMP.EQ.'YZ') ISYM=1 IF(ISYM.EQ.0) GO TO 100 C MULTIPLE DISPLACEMENT AND SCALAR FUNCTION FILES? WRITE(OUTPUT,200) 200 FORMAT(' '$) READ(INPUT,210) ANS 210 FORMAT(A1) MULTI=ANS.EQ.'Y' C ARRAY IX GETS SYMMETRY MAPPING OF NODE NUMBERS IF(NP+NP.GT.NPMAX) CALL OVER(1) IF(NPT+NPT.GT.NPTMAX) CALL OVER(3) NPT=0 DO 300 I=1,NP NPT=NPT+NPL(1,I) 300 NPL(1,I+NP)=NPL(1,I) K=0 DO 310 I=1,NJ IX(I)=I+NJ-K IF(X(ISYM,I).NE.0.0) GO TO 310 IX(I)=I K=K+1 310 CONTINUE IF(NJ+NJ-K.GT.NJMAX) CALL OVER(2) C USE ARRAY IX TO FORM SYMMETRY ELEMENTS DO 400 J=1,NPT J1=J+NPT DO 400 I=1,NTYPE,2 I1=IP(I,J) I2=IP(I+1,J) IP(I+1,J1)=IX(I1) IP(I,J1)=IX(I2) 400 CONTINUE C USE ARRAY IX TO FORM SYMMETRY COORDINATES DO 510 J=1,NJ J1=IX(J) IF(J1.LE.NJ) GO TO 510 DO 500 I=1,3 500 X(I,J1)=X(I,J) X(ISYM,J1)=-X(ISYM,J1) 510 CONTINUE NFILES=0 IF(.NOT.MULTI) GO TO 615 C USE ARRAY IX TO FORM SYMMETRY DISPLACEMENTS WRITE(OUTPUT,600) 600 FORMAT(' '$) READ(INPUT,610) NFILES 610 FORMAT(I) 615 DO 640 N=1,NFILES IF(MULTI) CALL RDDISP(U) DO 630 J=1,NJ J1=IX(J) IF(J1.LE.NJ) GO TO 630 DO 620 I=1,3 620 U(I,J1)=U(I,J) U(ISYM,J1)=-U(ISYM,J1) 630 CONTINUE IF(MULTI) CALL WRDISP(U) 640 CONTINUE IF(.NOT.MULTI) GO TO 715 C USE ARRAY IX TO FORM SYMMETRY SCALAR FUCTIONS 700 WRITE(OUTPUT,710) 710 FORMAT(' '$) READ(INPUT,610) NFILES 715 DO 730 N=1,NFILES IF(MULTI) CALL RDSFUN(IP,S,NTYPE) DO 720 J=1,NJ J1=IX(J) IF(J1.LE.NJ) GO TO 720 S(J1)=S(J) 720 CONTINUE IF(MULTI) CALL WRSFUN(S) 730 CONTINUE C CALCULATE NEW VALUES FOR NP, NJ, AND NPT 800 NP=NP+NP NJ=NJ+NJ-K NPT=NPT+NPT RETURN END SUBROUTINE MOVE(IP,IQ,L,M,N,NTYPE) DIMENSION IP(NTYPE,1),IQ(NTYPE,1) C MOVE ELEMENTS L THRU M OF IP TO IQ STARTING AT N+1 J1=N-L DO 10 J=L,M J2=J+J1 DO 10 I=1,NTYPE 10 IQ(I,J2)=IP(I,J) RETURN END SUBROUTINE ORDER(NPL,IP,NTYPE) INTEGER OUTPUT DIMENSION NPL(2,1),IP(NTYPE,1) COMMON/CNTL/ NP,NJ,NPT COMMON/DEVI/ INPUT,OUTPUT C NOT AVAILABLE FOR SOLID DATA IF(NTYPE.EQ.4) GO TO 200 WRITE(OUTPUT,100) 100 FORMAT(' %') RETURN C PROCESS EACH PART INDIVIDUALLY 200 M2=0 DO 600 N=1,NP M1=M2+1 M2=M2+NPL(1,N) M3=M1+1 C COMPARE THE NTH THRU LAST ELEMENT WITH THOSE ALREADY ORDERED DO 500 M=M3,M2 L1=M-1 L2=L1+M1 IPT=M C SEARCH THE PREVIOUSLY ORDERED POLYGONS BACKWARDS 210 DO 400 L3=M1,L1 L=L2-L3 C SEARCH FOR A CORRESPONDING NODE NUMBER THEN CHECK LINE C SEGMENT FORWARD AND BACKWARD DO 300 K=1,4 DO 250 J=1,4 IF(IP(J,IPT).NE.IP(K,L).OR.IP(J,IPT).EQ.0) GO TO 250 J1=J+1 IF(J1.GT.4.OR.IP(J1,IPT).EQ.0) J1=1 K1=K+1 IF(K1.GT.4.OR.IP(K1,L).EQ.0) K1=1 J2=J-1 IF(J2.LT.1) J2=4 IF(IP(J2,IPT).EQ.0) J2=3 K2=K-1 IF(K2.LT.1) K2=4 IF(IP(K2,L).EQ.0) K2=3 IF(IP(J1,IPT).EQ.IP(K1,L).OR.IP(J2,IPT).EQ.IP(K2,L)) GO TO 220 IF(IP(J2,IPT).NE.IP(K1,L).AND.IP(J1,IPT).NE.IP(K2,L)) GO TO 400 GO TO 450 C REVERSE POLYGON NODES IF NOT CONSISTENT WITH PROCESSED DATA 220 ITEMP=IP(1,IPT) IP(1,IPT)=IP(3,IPT) IP(3,IPT)=ITEMP GO TO 450 250 CONTINUE 300 CONTINUE 400 CONTINUE C IF CURRENT POLYGON DOES NOT MATCH ANY PREVIOUS POLYGON, C MOVE POINTER TO NEXT POLYGON AND TRY AGAIN IPT=IPT+1 IF(IPT.LE.M2) GO TO 210 C IF POINTER IS GREATER THAN THE NUMBER OF ELEMENTS, THEN C THIS POLYGONS HAS NO NEIGHBOR WRITE(OUTPUT,410) M 410 FORMAT(' %') GO TO 500 C IF THE LAST ORDERED POLYGON IS NOT THE SAME AS THE CURRENT C POLYGON, THEN EXCHANGE THEM 450 IF(IPT.EQ.M) GO TO 500 DO 460 I=1,4 ITEMP=IP(I,M) IP(I,M)=IP(I,IPT) 460 IP(I,IPT)=ITEMP 500 CONTINUE 600 CONTINUE RETURN END SUBROUTINE OPEN(FILEID,IUNIT,IOP,IERROR) C SUBROUTINE OPEN REQUEST FILENAME AND OPENS FILE FOR I/O C SUBPROGRAMS CALLED C OPEN = SYSTEM OPEN FILE ROUTINE C VARIABLES USED C FILEID = 5 ASCII CHARACTER ID C IUNIT = DEVICE LOGICAL NUMBER C IOP = 1 FOR INPUT FILE C = -1 FOR OUTPUT FILE C IERROR = 1 ON SUCCESSFUL COMPLETION C = 0 ON EMPTY FILE SPECIFICATION C = -1 ON FAILURE DOUBLE PRECISION ASEQ,BLANK,XNAME INTEGER OUTPUT COMMON/DEVI/ INPUT,OUTPUT DATA DSK/'DSK'/,MTA/'MTA'/ DATA BLANK/' '/ IERROR=0 OPTYPE='READ' IF(IOP.LT.0) OPTYPE='WRITE' WRITE(OUTPUT,10) OPTYPE,FILEID 10 FORMAT(' <',A5,1X,A5,' FILE> '$) READ(INPUT,20) XNAME 20 FORMAT(A10) IF(XNAME.EQ.BLANK) RETURN IERROR=1 IUNIT=10 ASEQ='SEQIN'  IF(IOP.LT.0) ASEQ='SEQOUT' OPEN(UNIT=IUNIT,DEVICE=DSK,FILE=XNAME,ACCESS=ASEQ,MODE='ASCII') RETURN END SUBROUTINE RDGEOM(NPL,X,IP,N) INTEGER OUTPUT DIMENSION NPL(2,1),X(3,1),IP(N,1) COMMON/CNTL/ NP,NJ,NPT COMMON/DEVI/ INPUT,OUTPUT COMMON/MAXI/ NPMAX,NJMAX,NPTMAX DATA IREAD/1/ C REQUEST FILE INFORMATION 10 CALL OPEN('GEOM.',IUNIT,IREAD,IERR) IF(IERR) 10,50,20 C READ GEOMETRY 20 READ(IUNIT,120) NP,NJ,NPT IF(NP.GT.NPMAX) CALL OVER(1) IF(NJ.GT.NJMAX) CALL OVER(2) IF(NPT.GT.NPTMAX) CALL OVER(3) READ(IUNIT,120) ((NPL(I,J),I=1,2),J=1,NP) READ(IUNIT,130) ((X(I,J),I=1,3),J=1,NJ) READ(IUNIT,120) ((IP(I,J),I=1,N),J=1,NPT) WRITE(OUTPUT,22) ((NPL(I,J),I=1,2),J=1,NP) 22 FORMAT(' '/(1X,10I5)) NPT1=0 DO 24 J=1,NP NPL(1,J)=NPL(2,J)-NPL(1,J)+1 NPL(2,J)=0 24 NPT1=NPT1+NPL(1,J) IF(NPT1.NE.NPT) GO TO 30 WRITE(OUTPUT,28) (NPL(1,J),J=1,NP) 28  FORMAT(' '/(1X,10I5)) WRITE(OUTPUT,140) READ(INPUT,150) ANS IF(ANS.NE.'Y') GO TO 34 RETURN C REQUEST PART GROUPINGS 30 WRITE(OUTPUT,32) 32 FORMAT(' ') 34 WRITE(OUTPUT,36) 36 FORMAT(' '$) READ(INPUT,100) NP IF(NP.GT.NPMAX) CALL OVER(1) DO 38 J=1,NP 38 NPL(2,J)=0 WRITE(OUTPUT,40) 40 FORMAT(' ') READ(INPUT,100) (NPL(1,I),I=1,NP) 50 RETURN 100 FORMAT(20I) 120 FORMAT(20I4) 130 FORMAT(1P6E12.5) 140 FORMAT(' '$) 150 FORMAT(A1) END SUBROUTINE WRGEOM(NPL,X,IP,N) INTEGER OUTPUT DIMENSION NPL(2,1),X(3,1),IP(N,1) COMMON/CNTL/ NP,NJ,NPT COMMON/DEVI/ INPUT,OUTPUT COMMON/MAXI/ NPMAX,NJMAX,NPTMAX DATA IWRITE/-1/ C REQUEST FILE INFORMATION 60 CALL OPEN('GEOM.',IUNIT,IWRITE,IERR) IF(IERR) 60,95,70 C REQUEST ELEMENT LIMITS FOR PARTS LIST 70 NPT1=0 DO 74 J=1,NP NPL(2,J)=NPT1+NPL(1,J) NPL(1,J)=NPT1+1 74 NPT1=NPL(2,J) WRITE(OUTPUT,78) ((NPL(I,J),I=1,2),J=1,NP) 78 FORMAT(' '/(1X,10I5)) WRITE(OUTPUT,140) READ(INPUT,150) ANS IF(ANS.EQ.'Y') GO TO 90 WRITE(OUTPUT,80) 80 FORMAT(' '$) READ(INPUT,100) NP IF(NP.GT.NPMAX) CALL OVER(1) WRITE(OUTPUT,85) 85 FORMAT(' ') READ(INPUT,100) ((NPL(I,J),I=1,2),J=1,NP) C WRITE GEOMETRY FILE  90 WRITE(IUNIT,120) NP,NJ,NPT WRITE(IUNIT,120) ((NPL(I,J),I=1,2),J=1,NP) WRITE(IUNIT,130) ((X(I,J),I=1,3),J=1,NJ) WRITE(IUNIT,120) ((IP(I,J),I=1,N),J=1,NPT) 95 RETURN 100 FORMAT(20I) 120 FORMAT(20I4) 130 FORMAT(6E12.5) 140 FORMAT(' '$) 150 FORMAT(A1) END SUBROUTINE RDSFUN(IP,S,N) INTEGER OUTPUT DIMENSION IP(N,1),S(1) COMMON/CNTL/ NP,NJ,NPT COMMON/DEVI/ INPUT,OUTPUT COMMON/JUNK/ SX(2,1) DATA IREAD/1/ C REQUEST FILE INFORMATION 10 CALL OPEN('SFUN.',IUNIT,IREAD,IERR) IF(IERR) 10,80,20 C ARE THE SCALAR FUNCTIONS DEFINED AT THE ELEMENT CENTERS? 20 WRITE(OUTPUT,30) 30 FORMAT(' '$) READ(INPUT,40) ANS 40 FORMAT(A1) N1=NJ IF(ANS.EQ.'Y') N1=NPT C READ SCALAR FUNCTIONS READ(IUNIT,100) (S(I),I=1,N1) IF(N1.EQ.NJ) RETURN C DO SIMPLE INTERPOLATION IF AT ELEMENT CENTERS. DO 50 J=1,NJ SX(1,J)=0. 50 SX(2,J)=0. DO 60 J=1,NPT  DO 60 I=1,N I1=IP(I,J) SX(1,I1)=S(J)+SX(1,I1) 60 SX(2,I1)=1.0+SX(2,I1) DO 70 I=1,NJ 70 S(I)=SX(1,I)/SX(2,I) 80 RETURN 100 FORMAT(6E12.5) END SUBROUTINE WRSFUN(S) INTEGER OUTPUT DIMENSION S(1) COMMON/CNTL/ NP,NJ,NPT COMMON/DEVI/ INPUT,OUTPUT DATA IWRITE/-1/ C REQUEST FILE INFORMATION 85 CALL OPEN('SFUN.',IUNIT,IWRITE,IERR) IF(IERR) 85,95,90 C WRITE SCALAR FUNCTIONS 90 WRITE(IUNIT,110) (S(I),I=1,NJ) 95 RETURN 110 FORMAT(1P6E12.5) END SUBROUTINE RDDISP(U) INTEGER OUTPUT DIMENSION U(3,1) COMMON/CNTL/ NP,NJ,NPT COMMON/DEVI/ INPUT,OUTPUT DATA IREAD/1/ C REQUEST FILE INFORMAT 10 CALL OPEN('DISP.',IUNIT,IREAD,IERR) IF(IERR) 10,30,20 C READ DISPLACEMENTS 20 READ(IUNIT,100) ((U(I,J),I=1,3),J=1,NJ) 30 RETURN 100 FORMAT(6E12.5) END SUBROUTINE WRDISP(U) INTEGER OUTPUT DIMENSION U(3,1) COMMON/CNTL/ NP,NJ,NPT COMMON/DEVI/ INPUT,OUTPUT DATA IWRITE/-1/ C REQUEST FILE INFORMAT 50 CALL OPEN('DISP.',IUNIT,IWRITE,IERR) IF(IERR) 50,70,60 C WRITE DISPLACEMENTS 60 WRITE(IUNIT,110) ((U(I,J),I=1,3),J=1,NJ) 70 RETURN 110 FORMAT(1P6E12.5) END C**********************************************************************C C C C SECTION.FOR VERSION 1.0(A) SEPTEMBER 1976 C C  C C SECTION.FOR - CLIPS AND CAPS EIGHT NODE BRICK THREE-DIMENSIONAL C C FINITE ELEMENT MODELS, ELEMINATES INTERIOR POLYGONS, AND C C MODIFIES DISPLACEMENT AND SCALAR FUNCTIONS TO REFLECT THIS C C NEW GEOMETRY. C C C C MIKE STEPHENSON HANK CHRISTIANSEN C C DEPARTMENT OF CIVIL ENGR. CIVIL ENGINEERING DEPT. C C AND ENGINEERING MECHANICS 368E ESTB C C THE UNIVERSITY OF ARIZONA BRIGHAM YOUNG UNIVERSITY C C TUCSON, ARIZONA 85721 PROVO, UTAH 84602 C C (602) 884-4803 (801) 374-1211 X2811 C C C C**********************************************************************C C SUBPROGRAMS CALLED C RDCNTL = READS CONTROL VARIABLES C RDGEOM = READS GEOMETRY C PLFILE = CLIPPING PLANE DEFINITION ROUTINE C DIST = DISTANCE TO CLIPPING PLANE ROUTINE C SOLID = CLIPPING AND CAPPING ROUTINE C PLYSRT = POLYGON SORTING ROUTINE C REDUCE = DATA REDUCTION ROUTINE C TRANS = DATA TRANSFORMATION ROUTINE C WRGEOM = WRITES GEOMETRY FILE C RDDISP = READS DISPLACEMENT FILE C WRDISP = WRITES DISPLACEMENT FILE C RDSFUN = READS SCALAR FUNCTION FILE C WRSFUN = WRITES SCALAR FUNCTION FILE C VARIABLES USED C A = COMMON BLOCKSTORAGE C A(N1) = NPL = ELEMENT LIMIT ARRAY BY PART C A(N2) = X = COORDINATE ARRAY BY NODE C A(N3) = IP = CONNECTIVITY ARRAY BY ELEMENT C A(N4) = IPL = CLIPPING PLANE NUMBER BY PART C A(N5) = PLP = POINT ON PLANE BY PART C A(N6) = PLD = NORMAL TO PLANE BY PART C A(N7) = D = DISTANCE TO PLANE BY NODE C = ICOL = NODAL REDUCTION ARRAY C A(N8) = DFAC = PROPORTION OF LINE ARRAY C A(N9) = IFAC = NODES OF CLIPPED LINE SEGMENTS C A(N10) = NPLN = ELEMENT LIMITS OF CLIPPED PARTS C = U = DISPLACEMENT ARRAY C = S = SCALAR FUNCTION ARRAY C A(N11) = IPN = NEW CONNECTIVITY ARRAY AFTER CLIPPING C = SX = SCALAR FUNCTION INTERPOLATION ARRAY C = UN = NEW DISPLACEMT ARRAY AFTER TRANSFORM C = SN = NEW SCALAR FUNCTION ARRAY AFTER TRANSFORM C A(N12) = XN = NEW COORDINATE ARRAY AFTER TRANSFORM C NJ = NUMBER OF JOINTS OR NODES C NP = NUMBER OF PARTS C NPT = NUMBER OF ELEMENTS C MTOT = SIZE OF COMMON BLOCK A C IFILES = NUMBER OF DISP. OR FUNC. FILES C IFIL = DISP. OR FUNC. FILE NUMBER C ICOOR = COORDINATE HASH TABLE C IPOLY = POLYGON HASH TABLE C JNK = TEMPORARY COMMON STORAGE C NPN = NUMBER OF PARTS IN NEW GEOMETRY C NJN = NUMBER OF JOINTS IN NEW GEOMETRY C NPTN = NUMBER OF ELEMENTS IN NEW GEOMETRY C IORD = HEXAHEDRON NODE NUMBER MAP C ITOTAL = NUMBER OF TOTAL STEPS BETWEEN INITAL AND FINAL PLANES C ISTEP = CLIPPING STEP NUMBER C ISIDE = 'FRON' SAVE ONLY POLYGONS IN FRONT OF PLANE C = 'BACK' SAVE ONLY POLYGONS BEHIND PLANE C = 'BOTH' SAVE ALL POLYGONS C IPLAST = PLANE NUMBER OF LAST CLIPPING PLANE INTEGER OUTPUT COMMON A(10000) COMMON/CONT/ NP,NJ,NPT COMMON/DEVI/ INPUT,OUTPUT COMMON/FREE/ MIN,MAX,IAVAIL COMMON/HASH/ ICOOR(128),IPOLY(128) COMMON/JUNK/ JNK(50) COMMON/NCON/ NPN,NJN,NPTN COMMON/ORDR/ IORD(4,6) COMMON/STEP/ ITOTAL,ISTEP,ISIDE,IPLAST DIMENSION IA(10000) EQUIVALENCE (A,IA) INPUT=-4 OUTPUT=-1 IPLAST=-1 MTOT=10000 WRITE(OUTPUT,1000) C READ GEOMETRY FILE CALL RDCNTL(NP,NJ,NPT) NPN=4*NP C CALCULATE ARRAY INDEXES NJ2=(NJ+1)/2 N1=1 N2=N1+2*NP N3=N2+3*(NJ+NJ2) N4=N3+8*NPT  N5=N4+NP N6=N5+6*NP N7=N6+6*NP N8=N7+NJ N9=N8+NJ2 N10=N9+2*NJ2 C READ GEOMETRY CALL RDGEOM(IA(N1),A(N2),IA(N3)) C READ CLIPPING PLANE DEFINITION CALL PLFILE(IA(N4),A(N5),A(N6)) C CALCULATE VIEWABLE POLYGONS C (PROCEED STEP BY STEP AND PART BY PART) DO 600 ISTEP=1,ITOTAL NPTN=0 NJN=NJ MAX=MTOT IAVAIL=0 N11=N10+2*NPN C ZERO POLYGON HASH TABLE DO 100 I=1,128 100 ICOOR(I)=0 DO 200 K=1,NP KSAFE=K C 2. CALCULATE DISTANCE FROM PLANE CALL DIST(A(N2),IA(N4),A(N5),A(N6),A(N7),KSAFE) C 3. CALCULATE INTERSECTION N12=N11+4*NPTN MIN=N12 CALL SOLID(IA(N1),A(N2),IA(N3),IA(N4),A(N7),A(N8),IA(N9),KSAFE) C 4. SORT AND STORE POLYGON LIST CALL PLYSRT(IA(N10),IA(N11),KSAFE) 200 CONTINUE C SELECT USEABLE DATA AND RENUMBER NODES CALL REDUCE(IA(N7),IA(N11)) C PREFORM TRANSFORMATION OF COORDINATES N12=N11+4*NPTN CALL TRGEOM(A(N2),IA(N7),A(N8),IA(N9),A(N12)) CALL WRGEOM(IA(N10),A(N12),IA(N11)) C PERFORM TRANSFORMATION ON DISPLACEMENT AND SPECIAL C FUNCTION FILES N11=N10+3*NJ C 1. DISPLACEMENT FILES WRITE(OUTPUT,1010) READ(INPUT,1020) IFILES IF(IFILES.LE.0) GO TO 400 DO 300 IFIL=1,IFILES CALL RDDISP(A(N10)) CALL TRDISP(A(N10),IA(N7),A(N8),IA(N9),A(N11)) 300 CALL WRDISP(A(N11)) C 2. SPECIAL FUNCTION FILES 400 WRITE(OUTPUT,1030) READ(INPUT,1020) IFILES IF(IFILES.LE.0) GO TO 600 DO 500 IFIL=1,IFILES CALL RDSFUN(A(N3),A(N10),A(N11)) CALL TRSFUN(A(N10),IA(N7),A(N8),IA(N9),A(N11)) 500 CALL WRSFUN(A(N11)) 600 IPLAST=-1 1000 FORMAT(' '//) 1010 FORMAT(' ',$) 1020 FORMAT(I) 1030 FORMAT(' ',$) END BLOCK DATA C BLOCK DATA - HEXAHEDRON NODE NUMBER MAP INITIALIZATION C VARIABLES USED C IORD = HEXAHEDRON NODE NUMBER MAP COMMON/ORDR/ IORD(4,6) DATA IORD/1,2,3,4,5,8,7,6 1 ,1,5,6,2,4,3,7,8 2 ,1,4,8,5,2,6,7,3/ END SUBROUTINE OPEN(FILEID,IUNIT,IOP,IERROR) C SUBROUTINE OPEN REQUEST FILENAME AND OPENS FILE FOR I/O C SUBPROGRAMS CALLED C OPEN = SYSTEM OPEN FILE ROUTINE C VARIABLES USED C FILEID = 5 ASCII CHARACTER ID C IUNIT = DEVICE LOGICAL NUMBER C IOP = 1 FOR INPUT FILE C = -1 FOR OUTPUT FILE C IERROR = 1 ON SUCCESSFUL COMPLETION C  = 0 ON EMPTY FILE SPECIFICATION C = -1 ON FAILURE DOUBLE PRECISION ASEQ,BLANK,XNAME INTEGER OUTPUT COMMON/DEVI/ INPUT,OUTPUT DATA DSK/'DSK'/,MTA/'MTA'/ DATA BLANK/' '/ IERROR=0 OPTYPE='READ' IF(IOP.LT.0) OPTYPE='WRITE' WRITE(OUTPUT,10) OPTYPE,FILEID 10 FORMAT(' <',A5,1X,A5,' FILE> ',$) READ(INPUT,20) XNAME 20 FORMAT(A10) IF(XNAME.EQ.BLANK) RETURN IERROR=1 IUNIT=10 ASEQ='SEQIN' IF(IOP.LT.0) ASEQ='SEQOUT' OPEN(UNIT=IUNIT,DEVICE=DSK,FILE=XNAME,ACCESS=ASEQ,MODE='ASCII') RETURN END SUBROUTINE RDCNTL(NP,NJ,NPT) COMMON/GEOM/ IUNIT,IERR DATA IREAD/1/ C REQUEST FILE INFORMATION 10 CALL OPEN('GEOM.',IUNIT,IREAD,IERR) IF(IERR) 10,50,20 C READ CONTROL VARIABLES 20 READ(IUNIT,100) NP,NJ,NPT 50 RETURN 100 FORMAT(20I4) END SUBROUTINE RDGEOM(NPL,X,IP) DIMENSION NPL(2,1),X(3,1),IP(8,1) COMMON/CONT/ NP,NJ,NPT COMMON/GEOM/ IUNIT,IERR DATA IREAD/1/ C READ GEOMETRY IF(IERR.EQ.0) RETURN READ(IUNIT,100) ((NPL(I,J),I=1,2),J=1,NP) READ(IUNIT,110) ((X(I,J),I=1,3),J=1,NJ) READ(IUNIT,100) ((IP(I,J),I=1,8),J=1,NPT) RETURN 100 FORMAT(20I4) 110 FORMAT(6E12.5) END SUBROUTINE WRGEOM(NPL,X,JP) DIMENSION NPL(2,1),X(3,1),JP(4,1) COMMON/NCON/ NPN,NJN,NPTN DATA IWRITE/-1/ C REQUEST FILE INFORMATION 60 CALL OPEN('GEOM.',IUNIT,IWRITE,IERR) IF(IERR) 60,90,70 C WRITE GEOMETRY FILE 70 WRITE(IUNIT,120) NPN,NJN,NPTN WRITE(IUNIT,120) ((NPL(I,J),I=1,2),J=1,NPN) WRITE(IUNIT,130) ((X(I,J),I=1,3),J=1,NJN) WRITE(IUNIT,120) ((JP(I,J),I=1,4),J=1,NPTN) 90 RETURN 120 FORMAT(20I4) 130 FORMAT(1P6E12.5) END SUBROUTINE RDSFUN(IP,S,SX) INTEGER OUTPUT DIMENSION IP(8,1),S(1),SX(2,1) COMMON/CONT/ NP,NJ,NPT COMMON/DEVI/ INPUT,OUTPUT DATA IREAD/1/ C REQUEST FILE INFORMATION 10 CALL OPEN('SFUN.',IUNIT,IREAD,IERR) IF(IERR) 10,80,20 C ARE THE SCALAR FUNCTIONS DEFINED AT THE ELEMENT CENTERS? 20 WRITE(OUTPUT,30) 30 FORMAT(' ',$) READ(INPUT,40) ANS 40 FORMAT(A1) N1=NJ IF(ANS.EQ.'Y') N1=NPT C READ SCALAR FUNCTIONS READ(IUNIT,100) (S(I),I=1,N1) IF(N1.EQ.NJ) RETURN C DO SIMPLE INTERPOLATION IF AT ELEMENT CENTERS. DO 50 J=1,NJ SX(1,J)=0. 50 SX(2,J)=0. DO 60 J=1,NPT DO 60 I=1,8 I1=IP(I,J) SX(1,I1)=S(J)+SX(1,I1) 60 SX(2,I1)=1.0+SX(2,I1) DO 70 I=1,NJ 70 S(I)=SX(1,I)/SX(2,I) 80 RETURN 100 FORMAT(6E12.5) END SUBROUTINE WRSFUN(S) INTEGER OUTPUT DIMENSION S(1) COMMON/DEVI/ INPUT,OUTPUT COMMON/NCON/ NPN,NJN,NPTN DATA IWRITE/-1/ C REQUEST FILE INFORMATION 85 CALL OPEN('SFUN.',IUNIT,IWRITE,IERR) IF(IERR) 85,95,90 C WRITE SCALAR FUNCTIONS 90 WRITE(IUNIT,110) (S(I),I=1,NJN) 95 RETURN 110 FORMAT(1P6E12.5) END SUBROUTINE RDDISP(U) DIMENSION U(3,1) COMMON/CONT/ NP,NJ,NPT DATA IREAD/1/ C REQUEST FILE INFORMAT 10 CALL OPEN('DISP.',IUNIT,IREAD,IERR) IF(IERR) 10,30,20 C READ DISPLACEMENTS 20 READ(IUNIT,100) ((U(I,J),I=1,3),J=1,NJ) 30 RETURN 100 FORMAT(6E12.5) END SUBROUTINE WRDISP(U) DIMENSION U(3,1) COMMON/NCON/ NPN,NJN,NPTN DATA IWRITE/-1/ C REQUEST FILE INFORMAT 50 CALL OPEN('DISP.',IUNIT,IWRITE,IERR) IF(IERR) 50,70,60 C WRITE DISPLACEMENTS 60 WRITE(IUNIT,110) ((U(I,J),I=1,3),J=1,NJN) 70 RETURN 100 FORMAT(6E) 110 FORMAT(1P6E12.5) END SUBROUTINE PLFILE(IPL,PLP,PLD) C SUBROUTINE PLFILE - REQUEST INFORMATION NECESSARY TO DEFINE THE C CLIPPING PLANE FOR EACH PART IN THE MODEL AND ALSO WHICH C DATA IS TO BE SAVED. C VARIABLES USED C IPL = PLANE NUMBER BY PART C PLP = POINT ON PLANE BY PART C PLD = NORMAL TO PLANE BY PART C ITOTAL = TOTAL STEPS BETWEEN INITIAL AND FINAL PLANES C ISTEP = STEP NUMBER C ISIDE = 'FRON' TO SAVE ONLY POLYGONS IN FRONT OF CLIPPING PLANE C = 'BACK' TO SAVE ONLY POLYGONS BEHIND CLIPPING PLANE C = 'BOTH' TO SAVE ALL POLYGONS INTEGER OUTPUT DIMENSION IPL(1),PLP(3,2,1),PLD(3,2,1) COMMON/CONT/ NP,NJ,NPT COMMON/DEVI/ INPUT,OUTPUT COMMON/JUNK/ K1,K2,PLPJ(3,2),PLDJ(3,2) COMMON/STEP/ ITOTAL,ISTEP,ISIDE C INITIALIZE VARIABLES ITOTAL=1 ISIDE='FRON' DO 10 I=1,NP 10 IPL(I)=0 N=0 C REQUEST NUMBER OF STEPS WRITE(OUTPUT,100) READ(INPUT,110) ITTL IF(ITTL-1) RETURN ITOTAL=ITTL C REQUEST PLANE DEFINITION BY PARTS WRITE(OUTPUT,120) 20 READ(INPUT,110) K1,K2,((PLPJ(I,J),I=1,3) 1,(PLDJ(I,J),I=1,3),J=1,2) IF(K1.LE.0) GO TO 40 N=N+1 IF(K2.LT.K1) K2=K1 DO 30 K=K1,K2 IPL(K)=N DO 30 J=1,2 DO 30 I=1,3 PLP(I,J,K)=PLPJ(I,J) 30 PLD(I,J,K)=PLDJ(I,J) GO TO 20  C REQUEST SIDE OF PLANE 40 WRITE(OUTPUT,130) READ(INPUT,140) ISIDE IF(ISIDE.NE.'FRON'.AND.ISIDE.NE.'BACK') ISIDE='BOTH' RETURN 100 FORMAT(' ',$) 110 FORMAT(2I,12E) 120 FORMAT(' '/ 1 ' ') 130 FORMAT(' ',$) 140 FORMAT(A4) END SUBROUTINE DIST(X,IPL,PLP,PLD,D,N) C SUBROUTINE DIST - CALCULATES DISTANCE FROM CLIPPING PLANE TO NODE C VARIABLLS USED C X = COORDINATE ARRAY BY NODE C IPL = CLIPPING PLANE NUMBER BY PART C PLP = POINT ON PLANE BY PART C PLD = NORMAL TO PLANE BY PART C D = DISTANCE TO PLANE BY NODE C N = PART NUMBER C NJ = NUMBER OF JOINTS OR NODES C NP = NUMBER OF PARTS C NPT = NUMBER OF ELEMENTS C ITOTAL = TOTAL NUMBER OF STEPS BETWEEN CLIPPING PLANES C ISTEP = STEP NUMBER BETWEEN CLIPPING PLANES C ISIDE = DATA SAVE INDICATOR C IPLAST = NUMBER OF LAST CLIPPING PLANE USED DIMENSION X(3,1),IPL(1),PLP(3,2,1),PLD(3,2,1),D(1) COMMON/CONT/ NP,NJ,NPT COMMON/JUNK/ PX(3),PD(3) COMMON/STEP/ ITOTAL,ISTEP,ISIDE,IPLAST C IF PLANE SAME AS LAST THEN RETURN ELSE ZERO DISTANCE ARRAY IF(IPL(N).EQ.IPLAST) RETURN DO 10 I=1,NJ 10 D(I)=0.0 IPLAST=IPL(N) IF(IPL(N).EQ.0) RETURN C CALCULATE INTEMEDIATE PLANE DEFINITION STEP=0. IF(ITOTAL-2) GO TO 20 STEP=(ISTEP-1)/(ITOTAL-1) 20 DO 30 I=1,3 PX(I)=PLP(I,1,N)+STEP*(PLP(I,2,N)-PLP(I,1,N)) 30 PD(I)=PLD(I,1,N)+STEP*(PLD(I,2,N)-PLD(I,1,N)) C CALCULATE DISTANCE TO PLANE DO 40 J=1,NJ D(J)=0. DO 40 I=1,3 40 D(J)=D(J)+(X(I,J)-PX(I))*PD(I) RETURN END SUBROUTINE SOLID(NPL,X,IP,IPN,D,DFAC,IFAC,L) C SUBROUTINE SOLID - CLIPS AND CAPS HEXAHEDRON ELEMENTS USING C PERPENDICULAR DISTANCE TO PLANE. C SUBPROGRAMS CALLED C SPLIT = CLIPS INDIVIDUAL POLYGONS ALONG CLIPPING PLANE C LOOKUP = HASH TABLE LOOKUP ROUTINE C ENTER = HASH TABLE ENTER ROUTINE C VARIABLES USED C NPL = PARTS ARRAY C IP = CONNECTIVITY ARRAY C IPN = CLIPPING PLANE NUMBER ARRAY BY PART C D = DISTANCE TO PLANE BY NODE C DFAC = PROPORTION OF LINE SEGMENT ARRAY C IFAC = NODE NUMBERS OF CLIPPED LINE SEGMENTS C ICOOR = COORDINATE HASH TABLE C IPOLY = POLYGON HASH TABLE C L = PART NUMBER C NJ = NUMBER OF JOINTS OR NODES C NP = NUMBER OF PARTS C NPT = NUMBER OF ELEMENTS C  XX = CLIPPED COORDINATE POINT C ITEMP = POLYGON NODE NUMBERS C IPFT = NODE NUMBERS OF POLYGON IN FRONT OF PLANE C IPBT = NODE NUMBERS OF POLYGON BEHIND PLANE C IPPT = NODE NUMBERS OF LINE SEGMENTS OF POLYGON ON PLANE C ISEG = ON-PLANE POLYGON LINE SEGMENTS C NLAST = NUMBER OF LAST POLYGON AFTER SORTING C NCOOR = NUMBER OF LAST NEW COORDINATE ENTERED IN HASH TABLE C IORD = HEXAHEDRON POLYGON NODE NUMBER MAP C KPLACE = INDEX TO HASH TABLE C ITOTAL = TOTAL NUMBER OF STEPS BETWEEN CLIPPING PLANES C ISTEP = STEP NUMBER C ISIDE = 'FRON' TO SAVE ONLY POLYGONS IN FRONT OF CLIPPING PLANE C = 'BACK' TO SAVE ONLY POLYGONS IN BEHIND CLIPPING PLANE C = 'BOTH' TO SAVE ALL POLYGONS C NPLN = POLYGON NUMBER (USED IN SORTING) C L1, L2 = LIMITS OF ELEMENTS IN THIS PART C KEY = KEY USED IN HASH INDEX CALCULATION C ITEST = FRONT, ON-PLANE, BACK POLYGON INDICATOR C NP2 = COUNT OF ON-PLANE INTERSECTIONS INTEGER OUTPUT DIMENSION NPL(2,1),X(3,1),IP(8,1),IPN(1),D(1),DFAC(1),IFAC(2,1) COMMON/CONT/ NP,NJ,NPT COMMON/DEVI/ INPUT,OUTPUT COMMON/HASH/ ICOOR(128),IPOLY(128) COMMON/JUNK/ XX(3),ITEMP(4),IPFT(6),IPBT(6),ISEG(6),IPPT(12) COMMON/NCON/ NPN,NCOOR,NLAST COMMON/ORDR/ IORD(4,6) COMMON/SAVE/ KPLACE,IPT COMMON/STEP/ ITOTAL,ISTEP,ISIDE C GET ELEMENT LIMITS AND ZERO POLYGON HASH TABLE L1=NPL(1,L) L2=NPL(2,L) NPLN=0 DO 4 I=1,128 4 IPOLY(I)=0 C REPEAT FOR EACH ELEMENT IN PART DO 95 J=L1,L2 C ZERO ON-PLANE POLYGON ARRAY NJP=0 DO 5 I=1,12 5 IPPT(I)=0 C REPEAT FOR EACH FACE OF HEXAHEDRON DO 90 K=1,6 C SET ITEMP EQUAL TO POLYGON NODES DO 20 I=1,4 J1=IORD(I,K) 20 ITEMP(I)=IP(J1,J) C CALCULATE INTERSECTION WITH PLANE; IF MORE THAN TWO C INTERSECTIONS TREAT AS WARPPED QUADRILATERAL. CALL SPLIT(X,IPN(L),D,DFAC,IFAC,NP2,NPLN) IF(NP2-2) 90,10,21 10 NJP=NJP+2 IPPT(NJP-1)=ISEG(1) IPPT(NJP)=ISEG(2) GO TO 90 C FIND HIGH NODES AND DIVIDE WARPPED QUADRILATERAL. 21 DO 22 I=1,4 I1=I J1=ITEMP(I) IF(D(J1).GT.0.0) GO TO 24 22 CONTINUE DO 23 I=1,4 I1=I J1=ITEMP(I) IF(D(J1).LT.0.0) GO TO 25 23 CONTINUE GO TO 100 24 I1=I1-1 25 I2=I1 DO 27 I=1,3 I2=I2+1 IF(I2.GT.4) I2=I2-4 J1=IORD(I2,K) 27 ITEMP(I)=IP(J1,J) ITEMP(4)=0 C CALCULATE INTERSECTION WITH POLYGON CALL SPLIT(X,IPN(L),D,DFAC,IFAC,NP2,NPLN) IF(NP2-2) 50,30,100 30 NJP=NJP+2 IPPT(NJP-1)=ISEG(1) IPPT(NJP)=ISEG(2) C LOAD ITEMP WITH SECOND HALF OF WARPED QUADRILATERAL I2=I1+2 DO 40 I=1,3 I2=I2+1 IF(I2.GT.4) I2=I2-4 J1=IORD(I2,K) 40 ITEMP(I)=IP(J1,J) ITEMP(4)=0 C CALCULATE POLYGON INTERSECTION 50 CALL SPLIT(X,IPN(L),D,DFAC,IFAC,NP2,NPLN) IF(NP2-2) 90,60,100 60 NJP=NJP+2 IPPT(NJP-1)=ISEG(1) IPPT(NJP)=ISEG(2) 90  CONTINUE C IF LESS THAN SIX INTERSECTION ON-PLANE THEN JUMP IF(NJP-5) GO TO 95 C ORDER ON-PLANE POLYGON LINE SEGMENTS CALL ORDER(IPPT,NJP,ITRIA) IF(ITRIA.LE.1) GO TO 93 DO 91 I=1,3 I1=I+3 ITEMP(I)=IPPT(I) IPPT(I)=IPPT(I1) ITEMP(I1)=0 91 IPPT(I1)=0 NJP=3 C DO LOOKUP AND ENTER FOR ON-PLANE POLYGON NPLN=NPLN+1 KEY=0 DO 92 I=1,NJP 92 KEY=KEY+ITEMP(I) ITEST=524288+NJP CALL LOOKUP(IPOLY,KEY,IFD,NPLT,X,ITEST,ITEMP,6) IF(.NOT.IFD) CALL ENTER(IPOLY,KEY,NPLN,ITEST,ITEMP,6) 93 NPLN=NPLN+1 KEY=0 DO 94 I=1,NJP 94 KEY=KEY+IPPT(I) ITEST=524288+NJP CALL LOOKUP(IPOLY,KEY,IFD,NPLT,X,ITEST,IPPT,6) IF(.NOT.IFD) CALL ENTER(IPOLY,KEY,NPLN,ITEST,IPPT,6) 95 CONTINUE RETURN C CLIPPING AND CAPPING ERRORS 100 WRITE(OUTPUT,110) 110 FORMAT(' ?') STOP END SUBROUTINE SPLIT(X,IPN,D,DFAC,IFAC,NP2,NPLN) C SUBROUTINE SPLIT - SPLITS A POLYGON INTO FRONT AND BACK POLYGONS C AND SAVE THE LINE SEMENT FOR USE IN FORMING THE CAP. C SUBPROGRAMS CALLED C LOOKUP = HASH TABLE LOOKUP ROUTINE C ENTER = HASH TABLE ENTER ROUTINE C VARIABLES USED C X = COORDINATE ARRAY C IPN = CLIPPING PLANE NUMBER BY PART C D = DISTANCE FROM NODE TO CLIPPING PLANE C DFAC = PROPORTION OF LINE SEGMENT C IFAC = NODES OF CLIPPED LINE SEGMENTS C ICOOR = COORDINATE HASH TABLE C IPOLY = POLYGON HASH TABLE C NJ = NUMBER OF JOINTS OR NODES C NP = NUMBER OF PARTS C NPT = NUMBER OF ELEMENTS C XX = COORDINATE OF CALCULATED INTERSECTION C ITEMP = TEMPORARY CONNECTIVITY ARRAY FOR POLYGON C IPFT = FRONT POLYGON CONNECTIVITY C IPBT = BACK POLYGON CONNECTIVITY C ISEG = ON-PLANE POLYGON LINE SEGMENT C NLAST = LAST POLYGON NUMBER AFTER POLYGON SORTING C NCOOR = NUMBER OF LAST COORDINATE ENTERED INTO HASH TABLE C KPLACE = INDEX TO HASH TABLE C IPT = HASH TABLE POINTER C ITOTAL = TOTAL NUMBER OF STEPS BETWEEN CLIPPING PLANES C ISTEP = CLIPPING PLANE STEP NUMBER C ISIDE = 'FRON' TO SAVE ONLY POLYGONS IN FRONT OF PLANE C = 'BACK' TO SAVE ONLY POLYGONS BEHIND PLANE C = 'BOTH' TO SAVE ALL POLYGONS C NJF = NUMBER OF NODES IN FRONT POLYGON C NJB = NUMBER OF NODES IN BACK POLYGON C NP2 = COUNT OF ON-PLANE INTERSECTIONS C NPLN = POLYGON NUMBER FOR SORTING DIMENSION X(3,1),D(1),DFAC(1),IFAC(2,1) COMMON/CONT/ NP,NJ,NPT COMMON/HASH/ ICOOR(128),IPOLY(128) COMMON/JUNK/ XX(3),ITEMP(4),IPFT(6),IPBT(6),ISEG(6),IPPT(12) COMMON/NCON/ NPN,NCOOR,NLAST COMMON/SAVE/ KPLACE,IPT COMMON/STEP/ ITOTAL,ISTEP,ISIDE C REPEAT FOR EACH NODE IN POLYGON NJB=0 NJF=0 NP2=0 DO 10 I=1,6 IPFT(I)=0 IPBT(I)=0 10 ISEG(I)=0 DO 40 I1=1,4 C SET J1 = FIRST NODE AND J2 = SECOND NODE OF LINE SEGMENT I2=I1+1 IF(I2.GT.4) I2=1 IF(ITEMP(I1).EQ.0) GO TO 41 J1=ITEMP(I1)  J2=ITEMP(I2) IF(J2.EQ.0) J2=ITEMP(1) C IF DISTANCE IS NEGATIVE, ZERO, POSITIVE THEN GO TO 15, 20, 30 IF(D(J1)) 15,20,30 15 IF(ISIDE.EQ.'FRON') GO TO 35 NJB=NJB+1 IPBT(NJB)=J1 GO TO 35 20 IF(ISIDE.EQ.'FRON') GO TO 22 NJB=NJB+1 IPBT(NJB)=J1 IF(ISIDE.EQ.'BACK') GO TO 24 22 NJF=NJF+1 IPFT(NJF)=J1 24 IF(IPN.EQ.0) GO TO 35 NP2=NP2+1 ISEG(NP2)=J1 GO TO 35 30 IF(ISIDE.EQ.'BACK') GO TO 35 NJF=NJF+1 IPFT(NJF)=J1 C IF NODES LIE ON OPPOSITE SIDES OF PLANE THEN CALCULATE C PROPORTION ELSE JUMP. 35 IF((D(J1)*D(J2)).GE.0.0) GO TO 40 FAC=D(J1)/(D(J2)-D(J1)) C CALCULATE COORDINATE OF INTERSECTION DO 34 JJ=1,3 34 XX(JJ)=X(JJ,J1)-FAC*(X(JJ,J2)-X(JJ,J1)) KEY=INT(XX(1)+XX(2)-XX(3)) C SEARCH FOR COORDINATE IN HASH TABLE CALL LOOKUP(ICOOR,KEY,IFD,NJT,X,ITEST,ITEMP,2) IF(IFD) GO TO 36 NCOOR=NCOOR+1 C IF COORDINATE NOT FOUND THEN ENTER IT INTO HASH TABLE  CALL ENTER(ICOOR,KEY,NCOOR,ITEST,ITEMP,2) C SAVE PROPORTION AND NODE NUMBERS OF CLIPPED LINE SEGMENT C FOR USE IN DATA TRANSFORMATION. NJT=NCOOR II=NJT-NJ DFAC(II)=FAC IFAC(1,II)=J1 IFAC(2,II)=J2 C ENTER COORDINATE IN COORDINATE ARRAY DO 33 JJ=1,3 33 X(JJ,NJT)=XX(JJ) C ENTER COORDINATE NODE NUMBER IN POLYGON CONNECTIVITY ARRAYS 36 IF(ISIDE.EQ.'FRON') GO TO 42 NJB=NJB+1 IPBT(NJB)=NJT IF(ISIDE.EQ.'BACK') GO TO 44 42 NJF=NJF+1 IPFT(NJF)=NJT 44 NP2=NP2+1 ISEG(NP2)=NJT 40 CONTINUE C CHECK FOR ON-PLANE POLYGONAL FACE 41 IF(NP2.NE.4) GO TO 58 DO 50 I=1,4 50 IF(ISEG(I).GT.NJ) GO TO 58 GO TO 90 C ENTER FRONT AND BACK POLYGONS C IF FRONT POLYGON THEN DO LOOKUP AND ENTER OR DELETE 58 IF(NJF.LT.3) GO TO 60 NPLN=NPLN+1 KEY=0 DO 59 I=1,NJF 59 KEY=KEY+IPFT(I) ITEST=262144+NJF CALL LOOKUP(IPOLY,KEY,IFD,NJT,X,ITEST,IPFT,6) IF(.NOT.IFD) CALL ENTER(IPOLY,KEY,NPLN,ITEST,IPFT,6) IF(IFD) CALL DELETE(IPOLY,6) C IF BACK POLYGON THEN DO LOOKUP AND ENTER OR DELETE 60 IF(NJB.LT.3) GO TO 80 71 NPLN=NPLN+1 KEY=0 DO 72 I=1,NJB 72 KEY=KEY+IPBT(I) ITEST=1048576+NJB CALL LOOKUP(IPOLY,KEY,IFD,NJT,X,ITEST,IPBT,6) IF(.NOT.IFD) CALL ENTER(IPOLY,KEY,NPLN,ITEST,IPBT,6) IF(IFD) CALL DELETE(IPOLY,6) C IF ONLY ONE INTERSECTION THEN RESET NP2 80 IF(NP2.EQ.1) NP2=0 RETURN C ENTER ON-PLANE POLYGON 90 NPLN=NPLN+1 KEY=0 DO 92 I=1,NP2 92 KEY=KEY+ISEG(I) ITEST=524288+NP2 CALL LOOKUP(IPOLY,KEY,IFD,NJT,X,ITEST,ISEG,6) IF(.NOT.IFD) CALL ENTER(IPOLY,KEY,NPLN,ITEST,ISEG,6) NP2=0 RETURN END SUBROUTINE LOOKUP(KVALS,KEY,IFD,IVAL,X,ITEST,ITEMP,N) C SUBROUTINE LOOKUP - HASH TABLE LOOKUP ROUTINE C VARIABLES USED C X = COORDINATE ARRAY C KVALS = HASH TABLE POINTERS C KEY = HASH INDEX CALCULATION KEY C IVAL = NODE NUMBER OF FOUND COORDINATE C IFD = -1 IF FOUND C = 0 IF NOT FOUND C ITEMP = POLYGON CONNECTIVITY C ITEST = POLYGON ASSOCIATED VALUE C KPLACE = HASH TABLE INDEX C IPT = HASH TABLE POINTER C XX = NEW COORDINATE DIMENSION X(3,1),KVALS(1),ITEMP(1),IP(6) COMMON IFREE(1) COMMON/JUNK/ XX(3) COMMON/SAVE/ KPLACE,IPT C CALCULATE HASH TABLE INDEX IFD=.FALSE. I2=MOD(KEY,512) I1=KEY/(2**9) I1=MOD(I1+I2,128) KPLACE=I1+1 IPT=KVALS(KPLACE) C IF NULL POINTER THEN NOT FOUND 11 IF(IPT.EQ.0) RETURN C IF FOUND THEN GO TO 31 IF(IFREE(IPT).EQ.KEY) GO TO 31 C INCREMENT POINTER 21 IPT=MOD(IFREE(IPT+1),262144) GO TO 11 C IF POLYGON THEN JUMP 31 IF(N.GT.2) GO TO 34 C CHECK COORDINATES IVAL=IFREE(IPT+1)/(2**18) X1=XX(1)-X(1,IVAL) X2=XX(2)-X(2,IVAL) X3=XX(3)-X(3,IVAL) X1=X1*X1+X2*X2+X3*X3 X2=X(1,IVAL)*X(1,IVAL)+X(2,IVAL)*X(2,IVAL)+X(3,IVAL)*X(3,IVAL) IF(X2.EQ.0.0) X2=1.0 X3=SQRT(X1/X2) IF(X3.GT.1.0E-04) GO TO 21 IFD=.TRUE. RETURN C CHECK POLYGON 34 IF(ITEST.NE.IFREE(IPT+2)) GO TO 21 C GET SIZE OF POLYGON AND FIND NODE OFFSET ISIZE=MOD(ITEST,262144) DO 40 I=3,5 I1=I*2-5 I2=I1+1 I3=IPT+I IP(I1)=IFREE(I3)/(2**18) 40 IP(I2)=MOD(IFREE(I3),262144) DO 41 IOFF=1,ISIZE IF(ITEMP(IOFF).EQ.IP(1)) GO TO 51 41 CONTINUE GO TO 21 C DETERMINE IF POLYGON IS SAME OR OPPOSITE ORDERING 51 IMOVE=1 II1=IOFF-1 IF(II1.LE.0) II1=ISIZE IF(ITEMP(II1).EQ.IP(2)) IMOVE=-1 DO 61 I=2,ISIZE IOFF=IOFF+IMOVE IF(IOFF.GT.ISIZE) IOFF=1 IF(IOFF.LE.0) IOFF=ISIZE IF(ITEMP(IOFF).NE.IP(I)) GO TO 21 61 CONTINUE IFD=.TRUE. RETURN END SUBROUTINE ENTER(KVALS,KEY,IVAL,ITEST,ITEMP,N) C SUBROUTINE ENTER - HASH TABLE ENTER ROUTINE C VARIABLE USED C KVALS = HASH TABLE POINTERS C KEY = HASH TABEL INDEX CALCULATION KEY C IVAL = HASH TABLE VALUE C ITEMP = TEMPORARY POLYGON ARRAY C ITEST = POLYGON ASSOCIATED VARIABLE C N = HASH TABEL BLOCK SIZE C XX = NEW COORDINATE C KPLACE = HASH TABLE INDEX C IPT = HASH TABLE POINTER DIMENSION KVALS(1),ITEMP(1) COMMON IFREE(1) COMMON/JUNK/ XX(3) COMMON/SAVE/ KPLACE,IPT C ENTER DATA CALL GETBLK(IPT,N) IFREE(IPT)=KEY IFREE(IPT+1)=IVAL*(2**18)+KVALS(KPLACE) KVALS(KPLACE)=IPT I1=IPT+1 C IF COORDINATE THEN RETURN IF(N.EQ.2) RETURN IFREE(IPT+2)=ITEST IFREE(IPT+3)=ITEMP(1)*(2**18)+ITEMP(2) IFREE(IPT+4)=ITEMP(3)*(2**18)+ITEMP(4) IFREE(IPT+5)=ITEMP(5)*(2**18)+ITEMP(6) I1=IPT+5 RETURN END SUBROUTINE DELETE(KVALS,N) C SUBROUTINE DELETE - DELETES DATA BLOCKS FROM HASH TABLE C SUBPROGRAMS CALLED C RETBLK = RETURN DATA BLOCK TO FREE STORAGE C VARIABLES USED C KVALS = HASH TABLE POINTERS C N = HASH TABLE BLOCK SIZE C KPLACE = HASH TABLE INDEX C IPT = HASH TABLE POINTER C IFREE = FREE STORAGE INTEGER OUTPUT DIMENSION KVALS(1) COMMON IFREE(1) COMMON/DEVI/ INPUT,OUTPUT COMMON/SAVE/ KPLACE,IPT C DELETE FIRST DATA BLOCK FROM TABLE IPT1=KVALS(KPLACE) IF(IPT1.NE.IPT) GO TO 10 KVALS(KPLACE)=MOD(IFREE(IPT+1),262144) CALL RETBLK(IPT,N) RETURN C IF NOT FIRST BLOCK THEN FOLLOW POINTERS 10 IPT2=MOD(IFREE(IPT1+1),262144) IF(IPT2.EQ.IPT) GO TO 20 IPT1=IPT2 IF(IPT1.NE.0) GO TO 10 WRITE(OUTPUT,15) 15 FORMAT(' ?') STOP C ADJUST POINTERS TO BRIDGE DELETED BLOCK 20 IFREE(IPT1+1)=IFREE(IPT1+1)/(2**18)*(2**18) 1+MOD(IFREE(IPT+1),262144) CALL RETBLK(IPT,N) RETURN END SUBROUTINE GETBLK(IPT,N) INTEGER OUTPUT COMMON IFREE(1) COMMON/DEVI/ INPUT,OUTPUT COMMON/FREE/ MIN,NEXT,IAVAIL IF(IAVAIL.EQ.0) GO TO 30 IPT=IAVAIL IF(IFREE(IPT+1).NE.N) GO TO 10 IAVAIL=IFREE(IPT) RETURN 10 IPT1=IFREE(IPT) IF(IPT1.EQ.0) GO TO 30 IF(IFREE(IPT1+1).NE.N) GO TO 20 IFREE(IPT)=IFREE(IPT1) IPT=IPT1 RETURN 20 IPT=IPT1 GO TO 10 30 IPT=NEXT-N NEXT=IPT IF(NEXT.GT.MIN) RETURN WRITE(OUTPUT,40) 40 FORMAT(' ?') STOP ENTRY RETBLK(IPT,N) IFREE(IPT)=IAVAIL IFREE(IPT+1)=N IAVAIL=IPT RETURN END SUBROUTINE ORDER(ITEMP,NJP,ITRIA) C SUBROUTINE ORDER - MATCHES END-POINTS OF LINE SEGMENTS C TO FORM POLYGONS C VARIABLES USED C ITEMP = POLYGON LINE SEGMENT ARRAY C NJP = NUMBER OF NODES IN ITEMP INTEGER OUTPUT DIMENSION ITEMP(1) COMMON/DEVI/ INPUT,OUTPUT C ORDER LINE SEGMENTS ITRIA=1 I1=NJP-2 DO 40 IPT=2,I1,2 C SEARCH FOR CORRESPONDING NODE I2=IPT+1 DO 10 I=I2,NJP I3=I 10 IF(ITEMP(IPT).EQ.ITEMP(I3)) GO TO 20 ITRIA=ITRIA+1 IF(ITRIA.LE.2) GO TO 40 WRITE(OUTPUT,15) 15 FORMAT(' ?') STOP C REVERSE LINE SEGMENT IF NECESSARY 20 IF(I3.NE.I3/2*2) GO TO 30 II1=ITEMP(I3) ITEMP(I3)=ITEMP(I3-1) ITEMP(I3-1)=II1 I3=I3-1 C SWAP LINE SEGMENTS 30 II1=ITEMP(IPT+1) II2=ITEMP(IPT+2) ITEMP(IPT+1)=ITEMP(I3) ITEMP(IPT+2)=ITEMP(I3+1) ITEMP(I3)=II1 ITEMP(I3+1)=II2 40 CONTINUE C ELEMINATE REDUNDANT NUMBERING OF NODES NJP=NJP/2 DO 50 I=1,NJP I1=2*I-1 50 ITEMP(I)=ITEMP(I1) C ZERO REMAINING ELEMENTS I1=NJP+1 DO 55 I=I1,12 55 ITEMP(I)=0 RETURN END SUBROUTINE PLYSRT(NPL,IJN,N) C SUBROUTINE PLYSRT - SORTS POLYGONS IN HASH TABLE C VARIABLES USED C NPL = PARTS ARRAY C IJN = CONNECTIVITY ARRAY C N = PART NUMBER C NCOUNT = TEMPORARY PARTS COUNT C ITEMP = TEMPORARY POLYGON VERTICE ARRAY C NLAST = LAST POLYGON NUMBER IN IJN DIMENSION NPL(2,1),IJN(4,1) COMMON IFREE(1) COMMON/CONT/ NP,NJ,NPT COMMON/HASH/ ICOOR(128),IPOLY(128) COMMON/JUNK/ NCOUNT(3),ILST(3),ITEMP(6) COMMON/NCON/ NPN,NCOOR,NLAST C ZERO NCOUNT DO 5 I=1,3 ILST(I)=0 5 NCOUNT(I)=0 C SORT POLYGONS ACCORDING TO FRONT, ON-PLANE, AND BACK AND C BY POLYGON NUMBER DO 70 ILOC=1,128 IF(IPOLY(ILOC).EQ.0) GO TO 70 IBLK=IPOLY(ILOC) 10 I1=IFREE(IBLK+2)/(2**18) IPT=ILST(I1) IF(IPT.NE.0) GO TO 20 IFREE(IBLK)=0 ILST(I1)=IBLK GO TO 60 20 IF(IFREE(IBLK+1).GT.IFREE(IPT+1)) GO TO 30 IFREE(IBLK)=ILST(I1) ILST(I1)=IBLK GO TO 60 30 IF(IFREE(IPT).NE.0) GO TO 40 IFREE(IBLK)=0 IFREE(IPT)=IBLK GO TO 60 40 IPT1=IFREE(IPT) IF(IFREE(IBLK+1).GT.IFREE(IPT1+1)) GO TO 50 IFREE(IBLK)=IPT1 IFREE(IPT)=IBLK GO TO 60 50 IPT=IPT1 GO TO 30 60 IBLK=MOD(IFREE(IBLK+1),262144) IF(IBLK.EQ.0) GO TO 70 GO TO 10 70 CONTINUE C FORM QUADRILATERALS AND TRIANGLES FROM DATA DO 100 I=1,3 IPT=ILST(I) 75 IF(IPT.EQ.0) GO TO 100 ISIZE=MOD(IFREE(IPT+2),262144) DO 80 J=3,5 I1=2*J-5 I2=I1+1 I3=IPT+J ITEMP(I1)=IFREE(I3)/(2**18) 80 ITEMP(I2)=MOD(IFREE(I3),262144) IPT1=IFREE(IPT) CALL RETBLK(IPT,6) IPT=IPT1 NLAST=NLAST+1 NCOUNT(I)=NCOUNT(I)+1 DO 85 J=1,4 85 IJN(J,NLAST)=ITEMP(J) IF(ISIZE.LE.4) GO TO 75 NLAST=NLAST+1  NCOUNT(I)=NCOUNT(I)+1 IJN(1,NLAST)=ITEMP(1) DO 90 J=2,4 90 IJN(J,NLAST)=ITEMP(J+2) GO TO 75 100 CONTINUE C STORE NCOUNT IN PARTS ARRAY NLAST1=NLAST+1 NCOUNT(2)=NCOUNT(2)+NCOUNT(3) NCOUNT(1)=NCOUNT(1)+NCOUNT(2) NPL(1,N)=NLAST1-NCOUNT(1) NPL(2,N)=NLAST-NCOUNT(2) K=NP+N NPL(1,K)=NLAST1-NCOUNT(2) NPL(2,K)=NLAST-NCOUNT(3) K=K+NP NPL(1,K)=NLAST1-NCOUNT(2) NPL(2,K)=NLAST-NCOUNT(3) K=K+NP NPL(1,K)=NLAST1-NCOUNT(3) NPL(2,K)=NLAST RETURN END SUBROUTINE REDUCE(ICOL,IJN) C SUBROUTINE REDUCE - FORMS A REDUCE VECTOR OF NODE NUMBERS C VARIABLES USED C ICOL = NEW NODE NUMBER ARRAY BY OLD NODE NUMBER C IJN = NEW CONNECTIVITY ARRAY C NJ = NUMBER OF JOINTS OR NODES C NP = NUMBER OF PARTS C NPT = NUMBER OF ELEMENTS DIMENSION ICOL(1),IJN(4,1) COMMON/CONT/ NP,NJ,NPT COMMON/NCON/ NPN,NJN,NLAST C ZERO NODE NUMBER ARRAY DO 10 I=1,NJ 10 ICOL(I)=0 C COUNT NUMBER OF TIMES NODE NUMBER USED IN IJN DO 20 J=1,NLAST DO 20 I=1,4 II=IJN(I,J) IF(II.LE.0.OR.II.GT.NJ) GO TO 20 ICOL(II)=ICOL(II)+1 20 CONTINUE C REPLACE COUNT WITH NEW NODE NUMBER FOR NODES USED NN=0 DO 40 I=1,NJ IF(ICOL(I).LE.0) GO TO 40 NN=NN+1 ICOL(I)=NN 40 CONTINUE C RENUMBER NODES IN ARRAY IJN NJ1=NJ-NN DO 60 J=1,NLAST DO 60 I=1,4 II=IJN(I,J) IF(II.LE.0) GO TO 60 IF(II.GT.NJ) GO TO 50 IJN(I,J)=ICOL(II) GO TO 60 50 IJN(I,J)=II-NJ1 60 CONTINUE RETURN END SUBROUTINE TRGEOM(X,ICOL,DFAC,IFAC,XN) C SUBROUTINE TRANS - TRANSFORMS, REDUCES AND/OR AUGMENTS C COORDINATE, DISPLACEMENT AND SCALAR FUNCTION ARRAY. C VARIABLES USED C X = COORDINATE ARRAY C = DISPLACEMENT ARRAY C S = SCALAR FUNCTION ARRAY C ICOL = REDUCED NODE NUMBER ARRAY C DFAC = PROPORTION OF LINE SEGMENT C IFAC = NODES OF CLIPPED LINE SEGMENT C  XN = NEW COORDINATE ARRAY C = NEW DISPLACEMENT ARRAY C SN = NEW SCALAR FUNCTION ARRAY C NJ = NUMBER OF JOINTS OR NODES C NP = NUMBER OF PARTS C NPT = NUMBER OF ELEMENTS C NPN = NEW NUMBER OF PARTS C NCOOR = NEW NUMBER OF NODES C NPTN = NEW NUMBER OF ELEMENTS DIMENSION X(3,1),ICOL(1),DFAC(1),IFAC(2,1),XN(3,1) COMMON/CONT/ NP,NJ,NPT COMMON/NCON/ NPN,NCOOR,NPTN COMMON/SAVE/ NSAVE NSAVE=NCOOR C PERFORM TRANSFORMATION ON OLD GEOMETRY ARRAY N=0 DO 4 J=1,NJ IF(ICOL(J).LE.0) GO TO 4 N=N+1 DO 3 I=1,3 3 XN(I,N)=X(I,J) 4 CONTINUE C IF NO NEW COORDINATES THEN JUMP J1=NJ+1 IF(J1.GT.NCOOR) GO TO 10 C INCLUDED CALCULATED COORDINATES IN NEW ARRAY DO 5 J=J1,NCOOR N=N+1 DO 5 I=1,3 5 XN(I,N)=X(I,J) 10 NCOOR=N RETURN END SUBROUTINE TRDISP(X,ICOL,DFAC,IFAC,XN) DIMENSION X(3,1),ICOL(1),DFAC(1),IFAC(2,1),XN(3,1) COMMON/CONT/ NP,NJ,NPT  COMMON/NCON/ NPN,NCOOR,NPTN COMMON/SAVE/ NSAVE C PERFORM TRANSFORMATION ON OLD DISPLACEMENT ARRAY N=0 DO 14 J=1,NJ IF(ICOL(J).LE.0) GO TO 14 N=N+1 DO 13 I=1,3 13 XN(I,N)=X(I,J) 14 CONTINUE C IF NO NEW DISPLACEMENTS THEN RETURN J1=NSAVE-NJ IF(J1.LE.0) RETURN DO 17 J=1,J1 N=N+1 I1=IFAC(1,J) I2=IFAC(2,J) DO 17 I=1,3 17 XN(I,N)=X(I,I1)-DFAC(J)*(X(I,I2)-X(I,I1)) RETURN END SUBROUTINE TRSFUN(S,ICOL,DFAC,IFAC,SN) DIMENSION S(1),ICOL(1),DFAC(1),IFAC(2,1),SN(1) COMMON/CONT/ NP,NJ,NPT COMMON/NCON/ NPN,NCOOR,NPTN COMMON/SAVE/ NSAVE C PERFORM TRANSFORMATION ON OLD SCALAR FUNCTION ARRAY N=0 DO 24 J=1,NJ IF(ICOL(J).LE.0) GO TO 24 N=N+1 SN(N)=S(J) 24 CONTINUE C IF NO NEW SCALAR FUNCTIONS THEN RETURN J1=NSAVE-NJ IF(J1.LE.0) RETURN DO 27 J=1,J1 N=N+1 I1=IFAC(1,J) I2=IFAC(2,J) 27 SN(N)=S(I1)-DFAC(J)*(S(I2)-S(I1)) RETURN END C**********************************************************************C C C C TITLE.FOR VERSION 1.0(A) SEPTEMBER 1976 C C C C TITLE.FOR IS A CHARACTER GENERATOR FOR TWO AND THREE C C DIMENSIONAL CHARACTERS. THE POLYGONAL DATA IS COMPATABLE C C WITH MOVIE.BYU FOR DISPLAY. C C C C MIKE STEPHENSON HANK CHRISTIANSEN C C DEPARTMENT OF CIVIL ENGR. CIVIL ENGINEERING DEPT. C C AND ENGINEERING MECHANICS 368E ESTB C C THE UNIVERSITY OF ARIZONA BRIGHAM YOUNG UNIVERSITY C C TUCSON, ARIZONA 85721 PROVO, UTAH 84602 C C (602) 884-4803  (801) 374-1211 X2811 C C C C**********************************************************************C INTEGER OUTPUT C DIMENSION NPL(2,NPMAX),X(3,NJMAX),IP(4,NPTMAX) DIMENSION NPL(2,10),X(3,100),IP(4,100) DIMENSION WORD(70) COMMON/CHAR/ CH(42),JQUAD(6,42),COOR(2,6,50) COMMON/DEVI/ INPUT,OUTPUT C INPUT AND OUTPUT ARE SET BELOW FOR THE DECSYSTEM-10 INPUT=-4 OUTPUT=-1 C  WRITE TITLE TO OUTPUT DEVICE WRITE(OUTPUT,10) 10 FORMAT(' ') C BEGIN LINE OF TEXT 20 NML=0 NP=0 NJH=0 NMH=0 30 NCHAR=0 35 WRITE(OUTPUT,40) 40 FORMAT(' ') READ(INPUT,50) (WORD(I),I=1,70) 50 FORMAT(70A1) C FIND LAST NON-BLANK CHARACTER DO 60 I=1,70 NCHAR=71-I 60 IF(WORD(NCHAR).NE.' ') GO TO 80 C IF BLANK LINE THEN END OF TITLE? WRITE(OUTPUT,70) 70 FORMAT(' '$)  READ(INPUT,50) ANS IF(ANS.NE.'Y') GO TO 30 GO TO 320 80 NP=NP+1 ID=2 C THREE-DIMENSIONAL TITLE? WRITE(OUTPUT,90) 90 FORMAT(' <3-D?> '$) READ(INPUT,50) ANS IF(ANS.EQ.'Y') ID=3 IDIN=ID-1 C REQUEST LEFT EDGE COORDINATES WRITE(OUTPUT,100) 100 FORMAT(' '$) READ(INPUT,110) XZ,YZ,ZZ 110 FORMAT(4E) C REQUEST SPACING, WIDTH, HEIGHT, AND FOR 3-D, DEPTH. 120 IF(ID.EQ.2) WRITE(OUTPUT,130) 130 FORMAT(' '$) IF(ID.EQ.3) WRITE(OUTPUT,140) 140 FORMAT(' '$) READ(INPUT,110) DDIN,SX,SY,SZ IF(SX.EQ.0.0.OR.SY.EQ.0.0) GO TO 120 IF(DDIN.EQ.0.0)DDIN=1.0 SX=SX/7.0 SY=SY/7.0 C IF 2-D THEN JUMP ELSE REQUEST OFFSET. IF(ID.EQ.2) GO TO 160 WRITE(OUTPUT,150) 150 FORMAT(' '$) READ(INPUT,110) DDX,DDY C FOR EACH CHARACTER IN LINE, GENERATE POLYGONAL DATA. 160 DO 290 I=1,NCHAR NJL=NJH+1 X1=WORD(I) DO 170 J=1,42 170 IF(X1.EQ.CH(J)) GO TO 190 C ISSUE WARNING IF CHARACTER NOT RECOGNIZED. WRITE(OUTPUT,180) X1 180 FORMAT(' ?') GO TO 35 190 DO 280 K=1,6 C GET POLYGON NUMBER. L=JQUAD(K,J) IF(L.EQ.0) GO TO 290 DO 280 I1=1,4 C GENERATE COORDINATES X1=XZ+SX*COOR(1,I1,L) Y1=YZ+SY*COOR(2,I1,L) IF(NJH.LT.NJL) GO TO 210 DO 200 J1=NJL,NJH,IDIN 200 IF(X1.EQ.X(1,J1).AND.Y1.EQ.X(2,J1)) GO TO 220 210 J1=NJH+1 NJH=NJH+IDIN X(1,J1)=X1 X(2,J1)=Y1 X(3,J1)=ZZ IF(ID.EQ.2) GO TO 270 X(1,NJH)=X1+DDX X(2,NJH)=Y1+DDY X(3,NJH)=ZZ-SZ 220 IF(ID.EQ.2) GO TO 270 J2=J1+1 C GENERATE POLYGONS GO TO (230,240,250,260),I1 230 IP(1,NMH+1)=J1 IP(2,NMH+2)=J1 IP(4,NMH+5)=J1 IP(1,NMH+2)=J2 IP(1,NMH+5)=J2 GO TO 280 240 IP(2,NMH+1)=J1 IP(1,NMH+3)=J1 IP(3,NMH+5)=J1 IP(2,NMH+3)=J2 IP(2,NMH+5)=J2 GO TO 280 250 IP(3,NMH+1)=J1 IP(4,NMH+3)=J1 IP(2,NMH+4)=J1 IP(3,NMH+3)=J2 IP(3,NMH+4)=J2 GO TO 280 260 IP(4,NMH+1)=J1 IP(3,NMH+2)=J1 IP(1,NMH+4)=J1 IP(4,NMH+2)=J2 IP(4,NMH+4)=J2 NMH=NMH+5 GO TO 280 270 IF(I1.EQ.1) NMH=NMH+1 IP(I1,NMH)=J1 280 CONTINUE C CLACULATE RIGHT EDGE CORRDINATE. 290 XZ=XZ+7.0*SX*DDIN XZ=XZ-7.0*SX*(DDIN-1.0) WRITE(OUTPUT,300) XZ 300 FORMAT(' ') WRITE(OUTPUT,310) NP,NMH,NJH 310 FORMAT(' ') NPL(1,NP)=NMH-NML NML=NMH GO TO 30 C COMPLETE NPL ARRAY. 320 NPT=0 DO 330 J=1,NP NPL(2,J)=NPL(1,J)+NPT NPL(1,J)=1+NPT 330 NPT=NPT+NPL(2,J) C WRITE GEOMETRY FILE. CALL WRGEOM(NP,NJH,NPT,NPL,X,IP) WRITE(OUTPUT,340) 340 FORMAT(' '$) READ(INPUT,50) ANS IF(ANS.EQ.'Y') GO TO 20 STOP END BLOCK DATA C CHARACTER DEFINITIONS. COMMON/CHAR/ CH(42),JQUAD(6,42),COOR(2,6,50) DATA (CH(I),I=1,42)/'A','B','C','D','E','F','G','H','I','J' 1 ,'K','L','M','N','O','P','Q','R','S','T','U','V','W','X' 2 ,'Y','Z','1','2','3','4','5','6','7','8','9','0',' ','.' 3 ,'/','-','=','$'/ DATA ((JQUAD(I,J),I=1,6),J=1,10)/1,2,3,4,0,0,1,3,5,6,7,0 1 ,1,2,8,0,0,0,1,5,6,7,0,0,1,2,3,8,0,0,1,2,3,0,0,0 2 ,1,2,8,9,10,0,1,3,11,0,0,0,24,25,49,0,0,0,6,13,14,0,0,0/ DATA ((JQUAD(I,J),I=1,6),J=11,20)/1,15,16,0,0,0,1,8,0,0,0,0 1 ,1,11,17,18,0,0,1,11,19,0,0,0,1,5,6,11,0,0,1,3,5,20,0,0 2 ,1,5,6,11,21,0,1,3,5,20,22,0,2,3,9,23,24,0,25,26,0,0,0,0/ DATA ((JQUAD(I,J),I=1,6),J=21,30)/1,6,11,0,0,0,44,45,0,0,0,0 1 ,27,28,29,30,0,0,31,32,33,34,0,0,31,32,35,0,0,0,24,25,36,0,0,0 2 ,12,0,0,0,0,0,24,25,37,38,0,0,3,24,25,39,0,0,11,40,41,0,0,0/ DATA ((JQUAD(I,J),I=1,6),J=31,42)/2,3,9,23,24,42,1,2,3,8,9,0 1 ,25,43,0,0,0,0,1,3,5,6,11,0,2,3,23,24,39,0,1,5,6,11,0,0 2 ,0,0,0,0,0,0,46,0,0,0,0,0,36,0,0,0,0,0,3,0,0,0,0,0 3 ,47,48,0,0,0,0,2,3,9,23,24,50/ DATA(((COOR(I,J,K),I=1,2),J=1,4),K=1,6)/1.,0.,2.,0.,2.,7.,1.,7. 1 ,2.,6.,6.,6.,6.,7.,2.,7.,2.,3.,5.,3.,5.,4.,2.,4.,5.,0.,6.,0. 2 ,6.,6.,5.,6.,2.,6.,5.,6.,5.,7.,2.,7.,2.,0.,5.,0.,5.,1.,2.,1./ DATA(((COOR(I,J,K),I=1,2),J=1,4),K=7,12)/5.,0.,6.,1.,6.,6.,5.,7. 1 ,2.,0.,6.,0.,6.,1.,2.,1.,5.,1.,6.,1.,6.,4.,5.,4.,3.,3.,5.,3. 2 ,5.,4.,3.,4.,5.,0.,6.,0.,6.,7.,5.,7.,3.,0.,4.,0.,4.,7.,3.,7./ DATA(((COOR(I,J,K),I=1,2),J=1,4),K=13,17)/5.,0.,6.,0.,6.,7. 1 ,5.,7.,1.,0.,2.,0.,2.,3.,1.,3.,2.,3.5,6.,7.,4.5,7.,2.,4.8 2 ,2.,2.2,4.5,0.,6.,0.,2.,3.5,2.,5.,3.5,3.,3.5,5.,2.,7./ DATA(((COOR(I,J,K),I=1,2),J=1,4),K=18,22)/3.5,3.,5.,5. 1 ,5.,7.,3.5,5.,2.,4.8,5.,0.,5.,2.2,2.,7.,5.,3.,6.,3.,6.,7. 2 ,5.,7.,5.,1.,5.,2.4,3.7,3.7,3.,3.,4.9,0.,6.,0.,5.,3.,3.9,3./ DATA(((COOR(I,J,K),I=1,2),J=1,4),K=23,27)/1.,3.,2.,3.,2.,7.  1 ,1.,7.,1.,0.,6.,0.,6.,1.,1.,1.,1.,6.,6.,6.,6.,7.,1.,7. 2 ,3.,0.,4.,0.,4.,6.,3.,6.,1.,7.,2.,0.,3.,0.,2.,7./ DATA(((COOR(I,J,K),I=1,2),J=1,4),K=28,32)/3.,0.,3.5,2.,3.5,5. 1 ,2.643,2.5,3.5,2.,4.,0.,4.357,2.5,3.5,5.,4.,0.,5.,0.,6.,7. 2 ,5.,7.,3.,3.5,3.5,4.375,2.,7.,1.,7.,3.,3.5,4.,3.5,6.,7.,5.,7./ DATA(((COOR(I,J,K),I=1,2),J=1,4),K=33,37)/1.,0.,2.,0.,3.5,2.625 1 ,3.,3.5,5.,0.,6.,0.,4.,3.5,3.,3.5,3.,0.,4.,0.,4.,3.5,3.,3.5 2 ,1.,1.,2.25,1.,6.,6.,4.75,6.,5.,4.3,6.,4.,6.,6.,5.,6./ DATA(((COOR(I,J,K),I=1,2),J=1,4),K=38,42)/1.,1.,2.6,1.,6.,4. 1 ,5.,4.3,5.,1.,6.,1.,6.,6.,5.,6.,1.,4.,2.8,4.,5.,5.7,5.,7. 2 ,1.,3.,5.,3.,5.,4.,1.,4.,1.,1.,2.,1.,2.,2.,1.,2./ DATA(((COOR(I,J,K),I=1,2),J=1,4),K=43,50)/3.,0.,4.2,0.,6.,6. 1 ,4.8,6.,1.,7.,3.5,0.,3.5,2.75,2.,7.,3.5,0.,6.,7.,5.,7. 2 ,3.5,2.75,3.,0.,4.,0.,4.,1.,3.,1.,2.,2.,5.,2.,5.,3.,2.,3. 3 ,2.,4.,5.,4.,5.,5.,2.,5.,3.,1.,4.,1.,4.,6.,3.,6. 4 ,3.,-2.,4.,-2.,4.,9.,3.,9./ END SUBROUTINE OPEN(FILEID,IUNIT,IOP,IERROR) C SUBROUTINE OPEN REQUEST FILENAME AND OPENS FILE FOR I/O C SUBPROGRAMS CALLED C OPEN = SYSTEM OPEN FILE ROUTINE C VARIABLES USED C FILEID = 5 ASCII CHARACTER ID C IUNIT = DEVICE LOGICAL NUMBER C IOP = 1 FOR INPUT FILE C = -1 FOR OUTPUT FILE C IERROR = 1 ON SUCCESSFUL COMPLETION C = 0 ON EMPTY FILE SPECIFICATION C = -1 ON FAILURE DOUBLE PRECISION ASEQ,BLANK,XNAME INTEGER OUTPUT COMMON/DEVI/ INPUT,OUTPUT DATA DSK/'DSK'/,MTA/'MTA'/ DATA BLANK/' '/ IERROR=0 OPTYPE='READ' IF(IOP.LT.0) OPTYPE='WRITE' WRITE(OUTPUT,10) OPTYPE,FILEID 10 FORMAT(' <',A5,1X,A5,' FILE> '$) READ(INPUT,20) XNAME 20 FORMAT(A10) IF(XNAME.EQ.BLANK) RETURN IERROR=1 IUNIT=10 ASEQ='SEQIN' IF(IOP.LT.0) ASEQ='SEQOUT' OPEN(UNIT=IUNIT,DEVICE=DSK,FILE=XNAME,ACCESS=ASEQ,MODE='ASCII') RETURN END SUBROUTINE WRGEOM(NP,NJ,NPT,NPL,X,IP) INTEGER OUTPUT DIMENSION NPL(2,1),X(3,1),IP(4,1) COMMON/DEVI/ INPUT,OUTPUT DATA IWRITE/-1/ C REQUEST FILE INFORMATION 60 CALL OPEN('TITLE',IUNIT,IWRITE,IERR) IF(IERR) 60,95,90 C WRITE GEOMETRY FILE 90 WRITE(IUNIT,120) NP,NJ,NPT WRITE(IUNIT,120) ((NPL(I,J),I=1,2),J=1,NP) WRITE(IUNIT,130) ((X(I,J),I=1,3),J=1,NJ) WRITE(IUNIT,120) ((IP(I,J),I=1,4),J=1,NPT) 95 RETURN 120 FORMAT(20I4) 130 FORMAT(1P6E12.5)  END  M O V I E . B Y U A GENERAL PURPOSE COMPUTER GRAPHICS DISPLAY SYSTEM SEPTEMBER 1976 MIKE STEPHENSON HANK CHRISTIANSEN DEPARTMENT OF CIVIL ENGR. CIVIL ENGINEERING DEPT. AND ENGINEERING MECHANICS 368E ESTB THE UNIVERSITY OF ARIZONA BRIGHAM YOUNG UNIVERSITY TUCSON, ARIZONA 85721 PROVO, UTAH 84602 (602) 884-4803 (801) 374-1211 X2811 TABLE OF CONTENTS CHAPTER PAGE 1 MOVIE USER'S MANUAL . . . . . . . 1-1 2 UTILITY USER'S MANUAL . . . . . . 2-1 3 SECTION USER'S MANUAL . . . . . . 3-1 4 TITLE USER'S MANUAL . . . . . . . 4-1 5 INSTALLING MOVIE.BYU . . . . . . 5-1 APPENDIX A SUGGESTED 16 BIT MACHINE CODE . . A-1 B SUGGESTED 32 BIT MACHINE CODE . . B-1 THE COMPUTER PROGRAMS DESCRIBED IN THIS DOCUMENT ARE AVAILABLE FROM HANK CHRISTIANSEN FOR A DISTRIBUTION CHARGE OF $25. NO CHARGE IS MADE FOR THE PROGRAMS WHICH WERE DEVELOPED UNDER PUBLIC FUNDING. NO AGENCY OF THE UNITED STATES GOVERNMENT, BRIGHAM YOUNG UNIVERSITY, THE UNIVERSITY OF ARIZONA, OR THEIR EMPLOYEES MAKES ANY WARRANTY EXPRESSED OR IMPLIED, OR ASSUMES ANY LEGAL RESPONSIBILITY FOR THE ACCURACY, COMPLETENESS OR USEFULNESS OF THESE COMPUTER PROGRAMS AND DOCUMENTS. CHAPTER 1 MOVIE USER'S MANUAL MOVIE IS AN INTERACTIVE PROGRAM FOR THE DISPLAY AND ANIMATION OF ANY MODEL COMPOSED OF TRIANGLES AND QUADRILATERALS. THE PROGRAM ALLOWS THE USER TO MANIPULATE THE MODEL (ROTATE, TRANSLATE, ECT.), SPECIFY COLORS FOR THE BACKGROUND AND THE DIFFERENT ELEMENT GROUPS, AND SELECT THE DISPLAY DEVICE. THE PROGRAM PROCEEDS IN THE FOLLOWING MANNER, FIRST TYPING ON THE USER'S TERMINAL THE PROGRAM TITLE. ENTER THE GEOMETRY FILENAME.EXT. IF THE EXTENTION IS OMITTED, THE DEFAULT EXTENSION DAT WILL BE USED. A ZERO FILE DESIGNATION WILL SKIP OVER THE GEOMETRY FILE AND REQUEST INFORMATION ABOUT THE DISPLACEMENT FILE. THIS IS HELPFUL WHEN USING SEVERAL DIFFERENT DISPLACEMENT OR SCALAR FUNCTION FILES WITH THE SAME GEOMETRY.(1)  THE GEOMETRY FILE IS NOW READ USING THE FOLLOWING FORTRAN STATEMENTS. READ(IDTA,10) NP,NJ,NPT READ(IDTA,10) ((NPL(I,J),I=1,2),J=1,NP) READ(IDTA,20) ((X(I,J),I=1,3),J=1,NJ) READ(IDTA,10) ((IP(I,J),I=1,4),J=1,NPT) 10 FORMAT(20I4) 20 FORMAT(6E12.5) (1) THE MANNER IN WHICH DATA FILES ARE INITIALIZED IS AN INSTALLATION DEPENDENT FEATURE. APPROPRIATE MODIFICATIONS SHOULD BE MADE IN THE SOURCE PROGRAM TO ACCOMMODATE YOUR SYSTEM. MOVIE USER'S MANUAL Page 1-2 THE VARIABLES ARE DEFINED AS FOLLOWS: NP = THE NUMBER OF PARTS NJ = THE NUMBER OF NODES OR JOINTS NPT = THE NUMBER OF ELEMENTS OR POLYGONS NPL = THE PARTS LIST ELEMENTS ARE GROUPED TOGETHER FOR CURVED  SURFACE SIMULATION AND COLOR DEFINITION. THE PARTS LIST CONTAINS THE ELEMENT NUMBERS OF THE LOWER AND UPPER BOUNDS OF THE ELEMENT GROUPING. BY REPEATING THE ELEMENT GROUP LIMIT NUMBERS IN THE PARTS LIST AND THEN USING THE EXPLODE AND PIVOT COMMANDS TO SEPARATE THE PARTS, COMPLEX PICTURES CAN BE DEVELOPED FROM RATHER SIMPLE DATA FILES. X = THE COORDINATES OF THE NODES IP = THE CONNECTIVITY OF THE ELEMENTS OR POLYGONS ENTER THE NAME OF THE DISPLACEMENT FILE IN THE SAME FORMAT USED ABOVE. A ZERO FILE DESIGNATION WILL SKIP THE DISPLACEMENT FILE AND REQUEST INFORMATION FOR THE SCALAR FUNCTION FILE. AT THIS POINT THE DISPLACEMENT FILE IS READ USING THE FOLLOWING FORTRAN STATEMENTS.  READ(IDTA,10) ((U(I,J),I=1,3),J=1,NJ) 10 FORMAT(6E12.5) THE VARIABLE, U, IS THE VALUE OF THE DISPLACEMENTS AT THE NODES ENTER THE NAME OF THE SCALAR FUNCTION FILE IN THE FORM DESCRIBED ABOVE. A ZERO FILE DESIGNATION WILL SKIP OVER THE SCALAR FUNCTION AND PROMPT THE USER TO ENTER THE NEXT COMMAND.  AT THIS POINT THE SCALAR FUNCTION WILL BE READ USING THE FOLLOWING FORTRAN STATEMENTS. READ(IDTA,10) (S(I),I=1,NJ) 10 FORMAT(6E12.5) MOVIE USER'S MANUAL Page 1-3 THE VARIABLE, S, IS THE VALUE OF THE SCALAR FUNCTION AT THE NODES. COMMAND PROMPT BEFORE ISSUING THE COMMAND PROMPT, SEVERAL PROGRAM VARIABLES ARE INITIALIZED SO THAT THE MODEL CAN BE DISPLAYED IMMEDIATELY. THE PROGRAM WILL ALSO REQUEST A DISPLAY DEVICE (SEE DEVICE) AND INFORMATION ABOUT DATA ORDERING (SEE FAST). >> THE PROGRAM IS NOW READY TO ACCEPT ONE OF THE ALLOWABLE COMMANDS. THE COMMANDS ARE LISTED IN ALPHABETICAL ORDER, AND THE INFORMATION THEY REQUEST IS DISCUSSED IN THE FOLLOWING PARAGRAPHS.  CENTER THE CENTER COMMAND INVOKES THE SUMMARY COMMAND, TRANSLATES THE ORIGIN TO THE CENTER OF THE MODEL, AND CALCULATES VALUES FOR DISTANCE TO THE ORIGIN, ANGLE OF VIEW, Z MIN., AND Z MAX. (SEE COMMANDS DISTANCE AND FIELD.) THE CALCULATED VALUES WILL BE TYPED ON THE USER'S TERMINAL. COLOR THE COLOR COMMAND ALLOWS THE USER TO SPECIFY THE  COLORS FOR THE BACKGROUND, FOR THE VARIOUS PARTS OF THE MODEL, AND FOR THE COLOR FRINGES. ENTER THE RED, BLUE, AND GREEN COLOR COMPONENTS OF THE BACKGROUND. THE LIGHT INTENSITY VARIES FROM 0 (NONE) TO 1 (FULL INTENSITY). MOVIE USER'S MANUAL Page 1-4 ENTER THE RED, BLUE, AND GREEN COLOR COMPONENTS OF EACH PART OF THE MODEL. IF I2 IS GREATER THAN I1, ALL PARTS I1 THROUGH I2 WILL BE THE SAME COLOR. A LINE OF ZEROES TERMINATES THIS COMMAND. ENTER Y OR YES IF STANDARD FRINGE COLORS ARE DESIRED (THE STANDARD COLORS ARE BLUE, TURQUOISE, GREEN, YELLOW, RED.) ANY OTHER RESPONSE WILL SKIP THE NEXT REQUEST. ENTER Y OR YES TO REFLECT THE COLORS ABOUT A WHITE MIDPOINT (I.E. RED, YELLOW, GREEN, TURQUOISE, BLUE, WHITE, BLUE, TURQUOISE, ETC.) AND TO SKIP THE NEXT REQUEST. IF STANDARD FRINGE COLORS ARE NOT DESIRED, THEN ENTER THE FRINGE NUMBER AND THE COLOR COMPONENTS FOR THAT FRINGE. A LINE OF ZEROES TERMINATES THIS COMMAND. THIS REQUEST IS SKIPPED IF STANDARD FRINGES ARE USED. CONTOUR THE CONTOUR COMMAND ALLOWS THE USER TO PLOT CONTOUR LINES ON HIS HIDDEN LINE DRAWING OUTPUT. SINCE THE LINES ARE PLOTTED USING RASTER SCAN LOGIC, THE CONTOURS WILL CURVE ACROSS THE MODEL. <# OF CONTOURS, LABEL SPACING>  ENTER THE NUMBER OF CONTOUR LINES (26 MAXIMUM) AND THE LABEL SPACING (THE NUMBER OF RASTER LINES BETWEEN LABELS). ENTER THE MINIMUM AND MAXIMUM CONTOUR VALUES TO BE PLOTTED. MOVIE USER'S MANUAL Page 1-5 DEVICE THE DEVICE COMMAND IS A SUBSET OF THE SCOPE COMMAND.  IT ALLOWS THE USER TO CHANGE DISPLAY DEVICES WITHOUT CHANGING OTHER SCOPE PARAMETERS. ENTER ONE OF THE FOLLOWING ALLOWABLE DISPLAY DEVICE ABBREVIATIONS: HPLT (HP PLOTTER), CPLT (CALCOMP PLOTTER), TEKT (TEKTRONIX), OR COMT (COMTAL). DIFUSE THE DIFUSE COMMAND ALLOWS THE USER TO SPECIFY THE AMOUNT OF DIFUSED LIGHT IN THE PICTURE BY PARTS. A LINE OF ZEROES TERMINATES THIS COMMAND. ENTER THE PART NUMBER AND THE VALUE OF DIFUSE FOR THAT PART. IF I2 IS GREATER THAN I1, THEN ALL PARTS I1 THROUGH I2 WILL HAVE THE SAME DIFUSED LIGHT. DISTANCE THE DISTANCE COMMAND ALLOWS THE USER TO SPECIFY THE DISTANCE BETWEEN THE MODEL AND OBSERVER. ENTER THE DISTANCE FROM THE OBSERVER TO THE MODEL ORIGIN. DRAW THE DRAW COMMAND SENDS THE PICTURE DEFINED BY ALL PREVIOUS COMMANDS TO THE DISPLAY DEVICE SELECTED IN THE SCOPE OR DEVICE COMMANDS. WHEN THIS DISPLAY OPTION IS USED MOVIE USER'S MANUAL Page 1-6 WITH LINE DRAWING OUTPUT, THE WATKIN'S HIDDEN LINE ALGORITHM IS NOT CALLED. EXIT THE EXIT COMMAND PROVIDES A CONTROLED TERMINATION OF THE PROGRAM (INCLUDING DUMPING OF THE OUTPUT BUFFER). EXPLODE THE EXPLODE COMMAND ALLOWS THE USER TO SPECIFY LOCAL MOTION (EXPLOSION) PATTERNS FOR ANY GROUP OF ELEMENTS.  ENTER THE PART NUMBERS AND THE LOCAL MOTION PATTERN IN THE X, Y, AND Z DIRECTIONS. IF I2 IS GREATER THAN I1, ALL PARTS I1 THROUGH I2 WILL HAVE THE SAME PATTERN. A LINE OF ZEROES TERMINATES THIS COMMAND. ENTER THE SCALE FACTOR TO BE USED IN SCALING THE ABOVE MOTION PATTERN PRIOR TO THEIR BEING ADDED TO THE NODAL COORDINATES. FAST THE FAST COMMAND ALLOWS THE USER TO DEFINE THE DATA ORGANIZATION AND INVOKE THE POOR MAN'S HIDDEN SURFACE PROCEDURE. ENTER Y OR YES IF THE POLYGONAL VERTICES IN THE GEOMETRY FILE ARE NOT ORDERED IN A CONSISTANT CLOCKWISE OR COUNTER-CLOCKWISE DIRECTION AND CAUSE THE NEXT TWO REQUESTS TO BE SKIPPED. THE POOR MAN'S HIDDEN SURFACE PROCEDURE CAN NOT BE USED UNLESS THE DATA IS CONSISTANT. MOVIE USER'S MANUAL Page 1-7 ENTER Y OR YES TO INVOKE THE POOR MAN'S HIDDEN SURFACE PROCEDURE. THE POOR MAN'S PROCEDURE WILL NOT SEND TO THE WATKIN'S ALGORITHM ANY POLYGON THE IS FACING AWAY FROM THE OBSEVER. THIS  SIGNIFICATLY REDUCES THE TIME NEEDED TO SOLVE THE HIDDEN SURFACE PROBLEM. USE IT WHEN EVER POSSIBLE. ENTER Y OR YES TO INDICATE A CLOCKWISE ORIENTATION OF THE POLYGONAL VERTICES WHEN VIEWING THE ELEMENT ON ITS OUTSIDE FACE. A COUNTER-CLOCKWISE ORIENTATION IS ASSUMED OTHERWISE. FIELD  THE FIELD COMMAND ALLOWS THE USER TO DEFINE THE FRUSTRUM OF VISION. ENTER THE ANGLE OF VIEW, THE DISTANCE TO THE FRONT CLIPPING PLANE, AND THE DISTANCE TO THE BACK CLIPPING PLANE. THE FRONT AND BACK CLIPPING PLANES SHOULD BE PLACED FAR ENOUGH AWAY FROM THE MODEL TO ALLOW FOR ALL ROTATIONS AND TRANSLATIONS TO WHICH THE MODEL WILL BE SUBJECTED. A SMALL ANGLE OF VIEW WILL REDUCE THE PERSPECTIVE WHILE A LARGE ANGLE OF VIEW WILL EXAGGERATE THE PERSPECTIVE. FLAT THE FLAT COMMAND WILL INVOKE FLAT ELEMENT SHADING. THE LIGHT INTENSITY WILL VARY AS THE COSINE SQUARE OF THE NORMAL BETWEEN THE LIGHT SOURCE AND THE NORMAL TO THE ELEMENT, BUT THE LIGHT INTENSITIES WILL NOT (IN GENERAL) MATCH AT THE ELEMENT BOUNDARIES. MOVIE USER'S MANUAL Page 1-8 FRINGE THE FRINGE COMMAND ALLOWS THE USER TO SPECIFY COLOR FRINGES TO REPRESENT THE DISPLACEMENT SYSTEM OR A SCALAR FUNCTION. <# OF FRINGES> ENTER THE NUMBER OF COLOR FRINGES. THIS NUMBER SHOULD NOT EXCEED THE NUMBER OF FRINGES SPECIFIED IN THE COLOR COMMAND. ENTER Y OR YES IF DISPLACEMENT FRINGES ARE DESIRED. ANY OTHER RESPONSE WILL SKIP OVER FURTHER REQUEST FOR DISPLACEMENT FRINGE INFORMATION. ENTER THE DIRECTION COSINES FOR THE DIRECTION IN WHICH THE DISPLACEMENTS ARE TO BE MONITORED AND DISPLAYED IN TERMS OF COLOR FRINGES. ENTER THE PART NUMBERS AND THE MINIMUM AND MAXIMUM FRINGE VALUE FOR THOSE PARTS. VALUES LESS THAN THE MINIMUM WILL HAVE THE MINIMUM FRINGE COLOR, AND VALUES GREATER THAN THE MAXIMUM WILL HAVE THE MAXIMUM FRINGE COLOR. IF I2 IS GREATER THAN I1, THEN ALL PARTS I1 THROUGH I2 WILL HAVE THE SAME FRINGE RANGE. A LINE OF ZEROES TERMINATES THIS COMMAND. LINEAR THE LINEAR COMMAND ALONG WITH THE TRANSIENT DATA OPTION IN THE MOVIE COMMAND ALLOWS THE USER TO LINEARLY  INTERPOLATE BETWEEN TWO DISPLACEMENT AND/OR SCALAR FUNCTION FILES. ENTER Y OR YES IF THE NODAL GEOMETRY IS TO BE MODIFIED BY THE PREVIOUSLY READ DISPLACEMENTS MULTIPLIED BY THE SCALE FACTOR SPECIFIED IN THE SCALE COMMAND AND IF THE FIRST SCALAR FUNCTION IS TO BE INCREMENTED TO THE SECOND SCALAR FUNCTION. ENTER THE FILENAME.EXT OF THE DISPLACEMENT FILE AT TIME=I. IF THE EXTENTION IS OMITTED, THE DEFAULT EXTENSION DAT WILL BE USED. A NULL FILE DESIGNATION WILL SKIP TO THE NEXT REQUEST WITHOUT READING A FILE. THE DISPLACMENTS ARE READ IN THE SAME FORMAT AS DESCRIBED PREVIOUSLY. ENTER THE NAME OF THE DISPLACEMENT FILE AT TIME=I+1 IN THE SAME FORMAT AS ABOVE. ENTER THE NAME OF THE SCALAR FUNCTION FILE AT TIME=I IN THE SAME FORMAT AS ABOVE. ENTER THE NAME OF THE SCALAR FUNCTION FILE AT TIME=I+1 IN THE SAME FORMAT AS ABOVE. MOVIE USER'S MANUAL Page 1-10 MOVIE THE MOVIE COMMAND ALLOWS THE USER  TO SPECIFY A ANIMATED SEQUENCE OF FRAMES. A SIMULATION OF HARMONIC STRUCTURAL VIBRATION IS POSSIBLE USING THIS OPTION AND SPECIFYING A DISPLACEMENT SCALE FACTOR. <# OF FRAMES> ENTER THE NUMBER OF FRAMES. THIS OPTION IS NOT ONLY USEFUL WHEN GENERATING LONG SEGUENCES OF FRAMES FOR MOVIES BUT ALSO FOR AS FEW AS TWO OR THREE FRAMES TO VIEW THE MODEL FROM DIFFERENT POSITIONS. ENTER THE NUMBERS OF THE FIRST AND LAST FRAMES TO ACTUALLY BE DISPLAYED. THIS OPTION IS USEFUL WHEN THE SYSTEM CRASHES WHILE IN THE MIDDLE OF A LONG SEQUENCE. INSTEAD OF REGENERATING ALL FRAMES OF THE SEQUENCE, IT IS ONLY NECESSARY TO GIVE THE NUMBERS OF THE FRAMES WANTED. IF A ZERO NUMBER  OF FRAMES IS GIVEN, THE PROGRAM SENDS ALL THE FRAMES TO THE DISPLAY DEVICE. ENTER Y OR YES IF A LINEAR INTERPOLATION BETWEEN TWO DISPLACEMENT OR SCALAR FUNCTION FILES IS DESIRED OVER THE NUMBER OF FRAMES SPECIFIED ABOVE. IF THIS OPTION IS USED, THE NEXT REQUEST WILL BE SKIPPED IF A NON-ZERO DISPLACEMENT SCALE FACTOR WAS ENTERED, THIS COMMAND WILL BE TYPED ON THE USER'S TERMINAL. ENTER THE NUMBER OF VIBRATION CYCLES PER FRAME FOR SIMULATION OF HARMONIC VIBRATION. ENTER THE TOTAL CHANGE IN THE TRANSLATION OF THE ORIGIN IN THE X, Y, AND Z DIRECTIONS. ENTER THE TOTAL CHANGE IN ROTATION ABOUT THE TRANSLATED ORIGIN IN THE GLOBAL X, Y, AND Z DIRECTIONS. THE INCREMENTAL ROTATIONS WILL BE MADE IN THE X, Y, Z ORDER. REMEMBER, FINITE ROTATIONS DO MOVIE USER'S MANUAL Page 1-11 NOT ADD AS VECTORS! ENTER THE PART NUMBERS AND THE ROTATIONS IN THE X, Y, AND Z DIRECTIONS ABOUT THE RELATIVE ORIGINS SPECIFIED IN THE PIVOT COMMAND. THIS COMMAND IS TERMINATED WITH A LINE OF ZEROES. ENTER THE CHANGE IN THE DISTANCE TO THE ORIGIN. A NEGATIVE VALUE WILL BRING THE MODEL TOWARDS THE OBSERVER. ENTER THE CHANGE IN THE DISPLACEMENT SCALE FACTOR. ENTER THE CHANGE IN THE LOCAL MOTION SCALE FACTOR. THIS COMMAND WILL PRODUCE SMOOTH ANIMATION OF THE EXPLOSION PATTERNS DEFINED IN THE EXPLODE COMMAND. ENTER Y OR YES TO SEND PICTURES TO THE DISPLAY DEVICE. ANY OTHER CHARACTER WILL CAUSE THE NEXT DISPLAY COMMAND TO PERFORM THE ANIMATION BUT  WILL NOT SEND THE PICTURES TO THE DISPLAY DEVICE. THIS IS HELPFUL IN CHECKING KEY FRAMES IN A MOVIE SINCE THE FINAL SCENE CAN BE DISPLAYED BY ISSUING A SECOND DISPLAY COMMANDS. PARTS THE PARTS COMMAND ALLOWS THE USER TO SELECT ALL OF THE MODEL OR A SUBSET OF THE MODEL FOR DISPLAY. ENTER Y OR YES TO DISPLAY ALL PARTS IN THE MODEL AND TO SKIP THE NEXT REQUEST. MOVIE USER'S MANUAL Page 1-12 ENTER THE NUMBERS OF THE PARTS THAT ARE TO BE DISPLAYED. IF I2 IS GREATER THAN I1, ALL PARTS I1 THROUGH I2 WILL BE DISPLAYED. A LINE OF ZEROES TERMINATES THIS COMMAND. PIVOT THE PIVOT COMMAND ALLOWS THE USER TO ROTATE INDIVIDUAL PARTS OF THE MODEL ABOUT AN ORIGIN DEFINED FOR THAT PART IN THE ORIGINAL AXIS DIRECTIONS OF THE MODEL. ENTER THE PART NUMBERS, THE AXIS (X, Y, OR Z), AND THE ANGLE OF ROTATION. IF I2 IS GREATER THAN I1, ALL PARTS I1 THROUGH I2 WILL BE PIVOTED. A LINE OF ZEROES TERMINATES THIS COMMAND. ENTER THE PART NUMBERS AND THE RELATIVE ORIGIN OF THE PARTS. THE RELATIVE ORIGIN SPECIFIES THE POINT ABOUT WHICH THE ROTATIONS WILL TAKE PLACE. ROTATIONS ARE ABOUT AXES PARALLEL TO THE ORIGINAL AXES OF THE MODEL. A LINE OF ZEROES TERMINATES THIS COMMAND. READ THE READ COMMAND RETURNS CONTROL TO THE BEGINNING OF THE PROGRAM SO THE USER MAY READ IN NEW GEOMETRY, DISPLACEMENT, AND SPECIAL FUNCTION FILES. RESTORE THE RESTORE COMMAND ZEROES ALL ROTATIONS AND TRANSLATIONS AND INTIALIZES THE ROTATION TRANSFORMATION MATRIX. MOVIE USER'S MANUAL Page 1-13 ROTATE THE COMMAND ROTATE ALLOWS THE USER TO ROTATE THE MODEL ABOUT THE TRANSLATED ORIGIN. ENTER ONE OF THE AXES (X, Y, OR Z) AND THE ANGLE OF ROTATION IN DEGREES. SCALE THE SCALE COMMAND ALLOWS THE USER TO SELECT A SCALE FACTOR FOR THE DISPLACEMENTS. THE DISPLACEMENTS WILL BE MULTIPLIED BY THE SCALE FACTOR BEFORE THEY ARE ADDED TO THE NODAL COORDINATES. ENTER THE DISPLACEMENT SCALE FACTOR. SCOPE THE SCOPE COMMAND REQUESTS INFORMATION NECESSARY TO DEFINE CERTAIN PICTURE VARIABLES. ENTER ONE OF THE FOLLOWING ALLOWABLE DISPLAY DEVICE ABBREVIATIONS: HPLT (HP PLOTTER), CPLT (CALCOMP PLOTTER), TEKT (TEKTRONIX), OR COMT (COMTAL).  THIS REQUEST IS ISSUED FOR CONTINUOUS-TONE DISPLAY DEVICES ONLY. ENTER C OR COLOR TO DISPLAY THE SCENE IN COLOR. THE DEFAULT DISPLAY MODE IS BLACK AND WHITE. ENTER THE RESOLUTION IN THE HORIZONTAL AND VERTICAL DIRECTIONS. IF ONLY THE XRESOL IS GIVEN, YRESOL IS ASSUMED TO HAVE THE SAME VALUE. IF BOTH MOVIE USER'S MANUAL Page 1-14 ARE ZERO, THE MAXIMUM VALUE OF 512 IS USED. SMOOTH THE SMOOTH COMMAND WILL INVOKE SMOOTH ELEMENT SHADING. THE LIGHT INTENSITY WILL MATCH AT ELEMENT BOUNDARIES PROVIDING CURVED SURFACE SIMULATION. THE DERIVATIVE OF THE LIGHT INTENSITY MAY NOT MATCH AT ELEMENT BOUNDARIES CAUSING MACH BAND EFFECTS (WHICH MAY OR MAY NOT BE NOTICABLE). SUMMARY THE SUMMARY COMMAND CALCULATES THE MINIMUM AND MAXIMUM VALUES OF THE COORDINATES, DISPLACEMENTS, AND SCALAR FUNCTIONS AND TYPES THEM ON THE USER'S TERMINAL FOR THE PARTS SPECIFIED IN CONTENT. TRANSLATE THE TRANSLATE COMMAND ALLOWS THE USER TO SHIFT THE ORIGIN OF THE MODEL TO A NEW LOCATION. ENTER THE COORDINATES OF THE NEW ORIGIN. UNIFORM THE UNIFORM COMMAND INVOKES UNIFORM SHADING OF THE ELEMENT FACES. THE SHADING WILL REMAIN CONSTANT OVER EACH INDIVIDUAL ELEMENT. THE VALUE USED IS THE AVERAGE OF THE NODAL VALUES BASED UPON FLAT SHADING. MOVIE USER'S MANUAL Page 1-15  VIEW THE VIEW COMMAND SENDS THE PICTURE DEFINED BY ALL PREVIOUS COMMANDS TO THE DISPLAY DEVICE SELECTED IN THE SCOPE OR DEVICE COMMANDS. THIS DISPLAY COMMAND WILL INVOKE WATKIN'S ALGORITHM TO REMOVE HIDDEN LINES OR SURFACES. THE PROGRAM WILL TYPE THE COLOR OPTION IN EFFECT IF THE OUTPUT IS A CONTINUOUS TONE PICTURE ELSE IT WILL TYPE THE NAME OF THE LINE DRAWING OUTPUT DEVICE.  WARP THE WARP COMMAND ALLOWS THE USER TO SPECIFY THE SCALE FACTORS IN THE X, Y, AND Z DIRECTIONS OF THE MODEL BY WHICH THE SCALAR FUNCTIONS WILL BE MODIFIED BEFORE THEY ARE ADDED TO THE NODAL COORDINATES. THIS IS USEFUL OVER LARGE PLANAR AREAS WHEN THE SCALE FACTORS ARE A MULTIPLE OF THE DIRECTIONS COSINES OF A NORMAL TO THE PLANAR AREA.  ENTER THE WARPING SCALE FACTORS FOR THE MODEL PARTS. ERROR MESSAGES IF A COMMAND IS NOT RECOGNIZED DURING THE EXECUTION OF THE PROGRAM, THE ILLEGAL COMMAND IS TYPED ON THE USER'S TERMINAL AS FOLLOWS. IF THE USER WISHES TO SEE A LIST OF THE AVAILABLE COMMANDS, HE SHOULD ANSWER Y OR YES TO THIS ERROR MESSAGE. Page Index-1 MOVIE USER'S MANUAL INDEX Animated sequence . . . . . . 1-10 Center . . . . . . . . . . . . 1-3 Color . . . . . . . . . . . . 1-3 Command prompt . . . . . . . . 1-3 Contour . . . . . . . . . . . 1-4 Device . . . . . . . . . . . . 1-5 Difuse . . . . . . . . . . . . 1-5 Displacement file . . . . . . 1-2  Distance . . . . . . . . . . . 1-5 Draw . . . . . . . . . . . . . 1-5 Error messages . . . . . . . . 1-15 Exit . . . . . . . . . . . . . 1-6 Explode . . . . . . . . . . . 1-6 Fast . . . . . . . . . . . . . 1-6 Field . . . . . . . . . . . . 1-7 Flat . . . . . . . . . . . . . 1-7 Fringe . . . . . . . . . . . . 1-8 Geometry file . . . . . . . . 1-1 Help . . . . . . . . . . . . . 1-8 Ip . . . . . . . . . . . . . . 1-2 Linear . . . . . . . . . . . . 1-9 Movie . . . . . . . . . . . . 1-10 Nj . . . . . . . . . . . . . . 1-2 Np . . . . . . . . . . . . . . 1-2 Npl . . . . . . . . . . . . . 1-2 Npt . . . . . . . . . . . . . 1-2 Parts . . . . . . . . . . . . 1-11 Pivot . . . . . . . . . . . . 1-12 Read . . . . . . . . . . . . . 1-12 Restore . . . . . . . . . . . 1-12 Rotate . . . . . . . . . . . . 1-13 S . . . . . . . . . . . . . . 1-2 Scalar function file . . . . . 1-2 Scale . . . . . . . . . . . . 1-13 Scope . . . . . . . . . . . . 1-13 Smooth . . . . . . . . . . . . 1-14 Structural vibration . . . . . 1-10 Summary . . . . . . . . . . . 1-14 Translate . . . . . . . . . . 1-14 U . . . . . . . . . . . . . . 1-2 Uniform . . . . . . . . . . . 1-14 View . . . . . . . . . . . . . 1-15 Warp . . . . . . . . . . . . . 1-15 X . . . . . . . . . . . . . . 1-2 CHAPTER 2 UTILITY USER'S MANUAL INTRODUCTION UTILITY IS A ROUTINE DESIGNED TO EDIT FORTRAN DATA FILES IN A FORMAT WHICH IS COMPATIBLE WITH MOVIE (PANEL DATA) OR SECTION (SOLID DATA). THE PROGRAM IS BASED UPON A FOUR LETTER KEY WORD SYSTEM WHICH ALLOWS THE USER TO SPECIFY COMMANDS TO READ, WRITE, OR CHANGE DATA FILES, TO PERFORM SYMMETRY OPERATIONS (E. G. TO CREATE A MODEL OF A COMPLETE SPHERE BASED UPON A MODEL OF 1/8 OF THE SPHERE LOCATED IN THE FIRST QUADRANT), TO ORDER PANEL DATA CONSISTENTLY, OR TO EXIT FROM THE PROGRAM IN A CONTROLLED MANNER. WHILE THE FOLLOWING INSTRUCTIONS ARE RATHER LENGTHY, USERS WILL NORMALLY NOT FIND MUCH REASON TO REFER TO THEM. THE SYSTEM IS EASILY LEARNED SINCE THE PROGRAM ASKS SPECIFIC QUESTIONS OR GIVES ONE OF THE FOLLOWING PROMPTS (> FOR LEVEL 1, >> FOR LEVEL 2, OR >>> FOR LEVEL 3). WHEN THESE PROMPTS ARE ENCOUNTERED, A LISTING OF THE AVAILABLE OPTIONS MAY BE OBTAINED BY ENTERING ? OR HELP. ESCAPE FROM REPEATED REQUESTS (IF ESCAPE IS APPROPRIATE) IS ACCOMPLISHED WITH A CARRIAGE RETURN. A CARRIAGE RETURN FOLLOWING THE PROMPT (>>>) FOR LEVEL 3 WILL TRANSFER CONTROL TO LEVEL 2 AND GIVE THE PROMPT (>>). ESCAPE TO LEVEL 1 IS ALSO OBTAINED BY A CARRIAGE RETURN. SINCE UTILITY IS APPLICABLE TO BOTH SOLID DATA (8 NODE BRICKS) AND PANEL DATA (TRIANGLES AND QUADRILATERALS), THE PROGRAM ISSUES THE FOLLOWING REQUEST. ENTER S OR SOLID FOR SOLID DATA MANIPULATION. ANY OTHER RESPONSE WILL DEFAULT TO PANEL DATA. UTILITY USER'S MANUAL Page 2-2 LEVEL 1 THE PROGRAM IS ENTERED AT LEVEL 1 AND THE CORRESPONDING PROMPT (>) IS GIVEN. AT THIS POINT THE USER SHOULD ENTER ONE OF THE FOLLOWING COMMANDS: GEOMETRY, DISPLACEMENT, FUNCTION, SYMMETRY, ORDER, OR EXIT. ACTUALLY ONLY THE FIRST FOUR LETTERS OF THE COMMANDS ARE REQUIRED. IF ANY OTHER COMMAND IS GIVEN, THE ABOVE OPTIONS ARE LISTED AND THE PROMPT IS REPEATED. IF THE COMMAND GIVEN IS GEOM, DISP, OR SPEC THE PROGRAM ENTERS LEVEL 2. IF THE COMMAND IS SYMM, SYMMETRY OPERATIONS ARE PERFORMED AS SPECIFIED. IF THE COMMAND IS ORDER AND THE PROGRAM IS IN PANEL MODE, THE ELMENTS OR PANELS ARE CONSISTENTLY ORDERED WITHIN EACH ELEMEMT GROUP. FOR THE COMMAND EXIT, THE BUFFERS ARE DUMPED AND CONTROL IS RETURNED TO THE MONITOR. LEVEL 2 THE LEVEL 2 ALGORITHM ENTERED DEPENDS UPON THE COMMAND GIVEN IN LEVEL 1. HOWEVER, THEY ALL SHARE THE SAME FUNCTIONAL COMMANDS WHICH ARE READ, WRITE, CHANGE, PRINT AND EXIT. IF THE COMMAND GIVEN IS UNACCEPTABLE, THE LEVEL 2 OPTIONS ARE LISTED AND THE PROMPT IS REPEATED. THE RESPONSE TO THE FIVE  ACCEPTABLE COMMANDS DEPENDS UPON THE COMMANDS GIVEN AT BOTH LEVEL 1 AND LEVEL 2. THIS RESPONSE WILL NOW BE DISCUSSED ACCORDING TO THE VARIOUS COMBINATIONS OF LEVEL 1 - LEVEL 2 COMMANDS. GEOM-READ ENTER THE INPUT GEOMETRY FILENAME.EXT. THE FILENAME SHOULD NOT EXCEED SIX CHARACTERS, AND THE EXTENSION SHOULD NOT EXCEED THREE. IF THE EXTENSION IS OMITTED, THE DEFAULT EXTENSION DAT WILL BE ASSUMED.(1) (1) THE MANNER IN WHICH DATA FILES ARE INITIALIZED IS AN INSTALLATION DEPENDENT FEATURE. APPROPRIATE MODIFICATIONS SHOULD BE MADE IN THE SOURCE PROGRAM TO ACCOMMODATE YOUR SYSTEM. UTILITY USER'S MANUAL Page 2-3 AT THIS POINT THE GEOMETRY FILE WILL BE READ USING THE FOLLOWING FORTRAN STATEMENTS. READ(IDTA,10) NP,NJ,NPT READ(IDTA,10) ((NPL(I,J),I=1,2),J=1,NP) READ(IDTA,20) ((X(I,J),I=1,3),J=1,NJ) READ(IDTA,10) ((IP(I,J),I=1,N),J=1,NPT) 10 FORMAT(20I4) 20 FORMAT(6E12.5) THE VARIABLES ARE DEFINED AS FOLLOWS: NP = THE NUMBER OF PARTS NJ = THE NUMBER OF NODES OR JOINTS NPT = THE NUMBER OF ELEMENTS  NPL = THE PARTS ARRAY(2) X = THE COORDINATES OF THE NODES IP = THE CONNECTIVITY OF THE ELEMENTS AFTER READING THE GEOMETRY FILE THE PROGRAM REQUEST VERIFICATION THAT THE PARTS ARRAY IS DEFINED PROPERLY. (LIST OF TOTAL NPL ARRAY) (LIST OF DIFFERENCED NPL ARRAY) ENTER Y OR YES IF THE PARTS ARRAY IS DEFINED  PROPERLY. ANY OTHER RESPONSE WILL REQUEST THE USER TO REDEFINE THE PARTS ARRAY. (2) THE PARTS ARRAY IS DEFINED IN ONE OF TWO WAYS. THE FIRST DEFINITION ASSUMS THAT THE ARRAY IS ONE DIMENSIONAL. EACH STORAGE LOCATION IN THE ARRAY CONTAINS THE NUMBER OF ELEMENTS IN THE ELEMENT GROUP THAT CORRESPONDS WITH THAT LOCATION. THE SECOND DEFINITION ASSUMS THAT THE ARRAY IS TWO DIMENSIONAL. THE  ARRAY CONTAINS THE LOWER AND UPPER LIMIT NUMBERS OF THE ELEMENTS ASSOCIATED WITH THAT PART. THESE DEFINITIONS ARE NOT NECESSARILY INTERCHANGABLE. THE SECOND DEFINITION ALLOWS PARTS TO OVERLAP WHILE THE FIRST DOES NOT. UTILITY REQUIRES THE NPL ARRAY BE DEFINED AS IN THE FIRST DEFINITION INTERNALLY ALTHOUGHT THE NPL ARRAY IS READ AND WRITTEN ACCORDING TO THE SECOND DEFINITION. UTILITY USER'S MANUAL  Page 2-4 THIS MESSAGE IS PRINTED IF THE PROGRAM DETECTS MULTIPLY DEFINED PARTS WHILE ATTEMPTING TO CONSTRUCT THE PARTS ARRAY. THE PROGRAM WILL REQUEST THE USER TO SUPPLY THE CORRECT PARTS ARRAY. ENTER THE NUMBER OF ELEMENT GROUPINGS ENTER THE NUMBER OF ELEMENTS IN EACH GROUP. GEOM-WRITE ENTER THE OUTPUT GEOMETRY FILENAME.EXT. THE FILENAME SHOULD NOT EXCEED SIX CHARACTERS, AND THE EXTENSION SHOULD NOT EXCEED THREE. IF THE EXTENSION IS OMITTED, THE DEFAULT EXTENSION DAT WILL BE ASSUMED. BEFORE WRITING THE GEOMETRY FILE, THE PROGRAM ALLOWS THE USER TO VERIFIY THE PARTS ARRAY AND TO CHANGE IT IF DESIRED. (LIST OF NPL ARRAY) ENTER Y OR YES IF THE LOWER AND UPPER LIMITS OF THE PARTS ARRAY ARE CORRECT. ANY OTHER RESPONSE WILL REQUEST NEW ELEMENT LIMIT INFORMATION. ENTER THE NUMBER OF PARTS. ENTER THE LOWER AND UPPER LIMIT NUMBERS OF THE BOUNDING ELEMENTS FOR EACH PART. (REMEMBER, THIS MAY BE AN OVERLAPPING DEFINITION.) UTILITY USER'S MANUAL Page 2-5 AT THIS POINT THE GEOMETRY FILE WILL BE WRITTEN USING THE FOLLOWING FORTRAN STATEMENTS. WRITE(IDTA,10) NP,NJ,NPT WRITE(IDTA,10) ((NPL(I,J),I=1,2),J=1,NP) WRITE(IDTA,20) ((X(I,J),I=1,3),J=1,NJ) WRITE(IDTA,10) ((IP(I,J),I=1,N),J=1,NPT) 10 FORMAT(20I4) 20 FORMAT(1P6E12.5) FOR VARIABLE DESCIPTIONS, SEE GEOM-READ. GEOM-CHANGE THIS COMMAND RESULTS IN THE PROGRAM ENTERING LEVEL 3 WITH THE USER RECEIVING THE PROMPT (>>>). THE ALLOWABLE COMMANDS IN THIS INSTANCE ARE GROUP, COORDINATES, ELEMENTS, MOVE, AND EXIT AN UNACCEPTABLE COMMAND WILL RESULT IN A LISTING OF THE FIVE LEGITIMATE COMMANDS AND THE PROMPT (>>>). ISSUE OF AN ACCEPTABLE COMMAND RESULTS IN THE FOLLOWING ACTIONS. GEOM-CHAN-GROUP ENTER THE NUMBER OF ELEMENT GROUPS (NP). ENTER THE COMPLETE ELEMENT GROUP LIST (NPL(1,I),I=1,NP). GEOM-CHAN-COORDINATES  ENTER Y OR YES TO CHANGE THE TOTAL NUMBER OF NODES (NJ) IN THE MODEL. ANY OTHER RESPONSE WILL SKIP THE NEXT REQUEST. UTILITY USER'S MANUAL Page 2-6 ENTER THE NEW NUMBER OF NODES. ENTER THE APPROPRIATE NODE NUMBER AND CORRESPONDING X, Y, AND Z COORDINATE VALUES (RIGHT HANDED SYSTEM) ACCORDING TO THE FORMAT (I,3E). IF THE NODE NUMBER IS LARGER THAN THE CURRENT TOTAL NUMBER OF NODES, THE TOTAL NUMBER OF NODES IS INCREASED TO THE VALUE OF THE ENTERED NODE NUMBER. GEOM-CHAN-ELEMENT ENTER A OR ADD TO ADD NEW ELEMENTS; ENTER D OR DELETE TO DELETE OLD ELEMENTS.  ENTER THE PART NUMBER AND ELEMENT NUMBERS (IN APPROPRIATE ORDER) ACCORDING TO THE FORMAT (5I) FOR QUADRILATERAL ELEMENTS, (4I) FOR TRIANGULAR ELEMENTS AND (9I) FOR SOLID ELEMENTS. ELEMENTS ARE INSERTED INTO THE ELEMENT LIST AT THE END OF THE GROUP OF ELEMENTS FOR THE INDICATED PART. THE APPROPRIATE PART GROUP NUMBER (NPL(1,I)) WILL BE INCREASED. IF THE USER WISHES TO ENTER ELEMENTS IN A NEW PART GROUP, HE SHOULD FIRST USE THE LEVEL 3 COMMAND PART TO INCREASE THE TOTAL NUMBER OF PARTS BY ONE AND ENTER THE VECTOR (NPL(1,I)) WITH THE LAST VALUE (FOR THE NEW GROUP) SET EQUAL TO ZERO. APPROPRIATE MODIFICATION IS MADE IN (NPL(1,I)) IF AN ELEMENT IS DELETED. HOWEVER, IF AN ENTIRE PART IS DELETED, THE COMMAND PART SHOULD BE EXECUTED (AFTER THE COMPLETION OF THE DELETION PROCESS) TO REDUCE THE TOTAL NUMBER OF PARTS. IF AN ELEMENT IS SPECIFIED TO BE DELETED FROM THE LIST AND CANNOT BE FOUND IN THE LIST, THE PROGRAM RESPONDS WITH THE MESSAGE %. IF AN ELEMENT HAS BEEN ENTERED WITH AN INCORRECT NODE  NUMBER, THE CORRECTION WILL REQUIRE THAT THE ELEMENT BE DELETED AND THE CORRECT ONE ENTERED (I. E. THERE IS NO REPLACE FEATURE!). UTILITY USER'S MANUAL Page 2-7 GEOM-CHAN-MOVE ENTER THE APPROPRIATE VALUES FOR I1, I2, AND I3. TO ILLUSTRATE THE USE OF THIS COMMAND, CONSIDER THE FOLLOWING EXAMPLE. SUPPOSE THAT WE WISH TO REORDER A LIST OF SIX ELEMENTS SUCH THAT THE FIRST TWO ELEMENTS REMAIN WHERE THEY ARE, THE FIFTH ELEMENT BECOMES THE THIRD ELEMENT, THE THIRD AND FOURTH ELEMENTS BECOME THE FOURTH AND FIFTH ELEMENTS AND THE SIXTH ELEMENT RETAINS ITS POSITION. THIS REORDERING MAY BE ACHIEVED BY THE MOVE COMMAND (2,3,5) OR (1,5,2). MOVE COMMANDS DO NOT AUTOMATICALLY RESULT IN CHANGES TO THE (NPL(1,I)) LIST. THE USER MAY MODIFY (NPL(1,I)) AS APPROPRIATE, EITHER BEFORE OR AFTER USING THE MOVE COMMAND. CAUTION SHOULD BE EXERCISED IN THE USE OF REPEATED MOVE COMMANDS TO AVOID GETTING ALL MIXED UP. USE OF PRIN COMMANDS BETWEEN MOVE COMMANDS TO ESTABLISH ELEMENT GROUP LIMIT LOCATIONS IS RECOMMENDED. GEOM-PRINT THIS COMMAND PAIR IS STRUCTURED SO AS TO FACILITATE QUICK CHECKS OF SUBSETS OF THE DATA. THESE COMMANDS RESULT IN THE PROGRAM ENTERING A LEVEL 3 OPERATION WITH THE PROMPT (>>>) WHICH IS SIMILAR TO THAT DISCUSSED IN GEOM-CHAN. THE ACCEPTABLE COMMANDS AT THIS LEVEL ARE GROUP, COORDINATES, ELEMENTS, AND EXIT. ISSUE OF ONE OF THESE COMMANDS RESULTS IN THE FOLLOWING ACTION. GEOM-PRIN-GROUP THE COMPLETE PART LIST (NPL(1,I),I=1,NP) IS PRINTED. GEOM-PRIN-COORDINATE ENTER I1 AND I2 WITH I1 BEING THE LOWER LIMIT AND I2 BEING THE UPPER LIMIT NODE NUMBERS (2I FORMAT). TO OBTAIN THE COORDINATES OF A SINGLE NODE SIMPLY ENTER JUST THE DESIRED NODE AS I1 AND DO NOT  ENTER I2. I2 WILL BE ADJUSTED TO BE NOT GREATER THAN (NJ). UTILITY USER'S MANUAL Page 2-8 GEOM-PRIN-ELEMENT ENTER I1 AND I2 WITH I1 BEING THE LOWER LIMIT AND I2 BEING THE UPPER LIMIT ELEMENT NUMBERS (2I FORMAT). TO OBTAIN THE NODE NUMBERS OF A SINGLE ELEMENT SIMPLY ENTER JUST THE DESIRED ELEMENT AS I1  AND DO NOT ENTER I2. I2 WILL BE ADJUSTED TO BE NOT GREATER THAN (NPT). DISP-READ ENTER THE INPUT DISPLACEMENT FILENAME.EXT. THE FILENAME SHOULD NOT EXCEED SIX CHARACTERS, AND THE EXTENSION SHOULD NOT EXCEED THREE. IF THE EXTENSION IS OMITTED, THE DEFAULT EXTENSION DAT WILL BE ASSUMED.  AT THIS POINT THE DISPLACEMENT FILE WILL BE READ USING THE FOLLOWING FORTRAN STATEMENTS. READ(IDTA,20) ((U(I,J),I=1,3),J=1,NJ) 20 FORMAT(6E12.5) THE VARIABLE, U, IS THE DISPLACEMENTS AT THE NODES. DISP-WRITE ENTER THE OUTPUT DISPLACEMENT FILENAME.EXT. THE FILENAME SHOULD NOT EXCEED SIX CHARACTERS, AND  THE EXTENSION SHOULD NOT EXCEED THREE. IF THE EXTENSION IS OMITTED, THE DEFAULT EXTENSION DAT WILL BE ASSUMED. AT THIS POINT THE DISPLACEMENT FILE WILL BE WRITTEN USING THE FOLLOWING FORTRAN STATEMENTS. UTILITY USER'S MANUAL Page 2-9 WRITE(IDTA,20) ((U(I,J),I=1,3),J=1,NJ) 20 FORMAT(1P6E12.5) FOR VARIABLE DESCIPTIONS, SEE DISP-READ. DISP-CHANGE ENTER THE NODE NUMBER AND THE X, Y, AND Z COORDINATE DIRECTION DISPLACEMENT COMPONENTS IN AN (I,3E) FORMAT. DISP-PRINT ENTER I1 AND I2 WITH I1 BEING THE LOWER LIMIT AND I2 BEING THE UPPER LIMIT NODE NUMBERS (2I FORMAT). TO OBTAIN THE DISPLACEMENTS OF A SINGLE NODE SIMPLY ENTER JUST THE DESIRED NODE AS I1 AND DO NOT ENTER I2. I2 WILL BE ADJUSTED TO BE NOT GREATER THAN (NJ). FUNC-READ ENTER THE INPUT SCALAR FUNCTION FILENAME.EXT. THE FILENAME SHOULD NOT EXCEED SIX CHARACTERS, AND THE EXTENSION SHOULD NOT EXCEED THREE. IF THE EXTENSION IS OMITTED, THE DEFAULT EXTENSION DAT WILL BE ASSUMED. AT THIS POINT THE SCALAR FUNCTION FILE WILL BE READ USING THE FOLLOWING FORTRAN STATEMENTS. READ(IDTA,20) (S(I),I=1,NJ) 20 FORMAT(6E12.5) UTILITY USER'S MANUAL Page 2-10 THE VARIABLE, S, IS THE SCALAR FUNCTION AT THE NODE. FUNC-WRITE ENTER THE OUTPUT SCALAR FUNCTION FILENAME.EXT. THE FILENAME SHOULD NOT EXCEED SIX CHARACTERS, AND THE EXTENSION SHOULD NOT EXCEED THREE. IF THE EXTENSION IS OMITTED, THE DEFAULT EXTENSION DAT WILL BE ASSUMED. AT THIS POINT THE SCALAR FUNCTION FILE WILL BE WRITTEN USING THE FOLLOWING FORTRAN STATEMENTS.  WRITE(IDTA,20) (S(I),I=1,NJ) 20 FORMAT(1P6E12.5) FOR VARIABLE DESCIPTIONS, SEE FUNC-READ. FUNC-CHANGE ENTER THE NODE NUMBER AND THE SCALAR FUNCTION VALUE. FUNC-PRINT ENTER I1 AND I2 WITH I1 BEING THE LOWER LIMIT AND I2 BEING THE UPPER LIMIT NODE NUMBERS (2I FORMAT). TO OBTAIN THE SCALAR FUNCTION OF A SINGLE NODE SIMPLY ENTER JUST THE DESIRED NODE AS I1 AND DO NOT ENTER I2. I2 WILL BE ADJUSTED TO BE NOT GREATER THAN (NJ). THIS COMPLETES THE DISCUSSION OF THE LEVEL 1-LEVEL 2 COMMAND COMBINATIONS. THE FOLLOWING PARAGRAPHS DESCRIBE THE OTHER LEVEL 1 COMMANDS WHICH ARE SYMMETRY AND ORDER.  UTILITY USER'S MANUAL Page 2-11 SYMMETRY THE SYMMETRY COMMAND PROVIDES MODIFICATION TO THE GEOMETRY, DISPLACEMENT, AND SPECIAL FUNCTION FILES. THE SYMMETRY OPERATION WILL DOUBLE THE NUMBER OF PARTS AND ELEMENTS, BUT THE NUMBER OF NODES WILL NOT DOUBLE DUE TO THE PRESENCE OF NODES ON THE PLANE OF SYMMETRY (WHICH ARE NOT REPEATED). IF BEFORE THE SYMMETRY OPERATION THERE WERE (NP) PARTS, THE SYMMETRICAL COUNTERPART TO THE NTH PART IS FOUND TO BE THE NP+NTH PART. ENTER ONE OF THE ACCEPTABLE SYMMETRY PLANES XY, XZ, OR YZ, OR A CARRIAGE RETURN TO PROVIDE ESCAPE. ENTER Y OR YES TO PREFORM THE SYMMETRY OPERATION ON MULTIPLE DISPLACEMENT OR SCALAR FUNCTION FILES. ANY OTHER REPONSE WILL SKIP THE REMAINING REQUESTS. ENTER THE NUMBER OF DISPLACEMENT FILES FOR WHICH SYMMETRY OPERATINS ARE DESIRED. A ZERO OR CARRIAGE RETURN WILL SKIP FURTHER REQUEST FOR DISPLACEMENT FILE INFORMATION. SEE DISP-READ FOR FORMAT INFORMATION.  SEE DISP-WRIT FOR FORMAT INFORMATION THE TWO REQUEST ABOVE ARE REPEATED FOR THE NUMBER OF DISPLACEMENT FILES SPECIFIED. ENTER THE NUMBER OF SCALAR FUNCTION FILES FOR WHICH SYMMETRY OPERATINS ARE DESIRED. A ZERO OR CARRIAGE RETURN WILL SKIP FURTHER REQUEST FOR DISPLACEMENT FILE INFORMATION. UTILITY USER'S MANUAL Page 2-12 SEE FUNC-READ FOR FORMAT INFORMATION. SEE FUNC-WRIT FOR FORMAT INFORMATION THE TWO REQUEST ABOVE ARE REPEATED FOR THE NUMBER OF SCALAR FUNCTION FILES SPECIFIED. ORDER THE ORDER COMMAND ATTEMPTS TO CONSISTENTLY ORDER THE PANEL DATA OF THE IP ARRAY IN A CLOCKWISE OR COUNTER-CLOCKWISE MANNER. THE FIRST ELEMENT IN EACH GROUP IS ASSUMED TO BE ORDERED CORRECTLY. ALL OTHER ELEMENTS IN THAT GROUP ARE MATCHED AGAINST PREVIOUSLY ORDERED ELEMENTS UNTIL THE PROCESS IS COMPLETE. IF AN ELEMENT CAN NOT BE MATCHED, THE MESSAGE % IS TYPED ON THE USERS TERMINAL. THIS ALGORITHM IS NOT AVAILABLE FOR USE WITH SOLID DATA. IF THE USER ATTEMPTS TO USE IT WITH SOLID DATA, THE MESSAGE % WILL BE TYPED ON HIS TERMINAL. UTILITY USER'S MANUAL Page 2-13 ERROR MESSAGES THERE ARE THREE WARNING AND THREE ERROR MESSAGES THAT MAY BE ISSUED DURING A SESSION. THE ERROR MESSAGES ARE CONSIDERED FATAL AND WILL CAUSE PROGRAM EXECUTION TO TERMINATE. THE MESSAGES ARE: % ATTEMPT TO DELETE AN ELEMENT THAT WAS NOT FOUND. SEE GEOM-CHAN-ELEM. % THE USER ATTEMPTED TO ORDER SOLID DATA, AN OPERATION THAT IS UNDEFINED. SEE ORDER. % WHILE ATTEMPTING TO ORDER PANEL DATA, AN ELEMENT WAS FOUND IN AN ELEMENT GROUPING THAT DID NOT HAVE A COMMON EDGE WITH ANY OTHER ELEMENT IN THAT GROUP. SEE ORDER. ? THE USER ATTEMPTED TO EXCEED THE MAXIMUM DIMENSION OF NPMAX. INCREASE THE VALUE OF NPMAX IN THE MAIN PROGRAM AND TRY AGAIN. ?  THE USER ATTEMPTED TO EXCEED THE MAXIMUM DIMENSION OF NJMAX. INCREASE THE VALUE OF NJMAX IN THE MAIN PROGRAM AND TRY AGAIN. ? THE USER ATTEMPTED TO EXCEED THE MAXIMUM DIMENSION OF NPTMAX. INCREASE THE VALUE OF NPTMAX IN THE MAIN PROGRAM AND TRY AGAIN. Page Index-1  UTILITY USER'S MANUAL INDEX Disp-change . . . . . . . . . 2-9 Disp-print . . . . . . . . . . 2-9 Disp-read . . . . . . . . . . 2-8 Disp-write . . . . . . . . . . 2-8 Displacement file . . . . . . 2-8 Error messages . . . . . . . . 2-13 Func-change . . . . . . . . . 2-10 Func-print . . . . . . . . . . 2-10 Func-read . . . . . . . . . . 2-9 Func-write . . . . . . . . . . 2-10 Geom-chan-coordinates . . . . 2-5 Geom-chan-element . . . . . . 2-6 Geom-chan-group . . . . . . . 2-5 Geom-chan-move . . . . . . . . 2-7 Geom-change . . . . . . . . . 2-5 Geom-prin-coordinate . . . . . 2-7 Geom-prin-element . . . . . . 2-8 Geom-prin-group . . . . . . . 2-7 Geom-print . . . . . . . . . . 2-7 Geom-read . . . . . . . . . . 2-2 Geom-write . . . . . . . . . . 2-4 Geometry file . . . . . . . . 2-2, 2-4 Ip . . . . . . . . . . . . . . 2-3 Level 1 . . . . . . . . . . . 2-2 Level 2 . . . . . . . . . . . 2-2 Nj . . . . . . . . . . . . . . 2-3 Np . . . . . . . . . . . . . . 2-3 Npl . . . . . . . . . . . . . 2-3 Npt . . . . . . . . . . . . . 2-3 Order . . . . . . . . . . . . 2-12 Panal data . . . . . . . . . . 2-1 S . . . . . . . . . . . . . . 2-9 Scalar function file . . . . . 2-9 Solid data . . . . . . . . . . 2-1 Symmetry . . . . . . . . . . . 2-11 U . . . . . . . . . . . . . . 2-8 X . . . . . . . . . . . . . . 2-3 CHAPTER 3 SECTION USER'S MANUAL SECTION IS AN INTERACTIVE PROGRAM. IT WILL PROMPT THE USER FOR ALL THE NECESSARY INFORMATION WITH THE FOLLOWING REQUESTS.  ENTER THE INPUT GEOMETRY FILENAME.EXT. THE FILENAME SHOULD NOT EXCEED SIX CHARACTERS. IF THE EXTENSION IS OMITTED, THE DEFAULT EXTENSION DAT WILL BE USED.(1) AT THIS POINT THE GEOMETRY FILE WILL BE READ USING THE FOLLOWING FORTRAN STATEMENTS. READ(IDTA,10) NP,NJ,NPT READ(IDTA,10) ((NPL(I,J),I=1,2),J=1,NP) READ(IDTA,20) ((X(I,J),I=1,3),J=1,NJ) READ(IDTA,10) ((IP(I,J),I=1,8),J=1,NPT) 10 FORMAT(20I4) 20 FORMAT(6E12.5) THE VARIABLES ARE DEFINED AS FOLLOWS: NP = THE NUMBER OF PARTS NJ = THE NUMBER OF NODES OR JOINTS NPT = THE NUMBER OF ELEMENTS NPL = THE PARTS LIST ELEMENTS ARE GROUPED TOGETHER FOR SMOOTH SURFACE SIMULATION AND COLOR DEFINITION. THE PARTS LIST CONTAINS THE ELEMENT NUMBERS OF THE LOWER AND UPPER BOUNDS OF THE ELEMENTS IN EACH GROUPING. (1) THE MANNER IN WHICH DATA FILES ARE INITIALIZED IS AN INSTALLATION DEPENDENT FEATURE. APPROPRIATE MODIFICATIONS SHOULD BE MADE IN THE SOURCE PROGRAM TO ACCOMMODATE YOUR SYSTEM. SECTION USER'S MANUAL Page 3-2 X = THE COORDINATES OF THE NODES THE COORDINATES ARE LISTED IN THE X, Y, AND Z DIRECTIONS BY NODE NUMBER. IP = THE CONNECTIVITY OF THE HEXAHEDRON ELEMENTS AN ELEMENT IS DEFINED BY SPECIFYING THE NODE NUMBERS ON TWO OPPOSITE FACES IN THE SAME CLOCKWISE OR COUNTER-CLOCKWISE DIRECTION. THE FIRST AND FIFTH NODE NUMBERS DEFINE AN EDGE JOINING THE FRONT AND BACK FACES.  ENTER THE NUMBER OF PLANES ON WHICH THE MODEL IS TO BE CLIPPED. IF ZERO STEPS ARE SPECIFIED, THE MODEL IS NOT CLIPPED BUT IS SWEPT FREE OF REDUNDANT INTERIOR DATA LEAVING ONLY POTENTIALLY VISIBLE SURFACES AND THE FOLLOWING TWO REQUEST ARE SKIPPED. ENTER THE CLIPPING PLANE DEFINITION FOR EACH PART. IF I2 IS GREATER THAN I1, ALL PARTS I1 THROUGH I2 WILL BE CLIPPED ON THE SAME PLANE. IF NO CLIPPING PLANE IS DEFINED FOR A PART, IT WILL NOT BE CLIPPED. POINT1 AND NORMAL1 ARE THE CARTESIAN COORDINATES OF THE POINT IN THE PLANE AND THE DIRECTION COSINES OF THE NORMAL TO THE PLANE OF THE INITIAL CLIPPING PLANE RESPECTIVELY. POINT2 AND NORMAL2 ARE THE POINT AND NORMAL DATA OF THE FINAL CLIPPING PLANE. IF THE NUMBER OF STEPS IS GREATER THAN TWO, A LINEAR INTERPOLATION BETWEEN THE INITIAL AND FINAL PLANES WILL BE USED TO CALCULATE INTERMEDIATE PLANES. A LINE OF ZEROS TERMINATES THIS REQUEST. ENTER FRONT, BACK OR BOTH TO SAVE ONLY POLYGONS THAT ARE IN FRONT OF THE CLIPPING PLANE, ONLY POLYGONS THAT ARE BEHIND THE CLIPPING PLANE, OR BOTH POLYGONS IN FRONT OF AND BEHIND THE CLIPPING PLANE. ENTER THE OUTPUT GEOMETRY FILENAME.EXT. THE FILENAME SHOULD NOT EXCEED SIX CHARACTERS. IF THE  EXTENSION IS OMITTED, THE DEFAULT EXTENSION DAT WILL BE USED. SECTION USER'S MANUAL Page 3-3 AT THIS POINT THE GEOMETRY FILE WILL BE WRITTEN USING THE FOLLOWING FORTRAN STATEMENTS. WRITE(IDTA,10) NP,NJ,NPT WRITE(IDTA,10) ((NPL(I,J),I=1,2),J=1,NP) WRITE(IDTA,20) ((X(I,J),I=1,3),J=1,NJ) WRITE(IDTA,10) ((IP(I,J),I=1,8),J=1,NPT) 10 FORMAT(20I4) 20 FORMAT(1P6E12.5) ENTER THE NUMBER OF DISPLACEMENT FILES TO BE TRANSFORMED TO REFLECT THE NEW GEOMETRY DEFINITION. A ZERO WILL SKIP OVER ANY FURTHER REQUEST FOR DISPLACEMENT FILE INFORMATION. ENTER THE INPUT DISPLACEMENT FILENAME.EXT. THE FILENAME SHOULD NOT EXCEED SIX CHARACTERS. IF THE EXTENSION IS OMITTED, THE DEFAULT EXTENSION DAT WILL BE USED. AT THIS POINT THE DISPLACEMENT FILE WILL BE READ USING THE FOLLOWING FORTRAN STATEMENTS. READ(IDTA,20) ((U(I,J),I=1,3),J=1,NJ) 20 FORMAT(6E12.5) THE VARIABLE, U, IS THE DISPLACEMENT AT THE NODE. ENTER THE OUTPUT DISPLACEMENT FILENAME.EXT.  THE FILENAME SHOULD NOT EXCEED SIX CHARACTERS. IF THE EXTENSION IS OMITTED, THE DEFAULT EXTENSION DAT WILL BE USED. AT THIS POINT THE DISPLACEMENT FILE WILL BE WRITTEN USING THE FOLLOWING FORTRAN STATEMENTS. WRITE(IDTA,20) ((U(I,J),I=1,3),J=1,NJ) 20 FORMAT(1P6E12.5) THE TWO REQUEST ABOVE ARE REPEATED FOR EACH DISPLACEMENT FILE SPECIFIED. SECTION USER'S MANUAL Page 3-4 ENTER THE NUMBER OF SCALAR FUNCTION FILES TO BE TRANSFORMED TO REFLECT THE NEW GEOMETRY. A ZERO WILL SKIP OVER FURTHER REQUEST FOR INFORMATION ABOUT SCALAR FUNCTION FILES. ENTER THE INPUT SCALAR FUNCTION FILENAME.EXT. THE FILENAME SHOULD NOT EXCEED SIX CHARACTERS. IF THE EXTENSION IS OMITTED, THE DEFAULT EXTENSION DAT WILL BE USED. AT THIS POINT THE SCALAR FUNCTION FILE WILL BE READ USING THE FOLLOWING FORTRAN STATEMENTS. READ(IDTA,20) (S(I),I=1,NJ) 20 FORMAT(6E12.5) THE VARIABLE, S, IS THE SCALAR FUNCTION AT THE NODE. ENTER THE OUTPUT SCALAR FUNTION FILENAME.EXT. THE FILENAME SHOULD NOT EXCEED SIX CHARACTERS. IF THE EXTENSION IS OMITTED, THE DEFAULT EXTENSION DAT WILL BE USED. AT THIS POINT THE SCALAR FUNCTION FILE WILL BE WRITTEN USING THE FOLLOWING FORTRAN STATEMENTS. WRITE(IDTA,20) (S(I),I=1,NJ) 20 FORMAT(1P6E12.5) THE TWO REQUESTS ABOVE ARE REPEATED FOR EACH SCALAR FUNCTION FILE SPECIFIED. SECTION USER'S MANUAL Page 3-5 ERROR MESSAGES THREE ERROR MESSAGES MAY BE ISSUED DURING THE EXECUTION OF THE PROGRAM. ALL THREE ARE CONSIDERED FATAL ERRORS AND WILL TERMINATE PROGRAM EXECUTION. ? THIS MESSAGE INDICATES THAT ALL THE AVAILABLE FREE STORAGE HAS BEEN USED PRIOR TO THE COMPLETION OF PROCESSING. INCREASE THE SIZE OF BLANK COMMON IN THE MAIN PROGRAM. ? THIS MESSAGE RESULTS WHEN THE LINE SEGMENTS STORED FOR THE ON-PLANE POLYGONS DO NOT FORM A CLOSED FIGURE. IF THIS HAPPENS, CHECK THE INPUT DATA FOR IMPROPERLY DEFINED ELEMENTS. ?  THIS MESSAGE OCCURS WHEN A WARPED QUADRILATERAL FACE APPEARS TO STILL BE WARPED AFTER THE FACE IS DIVIDED INTO TWO TRIANGLES. THIS GENERALLY INDICATES A PROBLEM ELSEWHERE IN THE PROGRAM. PLEASE REPORT THIS ERROR. ? THIS MESSAGE IS PRINTED IF THE END OF THE OVERFLOW LIST IS FOUND WHILE TRYING TO DELETE A  POLYGON FROM THE HASH TABLE. PLEASE REPORT THIS ERROR. Page Index-1 SECTION USER'S MANUAL INDEX Clipping plane . . . . . . . . 3-2 Displacement file . . . . . . 3-3 Error messages . . . . . . . . 3-5 Geometry file . . . . . . . . 3-1 Ip . . . . . . . . . . . . . . 3-2 Nj . . . . . . . . . . . . . . 3-1 Np . . . . . . . . . . . . . . 3-1 Npl . . . . . . . . . . . . . 3-1 Npt . . . . . . . . . . . . . 3-1 S . . . . . . . . . . . . . . 3-4 Scalar function file . . . . . 3-4 U . . . . . . . . . . . . . . 3-3 X . . . . . . . . . . . . . . 3-2 CHAPTER 4 TITLE USER'S MANUAL TITLE.FOR GENERATES TWO AND THREE DIMENSIONAL CHARACTER STRINGS IN A FORM THAT IS COMPATIBLE WITH MOVIE.BYU. THE PROGRAM IS INTERACTIVE, AND PROPMTS THE USER FOR ALL NECESSARY INPUT. THE PROGRAM PROCEEDS AS FOLLOWS: ENTER UP TO 70 CHARACTERS CONSISTING OF ONLY THE LETTERS OF THE ALPHABET, SPACES, THE INTEGERS 0 THRU 9 AND SPECIAL CHARACTERS . / - = $ . TO END A PARTICULAR TITLE, USE A CARRIAGE RETURN. <3-D?> ANSWER Y OR YES FOR THREE-DIMENSIONAL CHARACTERS AND CARRIAGE RETURN FOR TWO-DIMENSIONAL CHARACTERS. ENTER COORDINATES OF THER LOWER LEFT EDGE OF THE LINE OF TEXT. SINCE FOR NORMALIZED SPACING PURPOSES THE FRONT FACE OF A CHARACTER IS CENTERED IN A UNIT SQUARE, THE LEFT COORDINATES OF THE FIRST CHARACTER WILL BE SLIGHTLY GREATER THAN THE X-VALUE INPUT. SPACING: IS MULTIPLIED BY THE WIDTH SCALE FACTOR TO POSITION THE NEXT CHARACTER. A 1.0 GIVES A REASONALBE SPACING FOR TWO-DIMENSIONAL CHARACTERS, BUT THREE-DIMENSIONAL CHARACTERS WITH OFFSET (SEE NEXT INPUT) REQUIRE A LARGER VALUE. WIDTH: ACTUAL DISTANCE BETWEEN THE CENTER OF ADJACENT CHARACTERS IF SPACING = 1.0. THE ACTUAL WIDTH OF EACH CHARACTER (WITH THE EXCEPTION OF 1 AND THE SPECIAL CHARACTERS) IS 5/7 OF THE VALUE TITLE USER'S MANUAL Page 4-2 SPECIFIED FOR WIDTH. HEIGHT: ACTUAL HEIGHT OF THE CHARACTERS. DEPTH: NOT REQUIRED FOR TWO-DIMENSIONAL  CHARACTERS. POSITION OF BACK FACE OF CHARACTERS HAS A NEGATIVE Z-POSITION WITH RESPECT TO THE FRONT FACE (RIGHT-HANDED COORDINATE SYSTEM) FOR POSITIVE VALUE OF DEPTH. STRANGE EFFECTS CAN BE OBTAINED WITH NEGATIVE DEPTH. CHARACTERS ARE GENERATED IN COUNTERCLOCKWISE ORDERING FOR POSITIVE DEPTH. NOT REQUIRED FOR TWO-DIMENSIONAL CHARACTERS.  FOR THREE-DIMENSIONAL CHARACTERS, ENTER OFFSET COORDINATES FOR BACK FACE OF CHARACTER RELATIVE TO FRONT FACE. THIS SKEWING OF THE CHARACTERS PRODUCES THE EFFECT OF THE FRONT FACE BEING BRIGHT (LOOKING DIRECTLY AT THE OBSERVER) WITH THE SIDES OF THE CHARACTERS VISIBLE. THE COMBINATION OF OFFSET AND A SHARP PERSPECTIVE MAY BE QUITE CONFUSING. WITH NEAR-ZERO PRESPECTIVE, THE EFFECT (WHICH IS COMMONLY USED ON THREE-DIMENSIONAL CHARACTERS) IS QUITE GOOD. FOR SPACING, WIDTH, HEIGHT, DEPTH OF 1.5, 1., 1., 1.5 REASONABLE VALUES OF OFFSETS ARE .25, .25. OFFSETS MAY BE POSITIVE OR NEGATIVE. PRINTED IF NO CHARACTERS OR ONLY SPACES ARE ENCOUNTERED IN LINE OF TEXT. ENTER Y OR YES TO END TITLE OR CARRIAGE RETURN TO ENTER MORE LINES (PARTS). ENTER THE TITLE FILENAME.EXT. IF THE EXTENTION IS OMITTED, THE DEFAULT EXTENSION DAT WILL BE USED. A ZERO FILE DESIGNATION WILL NOT WRITE THE FILE, BUT WILL ASK IF THE USER WISHES TO START A NEW TITLE. THIS IS HELPFUL IF THE USER DISCOVERS AN ERROR IN HIS TITLE AT THE LAST MINUTE.(1) (1) THE MANNER IN WHICH DATA FILES ARE INITIALIZED IS AN INSTALLATION DEPENDENT FEATURE. APPROPRIATE MODIFICATIONS SHOULD BE MADE IN THE SOURCE PROGRAM TO ACCOMMODATE YOUR SYSTEM. TITLE USER'S MANUAL Page 4-3 THE GEOMETRY FILE IS NOW WRITTEN USING THE FOLLOWING FORTRAN STATEMENTS. WRITE(IDTA,10) NP,NJ,NPT WRITE(IDTA,10) ((NPL(I,J),I=1,2),J=1,NP) WRITE(IDTA,20) ((X(I,J),I=1,3),J=1,NJ) WRITE(IDTA,10) ((IP(I,J),I=1,4),J=1,NPT) 10 FORMAT(20I4) 20 FORMAT(6E12.5) ENTER Y OR YES IF THE USER WISHES TO BEGIN A NEW TITLE. ANY OTHER RESPONSE WILL RETURN CONTROL TO THE MONITOR. AFTER GENERATION OF THE DATA FOR A LINE OF TEXT, THE ROUTINE PRINTS THE NOMINAL X-COORDINATE FOR THE RIGHT EDGE OF THE TEXT (USEFUL FOR POSITIONING PURPOSES), AND ALSO INDICATES THE CURRENT TOTAL NUMBERS OF PARTS, ELEMENTS, AND NODES. ERROR MESSAGES ? UNACCPETABLE CHARACTER ENCOUNTERED IN THE LINE OF TEXT. ABORTS LINE OF TEXT AND ASKS FOR NEW LINE OF TEXT.  CHAPTER 5 INSTALLING MOVIE.BYU THE FOLLOWING COMMENTS ARE INTENDED AS A GUIDE TO INSTALLING MOVIE.BYU ON ANY HOST COMPUTER. THE PROGRAMS ARE MOSTLY WRITTEN IN MACHINE INDEPENDENT FORTRAN. BEGINNING WITH MOVIE.FOR, EACH PROGRAM AND SUBPROGRAM WILL BE EXAMINED ALONG WITH SUGGESTED CHANGES THAT MIGHT BE CALLED FOR FILE 1: USER.DOC USER.DOC IS THE DOCUMENTATION YOU ARE NOW READING. NO CHANGES ARE NECESSARY. FILE 2: MOVIE.FOR MOVIE.FOR IS THE FORTRAN SOURCE FILE FOR THE DRIVING PACKAGE. IT INCLUDES THE MAIN PROGRAM AND SUBROUTINES THAT POSITION THE MODEL IN THE VIEWING WINDOW AND CALCULATE LIGHT INTENSITY AND SHADING. MAIN PROGRAM: FUNCTION: READS DATA FILES AND CALLS INTERACTIVE PICTURE ROUTINE.  IT MAY BE NECESSARY TO CHANGE THE I/0 UNIT NUMBERS ASSOCIATED WITH THE VARIABLES INPUT, OUTPUT, AND ERROR. INPUT GETS THE UNIT NUMBER OF THE INPUT DEVICE, OUTPUT GETS THE UNIT NUMBER OF THE OUTPUT DEVICE, AND ERROR GETS THE NUMBER OF THE ERROR MESSAGE REPORTING DEVICE. TYPICALLY INPUT AND OUTPUT REFER TO THE USER'S TERMINAL AND ERROR EITHER TO THE TERMINAL OR LINE PRINTER. INSTALLING MOVIE.BYU  Page 5-2 REMEMBER THAT VARIABLES NPL, X, IP, U, AND SPEC MUST BE DIMENSIONED TO ACCOMMODATE THE MAXIMUM EXPECTED NUMBER OF PARTS, COORDINATES, OR ELEMENTS WHICH EVER IS APPROPRIATE. THE VARIABLES NPMAX, NJMAX, AND NPTMAX MUST ALSO BE SET TO REFLECT THE MAXIMUM DIMENSIONS. SUBROUTINE OPEN: FUNCTION: REQUEST DATA FILE NAMES AND OPENS I/O CHANNEL SUBROUTINE OPEN MAY NEED TO BE COMPLETELY REWRITTEN TO ACCOMMODATE YOUR PARTICULAR OPERATING SYSTEM. THE ROUTINE IS ENTERED WITH FILEID CONTAINING THE ALPHANUMERIC FILE IDENTIFICATION (GEOM., DISP., OR FUNC.) IT REQUESTS THE FILE NAME, AND OPENS THE FILE FOR INPUT IF IOP=1 AND FOR OUTPUT IF IOP=-1. A BLANK FILE SPECIFICATION WILL SET IERROR TO 0. THE ROUTINE RETURNS WITH THE DEVICE UNIT NUMBER IN IUNIT AND IERROR SET TO 1 ON SUCCESSFUL COMPLETION, 0 ON BLANK FILE, AND -1 ON FAILURE. SUBROUTINE ROTAT: FUNCTION: CALCULATES ROTATION TRANSFORMATION MATRIX NO CHANGES NECESSARY. SUBROUTINE PICTUR: FUNCTION: INTERACTIVELY ACCEPTS COMMANDS FROM THE USER AND PERFORMS THE APPROPRIATE TASK. BEFORE DISCUSSING CHANGES, REMEMBER THAT VARIABLES DA, DD, DIF, ICOL, NFR, NPLS, RORG, SPEC1, XNORM, AND XX MUST BE DIMENSIONED TO ACCOMMODATE THE MAXIMUM EXPECTED NUMBER OF PARTS, COORDINATES, OR ELEMENTS WHICH EVER IS APPROPRIATE. IN PARTICULAR, XNORM SHOULD BE DIMENSIONED AS THE GREATER OF THE MAXIMUM NUMBER OF COORDINATES OR THE MAXIMUM NUMBER OF ELEMENTS. IF THE FORTRAN OPERATING SYSTEM YOU ARE RUNNING DOES NOT ALLOW FREE FORMATED READS, MOST OF THE FORMAT STATEMENTS ASSOCIATED WITH INTERACTIVE READ STATEMENTS WILL NEED TO BE MODIFIED. THIS IS THE ONE MOST PREVALENT CHANGE THROUGHOUT THE PROGRAM. AT THE STATEMENT LABELED 80, THE PROGRAM ENTERS A SECTION OF CODE THAT SELECTS SCOPE PARAMETERS INCLUDING THE PICTURE DEVICE NUMBER. PICTURE DEVICES GREATER THAN 0 ARE CONTINUOUS-TONE DEVICES WHILE DEVICES LESS THAN 0 ARE LINE DRAWING DEVICES. THE ALLOWABLE DEVICES ARE CURRENTLY COMTAL, TEKTRONIX, HPLT (HEWLETT-PACKARD PLOTTER), AND CPLT (CALCOMP PLOTTER). BY ADDING AND/OR DELETING DEVICES, THIS INSTALLING MOVIE.BYU Page 5-3 SECTION OF CODE SHOULD REFLECT THE PICTURE DEVICES AT YOUR INSTALLATION. AT APPROXIMATELY THE STATEMENTS LABELED 242, THE PROGRAM ENTERS CODE THAT WRITES TO THE USER'S OUTPUT DEVICE THE NAME OF THE DISPLAY DEVICE WHICH JUST RECEIVED A PICTURE. IF YOU CHANGED THE ALLOWABLE DEVICES, YOU NEED TO CHANGE THIS SECTION OF CODE TO REFLECT THE DEVICES AVAILABLE. CHANGES THAT MAY BE REQUIRED TO THIS SUBROUTINE WHEN USING A 5 BIT DATA PACKING SCHEME FOR LIGHT INTENSITY AND COLOR ON 16 BIT MACHINES IS GIVEN BELOW. THE EXISTING CODE FOR 32 AND 36 BIT MACHINES IS FOLLOWED BY THE CORRESPONDING CODE WITH CHANGES FOR 16 BIT MACHINES. 32 AND 36 BIT MACHINES IPH=63 IF(IDVICE.LT.0) GO TO 86 16 BIT MACHINES IPH=31 IF(IDVICE.LT.0) GO TO 86 32 AND 36 BIT MACHINES IC1=PB3*63.0 IC2=PB2*63.0 IC3=PB1*63.0 IF(IC.EQ.1) GO TO 163 16 BIT MACHINES IC1=PB3*31.0 IC2=PB2*31.0 IC3=PB1*31.0 IF(IC.EQ.1) GO TO 163 32 AND 36 BIT MACHINES  163 IPB=IC1*2**12+IC2*2**6+IC3 WRITE(OUTPUT,164) (WORDS(I,IC),I=1,3) 16 BIT MACHINES 163 IPB=IC1*2**10+IC2*2**5+IC3 WRITE(OUTPUT,164) (WORDS(I,IC),I=1,3) 32 AND 36 BIT MACHINES IC1=X3*63.0 IC2=X2*63.0 IC3=X1*63.0 INSTALLING MOVIE.BYU Page 5-4 IF(IC.EQ.1) GO TO 167 16 BIT MACHINES IC1=X3*31.0 IC2=X2*31.0 IC3=X1*31.0 IF(IC.EQ.1) GO TO 167 32 AND 36 BIT MACHINES 167 ICC=IC1*2**12+IC2*2**6+IC3 DO 168 K=I1,I2 16 BIT MACHINES 167 ICC=IC1*2**10+IC2*2**5+IC3 DO 168 K=I1,I2 SUBROUTINE MULTDD: FUNCTION: MULTIPLYS COORDINATES BY LOCAL ROTATIONS NO CHANGES NECESSARY. FUNCTION AINTEN: FUNCTION: CLACULATES LIGHT INTENSITY AT A NODE NO CHANGES NECESSARY. FUNCTION IVSBLE: FUNCTION: COMPUTES NUMBER OF VISIBLE NODES. NO CHANGES NECESSARY. SUBROUTINE MULTDC: FUNCTION: MULTIPLYS COORDINATES BY GLOBAL ROTATIONS. NO CHANGES NECESSARY. FUNCTION ISHADE: FUNCTION: COMPUTES COLOR INTENSITY AT NODE FOR FRINGES. INSTALLING MOVIE.BYU Page 5-5 CHANGES THAT MAY BE REQUIRED TO THIS SUBROUTINE WHEN USING A 5 BIT DATA PACKING SCHEME FOR LIGHT INTENSITY AND COLOR ON 16 BIT MACHINES IS GIVEN BELOW. THE EXISTING CODE FOR 32 AND 36 BIT MACHINES IS FOLLOWED BY THE CORRESPONDING CODE WITH CHANGES FOR 16 BIT MACHINES. 32 AND 36 BIT MACHINES IC1=(F(1,I1)*X+F(1,I)*X1)*63.0 IC2=(F(2,I1)*X+F(2,I)*X1)*63.0 IC3=(F(3,I1)*X+F(3,I)*X1)*63.0 GO TO 4 2 X=X-1.0 IC1=F(1,NFRING)*63.0 IC2=F(2,NFRING)*63.0 IC3=F(3,NFRING)*63.0 GO TO 4 3 IC1=F(1,1)*63.0 IC2=F(2,1)*63.0 IC3=F(3,1)*63.0 4 ISHADE=IC1*2**12+IC2*2**6+IC3 RETURN 16 BIT MACHINES IC1=(F(1,I1)*X+F(1,I)*X1)*31.0 IC2=(F(2,I1)*X+F(2,I)*X1)*31.0  IC3=(F(3,I1)*X+F(3,I)*X1)*31.0 GO TO 4 2 X=X-1.0 IC1=F(1,NFRING)*31.0 IC2=F(2,NFRING)*31.0 IC3=F(3,NFRING)*31.0 GO TO 4 3 IC1=F(1,1)*31.0 IC2=F(2,1)*31.0 IC3=F(3,1)*31.0 4 ISHADE=IC1*2**10+IC2*2**5+IC3 RETURN SUBROUTINE DRAW: FUNCTION: CLIPS LINE SEGMENTS AND DOES QUICK PLOT.  NO CHANGES NECESSARY. SUBROUTINE INTHID: FUNCTION: INTIALIZES HIDDEN PROCESSOR. THE VARIABLES MAXFRE, MAXRES, AND MAXINT SHOULD BE CHANGED TO REFLECT THE DIMENSION OF IFREE(MAXFRE), THE DIMENSION OF IB(MAXRES), AND THE MAXIMUM ALLOWABLE LIGHT INSTALLING MOVIE.BYU Page 5-6 INTENSITY. CHANGES THAT MAY BE REQUIRED TO THIS SUBROUTINE WHEN  USING A 5 BIT DATA PACKING SCHEME FOR LIGHT INTENSITY AND COLOR ON 16 BIT MACHINES IS GIVEN BELOW. THE EXISTING CODE FOR 32 AND 36 BIT MACHINES IS FOLLOWED BY THE CORRESPONDING CODE WITH CHANGES FOR 16 BIT MACHINES. 32 AND 36 BIT MACHINES MAXINT=63 C INITIALIZE FREE STORAGE 16 BIT MACHINES MAXINT=31 C INITIALIZE FREE STORAGE FILE 3: HIDDEN.FOR HIDDEN.FOR IS THE FORTRAN SOURCE FILE FOR THE HIDDEN PROCESS. THE VARIOUS SUBROUTINES IN THIS FILE ARE AGAIN WRITTEN IN ANSI FORTRAN ALTHOUGH CERTAIN CHANGES WILL HAVE TO BE MADE TO ACCOMODATE THE WORD SIZE OF YOUR MACHINE. SUBROUTINE GETVAR: FUNCTION: GETS VARIABLE LENGTH BLOCK OF FREE STORAGE. NO CHANGES NECESSARY. SUBROUTINE LSTSET: FUNCTION: SET BLOCK SIZE AND LINKS SEGMENTS.  NO CHANGES NECESSARY. SUBROUTINE GETBLK: FUNCTION: GETS FIXED LENGTH BLOCK OF FREE STORAGE. NO CHANGES NECESSARY. SUBROUTINE RETBLK: FUNCTION: RETURNS FIXED LENGTH BLOCK TO FREE STORAGE. INSTALLING MOVIE.BYU Page 5-7 NO CHANGES NECESSARY. SUBROUTINE INTCLP: FUNCTION: INITIALIZES PARAMETERS USED IN HIDDEN ALGORITHM. NO CHANGES NECESSARY. SUBROUTINE POLMAK: FUNCTION: BEGINS NEW POLYGON IN PICTURE. CHANGES THAT MAY BE REQUIRED TO THIS SUBROUTINE WHEN USING A 5 BIT DATA PACKING SCHEME FOR LIGHT INTENSITY AND COLOR ON 16 BIT MACHINES IS GIVEN BELOW. THE EXISTING CODE FOR 32 AND 36 BIT MACHINES IS FOLLOWED BY THE CORRESPONDING CODE WITH CHANGES FOR 16 BIT MACHINES. 32 AND 36 BIT MACHINES COMMON/COMNIO/ICNT,IDUM(121) IPOLY=IPOLY+1 16 BIT MACHINES COMMON/COMNIO/ICNT,IDUM(141) IPOLY=IPOLY+1 SUBROUTINE EDGMAK: FUNCTION: STORES POLYGON EDGES FOR LATTER PROCESSING. CHANGES THAT MAY BE REQUIRED TO THIS SUBROUTINE WHEN USING A 5 BIT DATA PACKING SCHEME FOR LIGHT INTENSITY AND COLOR ON 16 BIT MACHINES IS GIVEN BELOW. THE EXISTING CODE FOR 32 AND 36 BIT MACHINES IS FOLLOWED BY THE CORRESPONDING CODE WITH CHANGES FOR 16 BIT MACHINES. 32 AND 36 BIT MACHINES COMMON/COMNIO/ICNT,NT,VX(10),VY(10),VZ(10),VN(10) 1,IC(10),VC(10),VTX(10),VTY(10),VTZ(10),VTN(10),VTC(10) 2,ITC(10) LOGICAL LASEDG,IBAD,ISHARE 16 BIT MACHINES COMMON/COMNIO/ICNT,NT,VX(10),VY(10),VZ(10),VN(10) 1,IC(10),IS(10),VC(10),VTX(10),VTY(10),VTZ(10),VTN(10) 2,VTC(10),ITC(10),ITS(10)  LOGICAL LASEDG,IBAD,ISHARE INSTALLING MOVIE.BYU Page 5-8 32 AND 36 BIT MACHINES C SET 18TH BIT IF EDGE IS SHARED C SET 19TH BIT IF EDGE IS VISIBLE FLAG I=524288 IF(ISHARE) I=786432 C PUT BEGIN POINT INTO EDGE STACK 16 BIT MACHINES C SET 0TH BIT IF EDGE IS SHARED C SET 1ST BIT IF EDGE IS VISIBLE FLAG I=1 IF(ISHARE) I=3 C PUT BEGIN POINT INTO EDGE STACK 32 AND 36 BIT MACHINES IC(ICNT)=I+MOD(K1,262144) VC(ICNT)=C1 16 BIT MACHINES IC(ICNT)=K1 IS(ICNT)=I VC(ICNT)=C1 32 AND 36 BIT MACHINES IC(ICNT)=I+MOD(K2,262144) VC(ICNT)=C2 16 BIT MACHINES IC(ICNT)=K2 IS(ICNT)=I VC(ICNT)=C2 SUBROUTINE POLSNP: FUNCTION: CLIPS POLYGONS AGAINST VIEWING WINDOW. CHANGES THAT MAY BE REQUIRED TO THIS SUBROUTINE WHEN USING A 5 BIT DATA PACKING SCHEME FOR LIGHT INTENSITY AND COLOR ON 16 BIT MACHINES IS GIVEN BELOW. THE EXISTING CODE FOR 32 AND 36 BIT MACHINES IS FOLLOWED BY THE CORRESPONDING CODE WITH CHANGES FOR 16 BIT MACHINES. 32 AND 36 BIT MACHINES COMMON/COMNIO/ICNT,NT,VX(10),VY(10),VZ(10),VN(10)  1,IC(10),VC(10),VTX(10),VTY(10),VTZ(10),VTN(10),VTC(10) 2,ITC(10) COMMON/EDGARG/IY,IX1,IX2,IZ1,IZ2,IS1,IS2,IPG,IDY INSTALLING MOVIE.BYU Page 5-9 1,KOL1,ISHR,IS1,IS2,KOL2 16 BIT MACHINES COMMON/COMNIO/ICNT,NT,VX(10),VY(10),VZ(10),VN(10) 1,IC(10),IS(10),VC(10),VTX(10),VTY(10),VTZ(10),VTN(10) 2,VTC(10),ITC(10),ITS(10) COMMON/EDGARG/IY,IX1,IX2,IZ1,IZ2,IS1,IS2,IPG,IDY 1,KOL1,ISHR,IS1,IS2,KOL2 32 AND 36 BIT MACHINES IF(IC(I).LT.524288) GO TO 10 K=I+1 16 BIT MACHINES IF(IS(I).LT.1) GO TO 10 K=I+1 32 AND 36 BIT MACHINES ISHR=MOD(IC(I),524288).GT.262144 C GET THE Z VALUES AND GIVE THEM 15 BITS 16 BIT MACHINES ISHR=IS(I).GT.1 C GET THE Z VALUES AND GIVE THEM 15 BITS 32 AND 36 BIT MACHINES C GET THE INTENSITY AND GIVE IT 6 BITS IS2=VN(L)*63. IS1=VN(K)*63. C************ COLOR ************ KOL1=MOD(IC(K),262144) KOL2=MOD(IC(L),262144) C RESET THE INTENSITY IF IT IS OUTSIDE THE RANGE IF(IS1.GT.63) IS1=63 IF(IS2.GT.63) IS2=63 IF(IS1.LT.0) IS1=0 16 BIT MACHINES  C GET THE INTENSITY AND GIVE IT 5 BITS IS2=VN(L)*31. IS1=VN(K)*31. C************ COLOR ************ KOL1=IC(K) KOL2=IC(L) C RESET THE INTENSITY IF IT IS OUTSIDE THE RANGE IF(IS1.GT.31) IS1=31 IF(IS2.GT.31) IS2=31 IF(IS1.LT.0) IS1=0 INSTALLING MOVIE.BYU Page 5-10 SUBROUTINE CLIP:  FUNCTION: DOES ACTUAL CLIPPING OF EDGES AGAINST PLANE. CHANGES THAT MAY BE REQUIRED TO THIS SUBROUTINE WHEN USING A 5 BIT DATA PACKING SCHEME FOR LIGHT INTENSITY AND COLOR ON 16 BIT MACHINES IS GIVEN BELOW. THE EXISTING CODE FOR 32 AND 36 BIT MACHINES IS FOLLOWED BY THE CORRESPONDING CODE WITH CHANGES FOR 16 BIT MACHINES. 32 AND 36 BIT MACHINES COMMON/COMNIO/ICNT,NT,VX(10),VY(10),VZ(10),VN(10)  1,IC(10),VC(10),VTX(10),VTY(10),VTZ(10),VTN(10),VTC(10) 2,ITC(10) COMMON/SNPDAT/T1,T2,I 16 BIT MACHINES COMMON/COMNIO/ICNT,NT,VX(10),VY(10),VZ(10),VN(10) 1,IC(10),IS(10),VC(10),VTX(10),VTY(10),VTZ(10),VTN(10) 2,VTC(10),ITC(10),ITS(10) COMMON/SNPDAT/T1,T2,I 32 AND 36 BIT MACHINES IF(IC(I).LT.524288) GO TO 30 IF(IBAD) GO TO 30 16 BIT MACHINES IF(IS(I).LT.1) GO TO 30 IF(IBAD) GO TO 30 32 AND 36 BIT MACHINES IC(I1)=IC(I) GO TO 101 100 C1=FLOAT(MOD(IC(I)/4096,64)) C2=FLOAT(MOD(IC(I+1)/4096,64)) KOLAVG=MOD(INT(ALPHA*(C2-C1)+C1+.5),64)*4096 C2=FLOAT(MOD(IC(I+1)/64,64)) KOLAVG=KOLAVG+MOD(INT(ALPHA*(C2-C1)+C1+.5),64)*64 C1=FLOAT(MOD(IC(I),64)) C2=FLOAT(MOD(IC(I+1),64)) KOLAVG=KOLAVG+MOD(INT(ALPHA*(C2-C1)+C1+.5),64) IC(I1)=KOLAVG+(IC(I)/524288)*524288 101 CONTINUE 16 BIT MACHINES IC(I1)=IC(I) GO TO 101 100 C1=FLOAT(MOD(IC(I)/1024,32)) INSTALLING MOVIE.BYU Page 5-11 C2=FLOAT(MOD(IC(I+1)/1024,32)) KOLAVG=MOD(INT(ALPHA*(C2-C1)+C1+.5),32)*32 C1=FLOAT(MOD(IC(I)/32,32)) C2=FLOAT(MOD(IC(I+1)/32,32)) KOLAVG=KOLAVG+MOD(INT(ALPHA*(C2-C1)+C1+.5),32)*32 C1=FLOAT(MOD(IC(I),32)) C2=FLOAT(MOD(IC(I+1),32)) KOLAVG=KOLAVG+MOD(INT(ALPHA*(C2-C1)+C1+.5),32) IC(I1)=KOLAVG 101 CONTINUE 32 AND 36 BIT MACHINES IC(ICNT)=MOD(IC(I1),262144)+524288 VC(ICNT)=VC(I1) 16 BIT MACHINES IC(ICNT)=IC(I1) IS(ICNT)=1 VC(ICNT)=VC(I1) 32 AND 36 BIT MACHINES 50 IC(I)=0 IC(I+1)=0 RETURN 16 BIT MACHINES 50 IS(I)=0 IS(I+1)=0 RETURN SUBROUTINE FACMAK: FUNCTION: STORES ZMIN CLIPPED EDGES FOR LATTER CAP POLYGON GENERATION. NOT IMPLEMENTED YET. SUBROUTINE HIDDEN: FUNCTION: DETERMINES VISIBLE SEGEMENTS AND SENDS THEM TO LINE DRAWING OR CONTINOUS-TONE SHADING ROUTINES. CHANGES THAT MAY BE REQUIRED TO THIS SUBROUTINE WHEN USING A 5 BIT DATA PACKING SCHEME FOR LIGHT INTENSITY AND COLOR ON 16 BIT MACHINES IS GIVEN BELOW. THE EXISTING CODE FOR 32 AND 36 BIT MACHINES IS FOLLOWED BY THE CORRESPONDING CODE WITH CHANGES FOR 16 BIT MACHINES. 32 AND 36 BIT MACHINES INSTALLING MOVIE.BYU  Page 5-12 SR1=FLOAT(MOD(ICOL1,64))*S1/63. SB1=FLOAT(MOD(ICOL1/64,64))*S1/63. SG1=FLOAT(MOD(ICOL1/4096,64))*S1/63. SR2=FLOAT(MOD(ICOL2,64))*S2/63. SB2=FLOAT(MOD(ICOL2/64,64))*S2/63. SG2=FLOAT(MOD(ICOL2/4096,64))*S2/63. 213 CONTINUE 16 BIT MACHINES 2)11 SR1=FLOAT(MOD(ICOL1,32))*S1/31. SB1=FLOAT(MOD(ICOL1/32,32))*S1/31. SG1=FLOAT(MOD(ICOL1/1024,32))*S1/31. SR2=FLOAT(MOD(ICOL2,32))*S2/31. SB2=FLOAT(MOD(ICOL2/32,32))*S2/31. SG2=FLOAT(MOD(ICOL2/1024,32))*S2/31. 213 CONTINUE 32 AND 36 BIT MACHINES A = FLOAT(ISEG(I+5))*63. RSEG(IJ+1) = (SR1-SR2)/A 16 BIT MACHINES 2)11 A = FLOAT(ISEG(I+5))*31. RSEG(IJ+1) = (SR1-SR2)/A 32 AND 36 BIT MACHINES  RSEG(IJ ) = (SR1/63.)+RSEG(IJ+1)*.5 RSEG(IJ+4) = (SB1/63.)+RSEG(IJ+5)*.5 RSEG(IJ+8) = (SG1/63.)+RSEG(IJ+9)*.5 IJ = IJ + 8 16 BIT MACHINES 2)11 RSEG(IJ ) = (SR1/31.)+RSEG(IJ+1)*.5 RSEG(IJ+4) = (SB1/31.)+RSEG(IJ+5)*.5 RSEG(IJ+8) = (SG1/31.)+RSEG(IJ+9)*.5 IJ = IJ + 8 SUBROUTINE DRAWIT: FUNCTION: SEND LINE TO BE DISPLAYED TO DEVICE AND CLEARS LINE STARTING POSITION. NO CHANGES NECESSARY. SUBROUTINE LINSHO: FUNCTION: UPDATES LINE INFORMATION UNTIL LINE CAN BE DRAWN. INSTALLING MOVIE.BYU Page 5-13 NO CHANGES NECESSARY. SUBROUTINE SHOW: FUNCTION: EVALUATES SHADING INFORMATION FOR VISIBLE SEGMENTS. CHANGES THAT MAY BE REQUIRED TO THIS SUBROUTINE WHEN USING A 5  BIT DATA PACKING SCHEME FOR LIGHT INTENSITY AND COLOR ON 16 BIT MACHINES IS GIVEN BELOW. THE EXISTING CODE FOR 32 AND 36 BIT MACHINES IS FOLLOWED BY THE CORRESPONDING CODE WITH CHANGES FOR 16 BIT MACHINES. 32 AND 36 BIT MACHINES STR=FLOAT(MOD(IBACKG,64)) STB=FLOAT(MOD(IBACKG/64,64)) STG=FLOAT(MOD(IBACKG/4096,64)) ENDR = STR 16 BIT MACHINES 2)14 STR=FLOAT(MOD(IBACKG,32)) STB=FLOAT(MOD(IBACKG/32,32)) STG=FLOAT(MOD(IBACKG/1024,32)) ENDR = STR SUBROUTINE PACKER: FUNCTION: PACKS DATA INTO STORAGE BLOCK FOR LATTER USE BY HIDDEN. SUBROUTINE PACKER MAY REQUIRE MANY CHANGES DEPENDING UPON THE WORD SIZE OF YOUR MACHINE AND YOUR DESIRE FOR SPEED OF OPERATION. THE ROUTINE YOU RECEIVED ON TAPE IS WRITTEN FOR A 36 BIT MACHINE IN ANSI FORTRAN. THEREFORE, IF YOU ARE RUNNING ON A MACHINE WITH LESS THAN A 36 BIT WORD, YOU WILL NEED TO MAKE MODIFICATIONS. ALSO, IF YOUR MACHINE SUPPORTS BIT MANIPULATION IN FORTRAN, YOU MAY WANT TO USE IT TO SPEED COMPUTATION. FIRST, THE PACKING SCHEME FOR THE 36 BIT WORD WILL BE PRESENTED, AND THEN, SUGGESTED PACKING SCHEMES FOR BOTH 16 AND 32 BIT WORDS WILL FOLLOW. 36 BIT WORD  TO STORE THE INFORMATION PASSED TO SUBROUTINE PACKER, FIVE 36 BIT WORDS ARE NEEDED. THE INFORMATION THAT EACH RECEIVES (ALONG WITH THE NUMBER OF BITS IT OCCUPIES DELIMITED BY SLASHES) IS OUTLINED BELOW. INSTALLING MOVIE.BYU Page 5-14 IFREE(IPT) = IC1/5/,IX1/10/,IX2/10/,IDY/10/ IFREE(IPT+1) = IC2/5/,IZ1/15/,IZ2/15/ IFREE(IPT+2) = IS1/6/,IS2/6/,NXTEDG/18/  IFREE(IPT+3) = ICOL1/18/,IP/13/ IFREE(IPT+4) = ICOL2/18/,IPS/13/ THE DATA IS STORED RIGHT JUSTIFIED WITHIN EACH WORD. THE VARIABLES ARE DEFINED AS FOLLOWS: IFREE = FREE STORAGE IPT = FREE STORAGE POINTER IC1 = BEGIN CONTOUR VALUE IX1 = BEGIN X COORDINATE IX2 = END X COORDINATE IDY = DELTA Y IC2 = END CONTOUR VALUE  IZ1 = BEGIN Z COORDINATE IZ2 = END Z COORDINATE IS1 = BEGIN INTENSITY IS2 = END INTENSITY NXTEDG = NEXT EDGE POINTER (IBUCKY(IY)) ICOL1 = BEGIN COLOR IP = POLYGON NUMBER ICOL2 = END COLOR IPS = IP OF SHARED POLYGON 16 BIT WORD CONVERSION OF THE HIDDEN PROCESSOR TO 16 BIT MACHINES WILL PROVE TO BE THE MOST INVOLVED. AS PREVIOUSLY NOTED, THERE ARE SEVERAL SUBROUTINES THAT WILL REQUIRE CHANGES. APPENDIX A CONTIANS SUGGESTED CODING OF SUBROUTINE PACKER USING THE SCHEME BELOW. SUBROUTINE PACKER REQUIRES ELEVEN 16 BIT WORDS TO STORE THE DATA SENT TO IT. IFREE(IPT) = IC1/5/,IX1/10/ IFREE(IPT+1) = IC2/5/,IX2/10/ IFREE(IPT+2) = IDY/10/ IFREE(IPT+3) = IZ1/15/  IFREE(IPT+4) = IZ2/15/ IFREE(IPT+5) = IS1/5/,IS2/5/ IFREE(IPT+6) = NXTEDG/15/ IFREE(IPT+7) = ICOL1/15/ IFREE(IPT+8) = ICOL2/15/ IFREE(IPT+9) = IP/13/ IFREE(IPT+10) = IPS/13/ INSTALLING MOVIE.BYU Page 5-15 NOTICE THAT THE NUMBER OF BITS USED FOR BOTH INTENSITY INFORMATION AND COLOR HAVE BEEN REDUCED. THIS IS THE REASON CHANGES MUST BE MADE TO THE SUBROUTINES MENTIONED ABOVE. EVERYWHERE INTENSITY AND COLOR RECEIVED MULTIPLES OF 6 BITS, THEY NOW WILL GET MULTIPLES OF 5 BITS. ALSO, NXTEDG NOW GETS 15 BITS INSTEAD OF 18. BY SUBTRACTING 2**15-1 OR 32767 FROM THE POINTER, A LARGER SEGMENT OF FREE STORAGE MAY BE MAPPED. 32 BIT WORD CONVERSION TO 32 BIT WORDS SHOULD BE OF RELATIVELY LITTLE TROUBLE. FIVE 32 BIT WORDS WILL BE REQUIRED TO STORE THE INFORMATION SENT TO SUBROUTINE PACKER IF CONTOURS ARE NOT REQUESTED. SIX 36 BIT WORDS WILL BE REQUIRED TO SUPPORT CONTOURING. A SIMPLE IF STATEMENT IS USED IN THE SUGGESTED SUBROUTINE TO CHOSE BETWEEN THE TWO. AS WITH THE 16 BIT SCHEME, A SUGGESTED ANSI FORTRAN SUBROUTINE TO IMPLEMENT THE PACKING SCHEME BELOW IS FOUND IN APPENDIX B. IFREE(IPT) = IX1/10/,IX2/10/,IDY/10/ IFREE(IPT+1) = IZ1/15/,IZ2/15/ IFREE(IPT+2) = IS1/6/,IS2/6/,NXTEDG/18/ IFREE(IPT+3) = ICOL1/18/,IP/13/ IFREE(IPT+4) = ICOL2/18/,IPS/13/ IFREE(IPT+6) = IC1/5/,IC2/5/ THE ONLY CHANGE NECESSARY IS THE PACKING OF THE CONTOUR INFORMATION IN THE SIXTH WORD INSTEAD OF THE FIRST AND SECOND AND CHANGING THE NUMBER OF WORDS ACCORDINGLY. SUBROUTINE UNPACK: FUNCTION: PERFORMS THE OPPOSITE FUNCTION OF PACKER. SINCE SUBROUTINE UNPACK REFORMS THE OPPOSITE FUNCTION OF PACKER, ANY CHANGES YOU MADE TO SUBROUTINE PACKER MUST ALSO BE REFLECTED IN CHANGES MADE TO SUBROUTINE UNPACK. APPENDICES A AND B CONTAIN SUGGESTED ANSI FORTRAN SUBROUTINES THAT PERFORM THIS FUNCTION FOR BOTH 16 AND 32 BIT MACHINES. SUBROUTINE ERRMSG: FUNCTION: WRITES ERROR MESSAGES TO ERROR OUTPUT DEVICE. NO CHANGES NECESSARY. INSTALLING MOVIE.BYU Page 5-16 SUBROUTINE CONSHO: FUNCTION: EVALUATES CONTOUR INFORMATION FOR VISIBLE SEGMENT. NO CHANGES NECESSARY. FILE 4: DEVICE.FOR DEVICE.FOR CONTAINS THE PICTURE DEVICE DEPENDENT CODE FOR DISPLAYING THE PICTURE. THESE ROUTINES WILL  GENERALLY NEED TO BE MODIFIED TO ACCOMMODATE YOUR DISPLAY DEVICES. SUBROUTINE BGNFRM: FUNCTION: INITIALIZES AN OUTPUT DEVICE TO RECEIVE A PICTURE. REMEMBER THAT THE DEVICE NUMBERS OF CONTINUOUS-TONE DEVICES ARE GREATER THAN 0 AND FOR LINE DRAWING DEVICES, THEY ARE LESS THAN ZERO. THE GENERAL EFFECT OF THIS ROUTINE ON ALL DEVICES IS AREA FOR LINE DRAWING DEVICES.  SUBROUTINE ENDFRM: FUNCTION: TERMINATES OUTPUT TO A DISPLAY DEVICE. SUBROUTINE ENDFRM DUMPS THE REMAINDER OF THE OUTPUT BUFFER AND RETURNS CONTROL TO THE USER TERMINAL. SUBROUTINE PLTLIN: FUNCTION: DRAWS A LINE FROM (A,B) TO (C,D) ON THE DISPLAY DEVICE. SUBROUTINE PLTLIN CONVERTS THE A, B, C, AND D COORDINATES FROM THERE RANGE OF 0 T0 IFX (THE X RESOLUTION) TO THE RANGE OF THE CHOSEN DISPLAY DEVICE. THE APPROPRIATE CALLS ARE THEN MADE TO THE PARTICULAR DEVICE TO DISPLAY THE LINE. SUBROUTINE LABEL: INSTALLING MOVIE.BYU Page 5-17 FUNCTION: PLOTS A LABEL ON THE DISPLAY DEVICE. SUBROUTINE LABEL PRINTS ALPHANUMIC INFORMATION ON THE DISPLAY DEVICE. THE LABEL, CHR, BEGINS AT (X,Y) AND IS NCNT CHARACTERS IN LENGTH. THIS ROUTINE IS USED TO PLACE  LABELS ON CONTOUR LINES. SUBROUTINE SRL: FUNCTION: CALCULATES SHADED LINE INFORMATION AND PASSES IT TO CONTINOUS-TONE DEVICE. SUBROUTINE SRL RECEIVES THE BEGINNING AND ENDING INTENSITIES AND COLORS OF LINE SEGMENTS. IT CALCULATES THE INTENSITY AND COLOR OF INTERMEDIATE POINTS. WHEN AN ENTIRE LINE HAS BEEN PROCESSED, IT IS SENT TO THE DEVICE. THERE ARE PRESENTLY NO CALLS TO DISPLAY THE PICTURE INCLUDED WITH SRL. THESE MUST BE SUPPLIED BY THE HOST SYSTEM. FILE 5: UTILITY.FOR UTILITY.FOR CONTAINS THE FORTRAN SOURCE FILE OF THE UTILITY ROUTINE. IT IS MOSTLY WRITTEN IN MACHINE INDEPENDENT FORTRAN. IF THE FORTRAN OPERATING SYSTEM YOU ARE RUNNING DOES NOT ALLOW FREE FORMATED READS, MOST OF THE FORMAT STATEMENTS ASSOCIATED WITH INTERACTIVE READ STATEMENTS WILL NEED TO BE MODIFIED. THIS SHOULD BE THE ONLY CHANGE THROUGHOUT THE PROGRAM. MAIN PROGRAM: FUNCTION: INTERACTIVELY CALLS SUBROUTINES TO PERFORM REQUESTED ACTIONS. IT MAY BE NECESSARY TO CHANGE THE I/0 UNIT NUMBERS ASSOCIATED WITH THE VARIABLES INPUT AND OUTPUT. INPUT GETS THE UNIT NUMBER OF THE INPUT DEVICE, AND OUTPUT GETS THE UNIT NUMBER OF THE OUTPUT DEVICE. TYPICALLY INPUT AND  OUTPUT REFER TO THE USER'S TERMINAL. REMEMBER THAT VARIABLES NPL, X, IP, JP, S, SX, AND U MUST BE DIMENSIONED TO ACCOMMODATE THE MAXIMUM EXPECTED NUMBER OF PARTS, COORDINATES, OR ELEMENTS WHICH EVER IS APPROPRIATE. THE VARIABLES NPMAX, NJMAX, AND NPTMAX MUST ALSO BE SET TO REFLECT THE MAXIMUM DIMENSIONS. FUNCTION CMD: INSTALLING MOVIE.BYU Page 5-18 FUNCTION: ISSUES COMMAND PROMPT FOR VARIOUS LEVELS AND ACCEPTS COMMAND. POSSIBLE I/O MODIFICATIONS (SEE INTRODUCTION ABOVE). SUBROUTINE HELP: FUNCTION: PRINTS HELP MESSAGE ON TERMINAL. POSSIBLE I/O MODIFICATIONS (SEE INTRODUCTION ABOVE). SUBROUTINE OVER: FUNCTION: PRINTS ERROR MESSAGE WHEN MAXIMUM DIMENSIONS EXCEEDED. POSSIBLE I/O MODIFICATIONS (SEE INTRODUCTION ABOVE). SUBROUTINE GEOM: FUNCTION: PERFORMS UTILTIY OPERATIONS READ, WRITE, PRINT, AND CHANGE ON GEOMETRY FILES. POSSIBLE I/O MODIFICATIONS (SEE INTRODUCTION ABOVE). SUBROUTINE DISP: FUNCTION: PERFORMS UTILITY OPERATIONS READ, WRITE, PRINT, AND CHANGE ON DISPLACEMENT FILES. POSSIBLE I/O MODIFICATIONS (SEE INTRODUCTION ABOVE). SUBROUTINE SFUN: FUNCTION: PERFORMS UTILITY OPERATIONS READ, WRITE, PRINT,  AND CHANGE ON SCALAR FUNCTION FILES. POSSIBLE I/O MODIFICATIONS (SEE INTRODUCTION ABOVE). SUBROUTINE SYMM: FUNCTION: PERFORMS SYMMETRY OPERATIONS ON FILES. POSSIBLE I/O MODIFICATIONS (SEE INTRODUCTION ABOVE). SUBROUTINE MOVE: FUNCTION: MOVES BLOCKS OF ELEMENTS. INSTALLING MOVIE.BYU Page 5-19 NO CHANGES NECESSARY. SUBROUTINE ORDER:  FUNCTION: PERFORMS ORDERING OF POLYGONAL VERTICES FOR PANEL SYSTEMS. POSSIBLE I/O MODIFICATIONS (SEE INTRODUCTION ABOVE). SUBROUTINE OPEN: FUNCTION: REQUEST DATA FILE NAMES AND OPENS I/O CHANNEL SUBROUTINE OPEN MAY NEED TO BE COMPLETELY REWRITTEN TO ACCOMMODATE YOUR PARTICULAR OPERATING SYSTEM. THE ROUTINE IS ENTERED WITH FILEID CONTAINING THE ALPHANUMERIC FILE IDENTIFICATION (GEOM., DISP., OR FUNC.) IT REQUESTS THE FILE NAME, AND OPENS THE FILE FOR INPUT IF IOP=1 AND FOR OUTPUT IF IOP=-1. A BLANK FILE SPECIFICATION WILL SET IERROR TO 0. THE ROUTINE RETURNS WITH THE DEVICE UNIT NUMBER IN IUNIT AND IERROR SET TO 1 ON SUCCESSFUL COMPLETION, 0 ON BLANK FILE, AND -1 ON FAILURE. SUBROUTINE RDGEOM: FUNCTION: READ GEOMETRY FILE FROM INPUT DEVICE. POSSIBLE I/O MODIFICATIONS (SEE INTRODUCTION ABOVE). SUBROUTINE WRGEOM: FUNCTION: WRITES GEOMETRY FILE TO OUTPUT DEVICE. POSSIBLE I/O MODIFICATINS (SEE INTRODUCTION ABOVE). SUBROUTINE RDSFUN: FUNCTION: READ SCALAR FUNCTION FILE FROM INPUT DEVICE. POSSIBLE I/O MODIFICATIONS (SEE INTRODUCTION ABOVE). SUBROUTINE WRSFUN: FUNCTION: WRITES SCALAR FUNCTION FILE TO OUTPUT DEVICE. NO CHANGES NECESSARY. SUBROUTINE RDDISP: INSTALLING MOVIE.BYU Page 5-20 FUNCTION: READS DISPLACEMENT FILE FROM INPUT DEVICE. NO CHANGES NECESSARY. SUBROUTINE WRDISP: FUNCTION: WRITES DISPLACEMENT FILE TO INPUT DEVICE. NO CHANGES NECESSARY. FILE 6: SECTION.FOR SECTION.FOR CONTAINS THE FORTRAN SOURCE FILE OF THE CLIPPING AND CAPPING ALGORITHM FOR 8 NODE BRICKS AS WELL AS THE CODE TO DELETE INTERIOR POLYGONS. IT IS MOSTLY WRITTEN IN MACHINE INDEPENDENT FORTRAN. IF THE FORTRAN OPERATING SYSTEM YOU ARE RUNNING DOES NOT ALLOW FREE FORMATED READS, MOST OF THE FORMAT STATEMENTS ASSOCIATED WITH INTERACTIVE READ STATEMENTS WILL NEED TO BE MODIFIED. THIS SHOULD BE THE MAJOR CHANGE THROUGHOUT THE PROGRAM. MAIN PROGRAM: FUNCTION: CONTROLS STORAGE ALLOCATION AND FLOW OF PROGRAM. IT MAY BE NECESSARY TO CHANGE THE I/0 UNIT NUMBERS ASSOCIATED WITH THE VARIABLES INPUT AND OUTPUT. INPUT GETS THE UNIT NUMBER OF THE INPUT DEVICE, AND OUTPUT GETS THE UNIT NUMBER OF THE OUTPUT DEVICE. THE DIMENSION OF VARIABLE A FOUND IN BLANK COMMON SHOULD BE ADJUSTED TO ACCOMMODATE THE PROBLEM TO BE RUN. THE DIMENSION OF IA SHOULD BE THE SAME AS A. THE VALUE ASSIGNED TO MTOT SHOULD ALSO BE THE SAME AS THE DIMENSION OF A. POSSIBLE I/O MODIFICATIONS (SEE INTRODUCTION ABOVE). BLOCK COMMON: FUNCTION: INITIALIZES THE POLYGON MAP OF THE HEXAHEDRON ELEMENT. NO CHANGES NECESSARY. SUBROUTINE OPEN: INSTALLING MOVIE.BYU Page 5-21 FUNCTION: REQUEST DATA FILE NAMES AND OPENS I/O CHANNEL SUBROUTINE OPEN MAY NEED TO BE COMPLETELY REWRITTEN TO ACCOMMODATE YOUR PARTICULAR OPERATING SYSTEM. THE ROUTINE IS ENTERED WITH FILEID CONTAINING THE ALPHANUMERIC FILE IDENTIFICATION (GEOM., DISP., OR FUNC.) IT REQUESTS THE FILE NAME, AND OPENS THE FILE FOR INPUT IF IOP=1 AND FOR OUTPUT IF IOP=-1. A BLANK FILE SPECIFICATION WILL SET IERROR TO 0. THE ROUTINE RETURNS WITH THE DEVICE UNIT NUMBER IN IUNIT AND IERROR SET TO 1 ON SUCCESSFUL COMPLETION, 0 ON BLANK FILE, AND -1 ON FAILURE. SUBROUTINE RDCNTL: FUNCTION: READS CONTROL INFORMATION FROM INPUT DEVICE NECESSARY TO ALLOCATE STORAGE. NO CHANGES NECESSARY. SUBROUTINE RDGEOM: FUNCTION: READS REMAINDER OF GEOMETRY FILE FROM INPUT DEVICE. NO CHANGES NECESSARY. SUBROUTINE WRGEOM: FUNCTION: WRITES GEOMETRY FILE TO OUTPUT DEVICE.  NO CHANGES NECESSARY. SUBROUTINE RDSFUN: FUNCTION: READS SCALAR FUNCTION FILE FROM INPUT DEVICE. POSSIBLE I/O MODIFICATIONS (SEE INTRODUCTION ABOVE). SUBROUTINE WRSFUN: FUNCTION: WRITES SCALAR FUNCTION FILE TO OUTPUT DEVICE. NO CHANGES NECESSARY. SUBROUTINE RDDISP: FUNCTION: READS DISPLACEMENT FILE FROM INPUT DEVICE. INSTALLING MOVIE.BYU Page 5-22  NO CHANGES NECESSARY. SUBROUTINE WRDISP: FUNCTION: WRITES DISPLACEMENT FILE TO OUTPUT DEVICE. NO CHANGES NECESSARY. SUBROUTINE PLFILE: FUNCTION: REQUESTS CLIPPING PLANE INFORMATION. POSSIBLE I/O MODIFICATIONS (SEE INTRODUCTION ABOVE). SUBROUTINE DIST: FUNCTION: CALCULATES DISTANCE TO FROM PLANE TO A POINT. NO CHANGES NECESSARY. SUBROUTINE SOLID:  FUNCTION: DISSEMBLES HEXAHEDRON INTO POLYGONS AND SENDS THEM TO CLIPPER. POSSIBLE I/O MODIFICATIONS (SEE INTRODUCTION ABOVE). SUBROUTINE SPLIT: FUNCTION: SPLITS POLYGONS ALONG PLANE AND SAVES ON-PLANE LINE SEGMENTS. NO CHANGES NECESSARY. SUBROUTINE LOOKUP: FUNCTION: PERFORMS HASH TABLE LOOKUP. NO CHANGES NECESSARY. SUBROUTINE ENTER: FUNCTION: PERFORMS HASH TABLE ENTER. NO CHANGES NECESSARY. SUBROUTINE DELETE: INSTALLING MOVIE.BYU Page 5-23 FUNCTION: PERFORMS HASH TABLE DELETE. POSSIBLE I/O MODIFICATIONS (SEE INTRODUCTION ABOVE). SUBROUTINE GETBLK: FUNCTION: GETS A BLOCK FROM FREE STORAGE. NO CHANGES NECESSARY. SUBROUTINE RETBLK: FUNCTION: RETURNS A BLOCK TO FREE STORAGE.  NO CHANGES NECESSARY. SUBROUTINE ORDER: FUNCTION: FORMS ON-PLANE POLYGONS FROM LINE SEGMENTS. POSSIBLE I/O MODIFICATIONS (SEE INTRODUCTION ABOVE). SUBROUTINE PLYSRT: FUNCTION: SORTS POLYGONS IN HASH TABLE AND STORES THEM. NO CHANGES NECESSARY. SUBROUTINE REDUCE: FUNCTION: CALCULATES NEW NODE NUMBERS. NO CHANGES NECESSARY. SUBROUTINE TRGEOM:  FUNCTION: TRANSFORMS OLD GEOMETRY TO NEW GEOMETRY. NO CHANGES NECESSARY. SUBROUTINE TRDISP: FUNCTION: TRANSFORMS OLD DISPLACEMENTS TO NEW DISPLACEMENTS. NO CHANGES NECESSARY. INSTALLING MOVIE.BYU Page 5-24 SUBROUTINE TRSFUN: FUNCTION: TRANSFORMS OLD SCALAR FUNCTIONS TO NEW SCALAR FUNCTIONS. NO CHANGES NECESSARY.  FILE 7: TITLE.FOR TITLE.FOR IS THE FORTRAN SOURCE FILE FOR THE TWO AND THREE DIMENSIONAL CHARACTER GENERATOR. THE DATA GENERATED IS COMPATIBLE WITH THE OTHER PROGRAMS IN MOVIE.BYU MAIN PROGRAM: FUNCTION: GENERATES CHARACTER STRINGS OF POLYGONS FOR DISPLAY. IT MAY BE NECESSARY TO CHANGE THE I/0 UNIT NUMBERS ASSOCIATED WITH THE VARIABLES INPUT AND OUTPUT. INPUT GETS  THE UNIT NUMBER OF THE INPUT DEVICE AND OUTPUT GETS THE UNIT NUMBER OF THE OUTPUT DEVICE. TYPICALLY INPUT AND OUTPUT REFER TO THE USER'S TERMINAL. REMEMBER THAT VARIABLES NPL, X, AND IP, MUST BE DIMENSIONED TO ACCOMMODATE THE MAXIMUM EXPECTED NUMBER OF PARTS, COORDINATES, OR ELEMENTS WHICH EVER IS APPROPRIATE. BLOCK DATA: FUNCTION: INITIALIZES ARRAYS WITH CHARACTER DEFINITIONS NO CHANGES NECESSARY. SUBROUTINE OPEN: FUNCTION: REQUEST DATA FILE NAMES AND OPENS I/O CHANNEL SUBROUTINE OPEN MAY NEED TO BE COMPLETELY REWRITTEN TO ACCOMMODATE YOUR PARTICULAR OPERATING SYSTEM. THE ROUTINE IS ENTERED WITH FILEID CONTAINING THE ALPHANUMERIC FILE IDENTIFICATION (GEOM., DISP., OR FUNC.) IT REQUESTS THE FILE NAME, AND OPENS THE FILE FOR INPUT IF IOP=1 AND FOR OUTPUT IF IOP=-1. A BLANK FILE SPECIFICATION WILL SET IERROR TO 0. THE ROUTINE RETURNS WITH THE DEVICE UNIT NUMBER IN IUNIT AND IERROR SET TO 1 ON SUCCESSFUL COMPLETION, 0 ON BLANK FILE, AND -1 ON FAILURE. INSTALLING MOVIE.BYU Page 5-25 SUBROUTINE WRGEOM: FUNCTION: WRITES GEOMETRY FILE TO OUTPUT DEVICE. POSSIBLE I/O MODIFICATINS (SEE INTRODUCTION ABOVE).  Page Index-1 INSTALLING MOVIE.BYU INDEX Ainten: . . . . . . . . . . . 5-4 Bgnfrm: . . . . . . . . . . . 5-16 Clip: . . . . . . . . . . . . 5-10 Cmd: . . . . . . . . . . . . . 5-17 Consho: . . . . . . . . . . . 5-16 Delete: . . . . . . . . . . . 5-22 Device.for . . . . . . . . . . 5-16 Disp: . . . . . . . . . . . . 5-18 Dist: . . . . . . . . . . . . 5-22 Draw: . . . . . . . . . . . . 5-5 Drawit: . . . . . . . . . . . 5-12 Edgmak: . . . . . . . . . . . 5-7 Endfrm: . . . . . . . . . . . 5-16 Enter: . . . . . . . . . . . . 5-22 Errmsg: . . . . . . . . . . . 5-15 Facmak: . . . . . . . . . . . 5-11 Geom: . . . . . . . . . . . . 5-18 Getblk: . . . . . . . . . . . 5-6, 5-23 Getvar: . . . . . . . . . . . 5-6 Help: . . . . . . . . . . . . 5-18  Hidden.for . . . . . . . . . . 5-6 Hidden: . . . . . . . . . . . 5-11 Intclp: . . . . . . . . . . . 5-7 Inthid: . . . . . . . . . . . 5-5 Ishade: . . . . . . . . . . . 5-4 Ivsble: . . . . . . . . . . . 5-4 Label: . . . . . . . . . . . . 5-16 Linsho: . . . . . . . . . . . 5-12 Lookup: . . . . . . . . . . . 5-22 Lstset: . . . . . . . . . . . 5-6 Move: . . . . . . . . . . . . 5-18 Movie.for . . . . . . . . . . 5-1 Multdc: . . . . . . . . . . . 5-4 Multdd: . . . . . . . . . . . 5-4 Open: . . . . . . . . . . . . 5-2, 5-19 to 5-20, 5-24 Order: . . . . . . . . . . . . 5-19, 5-23 Over: . . . . . . . . . . . . 5-18 Packer: . . . . . . . . . . . 5-13 Pictur: . . . . . . . . . . . 5-2 Plfile: . . . . . . . . . . . 5-22 Pltlin: . . . . . . . . . . . 5-16 Plysrt: . . . . . . . . . . . 5-23 Polmak: . . . . . . . . . . . 5-7 Polsnp: . . . . . . . . . . . 5-8 Rdcntl: . . . . . . . . . . . 5-21 Rddisp: . . . . . . . . . . . 5-19, 5-21 Rdgeom: . . . . . . . . . . . 5-19, 5-21 Rdsfun: . . . . . . . . . . . 5-19, 5-21 Reduce: . . . . . . . . . . . 5-23 Retblk: . . . . . . . . . . . 5-6, 5-23 Rotat: . . . . . . . . . . . . 5-2 Section.for . . . . . . . . . 5-20 Sfun: . . . . . . . . . . . . 5-18 Show: . . . . . . . . . . . . 5-13 Solid: . . . . . . . . . . . . 5-22 Split: . . . . . . . . . . . . 5-22 Srl: . . . . . . . . . . . . . 5-17 Symm: . . . . . . . . . . . . 5-18 Title.for . . . . . . . . . . 5-24 Trdisp: . . . . . . . . . . . 5-23 Trgeom: . . . . . . . . . . . 5-23 Trsfun: . . . . . . . . . . . 5-24 Unpack: . . . . . . . . . . . 5-15 User.doc . . . . . . . . . . . 5-1 Utility.for . . . . . . . . . 5-17 Wrdisp: . . . . . . . . . . . 5-20, 5-22 Wrgeom: . . . . . . . . . . . 5-19, 5-21, 5-25 Wrsfun: . . . . . . . . . . . 5-19, 5-21 APPENDIX A SUGGESTED 16 BIT MACHINE CODE SUBROUTINE PACKER C C SUBROUTINE PACKER FOR 16 BIT MACHINES IN ANSI FORTRAN C C THIS ROUTINE RECEIVES DATA THROUGH EDGARG AND PACKS IT C INTO A STORAGE BLOCK INSIDE FREE. IF THIS EDGE IS A C SHARED EDGE, THEN THE EDGE WILL BE COMPARED WITH EXISTING C EDGES ON THIS SCAN LINE TO FIND OUT WHICH IF ANY IT C MATCHES. IF THIS EDGE IS A HORIZONTAL EDGE, THEN IT WILL C BE STORED ON THE PREVIOUS SCAN LINE. COMMON/EDGARG/IY,IX1,IX2,IZ1,IZ2,IS1,IS2,IP,IDY,ICOL1, 1ISHR,IC1,IC2,ICOL2 COMMON/FREE/ IFREE(1) COMMON/EYES/XEY(3),IFY,ES(4) COMMON/BUCKY/IBUCKY(1) COMMON/QFORIO/CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC LOGICAL CONTRS,IBAD,ISHR C CHANGE IY IF THIS IS A HORIZONTAL EDGE IF(IDY.EQ.0) IY=IY+1 IF(IY.GT.IFY) IY=IFY IPT=IBUCKY(IY)+32767 C GENERATE THE EDGE DATA NUMWRD=11 C JUMP IF NO EDGE SHARING IF(.NOT.ISHR) GO TO 4 C TRACE THROUGH THE ENTRIES ON THIS SCAN LINE AND FIND OUT C IF THIS EDGE HAS ALREADY BEEN ENTERED. 1 IF(IPT.EQ.0) GO TO 4 IF(IX1.EQ.MOD(IFREE(IPT),1024) 1.AND.IX2.EQ.MOD(IFREE(IPT+1),1024) 2.AND.IDY.EQ.IFREE(IPT+2) 3.AND.IZ1.EQ.IFREE(IPT+3) 4.AND.IZ2.EQ.IFREE(IPT+4)) GO TO 3 C GET THE NEXT BLOCK IPT=IFREE(IPT+6)+32767 GO TO 1 C CHECK TO SEE IF THIS EDGE IS ALREADY SHARED C AND JUMP IF IT IS 3 IF(IFREE(IPT+10).NE.0) GO TO 4 C NOW PROVIDE THE SHARING POLYGON SUGGESTED 16 BIT MACHINE CODE Page A-2 IFREE(IPT+10)=IP GO TO 5 4 CONTINUE C GET ENOUGH FREE FOR EDGE BLOCK (176 BITS) CALL GETVAR(IPT,NUMWRD) IF(IBAD) RETURN C CBEG(5), XBEG(10) IFREE(IPT)=IX1 C CEND(5), XEND(10) IFREE(IPT+1)=IX2  C DELTA Y(10) IFREE(IPT+2)=IDY C ZBEG(15) IFREE(IPT+3)=IZ1 C ZEND(15) IFREE(IPT+4)=IZ2 C SBEG(5), SEND(5) IFREE(IPT+5)=IS1*32+IS2 C NEXT EDGE(16) IFREE(IPT+6)=IBUCKY(IY) C COLOR BEG(15) IFREE(IPT+7)=ICOL1 C COLOR END(15) IFREE(IPT+8)=ICOL2 C POLYGON NUMBER IFREE(IPT+9)=IP C SHARED POLYGON NUMBER IFREE(IPT+10)=0 IF(.NOT.CONTRS) GO TO 6 IFREE(IPT)=MOD(IFREE(IPT),1024)+IC1*1024 IFREE(IPT+1)=MOD(IFREE(IPT+1),1024)+IC2*1024 6 IBUCKY(IY)=IPT-32767 5 RETURN END SUBROUTINE UNPACK C C SUBROUTINE UNPACK FOR 16 BIT MACHINES IN ANSI FORTRAN C C UNPACK PERFORMS THE REVERSE OF PACKER. IT IS CALLED BY C HIDDEN WITH IEDGPT SET AND RETURNS DATA THROUGH EDGBLK. COMMON/FREE/IFREE(1) COMMON/EDGBLK/IPT,ICOL1,IDELY,X1,X2,Z1,Z2,S1,S2, 1IEDGPT,C1,C2,SHARED,IGTHRZ,ICOL2 COMMON/QFORIO/CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC LOGICAL CONTRS C GET DELTAY VALUE 15 IDELY=IFREE(IEDGPT+2) C JUMP IF A NON-HORIZONTAL LINE IF(IDELY.GT.0) GO TO 16 C JUMP IF WE ARE LOOKING FOR VERTICALS IF(IGTHRZ) 20,20,18  C JUMP IF WE ARE LOOKING FOR HORIZONTALS SUGGESTED 16 BIT MACHINE CODE Page A-3 16 IF(IGTHRZ) 19,19,20 C FLAG TO SAY THERE ARE HORIZONTAL EDGES ON THIS SCAN LINE 18 IGTHRZ=2 C GET NEXT EDGE BLOCK 19 IEDGPT=IFREE(IEDGPT+6)+32767 C GO HOME IF WE RAN OFF THE END OF THE LIST IF(IEDGPT) 3,3,15 C GET Z BEGIN 20 Z1=FLOAT(IFREE(IEDGPT+3)) C GET Z END AND MAKE IT REAL Z2=FLOAT(IFREE(IEDGPT+4)) C GET X BEGIN X1=FLOAT(MOD(IFREE(IEDGPT),1024)) C GET X END AND MAKE IT REAL X2=FLOAT(MOD(IFREE(IEDGPT+1),1024)) C GET SHADE BEGIN S1=FLOAT(MOD(IFREE(IEDGPT+5)/32,32)) C GET SHADE END AND MAKE IT REAL S2=FLOAT(MOD(IFREE+5),32)) C GET POINTER TO POLYGON IP=IFREE(IEDGPT+10) C GET THE COLOR OF THIS EDGE  ICOL1=IFREE(IEDGPT+7) ICOL2=IFREE(IEDGPT+8) C JUMP IF NO CONTOURING IF(.NOT.CONTRS) GO TO 4 C GET THE CONTOUR BEGIN C1=FLOAT(MOD(IFREE(IEDGPT)/1024,32)) C CET THE CONTOUR END C2=FLOAT(MOD(IFREE(IEDGPT+1)/1024,32)) 4 SHARED=-2. C IPT=IFREE(IEDGPT+9) C JUMP IF NOTHING IN THE TOP HALF IF(IP.EQ.0) GO TO 2 SHARED=-1.  IF(ISHARE.EQ.1) GO TO 1 ISHARE=1 GO TO 3 1 IPT=IP C GET POINTER TO NEXT EDGE ON SCAN LINE 2 IEDGPT=IFREE(IEDGPT+6)+32767 ISHARE=0 3 RETURN END APPENDIX B SUGGESTED 32 BIT MACHINE CHANGES SUBROUTINE PACKER C C SUBROUTINE PACKER FOR 32 BIT MACHINES IN ANSI FORTRAN C C THIS ROUTINE RECEIVES DATA THROUGH EDGARG AND PACKS IT C INTO A STORAGE BLOCK INSIDE FREE. IF THIS EDGE IS A C SHARED EDGE, THEN THE EDGE WILL BE COMPARED WITH EXISTING C EDGES ON THIS SCAN LINE TO FIND OUT WHICH IF ANY IT C MATCHES. IF THIS EDGE IS A HORIZONTAL EDGE, THEN IT WILL C BE STORED ON THE PREVIOUS SCAN LINE. COMMON/EDGARG/IY,IX1,IX2,IZ1,IZ2,IS1,IS2,IP,IDY,ICOL1, 1ISHR,IC1,IC2,ICOL2  COMMON/FREE/ IFREE(1) COMMON/EYES/XEY(3),IFY,ES(4) COMMON/BUCKY/IBUCKY(1) COMMON/QFORIO/CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC LOGICAL CONTRS,IBAD,ISHR C CHANGE IY IF THIS IS A HORIZONTAL EDGE IF(IDY.EQ.0) IY=IY+1 IF(IY.GT.IFY) IY=IFY IPT=IBUCKY(IY) C GENERATE THE EDGE DATA IT1=(IX1*1024+IX2)*1024+IDY IT2=IZ1*32768+IZ2 NUMWRD=5 C GET EXTRA WORD FOR CONTOURS IF(CONTRS) NUMWRD=6 C JUMP IF NO EDGE SHARING IF(.NOT.ISHR) GO TO 4 C TRACE THROUGH THE ENTRIES ON THIS SCAN LINE AND FIND OUT C IF THIS EDGE HAS ALREADY BEEN ENTERED. 1 IF(IPT.EQ.0) GO TO 4 IF(IT1.EQ.IFREE(IPT).AND.IT2.EQ.IFREE(IPT+1)) GO TO 3 C GET THE NEXT BLOCK IPT=MOD(IFREE(IPT+2),262144) GO TO 1 C CHECK TO SEE IF THIS EDGE IS ALREADY SHARED C AND JUMP IF IT IS 3 IF(MOD(IFREE(IPT+4),8192).NE.0) GO TO 4 C NOW PROVIDE THE SHARING POLYGON SUGGESTED 32 BIT MACHINE CHANGES Page B-2 IFREE(IPT+4)=IFREE(IPT+4)/8192*8192+IP GO TO 5 4 CONTINUE C GET ENOUGH FREE FOR EDGE BLOCK (160 OR 192 BITS) CALL GETVAR(IPT,NUMWRD) IF(IBAD) RETURN C XBEG(10), XEND(10), DELTA Y(10) IFREE(IPT)=IT1 C ZBEG(15), ZEND(15) IFREE(IPT+1)=IT2 C SBEG(6), SEND(6), NEXT EDGE(18) IFREE(IPT+2)=(IS1*64+IS2)*262144+IBUCKY(IY) C COLOR BEG(18), POLYGON NUMBER(13) IFREE(IPT+3)=ICOL1*8192+IP C COLOR END(18), SHARED POLYGON NUMBER(13) IFREE(IPT+4)=ICOL2*8192 C CONTOUR BEG(5), CONTOUR END(5) IFCONTRS) IFREE(IPT+5)=IC1*32+IC2 6 IBUCKY(IY)=IPT  5 RETURN END SUBROUTINE UNPACK C C SUBROUTINE UNPACK FOR 32 BIT MACHINES IN ANSI FORTRAN C C UNPACK PERFORMS THE REVERSE OF PACKER. IT IS CALLED BY C HIDDEN WITH IEDGPT SET AND RETURNS DATA THROUGH EDGBLK. COMMON/FREE/IFREE(1) COMMON/EDGBLK/IPT,ICOL1,IDELY,X1,X2,Z1,Z2,S1,S2, 1IEDGPT,C1,C2,SHARED,IGTHRZ,ICOL2 COMMON/QFORIO/CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC LOGICAL CONTRS C GET DELTAY VALUE 15 IDELY=MOD(IFREE(IEDGPT,1024) C JUMP IF A NON-HORIZONTAL LINE IF(IDELY.GT.0) GO TO 16 C JUMP IF WE ARE LOOKING FOR VERTICALS IF(IGTHRZ) 20,20,18 C JUMP IF WE ARE LOOKING FOR HORIZONTALS 16 IF(IGTHRZ) 19,19,20 C FLAG TO SAY THERE ARE HORIZONTAL EDGES ON THIS SCAN LINE 18 IGTHRZ=2 C GET NEXT EDGE BLOCK 19 IEDGPT=MOD(IFREE(IEDGPT+2),262144) C GO HOME IF WE RAN OFF THE END OF THE LIST IF(IEDGPT) 3,3,15 C GET Z BEGIN 20 Z1=FLOAT(MOD(IFREE(IEDGPT+1)/32768,32768)) C GET Z END AND MAKE IT REAL Z2=FLOAT(MOD(IFREE(IEDGPT+1),32768)) C GET X BEGIN X1=FLOAT(MOD(IFREE(IEDGPT)/1048576,1024)) SUGGESTED 32 BIT MACHINE CHANGES Page B-3 C GET X END AND MAKE IT REAL X2=FLOAT(MOD(IFREE(IEDGPT)/1024,1024)) C GET SHADE BEGIN S1=FLOAT(MOD(IFREE(IEDGPT+2)/16777216,64)) C GET SHADE END AND MAKE IT REAL S2=FLOAT(MOD(IFREE+2)/262144,64)) C GET POINTER TO POLYGON IP=MOD(IFREE(IEDGPT+4),8192) C GET THE COLOR OF THIS EDGE ICOL1=MOD(IFREE(IEDGPT+3)/8192,262144) ICOL2=MOD(IFREE(IEDGPT+4)/8192,262144) C JUMP IF NO CONTOURING IF(.NOT.CONTRS) GO TO 4 C GET THE CONTOUR BEGIN C1=FLOAT(MOD(IFREE(IEDGPT+5)/32,32)) C CET THE CONTOUR END C2=FLOAT(MOD(IFREE(IEDGPT+5),32)) 4 SHARED=-2. C IPT=MOD(IFREE(IEDGPT+3),8192) C JUMP IF NOTHING IN THE TOP HALF IF(IP.EQ.0) GO TO 2 SHARED=-1. IF(ISHARE.EQ.1) GO TO 1 ISHARE=1 GO TO 3 1 IPT=IP  C GET POINTER TO NEXT EDGE ON SCAN LINE 2 IEDGPT=MOD(IFREE(IEDGPT+2),262144) ISHARE=0 3 RETURN END C**********************************************************************C C C C MOVIE.FOR VERSION 2.0(A) SEPTEMBER 1976 C C C C A GENERAL PRUPOSE COMPUTER GRAPHICS DISPLAY PROGRAM FOR C C POLYGONAL DATA WITH LINE DRAWING AND C C CONTINUOUS-TONE PHOTOIMAGE OUTPUT. C  C C C MIKE STEPHENSON HANK CHRISTIANSEN C C DEPARTMENT OF CIVIL ENGR. CIVIL ENGINEERING DEPT. C C AND ENGINEERING MECHANICS 368E ESTB C C THE UNIVERSITY OF ARIZONA BRIGHAM YOUNG UNIVERSITY C C TUCSON, ARIZONA 85721 PROVO, UTAH 84602 C C (602) 884-4803 (801) 374-1211 X2811 C C C C**********************************************************************C C MAIN PROGRAM READS DATA AND CALLS PICTURE ROUTINE C SUBPROGRAMS CALLED C OPEN = DATA FILE OPEN ROUTINE C PICTUR = INTERACTIVE PICTURE PROCESSING ROUINE C VARIABLES USED C NP = NUMBER OF PARTS C NJ = NUMBER OF JOINTS OR NODES C NPT = NUMBER OF ELEMENTS C NPL = PARTS ARRAY - 1ST ROW = FIRST ELEMENT OF PART C - 2ND ROW = LAST ELEMENT OF PART C X = COORDINATE ARRAY C IP = CONNECTIVITY ARRAY C U = DISPLACEMENT ARRAY C SPEC = SCALAR FUNCTION ARRAY C ISPEC = .TRUE. FOR SCALAR FUNCTION FILE INCLUDED C = .FALSE. FOR SCALAR FUNCTION FILE NOT INCLUDED C NFILE = .TRUE. TO READ NEW DATA FILES C = .FALSE. TO EXIT C NPMAX = MAXIMUM NUMBER OF PARTS C NJMAX = MAXIMUM NUMBER OF NODES C NPTMAX = MAXIMUM NUMBER OF ELEMENTS(POLYGONS) INTEGER OUTPUT,ERROR LOGICAL ISP EC,NFILE C DIMENSION NPL(2,NPMAX),X(3,NJMAX),IP(4,NPTMAX),U(3,NJMAX), C 1 SPEC(NJMAX) DIMENSION NPL(2,20),X(3,250),IP(4,250),U(3,250), 1 SPEC(250) COMMON/DEVI/ INPUT,OUTPUT,ERROR DATA NP/0/,NJ/0/,NPT/0/ DATA NPMAX/20/,NJMAX/250/,NPTMAX/250/ DATA IREAD/1/ C INPUT, OUTPUT AND ERROR ARE SET BELOW FOR THE DECSYSTEM-10 INPUT=-4 OUTPUT=-1 ERROR=3 WRITE(OUTPUT,1) 1 FORMAT(' '/) ICODE=63 C READ GEOMET RY FILE 10 CALL OPEN('GEOM.',IUNIT,IREAD,IERROR) IF(IERROR) 10,20,11 11 READ(IUNIT,1000) NP,NJ,NPT IF(NP.GT.NPMAX) WRITE(OUTPUT,1020) NP,NPMAX IF(NJ.GT.NJMAX) WRITE(OUTPUT,1030) NJ,NJMAX IF(NPT.GT.NPTMAX) WRITE(OUTPUT,1040) NPT,NPTMAX IF(NP.GT.NPMAX.OR.NJ.GT.NJMAX.OR.NPT.GT.NPTMAX) STOP READ(IUNIT,1000) ((NPL(I,J),I=1,2),J=1,NP) READ(IUNIT,1010) ((X(I,J),I=1,3),J=1,NJ) READ(IUNIT,1000) ((IP(I,J),I=1,4),J=1,NPT) WRITE(OUTPUT,1050) NP,NJ,NPT C  READ DISPLACEMENT FILE 20 IF(NP.EQ.0) GO TO 10 CALL OPEN('DISP.',IUNIT,IREAD,IERROR) IF(IERROR) 20,30,21 21 READ(IUNIT,1010) ((U(I,J),I=1,3),J=1,NJ) C READ SPECIAL FUNCTION FILE 30 CALL OPEN('S. F.',IUNIT,IREAD,IERROR) ISPEC=.FALSE. IF(IERROR) 30,40,31 31 ISPEC=.TRUE. READ(IUNIT,1010) (SPEC(I),I=1,NJ) C SELECT OPTIONS AND VIEW SCENE 40 CALL PICTUR(NPL,X,IP,U,SPEC,NP,NJ,NPT,ISPEC,ICODE) GO TO 10 1000 FORMAT(20I) 1010 FORMAT(6E) 1020 FORM AT(' ') 1030 FORMAT(' ') 1040 FORMAT(' ') 1050 FORMAT(' ') END  SUBROUTINE OPEN(FILEID,IUNIT,IOP,IERROR) C SUBROUTINE OPEN REQUEST FILENAME AND OPENS FILE FOR I/O C SUBPROGRAMS CALLED C OPEN = SYSTEM OPEN FILE ROUTINE C VARIABLES USED C FILEID = 5 ASCII CHARACTER ID C IUNIT = DEVICE LOGICAL NUMBER C IOP = 1 FOR INPUT FILE C = -1 FOR OUTPUT FILE C IERROR = 1 ON SUCCESSFUL COMPLETION C = 0 ON EMPTY FILE SPECIFICATION C = -1 ON FAILURE DOUBLE PRECISION ASEQ,BLANK,XNAME INTEGE R OUTPUT,ERROR COMMON/DEVI/ INPUT,OUTPUT,ERROR DATA DSK/'DSK'/,MTA/'MTA'/ DATA BLANK/' '/ IERROR=0 1 WRITE(OUTPUT,2) FILEID 2 FORMAT(' <',A5,' FILE> ',$) READ(INPUT,3) XNAME 3 FORMAT(A10) IF(XNAME.EQ.BLANK) RETURN IERROR=1 IUNIT=10 IF(IOP.GT.0) ASEQ='SEQIN' IF(IOP.LT.0) ASEQ='SEQOUT' OPEN(UNIT=IUNIT,DEVICE=DSK,FILE=XNAME,ACCESS=ASEQ,MODE='ASCII') RETURN END  SUBROUTINE ROTAT(X,IDIR,THETA,K) C SUBROUTINE ROTAT CALCULATES ROTATION TRANSFORMATION MATRIX C VARIABLES USED C X = TRANSFORMATION MATRIX C IDIR = ROTATION ABOUT 1=X1, 2=X2, 3=X3 AXIS C THETA = ANGLE OF ROTATION IN DEGREES DIMENSION X(3,3,1) C COMPUTE SINE AND COSINE CS=COSD(THETA) SS=SIND(THETA) GO TO (1,2,3),IDIR C X1 DIRECTION 1 DO 11 I=1,3 X2=X(I,2,K) X3=X(I,3,K) X(I,2,K)=CS*X2-SS*X3 11 X(I,3,K)=CS*X3+SS*X2 RETU RN C X2 DIRECTION 2 DO 12 I=1,3 X1=X(I,1,K) X3=X(I,3,K) X(I,1,K)=CS*X1+SS*X3 12 X(I,3,K)=CS*X3-SS*X1 RETURN C X3 DIRECTION 3 DO 13 I=1,3 X1=X(I,1,K) X2=X(I,2,K) X(I,1,K)=CS*X1-SS*X2 13 X(I,2,K)=CS*X2+SS*X1 RETURN END  SUBROUTINE PICTUR(NPL,X,IP,U,SPEC,NP,NJ,NPT,ISPEC,ICODE) C SUBROUTINE PICTUR - INTERACTIVE PICTURE PROCEESING ROUTINE. C PICTUR ACCEPTS COMMANDS FROM THE USER AND PERFORMS THE INDICATED C ACTION. C COMMANDS ARE C SCOPE = SET SCOPE PARAMETERS C RESTORE = RESTORE GEOMETRY TO INITIAL CONDITION C CONTENT = SELECT CONTENT OF A SCENE AND SET LOCAL MOTION C DIFUSE = SET DIFUSED LIGHT INTENSITY OF INDIVIDUAL PARTS C SUMMARY = GIVE MAXIMUM AND MINIMUM VALUES OF DATA FILES READ  C FLAT = USE FLAT SHADING C SMOOTH = USE SMOOTH SHADING C COLOR = SELECT COLORS FOR BACKGROUND, PARTS, AND FRINGES C ROTATE = ROTATE MODEL ABOUT GLOBAL AXES C PIVOT = ROTATE MODEL ABOUT LOCAL AXES C TRANSLATE = TRANSLATE LOCAL ORIGIN OF MODEL C DISTANCE = SET DISTANCE FROM OBSERVER TO MODEL C FIELD = SPECIFY FRUSTRUM OF VISION C SCALE = SET SCALE FACTOR FOR DISPLACEMENT FUNCTIONS C WARP = SET SCALE FACTOR FOR SCALAR FUNCTIONS C MOVIE = SPECIFY ANIMATION SEQUENC E C DATA = SELECT POLYGON ORIENTATION AND POOR MAN'S HIDDEN SURFACE C DRAW = DISPLAY SCENE ON TEKTRONIX SCOPE - LINE DRAWING C VIEW = DISPLAY SCENE ON PRECISION DISPALY C READ = READ NEW DATA FILES C HELP = TYPE COMMANDS C EXIT = TERMINATE PROGRAM EXECUTION C SUBPROGRAMS CALLED C ROTAT = CALCULATE ROTATION TRANSFORMATION MATRIX C MULTDD = MULTIPLY COORDINATE BY LOCAL ROTATION C MULTDC = MULTIPLY COORDINATE BY GLOBAL ROTATION C IVSBLE = CALCULATE NUMBER VISIBLE NOD ES C AINTEN = CALCULATE LIGHT INTENSITY AT NODE C IPASS = DISPLAY SCENE ON DEVICE C VARIABLES USED C NPL = PARTS ARRAY C X = COORDINATE ARRAY C IP = CONNECTIVITY ARRAY C U = DISPLACEMENT ARRAY C SPEC = SCALAR FUNCTION ARRAY C XNORM = NORMALS ARRAY C NP = NUMBER OF PARTS C NJ = NUMBER OF JOINTS OR NODES C NPT = NUMBER OF ELEMENTS C ISPEC = .TRUE. FOR SCALAR FUNCTION FILE INCLUDED C = .FALSE. FOR NO SCALAR FUNCTION FILE INCLUDED C NFILE = .TRUE . TO READ NEW DATA FILES C = .FALSE. DO NOT READ NEW DATA FILES C DA = LOCAL ROTATIONS ARRAY BY PART C DC = GLOBAL TRANSFORMATION MATRIX C DD = LOCAL TRANSFORMATION MATRICES BY PART C FUNX, FUNY, FUNZ = WARPPING SCALE FACTORS (X1, X2, X3 DIRECTION) C COLOR = DATA ARRAY C NFR = FRINGE ARRAY - 1 DISPLAY FRINGES C - 0 DO NOT DISPLAY FRINGES C NPLS = DISPLAY PARTS ARRAY - 1 TO DISPLAY C - 0 NO DISPLAY C RORG = RELATIVE ORIGIN ARRAY FOR LOCAL ROTATIONS C WORDS = DATA ARRAY C ICOL= RED, BLUE, GREEN INTENSITY BY PARTS C XO = TRANSLATION ARRAY C XX = LOCAL MOTION TRANSLATION ARRAY C DIF = DIFUSED LIGHT ARRAY BY PART C TANAL = TANGENT OF PERSPECTIVE HALF ANGLE C CFRIN = RED, BLUE, GREEN, FRINGE INTENSITY BY FRINGE NUMBER C JFRING = .TRUE FOR FRINGES C = .FALSE. FOR NO FRINGES C DIRC = .TRUE. FOR CLOCKWISE ORIENTATION OF POLYGONS C = .FALSE. FOR COUNTER-CLOCKWISE ORIENTATION OF  POLYGONS C NFRINGE = NUMBER OF FRINGES C CMD = COMMAND WORD C SKALE = DISPLACEMNT SCALE FACTOR C ISMOTH = -1 FOR SMOOTH SHADING C = 0 FOR FLAT SHADING C = 1 FOR UNIFORM SHADING C DOZ = DISTANCE TO ORIGIN C FIELD = ANGLE OF VIEW (FRUSTRUM OF VISION) C DELTA = LOCAL MOTION SCALE FACTOR C IC = 1 FOR COLOR C 2 FOR BLACK AND WHITE C IFR1, IFR2 = FIRST AND LAST SCENE IN SEQUENCE SENT TO DISPLAY C CPF = VIBRATIONS/FRAME C DT = TOTAL TRAN SLATION IN ANIMATED SEQUENCE C DR = TOTAL ROTATION IN ANIMATED SEQENCE C DDOZ = CHANGE IN DISTANCE TO ORIGIN IN ANIMATED SEQUENCE C SFDEL = DISPLACEMENT SCALE FACTOR IN ANIMATED SEQUENCE C DDELTA = POSITION SCALE FACTOR IN ANIMATED SEQUENCE C IPM = .TRUE. DISPLAYS ALL PICTURES IN SEQUENCE C = .FALSE. MODIFIES GEOMETRY BUT DOES NOT DISPLAY C IPB = BACKGROUND COLOR C IDVICE = DISPLAY DEVICE NUMBER C DAMP = DAMPING FACTOR FOR SMOOTH ANIMATION C IMIX = .TRUE. INCONS ISTANT POLYGON VERTICE ORDERING C = .FALSE. CONSISTANT ORDERING (CLOCKWICE OR COUNTER-CLOCKWISE C NCNT = # OF VISIBLE NODES C IPOOR = .TRUE. FOR POOR MAN'S HIDDEN SURFACE REMOVAL C = .FALSE. FOR NO POOR MAN'S HIDDEN SURFACE REMOVAL DIMENSION NPL(2,1),X(3,1),IP(4,1),U(3,1),SPEC(1) DIMENSION DC(3,3),DR(3),DT(3),BFRIN(5),GFRIN(5),RFRIN(5) 1,WORDS(3,2),XO(3) C DIMENSION DA(3,NPMAX),DD(3,3,NPMAX),DIF(NPMAX),ICOL(NPMAX) C 1,NFR(NPMAX),NPLS(NPMAX),RORG(3,NPMAX ),SPEC1(NJMAX) C 2,XNORM(3,.GT.NJMAX.OR.NPTMAX),XX(3,NPMAX) DIMENSION DA(3,20),DD(3,3,20),DIF(20),ICOL(20),NFR(20) 1,NPLS(20),RORG(3,20),SPEC1(250),XNORM(3,250),XX(3,20) COMMON/DEVI/ INPUT,OUTPUT,ERROR COMMON/VARB/ UFRING,DRC(3),FRING(2,20) COMMON/VCOL/ NFRING,CFRIN(3,11) C HIDDEN ROUTINE COMMON STORAGE COMMON/CLIP3/ XB,YB,ZB,BINT,KB,CB,XE,YE,ZE,EINT,KE,CE,LAS, 1 ISHARE,NTR COMMON/CONLEV/ CONHI,CONLO,NCONLV,CLEVEL(26) COMMON/INTENS/ IPH,IPL,IP B,IFX,IFY COMMON/QFORIO/ CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC COMMON/ZRANGE/ ZMIN,ZMAX LOGICAL CONTRS,SHOSHR,ISHARE,NTR,LAS,IBAD INTEGER OUTPUT,ERROR LOGICAL DIRC,IFRING,IHLR,IMIX,IPM,IPOOR,ISPEC,JFRING,LINEAR 1,NFILE,UFRING DATA BFRIN/1.,1.,0.,0.,0./ DATA GFRIN/0.,1.,1.,1.,0./ DATA RFRIN/0.,0.,0.,1.,1./ DATA IREAD/1/ DATA WORDS/'RED,B','LUE,G','REEN ', 1 'BLACK',' AND ','WHITE'/ C READ(INPUT,COMMAND STRING FOR PROCESSING 10 I BAD=.FALSE. NTR=.FALSE. 12 IF(ICODE.EQ.0) GO TO 15 IF(ICODE.EQ.63) GO TO 41 IF(ICODE.EQ.31) GO TO 71 IF(ICODE.EQ.15) GO TO 81 IF(ICODE.EQ.7) GO TO 112 IF(ICODE.EQ.3) GO TO 131 IF(ICODE.EQ.1) GO TO 271 DO 13 I=1,NP DIF(I)=0.15 13 ICOL(I)=262143 IPB=0 DO 14 I=1,5 CFRIN(1,I)=GFRIN(I) CFRIN(2,I)=BFRIN(I) 14 CFRIN(3,I)=RFRIN(I) 15 WRITE(OUTPUT,16) 16 FORMAT(' >> ',$) READ(INPUT,18) CMD 18 FORMAT(A4) C R EAD NEW DATA 20 IF(CMD.EQ.'READ') RETURN C RETURN CONTROL TO MONITOR IF(CMD.EQ.'EXIT') CALL EXIT C ROTATE MODEL ABOUT ORIGIN 30 IF(CMD.NE.'ROTA') GO TO 40 WRITE(OUTPUT,32) 32 FORMAT(' ',$) READ(INPUT,34) X1,X2 34 FORMAT(A1,1X,E) I1=0 IF(X1.EQ.'X') I1=1 IF(X1.EQ.'Y') I1=2 IF(X1.EQ.'Z') I1=3 IF(I1.GT.0) GO TO 38 WRITE(OUTPUT,36) X1 36 FORMAT(' <',A1,' AXIS?>') GO TO 12 38 CALL ROTAT(DC,I1,X2,1) GO T O 12 C RESTORE MODEL TO ORIGINAL COORDINATE SYSTEM C (KILL ROTATIONS AND TRANSLATIONS) 40 IF(CMD.NE.'REST') GO TO 50 41 ICODE=ICODE-32 DO 44 J=1,3 DO 42 I=1,3 42 DC(I,J)=0. XO(J)=0. 44 DC(J,J)=1.0 DO 48 K=1,NP DO 48 J=1,3 DO 46 I=1,3 46 DD(I,J,K)=0. RORG(J,K)=0. 48 DD(J,J,K)=1.0 GO TO 12 50 IF(CMD.NE.'TRAN') GO TO 60 WRITE(OUTPUT,51) 51 FORMAT(' ',$) READ(INPUT,400) (XO(I),I=1,3) GO TO 12  C SPECIFIY DISPLACEMENT SCALE FACTOR 60 IF(CMD.NE.'SCAL') GO TO 70 WRITE(OUTPUT,61) 61 FORMAT(' ',$) READ(INPUT,400) SKALE GO TO 12 C SELECT FLAT OR SMOOTH SHADING 70 IF(CMD.NE.'FLAT'.AND.CMD.NE.'SMOO'.AND.CMD.NE.'UNIF') 1 GO TO 80 71 ICODE=ICODE-16 ISMOTH=0 SHOSHR=.TRUE. IF(CMD.EQ.'SMOO') ISMOTH=-1 IF(CMD.EQ.'SMOO') SHOSHR=.FALSE. IF(CMD.EQ.'UNIF') ISMOTH=1 GO TO 12 C SET SCOPE PARAMETERS 80 IF(C MD.NE.'SCOP'.AND.CMD.NE.'DEVI') GO TO 90 81 WRITE(OUTPUT,82) 82 FORMAT(' ',$) READ(INPUT,18) DEV IDVICE=0 IF(DEV.EQ.'COMT') IDVICE=1 IF(DEV.EQ.'TEKT') IDVICE=-1 IF(DEV.EQ.'HPLT') IDVICE=-2 IF(DEV.EQ.'CPLT') IDVICE=-3 IF(IDVICE.NE.0) GO TO 84 WRITE(OUTPUT,83) 83 FORMAT(' --') GO TO 81 84 IF(CMD.EQ.'DEVI') GO TO 12 ICODE=ICODE-8 IPL=0 IPH=63 IF(IDVICE.LT.0) GO TO 86 WRITE(OUTP UT,85) 85 FORMAT(' ',$) READ(INPUT,401) ANS IC=2+(ANS.EQ.'C') 86 WRITE(OUTPUT,87) 87 FORMAT(' ',$) READ(INPUT,402) IFX,IFY IF(IFX.LT.1.OR.IFX.GT.512) IFX=512 IF(IFY.LT.1.OR.IFY.GT.IFX) IFY=IFX RES=IFX-1 GO TO 12 C SET DIFUSED LIGHT INTENSITY BY PART 90 IF(CMD.NE.'DIFU') GO TO 100 WRITE(OUTPUT,92) 92 FORMAT(' ') 94 READ(INPUT,403) I1,I2,X1 IF(I1.EQ.0) GO TO 12 DO 96 I=I1,I2 96 DIF(I)=X1 GO TO 94 C SPECIFIY DISTANCE TO COORDINATE ORIGIN 100 IF(CMD.NE.'DIST') GO TO 105 WRITE(OUTPUT,102) 102 FORMAT(' ',$) READ(INPUT,400) DOZ GO TO 12 C SPECIFY FRUSTRUM OF VISION 105 IF(CMD.NE.'FIEL') GO TO 110 WRITE(OUTPUT,108) 108 FORMAT(' ',$) READ(INPUT,400) FIELD,ZMIN,ZMAX FIELD=FIELD/2.0 TANAL=SIND(FIELD)/COSD(FIELD) GO TO 12 C SELECT CONTENT OF THIS SCENE AND SPECIFY LOCAL MOTION 11 0 IF(CMD.NE.'PART') GO TO 120 WRITE(OUTPUT,111) 111 FORMAT(' ',$) READ(INPUT,401) ANS IF(ANS.NE.'Y') GO TO 114 112 ICODE=ICODE-4 DO 113 I=1,NP NPLS(I)=0 113 IF(NPL(1,I).LE.NPL(2,I)) NPLS(I)=1 GO TO 12 114 DO 115 I=1,NP 115 NPLS(I)=0 WRITE(OUTPUT,116) 116 FORMAT(' ',/) 117 READ(INPUT,402) II1,II2 IF(II1.EQ.0) GO TO 12 DO 118 J=II1,II2 118 IF(NPL(1,J).LE.NPL(2,J)) NPLS(J)=1 GO TO 117 C EXPLOSION O F PARTS 120 IF(CMD.NE.'EXPL') GO TO 130 WRITE(OUTPUT,121) 121 FORMAT(' ',/) 122 READ(INPUT,403) I1,I2,X1,X2,X3 IF(I1.EQ.0) GO TO 124 DO 123 I=I1,I2 XX(1,I)=X1 XX(2,I)=X2 123 XX(3,I)=X3 GO TO 122 124 WRITE(OUTPUT,125) 125 FORMAT(' ',$) READ(INPUT,400) DELTA GO TO 12 C GIVE SUMMARY OF DATA READ WITH MIN./MAX. VALUES 130 IF(CMD.NE.'SUMM'.AND.CMD.NE.'CENT') GO TO 145 131 ICODE=ICODE-2 DO 132  II=1,NP IF(NPLS(II).NE.0) GO TO 133 132 CONTINUE GO TO 12 133 I1=NPL(1,II) I2=IP(1,I1) XL=X(1,I2)-XO(1) XS=XL YL=X(2,I2)-XO(2) YS=YL ZL=X(3,I2)-XO(3) ZS=ZL UL=U(1,I2) US=UL SL=SPEC(I2) SS=SL DO 135 I=II,NP IF(NPLS(I).EQ.0) GO TO 135 I1=NPL(1,I) I2=NPL(2,I) DO 135 J=I1,I2 DO 135 K=1,4 K1=IP(K,J) IF(K1.EQ.0) GO TO 135 X1=X(1,K1)-XO(1) Y1=X(2,K1)-XO(2) Z1=X(3,K1 )-XO(3) IF(XL.LT.X1)XL=X1 IF(XS.GT.X1)XS=X1 IF(YL.LT.Y1)YL=Y1 IF(YS.GT.Y1)YS=Y1 IF(ZL.LT.Z1)ZL=Z1 IF(ZS.GT.Z1)ZS=Z1 DO 134 K2=1,3 X1=U(K2,K1) IF(UL.LT.X1)UL=X1 134 IF(US.GT.X1)US=X1 X1=SPEC(K1) IF(SL.LT.X1) SL=X1 IF(SS.GT.X1) SS=X1 135 CONTINUE WRITE(OUTPUT,136) XS,XL,YS,YL,ZS,ZL 136 FORMAT(' <',F9.4,' ') IF(US.NE.0.0.OR.UL.NE.0.0) WRITE(OUTPUT,137) US,UL 137  FORMAT(' <',1PE12.5,' ') IF(ISPEC) WRITE(OUTPUT,138) SS,SL 138 FORMAT(' <',1PE12.5,' ') IF(CMD.EQ.'SUMM') GO TO 12 XO(1)=XO(1)+(XS+XL)/2. XO(2)=XO(2)+(YS+YL)/2. XO(3)=XO(3)+(ZS+ZL)/2. XL=XL-XS IF(YL-YS.GT.XL) XL=YL-YS IF(ZL-ZS.GT.XL) XL=ZL-ZS DOZ=2.0*XL ZMIN=0.1 ZMAX=4.0*XL FIELD=45. TANAL=0.41421356 WRITE(OUTPUT,139) (XO(I),I=1,3) 139 FORMAT(' ') WRITE(OUTPUT,1 41) DOZ,FIELD,ZMIN,ZMAX 141 FORMAT(' ') GO TO 12 C SPECIFY OUT-OF-PLANE WARPPING SCALE FACTORS 145 IF(CMD.NE.'WARP') GO TO 150 WRITE(OUTPUT,146) 146 FORMAT(' ',$) READ(INPUT,400) FUNX,FUNY,FUNZ GO TO 12 C SELECT FRINGE OPTION AND SPECIFIY FRINGED PARTS 150 IF(CMD.NE.'FRIN') GO TO 160 WRITE(OUTPUT,151) 151 FORMAT(' <# FRINGES> ',$) READ(INPUT,402) NFRING IFRING=NFRING.GT.0 IF(.NOT.IFRIN G) GO TO 12 WRITE(OUTPUT,152) 152 FORMAT(' ',$) READ(INPUT,410) ANS UFRING=ANS.EQ.'Y' IF(.NOT.UFRING) GO TO 154 WRITE(OUTPUT,153) 153 FORMAT(' ',$) READ(INPUT,400) (DRC(I),I=1,3) X1=SQRT(DRC(1)*DRC(1)+DRC(2)*DRC(2)+DRC(3)*DRC(3)) DRC(1)=DRC(1)/X1 DRC(2)=DRC(2)/X1 DRC(3)=DRC(3)/X1 154 X3=NFRING-1 WRITE(OUTPUT,155) 155 FORMAT(' ') 156 READ(INPUT,403) I1,I2,X1,X2 IF(I1.LE .0) GO TO 158 DO 157 I=I1,I2 FRING(1,I)=X3/(X2-X1) 157 FRING(2,I)=X1*FRING(1,I) GO TO 156 158 WRITE(OUTPUT,159) 159 FORMAT(' ') 1501 READ(INPUT,402) I1,I2,I3 IF(I1.LE.0) GO TO 12 DO 1502 I=I1,I2 1502 NFR(I)=I3 GO TO 1501 C SPECIFY COLORS FOR VARIOUS PARTS 160 IF(CMD.NE.'COLO') GO TO 180 WRITE(OUTPUT,162) (WORDS(I,IC),I=1,3) 162 FORMAT(' ',$) READ(INPUT,400) PB1,PB2,PB3 IC1=PB3*63.0  IC2=PB2*63.0 IC3=PB1*63.0 IF(IC.EQ.1) GO TO 163 IC2=IC1 IC3=IC1 163 IPB=IC1*2**12+IC2*2**6+IC3 WRITE(OUTPUT,164) (WORDS(I,IC),I=1,3) 164 FORMAT(' ') 166 READ(INPUT,403) I1,I2,X1,X2,X3 IF(I1.EQ.0) GO TO 169 IC1=X3*63.0 IC2=X2*63.0 IC3=X1*63.0 IF(IC.EQ.1) GO TO 167 IC2=IC1 IC3=IC1 167 ICC=IC1*2**12+IC2*2**6+IC3 DO 168 K=I1,I2 168 ICOL(K)=ICC GO TO 166 169 WRITE(OUTPUT,170) 170 FORMAT(' ',$) READ(INPUT,401) ANS IF(ANS.NE.'Y') GO TO 175 WRITE(OUTPUT,171) 171 FORMAT(' ',$) READ(INPUT,401) ANS IF(ANS.NE.'Y') GO TO 173 CFRIN(1,6)=1. CFRIN(2,6)=1. CFRIN(3,6)=1. DO 172 I=1,5 I1=6-I I2=6+I CFRIN(1,I1)=GFRIN(I) CFRIN(1,I2)=GFRIN(I) CFRIN(2,I1)=BFRIN(I) CFRIN(2,I2)=BFRIN(I) CFRIN(3,I1)=RFRIN(I) 172 CFRIN(3,I2)=RFRIN(I) GO TO 12 173 DO 174 I=1,5 CFR IN(1,I)=GFRIN(I) CFRIN(2,I)=BFRIN(I) 174 CFRIN(3,I)=RFRIN(I) GO TO 12 175 WRITE(OUTPUT,176) (WORDS(I,IC),I=1,3) 176 FORMAT(' ') 177 READ(INPUT,404) I1,X1,X2,X3 IF(I1.EQ.0) GO TO 12 IF(IC.EQ.1) GO TO 178 X2=X1 X3=X1 178 CFRIN(1,I1)=X3 CFRIN(2,I1)=X2 CFRIN(3,I1)=X1 GO TO 177 C MOVIE OPTION--SELECT INCREMENTAL TRANSLATION,ROTATION,ETC. 180 IF(CMD.NE.'MOVI') GO TO 200 WRITE(OUTPUT,181) 181 FORMAT(' <# OF FRAMES>  ',$) READ(INPUT,402) NFRAME IF(NFRAME.EQ.0) GO TO 12 DO 182 J=1,NP DO 182 I=1,3 182 DA(I,J)=0.0 IFR1=1 IFR2=NFRAME WRITE(OUTPUT,183) 183 FORMAT(' ',$) READ(INPUT,402) I1,I2 IF(I1.LE.0) GO TO 184 IFR1=I1 IFR2=I2 IF(IFR2.GT.IFR1) IFR2=IFR1 184 WRITE(OUTPUT,185) 185 FORMAT(' ',$) READ(INPUT,401) ANS LINEAR=ANS.EQ.'Y' CPF=0.0 IF(LINEAR) GO TO 188 IF(SKALE.EQ.0.0) GO TO 188 WRITE(OUTPUT,187) 187 FORMAT(' ',$) READ(INPUT,400) CPF 188 WRITE(OUTPUT,189) 189 FORMAT(' ') WRITE(OUTPUT,190) 190 FORMAT(' ',$) READ(INPUT,400) DT(1),DT(2),DT(3) WRITE(OUTPUT,191) 191 FORMAT(' ',$) READ(INPUT,400) DR(1),DR(2),DR(3) WRITE(OUTPUT,192) 192 FORMAT(' ') 193 READ(INPUT,403) I1,I2,X1,X2,X3 IF(I1.EQ.0) GO TO 195 DO 194 I=I1,I2 DA(1,I)=X1 DA(2,I)=X2 194 DA(3,I)=X3 GO TO 193 195 WRITE(OUTPUT,196) 196 FORMAT(' ',$) READ(INPUT,400) DDOZ WRITE(OUTPUT,197) 197 FORMAT(' ',$) READ(INPUT,400) SFDEL XFRAME=NFRAME SFDEL=SFDEL/XFRAME WRITE(OUTPUT,198) 198 FORMAT(' ',$) READ(INPUT,400) DDELTA WRITE(OUTPUT,199) 199 FORMAT(' ',$) READ(INPUT,401) ANS IPM=ANS.EQ.'Y' GO TO 1 2 C CALCULATE NOMALS, LIGHT INTENSITY, ETC, AND DISPLAY SCENE 200 IF(CMD.NE.'VIEW'.AND.CMD.NE.'DRAW') GO TO 270 IHLR=CMD.EQ.'VIEW' IF(IDVICE.GT.0) IHLR=.TRUE. ISHARE=IDVICE.LT.0 SLINR=0.0 XMAGN=SKALE AMPZ=1.0 XFRAME=NFRAME DO 265 IIMOVE=1,NFRAME IF(NFRAME.EQ.0) GO TO 203 C INCREMENT DISPLACEMENTS, ROTATIONS, TRANSLATIONS, ETC. FOR MOVIE XIMOVE=IIMOVE XMAGN=XMAGN+SFDEL SKALE=XMAGN IF(LINEAR) SLINR=XIMOVE/XFRAME  IF(LINEAR) SKALE=XMAGN*SLINR IF(CPF.EQ.0.0) GO TO 201 ANG=360.0*CPF*XIMOVE SKALE=XMAGN*SIND(ANG) 201 AMP=180.0*XIMOVE/XFRAME AMP=COSD(AMP) DAMP=0.5*(AMPZ-AMP) AMPZ=AMP DOZ=DOZ+DDOZ*DAMP DELTA=DELTA+DDELTA*DAMP DO 202 I=1,3 ISAFE=I XO(I)=XO(I)+DT(I)*DAMP DDD=DR(I)*DAMP IF(DDD.NE.0.0) CALL ROTAT(DC,ISAFE,DDD,1) DO 202 J=1,NP JSAFE=J DDD=DA(I,J)*DAMP 202 IF(DDD.NE.0.0) CALL ROTAT(DD,ISAFE,DDD,JSAFE) IF(.NOT.IPM) GO TO 265 IF(IIMOVE.LT.IFR1.OR.IIMOVE.GT.IFR2) GO TO 265 C PROCESS PARTS INDIVIDUALY 203 CALL BGNFRM IF(IHLR) CALL INTHID IF(IBAD) GO TO 266 DO 240 I=1,NP ISAFE=I IF(NPLS(I).EQ.0) GO TO 240 I1=NPL(1,I) I2=NPL(2,I) C SET JFRING FOR FRINGES AND INCREMENT GLOBAL TRANSLATION JFRING=IFRING.AND.(NFR(I).EQ.1) XX1=XO(1)-DELTA*XX(1,I) XX2=XO(2)-DELTA*XX(2,I) XX3=XO(3)-DELTA*XX(3,I) IF(ISMOTH.GE.0.OR.IDVICE.LT.0 ) GO TO 220 C IF SMOOTH SHADING FIRST ZERO AND THEN CALCULATE AVERAGE NORMALS DO 204 K=1,NJ DO 204 J=1,3 204 XNORM(J,K)=0.0 DO 210 J=I1,I2 K4=3 IF(IP(4,J).GT.0) K4=4 DO 210 K=1,K4 K1=IP(K,J) IF((K+1)-K4) 205,206,207 205 K2=IP(K+1,J) K3=IP(K+2,J) GO TO 208 206 K2=IP(K4,J) K3=IP(1,J) GO TO 208 207 K2=IP(1,J) K3=IP(2,J) 208 X4=SPEC(K3)-SPEC(K2)+SLINR*(SPEC1(K3)-SPEC1(K2)) X5=SPEC(K1)-SPEC(K2)+SLINR*(SPEC1(K1) -SPEC1(K2)) X1=X(1,K3)-X(1,K2)+SKALE*(U(1,K3)-U(1,K2))+FUNX*X4 Y1=X(2,K3)-X(2,K2)+SKALE*(U(2,K3)-U(2,K2))+FUNY*X4 Z1=X(3,K3)-X(3,K2)+SKALE*(U(3,K3)-U(3,K2))+FUNZ*X4 X2=X(1,K1)-X(1,K2)+SKALE*(U(1,K1)-U(1,K2))+FUNX*X5 Y2=X(2,K1)-X(2,K2)+SKALE*(U(2,K1)-U(2,K2))+FUNY*X5 Z2=X(3,K1)-X(3,K2)+SKALE*(U(3,K1)-U(3,K2))+FUNZ*X5 CALL MULTDD(X1,Y1,Z1,DD,RORG,ISAFE) CALL MULTDC(X1,Y1,Z1,DC) CALL MULTDD(X2,Y2,Z2,DD,RORG,ISAFE) CALL MULTDC(X2,Y2,Z2,DC) U1=Y 1*Z2-Y2*Z1 U2=X2*Z1-X1*Z2 U3=X1*Y2-X2*Y1 U4=SQRT(U1*U1+U2*U2+U3*U3) IF(.NOT.IMIX) GO TO 209 X1=U1*XNORM(1,K2)+U2*XNORM(2,K2)+U3*XNORM(3,K2) IF(X1.LT.0.0) U4=-U4 209 XNORM(1,K2)=XNORM(1,K2)+U1/U4 XNORM(2,K2)=XNORM(2,K2)+U2/U4 XNORM(3,K2)=XNORM(3,K2)+U3/U4 210 CONTINUE C NORMALIZE AVERAGE NORMALS DO 215 J=1,NJ X1=XNORM(1,J)*XNORM(1,J)+XNORM(2,J)*XNORM(2,J)+ 1 XNORM(3,J)*XNORM(3,J) IF(X1.LE.0.0) GO TO 215 X1=SQRT(X1)  XNORM(1,J)=XNORM(1,J)/X1 XNORM(2,J)=XNORM(2,J)/X1 XNORM(3,J)=-XNORM(3,J)/X1 215 CONTINUE C CALCULATE DISPLACED COORDINATES 220 DO 230 J=I1,I2 K1=IP(1,J) K2=IP(2,J) K3=IP(3,J) K4=IP(4,J) IS1=K1 IS2=K2 IS3=K3 IS4=K4 C1=SPEC(K1)+SLINR*SPEC1(K1) U1=X(1,K1)+FUNX*C1+SKALE*U(1,K1)-XX1 V1=X(2,K1)+FUNY*C1+SKALE*U(2,K1)-XX2 W1=X(3,K1)+FUNZ*C1+SKALE*U(3,K1)-XX3 CALL MULTDD(U1,V1,W1,DD,RORG,ISAFE) CALL MULTDC( U1,V1,W1,DC) W1=DOZ-W1 C2=SPEC(K2)+SLINR*SPEC1(K2) U2=X(1,K2)+FUNX*C2+SKALE*U(1,K2)-XX1 V2=X(2,K2)+FUNY*C2+SKALE*U(2,K2)-XX2 W2=X(3,K2)+FUNZ*C2+SKALE*U(3,K2)-XX3 CALL MULTDD(U2,V2,W2,DD,RORG,ISAFE) CALL MULTDC(U2,V2,W2,DC) W2=DOZ-W2 C3=SPEC(K3)+SLINR*SPEC1(K3) U3=X(1,K3)+FUNX*C3+SKALE*U(1,K3)-XX1 V3=X(2,K3)+FUNY*C3+SKALE*U(2,K3)-XX2 W3=X(3,K3)+FUNZ*C3+SKALE*U(3,K3)-XX3 CALL MULTDD(U3,V3,W3,DD,RORG,ISAFE) CALL MULTDC(U3,V3, W3,DC) W3=DOZ-W3 IF(K4.NE.0) GO TO 221 U4=0.5*(U1+U3) V4=0.5*(V1+V3) W4=0.5*(W1+W3) GO TO 222 221 C4=SPEC(K4)+SLINR*SPEC1(K4) U4=X(1,K4)+FUNX*C4+SKALE*U(1,K4)-XX1 V4=X(2,K4)+FUNY*C4+SKALE*U(2,K4)-XX2 W4=X(3,K4)+FUNZ*C4+SKALE*U(3,K4)-XX3 CALL MULTDD(U4,V4,W4,DD,RORG,ISAFE) CALL MULTDC(U4,V4,W4,DC) W4=DOZ-W4 C CALCULATE NUMBER OF VISIBLE NODES 222 NCNT=IVSBLE(U1,V1,W1,U2,V2,W2,U3,V3,W3,U4,V4,W4,DIRC) IF(IPOOR.AND.NCNT.EQ .0) GO TO 230 C DRAW SIMPLE LINE DRAWING NOW IF(IHLR) GO TO 224 CALL DRAW(U1,V1,W1,U2,V2,W2,RES,TANAL) CALL DRAW(U2,V2,W2,U3,V3,W3,RES,TANAL) IF(K4.EQ.0) GO TO 223 CALL DRAW(U3,V3,W3,U4,V4,W4,RES,TANAL) CALL DRAW(U4,V4,W4,U1,V1,W1,RES,TANAL) GO TO 230 223 CALL DRAW(U3,V3,W3,U1,V1,W1,RES,TANAL) GO TO 230 C CALCULATE NORMALS FOR FLAT SHADING 224 IF(ISMOTH.LT.0) GO TO 225 CX=(V3-V1)*(W2-W4)-(V4-V2)*(W1-W3) CY=(U4-U2)*(W1-W3)-(U3-U1)* (W2-W4) CZ=(U4-U2)*(V3-V1)-(U3-U1)*(V4-V2) CD=SQRT(CX*CX+CY*CY+CZ*CZ) XNORM(1,K1)=CX/CD XNORM(2,K1)=CY/CD XNORM(3,K1)=CZ/CD K2=K1 K3=K1 K4=K1 C CALCULATE NODAL LIGHT INTENSITY C THEN CHECK FOR WATKIN'S WARPED POLYGON 225 AI1=AINTEN(U1,V1,W1,XNORM(1,K1),DIF(I)) AI2=AINTEN(U2,V2,W2,XNORM(1,K2),DIF(I)) AI3=AINTEN(U3,V3,W3,XNORM(1,K3),DIF(I)) IF(IS4.NE.0) AI4=AINTEN(U4,V4,W4,XNORM(1,K4),DIF(I)) IF(ISMOTH.LE.0) GO TO 2201  AI1=(AI1+AI2+AI3+AI4)/4.0 IF(IS4.EQ.0) AI1=(AI1+AI2+AI3)/3.0 AI2=AI1 AI3=AI1 AI4=AI1 2201 IF(IS4.EQ.0) GO TO 226 IF(NCNT.EQ.0.OR.NCNT.EQ.4) GO TO 226 CALL POLMAK IF(IBAD) GO TO 266 LAS=.FALSE. XB=U3 YB=V3 ZB=W3*TANAL IF(CONTRS) CB=C3 KB=ICOL(I) IF(JFRING) KB=ISHADE(U(1,IS3),C3,ISAFE) BINT=AI3 ZSTR=ZB KSTR=KB XE=U4 YE=V4 ZB=W4*TANAL IF(CONTRS) CE=C4 KE=ICOL(I) IF(JFRIN G) KE=ISHADE(U(1,IS4),C4,ISAFE) EINT=AI4 CALL EDGMAK IF(IBAD) GO TO 266 XB=XE YB=YE ZB=ZE IF(CONTRS) CB=CE KB=KE BINT=EINT XE=U1 YE=V1 ZE=W1*TANAL IF(CONTRS) CE=C1 KE=ICOL(I) IF(JFRING) KE=ISHADE(U(1,IS1),C1,ISAFE) EINT=AI1 CALL EDGMAK IF(IBAD) GO TO 266 XB=XE YB=YE ZB=ZE IF(CONTRS) CB=CE KB=KE BINT=EINT XE=U3 YE=V3 ZE=ZSTR IF(CONTRS) CE=C 3 KB=KSTR EINT=AI3 LAS=.TRUE. CALL EDGMAK IF(IBAD) GO TO 266 226 CALL POLMAK IF(IBAD) GO TO 266 LAS=.FALSE. XB=U1 YB=V1 ZB=W1*TANAL IF(CONTRS) CB=C1 KB=ICOL(I) IF(JFRING) KB=ISHADE(U(1,IS1),C1,ISAFE) BINT=AI1 ZSTR=ZB KSTR=KB XE=U2 YE=V2 ZE=W2*TANAL IF(CONTRS) CE=C2 KE=ICOL(I) IF(JFRING) KE=ISHADE(U(1,IS2),C2,ISAFE) EINT=AI2 CALL EDGMAK IF(IBAD) GO TO 266  XB=XE YB=YE ZB=ZE IF(CONTRS) CB=CE KB=KE BINT=EINT XE=U3 YE=V3 ZE=W3*TANAL IF(CONTRS) CE=C3 KE=ICOL(I) IF(JFRING) KE=ISHADE(U(1,IS3),C3,ISAFE) EINT=AI3 CALL EDGMAK IF(IBAD) GO TO 266 IF(IS4.EQ.0) GO TO 229 IF(NCNT.GT.0.AND.NCNT.LT.4) GO TO 229 XB=XE YB=YE ZB=ZE IF(CONTRS) CB=CE KB=KE BINT=EINT XE=U4 YE=V4 ZE=W4*TANAL IF(CONTRS) CE=C4 KE=ICOL (I) IF(JFRING) KE=ISHADE(U(1,IS4),C4,ISAFE) EINT=AI4 CALL EDGMAK IF(IBAD) GO TO 266 229 XB=XE YB=YE ZB=ZE IF(CONTRS) CB=CE KB=KE BINT=EINT XE=U1 YE=V1 ZE=ZSTR IF(CONTRS) CE=C1 KE=KSTR EINT=AI1 LAS=.TRUE. CALL EDGMAK IF(IBAD) GO TO 266 230 CONTINUE 240 CONTINUE IF(IHLR) CALL HIDDEN IF(IBAD) GO TO 266 CALL ENDFRM IF(IIMOVE.GT.1) GO TO 260 IF(IDVICE.GT.0) GO TO 250  IF(IDVICE.EQ.-1) WRITE(OUTPUT,242) 242 FORMAT(' ') IF(IDVICE.EQ.-2) WRITE(OUTPUT,244) 244 FORMAT(' ') IF(IDVICE.EQ.-3) WRITE(OUTPUT,246) 246 FORMAT(' ') GO TO 255 250 IF(IC.EQ.1) WRITE(OUTPUT,252) 252 FORMAT(' ') IF(IC.EQ.2) WRITE(OUTPUT,254) 254 FORMAT(' ') 255 IF(IFRING.AND.IHLR) WRITE(OUTPUT,256) 256 FORMAT(' ') IF(CONTRS.AND.IHLR) WRITE(OUTPUT,258) 258 FORM AT(' ') IF(NFRAME.LT.1) GO TO 265 260 IF(IDVICE.NE.-1) GO TO 263 WRITE(OUTPUT,261) IIMOVE,NFRAME,SKALE 261 FORMAT(' <',I3,'/',I3,F8.3,'>',$) READ(INPUT,401) ANS GO TO 265 263 WRITE(OUTPUT,264) IIMOVE,NFRAME,SKALE 264 FORMAT(' <',I3,'/',I3,F8.3,'>') 265 CONTINUE NFRAME=0 SKALE=XMAGN LINEAR=.FALSE. GO TO 12 266 CALL ENDFRM WRITE(OUTPUT,268) 268 FORMAT(' ') NFRAME=0 SKALE=XMAGN LINEAR=.FALSE.  GO TO 10 C SET DATA OPTIONS AND POOR MAN'S HIDDEN SURFACE REMOVAL 270 IF(CMD.NE.'FAST') GO TO 290 271 ICODE=ICODE-1 IPOOR=.FALSE. WRITE(OUTPUT,272) 272 FORMAT(' ',$) READ(INPUT,401) ANS IMIX=ANS.EQ.'Y' IF(IMIX) GO TO 12 WRITE(OUTPUT,274) 274 FORMAT(' ',$) READ(INPUT,401) ANS IPOOR=ANS.EQ.'Y' IF(.NOT.IPOOR) GO TO 12 WRITE(OUTPUT,276) 276 FORMAT(' ',$) READ(INPUT,401) ANS DIRC=ANS.EQ.'Y' GO TO 12 C SET LOCAL ROTATION ABOUT RELATIVE ORIGIN 290 IF(CMD.NE.'PIVO') GO TO 310 WRITE(OUTPUT,291) 291 FORMAT(' ') 292 READ(INPUT,293) I1,I2,X1,X2 293 FORMAT(2I,1X,A1,E) IF(I1.EQ.0) GO TO 296 IF(X1.EQ.'X') I3=1 IF(X1.EQ.'Y') I3=2 IF(X1.EQ.'Z') I3=3 DO 295 I=I1,I2 ISAFE=I 295 CALL ROTAT(DD,I3,X2,ISAFE) GO TO 292 296 WRITE(OUTPUT,297) 297 FORMAT(' ') 298 READ(INPU T,403) I1,I2,X1,X2,X3 IF(I1.EQ.0) GO TO 12 DO 299 I=I1,I2 RORG(1,I)=X1 RORG(2,I)=X2 299 RORG(3,I)=X3 GO TO 298 C COMMANDS 310 IF(CMD.NE.'HELP') GO TO 320 311 WRITE(OUTPUT,312) 312 FORMAT(' '/' '/' ',/) GO TO 12 314 WRITE(OUTPUT,316) CMD 316 FORMAT(' <',A4,'? HELP?> ',$) READ(INPUT,401) ANS IF(ANS.EQ.'Y') GO TO 311 GO TO 12 C ADD PREVIOUS DISPLACEMENTS AND SCALAR FUNCTIONS TO ARRAYS, C READ NEW ARRAYS, AND DIFFERENCE FOR TRANSIENT DATA 320 IF(CMD.NE.'LINE') GO TO 360 WRITE(OUTPUT,322) 322 FORMAT(' ',$) READ(INPUT,401) ANS IF(ANS.NE.'Y') GO TO 326 DO 324 J=1,NJ DO 323 I=1,3 X(I,J)=X(I,J)+SKALE*U(I,J) 323 U(I,J)=0. SPEC(J)=SPEC(J)+SPEC1(J) 324  SPEC1(J)=0. 326 CALL OPEN('DISP1',IUNIT,IREAD,IERROR) IF(IERROR) 326,330,328 328 READ(IUNIT,410) ((U(I,J),I=1,3),J=1,NJ) 330 CALL OPEN('DISP2',IUNIT,IREAD,IERROR) IF(IERROR) 330,340,332 332 READ(IUNIT,410) ((XNORM(I,J),I=1,3),J=1,NJ) 340 CALL OPEN('SPEC.',IUNIT,IREAD,IERROR) IF(IERROR) 340,344,342 342 READ(IUNIT,410) (SPEC1(J),J=1,NJ) 344 CALL OPEN('SPEC1',IUNIT,IREAD,IERROR) IF(IERROR) 344,350,346 346 READ(IUNIT,410) (SPEC(J),J=1,NJ) 350 DO 354 J=1,NJ DO 3 52 I=1,3 352 U(I,J)=XNORM(I,J)-U(I,J) 354 SPEC1(J)=SPEC(J)-SPEC1(J) GO TO 12 C SELECT CONTOUR OPTION AND SET CONTOUR LEVELS 360 IF(CMD.NE.'CONT') GO TO 314 WRITE(OUTPUT,361) 361 FORMAT(' <# OF CONTOURS, LABEL SPACING> ',$) READ(INPUT,403) NCONLV,LBLSPC CONTRS=NCONLV.GT.0 IF(.NOT.CONTRS) GO TO 12 IF(NCONLV.GT.26) NCONLV=26 WRITE(OUTPUT,363) 363 FORMAT(' ',$) READ(INPUT,400) CONLO,CONHI DELCON=(CONHI-CONLO)/(NCONLV-1)  CLEVEL(1)=CONLO DO 365 I=2,NCONLV 365 CLEVEL(I)=CLEVEL(I-1)+DELCON GO TO 12 400 FORMAT(3E) 401 FORMAT(A1) 402 FORMAT(16I) 403 FORMAT(2I,3E) 404 FORMAT(I,3E) 410 FORMAT(6E) END  SUBROUTINE MULTDD(X,Y,Z,DD,T,K) C SUBROUTINE MULTDD - MULTIPLYS COORDINATES BY LOCAL ROTATION C TRANSFORMATION MATRIX. C VARIABLES USED C X, Y, Z = CARTESIAN COORDINATES OF POINT C DD = TRANSFORMATION MATRIX C T = RELATIVE ORIGIN BY PART C I = PART NUMBER DIMENSION DD(3,3,1),T(3,1) X1=X-T(1,K) X2=Y-T(2,K) X3=Z-T(3,K) X=DD(1,1,K)*X1+DD(2,1,K)*X2+DD(3,1,K)*X3+T(1,K) Y=DD(1,2,K)*X1+DD(2,2,K)*X2+DD(3,2,K)*X3+T(2,K) Z=DD(1,3,K)*X1+DD(2,3 ,K)*X2+DD(3,3,K)*X3+T(3,K) RETURN END  FUNCTION AINTEN(U,V,W,XNORM,DIF) C FUNCTION AINTEN - CALCULATES LIGHT INTENSITY AT A NODE. C LIGHT INTENSITY IS COMPUTED AS THE SEQUARE OF THE ANGLE C BETWEEN THE OBSERVER AND THE NORMAL DIRECTION AT A NODE. C VARIABLES USED C U, V, W, = CARTESIAN COORDINATES OF POINT C XNORM = NORMAL COMPONENTS AT NODE C DIF = DIFUSED LIGHT DIMENSION XNORM(3) AI=U*XNORM(1)+V*XNORM(2)+W*XNORM(3) AI=AI*AI/(U*U+V*V+W*W) AINTEN=(DIF+(1.0-DIF)*AI) RETURN END  FUNCTION IVSBLE(U1,V1,W1,U2,V2,W2,U3,V3,W3,U4,V4,W4,DIRC) C FUNCTION IVSBLE - COMPUTES NUMBER OF VISIBLE NODES. C A NODE IS VISIBLE IF THE COSINE OF THE ANGLE BETWEEN C THE OBSERVER AND THE NORMAL AT THE NODE IS POSITIVE. C VARIABLES USED C IVSBLE = NUMBER OF VISIBLE NODES C U1, V1, W1, ETC. = CARTESTIAN COORDINATES OF NODES C DIRC = -1 FOR CLOCKWISE ORIENTATION OF NODES C = 0 FOR COUNTER-CLOCKWISE ORIENTATION OF NODES IVSBLE=0 X1=U1/W1 Y1=V1/W1  X2=U2/W2 Y2=V2/W2 X3=U3/W3 Y3=V3/W3 X4=U4/W4 Y4=V4/W4 XT=X1 YT=Y1 X5=X2-X4 X1=X1-X2 X2=X2-X3 X3=X3-X4 X4=X4-XT Y5=Y2-Y4 Y1=Y1-Y2 Y2=Y2-Y3 Y3=Y3-Y4 Y4=Y4-YT A1=X1*Y2-X2*Y1 A2=X2*Y3-X3*Y2 A3=X5*Y4-X4*Y5 A4=X4*Y1-X1*Y4 IF(A1.GE.0.0) IVSBLE=IVSBLE+1 IF(A2.GE.0.0) IVSBLE=IVSBLE+1 IF(A3.GE.0.0) IVSBLE=IVSBLE+1 IF(A4.GE.0.0) IVSBLE=IVSBLE+1 IF(DIRC) IVSBLE=4-IVSBLE RETURN END  SUBROUTINE MULTDC(U1,V1,W1,DC) C SUBROUTINE MULTDC - MULTYPLS COORDINATES BY GLOBAL ROTATION C TRANSFORMATION MATRIX. C VARIABLES USED C U1, V1, W1 = CARTESTIAN COORDINATES OF POINT C DC = GLOBAL TRANSFORMATION MATRIX DIMENSION DC(3,3) X1=U1 X2=V1 U1=DC(1,1)*X1+DC(2,1)*X2+DC(3,1)*W1 V1=DC(1,2)*X1+DC(2,2)*X2+DC(3,2)*W1 W1=DC(1,3)*X1+DC(2,3)*X2+DC(3,3)*W1 RETURN END  FUNCTION ISHADE(U,S,J) C FUNCTION SHADE - COMPUTES COLOR INTENSITY AT NODES FOR FRINGES C VARIABLES USED C SHADE = FRINGE LIGHT INTENSITY C K = NODE NUMBER C S = SCALAR FUNCTION ARRAY C F = FRINGE COLOR INTENSITY ARRAY BY FRINGE NUMBER C IMODE = 1 FOR RED, 2 FOR BLUE, 3 FOR GREEN C NFRING = # OF FRINGES C FRING3 = FRINGE NORALIZATION FACTOR C FRING4 = LOWEST NORMALIZED FRINGE VALUE DIMENSION U(3) COMMON/VARB/ UFRING,DR(3),FRING(2,1) COMMON/VCOL/ NFRING,F(3,1) LOGICAL UFRING X=S IF(UFRING) X=U(1)*DR(1)+U(2)*DR(2)+U(3)*DR(3) X=FRING(1,J)*X-FRING(2,J) IF(X.LT.0.0) GO TO 3 N=NFRING-1 DO 2 I=1,N IF(X.GT.1.0) GO TO 2 X1=1.0-X I1=I+1 IC1=(F(1,I1)*X+F(1,I)*X1)*63.0 IC2=(F(2,I1)*X+F(2,I)*X1)*63.0 IC3=(F(3,I1)*X+F(3,I)*X1)*63.0 GO TO 4 2 X=X-1.0 IC1=F(1,NFRING)*63.0 IC2=F(2,NFRING)*63.0 IC3=F(3,NFRING)*63.0 GO TO 4 3 IC1=F(1,1)*63.0 IC2=F(2,1)*63.0 IC3=F(3,1)*63.0 4 ISHADE=IC1*2**12+IC2*2**6+IC3 RETURN END  SUBROUTINE DRAW(X1,Y1,Z1,X2,Y2,Z2,RES,PER) R=0.5*RES D=R/(Z1*PER) U1=R+X1*D V1=R+Y1*D D=R/(Z2*PER) U2=R+X2*D V2=R+Y2*D C CLIP LEFT EDGE IF(U1.GE.0..AND.U2.GE.0.) GO TO 10 IF(U1.LT.0..AND.U2.LT.0.) RETURN IF(U1.GT.0.) GO TO 1 V1=(V1-V2)*U1/(U2-U1)+V1 U1=0. GO TO 10 1 V2=(V2-V1)*U2/(U1-U2)+V2 U2=0. C CLIP RIGHT EDGE 10 IF(U1.LE.RES.AND.U2.LE.RES) GO TO 20 IF(U1.GT.RES.AND.U2.GT.RES) RETURN  IF(U1.GT.RES) GO TO 11 V2=(V2-V1)*(RES-U1)/(U2-U1)+V1 U2=RES GO TO 20 11 V1=(V1-V2)*(RES-U2)/(U1-U2)+V2 U1=RES C CLIP BOTTOM EDGE 20 IF(V1.GE.0..AND.V2.GE.0.) GO TO 30 IF(V1.LT.0..AND.V2.LT.0.) RETURN IF(V1.GT.0.) GO TO 21 U1=(U1-U2)*V1/(V2-V1)+U1 V1=0. GO TO 30 21 U2=(U2-U1)*V2/(V1-V2)+U2 V2=0. C CLIP TOP EDGE 30 IF(V1.LE.RES.AND.V2.LE.RES) GO TO 40 IF(V1.GT.RES.AND.V2.GT.RES) RETURN IF(V1.GT.RES) GO TO 31  U2=(U2-U1)*(RES-V1)/(V2-V1)+U1 V2=RES GO TO 40 31 U1=(U1-U2)*(RES-V2)/(V1-V2)+U2 V1=RES 40 CALL PLTLIN(U1,V1,U2,V2) RETURN END  SUBROUTINE INTHID C INTHID INITIALIZES THE HIDDEN PROCESS C AND ALLOCATES THE AMOUNT OF DATA STORAGE C THE VALUE OF MAXFRE MUST EQUAL THE SIZE OF IFREE C THE VALUE OF MAXRES MUST EQUAL THE SIZE OF IB C THE VALUE OF MAXINT IS THE MAXIMUM INTENSITY COMMON/MAXMUM/MAXFRE,MAXRES,MAXINT COMMON/CORE/IFREST,LEN,IFREPT COMMON/BUCKY/IB(512) COMMON/FREE/IFREE(4000) MAXFRE=4000 MAXRES=512 MAXINT=63 C INITIALIZE FREE STORAGE LEN = MAXFRE IFREST=1 C INITIALIZE THE POLYGON CLIPPER CALL INTCLP RETURN END C**********************************************************************C C C C HIDDEN.FOR VERSION 1.0(A) SEPTEMBER 1976 C C C C THIS FILE CONTAINS THE HIDDEN LINE AND HIDDEN SURFACE C C PROCESSOR USING WATKIN'S ALGORITHM. MIKE ARCHULETA C C CODED THE ALGORITHM WHILE A STUDENT AT THE UNIVERSITY OF C C OF UTAH AND LATER REFINED IT AT LAWRENCE LIVERMORE LAB. C C C C MIKE STEPHENSON HANK CHRISTIANSEN C C DEPARTMENT OF CIVIL ENGR. CIVIL ENGINEERING DEPT. C C AND ENGINEERING MECHANICS 368E ESTB C C THE UNIVERSITY OF ARIZONA BRIGHAM YOUNG UNIVERSITY C C TUCSON, ARIZONA 85721 PROVO, UTAH 84602 C C (602) 884-4803 (801) 374-1211 X2811 C C C C**********************************************************************C SUBROUTINE GETVAR(INDEX,LENGTH) C GET A BLOCK FROM FREE STORAGE OF SIZE LENGTH AT LOCATION INDEX COMMON/CORE/IFREST,LEN,IFREPT C COMMON/FREE/IFREE(1) COMMON/QFORIO/CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC LOGICAL IBAD IBAD=.FALSE. INDEX=IFREST C UP THE NEXT AVAILABLE LOCATION IN FREE. IFREST=IFREST+LENGTH C GO HOME IF THERE IS STILL ROOM LEFT. IF(IFREST.LT.LEN)RETURN CALL ERRMSG(6,0) RETURN END  SUBROUTINE LSTSET(N) C SET THE SIZE OF THE BLOCK TO BE HANDLED BY GETBLK AND RETBLK COMMON/CORE/IFREST,LEN,IFREPT COMMON/FREE/IFREE(1) IFREPT=0 K=LEN-N+1 C RETURN IF NO ROOM LEFT FOR SEGMENT BLOCKS IF(K.LT.IFREST)RETURN IFREPT=IFREST C SET POINTERS THROUGH THE REMAINDER OF THE FREE LIST C LINKING THE SEGMENT BLOCKS TOGETHER. DO 1 I=IFREST,K,N M=I IFREE(I)=0 1 IFREE(I+1)=I+N C SET THE LAST POINTER TO ZERO INDICATING END OF SEGMENTS. IFREE(M+1)=0 RETURN END  SUBROUTINE GETBLK(INDEX) C GET A BLOCK FROM THE FREE STORAGE LIST COMMON/CORE/IFREST,LEN,IFREPT COMMON/FREE/IFREE(1) COMMON/QFORIO/CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC LOGICAL IBAD IBAD=.FALSE. IF(IFREPT.EQ.0)GO TO 1 C RETURN THE POINTER TO NEXT AVAILABLE SEGMENT BLOCK INDEX=IFREPT IFREPT=IFREE(IFREPT+1) RETURN 1 CALL ERRMSG(6,0) RETURN END  SUBROUTINE RETBLK(INDEX) C RETURN A BLOCK TO THE FREE STORAGE LIST COMMON/CORE/IFREST,LEN,IFREPT COMMON/FREE/IFREE(1) IFREE(INDEX)=0 IFREE(INDEX+1)=IFREPT IFREPT=INDEX RETURN END  SUBROUTINE INTCLP C THIS ROUTINE INITIALIZES SOME SIMPLE PARAMETERS THAT C ARE USED BY THE ALGORITHM. IT SHOULD BE CALLED ONCE AT C THE BEGINNING OF EACH PICTURE TAKING SESSION. COMMON/PGNCNT/IPOLY COMMON/BUCKY/IBUCKY(1) COMMON/EYES/XR,YR,IXRES,IYRES,DELINT,DELCON,IFLRCO,ICLGCO COMMON/INTENS/ITENHI,ITENLO,IBACKG,IFX1,IFY1 COMMON/CONLEV/CONHI,CONLOW,NCONLV,CLEVEL(1) COMMON/QFORIO/CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC COMMON/MAXMUM/MAXFRE,MAXRES,MAXINT COMMON/ZRANGE/ZMIN,ZMAX COMMON/ZFIXER/ZLOW,ZHI,ZSPRED,CURZEE COMMON/CORE/IFREST,LEN,IFREPT LOGICAL IBAD,CURZEE IBAD=.FALSE. CURZEE=.FALSE. IFREST=1 C JUMP TO 2 IF BAD RESOLUTION AND TO 3 IF BAD INTENSITY IF(IFX1.GT.MAXRES.OR.IFX1.LT.2) GO TO 2 IF(IFY1.GT.MAXRES.OR.IFY1.LT.2) GO TO 2 IF(ITENHI.GT.MAXINT.OR.ITENHI.LT.0) GO TO 3 IF(ITENLO.GT.MAXINT.OR.ITENLO.LT.0) GO TO 3 C THE INTENSITY IS ALSO BAD IF ITENHI IS LESS THAN ITENLO IF(ITENHI.LT.ITENLO) GO TO 3 C MAKE SURE THAT ZMIN AND ZMAX ARE GOOD GUYS ZLOW=ZMIN IF(ZLOW.LT.0) ZLOW=0. IF(ZMAX.LT.ZLOW) GO TO 4 ZHI=ZMAX ZSPRED=32767./(ZMAX-ZLOW) C CLEAR OUT THE BUCKET SORTING ARRAYS IPOLY=0 DO 1 I=1,IFY1 1 IBUCKY(I)=0 IXRES=IFX1-1 IYRES=IFY1 XR=IXRES/2. YR=(IFY1-1)/2. DELINT=ITENHI-ITENLO C DONT LET THE RANGE OF CONTOUR LEVELS EQUAL 0 IF(NCONLV.LE.0) NCONLV=1 DELCON=(CLEVEL(NCONLV)-CLEVEL(1))/31. IF(DELCON.EQ.0.0) DELCON=1. C FIND THE INDICES OF THE FLOOR AND CEILING FOR CONTOUR PLOTTING IFLRCO=1 DO 5 I=1,NCONLV J=I IF(CONLOW.GE.CLEVEL(I)) IFLRCO=I IF(CONHI.LE.CLEVEL(I)) GO TO 6 5 CONTINUE 6 ICLGCO=J RETURN C BAD RESOLUTION 2 CALL ERRMSG(7,0) RETURN C BAD INTENSITY 3 CALL ERRMSG(8,0) RETURN 4 CALL ERRMSG(11,0) RETURN END  SUBROUTINE POLMAK C POLMAK SHOULD BE CALLED ONCE AT THE BEGINNING OF EACH C POLYGON IN THE PICTURE. COMMON/PGNCNT/IPOLY COMMON/COMNIO/ICNT,IDUM(121) IPOLY=IPOLY+1 IF(IPOLY.EQ.8192) CALL ERRMSG(2,0) ICNT=0 RETURN END  SUBROUTINE EDGMAK C EDGMAK CAPTURES THE EDGES AND PUTS THEM INTO A STACK C FOR LATER PROCESSING BY POLSNP (WHICH DOES THE ACTUAL C CLIPPING). DATA COES IN THRU CLIP3 AND IS STORED IN COMNIO. COMMON/PGNCNT/IPOLY COMMON/CLIP3/X1,Y1,Z1,S1,K1,C1,X2,Y2,Z2,S2,K2,C2,LASEDG,ISHARE,NTR COMMON/QFORIO/CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC COMMON/COMNIO/ICNT,NT,VX(10),VY(10),VZ(10),VN(10),IC(10),VC(10) C 1 ,VTX(10),VTY(10),VTZ(10),VTN(10),VTC(10),ITC(10) LOGICAL LASEDG,IBAD,ISHARE IF(IBAD) GO TO 2 NT=NTR C JUMP IF EDGE STACK WILL OVERFLOW IF(ICNT.GE. 9) GO TO 1 C SET 18TH BIT IF EDGE IS SHARED AND SET 19TH BIT FOR EDGE IS C VISIBLE FLAG I=524288 IF(ISHARE) I=786432 C PUT BEGIN POINT INTO EDGE STACK ICNT=ICNT+1 VX(ICNT)=X1 VY(ICNT)=Y1 VZ(ICNT)=Z1 VN(ICNT)=S1 IC(ICNT)=I+MOD(K1,262144) VC(ICNT)=C1 C PUT END POINT INTO EDGE STACK ICNT=ICNT+1 VX(ICNT)=X2 VY(ICNT)=Y2 VZ(ICNT)=Z2 VN(ICNT)=S2 IC(ICNT)=I+MOD(K2,262144) VC(ICNT)=C2 C FLUSH THE EDGE STACK IF THIS WAS THE LAST EDGE IF(LASEDG) CALL POLSNP RETURN 1 CALL ERRMSG(12,IPOLY) RETURN 2 CALL ERRMSG(9,0) RETURN END  SUBROUTINE POLSNP C THIS SUBROUTINE DOES THE POLYGON CLIPPING. IT FIRST CLIPS C ALL THE EDGES OF THE POLYGON TO A PLANE AND THEN SHIPS THAT C SET OF LINES TO THE NEXT PLANE TO BE CLIPPED. LINES WHICH C ARE OUTSIDE OF THE PLANE BEING CLIPPED TO ARE NOT PASSED THRU C THE PIPE SINCE THEY DO NOT HAVE AN EFFECT ON HOW TO CLOSE THE POLYGON C UP. THIS ROUTINE CLIPS TO SIX PLANES, PERFORMS THE PERSPECTIVE C TRANSFORMATION, AND PASSES THE DATA TO PACKER OR HORZED. COMMON/COMNIO/ICNT,NT,VX(10),VY(10),VZ(10),VN(10),IC(10),VC(10) C 1 ,VTX(10),VTY(10),VTZ(10),VTN(10),VTC(10),ITC(10) COMMON/EDGARG/IY,IX1,IX2,IZ1,IZ2,IS1,IS2,IPG,IDY,KOL1 ,ISHR, &IC1,IC2,KOL2 COMMON/EYES/XR,YR,IXRES,IYRES,DELINT,DELCON,IFLRCO,ICLGCO COMMON/CONLEV/CONHI,CONLOW,NCONLV,CLEVEL(1) COMMON/PGNCNT/IPOLY COMMON/QFORIO/CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC COMMON/SNPDAT/T1,T2,IDS COMMON/ZFIXER/ZMIN,ZMAX,ZSPRED,CURZEE LOGICAL IBAD,ISHR,CURZEE,NT IF(IBAD) GO TO 11 C JUMP IF CURRENT POLYGON IS THE ZMIN CLIPPED IF(CURZEE) GO TO 30 C CLIP TO THE PLANE Z=ZMIN J=ICNT DO 1 I=1,J,2 IDS=I T1=VZ(I)-ZMIN T2=VZ(I+1)-ZMIN 1 CALL CLIP C GO AND SEE IF THE CLIPPED EDGES ARE TO BE SAVED CALL FACMAK(J) C CLIP TO THE PLANE Z=ZMAX J=ICNT DO 2 I=1,J,2 IDS=I T1=ZMAX-VZ(I) T2=ZMAX-VZ(I+1) 2 CALL CLIP C CLIP TO THE PLANE Y=Z 30 J=ICNT DO 3 I=1,J,2 IDS=I T1=VZ(I)-VY(I)  T2=VZ(I+1)-VY(I+1) 3 CALL CLIP C CLIP TO THE PLANE Y=-Z J=ICNT DO 4 I=1,J,2 IDS=I T1=VZ(I)+VY(I) T2=VZ(I+1)+VY(I+1) 4 CALL CLIP C CLIP TO THE PLANE X=Z J=ICNT DO 5 I=1,J,2 IDS=I T1=VZ(I)-VX(I) T2=VZ(I+1)-VX(I+1) 5 CALL CLIP C CLIP TO THE PLANE X=-Z J=ICNT DO 6 I=1,J,2 IDS=I T1=VZ(I)+VX(I) T2=VZ(I+1)+VX(I+1) 6 CALL CLIP C THE CLIPPING IS NOW COMPLETE. GO THROUGH THE LIST C OF EDGES AND SEE WHICH ARE OUTSIDE THE FRUSTUM OF VISION. IF(IBAD) GO TO 12 C GO HOME IF THAT WAS AN INTERNAL POLYGON IF(NT) GO TO 12 DO 10 I=1,ICNT,2 C JUMP IF EDGE IS OUTSIDE IF(IC(I).LT.524288) GO TO 10 K=I+1 L=I C ORDER THE END POINTS SO THAT I+1 HAS THE GREATEST Y VALUE VY(K)=VY(K)*YR/VZ(K)+YR VY(L)=VY(L)*YR/VZ(L)+YR IF(VY(L).LT.VY(K)) GO TO 7 K=I L=I+1 C GET DELTA Y 7 IDY=INT(VY(K)+.1)-INT(VY(L)+.1) IY=VY(K)+1.1 C GET THE PERSPECTIVE X AND GIVE IT 10 BITS IX1=VX(K)*XR/VZ(K)+XR+.1 IX2=VX(L)*XR/VZ(L)+XR+.1 IPG=IPOLY ISHR=MOD(IC(I),524288).GE.262144 C GET THE Z VALUES AND GIVE THEM 15 BITS IZ1=(VZ(K)-ZMIN)*ZSPRED+.1 IZ2=(VZ(L)-ZMIN)*ZSPRED+.1 C GET THE INTENSITY AND GIVE IT 6 BITS IS2=VN(L)*63. IS1=VN(K)*63. C************ COLOR************* KOL1=MOD(IC(K),262144) KOL2=MOD(IC(L),262144) C RESET THE INTENSITY IF IT IS OUTSIDE THE RANGE IF(IS1.GT.63) IS1=63 IF(IS2.GT.63) IS2=63 IF(IS1.LT.0) IS1=0 IF(IS2.LT.0) IS2=0 C GET THE CONTOUR VALUES AND GIVE THEM 5 BITS IC1=(VC(K)-CLEVEL(1))/DELCON IC2=(VC(L)-CLEVEL(1))/DELCON C RESET THE CONTOURS IF THEY ARE OUTSIDE THE RANGE IF(IC1.LE.0) IC1=0 IF(IC2.LE.0) IC2=0 IF(IC1.GT.31) IC1=31 IF(IC2.GT.31) IC2=31 C IF THIS IS A HORIZONTAL LINE, THEN SWAP END POINTS SO X1 IS MIN IF(IDY.NE.0) GO TO 9 IZ1=0 IZ2=0 IF(IX1.LT.IX2) GO TO 9 K=IX1 IX1=IX2 IX2=K C GO STORE THE DATA 9 CALL PACKER 10 CONTINUE RETURN 11 CALL ERRMSG(9,0) 12 RETURN END  SUBROUTINE CLIP C THIS ROUTINE CLIPS THE EDGE TO A PLANE. THE EQUATION OF THE C PLANE IS IMPLICITLY DEFINED WITHIN T1 AND T2. IF THE EDGE IS C CLIPPED, THEN IT IS ADDED TO THE STACK OF EDGES. COMMON/COMNIO/ICNT,NT,VX(10),VY(10),VZ(10),VN(10),IC(10),VC(10) C 1 ,VTX(10),VTY(10),VTZ(10),VTN(10),VTC(10),ITC(10) COMMON/SNPDAT/T1,T2,I COMMON/QFORIO/CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC COMMON/PGNCNT/IPOLY C COMMON/CLIP2/KOLAVG LOGICAL IBAD C JUMP IF LINE IS OUTSIDE FRUSTRUM OF VISION IF(IC(I).LT.524288) GO TO 30 IF(IBAD) GO TO 30 C JUMP IF LINE DOES NOT INTERSECT PLANE IF(T1) 10,11,12 10 IF(T2) 50,13,13 11 IF(T2) 13,30,30 12 IF(T2) 13,30,30 C THE LINE IS TO BE CLIPPED 13 ALPHA=T1/(T1-T2) C DETERMINE WHICH INDEX WILL RECEIVE THE CLIPPED POINT I1=I+1 IF(T1.LT.0.0) I1=I C CLIP VX(I1)=ALPHA*(VX(I+1)-VX(I))+VX(I) VY(I1)=ALPHA*(VY(I+1)-VY(I))+VY(I) VZ(I1)=ALPHA*(VZ(I+1)-VZ(I))+VZ(I) VN(I1)=ALPHA*(VN(I+1)-VN(I))+VN(I) IF(IC(I).NE.IC(I+1)) GO TO 100 IC(I1)=IC(I) GO TO 101 100 C1=FLOAT(MOD(IC(I)/4096,64)) C2=FLOAT(MOD(IC(I+1)/4096,64)) KOLAVG=MOD(INT(ALPHA*(C2-C1)+C1+.5),64)*4096 C1=FLOAT(MOD(IC(I)/64,64)) C2=FLOAT(MOD(IC(I+1)/64,64)) KOLAVG=KOLAVG+MOD(INT(ALPHA*(C2-C1)+C1+.5),64)*64 C1=FLOAT(MOD(IC(I),64)) C2=FLOAT(MOD(IC(I+1),64)) KOLAVG=KOLAVG+MOD(INT(ALPHA*(C2-C1)+C1+.5),64) IC(I1)=KOLAVG+(IC(I)/524288)*524288 101 CONTINUE VC(I1)=ALPHA*(VC(I+1)-VC(I))+VC(I) C JUMP IF EDGE STACK IS FULL IF (ICNT.GE.10) GO TO 40 ICNT=ICNT+1 VX(ICNT)=VX(I1) VY(ICNT)=VY(I1) VZ(ICNT)=VZ(I1) VN(ICNT)=VN(I1) IC(ICNT)=MOD(IC(I1),262144)+524288 VC(ICNT)=VC(I1) 30 RETURN 40 CALL ERRMSG(12,IPOLY) C SET LINE TO OUTSIDE OF FRUSTUM 50 IC(I)=0 IC(I+1)=0 RETURN END  SUBROUTINE FACMAK(ISTRT) C 15NOV73 M. ARCHULETA LLL X3361 C THIS ROUTINE STORES EDGES WHICH WERE CLIPPED AT THE Z=ZMIN C PLANE FOR FUTURE CAP POLYGON GENERATION. C IF ISTRT IS NEGATIVE, THERE WILL BE NO CAP POLYGONS C IF ISTRT IS ZERO, THERE WILL BE CAP POLYGONS C IF ISTRT IS POSITIVE, STORE THE EDGE INDEXED BY ISTRT AS C A POTENTIAL CAP POLYGON EDGE. COMMON/COMNIO/ICNT,NT,VX(10),VY(10),VZ(10),VN(10),IC(10),VC(10) & ,VTX(10),VTY(10),VTZ(10),VTN(10),VTC(10),ITC(10) COMMON/CLIP2/KOLAVG COMMON/ZFIXER/ZLOW,ZHI,ZSPRED,CURZEE LOGICAL CURZEE,KEEPIT,NT IF(ISTRT) 10,20,30 C NO POLYGON GENERATION 10 KEEPIT=.FALSE. RETURN C THERE WILL BE POLYGON GENERATION 20 KEEPIT=.TRUE. IBGIN=0 RETURN C RETURN IF NO POLYGON GENERATION 30 IF(.NOT.KEEPIT) RETURN C JUMP IF WE ARE GOING TO FLUSH THE STACK IF(ISTRT.EQ.1) GO TO 40 J=ICNT-ISTRT C JUMP IF CLIPPED STACK IS EMPTY IF(J.EQ.0) RETURN C ADD TO CLIPPED STACK FROM EDGE STACK NTT=64  IF(NT) NTT=96 DO 31 I=1,J VTX(I+IBGIN)=VX(I+ISTRT) VTY(I+IBGIN)=VY(I+ISTRT) VTZ(I+IBGIN)=VZ(I+ISTRT) VTN(I+IBGIN)=VN(I+ISTRT) VTC(I+IBGIN)=VC(I+ISTRT) ITC(I+IBGIN)=NTT 31 CONTINUE IBGIN=J+IBGIN RETURN C JUMP IF THERE ARE LESS THAN 3 CLIPPED EDGES 40 IF(IBGIN.LT.6) RETURN C THIS LOOP TAKES THE Z CLIPPED EDGES A PUTS THEM INTO THE EDGE STACK DO 41 I=1,IBGIN VX(I)=VTX(I) VY(I)=VTY(I) VZ(I)=VTZ(I) VN(I)=VTN(I) VC(I)=VTC(I) IC(I)=ITC(I)+KOLAVG 41 CONTINUE C CALL THE POLYGON INITIALIZER AND THEN THE POLYGON CLIPPER NT=.FALSE. CALL POLMAK ICNT=IBGIN CURZEE=.TRUE. CALL POLSNP CURZEE=.FALSE. RETURN END  SUBROUTINE HIDDEN C THIS IS THE HIDDEN SURFACE ALGORITHM ORIGINALLY C DEVELOPED BY GARY WATKINS OF THE UNIVERSITY OF UTAH. THIS C ROUTINE ASSUMES THAT ALL OF THE SURFACES TO BE PROCESSED C HAVE BEEN PASSED THROUGH POLMAK AND EDGMAK. THE ALGORITHM C SCANS THROUGH A BUCKET TO SEE IF ANY EDGES BECOME ACTIVE C ON A SCAN LINE. IF THEY DO, THEY ARE STORED INTO WORKING C SEGMENTS. THESE SEGMENTS ARE THEN SORTED IN X AND THEN C IN Z TO DETERMINE WHICH SEGMENT IS VISIBLE ON THE CURRENT C SCAN LINE. WHEN A SCAN LINE HAS BEEN PROCESSED, ALL SEGMENTS C ARE UPDATED TO THE NEXT SCAN LINE AND THE PROCESS RESTARTS. COMMON/BUCKY/IBUCKY(1) COMMON/FREE/ISEG(1) COMMON/EYES/IQ(2),IFX,IFY COMMON/SHOWER/IES,IVBL,COLOR,XLEFT,XRIGHT,SHRL,SHRR,SAML,SAMR, & RXVALU,RRANGE,LSTERR,IY,ICON,SHBL,SHBR,SHGL,SHGR COMMON/EDGBLK/IPT,ICOL1,IDELY,X1,X2,Z1,Z2,S1,S2,IEDGPT,C1,C2 &,SHARED,IGTHRZ,ICOL2 COMMON/COMNIO/LINES COMMON/SEGPTR/ISEGST,ISEGS2,ISEGL2,NOGREY COMMON/YSCLIN/OLDLFT,IYMOD,YLAST,NOHRZ1,NOHRZ2 DIMENSION RSEG(1),ZS(5),SAM(4) EQUIVALENCE (ISEG,RSEG),(ZS,IZS) LOGICAL IES,LSTERR,ISPLIT,IFROM,IXTEND,ABLLE &,ABRLT,J0BOX,JBOXES,ABBCKL,ABBCKR,J1BOX,JINTER COMMON/QFORIO/CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC LOGICAL IBAD,INTSCT,LINDRW,SHADED,CONTRS,NOHRZ1,NOHRZ2 C INITIALIZATION IF(IBAD) GO TO 360 NOGREY=13 NOHRZ1=.TRUE. LENGTH=11 LINDRW=.TRUE. SHADED=.FALSE. STEP=.00001 C JUMP IF LINE DRAWING IF(IDVICE.LE.0) GO TO 202 NOGREY=NOGREY+12 LENGTH=LENGTH+12 SHADED=.TRUE. LINDRW=.FALSE. LINES=0 STEP=1. GO TO 203 202 LENGTH=LENGTH+4 203 IF(CONTRS) NOGREY=NOGREY+4 IF(CONTRS) LENGTH=LENGTH+4 I=0 IBAD=.FALSE. JBAD=0 JCNT=0 IY=IFY C GET THE RIGHT AMOUNT OF WORDS FOR A SEGMENT BLOCK CALL LSTSET(LENGTH+4) ISEGST=0 204 IEDGPT=IBUCKY(IY) IGTHRZ=1 210 IF(IEDGPT.EQ.0)GO TO 228 CALL UNPACK IF(IDELY.EQ.0) GO TO 210 C GET POINTER TO FIRST OF SEG LIST ISEGPT=ISEGST IPREV=0 ISPLIT=.FALSE. C GET A FREE SEGMENT BLOCK AND CALL GETBLK(I) IF(IBAD) RETURN C STORE EDGE DATA IN SEG BLOCK LEFT C SEG(I)=PREVIOUS SEGMENT POINTER C SEG(I+1)=NEXT SEGMENT POINTER C SEG(I+2)=POLYGON POINTER C SEG(I+3)=NEXT SEGMENT WITH THIS POLYGON POINTER C I+5 THROUGH I+16 ARE FOR THE LEFT EDGE OF SEGMENT C I+6 THROUGH I+18 ARE FOR THE RIGHT EDGE OF SEGMENT C SEG(I+5)=NUMBER OF SCAN LINES THARE EDGE ARE ACTIVE C SEG(I+7)=X SEG(I+8)=XSLOPE SEG(I+11)=Z SEG(I+12)=ZSLOPE C SEG(I+15)=INTENSITY SEG(I+16)=INTENSITY SLOPE C SEG(I+4)=RESERVED FOR LINE DRAWING INFORMATION C JUMP ACCORDING TO THE TYPE OF PICTURE TO BE DISPLAYED C JUMP IF LINE DRAWING IF(LINDRW) GO TO 213 SR1=FLOAT(MOD(ICOL1,64))*S1/63. SB1=FLOAT(MOD(ICOL1/64,64))*S1/63. SG1=FLOAT(MOD(ICOL1/4096,64))*S1/63. SR2=FLOAT(MOD(ICOL2,64))*S2/63. SB2=FLOAT(MOD(ICOL2/64,64))*S2/63. SG2=FLOAT(MOD(ICOL2/4096,64))*S2/63. 213 CONTINUE ISEG(I+2)=IPT ISEG(I+3)=0 ISEG(I+4)=0 ISEG(I+5)=-IDELY ISEG(I+6)=0 RSEG(I+9)=0 RSEG(I+8)=(X1-X2)/ISEG(I+5) RSEG(I+7)=X1+RSEG(I+8)*.5 RSEG(I+12)=(Z1-Z2)/ISEG(I+5) RSEG(I+11)=Z1+RSEG(I+12)*.5 IJ=I+11 IF(.NOT.SHADED) GO TO 214 IJ=IJ+4 A = FLOAT(ISEG(I+5))*63. RSEG(IJ+1) = (SR1-SR2)/A RSEG(IJ+5) = (SB1-SB2)/A RSEG(IJ+9) = (SG1-SG2)/A RSEG(IJ ) = (SR1/63.)+RSEG(IJ+1)*.5  RSEG(IJ+4) = (SB1/63.)+RSEG(IJ+5)*.5 RSEG(IJ+8) = (SG1/63.)+RSEG(IJ+9)*.5 IJ = IJ + 8 214 IF(.NOT.CONTRS) GO TO 215 IJ=IJ+4 RSEG(IJ+1)=(C1-C2)/(ISEG(I+5)) RSEG(IJ)=(C1)+RSEG(IJ+1)*.5 215 IF(.NOT.LINDRW) GO TO 216 IJ=IJ+4 RSEG(IJ)=-2. IF(.NOT.SHOSHR) RSEG(IJ)=SHARED RSEG(IJ+1)=0. C GO SEARCH X SORT LIST TO SEE WHERE NEW EDGE WILL GO 216 IF(ISEGPT.EQ.0) GO TO 226 TE1=RSEG(I+7)-RSEG(ISEGPT+7) TE2=RSEG(I+7)-RSEG(ISEGPT+9) C JUMP IF POLYGON DOES NOT MATCH IF(IPT.NE.ISEG(ISEGPT+2)) GO TO 220 C JUMP IF LEFT EDGE EXPIRED IF(ISEG(ISEGPT+5).GE.0) GO TO 221 C JUMP IF NEW ESEGMENT TO THE LEFT OF OLD SEGMENT IF(TE1.LT.0.0) GO TO 226 C SEE IF EXISTING SEGMENT MUST BE SPLIT FOR NEW EDGE IF(ISEG(ISEGPT+6).GE.0) GO TO 219 IF(TE2.GE.0.0) GO TO 219 IF(ISPLIT) GO TO 219 ISPLIT=.TRUE. C LOAD RIGHT EDGE OF SEGMENT INTO NEW BLOCK DO 218 J=9,LENGTH+2,4 RSEG(I+J)=RSEG(ISEGPT+J) RSEG(I+J+1)=RSEG(ISEGPT+J+1) 218 CONTINUE ISEG(I+4)=((ISEG(I+4)/2)*2)+MOD(ISEG(ISEGPT+4),2) ISEG(I+6)=ISEG(ISEGPT+6) ISEG(ISEGPT+6)=0 219 IPREV=ISEGPT C GET POINTER TO NEXT SEGMENT BLOCK ISEGPT=ISEG(ISEGPT+1) GO TO 216 C JUMP IF LEFT EDGE EXPIRED 220 IF(ISEG(ISEGPT+5).GE.0) GO TO 221 IF(TE1) 226,219,219 C JUMP IF RIGHT EDGE EXPIRED 221 IF(ISEG(ISEGPT+6).GE.0) GO TO 219 IF(TE2) 226,219,219 226 ISEG(I+1)=ISEGPT ISEG(I)=0 C INSERT THIS NEW SEGMENT BLOCK BETWEEN EXISTING SEGMENTS IF(IPREV.EQ.0) GO TO 227 ISEG(IPREV)=0 ISEG(IPREV+1)=I GO TO 210 C THIS SEGMENT IS THE FIRST IN THE X SORTED LIST 227 ISEGST=I GO TO 210 C DECREMENT SCAN LINE COUNT 228 YLAST=IY IY=IY-1 NOHRZ2=NOHRZ1 NOHRZ1=IGTHRZ.EQ.1 IYMOD=MOD(IY,2) OLDLFT=0.0 ISEGS2=0 ISEGL2=0 SAM(2)=0.0 ISEGAC=0 INTSCT=.FALSE. C GET NEXT LEFT SAMPLE POINT 229 SAM(1)=SAM(2)+STEP IZS=0 IFROM=.FALSE. ISEGPT=ISEGAC ISEGAC=0 LSTERR=.FALSE. IXTEND=.TRUE. C JUMP IF NO MORE SEGMENTS FOR THIS SCAN LINE 230 IF(ISEGPT.EQ.0) GO TO 231 NEXT=ISEG(ISEGPT+3) XLEFT=RSEG(ISEGPT+7)-RSEG(ISEGPT+8) XRIGHT=RSEG(ISEGPT+9)-RSEG(ISEGPT+10) ZLEFT=RSEG(ISEGPT+11)-RSEG(ISEGPT+12) ZRIGHT=RSEG(ISEGPT+13)-RSEG(ISEGPT+14) GO TO 315 231 ISEGPT=ISEGST IF(ISEGPT.EQ.0) GO TO 350 C JUMP IF SEGMENT BLOCK STILL HAS EDGE(S) IF(ISEG(ISEGPT+5).NE.0.OR.ISEG(ISEGPT+6).NE.0) GO TO 234 C RETURN TO FREE LIST IF BLOCK IS EMPTY ISEGST=ISEG(ISEGPT+1) CALL RETBLK(ISEGPT) GO TO 231 234 IF(ISEG(ISEGPT+5).LT.0) GO TO 236 C MOVE RIGHT EDGE OF SEGMENT TO LEFT EDGE DO 235 J=7,LENGTH,4 RSEG(ISEGPT+J)=RSEG(ISEGPT+J+2) RSEG(ISEGPT+J+1)=RSEG(ISEGPT+J+3) 235 CONTINUE ISEG(ISEGPT+4)=MOD(ISEG(ISEGPT+4),2)*2 ISEG(ISEGPT+5)=ISEG(ISEGPT+6) ISEG(ISEGPT+6)=0 C JUMP IF RIGHT EDGE HAS NOT EXPIRED 236 IF(ISEG(ISEGPT+6).LT.0) GO TO 305 IPT=ISEG(ISEGPT+2) C GET NEXT SEGMENT NEXT=ISEG(ISEGPT+1) C JUMP IF END OF SEGMENT LIST 237 IF(NEXT.EQ.0) GO TO 242 C JUMP IF POLYGONS DO NOT MATCH IF(ISEG(NEXT+2).NE.IPT) GO TO 241 C JUMP IF LEFT EDGE EXPIRED IF(ISEG(NEXT+5).GE.0) GO TO 239 C MOVE LEFT EDGE OF SEGMENT TO RIGHT EDGE DO 238 J=7,LENGTH,4 RSEG(ISEGPT+J+2)=RSEG(NEXT+J) RSEG(ISEGPT+J+3)=RSEG(NEXT+J+1) 238 CONTINUE ISEG(ISEGPT+4)=ISEG(NEXT+4)/2 ISEG(ISEGPT+6)=ISEG(NEXT+5) ISEG(NEXT+5)=0 GO TO 305 C JUMP IF RIGHT EDGE EXPIRED 239 IF(ISEG(NEXT+6).GE.0) GO TO 241 C MOVE RIGHT EDGE OF NEXT TO RIGHT EDGE OF CURRENT DO 240 J=9,LENGTH+2,4 RSEG(ISEGPT+J)=RSEG(NEXT+J) RSEG(ISEGPT+J+1)=RSEG(NEXT+J+1) 240 CONTINUE ISEG(ISEGPT+4)=(ISEG(ISEGPT+4)/2)*2+MOD(ISEG(NEXT+4),2) ISEG(ISEGPT+6)=ISEG(NEXT+6) ISEG(NEXT+5)=0 ISEG(NEXT+6)=0 GO TO 305 C GET THE NEXT SEGMENT 241 NEXT=ISEG(NEXT+1) GO TO 237 C AN UNCLOSED POLYGON EXISTS SO MAKE RIGHT EDGE SAME AS LEFT EDGE 242 DO 243 J=7,LENGTH,4 RSEG(ISEGPT+J+2)=RSEG(ISEGPT+J) RSEG(ISEGPT+J+3)=RSEG(ISEGPT+J+1) 243 CONTINUE ISEG(ISEGPT+6)=-1 C TRY TO WRITE THE UNCLOSED POLYGON NUMBER ONLY C ONCE FOR EACH POLYGON IF(JBAD.EQ.ISEG(ISEGPT+2)) GO TO 305 JBAD=ISEG(ISEGPT+2) JCNT=JCNT+1 C DONT TYPE MORE THAN 10 MESSAGES IF(JCNT.GT.10) GO TO 305 CALL ERRMSG(5,JBAD) 305 XLEFT=RSEG(ISEGPT+7) XRIGHT=RSEG(ISEGPT+9) C JUMP IF NO VISIBLE SEGMENT TO PROCESS IF((.NOT.IXTEND.OR.IZS.NE.0).AND.XLEFT.GE.SAM(2)) GO TO 350 IFROM=.TRUE. ISEGST=ISEG(ISEGPT+1) ZLEFT=RSEG(ISEGPT+11) ZRIGHT=RSEG(ISEGPT+13) C UPDATE SEGMENT TO NEXT SCAN LINE DO 306 J=7,NOGREY,2 RSEG(ISEGPT+J)=RSEG(ISEGPT+J)+RSEG(ISEGPT+J+1) 306 CONTINUE ISEG(ISEGPT+5)=ISEG(ISEGPT+5)+1 ISEG(ISEGPT+6)=ISEG(ISEGPT+6)+1 C JUMP IF SEGMENT BLOCK STILL HAS EDGE(S) IF(ISEG(ISEGPT+5).NE.0) GO TO 307  IF(ISEG(ISEGPT+6).NE.0) GO TO 307 C DONT RETURN THE BLOCK IF IN LINE DRAWING MODE IF(IDVICE.LE.0) GO TO 307 C SEGMENT EXITED SO RETURN BLOCK TO FREE CALL RETBLK(ISEGPT) GO TO 315 C BACK POINTERS NEEDED ON NEW LIST 307 X1=RSEG(ISEGPT+7) C X1=RIGHT X VALUE IF LEFT EDGE EXPIRED IF(ISEG(ISEGPT+5).GE.0) X1=RSEG(ISEGPT+9) IS2=0 IS1=ISEGL2 C JUMP IF NO MORE SEGMENTS ON THE BACK TRACE 308 IF(IS1.EQ.0) GO TO 309 X2=RSEG(IS1+7) C X2=RIGHT X VALUE IF LEFT EDGE EXPIRED  IF(ISEG(IS1+5).GE.0) X2=RSEG(IS1+9) C JUMP IF CURRENT X IS TO RIGHT OF PREVIOUS SEGMENT IF(X1.GE.X2) GO TO 309 IS2=IS1 IS1=ISEG(IS1) GO TO 308 C SET THE BACK AND FORWARD POINTERS 309 IF(IS2.NE.0) ISEG(ISEGPT+1)=IS2 ISEG(ISEGPT)=IS1 IF(IS2.NE.0) ISEG(IS2)=ISEGPT IF(IS2.EQ.0) ISEGL2=ISEGPT IF(IS1.NE.0) ISEG(IS1+1)=ISEGPT IF(IS1.EQ.0) ISEGS2=ISEGPT 315 IF(SAM(1).GE.XRIGHT) GO TO 345 ABLLE=SAM(1).GE.XLEFT ABRLT=XRIGHT.LT.SAM(2) INTSCT=.FALSE. C GET XLEFT CLIP POINT XLCLIP=SAM(1) IF(.NOT.ABLLE) XLCLIP=XLEFT C GET XRIGHT CLIP POINT XRCLIP=SAM(2) IF(ABRLT) XRCLIP=XRIGHT J0BOX=.FALSE. JBOXES=.TRUE. C JUMP IF NO VISIBLE SEGMENT TO PROCESS IF((IZS .EQ.0).AND..NOT.ABLLE) GO TO 335 JBOXES=.FALSE. IF((IZS.EQ.0).AND.ABLLE) GO TO 331 C GET Z VALUES FOR NEW AND OLD LINES AT CLIP POINTS C JUMP SO ZERO DIVIDE WONT HAPPEN 323 IF(XLEFT.EQ.XRIGHT) GO TO 324 ZAL=((XLCLIP-XRIGHT)*(ZLEFT-ZRIGHT))/(XLEFT-XRIGHT)+ZRIGHT ZAR=((XRCLIP-XRIGHT)*(ZLEFT-ZRIGHT))/(XLEFT-XRIGHT)+ZRIGHT GO TO 325 324 ZAL=ZRIGHT ZAR=ZRIGHT C JUMP SO ZERO DIVIDE WONT HAPPEN 325 IF(ZS(2).EQ.ZS(3)) GO TO 326 ZCL=((XLCLIP-ZS(3))*(ZS(4)-ZS(5)))/(ZS(2)-ZS(3))+ZS(5) ZCR=((XRCLIP-ZS(3))*(ZS(4)-ZS(5)))/(ZS(2)-ZS(3))+ZS(5) GO TO 327 326 ZCL=ZS(5) ZCR=ZS(5) 327 ABBCKL=ZCL.LE.ZAL ABBCKR=ZCR.LE.ZAR J0BOX=ABBCKL.AND.ABBCKR C JUMP IF AB BACK ON LEFT AND RIGHT IF(J0BOX) GO TO 335 J1BOX=ABLLE.AND..NOT.ABBCKL.AND..NOT.ABBCKR C JUMP IF AB NOT BACK ON LEFT AND RIGHT IF(J1BOX) GO TO 331 JINTER=(ABBCKL.AND..NOT.ABBCKR).OR.(.NOT.ABBCKL.AND.ABBCKR.AND. &ABLLE) C JUMP IF THE TWO SURFACES INTERSECTED IF(JINTER) GO TO 328 JBOXES=.TRUE. C JBOXES=.NOT.ABLLE.AND..NOT.ABBCKL BY DEFAULT GO TO 335 C GET THE INTERSECTION POINT 328 SAM(2)=(XLCLIP*(ZAR-ZCR)-XRCLIP*(ZAL-ZCL))/(ZCL-ZAL-ZCR+ZAR) C RESET SAM(2) IF ARITHMETIC WAS A LITTLE OFF IF(SAM(2).LT.XLCLIP) SAM(2)=XLCLIP IF(SAM(2).GT.XRCLIP) SAM(2)=XRCLIP SAM(3)=SAM(2)*.25 SAM(4)=0 IXTEND=.FALSE. INTSCT=.TRUE. C JUMP IF LINE AB IS BACK ON THE RIGHT IF(ABBCKR) GO TO 332 GO TO 335 331 IF(IFROM.AND.(RRANGE.NE.RSEG(ISEGPT+8))) LSTERR=.TRUE. IF(IZS.NE.0.AND.ABRLT) IXTEND=.FALSE. IF(.NOT.ABRLT.AND..NOT.IXTEND) GO TO 332 SAM(2)=XRIGHT SAM(3)=XRIGHT*.25 SAM(4)=RSEG(ISEGPT+10) C SET PREVIOUS TEST SEGMENT TO CURRENT SEGMENT 332 IZS=ISEGPT ZS(2)=XLEFT ZS(3)=XRIGHT ZS(4)=ZLEFT ZS(5)=ZRIGHT 335 IF(J0BOX.AND..NOT.(XRIGHT.LE.SAM(2))) IXTEND=.FALSE. IF(J0BOX.AND.(XRIGHT.LE.SAM(2))) GO TO 345 C LINK SEGMENT WHICH BELONGS TO COMMON POLYGON ISEG(ISEGPT+3)=ISEGAC ISEGAC=ISEGPT IF(.NOT.JBOXES) GO TO 345 IXTEND=.FALSE. C UPDATE NEXT SAMPLE POINT SAM(2)=XLEFT SAM(3)=XLEFT*.25 SAM(4)=RSEG(ISEGPT+8) 345 ISEGPT=NEXT IF(IFROM) GO TO 231 GO TO 230 C OUTPUT SEGMENTS 350 IF(IXTEND) ISEGAC=0 IES=(ISEGPT.EQ.0).AND.IXTEND C JUMP IF BACKGROUND SEGMENT IF(IZS.EQ.0) GO TO 355 C JUMP IF THERE WAS NOT AN INTERSECTION IF(.NOT.INTSCT) GO TO 351 IF(IDVICE.GT.0) GO TO 351 C THIS IS WHERE A POINT WOULD BE PLOTTED TO C SHOW WHERE AN INTERSECTION IS. THE COORDINATE IS (SAM(2),IY). 351 CONTINUE XLEFT=(RSEG(IZS+7)-RSEG(IZS+8)) XRIGHT=(RSEG(IZS+9)-RSEG(IZS+10)) IJ=IZS+11 IF(.NOT.SHADED) GO TO 352 IJ=IJ+4 SHRL = RSEG(IJ )-RSEG(IJ+1) SHBL = RSEG(IJ+4)-RSEG(IJ+5) SHGL = RSEG(IJ+8)-RSEG(IJ+9) SHRR = RSEG(IJ+2)-RSEG(IJ+3) SHBR = RSEG(IJ+6)-RSEG(IJ+7) SHGR = RSEG(IJ+10)-RSEG(IJ+11) IJ = IJ + 8 352 IF(.NOT.CONTRS) GO TO 355 IJ=IJ+4 ICON=IJ 355 SAML=SAM(1)-STEP SAMR=SAM(2) IVBL=IZS RXVALU=SAM(3) RRANGE=SAM(4) C JUMP TO CONSHO IF CONTOUR OUTPUT IF(CONTRS) CALL CONSHO C JUMP TO LINSHO IF LINE DRAWING OUTPUT IF(LINDRW) CALL LINSHO C JUMP TO SHOW IF SHADED OUTPUT IF(SHADED) CALL SHOW IF(.NOT.IES) GO TO 229 C BACK POINTER NOT NEEDED NOW IF(ISEGL2.EQ.0) GO TO 356 ISEG(ISEGL2)=0 ISEG(ISEGL2+1)=0 356 ISEGST=ISEGS2 C JUMP IF STILL MORE SCAN LINES TO PROCESS IF(IY.GE.1) GO TO 204 IBAD=JBAD.OR.IBAD RETURN 360 CALL ERRMSG(9,0) RETURN END  SUBROUTINE DRAWIT(X1,Y1,I) C DRAWIT SENDS THE LINE TO BE DISPLAYED TO THE APPROPRIATE C DRAWING SUBROUTINE. IT ALSO CLEARS OUT THE LINE STARTING C POSITION. COMMON/QFORIO/CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC COMMON/FREE/RSEG(1) COMMON/INTENS/ITENHI,ITENLO,IBACKG,IFX,IFY C JUMP IF THIS EDGE HAS ALREADY BEEN DRAWN IF(RSEG(I-1).LE.-1.) GO TO 3 A=X1 B=Y1 C=RSEG(I-1) D=RSEG(I) C JUMP TO 1 IF NEW LINE DOES NOT MATCH OLD LINE IF(A.NE.OX1) GO TO 1 IF(B.NE.OY1) GO TO 1 IF(C.NE.OX2) GO TO 1 IF(D.EQ.OY2) GO TO 2 C STORE THE NEW END POINT 1 OX1=A OY1=B OX2=C OY2=D CALL PLTLIN(A,B,C,D) 2 RSEG(I-1)=-3. RSEG(I)=0 3 RETURN END  SUBROUTINE LINSHO C 04APR74 C LINSHO UPDATES THE INFORMATION WITHIN EACH OF THE C SEGMENT BLOCKS AS TO HOW MANY SCAN LINES EITHER THE LEFT OR C RIGHT EDGE OF THE SEGEMNT HAS BEEN VISIBLE. IF THE C EDGE IS EXITING ON THE NEXT SCAN LINE, THEN IT IS DRAWN. IF THE C EDGE WAS VISIBLE ON THE PREVIOUS SCAN LINE BUT NOT THIS SCAN LINE, C THEN IT IS DRAWN. THIS ROUTINE WILL CALL SUBROUTINE C DRAWIT WITH THE INFORMATION NECESSARY TO MAKE A LINE SEGMENT. COMMON/FREE/ISEG(1) COMMON/EDGBLK/IPT,ICOL, IYY,X1,X2,Z1,Z2,S1,S2,NEXT,C1,C2 &,SHARED,IGTHRZ,ICOL2 COMMON/QFORIO/CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC COMMON/SHOWER/IES,I,COLOR,XLEFT,XRIGHT,SHRL,SHRR,SAML,SAMR &,RXVALU,RRANGE,LSTERR,IY,ICON,SHBL,SHBR,SHGL,SHGR COMMON/INTENS/ITENHI,ITENLO,IBACKG,IFX,IFY COMMON/BUCKY/IBUCKY(1) COMMON/SEGPTR/ISEGST,ISEGS2,ISEGL2,NOGREY COMMON/YSCLIN/OLDLFT,IYMOD,YLAST,NOHRZ1,NOHRZ2 LOGICAL IES,SHOSHR,IBAD,LSTERR,LFTVIS,RGTVIS,MAYHRZ,LOAD &,NOHRZ1,NOHRZ2 DIMENSI ON RSEG(1) EQUIVALENCE (ISEG,RSEG) C JUMP IF THIS A BACKGROUND SEGMENT IF(I.EQ.0) GO TO 14 IJ=I+NOGREY+2 C CHECK TO SEE WHAT THE STATUS OF THE EDGE IS IF THIS C IS THE FIRST TIME THE EDGE IS VISIBLE. IF(ILAST.NE.I) MAYHRZ=.FALSE. LFTVIS=ABS(XLEFT-SAML).LT..001 RGTVIS=ABS(XRIGHT-SAMR).LT..001 I1=ISEG(I+4)/2 C JUMP IF LEFT EDGE NOT VISIBLE IF(.NOT.LFTVIS) GO TO 2 I1=IYMOD C JUMP IF LEFT EDGE NOT VISIBLE FOR FIRST TIME IF(RSEG(IJ).GE.-1.0) GO TO 1 MAYHRZ=.TRUE. RSEG(IJ)=SAML-RSEG(I+8)*(RSEG(IJ)+3.)*.5 RSEG(IJ+1)=YLAST C DRAW THE LEFT EDGE IF IT EXITS 1 IF(ISEG(I+5).NE.0) GO TO 2 MAYHRZ=.TRUE. CALL DRAWIT(SAML+RSEG(I+8)*.5,YLAST,IJ+1) C JUMP IF RIGHT SIDE NOT VISIBLE 2 IF(.NOT.RGTVIS) GO TO 4 I2=IYMOD C JUMP IF RIGHT EDGE NOT VISIBLE FOR FIRST TIME IF(RSEG(IJ+2).GE.-1.0) GO TO 3 MAYHRZ=.TRUE. RSEG(IJ+2)=SAMR-RSEG(I+10)*(RSEG(IJ+2 )+3.)*.5 RSEG(IJ+3)=YLAST C DRAW THE RIGHT EDGE IF IT EXITS 3 IF(ISEG(I+6).NE.0) GO TO 4 MAYHRZ=.TRUE. CALL DRAWIT(SAMR+RSEG(I+10)*.5,YLAST,IJ+3) C SET THE THIS LINE IS VISIBLE FLAGS 4 ISEG(I+4)=I1*2+I2 OLDLFT=SAMR C NOW START THE PROCESSING OF THE HORIZONTAL EDGES IGTHRZ=-1 LOAD=.FALSE. C JUMP IF THIS POLYGON PROBABLY DOESNT HAVE HORIZONTAL EDGES IF(SHOSHR.AND..NOT.MAYHRZ) GO TO 14 C JUMP IF THERE WERE NO HORIZONTAL EDGES FOUND FOR TH IS SCAN LINE IF(NOHRZ1) GO TO 12 NEXT=IBUCKY(IY+1) YA=YLAST C JUMP IF NO HORIZONTAL EDGES 10 IF(NEXT.LE.0) GO TO 12 CALL UNPACK IF(IYY.NE.0) GO TO 10 IF((SHARED.EQ.-1.).AND..NOT.SHOSHR) GO TO 10 IF(IPT.NE.ISEG(I+2)) GO TO 10 C GET THE FLOATING FLOOR OF SAML IF(FLOAT(INT(SAML)).GE.X2) GO TO 10 C GET THE FLOATING FLOOR OF SAMR IF(FLOAT(INT(SAMR)).LE.X1) GO TO 10 C GET THE TRUE HORIZONTAL SPAN IF(SAML.GT.X1) X1=SAML  IF(SAMR.LT.X2) X2=SAMR CALL PLTLIN(X1,YA,X2,YA) LOAD=.TRUE. GO TO 10 C JUMP IF THERE WERE NO HORIZONTAL EDGES LAST SCAN LINE 12 IF(NOHRZ2) GO TO 14 C JUMP IF WEVE BEEN THRU HERE BEFORE IF(LOAD) GO TO 14 LOAD=.TRUE. YA=YLAST+1 NEXT=IBUCKY(IY+2) GO TO 10 C JUMP IF NOT END OF SCAN LINE 14 ILAST=I IF(.NOT.IES) RETURN C RESET BACK POINTER IF(ISEGL2.EQ.0) GO TO 15 ISEG(ISEGL2)=0 ISEG(ISEGL2+1)=0 15 ISEGS T=ISEGS2 I=ISEGST IOLD=I XL=YLAST+1. C GO HOME IF END OF SEGMENTS REACHED 16 IF(I.EQ.0) RETURN INXT=I IF(ISEG(I+1).NE.0) INXT=ISEG(I+1) C DRAW IF LEFT EDGE WAS PREVIOUSLY VISIBLE IF(ISEG(I+4)/2.EQ.IYMOD) GO TO 17 X1=RSEG(I+7)-2.0*RSEG(I+8) CALL DRAWIT(X1,XL,I+NOGREY+3) C DRAW IF RIGHT EDGE WAS PREVIOUSLY VISIBLE 17 IF(MOD(ISEG(I+4),2).EQ.IYMOD) GO TO 18 X1=RSEG(I+9)-2.0*RSEG(I+10) CALL DRAWIT(X1,XL,I+NOGREY+5) 18 IOLD= I I=ISEG(I+1) GO TO 16 END  SUBROUTINE SHOW C 04OCT73 C THIS ROUTINE EVALUATES THE SHADING INFORMATION FOR C A VISIBLE SEGMENT. DATA COMES THROUGH SHOWER AND GOES TO C SRL (SHADED RASTER LINE) COMMON/SHOWER/IES,IVBL,COLOR,XLEFT,XRIGHT,SHRL,SHRR,SAML,SAMR, & RXVALU,RRANGE,LSTERR,IY,ICON,SHBL,SHBR,SHGL,SHGR COMMON/INTENS/ITENHI,ITENLO,IBACKG,IFX,IFY C COMMON/CONLEV/CONHI,CONLOW,NCONLV,CLEVEL(1) COMMON/EYES/XR,YR,IXRES,IYRES,DELINT,DELCON,IFLRCO,ICLGCO LOGICAL IES,LSTERR IF(SAMR.GT.IXRE!!S) SAMR=IXRES C GO HOME IF END OF SCAN LINE REACHED 2 IF(SAML.GE.IXRES) RETURN IF(SAML.GE.SAMR) GO TO 4 STR=FLOAT(MOD(IBACKG,64)) STB=FLOAT(MOD(IBACKG/64,64)) STG=FLOAT(MOD(IBACKG/4096,64)) ENDR = STR ENDB = STB ENDG = STG C JUMP IF BACKGROUND SEGMENT IF(IVBL.EQ.0) GO TO 3 RR = 0. RB = 0. RG = 0. IF ( XRIGHT.EQ.XLEFT ) GO TO 1 X = XRIGHT-XLEFT RR = (SHRR-SHRL)/X RB = (SHBR-SHBL)/X RG = (SHGR-SHGL)/X C!! C************ COLOR************* C EVALUATE THE START AND END INTENSITIES 1 X = SAML-XLEFT RTENLO = ITENLO STR = (X*RR+SHRL)*DELINT+RTENLO STB = (X*RB+SHBL)*DELINT+RTENLO STG = (X*RG+SHGL)*DELINT+RTENLO X = SAMR-XLEFT ENDR = (X*RR+SHRL)*DELINT+RTENLO ENDB = (X*RB+SHBL)*DELINT+RTENLO ENDG = (X*RG+SHGL)*DELINT+RTENLO 3 CALL SRL(SAML,STR,STB,STG,SAMR,ENDR,ENDB,ENDG,IY+1) C GO HOME IF THIS IS NOT THE END OF THE SCAN LINE 4 IF(.NOT.IES) RETURN !!IVBL=0 SAML=SAMR SAMR=IXRES GO TO 2 END !! SUBROUTINE PACKER C C SUBROUTINE PACKER FOR 36 BIT MACHINES IN ANSI FORTRAN C C THIS ROUTINE RECEIVES DATA THROUGH EDGARG AND PACKS IT INTO C A STORAGE BLOCK INSIDE FREE. IF THIS EDGE IS A SHARED EDGE, THEN C THE EDGE WILL BE COMPARED WITH EXISTING EDGES ON THIS SCAN LINE C TO FIND OUT WHICH IF ANY IT MATCHES. IF THIS EDGE IS A C HORIZONTAL EDGE, THEN IT WILL BE STORED ON THE PREVIOUS SCAN LINE. COMMON/EDGARG/IY,IX1,IX2,IZ1,IZ2,IS1,IS2,IP,IDY,ICOL1, ISHR, &IC1,IC2,ICOL2 COMMON/FRE""E/ IFREE(1) COMMON/EYES/XEY(3),IFY,ES(4) COMMON/BUCKY/IBUCKY(1) COMMON/QFORIO/CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC LOGICAL CONTRS,IBAD,ISHR C CHANGE IY IF THIS IS A HORIZONTAL EDGE IF(IDY.EQ.0) IY=IY+1 IF(IY.GT.IFY) IY=IFY IPT=IBUCKY(IY) C GENERATE THE EDGE DATA IT1=(IX1*1024+IX2)*1024+IDY IT2=IZ1*32768+IZ2 NUMWRD=5 C JUMP IF NO EDGE SHARING IF(.NOT.ISHR) GO TO 4 C TRACE THROUGH THE ENTRIES ON THIS SCAN LINE AND FIND OUT C IF THIS EDGE HAS ALRE""ADY BEEN ENTERED. 1 IF(IPT.EQ.0) GO TO 4 IF(IT1.EQ.MOD(IFREE(IPT),1073741824) 1.AND.IT2.EQ.MOD(IFREE(IPT+1),1073741824)) GO TO 3 C GET THE NEXT BLOCK IPT=MOD(IFREE(IPT+2),262144) GO TO 1 C CHECK TO SEE IF THIS EDGE IS ALREADY SHARED C AND JUMP IF IT IS 3 IF(MOD(IFREE(IPT+4),8192).NE.0) GO TO 4 C NOW PROVIDE THE SHARING POLYGON IFREE(IPT+4)=IFREE(IPT+4)/8192*8192+IP GO TO 5 4 CONTINUE C GET ENOUGH FREE FOR EDGE BLOCK (180 BITS) CALL GETVAR(IPT,NUMWRD) "" IF(IBAD) RETURN C CBEG(5), XBEG(10), XEND(10), DELTA Y(10) IFREE(IPT)=IT1 C CEND(5), ZBEG(15), ZEND(15) IFREE(IPT+1)=IT2 C SBEG(6), SEND(6), NEXT EDGE(18) IFREE(IPT+2)=(IS1*64+IS2)*262144+IBUCKY(IY) C COLOR BEG(18), POLYGON NUMBER(13) IFREE(IPT+3)=ICOL1*8192+IP C COLOR END(18), SHARED POLYGON NUMBER(13) IFREE(IPT+4)=ICOL2*8192 IF(.NOT.CONTRS) GO TO 6 IFREE(IPT)=MOD(IFREE(IPT),1073741824)+IC1*1073741824 IFREE(IPT+1)=MOD(IFREE(IPT+1),1073741824)+IC2*107374""1824 6 IBUCKY(IY)=IPT 5 RETURN END "" SUBROUTINE UNPACK C C SUBROUTINE UNPACK FOR 36 BIT MACHINES IN ANSI FORTRAN C C UNPACK PERFORMS THE REVERSE OF PACKER. IT IS CALLED BY C HIDDEN WITH IEDGPT SET AND RETURNS DATA THROUGH EDGBLK. COMMON/FREE/IFREE(1) COMMON/EDGBLK/IPT,ICOL1,IDELY,X1,X2,Z1,Z2,S1,S2,IEDGPT,C1,C2 &,SHARED,IGTHRZ,ICOL2 COMMON/QFORIO/CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC LOGICAL CONTRS C GET DELTAY VALUE 15 IDELY=MOD(IFREE(IEDGPT),1024) C JUMP IF A NON-HORIZONTAL LINE IF(IDELY.GT.0) GO TO 16## C JUMP IF WE ARE LOOKING FOR VERTICALS IF(IGTHRZ) 20,20,18 C JUMP IF WE ARE LOOKING FOR HORIZONTALS 16 IF(IGTHRZ) 19,19,20 C FLAG TO SAY THERE ARE HORIZONTAL EDGES ON THIS SCAN LINE 18 IGTHRZ=2 C GET NEXT EDGE BLOCK 19 IEDGPT=MOD(IFREE(IEDGPT+2),262144) C GO HOME IF WE RAN OFF THE END OF THE LIST IF(IEDGPT) 3,3,15 C GET Z BEGIN 20 Z1=FLOAT(MOD(IFREE(IEDGPT+1)/32768,32768)) C GET Z END AND MAKE IT REAL Z2=FLOAT(MOD(IFREE(IEDGPT+1),32768)) C GET X BEGIN X1=FLOAT(MOD(I##FREE(IEDGPT)/1048576,1024)) C GET X END AND MAKE IT REAL X2=FLOAT(MOD(IFREE(IEDGPT)/1024,1024)) C GET SHADE BEGIN S1=FLOAT(MOD(IFREE(IEDGPT+2)/16777216,64)) C GET SHADE END AND MAKE IT REAL S2=FLOAT(MOD(IFREE(IEDGPT+2)/262144,64)) C GET POINTER TO POLYGON IP=MOD(IFREE(IEDGPT+4),8192) C GET THE COLOR OF THIS EDGE ICOL1=MOD(IFREE(IEDGPT+3)/8192,262144) ICOL2=MOD(IFREE(IEDGPT+4)/8192,262144) C JUMP IF NO CONTOURING IF(.NOT.CONTRS) GO TO 4 C GET THE CONTOUR BEGIN ## C1=FLOAT(MOD(IFREE(IEDGPT)/1073741824,32)) C CET THE CONTOUR END C2=FLOAT(MOD(IFREE(IEDGPT+1)/1073741824,32)) 4 SHARED=-2. C IPT=MOD(IFREE(IEDGPT+3),8192) C JUMP IF NOTHING IN THE TOP HALF IF(IP.EQ.0) GO TO 2 SHARED=-1. IF(ISHARE.EQ.1) GO TO 1 ISHARE=1 GO TO 3 1 IPT=IP C GET POINTER TO NEXT EDGE ON SCAN LINE 2 IEDGPT=MOD(IFREE(IEDGPT+2),262144) ISHARE=0 3 RETURN END ## SUBROUTINE ERRMSG(I,J) C THIS ROUTINE WILL WRITE OUT THE ERROR MESSAGE. ARGUMENT I C IS THE ERROR NUMBER AND ARGUMENT J IS THE VALUE WHICH IS IN ERROR. COMMON/DEVI/ INPUT,OUTPUT,ERROR COMMON/QFORIO/CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC INTEGER OUTPUT,ERROR LOGICAL IBAD IF(IDVICE.EQ.-1) CALL ALMODE IBAD=.TRUE. C JUMP TO THE ERROR STRING GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13),I 1 WRITE(ERROR,30) J GO TO 25 2 WRITE(ERROR,31) GO TO 25 $$ 3 WRITE(ERROR,32) J GO TO 25 4 WRITE(ERROR,33) J GO TO 25 5 WRITE(ERROR,34) J GO TO 25 6 WRITE(ERROR,35) GO TO 25 7 WRITE(ERROR,36) GO TO 25 8 WRITE(ERROR,37) GO TO 25 9 WRITE(ERROR,38) GO TO 25 10 WRITE(ERROR,39) GO TO 25 11 WRITE(ERROR,40) GO TO 25 12 WRITE(ERROR,41) J GO TO 25 13 WRITE(ERROR,42) CONTINUE 25 RETURN 30 FORMAT(' MAXFRE.LT.100',I6/) 31 FORMAT(' TOO MANY P$$OLYGONS'/) 32 FORMAT(' BAD MAXRES',I6/) 33 FORMAT(' BAD MAXINT',I6/) 34 FORMAT(' UNCLOSED POLYGON',I6/) 35 FORMAT(' I NEED MORE FREE'/) 36 FORMAT(' BAD RESOLUTION'/) 37 FORMAT(' BAD INTENSITY'/) 38 FORMAT(' FIX YOUR DATA'/) 39 FORMAT(' BUFFER FULL'/) 40 FORMAT(' ZMAX.LE.0 OR ZMIN'/) 41 FORMAT(' EDG STK FUL 4 POL',I6/) 42 FORMAT(' BAD EDGE COUNT'/) END $$ SUBROUTINE CONSHO C 04APR74 C THIS ROUTINE EVALUATES THE CONTOUR INFORMATION FOR C A VISIBLE SEGMENT. DATA COMES THROUGH SHOWER AND GOES TO C LINE AND CRTBCD (LLL GRAPHICS ROUTINES) COMMON/FREE/RSEG(1) COMMON/SHOWER/IES,I,COLOR,XLEFT,XRIGHT,SHRL,SHRR,SAML,SAMR &,RXVALU,RRANGE,LSTERR,IY,J,SHBL,SHBR,SHGL,SHGR COMMON/INTENS/ITENHI,ITENLO,IBACKG,IFX,IFY COMMON/CONLEV/CONHI,CONLOW,NCONLV,CLEVEL(1) COMMON/EYES/XR,YR,IXRES,IYRES,DELINT,DELCON,IFLRCO,ICLGCO COMMON/YS%%CLIN/OLDLFT,IYMOD,YLAST COMMON/QFORIO/CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC LOGICAL IES,LSTERR,SHOSHR C JUMP IF BACKGROUND SEGMENT IF(I.EQ.0) RETURN YY=YLAST/(IFY+1) ITEXTY=MOD(IY,NCONLV*LBLSPC) C GET THE DATA FOR HALF A SCAN LINE AGO XL1=XLEFT-RSEG(I+8)*.5 XR1=XRIGHT-RSEG(I+10)*.5 CL1=(RSEG(J)-RSEG(J+1)*1.5)*DELCON+CLEVEL(1) CR1=(RSEG(J+2)-RSEG(J+3)*1.5)*DELCON+CLEVEL(1) C GET THE DATA FOR HALF A SCAN LINE AHEAD XL2=XLEFT+RSEG(I+8)*.5 %% XR2=XRIGHT+RSEG(I+10)*.5 CL2=(RSEG(J)-RSEG(J+1)*.5)*DELCON+CLEVEL(1) CR2=(RSEG(J+2)-RSEG(J+3)*.5)*DELCON+CLEVEL(1) C GO THROUGH THE CONTOUR LOOP C THIS IS REALLY DIFFICULT TO EXPLAIN. THE HIDDEN SURFACE C ALGORITHM HAS DETERMINED THAT IT HAS A VISIBLE SEGMENT. C I WILL CREATE A QUADRILATERAL ABOUT THIS VISIBLE SEGMENT WHERE C THE COORDINATES ARE (XR1, Y-1/2), (XL1, Y-1/2), (XR2, Y+1/2), C (XL2, Y+1/2). IN GOING THROUGH THE CONTOUR LOOP I CHECK TO SEE C IF A GIVEN CONTOUR LINE IN%%TERSECTS AN EDGE OF THE QUAD. C IF IT DOES, THEN I STORE THE COORDINATE. THE LINE THAT I WILL C DRAW MUST BE CONTAINED WITHIN THE VISIBLE SEGMENT. THE REASON I C DONT WORRY ABOUT THE Y INTERSECTION IS BECAUSE THE PICTURE C WHICH IM COMPUTING CANT EXIST BETWEEN SCAN LINES. DO 7 K=IFLRCO,ICLGCO XS=IFX XE=0. CC=CLEVEL(K) C CHECK THE LINE FROM TOP LEFT TO TOP RIGHT T1=CC-CL1 T2=CC-CR1 IF(T1*T2.GT.0.) GO TO 1 X=XL1 %% IF(T1.NE.T2) X=(T1/(T1-T2))*(XR1-XL1)+XL1 IF(X.LT.XS) XS=X IF(X.GT.XE) XE=X C CHECK THE LINE FROM TOP RIGHT TO BOTTOM RIGHT 1 T1=CC-CR1 T2=CC-CR2 IF(T1*T2.GT.0.) GO TO 2 X=XR1 IF(T1.NE.T2) X=(T1/(T1-T2))*(XR2-XR1)+XR1 IF(X.LT.XS) XS=X IF(X.GT.XE) XE=X C CHECK THE LINE FROM BOTTOM RIGHT TO BOTTOM LEFT 2 T1=CC-CR2 T2=CC-CL2 IF(T1*T2.GT.0.) GO TO 3 %%X=XR2 IF(T1.NE.T2) X=(T1/(T1-T2))*(XL2-XR2)+XR2 IF(X.LT.XS) XS=X IF(X.GT.XE) XE=X C CHECK THE LINE FROM BOTTOM LEFT TO TOP LEFT 3 T1=CC-CL2 T2=CC-CL1 IF(T1*T2.GT.0.) GO TO 4 X=XL1 IF(T1.NE.T2) X=(T1/(T1-T2))*(XL1-XL2)+XL2 IF(X.LT.XS) XS=X IF(X.GT.XE) XE=X C IF THE CONTOUR SEGMENT IS OUTSIDE THE RANGE OF THE C VISIBLE SEGMENT, THEN DONT DRAW IT 4 IF(XS.GT.SAMR) GO TO 7 %% IF(XE.LT.SAML) GO TO 7 IF(XS.LT.SAML) XS=SAML IF(XE.GT.SAMR) XE=SAMR CALL PLTLIN(XS,YLAST,XE,YLAST) C JUMP IF THIS ISNT THE TIME TO PLOT A LABEL IF((K-1)*LBLSPC.NE.ITEXTY) GO TO 7 CALL LABEL((XS+XE)/2.,YLAST,(64+K)*2**29,1) 7 CONTINUE RETURN END %%C**********************************************************************C C C C DEVICE.FOR VERSION 1.0(A) SEPTEMBER 1976 C C C C THIS FILE CONTAINS DEVICE DEPENDENT CALLS TO INITIALIZE, C C WRITE, AND TERMINATE PICTURE TRANSMISSION TO THE C C SELECTED DISPLAY DEVICE. C&& C C C MIKE STEPHENSON HANK CHRISTIANSEN C C DEPARTMENT OF CIVIL ENGR. CIVIL ENGINEERING DEPT. C C AND ENGINEERING MECHANICS 368E ESTB C C THE UNIVERSITY OF ARIZONA BRIGHAM YOUNG UNIVERSITY C C TUCSON, ARIZONA 85721 PROVO, UTAH 84602 C C (602) 884-4803 (801) 374-1211 X2811 &&C C C C**********************************************************************C SUBROUTINE BGNFRM COMMON/DEVI/ INPUT,OUTPUT,ERROR COMMON/PLTTER/ PLTSIZ,XLAST,YLAST COMMON/INTENS/ IPH,IPL,IPB,IFX,IFY COMMON/QFORIO/ CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC INTEGER OUTPUT,ERROR LOGICAL IFIRST DATA IFIRST/.TRUE./ C IF CONTINUOUS-TONE THEN RETURN. C (NOTE: NO CONTINUOUS-TONE DEVICE CALL INCLUD&&ED IN THIS VERSION.) IF(IDVICE.GT.0) RETURN C RES = MAXIMUM PICTURE COORDINATE (0.<=COOR.<=RES). C PLTSIZ = SCALE FACTOR TO CONVERT FROM INTERNAL COORDINATES C TO EXTERNAL PICTURE DEVICE COORDINATES. RES=IFX-1 IGO=IDVICE+2 IF(IGO) 10,20,30 C CALCOMP PLOTTER IS PICTURE DEVICE. 10 IF(IFIRST) CALL PLOTS(X,Y,I) IF(IFIRST) CALL PLOT(0.,0.5,-3) IFIRST=.FALSE. PLTSIZ=10./RES CALL PLOT(0.,10.,2) CALL PLOT(10.,10.,1) CALL &&PLOT(10.,0.,1) CALL PLOT(0.,0.,1) RETURN C HP PLOTTER IS PICTURE DEVICE. 20 WRITE(OUTPUT,21) 21 FORMAT(' ',$) READ(INPUT,22) ANS 22 FORMAT(A1) IF(ANS.NE.'Y') GO TO 20 PLTSIZ=6666./RES WRITE(OUTPUT,23) 23 FORMAT(' PLTL') IX=0 IY=0 WRITE(OUTPUT,24) IX,IY 24 FORMAT(1X,2I6,'^') DO 25 I=1,3 IX=IX+2222 25 WRITE(OUTPUT,29) IX,IY DO 26 I=1,3 IY=IY+3333 26 WRITE(OUTPUT,29) IX,IY DO 27 I=1,&&3 IX=IX-2222 27 WRITE(OUTPUT,29) IX,IY DO 28 I=1,3 IY=IY-3333 28 WRITE(OUTPUT,29) IX,IY 29 FORMAT(1X,2I6) XLAST=0. YLAST=0. RETURN C TEKTRONIX SCOPE IS PICTURE DEVICE. 30 PLTSIZ=779./RES CALL CLHOA CALL MVTO(244,779) CALL VCTO(1023,779) CALL VCTO(1023,0) CALL VCTO(244,0) CALL VCTO(244,779) XLAST=244. YLAST=779. RETURN END && SUBROUTINE ENDFRM COMMON/DEVI/ INPUT,OUTPUT,ERROR COMMON/QFORIO/ CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC INTEGER OUTPUT,ERROR C IF CONTINUOUS-TONE THEN RETURN. C (NOTE: NO CONTINUOUS-TONE DEVICE CALL INCLUDED IN THIS VERSION.) IF(IDVICE.GT.0) RETURN IGO=IDVICE+2 IF(IGO) 10,20,30 C CALCOMP PLOTTER IS PICTURE DEVICE. 10 CALL PLOT(11.,0.,-3) RETURN C HP PLOTTER IS PICTURE DEVICE. 20 WRITE(OUTPUT,22) 22 FORMAT(' PLTT') RETURN C '' TEKTRONIX SCOPE IS PICTURE DEVICE. 30 CALL MVTO(0,767) CALL ALMODE RETURN END '' SUBROUTINE PLTLIN(A,B,C,D) COMMON/DEVI/ INPUT,OUTPUT,ERROR COMMON/PLTTER/ PLTSIZ,XLAST,YLAST COMMON/QFORIO/ CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC DIMENSION X(2),Y(2) INTEGER OUTPUT,ERROR C IF CONTINUOUS-TONE THEN RETURN. C (NOTE: NO CONTINUOUS-TONE DEVICE CALL INCLUDED IN THIS VERSION.) IF(IDVICE.GT.0) RETURN C SCALE INTERNAL COORDINATES TO DEVICE COORDINTES. X(1)=A*PLTSIZ Y(1)=B*PLTSIZ X(2)=C*PLTSIZ Y(2)=D*PLTSIZ C IF CONT((INUOUS-TONE THEN RETURN. C (NOTE: NO CONTINUOUS-TONE DEVICE CALL INCLUDED IN THIS VERSION.) IGO=IDVICE+2 IF(IGO) 10,20,30 C CALCOMP PLOTTER IS PICTURE DEVICE. 10 CALL LINE(X,Y,2,1) RETURN C HP PLOTTER IS PICTURE DEVICE. 20 Y(1)=1.5*Y(1) Y(2)=1.5*Y(2) IF(XLAST.EQ.X(1).AND.YLAST.EQ.Y(1)) GO TO 24 IX=X(1) IY=Y(1) WRITE(OUTPUT,22) IX,IY 22 FORMAT(1X,2I6,'^') 24 X1=X(2)-X(1) Y1=Y(2)-Y(1) ITEST=SQRT(2.25*X1*X1+Y1*Y1) ((J=ITEST/3333 IF(J.LE.0) GO TO 27 IX=X1 IY=Y1 IDELX=IX/(J+1) IDELY=IY/(J+1) IX=X(1) IY=Y(1) DO 25 I=1,J IX=IX+IDELX IY=IY+IDELY 25 WRITE(OUTPUT,28) IX,IY 27 IX=X(2) IY=Y(2) WRITE(OUTPUT,28) IX,IY 28 FORMAT(1X,2I6) XLAST=X(2) YLAST=Y(2) RETURN C TEKTRONIX SCOPE IS PICTURE DEVICE. 30 X(1)=244.+X(1) X(2)=244.+X(2) IF(XLAST.EQ.X(1).AND.YLAST.EQ.Y(1)) GO TO 34 IX=X(1) IY=Y(1) (( CALL MVTO(IX,IY) 34 IX=X(2) IY=Y(2) CALL VCTO(IX,IY) XLAST=X(2) YLAST=Y(2) RETURN END (( SUBROUTINE LABEL(X,Y,CHR,NCNT) COMMON/DEVI/ INPUT,OUTPUT,ERROR COMMON/PLTTER/ PLTSIZ,XLAST,YLAST COMMON/QFORIO/ CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC C IF CONTINUOUS-TONE THEN RETURN. C (NOTE: NO CONTINUOUS-TONE DEVICE CALL INCLUDED IN THIS VERSION.) INTEGER OUTPUT,ERROR IF(IDVICE.GT.0) RETURN C SCALE INTERNAL COORDINATES TO EXTERNAL COORDINSTES. XC=X*PLTSIZ YC=Y*PLTSIZ IGO=IDVICE+2 IF(IGO) 10,20,30 C CALCOMP PLOTTER IS PICTURE D))EVICE. 10 CALL SYMBOL(XC,YC,0.1,CHR,0.0,NCNT) RETURN C HP PLOTTER IS PICTURE DEVICE. 20 RETURN C TEKTRONIX SCOPE IS PICTURE DEVICE. 30 RETURN END )) SUBROUTINE SRL(X1,S1R,S1B,S1G,X2,S2R,S2B,S2G,IY) COMMON/CSAVIT/ISAVIT COMMON/QFORIO/CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC COMMON / CORE / IFREST, LEN, IFREPT COMMON / COMNIO / I CNT COMMON / PGNCNT / IPOLY DIMENSION LINEG(4),LINEB(4),LINER(4) COMMON/LINEF/ICR,LIN4R(128),ICG,LIN4G(128),ICB,LIN4B(128),IFORK DATA IFORK/0/ C PRINT 2, IY, X1,S1G,S1B,S1R, X2,S2G,S2B,S2R C (NOTE: NO CONTINUOUS-TONE DEVICE CALL INCLUDED IN THIS VERSION.) I1=X1+1.5 ** I2=X2+0.5 IF(I1.NE.1) GO TO 96 I3=1 I4=1 96 IF(I1-I2) 97,98,99 97 IF(S1R.EQ.S2R.AND.S1B.EQ.S2B.AND.S1G.EQ.S2G) GO TO 98 DX=I2-I1 DR=(S2R-S1R)/DX DB=(S2B-S1B)/DX DG=(S2G-S1G)/DX DO 200 I=I1,I2 LINER(I3)=ABS(S1R) LINEB(I3)=ABS(S1B) LINEG(I3)=ABS(S1G) S1R=S1R+DR S1B=S1B+DB S1G=S1G+DG IF(I3.NE.4) GO TO 200 LIN4R(I4)=LINER(1)*(2**28)+LINER(2)*(2**20) 1 +LINER(3)*(2**10)+LINER(4)*(2**2) LIN4B(**I4)=LINEB(1)*(2**28)+LINEB(2)*(2**20) 1 +LINEB(3)*(2**10)+LINEB(4)*(2**2) LIN4G(I4)=LINEG(1)*(2**28)+LINEG(2)*(2**20) 1 +LINEG(3)*(2**10)+LINEG(4)*(2**2) I3=0 I4=I4+1 200 I3=I3+1 GO TO 99 98 IR=ABS(S1R) IG=ABS(S1G) IB=ABS(S1B) DO 300 I=I1,I2 LINER(I3)=IR LINEB(I3)=IB LINEG(I3)=IG IF(I3.NE.4) GO TO 300 LIN4R(I4)=LINER(1)*(2**28)+LINER(2)*(2**20) 1 +LINER(3)*(2**10)+LINER(4)*(2**2) LIN4B(I4)=LINEB(1)*(2**28**)+LINEB(2)*(2**20) 1 +LINEB(3)*(2**10)+LINEB(4)*(2**2) LIN4G(I4)=LINEG(1)*(2**28)+LINEG(2)*(2**20) 1 +LINEG(3)*(2**10)+LINEG(4)*(2**2) I3=0 I4=I4+1 300 I3=I3+1 99 IF(I2.LT.511) RETURN I=512-IY I=I*(2**18) ICG="400000200000+I ICR="410000200000+I ICB="420000200000+I RETURN END **C**********************************************************************C C C C UTILITY.FOR VERSION 1.0(A) SEPTEMBER 1976 C C C C A GENERAL UTILITY ROUTINE FOR BOTH 8 NODE BRICKS AND C C PANEL SYSTEMS. C C C++ C MIKE STEPHENSON HANK CHRISTIANSEN C C DEPARTMENT OF CIVIL ENGR. CIVIL ENGINEERING DEPT. C C AND ENGINEERING MECHANICS 368E ESTB C C THE UNIVERSITY OF ARIZONA BRIGHAM YOUNG UNIVERSITY C C TUCSON, ARIZONA 85721 PROVO, UTAH 84602 C C (602) 884-4803 (801) 374-1211 X2811 C C ++C C**********************************************************************C INTEGER OUTPUT C DIMENSION NPL(2,NPMAX),X(3,NJMAX),IP(8,NPTMAX),U(3,NJMAX) C 1,S(NJMAX) DIMENSION NPL(2,10),X(3,100),IP(8,100),U(3,100),S(100) COMMON/CNTL/ NP,NJ,NPT COMMON/DEVI/ INPUT,OUTPUT C COMMON/FUNC/ SX(2,NJMAX) COMMON/FUNC/ SX(2,100) C COMMON/JUNK/ JNK(8,NPTMAX) COMMON/JUNK/ JNK(8,100) COMMON/MAXI/ NPMAX,NJMAX,NPTMAX C INPUT AND OUTPUT ARE SET BELOW FOR THE DEC++SYSTEM-10 INPUT=-4 OUTPUT=-1 NPMAX=10 NJMAX=100 NPTMAX=100 C TYPE TITLE FOR USER INFORMATION WRITE(OUTPUT,10) 10 FORMAT(' ') C INITIALIZE CONTROL VARIABLES AND REQUEST DATA TYPE NJ=0 NP=0 NPT=0 NTYPE=4 WRITE(OUTPUT,20) 20 FORMAT(' '$) READ(INPUT,100) WORD IF(WORD.EQ.'S') NTYPE=8 IF(NTYPE.EQ.4) NPTMAX=2*NPTMAX C REQUEST COMMAND AND PROCEED 30 ++ WORD=CMD(1) IF(WORD.EQ.'GEOM') CALL GEOM(NPL,X,IP,NTYPE) IF(WORD.EQ.'DISP') CALL DISP(U) IF(WORD.EQ.'FUNC') CALL SFUN(IP,S,NTYPE) IF(WORD.EQ.'SYMM') CALL SYMM(NPL,X,IP,U,S,NTYPE) IF(WORD.EQ.'ORDE') CALL ORDER(NPL,IP,NTYPE) IF(WORD.EQ.'HELP'.OR.WORD.EQ.'?'.OR.WORD.EQ.' ') CALL HELP(1) GO TO 30 100 FORMAT(A1) END ++ FUNCTION CMD(INDX) INTEGER OUTPUT DIMENSION CHR(3) COMMON/DEVI/ INPUT,OUTPUT DATA CHR/' >',' >>',' >>>'/ C TYPE COMMAND PROMPT WRITE(OUTPUT,100) CHR(INDX) 100 FORMAT(A5,$) C ACCEPT COMMAND WORD READ(INPUT,200) CMD 200 FORMAT(A4) IF(CMD.EQ.'EXIT') CALL EXIT RETURN END ,, SUBROUTINE HELP(INDX) INTEGER OUTPUT COMMON/DEVI/ INPUT,OUTPUT C JUMP TO APPROPRIATE HELP MESSAGE GO TO (100,200,300,400),INDX C LEVEL ONE HELP MESSAGE 100 WRITE(OUTPUT,110) 110 FORMAT(' ') RETURN C LEVEL TWO HELP MESSAGE 200 WRITE(OUTPUT,210) 210 FORMAT(' ') RETURN C LEVEL THREE HELP MESSAGE (ALL BUT GEOM-CHAN) 300 WRITE(OUTPUT,--310) 310 FORMAT(' ') RETURN C LEVEL THREE HELP MESSAGE (GEOM-CHAN ONLY) 400 WRITE(OUTPUT,410) 410 FORMAT(' ') RETURN END -- SUBROUTINE OVER(INDX) INTEGER OUTPUT COMMON/DEVI/ INPUT,OUTPUT COMMON/MAXI/ NPMAX,NJMAX,NPTMAX C JUMP TO APPROPRIATE ERROR MESSAGE GO TO (500,600,700),INDX C ERROR: NP .GT. NPMAX 500 WRITE(OUTPUT,510) NPMAX 510 FORMAT(' ?') STOP C ERROR: NJ .GT. NJMAX 600 WRITE(OUTPUT,610) NJMAX 610 FORMAT(' ?') STOP C ERROR: NPTMAX .GT. NPTMAX 700 WRITE(OUTPUT,71..0) NPTMAX 710 FORMAT(' ?') STOP END .. SUBROUTINE GEOM(NPL,X,IP,NTYPE) INTEGER OUTPUT DIMENSION NPL(2,1),X(3,1),IP(NTYPE,1) DIMENSION II(8) COMMON/CNTL/ NP,NJ,NPT COMMON/DEVI/ INPUT,OUTPUT COMMON/JUNK/ JP(1) COMMON/MAXI/ NPMAX,NJMAX,NPTMAX C REQUEST COMMAND WORD. RETURN IF BLANK. 100 WORD=CMD(2) IF(WORD.EQ.' ') RETURN C READ GEOMETRY FILE IF(WORD.NE.'READ') GO TO 200 CALL RDGEOM(NPL,X,IP,NTYPE) GO TO 100 C WRITE GEOMETRY FILE 200 IF(WORD.NE.'WRIT'//) GO TO 300 CALL WRGEOM(NPL,X,IP,NTYPE) GO TO 100 C CHANGE GEOMETRY FILE 300 IF(WORD.NE.'CHAN') GO TO 800 310 WORD=CMD(3) IF(WORD.EQ.' ') GO TO 100 C MOVE ELEMENTS IF(WORD.NE.'MOVE') GO TO 400 330 WRITE(OUTPUT,340) 340 FORMAT(' '$) READ(INPUT,1000) I1,I2,I3 IF(I1.EQ.0) GO TO 310 IF(I2.EQ.1) GO TO 350 I5=I2-1 CALL MOVE(IP,JP,1,I5,1,NTYPE) 350 I5=I1+I2-1 J4=NPT-I1+1 //CALL MOVE(IP,JP,I2,I5,J4,NTYPE) 360 I4=I1+I2 IF(I4.GT.NPT) GO TO 370 CALL MOVE(IP,JP,I4,NPT,I2,NTYPE) 370 IF(I3.EQ.0) GO TO 380 CALL MOVE(JP,IP,1,I3,1,NTYPE) 380 I4=I3+1 I5=NPT-I1 IF(I5.LT.I4) GO TO 390 J4=I1+I3+1 CALL MOVE(JP,IP,I4,I5,J4,NTYPE) 390 I4=NPT-I1+1 J4=I3+1 IF(I2.LT.I3) J4=J4-I1 CALL MOVE(JP,IP,I4,NPT,J4,NTYPE) GO TO 330 C PART GROUPS 400 IF(WORD.NE.'GROU') GO TO 500 WRITE(OUTPUT,410) 410 FORMAT(' '$) READ(INPUT,1000) NP IF(NP.GT.NPMAX) CALL OVER(1) WRITE(OUTPUT,430) 430 FORMAT(' ') READ(INPUT,1000) (NPL(1,I),I=1,NP) NPT=0 DO 440 I=1,NP 440 NPT=NPT+NPL(1,I) IF(NPT.GT.NPTMAX) CALL OVER(3) GO TO 310 C COORDINATES 500 IF(WORD.NE.'COOR') GO TO 600 WRITE(OUTPUT,510) 510 FORMAT(' '$) READ(INPUT,520) ANS 520 FORMAT(A1) IF(ANS.NE.'Y') GO TO 540 WRITE(OUTPU//T,530) 530 FORMAT(' '$) READ(INPUT,1000) NJ IF(NJ.GT.NJMAX) CALL OVER(2) 540 WRITE(OUTPUT,550) 550 FORMAT(' '$) READ(INPUT,560) I,X1,X2,X3 560 FORMAT(I,3E) IF(I.EQ.0) GO TO 310 IF(I.GT.NJMAX) CALL OVER(2) IF(I.GT.NJ) NJ=I X(1,I)=X1 X(2,I)=X2 X(3,I)=X3 GO TO 540 C ELEMENTS 600 IF(WORD.NE.'ELEM') GO TO 700 605 WRITE(OUTPUT,610) 610 FORMAT(' '$) READ(INPUT,615) WORD 615// FORMAT(A1) IF(WORD.EQ.'A') GO TO 620 IF(WORD.EQ.'D') GO TO 650 GO TO 605 C ADD ELEMENTS 620 WRITE(OUTPUT,625) 625 FORMAT(' '$) READ(INPUT,1000) J1,(II(I),I=1,NTYPE) IF(J1.EQ.0) GO TO 310 NP1=1 DO 630 I=1,J1 630 NP1=NP1+NPL(1,I) IF(NP1.GT.NPTMAX) CALL OVER(3) IF(NP1.GT.NPT) GO TO 640 J3=NPT+1 DO 638 J=NP1,NPT J2=J3-1 DO 634 I=1,NTYPE 634 IP(I,J3)=IP(I,J2) 638 J3=J2 640 DO 645 I=1,NTYPE //645 IP(I,NP1)=II(I) NPT=NPT+1 NPL(1,J1)=NPL(1,J1)+1 GO TO 620 C DELETE ELEMENTS 650 WRITE(OUTPUT,625) READ(INPUT,1000) J1,(II(I),I=1,NTYPE) IF(J1.EQ.0) GO TO 310 NP2=0 DO 655 I=1,J1 655 NP2=NP2+NPL(1,I) NP1=NP2-NPL(1,J1)+1 DO 664 J=NP1,NP2 J2=J+1 J3=0 DO 660 I=1,NTYPE IF(IP(I,J).NE.II(I)) GO TO 664 J3=J3+1 IF(J3.EQ.NTYPE) GO TO 670 660 CONTINUE 664 CONTINUE WRITE(OUTPUT,668) 668 FORMAT(' %') GO TO 650 670 DO 675 I=J2,NPT J3=I-1 DO 675 J=1,NTYPE 675 IP(J,J3)=IP(J,I) NPT=NPT-1 NPL(1,J1)=NPL(1,J1)-1 GO TO 650 C TYPE HELP MESSAGE IF COMMAND NOT RECOGNIZED 700 CALL HELP(4) GO TO 310 C PRINT DATA ON TTY 800 IF(WORD.NE.'PRIN') GO TO 900 810 WORD=CMD(3) IF(WORD.EQ.' ') GO TO 100 C PART GROUPS IF(WORD.NE.'GROU') GO TO 840 WRITE(OUTPUT,820) (NPL(1,I),I=1,NP) 820 FORMAT(' '/(1X,10I4)) GO TO 810 C COORDINATES 840 IF(WORD.NE.'COOR') GO TO 860 845 WRITE(OUTPUT,850) 850 FORMAT(' '$) READ(INPUT,1000) I1,I2 IF(I2.GT.NJ) I2=NJ IF(I1.EQ.0) GO TO 810 WRITE(OUTPUT,855) (J,(X(I,J),I=1,3),J=I1,I2) 855 FORMAT(1X,I4,1P3E12.4) GO TO 845 C ELEMENTS 860 IF(WORD.NE.'ELEM') GO TO 890 865 WRITE(OUTPUT,870) 870 FORMAT(' '$) READ(INPUT,1000) I1,I2 IF(I2.GT.NPT) I2=NPT IF(I1.EQ.0) GO// TO 810 IF(NTYPE.EQ.4) TYPE 875,(J,(IP(I,J),I=1,4),J=I1,I2) 875 FORMAT(1X,5I5) IF(NTYPE.EQ.8) TYPE 885,(J,(IP(I,J),I=1,8),J=I1,I2) 885 FORMAT(1X,9I5) GO TO 865 C TYPE HELP MESSAGE IF COMMAND NOT RECOGNIZED 890 CALL HELP(3) GO TO 810 C TYPE HELP MESSAGE IF COMMAND NOT RECOGNIZED 900 CALL HELP(2) GO TO 100 1000 FORMAT(20I) END // SUBROUTINE DISP(U) INTEGER OUTPUT DIMENSION U(3,1) COMMON/CNTL/ NP,NJ,NPT COMMON/DEVI/ INPUT,OUTPUT COMMON/MAXI/ NPMAX,NJMAX,NPTMAX C REQUEST COMMAND WORD. RETURN IF BLANK. 100 WORD=CMD(2) IF(WORD.EQ.' ') RETURN C READ DISPLACEMENT FILE IF(WORD.NE.'READ') GO TO 200 CALL RDDISP(U,NJ) GO TO 100 C WRITE DISPLACEMENT FILE 200 IF(WORD.NE.'WRIT') GO TO 300 CALL WRDISP(U,NJ) GO TO 100 C CHANGE DISPLACEMENTS 30000 IF(WORD.NE.'CHAN') GO TO 400 310 WRITE(OUTPUT,320) 320 FORMAT(' '$) READ(INPUT,330) I,X1,X2,X3 330 FORMAT(I,3E) IF(I.EQ.0) GO TO 100 IF(I.GT.NJMAX) CALL OVER(2) U(1,I)=X1 U(2,I)=X2 U(3,I)=X3 GO TO 310 C PRINT DISPLACEMENTS ON TTY 400 IF(WORD.NE.'PRIN') GO TO 500 405 WRITE(OUTPUT,410) 410 FORMAT(' '$) READ(INPUT,420) I1,I2 420 FORMAT(2I) IF(I1.EQ.0) GO TO 100 IF(I2.GT.NJ) I2=NJ WRI00TE(OUTPUT,430) (J,(U(I,J),I=1,3),J=I1,I2) 430 FORMAT(1X,I4,1PE12.4) GO TO 405 C TYPE HELP MESSAGE IF COMMAND NOT RECOGNIZED 500 CALL HELP(2) GO TO 100 END 00 SUBROUTINE SFUN(IP,S,NTYPE) INTEGER OUTPUT DIMENSION IP(NTYPE,1),S(1) COMMON/CNTL/ NP,NJ,NPT COMMON/DEVI/ INPUT,OUTPUT COMMON/MAXI/ NPMAX,NJMAX,NPTMAX C REQUEST COMMAND WORD. RETURN IF BLANK. 100 WORD=CMD(2) IF(WORD.EQ.' ') RETURN C READ SCALAR FUNCTION FILE IF(WORD.NE.'READ') GO TO 200 CALL RDSFUN(IP,S,NTYPE) GO TO 100 C WRITE SCALAR FUNCTION FILE 200 IF(WORD.NE.'WRIT') GO TO 300 CALL WRSFUN(S) GO TO 100 C 11 CHANGE SCALAR FUNCTIONS 300 IF(WORD.NE.'CHAN') GO TO 400 310 WRITE(OUTPUT,320) 320 FORMAT(' '$) READ(INPUT,330) I,X1 330 FORMAT(I,E) IF(I.EQ.0) GO TO 100 IF(I.GT.NJMAX) CALL OVER(2) S(I)=X1 GO TO 310 C PRINT SCALAR FUNCTIONS ON TTY 400 IF(WORD.NE.'PRIN') GO TO 500 410 WRITE(OUTPUT,420) 420 FORMAT(' '$) READ(INPUT,430) I1,I2 430 FORMAT(2I) IF(I1.EQ.0) GO TO 310 IF(I2.LT.I1) I2=I1 IF(I1.GT.NJ) 11GO TO 410 IF(I2.GT.NJ) I2=NJ WRITE(OUTPUT,440) (I,S(I),I=I1,I2) 440 FORMAT(1X,I4,1PE12.4) GO TO 410 C TYPE HELP MESSAGE IF COMMAND NOT RECOGNIZED 500 CALL HELP(2) GO TO 100 END 11 SUBROUTINE SYMM(NPL,X,IP,U,S,NTYPE) INTEGER OUTPUT DIMENSION NPL(2,1),X(3,1),IP(NTYPE,1),U(3,1),S(1) COMMON/CNTL/ NP,NJ,NPT COMMON/DEVI/ INPUT,OUTPUT COMMON/JUNK/ IX(1) COMMON/MAXI/ NPMAX,NJMAX,NPTMAX LOGICAL MULTI C REQUEST SYMMETRY PLANE. RETURN IF BLANK. 100 WRITE(OUTPUT,110) 110 FORMAT(' '$) READ(INPUT,120) SYMP 120 FORMAT(A2) IF(SYMP.EQ.' ') RETURN ISYM=0 IF(SYMP.EQ.'XY') ISYM=3 IF(SYMP.22EQ.'XZ') ISYM=2 IF(SYMP.EQ.'YZ') ISYM=1 IF(ISYM.EQ.0) GO TO 100 C MULTIPLE DISPLACEMENT AND SCALAR FUNCTION FILES? WRITE(OUTPUT,200) 200 FORMAT(' '$) READ(INPUT,210) ANS 210 FORMAT(A1) MULTI=ANS.EQ.'Y' C ARRAY IX GETS SYMMETRY MAPPING OF NODE NUMBERS IF(NP+NP.GT.NPMAX) CALL OVER(1) IF(NPT+NPT.GT.NPTMAX) CALL OVER(3) NPT=0 DO 300 I=1,NP NPT=NPT+NPL(1,I) 300 NPL(1,I+NP)=NPL(1,I) K=0 DO 310 I=1,NJ 22 IX(I)=I+NJ-K IF(X(ISYM,I).NE.0.0) GO TO 310 IX(I)=I K=K+1 310 CONTINUE IF(NJ+NJ-K.GT.NJMAX) CALL OVER(2) C USE ARRAY IX TO FORM SYMMETRY ELEMENTS DO 400 J=1,NPT J1=J+NPT DO 400 I=1,NTYPE,2 I1=IP(I,J) I2=IP(I+1,J) IP(I+1,J1)=IX(I1) IP(I,J1)=IX(I2) 400 CONTINUE C USE ARRAY IX TO FORM SYMMETRY COORDINATES DO 510 J=1,NJ J1=IX(J) IF(J1.LE.NJ) GO TO 510 DO 500 I=1,3 500 X(I,J1)=X(I,J) X(ISYM,J1)22=-X(ISYM,J1) 510 CONTINUE NFILES=0 IF(.NOT.MULTI) GO TO 615 C USE ARRAY IX TO FORM SYMMETRY DISPLACEMENTS WRITE(OUTPUT,600) 600 FORMAT(' '$) READ(INPUT,610) NFILES 610 FORMAT(I) 615 DO 640 N=1,NFILES IF(MULTI) CALL RDDISP(U) DO 630 J=1,NJ J1=IX(J) IF(J1.LE.NJ) GO TO 630 DO 620 I=1,3 620 U(I,J1)=U(I,J) U(ISYM,J1)=-U(ISYM,J1) 630 CONTINUE IF(MULTI) CALL WRDISP(U) 640 CONTINUE IF(.NOT.MULTI) GO TO 71225 C USE ARRAY IX TO FORM SYMMETRY SCALAR FUCTIONS 700 WRITE(OUTPUT,710) 710 FORMAT(' '$) READ(INPUT,610) NFILES 715 DO 730 N=1,NFILES IF(MULTI) CALL RDSFUN(IP,S,NTYPE) DO 720 J=1,NJ J1=IX(J) IF(J1.LE.NJ) GO TO 720 S(J1)=S(J) 720 CONTINUE IF(MULTI) CALL WRSFUN(S) 730 CONTINUE C CALCULATE NEW VALUES FOR NP, NJ, AND NPT 800 NP=NP+NP NJ=NJ+NJ-K NPT=NPT+NPT RETURN END 22 SUBROUTINE MOVE(IP,IQ,L,M,N,NTYPE) DIMENSION IP(NTYPE,1),IQ(NTYPE,1) C MOVE ELEMENTS L THRU M OF IP TO IQ STARTING AT N+1 J1=N-L DO 10 J=L,M J2=J+J1 DO 10 I=1,NTYPE 10 IQ(I,J2)=IP(I,J) RETURN END 33 SUBROUTINE ORDER(NPL,IP,NTYPE) INTEGER OUTPUT DIMENSION NPL(2,1),IP(NTYPE,1) COMMON/CNTL/ NP,NJ,NPT COMMON/DEVI/ INPUT,OUTPUT C NOT AVAILABLE FOR SOLID DATA IF(NTYPE.EQ.4) GO TO 200 WRITE(OUTPUT,100) 100 FORMAT(' %') RETURN C PROCESS EACH PART INDIVIDUALLY 200 M2=0 DO 600 N=1,NP M1=M2+1 M2=M2+NPL(1,N) M3=M1+1 C COMPARE THE NTH THRU LAST ELEMENT WITH THOSE ALREADY ORDERED 44 DO 500 M=M3,M2 L1=M-1 L2=L1+M1 IPT=M C SEARCH THE PREVIOUSLY ORDERED POLYGONS BACKWARDS 210 DO 400 L3=M1,L1 L=L2-L3 C SEARCH FOR A CORRESPONDING NODE NUMBER THEN CHECK LINE C SEGMENT FORWARD AND BACKWARD DO 300 K=1,4 DO 250 J=1,4 IF(IP(J,IPT).NE.IP(K,L).OR.IP(J,IPT).EQ.0) GO TO 250 J1=J+1 IF(J1.GT.4.OR.IP(J1,IPT).EQ.0) J1=1 K1=K+1 IF(K1.GT.4.OR.IP(K1,L).EQ.0) K1=1 J2=J-1 IF(J2.LT.1) J2=4 IF(IP(J2,44IPT).EQ.0) J2=3 K2=K-1 IF(K2.LT.1) K2=4 IF(IP(K2,L).EQ.0) K2=3 IF(IP(J1,IPT).EQ.IP(K1,L).OR.IP(J2,IPT).EQ.IP(K2,L)) GO TO 220 IF(IP(J2,IPT).NE.IP(K1,L).AND.IP(J1,IPT).NE.IP(K2,L)) GO TO 400 GO TO 450 C REVERSE POLYGON NODES IF NOT CONSISTENT WITH PROCESSED DATA 220 ITEMP=IP(1,IPT) IP(1,IPT)=IP(3,IPT) IP(3,IPT)=ITEMP GO TO 450 250 CONTINUE 300 CONTINUE 400 CONTINUE C IF CURRENT POLYGON DOES NOT MATCH ANY PREVIOUS POLYGON, C MOV44E POINTER TO NEXT POLYGON AND TRY AGAIN IPT=IPT+1 IF(IPT.LE.M2) GO TO 210 C IF POINTER IS GREATER THAN THE NUMBER OF ELEMENTS, THEN C THIS POLYGONS HAS NO NEIGHBOR WRITE(OUTPUT,410) M 410 FORMAT(' %') GO TO 500 C IF THE LAST ORDERED POLYGON IS NOT THE SAME AS THE CURRENT C POLYGON, THEN EXCHANGE THEM 450 IF(IPT.EQ.M) GO TO 500 DO 460 I=1,4 ITEMP=IP(I,M) IP(I,M)=IP(I,IPT) 460 IP(I,IPT)=ITEMP 54400 CONTINUE 600 CONTINUE RETURN END 44 SUBROUTINE OPEN(FILEID,IUNIT,IOP,IERROR) C SUBROUTINE OPEN REQUEST FILENAME AND OPENS FILE FOR I/O C SUBPROGRAMS CALLED C OPEN = SYSTEM OPEN FILE ROUTINE C VARIABLES USED C FILEID = 5 ASCII CHARACTER ID C IUNIT = DEVICE LOGICAL NUMBER C IOP = 1 FOR INPUT FILE C = -1 FOR OUTPUT FILE C IERROR = 1 ON SUCCESSFUL COMPLETION C = 0 ON EMPTY FILE SPECIFICATION C = -1 ON FAILURE DOUBLE PRECISION ASEQ,BLANK,XNAME 55 INTEGER OUTPUT COMMON/DEVI/ INPUT,OUTPUT DATA DSK/'DSK'/,MTA/'MTA'/ DATA BLANK/' '/ IERROR=0 OPTYPE='READ' IF(IOP.LT.0) OPTYPE='WRITE' WRITE(OUTPUT,10) OPTYPE,FILEID 10 FORMAT(' <',A5,1X,A5,' FILE> '$) READ(INPUT,20) XNAME 20 FORMAT(A10) IF(XNAME.EQ.BLANK) RETURN IERROR=1 IUNIT=10 ASEQ='SEQIN' IF(IOP.LT.0) ASEQ='SEQOUT' OPEN(UNIT=IUNIT,DEVICE=DSK,FILE=XNAME,ACCESS=ASEQ,MODE='ASCII') RETURN END55 55 SUBROUTINE RDGEOM(NPL,X,IP,N) INTEGER OUTPUT DIMENSION NPL(2,1),X(3,1),IP(N,1) COMMON/CNTL/ NP,NJ,NPT COMMON/DEVI/ INPUT,OUTPUT COMMON/MAXI/ NPMAX,NJMAX,NPTMAX DATA IREAD/1/ C REQUEST FILE INFORMATION 10 CALL OPEN('GEOM.',IUNIT,IREAD,IERR) IF(IERR) 10,50,20 C READ GEOMETRY 20 READ(IUNIT,120) NP,NJ,NPT IF(NP.GT.NPMAX) CALL OVER(1) IF(NJ.GT.NJMAX) CALL OVER(2) IF(NPT.GT.NPTMAX) CALL OVER(3) READ(IUNIT,120) ((NPL(I,J),I66=1,2),J=1,NP) READ(IUNIT,130) ((X(I,J),I=1,3),J=1,NJ) READ(IUNIT,120) ((IP(I,J),I=1,N),J=1,NPT) WRITE(OUTPUT,22) ((NPL(I,J),I=1,2),J=1,NP) 22 FORMAT(' '/(1X,10I5)) NPT1=0 DO 24 J=1,NP NPL(1,J)=NPL(2,J)-NPL(1,J)+1 NPL(2,J)=0 24 NPT1=NPT1+NPL(1,J) IF(NPT1.NE.NPT) GO TO 30 WRITE(OUTPUT,28) (NPL(1,J),J=1,NP) 28 FORMAT(' '/(1X,10I5)) WRITE(OUTPUT,140) READ(INPUT,150) ANS IF(ANS.NE.'Y') GO TO 6634 RETURN C REQUEST PART GROUPINGS 30 WRITE(OUTPUT,32) 32 FORMAT(' ') 34 WRITE(OUTPUT,36) 36 FORMAT(' '$) READ(INPUT,100) NP IF(NP.GT.NPMAX) CALL OVER(1) DO 38 J=1,NP 38 NPL(2,J)=0 WRITE(OUTPUT,40) 40 FORMAT(' ') READ(INPUT,100) (NPL(1,I),I=1,NP) 50 RETURN 100 FORMAT(20I) 120 FORMAT(20I4) 130 FORMAT(1P6E12.5) 140 FORMAT(' '$) 150 FORMAT(A1) END 66 SUBROUTINE WRGEOM(NPL,X,IP,N) INTEGER OUTPUT DIMENSION NPL(2,1),X(3,1),IP(N,1) COMMON/CNTL/ NP,NJ,NPT COMMON/DEVI/ INPUT,OUTPUT COMMON/MAXI/ NPMAX,NJMAX,NPTMAX DATA IWRITE/-1/ C REQUEST FILE INFORMATION 60 CALL OPEN('GEOM.',IUNIT,IWRITE,IERR) IF(IERR) 60,95,70 C REQUEST ELEMENT LIMITS FOR PARTS LIST 70 NPT1=0 DO 74 J=1,NP NPL(2,J)=NPT1+NPL(1,J) NPL(1,J)=NPT1+1 74 NPT1=NPL(2,J) WRITE(OUTPUT,78) ((NPL(I,J),I=1,2),77J=1,NP) 78 FORMAT(' '/(1X,10I5)) WRITE(OUTPUT,140) READ(INPUT,150) ANS IF(ANS.EQ.'Y') GO TO 90 WRITE(OUTPUT,80) 80 FORMAT(' '$) READ(INPUT,100) NP IF(NP.GT.NPMAX) CALL OVER(1) WRITE(OUTPUT,85) 85 FORMAT(' ') READ(INPUT,100) ((NPL(I,J),I=1,2),J=1,NP) C WRITE GEOMETRY FILE 90 WRITE(IUNIT,120) NP,NJ,NPT WRITE(IUNIT,120) ((NPL(I,J),I=1,2),J=1,NP) WRITE(IUNIT,130) ((X(I,J),I=177,3),J=1,NJ) WRITE(IUNIT,120) ((IP(I,J),I=1,N),J=1,NPT) 95 RETURN 100 FORMAT(20I) 120 FORMAT(20I4) 130 FORMAT(6E12.5) 140 FORMAT(' '$) 150 FORMAT(A1) END 77 SUBROUTINE RDSFUN(IP,S,N) INTEGER OUTPUT DIMENSION IP(N,1),S(1) COMMON/CNTL/ NP,NJ,NPT COMMON/DEVI/ INPUT,OUTPUT COMMON/JUNK/ SX(2,1) DATA IREAD/1/ C REQUEST FILE INFORMATION 10 CALL OPEN('SFUN.',IUNIT,IREAD,IERR) IF(IERR) 10,80,20 C ARE THE SCALAR FUNCTIONS DEFINED AT THE ELEMENT CENTERS? 20 WRITE(OUTPUT,30) 30 FORMAT(' '$) READ(INPUT,40) ANS 40 FORMAT(A1) N1=NJ IF(ANS.EQ.'Y') N1=NPT C READ SCALA88R FUNCTIONS READ(IUNIT,100) (S(I),I=1,N1) IF(N1.EQ.NJ) RETURN C DO SIMPLE INTERPOLATION IF AT ELEMENT CENTERS. DO 50 J=1,NJ SX(1,J)=0. 50 SX(2,J)=0. DO 60 J=1,NPT DO 60 I=1,N I1=IP(I,J) SX(1,I1)=S(J)+SX(1,I1) 60 SX(2,I1)=1.0+SX(2,I1) DO 70 I=1,NJ 70 S(I)=SX(1,I)/SX(2,I) 80 RETURN 100 FORMAT(6E12.5) END 88 SUBROUTINE WRSFUN(S) INTEGER OUTPUT DIMENSION S(1) COMMON/CNTL/ NP,NJ,NPT COMMON/DEVI/ INPUT,OUTPUT DATA IWRITE/-1/ C REQUEST FILE INFORMATION 85 CALL OPEN('SFUN.',IUNIT,IWRITE,IERR) IF(IERR) 85,95,90 C WRITE SCALAR FUNCTIONS 90 WRITE(IUNIT,110) (S(I),I=1,NJ) 95 RETURN 110 FORMAT(1P6E12.5) END 99 SUBROUTINE RDDISP(U) INTEGER OUTPUT DIMENSION U(3,1) COMMON/CNTL/ NP,NJ,NPT COMMON/DEVI/ INPUT,OUTPUT DATA IREAD/1/ C REQUEST FILE INFORMAT 10 CALL OPEN('DISP.',IUNIT,IREAD,IERR) IF(IERR) 10,30,20 C READ DISPLACEMENTS 20 READ(IUNIT,100) ((U(I,J),I=1,3),J=1,NJ) 30 RETURN 100 FORMAT(6E12.5) END :: SUBROUTINE WRDISP(U) INTEGER OUTPUT DIMENSION U(3,1) COMMON/CNTL/ NP,NJ,NPT COMMON/DEVI/ INPUT,OUTPUT DATA IWRITE/-1/ C REQUEST FILE INFORMAT 50 CALL OPEN('DISP.',IUNIT,IWRITE,IERR) IF(IERR) 50,70,60 C WRITE DISPLACEMENTS 60 WRITE(IUNIT,110) ((U(I,J),I=1,3),J=1,NJ) 70 RETURN 110 FORMAT(1P6E12.5) END ;;C**********************************************************************C C C C SECTION.FOR VERSION 1.0(A) SEPTEMBER 1976 C C C C SECTION.FOR - CLIPS AND CAPS EIGHT NODE BRICK THREE-DIMENSIONAL C C FINITE ELEMENT MODELS, ELEMINATES INTERIOR POLYGONS, AND C C MODIFIES DISPLACEMENT AND SCALAR FUNCTIONS TO REFLECT THIS C<< C NEW GEOMETRY. C C C C MIKE STEPHENSON HANK CHRISTIANSEN C C DEPARTMENT OF CIVIL ENGR. CIVIL ENGINEERING DEPT. C C AND ENGINEERING MECHANICS 368E ESTB C C THE UNIVERSITY OF ARIZONA BRIGHAM YOUNG UNIVERSITY C C TUCSON, ARIZONA 85721 PROVO, UTAH 84602 <<C C (602) 884-4803 (801) 374-1211 X2811 C C C C**********************************************************************C C SUBPROGRAMS CALLED C RDCNTL = READS CONTROL VARIABLES C RDGEOM = READS GEOMETRY C PLFILE = CLIPPING PLANE DEFINITION ROUTINE C DIST = DISTANCE TO CLIPPING PLANE ROUTINE C SOLID = CLIPPING AND CAPPING ROUTINE C PLYSRT = POLYGON SORTING ROUTINE C REDUCE = DAT<<A REDUCTION ROUTINE C TRANS = DATA TRANSFORMATION ROUTINE C WRGEOM = WRITES GEOMETRY FILE C RDDISP = READS DISPLACEMENT FILE C WRDISP = WRITES DISPLACEMENT FILE C RDSFUN = READS SCALAR FUNCTION FILE C WRSFUN = WRITES SCALAR FUNCTION FILE C VARIABLES USED C A = COMMON BLOCKSTORAGE C A(N1) = NPL = ELEMENT LIMIT ARRAY BY PART C A(N2) = X = COORDINATE ARRAY BY NODE C A(N3) = IP = CONNECTIVITY ARRAY BY ELEMENT C A(N4) = IPL = CLIPPIN<<G PLANE NUMBER BY PART C A(N5) = PLP = POINT ON PLANE BY PART C A(N6) = PLD = NORMAL TO PLANE BY PART C A(N7) = D = DISTANCE TO PLANE BY NODE C = ICOL = NODAL REDUCTION ARRAY C A(N8) = DFAC = PROPORTION OF LINE ARRAY C A(N9) = IFAC = NODES OF CLIPPED LINE SEGMENTS C A(N10) = NPLN = ELEMENT LIMITS OF CLIPPED PARTS C = U = DISPLACEMENT ARRAY C = S = SCALAR FUNCTION ARRAY C << A(N11) = IPN = NEW CONNECTIVITY ARRAY AFTER CLIPPING C = SX = SCALAR FUNCTION INTERPOLATION ARRAY C = UN = NEW DISPLACEMT ARRAY AFTER TRANSFORM C = SN = NEW SCALAR FUNCTION ARRAY AFTER TRANSFORM C A(N12) = XN = NEW COORDINATE ARRAY AFTER TRANSFORM C NJ = NUMBER OF JOINTS OR NODES C NP = NUMBER OF PARTS C NPT = NUMBER OF ELEMENTS C MTOT = SIZE OF COMMON BLOCK A C IFILES = NUMBER OF DISP. OR FUNC. FILES C IFIL <<= DISP. OR FUNC. FILE NUMBER C ICOOR = COORDINATE HASH TABLE C IPOLY = POLYGON HASH TABLE C JNK = TEMPORARY COMMON STORAGE C NPN = NUMBER OF PARTS IN NEW GEOMETRY C NJN = NUMBER OF JOINTS IN NEW GEOMETRY C NPTN = NUMBER OF ELEMENTS IN NEW GEOMETRY C IORD = HEXAHEDRON NODE NUMBER MAP C ITOTAL = NUMBER OF TOTAL STEPS BETWEEN INITAL AND FINAL PLANES C ISTEP = CLIPPING STEP NUMBER C ISIDE = 'FRON' SAVE ONLY POLYGONS IN FRONT OF PLANE C = 'BACK' SAVE ONLY POLYG<<ONS BEHIND PLANE C = 'BOTH' SAVE ALL POLYGONS C IPLAST = PLANE NUMBER OF LAST CLIPPING PLANE INTEGER OUTPUT COMMON A(10000) COMMON/CONT/ NP,NJ,NPT COMMON/DEVI/ INPUT,OUTPUT COMMON/FREE/ MIN,MAX,IAVAIL COMMON/HASH/ ICOOR(128),IPOLY(128) COMMON/JUNK/ JNK(50) COMMON/NCON/ NPN,NJN,NPTN COMMON/ORDR/ IORD(4,6) COMMON/STEP/ ITOTAL,ISTEP,ISIDE,IPLAST DIMENSION IA(10000) EQUIVALENCE (A,IA) INPUT=-4 OUTPUT=-1 IP<<LAST=-1 MTOT=10000 WRITE(OUTPUT,1000) C READ GEOMETRY FILE CALL RDCNTL(NP,NJ,NPT) NPN=4*NP C CALCULATE ARRAY INDEXES NJ2=(NJ+1)/2 N1=1 N2=N1+2*NP N3=N2+3*(NJ+NJ2) N4=N3+8*NPT N5=N4+NP N6=N5+6*NP N7=N6+6*NP N8=N7+NJ N9=N8+NJ2 N10=N9+2*NJ2 C READ GEOMETRY CALL RDGEOM(IA(N1),A(N2),IA(N3)) C READ CLIPPING PLANE DEFINITION CALL PLFILE(IA(N4),A(N5),A(N6)) C CALCULATE VIEWABLE POLY<<GONS C (PROCEED STEP BY STEP AND PART BY PART) DO 600 ISTEP=1,ITOTAL NPTN=0 NJN=NJ MAX=MTOT IAVAIL=0 N11=N10+2*NPN C ZERO POLYGON HASH TABLE DO 100 I=1,128 100 ICOOR(I)=0 DO 200 K=1,NP KSAFE=K C 2. CALCULATE DISTANCE FROM PLANE CALL DIST(A(N2),IA(N4),A(N5),A(N6),A(N7),KSAFE) C 3. CALCULATE INTERSECTION N12=N11+4*NPTN MIN=N12 CALL SOLID(IA(N1),A(N2),IA(N3),IA(N4),A(N7),A(N8),IA(N9),KSAFE) C 4. SO<<RT AND STORE POLYGON LIST CALL PLYSRT(IA(N10),IA(N11),KSAFE) 200 CONTINUE C SELECT USEABLE DATA AND RENUMBER NODES CALL REDUCE(IA(N7),IA(N11)) C PREFORM TRANSFORMATION OF COORDINATES N12=N11+4*NPTN CALL TRGEOM(A(N2),IA(N7),A(N8),IA(N9),A(N12)) CALL WRGEOM(IA(N10),A(N12),IA(N11)) C PERFORM TRANSFORMATION ON DISPLACEMENT AND SPECIAL C FUNCTION FILES N11=N10+3*NJ C 1. DISPLACEMENT FILES WRITE(OUTPUT,1010) READ(INPUT,1020) IFILE<<S IF(IFILES.LE.0) GO TO 400 DO 300 IFIL=1,IFILES CALL RDDISP(A(N10)) CALL TRDISP(A(N10),IA(N7),A(N8),IA(N9),A(N11)) 300 CALL WRDISP(A(N11)) C 2. SPECIAL FUNCTION FILES 400 WRITE(OUTPUT,1030) READ(INPUT,1020) IFILES IF(IFILES.LE.0) GO TO 600 DO 500 IFIL=1,IFILES CALL RDSFUN(A(N3),A(N10),A(N11)) CALL TRSFUN(A(N10),IA(N7),A(N8),IA(N9),A(N11)) 500 CALL WRSFUN(A(N11)) 600 IPLAST=-1 1000 FORMAT(' '//) <<1010 FORMAT(' ',$) 1020 FORMAT(I) 1030 FORMAT(' ',$) END << BLOCK DATA C BLOCK DATA - HEXAHEDRON NODE NUMBER MAP INITIALIZATION C VARIABLES USED C IORD = HEXAHEDRON NODE NUMBER MAP COMMON/ORDR/ IORD(4,6) DATA IORD/1,2,3,4,5,8,7,6 1 ,1,5,6,2,4,3,7,8 2 ,1,4,8,5,2,6,7,3/ END == SUBROUTINE OPEN(FILEID,IUNIT,IOP,IERROR) C SUBROUTINE OPEN REQUEST FILENAME AND OPENS FILE FOR I/O C SUBPROGRAMS CALLED C OPEN = SYSTEM OPEN FILE ROUTINE C VARIABLES USED C FILEID = 5 ASCII CHARACTER ID C IUNIT = DEVICE LOGICAL NUMBER C IOP = 1 FOR INPUT FILE C = -1 FOR OUTPUT FILE C IERROR = 1 ON SUCCESSFUL COMPLETION C = 0 ON EMPTY FILE SPECIFICATION C = -1 ON FAILURE DOUBLE PRECISION ASEQ,BLANK,XNAME INTEGER OUTPUT>> COMMON/DEVI/ INPUT,OUTPUT DATA DSK/'DSK'/,MTA/'MTA'/ DATA BLANK/' '/ IERROR=0 OPTYPE='READ' IF(IOP.LT.0) OPTYPE='WRITE' WRITE(OUTPUT,10) OPTYPE,FILEID 10 FORMAT(' <',A5,1X,A5,' FILE> ',$) READ(INPUT,20) XNAME 20 FORMAT(A10) IF(XNAME.EQ.BLANK) RETURN IERROR=1 IUNIT=10 ASEQ='SEQIN' IF(IOP.LT.0) ASEQ='SEQOUT' OPEN(UNIT=IUNIT,DEVICE=DSK,FILE=XNAME,ACCESS=ASEQ,MODE='ASCII') RETURN END >> SUBROUTINE RDCNTL(NP,NJ,NPT) COMMON/GEOM/ IUNIT,IERR DATA IREAD/1/ C REQUEST FILE INFORMATION 10 CALL OPEN('GEOM.',IUNIT,IREAD,IERR) IF(IERR) 10,50,20 C READ CONTROL VARIABLES 20 READ(IUNIT,100) NP,NJ,NPT 50 RETURN 100 FORMAT(20I4) END ?? SUBROUTINE RDGEOM(NPL,X,IP) DIMENSION NPL(2,1),X(3,1),IP(8,1) COMMON/CONT/ NP,NJ,NPT COMMON/GEOM/ IUNIT,IERR DATA IREAD/1/ C READ GEOMETRY IF(IERR.EQ.0) RETURN READ(IUNIT,100) ((NPL(I,J),I=1,2),J=1,NP) READ(IUNIT,110) ((X(I,J),I=1,3),J=1,NJ) READ(IUNIT,100) ((IP(I,J),I=1,8),J=1,NPT) RETURN 100 FORMAT(20I4) 110 FORMAT(6E12.5) END @@ SUBROUTINE WRGEOM(NPL,X,JP) DIMENSION NPL(2,1),X(3,1),JP(4,1) COMMON/NCON/ NPN,NJN,NPTN DATA IWRITE/-1/ C REQUEST FILE INFORMATION 60 CALL OPEN('GEOM.',IUNIT,IWRITE,IERR) IF(IERR) 60,90,70 C WRITE GEOMETRY FILE 70 WRITE(IUNIT,120) NPN,NJN,NPTN WRITE(IUNIT,120) ((NPL(I,J),I=1,2),J=1,NPN) WRITE(IUNIT,130) ((X(I,J),I=1,3),J=1,NJN) WRITE(IUNIT,120) ((JP(I,J),I=1,4),J=1,NPTN) 90 RETURN 120 FORMAT(20I4) 130 FORMAT(1P6E12.5) END AA SUBROUTINE RDSFUN(IP,S,SX) INTEGER OUTPUT DIMENSION IP(8,1),S(1),SX(2,1) COMMON/CONT/ NP,NJ,NPT COMMON/DEVI/ INPUT,OUTPUT DATA IREAD/1/ C REQUEST FILE INFORMATION 10 CALL OPEN('SFUN.',IUNIT,IREAD,IERR) IF(IERR) 10,80,20 C ARE THE SCALAR FUNCTIONS DEFINED AT THE ELEMENT CENTERS? 20 WRITE(OUTPUT,30) 30 FORMAT(' ',$) READ(INPUT,40) ANS 40 FORMAT(A1) N1=NJ IF(ANS.EQ.'Y') N1=NPT C READ SCALAR FUNCTIONS BB READ(IUNIT,100) (S(I),I=1,N1) IF(N1.EQ.NJ) RETURN C DO SIMPLE INTERPOLATION IF AT ELEMENT CENTERS. DO 50 J=1,NJ SX(1,J)=0. 50 SX(2,J)=0. DO 60 J=1,NPT DO 60 I=1,8 I1=IP(I,J) SX(1,I1)=S(J)+SX(1,I1) 60 SX(2,I1)=1.0+SX(2,I1) DO 70 I=1,NJ 70 S(I)=SX(1,I)/SX(2,I) 80 RETURN 100 FORMAT(6E12.5) END BB SUBROUTINE WRSFUN(S) INTEGER OUTPUT DIMENSION S(1) COMMON/DEVI/ INPUT,OUTPUT COMMON/NCON/ NPN,NJN,NPTN DATA IWRITE/-1/ C REQUEST FILE INFORMATION 85 CALL OPEN('SFUN.',IUNIT,IWRITE,IERR) IF(IERR) 85,95,90 C WRITE SCALAR FUNCTIONS 90 WRITE(IUNIT,110) (S(I),I=1,NJN) 95 RETURN 110 FORMAT(1P6E12.5) END CC SUBROUTINE RDDISP(U) DIMENSION U(3,1) COMMON/CONT/ NP,NJ,NPT DATA IREAD/1/ C REQUEST FILE INFORMAT 10 CALL OPEN('DISP.',IUNIT,IREAD,IERR) IF(IERR) 10,30,20 C READ DISPLACEMENTS 20 READ(IUNIT,100) ((U(I,J),I=1,3),J=1,NJ) 30 RETURN 100 FORMAT(6E12.5) END DD SUBROUTINE WRDISP(U) DIMENSION U(3,1) COMMON/NCON/ NPN,NJN,NPTN DATA IWRITE/-1/ C REQUEST FILE INFORMAT 50 CALL OPEN('DISP.',IUNIT,IWRITE,IERR) IF(IERR) 50,70,60 C WRITE DISPLACEMENTS 60 WRITE(IUNIT,110) ((U(I,J),I=1,3),J=1,NJN) 70 RETURN 100 FORMAT(6E) 110 FORMAT(1P6E12.5) END EE SUBROUTINE PLFILE(IPL,PLP,PLD) C SUBROUTINE PLFILE - REQUEST INFORMATION NECESSARY TO DEFINE THE C CLIPPING PLANE FOR EACH PART IN THE MODEL AND ALSO WHICH C DATA IS TO BE SAVED. C VARIABLES USED C IPL = PLANE NUMBER BY PART C PLP = POINT ON PLANE BY PART C PLD = NORMAL TO PLANE BY PART C ITOTAL = TOTAL STEPS BETWEEN INITIAL AND FINAL PLANES C ISTEP = STEP NUMBER C ISIDE = 'FRON' TO SAVE ONLY POLYGONS IN FRONT OF CLIPPING PLANE C = 'BACK' TO SAVE ONLY POFFLYGONS BEHIND CLIPPING PLANE C = 'BOTH' TO SAVE ALL POLYGONS INTEGER OUTPUT DIMENSION IPL(1),PLP(3,2,1),PLD(3,2,1) COMMON/CONT/ NP,NJ,NPT COMMON/DEVI/ INPUT,OUTPUT COMMON/JUNK/ K1,K2,PLPJ(3,2),PLDJ(3,2) COMMON/STEP/ ITOTAL,ISTEP,ISIDE C INITIALIZE VARIABLES ITOTAL=1 ISIDE='FRON' DO 10 I=1,NP 10 IPL(I)=0 N=0 C REQUEST NUMBER OF STEPS WRITE(OUTPUT,100) READ(INPUT,110) ITTL IF(ITTL-1) RETURN ITOTAL=IFFTTL C REQUEST PLANE DEFINITION BY PARTS WRITE(OUTPUT,120) 20 READ(INPUT,110) K1,K2,((PLPJ(I,J),I=1,3) 1,(PLDJ(I,J),I=1,3),J=1,2) IF(K1.LE.0) GO TO 40 N=N+1 IF(K2.LT.K1) K2=K1 DO 30 K=K1,K2 IPL(K)=N DO 30 J=1,2 DO 30 I=1,3 PLP(I,J,K)=PLPJ(I,J) 30 PLD(I,J,K)=PLDJ(I,J) GO TO 20 C REQUEST SIDE OF PLANE 40 WRITE(OUTPUT,130) READ(INPUT,140) ISIDE IF(ISIDE.NE.'FRON'.AND.ISIDE.NE.'BACK') ISIDE='BOTH' RETURN FF100 FORMAT(' ',$) 110 FORMAT(2I,12E) 120 FORMAT(' '/ 1 ' ') 130 FORMAT(' ',$) 140 FORMAT(A4) END FF SUBROUTINE DIST(X,IPL,PLP,PLD,D,N) C SUBROUTINE DIST - CALCULATES DISTANCE FROM CLIPPING PLANE TO NODE C VARIABLLS USED C X = COORDINATE ARRAY BY NODE C IPL = CLIPPING PLANE NUMBER BY PART C PLP = POINT ON PLANE BY PART C PLD = NORMAL TO PLANE BY PART C D = DISTANCE TO PLANE BY NODE C N = PART NUMBER C NJ = NUMBER OF JOINTS OR NODES C NP = NUMBER OF PARTS C NPT = NUMBER OF ELEMENTS C ITOTAL = TOTAL NUMBER OF STEPS BETWEEN CLIPPING PLANES C ISTEP = STEPGG NUMBER BETWEEN CLIPPING PLANES C ISIDE = DATA SAVE INDICATOR C IPLAST = NUMBER OF LAST CLIPPING PLANE USED DIMENSION X(3,1),IPL(1),PLP(3,2,1),PLD(3,2,1),D(1) COMMON/CONT/ NP,NJ,NPT COMMON/JUNK/ PX(3),PD(3) COMMON/STEP/ ITOTAL,ISTEP,ISIDE,IPLAST C IF PLANE SAME AS LAST THEN RETURN ELSE ZERO DISTANCE ARRAY IF(IPL(N).EQ.IPLAST) RETURN DO 10 I=1,NJ 10 D(I)=0.0 IPLAST=IPL(N) IF(IPL(N).EQ.0) RETURN C CALCULATE INTEMEDIATE PLANE DEFINITION GG STEP=0. IF(ITOTAL-2) GO TO 20 STEP=(ISTEP-1)/(ITOTAL-1) 20 DO 30 I=1,3 PX(I)=PLP(I,1,N)+STEP*(PLP(I,2,N)-PLP(I,1,N)) 30 PD(I)=PLD(I,1,N)+STEP*(PLD(I,2,N)-PLD(I,1,N)) C CALCULATE DISTANCE TO PLANE DO 40 J=1,NJ D(J)=0. DO 40 I=1,3 40 D(J)=D(J)+(X(I,J)-PX(I))*PD(I) RETURN END GG SUBROUTINE SOLID(NPL,X,IP,IPN,D,DFAC,IFAC,L) C SUBROUTINE SOLID - CLIPS AND CAPS HEXAHEDRON ELEMENTS USING C PERPENDICULAR DISTANCE TO PLANE. C SUBPROGRAMS CALLED C SPLIT = CLIPS INDIVIDUAL POLYGONS ALONG CLIPPING PLANE C LOOKUP = HASH TABLE LOOKUP ROUTINE C ENTER = HASH TABLE ENTER ROUTINE C VARIABLES USED C NPL = PARTS ARRAY C IP = CONNECTIVITY ARRAY C IPN = CLIPPING PLANE NUMBER ARRAY BY PART C D = DISTANCE TO PLANE BY NODE C DFAC = PROPORTION OF LINE SEGHHMENT ARRAY C IFAC = NODE NUMBERS OF CLIPPED LINE SEGMENTS C ICOOR = COORDINATE HASH TABLE C IPOLY = POLYGON HASH TABLE C L = PART NUMBER C NJ = NUMBER OF JOINTS OR NODES C NP = NUMBER OF PARTS C NPT = NUMBER OF ELEMENTS C XX = CLIPPED COORDINATE POINT C ITEMP = POLYGON NODE NUMBERS C IPFT = NODE NUMBERS OF POLYGON IN FRONT OF PLANE C IPBT = NODE NUMBERS OF POLYGON BEHIND PLANE C IPPT = NODE NUMBERS OF LINE SEGMENTS OF POLYGON ON PLANE C ISEG = ON-PLANE PHHOLYGON LINE SEGMENTS C NLAST = NUMBER OF LAST POLYGON AFTER SORTING C NCOOR = NUMBER OF LAST NEW COORDINATE ENTERED IN HASH TABLE C IORD = HEXAHEDRON POLYGON NODE NUMBER MAP C KPLACE = INDEX TO HASH TABLE C ITOTAL = TOTAL NUMBER OF STEPS BETWEEN CLIPPING PLANES C ISTEP = STEP NUMBER C ISIDE = 'FRON' TO SAVE ONLY POLYGONS IN FRONT OF CLIPPING PLANE C = 'BACK' TO SAVE ONLY POLYGONS IN BEHIND CLIPPING PLANE C = 'BOTH' TO SAVE ALL POLYGONS C NPLN = POLYGON NHHUMBER (USED IN SORTING) C L1, L2 = LIMITS OF ELEMENTS IN THIS PART C KEY = KEY USED IN HASH INDEX CALCULATION C ITEST = FRONT, ON-PLANE, BACK POLYGON INDICATOR C NP2 = COUNT OF ON-PLANE INTERSECTIONS INTEGER OUTPUT DIMENSION NPL(2,1),X(3,1),IP(8,1),IPN(1),D(1),DFAC(1),IFAC(2,1) COMMON/CONT/ NP,NJ,NPT COMMON/DEVI/ INPUT,OUTPUT COMMON/HASH/ ICOOR(128),IPOLY(128) COMMON/JUNK/ XX(3),ITEMP(4),IPFT(6),IPBT(6),ISEG(6),IPPT(12) COMMON/NCON/ NPN,NCOOR,NLAHHST COMMON/ORDR/ IORD(4,6) COMMON/SAVE/ KPLACE,IPT COMMON/STEP/ ITOTAL,ISTEP,ISIDE C GET ELEMENT LIMITS AND ZERO POLYGON HASH TABLE L1=NPL(1,L) L2=NPL(2,L) NPLN=0 DO 4 I=1,128 4 IPOLY(I)=0 C REPEAT FOR EACH ELEMENT IN PART DO 95 J=L1,L2 C ZERO ON-PLANE POLYGON ARRAY NJP=0 DO 5 I=1,12 5 IPPT(I)=0 C REPEAT FOR EACH FACE OF HEXAHEDRON DO 90 K=1,6 C SET ITEMP EQUAL TO POLYGON NODES DO 20 I=1,4 J1HH=IORD(I,K) 20 ITEMP(I)=IP(J1,J) C CALCULATE INTERSECTION WITH PLANE; IF MORE THAN TWO C INTERSECTIONS TREAT AS WARPPED QUADRILATERAL. CALL SPLIT(X,IPN(L),D,DFAC,IFAC,NP2,NPLN) IF(NP2-2) 90,10,21 10 NJP=NJP+2 IPPT(NJP-1)=ISEG(1) IPPT(NJP)=ISEG(2) GO TO 90 C FIND HIGH NODES AND DIVIDE WARPPED QUADRILATERAL. 21 DO 22 I=1,4 I1=I J1=ITEMP(I) IF(D(J1).GT.0.0) GO TO 24 22 CONTINUE DO 23 I=1,4 I1=I J1=ITEMP(I) IFHH(D(J1).LT.0.0) GO TO 25 23 CONTINUE GO TO 100 24 I1=I1-1 25 I2=I1 DO 27 I=1,3 I2=I2+1 IF(I2.GT.4) I2=I2-4 J1=IORD(I2,K) 27 ITEMP(I)=IP(J1,J) ITEMP(4)=0 C CALCULATE INTERSECTION WITH POLYGON CALL SPLIT(X,IPN(L),D,DFAC,IFAC,NP2,NPLN) IF(NP2-2) 50,30,100 30 NJP=NJP+2 IPPT(NJP-1)=ISEG(1) IPPT(NJP)=ISEG(2) C LOAD ITEMP WITH SECOND HALF OF WARPED QUADRILATERAL I2=I1+2 DO 40 I=1,3 I2=I2+1 IF(I2.GT.4) HHI2=I2-4 J1=IORD(I2,K) 40 ITEMP(I)=IP(J1,J) ITEMP(4)=0 C CALCULATE POLYGON INTERSECTION 50 CALL SPLIT(X,IPN(L),D,DFAC,IFAC,NP2,NPLN) IF(NP2-2) 90,60,100 60 NJP=NJP+2 IPPT(NJP-1)=ISEG(1) IPPT(NJP)=ISEG(2) 90 CONTINUE C IF LESS THAN SIX INTERSECTION ON-PLANE THEN JUMP IF(NJP-5) GO TO 95 C ORDER ON-PLANE POLYGON LINE SEGMENTS CALL ORDER(IPPT,NJP,ITRIA) IF(ITRIA.LE.1) GO TO 93 DO 91 I=1,3 I1=I+3 ITEMP(I)=IPPT(I) HH IPPT(I)=IPPT(I1) ITEMP(I1)=0 91 IPPT(I1)=0 NJP=3 C DO LOOKUP AND ENTER FOR ON-PLANE POLYGON NPLN=NPLN+1 KEY=0 DO 92 I=1,NJP 92 KEY=KEY+ITEMP(I) ITEST=524288+NJP CALL LOOKUP(IPOLY,KEY,IFD,NPLT,X,ITEST,ITEMP,6) IF(.NOT.IFD) CALL ENTER(IPOLY,KEY,NPLN,ITEST,ITEMP,6) 93 NPLN=NPLN+1 KEY=0 DO 94 I=1,NJP 94 KEY=KEY+IPPT(I) ITEST=524288+NJP CALL LOOKUP(IPOLY,KEY,IFD,NPLT,X,ITEST,IPPT,6) IF(.NOT.IFD) CALL ENTER(IPOLHHY,KEY,NPLN,ITEST,IPPT,6) 95 CONTINUE RETURN C CLIPPING AND CAPPING ERRORS 100 WRITE(OUTPUT,110) 110 FORMAT(' ?') STOP END HH SUBROUTINE SPLIT(X,IPN,D,DFAC,IFAC,NP2,NPLN) C SUBROUTINE SPLIT - SPLITS A POLYGON INTO FRONT AND BACK POLYGONS C AND SAVE THE LINE SEMENT FOR USE IN FORMING THE CAP. C SUBPROGRAMS CALLED C LOOKUP = HASH TABLE LOOKUP ROUTINE C ENTER = HASH TABLE ENTER ROUTINE C VARIABLES USED C X = COORDINATE ARRAY C IPN = CLIPPING PLANE NUMBER BY PART C D = DISTANCE FROM NODE TO CLIPPING PLANE C DFAC = PROPORTION OF LINE SEGMENT C IFAC = NODES OF CLIPPED LINE SEGMENTS C ICOIIOR = COORDINATE HASH TABLE C IPOLY = POLYGON HASH TABLE C NJ = NUMBER OF JOINTS OR NODES C NP = NUMBER OF PARTS C NPT = NUMBER OF ELEMENTS C XX = COORDINATE OF CALCULATED INTERSECTION C ITEMP = TEMPORARY CONNECTIVITY ARRAY FOR POLYGON C IPFT = FRONT POLYGON CONNECTIVITY C IPBT = BACK POLYGON CONNECTIVITY C ISEG = ON-PLANE POLYGON LINE SEGMENT C NLAST = LAST POLYGON NUMBER AFTER POLYGON SORTING C NCOOR = NUMBER OF LAST COORDINATE ENTERED INTO HASH TABLE C KPLIIACE = INDEX TO HASH TABLE C IPT = HASH TABLE POINTER C ITOTAL = TOTAL NUMBER OF STEPS BETWEEN CLIPPING PLANES C ISTEP = CLIPPING PLANE STEP NUMBER C ISIDE = 'FRON' TO SAVE ONLY POLYGONS IN FRONT OF PLANE C = 'BACK' TO SAVE ONLY POLYGONS BEHIND PLANE C = 'BOTH' TO SAVE ALL POLYGONS C NJF = NUMBER OF NODES IN FRONT POLYGON C NJB = NUMBER OF NODES IN BACK POLYGON C NP2 = COUNT OF ON-PLANE INTERSECTIONS C NPLN = POLYGON NUMBER FOR SORTING DIMENSION IIX(3,1),D(1),DFAC(1),IFAC(2,1) COMMON/CONT/ NP,NJ,NPT COMMON/HASH/ ICOOR(128),IPOLY(128) COMMON/JUNK/ XX(3),ITEMP(4),IPFT(6),IPBT(6),ISEG(6),IPPT(12) COMMON/NCON/ NPN,NCOOR,NLAST COMMON/SAVE/ KPLACE,IPT COMMON/STEP/ ITOTAL,ISTEP,ISIDE C REPEAT FOR EACH NODE IN POLYGON NJB=0 NJF=0 NP2=0 DO 10 I=1,6 IPFT(I)=0 IPBT(I)=0 10 ISEG(I)=0 DO 40 I1=1,4 C SET J1 = FIRST NODE AND J2 = SECOND NODE OF LINE SEGMENT I2=I1+II1 IF(I2.GT.4) I2=1 IF(ITEMP(I1).EQ.0) GO TO 41 J1=ITEMP(I1) J2=ITEMP(I2) IF(J2.EQ.0) J2=ITEMP(1) C IF DISTANCE IS NEGATIVE, ZERO, POSITIVE THEN GO TO 15, 20, 30 IF(D(J1)) 15,20,30 15 IF(ISIDE.EQ.'FRON') GO TO 35 NJB=NJB+1 IPBT(NJB)=J1 GO TO 35 20 IF(ISIDE.EQ.'FRON') GO TO 22 NJB=NJB+1 IPBT(NJB)=J1 IF(ISIDE.EQ.'BACK') GO TO 24 22 NJF=NJF+1 IPFT(NJF)=J1 24 IF(IPN.EQ.0) GO TO 35 NP2=NP2+1 ISEG(NP2)=J1 II GO TO 35 30 IF(ISIDE.EQ.'BACK') GO TO 35 NJF=NJF+1 IPFT(NJF)=J1 C IF NODES LIE ON OPPOSITE SIDES OF PLANE THEN CALCULATE C PROPORTION ELSE JUMP. 35 IF((D(J1)*D(J2)).GE.0.0) GO TO 40 FAC=D(J1)/(D(J2)-D(J1)) C CALCULATE COORDINATE OF INTERSECTION DO 34 JJ=1,3 34 XX(JJ)=X(JJ,J1)-FAC*(X(JJ,J2)-X(JJ,J1)) KEY=INT(XX(1)+XX(2)-XX(3)) C SEARCH FOR COORDINATE IN HASH TABLE CALL LOOKUP(ICOOR,KEY,IFD,NJT,X,ITEST,ITEMP,2) IF(IFD) GO TO 36 II NCOOR=NCOOR+1 C IF COORDINATE NOT FOUND THEN ENTER IT INTO HASH TABLE CALL ENTER(ICOOR,KEY,NCOOR,ITEST,ITEMP,2) C SAVE PROPORTION AND NODE NUMBERS OF CLIPPED LINE SEGMENT C FOR USE IN DATA TRANSFORMATION. NJT=NCOOR II=NJT-NJ DFAC(II)=FAC IFAC(1,II)=J1 IFAC(2,II)=J2 C ENTER COORDINATE IN COORDINATE ARRAY DO 33 JJ=1,3 33 X(JJ,NJT)=XX(JJ) C ENTER COORDINATE NODE NUMBER IN POLYGON CONNECTIVITY ARRAYS 36 IF(ISIDE.EQ.'FRON') GO TOII 42 NJB=NJB+1 IPBT(NJB)=NJT IF(ISIDE.EQ.'BACK') GO TO 44 42 NJF=NJF+1 IPFT(NJF)=NJT 44 NP2=NP2+1 ISEG(NP2)=NJT 40 CONTINUE C CHECK FOR ON-PLANE POLYGONAL FACE 41 IF(NP2.NE.4) GO TO 58 DO 50 I=1,4 50 IF(ISEG(I).GT.NJ) GO TO 58 GO TO 90 C ENTER FRONT AND BACK POLYGONS C IF FRONT POLYGON THEN DO LOOKUP AND ENTER OR DELETE 58 IF(NJF.LT.3) GO TO 60 NPLN=NPLN+1 KEY=0 DO 59 I=1,NJF 59 KEY=KEY+IPFT(I) ITEST=262II144+NJF CALL LOOKUP(IPOLY,KEY,IFD,NJT,X,ITEST,IPFT,6) IF(.NOT.IFD) CALL ENTER(IPOLY,KEY,NPLN,ITEST,IPFT,6) IF(IFD) CALL DELETE(IPOLY,6) C IF BACK POLYGON THEN DO LOOKUP AND ENTER OR DELETE 60 IF(NJB.LT.3) GO TO 80 71 NPLN=NPLN+1 KEY=0 DO 72 I=1,NJB 72 KEY=KEY+IPBT(I) ITEST=1048576+NJB CALL LOOKUP(IPOLY,KEY,IFD,NJT,X,ITEST,IPBT,6) IF(.NOT.IFD) CALL ENTER(IPOLY,KEY,NPLN,ITEST,IPBT,6) IF(IFD) CALL DELETE(IPOLY,6) C IF ONLY ONE INTERSECIITION THEN RESET NP2 80 IF(NP2.EQ.1) NP2=0 RETURN C ENTER ON-PLANE POLYGON 90 NPLN=NPLN+1 KEY=0 DO 92 I=1,NP2 92 KEY=KEY+ISEG(I) ITEST=524288+NP2 CALL LOOKUP(IPOLY,KEY,IFD,NJT,X,ITEST,ISEG,6) IF(.NOT.IFD) CALL ENTER(IPOLY,KEY,NPLN,ITEST,ISEG,6) NP2=0 RETURN END II SUBROUTINE LOOKUP(KVALS,KEY,IFD,IVAL,X,ITEST,ITEMP,N) C SUBROUTINE LOOKUP - HASH TABLE LOOKUP ROUTINE C VARIABLES USED C X = COORDINATE ARRAY C KVALS = HASH TABLE POINTERS C KEY = HASH INDEX CALCULATION KEY C IVAL = NODE NUMBER OF FOUND COORDINATE C IFD = -1 IF FOUND C = 0 IF NOT FOUND C ITEMP = POLYGON CONNECTIVITY C ITEST = POLYGON ASSOCIATED VALUE C KPLACE = HASH TABLE INDEX C IPT = HASH TABLE POINTER C XX = NEW COORDINATE DIMENSION X(3JJ,1),KVALS(1),ITEMP(1),IP(6) COMMON IFREE(1) COMMON/JUNK/ XX(3) COMMON/SAVE/ KPLACE,IPT C CALCULATE HASH TABLE INDEX IFD=.FALSE. I2=MOD(KEY,512) I1=KEY/(2**9) I1=MOD(I1+I2,128) KPLACE=I1+1 IPT=KVALS(KPLACE) C IF NULL POINTER THEN NOT FOUND 11 IF(IPT.EQ.0) RETURN C IF FOUND THEN GO TO 31 IF(IFREE(IPT).EQ.KEY) GO TO 31 C INCREMENT POINTER 21 IPT=MOD(IFREE(IPT+1),262144) GO TO 11 C IF POLYGON THEN JUMP 31 JJIF(N.GT.2) GO TO 34 C CHECK COORDINATES IVAL=IFREE(IPT+1)/(2**18) X1=XX(1)-X(1,IVAL) X2=XX(2)-X(2,IVAL) X3=XX(3)-X(3,IVAL) X1=X1*X1+X2*X2+X3*X3 X2=X(1,IVAL)*X(1,IVAL)+X(2,IVAL)*X(2,IVAL)+X(3,IVAL)*X(3,IVAL) IF(X2.EQ.0.0) X2=1.0 X3=SQRT(X1/X2) IF(X3.GT.1.0E-04) GO TO 21 IFD=.TRUE. RETURN C CHECK POLYGON 34 IF(ITEST.NE.IFREE(IPT+2)) GO TO 21 C GET SIZE OF POLYGON AND FIND NODE OFFSET ISIZE=MOD(ITEST,262144) DJJO 40 I=3,5 I1=I*2-5 I2=I1+1 I3=IPT+I IP(I1)=IFREE(I3)/(2**18) 40 IP(I2)=MOD(IFREE(I3),262144) DO 41 IOFF=1,ISIZE IF(ITEMP(IOFF).EQ.IP(1)) GO TO 51 41 CONTINUE GO TO 21 C DETERMINE IF POLYGON IS SAME OR OPPOSITE ORDERING 51 IMOVE=1 II1=IOFF-1 IF(II1.LE.0) II1=ISIZE IF(ITEMP(II1).EQ.IP(2)) IMOVE=-1 DO 61 I=2,ISIZE IOFF=IOFF+IMOVE IF(IOFF.GT.ISIZE) IOFF=1 IF(IOFF.LE.0) IOFF=ISIZE IF(ITEMP(IOFF).NE.IP(I)) JJGO TO 21 61 CONTINUE IFD=.TRUE. RETURN END JJ SUBROUTINE ENTER(KVALS,KEY,IVAL,ITEST,ITEMP,N) C SUBROUTINE ENTER - HASH TABLE ENTER ROUTINE C VARIABLE USED C KVALS = HASH TABLE POINTERS C KEY = HASH TABEL INDEX CALCULATION KEY C IVAL = HASH TABLE VALUE C ITEMP = TEMPORARY POLYGON ARRAY C ITEST = POLYGON ASSOCIATED VARIABLE C N = HASH TABEL BLOCK SIZE C XX = NEW COORDINATE C KPLACE = HASH TABLE INDEX C IPT = HASH TABLE POINTER DIMENSION KVALS(1),ITEMP(1) COMMON IFREE(1) COMMON/JUNK/ XX(3)KK COMMON/SAVE/ KPLACE,IPT C ENTER DATA CALL GETBLK(IPT,N) IFREE(IPT)=KEY IFREE(IPT+1)=IVAL*(2**18)+KVALS(KPLACE) KVALS(KPLACE)=IPT I1=IPT+1 C IF COORDINATE THEN RETURN IF(N.EQ.2) RETURN IFREE(IPT+2)=ITEST IFREE(IPT+3)=ITEMP(1)*(2**18)+ITEMP(2) IFREE(IPT+4)=ITEMP(3)*(2**18)+ITEMP(4) IFREE(IPT+5)=ITEMP(5)*(2**18)+ITEMP(6) I1=IPT+5 RETURN END KK SUBROUTINE DELETE(KVALS,N) C SUBROUTINE DELETE - DELETES DATA BLOCKS FROM HASH TABLE C SUBPROGRAMS CALLED C RETBLK = RETURN DATA BLOCK TO FREE STORAGE C VARIABLES USED C KVALS = HASH TABLE POINTERS C N = HASH TABLE BLOCK SIZE C KPLACE = HASH TABLE INDEX C IPT = HASH TABLE POINTER C IFREE = FREE STORAGE INTEGER OUTPUT DIMENSION KVALS(1) COMMON IFREE(1) COMMON/DEVI/ INPUT,OUTPUT COMMON/SAVE/ KPLACE,IPT C DELETE FIRST DATA BLOCK FROM TABLLLE IPT1=KVALS(KPLACE) IF(IPT1.NE.IPT) GO TO 10 KVALS(KPLACE)=MOD(IFREE(IPT+1),262144) CALL RETBLK(IPT,N) RETURN C IF NOT FIRST BLOCK THEN FOLLOW POINTERS 10 IPT2=MOD(IFREE(IPT1+1),262144) IF(IPT2.EQ.IPT) GO TO 20 IPT1=IPT2 IF(IPT1.NE.0) GO TO 10 WRITE(OUTPUT,15) 15 FORMAT(' ?') STOP C ADJUST POINTERS TO BRIDGE DELETED BLOCK 20 IFREE(IPT1+1)=IFREE(IPT1+1)/(2**18)*(2**18) 1+MOD(IFREE(IPT+1),2LL62144) CALL RETBLK(IPT,N) RETURN END LL SUBROUTINE GETBLK(IPT,N) INTEGER OUTPUT COMMON IFREE(1) COMMON/DEVI/ INPUT,OUTPUT COMMON/FREE/ MIN,NEXT,IAVAIL IF(IAVAIL.EQ.0) GO TO 30 IPT=IAVAIL IF(IFREE(IPT+1).NE.N) GO TO 10 IAVAIL=IFREE(IPT) RETURN 10 IPT1=IFREE(IPT) IF(IPT1.EQ.0) GO TO 30 IF(IFREE(IPT1+1).NE.N) GO TO 20 IFREE(IPT)=IFREE(IPT1) IPT=IPT1 RETURN 20 IPT=IPT1 GO TO 10 30 IPT=NEXT-N NEXT=IPT IF(NEXT.GT.MIN) RETURN MM WRITE(OUTPUT,40) 40 FORMAT(' ?') STOP ENTRY RETBLK(IPT,N) IFREE(IPT)=IAVAIL IFREE(IPT+1)=N IAVAIL=IPT RETURN END MM SUBROUTINE ORDER(ITEMP,NJP,ITRIA) C SUBROUTINE ORDER - MATCHES END-POINTS OF LINE SEGMENTS C TO FORM POLYGONS C VARIABLES USED C ITEMP = POLYGON LINE SEGMENT ARRAY C NJP = NUMBER OF NODES IN ITEMP INTEGER OUTPUT DIMENSION ITEMP(1) COMMON/DEVI/ INPUT,OUTPUT C ORDER LINE SEGMENTS ITRIA=1 I1=NJP-2 DO 40 IPT=2,I1,2 C SEARCH FOR CORRESPONDING NODE I2=IPT+1 DO 10 I=I2,NJP I3=I 10 IF(ITEMP(IPT).EQ.ITEMP(I3)) GO TO 20 NN ITRIA=ITRIA+1 IF(ITRIA.LE.2) GO TO 40 WRITE(OUTPUT,15) 15 FORMAT(' ?') STOP C REVERSE LINE SEGMENT IF NECESSARY 20 IF(I3.NE.I3/2*2) GO TO 30 II1=ITEMP(I3) ITEMP(I3)=ITEMP(I3-1) ITEMP(I3-1)=II1 I3=I3-1 C SWAP LINE SEGMENTS 30 II1=ITEMP(IPT+1) II2=ITEMP(IPT+2) ITEMP(IPT+1)=ITEMP(I3) ITEMP(IPT+2)=ITEMP(I3+1) ITEMP(I3)=II1 ITEMP(I3+1)=II2 40 CONTINUE C ELEMINATE REDUNDANT NUMBERING ONNF NODES NJP=NJP/2 DO 50 I=1,NJP I1=2*I-1 50 ITEMP(I)=ITEMP(I1) C ZERO REMAINING ELEMENTS I1=NJP+1 DO 55 I=I1,12 55 ITEMP(I)=0 RETURN END NN SUBROUTINE PLYSRT(NPL,IJN,N) C SUBROUTINE PLYSRT - SORTS POLYGONS IN HASH TABLE C VARIABLES USED C NPL = PARTS ARRAY C IJN = CONNECTIVITY ARRAY C N = PART NUMBER C NCOUNT = TEMPORARY PARTS COUNT C ITEMP = TEMPORARY POLYGON VERTICE ARRAY C NLAST = LAST POLYGON NUMBER IN IJN DIMENSION NPL(2,1),IJN(4,1) COMMON IFREE(1) COMMON/CONT/ NP,NJ,NPT COMMON/HASH/ ICOOR(128),IPOLY(128) COMMON/JUNK/ NCOUNT(3),ILST(3),ITEMP(6) COMMON/NCON/ NPN,NCOOR,OONLAST C ZERO NCOUNT DO 5 I=1,3 ILST(I)=0 5 NCOUNT(I)=0 C SORT POLYGONS ACCORDING TO FRONT, ON-PLANE, AND BACK AND C BY POLYGON NUMBER DO 70 ILOC=1,128 IF(IPOLY(ILOC).EQ.0) GO TO 70 IBLK=IPOLY(ILOC) 10 I1=IFREE(IBLK+2)/(2**18) IPT=ILST(I1) IF(IPT.NE.0) GO TO 20 IFREE(IBLK)=0 ILST(I1)=IBLK GO TO 60 20 IF(IFREE(IBLK+1).GT.IFREE(IPT+1)) GO TO 30 IFREE(IBLK)=ILST(I1) ILST(I1)=IBLK GO TO 60 OO 30 IF(IFREE(IPT).NE.0) GO TO 40 IFREE(IBLK)=0 IFREE(IPT)=IBLK GO TO 60 40 IPT1=IFREE(IPT) IF(IFREE(IBLK+1).GT.IFREE(IPT1+1)) GO TO 50 IFREE(IBLK)=IPT1 IFREE(IPT)=IBLK GO TO 60 50 IPT=IPT1 GO TO 30 60 IBLK=MOD(IFREE(IBLK+1),262144) IF(IBLK.EQ.0) GO TO 70 GO TO 10 70 CONTINUE C FORM QUADRILATERALS AND TRIANGLES FROM DATA DO 100 I=1,3 IPT=ILST(I) 75 IF(IPT.EQ.0) GO TO 100 ISIZE=MOD(IFREE(IPT+2),262144)OO DO 80 J=3,5 I1=2*J-5 I2=I1+1 I3=IPT+J ITEMP(I1)=IFREE(I3)/(2**18) 80 ITEMP(I2)=MOD(IFREE(I3),262144) IPT1=IFREE(IPT) CALL RETBLK(IPT,6) IPT=IPT1 NLAST=NLAST+1 NCOUNT(I)=NCOUNT(I)+1 DO 85 J=1,4 85 IJN(J,NLAST)=ITEMP(J) IF(ISIZE.LE.4) GO TO 75 NLAST=NLAST+1 NCOUNT(I)=NCOUNT(I)+1 IJN(1,NLAST)=ITEMP(1) DO 90 J=2,4 90 IJN(J,NLAST)=ITEMP(J+2) GO TO 75 100 CONTINUE C STORE NCOUNT IN PARTS OOARRAY NLAST1=NLAST+1 NCOUNT(2)=NCOUNT(2)+NCOUNT(3) NCOUNT(1)=NCOUNT(1)+NCOUNT(2) NPL(1,N)=NLAST1-NCOUNT(1) NPL(2,N)=NLAST-NCOUNT(2) K=NP+N NPL(1,K)=NLAST1-NCOUNT(2) NPL(2,K)=NLAST-NCOUNT(3) K=K+NP NPL(1,K)=NLAST1-NCOUNT(2) NPL(2,K)=NLAST-NCOUNT(3) K=K+NP NPL(1,K)=NLAST1-NCOUNT(3) NPL(2,K)=NLAST RETURN END OO SUBROUTINE REDUCE(ICOL,IJN) C SUBROUTINE REDUCE - FORMS A REDUCE VECTOR OF NODE NUMBERS C VARIABLES USED C ICOL = NEW NODE NUMBER ARRAY BY OLD NODE NUMBER C IJN = NEW CONNECTIVITY ARRAY C NJ = NUMBER OF JOINTS OR NODES C NP = NUMBER OF PARTS C NPT = NUMBER OF ELEMENTS DIMENSION ICOL(1),IJN(4,1) COMMON/CONT/ NP,NJ,NPT COMMON/NCON/ NPN,NJN,NLAST C ZERO NODE NUMBER ARRAY DO 10 I=1,NJ 10 ICOL(I)=0 C COUNT NUMBER OF TIMES NODE NUMBER USED IN PPIJN DO 20 J=1,NLAST DO 20 I=1,4 II=IJN(I,J) IF(II.LE.0.OR.II.GT.NJ) GO TO 20 ICOL(II)=ICOL(II)+1 20 CONTINUE C REPLACE COUNT WITH NEW NODE NUMBER FOR NODES USED NN=0 DO 40 I=1,NJ IF(ICOL(I).LE.0) GO TO 40 NN=NN+1 ICOL(I)=NN 40 CONTINUE C RENUMBER NODES IN ARRAY IJN NJ1=NJ-NN DO 60 J=1,NLAST DO 60 I=1,4 II=IJN(I,J) IF(II.LE.0) GO TO 60 IF(II.GT.NJ) GO TO 50 IJN(I,J)=ICOL(II) GO TO PP60 50 IJN(I,J)=II-NJ1 60 CONTINUE RETURN END PP SUBROUTINE TRGEOM(X,ICOL,DFAC,IFAC,XN) C SUBROUTINE TRANS - TRANSFORMS, REDUCES AND/OR AUGMENTS C COORDINATE, DISPLACEMENT AND SCALAR FUNCTION ARRAY. C VARIABLES USED C X = COORDINATE ARRAY C = DISPLACEMENT ARRAY C S = SCALAR FUNCTION ARRAY C ICOL = REDUCED NODE NUMBER ARRAY C DFAC = PROPORTION OF LINE SEGMENT C IFAC = NODES OF CLIPPED LINE SEGMENT C XN = NEW COORDINATE ARRAY C = NEW DISPLACEMENT ARRAY C SN = NEW SCALAR FUNCTION ARRAY C NJ = NUMBEQQR OF JOINTS OR NODES C NP = NUMBER OF PARTS C NPT = NUMBER OF ELEMENTS C NPN = NEW NUMBER OF PARTS C NCOOR = NEW NUMBER OF NODES C NPTN = NEW NUMBER OF ELEMENTS DIMENSION X(3,1),ICOL(1),DFAC(1),IFAC(2,1),XN(3,1) COMMON/CONT/ NP,NJ,NPT COMMON/NCON/ NPN,NCOOR,NPTN COMMON/SAVE/ NSAVE NSAVE=NCOOR C PERFORM TRANSFORMATION ON OLD GEOMETRY ARRAY N=0 DO 4 J=1,NJ IF(ICOL(J).LE.0) GO TO 4 N=N+1 DO 3 I=1,3 3 XN(I,N)=X(I,J) 4 QQ CONTINUE C IF NO NEW COORDINATES THEN JUMP J1=NJ+1 IF(J1.GT.NCOOR) GO TO 10 C INCLUDED CALCULATED COORDINATES IN NEW ARRAY DO 5 J=J1,NCOOR N=N+1 DO 5 I=1,3 5 XN(I,N)=X(I,J) 10 NCOOR=N RETURN END QQ SUBROUTINE TRDISP(X,ICOL,DFAC,IFAC,XN) DIMENSION X(3,1),ICOL(1),DFAC(1),IFAC(2,1),XN(3,1) COMMON/CONT/ NP,NJ,NPT COMMON/NCON/ NPN,NCOOR,NPTN COMMON/SAVE/ NSAVE C PERFORM TRANSFORMATION ON OLD DISPLACEMENT ARRAY N=0 DO 14 J=1,NJ IF(ICOL(J).LE.0) GO TO 14 N=N+1 DO 13 I=1,3 13 XN(I,N)=X(I,J) 14 CONTINUE C IF NO NEW DISPLACEMENTS THEN RETURN J1=NSAVE-NJ IF(J1.LE.0) RETURN DO 17 J=1,J1 N=N+1 I1=IFAC(1,J)RR I2=IFAC(2,J) DO 17 I=1,3 17 XN(I,N)=X(I,I1)-DFAC(J)*(X(I,I2)-X(I,I1)) RETURN END RR SUBROUTINE TRSFUN(S,ICOL,DFAC,IFAC,SN) DIMENSION S(1),ICOL(1),DFAC(1),IFAC(2,1),SN(1) COMMON/CONT/ NP,NJ,NPT COMMON/NCON/ NPN,NCOOR,NPTN COMMON/SAVE/ NSAVE C PERFORM TRANSFORMATION ON OLD SCALAR FUNCTION ARRAY N=0 DO 24 J=1,NJ IF(ICOL(J).LE.0) GO TO 24 N=N+1 SN(N)=S(J) 24 CONTINUE C IF NO NEW SCALAR FUNCTIONS THEN RETURN J1=NSAVE-NJ IF(J1.LE.0) RETURN DO 27 J=1,J1 N=N+1 I1=IFAC(1,J) I2=IFAC(2,J) SS 27 SN(N)=S(I1)-DFAC(J)*(S(I2)-S(I1)) RETURN END SSC**********************************************************************C C C C TITLE.FOR VERSION 1.0(A) SEPTEMBER 1976 C C C C TITLE.FOR IS A CHARACTER GENERATOR FOR TWO AND THREE C C DIMENSIONAL CHARACTERS. THE POLYGONAL DATA IS COMPATABLE C C WITH MOVIE.BYU FOR DISPLAY. CTT C C C MIKE STEPHENSON HANK CHRISTIANSEN C C DEPARTMENT OF CIVIL ENGR. CIVIL ENGINEERING DEPT. C C AND ENGINEERING MECHANICS 368E ESTB C C THE UNIVERSITY OF ARIZONA BRIGHAM YOUNG UNIVERSITY C C TUCSON, ARIZONA 85721 PROVO, UTAH 84602 C C (602) 884-4803 (801) 374-1211 X2811 TTC C C C**********************************************************************C INTEGER OUTPUT C DIMENSION NPL(2,NPMAX),X(3,NJMAX),IP(4,NPTMAX) DIMENSION NPL(2,10),X(3,100),IP(4,100) DIMENSION WORD(70) COMMON/CHAR/ CH(42),JQUAD(6,42),COOR(2,6,50) COMMON/DEVI/ INPUT,OUTPUT C INPUT AND OUTPUT ARE SET BELOW FOR THE DECSYSTEM-10 INPUT=-4 OUTPUT=-1 C WRITE TITLE TO OUTPUT DEVICE TTWRITE(OUTPUT,10) 10 FORMAT(' ') C BEGIN LINE OF TEXT 20 NML=0 NP=0 NJH=0 NMH=0 30 NCHAR=0 35 WRITE(OUTPUT,40) 40 FORMAT(' ') READ(INPUT,50) (WORD(I),I=1,70) 50 FORMAT(70A1) C FIND LAST NON-BLANK CHARACTER DO 60 I=1,70 NCHAR=71-I 60 IF(WORD(NCHAR).NE.' ') GO TO 80 C IF BLANK LINE THEN END OF TITLE? WRITE(OUTPUT,70) 70 FORMAT(' '$) READ(INPUT,50) ANS IF(ANTTS.NE.'Y') GO TO 30 GO TO 320 80 NP=NP+1 ID=2 C THREE-DIMENSIONAL TITLE? WRITE(OUTPUT,90) 90 FORMAT(' <3-D?> '$) READ(INPUT,50) ANS IF(ANS.EQ.'Y') ID=3 IDIN=ID-1 C REQUEST LEFT EDGE COORDINATES WRITE(OUTPUT,100) 100 FORMAT(' '$) READ(INPUT,110) XZ,YZ,ZZ 110 FORMAT(4E) C REQUEST SPACING, WIDTH, HEIGHT, AND FOR 3-D, DEPTH. 120 IF(ID.EQ.2) WRITE(OUTPUT,130) 130 FORMAT(' '$TT) IF(ID.EQ.3) WRITE(OUTPUT,140) 140 FORMAT(' '$) READ(INPUT,110) DDIN,SX,SY,SZ IF(SX.EQ.0.0.OR.SY.EQ.0.0) GO TO 120 IF(DDIN.EQ.0.0)DDIN=1.0 SX=SX/7.0 SY=SY/7.0 C IF 2-D THEN JUMP ELSE REQUEST OFFSET. IF(ID.EQ.2) GO TO 160 WRITE(OUTPUT,150) 150 FORMAT(' '$) READ(INPUT,110) DDX,DDY C FOR EACH CHARACTER IN LINE, GENERATE POLYGONAL DATA. 160 DO 290 I=1,NCHAR NJL=NJH+1 TT X1=WORD(I) DO 170 J=1,42 170 IF(X1.EQ.CH(J)) GO TO 190 C ISSUE WARNING IF CHARACTER NOT RECOGNIZED. WRITE(OUTPUT,180) X1 180 FORMAT(' ?') GO TO 35 190 DO 280 K=1,6 C GET POLYGON NUMBER. L=JQUAD(K,J) IF(L.EQ.0) GO TO 290 DO 280 I1=1,4 C GENERATE COORDINATES X1=XZ+SX*COOR(1,I1,L) Y1=YZ+SY*COOR(2,I1,L) IF(NJH.LT.NJL) GO TO 210 DO 200 J1=NJL,NJH,IDIN 200 IF(X1.EQ.X(1,J1).AND.Y1.TTEQ.X(2,J1)) GO TO 220 210 J1=NJH+1 NJH=NJH+IDIN X(1,J1)=X1 X(2,J1)=Y1 X(3,J1)=ZZ IF(ID.EQ.2) GO TO 270 X(1,NJH)=X1+DDX X(2,NJH)=Y1+DDY X(3,NJH)=ZZ-SZ 220 IF(ID.EQ.2) GO TO 270 J2=J1+1 C GENERATE POLYGONS GO TO (230,240,250,260),I1 230 IP(1,NMH+1)=J1 IP(2,NMH+2)=J1 IP(4,NMH+5)=J1 IP(1,NMH+2)=J2 IP(1,NMH+5)=J2 GO TO 280 240 IP(2,NMH+1)=J1 IP(1,NMH+3)=J1 IP(3,NMH+5)=J1 IP(2,NMH+3)=J2 TT IP(2,NMH+5)=J2 GO TO 280 250 IP(3,NMH+1)=J1 IP(4,NMH+3)=J1 IP(2,NMH+4)=J1 IP(3,NMH+3)=J2 IP(3,NMH+4)=J2 GO TO 280 260 IP(4,NMH+1)=J1 IP(3,NMH+2)=J1 IP(1,NMH+4)=J1 IP(4,NMH+2)=J2 IP(4,NMH+4)=J2 NMH=NMH+5 GO TO 280 270 IF(I1.EQ.1) NMH=NMH+1 IP(I1,NMH)=J1 280 CONTINUE C CLACULATE RIGHT EDGE CORRDINATE. 290 XZ=XZ+7.0*SX*DDIN XZ=XZ-7.0*SX*(DDIN-1.0) WRITE(OUTPUT,300) XZ 300 FORMAT(' ') WRITE(OUTPUT,310) NP,NMH,NJH 310 FORMAT(' ') NPL(1,NP)=NMH-NML NML=NMH GO TO 30 C COMPLETE NPL ARRAY. 320 NPT=0 DO 330 J=1,NP NPL(2,J)=NPL(1,J)+NPT NPL(1,J)=1+NPT 330 NPT=NPT+NPL(2,J) C WRITE GEOMETRY FILE. CALL WRGEOM(NP,NJH,NPT,NPL,X,IP) WRITE(OUTPUT,340) 340 FORMAT(' '$) READ(INPUT,50) ANS IF(ANS.EQ.'Y') GO TO 20 STOP ETTND TT BLOCK DATA C CHARACTER DEFINITIONS. COMMON/CHAR/ CH(42),JQUAD(6,42),COOR(2,6,50) DATA (CH(I),I=1,42)/'A','B','C','D','E','F','G','H','I','J' 1 ,'K','L','M','N','O','P','Q','R','S','T','U','V','W','X' 2 ,'Y','Z','1','2','3','4','5','6','7','8','9','0',' ','.' 3 ,'/','-','=','$'/ DATA ((JQUAD(I,J),I=1,6),J=1,10)/1,2,3,4,0,0,1,3,5,6,7,0 1 ,1,2,8,0,0,0,1,5,6,7,0,0,1,2,3,8,0,0,1,2,3,0,0,0 2 ,1,2,8,9,10,0,1,3,11,0,0,0,24,25,49,0,0,0,6,13,14,0,0,0/ UU DATA ((JQUAD(I,J),I=1,6),J=11,20)/1,15,16,0,0,0,1,8,0,0,0,0 1 ,1,11,17,18,0,0,1,11,19,0,0,0,1,5,6,11,0,0,1,3,5,20,0,0 2 ,1,5,6,11,21,0,1,3,5,20,22,0,2,3,9,23,24,0,25,26,0,0,0,0/ DATA ((JQUAD(I,J),I=1,6),J=21,30)/1,6,11,0,0,0,44,45,0,0,0,0 1 ,27,28,29,30,0,0,31,32,33,34,0,0,31,32,35,0,0,0,24,25,36,0,0,0 2 ,12,0,0,0,0,0,24,25,37,38,0,0,3,24,25,39,0,0,11,40,41,0,0,0/ DATA ((JQUAD(I,J),I=1,6),J=31,42)/2,3,9,23,24,42,1,2,3,8,9,0 1 ,25,43,0,0,0,0,1,3,5,6,11,0,2,3,23,24UU,39,0,1,5,6,11,0,0 2 ,0,0,0,0,0,0,46,0,0,0,0,0,36,0,0,0,0,0,3,0,0,0,0,0 3 ,47,48,0,0,0,0,2,3,9,23,24,50/ DATA(((COOR(I,J,K),I=1,2),J=1,4),K=1,6)/1.,0.,2.,0.,2.,7.,1.,7. 1 ,2.,6.,6.,6.,6.,7.,2.,7.,2.,3.,5.,3.,5.,4.,2.,4.,5.,0.,6.,0. 2 ,6.,6.,5.,6.,2.,6.,5.,6.,5.,7.,2.,7.,2.,0.,5.,0.,5.,1.,2.,1./ DATA(((COOR(I,J,K),I=1,2),J=1,4),K=7,12)/5.,0.,6.,1.,6.,6.,5.,7. 1 ,2.,0.,6.,0.,6.,1.,2.,1.,5.,1.,6.,1.,6.,4.,5.,4.,3.,3.,5.,3. 2 ,5.,4.,3.,4.,5.,0.,6.,0.,6.,7.,5.,7.,3.,0.UU,4.,0.,4.,7.,3.,7./ DATA(((COOR(I,J,K),I=1,2),J=1,4),K=13,17)/5.,0.,6.,0.,6.,7. 1 ,5.,7.,1.,0.,2.,0.,2.,3.,1.,3.,2.,3.5,6.,7.,4.5,7.,2.,4.8 2 ,2.,2.2,4.5,0.,6.,0.,2.,3.5,2.,5.,3.5,3.,3.5,5.,2.,7./ DATA(((COOR(I,J,K),I=1,2),J=1,4),K=18,22)/3.5,3.,5.,5. 1 ,5.,7.,3.5,5.,2.,4.8,5.,0.,5.,2.2,2.,7.,5.,3.,6.,3.,6.,7. 2 ,5.,7.,5.,1.,5.,2.4,3.7,3.7,3.,3.,4.9,0.,6.,0.,5.,3.,3.9,3./ DATA(((COOR(I,J,K),I=1,2),J=1,4),K=23,27)/1.,3.,2.,3.,2.,7. 1 ,1.,7.,1.,0.,6.,0.,6.,1.,1.,1.UU,1.,6.,6.,6.,6.,7.,1.,7. 2 ,3.,0.,4.,0.,4.,6.,3.,6.,1.,7.,2.,0.,3.,0.,2.,7./ DATA(((COOR(I,J,K),I=1,2),J=1,4),K=28,32)/3.,0.,3.5,2.,3.5,5. 1 ,2.643,2.5,3.5,2.,4.,0.,4.357,2.5,3.5,5.,4.,0.,5.,0.,6.,7. 2 ,5.,7.,3.,3.5,3.5,4.375,2.,7.,1.,7.,3.,3.5,4.,3.5,6.,7.,5.,7./ DATA(((COOR(I,J,K),I=1,2),J=1,4),K=33,37)/1.,0.,2.,0.,3.5,2.625 1 ,3.,3.5,5.,0.,6.,0.,4.,3.5,3.,3.5,3.,0.,4.,0.,4.,3.5,3.,3.5 2 ,1.,1.,2.25,1.,6.,6.,4.75,6.,5.,4.3,6.,4.,6.,6.,5.,6./ DATA(((COOR(I,J,K),UUI=1,2),J=1,4),K=38,42)/1.,1.,2.6,1.,6.,4. 1 ,5.,4.3,5.,1.,6.,1.,6.,6.,5.,6.,1.,4.,2.8,4.,5.,5.7,5.,7. 2 ,1.,3.,5.,3.,5.,4.,1.,4.,1.,1.,2.,1.,2.,2.,1.,2./ DATA(((COOR(I,J,K),I=1,2),J=1,4),K=43,50)/3.,0.,4.2,0.,6.,6. 1 ,4.8,6.,1.,7.,3.5,0.,3.5,2.75,2.,7.,3.5,0.,6.,7.,5.,7. 2 ,3.5,2.75,3.,0.,4.,0.,4.,1.,3.,1.,2.,2.,5.,2.,5.,3.,2.,3. 3 ,2.,4.,5.,4.,5.,5.,2.,5.,3.,1.,4.,1.,4.,6.,3.,6. 4 ,3.,-2.,4.,-2.,4.,9.,3.,9./ END UU SUBROUTINE OPEN(FILEID,IUNIT,IOP,IERROR) C SUBROUTINE OPEN REQUEST FILENAME AND OPENS FILE FOR I/O C SUBPROGRAMS CALLED C OPEN = SYSTEM OPEN FILE ROUTINE C VARIABLES USED C FILEID = 5 ASCII CHARACTER ID C IUNIT = DEVICE LOGICAL NUMBER C IOP = 1 FOR INPUT FILE C = -1 FOR OUTPUT FILE C IERROR = 1 ON SUCCESSFUL COMPLETION C = 0 ON EMPTY FILE SPECIFICATION C = -1 ON FAILURE DOUBLE PRECISION ASEQ,BLANK,XNAME VV INTEGER OUTPUT COMMON/DEVI/ INPUT,OUTPUT DATA DSK/'DSK'/,MTA/'MTA'/ DATA BLANK/' '/ IERROR=0 OPTYPE='READ' IF(IOP.LT.0) OPTYPE='WRITE' WRITE(OUTPUT,10) OPTYPE,FILEID 10 FORMAT(' <',A5,1X,A5,' FILE> '$) READ(INPUT,20) XNAME 20 FORMAT(A10) IF(XNAME.EQ.BLANK) RETURN IERROR=1 IUNIT=10 ASEQ='SEQIN' IF(IOP.LT.0) ASEQ='SEQOUT' OPEN(UNIT=IUNIT,DEVICE=DSK,FILE=XNAME,ACCESS=ASEQ,MODE='ASCII') RETURN ENDVV VV SUBROUTINE WRGEOM(NP,NJ,NPT,NPL,X,IP) INTEGER OUTPUT DIMENSION NPL(2,1),X(3,1),IP(4,1) COMMON/DEVI/ INPUT,OUTPUT DATA IWRITE/-1/ C REQUEST FILE INFORMATION 60 CALL OPEN('TITLE',IUNIT,IWRITE,IERR) IF(IERR) 60,95,90 C WRITE GEOMETRY FILE 90 WRITE(IUNIT,120) NP,NJ,NPT WRITE(IUNIT,120) ((NPL(I,J),I=1,2),J=1,NP) WRITE(IUNIT,130) ((X(I,J),I=1,3),J=1,NJ) WRITE(IUNIT,120) ((IP(I,J),I=1,4),J=1,NPT) 95 RETURN 120 FORMAT(20I4) 130 FORMATWW(1P6E12.5) END WW SUBROUTINE PACKER C C SUBROUTINE PACKER FOR 16 BIT MACHINES IN ANSI FORTRAN C C THIS ROUTINE RECEIVES DATA THROUGH EDGARG AND PACKS IT C INTO A STORAGE BLOCK INSIDE FREE. IF THIS EDGE IS A C SHARED EDGE, THEN THE EDGE WILL BE COMPARED WITH EXISTING C EDGES ON THIS SCAN LINE TO FIND OUT WHICH IF ANY IT C MATCHES. IF THIS EDGE IS A HORIZONTAL EDGE, THEN IT WILL C BE STORED ON THE PREVIOUS SCAN LINE. COMMON/EDGARG/IY,IX1,IX2,IZ1,IZ2,IS1,IS2,IP,IDY,ICOL1, 1ISHR,IC1,IC2,ICOL2 COMMON/FRXXEE/ IFREE(1) COMMON/EYES/XEY(3),IFY,ES(4) COMMON/BUCKY/IBUCKY(1) COMMON/QFORIO/CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC LOGICAL CONTRS,IBAD,ISHR C CHANGE IY IF THIS IS A HORIZONTAL EDGE IF(IDY.EQ.0) IY=IY+1 IF(IY.GT.IFY) IY=IFY IPT=IBUCKY(IY)+32767 C GENERATE THE EDGE DATA NUMWRD=11 C JUMP IF NO EDGE SHARING IF(.NOT.ISHR) GO TO 4 C TRACE THROUGH THE ENTRIES ON THIS SCAN LINE AND FIND OUT C IF THIS EDGE HAS ALREADY BEEN ENTERED. 1 IF(IPT.EQ.0) GO TO 4 XX IF(IX1.EQ.MOD(IFREE(IPT),1024) 1.AND.IX2.EQ.MOD(IFREE(IPT+1),1024) 2.AND.IDY.EQ.IFREE(IPT+2) 3.AND.IZ1.EQ.IFREE(IPT+3) 4.AND.IZ2.EQ.IFREE(IPT+4)) GO TO 3 C GET THE NEXT BLOCK IPT=IFREE(IPT+6)+32767 GO TO 1 C CHECK TO SEE IF THIS EDGE IS ALREADY SHARED C AND JUMP IF IT IS 3 IF(IFREE(IPT+10).NE.0) GO TO 4 C NOW PROVIDE THE SHARING POLYGON IFREE(IPT+10)=IP GO TO 5 4 CONTINUE C GET ENOUGH FREE FOR EDGE BLOCK (176 BITS) CALL GETVAR(IPT,NUMWRD) XXIF(IBAD) RETURN C CBEG(5), XBEG(10) IFREE(IPT)=IX1 C CEND(5), XEND(10) IFREE(IPT+1)=IX2 C DELTA Y(10) IFREE(IPT+2)=IDY C ZBEG(15) IFREE(IPT+3)=IZ1 C ZEND(15) IFREE(IPT+4)=IZ2 C SBEG(5), SEND(5) IFREE(IPT+5)=IS1*32+IS2 C NEXT EDGE(16) IFREE(IPT+6)=IBUCKY(IY) C COLOR BEG(15) IFREE(IPT+7)=ICOL1 C COLOR END(15) IFREE(IPT+8)=ICOL2 C POLYGON NUMBER IFREE(IPT+9)=IP C SHARED POLYGON NUMBER IFREE(IPT+10)=0 IF(.NOT.CONTRS) GO TO 6 IFREE(IXXPT)=MOD(IFREE(IPT),1024)+IC1*1024 IFREE(IPT+1)=MOD(IFREE(IPT+1),1024)+IC2*1024 6 IBUCKY(IY)=IPT-32767 5 RETURN END XX SUBROUTINE UNPACK C C SUBROUTINE UNPACK FOR 16 BIT MACHINES IN ANSI FORTRAN C C UNPACK PERFORMS THE REVERSE OF PACKER. IT IS CALLED BY C HIDDEN WITH IEDGPT SET AND RETURNS DATA THROUGH EDGBLK. COMMON/FREE/IFREE(1) COMMON/EDGBLK/IPT,ICOL1,IDELY,X1,X2,Z1,Z2,S1,S2, 1IEDGPT,C1,C2,SHARED,IGTHRZ,ICOL2 COMMON/QFORIO/CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC LOGICAL CONTRS C GET DELTAY VALUE 15 IDELY=IFREE(IEDGPT+2) C JUMP IF A NON-HORIZONTAL LINE IF(IDELY.GT.0) GO TO 16 C JUMP YYIF WE ARE LOOKING FOR VERTICALS IF(IGTHRZ) 20,20,18 C JUMP IF WE ARE LOOKING FOR HORIZONTALS 16 IF(IGTHRZ) 19,19,20 C FLAG TO SAY THERE ARE HORIZONTAL EDGES ON THIS SCAN LINE 18 IGTHRZ=2 C GET NEXT EDGE BLOCK 19 IEDGPT=IFREE(IEDGPT+6)+32767 C GO HOME IF WE RAN OFF THE END OF THE LIST IF(IEDGPT) 3,3,15 C GET Z BEGIN 20 Z1=FLOAT(IFREE(IEDGPT+3)) C GET Z END AND MAKE IT REAL Z2=FLOAT(IFREE(IEDGPT+4)) C GET X BEGIN X1=FLOAT(MOD(IFREE(IEDGPT),1024)) C GET X END AND MAKE IYYT REAL X2=FLOAT(MOD(IFREE(IEDGPT+1),1024)) C GET SHADE BEGIN S1=FLOAT(MOD(IFREE(IEDGPT+5)/32,32)) C GET SHADE END AND MAKE IT REAL S2=FLOAT(MOD(IFREE+5),32)) C GET POINTER TO POLYGON IP=IFREE(IEDGPT+10) C GET THE COLOR OF THIS EDGE ICOL1=IFREE(IEDGPT+7) ICOL2=IFREE(IEDGPT+8) C JUMP IF NO CONTOURING IF(.NOT.CONTRS) GO TO 4 C GET THE CONTOUR BEGIN C1=FLOAT(MOD(IFREE(IEDGPT)/1024,32)) C CET THE CONTOUR END C2=FLOAT(MOD(IFREE(IEDGPT+1)/1024,32)) 4 SHARYYED=-2. C IPT=IFREE(IEDGPT+9) C JUMP IF NOTHING IN THE TOP HALF IF(IP.EQ.0) GO TO 2 SHARED=-1. IF(ISHARE.EQ.1) GO TO 1 ISHARE=1 GO TO 3 1 IPT=IP C GET POINTER TO NEXT EDGE ON SCAN LINE 2 IEDGPT=IFREE(IEDGPT+6)+32767 ISHARE=0 3 RETURN END YY SUBROUTINE PACKER C C SUBROUTINE PACKER FOR 32 BIT MACHINES IN ANSI FORTRAN C C THIS ROUTINE RECEIVES DATA THROUGH EDGARG AND PACKS IT C INTO A STORAGE BLOCK INSIDE FREE. IF THIS EDGE IS A C SHARED EDGE, THEN THE EDGE WILL BE COMPARED WITH EXISTING C EDGES ON THIS SCAN LINE TO FIND OUT WHICH IF ANY IT C MATCHES. IF THIS EDGE IS A HORIZONTAL EDGE, THEN IT WILL C BE STORED ON THE PREVIOUS SCAN LINE. COMMON/EDGARG/IY,IX1,IX2,IZ1,IZ2,IS1,IS2,IP,IDY,ICOL1, 1ISHR,IC1,IC2,ICOL2 COMMON/FRZZEE/ IFREE(1) COMMON/EYES/XEY(3),IFY,ES(4) COMMON/BUCKY/IBUCKY(1) COMMON/QFORIO/CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC LOGICAL CONTRS,IBAD,ISHR C CHANGE IY IF THIS IS A HORIZONTAL EDGE IF(IDY.EQ.0) IY=IY+1 IF(IY.GT.IFY) IY=IFY IPT=IBUCKY(IY) C GENERATE THE EDGE DATA IT1=(IX1*1024+IX2)*1024+IDY IT2=IZ1*32768+IZ2 NUMWRD=5 C GET EXTRA WORD FOR CONTOURS IF(CONTRS) NUMWRD=6 C JUMP IF NO EDGE SHARING IF(.NOT.ISHR) GO TO 4 C TRACE THROUGH THE ENTRIZZES ON THIS SCAN LINE AND FIND OUT C IF THIS EDGE HAS ALREADY BEEN ENTERED. 1 IF(IPT.EQ.0) GO TO 4 IF(IT1.EQ.IFREE(IPT).AND.IT2.EQ.IFREE(IPT+1)) GO TO 3 C GET THE NEXT BLOCK IPT=MOD(IFREE(IPT+2),262144) GO TO 1 C CHECK TO SEE IF THIS EDGE IS ALREADY SHARED C AND JUMP IF IT IS 3 IF(MOD(IFREE(IPT+4),8192).NE.0) GO TO 4 C NOW PROVIDE THE SHARING POLYGON IFREE(IPT+4)=IFREE(IPT+4)/8192*8192+IP GO TO 5 4 CONTINUE C GET ENOUGH FREE FOR EDGE BLOCK (160 OR 192 BITS) ZZ CALL GETVAR(IPT,NUMWRD) IF(IBAD) RETURN C XBEG(10), XEND(10), DELTA Y(10) IFREE(IPT)=IT1 C ZBEG(15), ZEND(15) IFREE(IPT+1)=IT2 C SBEG(6), SEND(6), NEXT EDGE(18) IFREE(IPT+2)=(IS1*64+IS2)*262144+IBUCKY(IY) C COLOR BEG(18), POLYGON NUMBER(13) IFREE(IPT+3)=ICOL1*8192+IP C COLOR END(18), SHARED POLYGON NUMBER(13) IFREE(IPT+4)=ICOL2*8192 C CONTOUR BEG(5), CONTOUR END(5) IFCONTRS) IFREE(IPT+5)=IC1*32+IC2 6 IBUCKY(IY)=IPT 5 RETURN END ZZ SUBROUTINE UNPACK C C SUBROUTINE UNPACK FOR 32 BIT MACHINES IN ANSI FORTRAN C C UNPACK PERFORMS THE REVERSE OF PACKER. IT IS CALLED BY C HIDDEN WITH IEDGPT SET AND RETURNS DATA THROUGH EDGBLK. COMMON/FREE/IFREE(1) COMMON/EDGBLK/IPT,ICOL1,IDELY,X1,X2,Z1,Z2,S1,S2, 1IEDGPT,C1,C2,SHARED,IGTHRZ,ICOL2 COMMON/QFORIO/CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC LOGICAL CONTRS C GET DELTAY VALUE 15 IDELY=MOD(IFREE(IEDGPT,1024) C JUMP IF A NON-HORIZONTAL LINE IF(IDELY.GT.0) GO TO 16 [[C JUMP IF WE ARE LOOKING FOR VERTICALS IF(IGTHRZ) 20,20,18 C JUMP IF WE ARE LOOKING FOR HORIZONTALS 16 IF(IGTHRZ) 19,19,20 C FLAG TO SAY THERE ARE HORIZONTAL EDGES ON THIS SCAN LINE 18 IGTHRZ=2 C GET NEXT EDGE BLOCK 19 IEDGPT=MOD(IFREE(IEDGPT+2),262144) C GO HOME IF WE RAN OFF THE END OF THE LIST IF(IEDGPT) 3,3,15 C GET Z BEGIN 20 Z1=FLOAT(MOD(IFREE(IEDGPT+1)/32768,32768)) C GET Z END AND MAKE IT REAL Z2=FLOAT(MOD(IFREE(IEDGPT+1),32768)) C GET X BEGIN X1=FLOAT(MOD(IF[[REE(IEDGPT)/1048576,1024)) C GET X END AND MAKE IT REAL X2=FLOAT(MOD(IFREE(IEDGPT)/1024,1024)) C GET SHADE BEGIN S1=FLOAT(MOD(IFREE(IEDGPT+2)/16777216,64)) C GET SHADE END AND MAKE IT REAL S2=FLOAT(MOD(IFREE+2)/262144,64)) C GET POINTER TO POLYGON IP=MOD(IFREE(IEDGPT+4),8192) C GET THE COLOR OF THIS EDGE ICOL1=MOD(IFREE(IEDGPT+3)/8192,262144) ICOL2=MOD(IFREE(IEDGPT+4)/8192,262144) C JUMP IF NO CONTOURING IF(.NOT.CONTRS) GO TO 4 C GET THE CONTOUR BEGIN C1=FLO[[AT(MOD(IFREE(IEDGPT+5)/32,32)) C CET THE CONTOUR END C2=FLOAT(MOD(IFREE(IEDGPT+5),32)) 4 SHARED=-2. C IPT=MOD(IFREE(IEDGPT+3),8192) C JUMP IF NOTHING IN THE TOP HALF IF(IP.EQ.0) GO TO 2 SHARED=-1. IF(ISHARE.EQ.1) GO TO 1 ISHARE=1 GO TO 3 1 IPT=IP C GET POINTER TO NEXT EDGE ON SCAN LINE 2 IEDGPT=MOD(IFREE(IEDGPT+2),262144) ISHARE=0 3 RETURN END [[XFER/A MT0:8 MOVIEMANUA XFER/A MT0:9 MOVIE.FO XFER/A MT0:10 OPEN XFER/A MT0:11 ROTAT XFER/A MT0:12 PICTUR XFER/A MT0:13 MULTDD XFER/A MT0:14 AINTEN XFER/A MT0:15 IVSBLE XFER/A MT0:16 MULTDC XFER/A MT0:17 ISHADE XFER/A MT0:18 DRAW XFER/A MT0:19 INTHID XFER/A MT0:20 HIDDEN.FO XFER/A MT0:21 LSTSET XFER/A MT0:22 GETBLK XFER/A MT0:23 RETBLK XFER/A MT0:24 INTCLP XFER/A MT0:25 POLMAK XFER/A MT0:26 EDGMAK XFER/A MT0:27 POLSNP XFER/A MT0:28 CLIP XFER/A MT0:29 FACMAK XFER/A MT0:30 HIDDEN XFER/A MT0:31 DRAWIT XFER/A\\ MT0:32 LINSHO XFER/A MT0:33 SHOW XFER/A MT0:34 PACKER XFER/A MT0:35 UNPACK XFER/A MT0:36 ERRMSG XFER/A MT0:37 CONSHO XFER/A MT0:38 DEVICE.FO XFER/A MT0:39 ENDFRM XFER/A MT0:40 PLTLIN XFER/A MT0:41 LABEL XFER/A MT0:42 SRL XFER/A MT0:43 UTILITY.FO XFER/A MT0:44 CMD XFER/A MT0:45 HELP XFER/A MT0:46 OVER XFER/A MT0:47 GEOM XFER/A MT0:48 DISP XFER/A MT0:49 SFUN XFER/A MT0:50 SYMM XFER/A MT0:51 MOVE XFER/A MT0:52 ORDER XFER/A MT0:53 OPEN.01 XFER/A MT0:54 RDGEOM XFER/A MT0:55 WRGEOM XFER/A MT0:56 RDSFUN XFER/A \\MT0:57 WRSFUN XFER/A MT0:58 RDDISP XFER/A MT0:59 WRDISP XFER/A MT0:60 SECTION.FO XFER/A MT0:61 BLOCK XFER/A MT0:62 OPEN.02 XFER/A MT0:63 RDCNTL XFER/A MT0:64 RDGEOM.01 XFER/A MT0:65 WRGEOM.01 XFER/A MT0:66 RDSFUN.01 XFER/A MT0:67 WRSFUN.01 XFER/A MT0:68 RDDISP.01 XFER/A MT0:69 WRDISP.01 XFER/A MT0:70 PLFILE XFER/A MT0:71 DIST XFER/A MT0:72 SOLID XFER/A MT0:73 SPLIT XFER/A MT0:74 LOOKUP XFER/A MT0:75 ENTER XFER/A MT0:76 DELETE XFER/A MT0:77 GETBLK.01 XFER/A MT0:78 ORDER.01 XFER/A MT0:79 PLYSRT XFER/A MT0:8\\0 REDUCE XFER/A MT0:81 TRGEOM XFER/A MT0:82 TRDISP XFER/A MT0:83 TRSFUN XFER/A MT0:84 TITLE.FO XFER/A MT0:85 BLOCK.01 XFER/A MT0:86 OPEN.03 XFER/A MT0:87 WRGEOM.02 XFER/A MT0:88 PACKER.16 XFER/A MT0:89 UNPACK.16 XFER/A MT0:90 PACKER.32 XFER/A MT0:91 UNPACK.32 XFER/A MT0:92 XFERMOVIE.BY XFER/A MT0:93 XFERMOVIE.BZ \\XFER/A MOVIEMANUA MT0:8 XFER/A MOVIE.FO MT0:9 XFER/A OPEN MT0:10 XFER/A ROTAT MT0:11 XFER/A PICTUR MT0:12 XFER/A MULTDD MT0:13 XFER/A AINTEN MT0:14 XFER/A IVSBLE MT0:15 XFER/A MULTDC MT0:16 XFER/A ISHADE MT0:17 XFER/A DRAW MT0:18 XFER/A INTHID MT0:19 XFER/A HIDDEN.FO MT0:20 XFER/A LSTSET MT0:21 XFER/A GETBLK MT0:22 XFER/A RETBLK MT0:23 XFER/A INTCLP MT0:24 XFER/A POLMAK MT0:25 XFER/A EDGMAK MT0:26 XFER/A POLSNP MT0:27 XFER/A CLIP MT0:28 XFER/A FACMAK MT0:29 XFER/A HIDDEN MT0:30 XFER/A DRAWIT MT0:31 XFER/A]] LINSHO MT0:32 XFER/A SHOW MT0:33 XFER/A PACKER MT0:34 XFER/A UNPACK MT0:35 XFER/A ERRMSG MT0:36 XFER/A CONSHO MT0:37 XFER/A DEVICE.FO MT0:38 XFER/A ENDFRM MT0:39 XFER/A PLTLIN MT0:40 XFER/A LABEL MT0:41 XFER/A SRL MT0:42 XFER/A UTILITY.FO MT0:43 XFER/A CMD MT0:44 XFER/A HELP MT0:45 XFER/A OVER MT0:46 XFER/A GEOM MT0:47 XFER/A DISP MT0:48 XFER/A SFUN MT0:49 XFER/A SYMM MT0:50 XFER/A MOVE MT0:51 XFER/A ORDER MT0:52 XFER/A OPEN.01 MT0:53 XFER/A RDGEOM MT0:54 XFER/A WRGEOM MT0:55 XFER/A RDSFUN MT0:56 XFER/A ]]WRSFUN MT0:57 XFER/A RDDISP MT0:58 XFER/A WRDISP MT0:59 XFER/A SECTION.FO MT0:60 XFER/A BLOCK MT0:61 XFER/A OPEN.02 MT0:62 XFER/A RDCNTL MT0:63 XFER/A RDGEOM.01 MT0:64 XFER/A WRGEOM.01 MT0:65 XFER/A RDSFUN.01 MT0:66 XFER/A WRSFUN.01 MT0:67 XFER/A RDDISP.01 MT0:68 XFER/A WRDISP.01 MT0:69 XFER/A PLFILE MT0:70 XFER/A DIST MT0:71 XFER/A SOLID MT0:72 XFER/A SPLIT MT0:73 XFER/A LOOKUP MT0:74 XFER/A ENTER MT0:75 XFER/A DELETE MT0:76 XFER/A GETBLK.01 MT0:77 XFER/A ORDER.01 MT0:78 XFER/A PLYSRT MT0:79 XFER/A REDUC]]E MT0:80 XFER/A TRGEOM MT0:81 XFER/A TRDISP MT0:82 XFER/A TRSFUN MT0:83 XFER/A TITLE.FO MT0:84 XFER/A BLOCK.01 MT0:85 XFER/A OPEN.03 MT0:86 XFER/A WRGEOM.02 MT0:87 XFER/A PACKER.16 MT0:88 XFER/A UNPACK.16 MT0:89 XFER/A PACKER.32 MT0:90 XFER/A UNPACK.32 MT0:91 XFER/A XFERMOVIE.BY MT0:92 XFER/A XFERMOVIE.BZ MT0:93 ]] ^^ ^^ M O V I E . B Y U ^^ ^^ A GENERAL PURPOSE COMPUTER GRAPHICS DISPLA^^Y SYSTEM ^^ SEPTEMBER 1976 ^^ MIKE STEPHENSON HANK CHRISTIANSEN DEPARTMENT OF CIVIL ENGR. CIVIL ENGINEERING DEPT. AND ENGINEERING MECH^^ANICS 368E ESTB THE UNIVERSITY OF ARIZONA BRIGHAM YOUNG UNIVERSITY TUCSON, ARIZONA 85721 PROVO, UTAH 84602 (602) 884-4803 (801) 374-1211 X2811 ^^ ^^ TABLE OF CONTENTS ^^ CHAPTER PAGE 1 MOVIE USER'S MANUAL . . . . . . . 1-1 2 UTILITY USER'S MANUAL . . . . . . 2-1 ^^ 3 SECTION USER'S MANUAL . . . . . . 3-1 4 TITLE USER'S MANUAL . . . . . . . 4-1 5 INSTALLING MOVIE.BYU . . . . . . 5-1 ^^ APPENDIX A SUGGESTED 16 BIT MACHINE CODE . . A-1 B SUGGESTED 32 BIT MACHINE CODE . . B-1 ^^ ^^ ^^ THE COMPUTER PROGRAMS DESCRIBED IN THIS DOCUMENT ARE AVAILABLE FROM HANK CHRISTIANSEN FOR A DISTRIBUTION CHARGE OF $25. NO CHARGE IS MADE FOR THE PROGRAMS WHICH WERE DEVELOPED UNDER PUBLIC FUNDING. NO AGENCY OF THE UNITED ^^ STATES GOVERNMENT, BRIGHAM YOUNG UNIVERSITY, THE UNIVERSITY OF ARIZONA, OR THEIR EMPLOYEES MAKES ANY WARRANTY EXPRESSED OR IMPLIED, OR ASSUMES ANY LEGAL RESPONSIBILITY FOR THE ACCURACY, COMPLETENESS OR USEFULNESS OF THESE COMPUTER PROGRAMS AND DOCUMENTS. ^^ ^^ CHAPTER 1 ^^ MOVIE USER'S MANUAL MOVIE IS AN INTERACTIVE PROGRAM FOR THE DISPLAY AND ANIMATION OF ANY MODEL COMPOSED OF TRIANGLES AND QUADRILA^^TERALS. THE PROGRAM ALLOWS THE USER TO MANIPULATE THE MODEL (ROTATE, TRANSLATE, ECT.), SPECIFY COLORS FOR THE BACKGROUND AND THE DIFFERENT ELEMENT GROUPS, AND SELECT THE DISPLAY DEVICE. THE PROGRAM PROCEEDS IN THE FOLLOWING MANNER, FIRST TYPING ON THE USER'S TERMINAL THE PROGRAM TITLE. ^^ ENTER THE GEOMETRY FILENAME.EXT. IF THE EXTENTION IS OMITTED, THE DEFAULT EXTENSION DAT ^^WILL BE USED. A ZERO FILE DESIGNATION WILL SKIP OVER THE GEOMETRY FILE AND REQUEST INFORMATION ABOUT THE DISPLACEMENT FILE. THIS IS HELPFUL WHEN USING SEVERAL DIFFERENT DISPLACEMENT OR SCALAR FUNCTION FILES WITH THE SAME GEOMETRY.(1) ^^ THE GEOMETRY FILE IS NOW READ USING THE FOLLOWING FORTRAN STATEMENTS. READ(IDTA,10) NP,NJ,NPT READ(IDTA,10) (^^(NPL(I,J),I=1,2),J=1,NP) READ(IDTA,20) ((X(I,J),I=1,3),J=1,NJ) READ(IDTA,10) ((IP(I,J),I=1,4),J=1,NPT) 10 FORMAT(20I4) 20 FORMAT(6E12.5) ^^ (1) THE MANNER IN WHICH DATA FILES ARE INITIALIZED IS AN INSTALLATION DEPENDENT FEATURE. APPROPRIATE MODIFICATIONS SHOULD BE MADE IN THE SOURCE PROGRAM TO ACCOMMODATE YOUR SYSTEM. MOVIE USER'S MANUAL Page 1-2 ^^ THE VARIABLES ARE DEFINED AS FOLLOWS: NP = THE NUMBER OF PARTS NJ = THE NUMBER OF NODES OR JOINTS NPT = ^^THE NUMBER OF ELEMENTS OR POLYGONS NPL = THE PARTS LIST ELEMENTS ARE GROUPED TOGETHER FOR CURVED SURFACE SIMULATION AND COLOR DEFINITION. THE PARTS LIST CONTAINS THE ELEMENT NUMBERS OF THE LOWER AND UPPER BOUNDS OF THE ELEMENT G^^ROUPING. BY REPEATING THE ELEMENT GROUP LIMIT NUMBERS IN THE PARTS LIST AND THEN USING THE EXPLODE AND PIVOT COMMANDS TO SEPARATE THE PARTS, COMPLEX PICTURES CAN BE DEVELOPED FROM RATHER SIMPLE DATA FILES. X = THE COORDINATES OF THE NODES ^^ IP = THE CONNECTIVITY OF THE ELEMENTS OR POLYGONS ENTER THE NAME OF THE DISPLACEMENT FILE IN THE SAME FORMAT USED ABOVE. A ZERO FILE DESIGNATION ^^ WILL SKIP THE DISPLACEMENT FILE AND REQUEST INFORMATION FOR THE SCALAR FUNCTION FILE. AT THIS POINT THE DISPLACEMENT FILE IS READ USING THE FOLLOWING FORTRAN STATEMENTS. ^^ READ(IDTA,10) ((U(I,J),I=1,3),J=1,NJ) 10 FORMAT(6E12.5) THE VARIABLE, U, IS THE VALUE O^^F THE DISPLACEMENTS AT THE NODES ENTER THE NAME OF THE SCALAR FUNCTION FILE IN THE FORM DESCRIBED ABOVE. A ZERO FILE ^^ DESIGNATION WILL SKIP OVER THE SCALAR FUNCTION AND PROMPT THE USER TO ENTER THE NEXT COMMAND. AT THIS POINT THE SCALAR FUNCTION WILL BE READ USING THE FOLLOWING FORTRAN STATEMENTS. ^^ READ(IDTA,10) (S(I),I=1,NJ) 10 FORMAT(6E12.5) MOVIE USER'S MANUAL Page 1-3 ^^ THE VARIABLE, S, IS THE VALUE OF THE SCALAR FUNCTION AT THE NODES. ^^ COMMAND PROMPT BEFORE ISSUING THE COMMAND PROMPT, SEVERAL PROGRAM VARIABLES ARE INITIALIZED SO THAT THE MODEL CAN BE DISPLAYED IMMEDIATELY^^. THE PROGRAM WILL ALSO REQUEST A DISPLAY DEVICE (SEE DEVICE) AND INFORMATION ABOUT DATA ORDERING (SEE FAST). >> ^^ THE PROGRAM IS NOW READY TO ACCEPT ONE OF THE ALLOWABLE COMMANDS. THE COMMANDS ARE LISTED IN ALPHABETICAL ORDER, AN^^D THE INFORMATION THEY REQUEST IS DISCUSSED IN THE FOLLOWING PARAGRAPHS. CENTER ^^ THE CENTER COMMAND INVOKES THE SUMMARY COMMAND, TRANSLATES THE ORIGIN TO THE CENTER OF THE MODEL, AND CALCULATES VALUES FOR DISTANCE TO THE ORIGIN, ANGLE OF VIEW, Z MIN., AND Z MAX. (SEE^^ COMMANDS DISTANCE AND FIELD.) THE CALCULATED VALUES WILL BE TYPED ON THE USER'S TERMINAL. COLOR ^^ THE COLOR COMMAND ALLOWS THE USER TO SPECIFY THE COLORS FOR THE BACKGROUND, FOR THE VARIOUS PARTS OF THE MODEL, AND FOR THE COLOR FRINGES. ^^ ENTER THE RED, BLUE, AND GREEN COLOR COMPONENTS OF THE BACKGROUND. THE LIGHT INTENSITY VARIES FROM 0 (NONE) TO 1 (FULL INTENSITY). MOVIE USER'S MANUAL Page 1-4 ^^ ENTER THE RED, BLUE, AND GREEN COLOR COMPONENTS OF EACH PART OF THE MODEL. IF I2 IS GREATER THAN I1, ALL PARTS I1 THR^^OUGH I2 WILL BE THE SAME COLOR. A LINE OF ZEROES TERMINATES THIS COMMAND. ENTER Y OR YES IF STANDARD FRINGE COLORS ARE ^^ DESIRED (THE STANDARD COLORS ARE BLUE, TURQUOISE, GREEN, YELLOW, RED.) ANY OTHER RESPONSE WILL SKIP THE NEXT REQUEST. ^^ ENTER Y OR YES TO REFLECT THE COLORS ABOUT A WHITE MIDPOINT (I.E. RED, YELLOW, GREEN, TURQUOISE, BLUE, WHITE, BLUE, TURQUOISE, ETC.) AND TO SKIP THE NEXT REQUEST. ^^ IF STANDARD FRINGE COLORS ARE NOT DESIRED, THEN ENTER THE FRINGE NUMBER AND THE COLOR COMPONENTS FOR THAT FRINGE. A LINE OF ZEROES TERMINATES THIS COMMAND. THIS REQUEST IS SKIPPED IF STANDARD FRINGES ARE USED. ^^ CONTOUR ^^ THE CONTOUR COMMAND ALLOWS THE USER TO PLOT CONTOUR LINES ON HIS HIDDEN LINE DRAWING OUTPUT. SINCE THE LINES ARE PLOTTED USING RASTER SCAN LOGIC, THE CONTOURS WILL CURVE ACROSS THE MODEL. <# OF CONTOURS, LABEL SPACING> ^^ ENTER THE NUMBER OF CONTOUR LINES (26 MAXIMUM) AND THE LABEL SPACING (THE NUMBER OF RASTER LINES BETWEEN LABELS). ^^ ENTER THE MINIMUM AND MAXIMUM CONTOUR VALUES TO BE PLOTTED. MOVIE USER'S MANUAL Page 1-5 ^^ DEVICE THE DE^^VICE COMMAND IS A SUBSET OF THE SCOPE COMMAND. IT ALLOWS THE USER TO CHANGE DISPLAY DEVICES WITHOUT CHANGING OTHER SCOPE PARAMETERS. ENTER ONE OF THE FOLLO^^WING ALLOWABLE DISPLAY DEVICE ABBREVIATIONS: HPLT (HP PLOTTER), CPLT (CALCOMP PLOTTER), TEKT (TEKTRONIX), OR COMT (COMTAL). ^^ DIFUSE THE DIFUSE COMMAND ALLOWS THE USER TO SPECIFY THE AMOUNT OF DIFUSED LIGHT IN THE PICTURE BY PARTS. A LINE OF ZEROE^^S TERMINATES THIS COMMAND. ENTER THE PART NUMBER AND THE VALUE OF DIFUSE FOR THAT PART. IF I2 IS GREATER THAN I1, THEN ALL PARTS I1 THR^^OUGH I2 WILL HAVE THE SAME DIFUSED LIGHT. DISTANCE ^^ THE DISTANCE COMMAND ALLOWS THE USER TO SPECIFY THE DISTANCE BETWEEN THE MODEL AND OBSERVER. ^^ ENTER THE DISTANCE FROM THE OBSERVER TO THE MODEL ORIGIN. ^^ DRAW THE DRAW COMMAND SENDS THE PICTURE DEFINED BY ALL PREVIOUS COMMANDS TO THE DISPLAY DEVICE SELECTED IN THE SCOPE OR DEVICE COMMANDS. WHEN THIS DISPLAY^^ OPTION IS USED MOVIE USER'S MANUAL Page 1-6 WITH LINE DRAWING OUTPUT, THE WATKIN'S HIDDEN LINE ALGORITHM IS NOT CALLED. ^^ EXIT THE^^ EXIT COMMAND PROVIDES A CONTROLED TERMINATION OF THE PROGRAM (INCLUDING DUMPING OF THE OUTPUT BUFFER). EXPLODE ^^ THE EXPLODE COMMAND ALLOWS THE USER TO SPECIFY LOCAL MOTION (EXPLOSION) PATTERNS FOR ANY GROUP OF ELEMENTS. ^^ ENTER THE PART NUMBERS AND THE LOCAL MOTION PATTERN IN THE X, Y, AND Z DIRECTIONS. IF I2 IS GREATER THAN I1, ALL PARTS I1 THROUGH I2 WILL HAVE THE SAME PATTERN. A LINE OF ZEROES TERMINATES THIS COMMAND. ^^ ENTER THE SCALE FACTOR TO BE USED IN SCALING THE ABOVE MOTION PATTERN PRIOR TO THEIR BEING ADDED TO THE NODAL COORDINATES. ^^ FAST ^^ THE FAST COMMAND ALLOWS THE USER TO DEFINE THE DATA ORGANIZATION AND INVOKE THE POOR MAN'S HIDDEN SURFACE PROCEDURE. ^^ ENTER Y OR YES IF THE POLYGONAL VERTICES IN THE GEOMETRY FILE ARE NOT ORDERED IN A CONSISTANT CLOCKWISE OR COUNTER-CLOCKWISE DIRECTION AND CAUSE THE NEXT TWO REQUESTS TO BE SKIPPED. THE POOR MAN'S HIDDEN SURFACE PROCEDURE CAN NOT BE USED UNLESS THE DATA IS CONSISTANT. ^^ MOVIE USER'S MANUAL Page 1-7 ENTER Y OR YES TO INVOK^^E THE POOR MAN'S HIDDEN SURFACE PROCEDURE. THE POOR MAN'S PROCEDURE WILL NOT SEND TO THE WATKIN'S ALGORITHM ANY POLYGON THE IS FACING AWAY FROM THE OBSEVER. THIS SIGNIFICATLY REDUCES THE TIME NEEDED TO SOLVE THE HIDDEN SURFACE PROBLEM. USE IT WHEN EVER POSSIBLE. ^^ ENTER Y OR YES TO INDICATE A CLOCKWISE ORIENTATION OF THE POLYGONAL VERTICES WHEN VIEWING THE ELEMENT ON ITS OUTSIDE FACE. A COUNTER-CLOCKWISE ORIENTATION IS ASSUMED OTHERWISE. ^^ FIELD ^^ THE FIELD COMMAND ALLOWS THE USER TO DEFINE THE FRUSTRUM OF VISION. ENTER THE ANGLE OF VIEW, THE DISTANCE TO^^ THE FRONT CLIPPING PLANE, AND THE DISTANCE TO THE BACK CLIPPING PLANE. THE FRONT AND BACK CLIPPING PLANES SHOULD BE PLACED FAR ENOUGH AWAY FROM THE MODEL TO ALLOW FOR ALL ROTATIONS AND TRANSLATIONS TO WHICH THE MODEL WILL BE SUBJECTED. A SMALL ANGLE OF VIEW WILL REDUCE THE PERSPECTIVE WHILE A LARGE ANGLE OF ^^ VIEW WILL EXAGGERATE THE PERSPECTIVE. FLAT ^^ THE FLAT COMMAND WILL INVOKE FLAT ELEMENT SHADING. THE LIGHT INTENSITY WILL VARY AS THE COSINE SQUARE OF THE NORMAL BETWEEN THE LIGHT SOURCE AND THE NORMAL TO THE ELEMENT, BUT THE LIGHT INTENSITIES WILL NOT (IN GENERAL) MATCH AT THE ELEMENT BOUNDARIES. ^^ MOVIE USER'S MANUAL Page 1-8 ^^ FRINGE THE FRINGE COMMAND ALLOWS THE USER TO SPECIFY COLOR FRINGES TO REPRESENT THE DISPLACEMENT SYSTEM OR A SCALAR FUNCTION. ^^ <# OF FRINGES> ENTER THE NUMBER OF COLOR FRINGES. THIS NUMBER SHOULD NOT EXCEED THE NUMBER OF FRINGES SPECIFIED IN THE COLOR COMMAND^^. ENTER Y OR YES IF DISPLACEMENT FRINGES ARE DESIRED. ANY OTHER RESPONSE WILL SKIP OVER FURTHER REQUEST FOR DISPLACEMENT FRINGE INFORMATION. ^^ ENTER THE DIRECTION COSINES FOR THE DIRECTION IN WHICH THE DISPLACEMENTS ARE TO BE MONITORED AND DISPLAYED IN TERMS OF COLOR FRINGES. ^^ ENTER THE PART NUMBERS AND THE MINIMUM AND MAXIMUM FRINGE VALUE FOR THOSE PARTS. VALUES LESS THAN THE MINIMUM WILL HAVE THE MINIMUM FRINGE COLOR, AND VALUES GREATER ^^ THAN THE MAXIMUM WILL HAVE THE MAXIMUM FRINGE COLOR. IF I2 IS GREATER THAN I1, THEN ALL PARTS I1 THROUGH I2 WILL HAVE THE SAME FRINGE RANGE. A LINE OF ZEROES TERMINATES THIS COMMAND. ^^ LINEAR THE LINEAR COMMAND ALONG WITH THE TRANSIENT DATA OPTION IN THE MOVIE COMMAND ALLOWS THE USER TO LINEARLY INTERPOLATE^^ BETWEEN TWO DISPLACEMENT AND/OR SCALAR FUNCTION FILES. ENTER Y OR YES IF THE NODAL GEOMETRY IS TO BE MODIFIED BY THE PREV^^IOUSLY READ DISPLACEMENTS MULTIPLIED BY THE SCALE FACTOR SPECIFIED IN THE SCALE COMMAND AND IF THE FIRST SCALAR FUNCTION IS TO BE INCREMENTED TO THE SECOND SCALAR FUNCTION. ^^ ENTER THE FILENAME.EXT OF THE DISPLACEMENT FILE AT TIME=I. IF THE EXTENTION IS OMITTED, THE DEFAULT EXTENSION DAT WILL BE USED. A NULL FILE DESIGNATION WILL SKIP TO THE NEXT REQUEST WITHOUT READING A FILE. THE DISPLACMENTS ARE READ IN THE SAME FORMAT AS DESCRIBED PREVIOUSLY. ^^ ENTER THE NAME OF THE DISPLACEMENT FILE AT TIME=I+1 IN THE SAME FORMAT AS ABOVE. ^^ ENTER THE NAME OF THE SCALAR FUNCTION FILE AT TIME=I IN THE SAME FORMAT AS ABOVE. ^^ ENTER THE NAME OF THE SCALAR FUNCTION FILE AT TIME=I+1 IN THE SAME FORMAT AS ABOVE. MOVIE USER'S MANUAL Page 1-10 ^^ MOVIE THE MOVIE^^ COMMAND ALLOWS THE USER TO SPECIFY A ANIMATED SEQUENCE OF FRAMES. A SIMULATION OF HARMONIC STRUCTURAL VIBRATION IS POSSIBLE USING THIS OPTION AND SPECIFYING A DISPLACEMENT SCALE FACTOR. <# OF FRAMES> ^^ ENTER THE NUMBER OF FRAMES. THIS OPTION IS NOT ONLY USEFUL WHEN GENERATING LONG SEGUENCES OF FRAMES FOR MOVIES BUT ALSO FOR AS FEW AS TWO OR THREE FRAMES TO VIEW THE MODEL FROM DIFFERENT POSITIONS. ^^ ENTER THE NUMBERS OF THE FIRST AND LAST FRAMES TO ACTUALLY BE DISPLAYED. THIS OPTION IS USEFUL WHEN THE SYSTEM CRASHES WHILE IN THE MIDDLE OF A LONG SEQUENCE. INSTEAD OF REGENERATING ALL ^^FRAMES OF THE SEQUENCE, IT IS ONLY NECESSARY TO GIVE THE NUMBERS OF THE FRAMES WANTED. IF A ZERO NUMBER OF FRAMES IS GIVEN, THE PROGRAM SENDS ALL THE FRAMES TO THE DISPLAY DEVICE. ^^ ENTER Y OR YES IF A LINEAR INTERPOLATION BETWEEN TWO DISPLACEMENT OR SCALAR FUNCTION FILES IS DESIRED OVER THE NUMBER OF FRAMES SPECIFIED ABOVE. IF THIS OPTION IS USED, THE NEXT REQUEST WILL BE SKIPPED ^^ IF A NON-ZERO DISPLACEMENT SCALE FACTOR WAS ENTERED, THIS COMMAND WILL BE TYPED ON THE USER'S TERMINAL. ENTER THE NUMBER OF VIBRATION CYCLES PER FRAME FOR SIMULATION OF HARMONIC VIBRATION. ^^ ENTER THE TOTAL CHANGE IN THE TRANSLATION OF THE ORIGIN IN THE X, Y, AND Z DIRECTIONS. ^^ ENTER THE TOTAL CHANGE IN ROTATION ABOUT THE TRANSLATED ORIGIN IN THE GLOBAL X, Y, AND Z DIRECTIONS. THE INCREMENTAL ROTATIONS WILL BE MADE IN THE X, Y, Z ORDER. REMEMBER, FINITE^^ ROTATIONS DO MOVIE USER'S MANUAL Page 1-11 NOT ADD AS VECTORS! ^^ ENTER THE PART NUMBERS AND THE ROTATIONS IN THE X, Y, AND Z DIRECTIONS ABOUT THE RELATIVE ORIGINS SPECIFIED IN THE PIVOT COMMAND. THIS COMMAND IS TERMINATED WITH A LINE OF ZEROES. ENTER THE CHANGE IN THE DISTANCE TO THE ORIGIN. A NEGATIVE VALUE WILL BRING THE MODEL TOWARDS THE OBSERVER. ^^ ENTER THE CHANGE IN THE DISPLACEMENT SCALE FACTOR. ^^ ENTER THE CHANGE IN THE LOCAL MOTION SCALE FACTOR. THIS COMMAND WILL PRODUCE SMOOTH ANIMATION OF THE EXPLOSION PATTERNS DEFINED IN THE EXPLODE COMMAND. ^^ ENTER Y OR YES TO SEND PICTURES TO THE DISPLAY DEVICE. ANY OTHER CHARACTER WILL CAUSE THE NEXT DISPLAY COMMAND TO PERFORM THE ANIMATION BUT WILL NOT SEND THE PICTURES TO THE DISPLAY DEVICE. THIS IS HELPFUL IN CHECKING KEY FRAMES IN A MOVIE SINCE THE FINAL SCEN^^E CAN BE DISPLAYED BY ISSUING A SECOND DISPLAY COMMANDS. PARTS ^^ THE PARTS COMMAND ALLOWS THE USER TO SELECT ALL OF THE MODEL OR A SUBSET OF THE MODEL FOR DISPLAY. ^^ ENTER Y OR YES TO DISPLAY ALL PARTS IN THE MODEL AND TO SKIP THE NEXT REQUEST. MOVIE USER'S MANUAL Page 1-12 ^^ ENTER THE NUMBERS OF THE PARTS THAT ARE TO BE DISPLAYED. IF I2 IS GREATER THAN I1, ALL PARTS I1 THROUGH I2 WILL BE DISPLAYED. A LINE OF ZEROES TERMINATES THIS COMMAND. ^^ PIVOT ^^ THE PIVOT COMMAND ALLOWS THE USER TO ROTATE INDIVIDUAL PARTS OF THE MODEL ABOUT AN ORIGIN DEFINED FOR THAT PART IN THE ORIGINAL AXIS DIRECTIONS OF THE MODEL. ^^ ENTER THE PART NUMBERS, THE AXIS (X, Y, OR Z), AND THE ANGLE OF ROTATION. IF I2 IS GREATER THAN I1, ALL PARTS I1 THROUGH I2 WILL BE PIVOTED. A LINE OF ZEROES TERMINATES THIS COMMAND. ^^ ENTER THE PART NUMBERS AND THE RELATIVE ORIGIN OF THE PARTS. THE RELATIVE ORIGIN SPECIFIES THE POINT ABOUT WHICH THE ROTATIONS WILL TAKE PLACE. ROTATIONS ARE ABOUT AXES PARALLEL TO THE ORIGINAL AXES OF THE MODEL. A LINE OF ZEROES TERMINATES THIS COMMAND. ^^ READ ^^ THE READ COMMAND RETURNS CONTROL TO THE BEGINNING OF THE PROGRAM SO THE USER MAY READ IN NEW GEOMETRY, DISPLACEMENT, AND SPECIAL FUNCTION FILES. ^^ RESTORE THE RESTORE COMMAND ZEROES ALL ROTATIONS AND TRANSLATIONS AND INTIALIZES THE ROTATION TRAN^^SFORMATION MATRIX. MOVIE USER'S MANUAL Page 1-13 ROTATE ^^ THE COMMAND ROTATE ALLOWS THE USER TO ROTATE THE MODEL ABOUT THE TRANSLATED ORIGIN. ^^ ENTER ONE OF THE AXES (X, Y, OR Z) AND THE ANGLE OF ROTATION IN DEGREES. SCALE ^^ THE SCALE COMMAND ALLOWS THE USER TO SELECT A SCALE FACTOR FOR THE DISPLACEMENTS. THE DISPLACEMENTS WILL BE MULTIPLIED BY THE SCALE FACTOR BEFORE THEY ARE ADDED TO THE ^^ NODAL COORDINATES. ENTER THE DISPLACEMENT SCALE FACTOR. ^^ SCOPE THE SCOPE COMMAND REQUES^^TS INFORMATION NECESSARY TO DEFINE CERTAIN PICTURE VARIABLES. ENTER ONE OF THE FOLLOWING ALLOWABLE DISPLAY DEVICE ABBREVIATIONS: HPLT (HP PLOTTER), ^^CPLT (CALCOMP PLOTTER), TEKT (TEKTRONIX), OR COMT (COMTAL). THIS REQUEST IS ISSUED FOR CONTINUOUS-TONE ^^ DISPLAY DEVICES ONLY. ENTER C OR COLOR TO DISPLAY THE SCENE IN COLOR. THE DEFAULT DISPLAY MODE IS BLACK AND WHITE. ENTER T^^HE RESOLUTION IN THE HORIZONTAL AND VERTICAL DIRECTIONS. IF ONLY THE XRESOL IS GIVEN, YRESOL IS ASSUMED TO HAVE THE SAME VALUE. IF BOTH MOVIE USER'S MANUAL Page 1-14 ARE ZERO, THE MAXIMUM VALUE OF 512 IS U^^SED. SMOOTH ^^ THE SMOOTH COMMAND WILL INVOKE SMOOTH ELEMENT SHADING. THE LIGHT INTENSITY WILL MATCH AT ELEMENT BOUNDARIES PROVIDING CURVED SURFACE SIMULATION. THE DERIVATIVE OF THE LIGHT INTENSITY MAY NOT MATCH AT ELEMENT BOUNDARIES CAUSING MACH BAND EFFECTS (WHICH MAY OR MAY NOT BE NOTICABLE).^^ SUMMARY ^^ THE SUMMARY COMMAND CALCULATES THE MINIMUM AND MAXIMUM VALUES OF THE COORDINATES, DISPLACEMENTS, AND SCALAR FUNCTIONS AND TYPES THEM ON THE USER'S TERMINAL FOR THE PARTS SPECIFIED IN CONTENT. ^^ TRANSLATE ^^ THE TRANSLATE COMMAND ALLOWS THE USER TO SHIFT THE ORIGIN OF THE MODEL TO A NEW LOCATION. ENTER THE COORDINATES OF THE NEW ORIGIN. ^^ UNIFORM ^^ THE UNIFORM COMMAND INVOKES UNIFORM SHADING OF THE ELEMENT FACES. THE SHADING WILL REMAIN CONSTANT OVER EACH INDIVIDUAL ELEMENT. THE VALUE USED IS THE AVERAGE OF THE NODAL VALUES BASED UPON FLAT SHADING. ^^ MOVIE USER'S MANUAL Page 1-15 VIEW ^^ THE VIEW COMMAND SENDS THE PICTURE DEFINED BY ALL PREVIOUS COMMANDS TO THE DISPLAY DEVICE SELECTED IN THE SCOPE OR DEVICE COMMANDS. THIS DISPLAY COMMAND WILL INVOKE WATKIN'S ALGORITHM TO REMOVE HIDDEN LINES OR SURFACES. THE PROGRAM WILL TYPE THE COLOR OPTION IN EFFECT^^ IF THE OUTPUT IS A CONTINUOUS TONE PICTURE ELSE IT WILL TYPE THE NAME OF THE LINE DRAWING OUTPUT DEVICE. WARP ^^ THE WARP COMMAND ALLOWS THE USER TO SPECIFY THE SCALE FACTORS IN THE X, Y, AND Z DIRECTIONS OF THE MODEL BY WHICH THE SCALAR FUNCTIONS WILL BE MODIFIED BEFORE THEY ARE ADDED TO ^^THE NODAL COORDINATES. THIS IS USEFUL OVER LARGE PLANAR AREAS WHEN THE SCALE FACTORS ARE A MULTIPLE OF THE DIRECTIONS COSINES OF A NORMAL TO THE PLANAR AREA. ENTER THE WARPING ^^ SCALE FACTORS FOR THE MODEL PARTS. ERROR MESSAGES ^^ IF A COMMAND IS NOT RECOGNIZED DURING THE EXECUTION OF THE PROGRAM, THE ILLEGAL COMMAND IS TYPED ON THE USER'S TERMINAL AS FOLLOWS. IF THE USER WISHES TO SEE A LIST OF THE AVAILABLE COMMANDS, HE SHOULD ANSWER Y OR YES TO THIS ERROR MESSAGE. Page Index-1 ^^ MOVIE USER'S MANUAL INDEX ^^ Animated sequence . . . . . . 1-10 Center . . . . . . . . . . . . 1-3 Color . . . . . . . . . . . . 1-3 Command prompt . . . . . . . . 1-3 Contour . . . . . . . . . . . 1-4 ^^ Device . . . . . . . . . . . . 1-5 Difuse . . . . . . . . . . . . 1-5 Displacement file . . . . . . 1-2 Distance . . . . . . . . . . . 1-5 Draw . . . . . . . . . . . . . 1-5 ^^ Error messages . . . . . . . . 1-15 Exit . . . . . . . . . . . . . 1-6 Explode . . . . . . . . . . . 1-6 Fast . . . . . . . . . . . . . 1-6 Field . . . . . . . . . . . . 1-7 ^^ Flat . . . . . . . . . . . . . 1-7 Fringe . . . . . . . . . . . . 1-8 Geometry file . . . . . . . . 1-1 Help . . . . . . . . . . . . . 1-8 ^^ Ip . . . . . . . . . . . . . . 1-2 Linear . . . . . . . . . . . . 1-9 Movie . . . . . . . . . . . . 1-10 ^^ Nj . . . . . . . . . . . . . . 1-2 Np . . . . . . . . . . . . . . 1-2 Npl . . . . . . . . . . . . . 1-2 Npt . . . . . . . . . . . . . 1-2 Parts . . . . . . . . . . . . 1^^-11 Pivot . . . . . . . . . . . . 1-12 Read . . . . . . . . . . . . . 1-12 Restore . . . . . . . . . . . 1-12 Rotate . . . . . . . . . . . . 1-13 ^^ S . . . . . . . . . . . . . . 1-2 Scalar function file . . . . . 1-2 Scale . . . . . . . . . . . . 1-13 Scope . . . . . . . . . . . . 1-13 Smooth . . . . . . . . . . . . 1-14 Structural vibration . . . . . 1-10 ^^ Summary . . . . . . . . . . . 1-14 Translate . . . . . . . . . . 1-14 U . . . . . . . . . . . . . . 1-2 Uniform . . . . . . . . . . . 1-14 ^^ View . . . . . . . . . . . . . 1-15 Warp . . . . . . . . . . . . . 1-15 X . . . . . . . . . . . . . . 1-2 ^^ ^^ ^^ CHAPTER 2 UTILITY USER'S MANUAL INTRODUCTION ^^ UTILITY IS A ROUTINE DESIGNED TO EDIT FORTRAN DATA FILES IN A FORMAT WHICH IS COMPATIBLE WITH MOVIE (PANEL DATA) OR SECTION (SOLID DATA). THE PROGRAM IS BASED UPON A FOUR LETTER KEY WORD SYSTEM WHICH ALLOWS THE USER TO SPECIFY ^^ COMMANDS TO READ, WRITE, OR CHANGE DATA FILES, TO PERFORM SYMMETRY OPERATIONS (E. G. TO CREATE A MODEL OF A COMPLETE SPHERE BASED UPON A MODEL OF 1/8 OF THE SPHERE LOCATED IN THE FIRST QUADRANT), TO ORDER PANEL DATA CONSISTENTLY, OR TO EXIT FROM THE PROGRAM IN A CONTROLLED MANNER. ^^ WHILE THE FOLLOWING INSTRUCTIONS ARE RATHER LENGTHY, USERS WILL NORMALLY NOT FIND MUCH REASON TO REFER TO THEM. THE SYSTEM IS EASILY LEARNED SINCE THE PROGRAM ASKS SPECIFIC QUESTIONS OR GIVES ONE OF THE FOLLOWING PROMPTS (> FOR LEVEL 1, >> FOR LEVEL 2, OR >>> FOR LEVEL 3). WHEN THESE PROMPTS ARE ENCOUNTERED, A LISTING OF THE AVAILABLE OPTIONS MAY BE OBTAINED BY ENTERING ? OR ^^ HELP. ESCAPE FROM REPEATED REQUESTS (IF ESCAPE IS APPROPRIATE) IS ACCOMPLISHED WITH A CARRIAGE RETURN. A CARRIAGE RETURN FOLLOWING THE PROMPT (>>>) FOR LEVEL 3 WILL TRANSFER CONTROL TO LEVEL 2 AND GIVE THE PROMPT (>>). ESCAPE TO LEVEL 1 IS ALSO OBTAINED BY A CARRIAGE RETURN. ^^ SINCE UTILITY IS APPLICABLE TO BOTH SOLID DATA (8 NODE BRICKS) AND PANEL DATA (TRIANGLES AND QUADRILATERALS), THE PROGRAM ISSUES THE FOLLOWING REQUEST. ^^ ENTER S OR SOLID FOR SOLID DATA MANIPULATION. ANY OTHER RESPONSE WILL DEFAULT TO PANEL DATA. UTILITY USER'S MANUA^^L Page 2-2 LEVEL 1 ^^ THE PROGRAM IS ENTERED AT LEVEL 1 AND THE CORRESPONDING PROMPT (>) IS GIVEN. AT THIS POINT THE USER SHOULD ENTER ONE OF THE FOLLOWING COMMANDS: GEOMETRY, DISPLACEMENT, FUNCTION, SYMMETRY, ORDER, OR EXIT. ACTUALLY ONLY THE FIRST FOUR LETTERS OF THE COMMANDS ARE REQUIRED. IF ANY OTHER COMMAND IS GIVEN, THE ABOVE OPTIONS ARE LISTED ^^ AND THE PROMPT IS REPEATED. IF THE COMMAND GIVEN IS GEOM, DISP, OR SPEC THE PROGRAM ENTERS LEVEL 2. IF THE COMMAND IS SYMM, SYMMETRY OPERATIONS ARE PERFORMED AS SPECIFIED. IF THE COMMAND IS ORDER AND THE PROGRAM IS IN PANEL MODE, THE ELMENTS OR PANELS ARE CONSISTENTLY ORDERED WITHIN EACH ELEMEMT GROUP. FOR THE COMMAND EXIT, THE BUFFERS ARE DUMPED AND CONTROL^^ IS RETURNED TO THE MONITOR. LEVEL 2 ^^ THE LEVEL 2 ALGORITHM ENTERED DEPENDS UPON THE COMMAND GIVEN IN LEVEL 1. HOWEVER, THEY ALL SHARE THE SAME FUNCTIONAL COMMANDS WHICH ARE READ, WRITE, CHANGE, PRINT AND EXIT. IF THE COMMAND GIVEN IS UNACCEPTABLE, THE LEVEL 2 OPTIONS ARE LISTED AND THE PROMPT IS REPEATED. THE RESPONS^^E TO THE FIVE ACCEPTABLE COMMANDS DEPENDS UPON THE COMMANDS GIVEN AT BOTH LEVEL 1 AND LEVEL 2. THIS RESPONSE WILL NOW BE DISCUSSED ACCORDING TO THE VARIOUS COMBINATIONS OF LEVEL 1 - LEVEL 2 COMMANDS. ^^ GEOM-READ ^^ ENTER THE INPUT GEOMETRY FILENAME.EXT. THE FILENAME SHOULD NOT EXCEED SIX CHARACTERS, AND THE EXTENSION SHOULD NOT EXCEED THREE. IF THE EXTENSION IS OMITTED, THE DEFAULT EXTENSION DAT WILL BE ASSUMED.(1) ^^ (1) THE MANNER IN WHICH DATA FILES ARE INITIALIZED IS AN INSTALLATION DEPENDENT FEATURE. APPROPRIATE MODIFICATIONS SHOULD BE MADE IN THE SOURCE PROGRAM TO ACCOMMODATE YOUR SYSTEM. UTILITY USER'S MANUAL Page 2-3 ^^ AT THIS POINT THE GEOMETRY FILE WILL BE READ USING THE FOLLOWING FORTRAN STATEMENTS. READ(IDTA^^,10) NP,NJ,NPT READ(IDTA,10) ((NPL(I,J),I=1,2),J=1,NP) READ(IDTA,20) ((X(I,J),I=1,3),J=1,NJ) READ(IDTA,10) ((IP(I,J),I=1,N),J=1,NPT) 10 FORMAT(20I4) 20 FORMAT(6E12.5) ^^ THE VARIABLES ARE DEFINED AS FOLLOWS: NP = THE NUMBER OF PARTS NJ = THE NUMBER OF NODES OR JOINTS NPT = THE NUMBER OF ELEMENTS ^^ NPL = THE PARTS ARRAY(2) X = THE COORDINATES OF THE NODES IP = THE CONNECTIVITY OF THE ELEMENTS AFTER READING THE GEOMETRY FILE THE PROGRAM REQUEST VERIFICA^^TION THAT THE PARTS ARRAY IS DEFINED PROPERLY. (LIST OF TOTAL NPL ARRAY) (LIST OF DIFFERENCED NPL ARRAY) ^^ ENTER Y OR YES IF THE PARTS ARRAY IS DEFINED PROPERLY. ANY OTHER RESPONSE WILL REQUEST THE USER TO REDEFINE THE PARTS ARRAY. ^^ ^^ (2) THE PARTS ARRAY IS DEFINED IN ONE OF TWO WAYS. THE FIRST DEFINITION ASSUMS THAT THE ARRAY IS ONE DIMENSIONAL. EACH STORAGE LOCATION IN THE ARRAY CONTAINS THE NUMBER OF ELEMENTS IN THE ELEMENT GROUP THAT CORRESPONDS WITH THAT LOCATION. THE SECOND DEFINITION ASSUMS THAT THE ARRAY IS TWO DIMENSIONAL. THE ARRAY CONTAINS THE LOWER AND UPPER LIMIT NUMBERS OF THE EL^^EMENTS ASSOCIATED WITH THAT PART. THESE DEFINITIONS ARE NOT NECESSARILY INTERCHANGABLE. THE SECOND DEFINITION ALLOWS PARTS TO OVERLAP WHILE THE FIRST DOES NOT. UTILITY REQUIRES THE NPL ARRAY BE DEFINED AS IN THE FIRST DEFINITION INTERNALLY ALTHOUGHT THE NPL ARRAY IS READ AND WRITTEN ACCORDING TO THE SECOND DEFINITION. UTILITY USER'S MANUAL ^^ Page 2-4 THIS MESSAGE IS PRINTED IF THE PROGRAM DETECTS MULTIPLY DEFINED PARTS WHILE ATTEMPTING TO ^^ CONSTRUCT THE PARTS ARRAY. THE PROGRAM WILL REQUEST THE USER TO SUPPLY THE CORRECT PARTS ARRAY. ENTER THE NUMBER OF ELEMENT GROUPINGS ^^ ENTER THE NUMBER OF ELEMENTS IN EACH GROUP. ^^ GEOM-WRITE ^^ ENTER THE OUTPUT GEOMETRY FILENAME.EXT. THE FILENAME SHOULD NOT EXCEED SIX CHARACTERS, AND THE EXTENSION SHOULD NOT EXCEED THREE. IF THE EXTENSION IS OMITTED, THE DEFAULT EXTENSION DAT WILL BE ASSUMED. ^^ BEFORE WRITING THE GEOMETRY FILE, THE PROGRAM ALLOWS THE USER TO VERIFIY THE PARTS ARRAY AND TO CHANGE IT IF DESIRED. ^^ (LIST OF NPL ARRAY) ENTER Y OR YES IF THE LOWER AND UPPER LIMITS OF THE PARTS ARRAY ARE CORRECT. ANY OTHER RESPONSE WILL REQUEST NEW ELEMENT LIMIT INFORMATION. ^^ ENTER THE NUMBER OF PARTS. ^^ ENTER THE LOWER AND UPPER LIMIT NUMBERS OF THE BOUNDING ELEMENTS FOR EACH PART. (REMEMBER, THIS MAY BE AN OVERLAPPING DEFINITION.) UTILITY USER'S MANUAL Page 2-5 ^^ AT THIS POINT THE GEOMETRY FILE WILL BE WRITTEN USING THE FOLLOWING FORTRAN STATEMENTS. WRITE(IDTA,10) NP,NJ,NPT WRITE(IDTA,10) ((NPL(I,J),I=1,2),J=1^^,NP) WRITE(IDTA,20) ((X(I,J),I=1,3),J=1,NJ) WRITE(IDTA,10) ((IP(I,J),I=1,N),J=1,NPT) 10 FORMAT(20I4) 20 FORMAT(1P6E12.5) ^^ FOR VARIABLE DESCIPTIONS, SEE GEOM-READ. GEOM-CHANGE ^^ THIS COMMAND RESULTS IN THE PROGRAM ENTERING LEVEL 3 WITH THE USER RECEIVING THE PROMPT (>>>). THE ALLOWABLE COMMANDS IN THIS INSTANCE ARE GROUP, COORDINATES, ELEMENTS, MOVE, AND EXIT AN UNACCEPTABLE COMMAND WILL RESULT IN A LISTING OF THE FIVE LEGITIMATE C^^OMMANDS AND THE PROMPT (>>>). ISSUE OF AN ACCEPTABLE COMMAND RESULTS IN THE FOLLOWING ACTIONS. GEOM-CHAN-GROUP ^^ ENTER THE NUMBER OF ELEMENT GROUPS (NP). ^^ ENTER THE COMPLETE ELEMENT GROUP LIST (NPL(1,I),I=1,NP). GEOM-CHAN-COORDINATES ^^ ENTER Y OR YES TO CHANGE THE TOTAL NUMBER OF NODES (NJ) IN THE MODEL. ANY OTHER RESPONSE WILL SKIP THE NEXT REQUEST. ^^ UTILITY USER'S MANUAL Page 2-6 ^^ ENTER THE NEW NUMBER OF NODES. ENTER THE APPROPRIATE NODE NUMBER AND CORRESPONDING X, Y, AND Z COORDINATE VALUES (RIGHT HANDED SY^^STEM) ACCORDING TO THE FORMAT (I,3E). IF THE NODE NUMBER IS LARGER THAN THE CURRENT TOTAL NUMBER OF NODES, THE TOTAL NUMBER OF NODES IS INCREASED TO THE VALUE OF THE ENTERED NODE NUMBER. GEOM-CHAN-ELEMENT ^^ ENTER A OR ADD TO ADD NEW ELEMENTS; ENTER D OR DELETE TO DELETE OLD ELEMENTS. ^^ ENTER THE PART NUMBER AND ELEMENT NUMBERS (IN APPROPRIATE ORDER) ACCORDING TO THE FORMAT (5I) FOR QUADRILATERAL ELEMENTS, (4I) FOR TRIANGULAR ^^ELEMENTS AND (9I) FOR SOLID ELEMENTS. ELEMENTS ARE INSERTED INTO THE ELEMENT LIST AT THE END OF THE GROUP OF ELEMENTS FOR THE INDICATED PART. THE APPROPRIATE PART GROUP NUMBER (NPL(1,I)) WILL BE INCREASED. IF THE USER WISHES TO ENTER ELEMENTS IN A NEW PART GROUP, HE SHOULD FIRST USE THE LEVEL 3 COMMAND PART TO INCREA^^SE THE TOTAL NUMBER OF PARTS BY ONE AND ENTER THE VECTOR (NPL(1,I)) WITH THE LAST VALUE (FOR THE NEW GROUP) SET EQUAL TO ZERO. APPROPRIATE MODIFICATION IS MADE IN (NPL(1,I)) IF AN ELEMENT IS DELETED. HOWEVER, IF AN ENTIRE PART IS DELETED, THE COMMAND PART SHOULD BE EXECUTED (AFTER THE COMPLETION OF THE DELETION PROCESS) TO RE^^DUCE THE TOTAL NUMBER OF PARTS. IF AN ELEMENT IS SPECIFIED TO BE DELETED FROM THE LIST AND CANNOT BE FOUND IN THE LIST, THE PROGRAM RESPONDS WITH THE MESSAGE %. IF AN ELEMENT HAS BEEN ENTERED WITH AN INCORRECT NODE NUMBER, THE CORRECTION WILL REQUIRE THAT THE ELEMENT ^^ BE DELETED AND THE CORRECT ONE ENTERED (I. E. THERE IS NO REPLACE FEATURE!). UTILITY USER'S MANUAL Page 2-7 GEOM-CHAN-MOVE ^^ ENTER THE APPROPRIATE VALUES FOR I1, I2, AND I3. TO ILLUSTRATE THE USE OF THIS COMMAND, CONSIDER THE FOLLOWING EXAMPLE. SUPPOSE THAT ^^ WE WISH TO REORDER A LIST OF SIX ELEMENTS SUCH THAT THE FIRST TWO ELEMENTS REMAIN WHERE THEY ARE, THE FIFTH ELEMENT BECOMES THE THIRD ELEMENT, THE THIRD AND FOURTH ELEMENTS BECOME THE FOURTH AND FIFTH ELEMENTS AND THE SIXTH ELEMENT RETAINS ITS POSITION. THIS REORDERING MAY BE ACHIEVED BY THE MOVE COMMAND ^^ (2,3,5) OR (1,5,2). MOVE COMMANDS DO NOT AUTOMATICALLY RESULT IN CHANGES TO THE (NPL(1,I)) LIST. THE USER MAY MODIFY (NPL(1,I)) AS APPROPRIATE, EITHER BEFORE OR AFTER USING THE MOVE COMMAND. CAUTION SHOULD BE EXERCISED IN THE USE OF REPEATED MOVE COMMANDS TO AVOID GETTING ALL MIXED UP. ^^USE OF PRIN COMMANDS BETWEEN MOVE COMMANDS TO ESTABLISH ELEMENT GROUP LIMIT LOCATIONS IS RECOMMENDED. GEOM-PRINT ^^ THIS COMMAND PAIR IS STRUCTURED SO AS TO FACILITATE QUICK CHECKS OF SUBSETS OF THE DATA. THESE COMMANDS RESULT IN THE PROGRAM ENTERING A LEVEL 3 OPERATION WITH THE PROMPT (>>>) WHICH IS SIMILAR TO THAT DISCUSSED IN GEOM-CHAN. THE ^^ ACCEPTABLE COMMANDS AT THIS LEVEL ARE GROUP, COORDINATES, ELEMENTS, AND EXIT. ISSUE OF ONE OF THESE COMMANDS RESULTS IN THE FOLLOWING ACTION. GEOM-PRIN-GROUP ^^ THE COMPLETE PART LIST (NPL(1,I),I=1,NP) IS PRINTED. GEOM-PRIN-COORDINATE ^^ ENTER I1 AND I2 WITH I1 BEING THE LOWER LIMIT AND I2 BEING THE UPPER LIMIT NODE NUMBERS (2I FORMAT). TO OBTAIN THE COORDINATES OF A SING^^LE NODE SIMPLY ENTER JUST THE DESIRED NODE AS I1 AND DO NOT ENTER I2. I2 WILL BE ADJUSTED TO BE NOT GREATER THAN (NJ). UTILITY USER'S MANUAL Page 2-8 ^^ GEOM-PRIN-ELEMENT ENTER I1 AND I2 WITH I1 BEING THE LOWER LIMIT AND ^^I2 BEING THE UPPER LIMIT ELEMENT NUMBERS (2I FORMAT). TO OBTAIN THE NODE NUMBERS OF A SINGLE ELEMENT SIMPLY ENTER JUST THE DESIRED ELEMENT AS I1 AND DO NOT ENTER I2. I2 WILL BE ADJUSTED TO BE NOT GREATER THAN (NPT). ^^ DISP-READ ^^ ENTER THE INPUT DISPLACEMENT FILENAME.EXT. THE FILENAME SHOULD NOT EXCEED SIX CHARACTERS, AND THE EXTENSION SHOULD NOT EXCEED THREE. IF THE EXTENSION IS OMITTED, THE DEFAULT EXTENSION DAT WILL BE ASSUMED. ^^ AT THIS POINT THE DISPLACEMENT FILE WILL BE READ USING THE FOLLOWING FORTRAN STATEMENTS. READ(IDTA,20) ((U(I,J),I=1,^^3),J=1,NJ) 20 FORMAT(6E12.5) THE VARIABLE, U, IS THE DISPLACEMENTS AT THE NODES. ^^ DISP-WRITE ^^ ENTER THE OUTPUT DISPLACEMENT FILENAME.EXT. THE FILENAME SHOULD NOT EXCEED SIX CHARACTERS, AND THE EXTENSION SHOULD NOT EXCEED THREE. IF THE EXTENSION IS OMITTED, THE DEFAULT EXTENSION DAT WILL BE ASSUMED. ^^ AT THIS POINT THE DISPLACEMENT FILE WILL BE WRITTEN USING THE FOLLOWING FORTRAN STATEMENTS. UTILITY USER'S MANUAL Page 2-9 ^^ WRITE(IDTA,20) ((U(I,J),I=1,3),J=1,NJ) 20 FORMAT(1P6E12.5) FOR VARIABLE DESCIPTIONS, SEE DISP-READ. ^^ DISP-CHANGE ^^ ENTER THE NODE NUMBER AND THE X, Y, AND Z COORDINATE DIRECTION DISPLACEMENT COMPONENTS IN AN (I,3E) FORMAT. ^^ DISP-PRINT ENTER I1 AND I2 WITH I1 BEING THE LOWER ^^ LIMIT AND I2 BEING THE UPPER LIMIT NODE NUMBERS (2I FORMAT). TO OBTAIN THE DISPLACEMENTS OF A SINGLE NODE SIMPLY ENTER JUST THE DESIRED NODE AS I1 AND DO NOT ENTER I2. I2 WILL BE ADJUSTED TO BE NOT GREATER THAN (NJ). ^^ FUNC-READ ^^ ENTER THE INPUT SCALAR FUNCTION FILENAME.EXT. THE FILENAME SHOULD NOT EXCEED SIX CHARACTERS, AND THE EXTENSION SHOULD NOT EXCEED THREE. IF THE EXTENSION IS OMITTED, THE DEFAULT EXTENSION DAT WILL BE ASSUMED. ^^ AT THIS POINT THE SCALAR FUNCTION FILE WILL BE READ USING THE FOLLOWING FORTRAN STATEMENTS. ^^ READ(IDTA,20) (S(I),I=1,NJ) 20 FORMAT(6E12.5) UTILITY USER'S MANUAL Page 2-10 THE VARIABLE, S^^, IS THE SCALAR FUNCTION AT THE NODE. FUNC-WRITE ^^ ENTER THE OUTPUT SCALAR FUNCTION FILENAME.EXT. THE FILENAME SHOULD NOT EXCEED SIX CHARACTERS, AND THE EXTENSION SHOULD NOT EXCEED ^^ THREE. IF THE EXTENSION IS OMITTED, THE DEFAULT EXTENSION DAT WILL BE ASSUMED. AT THIS POINT THE SCALAR FUNCTION FILE WILL BE WRITTEN USING THE FOLLOWING FORTRAN STATEMENTS. ^^ WRITE(IDTA,20) (S(I),I=1,NJ) 20 FORMAT(1P6E12.5) FOR VARIABLE DESCIPTIONS, SEE ^^FUNC-READ. FUNC-CHANGE ^^ ENTER THE NODE NUMBER AND THE SCALAR FUNCTION VALUE. ^^ FUNC-PRINT ENTER I1 AND ^^I2 WITH I1 BEING THE LOWER LIMIT AND I2 BEING THE UPPER LIMIT NODE NUMBERS (2I FORMAT). TO OBTAIN THE SCALAR FUNCTION OF A SINGLE NODE SIMPLY ENTER JUST THE DESIRED NODE AS I1 AND DO NOT ENTER I2. I2 WILL BE ADJUSTED TO BE NOT GREATER THAN (NJ). ^^ THIS COMPLETES THE DISCUSSION OF THE LEVEL 1-LEVEL 2 COMMAND COMBINATIONS. THE FOLLOWING PARAGRAPHS DESCRIBE THE OTHER LEVEL 1 COMMANDS WHICH ARE SYMMETRY AND ORDER. UTILITY USER'S MANUAL Page 2-11 ^^ SYMMETRY THE SYMMETRY COMMAND PROVIDES MODIFICATION TO THE GEOMETRY, DISPLACEM^^ENT, AND SPECIAL FUNCTION FILES. THE SYMMETRY OPERATION WILL DOUBLE THE NUMBER OF PARTS AND ELEMENTS, BUT THE NUMBER OF NODES WILL NOT DOUBLE DUE TO THE PRESENCE OF NODES ON THE PLANE OF SYMMETRY (WHICH ARE NOT REPEATED). IF BEFORE THE SYMMETRY OPERATION THERE WERE (NP) PARTS, THE SYMMETRICAL COUNTERPART TO THE NTH PART IS FOUND TO BE THE NP+NTH PART. ^^ ENTER ONE OF THE ACCEPTABLE SYMMETRY PLANES XY, XZ, OR YZ, OR A CARRIAGE RETURN TO PROVIDE ^^ ESCAPE. ENTER Y OR YES TO PREFORM THE SYMMETRY OPERATION ON MULTIPLE DISPLACEMENT OR SCALAR FUN^^CTION FILES. ANY OTHER REPONSE WILL SKIP THE REMAINING REQUESTS. ENTER THE NUMBER OF DISPLACEMENT FILES FOR WHICH SYMMETRY OPERATINS ^^ ARE DESIRED. A ZERO OR CARRIAGE RETURN WILL SKIP FURTHER REQUEST FOR DISPLACEMENT FILE INFORMATION. SEE DISP-READ FOR FORMAT INFORMATION. ^^ SEE DISP-WRIT FOR FORMAT INFORMATION ^^ THE TWO REQUEST ABOVE ARE REPEATED FOR THE NUMBER OF DISPLACEMENT FILES SPECIFIED. ENTER THE NUMBER OF SCALAR FUNCTION FILES FOR WHICH SYMMETRY^^ OPERATINS ARE DESIRED. A ZERO OR CARRIAGE RETURN WILL SKIP FURTHER REQUEST FOR DISPLACEMENT FILE INFORMATION. UTILITY USER'S MANUAL Page 2-12 ^^ SEE FUNC-READ FOR FORMAT INFORMATION. ^^ SEE FUNC-WRIT FOR FORMAT INFORMATION THE TWO REQUEST ABOVE ARE REPEATED FOR THE NUMBER OF SCALAR FUNCTION FILES SPECIFIED. ^^ ORDER THE ORDER COMMAND ATTEMPTS TO CON^^SISTENTLY ORDER THE PANEL DATA OF THE IP ARRAY IN A CLOCKWISE OR COUNTER-CLOCKWISE MANNER. THE FIRST ELEMENT IN EACH GROUP IS ASSUMED TO BE ORDERED CORRECTLY. ALL OTHER ELEMENTS IN THAT GROUP ARE MATCHED AGAINST PREVIOUSLY ORDERED ELEMENTS UNTIL THE PROCESS IS COMPLETE. IF AN ELEMENT CAN NOT BE MATCHED, THE MESSAGE % ^^ IS TYPED ON THE USERS TERMINAL. THIS ALGORITHM IS NOT AVAILABLE FOR USE WITH SOLID DATA. IF THE USER ATTEMPTS TO USE IT WITH SOLID DATA, THE MESSAGE % WILL BE TYPED ON HIS TERMINAL. ^^ UTILITY USER'S MANUAL Page 2-13 ERROR MESSAGES ^^ THERE ARE THREE WARNING AND THREE ERROR MESSAGES THAT MAY BE ISSUED DURING A SESSION. THE ERROR MESSAGES ARE CONSIDERED FATAL AND WILL CAUSE PROGRAM EXECUTION TO TERMINATE. THE MESSAGES ARE: ^^ % ATTEMPT TO DELETE AN ELEMENT THAT WAS NOT FOUND. SEE GEOM-CHAN-ELEM. ^^ % THE USER ATTEMPTED TO ORDER SOLID DATA, AN OPERATION THAT IS UNDEFINED. SEE ORDER. ^^ % WHILE ATTEMPTING TO ORDER PANEL DATA, AN ELEMENT WAS FOUND IN AN ELEMENT GROUPING THAT DID NOT HAVE A COMMON EDGE WITH ANY OTHER ELEMENT IN THAT GROUP. SEE ORDER. ^^ ? THE USER ATTEMPTED TO EXCEED THE MAXIMUM DIMENSION OF NPMAX. INCREASE THE VALUE OF NPMAX IN ^^ THE MAIN PROGRAM AND TRY AGAIN. ? THE USER ATTEMPTED TO EXCEED THE MAXIMUM DIMENS^^ION OF NJMAX. INCREASE THE VALUE OF NJMAX IN THE MAIN PROGRAM AND TRY AGAIN. ? THE USER ATTEMPTED TO^^ EXCEED THE MAXIMUM DIMENSION OF NPTMAX. INCREASE THE VALUE OF NPTMAX IN THE MAIN PROGRAM AND TRY AGAIN. Page Index-1 UTILITY USER'S MANUAL INDEX ^^ Disp-change . . . . . . . . . 2-9 Disp-print . . . . . . . . . . 2-9 Disp-^^read . . . . . . . . . . 2-8 Disp-write . . . . . . . . . . 2-8 Displacement file . . . . . . 2-8 Error messages . . . . . . . . 2-13 Func-change . . . . . . . . ^^. 2-10 Func-print . . . . . . . . . . 2-10 Func-read . . . . . . . . . . 2-9 Func-write . . . . . . . . . . 2-10 Geom-chan-coordinates . . . . 2-5 Geom-chan-element . . . . . . 2-6 ^^ Geom-chan-group . . . . . . . 2-5 Geom-chan-move . . . . . . . . 2-7 Geom-change . . . . . . . . . 2-5 Geom-prin-coordinate . . . . . 2-7 Geom-prin-element . . . . . . 2-8 Geom-prin-group . . . . . . . 2-7 ^^ Geom-print . . . . . . . . . . 2-7 Geom-read . . . . . . . . . . 2-2 Geom-write . . . . . . . . . . 2-4 Geometry file . . . . . . . . 2-2, 2-4 Ip . . . . . . . . . . . . . . 2-3 ^^ Level 1 . . . . . . . . . . . 2-2 Level 2 . . . . . . . . . . . 2-2 Nj . . . . . . . . . . . . . . 2-3 Np . . . . . . . . . . . . . . 2-3 Npl . . . . . . . . . . . . . 2-3 ^^ Npt . . . . . . . . . . . . . 2-3 Order . . . . . . . . . . . . 2-12 Panal data . . . . . . . . . . 2-1 ^^ S . . . . . . . . . . . . . . 2-9 Scalar function file . . . . . 2-9 Solid data . . . . . . . . . . 2-1 Symmetry . . . . . . . . . . . 2-11 U . . . . . . . . . . . . . . 2-8 ^^ X . . . . . . . . . . . . . . 2-3 ^^ ^^ CHAPTER 3 SECTION USER'S MANUAL ^^ SECTION IS AN INTERACTIVE PROGRAM. IT WILL PROMPT THE USER FOR ALL THE NECESSARY INFORMATION WITH THE FOLLOWING REQUESTS. ^^ ENTER THE INPUT GEOMETRY FILENAME.EXT. THE FILENAME SHOULD NOT EXCEED SIX CHARACTERS. IF THE EXTENSION IS OMITTED, THE DEFAULT EXTENSION DAT WILL BE USED.(1) ^^ AT THIS POINT THE GEOMETRY FILE WILL BE READ USING THE FOLLOWING FORTRAN STATEMENTS. READ(IDTA,10) NP,NJ,NPT ^^ READ(IDTA,10) ((NPL(I,J),I=1,2),J=1,NP) READ(IDTA,20) ((X(I,J),I=1,3),J=1,NJ) READ(IDTA,10) ((IP(I,J),I=1,8),J=1,NPT) 10 FORMAT(20I4) 20 FORMAT(6E12.5) ^^ THE VARIABLES ARE DEFINED AS FOLLOWS: NP = THE NUMBER OF PARTS NJ = THE NUMBER OF NODES OR JOINTS NPT = THE NUMBER OF ELEMENTS NPL = THE PARTS LIST ^^ ELEMENTS ARE GROUPED TOGETHER FOR SMOOTH SURFACE SIMULATION AND COLOR DEFINITION. THE PARTS LIST CONTAINS THE ELEMENT NUMBERS OF THE LOWER AND UPPER BOUNDS OF THE ELEMENTS IN EACH GROUPING. ^^ (1) THE MANNER IN WHICH DATA FILES ARE INITIALIZED IS AN INSTALLATION DEPENDENT FEATURE. APPROPRIATE MODIFICATIONS SHOULD BE MADE IN THE SOURCE PROGRAM TO ACCOMMODATE YOUR SYSTEM. SECTION USER'S MANUAL Page 3-2 ^^ X = THE COORDINATES OF THE NODES THE COORDINATES ARE LISTED IN THE X, Y, AND Z DIRECTIONS BY NODE NUMBER. IP = THE CONNECTIVITY OF^^ THE HEXAHEDRON ELEMENTS AN ELEMENT IS DEFINED BY SPECIFYING THE NODE NUMBERS ON TWO OPPOSITE FACES IN THE SAME CLOCKWISE OR COUNTER-CLOCKWISE DIRECTION. THE FIRST AND FIFTH NODE NUMBERS DEFINE AN EDGE JOINING THE FRONT AND BACK FACES. ^^ ENTER THE NUMBER OF PLANES ON WHICH THE MODEL IS TO BE CLIPPED. IF ZERO STEPS ARE SPECIFIED, THE MODEL IS NOT CLIPPED BUT IS SWEPT ^^ FREE OF REDUNDANT INTERIOR DATA LEAVING ONLY POTENTIALLY VISIBLE SURFACES AND THE FOLLOWING TWO REQUEST ARE SKIPPED. ^^ ENTER THE CLIPPING PLANE DEFINITION FOR EACH PART. IF I2 IS GREATER THAN I1, ALL PARTS I1 THROUGH I2 WILL BE CLIPPED ON THE SAME PLANE. IF NO CLIPPING PLANE IS DEFINED FOR A PART, IT WILL NOT BE CLIPPED. POINT1 AND NORMAL1 ARE THE CARTESIAN COORDINATES OF THE POINT IN THE P^^LANE AND THE DIRECTION COSINES OF THE NORMAL TO THE PLANE OF THE INITIAL CLIPPING PLANE RESPECTIVELY. POINT2 AND NORMAL2 ARE THE POINT AND NORMAL DATA OF THE FINAL CLIPPING PLANE. IF THE NUMBER OF STEPS IS GREATER THAN TWO, A LINEAR INTERPOLATION BETWEEN THE INITIAL AND FINAL PLANES WILL BE USED TO CALCULATE ^^ INTERMEDIATE PLANES. A LINE OF ZEROS TERMINATES THIS REQUEST. ENTER FRONT, BACK OR BOTH TO SAVE ONLY POLYGO^^NS THAT ARE IN FRONT OF THE CLIPPING PLANE, ONLY POLYGONS THAT ARE BEHIND THE CLIPPING PLANE, OR BOTH POLYGONS IN FRONT OF AND BEHIND THE CLIPPING PLANE. ^^ ENTER THE OUTPUT GEOMETRY FILENAME.EXT. THE FILENAME SHOULD NOT EXCEED SIX CHARACTERS. IF THE EXTENSION IS OMITTED, THE DEFAULT EXTENSION DAT WILL BE USED. SECTION USER'S MANUAL Page 3-3 ^^ AT THIS POINT THE GEOMETRY FILE WILL BE WRITTEN USING THE FOLLOWING FORTRAN STATEMENTS. WRITE(IDTA,10) NP,NJ,NPT ^^ WRITE(IDTA,10) ((NPL(I,J),I=1,2),J=1,NP) WRITE(IDTA,20) ((X(I,J),I=1,3),J=1,NJ) WRITE(IDTA,10) ((IP(I,J),I=1,8),J=1,NPT) 10 FORMAT(20I4) 20 FORMAT(1P6E12.5) ^^ ENTER THE NUMBER OF DISPLACEMENT FILES TO BE TRANSFORMED TO REFLECT THE NEW GEOMETRY DEFINITION. A ZERO WILL SKIP OVER ANY FURTHER REQUEST FOR DISPLACEMENT FILE INFORMATION. ^^ ENTER THE INPUT DISPLACEMENT FILENAME.EXT. THE FILENAME SHOULD NOT EXCEED SIX CHARACTERS. IF THE EXTENSION IS OMITTED, THE DEFAULT EXTENSION DAT WILL BE USED. ^^ AT THIS POINT THE DISPLACEMENT FILE WILL BE READ USING THE FOLLOWING FORTRAN STATEMENTS. READ(IDTA,20^^) ((U(I,J),I=1,3),J=1,NJ) 20 FORMAT(6E12.5) THE VARIABLE, U, IS THE DISPLACEMENT AT THE NODE. ^^ ENTER THE OUTPUT DISPLACEMENT FILENAME.EXT. THE FILENAME SHOULD NOT EXCEED SIX CHARACTERS. IF THE EXTENSION IS OMITTED, THE DEFAULT EXTENSION DAT WILL BE USED. ^^ AT THIS POINT THE DISPLACEMENT FILE WILL BE WRITTEN USING THE FOLLOWING FORTRAN STATEMENTS. WRITE(IDTA,20) ((U(I,J),I=1,3),J=1,NJ) 20 FOR^^MAT(1P6E12.5) THE TWO REQUEST ABOVE ARE REPEATED FOR EACH DISPLACEMENT FILE SPECIFIED. SECTION USER'S MANUAL Page 3-4 ^^ ENTER THE NUMBER OF SCALAR FUNCTION FILES TO BE TRANSFORMED TO REFLECT THE NEW GEOMETRY. A ZERO WILL SKIP OVER FURTHER REQUEST FOR INFORMATION ABOU^^T SCALAR FUNCTION FILES. ENTER THE INPUT SCALAR FUNCTION FILENAME.EXT. THE FILENAME SHOULD NOT EXCEED SIX ^^ CHARACTERS. IF THE EXTENSION IS OMITTED, THE DEFAULT EXTENSION DAT WILL BE USED. AT THIS POINT THE SCALAR FUNCTION FILE WILL BE READ USING THE FOLLOWING FORTRAN STATEMENTS. ^^ READ(IDTA,20) (S(I),I=1,NJ) 20 FORMAT(6E12.5) THE VARIABLE, S, IS THE SCALAR FUNCTION AT^^ THE NODE. ENTER THE OUTPUT SCALAR FUNTION FILENAME.EXT. THE FILENAME SHOULD NOT EXCEED SIX CHARACTERS. IF THE EXTENSION IS OMITTED, THE ^^ DEFAULT EXTENSION DAT WILL BE USED. AT THIS POINT THE SCALAR FUNCTION FILE WILL BE WRITTEN USING THE FOLLOWING FORTRAN STATEMENTS. ^^ WRITE(IDTA,20) (S(I),I=1,NJ) 20 FORMAT(1P6E12.5) THE TWO REQUESTS ABOVE ARE REPEAT^^ED FOR EACH SCALAR FUNCTION FILE SPECIFIED. SECTION USER'S MANUAL Page 3-5 ERROR MESSAGES ^^ THREE ERROR MESSAGES MAY BE ISSUED DURING THE EXECUTION OF THE PROGRAM. ALL THREE ARE CONSIDERED FATAL ERRORS AND WILL TERMINATE PROGRAM EXECUTION. ^^ ? THIS MESSAGE INDICATES THAT ALL THE AVAILABLE FREE STORAGE HAS BEEN USED PRIOR TO THE COMPLETION OF PROCESSIN^^G. INCREASE THE SIZE OF BLANK COMMON IN THE MAIN PROGRAM. ? ^^ THIS MESSAGE RESULTS WHEN THE LINE SEGMENTS STORED FOR THE ON-PLANE POLYGONS DO NOT FORM A CLOSED FIGURE. IF THIS HAPPENS, CHECK THE INPUT DATA FOR IMPROPERLY DEFINED ELEMENTS. ^^ ? THIS MESSAGE OCCURS WHEN A WARPED QUADRILATERAL FACE APPEARS TO STILL BE WARPED AFTER THE FACE IS DIVIDED INTO TWO TRIANGLES. THIS GENERALLY INDI^^CATES A PROBLEM ELSEWHERE IN THE PROGRAM. PLEASE REPORT THIS ERROR. ? ^^ THIS MESSAGE IS PRINTED IF THE END OF THE OVERFLOW LIST IS FOUND WHILE TRYING TO DELETE A POLYGON FROM THE HASH TABLE. PLEASE REPORT THIS ERROR. Page Index-1 ^^ SECTION USER'S MANUAL INDEX Clipping plane^^ . . . . . . . . 3-2 Displacement file . . . . . . 3-3 Error messages . . . . . . . . 3-5 Geometry file . . . . . . . . 3-1 ^^ Ip . . . . . . . . . . . . . . 3-2 Nj . . . . . . . . . . . . . . 3-1 Np . . . . . . . . . . . . . . 3-1 Npl . . . . . . . . . . . . . 3-1 ^^ Npt . . . . . . . . . . . . . 3-1 S . . . . . . . . . . . . . . 3-4 Scalar function file . . . . . 3-4 U . . . . . . . . . . . . . . 3-3 ^^ X . . . . . . . . . . . . . . 3-2 ^^ ^^ CHAPTER 4 TITLE USER'S MANUAL ^^ TITLE.FOR GENERATES TWO AND THREE DIMENSIONAL CHARACTER STRINGS IN A FORM THAT IS COMPATIBLE WITH MOVIE.BYU. THE PROGRAM IS INTERACTIVE, AND PROPMTS THE USER FOR ALL NECESSARY INPUT. THE PROGRAM PROCEEDS AS FOLLOWS: ^^ ENTER UP TO 70 CHARACTERS CONSISTING OF ONLY THE LETTERS OF THE ALPHABET, SPACES, THE INTEGERS 0 THRU 9 AND SPECIAL CHARACTERS . / - = $ . TO END A PARTICULAR TITLE, USE A CARRIAGE RET^^URN. <3-D?> ANSWER Y OR YES FOR THREE-DIMENSIONAL CHARACTERS AND CARRIAGE RETURN FOR TWO-DIMENSIONAL ^^ CHARACTERS. ENTER COORDINATES OF THER LOWER LEFT EDGE OF THE LINE OF TEXT. SINCE FOR NORMALIZED SPACING PUR^^POSES THE FRONT FACE OF A CHARACTER IS CENTERED IN A UNIT SQUARE, THE LEFT COORDINATES OF THE FIRST CHARACTER WILL BE SLIGHTLY GREATER THAN THE X-VALUE INPUT. ^^ SPACING: IS MULTIPLIED BY THE WIDTH SCALE FACTOR TO POSITION THE NEXT CHARACTER. A 1.0 GIVES A REASONALBE SPACING FOR TWO-DIMENSIONAL CHARACTERS, BUT THREE-DIMENSIONAL CHARACTERS WITH OFFSET (SEE NEXT INPUT) REQUIRE A LARGER VALUE. ^^ WIDTH: ACTUAL DISTANCE BETWEEN THE CENTER OF ADJACENT CHARACTERS IF SPACING = 1.0. THE ACTUAL WIDTH OF EACH CHARACTER (WITH THE EXCEPTION OF 1 AND THE SPECIAL CHARACTERS) IS 5/7 OF THE VALUE TITLE USER'S MANUAL Page 4-2 ^^ SPECIFIED FOR WIDTH. HEIGHT: ACTUAL HEIGHT OF THE CHARACTERS. DEPTH: NOT REQUIRED FOR TWO-DIMENSIONAL CHARACTERS. POSIT^^ION OF BACK FACE OF CHARACTERS HAS A NEGATIVE Z-POSITION WITH RESPECT TO THE FRONT FACE (RIGHT-HANDED COORDINATE SYSTEM) FOR POSITIVE VALUE OF DEPTH. STRANGE EFFECTS CAN BE OBTAINED WITH NEGATIVE DEPTH. CHARACTERS ARE GENERATED IN COUNTERCLOCKWISE ORDERING FOR POSITIVE DEPTH. ^^ NOT REQUIRED FOR TWO-DIMENSIONAL CHARACTERS. FOR THREE-DIMENSIONAL CHARACTERS, ENTER OFFSET COORDINATES FOR BACK FACE OF CHARACTER RELATIVE TO FRONT FACE. THIS SKEWING OF THE CHARACTERS PRODUCES ^^ THE EFFECT OF THE FRONT FACE BEING BRIGHT (LOOKING DIRECTLY AT THE OBSERVER) WITH THE SIDES OF THE CHARACTERS VISIBLE. THE COMBINATION OF OFFSET AND A SHARP PERSPECTIVE MAY BE QUITE CONFUSING. WITH NEAR-ZERO PRESPECTIVE, THE EFFECT (WHICH IS COMMONLY USED ON THREE-DIMENSIONAL CHARACTERS) IS QUITE GOOD. FOR SPACI^^NG, WIDTH, HEIGHT, DEPTH OF 1.5, 1., 1., 1.5 REASONABLE VALUES OF OFFSETS ARE .25, .25. OFFSETS MAY BE POSITIVE OR NEGATIVE. PRINTED IF NO CHARACTERS ^^OR ONLY SPACES ARE ENCOUNTERED IN LINE OF TEXT. ENTER Y OR YES TO END TITLE OR CARRIAGE RETURN TO ENTER MORE LINES (PARTS). ^^ ENTER THE TITLE FILENAME.EXT. IF THE EXTENTION IS OMITTED, THE DEFAULT EXTENSION DAT WILL BE USED. A ZERO FILE DESIGNATION WILL NOT WRITE THE FILE, BUT WILL ASK IF THE USER WISHES TO START A NEW TITLE. THIS IS HELPFUL IF THE USER DISCOVERS AN ERROR IN HIS TITLE AT THE LAST MINUTE.(1) ^^ ^^ (1) THE MANNER IN WHICH DATA FILES ARE INITIALIZED IS AN INSTALLATION DEPENDENT FEATURE. APPROPRIATE MODIFICATIONS SHOULD BE MADE IN THE SOURCE PROGRAM TO ACCOMMODATE YOUR SYSTEM. TITLE USER'S MANUAL Page 4-3 ^^ THE GEOMETRY FILE IS NOW WRITTEN USING THE FOLLOWING FORTRAN STATEMENTS. WRITE(IDTA,10) NP,NJ,NPT ^^ WRITE(IDTA,10) ((NPL(I,J),I=1,2),J=1,NP) WRITE(IDTA,20) ((X(I,J),I=1,3),J=1,NJ) WRITE(IDTA,10) ((IP(I,J),I=1,4),J=1,NPT) 10 FORMAT(20I4) 20 FORMAT(6E12.5) ^^ ENTER Y OR YES IF THE USER WISHES TO BEGIN A NEW TITLE. ANY OTHER RESPONSE WILL RETURN CONTROL TO THE MONITOR. ^^ AFTER GENERATION OF THE DATA FOR A LINE OF TEXT, THE ROUTINE PRINTS THE NOMINAL X-COORDINATE FOR THE RIGHT EDGE OF THE TEXT (USEFUL FOR POSITIONING PURPOSES), AND ALSO INDICATES THE CURRENT TOTAL NUMBERS OF PARTS, ELEMENTS, AND NODES. ^^ ERROR MESSAGES ? UNACCPETABLE CHARACTER ENCOUNTERED IN THE LINE OF TEXT. ABORTS LINE OF TEXT AND ASKS FOR NEW LINE OF TEXT. ^^ ^^ CHAPTER 5 ^^ INSTALLING MOVIE.BYU THE FOLLOWING COMMENTS ARE INTENDED AS A GUIDE TO INSTALLING MOVIE.BYU ON ANY HOST COMPUTER. THE PROGRAMS ARE MOSTLY WRITTEN IN MACHINE IN^^DEPENDENT FORTRAN. BEGINNING WITH MOVIE.FOR, EACH PROGRAM AND SUBPROGRAM WILL BE EXAMINED ALONG WITH SUGGESTED CHANGES THAT MIGHT BE CALLED FOR FILE 1: USER.DOC ^^ USER.DOC IS THE DOCUMENTATION YOU ARE NOW READING. NO CHANGES ARE NECESSARY. ^^ FILE 2: MOVIE.FOR MOVIE.FOR IS^^ THE FORTRAN SOURCE FILE FOR THE DRIVING PACKAGE. IT INCLUDES THE MAIN PROGRAM AND SUBROUTINES THAT POSITION THE MODEL IN THE VIEWING WINDOW AND CALCULATE LIGHT INTENSITY AND SHADING. MAIN PROGRAM: ^^ FUNCTION: READS DATA FILES AND CALLS INTERACTIVE PICTURE ROUTINE. IT MAY BE NECESSARY TO CHANGE THE I/0 UNIT NUMBERS ASSOCIATED WITH THE VARIABLES INPUT, OUTPUT, AND ERROR. ^^ INPUT GETS THE UNIT NUMBER OF THE INPUT DEVICE, OUTPUT GETS THE UNIT NUMBER OF THE OUTPUT DEVICE, AND ERROR GETS THE NUMBER OF THE ERROR MESSAGE REPORTING DEVICE. TYPICALLY INPUT AND OUTPUT REFER TO THE USER'S TERMINAL AND ERROR EITHER TO THE TERMINAL OR LINE PRINTER. INSTALLING MOVIE.BYU Page 5-2 ^^ REMEMBER THAT VARIABLES NPL, X, IP, U, AND SPEC MUST BE DIMENSIONED TO ACCOMMODATE THE MAXIMUM EXPECTED NUMBER OF PARTS, COORDINATES, OR ELEMENTS WHICH EVER IS APPROPRIATE. THE VARIABLES NPMAX, NJMAX, AND NPTMAX MUST ALSO BE SET TO REFLECT THE MAXIMUM DIMENSIONS. ^^ SUBROUTINE OPEN: FUNCTION: REQUEST DATA FILE NAMES AND OPENS I/O CHANNEL ^^ SUBROUTINE OPEN MAY NEED TO BE COMPLETELY REWRITTEN TO ACCOMMODATE YOUR PARTICULAR OPERATING SYSTEM. THE ROUTINE IS ENTERED WITH FILEID CONTAINING THE ALPHANUMERIC FILE IDENTIFICATION (GEOM., DISP., OR FUNC.) IT REQUESTS THE FILE NAME, AND OPENS THE FILE FOR INPUT IF IOP=1 AND FOR OUTPUT IF IOP=-1. A BLANK FILE SPECIFICATION WILL SET IE^^RROR TO 0. THE ROUTINE RETURNS WITH THE DEVICE UNIT NUMBER IN IUNIT AND IERROR SET TO 1 ON SUCCESSFUL COMPLETION, 0 ON BLANK FILE, AND -1 ON FAILURE. SUBROUTINE ROTAT: ^^ FUNCTION: CALCULATES ROTATION TRANSFORMATION MATRIX NO CHANGES NECESSARY. SUBROUTINE PICTUR: ^^ FUNCTION: INTERACTIVELY ACCEPTS COMMANDS FROM THE USER AND PERFORMS THE APPROPRIATE TASK. BEFORE DISCUSSING CHANGES, REMEMBER THAT VARIABLES DA, DD, DIF, ICOL, NFR, NPLS, RORG, SPEC1, XNORM, AND XX ^^ MUST BE DIMENSIONED TO ACCOMMODATE THE MAXIMUM EXPECTED NUMBER OF PARTS, COORDINATES, OR ELEMENTS WHICH EVER IS APPROPRIATE. IN PARTICULAR, XNORM SHOULD BE DIMENSIONED AS THE GREATER OF THE MAXIMUM NUMBER OF COORDINATES OR THE MAXIMUM NUMBER OF ELEMENTS. IF THE FO^^RTRAN OPERATING SYSTEM YOU ARE RUNNING DOES NOT ALLOW FREE FORMATED READS, MOST OF THE FORMAT STATEMENTS ASSOCIATED WITH INTERACTIVE READ STATEMENTS WILL NEED TO BE MODIFIED. THIS IS THE ONE MOST PREVALENT CHANGE THROUGHOUT THE PROGRAM. AT THE STATEMENT LABELED 80, THE ^^ PROGRAM ENTERS A SECTION OF CODE THAT SELECTS SCOPE PARAMETERS INCLUDING THE PICTURE DEVICE NUMBER. PICTURE DEVICES GREATER THAN 0 ARE CONTINUOUS-TONE DEVICES WHILE DEVICES LESS THAN 0 ARE LINE DRAWING DEVICES. THE ALLOWABLE DEVICES ARE CURRENTLY COMTAL, TEKTRONIX, HPLT (HEWLETT-PACKARD PLOTTER), AND CPLT (CALCOMP PLOTTER). BY ADDING AND/OR DELETING DEVICES, THIS ^^ INSTALLING MOVIE.BYU Page 5-3 SECTION OF CODE SHOULD REFLECT THE PICTURE DEVICES AT YOUR INSTALLATION. ^^AT APPROXIMATELY THE STATEMENTS LABELED 242, THE PROGRAM ENTERS CODE THAT WRITES TO THE USER'S OUTPUT DEVICE THE NAME OF THE DISPLAY DEVICE WHICH JUST RECEIVED A PICTURE. IF YOU CHANGED THE ALLOWABLE DEVICES, YOU NEED TO CHANGE THIS SECTION OF CODE TO REFLECT THE DEVICES AVAILABLE. ^^ CHANGES THAT MAY BE REQUIRED TO THIS SUBROUTINE WHEN USING A 5 BIT DATA PACKING SCHEME FOR LIGHT INTENSITY AND COLOR ON 16 BIT MACHINES IS GIVEN BELOW. THE EXISTING CODE FOR 32 AND 36 BIT MACHINES IS FOLLOWED BY THE CORRESPONDING CODE WITH CHANGES FOR 16 BIT MACHINES. ^^ 32 AND 36 BIT MACHINES IPH=63 IF(IDVICE.LT.0) GO TO 86 16 BIT MACHINES ^^ IPH=31 IF(IDVICE.LT.0) GO TO 86 32 AND 36 BIT MACHINES IC1=PB3*63.0 ^^ IC2=PB2*63.0 IC3=PB1*63.0 IF(IC.EQ.1) GO TO 163 16 BIT MACHINES ^^ IC1=PB3*31.0 IC2=PB2*31.0 IC3=PB1*31.0 IF(IC.EQ.1) GO TO 163 32 AND 36 BIT MACHINES ^^ 163 IPB=IC1*2**12+IC2*2**6+IC3 WRITE(OUTPUT,164) (WORDS(I,IC),I=1,3) 16 BIT MACHINES 163 IPB=IC^^1*2**10+IC2*2**5+IC3 WRITE(OUTPUT,164) (WORDS(I,IC),I=1,3) 32 AND 36 BIT MACHINES IC1=X3*63.0 IC2=X2*63.0 ^^ IC3=X1*63.0 INSTALLING MOVIE.BYU Page 5-4 IF(IC.EQ.1) GO TO 167 ^^ 16 BIT MACHINES IC1=X3*31.0 IC2=X2*31.0 IC3=X1*31.0 IF(IC.EQ.1) GO TO 167 ^^ 32 AND 36 BIT MACHINES 167 ICC=IC1*2**12+IC2*2**6+IC3 DO 168 K=I1,I2 16 BIT MACHINES ^^ 167 ICC=IC1*2**10+IC2*2**5+IC3 DO 168 K=I1,I2 SUBROUTINE MULTDD: ^^ FUNCTION: MULTIPLYS COORDINATES BY LOCAL ROTATIONS NO CHANGES NECESSARY. ^^ FUNCTION AINTEN: FUNCTION: CLACULATES LIGHT INTENSITY AT A NODE NO CHANGES NECESSARY. ^^ FUNCTION IVSBLE: FUNCTION: COMPUTES NUMBER OF VISIBLE NODES. NO CHANGES NECESSARY. ^^ SUBROUTINE MULTDC: FUNCTION: MULTIPLYS COORDINATES BY GLOBAL ROTATIONS. ^^ NO CHANGES NECESSARY. FUNCTION ISHADE: FUNCTION: COMPUTES COLOR INTENSITY AT NODE FOR FRINGES. INSTALLING ^^MOVIE.BYU Page 5-5 CHANGES THAT MAY BE REQUIRED TO THIS SUBROUTINE WHEN USING A 5 BIT DATA PACKING SCHEME FOR LIGHT INTENSITY AND COLOR ON 16 BIT MACHINES IS GIVEN BELOW. THE EXISTING CODE FOR 32 AND 36 BIT MACHINES IS FOLL^^OWED BY THE CORRESPONDING CODE WITH CHANGES FOR 16 BIT MACHINES. 32 AND 36 BIT MACHINES IC1=(F(1,I1)*X+F(1,I)*X1)*63.0 IC2=(F(2,I1)*X+F(2,I)*X1)*63.0 ^^ IC3=(F(3,I1)*X+F(3,I)*X1)*63.0 GO TO 4 2 X=X-1.0 IC1=F(1,NFRING)*63.0 IC2=F(2,NFRING)*63.0 IC3=F(3,NFRING)*63.0 ^^ GO TO 4 3 IC1=F(1,1)*63.0 IC2=F(2,1)*63.0 IC3=F(3,1)*63.0 4 ISHADE=IC1*2**12+IC2*2**6+IC3 RETURN ^^ 16 BIT MACHINES IC1=(F(1,I1)*X+F(1,I)*X1)*31.0 IC2=(F(2,I1)*X+F(2,I)*X1)*31.0 IC3=(F(3,I1)*X+F(3,I)*X1)*31.0 GO TO 4 ^^ 2 X=X-1.0 IC1=F(1,NFRING)*31.0 IC2=F(2,NFRING)*31.0 IC3=F(3,NFRING)*31.0 GO TO 4 3 IC1=F(1,1)*31.0 ^^ IC2=F(2,1)*31.0 IC3=F(3,1)*31.0 4 ISHADE=IC1*2**10+IC2*2**5+IC3 RETURN SUBROUTINE DRAW: ^^ FUNCTION: CLIPS LINE SEGMENTS AND DOES QUICK PLOT. NO CHANGES NECESSARY. ^^ SUBROUTINE INTHID: FUNCTION: INTIALIZES HIDDEN PROCESSOR. THE VARIABLES MAXFRE, MAXRES, AND MAXINT SHOULD BE CHANGED TO REFLECT THE DIMENSION OF IFREE(MAXFRE), THE ^^ DIMENSION OF IB(MAXRES), AND THE MAXIMUM ALLOWABLE LIGHT INSTALLING MOVIE.BYU Page 5-6 INTENSITY. ^^CHANGES THAT MAY BE REQUIRED TO THIS SUBROUTINE WHEN USING A 5 BIT DATA PACKING SCHEME FOR LIGHT INTENSITY AND COLOR ON 16 BIT MACHINES IS GIVEN BELOW. THE EXISTING CODE FOR 32 AND 36 BIT MACHINES IS FOLLOWED BY THE CORRESPONDING CODE WITH CHANGES FOR 16 BIT MACHINES. 32 AND 36 BIT MACHINES ^^ MAXINT=63 C INITIALIZE FREE STORAGE 16 BIT MACHINES ^^ MAXINT=31 C INITIALIZE FREE STORAGE FILE 3: HIDDEN.FOR ^^ HIDDEN.FOR IS THE FORTRAN SOURCE FILE FOR THE HIDDEN PROCESS. THE VARIOUS SUBROUTINES IN THIS FILE ARE AGAIN WRITTEN IN ANSI FORTRAN ALTHOUGH CERTAIN CHANGES WILL HAVE TO BE MADE TO ACCOMODAT^^E THE WORD SIZE OF YOUR MACHINE. SUBROUTINE GETVAR: FUNCTION: GETS VARIABLE LENGTH BLOCK OF FREE STORAGE. ^^ NO CHANGES NECESSARY. SUBROUTINE LSTSET: FUNCTION: SET BLOCK SIZE AND LINKS SEGMENTS. ^^ NO CHANGES NECESSARY. SUBROUTINE GETBLK: FUNCTION: GET^^S FIXED LENGTH BLOCK OF FREE STORAGE. NO CHANGES NECESSARY. SUBROUTINE RETBLK: ^^ FUNCTION: RETURNS FIXED LENGTH BLOCK TO FREE STORAGE. INSTALLING MOVIE.BYU Page 5-7 NO CHANGES NECESSARY. ^^ SUBROUTINE INTCLP: FUNCTION: INITIALIZES PARAMETERS USED IN HIDDEN ALGORITHM. NO CHANGES NECESSARY. ^^ SUBROUTINE POLMAK: FUNCTION: BEGINS NEW POLYGON IN PICTURE. CHANGES THAT MAY BE R^^EQUIRED TO THIS SUBROUTINE WHEN USING A 5 BIT DATA PACKING SCHEME FOR LIGHT INTENSITY AND COLOR ON 16 BIT MACHINES IS GIVEN BELOW. THE EXISTING CODE FOR 32 AND 36 BIT MACHINES IS FOLLOWED BY THE CORRESPONDING CODE WITH CHANGES FOR 16 BIT MACHINES. 32 AND 36 BIT MACHINES ^^ COMMON/COMNIO/ICNT,IDUM(121) IPOLY=IPOLY+1 16 BIT MACHINES ^^ COMMON/COMNIO/ICNT,IDUM(141) IPOLY=IPOLY+1 SUBROUTINE EDGMAK: FUNCTION: STORES PO^^LYGON EDGES FOR LATTER PROCESSING. CHANGES THAT MAY BE REQUIRED TO THIS SUBROUTINE WHEN USING A 5 BIT DATA PACKING SCHEME FOR LIGHT INTENSITY AND COLOR ON 16 BIT MACHINES IS GIVEN BELOW. THE EXISTING CODE FOR 32 AND 36 BIT MACHINES IS FOLLOWED BY THE CORRESPONDING CODE WITH CHANGES FOR 16 BIT MACHINES. ^^ 32 AND 36 BIT MACHINES COMMON/COMNIO/ICNT,NT,VX(10),VY(10),VZ(10),VN(10) 1,IC(10),VC(10),VTX(10),VTY(10),VTZ(10),VTN(10),VTC(10) 2,ITC(10) ^^ LOGICAL LASEDG,IBAD,ISHARE 16 BIT MACHINES COMMON/COMNIO/ICNT,NT,VX(10),VY(10),VZ(10),VN(10) 1,IC(10),IS(10),VC(10),VTX(10),VTY(10),VTZ(10),VTN(10) 2,VTC(^^10),ITC(10),ITS(10) LOGICAL LASEDG,IBAD,ISHARE INSTALLING MOVIE.BYU Page 5-8 32 AND 36 BIT MACHINES ^^ C SET 18TH BIT IF EDGE IS SHARED C SET 19TH BIT IF EDGE IS VISIBLE FLAG I=524288 IF(ISHARE) I=786432 C PUT BEGIN POINT INTO EDGE STACK ^^ 16 BIT MACHINES C SET 0TH BIT IF EDGE IS SHARED C SET 1ST BIT IF EDGE IS VISIBLE FLAG I=1 IF(ISHARE) I=3 C ^^PUT BEGIN POINT INTO EDGE STACK 32 AND 36 BIT MACHINES IC(ICNT)=I+MOD(K1,262144) VC(ICNT)=C1 ^^ 16 BIT MACHINES IC(ICNT)=K1 IS(ICNT)=I VC(ICNT)=C1 ^^ 32 AND 36 BIT MACHINES IC(ICNT)=I+MOD(K2,262144) VC(ICNT)=C2 16 BIT MACHINES ^^ IC(ICNT)=K2 IS(ICNT)=I VC(ICNT)=C2 SUBROUTINE POLSNP^^: FUNCTION: CLIPS POLYGONS AGAINST VIEWING WINDOW. CHANGES THAT MAY BE REQUIRED TO THIS SUBROUTINE WHEN USING A 5 BIT DATA PACKING SCHEME FOR LIGHT INTENSITY AND COLOR ON 16 BIT MACHINES IS GIVEN BELOW. ^^ THE EXISTING CODE FOR 32 AND 36 BIT MACHINES IS FOLLOWED BY THE CORRESPONDING CODE WITH CHANGES FOR 16 BIT MACHINES. 32 AND 36 BIT MACHINES COMMON/COMNIO/ICNT,NT,VX(10),VY(10),VZ(10),VN(10) ^^ 1,IC(10),VC(10),VTX(10),VTY(10),VTZ(10),VTN(10),VTC(10) 2,ITC(10) COMMON/EDGARG/IY,IX1,IX2,IZ1,IZ2,IS1,IS2,IPG,IDY INSTALLING MOVIE.BYU Page 5-9 1,K^^OL1,ISHR,IS1,IS2,KOL2 16 BIT MACHINES COMMON/COMNIO/ICNT,NT,VX(10),VY(10),VZ(10),VN(10) 1,IC(10),IS(10),VC(10),VTX(10),VTY(10),VTZ(10),VTN(10) 2,VTC(10),ITC(10),ITS(10) ^^ COMMON/EDGARG/IY,IX1,IX2,IZ1,IZ2,IS1,IS2,IPG,IDY 1,KOL1,ISHR,IS1,IS2,KOL2 32 AND 36 BIT MACHINES IF(IC(I).LT.524288) GO TO 10 ^^ K=I+1 16 BIT MACHINES IF(IS(I).LT.1) GO TO 10 K=I+1 ^^ 32 AND 36 BIT MACHINES ISHR=MOD(IC(I),524288).GT.262144 C GET THE Z VALUES AND GIVE THEM 15 BITS 16 BIT MACHINES ^^ ISHR=IS(I).GT.1 C GET THE Z VALUES AND GIVE THEM 15 BITS 32 AND 36 BIT MACHINES ^^ C GET THE INTENSITY AND GIVE IT 6 BITS IS2=VN(L)*63. IS1=VN(K)*63. C************ COLOR ************ KOL1=MOD(IC(K),262144) KOL2=MOD(IC(L),262144) ^^ C RESET THE INTENSITY IF IT IS OUTSIDE THE RANGE IF(IS1.GT.63) IS1=63 IF(IS2.GT.63) IS2=63 IF(IS1.LT.0) IS1=0 16 BIT MACHINES ^^ C GET THE INTENSITY AND GIVE IT 5 BITS IS2=VN(L)*31. IS1=VN(K)*31. C************ COLOR ************ KOL1=IC(K) KOL2=IC(L) ^^ C RESET THE INTENSITY IF IT IS OUTSIDE THE RANGE IF(IS1.GT.31) IS1=31 IF(IS2.GT.31) IS2=31 IF(IS1.LT.0) IS1=0 INSTALLING MOVIE.BYU Page 5-10 ^^ SUBROUTINE CLIP: FUNCTION: DOES ACTUAL CLIPPING OF EDGES AGAINST PLANE. CHANGES THAT MAY BE REQUIRED TO THIS SUBROUTINE WHEN USING^^ A 5 BIT DATA PACKING SCHEME FOR LIGHT INTENSITY AND COLOR ON 16 BIT MACHINES IS GIVEN BELOW. THE EXISTING CODE FOR 32 AND 36 BIT MACHINES IS FOLLOWED BY THE CORRESPONDING CODE WITH CHANGES FOR 16 BIT MACHINES. 32 AND 36 BIT MACHINES ^^ COMMON/COMNIO/ICNT,NT,VX(10),VY(10),VZ(10),VN(10) 1,IC(10),VC(10),VTX(10),VTY(10),VTZ(10),VTN(10),VTC(10) 2,ITC(10) COMMON/SNPDAT/T1,T2,I 16 BIT MACHINES ^^ COMMON/COMNIO/ICNT,NT,VX(10),VY(10),VZ(10),VN(10) 1,IC(10),IS(10),VC(10),VTX(10),VTY(10),VTZ(10),VTN(10) 2,VTC(10),ITC(10),ITS(10) COMMON/SNPDAT/T1,T2,I ^^ 32 AND 36 BIT MACHINES IF(IC(I).LT.524288) GO TO 30 IF(IBAD) GO TO 30 16 BIT MACHINES ^^ IF(IS(I).LT.1) GO TO 30 IF(IBAD) GO TO 30 32 AND 36 BIT MACHINES IC(I1)=IC(I) ^^ GO TO 101 100 C1=FLOAT(MOD(IC(I)/4096,64)) C2=FLOAT(MOD(IC(I+1)/4096,64)) KOLAVG=MOD(INT(ALPHA*(C2-C1)+C1+.5),64)*4096 C2=FLOAT(MOD(IC(I+1)/64,64)) KOLAVG=KOLAVG+MOD(INT(ALPHA*(C2-C1)+C1+.5),64)*64 ^^ C1=FLOAT(MOD(IC(I),64)) C2=FLOAT(MOD(IC(I+1),64)) KOLAVG=KOLAVG+MOD(INT(ALPHA*(C2-C1)+C1+.5),64) IC(I1)=KOLAVG+(IC(I)/524288)*524288 101 CONTINUE 16 BIT MACH^^INES IC(I1)=IC(I) GO TO 101 100 C1=FLOAT(MOD(IC(I)/1024,32)) INSTALLING MOVIE.BYU Page 5-11 ^^ C2=FLOAT(MOD(IC(I+1)/1024,32)) KOLAVG=MOD(INT(ALPHA*(C2-C1)+C1+.5),32)*32 C1=FLOAT(MOD(IC(I)/32,32)) C2=FLOAT(MOD(IC(I+1)/32,32)) KOLAVG=KOLAVG+MOD(INT(ALPHA*(C2-C1)+C1+.5),32)*32 ^^ C1=FLOAT(MOD(IC(I),32)) C2=FLOAT(MOD(IC(I+1),32)) KOLAVG=KOLAVG+MOD(INT(ALPHA*(C2-C1)+C1+.5),32) IC(I1)=KOLAVG 101 CONTINUE 32^^ AND 36 BIT MACHINES IC(ICNT)=MOD(IC(I1),262144)+524288 VC(ICNT)=VC(I1) 16 BIT MACHINES ^^ IC(ICNT)=IC(I1) IS(ICNT)=1 VC(ICNT)=VC(I1) 32 AND 36 BIT MACHINES ^^ 50 IC(I)=0 IC(I+1)=0 RETURN 16 BIT MACHINES ^^ 50 IS(I)=0 IS(I+1)=0 RETURN SUBROUTINE FACMAK: ^^ FUNCTION: STORES ZMIN CLIPPED EDGES FOR LATTER CAP POLYGON GENERATION. NOT IMPLEMENTED YET. ^^ SUBROUTINE HIDDEN: FUNCTION: DETERMINES VISIBLE SEGEMENTS AND SENDS THEM TO LINE DRAWING OR CONTINOUS-TONE SHADING ROUTINES. CHANGES THAT MAY BE REQUIRED TO THIS SUBROUTINE WHEN ^^ USING A 5 BIT DATA PACKING SCHEME FOR LIGHT INTENSITY AND COLOR ON 16 BIT MACHINES IS GIVEN BELOW. THE EXISTING CODE FOR 32 AND 36 BIT MACHINES IS FOLLOWED BY THE CORRESPONDING CODE WITH CHANGES FOR 16 BIT MACHINES. 32 AND 36 BIT MACHINES INSTALLI^^NG MOVIE.BYU Page 5-12 SR1=FLOAT(MOD(ICOL1,64))*S1/63. SB1=FLOAT(MOD(ICOL1/64,64))*S1/63. SG1=FLOAT(MOD(ICOL1/4096,64))*S1/63. SR2=FLOAT(MOD(ICOL2,64))^^*S2/63. SB2=FLOAT(MOD(ICOL2/64,64))*S2/63. SG2=FLOAT(MOD(ICOL2/4096,64))*S2/63. 213 CONTINUE 16 BIT MACHINES ^^ 2)11 SR1=FLOAT(MOD(ICOL1,32))*S1/31. SB1=FLOAT(MOD(ICOL1/32,32))*S1/31. SG1=FLOAT(MOD(ICOL1/1024,32))*S1/31. SR2=FLOAT(MOD(ICOL2,32))*S2/31. SB2=FLOAT(MOD(ICOL2/32,32))*S2/31. SG2=FLOAT(MOD(ICOL2/1024,32))*S2/31. ^^ 213 CONTINUE 32 AND 36 BIT MACHINES A = FLOAT(ISEG(I+5))*63. RSEG(IJ+1) = (SR1-SR2)/A ^^ 16 BIT MACHINES 2)11 A = FLOAT(ISEG(I+5))*31. RSEG(IJ+1) = (SR1-SR2)/A 32 AND 36 BIT MACHINES ^^ RSEG(IJ ) = (SR1/63.)+RSEG(IJ+1)*.5 RSEG(IJ+4) = (SB1/63.)+RSEG(IJ+5)*.5 RSEG(IJ+8) = (SG1/63.)+RSEG(IJ+9)*.5 IJ = IJ + 8 ^^ 16 BIT MACHINES 2)11 RSEG(IJ ) = (SR1/31.)+RSEG(IJ+1)*.5 RSEG(IJ+4) = (SB1/31.)+RSEG(IJ+5)*.5 RSEG(IJ+8) = (SG1/31.)+RSEG(IJ+9)*.5 IJ = IJ + 8 ^^ SUBROUTINE DRAWIT: FUNCTION: SEND LINE TO BE DISPLAYED TO DEVICE AND CLEARS LINE STARTING POSITION. ^^ NO CHANGES NECESSARY. SUBROUTINE LINSHO: FUNCTION: UPDATES LINE INFORMATION UNTIL LINE CAN BE DRAWN. ^^ INSTALLING MOVIE.BYU Page 5-13 NO CHANGES NECESSARY. SUBRO^^UTINE SHOW: FUNCTION: EVALUATES SHADING INFORMATION FOR VISIBLE SEGMENTS. CHANGES THAT MAY BE REQUIRED TO THIS SUBROUTINE WHEN USING A 5 BIT DATA PACKING^^ SCHEME FOR LIGHT INTENSITY AND COLOR ON 16 BIT MACHINES IS GIVEN BELOW. THE EXISTING CODE FOR 32 AND 36 BIT MACHINES IS FOLLOWED BY THE CORRESPONDING CODE WITH CHANGES FOR 16 BIT MACHINES. 32 AND 36 BIT MACHINES ^^ STR=FLOAT(MOD(IBACKG,64)) STB=FLOAT(MOD(IBACKG/64,64)) STG=FLOAT(MOD(IBACKG/4096,64)) ENDR = STR 16 BIT MACHINES ^^ 2)14 STR=FLOAT(MOD(IBACKG,32)) STB=FLOAT(MOD(IBACKG/32,32)) STG=FLOAT(MOD(IBACKG/1024,32)) ENDR = STR ^^ SUBROUTINE PACKER: FUNCTION: PACKS DATA INTO STORAGE BLOCK FOR LATTER USE BY HIDDEN. SUBROUTINE PACKER MAY REQUIRE MANY C^^HANGES DEPENDING UPON THE WORD SIZE OF YOUR MACHINE AND YOUR DESIRE FOR SPEED OF OPERATION. THE ROUTINE YOU RECEIVED ON TAPE IS WRITTEN FOR A 36 BIT MACHINE IN ANSI FORTRAN. THEREFORE, IF YOU ARE RUNNING ON A MACHINE WITH LESS THAN A 36 BIT WORD, YOU WILL NEED TO MAKE MODIFICATIONS. ALSO, IF YOUR MACHINE SUPPORTS BIT MANIPULATION IN FORTRAN, YOU MAY WANT TO USE IT TO SPEED ^^ COMPUTATION. FIRST, THE PACKING SCHEME FOR THE 36 BIT WORD WILL BE PRESENTED, AND THEN, SUGGESTED PACKING SCHEMES FOR BOTH 16 AND 32 BIT WORDS WILL FOLLOW. ^^ 36 BIT WORD TO STORE THE INFORMATION PASSED TO SUBROUTINE PACKER, FIVE 36 BIT WORDS ARE NEEDED. THE INFORMATION THAT EACH RECEIVES (ALONG WITH THE NUMBE^^R OF BITS IT OCCUPIES DELIMITED BY SLASHES) IS OUTLINED BELOW. INSTALLING MOVIE.BYU Page 5-14 IFREE(IPT) = IC1/5/,IX1/10/,IX2/10/,IDY/10/ IFREE(IPT+1) = IC2/5/,IZ1/15/,IZ2/15/ ^^ IFREE(IPT+2) = IS1/6/,IS2/6/,NXTEDG/18/ IFREE(IPT+3) = ICOL1/18/,IP/13/ IFREE(IPT+4) = ICOL2/18/,IPS/13/ THE DATA IS STORED RIGHT JUSTIFIED WITHIN EACH WORD. TH^^E VARIABLES ARE DEFINED AS FOLLOWS: IFREE = FREE STORAGE IPT = FREE STORAGE POINTER IC1 = BEGIN CONTOUR VALUE IX1 = BEGIN X COOR^^DINATE IX2 = END X COORDINATE IDY = DELTA Y IC2 = END CONTOUR VALUE IZ1 = BEGIN Z COORDINATE IZ2 = END Z COORDINATE IS1 = BEGIN INTENSITY ^^ IS2 = END INTENSITY NXTEDG = NEXT EDGE POINTER (IBUCKY(IY)) ICOL1 = BEGIN COLOR IP = POLYGON NUMBER ICOL2 = END COLOR IPS = IP OF SHARED POLYGON ^^ 16 BIT WORD CONVERSION OF THE HIDDEN PROCESSOR TO 16 BIT MACHINES WILL PR^^OVE TO BE THE MOST INVOLVED. AS PREVIOUSLY NOTED, THERE ARE SEVERAL SUBROUTINES THAT WILL REQUIRE CHANGES. APPENDIX A CONTIANS SUGGESTED CODING OF SUBROUTINE PACKER USING THE SCHEME BELOW. SUBROUTINE PACKER REQUIRES ELEVEN 16 BIT WORDS TO STORE THE DATA SENT TO IT. ^^ IFREE(IPT) = IC1/5/,IX1/10/ IFREE(IPT+1) = IC2/5/,IX2/10/ IFREE(IPT+2) = IDY/10/ IFREE(IPT+3) = IZ1/15/ IFREE(IPT+4) = IZ2/15/ IFREE(IPT+5) = IS1/5/,IS2/5/ ^^ IFREE(IPT+6) = NXTEDG/15/ IFREE(IPT+7) = ICOL1/15/ IFREE(IPT+8) = ICOL2/15/ IFREE(IPT+9) = IP/13/ IFREE(IPT+10) = IPS/13/ INSTALLI^^NG MOVIE.BYU Page 5-15 NOTICE THAT THE NUMBER OF BITS USED FOR BOTH INTENSITY INFORMATION AND COLOR HAVE BEEN REDUCED. THIS IS THE REASON CHANGES MUST BE MADE TO THE SUBROUTINES MENTIONED ABOVE. EVERYWHERE INTENSITY AND^^ COLOR RECEIVED MULTIPLES OF 6 BITS, THEY NOW WILL GET MULTIPLES OF 5 BITS. ALSO, NXTEDG NOW GETS 15 BITS INSTEAD OF 18. BY SUBTRACTING 2**15-1 OR 32767 FROM THE POINTER, A LARGER SEGMENT OF FREE STORAGE MAY BE MAPPED. ^^ 32 BIT WORD CONVERSION TO 32 BIT WORDS SHOULD BE OF RELATIVELY LITTLE TROUBLE. FIVE 32 BIT WORDS WILL BE REQUIRED TO STORE THE INFORMATION SENT TO SUBROUTINE PACKER IF CONTOURS ARE ^^ NOT REQUESTED. SIX 36 BIT WORDS WILL BE REQUIRED TO SUPPORT CONTOURING. A SIMPLE IF STATEMENT IS USED IN THE SUGGESTED SUBROUTINE TO CHOSE BETWEEN THE TWO. AS WITH THE 16 BIT SCHEME, A SUGGESTED ANSI FORTRAN SUBROUTINE TO IMPLEMENT THE PACKING SCHEME BELOW IS FOUND IN APPENDIX B. ^^ IFREE(IPT) = IX1/10/,IX2/10/,IDY/10/ IFREE(IPT+1) = IZ1/15/,IZ2/15/ IFREE(IPT+2) = IS1/6/,IS2/6/,NXTEDG/18/ IFREE(IPT+3) = ICOL1/18/,IP/13/ IFREE(IPT+4) = ICOL2/18/,IPS/13/ IFREE(IPT+6) = IC1/5/,IC2/5/ ^^ THE ONLY CHANGE NECESSARY IS THE PACKING OF THE CONTOUR INFORMATION IN THE SIXTH WORD INSTEAD OF THE FIRST AND SECOND AND CHANGING THE NUMBER OF WORDS ACCORDINGLY. ^^ SUBROUTINE UNPACK: FUNCTION: PERFORMS THE OPPOSITE FUNCTION OF PACKER. SINCE SUBROUTINE UNPACK REFORMS THE OPPOSITE FUNCTION OF ^^PACKER, ANY CHANGES YOU MADE TO SUBROUTINE PACKER MUST ALSO BE REFLECTED IN CHANGES MADE TO SUBROUTINE UNPACK. APPENDICES A AND B CONTAIN SUGGESTED ANSI FORTRAN SUBROUTINES THAT PERFORM THIS FUNCTION FOR BOTH 16 AND 32 BIT MACHINES. ^^ SUBROUTINE ERRMSG: FUNCTION: WRITES ERROR MESSAGES TO ERROR OUTPUT DEVICE. NO CHANGES NECESSARY. INSTALLING MOVIE.BYU Page 5-16 ^^ SUBROUTINE CONSHO: FUNCTION: EVALUATES CONTOUR INFORMATION FOR VISIBLE SEGMENT. ^^ NO CHANGES NECESSARY. FILE 4: DEVICE.FOR ^^ DEVICE.FOR CONTAINS THE PICTURE DEVICE DEPENDENT CODE FOR DISPLAYING THE PICTURE. THESE ROUTINES WILL GENERALLY NEED TO BE MODIFIED TO ACCOMMODATE YOUR DISPLAY DEVICES. ^^ SUBROUTINE BGNFRM: FUNCTION: INITIALIZES AN OUTPUT DEVICE TO RECEIVE A PICTURE. ^^ REMEMBER THAT THE DEVICE NUMBERS OF CONTINUOUS-TONE DEVICES ARE GREATER THAN 0 AND FOR LINE DRAWING DEVICES, THEY ARE LESS THAN ZERO. THE GENERAL EFFECT OF THIS ROUTINE ON ALL DEVICES IS AREA FOR LINE DRAWIN^^G DEVICES. SUBROUTINE ENDFRM: FUNCTION: TERMINATES OUTPUT TO A DISPLAY DEVICE. ^^ SUBROUTINE ENDFRM DUMPS THE REMAINDER OF THE OUTPUT BUFFER AND RETURNS CONTROL TO THE USER TERMINAL. SUBROUTINE PLTLIN: ^^ FUNCTION: DRAWS A LINE FROM (A,B) TO (C,D) ON THE DISPLAY DEVICE. SUBROUTINE PLTLIN CONVERTS THE A, B, C, AND D COORDINATES FROM THERE RANGE OF 0 T0 IFX (THE X RESOLUTION) TO THE RANGE OF THE CHOSEN DISPLAY DEVICE. THE APPROPRIATE CALLS ARE ^^THEN MADE TO THE PARTICULAR DEVICE TO DISPLAY THE LINE. SUBROUTINE LABEL: INSTALLING MOVIE.BYU Page 5-17 ^^ FUNCTION: PLOTS A LABEL ON THE DISPLAY DEVICE. SUBROUTINE LABEL PRINTS ALPHANUMIC INFORMATION ON THE DISPLAY DEVICE. THE LABEL, CHR, BEGINS AT (X,Y) AND IS NCNT CHARACTERS IN LENGTH. THIS ROUTINE IS USED TO PLAC^^E LABELS ON CONTOUR LINES. SUBROUTINE SRL: FUNCTION: CALCULATES SHADED LINE INFORMATION AND PASSES IT TO^^ CONTINOUS-TONE DEVICE. SUBROUTINE SRL RECEIVES THE BEGINNING AND ENDING INTENSITIES AND COLORS OF LINE SEGMENTS. IT CALCULATES THE INTENSITY AND COLOR OF INTERMEDIATE POINTS. WHEN AN ENTIRE LINE HAS BEEN PROCESSED, IT IS SENT TO THE DEVICE. THERE ARE PRESENTLY NO CALLS TO ^^DISPLAY THE PICTURE INCLUDED WITH SRL. THESE MUST BE SUPPLIED BY THE HOST SYSTEM. FILE 5: UTILITY.FOR ^^ UTILITY.FOR CONTAINS THE FORTRAN SOURCE FILE OF THE UTILITY ROUTINE. IT IS MOSTLY WRITTEN IN MACHINE INDEPENDENT FORTRAN. IF THE FORTRAN OPERATING SYSTEM YOU ARE RUNNING DOES NOT ALLOW FREE FORMATED READS, MOST OF THE ^^ FORMAT STATEMENTS ASSOCIATED WITH INTERACTIVE READ STATEMENTS WILL NEED TO BE MODIFIED. THIS SHOULD BE THE ONLY CHANGE THROUGHOUT THE PROGRAM. MAIN PROGRAM: ^^ FUNCTION: INTERACTIVELY CALLS SUBROUTINES TO PERFORM REQUESTED ACTIONS. IT MAY BE NECESSARY TO CHANGE THE I/0 UNIT NUMBERS ASSOCIATED WITH THE VARIABLES INPUT AND ^^OUTPUT. INPUT GETS THE UNIT NUMBER OF THE INPUT DEVICE, AND OUTPUT GETS THE UNIT NUMBER OF THE OUTPUT DEVICE. TYPICALLY INPUT AND OUTPUT REFER TO THE USER'S TERMINAL. REMEMBER THAT VARIABLES NPL, X, IP, JP, S, SX, AND U MUST BE DIMENSIONED TO ACCOMMODATE THE MAXIMUM EXPECTED ^^ NUMBER OF PARTS, COORDINATES, OR ELEMENTS WHICH EVER IS APPROPRIATE. THE VARIABLES NPMAX, NJMAX, AND NPTMAX MUST ALSO BE SET TO REFLECT THE MAXIMUM DIMENSIONS. FUNCTION CMD: INSTALLI^^NG MOVIE.BYU Page 5-18 FUNCTION: ISSUES COMMAND PROMPT FOR VARIOUS LEVELS AND ACCEPTS COMMAND. POSSIBLE I/O MODIFICATIO^^NS (SEE INTRODUCTION ABOVE). SUBROUTINE HELP: FUNCTION: PRINTS HELP MESSAGE ON TERMINAL. ^^ POSSIBLE I/O MODIFICATIONS (SEE INTRODUCTION ABOVE). SUBROUTINE OVER: FUNCTION: PRINTS ERROR MESSAGE WHEN MAXIMUM DIMENSIONS ^^ EXCEEDED. POSSIBLE I/O MODIFICATIONS (SEE INTRODUCTION ABOVE). SUBROUTINE GEOM: ^^ FUNCTION: PERFORMS UTILTIY OPERATIONS READ, WRITE, PRINT, AND CHANGE ON GEOMETRY FILES. POSSIBLE I/O MODIFICATIONS (SEE INTRODUCTION ABOVE). ^^ SUBROUTINE DISP: FUNCTION: PERFORMS UTILITY OPERATIONS READ, WRITE, PRINT, AND CHANGE ON DISPLACEMENT FILES. POSSIBLE I/O MODIFICATIONS (SEE INTRODUCTION ABOVE). ^^ SUBROUTINE SFUN: FUNCTION: PERFORMS UTILITY OPERATIONS READ, WRITE, PRINT, AND CHANGE ON SCALAR FUNCTION FILES. ^^ POSSIBLE I/O MODIFICATIONS (SEE INTRODUCTION ABOVE). SUBROUTINE SYMM: FUNCTION: PERFORMS SYMMETRY OPERATION^^S ON FILES. POSSIBLE I/O MODIFICATIONS (SEE INTRODUCTION ABOVE). SUBROUTINE MOVE: ^^ FUNCTION: MOVES BLOCKS OF ELEMENTS. INSTALLING MOVIE.BYU Page 5-19 NO CHANGES NECESSARY. ^^ SUBROUTINE ORDER: FUNCTION: PERFORMS ORDERING OF POLYGONAL VERTICES FOR PANEL SYSTEMS. POSSIBLE I/O MODIFICA^^TIONS (SEE INTRODUCTION ABOVE). SUBROUTINE OPEN: FUNCTION: REQUEST DATA FILE NAMES AND OPENS I/O CHANNEL ^^ SUBROUTINE OPEN MAY NEED TO BE COMPLETELY REWRITTEN TO ACCOMMODATE YOUR PARTICULAR OPERATING SYSTEM. THE ROUTINE IS ENTERED WITH FILEID CONTAINING THE ALPHANUMERIC FILE IDENTIFICATION (GEOM., DISP., OR FUNC.) IT REQUESTS THE FILE NAME, AND OPENS THE FILE FOR INPUT IF IOP=1 AND FOR OUTPUT IF IOP=-1. A BLANK FILE SPECIFICATION WILL SET ^^ IERROR TO 0. THE ROUTINE RETURNS WITH THE DEVICE UNIT NUMBER IN IUNIT AND IERROR SET TO 1 ON SUCCESSFUL COMPLETION, 0 ON BLANK FILE, AND -1 ON FAILURE. SUBROUTINE RDGEOM: ^^ FUNCTION: READ GEOMETRY FILE FROM INPUT DEVICE. POSSIBLE I/O MODIFICATIONS (SEE INTRODUCTION ABOVE). SUBROUTINE WRGEOM: ^^ FUNCTION: WRITES GEOMETRY FILE TO OUTPUT DEVICE. POSSIBLE I/O MODIFICATINS (SEE INTRODUCTION ABOVE). ^^ SUBROUTINE RDSFUN: FUNCTION: READ SCALAR FUNCTION FILE FROM INPUT DEVICE. POSSIBLE I/O MODIFICATIONS (SEE INTRODUCTION ABOVE). ^^ SUBROUTINE WRSFUN: FUNCTION: WRITES SCALAR FUNCTION FILE TO OUTPUT DEVICE. NO CHANGES NECESSARY. ^^ SUBROUTINE RDDISP: INSTALLING MOVIE.BYU Page 5-20 FUNCTION: READS DISPLACEMENT FILE FROM INPUT DEVICE. ^^ NO CHANGES NECESSARY. SUBROUTINE WRDISP: FU^^NCTION: WRITES DISPLACEMENT FILE TO INPUT DEVICE. NO CHANGES NECESSARY. FILE 6^^: SECTION.FOR SECTION.FOR CONTAINS THE FORTRAN SOURCE FILE OF THE CLIPPING AND CAPPING ALGORITHM FOR 8 NODE BRICKS AS WELL AS THE CODE TO DELETE INTERIOR POLYGONS. IT IS MOSTL^^Y WRITTEN IN MACHINE INDEPENDENT FORTRAN. IF THE FORTRAN OPERATING SYSTEM YOU ARE RUNNING DOES NOT ALLOW FREE FORMATED READS, MOST OF THE FORMAT STATEMENTS ASSOCIATED WITH INTERACTIVE READ STATEMENTS WILL NEED TO BE MODIFIED. THIS SHOULD BE THE MAJOR CHANGE THROUGHOUT THE PROGRAM. ^^ MAIN PROGRAM: FUNCTION: CONTROLS STORAGE ALLOCATION AND FLOW OF PROGRAM. IT MAY BE NECESSARY TO CHANGE THE I/0 UNIT NUMBERS ASSOCIATED WITH ^^THE VARIABLES INPUT AND OUTPUT. INPUT GETS THE UNIT NUMBER OF THE INPUT DEVICE, AND OUTPUT GETS THE UNIT NUMBER OF THE OUTPUT DEVICE. THE DIMENSION OF VARIABLE A FOUND IN BLANK COMMON SHOULD BE ADJUSTED TO ACCOMMODATE THE PROBLEM TO BE RUN. THE DIMENSION OF IA SHOULD BE THE SAME ^^AS A. THE VALUE ASSIGNED TO MTOT SHOULD ALSO BE THE SAME AS THE DIMENSION OF A. POSSIBLE I/O MODIFICATIONS (SEE INTRODUCTION ABOVE). ^^ BLOCK COMMON: FUNCTION: INITIALIZES THE POLYGON MAP OF THE HEXAHEDRON ELEMENT. NO CHANGES NECESSARY. ^^ SUBROUTINE OPEN: INSTALLING MOVIE.BYU Page 5-21 FUNCTION: REQUEST DATA FILE NAM^^ES AND OPENS I/O CHANNEL SUBROUTINE OPEN MAY NEED TO BE COMPLETELY REWRITTEN TO ACCOMMODATE YOUR PARTICULAR OPERATING SYSTEM. THE ROUTINE IS ENTERED WITH FILEID CONTAINING THE ALPHANUMERIC FILE IDENTIFICATION (GEOM., DISP., OR FUNC.) IT REQUESTS THE FILE NAME, AND OPENS THE FILE FOR INPUT IF IOP=1 AND ^^ FOR OUTPUT IF IOP=-1. A BLANK FILE SPECIFICATION WILL SET IERROR TO 0. THE ROUTINE RETURNS WITH THE DEVICE UNIT NUMBER IN IUNIT AND IERROR SET TO 1 ON SUCCESSFUL COMPLETION, 0 ON BLANK FILE, AND -1 ON FAILURE. ^^ SUBROUTINE RDCNTL: FUNCTION: READS CONTROL INFORMATION FROM INPUT DEVICE NECESSARY TO ALLOCATE STORAGE. NO CHANGES NECESSARY. ^^ SUBROUTINE RDGEOM: FUNCTION: READS REMAINDER OF GEOMETRY FILE FROM INPUT DEVICE. ^^ NO CHANGES NECESSARY. SUBROUTINE WRGEOM: FUNCTION: WRITES GEOMETRY FILE TO OUTPUT DEVICE. ^^ NO CHANGES NECESSARY. SUBROUTINE RDSFUN: FUNCTION: REA^^DS SCALAR FUNCTION FILE FROM INPUT DEVICE. POSSIBLE I/O MODIFICATIONS (SEE INTRODUCTION ABOVE). SUBROUTINE WRSFUN: ^^ FUNCTION: WRITES SCALAR FUNCTION FILE TO OUTPUT DEVICE. NO CHANGES NECESSARY. SUBROUTINE RDDISP: ^^ FUNCTION: READS DISPLACEMENT FILE FROM INPUT DEVICE. INSTALLING MOVIE.BYU Page 5-22 NO CHANGES NECESSARY. ^^ SUBROUTINE WRDISP: FUNCTION: WRITES DISPLACEMENT FILE TO OUTPUT DEVICE. NO CHANGES NECESSARY.^^ SUBROUTINE PLFILE: FUNCTION: REQUESTS CLIPPING PLANE INFORMATION. ^^ POSSIBLE I/O MODIFICATIONS (SEE INTRODUCTION ABOVE). SUBROUTINE DIST: FUNCTION: CALCULATES DISTANCE TO FROM PLANE TO A POINT. ^^ NO CHANGES NECESSARY. SUBROUTINE SOLID: FUNCTION: DISSEMBLE^^S HEXAHEDRON INTO POLYGONS AND SENDS THEM TO CLIPPER. POSSIBLE I/O MODIFICATIONS (SEE INTRODUCTION ABOVE). SUBROUTINE SPLIT: ^^ FUNCTION: SPLITS POLYGONS ALONG PLANE AND SAVES ON-PLANE LINE SEGMENTS. NO CHANGES NECESSARY. ^^ SUBROUTINE LOOKUP: FUNCTION: PERFORMS HASH TABLE LOOKUP. NO CHANGES NECESSARY. ^^ SUBROUTINE ENTER: FUNCTION: PERFORMS HASH TABLE ENTER. NO CHANGES NECESSARY. ^^ SUBROUTINE DELETE: INSTALLING MOVIE.BYU Page 5-23 ^^ FUNCTION: PERFORMS HASH TABLE DELETE. POSSIBLE I/O MODIFICATIONS (SEE INTRODUCTION ABOVE). SUBROUTINE GETBLK: ^^ FUNCTION: GETS A BLOCK FROM FREE STORAGE. NO CHANGES NECESSARY. SUBROUTINE RETBLK: ^^ FUNCTION: RETURNS A BLOCK TO FREE STORAGE. NO CHANGES NECESSARY. ^^ SUBROUTINE ORDER: FUNCTION: FORMS ON-PLANE POLYGONS FROM LINE SEGMENTS. POSSIBLE I/O MODIFICATIONS (SEE INTRODUCTION ABOVE). ^^ SUBROUTINE PLYSRT: FUNCTION: SORTS POLYGONS IN HASH TABLE AND STORES THEM. NO CHANGES NECESSARY. ^^ SUBROUTINE REDUCE: FUNCTION: CALCULATES NEW NODE NUMBERS. NO CHANGES NECESSARY. ^^ SUBROUTINE TRGEOM: FUNCTION: TRANSFORMS OLD GEOMETRY TO NEW GEOMETRY. ^^ NO CHANGES NECESSARY. SUBROUTINE TRDISP: FUNCTION: TRANSFORMS OLD DISPLACEMENTS TO NEW DISPLACE^^MENTS. NO CHANGES NECESSARY. INSTALLING MOVIE.BYU Page 5-24 SUBROUTINE TRSFUN: ^^ FUNCTION: TRANSFORMS OLD SCALAR FUNCTIONS TO NEW SCALAR FUNCTIONS. NO CHANGES NECESSARY. ^^ FILE 7: TITLE.FOR ^^ TITLE.FOR IS THE FORTRAN SOURCE FILE FOR THE TWO AND THREE DIMENSIONAL CHARACTER GENERATOR. THE DATA GENERATED IS COMPATIBLE WITH THE OTHER PROGRAMS IN MOVIE.BYU MAIN PROGRAM: ^^ FUNCTION: GENERATES CHARACTER STRINGS OF POLYGONS FOR DISPLAY. IT MAY BE NECESSARY TO CHANGE THE I/0 UNIT NUMBERS ASSOCIATED WITH THE VARIABLES INPUT AND OUTPUT. INPUT GETS THE UNIT NUMBER OF THE INPUT DEVICE AND OUTPUT ^^GETS THE UNIT NUMBER OF THE OUTPUT DEVICE. TYPICALLY INPUT AND OUTPUT REFER TO THE USER'S TERMINAL. REMEMBER THAT VARIABLES NPL, X, AND IP, MUST BE DIMENSIONED TO ACCOMMODATE THE MAXIMUM EXPECTED NUMBER OF PARTS, COORDINATES, OR ELEMENTS WHICH EVER IS APPROPRIATE. ^^ BLOCK DATA: FUNCTION: INITIALIZES ARRAYS WITH CHARACTER DEFINITIONS NO CHA^^NGES NECESSARY. SUBROUTINE OPEN: FUNCTION: REQUEST DATA FILE NAMES AND OPENS I/O CHANNEL ^^ SUBROUTINE OPEN MAY NEED TO BE COMPLETELY REWRITTEN TO ACCOMMODATE YOUR PARTICULAR OPERATING SYSTEM. THE ROUTINE IS ENTERED WITH FILEID CONTAINING THE ALPHANUMERIC FILE IDENTIFICATION (GEOM., DISP., OR FUNC.) IT REQUESTS THE FILE NAME, AND OPENS THE FILE FOR INPUT IF IOP=1 AND FOR OUTPUT IF IOP=-1. A BLANK FILE SPECIFICATION WILL SET ^^ IERROR TO 0. THE ROUTINE RETURNS WITH THE DEVICE UNIT NUMBER IN IUNIT AND IERROR SET TO 1 ON SUCCESSFUL COMPLETION, 0 ON BLANK FILE, AND -1 ON FAILURE. INSTALLING MOVIE.BYU Page 5-25 SUBRO^^UTINE WRGEOM: FUNCTION: WRITES GEOMETRY FILE TO OUTPUT DEVICE. POSSIBLE I/O MODIFICATINS (SEE INTRODUCTION ABOVE). Page Index-1 ^^ INSTALLING MOVIE.BYU INDEX ^^ Ainten: . . . . . . . . . . . 5-4 Bgnfrm: . . . . . . . . . . . 5-16 Clip: . . . . . . . . . . . . 5-10 Cmd: . . . . . . . . . . . . . 5-17 ^^ Consho: . . . . . . . . . . . 5-16 Delete: . . . . . . . . . . . 5-22 Device.for . . . . . . . . . . 5-16 Disp: . . . . . . . . . . . . 5-18 Dist: . . . . . . . . . . . . 5-22 Draw: . . . . . . .^^ . . . . . 5-5 Drawit: . . . . . . . . . . . 5-12 Edgmak: . . . . . . . . . . . 5-7 Endfrm: . . . . . . . . . . . 5-16 Enter: . . . . . . . . . . . . 5-22 Errmsg: . . . . . . . . . . . 5-15 ^^ Facmak: . . . . . . . . . . . 5-11 Geom: . . . . . . . . . . . . 5-18 Getblk: . . . . . . . . . . . 5-6, 5-23 Getvar: . . . . . . . . . . . 5-6 ^^ Help: . . . . . . . . . . . . 5-18 Hidden.for . . . . . . . . . . 5-6 Hidden: . . . . . . . . . . . 5-11 Intclp: . . . . . . . . . . . 5-7 Inthid: . ^^. . . . . . . . . . 5-5 Ishade: . . . . . . . . . . . 5-4 Ivsble: . . . . . . . . . . . 5-4 Label: . . . . . . . . . . . . 5-16 Linsho: . . . . . . . . . . . 5-12 Lookup: . . . . . . . . . . . 5-22^^ Lstset: . . . . . . . . . . . 5-6 Move: . . . . . . . . . . . . 5-18 Movie.for . . . . . . . . . . 5-1 Multdc: . . . . . . . . . . . 5-4 Multdd: . . . . . . . . . . . 5-4 ^^ Open: . . . . . . . . . . . . 5-2, 5-19 to 5-20, 5-24 Order: . . . . . . . . . . . . 5-19, 5-23 Over: . . . . . . . . . . . . 5-18 Packer: . . . . . . . . . . . 5-13 Pi^^ctur: . . . . . . . . . . . 5-2 Plfile: . . . . . . . . . . . 5-22 Pltlin: . . . . . . . . . . . 5-16 Plysrt: . . . . . . . . . . . 5-23 Polmak: . . . . . . . . . . . 5-7 Polsnp: . . . . . . . . . . . 5-8 ^^ Rdcntl: . . . . . . . . . . . 5-21 Rddisp: . . . . . . . . . . . 5-19, 5-21 Rdgeom: . . . . . . . . . . . 5-19, 5-21 Rdsfun: . . . . . . . . . . . 5-19, 5-21 Reduce: . . . . . . . . . . . 5-23 Retblk: . . . . . . . . . . . 5-6, 5-23 ^^ Rotat: . . . . . . . . . . . . 5-2 Section.for . . . . . . . . . 5-20 Sfun: . . . . . . . . . . . . 5-18 Show: . . . . . . . . . . . . 5-13 Solid: . . . . . . . . . . . . 5-22 ^^ Split: . . . . . . . . . . . . 5-22 Srl: . . . . . . . . . . . . . 5-17 Symm: . . . . . . . . . . . . 5-18 Title.for . . . . . . . . . . 5-24 Trdisp: . . . . . . . . . . . 5-23 Trgeom: . . . . ^^. . . . . . . 5-23 Trsfun: . . . . . . . . . . . 5-24 Unpack: . . . . . . . . . . . 5-15 User.doc . . . . . . . . . . . 5-1 Utility.for . . . . . . . . . 5-17 ^^ Wrdisp: . . . . . . . . . . . 5-20, 5-22 Wrgeom: . . . . . . . . . . . 5-19, 5-21, 5-25 Wrsfun: . . . . . . . . . . . 5-19, 5-21 ^^ ^^ APPENDIX A SUGGESTED 16 BIT ^^MACHINE CODE SUBROUTINE PACKER C C SUBROUTINE PACKER FOR 16 BIT MACHINES IN ANSI FORTRAN ^^ C C THIS ROUTINE RECEIVES DATA THROUGH EDGARG AND PACKS IT C INTO A STORAGE BLOCK INSIDE FREE. IF THIS EDGE IS A C SHARED EDGE, THEN THE EDGE WILL BE COMPARED WITH EXISTING C EDGES ON THIS SCAN LINE TO FIND OUT WHICH IF ANY IT C MATCHES. IF THIS EDGE IS A HORIZONTAL EDGE, THEN IT WILL ^^ C BE STORED ON THE PREVIOUS SCAN LINE. COMMON/EDGARG/IY,IX1,IX2,IZ1,IZ2,IS1,IS2,IP,IDY,ICOL1, 1ISHR,IC1,IC2,ICOL2 COMMON/FREE/ IFREE(1) COMMON/EYES/XEY(3),IFY,ES(4) COMMON/BUCKY/IBUCKY(1) COMMON/QFORIO/CON^^TRS,IDVICE,IBAD,SHOSHR,LBLSPC LOGICAL CONTRS,IBAD,ISHR C CHANGE IY IF THIS IS A HORIZONTAL EDGE IF(IDY.EQ.0) IY=IY+1 IF(IY.GT.IFY) IY=IFY IPT=IBUCKY(IY)+32767 C GENERATE THE EDGE DATA ^^ NUMWRD=11 C JUMP IF NO EDGE SHARING IF(.NOT.ISHR) GO TO 4 C TRACE THROUGH THE ENTRIES ON THIS SCAN LINE AND FIND OUT C IF THIS EDGE HAS ALREADY BEEN ENTERED. 1 IF(IPT.EQ.0) GO TO 4 ^^ IF(IX1.EQ.MOD(IFREE(IPT),1024) 1.AND.IX2.EQ.MOD(IFREE(IPT+1),1024) 2.AND.IDY.EQ.IFREE(IPT+2) 3.AND.IZ1.EQ.IFREE(IPT+3) 4.AND.IZ2.EQ.IFREE(IPT+4)) GO TO 3 C GET THE NEXT BLOCK IPT=IFRE^^E(IPT+6)+32767 GO TO 1 C CHECK TO SEE IF THIS EDGE IS ALREADY SHARED C AND JUMP IF IT IS 3 IF(IFREE(IPT+10).NE.0) GO TO 4 C NOW PROVIDE THE SHARING POLYGON SUGGESTED 16 BIT MACHINE CODE ^^ Page A-2 IFREE(IPT+10)=IP GO TO 5 4 CONTINUE C GET ENOUGH FREE FOR EDGE BLOCK (176 BITS) ^^ CALL GETVAR(IPT,NUMWRD) IF(IBAD) RETURN C CBEG(5), XBEG(10) IFREE(IPT)=IX1 C CEND(5), XEND(10) IFREE(IPT+1)=IX2 C DEL^^TA Y(10) IFREE(IPT+2)=IDY C ZBEG(15) IFREE(IPT+3)=IZ1 C ZEND(15) IFREE(IPT+4)=IZ2 C SBEG(5), SEND(5) ^^ IFREE(IPT+5)=IS1*32+IS2 C NEXT EDGE(16) IFREE(IPT+6)=IBUCKY(IY) C COLOR BEG(15) IFREE(IPT+7)=ICOL1 C COLOR END(15) ^^ IFREE(IPT+8)=ICOL2 C POLYGON NUMBER IFREE(IPT+9)=IP C SHARED POLYGON NUMBER IFREE(IPT+10)=0 IF(.NOT.CONTRS) GO TO 6 ^^ IFREE(IPT)=MOD(IFREE(IPT),1024)+IC1*1024 IFREE(IPT+1)=MOD(IFREE(IPT+1),1024)+IC2*1024 6 IBUCKY(IY)=IPT-32767 5 RETURN END ^^ SUBROUTINE UNPACK C C SUBROUTINE UNPACK FOR 16 BIT MACHINES IN ANSI FORTRAN C C UNPACK PERFORMS THE REVERSE OF PACKER. IT ^^IS CALLED BY C HIDDEN WITH IEDGPT SET AND RETURNS DATA THROUGH EDGBLK. COMMON/FREE/IFREE(1) COMMON/EDGBLK/IPT,ICOL1,IDELY,X1,X2,Z1,Z2,S1,S2, 1IEDGPT,C1,C2,SHARED,IGTHRZ,ICOL2 COMMON/QFORIO/CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC LOGICAL CONTRS ^^ C GET DELTAY VALUE 15 IDELY=IFREE(IEDGPT+2) C JUMP IF A NON-HORIZONTAL LINE IF(IDELY.GT.0) GO TO 16 C JUMP IF WE ARE LOOKING FOR VERTICALS IF(IGTHRZ) 20,20,18 C JUMP IF W^^E ARE LOOKING FOR HORIZONTALS SUGGESTED 16 BIT MACHINE CODE Page A-3 16 IF(IGTHRZ) 19,19,20 C FLAG TO SAY THERE ARE HORIZONTAL EDGES ON THIS SCAN LINE 18 IGTHRZ=2 ^^ C GET NEXT EDGE BLOCK 19 IEDGPT=IFREE(IEDGPT+6)+32767 C GO HOME IF WE RAN OFF THE END OF THE LIST IF(IEDGPT) 3,3,15 C GET Z BEGIN 20 Z1=FLOAT(IFREE(IEDGPT+3)) ^^ C GET Z END AND MAKE IT REAL Z2=FLOAT(IFREE(IEDGPT+4)) C GET X BEGIN X1=FLOAT(MOD(IFREE(IEDGPT),1024)) C GET X END AND MAKE IT REAL X2=FLOAT(MOD(IFREE(IEDGPT+1),1024)) C ^^GET SHADE BEGIN S1=FLOAT(MOD(IFREE(IEDGPT+5)/32,32)) C GET SHADE END AND MAKE IT REAL S2=FLOAT(MOD(IFREE+5),32)) C GET POINTER TO POLYGON IP=IFREE(IEDGPT+10) C GET THE COLOR OF THIS ED^^GE ICOL1=IFREE(IEDGPT+7) ICOL2=IFREE(IEDGPT+8) C JUMP IF NO CONTOURING IF(.NOT.CONTRS) GO TO 4 C GET THE CONTOUR BEGIN C1=FLOAT(MOD(IFREE(IEDGPT)/1024,32)) ^^ C CET THE CONTOUR END C2=FLOAT(MOD(IFREE(IEDGPT+1)/1024,32)) 4 SHARED=-2. C IPT=IFREE(IEDGPT+9) C JUMP IF NOTHING IN THE TOP HALF ^^ IF(IP.EQ.0) GO TO 2 SHARED=-1. IF(ISHARE.EQ.1) GO TO 1 ISHARE=1 GO TO 3 1 IPT=IP C GET POINTER TO ^^NEXT EDGE ON SCAN LINE 2 IEDGPT=IFREE(IEDGPT+6)+32767 ISHARE=0 3 RETURN END ^^ ^^ APPENDIX B ^^ SUGGESTED 32 BIT MACHINE CHANGES SUBROUTINE PACKER C C SUBROUTINE PACKER FOR 32 BIT M^^ACHINES IN ANSI FORTRAN C C THIS ROUTINE RECEIVES DATA THROUGH EDGARG AND PACKS IT C INTO A STORAGE BLOCK INSIDE FREE. IF THIS EDGE IS A C SHARED EDGE, THEN THE EDGE WILL BE COMPARED WITH EXISTING C EDGES ON THIS SCAN LINE TO FIND OUT WHICH IF ANY IT C MATCHES. IF THIS EDGE IS A HORIZONTAL EDGE, THEN IT W^^ILL C BE STORED ON THE PREVIOUS SCAN LINE. COMMON/EDGARG/IY,IX1,IX2,IZ1,IZ2,IS1,IS2,IP,IDY,ICOL1, 1ISHR,IC1,IC2,ICOL2 COMMON/FREE/ IFREE(1) COMMON/EYES/XEY(3),IFY,ES(4) COMMON/BUCKY/IBUCKY(1) ^^ COMMON/QFORIO/CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC LOGICAL CONTRS,IBAD,ISHR C CHANGE IY IF THIS IS A HORIZONTAL EDGE IF(IDY.EQ.0) IY=IY+1 IF(IY.GT.IFY) IY=IFY IPT=IBUCKY(IY) C GENERATE THE EDGE DAT^^A IT1=(IX1*1024+IX2)*1024+IDY IT2=IZ1*32768+IZ2 NUMWRD=5 C GET EXTRA WORD FOR CONTOURS IF(CONTRS) NUMWRD=6 C JUMP IF NO EDGE SHARING ^^ IF(.NOT.ISHR) GO TO 4 C TRACE THROUGH THE ENTRIES ON THIS SCAN LINE AND FIND OUT C IF THIS EDGE HAS ALREADY BEEN ENTERED. 1 IF(IPT.EQ.0) GO TO 4 IF(IT1.EQ.IFREE(IPT).AND.IT2.EQ.IFREE(IPT+1)) GO TO 3 C GET THE NEXT BLOCK ^^ IPT=MOD(IFREE(IPT+2),262144) GO TO 1 C CHECK TO SEE IF THIS EDGE IS ALREADY SHARED C AND JUMP IF IT IS 3 IF(MOD(IFREE(IPT+4),8192).NE.0) GO TO 4 C NOW PROVIDE THE SHARING POLYGON SUGGESTED 32 B^^IT MACHINE CHANGES Page B-2 IFREE(IPT+4)=IFREE(IPT+4)/8192*8192+IP GO TO 5 4 CONTINUE C GET ENOUGH FREE FOR EDGE BLOCK (160 ^^OR 192 BITS) CALL GETVAR(IPT,NUMWRD) IF(IBAD) RETURN C XBEG(10), XEND(10), DELTA Y(10) IFREE(IPT)=IT1 C ZBEG(15), ZEND(15) IFREE(IPT+1)=IT2 ^^ C SBEG(6), SEND(6), NEXT EDGE(18) IFREE(IPT+2)=(IS1*64+IS2)*262144+IBUCKY(IY) C COLOR BEG(18), POLYGON NUMBER(13) IFREE(IPT+3)=ICOL1*8192+IP C COLOR END(18), SHARED POLYGON NUMBER(13) IFREE(IPT+4)=ICOL2*8192 C CON^^TOUR BEG(5), CONTOUR END(5) IFCONTRS) IFREE(IPT+5)=IC1*32+IC2 6 IBUCKY(IY)=IPT 5 RETURN END ^^ SUBROUTINE UNPACK C C SUBROUTINE UNPACK FOR 32 BIT MACHINES IN ANSI FORTRAN C C UNPACK PERFORMS THE REVERSE OF PACKER. IT IS CALLED^^ BY C HIDDEN WITH IEDGPT SET AND RETURNS DATA THROUGH EDGBLK. COMMON/FREE/IFREE(1) COMMON/EDGBLK/IPT,ICOL1,IDELY,X1,X2,Z1,Z2,S1,S2, 1IEDGPT,C1,C2,SHARED,IGTHRZ,ICOL2 COMMON/QFORIO/CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC LOGICAL CONTRS ^^ C GET DELTAY VALUE 15 IDELY=MOD(IFREE(IEDGPT,1024) C JUMP IF A NON-HORIZONTAL LINE IF(IDELY.GT.0) GO TO 16 C JUMP IF WE ARE LOOKING FOR VERTICALS IF(IGTHRZ) 20,20,18 C JUMP IF WE ARE LOO^^KING FOR HORIZONTALS 16 IF(IGTHRZ) 19,19,20 C FLAG TO SAY THERE ARE HORIZONTAL EDGES ON THIS SCAN LINE 18 IGTHRZ=2 C GET NEXT EDGE BLOCK 19 IEDGPT=MOD(IFREE(IEDGPT+2),262144) C GO HOME IF WE RAN OFF THE END OF THE LIST ^^ IF(IEDGPT) 3,3,15 C GET Z BEGIN 20 Z1=FLOAT(MOD(IFREE(IEDGPT+1)/32768,32768)) C GET Z END AND MAKE IT REAL Z2=FLOAT(MOD(IFREE(IEDGPT+1),32768)) C GET X BEGIN ^^ X1=FLOAT(MOD(IFREE(IEDGPT)/1048576,1024)) SUGGESTED 32 BIT MACHINE CHANGES Page B-3 C GET X END AND MAKE IT REAL X2=FLOAT(MOD(IFREE(IEDGPT)/1024,1024)) C GET SHADE^^ BEGIN S1=FLOAT(MOD(IFREE(IEDGPT+2)/16777216,64)) C GET SHADE END AND MAKE IT REAL S2=FLOAT(MOD(IFREE+2)/262144,64)) C GET POINTER TO POLYGON IP=MOD(IFREE(IEDGPT+4),8192) C GET THE COLOR OF THIS EDGE ^^ ICOL1=MOD(IFREE(IEDGPT+3)/8192,262144) ICOL2=MOD(IFREE(IEDGPT+4)/8192,262144) C JUMP IF NO CONTOURING IF(.NOT.CONTRS) GO TO 4 C GET THE CONTOUR BEGIN C1=FLOAT(MOD(IFREE(IEDGPT+5)/32,32)) ^^ C CET THE CONTOUR END C2=FLOAT(MOD(IFREE(IEDGPT+5),32)) 4 SHARED=-2. C IPT=MOD(IFREE(IEDGPT+3),8192) C JUMP IF NOTHING IN THE TOP HALF ^^ IF(IP.EQ.0) GO TO 2 SHARED=-1. IF(ISHARE.EQ.1) GO TO 1 ISHARE=1 GO TO 3 1 IPT=IP C GET POINTER TO NEXT EDGE^^ ON SCAN LINE 2 IEDGPT=MOD(IFREE(IEDGPT+2),262144) ISHARE=0 3 RETURN END C**********************************************************************C C ^^ C C MOVIE.FOR VERSION 2.0(A) SEPTEMBER 1976 C C C C A GENERAL PRUPOSE COMPUTER GRAPHICS DISPLAY PROGRAM FOR C C POLYGONAL DATA WITH LINE DRAWING AND C C CONTINUOUS-TONE PHOTOIMAGE OUTPUT. C C C C ^^ MIKE STEPHENSON HANK CHRISTIANSEN C C DEPARTMENT OF CIVIL ENGR. CIVIL ENGINEERING DEPT. C C AND ENGINEERING MECHANICS 368E ESTB C C THE UNIVERSITY OF ARIZONA BRIGHAM YOUNG UNIVERSITY C C TUCSON, ARIZONA 85721 PROVO, UTAH 84602 C C (602) 884-4803 (801) 374-1211 X2811 C C ^^ C C**********************************************************************C C MAIN PROGRAM READS DATA AND CALLS PICTURE ROUTINE C SUBPROGRAMS CALLED C OPEN = DATA FILE OPEN ROUTINE ^^ C PICTUR = INTERACTIVE PICTURE PROCESSING ROUINE C VARIABLES USED C NP = NUMBER OF PARTS C NJ = NUMBER OF JOINTS OR NODES C NPT = NUMBER OF ELEMENTS ^^ C NPL = PARTS ARRAY - 1ST ROW = FIRST ELEMENT OF PART C - 2ND ROW = LAST ELEMENT OF PART C X = COORDINATE ARRAY C IP = CONNECTIVITY ARRAY C U = DISPLACEMENT ARRAY C SPEC = SCALAR FUNCTION ARRAY C ISPEC = .TRU^^E. FOR SCALAR FUNCTION FILE INCLUDED C = .FALSE. FOR SCALAR FUNCTION FILE NOT INCLUDED C NFILE = .TRUE. TO READ NEW DATA FILES C = .FALSE. TO EXIT C NPMAX = MAXIMUM NUMBER OF PARTS C NJMAX = MAXIMUM NUMBER OF NODES C NPTMAX = MAXIMUM NUMBER OF ELEMENTS(^^POLYGONS) INTEGER OUTPUT,ERROR LOGICAL ISPEC,NFILE C DIMENSION NPL(2,NPMAX),X(3,NJMAX),IP(4,NPTMAX),U(3,NJMAX), C 1 SPEC(NJMAX) DIMENSION NPL(2,20),X(3,250),IP(4,250),U(3,250), ^^ 1 SPEC(250) COMMON/DEVI/ INPUT,OUTPUT,ERROR DATA NP/0/,NJ/0/,NPT/0/ DATA NPMAX/20/,NJMAX/250/,NPTMAX/250/ DATA IREAD/1/ C INP^^UT, OUTPUT AND ERROR ARE SET BELOW FOR THE DECSYSTEM-10 INPUT=-4 OUTPUT=-1 ERROR=3 WRITE(OUTPUT,1) ^^ 1 FORMAT(' '/) ICODE=63 C READ GEOMETRY FILE 10 CALL OPEN('GEOM.',IUNIT,IREAD,IERROR) ^^ IF(IERROR) 10,20,11 11 READ(IUNIT,1000) NP,NJ,NPT IF(NP.GT.NPMAX) WRITE(OUTPUT,1020) NP,NPMAX IF(NJ.GT.NJMAX) WRITE(OUTPUT,1030) NJ,NJMAX IF(NPT.GT.NPTMAX) WRITE(OUTPUT,1040) NPT,NPTMAX IF(NP.GT.NPMAX.OR.NJ.GT.NJMAX.OR.NPT.GT.NPTMAX) STOP ^^ READ(IUNIT,1000) ((NPL(I,J),I=1,2),J=1,NP) READ(IUNIT,1010) ((X(I,J),I=1,3),J=1,NJ) READ(IUNIT,1000) ((IP(I,J),I=1,4),J=1,NPT) WRITE(OUTPUT,1050) NP,NJ,NPT C READ DISPLACEMENT FILE ^^ 20 IF(NP.EQ.0) GO TO 10 CALL OPEN('DISP.',IUNIT,IREAD,IERROR) IF(IERROR) 20,30,21 21 READ(IUNIT,1010) ((U(I,J),I=1,3),J=1,NJ) C READ SPECIAL FUNCTION FILE ^^ 30 CALL OPEN('S. F.',IUNIT,IREAD,IERROR) ISPEC=.FALSE. IF(IERROR) 30,40,31 31 ISPEC=.TRUE. READ(IUNIT,1010) (SPEC(I),I=1,NJ) ^^ C SELECT OPTIONS AND VIEW SCENE 40 CALL PICTUR(NPL,X,IP,U,SPEC,NP,NJ,NPT,ISPEC,ICODE) GO TO 10 1000 FORMAT(20^^I) 1010 FORMAT(6E) 1020 FORMAT(' ') 1030 FORMAT(' ') 1040 FORMAT(' ') 1050 FORMAT(' ') ^^ END SUBROUTINE OPEN(FILEID,IUNIT,IOP,IERROR) C SUBROUTINE OPEN REQUEST FILENAME AND OPENS FILE FOR I/O C SUBPROGRAMS CALLED ^^ C OPEN = SYSTEM OPEN FILE ROUTINE C VARIABLES USED C FILEID = 5 ASCII CHARACTER ID C IUNIT = DEVICE LOGICAL NUMBER C IOP = 1 FOR INPUT FILE C ^^ = -1 FOR OUTPUT FILE C IERROR = 1 ON SUCCESSFUL COMPLETION C = 0 ON EMPTY FILE SPECIFICATION C = -1 ON FAILURE DOUBLE PRECISION ASEQ,BLANK,XNAME INTEGER OUTPUT,ERROR ^^ COMMON/DEVI/ INPUT,OUTPUT,ERROR DATA DSK/'DSK'/,MTA/'MTA'/ DATA BLANK/' '/ IERROR=0 1 WRITE(OUTPUT,2) FILEID ^^ 2 FORMAT(' <',A5,' FILE> ',$) READ(INPUT,3) XNAME 3 FORMAT(A10) IF(XNAME.EQ.BLANK) RETURN IERROR=1 IUNIT=10 ^^ IF(IOP.GT.0) ASEQ='SEQIN' IF(IOP.LT.0) ASEQ='SEQOUT' OPEN(UNIT=IUNIT,DEVICE=DSK,FILE=XNAME,ACCESS=ASEQ,MODE='ASCII') RETURN END SUBROUTINE ROTAT(X,IDIR,THETA,K) ^^ C SUBROUTINE ROTAT CALCULATES ROTATION TRANSFORMATION MATRIX C VARIABLES USED C X = TRANSFORMATION MATRIX C IDIR = ROTATION ABOUT 1=X1, 2=X2, 3=X3 AXIS C THETA = ANGLE OF ROTATION IN DEGREES ^^ DIMENSION X(3,3,1) C COMPUTE SINE AND COSINE CS=COSD(THETA) ^^ SS=SIND(THETA) GO TO (1,2,3),IDIR C X1 DIRECTION 1 DO 11 I=1,3 X2=X(I^^,2,K) X3=X(I,3,K) X(I,2,K)=CS*X2-SS*X3 11 X(I,3,K)=CS*X3+SS*X2 RETURN C X2 DIRECTION ^^ 2 DO 12 I=1,3 X1=X(I,1,K) X3=X(I,3,K) X(I,1,K)=CS*X1+SS*X3 12 X(I,3,K)=CS*X3-SS*X1 ^^ RETURN C X3 DIRECTION 3 DO 13 I=1,3 X1=X(I,1,K) ^^ X2=X(I,2,K) X(I,1,K)=CS*X1-SS*X2 13 X(I,2,K)=CS*X2+SS*X1 RETURN END SUBROUTINE PICTUR(NPL,X,IP,U,SPEC,NP,NJ,NPT,ISPEC,ICODE) ^^ C SUBROUTINE PICTUR - INTERACTIVE PICTURE PROCEESING ROUTINE. C PICTUR ACCEPTS COMMANDS FROM THE USER AND PERFORMS THE INDICATED C ACTION. C COMMANDS ARE C SCOPE = SET SCOPE PARAMETERS ^^ C RESTORE = RESTORE GEOMETRY TO INITIAL CONDITION C CONTENT = SELECT CONTENT OF A SCENE AND SET LOCAL MOTION C DIFUSE = SET DIFUSED LIGHT INTENSITY OF INDIVIDUAL PARTS C SUMMARY = GIVE MAXIMUM AND MINIMUM VALUES OF DATA FILES READ C FLAT = USE FLAT SHADING C SMOOTH = USE SMOOTH SHADING ^^ C COLOR = SELECT COLORS FOR BACKGROUND, PARTS, AND FRINGES C ROTATE = ROTATE MODEL ABOUT GLOBAL AXES C PIVOT = ROTATE MODEL ABOUT LOCAL AXES C TRANSLATE = TRANSLATE LOCAL ORIGIN OF MODEL C DISTANCE = SET DISTANCE FROM OBSERVER TO MODEL C FIELD = SPECIFY FRUSTRUM OF VISION C SCALE = SET ^^SCALE FACTOR FOR DISPLACEMENT FUNCTIONS C WARP = SET SCALE FACTOR FOR SCALAR FUNCTIONS C MOVIE = SPECIFY ANIMATION SEQUENCE C DATA = SELECT POLYGON ORIENTATION AND POOR MAN'S HIDDEN SURFACE C DRAW = DISPLAY SCENE ON TEKTRONIX SCOPE - LINE DRAWING C VIEW = DISPLAY SCENE ON PRECISION DISPALY C READ = READ NEW DATA FILES ^^ C HELP = TYPE COMMANDS C EXIT = TERMINATE PROGRAM EXECUTION C SUBPROGRAMS CALLED C ROTAT = CALCULATE ROTATION TRANSFORMATION MATRIX C MULTDD = MULTIPLY COORDINATE BY LOCAL ROTATION ^^ C MULTDC = MULTIPLY COORDINATE BY GLOBAL ROTATION C IVSBLE = CALCULATE NUMBER VISIBLE NODES C AINTEN = CALCULATE LIGHT INTENSITY AT NODE C IPASS = DISPLAY SCENE ON DEVICE C VARIABLES USED C NPL^^ = PARTS ARRAY C X = COORDINATE ARRAY C IP = CONNECTIVITY ARRAY C U = DISPLACEMENT ARRAY C SPEC = SCALAR FUNCTION ARRAY C XNORM = NORMALS ARRAY C NP = NUMBER OF PARTS ^^ C NJ = NUMBER OF JOINTS OR NODES C NPT = NUMBER OF ELEMENTS C ISPEC = .TRUE. FOR SCALAR FUNCTION FILE INCLUDED C = .FALSE. FOR NO SCALAR FUNCTION FILE INCLUDED C NFILE = .TRUE. TO READ NEW DATA FILES C = .FALSE. DO NOT READ NEW DATA FILES ^^ C DA = LOCAL ROTATIONS ARRAY BY PART C DC = GLOBAL TRANSFORMATION MATRIX C DD = LOCAL TRANSFORMATION MATRICES BY PART C FUNX, FUNY, FUNZ = WARPPING SCALE FACTORS (X1, X2, X3 DIRECTION) C COLOR = DATA ARRAY C NFR = FRINGE ARRAY - 1 DISPLAY FRINGES ^^C - 0 DO NOT DISPLAY FRINGES C NPLS = DISPLAY PARTS ARRAY - 1 TO DISPLAY C - 0 NO DISPLAY C RORG = RELATIVE ORIGIN ARRAY FOR LOCAL ROTATIONS C WORDS = DATA ARRAY C ICOL= RED, BLUE, GREEN INTENSITY BY PARTS C XO = TRANSLATION A^^RRAY C XX = LOCAL MOTION TRANSLATION ARRAY C DIF = DIFUSED LIGHT ARRAY BY PART C TANAL = TANGENT OF PERSPECTIVE HALF ANGLE C CFRIN = RED, BLUE, GREEN, FRINGE INTENSITY BY FRINGE NUMBER C JFRING = .TRUE FOR FRINGES C = .FALSE. FOR NO FRINGES ^^ C DIRC = .TRUE. FOR CLOCKWISE ORIENTATION OF POLYGONS C = .FALSE. FOR COUNTER-CLOCKWISE ORIENTATION OF POLYGONS C NFRINGE = NUMBER OF FRINGES C CMD = COMMAND WORD C SKALE = DISPLACEMNT SCALE FACTOR C ISMOTH = -1 FOR SMOOTH SHADING ^^ C = 0 FOR FLAT SHADING C = 1 FOR UNIFORM SHADING C DOZ = DISTANCE TO ORIGIN C FIELD = ANGLE OF VIEW (FRUSTRUM OF VISION) C DELTA = LOCAL MOTION SCALE FACTOR C IC = 1 FOR COLOR C 2 FO^^R BLACK AND WHITE C IFR1, IFR2 = FIRST AND LAST SCENE IN SEQUENCE SENT TO DISPLAY C CPF = VIBRATIONS/FRAME C DT = TOTAL TRANSLATION IN ANIMATED SEQUENCE C DR = TOTAL ROTATION IN ANIMATED SEQENCE C DDOZ = CHANGE IN DISTANCE TO ORIGIN IN ANIMATED SEQUENCE C SFDEL = DISPLACEMENT SCALE FACTOR^^ IN ANIMATED SEQUENCE C DDELTA = POSITION SCALE FACTOR IN ANIMATED SEQUENCE C IPM = .TRUE. DISPLAYS ALL PICTURES IN SEQUENCE C = .FALSE. MODIFIES GEOMETRY BUT DOES NOT DISPLAY C IPB = BACKGROUND COLOR C IDVICE = DISPLAY DEVICE NUMBER C DAMP = DAMPING FACTOR FOR SMOOTH ANIMATION ^^ C IMIX = .TRUE. INCONSISTANT POLYGON VERTICE ORDERING C = .FALSE. CONSISTANT ORDERING (CLOCKWICE OR COUNTER-CLOCKWISE) C NCNT = # OF VISIBLE NODES C IPOOR = .TRUE. FOR POOR MAN'S HIDDEN SURFACE REMOVAL C = .FALSE. FOR NO POOR MAN'S HIDDEN SURFACE REMOVAL ^^DIMENSION NPL(2,1),X(3,1),IP(4,1),U(3,1),SPEC(1) DIMENSION DC(3,3),DR(3),DT(3),BFRIN(5),GFRIN(5),RFRIN(5) 1,WORDS(3,2),XO(3) C DIMENSION DA(3,NPMAX),DD(3,3,NPMAX),DIF(NPMAX),ICOL(NPMAX) C 1,NFR(NPMAX),NPLS(NPMAX),RORG(3,NPMAX),SPEC1(NJMAX) C 2,XNORM(3,.GT.NJMAX.OR.NPTMAX),XX(3,NPMAX) DIMENSION DA(3,20),DD(3,^^3,20),DIF(20),ICOL(20),NFR(20) 1,NPLS(20),RORG(3,20),SPEC1(250),XNORM(3,250),XX(3,20) COMMON/DEVI/ INPUT,OUTPUT,ERROR COMMON/VARB/ UFRING,DRC(3),FRING(2,20) COMMON/VCOL/ NFRING,CFRIN(3,11) C HIDDEN ROUTINE COMMON STORAGE ^^ COMMON/CLIP3/ XB,YB,ZB,BINT,KB,CB,XE,YE,ZE,EINT,KE,CE,LAS, 1 ISHARE,NTR COMMON/CONLEV/ CONHI,CONLO,NCONLV,CLEVEL(26) COMMON/INTENS/ IPH,IPL,IPB,IFX,IFY COMMON/QFORIO/ CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC ^^ COMMON/ZRANGE/ ZMIN,ZMAX LOGICAL CONTRS,SHOSHR,ISHARE,NTR,LAS,IBAD INTEGER OUTPUT,ERROR LOGICAL DIRC,IFRING,IHLR,IMIX,IPM,IPOOR,ISPEC,JFRING,LINEAR 1,NFILE,UFRING DATA BFRIN/1.,1^^.,0.,0.,0./ DATA GFRIN/0.,1.,1.,1.,0./ DATA RFRIN/0.,0.,0.,1.,1./ DATA IREAD/1/ DATA WORDS/'RED,B','LUE,G','REEN ', 1 'BLACK',' AND ','WHITE'/ ^^ C READ(INPUT,COMMAND STRING FOR PROCESSING 10 IBAD=.FALSE. NTR=.FALSE. 12 IF(ICODE.EQ.0) GO TO 15 IF(ICODE.EQ.63) GO TO 41 ^^ IF(ICODE.EQ.31) GO TO 71 IF(ICODE.EQ.15) GO TO 81 IF(ICODE.EQ.7) GO TO 112 IF(ICODE.EQ.3) GO TO 131 IF(ICODE.EQ.1) GO TO 271 DO 13 I=1,NP DIF(I)^^=0.15 13 ICOL(I)=262143 IPB=0 DO 14 I=1,5 CFRIN(1,I)=GFRIN(I) CFRIN(2,I)=BFRIN(I) 14 CFRIN(3,I)=RFRIN(I) ^^ 15 WRITE(OUTPUT,16) 16 FORMAT(' >> ',$) READ(INPUT,18) CMD 18 FORMAT(A4) C READ NEW DATA ^^ 20 IF(CMD.EQ.'READ') RETURN C RETURN CONTROL TO MONITOR IF(CMD.EQ.'EXIT') CALL EXIT ^^ C ROTATE MODEL ABOUT ORIGIN 30 IF(CMD.NE.'ROTA') GO TO 40 WRITE(OUTPUT,32) 32 FORMAT(' ',$) READ(INPUT,34) X1,X2 ^^ 34 FORMAT(A1,1X,E) I1=0 IF(X1.EQ.'X') I1=1 IF(X1.EQ.'Y') I1=2 IF(X1.EQ.'Z') I1=3 IF(I1.GT.0) GO TO 38 ^^ WRITE(OUTPUT,36) X1 36 FORMAT(' <',A1,' AXIS?>') GO TO 12 38 CALL ROTAT(DC,I1,X2,1) GO TO 12 ^^ C RESTORE MODEL TO ORIGINAL COORDINATE SYSTEM C (KILL ROTATIONS AND TRANSLATIONS) 40 IF(CMD.NE.'REST') GO TO 50 41 ICODE=ICODE-32 DO 44 J=1,3 DO 42 I=1,3 ^^ 42 DC(I,J)=0. XO(J)=0. 44 DC(J,J)=1.0 DO 48 K=1,NP DO 48 J=1,3 DO 46 I=1,3 ^^ 46 DD(I,J,K)=0. RORG(J,K)=0. 48 DD(J,J,K)=1.0 GO TO 12 ^^ 50 IF(CMD.NE.'TRAN') GO TO 60 WRITE(OUTPUT,51) 51 FORMAT(' ',$) READ(INPUT,400) (XO(I),I=1,3) GO TO 12 ^^ C SPECIFIY DISPLACEMENT SCALE FACTOR 60 IF(CMD.NE.'SCAL') GO TO 70 WRITE(OUTPUT,61) 61 FORMAT(' ',$) READ(INPUT,400) SKALE ^^ GO TO 12 C SELECT FLAT OR SMOOTH SHADING 70 IF(CMD.NE.'FLAT'.AND.CMD.NE.'SMOO'.AND.CMD.NE.'UNIF') 1 GO TO 80 ^^ 71 ICODE=ICODE-16 ISMOTH=0 SHOSHR=.TRUE. IF(CMD.EQ.'SMOO') ISMOTH=-1 IF(CMD.EQ.'SMOO') SHOSHR=.FALSE. IF(CMD.EQ.'UNIF') ISMOTH=1 ^^ GO TO 12 C SET SCOPE PARAMETERS 80 IF(CMD.NE.'SCOP'.AND.CMD.NE.'DEVI') GO TO 90 81 WRITE(OUTPUT,82) 82 FORMAT(' ^^',$) READ(INPUT,18) DEV IDVICE=0 IF(DEV.EQ.'COMT') IDVICE=1 IF(DEV.EQ.'TEKT') IDVICE=-1 IF(DEV.EQ.'HPLT') IDVICE=-2 IF(DEV.EQ.'CPLT') IDVICE=-3 ^^ IF(IDVICE.NE.0) GO TO 84 WRITE(OUTPUT,83) 83 FORMAT(' --') GO TO 81 84 IF(CMD.EQ.'DEVI') GO TO 12 ICODE=ICODE-8 ^^ IPL=0 IPH=63 IF(IDVICE.LT.0) GO TO 86 WRITE(OUTPUT,85) 85 FORMAT(' ',$) READ(INPUT,401) ANS IC=2+(ANS^^.EQ.'C') 86 WRITE(OUTPUT,87) 87 FORMAT(' ',$) READ(INPUT,402) IFX,IFY IF(IFX.LT.1.OR.IFX.GT.512) IFX=512 IF(IFY.LT.1.OR.IFY.GT.IFX) IFY=IFX RES=IFX-1 ^^ GO TO 12 C SET DIFUSED LIGHT INTENSITY BY PART 90 IF(CMD.NE.'DIFU') GO TO 100 WRITE(OUTPUT,92) ^^ 92 FORMAT(' ') 94 READ(INPUT,403) I1,I2,X1 IF(I1.EQ.0) GO TO 12 DO 96 I=I1,I2 96 DIF(I)=X1 GO TO 94 ^^ C SPECIFIY DISTANCE TO COORDINATE ORIGIN 100 IF(CMD.NE.'DIST') GO TO 105 WRITE(OUTPUT,102) 102 FORMAT(' ',$) READ(INPUT,400) DOZ ^^ GO TO 12 C SPECIFY FRUSTRUM OF VISION 105 IF(CMD.NE.'FIEL') GO TO 110 WRITE(OUTPUT,108) ^^ 108 FORMAT(' ',$) READ(INPUT,400) FIELD,ZMIN,ZMAX FIELD=FIELD/2.0 TANAL=SIND(FIELD)/COSD(FIELD) GO TO 12 ^^ C SELECT CONTENT OF THIS SCENE AND SPECIFY LOCAL MOTION 110 IF(CMD.NE.'PART') GO TO 120 WRITE(OUTPUT,111) 111 FORMAT(' ',$) READ(INPUT,401) ANS IF(ANS.NE.'Y') ^^GO TO 114 112 ICODE=ICODE-4 DO 113 I=1,NP NPLS(I)=0 113 IF(NPL(1,I).LE.NPL(2,I)) NPLS(I)=1 GO TO 12 114 DO 115 I=1,NP ^^ 115 NPLS(I)=0 WRITE(OUTPUT,116) 116 FORMAT(' ',/) 117 READ(INPUT,402) II1,II2 IF(II1.EQ.0) GO TO 12 DO 118 J=II1,II2 ^^ 118 IF(NPL(1,J).LE.NPL(2,J)) NPLS(J)=1 GO TO 117 C EXPLOSION OF PARTS 120 IF(CMD.NE.'EXPL') GO TO 130 WRITE(^^OUTPUT,121) 121 FORMAT(' ',/) 122 READ(INPUT,403) I1,I2,X1,X2,X3 IF(I1.EQ.0) GO TO 124 DO 123 I=I1,I2 XX(1,I)=X1 XX(2,I)=X2 ^^ 123 XX(3,I)=X3 GO TO 122 124 WRITE(OUTPUT,125) 125 FORMAT(' ',$) READ(INPUT,400) DELTA GO TO 12 ^^ C GIVE SUMMARY OF DATA READ WITH MIN./MAX. VALUES 130 IF(CMD.NE.'SUMM'.AND.CMD.NE.'CENT') GO TO 145 131 ICODE=ICODE-2 DO 132 II=1,NP ^^ IF(NPLS(II).NE.0) GO TO 133 132 CONTINUE GO TO 12 133 I1=NPL(1,II) I2=IP(1,I1) XL=X(1,I2)-XO(1) XS=XL ^^ YL=X(2,I2)-XO(2) YS=YL ZL=X(3,I2)-XO(3) ZS=ZL UL=U(1,I2) US=UL ^^ SL=SPEC(I2) SS=SL DO 135 I=II,NP IF(NPLS(I).EQ.0) GO TO 135 I1=NPL(1,I) I2=NPL(2,I) ^^ DO 135 J=I1,I2 DO 135 K=1,4 K1=IP(K,J) IF(K1.EQ.0) GO TO 135 X1=X(1,K1)-XO(1) Y1=X(2,K1)-XO(2) Z1=X(3,K1)-X^^O(3) IF(XL.LT.X1)XL=X1 IF(XS.GT.X1)XS=X1 IF(YL.LT.Y1)YL=Y1 IF(YS.GT.Y1)YS=Y1 IF(ZL.LT.Z1)ZL=Z1 IF(ZS.GT.Z1)ZS=Z1 ^^ DO 134 K2=1,3 X1=U(K2,K1) IF(UL.LT.X1)UL=X1 134 IF(US.GT.X1)US=X1 X1=SPEC(K1) IF(SL.LT.X1) SL=X1 ^^ IF(SS.GT.X1) SS=X1 135 CONTINUE WRITE(OUTPUT,136) XS,XL,YS,YL,ZS,ZL 136 FORMAT(' <',F9.4,' ') IF(US.NE.0.0.OR.UL.NE.0.0) WRITE(OUTPUT,137) US,UL 137 FOR^^MAT(' <',1PE12.5,' ') IF(ISPEC) WRITE(OUTPUT,138) SS,SL 138 FORMAT(' <',1PE12.5,' ') IF(CMD.EQ.'SUMM') GO TO 12 XO(1)=XO(1)+(XS+XL)/2. XO(2)=XO(2)+(YS+YL)/2. XO(3)=XO(3)+(ZS+ZL)/2. ^^ XL=XL-XS IF(YL-YS.GT.XL) XL=YL-YS IF(ZL-ZS.GT.XL) XL=ZL-ZS DOZ=2.0*XL ZMIN=0.1 ZMAX=4.0*XL ^^ FIELD=45. TANAL=0.41421356 WRITE(OUTPUT,139) (XO(I),I=1,3) 139 FORMAT(' ') WRITE(OUTPUT,141) DOZ,FIELD,ZMIN,ZMAX 141 FORMAT(' ') ^^ GO TO 12 C SPECIFY OUT-OF-PLANE WARPPING SCALE FACTORS 145 IF(CMD.NE.'WARP') GO TO 150 WRITE(OUTPUT,146) 146 FORMAT(' ',$) READ(INPUT,400) FUNX,FUNY,FUNZ GO TO 12 C SELECT FRINGE OPTION AND SPECIFIY FRINGED PARTS 150 IF(CMD.NE.'FRIN') GO TO 160 ^^ WRITE(OUTPUT,151) 151 FORMAT(' <# FRINGES> ',$) READ(INPUT,402) NFRING IFRING=NFRING.GT.0 IF(.NOT.IFRING) GO TO 12 WRITE(OUTPUT,152) ^^ 152 FORMAT(' ',$) READ(INPUT,410) ANS UFRING=ANS.EQ.'Y' IF(.NOT.UFRING) GO TO 154 WRITE(OUTPUT,153) 153 FORMAT(' ',$) READ(INPU^^T,400) (DRC(I),I=1,3) X1=SQRT(DRC(1)*DRC(1)+DRC(2)*DRC(2)+DRC(3)*DRC(3)) DRC(1)=DRC(1)/X1 DRC(2)=DRC(2)/X1 DRC(3)=DRC(3)/X1 154 X3=NFRING-1 WRITE(OUTPUT,155) ^^ 155 FORMAT(' ') 156 READ(INPUT,403) I1,I2,X1,X2 IF(I1.LE.0) GO TO 158 DO 157 I=I1,I2 FRING(1,I)=X3/(X2-X1) 157 FRING(2,I)=X1*FRING(1,I) ^^ GO TO 156 158 WRITE(OUTPUT,159) 159 FORMAT(' ') 1501 READ(INPUT,402) I1,I2,I3 IF(I1.LE.0) GO TO 12 DO 1502 I=I1,I2 1502 ^^NFR(I)=I3 GO TO 1501 C SPECIFY COLORS FOR VARIOUS PARTS 160 IF(CMD.NE.'COLO') GO TO 180 WRITE(OUTPUT,162) (WORDS^^(I,IC),I=1,3) 162 FORMAT(' ',$) READ(INPUT,400) PB1,PB2,PB3 IC1=PB3*63.0 IC2=PB2*63.0 IC3=PB1*63.0 IF(IC.EQ.1) GO TO 163 ^^ IC2=IC1 IC3=IC1 163 IPB=IC1*2**12+IC2*2**6+IC3 WRITE(OUTPUT,164) (WORDS(I,IC),I=1,3) 164 FORMAT(' ') 166 READ(INPUT,403) I1,I2,X1,X2,X3 ^^ IF(I1.EQ.0) GO TO 169 IC1=X3*63.0 IC2=X2*63.0 IC3=X1*63.0 IF(IC.EQ.1) GO TO 167 IC2=IC1 IC3=IC1 ^^ 167 ICC=IC1*2**12+IC2*2**6+IC3 DO 168 K=I1,I2 168 ICOL(K)=ICC GO TO 166 169 WRITE(OUTPUT,170) 170 FORMAT(' ',$)^^ READ(INPUT,401) ANS IF(ANS.NE.'Y') GO TO 175 WRITE(OUTPUT,171) 171 FORMAT(' ',$) READ(INPUT,401) ANS IF(ANS.NE.'Y') GO TO 173 ^^ CFRIN(1,6)=1. CFRIN(2,6)=1. CFRIN(3,6)=1. DO 172 I=1,5 I1=6-I I2=6+I CFRIN(^^1,I1)=GFRIN(I) CFRIN(1,I2)=GFRIN(I) CFRIN(2,I1)=BFRIN(I) CFRIN(2,I2)=BFRIN(I) CFRIN(3,I1)=RFRIN(I) 172 CFRIN(3,I2)=RFRIN(I) GO TO 12 ^^ 173 DO 174 I=1,5 CFRIN(1,I)=GFRIN(I) CFRIN(2,I)=BFRIN(I) 174 CFRIN(3,I)=RFRIN(I) GO TO 12 175 WRITE(OUTPUT,176) (WORDS(I,IC),I=1,3) ^^ 176 FORMAT(' ') 177 READ(INPUT,404) I1,X1,X2,X3 IF(I1.EQ.0) GO TO 12 IF(IC.EQ.1) GO TO 178 X2=X1 X3=X1 1^^78 CFRIN(1,I1)=X3 CFRIN(2,I1)=X2 CFRIN(3,I1)=X1 GO TO 177 C MOVIE OPTION--SELECT INCREMENTAL TRANSLATION,ROTATION,ETC. ^^ 180 IF(CMD.NE.'MOVI') GO TO 200 WRITE(OUTPUT,181) 181 FORMAT(' <# OF FRAMES> ',$) READ(INPUT,402) NFRAME IF(NFRAME.EQ.0) GO TO 12 DO 182 J=1,NP ^^ DO 182 I=1,3 182 DA(I,J)=0.0 IFR1=1 IFR2=NFRAME WRITE(OUTPUT,183) 183 FORMAT(' ',$) ^^ READ(INPUT,402) I1,I2 IF(I1.LE.0) GO TO 184 IFR1=I1 IFR2=I2 IF(IFR2.GT.IFR1) IFR2=IFR1 184 WRITE(OUTPUT,185) 185 FORMAT(' ',$) READ(INPUT,401) ANS LINEAR=ANS.EQ.'Y' CPF=0.0 IF(LINEAR) GO TO 188 IF(SKALE.EQ.0.0) GO TO 188 WRITE(OUTPUT,187) ^^ 187 FORMAT(' ',$) READ(INPUT,400) CPF 188 WRITE(OUTPUT,189) 189 FORMAT(' ') WRITE(OUTPUT,190) 190 FORMAT(' ',$) ^^ READ(INPUT,400) DT(1),DT(2),DT(3) WRITE(OUTPUT,191) 191 FORMAT(' ',$) READ(INPUT,400) DR(1),DR(2),DR(3) WRITE(OUTPUT,192) 192 FORMAT(' ') 193 REA^^D(INPUT,403) I1,I2,X1,X2,X3 IF(I1.EQ.0) GO TO 195 DO 194 I=I1,I2 DA(1,I)=X1 DA(2,I)=X2 194 DA(3,I)=X3 GO TO 193 ^^ 195 WRITE(OUTPUT,196) 196 FORMAT(' ',$) READ(INPUT,400) DDOZ WRITE(OUTPUT,197) 197 FORMAT(' ',$) READ(INPUT,400) SFDEL ^^ XFRAME=NFRAME SFDEL=SFDEL/XFRAME WRITE(OUTPUT,198) 198 FORMAT(' ',$) READ(INPUT,400) DDELTA WRITE(OUTPUT,199) ^^ 199 FORMAT(' ',$) READ(INPUT,401) ANS IPM=ANS.EQ.'Y' GO TO 12 C CALCULATE NOMALS, LIGHT INTENSITY, ETC, AND DISPLAY SCENE ^^ 200 IF(CMD.NE.'VIEW'.AND.CMD.NE.'DRAW') GO TO 270 IHLR=CMD.EQ.'VIEW' IF(IDVICE.GT.0) IHLR=.TRUE. ISHARE=IDVICE.LT.0 SLINR=0.0 XMAGN=SKALE ^^ AMPZ=1.0 XFRAME=NFRAME DO 265 IIMOVE=1,NFRAME IF(NFRAME.EQ.0) GO TO 203 C INCREMENT DISPLACEMENTS, ROTATIONS, TRANSLATIONS, ETC. FOR MOVIE ^^ XIMOVE=IIMOVE XMAGN=XMAGN+SFDEL SKALE=XMAGN IF(LINEAR) SLINR=XIMOVE/XFRAME IF(LINEAR) SKALE=XMAGN*SLINR IF(CPF.EQ^^.0.0) GO TO 201 ANG=360.0*CPF*XIMOVE SKALE=XMAGN*SIND(ANG) 201 AMP=180.0*XIMOVE/XFRAME AMP=COSD(AMP) DAMP=0.5*(AMPZ-AMP) AMPZ=AMP ^^ DOZ=DOZ+DDOZ*DAMP DELTA=DELTA+DDELTA*DAMP DO 202 I=1,3 ISAFE=I XO(I)=XO(I)+DT(I)*DAMP DDD=DR(I)*DAMP ^^ IF(DDD.NE.0.0) CALL ROTAT(DC,ISAFE,DDD,1) DO 202 J=1,NP JSAFE=J DDD=DA(I,J)*DAMP 202 IF(DDD.NE.0.0) CALL ROTAT(DD,ISAFE,DDD,JSAFE) IF(.NOT.IPM) GO TO 265 ^^IF(IIMOVE.LT.IFR1.OR.IIMOVE.GT.IFR2) GO TO 265 C PROCESS PARTS INDIVIDUALY 203 CALL BGNFRM IF(IHLR) CALL INTHID IF(IBAD) GO TO 266 ^^ DO 240 I=1,NP ISAFE=I IF(NPLS(I).EQ.0) GO TO 240 I1=NPL(1,I) I2=NPL(2,I) ^^ C SET JFRING FOR FRINGES AND INCREMENT GLOBAL TRANSLATION JFRING=IFRING.AND.(NFR(I).EQ.1) XX1=XO(1)-DELTA*XX(1,I) XX2=XO(2)-DELTA*XX(2,I) XX3=XO(3)-DELTA*XX(3,I) ^^ IF(ISMOTH.GE.0.OR.IDVICE.LT.0) GO TO 220 C IF SMOOTH SHADING FIRST ZERO AND THEN CALCULATE AVERAGE NORMALS DO 204 K=1,NJ DO 204 J=1,3 204 XNORM(J,K)=0.0 ^^ DO 210 J=I1,I2 K4=3 IF(IP(4,J).GT.0) K4=4 DO 210 K=1,K4 K1=IP(K,J) ^^ IF((K+1)-K4) 205,206,207 205 K2=IP(K+1,J) K3=IP(K+2,J) GO TO 208 206 K2=IP(K4,J) K3=IP(1,J) ^^ GO TO 208 207 K2=IP(1,J) K3=IP(2,J) 208 X4=SPEC(K3)-SPEC(K2)+SLINR*(SPEC1(K3)-SPEC1(K2)) X5=SPEC(K1)-SPEC(K2)+SLINR*(SPEC1(K1)-SPEC1(K2)) X1=X(1,K3)-X(1,K2)+SKALE*(U(1,K3)-U(1,K2))+FUNX*X4 Y1=X(2^^,K3)-X(2,K2)+SKALE*(U(2,K3)-U(2,K2))+FUNY*X4 Z1=X(3,K3)-X(3,K2)+SKALE*(U(3,K3)-U(3,K2))+FUNZ*X4 X2=X(1,K1)-X(1,K2)+SKALE*(U(1,K1)-U(1,K2))+FUNX*X5 Y2=X(2,K1)-X(2,K2)+SKALE*(U(2,K1)-U(2,K2))+FUNY*X5 Z2=X(3,K1)-X(3,K2)+SKALE*(U(3,K1)-U(3,K2))+FUNZ*X5 CALL MULTDD(X1,Y1,Z1,DD,RORG,ISAFE) CALL MULTDC(X1,Y1,Z1,DC) ^^ CALL MULTDD(X2,Y2,Z2,DD,RORG,ISAFE) CALL MULTDC(X2,Y2,Z2,DC) U1=Y1*Z2-Y2*Z1 U2=X2*Z1-X1*Z2 U3=X1*Y2-X2*Y1 U4=SQRT(U1*U1+U2*U2+U3*U3) ^^ IF(.NOT.IMIX) GO TO 209 X1=U1*XNORM(1,K2)+U2*XNORM(2,K2)+U3*XNORM(3,K2) IF(X1.LT.0.0) U4=-U4 209 XNORM(1,K2)=XNORM(1,K2)+U1/U4 XNORM(2,K2)=XNORM(2,K2)+U2/U4 XNORM(3,K2)=XNORM(3,K2)+U3/U4 2^^10 CONTINUE C NORMALIZE AVERAGE NORMALS DO 215 J=1,NJ X1=XNORM(1,J)*XNORM(1,J)+XNORM(2,J)*XNORM(2,J)+ 1 XNORM(3,J)*XNORM(3^^,J) IF(X1.LE.0.0) GO TO 215 X1=SQRT(X1) XNORM(1,J)=XNORM(1,J)/X1 XNORM(2,J)=XNORM(2,J)/X1 XNORM(3,J)=-XNORM(3,J)/X1 215 CONTINUE ^^ C CALCULATE DISPLACED COORDINATES 220 DO 230 J=I1,I2 K1=IP(1,J) K2=IP(2,J) ^^ K3=IP(3,J) K4=IP(4,J) IS1=K1 IS2=K2 IS3=K3 IS4=K4 C1=SPEC(K1)+^^SLINR*SPEC1(K1) U1=X(1,K1)+FUNX*C1+SKALE*U(1,K1)-XX1 V1=X(2,K1)+FUNY*C1+SKALE*U(2,K1)-XX2 W1=X(3,K1)+FUNZ*C1+SKALE*U(3,K1)-XX3 CALL MULTDD(U1,V1,W1,DD,RORG,ISAFE) CALL MULTDC(U1,V1,W1,DC) W1=DOZ-W1 ^^ C2=SPEC(K2)+SLINR*SPEC1(K2) U2=X(1,K2)+FUNX*C2+SKALE*U(1,K2)-XX1 V2=X(2,K2)+FUNY*C2+SKALE*U(2,K2)-XX2 W2=X(3,K2)+FUNZ*C2+SKALE*U(3,K2)-XX3 CALL MULTDD(U2,V2,W2,DD,RORG,ISAFE) CALL MULTDC(U2,V2,W2,DC) ^^ W2=DOZ-W2 C3=SPEC(K3)+SLINR*SPEC1(K3) U3=X(1,K3)+FUNX*C3+SKALE*U(1,K3)-XX1 V3=X(2,K3)+FUNY*C3+SKALE*U(2,K3)-XX2 W3=X(3,K3)+FUNZ*C3+SKALE*U(3,K3)-XX3 CALL MULTDD(U3,V3,W3,DD,RORG,ISAFE) CAL^^L MULTDC(U3,V3,W3,DC) W3=DOZ-W3 IF(K4.NE.0) GO TO 221 U4=0.5*(U1+U3) V4=0.5*(V1+V3) W4=0.5*(W1+W3) GO TO 222 ^^ 221 C4=SPEC(K4)+SLINR*SPEC1(K4) U4=X(1,K4)+FUNX*C4+SKALE*U(1,K4)-XX1 V4=X(2,K4)+FUNY*C4+SKALE*U(2,K4)-XX2 W4=X(3,K4)+FUNZ*C4+SKALE*U(3,K4)-XX3 CALL MULTDD(U4,V4,W4,DD,RORG,ISAFE) CALL MULTDC(U4,V4,W4,DC) ^^ W4=DOZ-W4 C CALCULATE NUMBER OF VISIBLE NODES 222 NCNT=IVSBLE(U1,V1,W1,U2,V2,W2,U3,V3,W3,U4,V4,W4,DIRC) IF(IPOOR.AND.NCNT.EQ.0) GO TO 230 ^^ C DRAW SIMPLE LINE DRAWING NOW IF(IHLR) GO TO 224 CALL DRAW(U1,V1,W1,U2,V2,W2,RES,TANAL) CALL DRAW(U2,V2,W2,U3,V3,W3,RES,TANAL) IF(K4.EQ.0) GO TO ^^223 CALL DRAW(U3,V3,W3,U4,V4,W4,RES,TANAL) CALL DRAW(U4,V4,W4,U1,V1,W1,RES,TANAL) GO TO 230 223 CALL DRAW(U3,V3,W3,U1,V1,W1,RES,TANAL) GO TO 230 ^^ C CALCULATE NORMALS FOR FLAT SHADING 224 IF(ISMOTH.LT.0) GO TO 225 CX=(V3-V1)*(W2-W4)-(V4-V2)*(W1-W3) CY=(U4-U2)*(W1-W3)-(U3-U1)*(W2-W4) CZ=(U4-U2)*(V3-V1)-(U3-U1)*(V4-V2) ^^ CD=SQRT(CX*CX+CY*CY+CZ*CZ) XNORM(1,K1)=CX/CD XNORM(2,K1)=CY/CD XNORM(3,K1)=CZ/CD K2=K1 K3=K1 K4=K1 ^^ C CALCULATE NODAL LIGHT INTENSITY C THEN CHECK FOR WATKIN'S WARPED POLYGON 225 AI1=AINTEN(U1,V1,W1,XNORM(1,K1),DIF(I)) AI2=AINTEN(U2,V2,W2,XNORM(1,K2),D^^IF(I)) AI3=AINTEN(U3,V3,W3,XNORM(1,K3),DIF(I)) IF(IS4.NE.0) AI4=AINTEN(U4,V4,W4,XNORM(1,K4),DIF(I)) IF(ISMOTH.LE.0) GO TO 2201 AI1=(AI1+AI2+AI3+AI4)/4.0 IF(IS4.EQ.0) AI1=(AI1+AI2+AI3)/3.0 AI2=AI1 ^^ AI3=AI1 AI4=AI1 2201 IF(IS4.EQ.0) GO TO 226 IF(NCNT.EQ.0.OR.NCNT.EQ.4) GO TO 226 CALL POLMAK IF(IBAD) GO TO 266 ^^LAS=.FALSE. XB=U3 YB=V3 ZB=W3*TANAL IF(CONTRS) CB=C3 KB=ICOL(I) IF(JFRING) KB=ISHADE(U(1^^,IS3),C3,ISAFE) BINT=AI3 ZSTR=ZB KSTR=KB XE=U4 YE=V4 ZB=W4*TANAL ^^ IF(CONTRS) CE=C4 KE=ICOL(I) IF(JFRING) KE=ISHADE(U(1,IS4),C4,ISAFE) EINT=AI4 CALL EDGMAK IF(IBAD) GO TO 266 ^^ XB=XE YB=YE ZB=ZE IF(CONTRS) CB=CE KB=KE BINT=EINT XE=U1 ^^ YE=V1 ZE=W1*TANAL IF(CONTRS) CE=C1 KE=ICOL(I) IF(JFRING) KE=ISHADE(U(1,IS1),C1,ISAFE) EINT=AI1 ^^ CALL EDGMAK IF(IBAD) GO TO 266 XB=XE YB=YE ZB=ZE IF(CONTRS) CB=CE ^^ KB=KE BINT=EINT XE=U3 YE=V3 ZE=ZSTR IF(CONTRS) CE=C3 KB=KST^^R EINT=AI3 LAS=.TRUE. CALL EDGMAK IF(IBAD) GO TO 266 226 CALL POLMAK IF(IBAD) GO TO 266 ^^ LAS=.FALSE. XB=U1 YB=V1 ZB=W1*TANAL IF(CONTRS) CB=C1 KB=ICOL(I) ^^ IF(JFRING) KB=ISHADE(U(1,IS1),C1,ISAFE) BINT=AI1 ZSTR=ZB KSTR=KB XE=U2 YE=V2 ^^ ZE=W2*TANAL IF(CONTRS) CE=C2 KE=ICOL(I) IF(JFRING) KE=ISHADE(U(1,IS2),C2,ISAFE) EINT=AI2 CALL EDGMAK IF(IBAD) GO TO 266 ^^ XB=XE YB=YE ZB=ZE IF(CONTRS) CB=CE KB=KE BINT=EINT ^^ XE=U3 YE=V3 ZE=W3*TANAL IF(CONTRS) CE=C3 KE=ICOL(I) IF(JFRING) KE=ISHADE(U(1,IS3),C3,ISAFE) ^^ EINT=AI3 CALL EDGMAK IF(IBAD) GO TO 266 IF(IS4.EQ.0) GO TO 229 IF(NCNT.GT.0.AND.NCNT.LT.4) GO TO 229 XB=XE YB=YE ^^ ZB=ZE IF(CONTRS) CB=CE KB=KE BINT=EINT XE=U4 YE=V4 ^^ ZE=W4*TANAL IF(CONTRS) CE=C4 KE=ICOL(I) IF(JFRING) KE=ISHADE(U(1,IS4),C4,ISAFE) EINT=AI4 CALL EDGMAK ^^ IF(IBAD) GO TO 266 229 XB=XE YB=YE ZB=ZE IF(CONTRS) CB=CE KB=KE BIN^^T=EINT XE=U1 YE=V1 ZE=ZSTR IF(CONTRS) CE=C1 KE=KSTR EINT=AI1 ^^ LAS=.TRUE. CALL EDGMAK IF(IBAD) GO TO 266 230 CONTINUE 240 CONTINUE IF(IHLR) CALL HIDDEN ^^ IF(IBAD) GO TO 266 CALL ENDFRM IF(IIMOVE.GT.1) GO TO 260 IF(IDVICE.GT.0) GO TO 250 IF(IDVICE.EQ.-1) WRITE(OUTPUT,242) 242 FORMAT(' ') ^^ IF(IDVICE.EQ.-2) WRITE(OUTPUT,244) 244 FORMAT(' ') IF(IDVICE.EQ.-3) WRITE(OUTPUT,246) 246 FORMAT(' ') GO TO 255 250 IF(IC.EQ.1) WRITE(OUTPUT,252) 252 FORMAT(' ') IF(IC.EQ.2) WRITE(OUTPUT,254) 254 FORMAT(' ') 255 IF(IFRING.AND.IHLR) WRITE(OUTPUT,256) 256 FORMAT(' ') IF(CONTRS.AND.IHLR) WRITE(OUTPUT,258) 258 FORMAT(' ') ^^ IF(NFRAME.LT.1) GO TO 265 260 IF(IDVICE.NE.-1) GO TO 263 WRITE(OUTPUT,261) IIMOVE,NFRAME,SKALE 261 FORMAT(' <',I3,'/',I3,F8.3,'>',$) READ(INPUT,401) ANS GO TO 265 ^^ 263 WRITE(OUTPUT,264) IIMOVE,NFRAME,SKALE 264 FORMAT(' <',I3,'/',I3,F8.3,'>') 265 CONTINUE NFRAME=0 SKALE=XMAGN LINEAR=.FALSE. GO TO 12 ^^ 266 CALL ENDFRM WRITE(OUTPUT,268) 268 FORMAT(' ') NFRAME=0 SKALE=XMAGN LINEAR=.FALSE. ^^ GO TO 10 C SET DATA OPTIONS AND POOR MAN'S HIDDEN SURFACE REMOVAL 270 IF(CMD.NE.'FAST') GO TO 290 271 ICODE=ICODE-1 ^^ IPOOR=.FALSE. WRITE(OUTPUT,272) 272 FORMAT(' ',$) READ(INPUT,401) ANS IMIX=ANS.EQ.'Y' IF(IMIX) GO TO 12 ^^WRITE(OUTPUT,274) 274 FORMAT(' ',$) READ(INPUT,401) ANS IPOOR=ANS.EQ.'Y' IF(.NOT.IPOOR) GO TO 12 WRITE(OUTPUT,276) 276 FORMAT(' ',^^$) READ(INPUT,401) ANS DIRC=ANS.EQ.'Y' GO TO 12 C SET LOCAL ROTATION ABOUT RELATIVE ORIGIN ^^ 290 IF(CMD.NE.'PIVO') GO TO 310 WRITE(OUTPUT,291) 291 FORMAT(' ') 292 READ(INPUT,293) I1,I2,X1,X2 293 FORMAT(2I,1X,A1,E) IF(I1.EQ.0) GO TO 296 ^^ IF(X1.EQ.'X') I3=1 IF(X1.EQ.'Y') I3=2 IF(X1.EQ.'Z') I3=3 DO 295 I=I1,I2 ISAFE=I 295 CALL ROTAT(DD,I3,X2,ISAFE) GO TO 292 ^^ 296 WRITE(OUTPUT,297) 297 FORMAT(' ') 298 READ(INPUT,403) I1,I2,X1,X2,X3 IF(I1.EQ.0) GO TO 12 DO 299 I=I1,I2 RORG(1,I)=X1 ^^ RORG(2,I)=X2 299 RORG(3,I)=X3 GO TO 298 C COMMANDS ^^ 310 IF(CMD.NE.'HELP') GO TO 320 311 WRITE(OUTPUT,312) 312 FORMAT(' '/' '/' ',/) GO TO ^^12 314 WRITE(OUTPUT,316) CMD 316 FORMAT(' <',A4,'? HELP?> ',$) READ(INPUT,401) ANS IF(ANS.EQ.'Y') GO TO 311 GO TO 12 ^^ C ADD PREVIOUS DISPLACEMENTS AND SCALAR FUNCTIONS TO ARRAYS, C READ NEW ARRAYS, AND DIFFERENCE FOR TRANSIENT DATA 320 IF(CMD.NE.'LINE') GO TO 360 WRITE(OUTPUT,322) 322 FORMAT(' ',$) ^^ READ(INPUT,401) ANS IF(ANS.NE.'Y') GO TO 326 DO 324 J=1,NJ DO 323 I=1,3 X(I,J)=X(I,J)+SKALE*U(I,J) 323 U(I,J)=0. ^^ SPEC(J)=SPEC(J)+SPEC1(J) 324 SPEC1(J)=0. 326 CALL OPEN('DISP1',IUNIT,IREAD,IERROR) IF(IERROR) 326,330,328 328 READ(IUNIT,410) ((U(I,J),I=1,3),J=1,NJ) 330 CALL OPEN('DISP2',IUNIT,IREAD,IERROR) IF(IERROR) 330,340,33^^2 332 READ(IUNIT,410) ((XNORM(I,J),I=1,3),J=1,NJ) 340 CALL OPEN('SPEC.',IUNIT,IREAD,IERROR) IF(IERROR) 340,344,342 342 READ(IUNIT,410) (SPEC1(J),J=1,NJ) 344 CALL OPEN('SPEC1',IUNIT,IREAD,IERROR) IF(IERROR) 344,350,346 ^^ 346 READ(IUNIT,410) (SPEC(J),J=1,NJ) 350 DO 354 J=1,NJ DO 352 I=1,3 352 U(I,J)=XNORM(I,J)-U(I,J) 354 SPEC1(J)=SPEC(J)-SPEC1(J) GO TO 12 ^^ C SELECT CONTOUR OPTION AND SET CONTOUR LEVELS 360 IF(CMD.NE.'CONT') GO TO 314 WRITE(OUTPUT,361) 361 FORMAT(' <# OF CONTOURS, LABEL SPACING> ',$) READ(INPUT,4^^03) NCONLV,LBLSPC CONTRS=NCONLV.GT.0 IF(.NOT.CONTRS) GO TO 12 IF(NCONLV.GT.26) NCONLV=26 WRITE(OUTPUT,363) 363 FORMAT(' ',$) READ(INPUT,400) CONLO,CONHI ^^ DELCON=(CONHI-CONLO)/(NCONLV-1) CLEVEL(1)=CONLO DO 365 I=2,NCONLV 365 CLEVEL(I)=CLEVEL(I-1)+DELCON GO TO 12 ^^ 400 FORMAT(3E) 401 FORMAT(A1) 402 FORMAT(16I) 403 FORMAT(2I,3E) 404 FORMAT(I,3E) 410 FORMAT(6E) END^^ SUBROUTINE MULTDD(X,Y,Z,DD,T,K) C SUBROUTINE MULTDD - MULTIPLYS COORDINATES BY LOCAL ROTATION C TRANSFORMATION MATRIX. C VARIABLES USED ^^ C X, Y, Z = CARTESIAN COORDINATES OF POINT C DD = TRANSFORMATION MATRIX C T = RELATIVE ORIGIN BY PART C I = PART NUMBER DIMENSION DD(3,3,1),T(3,1) ^^ X1=X-T(1,K) X2=Y-T(2,K) X3=Z-T(3,K) X=DD(1,1,K)*X1+DD(2,1,K)*X2+DD(3,1,K)*X3+T(1,K) Y=DD(1,2,K)*X1+DD(2,2,K)*X2+DD(3,2,K)*X3+T(2,K) ^^ Z=DD(1,3,K)*X1+DD(2,3,K)*X2+DD(3,3,K)*X3+T(3,K) RETURN END FUNCTION AINTEN(U,V,W,XNORM,DIF) C FUNCTION AINTEN - CAL^^CULATES LIGHT INTENSITY AT A NODE. C LIGHT INTENSITY IS COMPUTED AS THE SEQUARE OF THE ANGLE C BETWEEN THE OBSERVER AND THE NORMAL DIRECTION AT A NODE. C VARIABLES USED C U, V, W, = CARTESIAN COORDINATES OF POINT C XNORM = NORMAL COMPONENTS AT NODE ^^ C DIF = DIFUSED LIGHT DIMENSION XNORM(3) AI=U*XNORM(1)+V*XNORM(2)+W*XNORM(3) AI=AI*AI/(U*U+V*V+W*W) ^^ AINTEN=(DIF+(1.0-DIF)*AI) RETURN END FUNCTION IVSBLE(U1,V1,W1,U2,V2,W2,U3,V3,W3,U4,V4,W4,DIRC) C FUNCTION IVS^^BLE - COMPUTES NUMBER OF VISIBLE NODES. C A NODE IS VISIBLE IF THE COSINE OF THE ANGLE BETWEEN C THE OBSERVER AND THE NORMAL AT THE NODE IS POSITIVE. C VARIABLES USED C IVSBLE = NUMBER OF VISIBLE NODES C U1, V1, W1, ETC. = CARTESTIAN COO^^RDINATES OF NODES C DIRC = -1 FOR CLOCKWISE ORIENTATION OF NODES C = 0 FOR COUNTER-CLOCKWISE ORIENTATION OF NODES IVSBLE=0 X1=U1/W1 Y1=V1/W1 ^^ X2=U2/W2 Y2=V2/W2 X3=U3/W3 Y3=V3/W3 X4=U4/W4 Y4=V4/W4 ^^XT=X1 YT=Y1 X5=X2-X4 X1=X1-X2 X2=X2-X3 X3=X3-X4 X4=X4-XT ^^ Y5=Y2-Y4 Y1=Y1-Y2 Y2=Y2-Y3 Y3=Y3-Y4 Y4=Y4-YT A1=X1*Y2-X2*Y1 ^^ A2=X2*Y3-X3*Y2 A3=X5*Y4-X4*Y5 A4=X4*Y1-X1*Y4 IF(A1.GE.0.0) IVSBLE=IVSBLE+1 IF(A2.GE.0.0) IVSBLE=IVSBLE+1 IF(A3.GE.0.0) IVSBLE=IVSBLE+1 ^^ IF(A4.GE.0.0) IVSBLE=IVSBLE+1 IF(DIRC) IVSBLE=4-IVSBLE RETURN END SUBROUTINE MULTDC(U1,V1,W1,DC) ^^ C SUBROUTINE MULTDC - MULTYPLS COORDINATES BY GLOBAL ROTATION C TRANSFORMATION MATRIX. C VARIABLES USED C U1, V1, W1 = CARTESTIAN COORDINATES OF POINT C DC = GLOBAL TRANSFORMATION MATRIX ^^ DIMENSION DC(3,3) X1=U1 X2=V1 U1=DC(1,1)*X1+DC(2,1)*X2+DC(3,1)*W1 ^^ V1=DC(1,2)*X1+DC(2,2)*X2+DC(3,2)*W1 W1=DC(1,3)*X1+DC(2,3)*X2+DC(3,3)*W1 RETURN END FUNCTION ISHADE(U,S,J) C FUNCTION ^^SHADE - COMPUTES COLOR INTENSITY AT NODES FOR FRINGES C VARIABLES USED C SHADE = FRINGE LIGHT INTENSITY C K = NODE NUMBER C S = SCALAR FUNCTION ARRAY C F = FRINGE COLOR INTENSITY ARR^^AY BY FRINGE NUMBER C IMODE = 1 FOR RED, 2 FOR BLUE, 3 FOR GREEN C NFRING = # OF FRINGES C FRING3 = FRINGE NORALIZATION FACTOR C FRING4 = LOWEST NORMALIZED FRINGE VALUE DIMENSION U(3) ^^ COMMON/VARB/ UFRING,DR(3),FRING(2,1) COMMON/VCOL/ NFRING,F(3,1) LOGICAL UFRING X=S IF(UFRING) X=U(1)*DR(1)+U(2)*DR(2)+U(3)*DR(3) ^^ X=FRING(1,J)*X-FRING(2,J) IF(X.LT.0.0) GO TO 3 N=NFRING-1 DO 2 I=1,N IF(X.GT.1.0) GO TO 2 X1=1.0-X I1=I+1 ^^ IC1=(F(1,I1)*X+F(1,I)*X1)*63.0 IC2=(F(2,I1)*X+F(2,I)*X1)*63.0 IC3=(F(3,I1)*X+F(3,I)*X1)*63.0 GO TO 4 2 X=X-1.0 IC1=F(1,NFRING)*63.0 ^^ IC2=F(2,NFRING)*63.0 IC3=F(3,NFRING)*63.0 GO TO 4 3 IC1=F(1,1)*63.0 IC2=F(2,1)*63.0 IC3=F(3,1)*63.0 ^^ 4 ISHADE=IC1*2**12+IC2*2**6+IC3 RETURN END SUBROUTINE DRAW(X1,Y1,Z1,X2,Y2,Z2,RES,PER) R=0.5*RES D=R/(Z1*PER)^^ U1=R+X1*D V1=R+Y1*D D=R/(Z2*PER) U2=R+X2*D V2=R+Y2*D ^^ C CLIP LEFT EDGE IF(U1.GE.0..AND.U2.GE.0.) GO TO 10 IF(U1.LT.0..AND.U2.LT.0.) RETURN IF(U1.GT.0.) GO TO 1 V1=(V1-V2)*U1/(U2-U1)+V1 ^^ U1=0. GO TO 10 1 V2=(V2-V1)*U2/(U1-U2)+V2 U2=0. C CLIP RIGHT EDGE ^^ 10 IF(U1.LE.RES.AND.U2.LE.RES) GO TO 20 IF(U1.GT.RES.AND.U2.GT.RES) RETURN IF(U1.GT.RES) GO TO 11 V2=(V2-V1)*(RES-U1)/(U2-U1)+V1 U2=RES GO TO 20 ^^ 11 V1=(V1-V2)*(RES-U2)/(U1-U2)+V2 U1=RES C CLIP BOTTOM EDGE 20 IF(V1.GE.0..AND.V2.GE.0.) GO TO 30 ^^ IF(V1.LT.0..AND.V2.LT.0.) RETURN IF(V1.GT.0.) GO TO 21 U1=(U1-U2)*V1/(V2-V1)+U1 V1=0. GO TO 30 21 U2=(U2-U1)*V2/(V1-V2)+U2 ^^ V2=0. C CLIP TOP EDGE 30 IF(V1.LE.RES.AND.V2.LE.RES) GO TO 40 IF(V1.GT.RES.AND.V2.GT.RES) RETURN IF(V1.GT.RES) GO T^^O 31 U2=(U2-U1)*(RES-V1)/(V2-V1)+U1 V2=RES GO TO 40 31 U1=(U1-U2)*(RES-V2)/(V1-V2)+U2 V1=RES ^^ 40 CALL PLTLIN(U1,V1,U2,V2) RETURN END SUBROUTINE INTHID C INTHID INITIALIZES THE HIDDEN PROCESS ^^ C AND ALLOCATES THE AMOUNT OF DATA STORAGE C THE VALUE OF MAXFRE MUST EQUAL THE SIZE OF IFREE C THE VALUE OF MAXRES MUST EQUAL THE SIZE OF IB C THE VALUE OF MAXINT IS THE MAXIMUM INTENSITY COMMON/MAXMUM/MAXFRE,MAXRES,MAXINT COMMON/CO^^RE/IFREST,LEN,IFREPT COMMON/BUCKY/IB(512) COMMON/FREE/IFREE(4000) MAXFRE=4000 MAXRES=512 MAXINT=63 ^^ C INITIALIZE FREE STORAGE LEN = MAXFRE IFREST=1 C INITIALIZE THE POLYGON CLIPPER ^^ CALL INTCLP RETURN END C**********************************************************************C C C C ^^ HIDDEN.FOR VERSION 1.0(A) SEPTEMBER 1976 C C C C THIS FILE CONTAINS THE HIDDEN LINE AND HIDDEN SURFACE C C PROCESSOR USING WATKIN'S ALGORITHM. MIKE ARCHULETA C C CODED THE ALGORITHM WHILE A STUDENT AT THE UNIVERSITY OF C C OF UTAH AND LATER REFINED IT AT LAWRENCE LIVERMORE LAB. C C ^^ C C MIKE STEPHENSON HANK CHRISTIANSEN C C DEPARTMENT OF CIVIL ENGR. CIVIL ENGINEERING DEPT. C C AND ENGINEERING MECHANICS 368E ESTB C C THE UNIVERSITY OF ARIZONA BRIGHAM YOUNG UNIVERSITY C C TUCSON, ARIZONA 85721 PROVO, UTAH 84602 C C (602) 884-4803 (801) 374-1211^^ X2811 C C C C**********************************************************************C SUBROUTINE GETVAR(INDEX,LENGTH) C GET A BLOCK FROM FREE STORAGE OF SIZE LENGTH AT LOCATION INDEX COMMON/CORE/IFREST,LEN,IFREPT C COMMON/FREE/IFREE(1) ^^ COMMON/QFORIO/CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC LOGICAL IBAD IBAD=.FALSE. INDEX=IFREST C UP THE NEXT AVAILABLE LOCATION IN FREE. IFREST=IFREST+LENGTH C GO HOME IF THERE IS^^ STILL ROOM LEFT. IF(IFREST.LT.LEN)RETURN CALL ERRMSG(6,0) RETURN END SUBROUTINE LSTSET(N) C SET THE SIZE OF THE BLOCK TO BE HANDLED BY ^^GETBLK AND RETBLK COMMON/CORE/IFREST,LEN,IFREPT COMMON/FREE/IFREE(1) IFREPT=0 K=LEN-N+1 C RETURN IF NO ROOM LEFT FOR SEGMENT BLOCKS IF(K.LT.IFREST)RETURN ^^ IFREPT=IFREST C SET POINTERS THROUGH THE REMAINDER OF THE FREE LIST C LINKING THE SEGMENT BLOCKS TOGETHER. DO 1 I=IFREST,K,N M=I IFREE(I)=0 1 IFREE(^^I+1)=I+N C SET THE LAST POINTER TO ZERO INDICATING END OF SEGMENTS. IFREE(M+1)=0 RETURN END SUBROUTINE GETBLK(INDEX) C GET A BLOCK FROM THE FREE STORAGE ^^LIST COMMON/CORE/IFREST,LEN,IFREPT COMMON/FREE/IFREE(1) COMMON/QFORIO/CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC LOGICAL IBAD IBAD=.FALSE. IF(IFREPT.EQ.0)GO TO 1 ^^ C RETURN THE POINTER TO NEXT AVAILABLE SEGMENT BLOCK INDEX=IFREPT IFREPT=IFREE(IFREPT+1) RETURN 1 CALL ERRMSG(6,0) RETURN ^^ END SUBROUTINE RETBLK(INDEX) C RETURN A BLOCK TO THE FREE STORAGE LIST COMMON/CORE/IFREST,LEN,IFREPT COMMON/FREE/IFREE(1) IFREE(INDEX)=0 IFREE(INDEX+1)=IFREPT^^ IFREPT=INDEX RETURN END SUBROUTINE INTCLP C THIS ROUTINE INITIALIZES SOME SIMPLE PARAMETERS THAT C ARE USED BY THE ALGORITHM. IT SHOULD BE CALLED ON^^CE AT C THE BEGINNING OF EACH PICTURE TAKING SESSION. COMMON/PGNCNT/IPOLY COMMON/BUCKY/IBUCKY(1) COMMON/EYES/XR,YR,IXRES,IYRES,DELINT,DELCON,IFLRCO,ICLGCO COMMON/INTENS/ITENHI,ITENLO,IBACKG,IFX1,IFY1 COMMON/CONLEV/CONHI,CONLOW,NCONLV,CLEVEL(1) ^^ COMMON/QFORIO/CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC COMMON/MAXMUM/MAXFRE,MAXRES,MAXINT COMMON/ZRANGE/ZMIN,ZMAX COMMON/ZFIXER/ZLOW,ZHI,ZSPRED,CURZEE COMMON/CORE/IFREST,LEN,IFREPT LOGICAL IBAD,CURZEE IBAD=.FALSE.^^ CURZEE=.FALSE. IFREST=1 C JUMP TO 2 IF BAD RESOLUTION AND TO 3 IF BAD INTENSITY IF(IFX1.GT.MAXRES.OR.IFX1.LT.2) GO TO 2 IF(IFY1.GT.MAXRES.OR.IFY1.LT.2) GO TO 2 IF(ITENHI.GT.MAXINT.OR.ITENHI.LT.0) ^^GO TO 3 IF(ITENLO.GT.MAXINT.OR.ITENLO.LT.0) GO TO 3 C THE INTENSITY IS ALSO BAD IF ITENHI IS LESS THAN ITENLO IF(ITENHI.LT.ITENLO) GO TO 3 C MAKE SURE THAT ZMIN AND ZMAX ARE GOOD GUYS ZLOW=ZMIN IF(ZLOW.LT.0) ZLOW=0. ^^ IF(ZMAX.LT.ZLOW) GO TO 4 ZHI=ZMAX ZSPRED=32767./(ZMAX-ZLOW) C CLEAR OUT THE BUCKET SORTING ARRAYS IPOLY=0 DO 1 I=1,IFY1 1 IBU^^CKY(I)=0 IXRES=IFX1-1 IYRES=IFY1 XR=IXRES/2. YR=(IFY1-1)/2. DELINT=ITENHI-ITENLO C DONT LET THE RANGE OF CONTOUR L^^EVELS EQUAL 0 IF(NCONLV.LE.0) NCONLV=1 DELCON=(CLEVEL(NCONLV)-CLEVEL(1))/31. IF(DELCON.EQ.0.0) DELCON=1. C FIND THE INDICES OF THE FLOOR AND CEILING FOR CONTOUR PLOTTING IFLRCO=1 DO 5 I=1,NCONLV ^^ J=I IF(CONLOW.GE.CLEVEL(I)) IFLRCO=I IF(CONHI.LE.CLEVEL(I)) GO TO 6 5 CONTINUE 6 ICLGCO=J RETURN ^^C BAD RESOLUTION 2 CALL ERRMSG(7,0) RETURN C BAD INTENSITY 3 CALL ERRMSG(8,0) RETURN 4 CALL ERRMSG(11,0) ^^ RETURN END SUBROUTINE POLMAK C POLMAK SHOULD BE CALLED ONCE AT THE BEGINNING OF EACH C POLYGON IN THE PICTURE. COMMON/PGNCNT/IPOLY ^^ COMMON/COMNIO/ICNT,IDUM(121) IPOLY=IPOLY+1 IF(IPOLY.EQ.8192) CALL ERRMSG(2,0) ICNT=0 RETURN END ^^ SUBROUTINE EDGMAK C EDGMAK CAPTURES THE EDGES AND PUTS THEM INTO A STACK C FOR LATER PROCESSING BY POLSNP (WHICH DOES THE ACTUAL C CLIPPING). DATA COES IN THRU CLIP3 AND IS STORED IN COMNIO. COMMON/PGNCNT/IPOLY COMMON/CLIP3/X1,Y1,Z1,S1,K1,C1,X2,Y2,Z2,S2,K2,C2,LASEDG,ISHARE,NTR COMMON/QF^^ORIO/CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC COMMON/COMNIO/ICNT,NT,VX(10),VY(10),VZ(10),VN(10),IC(10),VC(10) C 1 ,VTX(10),VTY(10),VTZ(10),VTN(10),VTC(10),ITC(10) LOGICAL LASEDG,IBAD,ISHARE IF(IBAD) GO TO 2 NT=NTR C JUMP IF EDGE STACK WILL OVERFLOW ^^ IF(ICNT.GE. 9) GO TO 1 C SET 18TH BIT IF EDGE IS SHARED AND SET 19TH BIT FOR EDGE IS C VISIBLE FLAG I=524288 IF(ISHARE) I=786432 C PUT BEGIN POINT INTO EDGE STACK ^^ ICNT=ICNT+1 VX(ICNT)=X1 VY(ICNT)=Y1 VZ(ICNT)=Z1 VN(ICNT)=S1 IC(ICNT)=I+MOD(K1,262144) ^^VC(ICNT)=C1 C PUT END POINT INTO EDGE STACK ICNT=ICNT+1 VX(ICNT)=X2 VY(ICNT)=Y2 VZ(ICNT)=Z2 VN(ICNT)=S2 ^^ IC(ICNT)=I+MOD(K2,262144) VC(ICNT)=C2 C FLUSH THE EDGE STACK IF THIS WAS THE LAST EDGE IF(LASEDG) CALL POLSNP RETURN 1 CALL ERRMSG(12,IPOLY) ^^ RETURN 2 CALL ERRMSG(9,0) RETURN END SUBROUTINE POLSNP C THIS SUBROUTINE DOES THE POLYGON CLIPPING. IT FIRST CLIPS ^^ C ALL THE EDGES OF THE POLYGON TO A PLANE AND THEN SHIPS THAT C SET OF LINES TO THE NEXT PLANE TO BE CLIPPED. LINES WHICH C ARE OUTSIDE OF THE PLANE BEING CLIPPED TO ARE NOT PASSED THRU C THE PIPE SINCE THEY DO NOT HAVE AN EFFECT ON HOW TO CLOSE THE POLYGON C UP. THIS ROUTINE CLIPS TO SIX PLANES, PERFORMS THE PERSPECTIVE C TRANSFORMATION, AND PASSES THE DATA TO PACKER OR HORZED. COMMON/COMNIO/I^^CNT,NT,VX(10),VY(10),VZ(10),VN(10),IC(10),VC(10) C 1 ,VTX(10),VTY(10),VTZ(10),VTN(10),VTC(10),ITC(10) COMMON/EDGARG/IY,IX1,IX2,IZ1,IZ2,IS1,IS2,IPG,IDY,KOL1 ,ISHR, &IC1,IC2,KOL2 COMMON/EYES/XR,YR,IXRES,IYRES,DELINT,DELCON,IFLRCO,ICLGCO COMMON/CONLEV/CONHI,CONLOW,NCONLV,CLEVEL(1) COMMON/PGNCNT/IPOLY ^^ COMMON/QFORIO/CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC COMMON/SNPDAT/T1,T2,IDS COMMON/ZFIXER/ZMIN,ZMAX,ZSPRED,CURZEE LOGICAL IBAD,ISHR,CURZEE,NT IF(IBAD) GO TO 11 C JUMP IF CURRENT POLYGON IS THE ZMIN CLIPPED ^^ IF(CURZEE) GO TO 30 C CLIP TO THE PLANE Z=ZMIN J=ICNT DO 1 I=1,J,2 IDS=I T1=VZ(I)-ZMIN T2=^^VZ(I+1)-ZMIN 1 CALL CLIP C GO AND SEE IF THE CLIPPED EDGES ARE TO BE SAVED CALL FACMAK(J) C CLIP TO THE PLANE Z=ZMAX J=ICNT DO 2 I=1,J,2 ^^ IDS=I T1=ZMAX-VZ(I) T2=ZMAX-VZ(I+1) 2 CALL CLIP C CLIP TO THE PLANE Y=Z 30 J=ICNT ^^ DO 3 I=1,J,2 IDS=I T1=VZ(I)-VY(I) T2=VZ(I+1)-VY(I+1) 3 CALL CLIP C CLIP TO THE PLANE Y=-Z ^^ J=ICNT DO 4 I=1,J,2 IDS=I T1=VZ(I)+VY(I) T2=VZ(I+1)+VY(I+1) 4 CALL CLIP C CLIP TO THE PLANE X=Z ^^ J=ICNT DO 5 I=1,J,2 IDS=I T1=VZ(I)-VX(I) T2=VZ(I+1)-VX(I+1) 5 CALL CLIP ^^ C CLIP TO THE PLANE X=-Z J=ICNT DO 6 I=1,J,2 IDS=I T1=VZ(I)+VX(I) T2=VZ(I+1)+VX(I+1) ^^ 6 CALL CLIP C THE CLIPPING IS NOW COMPLETE. GO THROUGH THE LIST C OF EDGES AND SEE WHICH ARE OUTSIDE THE FRUSTUM OF VISION. IF(IBAD) GO TO 12 C GO HOME IF THAT WAS AN INTERNAL POLYGON IF(NT) GO TO 12 DO 10 I=1,IC^^NT,2 C JUMP IF EDGE IS OUTSIDE IF(IC(I).LT.524288) GO TO 10 K=I+1 L=I C ORDER THE END POINTS SO THAT I+1 HAS THE GREATEST Y VALUE VY(K)=VY(K)*YR/VZ(K)+YR ^^ VY(L)=VY(L)*YR/VZ(L)+YR IF(VY(L).LT.VY(K)) GO TO 7 K=I L=I+1 C GET DELTA Y 7 IDY=INT(VY(K)+.1)-INT(VY(L)+.1) ^^ IY=VY(K)+1.1 C GET THE PERSPECTIVE X AND GIVE IT 10 BITS IX1=VX(K)*XR/VZ(K)+XR+.1 IX2=VX(L)*XR/VZ(L)+XR+.1 IPG=IPOLY ISHR=MOD(IC(I),524288).GE.262144 C GET THE^^ Z VALUES AND GIVE THEM 15 BITS IZ1=(VZ(K)-ZMIN)*ZSPRED+.1 IZ2=(VZ(L)-ZMIN)*ZSPRED+.1 C GET THE INTENSITY AND GIVE IT 6 BITS IS2=VN(L)*63. IS1=VN(K)*63. C************ COLOR************* ^^ KOL1=MOD(IC(K),262144) KOL2=MOD(IC(L),262144) C RESET THE INTENSITY IF IT IS OUTSIDE THE RANGE IF(IS1.GT.63) IS1=63 IF(IS2.GT.63) IS2=63 IF(IS1.LT.0) IS1=0 ^^ IF(IS2.LT.0) IS2=0 C GET THE CONTOUR VALUES AND GIVE THEM 5 BITS IC1=(VC(K)-CLEVEL(1))/DELCON IC2=(VC(L)-CLEVEL(1))/DELCON C RESET THE CONTOURS IF THEY ARE OUTSIDE THE RANGE IF(IC1.LE.0) IC1=0 ^^ IF(IC2.LE.0) IC2=0 IF(IC1.GT.31) IC1=31 IF(IC2.GT.31) IC2=31 C IF THIS IS A HORIZONTAL LINE, THEN SWAP END POINTS SO X1 IS MIN IF(IDY.NE.0) GO TO 9 IZ1=0 IZ2=0 ^^ IF(IX1.LT.IX2) GO TO 9 K=IX1 IX1=IX2 IX2=K C GO STORE THE DATA 9 CALL PACKER ^^ 10 CONTINUE RETURN 11 CALL ERRMSG(9,0) 12 RETURN END SUBROUTINE CLIP ^^ C THIS ROUTINE CLIPS THE EDGE TO A PLANE. THE EQUATION OF THE C PLANE IS IMPLICITLY DEFINED WITHIN T1 AND T2. IF THE EDGE IS C CLIPPED, THEN IT IS ADDED TO THE STACK OF EDGES. COMMON/COMNIO/ICNT,NT,VX(10),VY(10),VZ(10),VN(10),IC(10),VC(10) C 1 ,VTX(10),VTY(10),VTZ(10),VTN(10),VTC(10),ITC(10) COMMON/SNPDAT/T1,T2,I COMMON/QF^^ORIO/CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC COMMON/PGNCNT/IPOLY C COMMON/CLIP2/KOLAVG LOGICAL IBAD C JUMP IF LINE IS OUTSIDE FRUSTRUM OF VISION IF(IC(I).LT.524288) GO TO 30 IF(IBAD) GO TO 30 ^^ C JUMP IF LINE DOES NOT INTERSECT PLANE IF(T1) 10,11,12 10 IF(T2) 50,13,13 11 IF(T2) 13,30,30 12 IF(T2) 13,30,30 C THE LINE IS TO BE CLIPPED ^^ 13 ALPHA=T1/(T1-T2) C DETERMINE WHICH INDEX WILL RECEIVE THE CLIPPED POINT I1=I+1 IF(T1.LT.0.0) I1=I C CLIP VX(I1)=ALPHA*(VX(I+1)-VX(I))+VX(I) ^^VY(I1)=ALPHA*(VY(I+1)-VY(I))+VY(I) VZ(I1)=ALPHA*(VZ(I+1)-VZ(I))+VZ(I) VN(I1)=ALPHA*(VN(I+1)-VN(I))+VN(I) IF(IC(I).NE.IC(I+1)) GO TO 100 IC(I1)=IC(I) GO TO 101 100 C1=FLOAT(MOD(IC(I)/409^^6,64)) C2=FLOAT(MOD(IC(I+1)/4096,64)) KOLAVG=MOD(INT(ALPHA*(C2-C1)+C1+.5),64)*4096 C1=FLOAT(MOD(IC(I)/64,64)) C2=FLOAT(MOD(IC(I+1)/64,64)) KOLAVG=KOLAVG+MOD(INT(ALPHA*(C2-C1)+C1+.5),64)*64 C1=FLOAT(MOD(IC(I),64)) ^^ C2=FLOAT(MOD(IC(I+1),64)) KOLAVG=KOLAVG+MOD(INT(ALPHA*(C2-C1)+C1+.5),64) IC(I1)=KOLAVG+(IC(I)/524288)*524288 101 CONTINUE VC(I1)=ALPHA*(VC(I+1)-VC(I))+VC(I) C JUMP IF EDGE STACK IS FULL ^^ IF (ICNT.GE.10) GO TO 40 ICNT=ICNT+1 VX(ICNT)=VX(I1) VY(ICNT)=VY(I1) VZ(ICNT)=VZ(I1) VN(ICNT)=VN(I1) IC(ICNT)=MOD(^^IC(I1),262144)+524288 VC(ICNT)=VC(I1) 30 RETURN 40 CALL ERRMSG(12,IPOLY) C SET LINE TO OUTSIDE OF FRUSTUM 50 IC(I)=0 IC(I+1)=0 ^^ RETURN END SUBROUTINE FACMAK(ISTRT) C 15NOV73 M. ARCHULETA LLL X3361 C THIS ROUTINE STORES EDGES WHICH WERE CLIPPED AT THE Z=ZMIN C PLANE FOR FUTURE CAP POLYGON GENERATION. ^^ C IF ISTRT IS NEGATIVE, THERE WILL BE NO CAP POLYGONS C IF ISTRT IS ZERO, THERE WILL BE CAP POLYGONS C IF ISTRT IS POSITIVE, STORE THE EDGE INDEXED BY ISTRT AS C A POTENTIAL CAP POLYGON EDGE. COMMON/COMNIO/ICNT,NT,VX(10),VY(10),VZ(10),VN(10),IC(10),VC(10) & ,VTX(10),VTY(10),VTZ(10),VTN(10),VTC(10),ITC(10) COMMON^^/CLIP2/KOLAVG COMMON/ZFIXER/ZLOW,ZHI,ZSPRED,CURZEE LOGICAL CURZEE,KEEPIT,NT IF(ISTRT) 10,20,30 C NO POLYGON GENERATION 10 KEEPIT=.FALSE. RETURN ^^ C THERE WILL BE POLYGON GENERATION 20 KEEPIT=.TRUE. IBGIN=0 RETURN C RETURN IF NO POLYGON GENERATION 30 IF(.NOT.KEEPIT) RETURN ^^ C JUMP IF WE ARE GOING TO FLUSH THE STACK IF(ISTRT.EQ.1) GO TO 40 J=ICNT-ISTRT C JUMP IF CLIPPED STACK IS EMPTY IF(J.EQ.0) RETURN C ADD TO CLIPPED STACK FROM EDGE STACK ^^ NTT=64 IF(NT) NTT=96 DO 31 I=1,J VTX(I+IBGIN)=VX(I+ISTRT) VTY(I+IBGIN)=VY(I+ISTRT) VTZ(I+IBGIN)=VZ(I+ISTRT) VTN(I+IBGIN)=VN(I+^^ISTRT) VTC(I+IBGIN)=VC(I+ISTRT) ITC(I+IBGIN)=NTT 31 CONTINUE IBGIN=J+IBGIN RETURN C JUMP IF THERE ARE LESS THAN 3 CLIPPED EDGES ^^ 40 IF(IBGIN.LT.6) RETURN C THIS LOOP TAKES THE Z CLIPPED EDGES A PUTS THEM INTO THE EDGE STACK DO 41 I=1,IBGIN VX(I)=VTX(I) VY(I)=VTY(I) VZ(I)=VTZ(I) ^^ VN(I)=VTN(I) VC(I)=VTC(I) IC(I)=ITC(I)+KOLAVG 41 CONTINUE C CALL THE POLYGON INITIALIZER AND THEN THE POLYGON CLIPPER NT=.FALSE. CALL POLMAK ^^ ICNT=IBGIN CURZEE=.TRUE. CALL POLSNP CURZEE=.FALSE. RETURN END ^^ SUBROUTINE HIDDEN C THIS IS THE HIDDEN SURFACE ALGORITHM ORIGINALLY C DEVELOPED BY GARY WATKINS OF THE UNIVERSITY OF UTAH. THIS C ROUTINE ASSUMES THAT ALL OF THE SURFACES TO BE PROCESSED C HAVE BEEN PASSED THROUGH POLMAK AND EDGMAK. THE ALGORITHM C SCANS THROUGH A BUCKET TO SEE IF ANY EDGES BECOME ACTIVE ^^ C ON A SCAN LINE. IF THEY DO, THEY ARE STORED INTO WORKING C SEGMENTS. THESE SEGMENTS ARE THEN SORTED IN X AND THEN C IN Z TO DETERMINE WHICH SEGMENT IS VISIBLE ON THE CURRENT C SCAN LINE. WHEN A SCAN LINE HAS BEEN PROCESSED, ALL SEGMENTS C ARE UPDATED TO THE NEXT SCAN LINE AND THE PROCESS RESTARTS. COMMON/BUCKY/IBUCKY(1) COM^^MON/FREE/ISEG(1) COMMON/EYES/IQ(2),IFX,IFY COMMON/SHOWER/IES,IVBL,COLOR,XLEFT,XRIGHT,SHRL,SHRR,SAML,SAMR, & RXVALU,RRANGE,LSTERR,IY,ICON,SHBL,SHBR,SHGL,SHGR COMMON/EDGBLK/IPT,ICOL1,IDELY,X1,X2,Z1,Z2,S1,S2,IEDGPT,C1,C2 &,SHARED,IGTHRZ,ICOL2 COMMON/COMNIO/LINES ^^ COMMON/SEGPTR/ISEGST,ISEGS2,ISEGL2,NOGREY COMMON/YSCLIN/OLDLFT,IYMOD,YLAST,NOHRZ1,NOHRZ2 DIMENSION RSEG(1),ZS(5),SAM(4) EQUIVALENCE (ISEG,RSEG),(ZS,IZS) LOGICAL IES,LSTERR,ISPLIT,IFROM,IXTEND,ABLLE &,ABRLT,J0BOX,JBOXES,ABBCKL,ABBCKR,J1BOX,JINTER ^^ COMMON/QFORIO/CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC LOGICAL IBAD,INTSCT,LINDRW,SHADED,CONTRS,NOHRZ1,NOHRZ2 C INITIALIZATION IF(IBAD) GO TO 360 NOGREY=13 NOHRZ1=.TRUE. ^^ LENGTH=11 LINDRW=.TRUE. SHADED=.FALSE. STEP=.00001 C JUMP IF LINE DRAWING IF(IDVICE.LE.0) GO TO 202 NOGREY=NOGREY+12 ^^ LENGTH=LENGTH+12 SHADED=.TRUE. LINDRW=.FALSE. LINES=0 STEP=1. GO TO 203 ^^ 202 LENGTH=LENGTH+4 203 IF(CONTRS) NOGREY=NOGREY+4 IF(CONTRS) LENGTH=LENGTH+4 I=0 IBAD=.FALSE. JBAD=0 ^^ JCNT=0 IY=IFY C GET THE RIGHT AMOUNT OF WORDS FOR A SEGMENT BLOCK CALL LSTSET(LENGTH+4) ISEGST=0 204 IEDGPT=IBUCKY(IY) IGTHRZ=1 ^^ 210 IF(IEDGPT.EQ.0)GO TO 228 CALL UNPACK IF(IDELY.EQ.0) GO TO 210 C GET POINTER TO FIRST OF SEG LIST ISEGPT=ISEGST IPREV=0 ^^ ISPLIT=.FALSE. C GET A FREE SEGMENT BLOCK AND CALL GETBLK(I) IF(IBAD) RETURN C STORE EDGE DATA IN SEG BLOCK LEFT C SEG(I)=PREVIOUS SEGMENT POINTER ^^ C SEG(I+1)=NEXT SEGMENT POINTER C SEG(I+2)=POLYGON POINTER C SEG(I+3)=NEXT SEGMENT WITH THIS POLYGON POINTER C I+5 THROUGH I+16 ARE FOR THE LEFT EDGE OF SEGMENT C I+6 THROUGH I+18 ARE FOR THE RIGHT EDGE OF SEGMENT C SEG(I+5)=NUMBER OF SCAN LINES THARE EDGE ARE ACTIVE C SEG(^^I+7)=X SEG(I+8)=XSLOPE SEG(I+11)=Z SEG(I+12)=ZSLOPE C SEG(I+15)=INTENSITY SEG(I+16)=INTENSITY SLOPE C SEG(I+4)=RESERVED FOR LINE DRAWING INFORMATION C JUMP ACCORDING TO THE TYPE OF PICTURE TO BE DISPLAYED C JUMP IF LINE DRAWING IF(LINDRW) GO TO 213 SR1=FLOAT(MOD(ICOL1,64^^))*S1/63. SB1=FLOAT(MOD(ICOL1/64,64))*S1/63. SG1=FLOAT(MOD(ICOL1/4096,64))*S1/63. SR2=FLOAT(MOD(ICOL2,64))*S2/63. SB2=FLOAT(MOD(ICOL2/64,64))*S2/63. SG2=FLOAT(MOD(ICOL2/4096,64))*S2/63. 213 CONTINUE ^^ ISEG(I+2)=IPT ISEG(I+3)=0 ISEG(I+4)=0 ISEG(I+5)=-IDELY ISEG(I+6)=0 RSEG(I+9)=0 ^^ RSEG(I+8)=(X1-X2)/ISEG(I+5) RSEG(I+7)=X1+RSEG(I+8)*.5 RSEG(I+12)=(Z1-Z2)/ISEG(I+5) RSEG(I+11)=Z1+RSEG(I+12)*.5 IJ=I+11 IF(.NOT.SHADED) GO TO 214 IJ=IJ+4 ^^ A = FLOAT(ISEG(I+5))*63. RSEG(IJ+1) = (SR1-SR2)/A RSEG(IJ+5) = (SB1-SB2)/A RSEG(IJ+9) = (SG1-SG2)/A RSEG(IJ ) = (SR1/63.)+RSEG(IJ+1)*.5 RSEG(IJ+4) = (SB1/63.)+RSEG(IJ+5)*.5 ^^ RSEG(IJ+8) = (SG1/63.)+RSEG(IJ+9)*.5 IJ = IJ + 8 214 IF(.NOT.CONTRS) GO TO 215 IJ=IJ+4 RSEG(IJ+1)=(C1-C2)/(ISEG(I+5)) RSEG(IJ)=(C1)+RSEG(IJ+1)*.5 ^^ 215 IF(.NOT.LINDRW) GO TO 216 IJ=IJ+4 RSEG(IJ)=-2. IF(.NOT.SHOSHR) RSEG(IJ)=SHARED RSEG(IJ+1)=0. C GO SEARCH X SORT LIST TO SEE WHERE NEW EDGE WILL GO 216 IF(ISE^^GPT.EQ.0) GO TO 226 TE1=RSEG(I+7)-RSEG(ISEGPT+7) TE2=RSEG(I+7)-RSEG(ISEGPT+9) C JUMP IF POLYGON DOES NOT MATCH IF(IPT.NE.ISEG(ISEGPT+2)) GO TO 220 C JUMP IF LEFT EDGE EXPIRED IF(ISEG(ISEGPT+5).GE.0) GO TO ^^221 C JUMP IF NEW ESEGMENT TO THE LEFT OF OLD SEGMENT IF(TE1.LT.0.0) GO TO 226 C SEE IF EXISTING SEGMENT MUST BE SPLIT FOR NEW EDGE IF(ISEG(ISEGPT+6).GE.0) GO TO 219 IF(TE2.GE.0.0) GO TO 219 IF(ISPLIT) GO TO 219 ^^ ISPLIT=.TRUE. C LOAD RIGHT EDGE OF SEGMENT INTO NEW BLOCK DO 218 J=9,LENGTH+2,4 RSEG(I+J)=RSEG(ISEGPT+J) RSEG(I+J+1)=RSEG(ISEGPT+J+1) 218 CONTINUE ^^ ISEG(I+4)=((ISEG(I+4)/2)*2)+MOD(ISEG(ISEGPT+4),2) ISEG(I+6)=ISEG(ISEGPT+6) ISEG(ISEGPT+6)=0 219 IPREV=ISEGPT C GET POINTER TO NEXT SEGMENT BLOCK ISEGPT=ISEG(ISEGPT+1) GO TO 216 ^^ C JUMP IF LEFT EDGE EXPIRED 220 IF(ISEG(ISEGPT+5).GE.0) GO TO 221 IF(TE1) 226,219,219 C JUMP IF RIGHT EDGE EXPIRED 221 IF(ISEG(ISEGPT+6).GE.0) GO TO 219 IF(TE2) 226,219,219 ^^ 226 ISEG(I+1)=ISEGPT ISEG(I)=0 C INSERT THIS NEW SEGMENT BLOCK BETWEEN EXISTING SEGMENTS IF(IPREV.EQ.0) GO TO 227 ISEG(IPREV)=0 ISEG(IPREV+1)=I ^^ GO TO 210 C THIS SEGMENT IS THE FIRST IN THE X SORTED LIST 227 ISEGST=I GO TO 210 C DECREMENT SCAN LINE COUNT 228 YLAST=IY IY=IY-1 ^^ NOHRZ2=NOHRZ1 NOHRZ1=IGTHRZ.EQ.1 IYMOD=MOD(IY,2) OLDLFT=0.0 ISEGS2=0 ISEGL2=0 ^^ SAM(2)=0.0 ISEGAC=0 INTSCT=.FALSE. C GET NEXT LEFT SAMPLE POINT 229 SAM(1)=SAM(2)+STEP IZS=0 ^^ IFROM=.FALSE. ISEGPT=ISEGAC ISEGAC=0 LSTERR=.FALSE. IXTEND=.TRUE. C JUMP IF NO MORE SEGMENTS FOR THIS SCAN LINE 230 IF(^^ISEGPT.EQ.0) GO TO 231 NEXT=ISEG(ISEGPT+3) XLEFT=RSEG(ISEGPT+7)-RSEG(ISEGPT+8) XRIGHT=RSEG(ISEGPT+9)-RSEG(ISEGPT+10) ZLEFT=RSEG(ISEGPT+11)-RSEG(ISEGPT+12) ZRIGHT=RSEG(ISEGPT+13)-RSEG(ISEGPT+14) GO TO 315 ^^ 231 ISEGPT=ISEGST IF(ISEGPT.EQ.0) GO TO 350 C JUMP IF SEGMENT BLOCK STILL HAS EDGE(S) IF(ISEG(ISEGPT+5).NE.0.OR.ISEG(ISEGPT+6).NE.0) GO TO 234 C RETURN TO FREE LIST IF BLOCK IS EMPTY ISEGST=ISEG(ISEGPT+1) ^^ CALL RETBLK(ISEGPT) GO TO 231 234 IF(ISEG(ISEGPT+5).LT.0) GO TO 236 C MOVE RIGHT EDGE OF SEGMENT TO LEFT EDGE DO 235 J=7,LENGTH,4 RSEG(ISEGPT+J)=RSEG(ISEGPT+J+2) ^^ RSEG(ISEGPT+J+1)=RSEG(ISEGPT+J+3) 235 CONTINUE ISEG(ISEGPT+4)=MOD(ISEG(ISEGPT+4),2)*2 ISEG(ISEGPT+5)=ISEG(ISEGPT+6) ISEG(ISEGPT+6)=0 C JUMP IF RIGHT EDGE HAS NOT EXPIRED 236 IF(ISEG(ISEGPT+6).^^LT.0) GO TO 305 IPT=ISEG(ISEGPT+2) C GET NEXT SEGMENT NEXT=ISEG(ISEGPT+1) C JUMP IF END OF SEGMENT LIST 237 IF(NEXT.EQ.0) GO TO 242 C JUMP IF POLYGONS DO NOT MATCH ^^ IF(ISEG(NEXT+2).NE.IPT) GO TO 241 C JUMP IF LEFT EDGE EXPIRED IF(ISEG(NEXT+5).GE.0) GO TO 239 C MOVE LEFT EDGE OF SEGMENT TO RIGHT EDGE DO 238 J=7,LENGTH,4 RSEG(ISEGPT+J+2)=RSEG(NEXT+J) ^^ RSEG(ISEGPT+J+3)=RSEG(NEXT+J+1) 238 CONTINUE ISEG(ISEGPT+4)=ISEG(NEXT+4)/2 ISEG(ISEGPT+6)=ISEG(NEXT+5) ISEG(NEXT+5)=0 GO TO 305 C JUMP IF RIGHT^^ EDGE EXPIRED 239 IF(ISEG(NEXT+6).GE.0) GO TO 241 C MOVE RIGHT EDGE OF NEXT TO RIGHT EDGE OF CURRENT DO 240 J=9,LENGTH+2,4 RSEG(ISEGPT+J)=RSEG(NEXT+J) RSEG(ISEGPT+J+1)=RSEG(NEXT+J+1) 240 CONTINUE ^^ ISEG(ISEGPT+4)=(ISEG(ISEGPT+4)/2)*2+MOD(ISEG(NEXT+4),2) ISEG(ISEGPT+6)=ISEG(NEXT+6) ISEG(NEXT+5)=0 ISEG(NEXT+6)=0 GO TO 305 C GET THE NEXT SEGMENT ^^ 241 NEXT=ISEG(NEXT+1) GO TO 237 C AN UNCLOSED POLYGON EXISTS SO MAKE RIGHT EDGE SAME AS LEFT EDGE 242 DO 243 J=7,LENGTH,4 RSEG(ISEGPT+J+2)=RSEG(ISEGPT+J) RSEG(ISEGPT+J+3)=RSEG(ISEGPT+J+1) 243 ^^CONTINUE ISEG(ISEGPT+6)=-1 C TRY TO WRITE THE UNCLOSED POLYGON NUMBER ONLY C ONCE FOR EACH POLYGON IF(JBAD.EQ.ISEG(ISEGPT+2)) GO TO 305 JBAD=ISEG(ISEGPT+2) JCNT=JCNT+1 ^^ C DONT TYPE MORE THAN 10 MESSAGES IF(JCNT.GT.10) GO TO 305 CALL ERRMSG(5,JBAD) 305 XLEFT=RSEG(ISEGPT+7) XRIGHT=RSEG(ISEGPT+9) C JUMP IF NO VISIBLE SEGMENT TO PROCESS ^^ IF((.NOT.IXTEND.OR.IZS.NE.0).AND.XLEFT.GE.SAM(2)) GO TO 350 IFROM=.TRUE. ISEGST=ISEG(ISEGPT+1) ZLEFT=RSEG(ISEGPT+11) ZRIGHT=RSEG(ISEGPT+13) C UPDATE SEGMENT TO NEXT SCAN LINE ^^ DO 306 J=7,NOGREY,2 RSEG(ISEGPT+J)=RSEG(ISEGPT+J)+RSEG(ISEGPT+J+1) 306 CONTINUE ISEG(ISEGPT+5)=ISEG(ISEGPT+5)+1 ISEG(ISEGPT+6)=ISEG(ISEGPT+6)+1 C JUMP IF SEGMENT BLOCK STILL HAS EDGE(S) IF(ISEG(ISEGPT+^^5).NE.0) GO TO 307 IF(ISEG(ISEGPT+6).NE.0) GO TO 307 C DONT RETURN THE BLOCK IF IN LINE DRAWING MODE IF(IDVICE.LE.0) GO TO 307 C SEGMENT EXITED SO RETURN BLOCK TO FREE CALL RETBLK(ISEGPT) GO TO 315 ^^ C BACK POINTERS NEEDED ON NEW LIST 307 X1=RSEG(ISEGPT+7) C X1=RIGHT X VALUE IF LEFT EDGE EXPIRED IF(ISEG(ISEGPT+5).GE.0) X1=RSEG(ISEGPT+9) IS2=0 IS1=ISEGL2 ^^ C JUMP IF NO MORE SEGMENTS ON THE BACK TRACE 308 IF(IS1.EQ.0) GO TO 309 X2=RSEG(IS1+7) C X2=RIGHT X VALUE IF LEFT EDGE EXPIRED IF(ISEG(IS1+5).GE.0) X2=RSEG(IS1+9) C JUMP IF CURRENT X IS TO RIGHT OF PREVIOUS SEGMENT IF(^^X1.GE.X2) GO TO 309 IS2=IS1 IS1=ISEG(IS1) GO TO 308 C SET THE BACK AND FORWARD POINTERS 309 IF(IS2.NE.0) ISEG(ISEGPT+1)=IS2 ISEG(ISEGPT)=IS1 ^^ IF(IS2.NE.0) ISEG(IS2)=ISEGPT IF(IS2.EQ.0) ISEGL2=ISEGPT IF(IS1.NE.0) ISEG(IS1+1)=ISEGPT IF(IS1.EQ.0) ISEGS2=ISEGPT 315 IF(SAM(1).GE.XRIGHT) GO TO 345 ABLLE=SAM(1).GE.XLEFT ^^ ABRLT=XRIGHT.LT.SAM(2) INTSCT=.FALSE. C GET XLEFT CLIP POINT XLCLIP=SAM(1) IF(.NOT.ABLLE) XLCLIP=XLEFT C GET XRIGHT CLIP POINT ^^ XRCLIP=SAM(2) IF(ABRLT) XRCLIP=XRIGHT J0BOX=.FALSE. JBOXES=.TRUE. C JUMP IF NO VISIBLE SEGMENT TO PROCESS IF((IZS .EQ.0).AND..NOT.ABLLE) GO TO 335 JBOXES=.FALSE. ^^ IF((IZS.EQ.0).AND.ABLLE) GO TO 331 C GET Z VALUES FOR NEW AND OLD LINES AT CLIP POINTS C JUMP SO ZERO DIVIDE WONT HAPPEN 323 IF(XLEFT.EQ.XRIGHT) GO TO 324 ZAL=((XLCLIP-XRIGHT)*(ZLEFT-ZRIGHT))/(XLEFT-XRIGHT)+ZRIGHT ZAR=((XRCLIP-XRIGHT)*(ZLEFT-ZRIGHT))/(XLEFT-X^^RIGHT)+ZRIGHT GO TO 325 324 ZAL=ZRIGHT ZAR=ZRIGHT C JUMP SO ZERO DIVIDE WONT HAPPEN 325 IF(ZS(2).EQ.ZS(3)) GO TO 326 ZCL=((XLCLIP-ZS(3))*(ZS(4)-ZS(5)))/(ZS(2)-ZS(3))+ZS(5) ^^ ZCR=((XRCLIP-ZS(3))*(ZS(4)-ZS(5)))/(ZS(2)-ZS(3))+ZS(5) GO TO 327 326 ZCL=ZS(5) ZCR=ZS(5) 327 ABBCKL=ZCL.LE.ZAL ABBCKR=ZCR.LE.ZAR J0BOX=ABBCKL^^.AND.ABBCKR C JUMP IF AB BACK ON LEFT AND RIGHT IF(J0BOX) GO TO 335 J1BOX=ABLLE.AND..NOT.ABBCKL.AND..NOT.ABBCKR C JUMP IF AB NOT BACK ON LEFT AND RIGHT IF(J1BOX) GO TO 331 JINTER=(ABBCKL.AND..NOT.ABBCKR).OR.(^^.NOT.ABBCKL.AND.ABBCKR.AND. &ABLLE) C JUMP IF THE TWO SURFACES INTERSECTED IF(JINTER) GO TO 328 JBOXES=.TRUE. C JBOXES=.NOT.ABLLE.AND..NOT.ABBCKL BY DEFAULT GO TO 335 ^^ C GET THE INTERSECTION POINT 328 SAM(2)=(XLCLIP*(ZAR-ZCR)-XRCLIP*(ZAL-ZCL))/(ZCL-ZAL-ZCR+ZAR) C RESET SAM(2) IF ARITHMETIC WAS A LITTLE OFF IF(SAM(2).LT.XLCLIP) SAM(2)=XLCLIP IF(SAM(2).GT.XRCLIP) SAM(2)=XRCLIP SAM(3)=SAM(2)*.25 SAM^^(4)=0 IXTEND=.FALSE. INTSCT=.TRUE. C JUMP IF LINE AB IS BACK ON THE RIGHT IF(ABBCKR) GO TO 332 GO TO 335 331 IF(IFROM.AND.(RRANGE.NE.RSE^^G(ISEGPT+8))) LSTERR=.TRUE. IF(IZS.NE.0.AND.ABRLT) IXTEND=.FALSE. IF(.NOT.ABRLT.AND..NOT.IXTEND) GO TO 332 SAM(2)=XRIGHT SAM(3)=XRIGHT*.25 SAM(4)=RSEG(ISEGPT+10) C SET PREVIOUS TEST SEGMENT TO CURRENT SEGMENT ^^ 332 IZS=ISEGPT ZS(2)=XLEFT ZS(3)=XRIGHT ZS(4)=ZLEFT ZS(5)=ZRIGHT 335 IF(J0BOX.AND..NOT.(XRIGHT.LE.SAM(2))) IXTEND=.FALSE. ^^ IF(J0BOX.AND.(XRIGHT.LE.SAM(2))) GO TO 345 C LINK SEGMENT WHICH BELONGS TO COMMON POLYGON ISEG(ISEGPT+3)=ISEGAC ISEGAC=ISEGPT IF(.NOT.JBOXES) GO TO 345 IXTEND=.FALSE. C UPDATE NEXT SAMPLE POI^^NT SAM(2)=XLEFT SAM(3)=XLEFT*.25 SAM(4)=RSEG(ISEGPT+8) 345 ISEGPT=NEXT IF(IFROM) GO TO 231 GO TO 230 ^^ C OUTPUT SEGMENTS 350 IF(IXTEND) ISEGAC=0 IES=(ISEGPT.EQ.0).AND.IXTEND C JUMP IF BACKGROUND SEGMENT IF(IZS.EQ.0) GO TO 355 C JUMP IF THERE WAS NOT AN INTERSECTION ^^ IF(.NOT.INTSCT) GO TO 351 IF(IDVICE.GT.0) GO TO 351 C THIS IS WHERE A POINT WOULD BE PLOTTED TO C SHOW WHERE AN INTERSECTION IS. THE COORDINATE IS (SAM(2),IY). 351 CONTINUE XLEFT=(RSEG(IZS+7)-RSEG(IZS+8)) XRIGHT=(R^^SEG(IZS+9)-RSEG(IZS+10)) IJ=IZS+11 IF(.NOT.SHADED) GO TO 352 IJ=IJ+4 SHRL = RSEG(IJ )-RSEG(IJ+1) SHBL = RSEG(IJ+4)-RSEG(IJ+5) SHGL = RSEG(IJ+8)-RSEG(IJ+9) ^^ SHRR = RSEG(IJ+2)-RSEG(IJ+3) SHBR = RSEG(IJ+6)-RSEG(IJ+7) SHGR = RSEG(IJ+10)-RSEG(IJ+11) IJ = IJ + 8 352 IF(.NOT.CONTRS) GO TO 355 IJ=IJ+4 ^^ ICON=IJ 355 SAML=SAM(1)-STEP SAMR=SAM(2) IVBL=IZS RXVALU=SAM(3) RRANGE=SAM(4) C JUMP^^ TO CONSHO IF CONTOUR OUTPUT IF(CONTRS) CALL CONSHO C JUMP TO LINSHO IF LINE DRAWING OUTPUT IF(LINDRW) CALL LINSHO C JUMP TO SHOW IF SHADED OUTPUT IF(SHADED) CALL SHOW IF(.NOT.IES) GO TO 229 ^^ C BACK POINTER NOT NEEDED NOW IF(ISEGL2.EQ.0) GO TO 356 ISEG(ISEGL2)=0 ISEG(ISEGL2+1)=0 356 ISEGST=ISEGS2 C JUMP IF STILL MORE SCAN LINES TO PROCESS ^^ IF(IY.GE.1) GO TO 204 IBAD=JBAD.OR.IBAD RETURN 360 CALL ERRMSG(9,0) RETURN END ^^ SUBROUTINE DRAWIT(X1,Y1,I) C DRAWIT SENDS THE LINE TO BE DISPLAYED TO THE APPROPRIATE C DRAWING SUBROUTINE. IT ALSO CLEARS OUT THE LINE STARTING C POSITION. COMMON/QFORIO/CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC COMMON/FREE/RSEG(1) COMMON/INTENS/I^^TENHI,ITENLO,IBACKG,IFX,IFY C JUMP IF THIS EDGE HAS ALREADY BEEN DRAWN IF(RSEG(I-1).LE.-1.) GO TO 3 A=X1 B=Y1 C=RSEG(I-1) D=RSEG(I) ^^ C JUMP TO 1 IF NEW LINE DOES NOT MATCH OLD LINE IF(A.NE.OX1) GO TO 1 IF(B.NE.OY1) GO TO 1 IF(C.NE.OX2) GO TO 1 IF(D.EQ.OY2) GO TO 2 C STORE THE NEW END POINT ^^ 1 OX1=A OY1=B OX2=C OY2=D CALL PLTLIN(A,B,C,D) 2 RSEG(I-1)=-3. RSEG(I^^)=0 3 RETURN END SUBROUTINE LINSHO C 04APR74 C LINSHO UPDATES THE INFORMATION WITHIN EACH OF THE C SEGMENT BLOCKS AS TO HOW MANY SCAN^^ LINES EITHER THE LEFT OR C RIGHT EDGE OF THE SEGEMNT HAS BEEN VISIBLE. IF THE C EDGE IS EXITING ON THE NEXT SCAN LINE, THEN IT IS DRAWN. IF THE C EDGE WAS VISIBLE ON THE PREVIOUS SCAN LINE BUT NOT THIS SCAN LINE, C THEN IT IS DRAWN. THIS ROUTINE WILL CALL SUBROUTINE C DRAWIT WITH THE INFORMATION NECESSARY TO MAKE A LINE SEGMENT. COMMON/FREE/ISEG(1) ^^ COMMON/EDGBLK/IPT,ICOL,IYY,X1,X2,Z1,Z2,S1,S2,NEXT,C1,C2 &,SHARED,IGTHRZ,ICOL2 COMMON/QFORIO/CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC COMMON/SHOWER/IES,I,COLOR,XLEFT,XRIGHT,SHRL,SHRR,SAML,SAMR &,RXVALU,RRANGE,LSTERR,IY,ICON,SHBL,SHBR,SHGL,SHGR COMMON/INTENS/ITENHI,ITENLO,IBACKG,IFX,IFY ^^ COMMON/BUCKY/IBUCKY(1) COMMON/SEGPTR/ISEGST,ISEGS2,ISEGL2,NOGREY COMMON/YSCLIN/OLDLFT,IYMOD,YLAST,NOHRZ1,NOHRZ2 LOGICAL IES,SHOSHR,IBAD,LSTERR,LFTVIS,RGTVIS,MAYHRZ,LOAD &,NOHRZ1,NOHRZ2 DIMENSION RSEG(1) EQUIVALENCE (ISEG,RSE^^G) C JUMP IF THIS A BACKGROUND SEGMENT IF(I.EQ.0) GO TO 14 IJ=I+NOGREY+2 C CHECK TO SEE WHAT THE STATUS OF THE EDGE IS IF THIS C IS THE FIRST TIME THE EDGE IS VISIBLE. IF(ILAST.NE.I) MAYHRZ=.FALSE. ^^ LFTVIS=ABS(XLEFT-SAML).LT..001 RGTVIS=ABS(XRIGHT-SAMR).LT..001 I1=ISEG(I+4)/2 C JUMP IF LEFT EDGE NOT VISIBLE IF(.NOT.LFTVIS) GO TO 2 I1=IYMOD ^^ C JUMP IF LEFT EDGE NOT VISIBLE FOR FIRST TIME IF(RSEG(IJ).GE.-1.0) GO TO 1 MAYHRZ=.TRUE. RSEG(IJ)=SAML-RSEG(I+8)*(RSEG(IJ)+3.)*.5 RSEG(IJ+1)=YLAST C DRAW THE LEFT EDGE IF IT EXITS 1 IF(ISEG(I^^+5).NE.0) GO TO 2 MAYHRZ=.TRUE. CALL DRAWIT(SAML+RSEG(I+8)*.5,YLAST,IJ+1) C JUMP IF RIGHT SIDE NOT VISIBLE 2 IF(.NOT.RGTVIS) GO TO 4 I2=IYMOD C JUMP IF RIGHT EDGE NOT VISIBLE FOR FIRST^^ TIME IF(RSEG(IJ+2).GE.-1.0) GO TO 3 MAYHRZ=.TRUE. RSEG(IJ+2)=SAMR-RSEG(I+10)*(RSEG(IJ+2)+3.)*.5 RSEG(IJ+3)=YLAST C DRAW THE RIGHT EDGE IF IT EXITS 3 IF(ISEG(I+6).NE.0) GO TO 4 ^^ MAYHRZ=.TRUE. CALL DRAWIT(SAMR+RSEG(I+10)*.5,YLAST,IJ+3) C SET THE THIS LINE IS VISIBLE FLAGS 4 ISEG(I+4)=I1*2+I2 OLDLFT=SAMR C NOW START THE PROCESSING OF THE HORIZONTAL EDGES IGT^^HRZ=-1 LOAD=.FALSE. C JUMP IF THIS POLYGON PROBABLY DOESNT HAVE HORIZONTAL EDGES IF(SHOSHR.AND..NOT.MAYHRZ) GO TO 14 C JUMP IF THERE WERE NO HORIZONTAL EDGES FOUND FOR THIS SCAN LINE IF(NOHRZ1) GO TO 12 NEXT=IBUCKY(IY+1) ^^ YA=YLAST C JUMP IF NO HORIZONTAL EDGES 10 IF(NEXT.LE.0) GO TO 12 CALL UNPACK IF(IYY.NE.0) GO TO 10 IF((SHARED.EQ.-1.).AND..NOT.SHOSHR) GO TO 10 ^^ IF(IPT.NE.ISEG(I+2)) GO TO 10 C GET THE FLOATING FLOOR OF SAML IF(FLOAT(INT(SAML)).GE.X2) GO TO 10 C GET THE FLOATING FLOOR OF SAMR IF(FLOAT(INT(SAMR)).LE.X1) GO TO 10 C GET THE TRUE HORIZONTAL SPAN ^^ IF(SAML.GT.X1) X1=SAML IF(SAMR.LT.X2) X2=SAMR CALL PLTLIN(X1,YA,X2,YA) LOAD=.TRUE. GO TO 10 C JUMP IF THERE WERE NO HORIZONTAL EDGES LAST SCAN LINE 12 IF(NOHRZ2) GO TO 1^^4 C JUMP IF WEVE BEEN THRU HERE BEFORE IF(LOAD) GO TO 14 LOAD=.TRUE. YA=YLAST+1 NEXT=IBUCKY(IY+2) GO TO 10 ^^ C JUMP IF NOT END OF SCAN LINE 14 ILAST=I IF(.NOT.IES) RETURN C RESET BACK POINTER IF(ISEGL2.EQ.0) GO TO 15 ISEG(ISEGL2)=0 ^^ ISEG(ISEGL2+1)=0 15 ISEGST=ISEGS2 I=ISEGST IOLD=I XL=YLAST+1. C GO HOME IF END OF SEGMENTS REACHED 16 IF(I.EQ.0^^) RETURN INXT=I IF(ISEG(I+1).NE.0) INXT=ISEG(I+1) C DRAW IF LEFT EDGE WAS PREVIOUSLY VISIBLE IF(ISEG(I+4)/2.EQ.IYMOD) GO TO 17 X1=RSEG(I+7)-2.0*RSEG(I+8) CALL DRAWIT(X1,XL,I+NOGREY+3) ^^ C DRAW IF RIGHT EDGE WAS PREVIOUSLY VISIBLE 17 IF(MOD(ISEG(I+4),2).EQ.IYMOD) GO TO 18 X1=RSEG(I+9)-2.0*RSEG(I+10) CALL DRAWIT(X1,XL,I+NOGREY+5) 18 IOLD=I I=ISEG(I+1) ^^ GO TO 16 END SUBROUTINE SHOW C 04OCT73 C THIS ROUTINE EVALUATES THE SHADING INFORMATION FOR C A VISIBLE SEGMENT. DATA COMES THROUGH SHOWER AND GOES TO C SRL ^^(SHADED RASTER LINE) COMMON/SHOWER/IES,IVBL,COLOR,XLEFT,XRIGHT,SHRL,SHRR,SAML,SAMR, & RXVALU,RRANGE,LSTERR,IY,ICON,SHBL,SHBR,SHGL,SHGR COMMON/INTENS/ITENHI,ITENLO,IBACKG,IFX,IFY C COMMON/CONLEV/CONHI,CONLOW,NCONLV,CLEVEL(1) COMMON/EYES/XR,YR,IXRES,IYRES,DELINT,DELCON,IFLRCO,ICLGCO LOGICAL IES,LSTERR ^^ IF(SAMR.GT.IXRES) SAMR=IXRES C GO HOME IF END OF SCAN LINE REACHED 2 IF(SAML.GE.IXRES) RETURN IF(SAML.GE.SAMR) GO TO 4 STR=FLOAT(MOD(IBACKG,64)) STB=FLOAT(MOD(IBACKG/64,64)) ^^ STG=FLOAT(MOD(IBACKG/4096,64)) ENDR = STR ENDB = STB ENDG = STG C JUMP IF BACKGROUND SEGMENT IF(IVBL.EQ.0) GO TO 3 ^^ RR = 0. RB = 0. RG = 0. IF ( XRIGHT.EQ.XLEFT ) GO TO 1 X = XRIGHT-XLEFT RR = (SHRR-SHRL)/X RB = (SHBR-SHBL^^)/X RG = (SHGR-SHGL)/X C C************ COLOR************* C EVALUATE THE START AND END INTENSITIES 1 X = SAML-XLEFT RTENLO = ITENLO ^^ STR = (X*RR+SHRL)*DELINT+RTENLO STB = (X*RB+SHBL)*DELINT+RTENLO STG = (X*RG+SHGL)*DELINT+RTENLO X = SAMR-XLEFT ENDR = (X*RR+SHRL)*DELINT+RTENLO ENDB = (X*RB+SHBL)*DELINT+RTENLO ^^ ENDG = (X*RG+SHGL)*DELINT+RTENLO 3 CALL SRL(SAML,STR,STB,STG,SAMR,ENDR,ENDB,ENDG,IY+1) C GO HOME IF THIS IS NOT THE END OF THE SCAN LINE 4 IF(.NOT.IES) RETURN IVBL=0 SAML=SAMR SAMR=I^^XRES GO TO 2 END SUBROUTINE PACKER C C SUBROUTINE PACKER FOR 36 BIT MACHINES IN ANSI FORTRAN C ^^ C THIS ROUTINE RECEIVES DATA THROUGH EDGARG AND PACKS IT INTO C A STORAGE BLOCK INSIDE FREE. IF THIS EDGE IS A SHARED EDGE, THEN C THE EDGE WILL BE COMPARED WITH EXISTING EDGES ON THIS SCAN LINE C TO FIND OUT WHICH IF ANY IT MATCHES. IF THIS EDGE IS A C HORIZONTAL EDGE, THEN IT WILL BE STORED ON THE PREVIOUS SCAN LINE. COMMON/EDGARG/IY,IX1,IX2,IZ1,IZ2,IS1,IS2,IP,IDY,ICOL1,^^ ISHR, &IC1,IC2,ICOL2 COMMON/FREE/ IFREE(1) COMMON/EYES/XEY(3),IFY,ES(4) COMMON/BUCKY/IBUCKY(1) COMMON/QFORIO/CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC LOGICAL CONTRS,IBAD,ISHR C C^^HANGE IY IF THIS IS A HORIZONTAL EDGE IF(IDY.EQ.0) IY=IY+1 IF(IY.GT.IFY) IY=IFY IPT=IBUCKY(IY) C GENERATE THE EDGE DATA IT1=(IX1*1024+IX2)*1024+IDY IT2=IZ1*32768+IZ2 ^^ NUMWRD=5 C JUMP IF NO EDGE SHARING IF(.NOT.ISHR) GO TO 4 C TRACE THROUGH THE ENTRIES ON THIS SCAN LINE AND FIND OUT C IF THIS EDGE HAS ALREADY BEEN ENTERED. 1 IF(IPT.EQ.0) GO TO 4 ^^ IF(IT1.EQ.MOD(IFREE(IPT),1073741824) 1.AND.IT2.EQ.MOD(IFREE(IPT+1),1073741824)) GO TO 3 C GET THE NEXT BLOCK IPT=MOD(IFREE(IPT+2),262144) GO TO 1 C CHECK TO SEE IF THIS EDGE IS ALREADY SHARED ^^ C AND JUMP IF IT IS 3 IF(MOD(IFREE(IPT+4),8192).NE.0) GO TO 4 C NOW PROVIDE THE SHARING POLYGON IFREE(IPT+4)=IFREE(IPT+4)/8192*8192+IP GO TO 5 4 CONTINUE C GET ENOUGH FREE ^^FOR EDGE BLOCK (180 BITS) CALL GETVAR(IPT,NUMWRD) IF(IBAD) RETURN C CBEG(5), XBEG(10), XEND(10), DELTA Y(10) IFREE(IPT)=IT1 C CEND(5), ZBEG(15), ZEND(15) IFREE(IPT+1)=IT2 ^^ C SBEG(6), SEND(6), NEXT EDGE(18) IFREE(IPT+2)=(IS1*64+IS2)*262144+IBUCKY(IY) C COLOR BEG(18), POLYGON NUMBER(13) IFREE(IPT+3)=ICOL1*8192+IP C COLOR END(18), SHARED POLYGON NUMBER(13) IFREE(IPT+4)=ICOL2*8192 ^^ IF(.NOT.CONTRS) GO TO 6 IFREE(IPT)=MOD(IFREE(IPT),1073741824)+IC1*1073741824 IFREE(IPT+1)=MOD(IFREE(IPT+1),1073741824)+IC2*1073741824 6 IBUCKY(IY)=IPT 5 RETURN END SUB^^ROUTINE UNPACK C C SUBROUTINE UNPACK FOR 36 BIT MACHINES IN ANSI FORTRAN C C UNPACK PERFORMS THE REVERSE OF PACKER. IT IS CALLED BY C HIDDEN WITH IEDGPT SET AND RETURNS DATA THROUGH EDGBLK. COMMON/FREE/IFREE(1) ^^ COMMON/EDGBLK/IPT,ICOL1,IDELY,X1,X2,Z1,Z2,S1,S2,IEDGPT,C1,C2 &,SHARED,IGTHRZ,ICOL2 COMMON/QFORIO/CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC LOGICAL CONTRS C GET DELTAY VALUE 15 IDELY=MOD(IFREE(IEDGPT),1024) ^^ C JUMP IF A NON-HORIZONTAL LINE IF(IDELY.GT.0) GO TO 16 C JUMP IF WE ARE LOOKING FOR VERTICALS IF(IGTHRZ) 20,20,18 C JUMP IF WE ARE LOOKING FOR HORIZONTALS 16 IF(IGTHRZ) 19,19,20 ^^C FLAG TO SAY THERE ARE HORIZONTAL EDGES ON THIS SCAN LINE 18 IGTHRZ=2 C GET NEXT EDGE BLOCK 19 IEDGPT=MOD(IFREE(IEDGPT+2),262144) C GO HOME IF WE RAN OFF THE END OF THE LIST IF(IEDGPT) 3,3,15 C GET Z BEGIN ^^ 20 Z1=FLOAT(MOD(IFREE(IEDGPT+1)/32768,32768)) C GET Z END AND MAKE IT REAL Z2=FLOAT(MOD(IFREE(IEDGPT+1),32768)) C GET X BEGIN X1=FLOAT(MOD(IFREE(IEDGPT)/1048576,1024)) C GET X END AND MAKE IT REAL ^^ X2=FLOAT(MOD(IFREE(IEDGPT)/1024,1024)) C GET SHADE BEGIN S1=FLOAT(MOD(IFREE(IEDGPT+2)/16777216,64)) C GET SHADE END AND MAKE IT REAL S2=FLOAT(MOD(IFREE(IEDGPT+2)/262144,64)) C GET POINTER TO POLYGON ^^ IP=MOD(IFREE(IEDGPT+4),8192) C GET THE COLOR OF THIS EDGE ICOL1=MOD(IFREE(IEDGPT+3)/8192,262144) ICOL2=MOD(IFREE(IEDGPT+4)/8192,262144) C JUMP IF NO CONTOURING IF(.NOT.CONTRS) GO TO 4 C GET THE CONTO^^UR BEGIN C1=FLOAT(MOD(IFREE(IEDGPT)/1073741824,32)) C CET THE CONTOUR END C2=FLOAT(MOD(IFREE(IEDGPT+1)/1073741824,32)) 4 SHARED=-2. C IPT=MOD(IFREE(IEDGPT+3),8192) ^^ C JUMP IF NOTHING IN THE TOP HALF IF(IP.EQ.0) GO TO 2 SHARED=-1. IF(ISHARE.EQ.1) GO TO 1 ISHARE=1 GO TO 3 ^^ 1 IPT=IP C GET POINTER TO NEXT EDGE ON SCAN LINE 2 IEDGPT=MOD(IFREE(IEDGPT+2),262144) ISHARE=0 3 RETURN END ^^SUBROUTINE ERRMSG(I,J) C THIS ROUTINE WILL WRITE OUT THE ERROR MESSAGE. ARGUMENT I C IS THE ERROR NUMBER AND ARGUMENT J IS THE VALUE WHICH IS IN ERROR. COMMON/DEVI/ INPUT,OUTPUT,ERROR COMMON/QFORIO/CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC INTEGER OUTPUT,ERROR LOGICAL IBAD ^^ IF(IDVICE.EQ.-1) CALL ALMODE IBAD=.TRUE. C JUMP TO THE ERROR STRING GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13),I 1 WRITE(ERROR,30) J GO TO 25 ^^ 2 WRITE(ERROR,31) GO TO 25 3 WRITE(ERROR,32) J GO TO 25 4 WRITE(ERROR,33) J GO TO 25 ^^ 5 WRITE(ERROR,34) J GO TO 25 6 WRITE(ERROR,35) GO TO 25 7 WRITE(ERROR,36) GO TO 25 8 WRITE(ERROR,37)^^ GO TO 25 9 WRITE(ERROR,38) GO TO 25 10 WRITE(ERROR,39) GO TO 25 11 WRITE(ERROR,40) ^^ GO TO 25 12 WRITE(ERROR,41) J GO TO 25 13 WRITE(ERROR,42) CONTINUE 25 RETURN ^^ 30 FORMAT(' MAXFRE.LT.100',I6/) 31 FORMAT(' TOO MANY POLYGONS'/) 32 FORMAT(' BAD MAXRES',I6/) 33 FORMAT(' BAD MAXINT',I6/) 34 FORMAT(' UNCLOSED POLYGON',I6/) 35 FORMAT(' I NEED MORE FREE'/) 36 FORMA^^T(' BAD RESOLUTION'/) 37 FORMAT(' BAD INTENSITY'/) 38 FORMAT(' FIX YOUR DATA'/) 39 FORMAT(' BUFFER FULL'/) 40 FORMAT(' ZMAX.LE.0 OR ZMIN'/) 41 FORMAT(' EDG STK FUL 4 POL',I6/) 42 FORMAT(' BAD EDGE COUNT'/) ^^ END SUBROUTINE CONSHO C 04APR74 C THIS ROUTINE EVALUATES THE CONTOUR INFORMATION FOR C A VISIBLE SEGMENT. DATA COMES THROUGH SHOWER AND GOES TO C LINE AND CRTBCD (LLL GRAPHICS ROUTINES) ^^ COMMON/FREE/RSEG(1) COMMON/SHOWER/IES,I,COLOR,XLEFT,XRIGHT,SHRL,SHRR,SAML,SAMR &,RXVALU,RRANGE,LSTERR,IY,J,SHBL,SHBR,SHGL,SHGR COMMON/INTENS/ITENHI,ITENLO,IBACKG,IFX,IFY COMMON/CONLEV/CONHI,CONLOW,NCONLV,CLEVEL(1) COMMON/EYES/XR,YR,IXRES,IYRES,DELINT,DELCON,IFLRCO,ICLGCO ^^ COMMON/YSCLIN/OLDLFT,IYMOD,YLAST COMMON/QFORIO/CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC LOGICAL IES,LSTERR,SHOSHR C JUMP IF BACKGROUND SEGMENT IF(I.EQ.0) RETURN YY=YLAST/(IFY+1) ITEXTY=MOD(IY,NCONLV*^^LBLSPC) C GET THE DATA FOR HALF A SCAN LINE AGO XL1=XLEFT-RSEG(I+8)*.5 XR1=XRIGHT-RSEG(I+10)*.5 CL1=(RSEG(J)-RSEG(J+1)*1.5)*DELCON+CLEVEL(1) CR1=(RSEG(J+2)-RSEG(J+3)*1.5)*DELCON+CLEVEL(1) C GET THE DATA FOR HALF A SCAN LINE AHEAD ^^ XL2=XLEFT+RSEG(I+8)*.5 XR2=XRIGHT+RSEG(I+10)*.5 CL2=(RSEG(J)-RSEG(J+1)*.5)*DELCON+CLEVEL(1) CR2=(RSEG(J+2)-RSEG(J+3)*.5)*DELCON+CLEVEL(1) C GO THROUGH THE CONTOUR LOOP C THIS IS REALLY DIFFICULT TO EXPLAIN. THE HIDDEN SURFACE ^^ C ALGORITHM HAS DETERMINED THAT IT HAS A VISIBLE SEGMENT. C I WILL CREATE A QUADRILATERAL ABOUT THIS VISIBLE SEGMENT WHERE C THE COORDINATES ARE (XR1, Y-1/2), (XL1, Y-1/2), (XR2, Y+1/2), C (XL2, Y+1/2). IN GOING THROUGH THE CONTOUR LOOP I CHECK TO SEE C IF A GIVEN CONTOUR LINE INTERSECTS AN EDGE OF THE QUAD. C IF IT DOES, THEN I STORE THE COORDINATE. THE LINE THAT I WILL C DRAW MUST BE CON^^TAINED WITHIN THE VISIBLE SEGMENT. THE REASON I C DONT WORRY ABOUT THE Y INTERSECTION IS BECAUSE THE PICTURE C WHICH IM COMPUTING CANT EXIST BETWEEN SCAN LINES. DO 7 K=IFLRCO,ICLGCO XS=IFX XE=0. CC=CLEVEL(K) ^^ C CHECK THE LINE FROM TOP LEFT TO TOP RIGHT T1=CC-CL1 T2=CC-CR1 IF(T1*T2.GT.0.) GO TO 1 X=XL1 IF(T1.NE.T2) X=(T1/(T1-T2))*(XR1-XL1)+XL1 ^^ IF(X.LT.XS) XS=X IF(X.GT.XE) XE=X C CHECK THE LINE FROM TOP RIGHT TO BOTTOM RIGHT 1 T1=CC-CR1 T2=CC-CR2 IF(T1*T2.GT.0.) GO TO 2 ^^ X=XR1 IF(T1.NE.T2) X=(T1/(T1-T2))*(XR2-XR1)+XR1 IF(X.LT.XS) XS=X IF(X.GT.XE) XE=X C CHECK THE LINE FROM BOTTOM RIGHT TO BOTTOM LEFT 2 T1=CC-CR2 T2=CC-CL2 ^^ IF(T1*T2.GT.0.) GO TO 3 X=XR2 IF(T1.NE.T2) X=(T1/(T1-T2))*(XL2-XR2)+XR2 IF(X.LT.XS) XS=X IF(X.GT.XE) XE=X C CHECK THE LINE FROM BOTTOM LEFT TO TOP LEFT ^^ 3 T1=CC-CL2 T2=CC-CL1 IF(T1*T2.GT.0.) GO TO 4 X=XL1 IF(T1.NE.T2) X=(T1/(T1-T2))*(XL1-XL2)+XL2 IF(X.LT.XS) XS=X ^^ IF(X.GT.XE) XE=X C IF THE CONTOUR SEGMENT IS OUTSIDE THE RANGE OF THE C VISIBLE SEGMENT, THEN DONT DRAW IT 4 IF(XS.GT.SAMR) GO TO 7 IF(XE.LT.SAML) GO TO 7 IF(XS.LT.SAML) XS=SAML IF(XE.GT.^^SAMR) XE=SAMR CALL PLTLIN(XS,YLAST,XE,YLAST) C JUMP IF THIS ISNT THE TIME TO PLOT A LABEL IF((K-1)*LBLSPC.NE.ITEXTY) GO TO 7 CALL LABEL((XS+XE)/2.,YLAST,(64+K)*2**29,1) 7 CONTINUE RETURN ^^ END C**********************************************************************C C C C DEVICE.FOR VERSION 1.0(A) SEPTEMBER 1976 C C C C THIS FILE CONTAINS DEVICE DEPENDENT CALLS TO INITIALIZE, C^^ C WRITE, AND TERMINATE PICTURE TRANSMISSION TO THE C C SELECTED DISPLAY DEVICE. C C C C MIKE STEPHENSON HANK CHRISTIANSEN C C DEPARTMENT OF CIVIL ENGR. CIVIL ENGINEERING DEPT. C C AND ENGINEERING MECHANICS 368E ESTB C C THE UNI^^VERSITY OF ARIZONA BRIGHAM YOUNG UNIVERSITY C C TUCSON, ARIZONA 85721 PROVO, UTAH 84602 C C (602) 884-4803 (801) 374-1211 X2811 C C C C**********************************************************************C SUBROUTINE BGNFRM ^^ COMMON/DEVI/ INPUT,OUTPUT,ERROR COMMON/PLTTER/ PLTSIZ,XLAST,YLAST COMMON/INTENS/ IPH,IPL,IPB,IFX,IFY COMMON/QFORIO/ CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC INTEGER OUTPUT,ERROR LOGICAL IFIRST ^^ DATA IFIRST/.TRUE./ C IF CONTINUOUS-TONE THEN RETURN. C (NOTE: NO CONTINUOUS-TONE DEVICE CALL INCLUDED IN THIS VERSION.) IF(IDVICE.GT.0) RETURN ^^ C RES = MAXIMUM PICTURE COORDINATE (0.<=COOR.<=RES). C PLTSIZ = SCALE FACTOR TO CONVERT FROM INTERNAL COORDINATES C TO EXTERNAL PICTURE DEVICE COORDINATES. RES=IFX-1 IGO=IDVICE+2 ^^ IF(IGO) 10,20,30 C CALCOMP PLOTTER IS PICTURE DEVICE. 10 IF(IFIRST) CALL PLOTS(X,Y,I) IF(IFIRST) CALL PLOT(0.,0.5,-3) ^^ IFIRST=.FALSE. PLTSIZ=10./RES CALL PLOT(0.,10.,2) CALL PLOT(10.,10.,1) CALL PLOT(10.,0.,1) CALL PLOT(0.,0.,1) ^^ RETURN C HP PLOTTER IS PICTURE DEVICE. 20 WRITE(OUTPUT,21) 21 FORMAT(' ',$) READ(INPUT,22) ^^ANS 22 FORMAT(A1) IF(ANS.NE.'Y') GO TO 20 PLTSIZ=6666./RES WRITE(OUTPUT,23) 23 FORMAT(' PLTL') IX=0 ^^ IY=0 WRITE(OUTPUT,24) IX,IY 24 FORMAT(1X,2I6,'^') DO 25 I=1,3 IX=IX+2222 25 WRITE(OUTPUT,29) IX,IY ^^ DO 26 I=1,3 IY=IY+3333 26 WRITE(OUTPUT,29) IX,IY DO 27 I=1,3 IX=IX-2222 27 WRITE(OUTPUT,29) IX,IY DO 28 ^^I=1,3 IY=IY-3333 28 WRITE(OUTPUT,29) IX,IY 29 FORMAT(1X,2I6) XLAST=0. YLAST=0. RETURN ^^ C TEKTRONIX SCOPE IS PICTURE DEVICE. 30 PLTSIZ=779./RES CALL CLHOA CALL MVTO(244,779) ^^ CALL VCTO(1023,779) CALL VCTO(1023,0) CALL VCTO(244,0) CALL VCTO(244,779) XLAST=244. YLAST=779. ^^ RETURN END SUBROUTINE ENDFRM COMMON/DEVI/ INPUT,OUTPUT,ERROR COMMON/QFORIO/ CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC INTEGER OUTPUT,ERROR ^^ C IF CONTINUOUS-TONE THEN RETURN. C (NOTE: NO CONTINUOUS-TONE DEVICE CALL INCLUDED IN THIS VERSION.) IF(IDVICE.GT.0) RETURN IGO=IDVICE+2 ^^ IF(IGO) 10,20,30 C CALCOMP PLOTTER IS PICTURE DEVICE. 10 CALL PLOT(11.,0.,-3) RETURN ^^ C HP PLOTTER IS PICTURE DEVICE. 20 WRITE(OUTPUT,22) 22 FORMAT(' PLTT') RETURN ^^ C TEKTRONIX SCOPE IS PICTURE DEVICE. 30 CALL MVTO(0,767) CALL ALMODE RETURN END ^^ SUBROUTINE PLTLIN(A,B,C,D) COMMON/DEVI/ INPUT,OUTPUT,ERROR COMMON/PLTTER/ PLTSIZ,XLAST,YLAST COMMON/QFORIO/ CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC DIMENSION X(2),Y(2) INTEGER OUTPUT,ERROR ^^ C IF CONTINUOUS-TONE THEN RETURN. C (NOTE: NO CONTINUOUS-TONE DEVICE CALL INCLUDED IN THIS VERSION.) IF(IDVICE.GT.0) RETURN C SCA^^LE INTERNAL COORDINATES TO DEVICE COORDINTES. X(1)=A*PLTSIZ Y(1)=B*PLTSIZ X(2)=C*PLTSIZ Y(2)=D*PLTSIZ ^^ C IF CONTINUOUS-TONE THEN RETURN. C (NOTE: NO CONTINUOUS-TONE DEVICE CALL INCLUDED IN THIS VERSION.) IGO=IDVICE+2 IF(IGO) 10,20,30 C CALCOMP PLOTTER IS PICTURE DEVICE. ^^ 10 CALL LINE(X,Y,2,1) RETURN C HP PLOTTER IS PICTURE DEVICE. ^^ 20 Y(1)=1.5*Y(1) Y(2)=1.5*Y(2) IF(XLAST.EQ.X(1).AND.YLAST.EQ.Y(1)) GO TO 24 IX=X(1) IY=Y(1) WRITE(OUTPUT,22) IX,IY 22 FORMAT(1X,2I6,'^')^^ 24 X1=X(2)-X(1) Y1=Y(2)-Y(1) ITEST=SQRT(2.25*X1*X1+Y1*Y1) J=ITEST/3333 IF(J.LE.0) GO TO 27 IX=X1 ^^ IY=Y1 IDELX=IX/(J+1) IDELY=IY/(J+1) IX=X(1) IY=Y(1) DO 25 I=1,J ^^ IX=IX+IDELX IY=IY+IDELY 25 WRITE(OUTPUT,28) IX,IY 27 IX=X(2) IY=Y(2) WRITE(OUTPUT,28) IX,IY 28 FORMAT(1X^^,2I6) XLAST=X(2) YLAST=Y(2) RETURN C TEKTRONIX SCOPE IS PICTURE DEVICE. ^^ 30 X(1)=244.+X(1) X(2)=244.+X(2) IF(XLAST.EQ.X(1).AND.YLAST.EQ.Y(1)) GO TO 34 IX=X(1) IY=Y(1) CALL MVTO(IX,IY) ^^ 34 IX=X(2) IY=Y(2) CALL VCTO(IX,IY) XLAST=X(2) YLAST=Y(2) RETURN ^^END SUBROUTINE LABEL(X,Y,CHR,NCNT) COMMON/DEVI/ INPUT,OUTPUT,ERROR COMMON/PLTTER/ PLTSIZ,XLAST,YLAST COMMON/QFORIO/ CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC C IF CONTINUOUS-TONE THEN ^^RETURN. C (NOTE: NO CONTINUOUS-TONE DEVICE CALL INCLUDED IN THIS VERSION.) INTEGER OUTPUT,ERROR IF(IDVICE.GT.0) RETURN C SCALE INTERNAL COORDINATES TO EXTERNAL COORDINST^^ES. XC=X*PLTSIZ YC=Y*PLTSIZ IGO=IDVICE+2 IF(IGO) 10,20,30 ^^ C CALCOMP PLOTTER IS PICTURE DEVICE. 10 CALL SYMBOL(XC,YC,0.1,CHR,0.0,NCNT) RETURN C HP PLOTTER IS PICTURE DEVICE. ^^ 20 RETURN C TEKTRONIX SCOPE IS PICTURE DEVICE. 30 RETURN ^^ END SUBROUTINE SRL(X1,S1R,S1B,S1G,X2,S2R,S2B,S2G,IY) COMMON/CSAVIT/ISAVIT COMMON/QFORIO/CONTRS,IDVICE,IBAD,SHOSHR,LBLSPC COMMON / CORE / IFREST, LEN, IFREPT COMMON / COMNIO / I CNT ^^ COMMON / PGNCNT / IPOLY DIMENSION LINEG(4),LINEB(4),LINER(4) COMMON/LINEF/ICR,LIN4R(128),ICG,LIN4G(128),ICB,LIN4B(128),IFORK DATA IFORK/0/ C PRINT 2, IY, X1,S1G,S1B,S1R, X2,S2G,S2B,S2R C (NOTE:^^ NO CONTINUOUS-TONE DEVICE CALL INCLUDED IN THIS VERSION.) I1=X1+1.5 I2=X2+0.5 IF(I1.NE.1) GO TO 96 I3=1 I4=1 ^^ 96 IF(I1-I2) 97,98,99 97 IF(S1R.EQ.S2R.AND.S1B.EQ.S2B.AND.S1G.EQ.S2G) GO TO 98 DX=I2-I1 DR=(S2R-S1R)/DX DB=(S2B-S1B)/DX DG=(S2G-S1G)/DX ^^ DO 200 I=I1,I2 LINER(I3)=ABS(S1R) LINEB(I3)=ABS(S1B) LINEG(I3)=ABS(S1G) S1R=S1R+DR S1B=S1B+DB ^^ S1G=S1G+DG IF(I3.NE.4) GO TO 200 LIN4R(I4)=LINER(1)*(2**28)+LINER(2)*(2**20) 1 +LINER(3)*(2**10)+LINER(4)*(2**2) LIN4B(I4)=LINEB(1)*(2**28)+LINEB(2)*(2**20) 1 +LINEB(3)*(2**10)+LINEB(4)*(2**2) LIN4G(I4)=LINEG(1)*(2^^**28)+LINEG(2)*(2**20) 1 +LINEG(3)*(2**10)+LINEG(4)*(2**2) I3=0 I4=I4+1 200 I3=I3+1 GO TO 99 98 IR=ABS(S1R) ^^ IG=ABS(S1G) IB=ABS(S1B) DO 300 I=I1,I2 LINER(I3)=IR LINEB(I3)=IB LINEG(I3)=IG ^^ IF(I3.NE.4) GO TO 300 LIN4R(I4)=LINER(1)*(2**28)+LINER(2)*(2**20) 1 +LINER(3)*(2**10)+LINER(4)*(2**2) LIN4B(I4)=LINEB(1)*(2**28)+LINEB(2)*(2**20) 1 +LINEB(3)*(2**10)+LINEB(4)*(2**2) LIN4G(I4)=LINEG(1)*(2**28)+LINEG(2)*(2**20) 1 +LINEG(3)*^^(2**10)+LINEG(4)*(2**2) I3=0 I4=I4+1 300 I3=I3+1 99 IF(I2.LT.511) RETURN I=512-IY I=I*(2**18) ^^ ICG="400000200000+I ICR="410000200000+I ICB="420000200000+I RETURN END C*****************************************************************^^*****C C C C UTILITY.FOR VERSION 1.0(A) SEPTEMBER 1976 C C C C A GENERAL UTILITY ROUTINE FOR BOTH 8 NODE BRICKS AND C C PANEL SYSTEMS. C C C C M^^IKE STEPHENSON HANK CHRISTIANSEN C C DEPARTMENT OF CIVIL ENGR. CIVIL ENGINEERING DEPT. C C AND ENGINEERING MECHANICS 368E ESTB C C THE UNIVERSITY OF ARIZONA BRIGHAM YOUNG UNIVERSITY C C TUCSON, ARIZONA 85721 PROVO, UTAH 84602 C C (602) 884-4803 (801) 374-1211 X2811 C C ^^ C C**********************************************************************C INTEGER OUTPUT C DIMENSION NPL(2,NPMAX),X(3,NJMAX),IP(8,NPTMAX),U(3,NJMAX) C 1,S(NJMAX) DIMENSION NPL(2,10),X(3,100),IP(8,100),U(3,100),S(1^^00) COMMON/CNTL/ NP,NJ,NPT COMMON/DEVI/ INPUT,OUTPUT C COMMON/FUNC/ SX(2,NJMAX) COMMON/FUNC/ SX(2,100) C COMMON/JUNK/ JNK(8,NPTMAX) COMMON/JUNK/ JNK(8,100) ^^ COMMON/MAXI/ NPMAX,NJMAX,NPTMAX C INPUT AND OUTPUT ARE SET BELOW FOR THE DECSYSTEM-10 INPUT=-4 OUTPUT=-1 NPMAX=10 ^^ NJMAX=100 NPTMAX=100 C TYPE TITLE FOR USER INFORMATION WRITE(OUTPUT,10) ^^ 10 FORMAT(' ') C INITIALIZE CONTROL VARIABLES AND REQUEST DATA TYPE NJ=0 NP=0 ^^ NPT=0 NTYPE=4 WRITE(OUTPUT,20) 20 FORMAT(' '$) READ(INPUT,100) WORD IF(WORD.EQ.'S') NTYPE=8 IF(NTYPE.^^EQ.4) NPTMAX=2*NPTMAX C REQUEST COMMAND AND PROCEED 30 WORD=CMD(1) IF(WORD.EQ.'GEOM') CALL GEOM(NPL,X,IP,NTYPE) IF(WORD.EQ.'DISP') CALL DISP(U) ^^ IF(WORD.EQ.'FUNC') CALL SFUN(IP,S,NTYPE) IF(WORD.EQ.'SYMM') CALL SYMM(NPL,X,IP,U,S,NTYPE) IF(WORD.EQ.'ORDE') CALL ORDER(NPL,IP,NTYPE) IF(WORD.EQ.'HELP'.OR.WORD.EQ.'?'.OR.WORD.EQ.' ') CALL HELP(1) GO TO 30 ^^ 100 FORMAT(A1) END FUNCTION CMD(INDX) INTEGER OUTPUT DIMENSION CHR(3) COMMON/DEVI/ INPUT,OUTPUT ^^DATA CHR/' >',' >>',' >>>'/ C TYPE COMMAND PROMPT WRITE(OUTPUT,100) CHR(INDX) 100 FORMAT(A5,$) ^^ C ACCEPT COMMAND WORD READ(INPUT,200) CMD 200 FORMAT(A4) IF(CMD.EQ.'EXIT') CALL EXIT ^^ RETURN END SUBROUTINE HELP(INDX) INTEGER OUTPUT COMMON/DEVI/ INPUT,OUTPUT ^^ C JUMP TO APPROPRIATE HELP MESSAGE GO TO (100,200,300,400),INDX C LEVEL ONE HELP MESSAGE 100 WRITE(OUTPUT,11^^0) 110 FORMAT(' ') RETURN C LEVEL TWO HELP MESSAGE ^^ 200 WRITE(OUTPUT,210) 210 FORMAT(' ') RETURN C LEVEL THREE HELP MESSAGE (ALL BUT GEOM-CHAN) ^^ 300 WRITE(OUTPUT,310) 310 FORMAT(' ') RETURN C LEVEL THREE HELP MESSAGE (GEOM-CHAN ONLY) 400 WRITE(^^OUTPUT,410) 410 FORMAT(' ') RETURN END SUBROUTINE OVER(INDX) INTEGER OUTPUT COMMON/DEVI/ INPUT,OUTPUT ^^ COMMON/MAXI/ NPMAX,NJMAX,NPTMAX C JUMP TO APPROPRIATE ERROR MESSAGE GO TO (500,600,700),INDX ^^ C ERROR: NP .GT. NPMAX 500 WRITE(OUTPUT,510) NPMAX 510 FORMAT(' ?') STOP C ^^ ERROR: NJ .GT. NJMAX 600 WRITE(OUTPUT,610) NJMAX 610 FORMAT(' ?') STOP C ERROR: NPTMAX .GT. N^^PTMAX 700 WRITE(OUTPUT,710) NPTMAX 710 FORMAT(' ?') STOP END SUBROUTINE GEOM(NPL,X,IP,NTYPE) ^^ INTEGER OUTPUT DIMENSION NPL(2,1),X(3,1),IP(NTYPE,1) DIMENSION II(8) COMMON/CNTL/ NP,NJ,NPT COMMON/DEVI/ INPUT,OUTPUT COMMON/JUNK/ JP(1) ^^ COMMON/MAXI/ NPMAX,NJMAX,NPTMAX C REQUEST COMMAND WORD. RETURN IF BLANK. 100 WORD=CMD(2) IF(WORD.EQ.' ') RETURN ^^ C READ GEOMETRY FILE IF(WORD.NE.'READ') GO TO 200 CALL RDGEOM(NPL,X,IP,NTYPE) GO TO 100 ^^ C WRITE GEOMETRY FILE 200 IF(WORD.NE.'WRIT') GO TO 300 CALL WRGEOM(NPL,X,IP,NTYPE) GO TO 100 ^^ C CHANGE GEOMETRY FILE 300 IF(WORD.NE.'CHAN') GO TO 800 310 WORD=CMD(3) IF(WORD.EQ.' ') GO TO 100 C MOV^^E ELEMENTS IF(WORD.NE.'MOVE') GO TO 400 330 WRITE(OUTPUT,340) 340 FORMAT(' '$) READ(INPUT,1000) I1,I2,I3 IF(I1.EQ.0) GO TO 310 ^^ IF(I2.EQ.1) GO TO 350 I5=I2-1 CALL MOVE(IP,JP,1,I5,1,NTYPE) 350 I5=I1+I2-1 J4=NPT-I1+1 CALL MOVE(IP,JP,I2,I5,J4,NTYPE) ^^ 360 I4=I1+I2 IF(I4.GT.NPT) GO TO 370 CALL MOVE(IP,JP,I4,NPT,I2,NTYPE) 370 IF(I3.EQ.0) GO TO 380 CALL MOVE(JP,IP,1,I3,1,NTYPE) 380 I4=I3+1 ^^ I5=NPT-I1 IF(I5.LT.I4) GO TO 390 J4=I1+I3+1 CALL MOVE(JP,IP,I4,I5,J4,NTYPE) 390 I4=NPT-I1+1 J4=I3+1 IF(I2.LT.I3) J4=J4^^-I1 CALL MOVE(JP,IP,I4,NPT,J4,NTYPE) GO TO 330 C PART GROUPS 400 IF(WORD.NE.'GROU') GO TO 500 ^^ WRITE(OUTPUT,410) 410 FORMAT(' '$) READ(INPUT,1000) NP IF(NP.GT.NPMAX) CALL OVER(1) WRITE(OUTPUT,430) 430 FORMAT(' ') ^^ READ(INPUT,1000) (NPL(1,I),I=1,NP) NPT=0 DO 440 I=1,NP 440 NPT=NPT+NPL(1,I) IF(NPT.GT.NPTMAX) CALL OVER(3) GO TO 310 ^^ C COORDINATES 500 IF(WORD.NE.'COOR') GO TO 600 WRITE(OUTPUT,510) 510 FORMAT(' '$) READ(INPUT,520) ANS ^^ 520 FORMAT(A1) IF(ANS.NE.'Y') GO TO 540 WRITE(OUTPUT,530) 530 FORMAT(' '$) READ(INPUT,1000) NJ IF(NJ.GT.NJMAX) CALL OVER(2) ^^ 540 WRITE(OUTPUT,550) 550 FORMAT(' '$) READ(INPUT,560) I,X1,X2,X3 560 FORMAT(I,3E) IF(I.EQ.0) GO TO 310 IF(I.GT.NJMAX) CALL OVER(2) ^^IF(I.GT.NJ) NJ=I X(1,I)=X1 X(2,I)=X2 X(3,I)=X3 GO TO 540 C ELEMENTS ^^ 600 IF(WORD.NE.'ELEM') GO TO 700 605 WRITE(OUTPUT,610) 610 FORMAT(' '$) READ(INPUT,615) WORD 615 FORMAT(A1) ^^ IF(WORD.EQ.'A') GO TO 620 IF(WORD.EQ.'D') GO TO 650 GO TO 605 C ADD ELEMENTS ^^ 620 WRITE(OUTPUT,625) 625 FORMAT(' '$) READ(INPUT,1000) J1,(II(I),I=1,NTYPE) IF(J1.EQ.0) GO TO 310 NP1=1 DO 630 I=1,J1 630 NP1=NP1+NPL(1,I^^) IF(NP1.GT.NPTMAX) CALL OVER(3) IF(NP1.GT.NPT) GO TO 640 J3=NPT+1 DO 638 J=NP1,NPT J2=J3-1 DO 634 I=1,NTYPE ^^ 634 IP(I,J3)=IP(I,J2) 638 J3=J2 640 DO 645 I=1,NTYPE 645 IP(I,NP1)=II(I) NPT=NPT+1 NPL(1,J1)=NPL(1,J1)+1 ^^ GO TO 620 C DELETE ELEMENTS 650 WRITE(OUTPUT,625) READ(INPUT,1000) J1,(II(I),I=1,NTYPE) IF(J1.^^EQ.0) GO TO 310 NP2=0 DO 655 I=1,J1 655 NP2=NP2+NPL(1,I) NP1=NP2-NPL(1,J1)+1 DO 664 J=NP1,NP2 J2=J+1 ^^ J3=0 DO 660 I=1,NTYPE IF(IP(I,J).NE.II(I)) GO TO 664 J3=J3+1 IF(J3.EQ.NTYPE) GO TO 670 660 CONTINUE ^^ 664 CONTINUE WRITE(OUTPUT,668) 668 FORMAT(' %') GO TO 650 670 DO 675 I=J2,NPT J3=I-1 ^^ DO 675 J=1,NTYPE 675 IP(J,J3)=IP(J,I) NPT=NPT-1 NPL(1,J1)=NPL(1,J1)-1 GO TO 650 C TYPE HELP MESSAGE IF ^^COMMAND NOT RECOGNIZED 700 CALL HELP(4) GO TO 310 C PRINT DATA ON TTY ^^ 800 IF(WORD.NE.'PRIN') GO TO 900 810 WORD=CMD(3) IF(WORD.EQ.' ') GO TO 100 C PART GROUPS ^^ IF(WORD.NE.'GROU') GO TO 840 WRITE(OUTPUT,820) (NPL(1,I),I=1,NP) 820 FORMAT(' '/(1X,10I4)) GO TO 810 C COORDINATES ^^ 840 IF(WORD.NE.'COOR') GO TO 860 845 WRITE(OUTPUT,850) 850 FORMAT(' '$) READ(INPUT,1000) I1,I2 IF(I2.GT.NJ) I2=NJ IF(I1.EQ.0) GO TO 810 ^^ WRITE(OUTPUT,855) (J,(X(I,J),I=1,3),J=I1,I2) 855 FORMAT(1X,I4,1P3E12.4) GO TO 845 C ELEMENTS ^^ 860 IF(WORD.NE.'ELEM') GO TO 890 865 WRITE(OUTPUT,870) 870 FORMAT(' '$) READ(INPUT,1000) I1,I2 IF(I2.GT.NPT) I2=NPT IF(I1.EQ.0) GO TO 810 IF(^^NTYPE.EQ.4) TYPE 875,(J,(IP(I,J),I=1,4),J=I1,I2) 875 FORMAT(1X,5I5) IF(NTYPE.EQ.8) TYPE 885,(J,(IP(I,J),I=1,8),J=I1,I2) 885 FORMAT(1X,9I5) GO TO 865 C TYPE HELP MESSAGE IF COMMAN^^D NOT RECOGNIZED 890 CALL HELP(3) GO TO 810 C TYPE HELP MESSAGE IF COMMAND NOT RECOGNIZED ^^ 900 CALL HELP(2) GO TO 100 1000 FORMAT(20I) END SUBROUTINE DISP(U) ^^ INTEGER OUTPUT DIMENSION U(3,1) COMMON/CNTL/ NP,NJ,NPT COMMON/DEVI/ INPUT,OUTPUT COMMON/MAXI/ NPMAX,NJMAX,NPTMAX C REQUEST COMMAND WO^^RD. RETURN IF BLANK. 100 WORD=CMD(2) IF(WORD.EQ.' ') RETURN C READ DISPLACEMENT FILE ^^ IF(WORD.NE.'READ') GO TO 200 CALL RDDISP(U,NJ) GO TO 100 C WRITE DISPLACEMENT FILE ^^ 200 IF(WORD.NE.'WRIT') GO TO 300 CALL WRDISP(U,NJ) GO TO 100 C CHANGE DISPLACEMENTS 300 IF(WORD.N^^E.'CHAN') GO TO 400 310 WRITE(OUTPUT,320) 320 FORMAT(' '$) READ(INPUT,330) I,X1,X2,X3 330 FORMAT(I,3E) IF(I.EQ.0) GO TO 100 IF(I.GT.NJMAX) CALL OVER(2) ^^ U(1,I)=X1 U(2,I)=X2 U(3,I)=X3 GO TO 310 C PRINT DISPLACEMENTS ON TTY ^^ 400 IF(WORD.NE.'PRIN') GO TO 500 405 WRITE(OUTPUT,410) 410 FORMAT(' '$) READ(INPUT,420) I1,I2 420 FORMAT(2I) ^^IF(I1.EQ.0) GO TO 100 IF(I2.GT.NJ) I2=NJ WRITE(OUTPUT,430) (J,(U(I,J),I=1,3),J=I1,I2) 430 FORMAT(1X,I4,1PE12.4) GO TO 405 C TYPE HELP MESSAGE IF COM^^MAND NOT RECOGNIZED 500 CALL HELP(2) GO TO 100 END SUBROUTINE SFUN(IP,S,NTYPE) INTEGER OUTPUT ^^ DIMENSION IP(NTYPE,1),S(1) COMMON/CNTL/ NP,NJ,NPT COMMON/DEVI/ INPUT,OUTPUT COMMON/MAXI/ NPMAX,NJMAX,NPTMAX C REQUEST COMMAND WORD. RETURN IF BLANK. ^^ 100 WORD=CMD(2) IF(WORD.EQ.' ') RETURN C READ SCALAR FUNCTION FILE IF(WORD.NE.'REA^^D') GO TO 200 CALL RDSFUN(IP,S,NTYPE) GO TO 100 C WRITE SCALAR FUNCTION FILE 200 IF(WORD.NE.'WRIT') GO TO 300 ^^ CALL WRSFUN(S) GO TO 100 C CHANGE SCALAR FUNCTIONS 300 IF(WORD.NE.'CHAN') GO TO 400 ^^ 310 WRITE(OUTPUT,320) 320 FORMAT(' '$) READ(INPUT,330) I,X1 330 FORMAT(I,E) IF(I.EQ.0) GO TO 100 IF(I.GT.NJMAX) CALL OVER(2) S(I)=X^^1 GO TO 310 C PRINT SCALAR FUNCTIONS ON TTY 400 IF(WORD.NE.'PRIN') GO TO 500 410 WRITE(OUTPUT,420) ^^ 420 FORMAT(' '$) READ(INPUT,430) I1,I2 430 FORMAT(2I) IF(I1.EQ.0) GO TO 310 IF(I2.LT.I1) I2=I1 IF(I1.GT.NJ) GO TO 410 ^^ IF(I2.GT.NJ) I2=NJ WRITE(OUTPUT,440) (I,S(I),I=I1,I2) 440 FORMAT(1X,I4,1PE12.4) GO TO 410 C TYPE HELP MESSAGE IF COMMAND NOT RECOGNIZED ^^ 500 CALL HELP(2) GO TO 100 END SUBROUTINE SYMM(NPL,X,IP,U,S,NTYPE) INTEGER OUTPUT DIMENSION NPL(2,1),X(^^3,1),IP(NTYPE,1),U(3,1),S(1) COMMON/CNTL/ NP,NJ,NPT COMMON/DEVI/ INPUT,OUTPUT COMMON/JUNK/ IX(1) COMMON/MAXI/ NPMAX,NJMAX,NPTMAX LOGICAL MULTI ^^ C REQUEST SYMMETRY PLANE. RETURN IF BLANK. 100 WRITE(OUTPUT,110) 110 FORMAT(' '$) READ(INPUT,120) SYMP 120 FORMAT(A2) ^^ IF(SYMP.EQ.' ') RETURN ISYM=0 IF(SYMP.EQ.'XY') ISYM=3 IF(SYMP.EQ.'XZ') ISYM=2 IF(SYMP.EQ.'YZ') ISYM=1 IF(ISYM.EQ.0) GO TO 100 ^^ C MULTIPLE DISPLACEMENT AND SCALAR FUNCTION FILES? WRITE(OUTPUT,200) 200 FORMAT(' '$) READ(INPUT,210) ANS 210 FORMAT(A1) ^^ MULTI=ANS.EQ.'Y' C ARRAY IX GETS SYMMETRY MAPPING OF NODE NUMBERS IF(NP+NP.GT.NPMAX) CALL OVER(1) IF(NPT+NPT.GT.NPTMAX) CALL OVER(3) ^^ NPT=0 DO 300 I=1,NP NPT=NPT+NPL(1,I) 300 NPL(1,I+NP)=NPL(1,I) K=0 DO 310 I=1,NJ IX(^^I)=I+NJ-K IF(X(ISYM,I).NE.0.0) GO TO 310 IX(I)=I K=K+1 310 CONTINUE IF(NJ+NJ-K.GT.NJMAX) CALL OVER(2) ^^ C USE ARRAY IX TO FORM SYMMETRY ELEMENTS DO 400 J=1,NPT J1=J+NPT DO 400 I=1,NTYPE,2 I1=IP(I,J) ^^ I2=IP(I+1,J) IP(I+1,J1)=IX(I1) IP(I,J1)=IX(I2) 400 CONTINUE C USE ARRAY IX TO FORM SYMMETRY COORDINATES ^^ DO 510 J=1,NJ J1=IX(J) IF(J1.LE.NJ) GO TO 510 DO 500 I=1,3 500 X(I,J1)=X(I,J) X(ISYM,J1)=-X(ISYM^^,J1) 510 CONTINUE NFILES=0 IF(.NOT.MULTI) GO TO 615 C USE ARRAY IX TO FORM SYMMETRY DISPLACEMENTS ^^ WRITE(OUTPUT,600) 600 FORMAT(' '$) READ(INPUT,610) NFILES 610 FORMAT(I) 615 DO 640 N=1,NFILES IF(MULTI) CALL RDDISP(U) ^^ DO 630 J=1,NJ J1=IX(J) IF(J1.LE.NJ) GO TO 630 DO 620 I=1,3 620 U(I,J1)=U(I,J) U(ISYM,J1)=-U(ISYM,J1) 630 CONTINUE ^^ IF(MULTI) CALL WRDISP(U) 640 CONTINUE IF(.NOT.MULTI) GO TO 715 C USE ARRAY IX TO FORM SYMMETRY SCALAR FUCTIONS ^^ 700 WRITE(OUTPUT,710) 710 FORMAT(' '$) READ(INPUT,610) NFILES 715 DO 730 N=1,NFILES IF(MULTI) CALL RDSFUN(IP,S,NTYPE) DO 720 J=1,NJ ^^ J1=IX(J) IF(J1.LE.NJ) GO TO 720 S(J1)=S(J) 720 CONTINUE IF(MULTI) CALL WRSFUN(S) 730 CONTINUE ^^ C CALCULATE NEW VALUES FOR NP, NJ, AND NPT 800 NP=NP+NP NJ=NJ+NJ-K NPT=NPT+NPT RETURN ^^ END SUBROUTINE MOVE(IP,IQ,L,M,N,NTYPE) DIMENSION IP(NTYPE,1),IQ(NTYPE,1) C MOVE ELEMENTS L THRU M OF IP TO IQ STARTING AT N+1 ^^ J1=N-L DO 10 J=L,M J2=J+J1 DO 10 I=1,NTYPE 10 IQ(I,J2)=IP(I,J) ^^ RETURN END SUBROUTINE ORDER(NPL,IP,NTYPE) INTEGER OUTPUT DIMENSION NPL(2,1),IP(NTYPE,1) COMMON/CNTL/ NP,NJ,NPT COMMON/DEVI/ IN^^PUT,OUTPUT C NOT AVAILABLE FOR SOLID DATA IF(NTYPE.EQ.4) GO TO 200 WRITE(OUTPUT,100) 100 FORMAT(' %') RETURN C PROCESS EACH PART INDIVIDUALLY 200 M2=0 DO 600 N=1,NP ^^ M1=M2+1 M2=M2+NPL(1,N) M3=M1+1 C COMPARE THE NTH THRU LAST ELEMENT WITH THOSE ALREADY ORDERED DO 500^^ M=M3,M2 L1=M-1 L2=L1+M1 IPT=M C SEARCH THE PREVIOUSLY ORDERED POLYGONS BACKWARDS ^^ 210 DO 400 L3=M1,L1 L=L2-L3 C SEARCH FOR A CORRESPONDING NODE NUMBER THEN CHECK LINE C SEGMENT FORWARD AND BACKWARD ^^ DO 300 K=1,4 DO 250 J=1,4 IF(IP(J,IPT).NE.IP(K,L).OR.IP(J,IPT).EQ.0) GO TO 250 J1=J+1 IF(J1.GT.4.OR.IP(J1,IPT).EQ.0) J1=1 K1=K+1 ^^ IF(K1.GT.4.OR.IP(K1,L).EQ.0) K1=1 J2=J-1 IF(J2.LT.1) J2=4 IF(IP(J2,IPT).EQ.0) J2=3 K2=K-1 IF(K2.LT.1) K2=4 IF(IP(K2,L).EQ.0) K2=^^3 IF(IP(J1,IPT).EQ.IP(K1,L).OR.IP(J2,IPT).EQ.IP(K2,L)) GO TO 220 IF(IP(J2,IPT).NE.IP(K1,L).AND.IP(J1,IPT).NE.IP(K2,L)) GO TO 400 GO TO 450 C REVERSE POLYGON NODES IF NOT CONSISTENT WITH PROCESSED DATA ^^ 220 ITEMP=IP(1,IPT) IP(1,IPT)=IP(3,IPT) IP(3,IPT)=ITEMP GO TO 450 250 CONTINUE 300 CONTINUE ^^ 400 CONTINUE C IF CURRENT POLYGON DOES NOT MATCH ANY PREVIOUS POLYGON, C MOVE POINTER TO NEXT POLYGON AND TRY AGAIN IPT=IPT+1 IF(IPT.LE.M2^^) GO TO 210 C IF POINTER IS GREATER THAN THE NUMBER OF ELEMENTS, THEN C THIS POLYGONS HAS NO NEIGHBOR WRITE(OUTPUT,410) M 410 FORMAT(' %') GO TO 500 C IF THE LAST ORDERED POLYGON IS NOT THE SAME AS THE CURRENT C POLYGON, THEN EXCHANGE THEM 450 IF(IPT.EQ.M) GO TO 500 ^^ DO 460 I=1,4 ITEMP=IP(I,M) IP(I,M)=IP(I,IPT) 460 IP(I,IPT)=ITEMP 500 CONTINUE 600 CONTINUE ^^ RETURN END SUBROUTINE OPEN(FILEID,IUNIT,IOP,IERROR) C SUBROUTINE OPEN REQUEST FILENAME AND OPENS FILE FOR I/O ^^ C SUBPROGRAMS CALLED C OPEN = SYSTEM OPEN FILE ROUTINE C VARIABLES USED C FILEID = 5 ASCII CHARACTER ID C IUNIT = DEVICE LOGICAL NUMBER ^^ C IOP = 1 FOR INPUT FILE C = -1 FOR OUTPUT FILE C IERROR = 1 ON SUCCESSFUL COMPLETION C = 0 ON EMPTY FILE SPECIFICATION C = -1 ON FAILURE ^^ DOUBLE PRECISION ASEQ,BLANK,XNAME INTEGER OUTPUT COMMON/DEVI/ INPUT,OUTPUT DATA DSK/'DSK'/,MTA/'MTA'/ DATA BLANK/' '/ IERROR=0 ^^ OPTYPE='READ' IF(IOP.LT.0) OPTYPE='WRITE' WRITE(OUTPUT,10) OPTYPE,FILEID 10 FORMAT(' <',A5,1X,A5,' FILE> '$) READ(INPUT,20) XNAME 20 FORMAT(A10) ^^ IF(XNAME.EQ.BLANK) RETURN IERROR=1 IUNIT=10 ASEQ='SEQIN' IF(IOP.LT.0) ASEQ='SEQOUT' OPEN(UNIT=IUNIT,DEVICE=DSK,FILE=XNAME,ACCESS=ASEQ,MODE='ASCII') ^^ RETURN END SUBROUTINE RDGEOM(NPL,X,IP,N) INTEGER OUTPUT DIMENSION NPL(2,1),X(3,1),IP(N,1) COMMON/CNTL/ NP,NJ,NPT COMMON/DE^^VI/ INPUT,OUTPUT COMMON/MAXI/ NPMAX,NJMAX,NPTMAX DATA IREAD/1/ C REQUEST FILE INFORMATION 10 CALL OPEN('GEOM.',IUNIT,IREAD,IER^^R) IF(IERR) 10,50,20 C READ GEOMETRY 20 READ(IUNIT,120) NP,NJ,NPT IF(NP.GT.NPMAX) CALL OVER(1) ^^ IF(NJ.GT.NJMAX) CALL OVER(2) IF(NPT.GT.NPTMAX) CALL OVER(3) READ(IUNIT,120) ((NPL(I,J),I=1,2),J=1,NP) READ(IUNIT,130) ((X(I,J),I=1,3),J=1,NJ) READ(IUNIT,120) ((IP(I,J),I=1,N),J=1,NPT) WRITE(OUTPUT,22) ((NPL(I,J),I=1,2),J=1,NP) 22 ^^FORMAT(' '/(1X,10I5)) NPT1=0 DO 24 J=1,NP NPL(1,J)=NPL(2,J)-NPL(1,J)+1 NPL(2,J)=0 24 NPT1=NPT1+NPL(1,J) IF(NPT1.NE.NPT) GO TO 30^^ WRITE(OUTPUT,28) (NPL(1,J),J=1,NP) 28 FORMAT(' '/(1X,10I5)) WRITE(OUTPUT,140) READ(INPUT,150) ANS IF(ANS.NE.'Y') GO TO 34 RETURN ^^ C REQUEST PART GROUPINGS 30 WRITE(OUTPUT,32) 32 FORMAT(' ') 34 WRITE(OUTPUT,36) ^^ 36 FORMAT(' '$) READ(INPUT,100) NP IF(NP.GT.NPMAX) CALL OVER(1) DO 38 J=1,NP 38 NPL(2,J)=0 WRITE(OUTPUT,40) 40 FORMAT(' ') READ(INPUT,100) (NPL(1,I),I=1,NP) 50 RETURN 100 FORMAT(20I) 120 FORMAT(20I4) 130 FORMAT(1P6E12.5) ^^ 140 FORMAT(' '$) 150 FORMAT(A1) END SUBROUTINE WRGEOM(NPL,X,IP,N) INTEGER OUTPUT DIMENSION NPL(2,1),X(3,1),IP(N,1) ^^ COMMON/CNTL/ NP,NJ,NPT COMMON/DEVI/ INPUT,OUTPUT COMMON/MAXI/ NPMAX,NJMAX,NPTMAX DATA IWRITE/-1/ C REQUEST FILE INFORMATION ^^ 60 CALL OPEN('GEOM.',IUNIT,IWRITE,IERR) IF(IERR) 60,95,70 C REQUEST ELEMENT LIMITS FOR PARTS LIST 70 NPT1=0 ^^ DO 74 J=1,NP NPL(2,J)=NPT1+NPL(1,J) NPL(1,J)=NPT1+1 74 NPT1=NPL(2,J) WRITE(OUTPUT,78) ((NPL(I,J),I=1,2),J=1,NP) 78 FORMAT(' '/(1X,10I5)) ^^ WRITE(OUTPUT,140) READ(INPUT,150) ANS IF(ANS.EQ.'Y') GO TO 90 WRITE(OUTPUT,80) 80 FORMAT(' '$) READ(INPUT,100) NP ^^ IF(NP.GT.NPMAX) CALL OVER(1) WRITE(OUTPUT,85) 85 FORMAT(' ') READ(INPUT,100) ((NPL(I,J),I=1,2),J=1,NP) C WRITE GEOMETRY FILE ^^ 90 WRITE(IUNIT,120) NP,NJ,NPT WRITE(IUNIT,120) ((NPL(I,J),I=1,2),J=1,NP) WRITE(IUNIT,130) ((X(I,J),I=1,3),J=1,NJ) WRITE(IUNIT,120) ((IP(I,J),I=1,N),J=1,NPT) 95 RETURN ^^ 100 FORMAT(20I) 120 FORMAT(20I4) 130 FORMAT(6E12.5) 140 FORMAT(' '$) 150 FORMAT(A1) ^^ END SUBROUTINE RDSFUN(IP,S,N) INTEGER OUTPUT DIMENSION IP(N,1),S(1) COMMON/CNTL/ NP,NJ,NPT COMMON/DEVI/ INPUT,OUTPUT COMMON/JUNK/^^ SX(2,1) DATA IREAD/1/ C REQUEST FILE INFORMATION 10 CALL OPEN('SFUN.',IUNIT,IREAD,IERR) IF(IERR) 10,80,20 ^^ C ARE THE SCALAR FUNCTIONS DEFINED AT THE ELEMENT CENTERS? 20 WRITE(OUTPUT,30) 30 FORMAT(' '$) READ(INPUT,40) ANS ^^ 40 FORMAT(A1) N1=NJ IF(ANS.EQ.'Y') N1=NPT C READ SCALAR FUNCTIONS REA^^D(IUNIT,100) (S(I),I=1,N1) IF(N1.EQ.NJ) RETURN C DO SIMPLE INTERPOLATION IF AT ELEMENT CENTERS. DO 50 J=1,NJ SX(1,J)=0. ^^ 50 SX(2,J)=0. DO 60 J=1,NPT DO 60 I=1,N I1=IP(I,J) SX(1,I1)=S(J)+SX(1,I1) 60 SX(2,I1)=1.0+SX(2,I1) ^^ DO 70 I=1,NJ 70 S(I)=SX(1,I)/SX(2,I) 80 RETURN 100 FORMAT(6E12.5) END ^^ SUBROUTINE WRSFUN(S) INTEGER OUTPUT DIMENSION S(1) COMMON/CNTL/ NP,NJ,NPT COMMON/DEVI/ INPUT,OUTPUT DATA IWRITE/-1/ ^^ C REQUEST FILE INFORMATION 85 CALL OPEN('SFUN.',IUNIT,IWRITE,IERR) IF(IERR) 85,95,90 C WRITE SCALAR FUNCTIONS ^^ 90 WRITE(IUNIT,110) (S(I),I=1,NJ) 95 RETURN 110 FORMAT(1P6E12.5) END ^^ SUBROUTINE RDDISP(U) INTEGER OUTPUT DIMENSION U(3,1) COMMON/CNTL/ NP,NJ,NPT COMMON/DEVI/ INPUT,OUTPUT DATA IREAD/1/ ^^ C REQUEST FILE INFORMAT 10 CALL OPEN('DISP.',IUNIT,IREAD,IERR) IF(IERR) 10,30,20 C READ DISPLACEMENTS ^^ 20 READ(IUNIT,100) ((U(I,J),I=1,3),J=1,NJ) 30 RETURN 100 FORMAT(6E12.5) END ^^ SUBROUTINE WRDISP(U) INTEGER OUTPUT DIMENSION U(3,1) COMMON/CNTL/ NP,NJ,NPT COMMON/DEVI/ INPUT,OUTPUT DATA IWRITE/-1/ ^^ C REQUEST FILE INFORMAT 50 CALL OPEN('DISP.',IUNIT,IWRITE,IERR) IF(IERR) 50,70,60 C WRITE DISPLACEMENTS ^^ 60 WRITE(IUNIT,110) ((U(I,J),I=1,3),J=1,NJ) 70 RETURN 110 FORMAT(1P6E12.5) END ^^ C**********************************************************************C C C C SECTION.FOR VERSION 1.0(A) SEPTEMBER 1976 C C C C SECTION.FOR - CLIPS AND CAPS EIGHT NODE BRICK THREE-DIMENSIONAL C C FINITE ELEMENT MODELS, ELEMINATES INTERIOR POLYGONS, AND C ^^ C MODIFIES DISPLACEMENT AND SCALAR FUNCTIONS TO REFLECT THIS C C NEW GEOMETRY. C C C C MIKE STEPHENSON HANK CHRISTIANSEN C C DEPARTMENT OF CIVIL ENGR. CIVIL ENGINEERING DEPT. C C AND ENGINEERING MECHANICS 368E ESTB C C THE UNIVERSIT^^Y OF ARIZONA BRIGHAM YOUNG UNIVERSITY C C TUCSON, ARIZONA 85721 PROVO, UTAH 84602 C C (602) 884-4803 (801) 374-1211 X2811 C C C C**********************************************************************C C SUBPROGRAMS CALLED ^^ C RDCNTL = READS CONTROL VARIABLES C RDGEOM = READS GEOMETRY C PLFILE = CLIPPING PLANE DEFINITION ROUTINE C DIST = DISTANCE TO CLIPPING PLANE ROUTINE C SOLID = CLIPPING AND CAPPING ROUTINE C PLYSRT = POLYGON SORTING ROUTINE ^^ C REDUCE = DATA REDUCTION ROUTINE C TRANS = DATA TRANSFORMATION ROUTINE C WRGEOM = WRITES GEOMETRY FILE C RDDISP = READS DISPLACEMENT FILE C WRDISP = WRITES DISPLACEMENT FILE C RDSFUN = READS SCALAR FUNCTION FILE C WRSFUN^^ = WRITES SCALAR FUNCTION FILE C VARIABLES USED C A = COMMON BLOCKSTORAGE C A(N1) = NPL = ELEMENT LIMIT ARRAY BY PART C A(N2) = X = COORDINATE ARRAY BY NODE C A(N3) = IP = CONNECTIV^^ITY ARRAY BY ELEMENT C A(N4) = IPL = CLIPPING PLANE NUMBER BY PART C A(N5) = PLP = POINT ON PLANE BY PART C A(N6) = PLD = NORMAL TO PLANE BY PART C A(N7) = D = DISTANCE TO PLANE BY NODE C = ICOL = NODAL REDUCTION ARRAY C A(N8) = DFAC = PROPORTION OF LINE ARRAY ^^ C A(N9) = IFAC = NODES OF CLIPPED LINE SEGMENTS C A(N10) = NPLN = ELEMENT LIMITS OF CLIPPED PARTS C = U = DISPLACEMENT ARRAY C = S = SCALAR FUNCTION ARRAY C A(N11) = IPN = NEW CONNECTIVITY ARRAY AFTER CLIPPING C = SX = SCALAR FUNCTION INTERPOLATION ARRAY C ^^ = UN = NEW DISPLACEMT ARRAY AFTER TRANSFORM C = SN = NEW SCALAR FUNCTION ARRAY AFTER TRANSFORM C A(N12) = XN = NEW COORDINATE ARRAY AFTER TRANSFORM C NJ = NUMBER OF JOINTS OR NODES C NP = NUMBER OF PARTS C NPT = NUMBER OF ELEMENTS C MTOT = SIZE OF COMMON^^ BLOCK A C IFILES = NUMBER OF DISP. OR FUNC. FILES C IFIL = DISP. OR FUNC. FILE NUMBER C ICOOR = COORDINATE HASH TABLE C IPOLY = POLYGON HASH TABLE C JNK = TEMPORARY COMMON STORAGE C NPN = NUMBER OF PARTS IN NEW GEOMETRY ^^ C NJN = NUMBER OF JOINTS IN NEW GEOMETRY C NPTN = NUMBER OF ELEMENTS IN NEW GEOMETRY C IORD = HEXAHEDRON NODE NUMBER MAP C ITOTAL = NUMBER OF TOTAL STEPS BETWEEN INITAL AND FINAL PLANES C ISTEP = CLIPPING STEP NUMBER C ISIDE = 'FRON' SAVE ONLY POLYGONS IN FRONT OF PLANE ^^ C = 'BACK' SAVE ONLY POLYGONS BEHIND PLANE C = 'BOTH' SAVE ALL POLYGONS C IPLAST = PLANE NUMBER OF LAST CLIPPING PLANE INTEGER OUTPUT COMMON A(10000) COMMON/CONT/^^ NP,NJ,NPT COMMON/DEVI/ INPUT,OUTPUT COMMON/FREE/ MIN,MAX,IAVAIL COMMON/HASH/ ICOOR(128),IPOLY(128) COMMON/JUNK/ JNK(50) COMMON/NCON/ NPN,NJN,NPTN COMMON/ORDR/ IORD(4,6) ^^ COMMON/STEP/ ITOTAL,ISTEP,ISIDE,IPLAST DIMENSION IA(10000) EQUIVALENCE (A,IA) INPUT=-4 OUTPUT=-1 IPLAST=-1 ^^ MTOT=10000 WRITE(OUTPUT,1000) C READ GEOMETRY FILE CAL^^L RDCNTL(NP,NJ,NPT) NPN=4*NP C CALCULATE ARRAY INDEXES NJ2=(NJ+1)/2 N1=1 ^^ N2=N1+2*NP N3=N2+3*(NJ+NJ2) N4=N3+8*NPT N5=N4+NP N6=N5+6*NP N7=N6+6*NP ^^ N8=N7+NJ N9=N8+NJ2 N10=N9+2*NJ2 C READ GEOMETRY ^^ CALL RDGEOM(IA(N1),A(N2),IA(N3)) C READ CLIPPING PLANE DEFINITION CALL PLFILE(IA(N4),A(N5),A(N6)) C CALCULATE VIEWABLE^^ POLYGONS C (PROCEED STEP BY STEP AND PART BY PART) DO 600 ISTEP=1,ITOTAL NPTN=0 NJN=NJ MAX=MTOT ^^ IAVAIL=0 N11=N10+2*NPN C ZERO POLYGON HASH TABLE DO 100 I=1,128 ^^ 100 ICOOR(I)=0 DO 200 K=1,NP KSAFE=K C 2. CALCULATE DISTANCE FROM PLANE ^^ CALL DIST(A(N2),IA(N4),A(N5),A(N6),A(N7),KSAFE) C 3. CALCULATE INTERSECTION N12=N11+4*NPTN MIN=N12 ^^ CALL SOLID(IA(N1),A(N2),IA(N3),IA(N4),A(N7),A(N8),IA(N9),KSAFE) C 4. SORT AND STORE POLYGON LIST CALL PLYSRT(IA(N10),IA(N11),KSAFE) ^^ 200 CONTINUE C SELECT USEABLE DATA AND RENUMBER NODES CALL REDUCE(IA(N7),IA(N11)) C ^^PREFORM TRANSFORMATION OF COORDINATES N12=N11+4*NPTN CALL TRGEOM(A(N2),IA(N7),A(N8),IA(N9),A(N12)) CALL WRGEOM(IA(N10),A(N12),IA(N11)) C PERFORM TRANSFORMATION O^^N DISPLACEMENT AND SPECIAL C FUNCTION FILES N11=N10+3*NJ C 1. DISPLACEMENT FILES ^^ WRITE(OUTPUT,1010) READ(INPUT,1020) IFILES IF(IFILES.LE.0) GO TO 400 DO 300 IFIL=1,IFILES CALL RDDISP(A(N10)) CALL TRDISP(A(N10),IA(N7),A(N8),IA(N9),A(N11)) ^^ 300 CALL WRDISP(A(N11)) C 2. SPECIAL FUNCTION FILES 400 WRITE(OUTPUT,1030) READ(INPUT,1020) IFILES IF(IFILES.LE.0)^^ GO TO 600 DO 500 IFIL=1,IFILES CALL RDSFUN(A(N3),A(N10),A(N11)) CALL TRSFUN(A(N10),IA(N7),A(N8),IA(N9),A(N11)) 500 CALL WRSFUN(A(N11)) 600 IPLAST=-1 ^^ 1000 FORMAT(' '//) 1010 FORMAT(' ',$) 1020 FORMAT(I) 1030 FORMAT(' ',$) END BLOCK DATA ^^ C BLOCK DATA - HEXAHEDRON NODE NUMBER MAP INITIALIZATION C VARIABLES USED C IORD = HEXAHEDRON NODE NUMBER MAP COMMON^^/ORDR/ IORD(4,6) DATA IORD/1,2,3,4,5,8,7,6 1 ,1,5,6,2,4,3,7,8 2 ,1,4,8,5,2,6,7,3/ END ^^ SUBROUTINE OPEN(FILEID,IUNIT,IOP,IERROR) C SUBROUTINE OPEN REQUEST FILENAME AND OPENS FILE FOR I/O C SUBPROGRAMS CALLED C OPEN = SYSTEM OPEN FILE ROUTINE ^^ C VARIABLES USED C FILEID = 5 ASCII CHARACTER ID C IUNIT = DEVICE LOGICAL NUMBER C IOP = 1 FOR INPUT FILE C = -1 FOR OUTPUT FILE C ^^ IERROR = 1 ON SUCCESSFUL COMPLETION C = 0 ON EMPTY FILE SPECIFICATION C = -1 ON FAILURE DOUBLE PRECISION ASEQ,BLANK,XNAME INTEGER OUTPUT COMMON/DEVI/ INPUT,OU^^TPUT DATA DSK/'DSK'/,MTA/'MTA'/ DATA BLANK/' '/ IERROR=0 OPTYPE='READ' IF(IOP.LT.0) OPTYPE='WRITE' ^^ WRITE(OUTPUT,10) OPTYPE,FILEID 10 FORMAT(' <',A5,1X,A5,' FILE> ',$) READ(INPUT,20) XNAME 20 FORMAT(A10) IF(XNAME.EQ.BLANK) RETURN IERROR=1 ^^ IUNIT=10 ASEQ='SEQIN' IF(IOP.LT.0) ASEQ='SEQOUT' OPEN(UNIT=IUNIT,DEVICE=DSK,FILE=XNAME,ACCESS=ASEQ,MODE='ASCII') RETURN END SUBROUTINE R^^DCNTL(NP,NJ,NPT) COMMON/GEOM/ IUNIT,IERR DATA IREAD/1/ C REQUEST FILE INFORMATION 10 CALL OPEN('GEOM.',IUNIT,IREAD,IERR) ^^ IF(IERR) 10,50,20 C READ CONTROL VARIABLES 20 READ(IUNIT,100) NP,NJ,NPT 50 RETURN ^^ 100 FORMAT(20I4) END SUBROUTINE RDGEOM(NPL,X,IP) DIMENSION NPL(2,1),X(3,1),IP(8,1) COMMON/CONT/ NP,NJ,NPT COM^^MON/GEOM/ IUNIT,IERR DATA IREAD/1/ C READ GEOMETRY IF(IERR.EQ.0) RETURN READ(IUNIT,100) ((NPL(I,J),^^I=1,2),J=1,NP) READ(IUNIT,110) ((X(I,J),I=1,3),J=1,NJ) READ(IUNIT,100) ((IP(I,J),I=1,8),J=1,NPT) RETURN 100 FORMAT(20I4) 110 FORMAT(6E12.5) ^^ END SUBROUTINE WRGEOM(NPL,X,JP) DIMENSION NPL(2,1),X(3,1),JP(4,1) COMMON/NCON/ NPN,NJN,NPTN DATA IWRITE/-1/ ^^C REQUEST FILE INFORMATION 60 CALL OPEN('GEOM.',IUNIT,IWRITE,IERR) IF(IERR) 60,90,70 C WRITE GEOMETRY FILE ^^ 70 WRITE(IUNIT,120) NPN,NJN,NPTN WRITE(IUNIT,120) ((NPL(I,J),I=1,2),J=1,NPN) WRITE(IUNIT,130) ((X(I,J),I=1,3),J=1,NJN) WRITE(IUNIT,120) ((JP(I,J),I=1,4),J=1,NPTN) 90 RETURN ^^ 120 FORMAT(20I4) 130 FORMAT(1P6E12.5) END SUBROUTINE RDSFUN(IP,S,SX) INTEGER OUTPUT DIMENSION IP(8,1),S(1),SX(2,1) ^^ COMMON/CONT/ NP,NJ,NPT COMMON/DEVI/ INPUT,OUTPUT DATA IREAD/1/ C REQUEST FILE INFORMATION 10 CALL OPEN^^('SFUN.',IUNIT,IREAD,IERR) IF(IERR) 10,80,20 C ARE THE SCALAR FUNCTIONS DEFINED AT THE ELEMENT CENTERS? 20 WRITE(OUTPUT,30) 30 FORMAT(' ',$) ^^ READ(INPUT,40) ANS 40 FORMAT(A1) N1=NJ IF(ANS.EQ.'Y') N1=NPT C READ SCALAR FUNCTIONS ^^ READ(IUNIT,100) (S(I),I=1,N1) IF(N1.EQ.NJ) RETURN C DO SIMPLE INTERPOLATION IF AT ELEMENT CENTERS. ^^DO 50 J=1,NJ SX(1,J)=0. 50 SX(2,J)=0. DO 60 J=1,NPT DO 60 I=1,8 I1=IP(I,J) SX(1,I1)=S(J)+SX(1,I1) ^^ 60 SX(2,I1)=1.0+SX(2,I1) DO 70 I=1,NJ 70 S(I)=SX(1,I)/SX(2,I) 80 RETURN 100 FORMAT(6E12.5) ^^ END SUBROUTINE WRSFUN(S) INTEGER OUTPUT DIMENSION S(1) COMMON/DEVI/ INPUT,OUTPUT COMMON/NCON/ NPN,NJN,NPTN ^^ DATA IWRITE/-1/ C REQUEST FILE INFORMATION 85 CALL OPEN('SFUN.',IUNIT,IWRITE,IERR) IF(IERR) 85,95,90 ^^ C WRITE SCALAR FUNCTIONS 90 WRITE(IUNIT,110) (S(I),I=1,NJN) 95 RETURN 110 FORMAT(1P6E12.5) ^^ END SUBROUTINE RDDISP(U) DIMENSION U(3,1) COMMON/CONT/ NP,NJ,NPT DATA IREAD/1/ ^^ C REQUEST FILE INFORMAT 10 CALL OPEN('DISP.',IUNIT,IREAD,IERR) IF(IERR) 10,30,20 C READ DISPLACEMENTS ^^ 20 READ(IUNIT,100) ((U(I,J),I=1,3),J=1,NJ) 30 RETURN 100 FORMAT(6E12.5) END SUBROUTINE WRDISP(U) ^^ DIMENSION U(3,1) COMMON/NCON/ NPN,NJN,NPTN DATA IWRITE/-1/ C REQUEST FILE INFORMAT ^^ 50 CALL OPEN('DISP.',IUNIT,IWRITE,IERR) IF(IERR) 50,70,60 C WRITE DISPLACEMENTS 60 WRITE(IUNIT,110) ((U(I,J),I=1,3),J=1,NJN) 70^^ RETURN 100 FORMAT(6E) 110 FORMAT(1P6E12.5) END SUBROUTINE PLFILE(IPL,PLP,PLD) ^^ C SUBROUTINE PLFILE - REQUEST INFORMATION NECESSARY TO DEFINE THE C CLIPPING PLANE FOR EACH PART IN THE MODEL AND ALSO WHICH C DATA IS TO BE SAVED. C VARIABLES USED C IPL = PLANE NUMBER BY PART ^^ C PLP = POINT ON PLANE BY PART C PLD = NORMAL TO PLANE BY PART C ITOTAL = TOTAL STEPS BETWEEN INITIAL AND FINAL PLANES C ISTEP = STEP NUMBER C ISIDE = 'FRON' TO SAVE ONLY POLYGONS IN FRONT OF CLIPPING PLANE C = 'BACK' TO SAVE ONLY POLYGONS BEHIND CLIPPING PLANE ^^ C = 'BOTH' TO SAVE ALL POLYGONS INTEGER OUTPUT DIMENSION IPL(1),PLP(3,2,1),PLD(3,2,1) COMMON/CONT/ NP,NJ,NPT COMMON/DEVI/ INPUT,OUTPUT COMMON/JUNK/^^ K1,K2,PLPJ(3,2),PLDJ(3,2) COMMON/STEP/ ITOTAL,ISTEP,ISIDE C INITIALIZE VARIABLES ITOTAL=1 ISIDE='FRON' ^^ DO 10 I=1,NP 10 IPL(I)=0 N=0 C REQUEST NUMBER OF STEPS ^^ WRITE(OUTPUT,100) READ(INPUT,110) ITTL IF(ITTL-1) RETURN ITOTAL=ITTL C REQUEST PLANE DEFINITION BY PARTS ^^ WRITE(OUTPUT,120) 20 READ(INPUT,110) K1,K2,((PLPJ(I,J),I=1,3) 1,(PLDJ(I,J),I=1,3),J=1,2) IF(K1.LE.0) GO TO 40 N=N+1 IF(K2.LT.K1) K2=K1 ^^ DO 30 K=K1,K2 IPL(K)=N DO 30 J=1,2 DO 30 I=1,3 PLP(I,J,K)=PLPJ(I,J) 30 PLD(I,J,K)=PLDJ(I,J) ^^ GO TO 20 C REQUEST SIDE OF PLANE 40 WRITE(OUTPUT,130) READ(INPUT,140) ISIDE ^^ IF(ISIDE.NE.'FRON'.AND.ISIDE.NE.'BACK') ISIDE='BOTH' RETURN 100 FORMAT(' ',$) 110 FORMAT(2I,12E) 120 FORMAT(' '/ 1 ' ') 130 FORMAT(' ',$) 140 FORMAT(A4) END SUBROUTINE DIST(X,IPL,PLP,PLD,D,N) C SUBROUTINE DIST - CALCULATES DISTANCE FROM CL^^IPPING PLANE TO NODE C VARIABLLS USED C X = COORDINATE ARRAY BY NODE C IPL = CLIPPING PLANE NUMBER BY PART C PLP = POINT ON PLANE BY PART C PLD = NORMAL TO PLANE BY PART ^^ C D = DISTANCE TO PLANE BY NODE C N = PART NUMBER C NJ = NUMBER OF JOINTS OR NODES C NP = NUMBER OF PARTS C NPT = NUMBER OF ELEMENTS C ITOTAL = TOTAL NUMBER OF STEPS BETWEEN CLIPPING PLANES C ISTEP = S^^TEP NUMBER BETWEEN CLIPPING PLANES C ISIDE = DATA SAVE INDICATOR C IPLAST = NUMBER OF LAST CLIPPING PLANE USED DIMENSION X(3,1),IPL(1),PLP(3,2,1),PLD(3,2,1),D(1) COMMON/CONT/ NP,NJ,NPT COMMON/JUNK/ PX(3),PD(3) ^^ COMMON/STEP/ ITOTAL,ISTEP,ISIDE,IPLAST C IF PLANE SAME AS LAST THEN RETURN ELSE ZERO DISTANCE ARRAY IF(IPL(N).EQ.IPLAST) RETURN DO 10 I=1,NJ ^^ 10 D(I)=0.0 IPLAST=IPL(N) IF(IPL(N).EQ.0) RETURN C CALCULATE INTEMEDIATE PLANE DEFINITION ^^STEP=0. IF(ITOTAL-2) GO TO 20 STEP=(ISTEP-1)/(ITOTAL-1) 20 DO 30 I=1,3 PX(I)=PLP(I,1,N)+STEP*(PLP(I,2,N)-PLP(I,1,N)) 30 PD(I)=PLD(I,1,N)+STEP*(PLD(I,2,N)-PLD(I,1,N)) ^^ C CALCULATE DISTANCE TO PLANE DO 40 J=1,NJ D(J)=0. DO 40 I=1,3 40 D(J)=D(J)+(X(I,J)-PX(I))*PD(I) ^^ RETURN END SUBROUTINE SOLID(NPL,X,IP,IPN,D,DFAC,IFAC,L) C SUBROUTINE SOLID - CLIPS AND CAPS HEXAHEDRON ELEMENTS USING C PERPENDICULAR DISTANCE TO PLANE. ^^ C SUBPROGRAMS CALLED C SPLIT = CLIPS INDIVIDUAL POLYGONS ALONG CLIPPING PLANE C LOOKUP = HASH TABLE LOOKUP ROUTINE C ENTER = HASH TABLE ENTER ROUTINE C VARIABLES USED ^^ C NPL = PARTS ARRAY C IP = CONNECTIVITY ARRAY C IPN = CLIPPING PLANE NUMBER ARRAY BY PART C D = DISTANCE TO PLANE BY NODE C DFAC = PROPORTION OF LINE SEGMENT ARRAY C IFAC = NODE NUMBERS OF CLIPPED LINE SEG^^MENTS C ICOOR = COORDINATE HASH TABLE C IPOLY = POLYGON HASH TABLE C L = PART NUMBER C NJ = NUMBER OF JOINTS OR NODES C NP = NUMBER OF PARTS C NPT = NUMBER OF ELEMENTS ^^ C XX = CLIPPED COORDINATE POINT C ITEMP = POLYGON NODE NUMBERS C IPFT = NODE NUMBERS OF POLYGON IN FRONT OF PLANE C IPBT = NODE NUMBERS OF POLYGON BEHIND PLANE C IPPT = NODE NUMBERS OF LINE SEGMENTS OF POLYGON ON PLANE C ISEG = ON-PLANE POLYGON LINE SEGMENTS C NLAST ^^= NUMBER OF LAST POLYGON AFTER SORTING C NCOOR = NUMBER OF LAST NEW COORDINATE ENTERED IN HASH TABLE C IORD = HEXAHEDRON POLYGON NODE NUMBER MAP C KPLACE = INDEX TO HASH TABLE C ITOTAL = TOTAL NUMBER OF STEPS BETWEEN CLIPPING PLANES C ISTEP = STEP NUMBER C ISIDE = 'FRON' TO SAVE ONLY PO^^LYGONS IN FRONT OF CLIPPING PLANE C = 'BACK' TO SAVE ONLY POLYGONS IN BEHIND CLIPPING PLANE C = 'BOTH' TO SAVE ALL POLYGONS C NPLN = POLYGON NUMBER (USED IN SORTING) C L1, L2 = LIMITS OF ELEMENTS IN THIS PART C KEY = KEY USED IN HASH INDEX CALCULATION C ITEST = FRONT, ON-PLANE, BACK POLYGON INDICATOR ^^ C NP2 = COUNT OF ON-PLANE INTERSECTIONS INTEGER OUTPUT DIMENSION NPL(2,1),X(3,1),IP(8,1),IPN(1),D(1),DFAC(1),IFAC(2,1) COMMON/CONT/ NP,NJ,NPT COMMON/DEVI/ INPUT,OUTPUT ^^ COMMON/HASH/ ICOOR(128),IPOLY(128) COMMON/JUNK/ XX(3),ITEMP(4),IPFT(6),IPBT(6),ISEG(6),IPPT(12) COMMON/NCON/ NPN,NCOOR,NLAST COMMON/ORDR/ IORD(4,6) COMMON/SAVE/ KPLACE,IPT COMMON/STEP/ ITOTAL,ISTEP,ISIDE ^^ C GET ELEMENT LIMITS AND ZERO POLYGON HASH TABLE L1=NPL(1,L) L2=NPL(2,L) NPLN=0 DO 4 I=1,128 ^^ 4 IPOLY(I)=0 C REPEAT FOR EACH ELEMENT IN PART DO 95 J=L1,L2 ^^ C ZERO ON-PLANE POLYGON ARRAY NJP=0 DO 5 I=1,12 5 IPPT(I)=0 C REPEAT FOR E^^ACH FACE OF HEXAHEDRON DO 90 K=1,6 C SET ITEMP EQUAL TO POLYGON NODES DO 20 I=1,4 ^^ J1=IORD(I,K) 20 ITEMP(I)=IP(J1,J) C CALCULATE INTERSECTION WITH PLANE; IF MORE THAN TWO C INTERSECTIONS TREAT AS WARPPED QUADRILATERAL. ^^ CALL SPLIT(X,IPN(L),D,DFAC,IFAC,NP2,NPLN) IF(NP2-2) 90,10,21 10 NJP=NJP+2 IPPT(NJP-1)=ISEG(1) IPPT(NJP)=ISEG(2) GO TO 90 ^^ C FIND HIGH NODES AND DIVIDE WARPPED QUADRILATERAL. 21 DO 22 I=1,4 I1=I J1=ITEMP(I) IF(D(J1).GT.0.0) GO TO 24 ^^ 22 CONTINUE DO 23 I=1,4 I1=I J1=ITEMP(I) IF(D(J1).LT.0.0) GO TO 25 ^^ 23 CONTINUE GO TO 100 24 I1=I1-1 25 I2=I1 ^^ DO 27 I=1,3 I2=I2+1 IF(I2.GT.4) I2=I2-4 J1=IORD(I2,K) 27 ITEMP(I)=IP(J1,J) ITEMP(4)=0 ^^ C CALCULATE INTERSECTION WITH POLYGON CALL SPLIT(X,IPN(L),D,DFAC,IFAC,NP2,NPLN) IF(NP2-2) 50,30,100 30 NJP=NJP+2 IPPT(NJP-1)=ISEG(1) ^^ IPPT(NJP)=ISEG(2) C LOAD ITEMP WITH SECOND HALF OF WARPED QUADRILATERAL I2=I1+2 DO 40 I=1,3 ^^ I2=I2+1 IF(I2.GT.4) I2=I2-4 J1=IORD(I2,K) 40 ITEMP(I)=IP(J1,J) ITEMP(4)=0 C CALCULATE^^ POLYGON INTERSECTION 50 CALL SPLIT(X,IPN(L),D,DFAC,IFAC,NP2,NPLN) IF(NP2-2) 90,60,100 60 NJP=NJP+2 IPPT(NJP-1)=ISEG(1) IPPT(NJP)=ISEG(2) ^^ 90 CONTINUE C IF LESS THAN SIX INTERSECTION ON-PLANE THEN JUMP IF(NJP-5) GO TO 95 ^^ C ORDER ON-PLANE POLYGON LINE SEGMENTS CALL ORDER(IPPT,NJP,ITRIA) IF(ITRIA.LE.1) GO TO 93 DO 91 I=1,3 ^^I1=I+3 ITEMP(I)=IPPT(I) IPPT(I)=IPPT(I1) ITEMP(I1)=0 91 IPPT(I1)=0 NJP=3 ^^ C DO LOOKUP AND ENTER FOR ON-PLANE POLYGON NPLN=NPLN+1 KEY=0 DO 92 I=1,NJP 92 KEY=KEY+ITEMP(I) ^^ ITEST=524288+NJP CALL LOOKUP(IPOLY,KEY,IFD,NPLT,X,ITEST,ITEMP,6) IF(.NOT.IFD) CALL ENTER(IPOLY,KEY,NPLN,ITEST,ITEMP,6) 93 NPLN=NPLN+1 KEY=0 DO 94 I=1,NJP ^^ 94 KEY=KEY+IPPT(I) ITEST=524288+NJP CALL LOOKUP(IPOLY,KEY,IFD,NPLT,X,ITEST,IPPT,6) IF(.NOT.IFD) CALL ENTER(IPOLY,KEY,NPLN,ITEST,IPPT,6) 95 CONTINUE RETURN ^^ C CLIPPING AND CAPPING ERRORS 100 WRITE(OUTPUT,110) 110 FORMAT(' ?') STOP END ^^ SUBROUTINE SPLIT(X,IPN,D,DFAC,IFAC,NP2,NPLN) C SUBROUTINE SPLIT - SPLITS A POLYGON INTO FRONT AND BACK POLYGONS C AND SAVE THE LINE SEMENT FOR USE IN FORMING THE CAP. C SUBPROGRAMS CALLED ^^ C LOOKUP = HASH TABLE LOOKUP ROUTINE C ENTER = HASH TABLE ENTER ROUTINE C VARIABLES USED C X = COORDINATE ARRAY C IPN = CLIPPING PLANE NUMBER BY PART C D = DI^^STANCE FROM NODE TO CLIPPING PLANE C DFAC = PROPORTION OF LINE SEGMENT C IFAC = NODES OF CLIPPED LINE SEGMENTS C ICOOR = COORDINATE HASH TABLE C IPOLY = POLYGON HASH TABLE C NJ = NUMBER OF JOINTS OR NODES C NP = NUMBER OF PARTS ^^ C NPT = NUMBER OF ELEMENTS C XX = COORDINATE OF CALCULATED INTERSECTION C ITEMP = TEMPORARY CONNECTIVITY ARRAY FOR POLYGON C IPFT = FRONT POLYGON CONNECTIVITY C IPBT = BACK POLYGON CONNECTIVITY C ISEG = ON-PLANE POLYGON LINE SEGMENT ^^ C NLAST = LAST POLYGON NUMBER AFTER POLYGON SORTING C NCOOR = NUMBER OF LAST COORDINATE ENTERED INTO HASH TABLE C KPLACE = INDEX TO HASH TABLE C IPT = HASH TABLE POINTER C ITOTAL = TOTAL NUMBER OF STEPS BETWEEN CLIPPING PLANES C ISTEP = CLIPPING PLANE STEP NUMBER C ^^ ISIDE = 'FRON' TO SAVE ONLY POLYGONS IN FRONT OF PLANE C = 'BACK' TO SAVE ONLY POLYGONS BEHIND PLANE C = 'BOTH' TO SAVE ALL POLYGONS C NJF = NUMBER OF NODES IN FRONT POLYGON C NJB = NUMBER OF NODES IN BACK POLYGON C NP2 = COUNT OF ON-PLANE INTERSECTIONS C NPLN = POLYGON NUMBER^^ FOR SORTING DIMENSION X(3,1),D(1),DFAC(1),IFAC(2,1) COMMON/CONT/ NP,NJ,NPT COMMON/HASH/ ICOOR(128),IPOLY(128) COMMON/JUNK/ XX(3),ITEMP(4),IPFT(6),IPBT(6),ISEG(6),IPPT(12) COMMON/NCON/ NPN,NCOOR,NLAST ^^ COMMON/SAVE/ KPLACE,IPT COMMON/STEP/ ITOTAL,ISTEP,ISIDE C REPEAT FOR EACH NODE IN POLYGON NJB=0 ^^ NJF=0 NP2=0 DO 10 I=1,6 IPFT(I)=0 IPBT(I)=0 10 ISEG(I)=0 ^^ DO 40 I1=1,4 C SET J1 = FIRST NODE AND J2 = SECOND NODE OF LINE SEGMENT I2=I1+1 IF(I2.GT.4) I2=1 ^^ IF(ITEMP(I1).EQ.0) GO TO 41 J1=ITEMP(I1) J2=ITEMP(I2) IF(J2.EQ.0) J2=ITEMP(1) C IF DISTANCE IS NEGATIVE, ZERO, POSITIVE THEN GO TO 15, 20, 3^^0 IF(D(J1)) 15,20,30 15 IF(ISIDE.EQ.'FRON') GO TO 35 NJB=NJB+1 IPBT(NJB)=J1 GO TO 35 20 IF(^^ISIDE.EQ.'FRON') GO TO 22 NJB=NJB+1 IPBT(NJB)=J1 IF(ISIDE.EQ.'BACK') GO TO 24 22 NJF=NJF+1 IPFT(NJF)=J1 24 IF(IPN.EQ.0) GO TO 35 ^^ NP2=NP2+1 ISEG(NP2)=J1 GO TO 35 30 IF(ISIDE.EQ.'BACK') GO TO 35 NJF=NJF+1 IPFT(NJF)=J1 ^^ C IF NODES LIE ON OPPOSITE SIDES OF PLANE THEN CALCULATE C PROPORTION ELSE JUMP. 35 IF((D(J1)*D(J2)).GE.0.0) GO TO 40 FAC=D(J1)/(D(J2)-D(J1)) ^^ C CALCULATE COORDINATE OF INTERSECTION DO 34 JJ=1,3 34 XX(JJ)=X(JJ,J1)-FAC*(X(JJ,J2)-X(JJ,J1)) KEY=INT(XX(1)+XX(2)-XX(3)) ^^ C SEARCH FOR COORDINATE IN HASH TABLE CALL LOOKUP(ICOOR,KEY,IFD,NJT,X,ITEST,ITEMP,2) IF(IFD) GO TO 36 NCOOR=NCOOR+1 ^^ C IF COORDINATE NOT FOUND THEN ENTER IT INTO HASH TABLE CALL ENTER(ICOOR,KEY,NCOOR,ITEST,ITEMP,2) C SAVE PROPORTION AND NODE NUMBERS OF CLIPPED LINE SEGMENT C FOR USE IN DATA TRANSFORMATION. ^^ NJT=NCOOR II=NJT-NJ DFAC(II)=FAC IFAC(1,II)=J1 IFAC(2,II)=J2 ^^ C ENTER COORDINATE IN COORDINATE ARRAY DO 33 JJ=1,3 33 X(JJ,NJT)=XX(JJ) C ENTER COORDINATE NODE NUMBER IN P^^OLYGON CONNECTIVITY ARRAYS 36 IF(ISIDE.EQ.'FRON') GO TO 42 NJB=NJB+1 IPBT(NJB)=NJT IF(ISIDE.EQ.'BACK') GO TO 44 42 NJF=NJF+1 ^^ IPFT(NJF)=NJT 44 NP2=NP2+1 ISEG(NP2)=NJT 40 CONTINUE C CHECK FOR ON-PLANE POLYGONAL FACE ^^ 41 IF(NP2.NE.4) GO TO 58 DO 50 I=1,4 50 IF(ISEG(I).GT.NJ) GO TO 58 GO TO 90 C ENTER FRONT AND BACK POL^^YGONS C IF FRONT POLYGON THEN DO LOOKUP AND ENTER OR DELETE 58 IF(NJF.LT.3) GO TO 60 NPLN=NPLN+1 KEY=0 DO 59 I=1,NJF ^^ 59 KEY=KEY+IPFT(I) ITEST=262144+NJF CALL LOOKUP(IPOLY,KEY,IFD,NJT,X,ITEST,IPFT,6) IF(.NOT.IFD) CALL ENTER(IPOLY,KEY,NPLN,ITEST,IPFT,6) IF(IFD) CALL DELETE(IPOLY,6) ^^ C IF BACK POLYGON THEN DO LOOKUP AND ENTER OR DELETE 60 IF(NJB.LT.3) GO TO 80 71 NPLN=NPLN+1 KEY=0 DO 72 I=1,NJB 72 KEY=KEY+IPBT(I)^^ ITEST=1048576+NJB CALL LOOKUP(IPOLY,KEY,IFD,NJT,X,ITEST,IPBT,6) IF(.NOT.IFD) CALL ENTER(IPOLY,KEY,NPLN,ITEST,IPBT,6) IF(IFD) CALL DELETE(IPOLY,6) C IF ONLY ONE INTERSECTION THEN RESET NP2^^ 80 IF(NP2.EQ.1) NP2=0 RETURN C ENTER ON-PLANE POLYGON ^^ 90 NPLN=NPLN+1 KEY=0 DO 92 I=1,NP2 92 KEY=KEY+ISEG(I) ITEST=524288+NP2 CALL LOOKUP(IPOLY,KEY,IFD,NJT,X,ITEST,ISEG,6) IF(.NO^^T.IFD) CALL ENTER(IPOLY,KEY,NPLN,ITEST,ISEG,6) NP2=0 RETURN END SUBROUTINE LOOKUP(KVALS,KEY,IFD,IVAL,X,ITEST,ITEMP,N) C SUBROUTINE LOOKUP - HASH TABLE LO^^OKUP ROUTINE C VARIABLES USED C X = COORDINATE ARRAY C KVALS = HASH TABLE POINTERS C KEY = HASH INDEX CALCULATION KEY C IVAL = NODE NUMBER OF FOUND COORDINATE ^^ C IFD = -1 IF FOUND C = 0 IF NOT FOUND C ITEMP = POLYGON CONNECTIVITY C ITEST = POLYGON ASSOCIATED VALUE C KPLACE = HASH TABLE INDEX C IPT = HASH TABLE POINTER C ^^ XX = NEW COORDINATE DIMENSION X(3,1),KVALS(1),ITEMP(1),IP(6) COMMON IFREE(1) COMMON/JUNK/ XX(3) COMMON/SAVE/ KPLACE,IPT ^^ C CALCULATE HASH TABLE INDEX IFD=.FALSE. I2=MOD(KEY,512) I1=KEY/(2**9) I1=MOD(I1+I2,128) ^^ KPLACE=I1+1 IPT=KVALS(KPLACE) C IF NULL POINTER THEN NOT FOUND 11 IF(IPT.EQ.0) RETURN ^^ C IF FOUND THEN GO TO 31 IF(IFREE(IPT).EQ.KEY) GO TO 31 C INCREMENT POINTER ^^ 21 IPT=MOD(IFREE(IPT+1),262144) GO TO 11 C IF POLYGON THEN JUMP 31 IF(N.GT.2) GO TO 34 ^^ C CHECK COORDINATES IVAL=IFREE(IPT+1)/(2**18) X1=XX(1)-X(1,IVAL) X2=XX(2)-X(2,IVAL) ^^ X3=XX(3)-X(3,IVAL) X1=X1*X1+X2*X2+X3*X3 X2=X(1,IVAL)*X(1,IVAL)+X(2,IVAL)*X(2,IVAL)+X(3,IVAL)*X(3,IVAL) IF(X2.EQ.0.0) X2=1.0 X3=SQRT(X1/X2) IF(X3.GT.1.0E-04) GO TO 21 IFD^^=.TRUE. RETURN C CHECK POLYGON 34 IF(ITEST.NE.IFREE(IPT+2)) GO TO 21 ^^ C GET SIZE OF POLYGON AND FIND NODE OFFSET ISIZE=MOD(ITEST,262144) DO 40 I=3,5 I1=I*2-5 I2=I1+1 ^^ I3=IPT+I IP(I1)=IFREE(I3)/(2**18) 40 IP(I2)=MOD(IFREE(I3),262144) DO 41 IOFF=1,ISIZE IF(ITEMP(IOFF).EQ.IP(1)) GO TO 51 41 CONTINUE ^^ GO TO 21 C DETERMINE IF POLYGON IS SAME OR OPPOSITE ORDERING 51 IMOVE=1 II1=IOFF-1 IF(II1.LE.0) II1=I^^SIZE IF(ITEMP(II1).EQ.IP(2)) IMOVE=-1 DO 61 I=2,ISIZE IOFF=IOFF+IMOVE IF(IOFF.GT.ISIZE) IOFF=1 IF(IOFF.LE.0) IOFF=ISIZE IF(ITEMP(IOFF).NE.IP(I)) GO TO 21 ^^ 61 CONTINUE IFD=.TRUE. RETURN END SUBROUTINE ENTER(KVALS,KEY,IVAL,ITEST,ITEMP,N) ^^ C SUBROUTINE ENTER - HASH TABLE ENTER ROUTINE C VARIABLE USED C KVALS = HASH TABLE POINTERS C KEY = HASH TABEL INDEX CALCULATION KEY C IVAL = HASH TABLE VALUE C ITEMP = T^^EMPORARY POLYGON ARRAY C ITEST = POLYGON ASSOCIATED VARIABLE C N = HASH TABEL BLOCK SIZE C XX = NEW COORDINATE C KPLACE = HASH TABLE INDEX C IPT = HASH TABLE POINTER ^^ DIMENSION KVALS(1),ITEMP(1) COMMON IFREE(1) COMMON/JUNK/ XX(3) COMMON/SAVE/ KPLACE,IPT C ENTER DATA ^^ CALL GETBLK(IPT,N) IFREE(IPT)=KEY IFREE(IPT+1)=IVAL*(2**18)+KVALS(KPLACE) KVALS(KPLACE)=IPT I1=IPT+1 ^^ C IF COORDINATE THEN RETURN IF(N.EQ.2) RETURN IFREE(IPT+2)=ITEST IFREE(IPT+3)=ITEMP(1)*(2**18)+ITEMP(2) IFREE(IPT+4)=ITEMP(3)*(2^^**18)+ITEMP(4) IFREE(IPT+5)=ITEMP(5)*(2**18)+ITEMP(6) I1=IPT+5 RETURN END SUBROUTINE DELETE(KVALS,N) ^^ C SUBROUTINE DELETE - DELETES DATA BLOCKS FROM HASH TABLE C SUBPROGRAMS CALLED C RETBLK = RETURN DATA BLOCK TO FREE STORAGE C VARIABLES USED ^^ C KVALS = HASH TABLE POINTERS C N = HASH TABLE BLOCK SIZE C KPLACE = HASH TABLE INDEX C IPT = HASH TABLE POINTER C IFREE = FREE STORAGE INTEGER OUTPUT ^^ DIMENSION KVALS(1) COMMON IFREE(1) COMMON/DEVI/ INPUT,OUTPUT COMMON/SAVE/ KPLACE,IPT C DELETE FIRST DATA BLOCK FROM TABLE ^^ IPT1=KVALS(KPLACE) IF(IPT1.NE.IPT) GO TO 10 KVALS(KPLACE)=MOD(IFREE(IPT+1),262144) CALL RETBLK(IPT,N) RETURN ^^ C IF NOT FIRST BLOCK THEN FOLLOW POINTERS 10 IPT2=MOD(IFREE(IPT1+1),262144) IF(IPT2.EQ.IPT) GO TO 20 IPT1=IPT2 IF(IPT^^1.NE.0) GO TO 10 WRITE(OUTPUT,15) 15 FORMAT(' ?') STOP C ADJUST POINTERS TO BRIDGE DELETED BLOCK ^^ 20 IFREE(IPT1+1)=IFREE(IPT1+1)/(2**18)*(2**18) 1+MOD(IFREE(IPT+1),262144) CALL RETBLK(IPT,N) RETURN END SUBROUTINE GETBLK(IPT,N) ^^ INTEGER OUTPUT COMMON IFREE(1) COMMON/DEVI/ INPUT,OUTPUT COMMON/FREE/ MIN,NEXT,IAVAIL IF(IAVAIL.EQ.0) GO TO 30 ^^ IPT=IAVAIL IF(IFREE(IPT+1).NE.N) GO TO 10 IAVAIL=IFREE(IPT) RETURN 10 IPT1=IFREE(IPT) IF(IPT1.EQ.0) GO TO 3^^0 IF(IFREE(IPT1+1).NE.N) GO TO 20 IFREE(IPT)=IFREE(IPT1) IPT=IPT1 RETURN 20 IPT=IPT1 ^^ GO TO 10 30 IPT=NEXT-N NEXT=IPT IF(NEXT.GT.MIN) RETURN ^^ WRITE(OUTPUT,40) 40 FORMAT(' ?') STOP ENTRY RETBLK(IPT,N) IFREE(IPT)=I^^AVAIL IFREE(IPT+1)=N IAVAIL=IPT RETURN END SUBROUTINE ORDER(ITEMP,NJP,ITRIA) ^^ C SUBROUTINE ORDER - MATCHES END-POINTS OF LINE SEGMENTS C TO FORM POLYGONS C VARIABLES USED C ITEMP = POLYGON LINE SEGMENT ARRAY C NJP = NUMBER OF NODES IN ITEMP ^^ INTEGER OUTPUT DIMENSION ITEMP(1) COMMON/DEVI/ INPUT,OUTPUT C ORDER LINE SEGMENTS ^^ ITRIA=1 I1=NJP-2 DO 40 IPT=2,I1,2 C SEARCH FOR CORRESPONDING NODE ^^ I2=IPT+1 DO 10 I=I2,NJP I3=I 10 IF(ITEMP(IPT).EQ.ITEMP(I3)) GO TO 20 ITRIA=ITRIA+1 IF(ITRIA.LE.2) GO TO 40 ^^ WRITE(OUTPUT,15) 15 FORMAT(' ?') STOP C REVERSE LINE SEGMENT IF NECESSARY ^^ 20 IF(I3.NE.I3/2*2) GO TO 30 II1=ITEMP(I3) ITEMP(I3)=ITEMP(I3-1) ITEMP(I3-1)=II1 I3=I3-1 C SWAP LINE SEGMENTS^^ 30 II1=ITEMP(IPT+1) II2=ITEMP(IPT+2) ITEMP(IPT+1)=ITEMP(I3) ITEMP(IPT+2)=ITEMP(I3+1) ITEMP(I3)=II1 ^^ ITEMP(I3+1)=II2 40 CONTINUE C ELEMINATE REDUNDANT NUMBERING OF NODES NJP=NJP/2 ^^ DO 50 I=1,NJP I1=2*I-1 50 ITEMP(I)=ITEMP(I1) C ZERO REMAINING ELEMENTS I1=NJP+1 ^^ DO 55 I=I1,12 55 ITEMP(I)=0 RETURN END SUBROUTINE PLYSRT(NPL,IJN,N) ^^ C SUBROUTINE PLYSRT - SORTS POLYGONS IN HASH TABLE C VARIABLES USED C NPL = PARTS ARRAY C IJN = CONNECTIVITY ARRAY C N = PART NUMBER ^^ C NCOUNT = TEMPORARY PARTS COUNT C ITEMP = TEMPORARY POLYGON VERTICE ARRAY C NLAST = LAST POLYGON NUMBER IN IJN DIMENSION NPL(2,1),IJN(4,1) COMMON IFREE(1) ^^COMMON/CONT/ NP,NJ,NPT COMMON/HASH/ ICOOR(128),IPOLY(128) COMMON/JUNK/ NCOUNT(3),ILST(3),ITEMP(6) COMMON/NCON/ NPN,NCOOR,NLAST C ZERO NCOUNT ^^ DO 5 I=1,3 ILST(I)=0 5 NCOUNT(I)=0 C SORT POLYGONS ACCORDING TO FRONT, ON-PLANE, AND BACK AND C BY POLYGON NUMBER ^^ DO 70 ILOC=1,128 IF(IPOLY(ILOC).EQ.0) GO TO 70 IBLK=IPOLY(ILOC) ^^ 10 I1=IFREE(IBLK+2)/(2**18) IPT=ILST(I1) IF(IPT.NE.0) GO TO 20 IFREE(IBLK)=0 ILST(I1)=IBLK GO TO 60 ^^ 20 IF(IFREE(IBLK+1).GT.IFREE(IPT+1)) GO TO 30 IFREE(IBLK)=ILST(I1) ILST(I1)=IBLK GO TO 60 ^^ 30 IF(IFREE(IPT).NE.0) GO TO 40 IFREE(IBLK)=0 IFREE(IPT)=IBLK GO TO 60 40 IPT1=IFREE(IPT) ^^ IF(IFREE(IBLK+1).GT.IFREE(IPT1+1)) GO TO 50 IFREE(IBLK)=IPT1 IFREE(IPT)=IBLK GO TO 60 50 IPT=IPT1 GO TO ^^30 60 IBLK=MOD(IFREE(IBLK+1),262144) IF(IBLK.EQ.0) GO TO 70 GO TO 10 70 CONTINUE ^^ C FORM QUADRILATERALS AND TRIANGLES FROM DATA DO 100 I=1,3 IPT=ILST(I) ^^ 75 IF(IPT.EQ.0) GO TO 100 ISIZE=MOD(IFREE(IPT+2),262144) DO 80 J=3,5 I1=2*J-5 I2=I1+1 ^^ I3=IPT+J ITEMP(I1)=IFREE(I3)/(2**18) 80 ITEMP(I2)=MOD(IFREE(I3),262144) IPT1=IFREE(IPT) CALL RETBLK(IPT,6) IPT=IPT1 ^^ NLAST=NLAST+1 NCOUNT(I)=NCOUNT(I)+1 DO 85 J=1,4 85 IJN(J,NLAST)=ITEMP(J) IF(ISIZE.LE.4) GO TO 75 ^^ NLAST=NLAST+1 NCOUNT(I)=NCOUNT(I)+1 IJN(1,NLAST)=ITEMP(1) DO 90 J=2,4 90 IJN(J,NLAST)=ITEMP(J+2) ^^ GO TO 75 100 CONTINUE C STORE NCOUNT IN PARTS ARRAY NLAST1=NLAST^^+1 NCOUNT(2)=NCOUNT(2)+NCOUNT(3) NCOUNT(1)=NCOUNT(1)+NCOUNT(2) NPL(1,N)=NLAST1-NCOUNT(1) NPL(2,N)=NLAST-NCOUNT(2) K=NP+N NPL(1,K)=NLAST1-NCOUNT(2) ^^ NPL(2,K)=NLAST-NCOUNT(3) K=K+NP NPL(1,K)=NLAST1-NCOUNT(2) NPL(2,K)=NLAST-NCOUNT(3) K=K+NP NPL(1,K)=NLAST1-NCOUNT(3) ^^ NPL(2,K)=NLAST RETURN END SUBROUTINE REDUCE(ICOL,IJN) C SUBROUTINE REDUCE - FORMS A REDUCE VECTOR OF NODE NUMBERS ^^ C VARIABLES USED C ICOL = NEW NODE NUMBER ARRAY BY OLD NODE NUMBER C IJN = NEW CONNECTIVITY ARRAY C NJ = NUMBER OF JOINTS OR NODES C NP = NUMBER OF PARTS C NPT = NUMBER OF ELEMENTS ^^ DIMENSION ICOL(1),IJN(4,1) COMMON/CONT/ NP,NJ,NPT COMMON/NCON/ NPN,NJN,NLAST C ZERO NODE NUMBER ARRAY ^^ DO 10 I=1,NJ 10 ICOL(I)=0 C COUNT NUMBER OF TIMES NODE NUMBER USED IN IJN ^^ DO 20 J=1,NLAST DO 20 I=1,4 II=IJN(I,J) IF(II.LE.0.OR.II.GT.NJ) GO TO 20 ICOL(II)=ICOL(II)+1 20 CONTINUE ^^ C REPLACE COUNT WITH NEW NODE NUMBER FOR NODES USED NN=0 DO 40 I=1,NJ IF(ICOL(I).LE.0) GO TO 40 NN=NN+1 ^^ ICOL(I)=NN 40 CONTINUE C RENUMBER NODES IN ARRAY IJN NJ1=NJ-NN ^^ DO 60 J=1,NLAST DO 60 I=1,4 II=IJN(I,J) IF(II.LE.0) GO TO 60 IF(II.GT.NJ) GO TO 50 IJN(I,J)=ICOL(II) GO TO 60 ^^ 50 IJN(I,J)=II-NJ1 60 CONTINUE RETURN END SUBROUTINE TRGEOM(X,ICOL,DFAC,IFAC,XN) ^^ C SUBROUTINE TRANS - TRANSFORMS, REDUCES AND/OR AUGMENTS C COORDINATE, DISPLACEMENT AND SCALAR FUNCTION ARRAY. C VARIABLES USED C X = COORDINATE ARRAY C = DISPLACEMENT ARRAY ^^ C S = SCALAR FUNCTION ARRAY C ICOL = REDUCED NODE NUMBER ARRAY C DFAC = PROPORTION OF LINE SEGMENT C IFAC = NODES OF CLIPPED LINE SEGMENT C XN = NEW COORDINATE ARRAY C = NEW DISPLACEMENT ARRAY C ^^SN = NEW SCALAR FUNCTION ARRAY C NJ = NUMBER OF JOINTS OR NODES C NP = NUMBER OF PARTS C NPT = NUMBER OF ELEMENTS C NPN = NEW NUMBER OF PARTS C NCOOR = NEW NUMBER OF NODES C NPTN = NEW NUMBER OF ELE^^MENTS DIMENSION X(3,1),ICOL(1),DFAC(1),IFAC(2,1),XN(3,1) COMMON/CONT/ NP,NJ,NPT COMMON/NCON/ NPN,NCOOR,NPTN COMMON/SAVE/ NSAVE NSAVE=NCOOR ^^ C PERFORM TRANSFORMATION ON OLD GEOMETRY ARRAY N=0 DO 4 J=1,NJ IF(ICOL(J).LE.0) GO TO 4 ^^ N=N+1 DO 3 I=1,3 3 XN(I,N)=X(I,J) 4 CONTINUE C IF NO NEW COORDINATES THEN JUMP ^^ J1=NJ+1 IF(J1.GT.NCOOR) GO TO 10 C INCLUDED CALCULATED COORDINATES IN NEW ARRAY DO 5 J=J1,NCOOR ^^ N=N+1 DO 5 I=1,3 5 XN(I,N)=X(I,J) 10 NCOOR=N RETURN END ^^ SUBROUTINE TRDISP(X,ICOL,DFAC,IFAC,XN) DIMENSION X(3,1),ICOL(1),DFAC(1),IFAC(2,1),XN(3,1) COMMON/CONT/ NP,NJ,NPT COMMON/NCON/ NPN,NCOOR,NPTN COMMON/SAVE/ NSAVE C PERFOR^^M TRANSFORMATION ON OLD DISPLACEMENT ARRAY N=0 DO 14 J=1,NJ IF(ICOL(J).LE.0) GO TO 14 N=N+1 DO 13 I=1,3 ^^ 13 XN(I,N)=X(I,J) 14 CONTINUE C IF NO NEW DISPLACEMENTS THEN RETURN J1=NSAVE-NJ ^^ IF(J1.LE.0) RETURN DO 17 J=1,J1 N=N+1 I1=IFAC(1,J) I2=IFAC(2,J) DO 17 I=1,3 17^^ XN(I,N)=X(I,I1)-DFAC(J)*(X(I,I2)-X(I,I1)) RETURN END SUBROUTINE TRSFUN(S,ICOL,DFAC,IFAC,SN) DIMENSION S(1),ICOL(1),DFAC(1),IFAC(2,1),SN(1) COMMON/CONT/ NP,NJ,NPT COMMON/NCON/ NPN,NCOO^^R,NPTN COMMON/SAVE/ NSAVE C PERFORM TRANSFORMATION ON OLD SCALAR FUNCTION ARRAY N=0 DO 24 J=1,NJ ^^ IF(ICOL(J).LE.0) GO TO 24 N=N+1 SN(N)=S(J) 24 CONTINUE C IF NO NEW SCALAR FUNCTIONS THEN RETURN ^^ J1=NSAVE-NJ IF(J1.LE.0) RETURN DO 27 J=1,J1 N=N+1 I1=IFAC(1,J) I2=IFAC(2,J)^^ 27 SN(N)=S(I1)-DFAC(J)*(S(I2)-S(I1)) RETURN END C**********************************************************************C C C C TITLE.FOR VERSION 1.0(A)^^ SEPTEMBER 1976 C C C C TITLE.FOR IS A CHARACTER GENERATOR FOR TWO AND THREE C C DIMENSIONAL CHARACTERS. THE POLYGONAL DATA IS COMPATABLE C C WITH MOVIE.BYU FOR DISPLAY. C C C C MIKE STEPHENSON HANK CHRISTIANSEN ^^ C C DEPARTMENT OF CIVIL ENGR. CIVIL ENGINEERING DEPT. C C AND ENGINEERING MECHANICS 368E ESTB C C THE UNIVERSITY OF ARIZONA BRIGHAM YOUNG UNIVERSITY C C TUCSON, ARIZONA 85721 PROVO, UTAH 84602 C C (602) 884-4803 (801) 374-1211 X2811 C C C C********^^**************************************************************C INTEGER OUTPUT C DIMENSION NPL(2,NPMAX),X(3,NJMAX),IP(4,NPTMAX) DIMENSION NPL(2,10),X(3,100),IP(4,100) DIMENSION WORD(70) COMMON/CHAR/ CH(42),JQUAD(6^^,42),COOR(2,6,50) COMMON/DEVI/ INPUT,OUTPUT C INPUT AND OUTPUT ARE SET BELOW FOR THE DECSYSTEM-10 INPUT=-4 OUTPUT=-1 ^^ C WRITE TITLE TO OUTPUT DEVICE WRITE(OUTPUT,10) 10 FORMAT(' ') ^^C BEGIN LINE OF TEXT 20 NML=0 NP=0 NJH=0 NMH=0 30 NCHAR=0 ^^ 35 WRITE(OUTPUT,40) 40 FORMAT(' ') READ(INPUT,50) (WORD(I),I=1,70) 50 FORMAT(70A1) C FIND LAST NON-BLANK CHARACTER ^^ DO 60 I=1,70 NCHAR=71-I 60 IF(WORD(NCHAR).NE.' ') GO TO 80 C IF BLANK LINE THEN END OF TITLE? ^^ WRITE(OUTPUT,70) 70 FORMAT(' '$) READ(INPUT,50) ANS IF(ANS.NE.'Y') GO TO 30 GO TO 320 80 NP=NP+1 ^^ ID=2 C THREE-DIMENSIONAL TITLE? WRITE(OUTPUT,90) 90 FORMAT(' <3-D?> '$) ^^ READ(INPUT,50) ANS IF(ANS.EQ.'Y') ID=3 IDIN=ID-1 C REQUEST LEFT EDGE COORDINATES ^^ WRITE(OUTPUT,100) 100 FORMAT(' '$) READ(INPUT,110) XZ,YZ,ZZ 110 FORMAT(4E) C REQUEST SPACING, WIDTH, HEIGHT, AND FOR 3-D, DEPTH. ^^ 120 IF(ID.EQ.2) WRITE(OUTPUT,130) 130 FORMAT(' '$) IF(ID.EQ.3) WRITE(OUTPUT,140) 140 FORMAT(' '$) READ(INPUT,110) DDIN,SX,SY,SZ IF(SX.EQ.0.0.OR.SY.EQ.0.^^0) GO TO 120 IF(DDIN.EQ.0.0)DDIN=1.0 SX=SX/7.0 SY=SY/7.0 C IF 2-D THEN JUMP ELSE REQUEST OFFSET. ^^ IF(ID.EQ.2) GO TO 160 WRITE(OUTPUT,150) 150 FORMAT(' '$) READ(INPUT,110) DDX,DDY C FOR EACH CHARACTER IN LINE, GENERATE POLYGONAL DATA. ^^ 160 DO 290 I=1,NCHAR NJL=NJH+1 X1=WORD(I) DO 170 J=1,42 170 IF(X1.EQ.CH(J)) GO TO 190 ^^ C ISSUE WARNING IF CHARACTER NOT RECOGNIZED. WRITE(OUTPUT,180) X1 180 FORMAT(' ?') GO TO 35 190 DO 280 K=1,6 ^^ C GET POLYGON NUMBER. L=JQUAD(K,J) IF(L.EQ.0) GO TO 290 DO 280 I1=1,4 ^^ C GENERATE COORDINATES X1=XZ+SX*COOR(1,I1,L) Y1=YZ+SY*COOR(2,I1,L) IF(NJH.LT.NJL) GO TO 210 DO 200^^ J1=NJL,NJH,IDIN 200 IF(X1.EQ.X(1,J1).AND.Y1.EQ.X(2,J1)) GO TO 220 210 J1=NJH+1 NJH=NJH+IDIN X(1,J1)=X1 X(2,J1)=Y1 X(3,J1)=ZZ ^^ IF(ID.EQ.2) GO TO 270 X(1,NJH)=X1+DDX X(2,NJH)=Y1+DDY X(3,NJH)=ZZ-SZ 220 IF(ID.EQ.2) GO TO 270 J2=J1+1 ^^ C GENERATE POLYGONS GO TO (230,240,250,260),I1 230 IP(1,NMH+1)=J1 IP(2,NMH+2)=J1 ^^ IP(4,NMH+5)=J1 IP(1,NMH+2)=J2 IP(1,NMH+5)=J2 GO TO 280 240 IP(2,NMH+1)=J1 IP(1,NMH+3)=J1 IP(3,NMH+5)=J1 ^^ IP(2,NMH+3)=J2 IP(2,NMH+5)=J2 GO TO 280 250 IP(3,NMH+1)=J1 IP(4,NMH+3)=J1 IP(2,NMH+4)=J1 ^^ IP(3,NMH+3)=J2 IP(3,NMH+4)=J2 GO TO 280 260 IP(4,NMH+1)=J1 IP(3,NMH+2)=J1 IP(1,NMH+4)=J1 ^^ IP(4,NMH+2)=J2 IP(4,NMH+4)=J2 NMH=NMH+5 GO TO 280 270 IF(I1.EQ.1) NMH=NMH+1 IP(I1,NMH)=J1 280 CONTINUE ^^ C CLACULATE RIGHT EDGE CORRDINATE. 290 XZ=XZ+7.0*SX*DDIN XZ=XZ-7.0*SX*(DDIN-1.0) WRITE(OUTPUT,300) XZ ^^ 300 FORMAT(' ') WRITE(OUTPUT,310) NP,NMH,NJH 310 FORMAT(' ') NPL(1,NP)=NMH-NML NML=NMH GO TO 30 ^^ C COMPLETE NPL ARRAY. 320 NPT=0 DO 330 J=1,NP NPL(2,J)=NPL(1,J)+NPT NPL^^(1,J)=1+NPT 330 NPT=NPT+NPL(2,J) C WRITE GEOMETRY FILE. CALL WRGEOM(NP,NJH,NPT,NPL,X,IP) WRITE(OUTPUT,340) 340 FORMAT(' ^^'$) READ(INPUT,50) ANS IF(ANS.EQ.'Y') GO TO 20 STOP END BLOCK DATA ^^ C CHARACTER DEFINITIONS. COMMON/CHAR/ CH(42),JQUAD(6,42),COOR(2,6,50) DATA (CH(I),I=1,42)/'A','B','C','D','E','F','G','H','I','J' 1 ,'K','L','M','N','O','P','Q','R','S','T','U','V','W','X' 2 ,'Y','Z','1','2','3','4','5','6','7','8','9','0',' ','.' ^^ 3 ,'/','-','=','$'/ DATA ((JQUAD(I,J),I=1,6),J=1,10)/1,2,3,4,0,0,1,3,5,6,7,0 1 ,1,2,8,0,0,0,1,5,6,7,0,0,1,2,3,8,0,0,1,2,3,0,0,0 2 ,1,2,8,9,10,0,1,3,11,0,0,0,24,25,49,0,0,0,6,13,14,0,0,0/ DATA ((JQUAD(I,J),I=1,6),J=11,20)/1,15,16,0,0,0,1,8,0,0,0,0 1 ,1,11,17,18,0,0,1,11,19,0,0,0,1,5,6,11,0,0,1,3,5,20,0,0 2 ,1,5,6,11,21,0,1^^,3,5,20,22,0,2,3,9,23,24,0,25,26,0,0,0,0/ DATA ((JQUAD(I,J),I=1,6),J=21,30)/1,6,11,0,0,0,44,45,0,0,0,0 1 ,27,28,29,30,0,0,31,32,33,34,0,0,31,32,35,0,0,0,24,25,36,0,0,0 2 ,12,0,0,0,0,0,24,25,37,38,0,0,3,24,25,39,0,0,11,40,41,0,0,0/ DATA ((JQUAD(I,J),I=1,6),J=31,42)/2,3,9,23,24,42,1,2,3,8,9,0 1 ,25,43,0,0,0,0,1,3,5,6,11,0,2,3,23,24,39,0,1,5,6,11,0,0 2 ,0,0,0,0,0,0,46,0,0,0,0,0,36,0,0,0,0,0,3,^^0,0,0,0,0 3 ,47,48,0,0,0,0,2,3,9,23,24,50/ DATA(((COOR(I,J,K),I=1,2),J=1,4),K=1,6)/1.,0.,2.,0.,2.,7.,1.,7. 1 ,2.,6.,6.,6.,6.,7.,2.,7.,2.,3.,5.,3.,5.,4.,2.,4.,5.,0.,6.,0. 2 ,6.,6.,5.,6.,2.,6.,5.,6.,5.,7.,2.,7.,2.,0.,5.,0.,5.,1.,2.,1./ DATA(((COOR(I,J,K),I=1,2),J=1,4),K=7,12)/5.,0.,6.,1.,6.,6.,5.,7. 1 ,2.,0.,6.,0.,6.,1.,2.,1.,5.,1.,6.,1.,6.,4.,5.,4.,3.,3.,5.,3. ^^ 2 ,5.,4.,3.,4.,5.,0.,6.,0.,6.,7.,5.,7.,3.,0.,4.,0.,4.,7.,3.,7./ DATA(((COOR(I,J,K),I=1,2),J=1,4),K=13,17)/5.,0.,6.,0.,6.,7. 1 ,5.,7.,1.,0.,2.,0.,2.,3.,1.,3.,2.,3.5,6.,7.,4.5,7.,2.,4.8 2 ,2.,2.2,4.5,0.,6.,0.,2.,3.5,2.,5.,3.5,3.,3.5,5.,2.,7./ DATA(((COOR(I,J,K),I=1,2),J=1,4),K=18,22)/3.5,3.,5.,5. 1 ,5.,7.,3.5,5.,2.,4.8,5.,0.,5.,2.2,2.,7.,5.,3.,6.,3.,6.,7. 2 ,5.,7.,5^^.,1.,5.,2.4,3.7,3.7,3.,3.,4.9,0.,6.,0.,5.,3.,3.9,3./ DATA(((COOR(I,J,K),I=1,2),J=1,4),K=23,27)/1.,3.,2.,3.,2.,7. 1 ,1.,7.,1.,0.,6.,0.,6.,1.,1.,1.,1.,6.,6.,6.,6.,7.,1.,7. 2 ,3.,0.,4.,0.,4.,6.,3.,6.,1.,7.,2.,0.,3.,0.,2.,7./ DATA(((COOR(I,J,K),I=1,2),J=1,4),K=28,32)/3.,0.,3.5,2.,3.5,5. 1 ,2.643,2.5,3.5,2.,4.,0.,4.357,2.5,3.5,5.,4.,0.,5.,0.,6.,7. 2 ,5.,7.,3.,3.5,3.5,4.375,2.,7.,1.^^,7.,3.,3.5,4.,3.5,6.,7.,5.,7./ DATA(((COOR(I,J,K),I=1,2),J=1,4),K=33,37)/1.,0.,2.,0.,3.5,2.625 1 ,3.,3.5,5.,0.,6.,0.,4.,3.5,3.,3.5,3.,0.,4.,0.,4.,3.5,3.,3.5 2 ,1.,1.,2.25,1.,6.,6.,4.75,6.,5.,4.3,6.,4.,6.,6.,5.,6./ DATA(((COOR(I,J,K),I=1,2),J=1,4),K=38,42)/1.,1.,2.6,1.,6.,4. 1 ,5.,4.3,5.,1.,6.,1.,6.,6.,5.,6.,1.,4.,2.8,4.,5.,5.7,5.,7. 2 ,1.,3.,5.,3.,5.,4.,1.,4.,1.,1.,2.,1.,2.,2.,1.,2./ ^^ DATA(((COOR(I,J,K),I=1,2),J=1,4),K=43,50)/3.,0.,4.2,0.,6.,6. 1 ,4.8,6.,1.,7.,3.5,0.,3.5,2.75,2.,7.,3.5,0.,6.,7.,5.,7. 2 ,3.5,2.75,3.,0.,4.,0.,4.,1.,3.,1.,2.,2.,5.,2.,5.,3.,2.,3. 3 ,2.,4.,5.,4.,5.,5.,2.,5.,3.,1.,4.,1.,4.,6.,3.,6. 4 ,3.,-2.,4.,-2.,4.,9.,3.,9./ END ^^SUBROUTINE OPEN(FILEID,IUNIT,IOP,IERROR) C SUBROUTINE OPEN REQUEST FILENAME AND OPENS FILE FOR I/O C SUBPROGRAMS CALLED C OPEN = SYSTEM OPEN FILE ROUTINE ^^ C VARIABLES USED C FILEID = 5 ASCII CHARACTER ID C IUNIT = DEVICE LOGICAL NUMBER C IOP = 1 FOR INPUT FILE C = -1 FOR OUTPUT FILE C IERROR = 1 ON SUCCESSFUL COMPLETION ^^ C = 0 ON EMPTY FILE SPECIFICATION C = -1 ON FAILURE DOUBLE PRECISION ASEQ,BLANK,XNAME INTEGER OUTPUT COMMON/DEVI/ INPUT,OUTPUT ^^ DATA DSK/'DSK'/,MTA/'MTA'/ DATA BLANK/' '/ IERROR=0 OPTYPE='READ' IF(IOP.LT.0) OPTYPE='WRITE' WRITE(OUTPUT,10^^) OPTYPE,FILEID 10 FORMAT(' <',A5,1X,A5,' FILE> '$) READ(INPUT,20) XNAME 20 FORMAT(A10) IF(XNAME.EQ.BLANK) RETURN IERROR=1 IUNIT=10 ^^ ASEQ='SEQIN' IF(IOP.LT.0) ASEQ='SEQOUT' OPEN(UNIT=IUNIT,DEVICE=DSK,FILE=XNAME,ACCESS=ASEQ,MODE='ASCII') RETURN END SUBROUTINE WRGEOM(NP,NJ,NPT,NPL,X,IP) ^^ INTEGER OUTPUT DIMENSION NPL(2,1),X(3,1),IP(4,1) COMMON/DEVI/ INPUT,OUTPUT DATA IWRITE/-1/ C REQUEST FILE INFORMATION ^^ 60 CALL OPEN('TITLE',IUNIT,IWRITE,IERR) IF(IERR) 60,95,90 C WRITE GEOMETRY FILE 90 WRITE(IUNIT,120) NP,NJ,NPT ^^ WRITE(IUNIT,120) ((NPL(I,J),I=1,2),J=1,NP) WRITE(IUNIT,130) ((X(I,J),I=1,3),J=1,NJ) WRITE(IUNIT,120) ((IP(I,J),I=1,4),J=1,NPT) 95 RETURN 120 FORMAT(20I4) ^^ 130 FORMAT(1P6E12.5) END ^^materials and equipment shall conform to the requirements of the UL, or the FMS for fire- alarm systems of the type indi- cated. The Contractor shall submit proof that the items furnished under this specification conform to these requiremeDnts. The UL label or seal, or listing in the UL Fire Protection Equipment List will be accepted as evidence that the items conform to UL requirements. The FMS label or seal, or listing in the Factory Mutual Approval Guide will be accepted as sufficienUt evidence that the items conform to the FMS requirements.  3.3 Qualifications of installer: The system shall be installed by an experienced firm regularly engaged in the installation of automatic fire- detection and alarm systems in accordance with rMNFPA standards. The Contract- ing Officer may reject any proposed installer who cannot show evidence of such qualifications.  4. INSTALLATION AND WIRING: System components shall be securely fastened to their support independently of the wiring.  Runsү of conduit, wire, and cable shall be straight, neatly arranged, properly supported, and parallel or perpendicular to walls and partitions. Installation of wiring and fire detecting circuit shall conform to Article 210 of NFPA Standard No. 72D. Circuits and apparatus installed in hazardous locations shall conform to Section 501- 14 of Article 501 of the National Electrical Code. Spot- type detectors shall be connected directly to the detector- circuit line wires.  5. ALARM BELLS:  Vibrating bells Sshall be used for noncoded signals and single- stroke bells shall be used for coded signals. Bells shall be under- dome, not less than six inches in diameter, and approved for the intended use, and shall operate on low- voltage rectified current. The odperating mechanism shall be housed behind the gong shell. The bells shall be mounted not less than seven feet above the floor and below the bottom surface of the ceiling construction, and shall be located as indicated. Exterior bells shall be the weatherproof type, protected by a nonferrous metal housing with a grille or louvers. Bells shall not be provided in patient- occupied areas of hospitals.  6. MANUAL FIRE ALARM BOXES shall be of the coded or noncoded type located near exits in the appro:ximate locations indicated and mounted 4- 1/2 feet above the floor. Surface- mounted boxes shall have an integral or matching back box. Outdoor boxes shall be approved for such use. Boxes shall be of the break- glass pull- lever type.  7. FIRE DETiECTING EQUIPMENT shall be of the following types, selected by the Contractor and as approved by the Contracting Officer: a. fixed- tempera- ture type; b. rate- of- rise type; c. combination fixed temperature- and- rate- of- rise type; d. other approved type operating on any other principle suited to the conditions and acceptable to the Contracting Officer. Detector circuit design shall be suitable for the types and numbers of detectors, as approved, and shall limit detector circuit current not to ei^xceed ratings of the detectors and associated relays.  7.1 Location: Detecting equipment shall be installed throughout permanently divided parts of the premises including all rooms, halls, corridors, storage areas, basements, attics, lofts, closet s, elevator shafts, enclosed stairways, dumb- waiter shafts, chutes, utility crawl spaces, and other minor subdivisions and enclosures, excluding wardrobes of wood or metal construction. Detectors shall not be installed in attics or spaces above suspenׁded ceilings where all inclosing construction and materials within the space are completely noncombustible. For the purpose of this specification, a surface shall be considered smooth where broken as a result of variances in elevation or by obstructions such as structural members, ducts, or similar conditions having a depth of 10 or less inches.  7.2 Spacing: The detector spacing on smooth surfaces shall not exceed the distance recommended by the testing and approving laboratory for the particularf device installed. In areas where irregularities exceed those described, the detector spacing shall be reduced to provide detection coverage equaling or exceeding that required for smooth surfaces. An open area underneath a deck, mezzanine, or floor landing of a stairway having a minor linear dimension of four or more feet shall be considered a separate subdivi- sion and protected accordingly.  7.3 Detectors: Temperature ratings of thermostatic- type detectors shall be selected by the Contractor annd approved by the Contracting Officer, in accordance with Table 1. ___________________________________________________________________________  TABLE l. DETECTOR TEMPERATURE RATINGS Temperatures are in degrees Fahrenheit.  Ce_xiling temperatures Not Above exceeding Thermostat ratings__________________________ -- to 100 135 to 165, ordinary 100 to 150 175 to 225, intermediate 150 to 225 250 to 300, high 225 to 300 325 ۾to 360, extra high___________________________________________________________________________ 8. CONTROL UNIT shall be installed as part of the system in each protected building and shall be approved for use with the fire- detecting equipment, manua4l fire- alarm boxes or stations, and alarm- sounding appliances. The control unit shall be located where indicated and shall be housed in a substantial steel cabinet with lock and key. The cabinet shall be painted inside and out. The control unit s8hall include a suitable means for testing the system and shall have an indicating meter that will show at all times the current passing through each electrically supervised circuit. The meter scale shall be limited to three times the normal current. TChe unit shall be arranged so as to operate the alarm bells in the event of fire and to continue operation until silenced by switch within the unit cabinet. Operation of the silencing switch shall light an indicator lamp. Meter and indicator lamp shal l be plainly visible when the cabinet of the control unit is closed. Relays shall be the plug- in type.  9. TRANSMITTERS: Fire- alarm transmitters shall be the unit type with optional manual feature. When practicable, transmitters may be combined with the control unit in a single assembly if the combination meets all requirements for both control unit and transmitters. Transmitters shall be of the shunt- noninterfering type, or type fully compatible with the base fire- alarm system to which transmcitters are connected, and shall be approved for the use employed. Compatibility applies particularly to features of the base system that provide for reception of clear and intelligible signals. Transmitters shall be electrically supervised, designed tko transmit coded fire- alarm signals and distinctive coded trouble signals over circuits to a central- alarm location. Transmission of a coded trouble signal shall auto- matically result from a break in a fire- detecting circuit or interior manual fire%- alarm box circuit or from failure of main power supply for transmitters or alarm- bell operation. Provision shall be made also for a restoration signal, upon restoration of the transmitters, interior circuits, and power supply to normal standby condition after a fire- alarm or trouble signal. A fire- alarm signal shall consist of not less than three complete transmissions of the code number identifying the transmitter. One transmission of the coded signal identifying the transmitter is acceptable!& as a trouble signal and one or more as a restoration signal. The transmitter shall be housed in a cabinet as specified above for the control unit. A stamped or engraved plate bearing the code number of the transmitter shall be securely attached to t!(he front of the cabinet. Transmitters subject to low ambient temperatures shall have suitable low temperature lubricants as recommended by the manufac- turer.  10. FACILITIES FOR TRANSMISSION OF SIGNALS: Signal identification for both fire and line- $trouble conditions shall be transmitted over existing supervised fire- reporting telephone circuits. Reporting signals at central- alarm location shall be made by annunciator identification, signal light, or drops.  11. POWER SUPPLY:  11.1 Primary &"power supply shall be low voltage rectified direct current. Rectifiers shall be of the solid state type. Point of connection shall be the line side of the main service switch through an approved fused cutout enclosed in a locked steel cabinet. The connection shall comply with appli- cable requirements of Article 22 of Standard No. 72D of the National Fire Protection Association. Power- supply wiring shall be in conduit or metallic tubing. Transformer, rectifier, resistors, and other required power- su4pply supply unit may be furnished and installed if approved for the application.  11.2 Standby power supply: Standby power that will insure operation of all of the fire- alarm bells within the protected building in the event of power failure shall(/ be provided by a storage battery with a transfer switch. The transfer to battery shall be automatic upon failure of the primary power supply; indicated by a trouble signal at the control alarm location; and arranged so there will be no drain on the ba@ttery except upon transfer and during a fire alarm. Restoration of primary power supply shall automatically disconnect the battery and reconnect the main supply. The transmitter for a coded system in the protected building connected to another location via a proprietary or a central- station- type fire- alarm system shall be arranged to transmit a trouble signal upon failure of the main power supply. The battery shall be housed in the control- unit or transmitter cabinet or in a cabinet as specified above for the control unit and connected to either the control- unit cabinet or the transmitter cabinet. To prevent rapid battery deterioration, positive separation shall be provided to prevent contact between cell terminals, and between terminals and the cabinet. Storage battery shall conform to the requirements of Fed. Spec. W- B- 134, type I II III, class 1 2, style A B.  12. ZONING DEVICES shall be provided as indicated for zoning of fire- detecting circuits. The devices shall be incorporated in or located adjacent to the control unit.  13. HEADQUARTERS EQUIPMENT: Complete receiving, recording, supervisory, and power- supply equipment meeting the requirements for a Class A proprietary system, as defined in NFPA Standard No. 72D, to receive and record clear and intelligible signals, shall be installed at locations indicated. The equip- ment shall be designed to accommodate the number of box circuits indicated, and each box circuit shall operate independently of all other circuits." Meters shall be provided to show at all times the current passing through each transmitter box circuit and the voltage across the terminals of the circuit, with means for determining also the voltage between each side of the circuit and ground. At h^-eadquarters, alarm recording equipment shall be installed on a suitable metal shelf, desk, or table. Recorders or registers shall be of the punch or slash type and shall have spring- wound paper- takeup reels. A single- stroke alarm gong shall be installed at each register location to sound the alarms received, and additional alarm gongs of the same type shall be installed at other locations indicated. Power supply shall be single phase taken from the building electric service as specified in the paragraph POWER SUPPLY. The voltage of the power supply shall be suitably reduced and rectified. A floating storage battery of the sealed type shall be connected across the rectifier output. The battery shall be of a capacity capable of operating the syɉstem for not less than 24 hours with the maximum normal load and with the power supply to the charger discon- nected. The battery shall be housed in a locked metal cabinet as specified above for the control unit, or may be enclosed in the control- or power- sup- ply- equipment cabinet if properly ventilated. The power- supply equipment shall be of adequate capacity to keep the battery in fully charged condition d to give it a periodic conditioning charge of at least one ampere in excess of the normal load. Indicating instruments shall be provided for making the following tests: Current strength in each circuit, voltage across terminals of each circuit at the inside terminals of the protective devices, and voltage between ground and each side ofc? each circuit. Current shall be adjusted to normal before making voltage tests. Failure of charging power supply to the battery shall be indicated by an audible trouble signal energized from the battery.  14. EQUIPMENT MANUALS: In accordance with SECTION: 1B the Contractor shall furnish 4 copies of a manual giving complete instructions for the operation, inspection, testing, and maintenance of the system including wiring diagrams.  15. TOOLS AND SPARE PARTS: Special tools necessary for the maintenance of the equipment shall be furnished. One spare set of fuses of each type and size required, and 2 percent of the total number of each type of detector, but not less than two thereof, shall be furnished. A minimum of 200 feet of each type of 3line detector shall be provided.  16. REPAIR OF EXISTING WORK: The work shall be carefully laid out in advance. Cutting, channeling, chasing, or drilling of floors, walls, parti- tions, ceilings or other surfaces is necessary for the proper installation, support, or anchorage of the conduit or other work and shall be carefully done. Damage to buildings, piping, or equipment shall be repaired and re- finished by skilled mechanics of the trades involved.  17. TESTS: After complete installation of 3Bthe equipment, and at the time as directed by the Contracting Officer, the Contractor shall conduct tests to demonstrate that operating and installation requirements of this specifi- cation have been met.  18. SHOP DRAWING MATERIALS must be submitted for, but are not limited to, those items listed below in accordance with SPECIAL PROVISIONS and SECTION: 1B. Thorough review of shop drawings and other submittals for completeness and compliance with the contract, and necessary correction thereof prior to s:ubmittal, is a Contractor responsibility under the Contractor quality control provisions of this contract.  18.1 Shop drawings for: Panel Power Supply 18.2 Layout drawings to scale (at least 1/4" to 1'- 0") showing locations of all detecto9rs and other equipment.  18.3 Catalog cuts, brochures, and descriptive data for:  Panels Detectors Power Supply Gongs Transmitters Manual Stations Wire 18.4 The Contractor shall submit the qualifications of the installing firmW> and the individual technicians who will be doing the work. A certificate from the equipment supplier of the installing firm and technicians will be included.  19. QUALITY CONTROL: The Contractor shall establish and maintain control of the work covMered under this section to insure compliance with the contract requirements in accordance with the SPECIAL PROVISIONS, including but not limited to the items listed below.  19.1 Only approved materials and equipment are installed.  19.2 Materials are protected before, during and after installation.  19.3 Required tests are conducted and the results documented.  ---------------------------------------------------------------------------------------------------------------------------------------=0--------------ests are conducted and the results documented. LL. l l~ TYPER.SV LOADED BY RLDR REV 05.00 AT 15:14:34 05/28/77 TYPER .DBIN .BIND TMIN NSAC3 DEBUG NMAX 006704 ZMAX 000064 CSZE 000000 EST 047037 SST 047570 DEBUG 001746 TMIN G 001645 TYPER 000445 USTAD 000400 .BIND 001573 .DBIN 001515 .DBNI 001506 .GTCH 000052 .PTCH 000053 .SAC0 020016 .SAC1 024016 .SAC2 030016 .SAC3 034016 .GTCH 000052 .@PTCH 000053 USTAD 000400 TYPER 000445 .DBNI 001506 .DBIN 001515 .BIND 001573 TMIN 001645 DEBUG 001746 .SAC0 020016 .SAC1 024016 .SAC2 030016 .SAC3 034016 COMPAR.SV i i' M ] o  ' H 8 `   g _ +'OT_ku;s::c% -@ @@@ @ @ [.<(+!&]$*);^-/S|,%_>?`:#@'="abcdefghijklmnopqr[~stuvwxyz{ABCDEFGHI}JKLMNOPQR\STUVWXYZ0123456789 1% D& D* @ KC LK MS KCPC U (ENTER 1 FOR EBCDIC,0 FOR ASCII#Pt LK )x(" ENTER INPUTFILENAME ",Z)! (RI (S20)! (START WITH RECORD# F  U> #P QERROR IN IDSK0 OPEN#PՐ@9 KC+PKPC6#C+ U #P4# L" )RECORD COUeNT IS ONLY RECORDS LONGN )ERROR IN FILE=N KC U #PK\# LWY KCPC#C+ (  F ' L3 F ' L U #CC H F.'C F  K+G ) (1X,OI6,"K",OI6,"K",OI6,"K"," ",A2,Z)!#PC`3 )ERROR IN RDSEQ IDSK0= Q X XC   9 f3P/Ґ")GX f'0hPP2! G#P/ ?PGX `WX?COPYRIGHT (C) DGC,1971,1972,1973,1974,1975ALL RIGHTS RESERVED.8 Pn3 !)Z@h#C@l\ll)k=k  C)h )i)d@j9bX)aHo  PP " Y9MT Q hC`CS0 2K$GHi1APk@1PhB0h) :JBӀ@ (n0 2Hn!A (n iPP   U6 Q w  ! " !  MEMORY OVERFLOW OR NO F$COM.$$ $TTO F$COM.$$8 ;    WWP* WWPCK!TPCC!V`CA!NPC!N`C!HCCCCCCCCCCCC!;CPCC2S e"C'C  3 e)%" PS# a+ +3  @S"') +K1  @v1Y3 #C#%d# 7ˀC!C# `K1 # 1N+"\m "KS 7C3"K 7C32IEDFGO.AP2LS(,/Z! )HX[T5"'H#Ƃ +# (#++¦) 3͵S#)3 ,%+3 q#PSCPSP3 B4 # #Ƃ 3 3 =|3!+ ! !  a##C .1J >|3m=\#C 6G1+ J#+ҋ 13"")''B3") ZG+`P2` I3" "*'G+#K,3*K1B)J - \l)83;"B84l3 #C3 @(1<#3 #C @k# h#+A Z aC#+A Z)w a#3 ?CP ; 3+ J#B3ҜCSK 3 "C < #Ă#ł  3#  =4APC =3#  >  > Z!C#C+#3J # a3C#+P I_ 3#P =US#)3A ,CM3#  =|S#)3A ,C ) a3ҝ1+P1 I.3)J S#)3A ,C)#P ="s# a# `1 1 1 G ZFT 3# 3#S)3A ,+A Z)? ) aC'C3 eCPC+r ; 7") !ZS e*3J+JR3C e"G^3B3" )3 eC!33 e"/ǎDlODŽP3 e"/4lZG3"C3 eC3 eC < ) 3K e;+J3 eCǓ eC3 e EC")K1"C1"C3#)J PS Q  #P+ -CS >C#Á `1S #+A Z) a# ` 3ǂC 3#+ ?4C^ ]P@# GKPC3"C e23#B# # ##Ƃ X# X#+A Z) a#3 ?X#) # 3BX Z#C#C#C%CLAJzS#Ƃ N#  #) C) ) #+K+KO3B#BPB#`3` I3'N)%B"C 5C#C# #) ) 9+3K)# ^) ZY FDG+3 q#SPSPP3 A\E' 8+3 +K 9#+C+#+K+#BC#3 9+ë3K :#)ō 1 )#S3A ,C *3)#S)K+#!J3# 9+3K :#+A(` Z+ a#C#Â# 8)֒ 9#C#))K)K3J#+1\llLl8S3̕ Z,l al4l\l8l3#Dl"+Bl8l4l\ll8C3#B)`PB)ZBCBCC#C# `Ѫ 61R 1J 1H # `Ѫ '1C );1; 8.19 +17 $15 &13 #!+3#̂ 3S / 3؀ Z3#B# 1#l4l̅C 6+ΦC@0+-.ED \l8+3SɶS3/ qO4l\l8#C#C3Ʌ/ r4lO\ll83JJ$CʅPC#ʂ S / 33#Ђ6C q C#ʂPC%Cʭ 23PC#ʂ S 0 23#ЂC qC#ʂPC 4l4l8\ll83"(:\lXnn$nLnl")&B"9!n$nLn9l")B:\lPn =32#S01   "   % ( +.1#3 ?C ` aX0 ? X3ҝ! !ʕ;SX)) aP W 1 SCK! CW 1 + ?X&+ ?X$PLT$TTP$CDR$TTO1$TTO$TTI1$TTI$LPT$PTR$PTP$TTRP PCCPC f3 2S7 C1dTK;T  "*#P+Z:-? 8;+;)B   ?  )? ? 3J+JBS)' )# #ĭ? 8;+ ?檛 ?) / *? !P ".+PK)KPK)K# `8 1  # a81U# a\  0h") JZӀ@X Xn8h+I ZP2[n8nW! g3."J10k Z3B+J;;+JXW+3) 3 p8;KSX\l0l!_PlZZ(J#)XB*3 c8lS2SS32 c*8l3"7Ґҕ3'!SK32+ c*8l3#:2 q8l3"K23"@@@32J232 J!3Xl8 \l8l)XlCC2S3!Xl88l)Xl \W.K2 e"+) Z 3:+JXW W2SCKpC# `#K a# X3+ X'/7G\o8OW)#W!WP!K ]." P ]B! ] X "X ( 0 6STOP PAUSE EXIT ! P8#J֠WXTo0Z; \[;Z UBJ@J; 9L"K k'SX)C0Ho*"To0Z?D$$gpi`:#@'D$$j~="abcdefghiD$$hjklmnopqrD$$#h[~stuvwxD$$dyzD$$`f{ABCD$$%iDEFGHI}JD$$iKLMNOPQRD$$gi\STUVWXYZD$$\k0123456789Du@@ u8 _SE301.08 k k1  SECTION 5 VENTILATING SYSTEM, MECHANICAL l. APPLICABLE PUBLICATIONS: The following publications of the issues listed below, but referred to thereafter by basic designation only, form a part of this specification to the extent indicated by the references thereto: l.l Federal Specifications: F-F-300a. Filter, Air Conditioning: Viscous- ImpingBement and Dry Types, Cleanable. F-F-3l0a Filter, Air Conditioning: Viscous- & Int. Am-l Impingement and Dry Types, Replaceable. (GSA-FSS). L-S-l25B. ScreeningG, Insect, Nonmetallic. HH-I-545B Insulation, Thermal and Acoustical & Am-l. (Mineral Fiber, Duct Lining Material). QQ-S-698 Steel, Sheet and Strip, Low-Carbon. B & Am-3. QQ-S-766c Steel Plates, Sheets, and Strip -- & Am-5. Corrosion Resisting. QQ-S-775E. Steel Sheets, Carbon, Zinc-Coated  (Galvanized) by the Hot-Dip Process. RR-W-360A. Wire Fabric, Industrial. RR-W-365 Wire Fabric (Insect Screening). & Am-l. l.2 Federal Standard: No. l4la = Paint, Varnish, Lacquer, and Related & Change Notices Materials; Methods of Inspection, l, 2, 3, 4. Sampling, and Testing. l.3 Military Specifications: MIL-A-33l6B  Adhesives, Fire-Resistant, Thermal & Am-2. Insulation. MIL-F-l608lG. Fans, Ventilating, Propeller. MIL-A-52l74B. Aluminum Alloy Duct Sheet.  l.4 American Board Product\ s Association (ABPA) publication: Bulletin l975. Performance Data Acoustical Materials. l.5 Air- Conditioning and Refrigeration Institute (ARI) Standard: 4l0-72. Forced- Circulation Air- Cooling and Air- Heating Coils. l.6 Air Moving and Conditioning Association, Inc. (AMCA) Standard: 2l0-74. Laboratory Methods of Testing Fans % for Rating. l.7 American Society for Testing and Materials (ASTM) publications: A l67-74. Stainless and Heat-Resisting Chromium- Nickel Steel Plate, Sheet, and T Strip. A 525-75. Steel Sheet, Zinc- Coated (Galvanized) by the Hot-Dip Process, General  Requirements. B 22l-75., Aluminum-Alloy Extruded Bars, Rods, Wire, Shapes, and Tubes. D l57l-73. Woven Asbestos Cloth. E 84-75. Surface Burning Characteristݻics of Building Materials. l.8 National Fire Protection Association (NFPA) Codes: No. 90A-l975. Air Conditioning and Ventilating Systems. x No. 9l-l973. Blower and Exhaust Systems. No. 96-l973. Removal of Smoke and Grease-Laden Vapors from Commercial Cooking EquiCpment. l.9 Sheet Metal and Air Conditioning Contractors National Association, Inc. (SMACNA) publications: Fire Danger Guide for Air Handling System (l970, 3d Prtg, Sep l973). Low Velocity and Duct Construction Standards (l969). l.l0 Underwriters' Laboratories, Inc. (UL) publications: Building Materials Directory (January l976 with Quarterly Supplements). Fire Resistance Index (January l976 with Quarterly Supplements). UL l0B. # Fire Tests of Door Assemblies (Feb. 28, l974; Rev Mar l, l974). UL 555. Fire Dampers (Jul 3l, l973). 2. GENERAL: The contract drawings indicate the extent and generalK arrange- ment of the ventilating system. The Contractor shall be responsible for installing the proposed system as indicated, without violation of applicable codes, standards, or specification requirements. Except where dimensions are shown to locate ductwork or equipment, the drawings show duct size and arrangement only. Equipment and ductwork arrangements submitted shall fit into the space as indicated, and shall allow adequate and approved clearances for entry, servicing and maintenance. L 2.l Capacities of equipment and materials shall be not less than those indicated. 2.2 Conformance to agency requirements: Where materials or equipment are specified to conform to the requirements of the Underwriters' Laboratories, Inc., or thHe Air Moving and Conditioning Association, Inc., the Contractor shall submit proof of such conformance. The label or listing of the specified agency will be acceptable evidence. In lieu of such label or listing, the Contractor may submit a written cer tificate from any nationally recognized testing agency adequately equipped and competent to perform such services, stating that the items have been tested and that the units conform to the requirements specified hereinbefore, including methods of testing of the specified agencies. The system installation shall conform to the requirements of the National Fire Protection Association, Standard No. (90A), (9l), (96). 2.3 Nameplates: Each major item of equipment shall have the manufacturer's namRe, address, serial and model number on a plate securely attached to the item. 2.4 Safety requirements: Belts, pulleys, chains, gears, couplings, projecting setscrews, keys, and other rotating parts so located that personnel can come in close prGoximity thereto, shall be fully enclosed or properly guarded. Items such as catwalks, ladders and guardrails shall be provided where indicated for safe operation and maintenance of equipment. 2.5 Verification of dimensions: The Contractor shall visit the premises to thoroughly familiarize himself with all details of the work and working conditions and verify all dimensions in the field, and shall advise the Contracting Officer of any discrepancy before performing any work. The Contractor *shall be specifically responsible for the coordination and proper relation of his work to the building structure and to the work of all trades. 3. MATERIALS AND EQUIPMENT shall conform to the respective publications and other requirements specified below. Other materials and equipment shall be as specified elsewhere herein and as shown on the drawings and shall be the products of manufacturers regularly engaged in the manufacture of such products. Items of equipment shall essentially duplicIWate equipment that has been in satisfactory use at least two years prior to bid opening and shall be supported by a service organization that is, in the opinion of the Con- tracting Officer, reasonably convenient to the site. 3.l Acoustical duct lilning: Federal Specification HH- I- 545, type I and type II, except as herein specified: 3.l.l Fire hazard classification: Flame spread rating of acoustical materials shall not exceed 25, and smoke developed rating shall not exceed 50 when testedC in accordance with ASTM Specification E 84. The adhesive shall be fire resistant in accordance with Military Specification MIL- A- 33l6. 3.2 Adhesive: Military Specification MIL- A- 33l6, class l or 2 as herein- after specified. 3.3 Air filQters shall be: 3.3.l Sectional cleanable: Federal Specification F- F- 300, type I, of size indicated or required. The holding frame shall be zinc- coated steel specified herein, with cell- holding devices and gasketed cell seats. 3.3.2 Sectio}nal throwaway: Federal Specification F- F- 3l0, type I, grade A, of size indicated or required. 3.4 Aluminum extrusions: ASTM Specification B 22l, alloy 6063, temper T- 5. 3.5 Aluminum sheets: Military Specification MIL- A- 52l74. 3.6 Asbestos: ASTM Specification D l57l, Underwriters grade. 3.7 Screens: 3.7.l Insect screen cloth: Federal Specification RR- W- 365, type VI or VII, or Federal Specification L- S- l25, type II, class l, aluminum color. Mesh size shall be l8 by %l6. 3.7.2 Bird screen: Federal Specification RR- W- 360, type I, class l, with l by l mesh, 0.063- inch diameter aluminum wire or 0.03l- inch diameter stain- less steel wire. 3.7.3 Frames for screens: Frames shall be provided for screens; frqames shall be removable and shall be of extruded aluminum or stainless steel. Insect screen frames shall be grooved type with vinyl or neoprene spline insert for securing screen cloth. 3.8 Steel sheets shall conform to the following requirements: 0 3.8.l Uncoated: Federal Specification QQ-S-698, skin-passed temper. 3.8.2 Galvanized: Federal Specification QQ-S-775, type I, class d; ASTM Specification A 525. 3.8.3 Corrosion resisting: Federal Specification QQ-S-766, class 304, finish Number l; ASTM Specification A l67. 4. WORKMANSHIP: Materials and equipment shall be installed in accordance with the approved recommendations of the manufacturer to conform to the contract documents. The installations shall be accomplished by> workmen skilled in this type of work. 5. ELECTRICAL WORK: Electrical- motor- driven equipment specified herein shall be provided complete with motors, (motor starters,) and controls. Electrical equipment and wiring shall be in accordance with SECTION: ELEC- TRICAL WORK, INTERIOR. (Motor starters shall be provided complete with properly sized thermal overload protection and other appurtenances necessary for the motor control specified.) Manual or automatic control and protective or signalV1 devices required for the operation specified herein, and any control wiring required for control devices but not shown on the electrical plans, shall be provided under this section. 6. AIR MOVING DEVICES: 6.l General: Fans shall be tested a1nd rated in accordance with the standards of the Air Moving and Conditioning Association, Inc. Standard 2l0. Fans may be directly connected to the motor shaft or indirectly connected to the motor by means of a V- belt drive unless otherwise specified.Q Where V- belt drives are used, such drives shall be designed for not less than l50 percent of the connected driving capacity, and motor sheaves shall be adjustable to provide not less than 20 percent speed variation. Sheaves shall be selected tom drive the fan at such speed as to produce the specified capacity when set at the approximate midpoint of the sheave adjustment. Motors for V- belt drives shall be provided with adjustable rails or bases. Fans shall be provided with personnel scree!ns or guards on both suction and supply ends except where ducts or dampers are connected to the fan. Fans and motors shall be provided with vibration isolation supports or mountings. Vibration isolation units under floor mounted equipment shall be standard products with published loading ratings, and shall be single rubber- in- shear, double rubber- in- shear springs, or springs under inertia base. Each fan shall be selected to produce the capacity required at the fan total pressure  indicated. Standard AMCA arrangement, rotation and discharge shall be as indicated on the drawing. (On recirculating ventilating systems, a fire safety switch shall be provided in the return duct ahead of the fresh-air intake to de- energize the fan if the rhair temperature exceeds l25 degrees F.) 6.2 Centrifugal fans shall be fully enclosed, single- width single- inlet, or double- width double- inlet, as required or indicated. Impeller wheels shall have backward inclined or backward curved blades of the non- overloading type, except wheels l2 inches in diameter or smaller may have forward curved blades. Impeller wheels shall be rigidly constructed, accurately balanced both statically and dynamically, and free from objectionable vibration or (noise. Fan blades may be flat or airfoil design in wheel sizes up to 27 inches. Fan blades for wheels over 27 inches shall be of airfoil design. Fan wheels over 36 inches in diameter shall have overhung pulleys and a bearing on each side of the wheͯel. Fan wheels 36 inches or less in diameter may have one or more extra-long bearings between the fan wheel and the drive. The bearings shall be babbitted sleeve type, self- alining and self-oiling with adequate oil reservoirs, or shall be self- alining ball type with accessible grease fittings. The fan shafts shall be steel, accurately finished, and shall be provided with key and key seats for impeller hubs and fan pulleys. Each fan outlet shall be designed for the attachment of angles an>d bolts for attaching flexible connections. The fans shall be furnished with coating hereinafter specified in paragraph PAINTING AND FINISHING. (Manually) (Motor) operated vortex dampers shall be provided on suction inlets. (Motor- operated) (Gravity) outlet dampers shall be provided. Motor, unless otherwise indicated shall not exceed l,800 r.p.m. and shall have (open) (dripproof) (totally- enclosed) (explosionproof) enclosure. Motor starters shall be (manual) (magnetic) (across- the- lin'e) (reduced- voltage- start) type with (general- purpose) (weather- resistant) (water- tight) enclosures. Remote manual switch with pilot indicating light shall be provided where indicated. 6.3 Propeller fans and motors shall be supported on heFavy metal frames designed for wall opening and mounting. Fan wheels less than 24 inches diameter shall be directly connected to the motor, and fans 24 inches diameter or larger shall be connected to the motor by a V- belt drive. Fan shall conform to Military Specification MIL- F- l608l. Motors shall have (open) (dripproof) (totally- enclosed) (explosionproof) enclosures. Motor starters shall be (manual) (magnetic) (across- the- line) type with (general- purpose) (weather- resistant) (wateJ%r-tight) (explosion- proof) enclosures. (Gravity) (Motor- operated) dampers shall be provided as hereinafter specified. Remote manual switch with pilot indicating light shall be provided where indicated. 6.4 Power roof ventilators shall be (propeller) (centrifugal) type with a weathertight housing and turned down rectangular base constructed of aluminum, galvanized steel, or glass fiber reinforced high- impact plastic. Fan discharge opening shall be provided with l by l inch wire mesh bird screens suitable for the weathertight housings. Sealed, permanently lubricated sleeve, roller or ball bearing with provision for end thrust shall be provided. The fan motor on centrifugal units shall be enclosed in an air- cooled motor compartmaent outside of the exhaust air stream. Motors shall have (dripproof) (totally- enclosed) (explosion- proof) enclosures. Motor starters shall be (manual) (magnetic) (across- the- line) type with (general- purpose), (weather-resistant) (explosion- prtoof) enclosure. Remote manual switch with pilot light shall be provided where indicated. (Gravity) (motor- operated) back-draft dampers shall be provided as herein specified. Motors shall be provided with safety disconnect switch mounted under the fan housing adjacent to the motor. and shall be complete with airtight enclosure, fans, motors, adjustable V- belt drive, belt guards, access doors wherever required for servicing, filters, (heating-coil,) (mixing box,) (filter box,) (combination] filter- mixing box,) vibration isolation bases, and any other appurtenances necessary for satisfactory operation. Each air-handling unit shall have physical dimensions suitable to fit space allotted to the unit, and shall have the capacity indicatned. 6.5.l Enclosure shall be constructed of not lighter than l8 gage, 0.0478 inch nominal thickness, hot- dip galvanized steel or finished as hereinafter specified under paragraph PAINTING AND FINISHING. The enclosure shall be acoustically lined at the factory with not less than l inch thickness of fiber glass manufactured for duct liner service. All acoustical duct liner materials, coating and adhesive shall conform to fire- hazard requirements in paragraph Acoustical duct lining under !? paragraph MATERIALS AND EQUIPMENT. 6.5.2 Filters shall be ( -inch throwaway) ( -inch permanent) (or) and shall conform to the requirements as specified in paragraph AIR FILTERS. 6.5.3 Fans shall be double- inlet centri qfugal type with each fan in a separate scroll. Fans shall be statically and dynamically balanced at the factory in the air handling unit. Fans shall be mounted on steel shaft accurately finished, and supported in ball- type bearings provided with Ilubrication facilities outside of the unit, or permanently lubricated sleeve-type or ball- type bearings. Fans shall be driven by a unit- mounted motor connected to fans by V- belt drive complete with belt guard. Sheaves shall be adjustable to provE:ide not less than 20 percent speed variation and shall be selected to drive the fan at such a speed as to produce the specified capacity when set at the approximate midpoint of sheave adjustment. Fan motors shall have (open) (dripproof) (totally- enclosed) (explosionproof) enclosures. Motor starters shall be (manual) (magnetic) (across- the- line) (reduced- voltage- start) type with (general- purpose) (weathertight) (explosion-proof) enclosure. Remote manual switch with pilot indicating lig ht shall be provided where indicated. 6.5.4 Heating coils shall be as follows: 6.5.4.l Water coils shall be fin- and- tube type constructed of seamless copper tubes and copper or aluminum fins mechanically bonded or soldered to tube. Casing agnd tube support sheets shall be ]6 gage, 0.0635 inch nominal thickness, galvanized steel, formed to provide structural strength. Tubes shall be correctly circuited for proper water velocity without excessive pressure drop and they shall be drainableT where required or indicated on drawings. Each coil shall be tested at the factory under water at not less than 250 p.s.i. air pressure and shall be suitable for 200 p.s.i. working pressure. Coils shall be mounted for counterflow service. Drainaޤble coils shall be installed in the air handling units with a pitch of not less than ]/8 inch per foot of tube length toward the drain end. Coils shall conform to the provisions of ARI Standard 4l0. 6.5.4.2 Steam coils shall be constructed o>f cast semi-steel, welded steel, or copper headers, red-brass or copper tubes, and copper or aluminum fins mechanically bonded or soldered. Tubes shall be rolled and bushed, brazed or welded into headers. Coil casings and tube support sheets, withk collars of ample width, shall be not lighter than l6 gage, 0.0635 inch nominal thickness, galvanized steel, formed to provide structural strength. When required, multiple tube supports shall be provided to prevent tube sag. The fin tube and header s^ection shall float within the casting to allow free expansion of tubing for coils subject to high pressure steam service. Coils shall be factory tested at 250 p.s.i. hydrostatic test pressure or under water at 250 p.s.i. air pressure and shall be ~designed for 200 p.s.i. steam working pressure. Preheat coils shall be steam- distributing tube type with condensing tubes not less than 5/8 inch outside diameter. Distributing tubes shall be not less than 3/8 inch outside diameter, with orifices tIIo discharge steam to condenser tubes. Distributing tubes shall be installed concen- tric inside of condenser tubes and shall be held securely in position. The maximum length of a single coil shall be limited to l20 times the diameter of the outsidGe tube. Other heating coils shall be single- tube type with not less than l/2 inch outside diameter. Supply headers shall distribute steam evenly to all tubes at the indicated steam pressure. Coils shall conform to the provisions of ARI Standard 4l0. 6.6 In- line centrifugal fans shall have welded tubular steel casing, centrifugal backward inclined blades, stationary discharge conversion vanes, internal and external belt guards, and adjustable motor mounts. Air shall enter and leave the &fan axially. Inlets shall be streamline with conversion vanes to eliminate turbulence and provide smooth discharge air flow. Fan bearings and drive shafts shall be enclosed and isolated from the air stream. Fan bearings shall be sealed against dustrO and dirt and shall be permanently lubricated. Motors shall have (open) (drip- proof) (totally- enclosed) (explosionproof) enclosure. Motor starters shall be (manual) (magnetic) (across-the-line) type with (general- purpose) (weather-resistant) (e]xplosionproof) enclosure. Remote manual switch with pilot indicating light shall be provided where indicated. 6.7 Centrifugal ventilators shall have weatherproof housing constructed of aluminum or glass- fiber- reinforced high- impact plastic. Fa~n wheels shall be backward curved, non- overloading centrifugal type accurately balanced statically and dynamically. The fan shall be designed to discharge the air down or away from the building exterior wall. The discharge opening shall be provided with aluminum bird screen. Motors shall have (dripproof) (explosionproof) enclosure. Motor starters shall be (manual) (magnetic) (across-the- line) type with (general-purpose) (weather- resistant) (explosionproof) enclosure. Remote manual switch with pilot light shall be provided where indicated. Fan shall be provided with (wall-grille) (gravity dampers) (motor-operated damper). 7. DAMPERS: 7.l Gravity dampers shall be factory- fabricated, parallel- blade type with delicatelcy balanced blades that open automatically when the fan starts and close by gravity when the fan stops. The blades shall be constructed of galvanized steel or aluminum sheets with interlocking edges, with a maximum width of l0 inches. The edges of t'he blades shall be provided with felt or rubber strips to prevent rattling. Damper blades shall be supported on galvanized steel or aluminum frames. 7.2 Motor-operated dampers shall be factory-fabricated, (parallel- blade) (opposed-blade) type c#onstructed of galvanized steel or aluminum sheets. The blades shall have a maximum width of l0 inches. The edges of the blades shall be supported on galvanized or aluminum frames. The damper operator shall be connected so that the damper will remain open when the fan is running and will be closed when the fan is stopped. The operator shall be electric or pneumatic and shall be (two- position) (modulating) type, as required, indicated or specified. Electric motors shall operate the dampers through an oil- immersed gear train. 7.3 Manual dampers and splitters: Manual dampers with locking quad- rants, multiple- blade dampers, and splitter dampers shall be installed where indicated or necessary for proper control and balancing of air 99 distribution. All dampers shall have an accessible operating mechanism. Exposed parts of operating mechanisms occurring in finished portions of the building shall be chromium plated with all exposed edges rounded. Operators shall not project bel]row the ceiling in neuropsychiatric areas. Splitter dampers shall be operated by a 3/l6- inch rod brought through the side of the duct and locked with a setscrew and bushing. Two rods shall be provided for splitter dampers over l2 inches in width. +Dampers and splitters shall be constructed of material two gages heavier than the duct. Multiple blade dampers shall be (opposed -blade) (parallel- blade) type with a maximum blade width of l2 inches. Two or more blades shall be used when the bla Tde width is more than l2 inches. Splitter dampers shall be of sufficient length to close off either branch duct. 7.4 Fire dampers shall be provided in accordance with the National Fire Protection Association Standard No. (90A) (9l) (96). Dampers shall be installed with sufficient tension to prevent rattling or vibration. Fire dampers shall conform to the requirements of Underwriters' Labora- tories, Inc. 7.4.l Fire doors and fire dampers conforming to UL l0B and UL 555 shall be pr*ovided where shown. All ducts passing through one-hour partition or walls shall be provided with fire dampers where shown on the drawings. All ducts passing through 2-hour walls shall be provided with fire dampers where shown. All ducts passing th[rough 4-hour walls shall be provided with fire doors where shown. All ducts providing service to two or more floors shall be located in a fire rated chase or equipped with fire dampers or fire doors as appropriate. All ducts passing through walls and ceilings of heater/boiler rooms shall be provided with fire dampers whether shown or not. Fire doors and fire dampers shall be automatic operating type approved for the protection of openings in one-, two- and four-hour fire-rated walls and partitions and shall be installed in accordance with the conditions of their approval and the manufacturer's instructions. Suitable handhole openings with tightly fitted access covers or doors shall be provided in the ducts to make all fire doors an5d fire dampers accessible for inspection and maintenance. Ductwork in fire-rated floor-ceiling or roof-ceiling assembly system with air ducts that pierce the ceiling of the assembly shall be constructed in conformance with designs in Underwriters'  Laboratories, Inc., Fire Resistance Index. Other designs that have been tested by an approved, independent, nationally recognized testing organization and comply with the requirements set forth in NFPA 90A are acceptable. Unless otherwise shown, t9he installation details given in NFPA 9l for fire doors and in SMACNA Fire Damper Guide for fire dampers shall be followed except minimum thickness metal for all sleeves provided for fire dampers shall be not lighter than l4 gage. All accessory item/s associated with the fire doors and fire dampers such as retaining angles, sleeves, breakaway connections and access doors shall be provided. 8. AIR FILTERS shall be class l or 2 in accordance with Underwriters' Laboratories, Inc., Building Materials Directory, except as specified herein: 8.l Range and griddle hood filters shall be sectional, permanent, washable type, designed for extraction of grease from grease- laden air. The filters shall be the all- metallic- media type with suitable metal frames, and shall be listed in the Underwriters' Laboratories, Inc., Building Materials List, Guide AKUS. Filters shall be nominal 2 inches thick. Clean filter shall have static pressure not in excess of inch of water when handl҃ing CFM air. Filter dimensions shall be suitable for the application as indicated. 8.2 Sectional renewable media filters: The air filters shall be sectional, renewable dry- media type, of the size required to suit the application. The filtering media shall be (l inch thick) (2 inches thick) glass- fiber media pad enclosed in sectional frames of not less than l6- gage galvanized steel and equipped with quick- opening mechanism for changing filter media. The air flow capacity of the fzilter shall be based on net filter face velocity not exceeding 350 feet per minute with initial resistance of (0.08) (0.l0) inch water gage. 8.3 Sectional cleanable filters shall be in accordance with Federal Specification F- F- 300, type I (l iFnch) (2 inches) thick and of the size required. The holding frame shall be galvanized steel specified herein- before, with suitable cell- holding devices. Viscous adhesive shall be provided in 5- gallon containers in sufficient quantity for twelve cleaning operations and not less than l quart for each filter section. One washing and charging tank shall be provided for every l00 filter sections or fraction thereof. The drain rack shall be provided with dividers and partitions to properly support the filters in the draining position. 8.4 Sectional throwaway filters shall be in accordance with Federal Specification F- F- 3l0. Filters shall be (l inch) (2 inches) thick, of the size required. 9. DUCTWORK shall be constructed ofk galvanized steel sheets or of aluminum sheets. Ducts, unless otherwise approved, shall conform to the dimensions indicated and shall be straight and smooth on the inside, with joints neatly finished. All edges and slips shall be hammered down toJQ leave a smooth interior duct finish. Joints shall be made substantially airtight, and no dust marks from air leaks shall show at connections, grilles, register, or diffusers. Ducts shall be anchored securely to the structural slab or framing in th>e building and the method of anchoring and/or fastening shall be detailed on the layout drawings. Ducts shall be so constructed and installed as to be completely free from vibration under all conditions of operation. Layout drawings required under `the paragraph SHOP DRAWING MATERIALS shall show, for suspended ductwork, the location of all supports, typical details for anchorages, and details for special anchorages for supports attached to metal roof decking. Supports shall be attached only >o structural framing members and concrete slabs. Supports shall not be anchored to metal decking unless a means is provided and approved for preventing the anchor from puncturing the metal decking. Where supports are required between structural framing members, suitable intermediate metal framing shall be provided and detailed. Items not shown in detail or described herein shall be set forth in the publication, Low Velocity and Duct Construction Standards of the Sheet Metal and Air Conditi0oning Contractors National Association. 9.l Rectangular ducts shall be fabricated in conformance with SMACNA Low Velocity and Duct Construction Standards. 9.2 Round ducts shall be fabricated in conformance with table I. 9.3 Paint- spray 'Gexhaust ducts: Sheet metal thicknesses required for paint- spray exhaust systems and other flammable vapors shall conform to NFPA Standard No. 9l. 9.4 Kitchen exhaust ducts: Ducts for hoods over cooking equipment used in processes producing smoke or grease- laden vapors shall be corrosion resisting steel and constructed and installed as required by NFPA Standard No. 96. Ductwork exposed in kitchen and dining areas shall be fabricated from not less than l8 gage corrosion resisting steel T#welded liquid tight and pitched so that condensate will drain towards hoods or low spots indicated. Concealed ductwork serving hoods over moisture producing equipment such as dishwashers, urns, steamtables, and serving lines shall be not less than ll8 gage corrosion resisting steel or galvanized steel with joints and seams welded or soldered liquid tight to be compatible with the material. Transitions between corro- sion- resisting steel and galvanized steel shall be provided with a gasketed l]iquid tight insulating flange. 9.4 "(FOR AIR FORCE PROJECTS: Kitchen exhaust ductwork will be constructed of No. l2 U.S. Gage black iron with all joints welded. Ductwork exposed in kitchen and dining areas shall be fabricated from corrosionR resistant steel not less than No. l4 US Gage, welded water- tight.) 9.5 Air deflectors shall be provided in: all square elbows, duct- mounted supply outlets, takeoff or extension collars to supply outlets, and tap- in branch- takeoff connections%s. Air deflectors shall be factory fabricated and factory or field assembled units consisting of curved turning vanes or louver blades for uniform air distribution and change of direction with minimum turbulence and pressure loss. Square elbows sQhall be provided with curved vanes. 9.6 Hinged duct- access doors shall be provided at all air control dampers, fire dampers, and at all other apparatus requiring service and inspection in the duct systems. Access door openings shall be ]5 inches by ]8 inches unless otherwise indicated. Where size of duct will not accommodate this opening, the doors shall be made as large as practicable. Access doors of rigid type, not less than 24 by 24 inches, shall be provided on each side of each a+ir- handling unit, and shall be made airtight with felt or rubber gaskets. Doors shall be provided with galvanized steel hinges having bronze pins and two approved brass fasteners. All doors 24 by 24 inches and over shall be provided with fastene'Mrs that can be operated from both sides. Access doors in plenums and ducts with acoustical lining shall be provided with the same lining. 9.7 Duct test holes: Holes with covers in ducts and plenums shall be provided where indicated, directed, or Awhere necessary for using pitot tubes for taking air measurements to balance the air systems. 9.8 Apparatus connections: Where sheet metal connections are made to fans, or where ducts of dissimilar metals are connected, a noncombustible flexible Econnection of ]5- ounce woven asbestos or other approved non- combustible materials approximately 6 inches wide conforming to ASTM Specification D ]57] shall be installed and securely fastened by zinc- coated steel clinch-type draw bands for round duccts. For rectangular ducts the flexible connections locked to metal collars shall be installed using normal duct construction methods. 9.9 Duct sleeves and framed prepared openings: Duct sleeves shall be provided for all round ducts l5-inches diameter or less passing through floors, walls, ceilings, or roofs and shall be installed during construc- tion of the floor, wall, ceiling or roof. Round ducts larger than l5 inches diameter and all square and rectangular ducts passing through flMoors, walls, ceilings, or roofs shall be installed through framed prepared openings. The Contractor shall be responsible for the proper size and location of sleeves and framed prepared openings. Duct sleeves and framed prepared openings shall be pr ovided for all duct mains and duct branches. Branch takeoff connections to grilles, registers and diffusers shall be in accordance with SMACNA Low Velocity and Duct Construction Standards. 9.9.l Duct sleeves shall be fabricated from 20 gage,% 0.0396 inch nominal thickness, galvanized steel unless otherwise indicated. Where sleeves are installed in bearing walls or partitions, black steel pipe, schedule 30, 40 or standard weight shall be used. Sleeve shall provide ] inch clearance between the duct and the sleeve except at grilles, registers and diffusers. 9.9.2 Framed prepared openings for round ducts larger than l5 inches diameter and for all square and rectangular ducts shall provide l inch clearance between the duct and tN&he opening except at grilles, registers, and diffusers. 9.9.3 Closure collar of galvanized steel not less than 4 inches wide shall be provided on each side of walls or floors where sleeves or prepared openings are provided except where grilles, -ontrol valve to regulate the high temperature hot water supplied to the converter. A room thermostat shall be provided as a temperature-limit switch to stop the circulating pump in order to prevent space overheating. The circulating pump shall operate conptinuously except when stopped by the space thermostat or the outside high limit thermostat when the temperature exceeds 65~ F.  l2.2.6 Room Thermostats shall be an approved lock-shield type, without thermometers and designed to operate on a 2~ F tempera ture differential over a range of [55 to 85~ F] [36 to 65~ F]. Thermostats shall be of the [stop- start type] [or] [proportioning type, with provisions for night setback].  l2.2.7 Outdoor Reset Thermostat shall be of the adjustable type set for a desigdn of temperature of ~ F with a heating supply water temperature of ~ F. A suitable ventilated weather shelter shall be provided for the outside sensing element. The unit shall be mounted indoors with its sensing element located in the outdoor aoir. The unit shall proportionally reset the control point of a remote sensing temperature controller.  l2.2.8 Seven-day Program Timer shall be provided with the proper switching action so that one timer will switch all zones. The timer schedule for each zone shall provide for raising and lowering the temperature twice during each 24-hour period throughout the week. During the weekend, there shall be one cycle of raising and lowering the zone temperature.  l2.3 Space-temperature Control For Unit Heaters: The space temperature shall be maintained automatically be stopping and starting the unit heater fan by means of a room thermostat.  l2.4 Space-temperature Control For Heating And Ventilating Units: A manual switch shall start the fan motor and put the control circuit in operation. When operating automatically with a room temperature below 67~ F, the coil shall be filled with hot water, the fresh-air damper shall be closed, the recirculating damper shall be wide open, and the unit shall develoXp maximum heating capacity. When the room temperature rises to 67~ F, the fresh-air damper shall open automatically to the minimum setting indicated, and the recirculating damper shall close correspondingly. As the room temperature continues to rise,G the modulating hot water valve shall gradually modulate the temperature of the water supplied to the coil until finally the modulating valve is completely closed on the hot water side and the unit is developing maximum cooling capacity with the minimum 0fresh-air setting. If the room temperature continues to rise with the modulating valve closed, the fresh-air damper shall open gradually and the recirculating damper shall close gradually, modulating between minimum and l00 percent fresh air as necessary to counteract excess heat load. On a falling temperature within the room, the cycle of automatic operation shall be reversed. The room thermostat shall be a modulating type. A suitable two-point manual selector switch shall be provided for auto- mbatic operation as described herein, or for night operation at reduced tempera- ture with no fresh air. The control switch for the fans shall be so arranged that the fresh-air damper is closed when the fans are not in operation. A thermostat in the airstr]eam shall prevent the outlet temperature from dropping below a predetermined minimum. Motor control shall be magnetic across-the-line type with general-purpose enclosure and three-position manual-off-automatic selector switch in the cover.  l3. COLD-WiATER CONNECTIONS shall be made to the water supply system as indicated. Necessary pipe, fittings and valves required for water connections between the converter and cold-water main shall be provided as shown on the drawings and in conformance with requirexments of SECTION: PLUMBING, GENERAL PURPOSE. Pipe shall be galvanized steel or Type L copper tubing.  l3.l Relief Valve: The pressure-relief valve shall be adjusted to open automatically when the pressure within the heating system rises above lb/in2g. The discharge from the relief valve shall be installed where shown. The valve shall be equipped with a lever for manual operation. All pressure relief valves shall be ASME-approved and -rated.  l3.2 Strainers: Basket or Y-type strainers shall be the same size as the pipelines in which they are installed. The strainer bodies shall be heavy  and durable, of the best grade cast iron, with bottoms drilled and plugged. The bodies shall have arrows clearly cast on the sides to indicate the direc- tion of flow. Each strainer shall be equipped with an easily removable cover and sediment basket. The basket shall be not less than 0.025-inch thick (22 gage) sheet brass with not less than 400 small perforations/in2 to provide a net free area through the basket of at least 3.30 times that of the entering pipe. The flow shall be into the basket and out through the perforations.  l3.4 Pressure-regulating Valve: The valve shall be a type that will not stick nor allow pressure to build up on the low side. T^he valve shall be set to maintain a terminal pressure of approximately five lb/in2 in excess of the static head on the system and shall operate within a two-lb/in2 varia- tion regardless of initial pressure and without objectionable noise under any condition of operation.  l4. CONTROL VALVES AND CONTROLLER:  l4.l Thermostatic Steam-regulating Valve: The valve shall be adjustable, shall have an operating range of approximately l00~-200~ F, and shall be furnished complete with a thermostatic element, steam valve, connecting capillary tubing, and all required accessories. The thermostatic element shall be inserted in a separable socket in the hot-water supply main.  l4.2 Water-temperature Controller: Controller shall be of a sturdy con- struction,  protected against dust and dampness. The thermostatic element shall be inserted in a separable socket installed in either the upper part of the converter shell or in the hot-water-supply line leaving the converter. The controller shall operate on a l0~ F differential over an adjustable temperature range of approximately l00~-220~ F. and shall be suitable for operating in conjunction with the motor-operated steam valve (and 3-way mixing valve) supplied.  l4.3 Motor-operated-steam Valve: Bodies shall )be designed for a static pressure of l25 lb/in2g and shall be installed in the steam-supply main to the converter. The valve shall be of the [2-position type] [fully proportioning type] and shall regulate the flow of steam to the coil in the converter in r< response to the temperature controller. Valves larger than 2 inches shall be equipped with renewable seats of noncorrodible metal. The electric motor shall be suitable for a steam working pressure of 40 to l00 lb/in2 as required.  l4.4 Three-way Mi9Exing Valve: Valve shall be of the fully proportioning packed type, with metal disk, bronze body and trim designed for a static pressure of l50 lb/in2g. The valve shall have a detachable operator powered by a reversible motor and enclosed in a metal cove8r and equipped with a posi- tion indicator, as specified below.  l4.5 High Temperature Water Control Valves: Control valves shall be two-way or three-way pattern of the modulating type as indicated for the sequence below specified. Valve bodies shall be rated for service as noted above. Valves shall be tight closing type. Valve actuator for HTW shall be the  reversible type with proportional motor and adjustable stroke with cast alumi- num mounting yoke. Ambient temperature range is 25~-l50~ F. Bo\dy shall be carbon steel, globe type with screwed connections. Packing shall be teflon-impregnated asbestos with Type 3l6 stainless steel trim. Valve shall have close-off rating for pressures and temperatures of approximately degrees F and lb/Рin2g inlet and degrees F and lb/in2g on return side. Each valve for modulating service shall have a contoured plug with removable disks, and each valve shall be provided with valve-stem travel indi- cator or means of indicating position of the valve, as specified below in pargraph Control Indicating Devices.  l4.6 Damper Or Valve Operator: Operator shall be provided for each automatic damper or valve and shall be of sufficient capacity to operate the damper or valve under all conditions, and tDo guarantee tight close-off of valves as speci- fied, against system pressure encountered. Each operator shall be full-propor- tioning and provided with spring-return for normally closed or open position for fire or freeze protection on power interruptio7n as indicated. Valve and damper operating speeds shall be selected or adjusted so operators will remain in step with the controller without hunting regardless of load variations. Operators acting in sequence with other operators shall have adjustment o!If the control sequence as required by the operating characteristics of the system. Electric and electronic modulating operators shall be hydraulic or oil-immersed gear-train type.  l4.7 Control Indicating Devices: Each controller, except space therm Mo- stats, shall be provided with a permanent device to indicate exact point at which controller is operating within the modulating range. For individually mounted controllers, the indicating device may be permanently mounted or may be a portable volt-ohmd meter. Volt-ohm meters shall be 20,000 ohms for direct current or 5,000 ohms for alternating current. At each controller where port- able devices are used, means shall be provided for attaching and disconnecting the indicating devices without the use of tools, except for removal of covers, and without breaking control lines.  l5. CONDENSATE-PUMPING UNIT: [Each] [The] pump shall have a minimum capacity of gal/min when discharging against the specified pressure. The minimum capacity of the tank shall be gallons. The condensate-pumping unit shall be of the [single] [duplex], [horizontal-shaft] [vertical-shaft] type, as indicated. The unit shall consist of [one] [two] pump[s], [one] [two] electric motor[s] and a single receiver, all mounted on a suitable cast iron or steel base. [The motor may be mounted on the receiving-tank top]. The pump[s] shall be centrifugal or turbine type, bronze-fitted throughout, with impellers of bronze or other approved corrosion-resistant metal. The pump[s;] shall be free from air-binding when handling condensate with tempera- tures up to 200~ F. The pump[s] shall be connected directly to [a] suitable dripproof enclosed motor[s]. The receiver shall be cast iron or of not less than 3/l6-inch-thick black iron or steel and shall be provided with all the necessary reinforced threaded openings, including condensate return, vent, overflow, and pump suction connections. Inlet strainer shall be provided either integral in the tank or separate in the inlet line toL the tank. The vent pipe shall be galvanized steel, and the fittings shall be galvanized malleable-iron. The vent pipe shall be installed as indicated or directed.  receiving tank may be mounted on a single base with the receiver piped to the pump su}ction[s]. A gate valve and check valve shall be provided in the discharge connection from each pump.  l5.l Controls: Enclosed float switch[es] complete with float mechanism[s] shall be installed in the head of the receiver. [The] [Each] condensate ȓpump shall be controlled automatically by means of the [respective] float switch that will automatically start the motor when the water in the receiving tank reaches the high level, and stop the motor when the water reaches the low level. The motor[s]y shall be provided with magnetic across-the-line starter[s] equipped with general-purpose enclosures and 3-position manual-off-automatic selector switch in the cover.  l5.2 Rating And Testing: The pump manufacturer shall submit a test report in the form of an affidavit, covering the actual test of the unit and certifying that the equipment complies with the specified requirements in all respects.  l6. FLASH TANK shall be sized and installed as indicated. The flash tank shall be welded construction utilizing steel sheets not less than 0.ll96-inch in nominal thickness (ll gage). The tank shall be provided with a handhole and with tapping for the condensate returns, drip lines, vent line, and condensate discharge line to the condensate receiveQr. The discharge line shall be equipped with a float trap. The vent pipe shall be of galvanized steel, and the fittings shall be of galvanized malleable iron. The vent pipe shall be installed as indicated or directed. Vent piping shall be flashed asu below specified.  l7. EXPANSION TANK shall be constructed of steel in accordance with require- ments of the ASME Boiler and Pressure Vessel Code, Section VIII, for a working pressure of l25 lb/in2g.  l8. PIPING: Unless otherwise specified herein,8 pipe and fitting shall conform to the requirements of ANSI B3l.l, Section l. Pipe shall be cut accurately to measurements established at the jobsite, worked into place without springing or forcing, and properly clear windows, doors, and other opening&s. Cutting or other weakening of the building structure to facilitate piping installation will not be permitted.  Pipes shall have burrs removed by reaming, and shall be so installed as to permit free expansion and contraction without causing damage to$ building structure, pipe, joints, or hangers. Changes in direction shall be made with fittings, except that bending of pipe up to four inches will be permitted, provided a pipe bender is used and wide sweep bends are formed. The center line radius of% bends shall be not less than six diameters of the pipe. Bent pipe showing kinks, wrinkles, flattening or other malformations will not be accepted. Vent pipes shall be installed through the roof as indicated and shall be flashed as below specified. Unless otherwise indicated, horizontal supply mains shall pitch down in the direction of flow with a grade of not less than one inch in 40 feet. Open ends of pipelines and equipment shall be properly capped or plugged during installation to keep dirt or other foreign materials out of the systems. Pipe not otherwise specified shall be uncoated. Unless otherwise specified or shown,  steel pipe 2 l/2 inches or less in diameter, and with flanges for pipe three or more inches in diameter. Unions for copper pipe or tubing shall be brass or bronze. Connections between ferrous and copper piping shall be electrically isolated from each other with dielectric unions as specified below.  l8.l Low Temperature Water Piping: Piping shall be steel, conforming to ASTM A 53, Grade A, standard weight, black; ASTM A l20, standard weight, black; Fed. Spec. WW-P-406, weight A, Class l; or Fed. Spec. WW-P-404, Grade A, standard weight, black; or copper tubing conforming to Fed. Spec. WW-T- 799, type K or L.  l8.2 Low Temperature Water Fittings: Fittings shall be [cast iron] [black, malleable-iron] [or steel] [solder-joint] [or] [flared-tube] type. Fittings adjacent to valves shall suit valves specified. Reducing fittings shall be used for changes in pipe sizesE. In horizontal lines, reducing fittings shall be the eccentric type to maintain the bottom of the adjoining pipes at the same level. [Fittings for copper tubing shall be of the solder-joint type, cast or wrought bronze or wrought copper.]  l8.3 Steam Piping And Fittings: Piping shall be steel, conforming to ASTM A 53, Grade A, standard weight, black; ASTM A l20, standard weight, black; Fed. Spec. WW-P-406, weight A, Class l; or Fed. Spec. WW-P-404, Grade A, standard weight, black. Fittings shall be black, malleable-iron or steel; fittings adjacent to valves shall suit valves specified. Reducing fittings shall be used for changes in pipe sizes. In horizontal steam lines, reducing fittings shall be the eccentric type to maintain the bottom of the lines at the same level.  l8.4 Condensate Return Piping And Fittings: Fittings shall be steel conforming to ASTM A 53, extra strong weight, black; ASTM A l20, extra strong weight, black; Fed. Spec. WW-P-406, weight B, Class l or Fed. Spec. WW-P-404, ?Grade A, extra strong, black. Fittings shall be cast iron or malleable-iron, extra heavy.  l8.5 Vent Piping And Fittings: Piping shall be steel, conforming to: ASTM A 53, Grade A, standard weight, black; ASTM A l20, standard weight, black; Fed. Spec.[ WW-P-406, weight A, Class l; or Fed. Spec. WW-P-404, Grade A standard weight, black. Fittings shall be black malleable-iron to suit piping.  l8.6 High temperature Water Piping: Piping shall be black, seamless, schedule 40 steel and shall conform to ˮASTM A 53, Grade B, or to ASTM A l06, Grade B.  l8.7 High Temperature Water Fittings: Fittings shall be steel welding fittings conforming in physical and chemical properties to ASTM A 234. Butt welding fittings shall conform to ANSI Bl6.9. Socket wel,ded fittings shall conform to ANSI Bl6.l. Screwed fittings, where required, shall be black forged steel, 2000 lb. class, conforming to Mil. Spec. MIL-P-l8l74, Type l, Class l. Flanges shall be serrated or raised-face type.  l8.8 Gage Piping: Piping= shall be copper tubing conforming to Fed. Spec. WW-T-799, Type K or L for steam and low temperature water. Black steel ASTM A l06, seamless, Grade A pipe, shall be used for high temperature water gage piping.  l8.9 Joints: Joints between sections of,N and between, pipe or tubing and fittings shall be threaded, flanged, welded, flared and sweated as specified below. Except as otherwise specified, fittings used on steel pipe shall be threaded for fittings one inch and smaller, threaded or welded for fitFtings l l/4 inches up through 2 l/2 inches; and flanged or welded for fittings 3 inches and larger. All joints between sections of copper tubing or pipe shall be flared or sweated as below specified. Pipe and fittings l l/4 inches and larger and installevd in inaccessible conduits or trenches beneath concrete floor slabs shall be welded. Unless otherwise specified, connections to equipment shall be made with black malleable-iron unions for pipe 2 l/2 inches or smaller in diameter, and with flanges for pipe three or more inches in diameter.  l8.9.l Low Temperature Water Piping Systems may have threaded, welded, flanged or flared and sweated joints as applicable and as specified.  l8.9.2 Steam Piping Systems may have threaded, welded or flanged joints  J as applicable and as specified.  l8.9.3 High Temperature Water Systems shall have welded joints to the maximum extent practicable except screwed joints and fittings may be at connections to equipment and piping 3/4 inch and smaller.  l8.9.4 Threadedk Joints shall be made with tapered threads properly cut, and shall be made perfectly tight with a stiff mixture of graphite and oil or with polytetrafluoroethylene tape conforming to Mil. Spec. MIL-T-27730, applied to the male threads only, and in no case to the fittings.  l8.9.5 Welded Joints shall be fusion-welded in accordance with ANSI B3l.l, unless otherwise required. Changes in direction of piping shall be made with welded fittings only; mitering or notching pipe to form elbows and tees or other similar type construction will not be permitted. Branch connections may be made with either welded tees or forged branch outlet fittings, either being acceptable without size limitation. Branch outlet fittings, where used, shall be forged, flared for imWproved flow characteristics where attached to the run, reinforced against external strains, and designed to withstand full pipe- bursting strength.  l8.9.5.l Beveling: Field and shop bevels shall be in accordance with the recognized standards and shall*= be done by mechanical means or flame-cutting. Where beveling is done by flame-cutting, surfaces shall be cleaned of scale and oxidation prior to welding.  l8.9.5.2 Alinement: Before welding, the component parts to be welded shall be alined so that no  strain is placed on the weld when finally posi- tioned. Height shall be so alined that no part of the pipe wall is offset by more than 20 percent of the wall thickness. Flanges and branches shall  be set true. This alinement shall be preserved during the welding operation. If tack welds are used, welds shall be of the same quality and made by the same procedure as the completed weld; otherwise, tack welds shall be removed during the welding operation.  l8.9.5.3 Erection: Where the temperature of 5the component parts being welded reached 32~ F or lower, the material shall be heated to approximately l00~ F for three feet on each side of the weld before welding, and the weld shall be finished before the material cools to 32~ F.  l8.9.5.4 Weld Inspection: Welds shall be inspected for defects in accord- ance with the following:  (a) Cracks shall not be acceptable regardless of length or loca- tion.  (b) Undercut shall not be deeper than five percent of the base- metal thickness or l/32-inch%, whichever is less.  (c) Overlap shall not be permitted. The Contracting Officer reserves the right to further examine the welds by one or a combination of the processes listed below:  Radiography Liquid penetrant Magnetic particle U]{ltrasonic Weld defects shall be removed and repairs made to the weld, or the weld joints shall be entirely removed and rewelded at no additional cost to the Government.  l8.9.5.5 Electrodes shall be stored in a dry heated area and shall be kept free of moisture or dampness during fabrication operations. Electrodes that have lost part of their coating shall be discarded.  l8.9.6 Flanged joints or unions shall be provided in each line immediately preceding the connection to each piece of equipment orР material requiring maintenance such as coils, pumps, control valves and similar items. Flanged joints shall be faced true, provided with gaskets, and made perfectly square and tight. Full-faced gaskets shall be used with cast iron flanges, and all g`askets shall be as thin as the finish of the flange face permits. Gaskets for high temperature water shall be metallic asbestos type. Where cast iron flanges are bolted to steel flanges, the raised face on the steel flange shall be removed and the facDe shall be completely smooth and true. Bolt threads and nuts shall receive a coat of anti-seize compound before being made up. All flange gaskets shall be lubricated with graphite and oil immediately prior to installation.  l8.9.7 Dielectric Uniowuns shall be provided between ferrous and nonferrous piping to prevent galvanic corrosion on low temperature water. The dielectric unions shall meet the requirements for tensile strength of pipe fittings in accordance with Fed. Spec. WW-U-53l and shall 3be suitable for temperatures and pressures encountered. The dielectric unions shall have metal connections on both ends of union. The ends shall be threaded, brazed or soldered to match adjacent piping. The metal parts of the union shall be separated sRo that the electrical current is below one percent of the galvanic current which would exist with metal-to-metal contact. Dielectric unions will not be required between nonferrous piping or fittings and stainless steel tubing.  l8.9.8 Flared And Sweated Pipe And Tubing: Tubing shall be cut square and burrs shall be removed. Both inside of fittings and outside of tubing shall be well cleaned with an abrasive before sweating. Care shall be taken to prevent annealing of fittings and hard-drawn tubing when making connections. Installation shall be made by competent workmen in accordance with the manu- facturer's recommendations. Mitering of joints for elbows, and notching of straight runs of pipe for tees, will not be permitted. Joints for soldered fifttings shall be made with a noncorrosive paste flux and solid string or wire solder, 40 percent tin and 60 percent lead. Cored solder will not be permitted. Joints for flared-type fittings shall be of the compression pattern. Swing joints or offsets shall be provided on all branch connections, mains, and risers to provide for expansion and contraction of the pipe without under stress to fittings, pipe or tubing.  l8.l0 Connections To Equipment: Supply and return connections shall be provided by the Cpontractor unless otherwise shown. Valves and traps shall be installed in accordance with the manufacturer's recommendations, and in an acceptable manner. Unless otherwise indicated, the size of the supply and return pipes to each piece of equipment shall be not smaller than the connections on the equipment.  l8.l0.l Low Temperature Water And Steam And Return Connections, unless otherwise indicated, shall be made with malleable iron unions for piping 2 l/2 inches or less in diameter and with flanges f#jor pipe three or more inches in diameter.  l8.l0.2 High Temperature Water Connections shall be made with 2000 lb. black malleable iron unions for pipe 3/4 inches or smaller in diameter and with flanges for pipe one inch and larger in diameter.  l8.ll T Branch Connections: Branches shall be taken from the top of supply mains at an angle of 45 degrees above the horizontal, unless otherwise indica- ted or specified. Branches from the return mains shall be taken from the top or side unless otherwise indikcated or specified. Connections shall be made carefully to insure unrestricted circulation, eliminate air pockets; and permit the complete drainage of the system. Changes in horizontal pipe sizes shall be made through eccentric reducing fittings.  l8.Ĭll.l Low Temperature Water Branches from mains shall be taken off as specified above. Branches taken from the tops of mains shall pitch up and those taken from the bottom shall pitch down from the mains, with a grade of not less than one inch in ten feetsc. [Special flow fittings shall be installed on the mains to bypass portions of water through each radiator. Special flow fittings shall be standard catalog products and shall be installed as recommended by the manufacturer.]  l8.ll.2 Steam Supply Awnd Condensate Branches shall be taken from mains as above specified. Branches shall pitch up from the mains with a grade of not less than one inch in ten feet, unless otherwise indicated.  l8.ll.3 High Temperature Water Branches shall take off at 45 dTegrees in the direction of the fluid flow from the supply and return lines and should be branched exclusively from the top or upper half of the main line unless otherwise shown. Abrupt reduction in pipe sizes should be avoided.  l8.l2 Risers: The loc%ation of risers is approximate. Exact locations of the risers shall be as approved. [Steam supply downfeed risers shall terminate in a dirt pocket and shall be dripped through a trap to the return line.]  l8.l3 Hangers And Supports:  l8.l3.l Pipe eSupports And Structural Reinforcement: Hangers used for the support of piping of 2-inch nominal pipe size and larger shall be fabricated to permit adequate adjustment after erection while still supporting the load. Pipe guides and anchors shall be instalu"led, as shown, to keep pipes in accurate alinement, to direct the expansion movement and to prevent buckling, swaying and undue strain. All piping, headers, and equipment shall be coordinated with the Contractor responsible for the structural work, and where necessary specific provisions shall be made for their support. Structural steel required for reinforcement to properly support piping, headers, and equipment but not shown on the structural plans shall be provided under this section. Material used fVor supports shall be as specified under SECTION: STRUCTURAL STEEL.  l8.l3.2 Pipe Hangers, Inserts, And Supports conforming to Fed. Spec. WW-H-l7l shall be provided. Inserts shall be Type l8 or l9 and shall be secured firmly to concrete forms in correcTt locations and installed before the concrete is poured. Beam clamps shall be Types 20, 2l, 28, 29, 30, or 3l. Spring-type hangers shall be provided for high temperature water piping where indicated.  l8.l3.3 Horizontal Piping: The maximum spacing be tween pipe supports for straight runs shall conform to Table II. Pipe hangers or supports shall be spaced not over five feet apart at heavy fittings and valves such as pressure- reducing and zone-control valves. A hanger shall be installed not over one g foot from each change in direction of piping. Piping four inches and above shall have roller supports, Types 43 or 44 and protective saddles, Type 40 A, shall be provided. For suspended piping under four inches, hangers, Types 5, 6, 9, ll or l2, and tTurnbuckles, Type l3 or l5, shall be used. Brackets for support of piping at walls shall conform to Type 35. Metallic pipes supported on beams or brackets shall be provided with a minimum l/2-inch graphite slide plate and minimum 3 l/2-inch thick cradleT, with high temperature resilient pad inserted between pipe and cradle. The graphite slide plate shall be cemented to the beam or bracket and the graphite cradle shall be strapped to the pipe using 3/4-inch by 0.020 inch stainless steel straps.    TABLE II  MAXIMUM SPACING BETWEEN PIPE SUPPORTS _____________________________________________________________________________ Nominal pipe size, l l/2 2 2 l/2 3 4 5 6 8 l0 l2inches  Maximumspan, feet 9 l0 ll l2 l4 l6 l7 l9 22 23 l8.l3.4 Copper Tubing shall be supported as follows unless otherwise in- dicated by the manufacturer and approved.    Nominaltubing size, l l/4 l l/2 2 2 l/2 3 4 and over inches Maximumspan, feet 7 8  9 l0 ll l2  l8.3.5 Vertical-piping Supports shall be type 8 clamps located as indicated. A ring type hanger shall be installed on all vertical exposed risers over 5 feet in length at the mid point of the riser. Thies hanger shall be secured to the structural members in a manner that will restrain any horizontal move- ment of the pipe.  l8.l3.6 Piping In Trenches: Pipes shall rest on suitable wall or floor supports with rollers. Floor rollers shall be Type 45 or  46.  l8.l4 Pipe Sleeves, General: *(For rehab. work, pipe sleeves are not re- quired for pipes passing through core-drilled, concrete walls). Pipes passing through concrete or masonry walls, concrete floors or roofs shall be provided with pipe sleeves fitted into place at the time of construction. Sleeves shall not be installed in structural members except where indicated or approved. All rectangular and square openings shall be as detailed on the drawing. Each sleeve shall extend through its respective wall, floor, or roof, and shall be cut flush with each surface. Unless otherwise indicated, sleeves shall provide a minimum of l/4-inch all around clearance between bare pipe and sleeves or between jacket over insulation and sleeves. Sleeves iin bearing walls, waterproofing membrane floors, and wet areas shall be steel pipe or cast iron pipe. Sleeves in nonbearing walls, floors, or ceilings may be steel pipe, cast iron pipe, or galvanized sheet metal with lock-type longitudinal seam and of׫ the metal thickness indicated. Except in pipe chases or interior walls, the annular space between pipe and sleeve or between jacket over insulation and sleeve shall be sealed as indicated and specified in SECTION: CALKING AND SEALANTS.  l8.l4.l PipVYes passing through waterproofing membranes shall be installed through a 4-pound lead-flashing sleeve, or a l6-ounce copper sleeve, or a 0.032-inch thick aluminum sleeve, each within an integral skirt or flange. Flashing sleeve shall be suitably formed, and the skirt or flange shall extend eight or more inches from the pipe and be set over the roof or floor  membrane in a troweled coating of bituminous cement. The flashing sleeve shall extend up the pipe a minimum of two inches above the highest flood l4evel of the roof or a minimum of ten inches above the roof, whichever is greater, or ten inches above the floor. The annular space between the flashing sleeve and the bare pipe or between the flashing sleeve and the metal-jacket- covered insulation shall 1 C 800 IF(JBYTE.NE.I15K) GO TO M900 ;15K=CARRIAGE RETURN IF(PRINT.EQ..FALSE.) GO TO 2000 CALL SUBSTR(ICRLF,1,4,JBUF1,NBOUT) NBOUT=NBOUT+2 ASSIGN 805 TO INIT GO TO 4000 C C PACK FROM LC=1 TO MARGIN HERE C 805 ASSIGN 1002 TO INIT IBYTE=40K 807 IF(LC.GE.MARGIN) GO TO 815 CALL IPUTBYTE(JBUF1,NBOUT,IBYTE) LC=LC+1 NBOUT=NBOUT+1 GO TO 807 815 IF(JBYTE.EQ.I31K) GO TO 4500 ;IF NEW PAGE READ NEXT CHARACTER GO TO INIT ;ELSE PACK IN PRESENT C C CHECK FOR MORE TYPES OF COMMANDS........ C 900 IF(JBYTE.NE.I45K) GO TO 1000 ;45K = INDEX IF(PRINT.EQ..FALSE.) GO TO 2000 INDEX=2 MARGIN=1 WRITE(IDISK1,905) 905 FORMAT(1X) ;OUTPUT XTRA CRLF ASSIGN 1002 TO INIT ;DO NOT INIT MARGIN CANCELLED GO TO 4500 C C MUST BE A NON VERTICAL OR HORIZONTAL CONTROL TO GET HERE C MOST LIKELY A ALPHANUMERIC C USE THE LOOK UP TABLE UNLESS A 52K (=END) C 1000 IF(JBYTE.NE.I31K) GO TO 1001 ;END OF PAGE = 31K CALL IPUTBYTE(JBUF1,NBOUT,JBYTE) IF(PRINT.EQ..FALSE.) GO TO 4500 1001 GO TO INIT 1002 CALL IPUTBYTE(JBUF1,NBOUT,JBYTE) ;PACK INTO OUTPUT BUFFER NBOUT=NBOUT+1 LC=LC+1 GO TO 4500 C C OUTPUT SECTION FOR PRINT=..FALSE.. C 2000 CALL IPUTBYTE(JBUF1,NBOUT,JBYTE) CALL WRITSQ(IDISK1,JBUF1,NBOUT,IERR) GO TO 4100 C C OUTPUT SECTION IF PRINT=.TRUE. C 4000 CALL WRITSQ(IDISK1,JBUF1,NBOUT-1,IERR) 4100 NBOUT=1 LC=1 IF(HIERR.NE.1) GO TO 8000 GO TO ISWITCH 4500 CONTINUE GO TO 500 ;READ IN NEXT BUFFER 5000 TYPE "ERROR IN OPEN IDSK0=",IERR STOP 6000 TYPE "ERROR IN OPEN IDISK1=",IERR STOP 7000 TYPE "ERROR IN RDSEQ IDSK0=",IERR STOP 8000 TYPE "ERROR IN WRITSQ IDISK1=",IERR 9999 STOP END XREF.SVDP0.SVTYPER.06 l le8;******************************************************** ; TYPER.06 TYPES FOREGROUND DATA ; ; RLDR/A/S/D TYPER/U MATH.LB/U ; OR ; RLDR TYPER MATH.LB ; OR ; RLDR TYPER TYPERF/S 40000/F 374/Z MATH.LB ; ; MAY 31,1977 TED CREEDON ALL RIGHTS RESERVED ;********************************************************** .TITL TYPER .ENT TYPER .ENT .GTCH,.PTCH .EXTN .BIND,.DBIN .ZREL POINT: 2*BUFF0 ;BYTE POINTER TO BUFFER ADDRESS ERT: ERROR .GTCH: AGTCH .PTCH: APTCH ;NEEDED BY MATH.LB .TXTM 1 .NRE3L ; ; ; I/O CHANNEL SELECT SIZE=200 DISK=2 PPLT=3 TTTO=0 TTTI=1 TYPER: .SYST .RESET JMP ERT SUB 1,1 LDA 0,NTTO .SYSTM .OPEN TTTO JMP ERT SUB 1,1 LDA 0,NTTI .SYSTM .OPEN TTTI JMP ERT LDA 0,M1 .SYSTM .WRL TTTO JMP ERT LDA 0,M2 ;READ INPUT FILE NAME .SYSTM .RDL TTTI JMP ERT LDA 0,M2 SUB 1,1 ;OPEN INPUT FILE .SYSTM .OPEN DISK JMP ERT LDA 0 M8 ;OUTPUT FILE? MESSAGE .SYST .WRL TTTO JMP ERT LDA 0 NPLT ;BUFFER CONT. FILE NAME .SYST ;READ OUTPUT FILE NAME .RDL TTTI JMP ERT .SYS T .OPEN PPLT JMP TYPER ;RESTART IF NO FILE WAS FOUND OR OTHER ERROR JMP @.+1 ;JUMP TO SECTION I.D. SECID NTTO: .+1*2 .TXT *$TTO1* NTTI: .+1*2 .TXT *$TTI1* NPLT: .+1*2 .BLK 20 ;OUTPUT FILE NAME HERE M1: .+1*2 .TXT *INPUTFILE NAME? - <0>* M2: .+1*2 MuS2: .BLK 20 M8: .+1*2 .TXT*OUTPUT FILE NAME? - <0>* ; ; ERRORS HANDLED HERE ; ERROR: .SYSTM .ERTN JMP ERROR ; ; DISK INPUT ERRORS HANDLED HERE ; MSECT: .+1*2 .TXT*ENTER SECTION I.D. .I.E 16 A OR 15 C ETC.<0>* ; MNUMB: 0 ;POINTER TO END OF SECTION INPUT. PAGE NUMBER ;FILLED IN FROM MNUMB ON MTEXT :.+2*2+30 MPAGE: .+1*2 .TXT* NN Z <0>* ; 30 SPACES 16 A - SECID: LDA 0 MSECT ;SECTION MESSAGE .SYST .WRL TTTO JMP ERT LDA 0 MTEXT .SYST .RDL TTTI JMP ERT ADD 0 1 ;CREAT[E POINTER TO END OF TEXT STA 1 MNUMB DSZ MNUMB ;DECREMENT MNUMB TO VERWRITE THE CR JMP STRTP ;JUMP TO START PAGE SECTION PMESS: .+1*2 .TXT*STARTING PAGE NUMBER<0>* SPG: .+1*2 .BLK 10 ;STARTING PAGE ASCII STRING HERE PBEGIN: 0 ;OCTAL VALUE OF SPG STRIN@"G HERE ;=STARTING PAGE NO. STRTP: LDA 0 PMESS .SYST .WRL TTTO JMP ERT LDA 0 SPG ;BUFFER POINTER FOR START PAGE STRING .SYST .RDL TTTI JMP ERT JSR @.+1 GETSTR ;CALL ASCII DECIMAL TO BINARY INTEGER COMVERTER SPG ;ADDRESS OF BYFFER POINTER TO PAGE1 STRING STA 1 PBEGIN ;CONVERTED HERE ADDO# 1 1 SBN ;SKIP IF STARTING PAGE NO .GT. ZERO JMP STRTP ;REPEAT MESSAGE AND TRY AGAIN SUBZL 0 0 ;GENERATE +1 SUBZ# 1 0 SZC ;SKIP IF AC1 .GT. 1 JMP PAGIT ;START PAGE PRINTING IF=0 ; ; CYCLE THRU PBEGIN-1 PAGES HERE BEFORE PRINTING ; LDA 1 PBEGIN STA 1 PAGES ;TEMP SAVE DSZ PAGES JMP NL JMP PAGIT NL: LDA 0 POINT ;GET BUFFER POINTER .SYST .RDL DISK JMP DSKER LDA 2 C1 SUB 1 2 SZR JMP NL ;<>1 BYTE READ =>NOT FORM FEED JSR @.+1 CHECK ;CHECK IF FuF IN BYTE 1 OF BUFFER POINT ;ADDRESS OF POINTER TO STRING TO HAVE ;FIRST BYTE CHECKED JMP NL ;NO DSZ PAGES ;YES FF FOUND JMP NL ;BUT NOT PBEGIN - 1 PABES JMP PAGIT ;YES ; ; DISK ERRORS TYPED HERE ; DSKER: LDA 0 ENDMS ;GET END MESSAGE .SYST .WRL TTTO JMP ERT ;NOT AGAIN JMP @.+1 TYPER ENDMS: .+1*2 .TXT*DISK END OR ERROR<15>* NBYTES: 0 ;NO OF BYTES READ OFF INPUT FILE PAGES: 0 ;DECREMENTED PAGE COUNT DURING <>0 OR 1 PAGE BEGIN C1: 1 MLINES: 67 ;NO OF LINES PER PAGE INCLUDING SECTION ID  ;ANS PAGE NO. NLINE: 0 ;NO OF LINES OUTPUT ON THIS PAGE ; ; PAGE PRINT SECTION ; PAGIT: SUBO 0 0 STA 0 NLINE ;ZERO LINE COUNTER RETRY: ISZ NLINE LDA 0 POINT ;BUFFER POINTER .SYST .RDL DISK JMP DSKER STA 1 NBYTES ;SAVE NO OF BYTES READ FOR .WRS LDA 2 C1 SUB# 1 2 SZR ;ONE BYTE READ? JMP OUT ;NO PRINT LINE ; ; ONLY ONE BYTE READ MAY BE FF=14 CR=15 NULL=0 ; IF FF PAGE NUMBER AND SECTION ID ARE PRINTED ; AND NEW PAGE MESSAGE IS OUTPUT JSR @.+1 ;CHECK PRESERVES AC1 CHECK POINT ;ADDRESS OF STRING POINTER JMP OUT ;FF NOT FOUND JMP PGNBR ;FF WAS FOUND ; OUT: LDA 0 POINT ;BUFFER POINTER LDA 1 NBYTES ;NO OF BYTES TO OUTPUT .SYST .WRS PPLT JMP ERT JMP RETRY ;GET NEXT LINE ; ; OUTPUT PAD CARRIAGE RETURNS TO MAKE MLINES LINES ; PER PAGE. THEN PRINT SECTION ID AND PAGE NO. ; NCR: 0 ;NO OF PAD CR'S TO BE OUTPUT THIS PAGE C5: 5 MCR: .+1*2 .TXT*<15><15>* ;2 CR'S AOPT: OPT PGNBR: LDA 0 NLINE ;LINES OUTPUT THIS PAGE LDA 1 MLINE ;MAX NO PERMITTED SUBZ 0 1 SNC ;SKIP IF MAX-PRINTED>0 JMP TYPIT ;<vy0 TYPE SECTION ID STA 1 NCR LDA 0 MCR ;CR POINTER SUBZL 1 1 ;GEN +1 MORE: .SYST ;OUTPUT ONE CR PER LOOP .WRL PPLT JMP ERT DSZ NCR ;DECREMENT NO OF CR'S JMP MORE ;NOT 0 OUTPUT ONE MORE TYPIT: SUBO 0 0 STA 0 NLINE ;ZERO NLINE LDA 1 PBEGIN JSR @.+1 MKSTR ;CONVERT PBEGIN TO ASCII DECIMAL MNUMB ;POINTER TO TEXT AREA TO BE FILLED LDA 0 @AMPAGE ;BEGINNING OF STRING LDA 1 @AOPT ;END OF STRING SUB 0 1 ;DIFFERENCE IS LENGTH .SYST .WRS PPLT JMP ERT ISZ PBEGIN ;INCREMENT PAGE COUNTER LDA 0 CMESS ;ENTER E TO RESTART CR TO CONTINUE .SYST .WRL TTTO JMP ERT LDA 0 EMESS SUBZL 1 1 ;GEN + 1 BYTES IN .SYST .RDL TTTI JMP ERT LDA 2 EMESS MOVZR 2 2 ;CONVERT BUFFER POINTER TO ADDR LDA 0 0 2 ;FIRST BYTE IN AC0 MOVS 0 0 LDA 1 C177 AND 1 0 ;MASKED BYTE IN RH OF AC0 LDA 1 CE ;GET E CODE SUB 1 0 SZR JMP OUT ;NOT AN "E" OUTPUT FF AND DO NEXT PAGE JMP @.+1 ;RESTART PROGRAM TYPER AMPAGE: MPAGE ;ADDRESS OF MPAGE CMESS: .+1*2 .TXT*IF "E" IS NOT ENTERED PROGRAM CONTINUES<0>* EMESS: .+1*2 .BLK 10 ;END MESSAGE BUFFERED HERE CE: 105 ;"E"=105 OCTAL ; ; SUBROUTINE CHECK ; CHECKS FIRST BYTE OF STRING FOR FF ; JSR @.+1 ; CHECK ; POINTER ADDRESS ;; RETURN IF FF NOT IN BYTE 1 OF STRING ; RETURN IF FF WAS IN BYTE 1 OF STRING C14: 14 ;FF = 14Z K CHECK: LDA 2 1 3 ;ADDRESS OF POINTER IN AC2 LDA 2 0 2 ;POINTER IN AC2 MOVZR 2 2 ;ADDRESS OF STRING IN AC2 LDA 2 0 2 ;FIRST WORD IN AC2 MOVS 2 2 LDA 1 C177 ;MASK OUT AND 1 2 LDA 0 C14 ;GET FF SUB# 0 2 SZR JMP 2 3 ;FF NOT FOUND JMP 3 3 ;FF WAS FOUND ; ; SUBROUTINE GETSTR ; CONVERTS ASCII DECIMAL STRING TO BINARY INTEGER ; JSR @.+1 ; GETSTR ; ADDRESS OF STRING POINTER ; RETURNS TO HERE GETSTR: STA 3 AC3O LDA 2 1 3 ;ADDRESS OF STRING POOINTER LDA 2 0 2 ;POINTER IN AC2 STA 2 PNT ;SAVE NFOR USE BY GTCHR JSR @ADBIN LDA 3 AC3O JMP 2 3 ;RETURN TO CALLER PNT: 0 ;POINTER TO TEXT STRING ;TO BE CONVERTED AC3O: 0 ADBIN: .DBIN C177: 177 AGTCH: LDA 2 PNT ;GET POINTER MOVZR 2 2 ;MAKE ADDRESS LDA 1 0 2 ;GET WORD LDA 0 C377 MOV# 2 2 SNC ;SKIP IF EVEN MOVS 1 1 AND 1 0 ISZ PNT JMP 0 3 ;BACK TO DBIN C377: 377 ;MASK ; ; SUBROUTINE MKSTR ; CONVERTS BINARY INTEGER INTO DECIMAL ASCII ; STRING AND PACKS IT INTO THE BUFFER POINTED TO ; JSR @.+1 ; MKSTR ; ADDRESS OF POINTER TO BUFFER WHICHM WILL RECIEVE STRING ; RETURNS HERE ; NOTE THE NUMBER IN PASSEN IN AC1 MKSTR: STA 3 AC3D LDA 0 T60 ;REPLACE ZERO ASCII IN C60 WITH 60K STA 0 C60 ;READY TO SUPPRESS LEADING ZEROES LDA 2 1 3 ;GET ADDRESS OF POINTER LDA 2 0 2 ;GET POINTER IN AC2 STA 5a2 OPT JSR @ABIND ;CALL BIND LDA 3 AC3D JMP 2 3 ; NDEC: 0 ;NO OF DIGITS IN INTEGER STRING CONVERTED FROM AC1 CR: 15 ;CR PACKED INTO LAST BYTE FREE T3: 0 ;TEMP STORAGE AC3D: 0 OPT: 0 ;POINTER TO BEGINNING OF AREA INTO WHICH STRING ;WILL BE PACKED BY APi TCH ABIND: .BIND C1774: 177400 ;MASK ; APTCH: MOV 0 0 SNR ;LAST BYTE IS A CR LDA 0 CR ;CR FOR LAST STA 0 T3 ; ; SUPPRESS LEADING ZEROES AND + - SIGNS ; LDA 1 C53 ;+SIGN SUB 0 1 SNR JMP 0 3 ;BACK TO MATH.LB LDA 1 C55 ;-SIGN SUB 0 1 SNR JMP 0 3 ҧ ;BACK TO MATH.LB LDA 1 C60 ;ZERO SUB 0 1 SNR JMP 0 3 ;AS A ZERO DSZ C60 ;MAKE C60 UNEQUAL TO 60 ;SINCE NON ZERO DIGIT FOUND LDA 2 OPT ;GET POINTER STA 3 AC3A LDA 3 C377 MOVZR 2 2 SNC ;CONVERT POINTER TO ADDRESS ANS ;SKIP IF BYTE IS RIGHT HAND MOVS 0 0 SKP ;SWAP BYTE BUT NOT MASK MOVS 3 3 ;SWAP MASK BUT NOT BYTE LDA 1 0 2 ;GET WORD AND 3 1 ;KEEP ONE HALF ADD 1 0 ;ADD IN NEW STA 0 0 2 ;WRITE WORD BACK ISZ NDEC ;ADD ONE TO NUMBER OF DECIMAL DIGITS ISZ OPT ;ALSO INCREMENT Pt|OINTER JMP @AC3A ;RETURN TO MATH.LB T60: 60 ;ZERO ASCII C60: 0 ;REPLACED EVERY TIME .DBIN IS CALLED C53: 53 ;+SIGN C55: 55 ;-SIGN AC3A: 0 ;SAVE AC3 WHILE IN APTCH BUFF0: .BLK SIZE .END TYPER LDA 1 0 2 ;GET WORD LDA 0 C377 MOV# 2 2 SNC ;SKIP IF EVE-9N MOVS 1 1 AND 1 0 ISZ PNT JMP 0 3 ;BACK TO DBIN C377: 377 ;MASK ; ; SUBROUTINE MKSTR ; CONVERTS BINARY INTEGER INTO DECIMAL ASCII ; STRING AND PACKS IT INTO THE BUFFER POINTED TO ; JSR @.+1 ; MKSTR ; ADDRESS OF POINTER TO BUFFER WHICH WILL RECIEVE STzRING ; RETURNS HERE ; NOTE THE NUMBER IN PASSEN IN AC1 MKSTR: STA 3 AC3D LDA 0 T60 ;REPLACE ZERO ASCII IN C60 WITH 60K STA 0 C60 ;READY TO SUPPRESS LEADING ZEROES LDA 2 1 3 ;GET ADDRESS OF POINTER LDA 2 0 2 ;GET POINTER IN AC2 STA 2 OPT JSR @ABINtMD ;CALL BIND LDA 3 AC3D JMP 2 3 ; NDEC: 0 ;NO OF DIGITS IN INTEGER STRING CONVERTED FROM AC1 CR: 15 ;CR PACKED INTO LAST BYTE FREE T3: 0 ;TEMP STORAGE AC3D: 0 OPT: 0 ;POINTER TO BEGINNING OF AREA INTO WHICH STRING ;WILL BE PACKED BY APTCH ABIND: .BIND2G C1774: 177400 ;MASK ; APTCH: MOV 0 0 SNR ;LAST BYTE IS A CR LDA 0 CR ;CR FOR LAST STA 0 T3 ; ; SUPPRESS LEADING ZEROES AND + - SIGNS ; LDA 1 C53 ;+SIGN SUB 0 1 SNR JMP 0 3 ;BACK TO MATH.LB LDA 1 C55 ;-SIGN SUB 0 1 SNR JMP 0 3 ;BACK TO MATH.L_B LDA 1 C60 ;ZERO SUB 0 1 SNR JMP 0 3 ;AS A ZERO DSZ C60 ;MAKE C60 UNEQUAL TO 60 ;SINCE NON ZERO DIGIT FOUND LDA 2 OPT ;GET POINTER STA 3 AC3A LDA 3 C377 MOVZR 2 2 SNC ;CONVERT POINTER TO ADDRESS ANS ;SKIP IF BYTE IS RIGHT HAND MOVS 0< 0 SKP ;SWAP BYTE BUT NOT MASK MOVS 3 3 ;SWAP MASK BUT NOT BYTE LDA 1 0 2 ;GET WORD AND 3 1 ;KEEP ONE HALF ADD 1 0 ;ADD IN NEW STA 0 0 2 ;WRITE WORD BACK ISZ NDEC ;ADD ONE TO NUMBER OF DECIMAL DIGITS ISZ OPT ;ALSO INCREMENT POINTER JMP @AC3A ;RETURN TO MATH.LB T60: 60 ;ZERO ASCII C60: 0 ;REPLACED EVERY TIME .DBIN IS CALLED C53: 53 ;+SIGN C55: 55 ;-SIGN AC3A: 0 ;SAVE AC3 WHILE IN APTCH BUFF0: .BLK SIZE .END TYPER TYPER.LS l m 0001 TYPER 01 ;******************************************************** 02 ; TYPER.06 TYPES FOREGROUND DATA 03 ; 04 ; RLDR/A/S/D TYPER/U MATH.LB/U 05 ; OR 06 ; RLDR TYPER MATH.LB 07 ; 08 ; MAY 31,1977 TED CREEDON ALL RIGHTS RESERVED 09 ;********************************************************** 10 .TITL TYPER 11 .ENT TYPER 12 .ENT .GTCH,.PTCH 13 .EXTN .BIND,.DBIN 14 .ZREL 15 00000-001534"POINT: 2*BUFF0 ;BYTE POINTER TO BUFFER ADDRESS 16 00001-000150'ERT: ERROR 17 00002-000565'.GTCH: AGTCH 18 00003-000617'.PTCH: APTCH 19 ;NEEDED BY MATH.LB 20, 000001 .TXTM 1 21 .NREL 22 ; 23 ; 24 ; I/O CHANNEL SELECT 25 000200 SIZE=200 26 000002 DISK=2 27 000003 PPLT=3 28 000000 TTTO=0 29 000001 TTTI=1 30 00000'006017 TYPER: .SYST 31 00001'005000 .RESET 32 00002'000001- JMP ERT 33 00003'126400 SUB 1,1 34 00004'020443 LDA 0,NTTO 35 00005'006017 .SYSTM 36 00006'014000 .OPEN TTTO 37 00007'000001- JMP ERT 38 00010'126400 SUB 1,1 39 00011'020442 LDA 0,NTTI 40 00012'0k.06017 .SYSTM 41 00013'014001 .OPEN TTTI 42 00014'000001- JMP ERT 43 00015'020463 LDA 0,M1 44 00016'006017 .SYSTM 45 00017'017000 .WRL TTTO 46 00020'000001- JMP ERT 47 00021'020472 LDA 0,M2 ;READ INPUT FILE NAME 48 00022'006017 .SYSTM 49 00023'015401 .RDL TTTI 50 00024'000001- JMP ERT 51 00025'020466 LDA 0,M2 52 00026'126400 SUB 1,1 ;OPEN INPUT FILE 53 00027'006017 .SYSTM 54 00030'014002 .OPEN DISK 55 00031'000001- JMP ERT 56 00032'020502 LDA 0 M8 ;OUTPUT FILE? MESSAGE 57 00033'006017 .SYST 58 00034'017000 .WRL TTTO 59 00035'000001- JMP ERT 0002 TYPER 01 00036'020421 LDA 0 NPLT ;BUFFER CONT. FILE NAME 02 00037'006017 .SYST ;READ OUTPUT FILE NAME 03 00040'015401 .RDL TTTI 04 00041'000001- JMP ERT 05 00042'006017 .SYST 06 00043'014003 .:_OPEN PPLT 07 00044'000734 JMP TYPER ;RESTART IF NO FILE WAS FOUND OR OTHER ERROR 08 00045'002401 JMP @.+1 ;JUMP TO SECTION I.D. 09 00046'000230' SECID 10 00047'000120"NTTO: .+1*2 11 .TXT *$TTO1* 00050'022124 00051'052117 00052'030400 12 00053'000130"NTTI: .+1*2 13 .TXT *$TTI1* 00054'022124 00055'052111 00056'030400 14 00057'000140"NPLT: .+1*2 15 000020 .BLK 20 ;OUTPUT FILE NAME HERE 16 00100'000202"M1: .+1*2 17 .TXT *INPUTFILE NAME? - <0>* 00101'044516 00102'050125 00103'052106 00104'044514 00105'042440 00106'047101 00107'046505 00110'037440 00111'026440 00112'000000 18 00113'000230"M2: .+1*2 19 000020 MS2: .BLK 20 20 00134'000272"M8: .+1*vr2 21 .TXT*OUTPUT FILE NAME? - <0>* 00135'047525 00136'052120 00137'052524 00140'020106 00141'044514 00142'042440 00143'047101 00144'046505 00145'037440 00146'026440 00147'000000 22  ; 23k ; ERRORS HANDLED HERE 24 ; 25 00150'006017 ERROR: .SYSTM 26 00151'006400 .ERTN 27 00152'000776 JMP ERROR 28 ; 29 ; DISK INPUT ERRORS HANDLED HERE 30 ; 31 00153'000330"MSECT: .+1*2 32 5 .TXT*ENTER SECTION I.D. .I.E 16 A OR 15 C ETC.<0>* 0003 TYPER 00154'042516 00155'052105 00156'051040 00157'051505 00160'041524 00161'044517 00162'047040 00163'044456 00164'042056 00165'020056 00166'0w44456 00167'042440 00170'030466 00171'020101 00172'020117 00173'051040 00174'030465 00175'020103 00176'020105 00177'052103 00200'027000 00201'000000 01 ; 02 00202'000000 MNUMB: 0 ;POINTER TO END OFj SECTION INPUT. PAGE NUMBER 03 ;FILLED IN FROM MNUMB ON 04 00203'000442"MTEXT :.+2*2+30 05 00204'000412"MPAGE: .+1*2 06 .TXT* NN Z <0>* 00205'020040 00206'020040 00207'020040 00210'LH020040 00211'020040 00212'020040 00213'020040 00214'020040 00215'020040 00216'020040 00217'020040 00220'020040 00221'020040 00222'020040 00223'020040 00224'047116 00225'020132 00226'020000 00227'000000 07 ; 30 SPACES 16 A - 08 00230'020723 SECID: LDA 0 MSECT ;SECTION MESSAGE 09 00231'006017 .SYST 10 00232'017000 .WRL TTTO 11 00233'000001- JMP ERT 12 00234'020747 LDA 0 MTEXT 13 00235'006017 .SYST 14 00236'015401 .RDL TTTI 15 00237!'000001- JMP ERT 16 00240'107000 ADD 0 1 ;CREATE POINTER TO END OF TEXT 17 00241'044741 STA 1 MNUMB 18 00242'014740 DSZ MNUMB ;DECREMENT MNUMB TO VERWRITE THE CR 0004 TYPER 01 00243'000427 JMP STRTP ;JUMP TO START PAGE SECTION 02 00244'000512"PMESS: .+1*2 03 .TXT*STARTING PAGE NUMBER<0>* 00245'051524 00246'040522 00247'052111 00250'047107 00251'020120 00252'040507 00253'042440 00254'047125 00255'046502 00256'042522 00257'000000 04 00260'0005}42"SPG: .+1*2 05 000010 .BLK 10 ;STARTING PAGE ASCII STRING HERE 06 00271'000000 PBEGIN: 0 ;OCTAL VALUE OF SPG STRING HERE 07 ;=STARTING PAGE NO. 08 00272'020752 STRTP: LDA 0 PMESS 09 00273'006017 .SYST 10 00274'017000 .WRL TTTO 11 0)0275'000001- JMP ERT 12 00276'020762 LDA 0 SPG ;BUFFER POINTER FOR START PAGE STRING 13 00277'006017 .SYST 14 00300'015401 .RDL TTTI 15 00301'000001- JMP ERT 16 00302'006401 JSR @.+1 17 00303'000552' GETSTR ;CALL ASCII DECIMAL TO BINARY INTEGER COMVERTfER 18 00304'000260' SPG ;ADDRESS OF BYFFER POINTER TO PAGE STRING 19 00305'044764 STA 1 PBEGIN ;CONVERTED HERE 20 00306'127057 ADDO# 1 1 SBN ;SKIP IF STARTING PAGE NO .GT. ZERO 21 00307'000763 JMP STRTP ;REPEAT MESSAGE AND TRY AGAIN 22 00310'102520 bSUBZL 0 0 ;GENERATE +1 23 00311'122432 SUBZ# 1 0 SZC ;SKIP IF AC1 .GT. 1 24 00312'000452 JMP PAGIT ;START PAGE PRINTING IF=0 25 ; 26 ; CYCLE THRU PBEGIN-1 PAGES HERE BEFORE PRINTING 27 ; 28 00313'024756 LDA 1 PB~VEGIN 29 00314'044444 STA 1 PAGES ;TEMP SAVE 30 00315'014443 DSZ PAGES 31 00316'000402 JMP NL 32 00317'000445 JMP PAGIT 33 00320'020000-NL: LDA 0 POINT ;GET BUFFER POINTER 34 00321'006017 .SYST 35 00322'015402 .RDL DISK 36 00323'000413 JMP DSKER 37) 00324'030435 LDA 2 C1 38 00325'132404 SUB 1 2 SZR 39 00326'000772 JMP NL ;<>1 BYTE READ =>NOT FORM FEED 40 00327'006401 JSR @.+1 41 00330'000537' CHECK ;CHECK IF FF IN BYTE 1 OF BUFFER 42 00331'000000- POINT ;ADDRESS OF POINTER TO STRING TO HAVE  43 ;FIRST BYTE CHECKED 44 00332'000766 JMP NL ;NO 45 00333'014425 DSZ PAGES ;YES FF FOUND 46 00334'000764 JMP NL ;BUT NOT PBEGIN - 1 PABES 47 00335'000427 JMP PAGIT ;YES 48 ; 0005 TYPER 01 ; DISK ERRyORS TYPED HERE 02 ; 03 00336'020406 DSKER: LDA 0 ENDMS ;GET END MESSAGE 04 00337'006017 .SYST 05 00340'017000 .WRL TTTO 06 00341'000001- JMP ERT ;NOT AGAIN 07 00342'002401 JMP @.+1 08 00343'000000' TYPER 09 00344'000712"ENDMS: .+1*2 10 { .TXT*DISK END OR ERROR<15>* 00345'042111 00346'051513 00347'020105 00350'047104 00351'020117 00352'051040 00353'042522 00354'051117 00355'051015 00356'000000 11 00357'000000 NBYTES: 0 ;NO OF BYTES READ OFCF INPUT FILE 12 00360'000000 PAGES: 0 ;DECREMENTED PAGE COUNT DURING <>0 OR 1 PAGE BEGIN 13 00361'000001 C1: 1 14 00362'000067 MLINES: 67 ;NO OF LINES PER PAGE INCLUDING SECTION ID 15 ;ANS PAGE NO. 16 00363'000000 NLINE: 0 ;NO OF LINES OUTPXUT ON THIS PAGE 17 ; 18 ; PAGE PRINT SECTION 19 ; 20 00364'102440 PAGIT: SUBO 0 0 21 00365'040776 STA 0 NLINE ;ZERO LINE COUNTER 22 00366'010775 RETRY: ISZ NLINE 23 00367'020000- LDA 0 POINT ;BUFFER POINTER 24 00370O'006017 .SYST 25 00371'015402 .RDL DISK 26 00372'000744 JMP DSKER 27 00373'044764 STA 1 NBYTES ;SAVE NO OF BYTES READ FOR .WRS 28 00374'030765 LDA 2 C1 29 00375'132414 SUB# 1 2 SZR ;ONE BYTE READ? 30 00376'000406 JMP OUT ;NO PRINT LINE 31 |B ; 32 ; ONLY ONE BYTE READ MAY BE FF=14 CR=15 NULL=0 33 ; IF FF PAGE NUMBER AND SECTION ID ARE PRINTED 34 ; AND NEW PAGE MESSAGE IS OUTPUT 35 00377'006401 JSR @.+1 ;CHECK PRESERVES AC1 36 00400'000537' CHECK 37 00401'000000- POINT ;ADDRESS OF STRING POINTER 38 00402'000402 JMP OUT ;FF NOT FOUND 39 00403'000415 JMP PGNBR ;FF WAS FOUND 40 ; 41 00404'020000-OUT: LDA 0 POINT ;BUFFER POINTER 42 00405'024752 LDA 1 NBYTES ;NO OF BYTES TO OUTPUT 43 00406I'006017 .SYST 44 00407'016403 .WRS PPLT 45 00410'000001- JMP ERT 46 00411'000755 JMP RETRY ;GET NEXT LINE 47 ; 48 ; OUTPUT PAD CARRIAGE RETURNS TO MAKE MLINES LINES 49 ; PER PAGE. THEN PRINT SECTION ID AND PAGE NOޞ. 0006 TYPER 01 ; 02 00412'000000 NCR: 0 ;NO OF PAD CR'S TO BE OUTPUT THIS PAGE 03 00413'000005 C5: 5 04 00414'001032"MCR: .+1*2 05 .TXT*<15><15>* ;2 CR'S 00415'006415 00416'000000 06 00417'000614'AOPT: OPT 07 00420'9020743 PGNBR: LDA 0 NLINE ;LINES OUTPUT THIS PAGE 08 00421'024741 LDA 1 MLINE ;MAX NO PERMITTED 09 00422'106423 SUBZ 0 1 SNC ;SKIP IF MAX-PRINTED>0 10 00423'000411 JMP TYPIT ;<0 TYPE SECTION ID 11 00424'044766 STA 1 NCR 12 00425'020767 LDA 0 MCR d;CR POINTER 13 00426'126520 SUBZL 1 1 ;GEN +1 14 00427'006017 MORE: .SYST ;OUTPUT ONE CR PER LOOP 15 00430'017003 .WRL PPLT 16 00431'000001- JMP ERT 17 00432'014760 DSZ NCR ;DECREMENT NO OF CR'S 18 00433'000774 JMP MORE ;NOT 0 OUTPUT ONE MORE 19 00434'102440 TYPIT: SUBO 0 0 20 00435'040726 STA 0 NLINE ;ZERO NLINE 21 00436'024633 LDA 1 PBEGIN 22 00437'006401 JSR @.+1 23 00440'000577' MKSTR ;CONVERT PBEGIN TO ASCII DECIMAL 24 00441'000202' MNUMB ;POINTER TO TEXT AREA TO BE FILLED 25 00442'0224343 LDA 0 @AMPAGE ;BEGINNING OF STRING 26 00443'026754 LDA 1 @AOPT ;END OF STRING 27 00444'106400 SUB 0 1 ;DIFFERENCE IS LENGTH 28 00445'006017 .SYST 29 00446'016403 .WRS PPLT 30 00447'000001- JMP ERT 31 00450'010621 ISZ PBEGIN ;INCREMENT PAGE COUN"TER 32 00451'020425 LDA 0 CMESS ;ENTER E TO RESTART CR TO CONTINUE 33 00452'006017 .SYST 34 00453'017000 .WRL TTTO 35 00454'000001- JMP ERT 36 00455'020447 LDA 0 EMESS 37 00456'126520 SUBZL 1 1 ;GEN + 1 BYTES IN 38 00457'006017 .SYST 39 00460'015401 .RDL TTTI 40 00461'000001- JMP ERT 41 00462'030442 LDA 2 EMESS 42 00463'151220 MOVZR 2 2 ;CONVERT BUFFER POINTER TO ADDR 43 00464'021000 LDA 0 0 2 ;FIRST BYTE IN AC0 44 00465'101300 MOVS 0 0 45 00466'024476 LDA 1 C177 46 00467'123400 AND 1 0 ;MqASKED BYTE IN RH OF AC0 47 00470'024445 LDA 1 CE ;GET E CODE 48 00471'122404 SUB 1 0 SZR 49 00472'000712 JMP OUT ;NOT AN "E" OUTPUT FF AND DO NEXT PAGE 50 00473'002401 JMP @.+1 ;RESTART PROGRAM 51 00474'000000' TYPER 52 00475'000204'AMPAGE: MPAGE ;jADDRESS OF MPAGE 53 00476'001176"CMESS: .+1*2 54  .TXT*IF "E" IS NOT ENTERED PROGRAM CONTINUES<0>* 00477'044506 00500'020042 00501'042442 0007 TYPER 00502'020111 00503'051440 00504'047117 00505'052040 00506'042516 00507'052105 00510'051105 00511'042040 00512'050122 00513'047507 00514'051101 00515'046440 00516'041517 00517'047124 00520'044516 00521'052505 00522'051400 00523'000000 01 00524'001252"EMESS: .+1*~2 02 000010 .BLK 10 ;END MESSAGE BUFFERED HERE 03 00535'000105 CE: 105 ;"E"=105 OCTAL 04 ; 05 ; SUBROUTINE CHECK 06 ; CHECKS FIRST BYTE OF STRING FOR FF 07 ; JSR @.+1 08 ; CHECK 09  ; POINTER ADDRESS 10 ;; RETURN IF FF NOT IN BYTE 1 OF STRING 11 ; RETURN IF FF WAS IN BYTE 1 OF STRING 12 00536'000014 C14: 14 ;FF = 14 K 13 00537'031401 CHECK: LDA 2 1 3 ;ADDRESS OF POINTER IN AC2 14 00540'031000 LDA 2 0 2 ;POINTER IN AC2 15 00541'151220 MOVZR 2 2 ;ADDRESS OF STRING IN AC2 16 00542'031000 LDA 2 0 2 ;FIRST WORD IN AC2 17 00543'151300 MOVS 2 2 18 00544'024420 LDA 1 C177 ;MASK OUT 19 00545'133400 AND 1 2 20 00546'020770 LDA 0 C14 ;GET FF 21 00547'112414 SUB# 0 2 SZR 22 00550'001402 JMP 2 3 ;FF NOT FOUND 23 00551'001403 JMP 3 3 ;FF WAS FOUND 24 ; 25 ; SUBROUTINE GETSTR 26 ; CONVERTS ASCII DECIMAL STRING TO BINARY INTEGER 27 ; JSR @.+1 28 Q ; GETSTR 29 ; ADDRESS OF STRING POINTER 30 ; RETURNS TO HERE 31 00552'054410 GETSTR: STA 3 AC3O 32 00553'031401 LDA 2 1 3 ;ADDRESS OF STRING POOINTER 33 00554'031000 LDA 2 0 2 ;POINTER IN AC2 34 00555'050404 STA 2 PNT ;SAVE FOR USE BY GTCHR 35 00556'006405 JSR @ADBIN 36 00557'034403 LDA 3 AC3O 37 00560'001402 JMP 2 3 ;RETURN TO CALLER 38 00561'000000 PNT: 0 ;POINTER TO TEXT STRING 39 ;TO BE CONVERTED 40 00562'000000 AC3O: 0 41 00563'077777 Az.DBIN: .DBIN 0008 TYPER 01 00564'000177 C177: 177 02 00565'030774 AGTCH: LDA 2 PNT ;GET POINTER 03 00566'151220 MOVZR 2 2 ;MAKE ADDRESS 04 00567'025000 LDA 1 0 2 ;GET WORD 05 00570'020406 LDA 0 C377 06 00571'151013 MOV# 2 2 SNC ;SKIP IF EVEN 07 00572'125300 MOVS 1 1 08 00573'123400 AND 1 0 09 00574'010765 ISZ PNT 10 00575'001400 JMP 0 3 ;BACK TO DBIN 11 00576'000377 C377: 377 ;MASK 12 ; 13 ; SUBROUTINE MKSTR 14 ; CONVERTS BINARY INTEGER INTO DECIMAL AS9wCII 15 ; STRING AND PACKS IT INTO THE BUFFER POINTED TO 16 ; JSR @.+1 17 ; MKSTR 18 ; ADDRESS OF POINTER TO BUFFER WHICH WILL RECIEVE STRING 19 ; RETURNS HERE 20 ; NOTE THE NUMBE(R IN PASSEN IN AC1 21 00577'054414 MKSTR: STA 3 AC3D 22 00600'020451 LDA 0 T60 ;REPLACE ZERO ASCII IN C60 WITH 60K 23 00601'040451 STA 0 C60 ;READY TO SUPPRESS LEADING ZEROES 24 00602'031401 LDA 2 1 3 ;GET ADDRESS OF POINTER 25 00603'031000 LDA 2 0 ߔ2 ;GET POINTER IN AC2 26 00604'050410 STA 2 OPT 27 00605'006410 JSR @ABIND ;CALL BIND 28 00606'034405 LDA 3 AC3D 29 00607'001402 JMP 2 3 30 ; 31 00610'000000 NDEC: 0 ;NO OF DIGITS IN INTEGER STRING CONVERTED FROM AC1 32 00611'000015 CR: 15 ;CR PACKED INTO LAST BYTE FREE 33 00612'000000 T3: 0 ;TEMP STORAGE 34 00613'000000 AC3D: 0 35 00614'000000 OPT: 0 ;POINTER TO BEGINNING OF AREA INTO WHICH STRING 36 ;WILL BE PACKED BY APTCH 37 00615'077777 ABIND: .BIND 38 00616'177400 C17?74: 177400 ;MASK 39 ; 40 00617'101005 APTCH: MOV 0 0 SNR ;LAST BYTE IS A CR 41 00620'020771 LDA 0 CR ;CR FOR LAST 42 00621'040771 STA 0 T3 43 ; 44 ; SUPPRESS LEADING ZEROES AND + - SIGNS 45 ; 46 00622'024431 LDA 1 C53 ;+SIGN 47 00623'106405 SUB 0 1 SNR 48 00624'001400 JMP 0 3 ;BACK TO MATH.LB 49 00625'024427 LDA 1 C55 ;-SIGN 50 00626'106405 SUB 0 1 SNR 51 00627'001400 JMP 0 3 ;BACK TO MATH.LB 52 00630'024422 LDA 1 C60 ;ZERO 53 00631'106405 % SUB 0 1 SNR 54 00632'001400 JMP 0 3 ;AS A ZERO 55 00633'014417 DSZ C60 ;MAKE C60 UNEQUAL TO 60 56 ;SINCE NON ZERO DIGIT FOUND 57 00634'030760 LDA 2 OPT ;GET POINTER 58 00635'054420 STA 3 AC3A 59 00636'034740 LDA 3 C377 0009 TYPER 01 00637'151223 MOVZR 2 2 SNC ;CONVERT POINTER TO ADDRESS ANS 02 ;SKIP IF BYTE IS RIGHT HAND 03 00640'101301 MOVS 0 0 SKP ;SWAP BYTE BUT NOT MASK 04 00641'175300 MOVS 3 3 ;SWAP MASK BUT NOT BYTE 05 00642'025000 LDA 1 0 2 ;GET QWORD 06 00643'167400 AND 3 1 ;KEEP ONE HALF 07 00644'123000 ADD 1 0 ;ADD IN NEW 08 00645'041000 STA 0 0 2 ;WRITE WORD BACK 09 00646'010742 ISZ NDEC ;ADD ONE TO NUMBER OF DECIMAL DIGITS 10 00647'010745 ISZ OPT ;ALSO INCREMENT POINTER 11 00650'0024&05 JMP @AC3A ;RETURN TO MATH.LB 12 00651'000060 T60: 60 ;ZERO ASCII 13 00652'000000 C60: 0 ;REPLACED EVERY TIME .DBIN IS CALLED 14 00653'000053 C53: 53 ;+SIGN 15 00654'000055 C55: 55 ;-SIGN 16 00655'000000 AC3A: 0 ;SAVE AC3 WHILE IN APTCH 17 0002005 BUFF0: .BLK SIZE 18 000000' .END TYPER 0010 TYPER ABIND 000615' 8/27 8/37 AC3A 000655' 8/58 9/11 9/16 AC3D 000613' 8/21 8/28 8/34 AC3O 000562' 7/31 7/36 7/40 ADBIN 000563' 7/35 7/41 AGTCH 000565' 1&/17 8/02 AMPAG 000475' 6/25 6/52 AOPT 000417' 6/06 6/26 APTCH 000617' 1/18 8/40 BUFF0 000656' 1/15 9/17 C1 000361' 4/37 5/13 5/28 C14 000536' 7/12 7/20 C177 000564' 6/45 7/18 8/01 C1774 000616' 8/38 C377 000576' 8/05 8/11 8/59 C5 000413' 6/03 C53 000653' 8/46 9/14 C55 000654' 8/49 9/15 C60 000652' 8/23 8/52 8/55 9/13 CE 000535' 6/47 7/03 CHECK 000537' 4/41 5/36 7/13 CMESS 000476' 6/32 b2 6/53 CR 000611' 8/32 8/41 DISK 000002 1/26 1/54 4/35 5/25 DSKER 000336' 4/36 5/03 5/26 EMESS 000524' 6/36 6/41 7/01 ENDMS 000344' 5/03 5/09 ERROR 000150' 1/16 2/25 2/27 ERT 000001- 1/16 1/32 1/37 1/42 1/46 1/50 1/55 1/59 2/04 3/11 3/15 4/11 4/15 5/06 5/45 6/16 6/30 6/35 6/40 GETST 000552' 4/17 7/31 M1 000100' 1/43 2/16 M2 000113' 1/47 1/51 2/18 M8 000134' 1W/56 2/20 MCR 000414' 6/04 6/12 MKSTR 000577' 6/23 8/21 MLINE 000362' 5/14 6/08 MNUMB 000202' 3/02 3/17 3/18 6/24 MORE 000427' 6/14 6/18 MPAGE 000204' 3/05 6/52 MS2 000114' 2/19 MSECT 000153' 2/31 K/ 3/08 MTEXT 000203' 3/04 3/12 NBYTE 000357' 5/11 5/27 5/42 NCR 000412' 6/02 6/11 6/17 NDEC 000610' 8/31 9/09 NL 000320' 4/31 4/33 4/39 4/44 4/46 NLINE 000363' 5/16 5/21 5/22 6/07 6/20 NPLT 0000057' 2/01 2/14 NTTI 000053' 1/39 2/12 NTTO 000047' 1/34 2/10 OPT 000614' 6/06 8/26 8/35 8/57 9/10 OUT 000404' 5/30 5/38 5/41 6/49 PAGES 000360' 4/29 4/30 4/45 5/12 PAGIT 000364' 4/24 X'4/32 4/47 5/20 PBEGI 000271' 4/06 4/19 4/28 6/21 6/31 PGNBR 000420' 5/39 6/07 PMESS 000244' 4/02 4/08 0011 TYPER PNT 000561' 7/34 7/38 8/02 8/09 POINT 000000- 1/15 4/33 4/42 5/23 5/37 ;5/41 PPLT 000003 1/27 2/06 5/44 6/15 6/29 RETRY 000366' 5/22 5/46 SECID 000230' 2/09 3/08 SIZE 000200  1/25 9/17 SPG 000260' 4/04 4/12 4/18 STRTP 000272' 4/01 4/08 4/21 T3 000612' 8/33 8/42 T60 000651' 8/22 9/12 TTTI 000001 1/29 1/41 1/49 2/03 3/14 4/14 6/39 TTTO 000000 1/28 1/36 1/45 1/58 3/10 4/10 5/05 6/34 TYPER 000000' 1/30 2/07 5/08 6/51 9/18 TYPIT 000434' 6/10 c] 6/19 .BIND 000615'X 8/37 .DBIN 000563'X 7/41 .GTCH 000002- 1/17 .PTCH 000003- 1/18 TYPEREDIT.SV l l TYPERF.SV l lCB@AA@oBBB@"@"@3f  !# !" !3 !: !6 !B !  @ˀ$TTO1$TTI1INPUTFILE NAME? -  OUTPUT FILE NAME? -  >ENTER SECTION I.D. .I.E 16 A OR 15 C ETC.p NN Z ! ! ISTARTING PAGE NUMBER! !  A@I/P*)I$#%  1 A%I! @30DISK END OR ERROR 7 A I1  A )  A!) I!P  A) A@%- ! !'P 1"Ґ")>)%@3@IF "E" IS NOT ENTERED PROGRAM CONTINUESdE 32Ґ2)! Y32Q 9Bh1Ґ*! Y !)A)32Q 9 B!A)))1Y9ғ*B0+-Y-Q+!2 Y&Q$A$A$ )#)! )1) I)P 1PPP+-09SYQA9%Y! J!I )=! !1'd -+0BB0 2 *Z"*:X8:2! H`:Y:2`Y8 `8 ; CKS8Z9(J+J@Z*J8H` TYPER.SV l lP,%J  )!# )!" )!3 )!: )!6 )!B )! ) $TTO1$TTI1INPUTFILE NAME? - OUTPUT FILE NAME? - i "ENTER SECTION I.D. .I.E 16 A OR 15 C ETC.lT NN Z ! )! )ISTARTING PAGE NUMBER! )! ) I/P*)I$#% (  1 (! )%DISK END OR ERROR 7 A ( I1  ( () )d !) I!P ) A) %- )! )!'P )1"Ґ")>)%%IF "E" IS NOT ENTERED PROGRAM CONTINUESE 32Ґ2)! Y32Q 9Z1Ґ*! Y !)A)32Q 9 !A)))1Y9ғ*B0+-&8Y-Q+!2 + +Y&Q$A$A$ *)#)! *)1) I)P 1PPP+-09SYQA9%Y! }J!I +)=! +!1'd -+00 2 *Z"*:X8:2! H`:Y:2`Y8 `8 ; CKS8Z9(J+J@Z*J8H`