      PROGRAM SEPARMC                                                                                                               
C     PROGRAM SEPARMC (IN,        REST,        PARM,        PARC,               B2                                                  
C    1                                                      OUTPUT,     )       B2                                                  
C    2          TAPE10=IN, TAPE11=REST, TAPE12=PARM, TAPE13=PARC,                                                                   
C    3                                                TAPE6=OUTPUT)                                                                 
C     -------------------------------------------------------------             B2                                                  
C                                                                               B2                                                  
C     JUL 03/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS )      B2                                                  
C     JUL 22/02 - F.MAJAESS                                                                                                         
C                                                                               B2                                                  
CSEPARMC - SEPARATES "PARM" AND "PARC" NAMED RECORDS FROM THE REST.     1  3    B1                                                  
C                                                                               B3                                                  
CAUTHOR  - F.MAJAESS                                                            B3                                                  
C                                                                               B3                                                  
CPURPOSE - SEPARATES "PARM" AND "PARC" NAMED RECORDS (WITH "CHAR" KIND) INTO    B3                                                  
C          OWN FILES FROM THE REST OF THE RECORDS SUPPLIED IN THE "IN" FILE.    B3                                                  
C          NOTE - MAXIMUM RECORD LENGTH IS $BIJ$ WORDS.                         B3                                                  
C                 IF NO "PARM" OR "PARC" NAMED RECORD IS FOUND, THEN NOTHING    B3                                                  
C                 WILL BE WRITTEN INTO THE CORRESPONDING OUTPUT FILE SPECIFIED. B3                                                  
C                                                                               B3                                                  
CINPUT FILE...                                                                  B3                                                  
C                                                                               B3                                                  
C      IN   = INPUT FILE POSSIBLY CONTAINING "PARM" AND/OR "PARC" NAMED RECORDS.B3                                                  
C                                                                               B3                                                  
COUTPUT FILE(S)...                                                              B3                                                  
C                                                                               B3                                                  
C      REST = THE REST OF RECORDS NOT WRITTEN INTO "PARM" OR "PARC" FILES.      B3                                                  
C      PARM = "CHAR" KIND RECORDS WITH "PARM" NAME. (MAY BE EMPTY)              B3                                                  
C      PARC = "CHAR" KIND RECORDS WITH "PARC" NAME. (MAY BE EMPTY)              B3                                                  
C-------------------------------------------------------------------------------                                                    
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      LOGICAL OK                                                                                                                    
      COMMON/ICOM/IBUF(8),IDAT(65341)                                                                                               
C                                                                                                                                   
      DATA MAXX/65341/                                                                                                              
C                                                                                                                                   
C--------------------------------------------------------------------                                                               
      NF=5                                                                                                                          
      CALL JCLPNT(NF,10,11,12,13,6)                                                                                                 
                                                                                                                                    
      IF(NF.LT.5) CALL                             XIT('SEPARMC',-1)                                                                
                                                                                                                                    
      DO N=10,13                                                                                                                    
       REWIND N                                                                                                                     
      ENDDO                                                                                                                         
                                                                                                                                    
C     * INITIALIZE RECORD COUNTERS.                                                                                                 
                                                                                                                                    
      NREC =0                                                                                                                       
      NRECR=0                                                                                                                       
      NRECM=0                                                                                                                       
      NRECC=0                                                                                                                       
C                                                                                                                                   
C     * LOOP OVER THE INPUT RECORDS...                                                                                              
C                                                                                                                                   
  150 CALL RECGET(10, -1,-1,-1,-1, IBUF,MAXX,OK)                                                                                    
      IF (.NOT.OK) THEN                                                                                                             
        NREC=NRECR+NRECM+NRECC                                                                                                      
        IF (NREC.EQ.0) THEN                                                                                                         
         WRITE(6,6010)                                                                                                              
         CALL                                      XIT('SEPARMC',-2)                                                                
        ELSE                                                                                                                        
         WRITE(6,6020) NREC,NRECR,NRECM,NRECC                                                                                       
         CALL                                      XIT('SEPARMC',0)                                                                 
        ENDIF                                                                                                                       
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * AND SEPARATE ...                                                                                                            
C                                                                                                                                   
                                                                                                                                    
      IF ( IBUF(1).EQ.NC4TO8("CHAR") .AND.                                                                                          
     1    (IBUF(3).EQ.NC4TO8("PARM") .OR.                                                                                           
     2     IBUF(3).EQ.NC4TO8("PARC")     )  ) THEN                                                                                  
C                                                                                                                                   
         IF (IBUF(3).EQ.NC4TO8("PARM")) THEN                                                                                        
                                                                                                                                    
C         * WRITE "PARM" NAMED RECORD(S) INTO "PARM" FILE.                                                                          
                                                                                                                                    
          CALL RECPUT(12,IBUF)                                                                                                      
          NRECM=NRECM+1                                                                                                             
                                                                                                                                    
         ELSE                                                                                                                       
                                                                                                                                    
C         * WRITE "PARC" NAMED RECORD(S) INTO "PARC" FILE.                                                                          
                                                                                                                                    
          CALL RECPUT(13,IBUF)                                                                                                      
          NRECC=NRECC+1                                                                                                             
                                                                                                                                    
         ENDIF                                                                                                                      
                                                                                                                                    
      ELSE                                                                                                                          
                                                                                                                                    
                                                                                                                                    
C        * WRITE THE REST OF NO "PARC" AND "PARM" NAMED RECORD(S)                                                                   
C        * INTO "REST" FILE.                                                                                                        
                                                                                                                                    
         CALL RECPUT(11,IBUF)                                                                                                       
         NRECR=NRECR+1                                                                                                              
                                                                                                                                    
      ENDIF                                                                                                                         
                                                                                                                                    
      GO TO 150                                                                                                                     
C--------------------------------------------------------------------                                                               
 6010 FORMAT('0 SEPARMC - INPUT FILE IS EMPTY')                                                                                     
 6020 FORMAT('0 SEPARMC - RECORDS IN =',I7,', RECORDS OUT =',3I7)                                                                   
      END                                                                                                                           
