      SUBROUTINE INITCN                                                   00001 
C                                                                         00002 
C     THIS SUBROUTINE PERFORMS INITIALIZATION FOR THE IWGDE SOFTWARE.     00003 
C     READS OR WRITES VOL1, HDR1, HDR2, AND EOF MARK OF TAPE.             00004 
C     SEE INITCN.DOC FOR MORE DETAILS.                                    00005 
C                                                                         00006 
C                                                                         00007 
      LOGICAL*1 WRITE(5),READ(5),LOWNER(14),DBUGFG(3),YES(3),LBLANK       00008 
C                                                                         00009 
      INCLUDE 'SY:BCOM.FTN'                                               00010 
      INCLUDE 'SY:FLGCM.FTN'                                              00011 
      INCLUDE 'SY:LABCM.FTN'                                              00012 
      INCLUDE 'SY:MTCOMM.FTN'                                             00013 
      INCLUDE 'SY:MTFCB.FTN'                                              00014 
C                                                                         00015 
      DATA LBLANK/1H /                                                    00016 
      DATA NBUFER/2800/                                                   00017 
      DATA WRITE(1),WRITE(2),WRITE(3),WRITE(4),WRITE(5)                   00018 
     1 /1HW,1HR,1HI,1HT,1HE/                                              00019 
      DATA READ(1),READ(2),READ(3),READ(4),READ(5)                        00020 
     1 /1HR,1HE,1HA,1HD,1H /                                              00021 
      DATA VOL1/4HVOL1/                                                   00022 
      DATA LOWNER(1),LOWNER(2),LOWNER(3),LOWNER(4),LOWNER(5),             00023 
     1 LOWNER(6),LOWNER(7),LOWNER(8),LOWNER(9),LOWNER(10),                00024 
     2 LOWNER(11),LOWNER(12),LOWNER(13),LOWNER(14)                        00025 
     3 /1HP,1HD,1HP,1H1,1H1,1HI,1HW,1HG,1HD,1HE,1HT,1HA,1HP,1HE/          00026 
      DATA YES(1),YES(2),YES(3)/1HY,1HE,1HS/                              00027 
C                                                                         00028 
      CALL ASNLUN(6,'TO',0)                                               00029 
      TTLUN=6                                                             00030 
      CALL ASNLUN(1,'MM',0)                                               00031 
      MTLUN=1                                                             00032 
C                                                                         00033 
CC    INITIALIZE ARRAYS                                                   00034 
C                                                                         00035 
      LABFLG = 0                                                          00036 
      IBCT=0                                                              00037 
      IBCH=0                                                              00038 
      DO 32758 I=1,6                                                      00039 
      VSNLST(I)= LBLANK                                                   00039 
32758 CONTINUE                                                            00039 
      DO 32757 I=1,80                                                     00040 
      LBUFR(I) = LBLANK                                                   00040 
32757 CONTINUE                                                            00040 
      DO 32756 I=1,17                                                     00041 
      DDFNAM(I) = LBLANK                                                  00042 
      DFNAME(I) = LBLANK                                                  00043 
32756 CONTINUE                                                            00044 
      KTBLK = 0                                                           00045 
      KTFILE = 1                                                          00046 
      DEBUG = .FALSE.                                                     00047 
      TYPE 13                                                             00048 
13    FORMAT (' IS THIS A DEBUG?> ',$)                                    00049 
      ACCEPT 14, DBUGFG                                                   00050 
14    FORMAT (3A1)                                                        00051 
      CALL STRCOM (DBUGFG,YES,3,IRET)                                     00052 
      IF (IRET .EQ. 0) DEBUG = .TRUE.                                     00053 
C                                                                         00054 
CC    IDENTIFY ROUTINE                                                    00055 
C                                                                         00056 
      IF (DEBUG) TYPE 1                                                   00057 
1     FORMAT (' INITCN')                                                  00058 
      TYPE 2                                                              00059 
