home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: Science / Science.zip / ABCPLOT.ZIP / ABCPLOT.FOR < prev    next >
Text File  |  1991-04-02  |  20KB  |  523 lines
  1. C======================================================================
  2.       SUBROUTINE ABCPLT(FILNAM,NCURV,IX,IY,ICAT,ITYPE,ISWTCH,ITEXT,OUTF)
  3. C
  4. C     Version 6.0, December 1989. 
  5. C     (Arrays condensed from version 5.0 to allow 50% longer
  6. C     and 500% wider data files.)
  7. C
  8. C     Designed and written in FORTRAN 
  9. C     by Robert L. Dougherty
  10. C
  11. C     C-language command line parser (main program)
  12. C     by Ryan Rumanang; revised by Ting Liang and
  13. C                               Robert L. Dougherty
  14. C
  15. C     Warning: Non-ANSI-Standard Fortran (END DO statements are used).
  16. C
  17. C     ABCPLT is a group of subroutines that read data from a
  18. C     file and plot the data to the terminal or an output file.
  19. C
  20. C     A front end for this subroutine has been written in C.
  21. C     The front end allows the use of a command line that
  22. C     gives the name of the input data file and provides
  23. C     several graphing options.
  24. C
  25. C     As written, the program requires one data file, whose name
  26. C     is passed to ABCPLT from the calling program.  (The calling 
  27. C     program can create a temporary file if data are piped from 
  28. C     standard input).  This data file MUST have at least 2 lines,
  29. C     it MUST contain ONLY numbers that are readable by FORTRAN in
  30. C     list format; each line of the file MUST contain the same 
  31. C     number of numbers.  ABCPLT assumes these conditions, but it 
  32. C     does not check for them.  Unpredictable results will occur if
  33. C     these conditions are not met!
  34. C
  35. C     The program consists of this routine and 8 other subroutines:
  36. C
  37. C     COUNT    -- Finds out how many lines are in the raw data file,
  38. C                 and how many fields are in the first line.
  39. C     DATFILE  -- Reads the contents of the raw data file into a
  40. C                 data matrix.
  41. C     TCDFOPEN -- Opens and prepares to read the data file, ignoring 
  42. C                 commented lines above the actual data.
  43. C     DATCHEK  -- Checks the data matrix for a valid categorical
  44. C                 variable.
  45. C     UNIQUE   -- Called by DATCHEK.  Determines the number of unique
  46. C                 values in an array.
  47. C     ASSIGN   -- Assigns the proper elements of the data matrix to
  48. C                 the plotting arrays.  Used when data not categorical.
  49. C     DATAORG  -- Used when dataset contains a categorical variable.
  50. C                 Assigns the proper elements of the data matrix, by
  51. C                 category, to the plotting arrays.
  52. C     PLOT     -- Does the actual plotting.
  53. C----------------------------------------------------------------------
  54.  
  55. C     Set parameters for sizes of arrays.  These can be changed within
  56. C     the limits allowed by available memory.
  57. C     Maximum # of records in the input data file.
  58.       PARAMETER (MAXN=3000)
  59. C     Maximum # of fields in the input data file.
  60.       PARAMETER (MAXM=100)
  61. C     Maximum # of curves.
  62.       PARAMETER (MAXC=10)
  63.  
  64. C     Use the NEAR attribute for those variables passed from the C
  65. C     module.
  66.       INTEGER NCURV [NEAR],IX [NEAR],IY [NEAR],ICAT [NEAR],
  67.      +        ITYPE [NEAR],ISWTCH [NEAR],ITEXT [NEAR]
  68.       CHARACTER*80 FILNAM [NEAR], OUTF [NEAR]
  69.       DIMENSION IY(MAXC)
  70.       DIMENSION X(MAXN),Y(MAXC,MAXN),IDX(MAXN),CAT(MAXN),WORK(MAXN)
  71.       DIMENSION DATLIN(MAXM)
  72.  
  73. C     Inspect the data file and find out how many cases and fields.
  74.       CALL COUNT(FILNAM,MAXM,DATLIN,NCASE,NFIELD)
  75.       IF (NCASE .GT. MAXN) THEN
  76.          write(*,*)"ERROR! Too many lines in data file!"
  77.          STOP
  78.       END IF
  79.  
  80. C     Read the raw data file with the data.
  81.       CALL DATFILE(FILNAM,NCASE,NFIELD,MAXN,MAXM,MAXC,X,Y,ICAT,DATLIN,
  82.      +      IX,IY,CAT,NCURV) 
  83.  
  84. C     Decide whether the data set can be treated as categorical
  85.       KATEGOR=1
  86.       IF(ICAT.NE.0)THEN
  87.           CALL DATCHEK(MAXN,X,CAT,WORK,NCASE,IDX,KATEGOR)
  88.       END IF
  89.  
  90. C     Call the appropriate subroutine to read data into X and Y vectors.
  91.       IF ((KATEGOR .GT. 1) .AND. (KATEGOR .LE. 10)) THEN
  92.          CALL DATAORG(MAXN,MAXC,NCASE,NCURV,WORK,
  93.      +               IDX,CAT,KATEGOR,X,Y)
  94.       ENDIF
  95.  
  96. C     Use 6 as logical unit for output.
  97.       LUNOUT=6
  98. C     If output is to go on file, open file.
  99.       IF (ITYPE .EQ. 0) OPEN (UNIT=LUNOUT, FILE=OUTF)
  100.  
  101.       IF (ITEXT .EQ. 1) THEN
  102. C       Write the data.
  103.         DO I=1,NCASE
  104.            WRITE(LUNOUT,*)X(I),(Y(J,I),J=1,NCURV)
  105.         END DO
  106.       ELSE
  107. C       Plot the data.
  108.         CALL PLOT (MAXN,MAXC,NCURV,NCASE,X,Y,WORK,ITYPE,ISWTCH,10)
  109.       END IF
  110.  
  111. C     Return to the calling (C language) routine
  112.       RETURN
  113.       END
  114.  
  115. C======================================================================
  116.       SUBROUTINE COUNT(FN,MAXM,XYZ,NLINES,NFIELDS)
  117. C     A program to count the number of lines and the number of fields
  118. C     per line in a data file.  Requires data file with at least 2 records
  119. C     and with only numeric data.  Assumes that all records have the same
  120. C     number of fields.  No more than 100 records per line.
  121. C----------------------------------------------------------------------
  122.       DIMENSION XYZ(MAXM)
  123.       CHARACTER*80,FN 
  124.       CHARACTER*800,TXT
  125.       CALL TCDFOPEN(12,FN)
  126. C
  127. C     Find out how many lines, by reading the first field in each record.
  128. C
  129.       NLINES=0
  130.   10  READ(12,*,END=11)X
  131.          NLINES=NLINES+1 
  132.       GOTO 10
  133.   11  CONTINUE
  134.       CLOSE(12)
  135.       CALL TCDFOPEN(12,FN)
  136. C     Find out how many fields.
  137. C     Read the first line AS TEXT, then write it to a separate scratch file.
  138.       READ(12,100)TXT
  139.       CLOSE(12)
  140. C     Open a scratch file.
  141.       OPEN(UNIT=13,STATUS='UNKNOWN')
  142.       WRITE(13,100)TXT
  143. C     Read the numbers from the scratch file into vector.
  144. C     Repeat the READ for an increasing number of vector elements.
  145. C     When an error occurs, we've tried to read too many elements.
  146.       DO J=1,MAXM+1
  147.          NFIELDS=J-1
  148.          REWIND(13)
  149.          READ(13,*,ERR=14)(XYZ(I),I=1,J)
  150.       END DO
  151.       CLOSE(13)
  152. C     The only way to get here is if no error occurred: more fields in
  153. C     the data line than the value of maxm.
  154.       WRITE(*,200)
  155.   200 format(' ALERT: More data elements than allowed!')
  156.       NFIELDS=MAXM
  157.       GOTO 2
  158.    14 CLOSE(13)
  159.     2 CONTINUE
  160.   100 FORMAT(A800,I5)
  161.       CLOSE(UNIT=12)
  162.    13 RETURN
  163.       END
  164.  
  165. C======================================================================
  166.       SUBROUTINE DATFILE(FN,N,M,MAXN,MAXM,MAXC,X,Y,ICAT,DATLIN,IX,IY,
  167.      +      CAT,NCURV)
  168. C     This subroutine reads the numbers in a file into a data matrix,
  169. C     storing only those numbers needed for the plot.
  170. C----------------------------------------------------------------------
  171.       CHARACTER*80 FN
  172.       DIMENSION X(MAXN),Y(MAXC,MAXN),CAT(MAXN),DATLIN(MAXM),IY(MAXC)
  173.       CALL TCDFOPEN(12,FN)
  174.       DO I=1,N
  175. C        Read a line at a time, then parse into the data matrices
  176.          READ(12,*)(DATLIN(J),J=1,M)
  177. C        Get the X-variable.
  178. C        If no explicit X-variable, create it.
  179.          IF (IX .EQ. 0) THEN
  180.             X(I)=REAL(I)
  181.          ELSE
  182.             X(I)=DATLIN(IX)
  183.          END IF
  184. C        The Y variables are stored in the columns of the Y matrix.
  185.          DO J=1,NCURV
  186.             Y(J,I)=DATLIN(IY(J))
  187.          END DO
  188. C        The category variable is stored in the CAT vector.
  189.          IF (ICAT .NE. 0) THEN
  190.             CAT(I)=DATLIN(ICAT)
  191.          END IF
  192.       END DO
  193.       CLOSE(UNIT=12)
  194.       RETURN
  195.       END
  196.  
  197. C======================================================================
  198.       SUBROUTINE TCDFOPEN(LUN,CDFNAM)
  199. C     Top-Commented Data File OPEN routine.
  200. C
  201. C     Use TCDFOPEN, rather than OPEN, to open a data file that your
  202. C     program will read, so you can place comment lines above the 
  203. C     actual data lines.  The comment lines won't be seen by your 
  204. C     program.
  205. C
  206. C     TCDFOPEN is similar to its partner routine, CDFOPEN.  But 
  207. C     TCDFOPEN differs from CDFOPEN in several important ways.
  208. C     First, it only works with files that have all comment lines
  209. C     at the top.  Next, instead of reading the entire file,
  210. C     TCDFOPEN only has to read the comment lines, position the
  211. C     file pointer to the first non-comment line, and exit.
  212. C     The calling program will then read from the file itself, not
  213. C     a copy of it.  This reduces disk space needed for scratch files
  214. C     and saves time, especially with long files.  I use it with
  215. C     long database-type files such as weather records.
  216. C
  217. C     Arguments:
  218. C     LUN: Logical Unit Number to be associated with the file.
  219. C     CDFNAM: Commented Data File NAMe.  A character string that names
  220. C             the file.
  221. C
  222. C     Programmed by Bob Dougherty, USDA-ARS, Woodward, OK 73801
  223. C
  224. C----------------------------------------------------------------------
  225.       IMPLICIT INTEGER (A-Z)
  226. C
  227.       CHARACTER CDFNAM*(*)
  228.       CHARACTER*1 POS1
  229.  
  230. C     These indented statements may have to be changed for your application.
  231. C       Number of possible comment characters 
  232.         PARAMETER (NCOM=4)
  233. C       Declare and define a string containing the possible
  234. C       characters used in first position of line for comment:
  235.         CHARACTER*4 COM
  236.         DATA COM/'"!#*'/
  237. C     End of application-specific statements.
  238. C
  239. C     Open the commented data file.  Use the temporary unit #.
  240.       OPEN (FILE=CDFNAM,UNIT=LUN,STATUS='OLD')
  241. C
  242. C     Read each line of the commented data file; check for comments.
  243.     1 CONTINUE
  244.         READ(LUN,101,END=2) POS1
  245.   101   FORMAT(A1)
  246.         DO I=1,NCOM
  247.           IF (POS1 .EQ. COM(I:I)) GOTO 1
  248.         END DO
  249.     2 CONTINUE
  250.  
  251. C     Reposition to the line just read.
  252.       BACKSPACE (LUN)
  253.       RETURN
  254.       END
  255.  
  256. C======================================================================
  257.       SUBROUTINE DATCHEK(MAXN,X,CAT,ARRAY1,N,IDX,KATEGOR) 
  258.       DIMENSION IDX(MAXN),X(MAXN),CAT(MAXN),ARRAY1(MAXN)
  259. C     Some datasets will have one independent variable,
  260. C     one dependent variable, and one category variable.
  261. C     This program checks that the number of unique values
  262. C     in the category variable, times the number of unique
  263. C     values in the x-variable, is equal to the number of
  264. C     cases in the dataset.  Note that this is not a rigorous
  265. C     test for the presence of a categorical variable.
  266. C----------------------------------------------------------------------
  267. C     Presume it's not categorical unless determined otherwise.
  268.       KATEGOR=1
  269. C     How many unique values are in the supposed category column?
  270.       CALL UNIQUE(MAXN,N,CAT,ARRAY1,NUMCAT,IDX)
  271. C     Replace the category's value with its ID number.
  272.       DO I=1,N
  273.          CAT(I)=REAL(IDX(I))
  274.       END DO
  275. C     If more than 1 categories, OK
  276.       IF (NUMCAT .GT. 1) THEN
  277. C       How many unique values of the independent variable?
  278.         CALL UNIQUE(MAXN,N,X,ARRAY1,NUMX,IDX) 
  279. C       Is the product of the 2 numbers of unique values
  280. C       the same as the number of cases in this data set?
  281.         IF (NUMX*NUMCAT .EQ. N) THEN
  282.           KATEGOR=NUMCAT 
  283.         END IF
  284.       END IF
  285.       RETURN
  286.       END
  287.  
  288. C======================================================================
  289.       SUBROUTINE UNIQUE(MAXN,N,ARRAY,UNIQ,NUMUNIQ,ID)
  290. C     This subroutine answers the questions, 
  291. C     "How many unique values are there in ARRAY?
  292. C     and "What is the category of each value in ARRAY?)
  293. C     (actually, the first N rows of ARRAY)
  294. C----------------------------------------------------------------------
  295.       DIMENSION ARRAY(MAXN),UNIQ(MAXN),ID(MAXN)
  296. C     The first case is always unique.
  297.       NUMUNIQ=1
  298.       UNIQ(1)=ARRAY(1)
  299.       ID(1)=1
  300. C     examine each case after the first
  301.       DO I=2,N 
  302. C        assume initially that this case is unique.
  303.          IMUNIQ=1
  304. C        Look at all known unique values, compare this value to each.
  305.          J=0
  306. C        While j <= numuniq, do the following
  307.     1    IF(J.LT.NUMUNIQ) THEN
  308.             J=J+1
  309. C           If this datum is the same as a known unique, it's not unique.
  310.             IF (ARRAY(I).EQ.UNIQ(J)) THEN
  311.                IMUNIQ=0
  312. C              Identify the datum by its category
  313.                ID(I)=J
  314. C              Set J so this loop will not continue
  315.                J=NUMUNIQ
  316.             ENDIF
  317.          GOTO 1
  318.          ENDIF
  319.          IF (IMUNIQ .EQ. 1)THEN
  320. C          Increment the number of unique values
  321.            NUMUNIQ=NUMUNIQ+1
  322. C          Add the datum to the list of unique values
  323.            UNIQ(NUMUNIQ)=ARRAY(I)
  324. C           Identify the datum by its category
  325.            ID(I)=NUMUNIQ
  326.          END IF
  327.       END DO
  328.       RETURN
  329.       END
  330.  
  331. C======================================================================
  332.       SUBROUTINE DATAORG(MAXN,MAXC,N,NCURV,WORKX,IDX,CAT,KATEGOR,X,Y)
  333. C----------------------------------------------------------------------
  334.       DIMENSION X(MAXN),Y(MAXC,MAXN),WORKX(MAXN)
  335.       DIMENSION IDX(MAXN),CAT(MAXN)
  336.       DO I=1,N
  337.          WORKX(I)=X(I)
  338.       END DO
  339.       DO I=1,N
  340. C       The value of IDX for this case tells which unique value of X it is.
  341.         KASE=IDX(I)
  342.         X(KASE)=WORKX(I)  
  343. C       The value of IDCAT tells which category this case is for.
  344.         KAT=REAL(CAT(I))
  345.         Y(KAT,KASE)=Y(1,I)
  346.       END DO 
  347. C     Calculate new values for NCURV and N.
  348.       NCURV=KATEGOR
  349.       N=N/KATEGOR
  350.       RETURN
  351.       END
  352.  
  353. C======================================================================
  354.       SUBROUTINE PLOT (MAXN,MAXC,NPLOTS,NPTS,X,Y,YN,IFLAG,ISWTCH,LUNIT)
  355.  
  356. C     Subroutine written by Bob Dougherty, Nov. 1982 (revised Aug. 1984)
  357. C     Based on a routine written by George Innis.
  358.  
  359. C     This routine does simple line printer or dumb terminal plots, and can
  360. C     print up to 10 dependent variables against 1 independent variable.
  361. C     The call for this subroutine,
  362.  
  363. C     CALL PLOT (NPLOTS,NPTS,X,Y,YN,IFLAG)
  364.  
  365. C     is issued only once for a graph.  The parameters are
  366.  
  367. C     NPLOTS -- The total number of plots on the graph;
  368. C     NPTS   -- The number of values that each variable takes;
  369. C     X      -- An array containing the values of the ind. variable;
  370. C     Y      -- An array containing the values of each of the dep. variables;
  371. C     YN     -- An array which has no values.  Its use is internal to the
  372. C               subroutine but it must be named in the call.
  373. C     IFLAG   -- indicates whether the plot is to be a printer plot (for
  374. C               IFLAG=0) or a terminal plot (for IFLAG=1)
  375. C     ISWTCH -- Indicates whether the axes are to be switched (0=normal
  376. C               1=switched)
  377. C     LUNIT  -- The logical unit # if writing output to a file.
  378.  
  379. C    Note:    the program that calls this subroutine must dimension
  380. c             the arrays X, Y, and YN as follows:
  381. C             X(NPTS)
  382. C             Y(NPLOTS,NPTS)
  383. C             YN(NPTS)
  384. C  Note that each value in X corresponds to (NPLOTS) values in Y.
  385. C  For example, a printed graph of 3 plots, each with 20 points,
  386. C  may be called in this form:
  387. C     CALL PLOT(3,20,X,Y,YN,0)
  388. C  In this case, the following dimension statements in the main program
  389. C  would represent the minimum required array space:
  390. C     DIMENSION X(20),Y(3,20),YN(20)
  391. C  Here, Y(2,5) is Y-value of the 5th point in the 2nd plot . Its geometric
  392. C  location on the graph will be [X(5),Y(2,5)].
  393. C  For the case in which only one curve is needed, Y need only be dimensioned
  394. C  as (NPTS), and its values can be singly subscripted.
  395. C----------------------------------------------------------------------
  396.  
  397.       REAL X(MAXN),Y(MAXC,MAXN),YN(MAXN)
  398.       INTEGER COLUMNS
  399.       CHARACTER*1,BLANK,GRAPH(121,51)
  400.       CHARACTER*1,ISYM(10),ISYMBOL,ISYM1,ISYM2,BORDER
  401. C
  402. C     ISYM is a vector containing the characters to represent points.
  403. C     ISYM2 is the character to represent overlapping points.
  404.       DIMENSION ZX(13)
  405.       DATA ISYM/'A','B','C','D','E','F','G','H','I','J'/,ISYM2/'*'/
  406.       DATA BORDER/'+'/
  407.  
  408. C     Assign values for size of plot, based on the value of 'iflag'.                                        
  409.       IF (IFLAG .EQ. 0) THEN
  410. C        Assign values for printer plot.
  411.          LINES=51
  412.          COLUMNS=109
  413.          NXTICK=7
  414.       ELSE
  415. C        Assign values for terminal plot.
  416.          LINES=18
  417.          COLUMNS=65
  418.          NXTICK=5
  419.       ENDIF
  420. C     Find maximum and minimum values of independent variable
  421.       XMIN=X(1)
  422.       XMAX=X(1)
  423.       DO  I=1,NPTS
  424.           IF (X(I) .GT. XMAX) XMAX=X(I)
  425.           IF (X(I) .LT. XMIN) XMIN=X(I)
  426.       END DO
  427. C     Find maximum and minimum values of all dependent variables
  428.       YMIN=Y(1,1)
  429.       YMAX=Y(1,1)
  430.       DO I=1,NPLOTS
  431.           DO  J=1,NPTS
  432.               IF (Y(I,J) .GT. YMAX) YMAX=Y(I,J)
  433.               IF (Y(I,J) .LT. YMIN) YMIN=Y(I,J)
  434.           END DO
  435.       END DO
  436. C     Initialize the graph matrix.  Fill it with blanks.
  437.       BLANK =' '
  438.       DO I=1,COLUMNS
  439.         DO J=1,LINES
  440.           GRAPH(I,J)=BLANK
  441.         END DO
  442.       END DO
  443. C     Establish the scaling factors for the x and the y directions.
  444.       IF (ISWTCH .EQ. 0) THEN
  445.           XSCALE=(XMAX-XMIN)/(COLUMNS-1)
  446.           YSCALE=(YMAX-YMIN)/(LINES-1)  
  447.       ELSE
  448.           XSCALE=(XMAX-XMIN)/(LINES-1)
  449.           YSCALE=(YMAX-YMIN)/(COLUMNS-1)
  450. C     Initialize the numbers to be used as tick labels on X axis.
  451.       END IF
  452.       IF (ISWTCH .EQ. 0) THEN
  453.           DO K=1,NXTICK
  454.               ZX(K)=(XMAX-XMIN)/(NXTICK-1)*(K-1)+XMIN 
  455.           END DO
  456.       ELSE
  457.           DO K=1,NXTICK
  458.               ZX(K)=(YMAX-YMIN)/(NXTICK-1)*(K-1)+YMIN 
  459.           END DO
  460.       END IF   
  461. C     Fill the array yn in turn with each y vector; place symbol in graph matrix.
  462.       DO NCURV=1, NPLOTS
  463.           DO J=1,NPTS
  464.               YN(J)=Y(NCURV,J)
  465.           END DO
  466.           ISYM1=ISYM(NCURV)
  467. C         Put points for this curve in  graph
  468.           DO I=1,NPTS
  469.               ISYMBOL=ISYM1
  470.               XX=X(I)
  471.               YY=YN(I)
  472.               IF (ISWTCH .EQ. 0) THEN
  473.                   IX=(XX-XMIN)/XSCALE+1.5
  474.                   IY=(YY-YMIN)/YSCALE+.5
  475.               ELSE
  476.                   IY=(XX-XMIN)/XSCALE+.5
  477.                   IX=(YY-YMIN)/YSCALE+1.5
  478.               END IF
  479.               IY=LINES-IY
  480.               IF (GRAPH(IX,IY).NE.BLANK) ISYMBOL=ISYM2
  481.               GRAPH(IX,IY)= ISYMBOL
  482.               ISYMBOL=ISYM1
  483.           END DO
  484.       END DO
  485. C
  486. C   Print the graph
  487. C
  488.       IF (ISWTCH .EQ. 1) THEN
  489.           YMAX=XMAX
  490.           YSCALE=XSCALE
  491.       END IF
  492.       IF (IFLAG .EQ. 0) THEN
  493.           WRITE(LUNIT,501)
  494.           YES=YMAX+YSCALE
  495.           DO I=1,LINES
  496.               YES=YES-YSCALE
  497.               WRITE(LUNIT,502)YES,BORDER,(GRAPH(J,I),J=1,COLUMNS),
  498.      +                        BORDER,YES
  499.           END DO
  500.           WRITE(LUNIT,503)
  501.           WRITE(LUNIT,504)(ZX(I),I=1,NXTICK)
  502.       ELSE
  503.           WRITE(*,601)
  504.           YES=YMAX+YSCALE
  505.           DO I=1,LINES
  506.               YES=YES-YSCALE
  507.               WRITE(*,602)YES,BORDER,(GRAPH(J,I),J=1,COLUMNS),BORDER
  508.           END DO
  509.           WRITE(*,601)
  510.           WRITE(*,604)(ZX(I),I=1,NXTICK)
  511.       ENDIF
  512.   501 FORMAT(12X,'+',6(17('-'),'+'))
  513.   502 FORMAT(' ',E9.3,1X,1A1,109A1,1A1,1X,E9.3)
  514.   503 FORMAT(1H ,11X,'+',6(17('-'),'+'))
  515.   504 FORMAT (5X,E9.3,6(9X,E9.3))
  516.   601 FORMAT(12X,'+',4(15('-'),'+'))
  517.   602 FORMAT(' ',E9.3,1X,1A1,65A1,1A1)
  518.   604 FORMAT (6X,E9.3,4(7X,E9.3))
  519.       RETURN
  520.       END
  521.  
  522.  
  523.