C Copyright(c) 1997, Space Science and Engineering Center, UW-Madison
C Refer to "McIDAS Software Acquisition and Distribution Policies"
C in the file  mcidas/data/license.txt

C *** $Id: getrte.f,v 1.16 1997/10/10 20:17:07 dglo Exp $ ***

C     GETRTE: get routing code entry for specified code
C           INUM (I) - default SSEC product destination #
C           ONUM (I) - new product destination #
C           CTEXT (C) - new product name (if LW file)
C           func value- =0 = NO TABLE -- file product using defaults
C                       >0 = file product using values in RTECOM
C                       <0 = do not file product
C

      FUNCTION GETRTE(INUM,ONUM,CTEXT)
      IMPLICIT INTEGER(A-B,D-Z)
      IMPLICIT CHARACTER*12 (C)

      CHARACTER*2 CNAMES
      CHARACTER*4 CLIT

      PARAMETER (ENTWRD=64)
      PARAMETER (OFFSET=128)
      PARAMETER (MAXNAM=256)

      COMMON/RTECOM/ RSTAT,RPROD,RTYPE,RBEG,REND,rnow,RCDAY,RCTIM,
     &               RRDAY,RRTIM,RMEMO(8),RPOST(3),RMASK(3),RTEXT(3),
     &               rcond,rlast,rltxt(3),rxcut,rsysb,rsyse,rsysc,
     &               RDUM(28)

C     WORD(S)  NAME    DESCRIPTION
C       1      RSTAT   ROUTING STATUS 0=SUSpended , 1=RELeased
C       2      RPROD   PROUDUCT NAME
C       3      RTYPE   PROUDUCT TYPE (AREA,MD,GRID,TEXT)
C       4      RBEG    CYLINDER BEGINING NUMBER
C       5      REND    CYLINDER ENDING NUMBER
C       6      rnow    Current product number filed in cylinder
C       7      RCDAY   CREATE DAY (YYDDD)
C       8      RCTIM   CREATE TIME (HHMMSS)
C       9      RRDAY   RECEIVE DAY (YYDDD)
C      10      RRTIM   RECEIVE TIME (HHMMSS)
C     11-18    RMEMO   MEMO FIELD (32 CHARACTER)
C     19-21    RPOST   BATCH FILE NAME FOR POST PROCESS
C     22-24    RMASK   TEXT FILE NAME MASK FOR TYPE=TEXT
C     25-27    RTEXT   LAST TEXT FILE NAME CREATED
C      28      rcond   Decoder condition code (1-7 , def=1)
C      29      rlast   Last successful product number (defined by rcond)
C     30-32    rltxt   Last successful text file name (defined by rcond)
C      33      rxcut   Execute Post Process batch file based on rcond
C      34      rsysb   if >0 -- SYSKEY index for beginning cylinder number
C      35      rsyse   if >0 -- SYSKEY index for ending cylinder number
C      36      rsysc   if >0 -- SYSKEY index for current cylinder number
C     37-64    RDUM    RESERVED

      DIMENSION CNAMES(MAXNAM),NAMES(OFFSET)

      EQUIVALENCE (CNAMES,NAMES)

      DATA CFILE/'ROUTE.SYS'/

C--- SET INITIAL RETURN CODE -- TAKE DEFAULT
      GETRTE=0
      ONUM=INUM
      CNAME=' '

C--- CHECK EXISTANCE OF ROUTING TABLE
      IF(LWFILE(CFILE).EQ.0) RETURN

C--- GET THE PRODUCT/CREATE DATE/CREATE TIME FROM KEYIN
      CPROD=CKWP('DIALPROD',1,' ')

C--- LOCK THE FILE
      CALL LOCK(CFILE)

C--- GET NAME TABLE
      VAL = LWI(CFILE,0,OFFSET,NAMES)

C--- SCAN TABLE FOR MATCHING PRODUCT ID
      DO 10 I=1,MAXNAM
      IF(CPROD(1:2).EQ.CNAMES(I)(1:2)) THEN

            GETRTE = -1

C--- DETERMINE THE POINTER TO THE PRODUCT ENTRY AND READ THE ENTRY
            PTR = (I-1)*ENTWRD+OFFSET
            VAL = LWI(CFILE,PTR,ENTWRD,RSTAT)

            IF(RSTAT.NE.0) THEN

C--- PRODUCT IS RELEASED (ACTIVE)
               GETRTE=I

C--- PRODUCT CREATE DAY AND TIME
               RCDAY=IKWP('DIALPROD',2,0)
               RCTIM=IKWP('DIALPROD',3,0)
               CDAY=CFU(RCDAY)
               CTIM=CFJ(RCTIM)
               CALL SDEST('PRODUCT CODE='//CPROD//CDAY//CTIM(7:12),0)

C--- PRODUCT RECEIVE DAY AND TIME
               CALL GETDAY(RRDAY)
               CALL GETTIM(RRTIM)

               IF(RBEG.EQ.-1.AND.REND.EQ.-1) THEN
C--- USE THE DEFAULT

                 rnow = INUM
                 ONUM = INUM
                 CALL MOVWC(rmask,cmask)
                 if(cmask(1:1) .ne. ' ') ctext = cmask
                 call movcw(ctext,rtext)

               ELSE

C--- CYLINDER IS DEFINED: COMPUTE THE NEW NUMBER
                 IF(rnow.EQ.-1) THEN
                    rnow=RBEG
                 ELSE
                    rnow=rnow+1
                    IF(rnow.GT.REND) rnow=RBEG
                 ENDIF

                 ONUM = rnow

                 CTYPE=CLIT(RTYPE)
                 IF(CTYPE(1:4).EQ.'TEXT') THEN
                    CALL MOVWC(RMASK,CMASK)
                    if(cmask(1:1) .eq. ' ') cmask = ctext
                    LEN=NCHARS(CMASK,IB,IE)
                    CNUM=CFJ(ONUM)
                    CTEXT=CMASK(IB:IE)//'.'//CNUM(10:12)
                    CALL MOVCW(CTEXT,RTEXT)
                 ENDIF

               ENDIF
            ENDIF

            GOTO 999
      ENDIF
10    CONTINUE

C--- UNLOCK THE FILE
999   CALL UNLOCK(CFILE)

      RETURN
      END
