@z
This file was created by Aleksandar Donev as part of the Network Optimization project.
Feel free to use any portion of it and contact me at donev@pa.msu.edu
@x

\Title{Scientific Plotting Library}
\author{Aleksandar Donev}
\date{January 2000}

@*0 Module |Simple_Graphics|.
This module provides some useful high-level 2D and 3D Fortran 90 plotting routines based on the DISLIN graphics library. It implements MATLAB-like routines for plotting 2D or 3D line and surface plots. The 2D line plotting routines accept either vectors or matrices as arguments, similar to MATLAB's plot. The 3D and surface-plotting routines are not really that sophisticated yet. 

NOTE: At present only vector-based 2D routines have been implemented. They use flexible assumed-shape based array syntax, so calling them with array sections should provide for an easy and relatively efficient (this is not the primary goal of this library) interface to making more complicated plots (such as plots with an unknown number of curves):

@a@%%
MODULE Simple_Graphics @;
   USE Precision @; // Kind parameters
   USE DISLIN @; // The DISLIN library
   IMPLICIT NONE @;
   PUBLIC :: InitGraphics, EndGraphics, Plot2D, Plot2D_r_sp, Plot2D_r_dp @;
   PRIVATE @;

   INTEGER, PARAMETER, PUBLIC :: r_sg = KIND(0.0) @;
   @<GlobalVariables@>@;
   @<GenericInterfaces@>@;
 
CONTAINS @;

   @<InitGraphics@>@;
   @<EndGraphics@>@;
   @<Plot2D@>@;

END MODULE Simple_Graphics @;
@%%
   @*1 Initialization and Termination.
   These routines attempt to set some friendly and nice parameters for the plotting routines. They accept an optional routine |my_func| which can be used to perform some additional actions or to override some of the defaults.  
   @m _MyFunInterface @;@%%
   INTERFACE @;
      SUBROUTINE my_func(level) @;
         INTEGER, INTENT(IN) :: level @;
      END SUBROUTINE my_func @; 
   END INTERFACE @; 
 @%%  
 @      
 The subroutine |InitGraphics| must be called before plotting anything. The function |my_func| can perform any additional level 0 (before calling |DISINI|) or level 1 (after calling |DISINI|) routines needed: 
