      SUBROUTINE FETNXT(JSTAT,JTAG,JDATA,JCHCT)                           00001 
C                                                                         00002 
C          THIS SUBROUTINE RETURNS THE CONTENTS (OR PARTIAL CONTENTS)     00003 
C        OF A DATA FIELD EACH TIME IT IS CALLED.                          00004 
C                                                                         00005 
C          CALLING SEQUENCES:                                             00006 
C                                                                         00007 
C          CALL FETNXT(JSTAT,JTAG,JDATA,JCHCT)                            00008 
C                                                                         00009 
C            THIS ENTRY RETURNS THE FIRST JCHCT CHARACTERS OF THE NEXT    00010 
C          DATA FIELD IN THE CURRENT RECORD EACH TIME IT IS CALLED.       00011 
C                                                                         00012 
C            JCHCT - INPUT  - MAXIMUM NUMBER OF CHARACTERS TO BE          00013 
C                             RETURNED.                                   00014 
C                                                                         00015 
C                    OUTPUT - NUMBER OF CHARACTERS ACTUALLY RETURNED.     00016 
C                                                                         00017 
C            JDATA - OUTPUT - ARRAY CONTAINING THE DATA RETURNED, TEN     00018 
C                             CHARACTERS PER WORD.                        00019 
C                                                                         00020 
C            JSTAT - OUTPUT - INDICATES STATUS OF LAST REQUEST.           00021 
C                                                                         00022 
C                              0 = NO ERRORS                              00023 
C                                                                         00024 
C                             -1 = NO MORE FIELDS (END OF RECORD).        00025 
C                                                                         00026 
C                             -2 = MORE CHARACTERS IN DATA FIELD          00027 
C                                                                         00028 
C            JTAG  - OUTPUT - TAG NUMBER OF FIELD BEING RETURNED.         00029 
C                                                                         00030 
C                                                                         00031 
C          CALL FETMOR(JSTAT,JTAG,JDATA,JCHCT)                            00032 
C                                                                         00033 
C            THIS ENTRY RETURNS THE NEXT JCHCT CHARACTERS FROM THE        00034 
C          CURRENT DATA FIELD.  THE PARAMETERS ARE THE SAME AS IN THE     00035 
C          CALL TO FETNXT.                                                00036 
C                                                                         00037 
C                                                                         00038 
      INCLUDE 'SY:BCOM.FTN'                                               00039 
      INCLUDE 'SY:FLGCM.FTN'                                              00040 
      INCLUDE 'SY:LDCOM.FTN'                                              00041 
      INCLUDE 'SY:TTCOM.FTN'                                              00042 
      INCLUDE 'SY:MTCOMM.FTN'                                             00043 
C                                                                         00044 
C                                                                         00045 
      LOGICAL*1 JDATA(JCHCT),ITEMP(80),ITMP                               00046 
      REAL*8 JTAG                                                         00047 
C                                                                         00048 
C     ITS IS THE LOCAL DATA BUFFER SIZE TO WHICH ITMP IS DIMENSIONED      00049 
C                                                                         00050 
      DATA ITS/80/                                                        00051 
      DATA  ICUR /0/,  INDX /0/                                           00052 
      DATA LIMTAG /50/                                                    00053 
       IF(DEBUG) TYPE 8000                                                00054 
8000  FORMAT(' FETNXT')                                                   00055 
C                                                                         00056 
C          PRESET                                                         00057 
C                                                                         00058 
      JJSTAT=0                                                            00059 
      NLIM=1                                                              00060 
      IF (ITTL .LT. LIMTAG)  GO TO 110                                    00061 
C                                                                         00062 
C     IF TAG TABLE LARGER THAN LIMTAG, READ TAGS FROM FILE                00063 
      IF (IRCH .NE. IBAS)  GO TO 110                                      00064 
