SUBROUTINE DBGET4(CNAME,LENGTH,DATA,
     *                  YEAR,PERIOD,FREQ,DOC,LDOC,ECODE)
      PARAMETER (IPBUF=15000,IPBUF2=IPBUF+2,IPW=64)
      IMPLICIT INTEGER (A-Z)
C
C     USER-CALLABLE ROUTINE TO GET A VARIABLE FROM A TSP 4.2 DATABANK
C
      COMMON /COM43/ NOT43(5),IYBASE
      COMMON /IOCOM/ NOTIO,OUNIT
      COMMON /TSPCOM/ NOTTSP(8),NWORD
      CHARACTER*8 CNAME
      INTEGER*2 TYPE2,ECODE,IOFF
      REAL BUFFER,BUF2,DATA
      DIMENSION IREC(IPW),BUFFER(IPBUF),BUF2(IPBUF2),DATA(1),NAME(2),
     * DOC(1)
      EQUIVALENCE (BUF2(3),BUFFER(1))
C
      OUNIT=6
      NWORD=2
      IYBASE=1900
C
      READ(CNAME,888) NAME
  888 FORMAT(2A4)
      LEN2=0
      CALL DBFDI(IREC,POS,IOFF,NAME,LEN2,LDOCA,TYPE2,NEW,ECODE)
      LDOC = MIN0(LDOC,LDOCA)
      IF (ECODE.NE.0 .OR. TYPE2.NE.3) RETURN
C
      LENACT = LEN2 - 2 - LDOCA
      IF (LENACT.GT.LENGTH) THEN
        WRITE(OUNIT,100) CNAME,LENACT,LENGTH
100     FORMAT(' DBGET4:  VARIABLE ',A8,' TRUNCATED FROM ACTUAL',
     *      ' LENGTH OF',I8,' TO MAXIMUM INPUT LENGTH OF ',I8)
      ENDIF
      LENGTH = MIN0(LENGTH,LENACT)
      LENTOT = 2+LENGTH+LDOC
      IF (LENTOT.GT.IPBUF) THEN
        IBUF = IPBUF
        WRITE(OUNIT,101) CNAME,LENGTH,IBUF
101     FORMAT(' DBGET4:  VARIABLE ',A8,' TRUNCATED FROM ACTUAL',
     *      ' LENGTH OF',I8,' TO CURRENT INTERNAL LIMIT IN',
     *      ' DBGET4 OF ',I8)
        LENTOT = IPBUF
      ENDIF
C
      CALL DBGET2(POS,IOFF,LENTOT,BUF2,ECODE)
      IF (ECODE.NE.0) RETURN
C
      CALL IMOV(LENGTH,BUFFER,DATA)
      IF (LDOC.GT.0) CALL IMOV(LDOC,BUFFER(LENGTH+1),DOC)
      FREQ = BUF2(1)
      DATE = BUF2(2)
      CALL UNTSDT(DATE,YEAR,PERIOD,FREQ)
      RETURN
C
C-----------------------------------------------------------------------
C
      ENTRY DBPUT4(CNAME,LENGTH,DATA,YEAR,PERIOD,FREQ,
     *             DOC,LDOC,ECODE)
C
C     USER-CALLABLE ROUTINE TO PUT A VARIABLE INTO A TSP 4.2 DATABANK
C
      OUNIT=6
      NWORD=2
      IYBASE=1900
C
      READ(CNAME,888) NAME
C
      LENTOT = LENGTH+LDOC
      IF (LENTOT.GT.IPBUF) THEN
        IBUF = IPBUF
        WRITE(OUNIT,201) CNAME,LENTOT,IBUF
201     FORMAT(' DBPUT4:  VARIABLE ',A8,' TRUNCATED FROM ACTUAL',
     *      ' LENGTH OF',I8,' TO CURRENT INTERNAL LIMIT IN',
     *      ' DBPUT4 OF ',I8)
        LDOC = MAX0(0,LDOC-IPBUF+LENTOT)
        LENTOT = IPBUF
      ENDIF
C
      CALL IMOV(LENGTH,DATA,BUFFER)
      IF (LDOC.GT.0) CALL IMOV(LDOC,DOC,BUFFER(LENGTH+1))
C
      CALL TSDATE(DATE,YEAR,PERIOD,FREQ)
      BUF2(1) = FREQ
      BUF2(2) = DATE
C
      LEN2 = LENTOT + 2
      TYPE2 = 3
      CALL DBPUTV(POS,NAME,LEN2,LDOC,TYPE2,BUF2,ECODE)
      RETURN
      END
C----------------
      SUBROUTINE WRNPRT(NWARN,WRN,DATUM,IFMT)
      IMPLICIT INTEGER (A-Z)
C
      INTEGER WRN(1),DATUM(2)
      COMMON /IOCOM/ NOTIO,OUNIT
        INTEGER OUNIT
C
      WRITE(OUNIT,100)
100   FORMAT(' *** WARNING:')
      WRITE(OUNIT,101) (WRN(I),I=1,NWARN)
101   FORMAT(1X,16A4)
      IF (IFMT.EQ.6) THEN
        WRITE(OUNIT,206) DATUM(1)
206     FORMAT(1X,I8)
      ENDIF
C
      RETURN
      END