2     FORMAT(' DO YOU WANT TO READ OR WRITE A TAPE?> ',$)                 00060 
      ACCEPT 3, TYPE                                                      00061 
3     FORMAT(5A1)                                                         00062 
      CALL STRCOM (TYPE,READ,5,IRET)                                      00063 
      IF(.NOT.(IRET .EQ. 0)) GO TO 32755                                  00064 
      TYPE 15                                                             00065 
15    FORMAT (' IF READ, WHICH FILE?> ',$)                                00066 
      ACCEPT 16, NFILE                                                    00067 
16    FORMAT (I3)                                                         00068 
32755 TYPE 4                                                              00070 
4     FORMAT(' ENTER VSNLST (UP TO SIX CHARACTERS)> ',$)                  00071 
      ACCEPT 5, VSNLST                                                    00072 
5     FORMAT(6A1)                                                         00073 
      TYPE 6                                                              00074 
6     FORMAT(' ENTER DDF NAME (UP TO SEVENTEEN CHARACTERS)> '$)           00075 
      ACCEPT 7, DDFNAM                                                    00076 
7     FORMAT (17A1)                                                       00077 
      TYPE 8                                                              00078 
8     FORMAT (' ENTER DF NAME (UP TO SEVENTEEN CHARACTERS)> '$)           00079 
      ACCEPT 7, DFNAME                                                    00080 
C                                                                         00081 
C **  CHECK TYPE FLAG                                                     00082 
C                                                                         00083 
      CALL STRCOM (TYPE,WRITE,5,IRET)                                     00084 
      IF(IRET.EQ.0) GO TO 32754                                           00085 
      CALL STRCOM (TYPE,READ,5,IRET)                                      00086 
      IF(IRET.EQ.0) GO TO 32753                                           00087 
      TYPE 9, (TYPE(L), L=1,5)                                            00088 
9     FORMAT(' ** TYPE FLAG IN ERROR ',5A1)                               00089 
      ASSIGN 32751 TO I32752                                              00090 
      GO TO 32752                                                         00090 
32751 CONTINUE                                                            00091 
C                                                                         00092 
C **  OPEN FILE FOR INPUT                                                 00093 
32753 ASSIGN 32749 TO I32750                                              00094 
      GO TO 32750                                                         00094 
32749 ASSIGN 32747 TO I32748                                              00095 
      GO TO 32748                                                         00095 
C                                                                         00096 
C **  READ VOL1 LABEL                                                     00097 
32747 ASSIGN 32745 TO I32746                                              00098 
      GO TO 32746                                                         00098 
32745 DO 32744 I=1,80                                                     00099 
      IVOL1(I)=LBUFR(I)                                                   00099 
32744 CONTINUE                                                            00099 
C                                                                         00100 
C **  VERIFY VOL1 RECORD                                                  00101 
      CALL STRCOM (BUFR(1),VOL1,4,IRET)                                   00102 
      IF(IRET.EQ.0) GO TO 32743                                           00103 
      TYPE 10, BUFR(1)                                                    00104 
10    FORMAT(' *VOL1* RECORD NOT FOUND, FOUND INSTEAD WAS ',A4/)          00105 
      ASSIGN 32742 TO I32752                                              00106 
      GO TO 32752                                                         00106 
32742 CONTINUE                                                            00107 
C                                                                         00108 
CC    VERIFY VOLUME IDENTIFIER                                            00109 
C                                                                         00110 
32743 CALL STRCOM(LBUFR(5),VSNLST(1),6,IRET)                              00111 
      IF(IRET.EQ.0 ) GO TO 32741                                          00112 
      TYPE 11, (VSNLST(K),K=1,6), (LBUFR(L),L=5,10)                       00113 
