C-*- Fortran -*-
C
      SUBROUTINE WWRITE
      INCLUDE 'param.h'                                                 
      COMMON /WBUF/ H(IWBULL),I(IWBULL),J(IWBULL),K(IWBULL),L(IWBULL),
     -     IPOS,IUNIT,IBLE
      WRITE(IUNIT) I,J,K,L,H
      RETURN
      END
C
      SUBROUTINE WREAD(LF)
      INCLUDE 'param.h'                                                 
      COMMON /WBUF/ H(IWBULL),I(IWBULL),J(IWBULL),K(IWBULL),L(IWBULL),
     -     IPOS,IUNIT,IBLE
      LOGICAL LF
C     WRITE(6,*) ' WREAD: IBLE = ',IBLE,' IWBULL = ',IWBULL
      READ(IUNIT,IOSTAT=KX) (I(II),II=1,IBLE),(J(JJ),JJ=1,IBLE),
     -     (K(KK),KK=1,IBLE),(L(LL),LL=1,IBLE),(H(IHH),IHH=1,IBLE)
      IF (KX.NE.0) THEN
       WRITE(6,*) ' READ ERROR UNIT ',IUNIT
       STOP 'STOP IN WREAD'
      END IF
      LF=.FALSE.
      IF (I(IBLE).EQ.-1.AND.J(IBLE).EQ.-1.AND.K(IBLE).EQ.-1.
     -     AND.H(IBLE).EQ.-10000.D0) THEN
       LF=.TRUE.
       IPOS=L(IBLE)
      ELSE
       LF=.FALSE.
       IPOS=IBLE
      END IF
      RETURN
      END
C
      SUBROUTINE WADD(I1,J1,K1,L1,HVAL)
      INCLUDE 'param.h'                                                 
      COMMON /WBUF/ H(IWBULL),I(IWBULL),J(IWBULL),K(IWBULL),L(IWBULL),
     -     IPOS,IUNIT,IBLE
      IPOS=IPOS+1
      IF (IPOS.EQ.IWBULL+1) THEN
       CALL WWRITE
       IPOS=1
      END IF
      I(IPOS)=I1
      J(IPOS)=J1
      K(IPOS)=K1
      L(IPOS)=L1
      H(IPOS)=HVAL
      RETURN
      END
C
      SUBROUTINE WCLOS(IMODE)
      INCLUDE 'param.h'                                                 
      COMMON /WBUF/ H(IWBULL),I(IWBULL),J(IWBULL),K(IWBULL),L(IWBULL),
     -     IPOS,IUNIT,IBLE
      IF (IMODE.NE.1.AND.IMODE.NE.2) STOP 'ILLIGAL IMODE in WCLOS'
      IF (IMODE.EQ.1) THEN
C dump the last buffer, if completely filled
       IF (IPOS.EQ.IBLE) THEN
        CALL WWRITE
        IPOS=0
       END IF
       I(IWBULL)=-1
       J(IWBULL)=-1
       K(IWBULL)=-1
       L(IWBULL)=IPOS
       H(IWBULL)=-10000.
       CALL WWRITE
      END IF
      CLOSE(IUNIT)
      WRITE(6,*)
      WRITE(6,*) ' CLOSED UNIT ',IUNIT
      WRITE(6,*)
      RETURN
      END
