      SUBROUTINE OBSWRT (MESSFL,SCLU,OBDOFL,DOTITL,NUMPLT,
     I                   NUMLOC,TOTLOC,DODAT,DATSTR)
C
C     + + + PURPOSE + + +
C     routine to write out observed DO data
C
C     + + + DUMMY ARGUMENTS + + +
      INTEGER     MESSFL,SCLU,OBDOFL,NUMPLT,NUMLOC(NUMPLT),TOTLOC,
     1            DATSTR(5)
      REAL        DODAT(4,TOTLOC)
      CHARACTER*1 DOTITL(70)
C
C     + + + ARGUMENT DEFINITIONS + + +
C     MESSFL - unit number for message file
C     SCLU   - screen cluster number for DO data on message file
C     OBDOFL - unit number for DO data file
C     DOTITL - observed DO data title
C     NUMPLT - number of plots
C     NUMLOC - number of locations this plot
C     TOTLOC - total number of locations
C     DODAT  - observed DO data
C     DATSTR - starting positions in DODATA array for each plot
C
C     + + + LOCAL VARIABLES + + +
      INTEGER     I,I80,J,K,KK,L,SGRP,LEN,JUST
      CHARACTER*1 BLNK,TBUFF(80)
C
C     + + + FUNCTIONS + + +
      INTEGER     LENSTR
C
C     + + + EXTERNALS + + +
      EXTERNAL    ZIPC, GETTXT, INTCHR, DECCHR, LENSTR, CHRCHR
C
C     + + + OUTPUT FORMAT + + +
2000  FORMAT (80A1)
C
C     + + + END SPECIFICATIONS + + +
C
      I80 = 80
      BLNK= ' '
      JUST= 0
C
      CALL ZIPC (I80,BLNK,TBUFF)
C     write out DO title
      LEN = 10
      SGRP= 11
      CALL GETTXT (MESSFL,SCLU,SGRP,LEN,TBUFF)
      L= 70
      CALL CHRCHR (L,DOTITL,TBUFF(11))
      WRITE (OBDOFL,2000) (TBUFF(I),I=1,LENSTR(I80,TBUFF))
      CALL ZIPC (I80,BLNK,TBUFF)
C     write out DO data from 1 to NUMPLT
      DO 20 I= 1,NUMPLT
        LEN = 10
        SGRP= 12
        CALL GETTXT (MESSFL,SCLU,SGRP,LEN,TBUFF)
        L=4
        CALL INTCHR (NUMLOC(I),L,JUST,K,TBUFF(11))
        WRITE (OBDOFL,2000) (TBUFF(K),K=1,LENSTR(I80,TBUFF))
        L=15
        CALL ZIPC (L,BLNK,TBUFF)
        DO 10 J= DATSTR(I),DATSTR(I)+NUMLOC(I)-1
          LEN = 10
          SGRP= 13
          CALL GETTXT (MESSFL,SCLU,SGRP,LEN,TBUFF)
          L=10
          DO 5 K= 1,4
            CALL DECCHR (DODAT(K,J),L,JUST,KK,TBUFF(K*L+1))
 5        CONTINUE
          WRITE (OBDOFL,2000) (TBUFF(K),K=1,LENSTR(I80,TBUFF))
 10     CONTINUE
        L= 50
        CALL ZIPC (L,BLNK,TBUFF)
 20   CONTINUE
C     blank line to signal end of file
      WRITE (OBDOFL,2000) TBUFF
C
      RETURN
      END
