!______________________________________________________________________________ ! This program demonstrates how to use the Graphics module to plot 3D curves ! It plots the function z=sin(x)sin(y) both as a 2D color plot and as a surface !______________________________________________________________________________ PROGRAM DISLIN_test USE SimpleGraphics IMPLICIT NONE INTEGER, PARAMETER :: wp=KIND(0.0E0) ! All variables that are plotted must be single precision! REAL(KIND=wp) :: pi=3.141592654 INTEGER, PARAMETER :: N=20 INTEGER :: i,j REAL(KIND=wp), DIMENSION(N) :: X,Y REAL(KIND=wp), DIMENSION(N,N) :: Z CHARACTER(LEN=100), DIMENSION(2) :: title ! Don't worry about this syntax yet ! It is used to set up the proper arrays for plotting !__________________________________ X=2*pi*(REAL((/(i,i=1,N)/))/N-0.5) Y=X FORALL(i=1:N,j=1:N) Z(i,j)=SIN(X(i))*SIN(Y(j)) !__________________________________ title(1)="Example of 3D surface plot of the function z=sin(x) sin(y)" CALL InitGraphics(file="TestSimple_3Dcolor.png",file_type="CONS", & plot_title=title, & x_label="x",y_label="y") CALL SurfPlot(x=X,y=Y,z=Z,plot_spec="23R") CALL EndGraphics() CALL InitGraphics(file="TestSimple_3Dsurf.png",file_type="CONS", & plot_title=title, & x_label="x",y_label="y",z_label="z") CALL SurfPlot(x=X,y=Y,z=Z,plot_spec="3SR",view=(/35.0,25.0,7.0/)) CALL EndGraphics() END PROGRAM DISLIN_test