C*********************************************************************** C * C G O D D A R D C O M P U T E R S C I E N C E I N S T I T U T E * C * C (1) PROGRAM NAME, TRANSFORMATIONS * C (2) CALLING NAME, TRANSF * C (3) STATUS/CHANGE LEVEL, PGM.=GCSL021, PCR.= 02-08-67 * C (4) PROGRAMMED BY, R. R. LEFFEL * C MODIFIED BY, STEWART H. CROSSLAND * C (5) ADAPTED TO HP FORMAT ROLAND JAHN 04-70 * C * C SUPPORTED IN PART BY GRANT NO. FR00197 BY THE * C SPECIAL RESEARCH RESOURCES BRANCH, NIH-USPHS. * C * C*********************************************************************** PROGRAM GCS21 DIMENSION NCOM(36),XOX(500),YOY(500) EQUIVALENCE (NPNT,N),(CONST,C) C C READ HEADER AND PARAMETER CARDS C 10 WRITE (6, 1090) READ (5, 1070) (NCOM(I),I=1,36) WRITE (6, 1070) (NCOM(I),I=1,36) READ (5, 1080) ISW1,ISW2,NPNT,NCODE,CONST WRITE (6, 1110) ISW1,ISW2,NPNT,NCODE,CONST IF (ISW1) 20,30,20 20 WRITE (2, 1100) PAUSE C C INITIALIZE VARIABLES C 30 XN = NPNT WRITE (6, 1120) 40 LINES = 0 YM = 0.0 XM = 0.0 SX = 0.0 SXX = 0.0 SY = 0.0 SYY = 0.0 C C READ DATA AND BRANCH TO C THE INDICATED TRANSFORMATION C DO 1050 I= 1,N X = 0.0 Y = 0.0 CALL READ (NPNT,X,Y) ORIGX = X ORIGY = Y GO TO (50,90,130,170,190,260,330,380,400,420,470,480,490,500,530,6 100,640,690,690,870,890,910,930,950,980),NCODE C--------------------------------------- 50 IF (X) 70, 60, 60 60 X=X**.5 70 IF (Y) 1000, 80, 80 80 Y=Y**.5 GO TO 1000 C--------------------------------------- 90 IF (X)110,100,100 100 X=X+(X+1.0)**.5 110 IF (Y) 1000,120,120 120 Y=Y+(Y+1.0)**.5 GO TO 1000 C--------------------------------------- 130 IF (X) 150,150,140 140 X = ALOG(X)/ALOG(10.0) 150 IF (Y) 1000,1000,160 160 Y = ALOG(Y)/ALOG(10.0) GO TO 1000 C--------------------------------------- 170 X=EXP(X) 180 Y=EXP(Y) GO TO 1000 C--------------------------------------- 190 IF (X)220,210,200 200 IF (X-1.0)210,220,220 210 X=X**.5 X=ATAN(X/SQRT(1.0-X**2.0)) 220 IF (Y)250,240,230 230 IF (Y-1.0)240,250,250 240 Y=Y**.5 Y=ATAN(Y/SQRT(1.0-Y**2.0)) 250 GO TO 1000 C--------------------------------------- 260 IF (X)290,280,270 270 IF (X-XN )280,290,290 280 V=(X/(XN+1.))**.5 W=((X+1.)/(XN+1.))**.5 X=ATAN(V/SQRT(1.0-V**2.0))+ATAN(W/SQRT(1.0-W**2.0)) 290 IF (Y)320,310,300 300 IF (Y-XN )310,320,320 310 V=(Y/(XN+1.))**.5 W=((Y+1.)/(XN+1.))**.5 Y=ATAN(V/SQRT(1.0-V**2.0))+ATAN(W/SQRT(1.0-W**2.0)) 320 GO TO 1000 C--------------------------------------- 330 IF (X)340,350,340 340 X=1.0/X 350 IF (Y)360,370,360 360 Y=1.0/Y 370 GO TO 1000 C--------------------------------------- 380 X=X+C 390 Y=Y+C GO TO 1000 C--------------------------------------- 400 X=X*C 410 Y=Y*C GO TO 1000 C--------------------------------------- 420 IF (X)440,430,430 430 X=X**C 440 IF (Y)460,450,450 450 Y=Y**C 460 GO TO 1000 C--------------------------------------- 470 X=X+Y GO TO 1000 C--------------------------------------- 480 X=X-Y GO TO 1000 C--------------------------------------- 490 X=X*Y GO TO 1000 C--------------------------------------- 500 IF (Y)510,520,510 510 X=X/Y 520 GO TO 1000 C--------------------------------------- 530 IF (C-X)540,540,550 540 X=1.0 GO TO 560 550 X=0.0 560 IF (C-Y)570,570,580 570 Y=1.0 GO TO 590 580 Y=0.0 590 GO TO 1000 C--------------------------------------- 600 IF (X-Y)610,620,620 610 X=0.0 GO TO 630 620 X=1.0 630 GO TO 1000 C--------------------------------------- 640 IF (X)660,660,650 650 X=ALOG(X) 660 IF (Y)680,680,670 670 Y=ALOG(Y) 680 GO TO 1000 C--------------------------------------- C***** CODE 18 AND 19 ***** C--------------------------------------- 690 XOX(I) = X XM = XM + XOX(I) SX = SX+(XOX(I)*XOX(I)) SXX = SXX + XOX(I) YOY(I) = Y YM = YM + YOY(I) SY = SY+(YOY(I)*YOY(I)) SYY = SYY + YOY(I) IF (I-N) 1050,740,740 740 SXX = SXX*SXX SYY = SYY*SYY IF (X) 750,760,750 750 XM = XM/XN SSX = ((SX - (SXX/XN))/(XN-1.0))**0.5 GO TO 780 760 YM = YM/XN SSY=((SY - (SYY/XN))/(XN-1.0))**0.5 780 DO 860 J = 1,N X = XOX(J) Y = YOY(J) C--------------------------------------- IF (NCODE-19) 830,790,830 790 IF (X) 810, 810, 800 800 XOX(J) = XOX(J) / SSX GO TO 840 810 IF (Y) 840,840, 820 820 YOY(J) = YOY(J) / SSY GO TO 840 830 XOX(J) = XOX(J) - XM YOY(J) = YOY(J) - YM 840 WRITE (6, 1060) X,Y,XOX(J),YOY(J) IF (ISW1) 850,860, 850 850 WRITE (4, 1060) X,Y,XOX(J),YOY(J) 860 CONTINUE GO TO 1050 C--------------------------------------- 870 X=SIN(X) 880 Y=SIN(Y) GO TO 1000 C--------------------------------------- 890 X=COS(X) 900 Y=COS(Y) GO TO 1000 C--------------------------------------- 910 X=ATAN(X) 920 Y=ATAN(Y) GO TO 1000 C--------------------------------------- 930 IF (X)1000,1000,940 940 X=X**Y GO TO 1000 C--------------------------------------- 950 IF (C)1000,1000,960 960 Y=C**Y 970 X=C**X GO TO 1000 C--------------------------------------- 980 IF (X)1000,990,1000 990 X=C C C CONTROL THE NUMBER OF PRINT LINES PER PAGE C 1000 IF (LINES-40) 1020,1020,1010 1010 WRITE (6, 1090) WRITE (6, 1070) (NCOM(L),L=1,36) WRITE (6, 1110) ISW1,ISW2,NPNT,NCODE,CONST WRITE (6, 1120) 1020 WRITE (6, 1060) ORIGX,ORIGY,X,Y 1030 LINES = 0 IF (ISW1) 1040,1050,1040 1040 WRITE (4, 1060) ORIGX,ORIGY,X,Y 1050 LINES = LINES + 1 C C FORMAT STATEMENTS C 1060 FORMAT(3(F12.4,5X),3X,F12.4) 1070 FORMAT( 36A2 ) 1080 FORMAT(2I1,I3,I2,F8.0) 1090 FORMAT( 55(/) 25HTRANSFORMATIONS (GCSL021)/) 1100 FORMAT(/5(1H*),50HGCSL021---READY PUNCH AND THEN PUSH THE RUN 1 BUTTON,5(1H*) /) 1110 FORMAT(/ 16HINPUT PARAMETERS,4X,5HISW1=I1,2X,5HISW2=I1,2X,7HNPOI 1NT=I3,2X,6HNCODE=I2,2X,6HCONST=F8.0/) 1120 FORMAT(8X,1HX,16X,1HY,10X,14HTRANSFORMATION,6X, 1 14HTRANSFORMATION/ 40X, 4HOF X,16X, 4HOF Y/) C C PROGRAM CONTROL LOGIC C IF (ISW2) 10,1130, 10 1130 CONTINUE END SUBROUTINE READ (NPNT,X,Y) DIMENSION X(1),Y(1) READ (5, 100) X 100 FORMAT(3X,F8.1) RETURN END *SUBSET OF PBI DATA OF DR. SPEER (AUTOMATIC) 0100503+000000. 56.00000 0.00000 4.0253 66.00000 0.00000 4.1896 14.00000 0.00000 2.6390 59.00000 0.00000 4.0775 62.00000 0.00000 4.1271 *SUBSET OF PBI DATA OF DR. SPEER (AUTOMATIC) 0100517+000000. 56.00000 0.00000 4.0253 66.00000 0.00000 4.1896 14.00000 0.00000 2.6390 59.00000 0.00000 4.0775 62.00000 0.00000 4.1271 *SUBSET OF PBI DATA OF DR. SPEER (AUTOMATIC) 0100518+000000. 68.00000 0.00000 4.2195 145.00000 0.00000 4.9767 72.00000 0.00000 4.2766 66.00000 0.00000 4.1896 58.00000 0.00000 4.0604 *SUBSET OF PBI DATA OF DR. SPEER (AUTOMATIC) 0000519+0000. 183.00000 0.00000 5.2094 143.00000 0.00000 4.9628 58.00000 0.00000 4.0604 69.00000 0.00000 4.2341 47.00000 0.00000 3.8501