Document title: Subroutine DE2_UA_UROPEN.FOR for NDADS DE datatype UA
Project: DE
NDADS Datatype: UA
EID: SOFTWARE
Super-EID: SOFTWARE
There may be other documents also identified by this super-EID.
NDADS filename: DE2_UA_UROPEN.FOR
TRF entry: b48493.for in NSSDC's controlled digital document library, Mar. 1999.
Document text follows:
----------------------

      SUBROUTINE UROPEN(FDATE,FTIME,IERR,MAP)
C---------------------------------------------------------
C       Open DE UA files and position for read.
C       A.E.Hedin 11/27/84
C     Input parameters:
C       FDATE - First date (YYDDD) for data (INTEGER).
C       FTIME - First time (Millisec) for data (INTEGER).
C       MAP   - array containing number of data items to be
C               retrieved plus list of the data item numbers.
C                1 NACS N2
C                2 NACS O
C                3 NACS HE
C                4 NACS AR
C                5 NACS N
C                6 WATS TN
C                7 WATS NVE
C                8 WATS NVU
C                9 LANG NP
C               10 LANG TE
C               11 FPI FWAV
C               12 FPI FALT
C               13 FPI FVN
C               14 FPI FTEM
C               15 FPI RAY
C               16 RPA TI
C               17 RPA NI
C               18 RPA IVE
C               19 RPA IVN
C               20 RPA IVU
C     Output parameters:
C       IERR - Error return:
C              3XX Open error with XX VAX error code;
C              800 No data within 20 days of request;
C              900 No further data.
C     I/O Units 92 and 94.
C     File names of the form SYS$UA:DEUAyyddd
C----------------------------------------------------------
      INTEGER FDATE,FTIME,FMAP(21),RMAP(21),TMAP(21)
      DIMENSION MAP(1)
      CHARACTER*5 CYD
      COMMON/U$COM/IOS,NW,IOPEN,NDATE,RMAP,TMAP
      DATA IOPEN/0/,RMAP/21*0/,FMAP/21*0/,MAXMAP/21/
      DATA JOPEN/9876/,MINDATE/81218/,MAXDATE/83049/
      IERR=0
      ITIME=0
C      Save map parameters
      MP=MIN(MAXMAP,MAP(1)+1)
      DO 20 I=1,MP
        RMAP(I)=MAP(I)
   20 CONTINUE
C      Close file if open
      IF(IOPEN.EQ.JOPEN) THEN
        CLOSE(92)
        IOPEN=0
      ENDIF
C      Open requested date or earliest expected
      NDATE=MAX(FDATE,MINDATE)
      WRITE(CYD,100) NDATE
  100 FORMAT(I5)
      OPEN(92,ERR=25,FORM='UNFORMATTED',FILE='SYS$UA:DEUA'//CYD,
     &  IOSTAT=IOS,READONLY,SHARED,STATUS='OLD')
   25 CONTINUE
      IF(IOS.GT.0) THEN
        IF(IOS.EQ.29) GOTO 30
        GOTO 90
      ENDIF
C     If successful open then
C        Get first record.
        IOPEN=JOPEN
        READ(92) NWYD,(FMAP(J),J=1,NWYD/100000)
        NW=NWYD/100000
        IF(FTIME.GT.0) THEN
C         Position to requested time.
          DO WHILE (ITIME.LT.FTIME)
            READ(92,END=30) ITIME
          ENDDO
          BACKSPACE(92)
        ENDIF
        GOTO 50
C     Else (file not found exit from open)
   30   CONTINUE
        II=0
   31   CONTINUE
        II=II+1
        NDATE=NDATE+1
        IF(MOD(NDATE,1000).GE.366) NDATE=1000*(NDATE/1000+1)+1
        IF(II.GT.20) THEN
          IERR=800
          GOTO 50
        ENDIF
        IF(NDATE.GT.MAXDATE) THEN
          IERR=900
          GOTO 50
        ENDIF
        WRITE(CYD,100) NDATE
        OPEN(92,ERR=35,FORM='UNFORMATTED',FILE='SYS$UA:DEUA'//CYD,
     &  IOSTAT=IOS,READONLY,SHARED,STATUS='OLD')
   35   CONTINUE
        IF(IOS.GT.0) THEN
          IF(IOS.EQ.29) GOTO 31
          GOTO 90
        ENDIF
        IOPEN=JOPEN
        READ(92) NWYD,(FMAP(J),J=1,NWYD/100000)
        NW=NWYD/100000
C     Endif
   50 CONTINUE
C     Set up data transfer index array
      DO 55 J=1,MAXMAP
        TMAP(J)=0
   55 CONTINUE
      DO 60 K=1,RMAP(1)
        DO 60 J=1,NW
          IF(RMAP(K+1).EQ.FMAP(J)) TMAP(FMAP(J))=J
   60 CONTINUE
      RETURN
   90 CONTINUE
C      WRITE(6,110)IOS,NDATE
C  110 FORMAT(' OPEN ERROR ',I3,' ON UNIT 92 FOR UA DAY ',I5)
      IERR=300+IOS
      RETURN
      END