11    FORMAT(' VOLUME IDENTIFIER IS NOT AS EXPECTED'/                     00114 
     1 ' EXPECTED VALUE:  ',6A1,10X,' TAPE VALUE:  ',6A1/)                00115 
      ASSIGN 32740 TO I32752                                              00116 
      GO TO 32752                                                         00116 
32740 CONTINUE                                                            00117 
C                                                                         00118 
CC    SKIP TO FILE N                                                      00119 
C                                                                         00120 
32741 CALL FINDFL (NFILE)                                                 00121 
C                                                                         00122 
C **  READ HEADER RECORDS 1 AND 2                                         00123 
      CALL RHDR12(IFLAG)                                                  00124 
      IF (DEBUG) TYPE 1                                                   00125 
      IF(IFLAG.EQ.0) GO TO 32739                                          00126 
      TYPE 12                                                             00127 
12    FORMAT(' *PREMATURE END-OF-TAPE'/)                                  00128 
      ASSIGN 32738 TO I32752                                              00129 
      GO TO 32752                                                         00129 
32738 CONTINUE                                                            00130 
C                                                                         00131 
C **  END OF READ                                                         00132 
32739 RETURN                                                              00133 
C                                                                         00135 
C **  OPEN FILE FOR OUTPUT                                                00136 
C                                                                         00137 
32754 ASSIGN 32737 TO I32750                                              00138 
      GO TO 32750                                                         00138 
32737 ASSIGN 32736 TO I32748                                              00139 
      GO TO 32748                                                         00139 
C                                                                         00140 
CC    VERIFY THAT THE RIGHT TAPE IS MOUNTED BEFORE WRITING                00141 
C                                                                         00142 
CC    READ VOL1 LABEL                                                     00143 
C                                                                         00144 
32736 ASSIGN 32735 TO I32746                                              00145 
      GO TO 32746                                                         00145 
C                                                                         00146 
CC    VERIFY VOLUME IDENTIFIER                                            00147 
C                                                                         00148 
32735 CALL STRCOM (LBUFR(5),VSNLST(1),6,IRET)                             00149 
      IF(IRET .EQ. 0) GO TO 32734                                         00150 
      TYPE 11, (VSNLST(K),K=1,6), (LBUFR(L),L=5,10)                       00151 
      ASSIGN 32733 TO I32752                                              00152 
      GO TO 32752                                                         00152 
32733 CONTINUE                                                            00153 
32734 ASSIGN 32732 TO I32748                                              00154 
      GO TO 32748                                                         00154 
C                                                                         00155 
CC    WRITE A VOL1 LABEL                                                  00156 
C                                                                         00157 
32732 CALL STRMOV (VOL1,LBUFR(1),4)                                       00158 
      DO 32731 I=1,6                                                      00159 
      LBUFR(I+4) = VSNLST(I)                                              00159 
32731 CONTINUE                                                            00159 
      DO 32730 I=1,14                                                     00160 
      LBUFR(I+37) = LOWNER(I)                                             00160 
32730 CONTINUE                                                            00160 
      LBUFR(80) = '1'                                                     00161 
      NBUFER = 80                                                         00162 
      IBUFER = 1                                                          00163 
      ASSIGN 32728 TO I32729                                              00164 
      GO TO 32729                                                         00164 
C                                                                         00165 
CC    WRITE D(D)F HDR1 & HDR2 LABELS                                      00166 
C                                                                         00167 
32728 CALL WHDR12                                                         00168 
      IF (DEBUG) TYPE 1                                                   00169 
      RETURN                                                              00170 
32750 CONTINUE                                                            00171 
      CALL MTATT(MTLUN,ISTAT)                                             00172 
      IF(.NOT.(MTERRL)) GO TO 32727                                       00173 
      ASSIGN 32725 TO I32726                                              00173 
      GO TO 32726                                                         00173 
32725 CONTINUE                                                            00173 
32727 GO TO I32750                                                        00174 
32748 CONTINUE                                                            00175 
      CALL MTRWD(MTLUN,ISTAT)                                             00176 
      IF(.NOT.(MTERRL)) GO TO 32724                                       00177 
      ASSIGN 32722 TO I32723                                              00177 
      GO TO 32723                                                         00177 
