      PROGRAM JOINRTD                                                                                                               
C     PROGRAM JOINRTD (RTD1,       RTD2,       OUT,       OUTPUT,       )       B2                                                  
C    1           TAPE1=RTD1, TAPE2=RTD2, TAPE3=OUT, TAPE6=OUTPUT)                                                                   
C     -----------------------------------------------------------               B2                                                  
C                                                                               B2                                                  
C     JAN 31/17 - S.KHARIN.                                                     B2                                                  
C                                                                               B2                                                  
CJOINRTD - JOINS TWO RTD FILES.                                         2  1    B1                                                  
C                                                                               B3                                                  
CAUTHOR  - S.KHARIN                                                             B3                                                  
C                                                                               B3                                                  
CPURPOSE - JOINS TWO RTD FILES IN "OUT". STARTING WITH RTD2, THEN ADD           B3                                                  
C          REMAINING FIELDS FROM RTD1.                                          B3                                                  
C                                                                               B3                                                  
CINPUT FILES...                                                                 B3                                                  
C                                                                               B3                                                  
C     RTD1 = FIRST  INPUT RTD FILE                                              B3                                                  
C     RTD2 = SECOND INPUT RTD FILE WITH ADDITIONAL VARIABLES, POSSIBLY IN A     B3                                                  
C            DIFFERENT ORDER                                                    B3                                                  
C                                                                               B3                                                  
COUTPUT FILE...                                                                 B3                                                  
C                                                                               B3                                                  
C     RTDM = MERGED SET OF TWO INPUT RTD FILES (START WITH RTD2 AND THEN ADD    B3                                                  
C            REMAINING FIELDS FROM RTD1)                                        B3                                                  
C-------------------------------------------------------------------------------                                                    
                                                                                                                                    
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
                                                                                                                                    
      PARAMETER (IJM=308321, IJMV=IJM*1)                                                                                            
      REAL X(IJM), Y(IJM)                                                                                                           
      PARAMETER(NSPLMAX=100000)                                                                                                     
      CHARACTER*53 SPRLAB1(NSPLMAX),SPRLAB2(NSPLMAX)                                                                                
      INTEGER ILAB1(NSPLMAX),ILAB2(NSPLMAX)                                                                                         
      CHARACTER*11 YEARS1,YEARS2                                                                                                    
                                                                                                                                    
      CHARACTER*64 SPRLBL1,SPRLBL2                                                                                                  
      COMMON/ICOM/ IBUF(8),IDAT(IJMV)                                                                                               
      COMMON/JCOM/ JBUF(8),JDAT(IJMV)                                                                                               
      EQUIVALENCE (SPRLBL1,IDAT),(SPRLBL2,JDAT)                                                                                     
                                                                                                                                    
      LOGICAL OK                                                                                                                    
                                                                                                                                    
      DATA MAXX/IJMV/,SPVAL/1.E38/                                                                                                  
      DATA ILAB1/100000*0/,ILAB2/100000*0/                                                                                          
C-----------------------------------------------------------------------                                                            
                                                                                                                                    
      NFF=4                                                                                                                         
      CALL JCLPNT(NFF,1,2,3,6)                                                                                                      
      IF (NFF.LT.4) CALL                           XIT('JOINRTD',-1)                                                                
      REWIND 1                                                                                                                      
      REWIND 2                                                                                                                      
      REWIND 3                                                                                                                      
C                                                                                                                                   
C     * DETERMINE THE LENGTH IN INPUT FILES                                                                                         
C                                                                                                                                   
C     * RTD1                                                                                                                        
C                                                                                                                                   
      CALL RECGET(1,NC4TO8("LABL"),-1,-1,-1,IBUF,MAXX,OK)                                                                           
      IF (.NOT.OK) CALL                            XIT('JOINRTD',-2)                                                                
      YEARS1=SPRLBL1(54:64)                                                                                                         
      WRITE(*,*) 'YEARS1=',YEARS1                                                                                                   
      CALL RECGET(1,NC4TO8("TIME"),-1,-1,-1,IBUF,MAXX,OK)                                                                           
      IF (.NOT.OK) CALL                            XIT('JOINRTD',-3)                                                                
      LEN1=IBUF(5)                                                                                                                  
      WRITE(*,*) 'LEN1=',LEN1                                                                                                       
