      SUBROUTINE QOBSDO
     I                  (MESSFL,METRIC,NUMRCH,
     M                   DAT2)
C
C     + + + PURPOSE + + +
C     routine to plot observed DO data
C
C     + + + DUMMY ARGUMENTS + + +
      INTEGER     MESSFL,METRIC,NUMRCH
      REAL        DAT2(3,NUMRCH)
C
C     + + + ARGUMENT DEFINITIONS + + +
C     MESSFL - unit number for message file
C     METRIC - metric units flag
C     NUMRCH - maximum number of plots
C     DAT2   - array containing valid plot locations
C
C     + + + PARAMETERS + + +
      INTEGER     MAXPLT,MAXLOC
      PARAMETER   (MAXPLT=5,MAXLOC=50)
C
C     + + + LOCAL VARIABLES + + +
      INTEGER     I,I1,I70,J,K,SCLU,SGRP,INONE,RESP,RETCOD,LEN,LOCS,
     1            RNUM,LOC,NFLDS,OBDOFL,NOPLTS,LSTPOS,OFFSET,IDUM,LCLU,
     2            IVAL(3,MAXLOC),CVAL(3,MAXLOC),NUMLOC(MAXPLT),SAVFG,
     3            DATSTR(MAXPLT),UCCNT(4),UCDEF,VLINFG(4),USTRLN(4)
      REAL        DODAT(4,MAXLOC),RNONE,URMIN(4),URMAX(4),URDEF(4),RN
      DOUBLE PRECISION DDUM
      CHARACTER*1 DOTITL(70),BLNK,SCHRBF(80,50)
C
C     + + + EXTERNALS + + +
      EXTERNAL    ZIPI, ZIPR, ZIPC, QRESP, QRESCN, QFOPEN, QTSTR
      EXTERNAL    PRNTXT, QRESPI, PRNTXI, OBSWRT, QFCLOS, QSCSET
      EXTERNAL    OBSREA, PMXTXI, ZMNSST
C
C     + + + END SPECIFICATIONS + + +
C
      I1 = 1
      I70= 70
      INONE= -999
      RNONE= -999.
      BLNK = ' '
      SCLU = 21
C
C     initialize all parameters
      CALL ZIPI (MAXPLT,INONE,NUMLOC)
      NOPLTS= -999
      CALL ZIPR (4*MAXLOC,RNONE,DODAT)
      CALL ZIPC (I70,BLNK,DOTITL)
      SAVFG= 1
C
 5    CONTINUE
C       setup, edit, or save?
        SGRP= 1
        CALL QRESP (MESSFL,SCLU,SGRP,RESP)
        IF (RESP.EQ.1) THEN
C         set retcod to work from scratch
          RETCOD= I1
        ELSE IF (RESP.EQ.2) THEN
C         try to open the old file
          SGRP= 2
          CALL QFOPEN (MESSFL,SCLU,SGRP,OBDOFL,RETCOD)
          IF (RETCOD.EQ.0) THEN
C           fill the observed D.O. variables with values from old file
            CALL OBSREA (MESSFL,SCLU,OBDOFL,MAXPLT,MAXLOC,
     O                   DOTITL,NOPLTS,NUMLOC,DODAT,RETCOD)
            I= 0
            CALL QFCLOS (OBDOFL,I)
          END IF
        ELSE IF (RESP.EQ.3) THEN
C         write out file - first try to open
          SGRP= 10
          CALL QFOPEN (MESSFL,SCLU,SGRP,OBDOFL,RETCOD)
          CALL OBSWRT (MESSFL,SCLU,OBDOFL,DOTITL,NOPLTS,
     I                 NUMLOC,DATSTR(LSTPOS),DODAT,DATSTR)
          I= 0
          CALL QFCLOS (OBDOFL,I)
          SAVFG= 1
        ELSE IF (RESP.EQ.4) THEN
C         all done, is everything saved?
          IF (SAVFG.EQ.0) THEN
C           let user know files unsaved and verify exit
            LCLU= 19
            SGRP= 8
            CALL QRESP (MESSFL,LCLU,SGRP,RESP)
            IF (RESP.EQ.1) THEN
C             dont exit, go back and save
              RESP= 3
            ELSE
C             want to exit no matter what
              RESP= 4
            END IF
          END IF
        END IF
C
        IF (RESP.EQ.1 .OR. RESP.EQ.2) THEN
C         edit new or current data
          SAVFG= 0
          IF (METRIC.NE.0.AND.METRIC.NE.1) THEN
