      PROGRAM JOINPIO                                                                                                               
C     PROGRAM JOINPIO(JOIN,        IN11, ...        IN70,        OUTPUT,)       J2                                                  
C    1         TAPE10=JOIN, TAPE21=IN11, ...,TAPE50=IN70, TAPE6 =OUTPUT)                                                            
C     -----------------------------------------------------------------         J2                                                  
C                                                                               J2                                                  
C     MAR 29/18 - S.KHARIN (WRITE OUT SCALAR AND FULL FIELDS FROM IN11 ONLY)    J2                                                  
C                                                                               J2                                                  
CJOINPIO - JOINS UP TO 64 PARALLEL I/O OUTPUT FILES.                   64  1    J1                                                  
C                                                                               J3                                                  
CAUTHOR  - F.MAJAESS                                                            J3                                                  
C                                                                               J3                                                  
CPURPOSE - JOINS, AT THE RECORD LEVEL, UP TO 60 FILES (MAINLY OUTGCM_.. AND     J3                                                  
C          OUTEND_..) RESULTED FROM RUNNING IN PARALLEL I/O MODE.               J3                                                  
C          NOTE - EACH INPUT FILE IS EXPECTED TO HAVE THE SAME NUMBER OF        J3                                                  
C                 RECORDS WITHN THE SAME MATCHING LABEL AND DATA TYPE IN THE    J3                                                  
C                 CORESSPONDING RECORD TO THOSE CONTAINED IN "IN11" INPUT FILE. J3                                                  
C                 "GRID","SPEC" AND "ENRG" KIND RECORDS ONLY ARE PROCESSED WITH J3                                                  
C                 "ENRG" RECORDS WRITTEN AS IS FROM "IN11" AND SKIPPED FROM THE J3                                                  
C                 OTHER "IN12"... FILES.                                        J3                                                  
C                                                                               J3                                                  
CINPUT FILE(S)...                                                               J3                                                  
C                                                                               J3                                                  
C      IN11,... ,IN70 = INPUT FILES (TYPICALLY OUTGCM_.. OR OUTEND_..) WHOSE    J3                                                  
C                       CORRESPONDING RECORDS ARE TO BE JOINED.                 J3                                                  
C                       (UP TO 60 FILES)                                        J3                                                  
C                                                                               J3                                                  
COUTPUT FILE...                                                                 J3                                                  
C                                                                               J3                                                  
C      JOIN = FILE CONTAINING ALL OF THE CORRESPONDING INPUT RECORDS JOINED.    J3                                                  
C-------------------------------------------------------------------------------                                                    
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      PARAMETER (MAXX  = 65341 , MAXXR = 65341 )                                                                                    
      REAL A(MAXXR)                                                                                                                 
      LOGICAL OK,SPEC                                                                                                               
      COMMON/ICOM/IBUF(8),IDAT(MAXX)                                                                                                
      COMMON/JCOM/JBUF(8),JDAT(MAXX)                                                                                                
C                                                                                                                                   
C--------------------------------------------------------------------                                                               
      NF=66                                                                                                                         
      CALL JCLPNT(NF,10,11,12,13,14,15,16,17,18,19,20,                                                                              
     1                  21,22,23,24,25,26,27,28,29,30,                                                                              
     2                  31,32,33,34,35,36,37,38,39,40,                                                                              
     3                  41,42,43,44,45,46,47,48,49,50,                                                                              
     4                  51,52,53,54,55,56,57,58,59,60,                                                                              
     5                  61,62,63,64,65,66,67,68,69,70,                                                                              
     6                  71,72,73,74,6)                                                                                              
      NF=NF-2                                                                                                                       
      WRITE(6,6000) NF                                                                                                              
C                                                                                                                                   
C     * REWIND OUTPUT FILE                                                                                                          
C                                                                                                                                   
      REWIND 10                                                                                                                     
      NRECS=0                                                                                                                       
C                                                                                                                                   
C     * REWIND INPUT FILE                                                                                                           
C                                                                                                                                   
      DO 100 N=11,10+NF                                                                                                             
       REWIND N                                                                                                                     
  100 CONTINUE                                                                                                                      
                                                                                                                                    
      NR=0                                                                                                                          
C                                                                                                                                   
C     * READ DATA RECORDS FROM FIRST INPUT FILE.                                                                                    
C                                                                                                                                   
  150 CALL GETFLD2(11,A, -1 ,0,0,0,IBUF,MAXX,OK)                                                                                    
      IF(.NOT.OK)THEN                                                                                                               
        IF(NR.EQ.0) CALL                           XIT('JOINPIO',-1)                                                                
        WRITE(6,6010) NR                                                                                                            
        CALL                                       XIT('JOINPIO',0)                                                                 
      ENDIF                                                                                                                         
      IF(NR.EQ.0) CALL PRTLAB(IBUF)                                                                                                 
      NR=NR+1                                                                                                                       
                                                                                                                                    