@%%
 @<GlobalVariables@>=@%%
 @%% LOGICAL, SAVE :: plot_initialized=.FALSE. 
 LOGICAL, SAVE :: new_plot=.TRUE. @; // Has |GRAF| been called ? 
 INTEGER, SAVE :: n_legend_lines=0, max_legend_lines=10, leg_pos=8, n_ticks=5 @; // Some choices
 CHARACTER(LEN=2000), SAVE :: Leg="" @;  // Legend text 
 @
 @f file _file

 @<InitGraphics@>=@%%
 SUBROUTINE InitGraphics(file, file_type, n_plots, tex_mode, @| plot_title, x_label, y_label, z_label, tick_labels, legend_position, my_func) @;
   CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: file,file_type @;
   INTEGER, OPTIONAL, INTENT(IN) :: n_plots @;
   LOGICAL, OPTIONAL :: tex_mode @;
   CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: x_label,y_label,z_label @;
   CHARACTER(LEN=*), DIMENSION(:), OPTIONAL, INTENT(IN) :: plot_title @;
   CHARACTER(LEN=3), OPTIONAL, INTENT(IN) :: tick_labels @; // Such as |"3F5"|
   CHARACTER(LEN=2), OPTIONAL, INTENT(IN) :: legend_position @;  
   OPTIONAL :: my_func @;
   _MyFunInterface @;          
   
   INTEGER :: line, n_digits @;
   LOGICAL :: use_tex @;
   n_digits=1 @; // Default number of digits
   use_tex=.TRUE. @;
   
   IF(PRESENT(n_plots)) max_legend_lines=n_plots @;
   IF(PRESENT(tex_mode)) use_tex=tex_mode @;
   IF(PRESENT(file)) CALL SETFIL(file) @;

   IF(PRESENT(legend_position)) THEN @;
      SELECT CASE(legend_position) @;
         CASE("LL") @; // Lower left corner
            leg_pos=5 @;    
         CASE("LR") @; // Lower right corner
            leg_pos=6 @;
         CASE("UR") @; // Upper right corner
            leg_pos=7 @;
         CASE("UL") @; // Upper left corner
            leg_pos=8 @;
      ENDSELECT @;
   END IF @;
                                    
   IF(PRESENT(file_type)) THEN @;
      CALL METAFL(file_type) @;
   ELSE @;
      CALL METAFL("CONS") @; // Default     
   END IF @;   
    
   CALL SCRMOD("REVERS") @; // Black-on-white graphics
   CALL SETPAG("PS4L") @;
   @%% CALL SCLMOD("FULL") @;
   
   IF(PRESENT(my_func)) CALL my_func(0) @; // Execute level 0 additional activities
   CALL DISINI @; // Initalize the graphics
   @%% plot_initialized = .TRUE. @;
   CALL CENTER @;
   CALL PAGERA @; // Border around the page
   CALL DISALF @; // DISLIN font
   CALL COMPLX @; // Nicer font   
   CALL NOCHEK @; // Suppress extra messages
   CALL WINKEY("RETURN") @;
   CALL WINKEY("ESCAPE") @;   
   IF(use_tex) THEN @;
      CALL TEXMOD("ON") @; // Use LaTex in labels and such
   ELSE @;
      CALL TEXMOD("OFF") @;   
	   CALL MIXALF @; // Use control characters   
	   CALL SETMIX('_',"IND") @; // For indices
	   CALL SETMIX('^',"EXP") @; // Exponents	   
	   CALL SETMIX('$',"RES") @; // Back to normal
	   CALL SETMIX('/',"LEG") @; // New line   
	END IF @;  
	new_plot=.TRUE. @;
    
   IF(PRESENT(x_label)) CALL NAME(x_label,'X') @; 
   IF(PRESENT(y_label)) CALL NAME(y_label,'Y') @;
   IF(PRESENT(z_label)) CALL NAME(z_label,'Z') @;
   IF(PRESENT(plot_title)) THEN @;
     DO line=1,SIZE(plot_title) @;
       CALL TITLIN(plot_title[line],line) @; // New line in title 
     END DO @;
   END IF @; 

   IF(PRESENT(tick_labels)) THEN @; // Not at all optimized      
      n_ticks=MAX(1, MIN(IACHAR(tick_labels(1:1))-48, 9)) @; // Between 2-10 ticks 
      n_digits=MAX(0, MIN(IACHAR(tick_labels(3:3))-48, 9)) @; // Number of digits
      CALL LABDIG(n_digits,"XYZ") @;        
      SELECT CASE (tick_labels(2:2)) @;
         CASE ('D') @; // Decimal notation, base 10 exponents
            CALL LABELS("EXP","XYZ") @; 
         CASE ('E') @; // Exponential notation, as in Fortran
            CALL LABELS("FEXP","XYZ") @; 
         CASE ('F') @; // Floating-point notation
            CALL LABELS("FLOAT","XYZ") @;                                 
      ENDSELECT @;
   ELSE @;
      CALL LABDIG(n_digits,"XYZ") @;  
      CALL LABELS("FLOAT","XYZ") @;                 
   END IF @;   
   
   CALL LEGINI(Leg,max_legend_lines,50) @;            
   CALL FRAME(0) @; // No frames
   CALL MIXLEG @; // Multiline legends
   @%% CALL LEGCLR @; // Somewhat dubious
   CALL LEGTIT("") @; // To avoid the default German |"Legende"| 
       
   IF(PRESENT(my_func)) CALL my_func(1) @; // Level 1 additional actions 
   
 END SUBROUTINE @; // |InitGraphics|