C                                                                         00065 
100   STOP ' FETNXT. TAGLIM EXCEEDED'                                     00066 
C                                                                         00067 
  110 JSTAT = 0                                                           00068 
      ICUR = ICUR + 1                                                     00069 
      IF (ICUR .GT. ITTL)  GO TO 800                                      00070 
      INDX = INDX + 1                                                     00071 
      IF (INDX .GT. LIMTAG)  ICUR = ICUR - 1                              00072 
      IF (INDX .GT. LIMTAG)  GO TO 100                                    00073 
      JTAG = ITAG(INDX)                                                   00074 
C                                                                         00075 
C          GET DATA FIELD PARAMETERS                                      00076 
C                                                                         00077 
      JSCP = ISCP(INDX) + IBAS                                            00078 
      IF (IRCH .EQ. JSCP)  GO TO 200                                      00079 
C                                                                         00080 
C          POINTER ERROR                                                  00081 
C                                                                         00082 
      PRINT 9000,  IRCH, JSCP                                             00083 
      IF (IRCH .GT. JSCP)  STOP 'ABORT'                                   00084 
C                                                                         00085 
C          SKIP CHARACTERS                                                00086 
C                                                                         00087 
  200 KLIM = ILOF(INDX) - 1                                               00088 
      IF (KLIM .GT. JCHCT)  GO TO 300                                     00089 
      IF(JCHCT.GT.KLIM) JCHCT=KLIM                                        00090 
204   IF(KLIM.GT.ITS) GO TO 400                                           00091 
      IF (JSTAT .EQ. -2)  GO TO 900                                       00092 
C                                                                         00093 
C                                                                         00094 
C     GET THE NEXT KLIM CHARACTERS OR UNTIL (RTERM)                       00095 
C                                                                         00096 
210   DO 220 I=1,KLIM                                                     00097 
      ITEMP(I)= NXTCHR(IDUM)                                              00098 
      JFIN=I                                                              00099 
      IF (RTERM) GOTO 240                                                 00100 
  220   CONTINUE                                                          00101 
C     MOVE JFIN CHARACTERS TO THE USER'S ARRAY                            00102 
C                                                                         00103 
240   CONTINUE                                                            00104 
      CALL STRMOV(ITEMP,JDATA(NLIM),JFIN)                                 00105 
C                                                                         00106 
C     ADJUST POINTER TO USERS ARRAY                                       00107 
C                                                                         00108 
      IF(JJSTAT.EQ.-3) NLIM=NLIM+ITS                                      00109 
C                                                                         00110 
C     FIND NUMBER OF CHARACTERS REMAINING TO TRANSFER.  IF THIS IS MORE   00111 
C     THAN A BUFFER FULL LIMIT IT TO SUCH.                                00112 
C                                                                         00113 
      IF(JJSTAT.EQ.-3) KLIM=MIN0(ITS,(KSAV-NLIM+1))                       00114 
C                                                                         00115 
C     IF DATA REMAINS TO TRANSFER DO SO.                                  00116 
C                                                                         00117 
      IF(JJSTAT.EQ.-3.AND.KLIM.GT.0) GO TO 210                            00118 
      IF (RTERM)  GO TO 259                                               00119 
C                                                                         00120 
C          PASS TERMINATOR                                                00121 
C                                                                         00122 
      IF (FTERM)  PRINT 9020                                              00123 
      FTERM = .FALSE.                                                     00124 
      IF(JSTAT.EQ.-2) GO TO 260                                           00125 
      ITMP = NXTCHR(IDUM)                                                 00126 
      IF (FTERM)  GO TO 255                                               00127 
      IF (RTERM)  GO TO 260                                               00128 
C                                                                         00129 
C          ERROR - FIELD IMPROPERLY TERMINATED                            00130 
C                                                                         00131 
      PRINT 9010,  JTAG, ITMP                                             00132 
      PRINT 9030                                                          00133 
      JK = 1                                                              00134 
  270 ITMP = NXTCHR(IDUM)                                                 00135 
      JK = JK + 1                                                         00136 
      IF (RTERM)  GO TO 260                                               00137 
      GO TO 270                                                           00138 