C                                                                                                                                   
C     * RTD2                                                                                                                        
C                                                                                                                                   
      CALL RECGET(2,NC4TO8("LABL"),-1,-1,-1,JBUF,MAXX,OK)                                                                           
      IF (.NOT.OK) CALL                            XIT('JOINRTD',-4)                                                                
      YEARS2=SPRLBL2(54:64)                                                                                                         
      WRITE(*,*) 'YEARS2=',YEARS2                                                                                                   
      CALL RECGET(2,NC4TO8("TIME"),-1,-1,-1,JBUF,MAXX,OK)                                                                           
      IF (.NOT.OK) CALL                            XIT('JOINRTD',-5)                                                                
      LEN2=JBUF(5)                                                                                                                  
      WRITE(*,*) 'LEN2=',LEN2                                                                                                       
C                                                                                                                                   
C     * MERGED LENGTH RTD1+RTD2                                                                                                     
C                                                                                                                                   
      LEN3=LEN1+LEN2                                                                                                                
      WRITE(*,*) 'LEN3=',LEN3                                                                                                       
                                                                                                                                    
      REWIND 1                                                                                                                      
      REWIND 2                                                                                                                      
C                                                                                                                                   
C     * FIND ALL SUPERLABELS IN THE FIRST FILE                                                                                      
C                                                                                                                                   
      DO N=1,NSPLMAX                                                                                                                
        CALL RECGET(1,NC4TO8("LABL"),-1,-1,-1,IBUF,MAXX,OK)                                                                         
        IF (.NOT.OK) GOTO 10                                                                                                        
        SPRLAB1(N)=SPRLBL1(1:53)                                                                                                    
      ENDDO                                                                                                                         
 10   CONTINUE                                                                                                                      
      NSPL1=N-1                                                                                                                     
      WRITE(*,*)'NSPL1=',NSPL1                                                                                                      
C                                                                                                                                   
C     * FIND ALL SUPERLABELS IN THE 2ND FILE                                                                                        
C                                                                                                                                   
      DO N=1,NSPLMAX                                                                                                                
        CALL RECGET(2,NC4TO8("LABL"),-1,-1,-1,JBUF,MAXX,OK)                                                                         
        IF (.NOT.OK) GOTO 20                                                                                                        
        SPRLAB2(N)=SPRLBL2(1:53)                                                                                                    
      ENDDO                                                                                                                         
 20   CONTINUE                                                                                                                      
      NSPL2=N-1                                                                                                                     
      WRITE(*,*)'NSPL2=',NSPL2                                                                                                      
C                                                                                                                                   
C     * MERGE TWO SUPERLABEL SETS TOGETHER. START WITH THE 2ND SET                                                                  
C     * ILAB1 AND ILAB2 INDICATE WHETHER VARIABLE EXISTS IN RTD1 AND RTD2.                                                          
C                                                                                                                                   
      NSPL3=NSPL2                                                                                                                   
      DO N=1,NSPL3                                                                                                                  
        ILAB2(N)=1                                                                                                                  
      ENDDO                                                                                                                         
      NS=1                                                                                                                          
      DO N=1,NSPL1                                                                                                                  
        DO N1=NS,NSPL2+NS-1                                                                                                         
          N1M=MOD(N1-1,NSPL2)+1                                                                                                     
          IF(SPRLAB1(N).EQ.SPRLAB2(N1M))THEN                                                                                        
            ILAB1(N1M)=1                                                                                                            
            NS=MOD(N1,NSPL2)+1                                                                                                      
            GOTO 30                                                                                                                 
          ENDIF                                                                                                                     
        ENDDO                                                                                                                       
        NSPL3=NSPL3+1                                                                                                               
        ILAB1(NSPL3)=1                                                                                                              
        SPRLAB2(NSPL3)=SPRLAB1(N)                                                                                                   
 30     CONTINUE                                                                                                                    
      ENDDO                                                                                                                         
      WRITE(*,*)'NSPL3=',NSPL3                                                                                                      