@%%
 @
 This function needs to be called to end the plotting. The optional routine |my_func| now specifies additional level 0 routines (passed as -1) executed at the end:
 @<EndGraphics@>=@%% 
 SUBROUTINE EndGraphics(my_func) @; 
   OPTIONAL :: my_func @;
   _MyFunInterface @;

   INTEGER :: line
   
   CALL SETVLT("SMALL") @;               
   CALL SETCLR(1) @;
   DO line = n_legend_lines+1, max_legend_lines @;
      CALL LEGPAT(-1,1,-1,-1,-1,line) @; 
      CALL LEGLIN(Leg,"",line) @; // Clear legend line
   END DO   
   CALL LEGEND(Leg,leg_pos) @;
   
   IF(PRESENT(my_func)) CALL my_func(-1) @; 
   CALL DISFIN @; 
   @%% plot_initialized=.FALSE. @; // Reset  
   new_plot=.TRUE. @; // Reset
   n_legend_lines=0 @;
   n_ticks=5 @;
   max_legend_lines=10 @;
   leg_pos=8 @;
   Leg="" @;
   
 END SUBROUTINE EndGraphics @;
@%%
 @*1 Line and Symbol Plots.
 The subroutine |Plot2D| plots 2D curves on a graph with specified line-types, symbol-types and colors. {\em All} arguments are optional. This time the x and y data are both stored in rank-one arrays-vectors! The logical indicator new indicates whether this is a new plot or an old one. Again, |my_func| can perform any additional level 2 routines (after GRAF) needed. If specified, axis determines the scaling. Otherwise, the scaling is chosen so as to fit the data range of x and y.

 The same macro can be supplemented to work in 3D as well. However, I do not really need that at the moment and will thus skip this task.