C     * WRITE OUT "ENRG" RECORD IF PRESENT...                                                                                       
                                                                                                                                    
      IF(IBUF(1).EQ.NC4TO8("ENRG").AND.                                                                                             
     1   IBUF(3).EQ.NC4TO8("ENRG")) THEN                                                                                            
       CALL PUTFLD2(10,A,IBUF,MAXX)                                                                                                 
       IF(NR.EQ.1) CALL PRTLAB(IBUF)                                                                                                
       GO TO 150                                                                                                                    
      ENDIF                                                                                                                         
                                                                                                                                    
C     * ABORT ON OTHER THAN "GRID" AND "SPEC" DATA RECORDS.                                                                         
                                                                                                                                    
      IF (IBUF(1).NE.NC4TO8("GRID").AND.IBUF(1).NE.NC4TO8("SPEC"))                                                                  
     1  CALL                                       XIT('JOINPIO',-2)                                                                
      SPEC=(IBUF(1).EQ.NC4TO8("SPEC"))                                                                                              
      NWDS=IBUF(5)*IBUF(6)                                                                                                          
      IF(SPEC) NWDS=NWDS*2                                                                                                          
C                                                                                                                                   
C     * WRITE OUT "SCALAR AND FULL GRIDS IF PRESENT...                                                                              
C                                                                                                                                   
      IF(IBUF(1).EQ.NC4TO8("GRID").AND.                                                                                             
     1     (NWDS.EQ.1.OR.NWDS.EQ.IBUF(5)*(IBUF(5)-1)/2)) THEN                                                                       
       CALL PUTFLD2(10,A,IBUF,MAXX)                                                                                                 
       IF(NR.EQ.1) CALL PRTLAB(IBUF)                                                                                                
       GO TO 150                                                                                                                    
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * ABORT IF EXPECTED OUTPUT ARRAY SIZE IS NOT LARGE ENOUGH.                                                                    
C                                                                                                                                   
      IF (NF*NWDS.GT.MAXXR) CALL                   XIT('JOINPIO',-3)                                                                
                                                                                                                                    
C     * SKIP TO WRITE THE RECORD READ IF ONLY ONE INPUT FILE                                                                        
C     * IS GETTING PROCESSED!.                                                                                                      
      IF (NF.EQ.1) GO TO 300                                                                                                        
                                                                                                                                    
C     * LOOP OVER AND READ THE REMAINING ELEMENTS FOR THE CURRENT                                                                   
C     * RECORD PROCESSED FROM THE REST OF THE INPUT FILES                                                                           
                                                                                                                                    
      DO 250 N=12,10+NF                                                                                                             
       NOFFST=(N-11)*NWDS+1                                                                                                         
  200  CALL GETFLD2(N,A(NOFFST),-1 ,0,0,0,JBUF,MAXX,OK)                                                                             
       IF(.NOT.OK) CALL                            XIT('JOINPIO',-4)                                                                
                                                                                                                                    
C      * SKIP OVER "ENRG" RECORDS (ONLY SUCH RECORDS FROM "IN11"                                                                    
C      * ARE WRITTEN OUT).                                                                                                          
C                                                                                                                                   
       IF(IBUF(1).EQ.NC4TO8("ENRG").AND.                                                                                            
     1   IBUF(3).EQ.NC4TO8("ENRG")) GO TO 200                                                                                       
C                                                                                                                                   
C      * ABORT IF ANY 2 CORRESPONDING LABEL ELEMENTS DIFFER.                                                                        
C                                                                                                                                   
       DO 240 K=1,8                                                                                                                 
        IF (IBUF(K).NE.JBUF(K)) THEN                                                                                                
         CALL PRTLAB(IBUF)                                                                                                          
         CALL PRTLAB(JBUF)                                                                                                          
         CALL                                      XIT('JOINPIO',-5)                                                                
        ENDIF                                                                                                                       
  240  CONTINUE                                                                                                                     
                                                                                                                                    
  250 CONTINUE                                                                                                                      
C                                                                                                                                   
C     * ADJUST THE DIMENSION BASED ON THE RECORD KIND.                                                                              
C                                                                                                                                   
  300 IF (SPEC) THEN                                                                                                                
       IBUF(5)=NF*IBUF(5)                                                                                                           
      ELSE                                                                                                                          
       IBUF(6)=NF*IBUF(6)                                                                                                           
      ENDIF                                                                                                                         
                                                                                                                                    
C     * WRITE OUT THE JOINED ELEMENT OF THE CURRENT RECORD PROCESSED                                                                
C     * AND LOOP BACK FOR THE REST.                                                                                                 
                                                                                                                                    
      CALL PUTFLD2(10,A,IBUF,MAXX)                                                                                                  
      IF(NR.EQ.1) CALL PRTLAB(IBUF)                                                                                                 
                                                                                                                                    
      GO TO 150                                                                                                                     
C--------------------------------------------------------------------                                                               
 6000 FORMAT (' RECORDS FROM ',I5,' INPUT FILES WILL BE JOINED')                                                                    
 6010 FORMAT('0',I6,'  SET OF RECORDS PROCESSED')                                                                                   
      END                                                                                                                           