C           check metric units
            SGRP= 3
            CALL QRESP (MESSFL,SCLU,SGRP,METRIC)
            IF (METRIC.EQ.2) METRIC= 0
          END IF
C
C         get title
          LEN = 65
          SGRP= 4
          CALL QTSTR (MESSFL,SCLU,SGRP,LEN,
     O                DOTITL)
C
C         loop to modify plots
          DATSTR(1)= 1
          IF (RETCOD.EQ.0) THEN
C           determine number of locations for each plot and total plots
            I= 0
 10         CONTINUE
              I= I+ 1
              IF (I.GT.1) DATSTR(I)= DATSTR(I-1)+ NUMLOC(I-1)
            IF (NUMLOC(I).GT.0) GO TO 10
            LSTPOS= I
            NOPLTS= I- 1
          END IF
          I= 0
C         get number of plots
          SGRP= 5
          CALL QRESPI (MESSFL,SCLU,SGRP,
     M                 NOPLTS)
C
          DO 100 I= 1,NOPLTS
C           number of locations for this plot
            SGRP= 6
            CALL PMXTXI (MESSFL,SCLU,SGRP,I1,I1,-I1,I1,I)
C           save message text
            CALL ZMNSST
            SGRP= 7
            LOCS= NUMLOC(I)
            CALL QRESPI (MESSFL,SCLU,SGRP,LOCS)
            IF (RETCOD.EQ.0) THEN
C             previous data, compare with new inputs
              IF (LOCS.NE.NUMLOC(I).AND.NUMLOC(I+1).GT.0) THEN
C               adjust DODAT array to make room for new data
                OFFSET= LOCS- NUMLOC(I)
                IF (OFFSET.GT.0) THEN
                  DO 40 J= DATSTR(LSTPOS),DATSTR(I+1),-1
                    DO 30 K= 1,4
                      IF (J+OFFSET.LE.MAXLOC)
     1                    DODAT(K,J+OFFSET)= DODAT(K,J)
 30                 CONTINUE
 40               CONTINUE
                  LOC= DATSTR(I)+ NUMLOC(I)
                  CALL ZIPR (OFFSET*4,RNONE,DODAT(1,LOC))
                ELSE
                  DO 60 J= DATSTR(I+1),DATSTR(LSTPOS)
                    DO 50 K= 1,4
                      DODAT(K,J+OFFSET)= DODAT(K,J)
 50                 CONTINUE
 60               CONTINUE
                END IF
                DO 65 K= LSTPOS,I+1,-1
                  DATSTR(K)= DATSTR(K)+ OFFSET
 65             CONTINUE
              END IF
              NUMLOC(I)= LOCS
            ELSE
C             no previous data
              NUMLOC(I)= LOCS
              IF (I.GT.1) DATSTR(I)= DATSTR(I-1)+ NUMLOC(I-1)
              IF (I.EQ.NOPLTS) THEN
                DATSTR(I+1)= DATSTR(I)+ NUMLOC(I)
                LSTPOS= I+ 1
              END IF
            END IF
C           set up ranges for full screen from base data set values
            I1   = 1
            NFLDS= 4
            IDUM = 0
            DDUM = 0.0
            CALL ZIPI (NFLDS,IDUM,VLINFG)
            CALL ZIPI (NFLDS,IDUM,UCCNT)
            CALL ZIPI (NFLDS,I1,USTRLN)
            UCDEF= 0
            RNUM = 4
            RN   = 0.0
            CALL ZIPR (RNUM,RN,URMIN)
            CALL ZIPR (RNUM,RN,URDEF)
            URMIN(1)= DAT2(3,NUMRCH)
            RN   = 25.0
            CALL ZIPR (RNUM,RN,URMAX(2))
            URMAX(1)= DAT2(2,1)
            CALL QSCSET (I1,RNUM,I1,I1,NFLDS,IDUM,IDUM,IDUM,
     I                   URMIN,URMAX,URDEF,DDUM,DDUM,DDUM,
     I                   VLINFG,UCCNT,UCDEF,USTRLN,BLNK)
C           get DO data - full screen
            SGRP= 8+ METRIC
            CALL QRESCN (MESSFL,SCLU,SGRP,I1,RNUM,I1,NUMLOC(I),I1,
     M                   IVAL,DODAT(1,DATSTR(I)),CVAL,SCHRBF)
 100      CONTINUE
C         set RESP to SAve option
          RESP= 3
        END IF
C
      IF (RESP.NE.4) GO TO 5
C
      RETURN
      END
