diff options
Diffstat (limited to 'sys/gio/ncarutil/tests/pwrzst.f')
| -rw-r--r-- | sys/gio/ncarutil/tests/pwrzst.f | 127 |
1 files changed, 127 insertions, 0 deletions
diff --git a/sys/gio/ncarutil/tests/pwrzst.f b/sys/gio/ncarutil/tests/pwrzst.f new file mode 100644 index 00000000..4067ed86 --- /dev/null +++ b/sys/gio/ncarutil/tests/pwrzst.f @@ -0,0 +1,127 @@ + SUBROUTINE TPWRZS (IERROR) +C +C LATEST REVISION JULY, 1984 +C +C PURPOSE TO PROVIDE A SIMPLE DEMONSTRATION OF +C PWRZS IN CONJUNCTION WITH SRFACE. +C +C USAGE CALL TPWRZS (IERROR) +C +C ARGUMENTS +C +C ON OUTPUT IERROR +C AN INTEGER VARIABLE +C = 0, IF THE TEST WAS SUCCESSFUL, +C = 1, OTHERWISE +C +C I/O IF THE TEST WAS SUCCESSFUL, THE MESSAGE +C +C PWRZS TEST SUCCESSFUL . . . SEE PLOT +C TO VERIFY PERFORMANCE +C +C IS PRINTED ON UNIT 6. +C IN ADDITION, ONE FRAME CONTAINING THE SAMPLE +C PLOT IS PRODUCED ON THE MACHINE GRAPHICS +C DEVICE. IN ORDER TO DETERMINE IF THE TEST +C WAS SUCCESSFUL, IT IS NECESSARY TO EXAMINE +C THIS PLOT. +C +C PRECISION SINGLE +C +C REQUIRED LIBRARY PWRZS, SRFACE +C FILES +C +C LANGUAGE FORTRAN +C +C ALGORITHM A FUNCTION OF TWO VARIABLES IS DEFINED, AND +C VALUES OF THE FUNCTION ON A TWO DIMENSIONAL +C RECTANGULAR GRID ARE STORED IN AN ARRAY. THIS +C SUBROUTINE CALLS SRFACE TO DRAW A SURFACE +C REPRESENTATION OF THE ARRAY VALUES, AND THEN +C PWRZS IS CALLED THREE TIMES TO LABEL THE +C FRONT, SIDE, AND BACK OF THE PICTURE. +C +C PORTABILITY ANSI FORTRAN 77 +C +C + DIMENSION Z(20,30) ,X(20) ,Y(30) ,MM(20,30,2), + 1 S(6) +C +C LOAD THE SRFACE COMMON BLOCK, NEEDED TO SURPRESS NEWFM CALL +C + COMMON /SRFIP1/ IFR ,ISTP ,IROTS ,IDRX , + 1 IDRY ,IDRZ ,IUPPER ,ISKIRT , + 2 NCLA ,THETA ,HSKIRT ,CHI , + 3 CLO ,CINC ,ISPVAL +C +C SPECIFY COORDINATES FOR PLOT TITLES. ON AN ABSTRACT GRID WHERE +C THE INTEGER COORDINATES RANGE FROM 0.0 TO 1.0, THE VALUES TX AND +C TY DEFINE THE CENTER OF THE TITLE STRING. +C + DATA TX/0.4375/, TY/0.9667/ +C +C SPECIFY GRID LOOP INDICES, AND LINE OF SIGHT +C + DATA M/20/, N/30/ + DATA S/4.,5.,3.,0.,0.,0./ +C +C INITIALIZE ERROR PARAMETER +C + IERROR = 1 +C +C DEFINE FUNCTION VALUES AND STORE IN Z +C + DO 10 I=1,M + X(I) = -1.+FLOAT(I-1)/FLOAT(M-1)*2. + 10 CONTINUE + DO 20 J=1,N + Y(J) = -1.+FLOAT(J-1)/FLOAT(N-1)*2. + 20 CONTINUE + DO 40 J=1,N + DO 30 I=1,M + Z(I,J) = EXP(-2.*SQRT(X(I)**2+Y(J)**2)) + 30 CONTINUE + 40 CONTINUE +C +C SET SRFACE PARAMETERS TO SURPRESS FRAME CALL AND DRAW CONTOURS + call srfabd +C + IFR = 0 + IDRZ = 1 +C +C SELECT NORMALIZATION TRANS NUMBER 0 +C + CALL GSELNT (0) +C +C LABEL THE PLOT +C + CALL WTSTR (TX,TY,'DEMONSTRATION PLOT FOR PWRZS',2,0,0) +C +C DRAW SURFACE PLOT +C + CALL SRFACE (X,Y,Z,MM,M,M,N,S,0.) +C +C PUT PWRZS LABELS ON PICTURE +C + ISIZE = 35 + CALL PWRZS (0.,1.1,0.,'FRONT',5,ISIZE,-1,3,0) + CALL PWRZS (1.1,0.,0.,'SIDE',4,ISIZE,2,-1,0) + CALL PWRZS (0.,-1.1,.2,' BACK BACK BACK BACK BACK',25,ISIZE,-1, + 1 3,0) +c CALL NEWFM +C + IERROR = 0 +c WRITE (6,1001) +C +C RESTORE SRFACE PARAMETERS TO DEFAULT +C + IFR = 1 + IDRZ = 0 +C + RETURN +C +C +c1001 FORMAT (' PWRZS TEST SUCCESSFUL',24X, +c 1 'SEE PLOT TO VERIFY PERFORMANCE') +C + END |