      SUBROUTINE WEOF12                                                   00001 
C                                                                         00002 
CC    THIS SUBROUTINE WRITES EOF1 & EOF2 LABELS                           00003 
C                                                                         00004 
      LOGICAL*1 LBLANK,LYYDDD(6)                                          00005 
      DIMENSION SYSCOD(3)                                                 00006 
C                                                                         00007 
      INCLUDE 'SY:BCOM.FTN'                                               00008 
      INCLUDE 'SY:FLGCM.FTN'                                              00009 
      INCLUDE 'SY:LABCM.FTN'                                              00010 
      INCLUDE 'SY:MTCOMM.FTN'                                             00011 
      INCLUDE 'SY:MTFCB.FTN'                                              00012 
C                                                                         00013 
      DATA LBLANK/1H /                                                    00014 
      DATA EOF1,EOF2/4HEOF1,4HEOF2/                                       00015 
      DATA SYSCOD(1),SYSCOD(2),SYSCOD(3)/4H  BI,4HOMET,4HRICS/            00016 
C                                                                         00017 
CC    IDENTIFY ROUTINE                                                    00018 
C                                                                         00019 
      IF (DEBUG) TYPE 1                                                   00020 
1     FORMAT (' WEOF12')                                                  00021 
C                                                                         00022 
CC    FILL LBUFR WITH 80 CHARACTERS OF EOF1 INFORMATION                   00023 
C                                                                         00024 
CC    BUT FIRST INITIALIZE LBUFR WITH BLANKS                              00025 
C                                                                         00026 
      DO 32758 I=1,80                                                     00027 
      LBUFR(I) = LBLANK                                                   00027 
32758 CONTINUE                                                            00027 
C                                                                         00028 
CC    NOW PUT EOF1 INTO LBUFR                                             00029 
C                                                                         00030 
      CALL STRMOV (EOF1,LBUFR(1),4)                                       00031 
C                                                                         00032 
CC    AND LBDATA                                                          00033 
C                                                                         00034 
      IF(.NOT.(LABFLG .EQ. 0)) GO TO 32757                                00035 
      DO 32756 I=1,17                                                     00036 
      LBDATA(I) = DDFNAM(I)                                               00036 
32756 CONTINUE                                                            00036 
32757 IF(.NOT.(LABFLG .EQ. 1)) GO TO 32755                                00038 
      DO 32754 I=1,17                                                     00039 
      LBDATA(I) = DFNAME(I)                                               00039 
32754 CONTINUE                                                            00039 
32755 CALL STRMOV (LBDATA,LBUFR(5),17)                                    00041 
C                                                                         00042 
CC    AND VSNLST                                                          00043 
C                                                                         00044 
      CALL STRMOV (VSNLST,LBUFR(22),6)                                    00045 
C                                                                         00046 
CC    AND FILE SECTION NUMBER                                             00047 
C                                                                         00048 
      I = 1                                                               00049 
      ENCODE (4,2,LBUFR(28)) I                                            00050 
2     FORMAT (I4)                                                         00051 
      CALL LEADZE (LBUFR(28),4)                                           00052 
C                                                                         00053 
CC    AND KTFILE                                                          00054 
C                                                                         00055 
      ENCODE (4,2,LBUFR(32)) KTFILE                                       00056 
      CALL LEADZE (LBUFR(32),4)                                           00057 
C                                                                         00058 
CC    AND YYDDD                                                           00059 
C                                                                         00060 
      CALL YYDDD (LYYDDD)                                                 00061 
      CALL STRMOV (LYYDDD,LBUFR(42),6)                                    00062 
      CALL STRMOV (LYYDDD,LBUFR(48),6)                                    00063 
C                                                                         00064 
CC    AND BLOCK COUNT                                                     00065 
C                                                                         00066 
      I = 0                                                               00067 
      ENCODE (6,3,LBUFR(55)) I                                            00068 
3     FORMAT (I6)                                                         00069 
      CALL LEADZE (LBUFR(55),6)                                           00070 
C                                                                         00071 
CC    AND SYSTEM CODE                                                     00072 
C                                                                         00073 
      CALL STRMOV (SYSCOD,LBUFR(61),12)                                   00074 
