      PROGRAM XFIND                                                                                                                 
C     PROGRAM XFIND (XFILE,       XOUT1,       XOUT2,...,       XOUT80,         B2                                                  
C    1                                         INPUT,           OUTPUT, )       B2                                                  
C    2         TAPE1=XFILE,TAPE11=XOUT1,TAPE12=XOUT2,...,TAPE90=XOUT80,         B2                                                  
C    3                                   TAPE5=INPUT,     TAPE6=OUTPUT)         B2                                                  
C     ------------------------------------------------------------              B2                                                  
C                                                                               B2                                                  
C     JAN 04/10 - S.KHARIN (ADD OPTION FOR SAVING LABELS IN OUTPUT FILES)       B2                                                  
C     JUL 03/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)                                                           
C     FEB 14/02 - S.KHARIN  (ENSURE WRITING INTO THE CORRECT OUTPUT UNIT NUMBER)                                                    
C     MAR 29/00 - S.KHARIN  (ADD AN OPTION FOR SAVING UP TO 80 SETS IN                                                              
C                            SEPARATE FILES)                                                                                        
C     JAN 30/98 - D.LIU     (OPTIONALLY TURN SUPERLABEL TO BE SEARCHED FOR                                                          
C                            INTO UPPER/LOWER CASE BEFORE SEARCHING)                                                                
C     FEB 20/92 - E.CHAN    (TREAT SUPERLABELS AS CHARACTER DATA INSTEAD                                                            
C                            OF AS 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 (READ THE SUPERLABEL FROM COLUMNS 15-74)                                                                
C     FEB 23/89 - F.MAJAESS (ALLOW BOTH ABORT AND WARNING EXITS IF THE                                                              
C                            REQUESTED FIELD IS NOT FOUND)                                                                          
C     OCT 03/88 - F.MAJAESS (ABORT IF A REQUESTED FIELD IS NOT FOUND)                                                               
C     NOV 04/87 - G.J.B     (OUTPUT IBUF OF FIRST AND LAST LABEL ONLY)                                                              
C     DEC 06/83 - B.DUGAS.                                                                                                          
C     APR 08/81 - J.D.HENDERSON                                                                                                     
C                                                                               B2                                                  
CXFIND   - FIND SUPERLABELED SETS IN A FILE.                            1 80 C  B1                                                  
C                                                                               B3                                                  
CAUTHOR  - J.D.HENDERSON                                                        B3                                                  
C                                                                               B3                                                  
CPURPOSE - FINDS SUPERLABELLED SETS ON FILE "XFILE" AND COPIES THEM TO          B3                                                  
C          FILES "XOUT*" IN THE ORDER REQUESTED ON CARDS.                       B3                                                  
C          NOTE - THE SUPERLABEL IS NOT COPIED TO FILES "XOUT*".                B3                                                  
C                 THE LARGEST FIELD SIZE IS $BIJ$ WORDS.                        B3                                                  
C                                                                               B3                                                  
CINPUT FILE...                                                                  B3                                                  
C                                                                               B3                                                  
C      XFILE = CONTAINS MULTI-LEVEL SETS OF GRIDS, CROSS-SECTIONS ,ETC.         B3                                                  
C              EACH SET IS PRECEDED BY AN 80 CHARACTER SUPERLABEL.              B3                                                  
C              ONLY THE CHARACTERS 4 TO 64  ARE USED IN THE COMPARISON.         B3                                                  
C                                                                               B3                                                  
COUTPUT FILE...                                                                 B3                                                  
C                                                                               B3                                                  
C      XOUT1,... = SUPERLABELED SETS COPIED FROM FILE XFILE                     B3                                                  
C                                                                                                                                   
CINPUT PARAMETER...                                                                                                                 
C                                                                               B5                                                  
C11:11 ISWTCH = EXIT CONTROL SWITCH WHICH MUST BE '0', ' ' OR '1'.              B5                                                  
C               0 OR BLANK - NORMAL ABORT IF REQUESTED FIELD IS NOT FOUND,      B5                                                  
C               1          - WARNING EXIT IF REQUESTED FIELD IS NOT FOUND,      B5                                                  
C               OTHERS     - IMMEDIATE ABORT.                                   B5                                                  
C12:12 DUMMY  = THIS CHARACTER MAY BE 'U', 'u', 'L', AND 'l' TO                 B5                                                  
C               REQUEST THAT THE SUPERLABEL TO BE SEARCH FOR BE CONVERTED       B5                                                  
C               INTO UPPER OR LOWER CASE.                                       B5                                                  
C13:14 LSLAB  = 1, SAVE SUPERLABELS IN OUTPUT FILES.                            B5                                                  
C               OTHERWISE, DO NOT SAVE SUPERLABELS.                             B5                                                  
C15:74 SPRLBL = 60 CHARACTER SUPERLABEL OF SET TO BE FOUND ON XFILE.            B5                                                  
C               N.B. THE SUPERLABEL IS FROM COLUMN 15 TO COLUMN 74.             B5                                                  
C                                                                               B5                                                  
CEXAMPLE OF INPUT CARD...                                                       B5                                                  
C                                                                               B5                                                  
C*XFIND.  1   OBSERVED TEMPERATURE CROSS-SECTION (JAN)                          B5                                                  
C-----------------------------------------------------------------------------                                                      
C                                                                                                                                   
C     * NLABF = FLAG ARRAY FOR THE FOUND SUPERLABELS                                                                                
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      INTEGER NLABF(10000),ISWTAB(10000)                                                                                            
      CHARACTER*64 LBLTAB(10000),NEWLAB                                                                                             
      CHARACTER SPRLBL*60,DUMMY*3                                                                                                   
      INTEGER JBUF(8)                                                                                                               
      COMMON/ICOM/ IBUF(8),LABEL(65341)                                                                                             
      EQUIVALENCE (LABEL,NEWLAB)                                                                                                    
C                                                                                                                                   
      DATA LA/65341/                                                                                                                
C--------------------------------------------------------------------                                                               
      NF=83                                                                                                                         
      CALL JCLPNT(NF,1,                                                                                                             
     1         11,12,13,14,15,16,17,18,19,20,                                                                                       
     2         21,22,23,24,25,26,27,28,29,30,                                                                                       
     3         31,32,33,34,35,36,37,38,39,40,                                                                                       
     4         41,42,43,44,45,46,47,48,49,50,                                                                                       
     5         51,52,53,54,55,56,57,58,59,60,                                                                                       
     6         61,62,63,64,65,66,67,68,69,70,                                                                                       
     7         71,72,73,74,75,76,77,78,79,80,                                                                                       
     8         81,82,83,84,85,86,87,88,89,90,5,6)                                                                                   
      REWIND 1                                                                                                                      
      MAXLEN=LA+8                                                                                                                   
      NFOUT=NF-3                                                                                                                    
      IF (NFOUT.LT.1) CALL                         XIT('XFIND',-1)                                                                  
      WRITE(6,6005) NFOUT                                                                                                           
C                                                                                                                                   
C     * READ ALL SUPERLABELS FROM INPUT CARD.                                                                                       
C                                                                                                                                   
      NSL=0                                                                                                                         
  100 READ(5,5010,END=105) ISWTCH,DUMMY,LSLAB,SPRLBL                            B4                                                  
      IF((ISWTCH.GT.1))THEN                                                                                                         
         WRITE(6,6010) ISWTCH,DUMMY,LSLAB,SPRLBL                                                                                    
         CALL                                      XIT('XFIND',-2)                                                                  
      ENDIF                                                                                                                         
                                                                                                                                    
C     * IF DUMMY(1:1) IS EITHER 'U' OR 'L', THE LABEL SPRLBL WILL                                                                   
C     * BE CONVERTED INTO UPPER CASE OR LOWER CASE AS REQUESTED.                                                                    
                                                                                                                                    
      IF (DUMMY(1:1).EQ.'U'.OR.DUMMY(1:1).EQ.'u') THEN                                                                              
         CALL LWRTUPR(SPRLBL,60)                                                                                                    
      ELSE IF (DUMMY(1:1).EQ.'L'.OR.DUMMY(1:1).EQ.'l') THEN                                                                         
         CALL UPRTLWR(SPRLBL,60)                                                                                                    
      ENDIF                                                                                                                         
                                                                                                                                    
      NSL=NSL+1                                                                                                                     
      LBLTAB(NSL)(1:4)='    '                                                                                                       
      LBLTAB(NSL)(5:64)=SPRLBL(1:60)                                                                                                
      ISWTAB(NSL)=ISWTCH                                                                                                            
      WRITE(6,6020) ISWTAB(NSL),LBLTAB(NSL)                                                                                         
      GOTO 100                                                                                                                      
 105  CONTINUE                                                                                                                      
      IF (NSL.EQ.0) CALL                           XIT('XFIND',-3)                                                                  
      WRITE(6,6015) NSL                                                                                                             
C                                                                                                                                   
C     * ABORT IF NFOUT=1 AND THERE ARE DUPLICATE SUPERLABELS IN                                                                     
C     * INPUT CARD                                                                                                                  
C                                                                                                                                   
      IF (NFOUT.EQ.1.AND.NSL.GT.1) THEN                                                                                             
         DO N=1,NSL-1                                                                                                               
               DO N1=N+1,NSL                                                                                                        
                  IF (LBLTAB(N).EQ.LBLTAB(N1))CALL XIT('XFIND',-4)                                                                  
               ENDDO                                                                                                                
         ENDDO                                                                                                                      
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * CHECK IF THE NUMBERS OF OUTPUT FILES AND OF SUPERLABELS                                                                     
C     * ARE EQUAL (DO IT ONLY IF NFOUT > 1)                                                                                         
C                                                                                                                                   
      IF (NFOUT.GT.1.AND.NFOUT.NE.NSL) THEN                                                                                         
         WRITE(6,6018)                                                                                                              
         CALL                                      XIT('XFIND',-5)                                                                  
      ENDIF                                                                                                                         
                                                                                                                                    
      DO N=1,NFOUT                                                                                                                  
         REWIND 10+N                                                                                                                
      ENDDO                                                                                                                         
C                                                                                                                                   
C     * NLABFT = TOTAL NUMBER OF THE SUPERLABELS FOUND IN THE INPUT FILE                                                            
C     * NLABF(N) = FLAG ARRAY FOR THE FOUND SUPERLABELS                                                                             
C                                                                                                                                   
      NLABFT=0                                                                                                                      
      DO N=1,NSL                                                                                                                    
         NLABF(N)=0                                                                                                                 
      ENDDO                                                                                                                         
C                                                                                                                                   
C     * READ THE NEXT RECORD FROM XFILE.                                                                                            
C     * IF THIS SUPERLABEL IS NOT FOUND ON THE FILE, PRINT MESSAGE AND                                                              
C     * GO BACK FOR THE NEXT ONE OR ABORT (DEPENDING ON ISWTCH VALUE).                                                              
C                                                                                                                                   
  110 CONTINUE                                                                                                                      
      CALL FBUFFIN(1,IBUF,MAXLEN,K,LEN)                                                                                             
      IF(K.EQ.0)THEN                                                                                                                
C                                                                                                                                   
C     * PRINT SUPERLABELS THAT ARE NOT FOUND                                                                                        
C                                                                                                                                   
         ISWTCH=1                                                                                                                   
         DO N=1,NSL                                                                                                                 
            IF (NLABF(N).EQ.0) THEN                                                                                                 
               WRITE(6,6030) LBLTAB(N)                                                                                              
               ISWTCH=MIN(ISWTCH,ISWTAB(N))                                                                                         
            ENDIF                                                                                                                   
         ENDDO                                                                                                                      
         IF(ISWTCH.EQ.0)THEN                                                                                                        
            CALL                                   XIT('XFIND',-6)                                                                  
         ELSE                                                                                                                       
            CALL                                   XIT('XFIND',-101)                                                                
         ENDIF                                                                                                                      
      ENDIF                                                                                                                         
      IF(IBUF(1).NE.NC4TO8("LABL")) GO TO 110                                                                                       
C                                                                                                                                   
C     * CHECK THE LABEL JUST READ.                                                                                                  
C                                                                                                                                   
 120  CONTINUE                                                                                                                      
      DO N=1,NSL                                                                                                                    
         IF (NEWLAB.EQ.LBLTAB(N)) THEN                                                                                              
C                                                                                                                                   
C     * ABORT IF THE INPUT FILE CONTAINS DUPLICATE SUPERLABELS                                                                      
C                                                                                                                                   
            IF(NLABF(N).EQ.1) CALL                 XIT('XFIND',-7)                                                                  
            NSLF=N                                                                                                                  
            NLABF(NSLF)=1                                                                                                           
            NLABFT=NLABFT+1                                                                                                         
            NREC=0                                                                                                                  
C                                                                                                                                   
C     * CHECK FOR THE SAME SUPERLABELS IN THE LIST READ FROM INPUT CARD.                                                            
C                                                                                                                                   
            IF (NSLF.LT.NSL) THEN                                                                                                   
               DO N1=NSLF+1,NSL                                                                                                     
                  IF (NEWLAB.EQ.LBLTAB(N1)) THEN                                                                                    
                     NLABF(N1)=1                                                                                                    
                     NLABFT=NLABFT+1                                                                                                
                  ENDIF                                                                                                             
               ENDDO                                                                                                                
            ENDIF                                                                                                                   
C                                                                                                                                   
C     * SAVE SUPERLABEL, IF REQUESTED                                                                                               
C                                                                                                                                   
            IF (LSLAB.EQ.1)THEN                                                                                                     
               CALL FBUFOUT(10+MIN(NSLF,NFOUT),IBUF,LEN,K)                                                                          
            ENDIF                                                                                                                   
            GOTO 210                                                                                                                
         ENDIF                                                                                                                      
      ENDDO                                                                                                                         
C                                                                                                                                   
C     * THE LABEL IS NOT FOUND IN THE LIST READ FROM INPUT CARD.                                                                    
C     * GO BACK AND READ NEXT RECORD.                                                                                               
C                                                                                                                                   
      GO TO 110                                                                                                                     
C                                                                                                                                   
C     * IF THIS IS THE RIGHT LABEL COPY THE SET TO THE CORRESPONDING XOUT.                                                          
C                                                                                                                                   
 210  CALL FBUFFIN(1,IBUF,MAXLEN,K,LEN)                                                                                             
      IF (K.EQ.0) THEN                                                                                                              
C                                                                                                                                   
C     * EOF...                                                                                                                      
C                                                                                                                                   
         WRITE(6,6025) JBUF,NREC                                                                                                    
         WRITE(6,6040) LBLTAB(NSLF)                                                                                                 
         IF (NREC.EQ.0.OR.NLABFT.LT.NSL) THEN                                                                                       
C                                                                                                                                   
C     * PRINT SUPERLABELS THAT ARE NOT FOUND AND ABORT                                                                              
C                                                                                                                                   
            ISWTCH=1                                                                                                                
            DO N=1,NSL                                                                                                              
               IF (NLABF(N).EQ.0) THEN                                                                                              
                  WRITE(6,6030) LBLTAB(N)                                                                                           
                  ISWTCH=MIN(ISWTCH,ISWTAB(N))                                                                                      
               ENDIF                                                                                                                
            ENDDO                                                                                                                   
            IF(ISWTCH.EQ.0)THEN                                                                                                     
               CALL                                XIT('XFIND',-8)                                                                  
            ELSE                                                                                                                    
               CALL                                XIT('XFIND',-102)                                                                
            ENDIF                                                                                                                   
         ENDIF                                                                                                                      
C                                                                                                                                   
C     * EXIT NORMALLY IF ALL SUPERLABELS ARE FOUND                                                                                  
C                                                                                                                                   
         CALL                                      XIT('XFIND',0)                                                                   
      ENDIF                                                                                                                         
                                                                                                                                    
      IF (IBUF(1).EQ.NC4TO8("LABL")) THEN                                                                                           
C                                                                                                                                   
C     * SUPERLABEL...                                                                                                               
C                                                                                                                                   
        WRITE(6,6025) JBUF,NREC                                                                                                     
        WRITE(6,6040) LBLTAB(NSLF)                                                                                                  
        IF (NREC.EQ.0) THEN                                                                                                         
C                                                                                                                                   
C     * ABORT IF FOUND NO RECORDS                                                                                                   
C                                                                                                                                   
           IF(ISWTAB(NSLF).EQ.0)THEN                                                                                                
              CALL                                 XIT('XFIND',-9)                                                                  
           ELSE                                                                                                                     
              IF (NSL.EQ.1) CALL                   XIT('XFIND',-103)                                                                
           ENDIF                                                                                                                    
        ENDIF                                                                                                                       
C                                                                                                                                   
C     * EXIT NORMALLY IF ALL SUPERLABELS ARE FOUND                                                                                  
C                                                                                                                                   
        IF (NLABFT.EQ.NSL) CALL                    XIT('XFIND',0)                                                                   
        GO TO 120                                                                                                                   
      ENDIF                                                                                                                         
                                                                                                                                    
C                                                                                                                                   
C     * WRITE OUT RECORDS FOR THE SUPERLABEL FOUND                                                                                  
C                                                                                                                                   
      CALL FBUFOUT(10+MIN(NSLF,NFOUT),IBUF,LEN,K)                                                                                   
C                                                                                                                                   
C     * WRITE OUT RECORDS FOR THE SAME SUPERLABELS, IF ANY                                                                          
C                                                                                                                                   
      IF (NSLF.LT.NSL) THEN                                                                                                         
         DO N=NSLF+1,NSL                                                                                                            
            IF (LBLTAB(NSLF).EQ.LBLTAB(N)) THEN                                                                                     
               CALL FBUFOUT(10+MIN(N,NFOUT),IBUF,LEN,K)                                                                             
            ENDIF                                                                                                                   
         ENDDO                                                                                                                      
      ENDIF                                                                                                                         
                                                                                                                                    
      NREC=NREC+1                                                                                                                   
      DO 220 J=1,8                                                                                                                  
  220 JBUF(J)=IBUF(J)                                                                                                               
      IF(NREC.EQ.1) WRITE(6,6024) IBUF                                                                                              
      GO TO 210                                                                                                                     
                                                                                                                                    
C--------------------------------------------------------------------                                                               
 5010 FORMAT(10X,I1,A1,I2,A60)                                                  B4                                                  
 6005 FORMAT('0 FOUND ',I5,' OUTPUT FILES.')                                                                                        
 6010 FORMAT(11X,I1,A1,I2,A60)                                                                                                      
 6015 FORMAT('0 FOUND ',I5,' SUPERLABELS IN INPUT CARD.')                                                                           
 6018 FORMAT('0...THE NUMBER OF OUTPUT FILES .GT. 1 AND .NE.',                                                                      
     1 ' THE NUMBER OF SUPERLABELS IN INPUT CARD.')                                                                                 
 6020 FORMAT('0  ISWTCH = ',I1,/'0   LOOKING FOR-',A64)                                                                             
 6024 FORMAT(' FIRST RECORD:  ',A4,I10,1X,A4,I10,4I6)                                                                               
 6025 FORMAT('  LAST RECORD:  ',A4,I10,1X,A4,I10,4I6,/,                                                                             
     1       '0 NUMBER OF RECORDS',I10)                                                                                             
 6030 FORMAT('0...CANNOT FIND ',A64)                                                                                                
 6040 FORMAT('0      XFIND ON-',A64)                                                                                                
      END                                                                                                                           