C
      SUBROUTINE WOPEN(IUNITT,IMODE)
      INCLUDE 'param.h'                                                 
      COMMON /WBUF/ H(IWBULL),I(IWBULL),J(IWBULL),K(IWBULL),L(IWBULL),
     -     IPOS,IUNIT,IBLE
      CHARACTER*4 FN
      CHARACTER*6 FILEN
      CHARACTER*1 FNUM(10)
      DATA FNUM /'0','1','2','3','4','5','6','7','8','9'/
      FN='FILE'
      IF (IUNITT.EQ.6) STOP 'CANNOT OPEN UNIT 6 FOR UNFORMATTED WRITING'
      IF (IUNITT.EQ.0) STOP 'CANNOT OPEN UNIT 0 FOR UNFORMATTED WRITING'
      IF (IUNITT.EQ.5) STOP 'CANNOT OPEN UNIT 5 FOR UNFORMATTED WRITING'
      IF (IUNITT.GE.99) STOP ' WE WILL CERTAINLY NOT OPEN FILES > 99'
      IPOS=0
      IUNIT=IUNITT
      I10=IUNIT/10+1
      I1=MOD(IUNIT,10)+1
      FILEN=FN//FNUM(I10)//FNUM(I1)
      WRITE(6,*)
      IF (IMODE.EQ.1) THEN
       OPEN (UNIT=IUNIT,FORM='UNFORMATTED',STATUS='UNKNOWN',FILE=FILEN)
       WRITE(6,*) ' OPENED UNIT ',IUNIT,' FOR UNFORMATTED WRITING '
       WRITE(6,*) ' THE BUFFER LENGTH IS ',IWBULL
       WRITE(IUNIT) IWBULL
      ELSE IF (IMODE.EQ.2) THEN
       OPEN (UNIT=IUNIT,FORM='UNFORMATTED',STATUS='OLD',FILE=FILEN)
       WRITE(6,*) ' OPENED UNIT ',IUNIT,' FOR UNFORMATTED READING '
       READ(IUNIT) IBLE
       WRITE(6,*) ' WE FOUND A BUFFER LENGTH OF ',IBLE
       IF (IBLE.NE.IWBULL) THEN
        WRITE(6,*) ' THIS CORRESPONDS NOT TO OUR ACTUAL BUFFER LENGTH OF
     $ ',
C folded 1 (fixf $Revision: 1.3 $) 
     -       IWBULL
        IF (IWBULL.GT.IBLE) THEN
         WRITE(6,*) ' BUT WE TRY OUR BEST ....'
        ELSE
         STOP ' WE CANNOT HOLD THE BUFFERS IN MEMORY'
        END IF
       ELSE
        IBLE=IWBULL
       END IF
      ELSE
       STOP ' THIS CASE IS NOT SUPPORTED'
      END IF
      WRITE(6,*)
      RETURN
      END
C
      SUBROUTINE WWRIT2
      INCLUDE 'param.h'                                                 
      COMMON /WBUF2/ H(IWBULL),I(IWBULL),J(IWBULL),K(IWBULL),L(IWBULL),
     -     IPOS,IUNIT,IBLE
      WRITE(IUNIT) I,J,K,L,H
      RETURN
      END
C
      SUBROUTINE WREAD2(LF)
      INCLUDE 'param.h'                                                 
      COMMON /WBUF2/ H(IWBULL),I(IWBULL),J(IWBULL),K(IWBULL),L(IWBULL),
     -     IPOS,IUNIT,IBLE
      LOGICAL LF
      READ(IUNIT,IOSTAT=KX) (I(II),II=1,IBLE),(J(JJ),JJ=1,IBLE),
     -     (K(KK),KK=1,IBLE),(L(LL),LL=1,IBLE),(H(IHH),IHH=1,IBLE)
      IF (KX.NE.0) THEN
       WRITE(6,*) ' READ ERROR UNIT ',IUNIT
       STOP 'STOP IN WREAD'
      END IF
      LF=.FALSE.
      IF (I(IBLE).EQ.-1.AND.J(IBLE).EQ.-1.AND.K(IBLE).EQ.-1.
     -     AND.H(IBLE).EQ.-10000.D0) THEN
       LF=.TRUE.
       IPOS=L(IBLE)
      ELSE
       LF=.FALSE.
       IPOS=IBLE
      END IF
      RETURN
      END
C
      SUBROUTINE WADD2(I1,J1,K1,L1,HVAL)
      INCLUDE 'param.h'                                                 
      COMMON /WBUF2/ H(IWBULL),I(IWBULL),J(IWBULL),K(IWBULL),L(IWBULL),
     -     IPOS,IUNIT,IBLE
      IPOS=IPOS+1
      IF (IPOS.EQ.IWBULL+1) THEN
       CALL WWRIT2
       IPOS=1
      END IF
      I(IPOS)=I1
      J(IPOS)=J1
      K(IPOS)=K1
      L(IPOS)=L1
      H(IPOS)=HVAL
      RETURN
      END