C                                                                                                                                   
C     * PRINT ALL SUPERLABELS                                                                                                       
C                                                                                                                                   
      DO N=1,NSPL3                                                                                                                  
        WRITE(*,'(I5,A,2I5)')N,SPRLAB2(N),ILAB1(N),ILAB2(N)                                                                         
      ENDDO                                                                                                                         
C                                                                                                                                   
C     * PROCESS LABELS FROM RTD2                                                                                                    
C                                                                                                                                   
      REWIND 1                                                                                                                      
      REWIND 2                                                                                                                      
      CALL RECGET(2,NC4TO8("LABL"),-1,-1,-1,JBUF,MAXX,OK)                                                                           
      DO N=1,NSPL2                                                                                                                  
C                                                                                                                                   
C       * SAVE SUPERLABEL FROM RTD2                                                                                                 
C                                                                                                                                   
        CALL RECPUT(3,JBUF)                                                                                                         
        IF(ILAB1(N).EQ.0)THEN                                                                                                       
C                                                                                                                                   
C         * THIS RECORD DOES NOT EXIST IN RTD1                                                                                      
C                                                                                                                                   
C         * GET DATA RECORDS                                                                                                        
C                                                                                                                                   
 40       CONTINUE                                                                                                                  
          CALL RECGET(2,-1,-1,-1,-1,JBUF,MAXX,OK)                                                                                   
          IF (.NOT.OK) THEN                                                                                                         
            GOTO 80                                                                                                                 
          ENDIF                                                                                                                     
          IF(JBUF(1).EQ.NC4TO8("LABL"))THEN                                                                                         
            GOTO 70                                                                                                                 
          ELSE                                                                                                                      
C                                                                                                                                   
C           * PREPEND MISSING VALUES                                                                                                
C                                                                                                                                   
            DO I=1,LEN1                                                                                                             
              X(I)=SPVAL                                                                                                            
            ENDDO                                                                                                                   
            CALL RECUP2(Y,JBUF)                                                                                                     
            DO I=1,LEN2                                                                                                             
              X(LEN1+I)=Y(I)                                                                                                        
            ENDDO                                                                                                                   
            JBUF(5)=LEN3                                                                                                            
            CALL PUTFLD2(3,X,JBUF,MAXX)                                                                                             
            GOTO 40                                                                                                                 
          ENDIF                                                                                                                     
        ELSE                                                                                                                        
C                                                                                                                                   
C         * THIS RECORD DOES EXIST IN RTD1                                                                                          
C                                                                                                                                   
C         * GET SUPERLABEL FROM RTD1                                                                                                
C                                                                                                                                   
 50       CONTINUE                                                                                                                  
          CALL RECGET(1,NC4TO8("LABL"),-1,-1,-1,IBUF,MAXX,OK)                                                                       
          IF (.NOT.OK) THEN                                                                                                         
            REWIND 1                                                                                                                
            GOTO 50                                                                                                                 
          ENDIF                                                                                                                     
          IF(SPRLBL1(1:53).NE.SPRLBL2(1:53))THEN                                                                                    
            GOTO 50                                                                                                                 
          ENDIF                                                                                                                     
C                                                                                                                                   
C         * GET DATA RECORDS                                                                                                        
C                                                                                                                                   
 60       CONTINUE                                                                                                                  
          CALL RECGET(2,-1,-1,-1,-1,JBUF,MAXX,OK)                                                                                   
          IF (.NOT.OK) THEN                                                                                                         
            GOTO 80                                                                                                                 
          ENDIF                                                                                                                     
          IF(JBUF(1).EQ.NC4TO8("LABL"))THEN                                                                                         
            GOTO 70                                                                                                                 
          ELSE                                                                                                                      
