SUBROUTINE TISOSR (nplot, IERROR) C C LATEST REVISION DECEMBER 1984 C C PURPOSE TO PROVIDE A SIMPLE DEMONSTRATION OF C ISOSRF AND TO TEST ISOSRF ON A SINGLE PROBLEM C C USAGE CALL TISOSR (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 IS SUCCESSFUL, THE MESSAGE C C ISOSRF TEST SUCCESSFUL . . . SEE PLOT TO C VERIFY PERFORMANCE C C IS WRITTEN ON UNIT 6. C IN ADDITION, TWO FRAMES CONTAINING THE SAMPLE C PLOTS ARE PRODUCED ON THE MACHINE GRAPHICS C DEVICE. IN ORDER TO DETERMINE IF THE TEST C WAS SUCCESSFUL, IT IS NECESSARY TO EXAMINE C THESE PLOTS. C C PRECISION SINGLE C C REQUIRED LIBRARY ISOSRF FROM ULIB LIBRARY C FILES C C LANGUAGE STANDARD FORTRAN77 C C HISTORY WRITTEN BY MEMBERS OF THE C SCIENTIFIC COMPUTING DIVISION OF NCAR, C BOULDER COLORADO C C ALGORITHM A FUNCTION OF THREE VARIABLES IS DEFINED, AND C VALUES OF THE FUNCTION ON A THREE DIMENSIONAL C RECTANGULAR GRID ARE STORED IN AN ARRAY. THIS C SUBROUTINE CALLS EZISOS AND ISOSRF TO DRAW ISO- C VALUED SURFACE PLOTS OF THE FUNCTION. C C PORTABILITY ANSI STANDARD C C SAVE DIMENSION T(21,31,19),SLAB(33,33),EYE(3) C C SPECIFY COORDINATES FOR PLOT TITLES. ON AN ABSTRACT GRID WHERE C THE INTEGER COORDINATES RANGE FROM 1 TO 1024, THE VALUES IX AND IY C DEFINE THE CENTER OF THE TITLE STRING. C REAL IX,IY DATA IX/.44/, IY/.95/ C DATA NU,NV,NW/21,31,19/ DATA RBIG1,RBIG2,RSML1,RSML2/6.,6.,2.,2./ DATA TISO/0./ DATA MUVWP2/33/ DATA IFLAG/-7/ C C INITIALIZE ERROR PARAMETER C IERROR = 1 C C FILL THREE DIMENSIONAL ARRAY TO BE PLOTTED C JCENT1 = FLOAT(NV)*.5-RBIG1*.5 JCENT2 = FLOAT(NV)*.5+RBIG2*.5 DO 30 I=1,NU FIMID = I-NU/2 DO 20 J=1,NV FJMID1 = J-JCENT1 FJMID2 = J-JCENT2 DO 10 K=1,NW FKMID = K-NW/2 F1 = SQRT(RBIG1*RBIG1/(FJMID1*FJMID1+FKMID*FKMID+.1)) F2 = SQRT(RBIG2*RBIG2/(FIMID*FIMID+FJMID2*FJMID2+.1)) FIP1 = (1.-F1)*FIMID FIP2 = (1.-F2)*FIMID FJP1 = (1.-F1)*FJMID1 FJP2 = (1.-F2)*FJMID2 FKP1 = (1.-F1)*FKMID FKP2 = (1.-F2)*FKMID T(I,J,K) = AMIN1(FIMID*FIMID+FJP1*FJP1+FKP1*FKP1- 1 RSML1*RSML1, 2 FKMID*FKMID+FIP2*FIP2+FJP2*FJP2-RSML2*RSML2) 10 CONTINUE 20 CONTINUE 30 CONTINUE C C DEFINE EYE POSITION C EYE(1) = 100. EYE(2) = 150. EYE(3) = 125. C C LABEL THE PLOT TO BE DRAWN BY EZISOS C if (nplot .eq. 1) then CALL GSELNT(0) CALL WTSTR(IX,IY,'DEMONSTRATION PLOT FOR ENTRY EZISOS OF ISOSRF', 1 2,0,0) C C TEST EZISOS C CALL EZISOS (T,NU,NV,NW,EYE,SLAB,TISO) endif C C LABEL THE PLOT TO BE DRAWN BY ISOSRF C if (nplot .eq. 2) then CALL GSELNT(0) CALL WTSTR(IX,IY,'DEMONSTRATION PLOT FOR ENTRY ISOSRF OF ISOSRF', 1 2,0,0) C C TEST ISOSRF WITH SUBARRAY OF T C MU=NU/2 MV=NV/2 MW=NW/2 MUVWP2=MAX0(MU,MV,MW)+2 CALL ISOSRF(T(MU,MV,MW),NU,MU,NV,MV,MW,EYE,MUVWP2,SLAB,TISO,IFLAG) endif c CALL FRAME C IERROR = 0 c WRITE (6,1001) RETURN C c1001 FORMAT (' ISOSRF TEST SUCCESSFUL',24X, c 1 'SEE PLOT TO VERIFY PERFORMANCE') C END