From fa080de7afc95aa1c19a6e6fc0e0708ced2eadc4 Mon Sep 17 00:00:00 2001 From: Joseph Hunkeler Date: Wed, 8 Jul 2015 20:46:52 -0400 Subject: Initial commit --- sys/gio/ncarutil/tests/threedt.f | 129 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 129 insertions(+) create mode 100644 sys/gio/ncarutil/tests/threedt.f (limited to 'sys/gio/ncarutil/tests/threedt.f') diff --git a/sys/gio/ncarutil/tests/threedt.f b/sys/gio/ncarutil/tests/threedt.f new file mode 100644 index 00000000..0cb6532d --- /dev/null +++ b/sys/gio/ncarutil/tests/threedt.f @@ -0,0 +1,129 @@ + SUBROUTINE TTHREE (IERROR) +C +C LATEST REVISION JULY, 1984 +C +C PURPOSE TO PROVIDE A SIMPLE DEMONSTRATION OF +C THE ROUTINE THREED. +C +C USAGE CALL TTHREE (IERROR) +C +C ARGUMENTS +C +C ON OUTPUT IERROR +C AN INTEGER VARIABLE +C =0 IF THERE IS A NORMAL EXIT FROM THE +C ROUTINE THREED. +C =1 OTHERWISE +C +C I/O IF THERE IS A NORMAL EXIT FROM THE ROUTINE +C THREED THE MESSAGE +C THREED TEST SUCCESSFUL . . . SEE PLOT TO +C VERIFY PERFORMANCE +C IS PRINTED. +C +C PRECISION SINGLE +C +C LANGUAGE FORTRAN +C +C HISTORY ORIGINALLY WRITTEN NOVEMBER 1976 +C CONVERTED TO GKS AND FORTRAN 77 JULY 1984 +C +C ALGORITHM ROUTINE TTHREE CALLS SET3 TO ESTABLISH A +C MAPPING BETWEEN THE PLOTTER ADDRESSES AND +C THE USER'S VOLUME, AND TO INDICATE THE +C COORDINATES OF THE EYE POSITION FROM +C WHICH THE LINES TO BE DRAWN ARE VIEWED. +C NEXT, THE VOLUME PERIMETERS AND ASSOCIATED +C TICK MARKS ARE DRAWN BY CALLS TO PERIM3. +C THEN THE LINES ARE DRAWN. THESE ARE +C CERTAIN LATITUDES AND LONGITUDES OF A +C SPHERE. +C +C PORTABILITY ANSI FORTRAN 77 +C +C +C +C + REAL EYE(3),X(31),Y(31),Z(31) +C +C SPECIFY ARGUMENT VALUES TO BE USED BY ROUTINE SET3. ON AN +C ABSTRACT PLOTTER WITH AN ADDRESS RANGE OF 0. TO 1. IN EACH +C COORDINATE DIRECTION, THE VALUES RXA, RXB, RYA, AND RYB +C DEFINE THE PORTION OF THE ADDRESS SPACE TO BE USED IN MAKING +C THE PLOT. UC, UD, VC, VD, WC, WD DEFINE A VOLUME IN USER +C COORDINATES WHICH IS TO BE MAPPED ONTO THE PORTION OF THE +C VIEWING SURFACE AS SPECIFIED BY RXA, RXB, RYA, AND RYB. +C + DATA RXA/0.097656/, RXB/0.90236/, RYA/0.097656/, RYB/0.90236/ + DATA UC/-1./, UD/1./, VC/-1./, VD/1./, WC/-1./, WD/1./ + DATA EYE(1),EYE(2),EYE(3)/10.,6.,3./ + DATA TX/0.4374/, TY/0.9570/ +C +C DEFINE PI + DATA PI/3.1415926535898/ +C +C +C SELECT NORMALIZATION TRANSFORMATION 0 +C + CALL GSELNT (0) +C +C CALL SET3 TO ESTABLISH A MAPPING BETWEEN THE PLOTTER ADDRESSES +C AND THE USER'S VOLUME, AND TO INDICATE THE COORDINATES OF THE +C EYE POSITION FROM WHICH THE LINES TO BE DRAWN ARE VIEWED. +C + CALL SET3(RXA,RXB,RYA,RYB,UC,UD,VC,VD,WC,WD,EYE) +C +C CALL PERIM3 TO DRAW PERIMETER LINES AND TICK MARKS +C + CALL PERIM3(2,5,1,10,1,-1.) + CALL PERIM3(4,2,1,1,2,-1.) + CALL PERIM3(2,10,4,5,3,-1.) +C +C DEFINE AND DRAW LATITUDINAL LINES ON THE SPHERE OF RADIUS ONE +C HAVING CENTER (0.,0.,0.) +C + DO 10 J=1,18 + THETA = FLOAT(J)*PI/9. + CT = COS(THETA) + ST = SIN(THETA) + DO 20 K=1,31 + PHI = FLOAT(K-16)*PI/30. + Z(K) = SIN(PHI) + CP = COS(PHI) + X(K) = CT*CP + Y(K) = ST*CP + 20 CONTINUE + CALL CURVE3(X,Y,Z,31) + 10 CONTINUE +C +C DEFINE AND DRAW LONGITUDINAL LINES ON THE SPHERE OF RADIUS ONE +C HAVING CENTER (0.,0.,0.) +C + DO 30 K=1,5 + PHI = FLOAT(K-3)*PI/6. + SP = SIN(PHI) + CP = COS(PHI) + DO 40 J=1,31 + TUETA = FLOAT(J-1)*PI/15. + X(J) = COS(TUETA)*CP + Y(J) = SIN(TUETA)*CP + Z(J) = SP + 40 CONTINUE + CALL CURVE3(X,Y,Z,31) + 30 CONTINUE +C +C CALL WTSTR FOR THREED PLOT TITLE +C + CALL WTSTR(TX,TY,'DEMONSTRATION PLOT FOR ROUTINE THREED',2,0,0) + call pwrzt (1.,0.,-1.,'DEMONSTRATION PLOT FOR ROUTINE THREED', 37, + * 2, 2, 3, 0) +C +c CALL NEWFM +C + IERROR = 0 +c WRITE(6,1001) + RETURN +C +c1001 FORMAT(' THREED TEST SUCCESSFUL', 24X, +c 1 'SEE PLOT TO VERIFY PERFORMANCE') + END -- cgit