C                                                                                                                                   
C           * MERGE RTD1 & RTD2                                                                                                     
C                                                                                                                                   
            CALL RECGET(1,-1,-1,-1,-1,IBUF,MAXX,OK)                                                                                 
            CALL RECUP2(X,IBUF)                                                                                                     
            CALL RECUP2(Y,JBUF)                                                                                                     
            DO I=1,LEN2                                                                                                             
              X(LEN1+I)=Y(I)                                                                                                        
            ENDDO                                                                                                                   
            JBUF(5)=LEN3                                                                                                            
            CALL PUTFLD2(3,X,JBUF,MAXX)                                                                                             
            GOTO 60                                                                                                                 
          ENDIF                                                                                                                     
        ENDIF                                                                                                                       
 70     CONTINUE                                                                                                                    
      ENDDO                                                                                                                         
 80   CONTINUE                                                                                                                      
C                                                                                                                                   
C     * READ THE REMAINING RECORDS FROM RTD1                                                                                        
C                                                                                                                                   
      IF(NSPL3.GT.NSPL2)THEN                                                                                                        
        DO N=NSPL2+1,NSPL3                                                                                                          
C                                                                                                                                   
C       * GET SUPERLABEL FROM RTD1                                                                                                  
C                                                                                                                                   
 90       CONTINUE                                                                                                                  
          CALL RECGET(1,NC4TO8("LABL"),-1,-1,-1,IBUF,MAXX,OK)                                                                       
          IF (.NOT.OK) THEN                                                                                                         
            REWIND 1                                                                                                                
            GOTO 90                                                                                                                 
          ENDIF                                                                                                                     
          IF(SPRLBL1(1:53).NE.SPRLAB2(N))THEN                                                                                       
            GOTO 90                                                                                                                 
          ENDIF                                                                                                                     
C                                                                                                                                   
C         * SAVE SUPERLABEL FROM RTD1                                                                                               
C                                                                                                                                   
          SPRLBL1(54:64)=YEARS2                                                                                                     
          IBUF(5)=10                                                                                                                
          CALL RECPUT(3,IBUF)                                                                                                       
C                                                                                                                                   
C         * GET DATA RECORDS                                                                                                        
C                                                                                                                                   
 100      CONTINUE                                                                                                                  
          CALL RECGET(1,-1,-1,-1,-1,IBUF,MAXX,OK)                                                                                   
          IF (.NOT.OK) THEN                                                                                                         
            GOTO 120                                                                                                                
          ENDIF                                                                                                                     
          IF(IBUF(1).EQ.NC4TO8("LABL"))THEN                                                                                         
            BACKSPACE 1                                                                                                             
            BACKSPACE 1                                                                                                             
            GOTO 110                                                                                                                
          ELSE                                                                                                                      
C                                                                                                                                   
C           * APPEND MISSING VALUES                                                                                                 
C                                                                                                                                   
            CALL RECUP2(X,IBUF)                                                                                                     
            DO I=1,LEN2                                                                                                             
              X(LEN1+I)=SPVAL                                                                                                       
            ENDDO                                                                                                                   
            IBUF(5)=LEN3                                                                                                            
            CALL PUTFLD2(3,X,IBUF,MAXX)                                                                                             
            GOTO 100                                                                                                                
          ENDIF                                                                                                                     
 110      CONTINUE                                                                                                                  
        ENDDO                                                                                                                       
      ENDIF                                                                                                                         
 120  CONTINUE                                                                                                                      
C                                                                                                                                   
C     * EXIT                                                                                                                        
C                                                                                                                                   
      CALL                                         XIT('JOINRTD',0)                                                                 
C                                                                                                                                   
C-----------------------------------------------------------------------                                                            
      END                                                                                                                           
