C                                                            <HTML><PRE>
C Subroutine file 'apw.for': Subroutines writing the quantities at the
C points of rays into unformatted output files.  The quantities are
C stored in common block <A HREF="pointc.inc" TYPE="text/html">/POINTC/</A>.
C
C Version: 7.00
C Date: 2013, February 26
C Coded by Ludek Klimes
C
C This file consists of the following external procedures:
C     APW1... Subroutine designed to write the initial point of a ray,
C             stored in common block /POINTC/, into the output
C             unformatted file.
C             <A HREF="#APW1">APW1</A>
C     APW2... Subroutine designed to write the current point of a ray,
C             stored in common block /POINTC/, into the output
C             unformatted file.
C             This subroutine is thus designed for writing the ray point
C             by point directly into the output file.
C             <A HREF="#APW2">APW2</A>
C     APW3... Subroutine designed to copy the current point of a ray,
C             stored in common block /POINTC/, to two stock arrays,
C             in order to write the whole ray at once later.
C             This subroutine together with APW4 is thus designed for
C             situations, in which we cannot write the ray point by
C             point directly into the output file.
C             <A HREF="#APW3">APW3</A>
C     APW4... Subroutine designed to write all points of a ray, already
C             stored by subroutine APW3 in the stock arrays, into the
C             output unformatted file.
C             <A HREF="#APW4">APW4</A>
C
C=======================================================================
C
C     <A NAME="APW1"></A>
C
      SUBROUTINE APW1(LU)
      INTEGER LU
C
C This subroutine writes the initial point of a ray, stored in common
C block /POINTC/, into the output unformatted file.
C
C Input:
C     LU...   Logical unit number of the external output device
C             containing an unformatted file with the quantities at
C             the initial points of rays.
C
C No Output.
C
C Common block /POINTC/:
      INCLUDE 'pointc.inc'
C <A HREF="pointc.inc" TYPE="text/html">pointc.inc</A>
C
C Date: 2013, February 19
C Coded by Ludek Klimes
C
C-----------------------------------------------------------------------
C
C     Auxiliary storage locations:
      INTEGER I1,I2,I
C
C.......................................................................
C
      IF(NPVI.EQ.3) THEN
        I1=7
        I2=9
      ELSE
        I1=1
        I2=NPVI
      END IF
      WRITE(LU) ISRC,-IWAVE,IRAY,ICB1I,IEND,ISHEET,IREC,YLI,YI,
     *          NPVI,(PVI(I),I=I1,I2)
      RETURN
      END
C
C=======================================================================
C
C     <A NAME="APW2"></A>
C
      SUBROUTINE APW2(LU)
      INTEGER LU
C
C This subroutine writes the current point of a ray, stored in common
C block /POINTC/, into the output unformatted file.
C This subroutine is thus designed for writing the ray point by point.
C
C Input:
C     LU...   Logical unit number of the external output device
C             containing an unformatted file with the quantities at
C             the points along rays.
C
C No Output.
C
C Common block /POINTC/:
      INCLUDE 'pointc.inc'
C <A HREF="pointc.inc" TYPE="text/html">pointc.inc</A>
C
C Date: 2013, February 16
C Coded by Ludek Klimes
C
C-----------------------------------------------------------------------
C
C     Auxiliary storage locations:
      INTEGER I1,I2,I
C
C.......................................................................
C
      IF(NPV.EQ.3) THEN
        I1=7
        I2=9
      ELSE
        I1=1
        I2=NPV
      END IF
      WRITE(LU) ISRC,IWAVE,IRAY,NY,ICB1,ISRF,KMAH,
     *          X,UEBRAY,YL,(Y(I),I=1,NY),NPV,(PV(I),I=I1,I2)
      RETURN
      END
C
C=======================================================================
C
C     <A NAME="APW3"></A>
C
      SUBROUTINE APW3(ISTOK,MISTOK,STOK,MSTOK)
      INTEGER MISTOK,MSTOK
      INTEGER ISTOK(MISTOK)
      REAL STOK(MSTOK)
C
C This subroutine copies the current point of a ray, stored in common
C block /POINTC/, to two stock arrays, in order to write the whole ray
C at once later.  This subroutine together with APW4 is thus designed
C for situations, in which we cannot write the ray point by point
C directly into the output file, e.g., when writing two-point rays only
C or when simultaneously storing several rays.
C
C Input:
C     ISTOK,STOK... Stock arrays to accumulate all points of a ray.
C             Set ISTOK(1)=0 before the first invocation of APW3.
C             The stored ray can be deleted by setting ISTOK(1)=0.
C     MISTOK..Dimension of stock array ISTOK.
C             To store NPTS points, MISTOK should be at least 8*NPTS+1.
C     MSTOK...Dimension of stock array STOK.
C             To store NPTS points, MSTOK should be at least
C             (8+NY+NPV)*NPTS, see common block <A HREF="pointc.inc" TYPE="text/html">/POINTC/</A>.
C             Examples:
C             P-P wave in isotropic media:   at least 37*NPTS.
C             S-S wave in isotropic media:   at least 43*NPTS.
C             P-P wave in anisotropic media: at least 40*NPTS.
C             S-S wave in anisotropic media: at least 49*NPTS.
C
C Output:
C     ISTOK,STOK... Updated input arrays.
C
C Common block /POINTC/:
      INCLUDE 'pointc.inc'