C
      SUBROUTINE WCLOS2(IMODE)
      INCLUDE 'param.h'                                                 
      COMMON /WBUF2/ H(IWBULL),I(IWBULL),J(IWBULL),K(IWBULL),L(IWBULL),
     -     IPOS,IUNIT,IBLE
      IF (IMODE.NE.1.AND.IMODE.NE.2) STOP 'ILLIGAL IMODE in WCLOS'
      IF (IMODE.EQ.1) THEN
C dump the last buffer, if completely filled
       IF (IPOS.EQ.IBLE) THEN
        CALL WWRITE
        IPOS=0
       END IF
       I(IWBULL)=-1
       J(IWBULL)=-1
       K(IWBULL)=-1
       L(IWBULL)=IPOS
       H(IWBULL)=-10000.
       CALL WWRIT2
      END IF
      CLOSE(IUNIT)
      WRITE(6,*)
      WRITE(6,*) ' CLOSED UNIT ',IUNIT
      WRITE(6,*)
      RETURN
      END
C
      SUBROUTINE WOPEN2(IUNITT,IMODE)
      INCLUDE 'param.h'                                                 
      COMMON /WBUF2/ H(IWBULL),I(IWBULL),J(IWBULL),K(IWBULL),L(IWBULL),
     -     IPOS,IUNIT,IBLE
      CHARACTER*4 FN
      CHARACTER*6 FILEN
      CHARACTER*1 FNUM(10)
      DATA FNUM /'0','1','2','3','4','5','6','7','8','9'/
      FN='FILE'
      IF (IUNITT.EQ.6) STOP 'CANNOT OPEN UNIT 6 FOR UNFORMATTED WRITING'
      IF (IUNITT.EQ.0) STOP 'CANNOT OPEN UNIT 0 FOR UNFORMATTED WRITING'
      IF (IUNITT.EQ.5) STOP 'CANNOT OPEN UNIT 5 FOR UNFORMATTED WRITING'
      IF (IUNITT.GE.99) STOP ' WE WILL CERTAINLY NOT OPEN FILES > 99'
      IPOS=0
      IUNIT=IUNITT
      I10=IUNIT/10+1
      I1=MOD(IUNIT,10)+1
      FILEN=FN//FNUM(I10)//FNUM(I1)
      WRITE(6,*)
      IF (IMODE.EQ.1) THEN
       OPEN (UNIT=IUNIT,FORM='UNFORMATTED',STATUS='UNKNOWN',FILE=FILEN)
       WRITE(6,*) ' OPENED UNIT ',IUNIT,' FOR UNFORMATTED WRITING '
       WRITE(6,*) ' THE BUFFER LENGTH IS ',IWBULL
       WRITE(IUNIT) IWBULL
      ELSE IF (IMODE.EQ.2) THEN
       OPEN (UNIT=IUNIT,FORM='UNFORMATTED',STATUS='OLD',FILE=FILEN)
       WRITE(6,*) ' OPENED UNIT ',IUNIT,' FOR UNFORMATTED READING '
       READ(IUNIT) IBLE
       WRITE(6,*) ' WE FOUND A BUFFER LENGTH OF ',IBLE
       IF (IBLE.NE.IWBULL) THEN
        WRITE(6,*) ' THIS CORRESPONDS NOT TO OUR ACTUAL BUFFER LENGTH OF
     $ ',
C folded 1 (fixf $Revision: 1.3 $) 
     -       IWBULL
        IF (IWBULL.GT.IBLE) THEN
         WRITE(6,*) ' BUT WE TRY OUR BEST ....'
        ELSE
         STOP ' WE CANNOT HOLD THE BUFFERS IN MEMORY'
        END IF
       ELSE
        IBLE=IWBULL
       END IF
      ELSE
       STOP ' THIS CASE IS NOT SUPPORTED'
      END IF
      WRITE(6,*)
      RETURN
      END
 
 
 
