      SUBROUTINE RDREC(ISTAT)                                             00001 
C                                                                         00002 
C          THIS SUBROUTINE STARTS LOADING OF THE NEXT LOGICAL RECORD      00003 
C        ON THE FILE.  THE LEADER AND TAG TABLE ARE LOADED.               00004 
C                                                                         00005 
C          CALLING SEQUENCE                                               00006 
C                                                                         00007 
C            CALL RDREC(ISTAT)                                            00008 
C                                                                         00009 
C              ISTAT - STATUS ON COMPLETION,  0 = NO ERRORS               00010 
C                                            -1 = END OF DF               00011 
C                                            -2 = ERRORS IN LOADING       00012 
C                                                                         00013 
C            CALL DMPDDF(ISTAT)                                           00014 
C                                                                         00015 
C              ISTAT - STATUS ON COMPLETION,  0 = NO ERRORS               00016 
C                                            -1 = ERROR IN DUMPING        00017 
C                                                                         00018 
      INCLUDE 'SY:BCOM.FTN'                                               00019 
      INCLUDE 'SY:FLGCM.FTN'                                              00020 
      INCLUDE 'SY:LDCOM.FTN'                                              00021 
      INCLUDE 'SY:TTCOM.FTN'                                              00022 
      INCLUDE 'SY:MTCOMM.FTN'                                             00023 
      LOGICAL*1 ITMP                                                      00024 
      DIMENSION  JCHR(60)                                                 00025 
      LOGICAL  DMP                                                        00026 
C                                                                         00027 
      DATA  IZERO  / 2H00/ ,  I08  / 2H08/                                00028 
      DATA  RFILE /3HDDF/, DMP /.FALSE./                                  00029 
      DATA LIMTAG /50/                                                    00030 
C                                                                         00031 
  100 ISTAT = 0                                                           00032 
      ICUR=0                                                              00033 
      IRCH=0                                                              00034 
C                                                                         00035 
C          READ LEADER                                                    00036 
C                                                                         00037 
      CALL GETLDR(RFILE)                                                  00038 
      IF (SPAN .LT. 0)  GO TO 900                                         00039 
      IF (.NOT. DEBUG)  GO TO 170                                         00040 
      PRINT 9200,IRCT,SPAN,ISSC,ICSC,IFCC,IBAS,LTAG,LLOF,LSCP             00041 
  170 IF (.NOT. FAIL)  GO TO 180                                          00042 
      PRINT 9205                                                          00043 
      IFAIL = 1                                                           00044 
      FAIL = .FALSE.                                                      00045 
C                                                                         00046 
C          GET TAG TABLE AND PRINT IT                                     00047 
C                                                                         00048 
  180 CALL GETAGS                                                         00049 
  190 IF (.NOT. FAIL)  GO TO 200                                          00050 
      PRINT 9205                                                          00051 
      FAIL = .FALSE.                                                      00052 
      IFAIL = 1                                                           00053 
C                                                                         00054 
C          PRINT DATA FOR EACH TAG                                        00055 
C                                                                         00056 
  200 IF (.NOT. DMP)  GO TO 800                                           00057 
      IF (IFCC .NE. IZERO) GOTO 400                                       00058 
C                                                                         00059 
C          UNSTRUCTURED DATA                                              00060 
C                                                                         00061 
      IF(.NOT.(ITTL .GE. LIMTAG)) GO TO 32758                             00062 
      ASSIGN 32756 TO I32757                                              00062 
      GO TO 32757                                                         00062 
32756 CONTINUE                                                            00062 
32758 INDX = 0                                                            00063 
      DO 280  I = 1, ITTL                                                 00064 
      INDX = INDX + 1                                                     00065 
C                                                                         00066 
      IF (INDX .LE. LIMTAG)  GOTO 210                                     00067 
C                                                                         00068 
C     TAG TABLE GREATER THAN LIM TAG, READ TAGS FROM FILE                 00069 
C                                                                         00070 
      ASSIGN 32755 TO I32757                                              00071 
      GO TO 32757                                                         00071 
