      PROGRAM XDELET                                                                                                                
C     PROGRAM XDELET (OLD,       NEW,       INPUT,       OUTPUT,        )       B2                                                  
C    1          TAPE1=OLD, TAPE2=NEW, TAPE5=INPUT, TAPE6=OUTPUT)                                                                    
C     ----------------------------------------------------------                B2                                                  
C                                                                               B2                                                  
C     JUL 03/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)       B2                                                  
C     JAN 14/93 - E. CHAN   (END READ USING FBUFFIN IF K.GE.0)                                                                      
C     FEB 21/92 - E. CHAN   (TREAT SUPERLABELS AS ASCII INSTEAD OF AS                                                               
C                            HOLLERITH LITERALS)                                                                                    
C     JAN 29/92 - E. CHAN   (CONVERT HOLLERITH LITERALS TO ASCII AND                                                                
C                            REPLACE BUFFERED I/O)                                                                                  
C     MAR 06/89 - F.MAJAESS (INCREASE FIELD DIMENSION TO 66000)                                                                     
C     DEC 06/83 - B.DUGAS.                                                                                                          
C     DEC 07/80 - J.D.HENDERSON                                                                                                     
C                                                                               B2                                                  
CXDELET  - DELETES SUPERLABELED SETS FROM A FILE                        1  1 C  B1                                                  
C                                                                               B3                                                  
CAUTHOR  - J.D.HENDERSON                                                        B3                                                  
C                                                                               B3                                                  
CPURPOSE - DELETES SUPERLABELED SETS FROM A FILE OLD AND PUTS THE REST          B3                                                  
C          OF THE SETS ON FILE NEW.                                             B3                                                  
C          NOTE - MAXIMUM NUMBER OF DELETIONS IS 100 AND                        B3                                                  
C                 THE LARGEST FIELD SIZE IS $BIJ$ WORDS.                        B3                                                  
C                                                                               B3                                                  
CINPUT FILE...                                                                  B3                                                  
C                                                                               B3                                                  
C      OLD = CONTAINS SUPERLABELED SETS OF DATA                                 B3                                                  
C                                                                               B3                                                  
COUTPUT FILE...                                                                 B3                                                  
C                                                                               B3                                                  
C      NEW = COPY OF FILE OLD WITH SOME SETS DELETED                            B3                                                  
C                                                                                                                                   
CINPUT PARAMETER...                                                                                                                 
C                                                                               B5                                                  
C      LABLD = SUPERLABEL TO BE DELETED (UP TO 100 CARDS CAN BE READ)           B5                                                  
C                                                                               B5                                                  
CEXAMPLE OF INPUT CARD...                                                       B5                                                  
C                                                                               B5                                                  
C*  XDELET    OBSERVED TEMPERATURE CROSS-SECTION (JAN)                          B5                                                  
C-----------------------------------------------------------------------------                                                      
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      LOGICAL COPY                                                                                                                  
      CHARACTER*64 LABLD(100),SLABL                                                                                                 
      COMMON/ICOM/ IBUF(8),LABEL(65341)                                                                                             
      EQUIVALENCE (SLABL,LABEL)                                                                                                     
C                                                                                                                                   
      DATA LA/65341/                                                                                                                
C--------------------------------------------------------------------                                                               
      NFF=4                                                                                                                         
      CALL JCLPNT(NFF,1,2,5,6)                                                                                                      
      REWIND 1                                                                                                                      
      REWIND 2                                                                                                                      
C                                                                                                                                   
C     * READ THE DELETION LABELS FROM CARDS (MAX 100).                                                                              
C     * IF THERE ARE NO DELETIONS THE WHOLE FILE IS COPIED.                                                                         
C                                                                                                                                   
      N=1                                                                                                                           
  105 READ(5,5010,END=107) LABLD(N)                                             B4                                                  
      WRITE(6,6040) LABLD(N)                                                                                                        
      N=N+1                                                                                                                         
      IF(N.GT.100) THEN                                                                                                             
        GOTO 107                                                                                                                    
      ENDIF                                                                                                                         
      GO TO 105                                                                                                                     
  107 NDEL=N-1                                                                                                                      
      WRITE(6,6010) NDEL                                                                                                            
      COPY=.TRUE.                                                                                                                   
      NSDEL=0                                                                                                                       
C                                                                                                                                   
C     * READ THE NEXT RECORD FROM FILE OLD.                                                                                         
C                                                                                                                                   
      MAXLEN=LA+8                                                                                                                   
  110 CALL FBUFFIN(1,IBUF,MAXLEN,K,LEN)                                                                                             
      IF(K.GE.0) THEN                                                                                                               
        WRITE(6,6020) NSDEL                                                                                                         
        CALL                                       XIT('XDELET',0)                                                                  
      ENDIF                                                                                                                         
      IF(IBUF(1).NE.NC4TO8("LABL")) GO TO 190                                                                                       
C                                                                                                                                   
C     * CHECK THE SUPERLABEL JUST READ FROM THE FILE.                                                                               
C     * IF IT IS THE SAME AS ANY DELETION LABEL, DO NOT COPY THIS SET.                                                              
C                                                                                                                                   
      IF(NDEL.EQ.0) GO TO 190                                                                                                       
      DO 175 N=1,NDEL                                                                                                               
      COPY=.FALSE.                                                                                                                  
      IF( SLABL .NE. LABLD(N) ) COPY=.TRUE.                                                                                         
      IF(.NOT.COPY)THEN                                                                                                             
        NSDEL=NSDEL+1                                                                                                               
        GO TO 190                                                                                                                   
      ENDIF                                                                                                                         
  175 CONTINUE                                                                                                                      
C                                                                                                                                   
C     * COPY THIS RECORD ONTO FILE NEW IF REQUESTED.                                                                                
C                                                                                                                                   
  190 IF(.NOT.COPY) GO TO 110                                                                                                       
      CALL FBUFOUT(2,IBUF,LEN,K)                                                                                                    
      GO TO 110                                                                                                                     
C--------------------------------------------------------------------                                                               
 5010 FORMAT(10X,A64)                                                           B4                                                  
 6010 FORMAT('0',I6,' DELETIONS REQUESTED')                                                                                         
 6020 FORMAT('0',I6,' SETS DELETED')                                                                                                
 6040 FORMAT('   DELETE-',A64)                                                                                                      
      END                                                                                                                           