@%%          
 @f dim _dim @;  
 @m _Plot(_kind, dim) @; // Only for 2D at present
 SUBROUTINE Plot@e@&dim@e@&D_@e@&_kind(x, y, plot_spec, legend,  @| symbol_spec, line_spec, color_spec, axis, my_func) @;
 
   REAL(KIND=_kind), DIMENSION(:), INTENT(IN), OPTIONAL :: x @;
   REAL(KIND=_kind), DIMENSION(:), INTENT(IN), OPTIONAL :: y @; // |SIZE(y)=SIZE(x)|
   @%% INTEGER, INTENT(IN), OPTIONAL :: step @;
   CHARACTER(LEN=3), INTENT(IN), OPTIONAL :: plot_spec @; // Shortcut
   CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: legend @;   
   INTEGER, DIMENSION(2), INTENT(IN), OPTIONAL :: symbol_spec,line_spec,color_spec @; // Full choice of line/symbol/color setting   
   @%% LOGICAL, OPTIONAL, INTENT(IN) :: new_plot @; // Is this a new axis system
   REAL(KIND=_kind), DIMENSION(4), INTENT(IN), OPTIONAL :: axis @;
   OPTIONAL :: my_func @; // Additional operation
   _MyFunInterface @;
 
   INTEGER :: point @; // Counter @%% , every
   INTEGER :: sym_type, sym_size, line_type, line_size, color_table, color_indx @;
   REAL(KIND=_kind), PARAMETER :: one=1.0_@e@&_kind, zero=0.0_@e@&_kind @;
   REAL(KIND=_kind) :: min_x=zero, max_x=one, min_y=zero, max_y=one, len_x, len_y @;
   CHARACTER(LEN=5), DIMENSION(0:7), PARAMETER :: color_tables=(/"SMALL","VGA  ","RAIN ","SPEC ","GREY ","RRAIN","RSPEC","RGREY"/) @; 
   LOGICAL :: plot_symbols, plot_lines @; // Logical indicators 

   /* Initial values--too bad for the save */
   @%% every = 1 @;
   sym_type=15;@~ sym_size=20;@~ line_type=0;@~ line_size=1;@~ color_table=0;@~ color_indx=4 @; // These defaults are just my kinky taste---do not rely on them!
   plot_symbols=.FALSE.;@~ plot_lines=.FALSE. @;
   IF( PRESENT(x)) THEN @;
      IF( .NOT.PRESENT(y) . OR. (PRESENT(y) .AND. (SIZE(y) /= SIZE(x))) ) THEN @;
         @; // |CALL Warning("In Plot2D there is a mismatch between x and y array sizes")|
         RETURN @; // Incompatible sizes
      END IF @;   
   END IF @;    
   @%% IF(PRESENT(step)) every=step @;
   @%% IF(PRESENT(new_plot)) plot_new=new_plot @;

   String_spec: IF(PRESENT(plot_spec)) THEN @;
   
       Plot_choice: SELECT CASE(plot_spec(1:1)) @;      
         CASE('S') @; // Plot symbols
            plot_symbols=.TRUE. @;
            
            Symbol_choice: SELECT CASE(plot_spec(2:2)) @;
             CASE('S') @; // Squares
               sym_type=0 @;
             CASE('C') @; // Circles
               sym_type=1 @;
             CASE('T') @; // Triangles
               sym_type=2 @;
             CASE('D') @; // Diamonds
               sym_type=5 @;
             CASE('N') @; // Nabla symbol
               sym_type=6 @;  
             CASE('s') @; // Filled squares
               sym_type=16 @;
             CASE('c') @; // Filled circles
               sym_type=21 @;
             CASE('t') @; // Filled triangles
               sym_type=20 @;
             CASE('d') @; // Filled diamonds
               sym_type=19 @;
             CASE('n') @; // Filled nabla 
               sym_type=20 @;
             CASE('+') @; // Plus
               sym_type=3 @; 
             CASE('x','X') @; // Cross
               sym_type=4 @;
             CASE('*') @; // Star
               sym_type=8 @;     
            ENDSELECT Symbol_choice @;    
                    
         CASE('L') @; // Plot line
            plot_lines=.TRUE. @;
            
            Line_choice: SELECT CASE(plot_spec(2:2)) @;
             CASE('-') @; // Solid line
               line_type=0 @; 
             CASE('.') @; // Dotted
               line_type=1 @; 
             CASE(':') @; // Long-short dash
               line_type=4 @; 
             CASE('~') @; // Dashed-short
               line_type=7 @; 
             CASE('|') @; // Dashed-long
               line_type=5 @; 
             CASE('=') @; // Dash-dotted
               line_type=3 @; 
           ENDSELECT Line_choice @;    

       ENDSELECT Plot_choice @;  
       
       Color_choice: SELECT CASE(plot_spec(3:3)) @; 
         CASE('R') @; // Red
           color_indx=2 @; 
         CASE('B') @; // Blue
           color_indx=4 @; 
         CASE('G') @; // Green
           color_indx=3 @;  
         CASE('Y') @; // Yellow
           color_indx=5 @;  
         CASE('O') @; // Orange
           color_indx=6 @;  
         CASE('C') @; // Cyan
           color_indx=7 @;
         CASE('M') @; // Magenta
           color_indx=8 @;                        
         CASE('K') @; // Black
           color_indx=1 @;                
       ENDSELECT Color_choice @;
       
   END IF String_spec @;      
                                                   
   IF(PRESENT(symbol_spec)) THEN @;
      plot_symbols=.TRUE. @;
      sym_type = MAX(0, MIN(symbol_spec[1], 21)) @; // Must be in $[0,21]$
      sym_size = MAX(1, MIN(symbol_spec[2], 100)) @; // Make it reasonable
   END IF @;
   IF(PRESENT(line_spec)) THEN @;
      plot_lines=.TRUE. @;   
      line_type = MAX(0, MIN(line_spec[1], 7)) @; // Must be in $[0,7]$
      line_size = MAX(1, MIN(line_spec[2], 25)) @; // Make it reasonable
   END IF @;  
   IF(PRESENT(color_spec)) THEN @;
      color_table = MAX(0, MIN(color_spec[1], 7)) @; // Must be in $[0,7]$
      color_indx = MAX(0, MIN(color_spec[2], 255)) @; // Make it be in $[0,255]$
   END IF @;      

   IF(new_plot) THEN @; // We need to make the axis system  
   
     IF(.NOT.PRESENT(axis)) THEN @; // Use the whole range 
       IF(PRESENT(x).AND.PRESENT(y)) THEN @; // Find the axis range
		       min_x=MINVAL(x) @; 
		       max_x=MAXVAL(x) @; 
		       min_y=MINVAL(y) @; 
		       max_y=MAXVAL(y) @; 
		 END IF @;    
     ELSE @; // Use the supplied axis range 
       min_x=axis(1) @; 
       max_x=axis(2) @; 
       min_y=axis(3) @; 
       max_y=axis(4) @; 
     END IF @; 
     len_x=max_x-min_x @; // Total length of |x| axis 
     len_y=max_y-min_y @; // Total length of |y| axis 
     CALL GRAF( REAL(min_x-len_x/20,r_sg), REAL(max_x+len_x/20,r_sg), &
               REAL(min_x,r_sg), REAL(len_x/n_ticks,r_sg), &
               REAL(min_y-len_y/20,r_sg), REAL(max_y+len_y/20,r_sg), &
               REAL(min_y,r_sg), REAL(len_y/n_ticks,r_sg) ) @; // I added about some extra room
     CALL TITLE @; // Doesn't hurt even if there is no title
     new_plot=.FALSE. @;
   END IF @;
      
   IF(PRESENT(my_func)) CALL my_func(2) @; // We should be in level 2 
         
   IF(plot_symbols.OR.plot_lines) THEN @; // Set the legend and color if plotting anything
   
      CALL SETVLT(color_tables[color_table]) @;               
      CALL SETCLR(color_indx) @;

      n_legend_lines = n_legend_lines + 1 @;            
      IF (plot_symbols.AND.(.NOT.plot_lines)) THEN @;
         CALL LEGPAT(-1,line_size,sym_type,color_indx,-1,n_legend_lines) @; 
      ELSEIF ((.NOT.plot_symbols).AND.plot_lines) THEN @;  
         CALL LEGPAT(line_type,line_size,-1,color_indx,-1,n_legend_lines) @;
      ELSEIF (plot_symbols.AND.plot_lines) THEN @;
         CALL LEGPAT(line_type,line_size,sym_type,color_indx,-1,n_legend_lines) @;
      END IF@;   
      IF(PRESENT(legend)) CALL LEGLIN(Leg,legend,n_legend_lines) @;                                   
   END IF @;   
         
   IF(plot_symbols) THEN @;
      @%% CALL INCMRK(-ABS(every)) @;
      @%% CALL MARKER(sym_type) @;
      CALL HSYMBL(sym_size) @;
      DO point = 1, SIZE(x) @;
         CALL RLSYMB(sym_type, @E REAL(x[point],r_sg), @E REAL(y[point],r_sg)) @;
      END DO @;
   END IF @;     

   IF(plot_lines) THEN @;
      @%% CALL INCMRK(0) @;   
      CALL LINTYP(line_type) @;
      CALL LINWID(line_size) @;
      DO point = 1, SIZE(x)-1 @;
          CALL RLINE(@E REAL(x[point],r_sg), @E REAL(y[point],r_sg),  @|&
                     @E REAL(x[point+1],r_sg), @E REAL(y[point+1],r_sg)) @;
      END DO @;
      CALL LINWID(1) @; // Reset the pen      
   END IF @;   
   
   @%% IF(plot_symbols.OR.plot_lines) THEN @; // Set the color if plotting anything
   @%%   IF(plot_symbols.AND.plot_lines) CALL INCMRK(ABS(every)) @;     
   @%%   CALL CURVE ( @E REAL(x,r_sg), @E REAL(y,r_sg), SIZE(x)) @;  
   @%% END IF @;           
   @%%
 END SUBROUTINE @; // |Plot2D|  
@%%   
   @
   We make specific instances of this routine for single and double-precision arguments: 
   @<Plot2D@>=@%%
   _Plot(r_sp, 2) @;
   _Plot(r_dp, 2) @;

   @ We include this under one generic heading:
   @<GenericInterfaces@>=@%%
   INTERFACE Plot2D
      MODULE PROCEDURE Plot2D_@e@&R_WP @;
   END INTERFACE                     
@%%