32755 INDX = 1                                                            00072 
  210 CONTINUE                                                            00073 
          JSCP = ISCP(INDX) + IBAS                                        00074 
          IF (IRCH .EQ. JSCP)  GO TO 220                                  00075 
          PRINT 9215,  IRCH, JSCP                                         00076 
          IF (IRCH .GT. JSCP)  STOP 'ABORT'                               00077 
          ISKP = JSCP - IRCH                                              00078 
          PRINT 9220, (NXTCHR(INDX),J=1,ISKP)                             00079 
  220     JLIM = ILOF(INDX) - 1                                           00080 
          JJLIM = JLIM                                                    00081 
          IF (JJLIM .GT. 60)  JJLIM = 60                                  00082 
          DO 230  J = 1, JJLIM                                            00083 
              JCHR(J) = NXTCHR(IDUM)                                      00084 
              IF (FTERM)  GO TO 240                                       00085 
              IF (RTERM)  GO TO 240                                       00086 
  230     CONTINUE                                                        00087 
           PRINT 9225,  ITAG(INDX), (JCHR(J),J=1,JJLIM)                   00088 
          IF (JJLIM .EQ. JLIM)  GO TO 250                                 00089 
  232     JLIM = JLIM - 60                                                00090 
          JJLIM = JLIM                                                    00091 
          IF (JJLIM .GT. 60)  JJLIM = 60                                  00092 
          DO 236  J = 1, JJLIM                                            00093 
              JCHR(J) = NXTCHR(IDUM)                                      00094 
              IF (FTERM .OR. RTERM)  GO TO 240                            00095 
  236     CONTINUE                                                        00096 
          PRINT 9226,  (JCHR(J),J=1,JJLIM)                                00097 
          IF (JJLIM .EQ. JLIM)  GO TO 250                                 00098 
          GO TO 232                                                       00099 
C                                                                         00100 
C          TERMINATOR HIT BEFORE END OF FIELD                             00101 
C                                                                         00102 
  240     JLIM = J - 1                                                    00103 
           PRINT 9225,  ITAG(INDX), (JCHR(J),J=1,JLIM)                    00104 
          PRINT 9250                                                      00105 
          IF (FTERM)  GO TO 270                                           00106 
          GO TO 820                                                       00107 
  250     ITMP = NXTCHR(IDUM)                                             00108 
          IF (RTERM)  GO TO 820                                           00109 
          IF (FTERM)  GO TO 270                                           00110 
C                                                                         00111 
C          ERROR - NO FIELD TERMINATOR                                    00112 
C                                                                         00113 
          PRINT 9010                                                      00114 
          STOP 'ABORT'                                                    00115 
C                                                                         00116 
C          CLEAR FIELD TERMINATOR FLAG                                    00117 
C                                                                         00118 
  270 FTERM = .FALSE.                                                     00119 
C                                                                         00120 
C          END OF TAG DATA PRINT LOOP                                     00121 
C                                                                         00122 
  280 CONTINUE                                                            00123 
      GO TO 820                                                           00124 
C                                                                         00125 
C          STRUCTURED DATA                                                00126 
C                                                                         00127 
  400 IF (IFCC .EQ. I08 ) GOTO 410                                        00128 
C                                                                         00129 
C          ERROR - UNKNOWN FCC                                            00130 
C                                                                         00131 
      PRINT 9245,  IFCC                                                   00132 
 405  ISTAT=-2                                                            00133 
      RETURN                                                              00134 
C                                                                         00135 
C          CHECK FOR DATA FILE NAME                                       00136 
C                                                                         00137 
  410 IBEG = 1                                                            00138 
      IF (ITAG(1) .EQ. 0)  GO TO 420                                      00139 
C                                                                         00140 
C          ERROR - FIRST TAG IS NOT DATA FILE NAME                        00141 
C                                                                         00142 
      PRINT 9240,  ITAG(1)                                                00143 
      ISTAT=-2                                                            00144 
      GO TO 430                                                           00145 
C                                                                         00146 
C          PRINT DATA FILE NAME                                           00147 
C                                                                         00148 
  420 IBEG = 2                                                            00149 
      JLIM = ILOF(I) - 1                                                  00150 
       PRINT 9225,  ITAG(1) , (NXTCHR(J),J=1,JLIM)                        00151 
      ITMP = NXTCHR(IDUM)                                                 00152 
      IF (RTERM)  GO TO 405                                               00153 
      IF (FTERM)  GO TO 430                                               00154 
