*-----------------------------------------------------------------------
*     Copyright (C) 2000-2022 GFD Dennou Club. All rights reserved.
*-----------------------------------------------------------------------
      SUBROUTINE FCPACK

      INTEGER   IBUF(*)
      LOGICAL   LEOL
      CHARACTER CDSN*(*),CACT*(*),CBUF*(*),CLX*(*)

      PARAMETER (MAXNR=99)
      PARAMETER (MAXCL=2,ISLCT=@ICLCT)

      INTEGER   NR(MAXNR),NZ(MAXNR),ILZ(2,MAXCL)
      LOGICAL   LE(MAXNR),LCHREQ,LEXIST,LSLFC,LCHNG,LSEOL
      CHARACTER CS(MAXNR)*1,CL*2,CLL(MAXCL)*2,CZ*1,CLR*2

      EXTERNAL  LCHREQ,LENC

      SAVE

      DATA      ILZ/ 10,  0, 13, 10 /
*     HEX. DECIMAL   '0A00', '0D0A'

      DATA      LSLFC/.FALSE./, LSEOL/.FALSE./
      DATA      LE/MAXNR*.FALSE./
      DATA      CS/MAXNR*'C'/

      RETURN
*-----------------------------------------------------------------------
      ENTRY FCSLFC(CLX)

      IF (LSLFC) THEN
        CALL MSGDMP('E','FCSLFC',
     +       'FCSLFC SHOULD BE CALLED BEFORE FCLEOL.')
      END IF
      NCLX=LENC(CLX)
      IF (.NOT.(NCLX.LE.2)) THEN
        CALL MSGDMP('E','FCSLFC',
     +       'LENGTH OF <LF> CHARACTER SHOULD BE 1 OR 2.')
      END IF

      CL=CLX(1:NCLX)
      LSLFC=.TRUE.

      RETURN
*-----------------------------------------------------------------------
      ENTRY FCLEOL(IOU,LEOL)

      IF (LCHREQ(CS(IOU),'C')) THEN
        LE(IOU)=LEOL
        IF (.NOT.LSEOL) THEN
          DO 5 N=1,MAXCL
            CLL(N)=CHAR(ILZ(1,N))//CHAR(ILZ(2,N))
    5     CONTINUE
          LSEOL=.TRUE.
        END IF
        IF (.NOT.LSLFC) THEN
          CL=CLL(ISLCT)
          LSLFC=.TRUE.
        END IF
        NL=LENC(CL)
      ELSE
        CALL MSGDMP('E','FCLEOL',
     +       'FCLEOL SHOULD BE CALLED BEFORE FCOPEN.')
      END IF

      RETURN
*-----------------------------------------------------------------------
      ENTRY FCOPEN(IOU,CDSN,NRL,CACT,ICON)

      IF (.NOT.(LCHREQ(CACT(1:1),'R') .OR. LCHREQ(CACT(1:1),'W'))) THEN
        CALL MSGDMP('E','FCOPEN',
     +       'ACCESS MODE SHOULD BE ''R'' OR ''W''.')
      ELSE
        CS(IOU)=CACT(1:1)
      END IF

      INQUIRE(FILE=CDSN,EXIST=LEXIST)

      IF (LCHREQ(CACT(1:1),'R')) THEN
        IF (.NOT.LEXIST) THEN
          CALL MSGDMP('E','FCOPEN','FILE DOES NOT EXIST.')
        END IF
      ELSE IF (LCHREQ(CACT(1:1),'W')) THEN
        IF (LEXIST) THEN
          OPEN(UNIT=IOU,FILE=CDSN)
          CLOSE(UNIT=IOU,STATUS='DELETE')
        END IF
      END IF

      NR(IOU)=1
      NZ(IOU)=NRL
      IF (LE(IOU)) THEN
        IF (LCHREQ(CACT(1:1),'R')) THEN
          OPEN(UNIT=IOU,FILE=CDSN,FORM='UNFORMATTED',
     +         ACCESS='DIRECT',RECL=1)
          DO 10 N=1,2
            READ(IOU,REC=NRL+N,IOSTAT=IOS) CZ
            IF (IOS.EQ.0) THEN
              CLR(N:N)=CZ
            ELSE
              IF (N.EQ.1) THEN
                CALL MSGDMP('E','FCOPEN','RECORD LENGTH IS WRONG.')
              ELSE
                CLR(N:N)=CHAR(0)
              END IF
            END IF
   10     CONTINUE
          IF (CLR(1:NL).EQ.CL(1:NL)) THEN
            NRECL=NRL+NL
          ELSE
            LCHNG=.FALSE.
            DO 20 N=1,MAXCL
              NLX=LENC(CLL(N))
              IF (CLR(1:NLX).EQ.CLL(N)(1:NLX)) THEN
                CALL MSGDMP('W','FCOPEN',
     +               '<LF> CHARACTER IS NOT CONSISTENT, BUT ACCEPTED.')
                NRECL=NRL+NLX
                LCHNG=.TRUE.
              END IF
   20       CONTINUE
            IF (.NOT.LCHNG) THEN
              CALL MSGDMP('E','FCOPEN','<LF> CHARACTER IS NOT FOUND.')
            END IF
          END IF
          CLOSE(UNIT=IOU)
        ELSE
          NRECL=NRL+NL
        ENDIF
      ELSE
        NRECL=NRL
      END IF

      OPEN(UNIT=IOU,FILE=CDSN,FORM='UNFORMATTED',
     +     ACCESS='DIRECT',RECL=NRECL,
     +     IOSTAT=ICON)

      RETURN