C                                                                         00075 
CC    NOW WRITE EOF1 LABEL                                                00076 
C                                                                         00077 
      IBUFER = 1                                                          00078 
      NBUFER = 80                                                         00079 
      ASSIGN 32752 TO I32753                                              00080 
      GO TO 32753                                                         00080 
C                                                                         00081 
CC    FILL LBUFR WITH 80 CHARACTERS OF EOF2 INFORMATION                   00082 
C                                                                         00083 
CC    BUT FIRST INITIALIZE LBUFR WITH BLANKS                              00084 
C                                                                         00085 
32752 DO 32751 I=1,80                                                     00086 
      LBUFR(I) = LBLANK                                                   00086 
32751 CONTINUE                                                            00086 
C                                                                         00087 
CC    NOW PUT EOF2 INTO LBUFR                                             00088 
C                                                                         00089 
      CALL STRMOV (EOF2,LBUFR(1),4)                                       00090 
C                                                                         00091 
CC    AND RECORD FORMAT                                                   00092 
C                                                                         00093 
      LBUFR(5) = 'U'                                                      00094 
C                                                                         00095 
CC    AND BLOCK LENGTH                                                    00096 
C                                                                         00097 
      IBLOCL = 2046                                                       00098 
      ENCODE (5,4,LBUFR(6)) IBLOCL                                        00099 
4     FORMAT (I5)                                                         00100 
      CALL LEADZE (LBUFR(6),5)                                            00101 
C                                                                         00102 
CC    AND RECORD LENGTH                                                   00103 
C                                                                         00104 
      IRECL = 2046                                                        00105 
      ENCODE (5,4,LBUFR(11)) IRECL                                        00106 
      CALL LEADZE (LBUFR(11),5)                                           00107 
C                                                                         00108 
CC    NOW WRITE EOF2 LABEL                                                00109 
C                                                                         00110 
      IBUFER = 1                                                          00111 
      NBUFER = 80                                                         00112 
      ASSIGN 32750 TO I32753                                              00113 
      GO TO 32753                                                         00113 
C                                                                         00114 
CC    NOW WRITE AN END-OF-FILE MARK                                       00115 
C                                                                         00116 
32750 ASSIGN 32748 TO I32749                                              00117 
      GO TO 32749                                                         00117 
C                                                                         00118 
CC    THATS IT!                                                           00119 
C                                                                         00120 
32748 LABFLG = LABFLG + 1                                                 00121 
      RETURN                                                              00122 
C                                                                         00123 
C     M T W R I T . F L X                                                 00124 
C                                                                         00125 
C     NOTE ** INCLUDE MTFCB.FTN COMMON DEFINITION                         00126 
C     MAGTAPE PROCEDURES TO WRITE A TAPE                                  00127 
32749 CONTINUE                                                            00128 
      MAGERR = .FALSE.                                                    00129 
      CALL MTEOF( MTLUN,ISTAT )                                           00130 
      IF(.NOT.( MTERRL )) GO TO 32747                                     00131 
      ASSIGN 32745 TO I32746                                              00131 
      GO TO 32746                                                         00131 
32745 CONTINUE                                                            00131 
32747 GO TO I32749                                                        00132 
32753 CONTINUE                                                            00133 
      MAGERR = .FALSE.                                                    00134 
      CALL MTWLB( MTLUN,LBUFR(IBUFER),NBUFER,ISTAT )                      00135 
      IF(.NOT.( MTERRL )) GO TO 32744                                     00136 
      ASSIGN 32742 TO I32743                                              00136 
      GO TO 32743                                                         00136 
32742 CONTINUE                                                            00136 
32744 GO TO I32753                                                        00137 
32746 CONTINUE                                                            00138 
      CALL ERROR( TTLUN,'WRITE MAGTAPE END-OF-FILE FAILED',MTDSW,MTIOS )  00139 
      ASSIGN 32740 TO I32741                                              00140 
      GO TO 32741                                                         00140 
32740 GO TO I32746                                                        00141 
32743 CONTINUE                                                            00142 
      CALL ERROR( TTLUN,'WRITE MAGTAPE FAILED',MTDSW,MTIOS )              00143 
      ASSIGN 32739 TO I32741                                              00144 
      GO TO 32741                                                         00144 
32739 GO TO I32743                                                        00145 
32741 CONTINUE                                                            00146 
      MAGERR = .TRUE.                                                     00147 
      GO TO I32741                                                        00148 
      END                                                                 00149 