C                                                                         00155 
C          ERROR - NO FIELD TERMINATOR                                    00156 
C                                                                         00157 
      PRINT 9010                                                          00158 
      GO TO 405                                                           00159 
C                                                                         00160 
C          UNPACK REST OF DDF                                             00161 
C                                                                         00162 
  430 CONTINUE                                                            00163 
C                                                                         00164 
C          RETURN IF DF                                                   00165 
C                                                                         00166 
  800 IF (RFILE .EQ. 2HDF)  GO TO 1000                                    00167 
C                                                                         00168 
C          SKIP REST OF DDF                                               00169 
C                                                                         00170 
  810 ITMP = NXTCHR(IDUM)                                                 00171 
      IF (RTERM)  GO TO 820                                               00172 
      GO TO 810                                                           00173 
C                                                                         00174 
C          CHECK IF EOF                                                   00175 
C                                                                         00176 
  820 RTERM = .FALSE.                                                     00177 
C     IF (FSEP)  GO TO 900                                                00178 
C                                                                         00179 
C     CALL NXTCHR IN ORDER TO READ THE EOF MARK WHICH FOLLOWS             00180 
C     THE EOR CHARACTER AND PADDING CHARACTERS (IF PRESENT).              00181 
C                                                                         00182 
  830 ITMP = NXTCHR(IDUM)                                                 00183 
      IF (IFAIL .EQ. 0)  GO TO 850                                        00184 
      IF (.NOT. DMP)  GO TO 840                                           00185 
      PRINT 9300, ILIM,(IBLK(I),IBLK(I+1),IBLK(I+2),IBLK(I+3),            00186 
     1IBLK(I+4),                                                          00187 
     1            IBLK(I+5),IBLK(I+6),IBLK(I+7),IBLK(I+8),IBLK(I+9),      00188 
     2            IBLK(I),IBLK(I+1),IBLK(I+2),IBLK(I+3),IBLK(I+4),        00189 
     3            IBLK(I+5),IBLK(I+6),IBLK(I+7),IBLK(I+8),IBLK(I+9),      00190 
     4            I=1,ILIM,4)                                             00191 
  840 IFAIL = 0                                                           00192 
  850 IF (IEOF)  GO TO 900                                                00193 
      IF(DEBUG) TYPE 9500,IEOF                                            00194 
      PRINT 9000                                                          00195 
      STOP 'ABORT'                                                        00196 
C                                                                         00197 
C          END OF FILE, CLOSE FILE                                        00198 
C                                                                         00199 
  900 FSEP = .FALSE.                                                      00200 
      IF (RFILE .EQ. 3HDDF)  GO TO 910                                    00201 
C                                                                         00202 
C     SET END OF DF STATUS.                                               00203 
C                                                                         00204 
      ISTAT=-1                                                            00205 
      GO TO 1000                                                          00206 
C                                                                         00207 
C          CHANGE LABELS, OPEN DF                                         00208 
C                                                                         00209 
  910 CALL CHGFIL                                                         00210 
      RFILE = 2HDF                                                        00211 
C                                                                         00212 
C          GET FIRST RECORD OF DF IF NOT DUMPING                          00213 
C                                                                         00214 
      IF (.NOT. DMP)  GO TO 100                                           00215 
      DMP = .FALSE.                                                       00216 
      GO TO 1000                                                          00217 
C                                                                         00218 
C          DUMP DDF                                                       00219 
C                                                                         00220 
      ENTRY DMPDDF                                                        00221 
C                                                                         00222 
      DMP = .TRUE.                                                        00223 
      GO TO 100                                                           00224 
C                                                                         00225 
C          END OF ROUTINE                                                 00226 
C                                                                         00227 
 1000 ICUR = 0                                                            00228 
      RETURN                                                              00229 
C                                                                         00230 
C          FORMATS                                                        00231 
C                                                                         00232 
 9000 FORMAT (42H DID NOT HIT EOF AT END OF DDF, WILL ABORT)              00233 
 9010 FORMAT (45H DATA FIELD IMPROPERLY TERMINATED, WILL ABORT)           00234 