*-----------------------------------------------------------------------
      ENTRY FCCLOS(IOU,ICON)

      CLOSE(UNIT=IOU,IOSTAT=ICON)
      CS(IOU)='C'

      RETURN
*-----------------------------------------------------------------------
      ENTRY FCNREC(IOU,NREC)

      IF (LCHREQ(CS(IOU),'R')) THEN
        NR(IOU)=NREC
      ELSE
        CALL MSGDMP('E','FCNREC',
     +       'RECORD NUMBER CAN BE SPECIFIED ONLY FOR READ MODE.')
      END IF

      RETURN
*-----------------------------------------------------------------------
      ENTRY FCGETR(IOU,CBUF,ICON)

      IF (.NOT.LCHREQ(CS(IOU),'R')) THEN
        CALL MSGDMP('E','FCGETR','ACCESS MODE IS NOT ''R''.')
      END IF

      READ(UNIT=IOU,REC=NR(IOU),IOSTAT=ICON) CBUF(1:NZ(IOU))

      IF (ICON.EQ.0) THEN
        NR(IOU)=NR(IOU)+1
      END IF

      RETURN
*-----------------------------------------------------------------------
      ENTRY FCPUTR(IOU,CBUF,ICON)

      IF (.NOT.LCHREQ(CS(IOU),'W')) THEN
        CALL MSGDMP('E','FCPUTR','ACCESS MODE IS NOT ''W''.')
      END IF

      IF (LE(IOU)) THEN
        WRITE(UNIT=IOU,REC=NR(IOU),IOSTAT=ICON) CBUF(1:NZ(IOU)),CL(1:NL)
      ELSE
        WRITE(UNIT=IOU,REC=NR(IOU),IOSTAT=ICON) CBUF(1:NZ(IOU))
      END IF

      IF (ICON.EQ.0) THEN
        NR(IOU)=NR(IOU)+1
      END IF

      RETURN
*-----------------------------------------------------------------------
      ENTRY FCGETS(IOU,IBUF,ICON)

      IF (.NOT.LCHREQ(CS(IOU),'R')) THEN
        CALL MSGDMP('E','FCGETS','ACCESS MODE IS NOT ''R''.')
      END IF
      IF (.NOT.(MOD(NZ(IOU),4).EQ.0)) THEN
        CALL MSGDMP('E','FCGETS',
     +       'RECORD LENGTH SHOULD BE A MULTIPLE OF 4.')
      END IF
      NA=NZ(IOU)/4

      IF (LE(IOU)) THEN
        CALL MSGDMP('E','FCGETS',
     +       '<LF> CHARACTER CAN BE HANDLED FOR CHARACTER I/O.')
      ELSE
        READ(UNIT=IOU,REC=NR(IOU),IOSTAT=ICON) (IBUF(N),N=1,NA)
      END IF

      IF (ICON.EQ.0) THEN
        NR(IOU)=NR(IOU)+1
      END IF

      RETURN
*-----------------------------------------------------------------------
      ENTRY FCPUTS(IOU,IBUF,ICON)

      IF (.NOT.LCHREQ(CS(IOU),'W')) THEN
        CALL MSGDMP('E','FCPUTS','ACCESS MODE IS NOT ''W''.')
      END IF
      IF (.NOT.(MOD(NZ(IOU),4).EQ.0)) THEN
        CALL MSGDMP('E','FCPUTS',
     +       'RECORD LENGTH SHOULD BE A MULTIPLE OF 4.')
      END IF
      NA=NZ(IOU)/4

      IF (LE(IOU)) THEN
        CALL MSGDMP('E','FCPUTS',
     +       '<LF> CHARACTER CAN BE HANDLED FOR CHARACTER I/O.')
      ELSE
        WRITE(UNIT=IOU,REC=NR(IOU),IOSTAT=ICON) (IBUF(N),N=1,NA)
      END IF

      IF (ICON.EQ.0) THEN
        NR(IOU)=NR(IOU)+1
      END IF

      RETURN
      END