C <A HREF="pointc.inc" TYPE="text/html">pointc.inc</A>
C
C Date: 2013, February 21
C Coded by Ludek Klimes
C
C-----------------------------------------------------------------------
C
C     Auxiliary storage locations:
      INTEGER I
      INTEGER NISTOK,NSTOK,NPTS
      SAVE    NISTOK,NSTOK,NPTS
      DATA    NISTOK,NSTOK,NPTS/0,0,0/
C
C.......................................................................
C
      IF(ISTOK(1).EQ.0) THEN
C       New ray
        NISTOK=0
        NSTOK=0
        NPTS=0
      END IF
C
      IF(NISTOK+9.GT.MISTOK) THEN
C       <A NAME="error01"></A><FONT COLOR="RED">APW-01</FONT>
        CALL ERROR('APW-01: Small stock array ISTOK for ray points')
C       Subroutine APW3 is called in order to store the points of a ray
C       in order to write the whole ray into the unformatted output file
C       later.  The array corresponding to dummy argument ISTOK of
C       subroutine APW3 is too small to accommodate all points of a ray.
C       You may increase the dimension of the array, or increase step
C       <A HREF="ray.for#data3" TYPE="text/html">STORE</A> in the independent variable along the ray.
      END IF
      IF(NSTOK+8+NY+NPV.GT.MSTOK) THEN
C       <A NAME="error02"></A><FONT COLOR="RED">APW-02</FONT>
        CALL ERROR('APW-02: Small stock array STOK for ray points')
C       Subroutine APW3 is called in order to store the points of a ray
C       in order to write the whole ray into the unformatted output file
C       later.  The array corresponding to dummy argument STOK of
C       subroutine APW3 is too small to accommodate all points of a ray.
C       You may increase the dimension of the array, or increase step
C       <A HREF="ray.for#data3" TYPE="text/html">STORE</A> in the independent variable along the ray.
      END IF
      NPTS=NPTS+1
      IF(NPTS.NE.MAX0(1,IPT)) THEN
C       <A NAME="error03"></A><FONT COLOR="RED">APW-03</FONT>
        CALL ERROR('APW-03: Incorrect index of the point on a ray')
C       Serial index of the point on a ray does not correspond to the
C       value of IPT in common block <A HREF="pointc.inc" TYPE="text/html">/POINTC/</A>.
C       This error should not appear.  Contact the authors.
      END IF
      IF(ISRC.LE.0) THEN
C       <A NAME="error04"></A><FONT COLOR="RED">APW-04</FONT>
        CALL ERROR('APW-04: Index of the source is not positive')
C       The index of the source (value of ISRC in common block <A HREF="pointc.inc" TYPE="text/html">/POINTC/</A>.
C       is not positive.
C       This error should not appear.  Contact the authors.
      END IF
C
      ISTOK(NISTOK+1)=ISRC
      ISTOK(NISTOK+2)=IWAVE
      ISTOK(NISTOK+3)=IRAY
      ISTOK(NISTOK+4)=NY
      ISTOK(NISTOK+5)=ICB1
      ISTOK(NISTOK+6)=ISRF
      ISTOK(NISTOK+7)=KMAH
      STOK(NSTOK+1)=X
      STOK(NSTOK+2)=UEBRAY
      DO 11 I=1,6
        STOK(NSTOK+2+I)=YL(I)
   11 CONTINUE
      DO 12 I=1,NY
        STOK(NSTOK+8+I)=Y(I)
   12 CONTINUE
      ISTOK(NISTOK+8)=NPV
      DO 13 I=1,NPV
        STOK(NSTOK+8+NY+I)=PV(I)
   13 CONTINUE
C
      ISTOK(NISTOK+9)=0
      NISTOK=NISTOK+8
      NSTOK=NSTOK+8+NY+NPV
      RETURN
      END
C
C=======================================================================
C
C     <A NAME="APW4"></A>
C
      SUBROUTINE APW4(LU,ISTOK,STOK)
      INTEGER LU,ISTOK(*)
      REAL STOK(*)
C
C This subroutine writes all points of a ray, already stored by
C subroutine APW3 in the stock arrays, into the output unformatted file.
C
C Input:
C     LU...   Logical unit number of the external output device
C             containing an unformatted file with the quantities at
C             the points along rays.
C     ISTOK,STOK... Output arrays of subroutine APW3.
C
C Output:
C     ISTOK(1)=0
C
C Common block /POINTC/:
      INCLUDE 'pointc.inc'
C <A HREF="pointc.inc" TYPE="text/html">pointc.inc</A>
C
C Date: 2013, February 26
C Coded by Ludek Klimes
C
C-----------------------------------------------------------------------
C
C     Auxiliary storage locations:
      INTEGER II,IS,ISY,ISPV,I
C
C.......................................................................
C
      II=0
      IS=0
C
C     Loop over the points of the ray:
   10 CONTINUE
        IF(ISTOK(II+1).EQ.0) THEN
C         End of the ray
          GO TO 90
        END IF
        ISY=IS+8+ISTOK(II+4)
        ISPV=ISY+ISTOK(II+8)
        WRITE(LU) (ISTOK(I),I=II+1,II+7),
     *            (STOK(I),I=IS+1,ISY),
     *            ISTOK(II+8),
     *            (STOK(I),I=ISY+1,ISPV)
        II=II+8
        IS=ISPV
      GO TO 10
C
   90 CONTINUE
      ISTOK(1)=0
      RETURN
      END
C
C=======================================================================
C