C                                                                         00235 
 9200 FORMAT ('0BLOCK COUNT IS ',I4,', SPAN IS ',I5,                      00236 
     1       /' SUBSYSTEM IS ',A1,', CHARACTER SET IS ',A1,               00237 
     2       /' FIELD CONTROL IS ',A1,', BASE ADDRESS IS ',I5,            00238 
     3       /' LENGTHS ARE: TAG ',I1,', LOF ',I1,', SCP ',I1)            00239 
 9205 FORMAT (27H FAILURE NOTED ON THIS PASS)                             00240 
 9215 FORMAT (' GETREC ** CHRPTR IS ',I4,12H, SHOULD BE ,I4)              00241 
 9220 FORMAT ('0CHARACTERS SKIPPED: ' 30A1)                               00242 
 9225 FORMAT ('0DATA FOR TAG ',A7,' IS: ',(5X,60A1))                      00243 
 9226 FORMAT (26X,60A1)                                                   00244 
 9235 FORMAT (16H0ERROR - IRCT = ,I4,9H, IRCH = ,I4)                      00245 
 9240 FORMAT (41H0ERROR - NO DATA BASE NAME, FIRST TAG IS ,A7)            00246 
 9245 FORMAT ('0ERROR - INVALID FIELD CONTROL COUNT - ',1A1)              00247 
 9250 FORMAT (' ABOVE FIELD TERMINATED BEFORE FIELD COUNT EHXAUSTED. ',   00248 
     1        'END OF FIELD ASSUMED.')                                    00249 
C                                                                         00250 
 9300 FORMAT (29H1DUMP OF BLOCK WITH FAILURE, ,I5,7H WORDS.,//,           00251 
     1        (10O7,4X,10A5,/))                                           00252 
 9500 FORMAT(' IEOF = ',O6)                                               00253 
C                                                                         00254 
C                                                                         00255 
C                                                                         00256 
C     M T R E A D . F L X                                                 00257 
C                                                                         00258 
C                                                                         00259 
C     NOTE ** INCLUDE MTFCB.FTN COMMON DEFINITION                         00260 
C     MAGTAPE PROCEDURES TO READ A TAPE                                   00261 
C                                                                         00262 
C                                                                         00263 
32757 CONTINUE                                                            00264 
      MAGERR = .FALSE.                                                    00265 
      NBUFER=2800                                                         00266 
      CALL MTRLB( MTLUN,LBUFR,NBUFER,ISTAT )                              00267 
      IF(.NOT.( ISTAT.EQ.0 )) GO TO 32754                                 00268 
      MAGEND = .FALSE.                                                    00269 
      NBUFER = MTIOS(2)                                                   00270 
32754 IF(.NOT.( ISTAT.EQ.1 )) GO TO 32753                                 00272 
      ASSIGN 32751 TO I32752                                              00272 
      GO TO 32752                                                         00272 
32751 CONTINUE                                                            00272 
32753 IF(.NOT.( ISTAT.EQ.2 )) GO TO 32750                                 00273 
      IF(.NOT.( MTIOS(1).NE.MTEOFS )) GO TO 32748                         00274 
      ASSIGN 32747 TO I32752                                              00274 
      GO TO 32752                                                         00274 
32747 GO TO 32749                                                         00274 
32748 MAGEND = .TRUE.                                                     00275 
32749 CONTINUE                                                            00276 
32750 GO TO I32757                                                        00277 
C                                                                         00278 
C                                                                         00279 
C*******************                                                      00280 
C                                                                         00281 
C                                                                         00282 
C     ERROR HANDLERS                                                      00283 
C                                                                         00284 
C                                                                         00285 
32752 CONTINUE                                                            00286 
      CALL ERROR( TTLUN,'READ MAGTAPE FAILED',MTDSW,MTIOS )               00287 
      ASSIGN 32745 TO I32746                                              00288 
      GO TO 32746                                                         00288 
32745 GO TO I32752                                                        00289 
C                                                                         00290 
C                                                                         00291 
C                                                                         00292 
C                                                                         00293 
32744 CONTINUE                                                            00294 
      CALL MTDET( MTLUN,ISTAT )                                           00295 
      CALL EXIT                                                           00296 
      GO TO I32744                                                        00297 
C                                                                         00298 
C                                                                         00299 
32743 CONTINUE                                                            00300 
      CONTINUE                                                            00301 
      GO TO I32743                                                        00302 
C                                                                         00303 
C                                                                         00304 
32746 CONTINUE                                                            00305 
      MAGERR = .TRUE.                                                     00306 
      GO TO I32746                                                        00307 
      END                                                                 00308 