32722 CONTINUE                                                            00177 
32724 GO TO I32748                                                        00178 
32746 CONTINUE                                                            00179 
      ASSIGN 32720 TO I32721                                              00179 
      GO TO 32721                                                         00179 
32720 GO TO I32746                                                        00179 
32721 CONTINUE                                                            00180 
      MAGERR = .FALSE.                                                    00181 
      NBUFER=2800                                                         00182 
      CALL MTRLB(MTLUN,LBUFR,NBUFER,ISTAT)                                00183 
      IF(.NOT.(ISTAT.EQ.0)) GO TO 32719                                   00184 
      MAGEND = .FALSE.                                                    00185 
      NBUFER = MTIOS(2)                                                   00186 
32719 IF(.NOT.(ISTAT.EQ.1)) GO TO 32718                                   00188 
      ASSIGN 32716 TO I32717                                              00188 
      GO TO 32717                                                         00188 
32716 CONTINUE                                                            00188 
32718 IF(.NOT.(ISTAT.EQ.2)) GO TO 32715                                   00189 
      IF(.NOT.(MTIOS(1).NE.MTEOFS)) GO TO 32713                           00190 
      ASSIGN 32712 TO I32717                                              00190 
      GO TO 32717                                                         00190 
32712 GO TO 32714                                                         00190 
32713 MAGEND = .TRUE.                                                     00191 
32714 CONTINUE                                                            00192 
32715 GO TO I32721                                                        00193 
32729 CONTINUE                                                            00194 
      ASSIGN 32710 TO I32711                                              00194 
      GO TO 32711                                                         00194 
32710 GO TO I32729                                                        00194 
32711 CONTINUE                                                            00195 
      MAGERR = .FALSE.                                                    00196 
      CALL MTWLB(MTLUN,LBUFR(IBUFER),NBUFER,ISTAT)                        00197 
      IF(.NOT.(MTERRL)) GO TO 32709                                       00198 
      ASSIGN 32707 TO I32708                                              00198 
      GO TO 32708                                                         00198 
32707 CONTINUE                                                            00198 
32709 GO TO I32711                                                        00199 
32726 CONTINUE                                                            00200 
      CALL ERROR(TTLUN,'ATTACH MAGTAPE FAILED',MTDSW,MTIOS)               00201 
      ASSIGN 32705 TO I32706                                              00202 
      GO TO 32706                                                         00202 
32705 GO TO I32726                                                        00203 
32723 CONTINUE                                                            00204 
      CALL ERROR(TTLUN,'REWIND MAGTAPE FAILED',MTDSW,MTIOS)               00205 
      ASSIGN 32704 TO I32706                                              00206 
      GO TO 32706                                                         00206 
32704 GO TO I32723                                                        00207 
32717 CONTINUE                                                            00208 
      CALL ERROR (TTLUN,'READ MAGTAPE FAILED',MTDSW,MTIOS)                00209 
      ASSIGN 32703 TO I32706                                              00210 
      GO TO 32706                                                         00210 
32703 GO TO I32717                                                        00211 
32708 CONTINUE                                                            00212 
      CALL ERROR (TTLUN,'WRITE MAGTAPE FAILED',MTDSW,MTIOS)               00213 
      ASSIGN 32702 TO I32706                                              00214 
      GO TO 32706                                                         00214 
32702 GO TO I32708                                                        00215 
32706 CONTINUE                                                            00216 
      MAGERR = .TRUE.                                                     00217 
      GO TO I32706                                                        00218 
32752 CONTINUE                                                            00219 
      IABORT = 1                                                          00220 
      IF (IABORT .EQ. 1) STOP                                             00221 
      GO TO I32752                                                        00222 
      END                                                                 00223 