C                                                                         00139 
C          CLEAR FIELD TERMINATOR FLAG                                    00140 
C                                                                         00141 
  255 FTERM = .FALSE.                                                     00142 
      GO TO 900                                                           00143 
C                                                                         00144 
C          CLEAR RECORD TERMINATOR FLAG                                   00145 
C                                                                         00146 
  259 PRINT 9040                                                          00147 
  260 RTERM = .FALSE.                                                     00148 
      FTERM = .FALSE.                                                     00149 
      FSEP = .FALSE.                                                      00150 
      IF (JK .GT. 1)  PRINT 9050, JK                                      00151 
      JK = 0                                                              00152 
      ICUR = ITTL                                                         00153 
      INDX = 0                                                            00154 
      IF(DEBUG) TYPE 9060, ITMP                                           00155 
      ITMPOL=ITMP                                                         00156 
      GO TO 900                                                           00157 
C                                                                         00158 
C          SET UP FOR PARTIAL TRANSFER                                    00159 
C                                                                         00160 
  300 LIMSV = KLIM - JCHCT                                                00161 
      KLIM = JCHCT                                                        00162 
      JSTAT = -2                                                          00163 
      GO TO 204                                                           00164 
C                                                                         00165 
C     SET UP FOR TRANSFER OF MORE THAN ONE ITEMP BUFFER FULL OF DATA      00166 
C                                                                         00167 
  400 KSAV=KLIM                                                           00168 
      KLIM=ITS                                                            00169 
      JJSTAT=-3                                                           00170 
      GO TO 210                                                           00171 
C                                                                         00172 
C          FETMOR ENTRY (JSTAT,JTAG,JDATA,JCHCT)                          00173 
C                                                                         00174 
      ENTRY FETMOR  (JSTAT,JTAG,JDATA,JCHCT)                              00175 
      IF(DEBUG) TYPE 8001                                                 00176 
8001  FORMAT(' FETMOR')                                                   00177 
C                                                                         00178 
      JSTAT = 0                                                           00179 
      JJSTAT=0                                                            00180 
      KLIM = LIMSV                                                        00181 
      NLIM=1                                                              00182 
      IF (KLIM .GT. JCHCT)  GO TO 300                                     00183 
      IF(JCHCT.GT.KLIM) JCHCT=KLIM                                        00184 
      GO TO 204                                                           00185 
C                                                                         00186 
C       ALL FIELDS EXTRACTED, RETURN END OF RECORD                        00187 
C                                                                         00188 
  800 JSTAT = -1                                                          00189 
C                                                                         00190 
C          END OF ROUTIME                                                 00191 
C                                                                         00192 
  900 RETURN                                                              00193 
C                                                                         00194 
C          FORMATS                                                        00195 
C                                                                         00196 
 9000 FORMAT (' GETFLD ** CHRPTR IS',I4,12H, SHOULD BE ,I4)               00197 
 9010 FORMAT (16H ERROR - AT TAG ,A7,14H CHARACTER IS ,O3,                00198 
     1        22H, SHOULD BE TERMINATOR)                                  00199 
 9020 FORMAT (50H  FIELD TERMINATOR HIT PREMATURELY   WILL CONTINUE)      00200 
 9030 FORMAT (54H TERMINATOR OUT OF PLACE: SKIP THE REST OF THIS RECORD)  00201 
 9040 FORMAT (57H RECORD TERMINATOR HIT PREMATURELY:  ASSUME END OF RECO  00202 
     1RD)                                                                 00203 
 9050 FORMAT (9H SKIPPED ,I5,11H CHARACTERS)                              00204 
 9060 FORMAT(' ITMP = ',I3)                                               00205 
      END                                                                 00206 
