      PROGRAM MOVAVG                                                                                                                
C     PROGRAM MOVAVG (XIN,      XMA,      INPUT,      OUTPUT,           )       C2                                                  
C    1          TAPE1=XIN,TAPE2=XMA,TAPE5=INPUT,TAPE6=OUTPUT)                                                                       
C     -------------------------------------------------------                   C2                                                  
C                                                                               C2                                                  
C     JAN 04/10 - S.KHARIN (RESPECT SPECIAL VALUES IN TIME SERIES)              C2                                                  
C     DEC 04/09 - S.KHARIN (BUGFIX FOR CASE OF TIME SERIES LENGTH < 10)                                                             
C     NOV 30/09 - S.KHARIN (BUGFIX FOR CASE OF TIME SERIES LENGTH < 5)                                                              
C     NOV 26/09 - S.KHARIN (ADD LEND INPUT CARD PARAMETER)                                                                          
C     JUL 06/09 - F.MAJAESS (SWITCH "JCLPNT1" REFERENCES TO "JCLPNT")                                                               
C     APR 12/07 - S.KHARIN (CHANGE ".movavg_copy_" REFERENCE TO ".XXX_copy_")                                                       
C     SEP 30/04 - S.KHARIN (CREATE A COPY OF INPUT FILE INTERNALLY.                                                                 
C                           EXTEND TO MULTI-LEVEL FIELDS AND TIME SERIES)                                                           
C     SEP 01/97 - GJB (ORIGINAL VERSION)                                                                                            
C                                                                               C2                                                  
CMOVAVG  - MOVING AVERAGE ON INPUT FILE                                 1  1 C  C1                                                  
C                                                                               C3                                                  
CAUTHOR  - G.J.BOER                                                             C3                                                  
C                                                                               C3                                                  
CPURPOSE - MOVING AVERAGE PROGRAM                                               C3                                                  
C          NOTE - A COPY OF INPUT FILE WILL BE CREATED INTERNALLY.              C3                                                  
C                                                                               C3                                                  
CINPUT FILE...                                                                  C3                                                  
C                                                                               C3                                                  
C      XIN = INPUT FILE (REAL OR COMPLEX, MULTILEVEL)                           C3                                                  
C                                                                               C3                                                  
COUTPUT FILE...                                                                 C3                                                  
C                                                                               C3                                                  
C      XMA = MOVING AVERAGE OF XIN                                              C3                                                  
C                                                                                                                                   
CINPUT PARAMETERS...                                                                                                                
C                                                                               C5                                                  
C      MAVG = LENGTH OF MOVING AVERAGE WINDOW                                   C5                                                  
C      NSKP = SKIP THE FIRST NSKP RECORDS (DEFAULT NSKP=0)                      C5                                                  
C      LEND = 1, APPEND MISSING VALUES AT THE ENDS TO KEEP THE LENGTH OF OUTPUT C5                                                  
C                TIME SERIES THE SAME AS THAT IN THE INPUT FILE.                C5                                                  
C                IF MAVG IS AN ODD NUMBER, (MAVG-1)/2 RECORDS ARE APPENDED AT   C5                                                  
C                THE BEGINNING AND THE END OF OUTPUT FILE.                      C5                                                  
C                IF MAVG IS AN EVEN NUMBER, MAVG/2 RECORDS PREPPENDED AT        C5                                                  
C                THE BEGINNING, AND MAVG2/-1 RECORDS APPENDED AT THE END.       C5                                                  
C             OTHERWISE, OUTPUT FILE WILL BE (MAVG-1)*NLEV RECORDS SHORTER.     C5                                                  
C                                                                               C5                                                  
CEXAMPLE OF INPUT CARD...                                                       C5                                                  
C                                                                               C5                                                  
C*MOVAVG      5                                                                 C5                                                  
C (5-TIMESTEP MOVING AVERAGE. OUTPUT FILE WILL BE SHORTER BY 4*NLEV RECORDS)    C5                                                  
C                                                                               C5                                                  
C*MOVAVG      5         1                                                       C5                                                  
C (5-TIMESTEP MOVING AVERAGE. OUTPUT FILE WILL BE OF THE SAME SIZE AS INPUT     C5                                                  
C  FILE BY APPENDING MISSING VALUES AT BOTH ENDS.                               C5                                                  
C----------------------------------------------------------------------------                                                       
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      REAL A(1852800),B(65341),C(65341)                                                                                             
      INTEGER IA(1852800),IB(1852800)                                                                                               
C                                                                                                                                   
      LOGICAL OK,SPEC                                                                                                               
      COMMON/ICOM/IBUF(8),IDAT(65341)                                                                                               
      INTEGER LEV(100),JBUF(8)                                                                                                      
                                                                                                                                    
      CHARACTER*128 ARG(90)                                                                                                         
                                                                                                                                    
C     * ARG - ARRAY WITH COMMAND LINE ARGUMENTS                                                                                     
                                                                                                                                    
      COMMON /JCLPNTA/ ARG                                                                                                          
                                                                                                                                    
      REAL SPVAL,SPVALT                                                                                                             
      DATA SPVAL/1.E+38/,SPVALT/1.E32/                                                                                              
                                                                                                                                    
      DATA MAXX,MAXG,MAXL,MAXRSZ/65341,1852800,100,65341/                                                                           
C---------------------------------------------------------------------                                                              
      NFF=4                                                                                                                         
      CALL JCLPNT(NFF,1,2,5,6)                                                                                                      
      REWIND 1                                                                                                                      
      REWIND 2                                                                                                                      
C                                                                                                                                   
C     * READ INPUT CARD.                                                                                                            
C                                                                                                                                   
      READ(5,5010,END=900) MAVG,NSKP,LEND                                       C4                                                  
      WRITE(6,6010) MAVG,NSKP,LEND                                                                                                  
                                                                                                                                    
      IF (MAVG.LE.0.OR.NSKP.LT.0)CALL              XIT('MOVAVG',-1)                                                                 
      FAC=1.0E0/FLOAT(MAVG)                                                                                                         
C                                                                                                                                   
C     * FIND THE NUMBER OF LEVELS, TYPE OF DATA, ETC...                                                                             
C                                                                                                                                   
      CALL FILEV(LEV,NLEV,IBUF,1)                                                                                                   
      IF (NLEV.EQ.0) THEN                                                                                                           
        WRITE(6,6020)                                                                                                               
        CALL                                       XIT('MOVAVG',-2)                                                                 
      ENDIF                                                                                                                         
      IF (NLEV.GT.MAXL) CALL                       XIT('MOVAVG',-3)                                                                 
      KIND=IBUF(1)                                                                                                                  
      NAME=IBUF(3)                                                                                                                  
      NWDS=IBUF(5)*IBUF(6)                                                                                                          
      SPEC=(KIND.EQ.NC4TO8("FOUR").OR.KIND.EQ.NC4TO8("SPEC"))                                                                       
      IF (SPEC) NWDS=NWDS*2                                                                                                         
      IF (NWDS.GT.MAXRSZ.OR.NWDS*NLEV.GT.MAXG)CALL XIT('MOVAVG',-4)                                                                 
      WRITE(6,6030) NAME,NLEV,(LEV(NL),NL=1,NLEV)                                                                                   
      CALL PRTLAB(IBUF)                                                                                                             
      REWIND 1                                                                                                                      
                                                                                                                                    
      IF(KIND.EQ.NC4TO8("TIME")) GO TO 200                                                                                          
                                                                                                                                    
C                                                                                                                                   
C     * CREATE A COPY OF INPUT FILE                                                                                                 
C                                                                                                                                   
      WRITE(6,'(A)')'CREATE A COPY OF INPUT FILE.'                                                                                  
      CALL SYSTEM('\cp '//ARG(1)//' .XXX_copy_'//ARG(1))                                                                            
      OPEN(3,FILE='.XXX_copy_'//ARG(1),                                                                                             
     1     STATUS='OLD', FORM='UNFORMATTED',ERR=910)                                                                                
      REWIND 3                                                                                                                      
C                                                                                                                                   
C     * SKIP FIRST NSKP TIME STEPS                                                                                                  
C                                                                                                                                   
      DO N=1,NSKP                                                                                                                   
        DO NL=1,NLEV                                                                                                                
          CALL RECGET(1,-1,-1,-1,LEV(NL),IBUF,MAXX,OK)                                                                              
          IF(.NOT.OK) CALL                         XIT('MOVAVG',-5)                                                                 
        ENDDO                                                                                                                       
      ENDDO                                                                                                                         
C                                                                                                                                   
C     * READ THE FIRST RECORD IN THE MOVING AVERAGE                                                                                 
C                                                                                                                                   
      NR=NSKP                                                                                                                       
      NB=0                                                                                                                          
      DO NL=1,NLEV                                                                                                                  
        IW=(NL-1)*NWDS                                                                                                              
        CALL GETFLD2(1,A(IW+1),-1,-1,-1,LEV(NL),IBUF,MAXX,OK)                                                                       
        IF(.NOT.OK) CALL                           XIT('MOVAVG',-6)                                                                 
      ENDDO                                                                                                                         
      DO I=1,8                                                                                                                      
        JBUF(I)=IBUF(I)                                                                                                             
      ENDDO                                                                                                                         
      NR=NR+1                                                                                                                       
      NB=NB+1                                                                                                                       
      NBEG=MAVG/2                                                                                                                   
C                                                                                                                                   
C     * READ AND ACCUMULATE MAVG TIME STEPS                                                                                         
C                                                                                                                                   
      IF (MAVG.EQ.1) GO TO 110                                                                                                      
C                                                                                                                                   
C     * PREPEND MISSING VALUES AT THE BEGINNING, IF REQUESTED                                                                       
C                                                                                                                                   
      IF(LEND.EQ.1)THEN                                                                                                             
        DO I=1,NWDS                                                                                                                 
          B(I)=SPVAL                                                                                                                
        ENDDO                                                                                                                       
        IBUF(8)=1                                                                                                                   
        DO NL=1,NLEV                                                                                                                
          IBUF(4)=LEV(NL)                                                                                                           
          CALL PUTFLD2(2,B,IBUF,MAXX)                                                                                               
        ENDDO                                                                                                                       
      ENDIF                                                                                                                         
      DO N=2,MAVG                                                                                                                   
        DO NL=1,NLEV                                                                                                                
          IW=(NL-1)*NWDS                                                                                                            
          CALL GETFLD2(1,B,-1,-1,-1,LEV(NL),IBUF,MAXX,OK)                                                                           
          IF(.NOT.OK) CALL                         XIT('MOVAVG',-7)                                                                 
C                                                                                                                                   
C         * MAKE SURE THAT THE FIELDS ARE THE SAME KIND AND SIZE.                                                                   
C                                                                                                                                   
          CALL CMPLBL(0,IBUF,0,JBUF,OK)                                                                                             
          IF(.NOT.OK)THEN                                                                                                           
            CALL PRTLAB (IBUF)                                                                                                      
            CALL PRTLAB (JBUF)                                                                                                      
            CALL                                   XIT('MOVAVG',-8)                                                                 
          ENDIF                                                                                                                     
          DO I=1,NWDS                                                                                                               
            A(IW+I)=A(IW+I)+B(I)                                                                                                    
          ENDDO                                                                                                                     
        ENDDO                                                                                                                       
C                                                                                                                                   
C     * PREPEND MISSING VALUES AT THE BEGINNING, IF REQUESTED                                                                       
C                                                                                                                                   
        IF(LEND.EQ.1.AND.N.LE.NBEG)THEN                                                                                             
          DO I=1,NWDS                                                                                                               
            B(I)=SPVAL                                                                                                              
          ENDDO                                                                                                                     
          IBUF(8)=1                                                                                                                 
          DO NL=1,NLEV                                                                                                              
            IBUF(4)=LEV(NL)                                                                                                         
            CALL PUTFLD2(2,B,IBUF,MAXX)                                                                                             
          ENDDO                                                                                                                     
        ENDIF                                                                                                                       
        NR=NR+1                                                                                                                     
      ENDDO                                                                                                                         
C                                                                                                                                   
C     * GET MOVING AVERAGE                                                                                                          
C                                                                                                                                   
 110  CONTINUE                                                                                                                      
      DO NL=1,NLEV                                                                                                                  
        IW=(NL-1)*NWDS                                                                                                              
        DO I=1,NWDS                                                                                                                 
          A(IW+I)=A(IW+I)*FAC                                                                                                       
        ENDDO                                                                                                                       
C                                                                                                                                   
C       * SAVE THE RESULT WITH IBUF THAT OF THE LAST                                                                                
C       * RECORD IN THE BLOCK.                                                                                                      
C                                                                                                                                   
        IBUF(4)=LEV(NL)                                                                                                             
        CALL PUTFLD2(2,A(IW+1),IBUF,MAXX)                                                                                           
      ENDDO                                                                                                                         
C                                                                                                                                   
C     * SKIP FIRST NSKP TIME STEPS                                                                                                  
C                                                                                                                                   
      DO N=1,NSKP                                                                                                                   
        DO NL=1,NLEV                                                                                                                
          CALL RECGET(3,-1,-1,-1,LEV(NL),IBUF,MAXX,OK)                                                                              
          IF(.NOT.OK) CALL                         XIT('MOVAVG',-9)                                                                 
        ENDDO                                                                                                                       
      ENDDO                                                                                                                         
C                                                                                                                                   
C     * NOW FORM MOVING AVERAGES BY ADDING B(MAVG+I)*FAC AND SUBTRACTING C(I)*FAC                                                   
C                                                                                                                                   
 120  CONTINUE                                                                                                                      
      DO NL=1,NLEV                                                                                                                  
        IW=(NL-1)*NWDS                                                                                                              
        CALL GETFLD2(3,C,-1,-1,-1,LEV(NL),IBUF,MAXX,OK)                                                                             
        IF(.NOT.OK) THEN                                                                                                            
          WRITE(6,6045)                                                                                                             
          CALL                                     XIT('MOVAVG',-10)                                                                
        ENDIF                                                                                                                       
        CALL GETFLD2(1,B,-1,-1,-1,LEV(NL),IBUF,MAXX,OK)                                                                             
        IF(.NOT.OK)THEN                                                                                                             
          IF(NL.NE.1) CALL                         XIT('MOVAVG',-11)                                                                
          CALL PRTLAB(IBUF)                                                                                                         
C                                                                                                                                   
C         * REMOVE COPY OF INPUT FILE                                                                                               
C                                                                                                                                   
          WRITE(6,'(A)') 'REMOVE COPY OF INPUT FILE.'                                                                               
          CALL SYSTEM('\rm .XXX_copy_'//ARG(1))                                                                                     
C                                                                                                                                   
C         * APPEND MISSING VALUES AT THE END, IF REQUESTED                                                                          
C                                                                                                                                   
          IF(LEND.EQ.1)THEN                                                                                                         
            DO N=1,MAVG-NBEG-1                                                                                                      
              DO I=1,NWDS                                                                                                           
                B(I)=SPVAL                                                                                                          
              ENDDO                                                                                                                 
              IBUF(2)=NTIME                                                                                                         
              IBUF(8)=1                                                                                                             
              DO NL1=1,NLEV                                                                                                         
                IBUF(4)=LEV(NL1)                                                                                                    
                CALL PUTFLD2(2,B,IBUF,MAXX)                                                                                         
              ENDDO                                                                                                                 
            ENDDO                                                                                                                   
            NB=NR                                                                                                                   
          ENDIF                                                                                                                     
          WRITE(6,6040) NR,NB                                                                                                       
          CALL                                     XIT('MOVAVG',0)                                                                  
        ENDIF                                                                                                                       
        NTIME=IBUF(2)                                                                                                               
C                                                                                                                                   
C       * MAKE SURE THAT ALL RECORDS HAVE THE SAME NAME, KIND AND SIZE.                                                             
C                                                                                                                                   
        CALL CMPLBL(0,IBUF,0,JBUF,OK)                                                                                               
        IF (.NOT.OK .OR. IBUF(3).NE.JBUF(3)) THEN                                                                                   
          CALL PRTLAB (IBUF)                                                                                                        
          CALL PRTLAB (JBUF)                                                                                                        
          CALL                                     XIT('MOVAVG',-12)                                                                
        ENDIF                                                                                                                       
        DO I=1,NWDS                                                                                                                 
          A(IW+I)=A(IW+I)+(B(I)-C(I))*FAC                                                                                           
        ENDDO                                                                                                                       
C                                                                                                                                   
C       * SAVE THE RESULT WITH IBUF THAT OF THE LAST                                                                                
C       * RECORD IN THE BLOCK                                                                                                       
C                                                                                                                                   
        IBUF(4)=LEV(NL)                                                                                                             
        CALL PUTFLD2(2,A(IW+1),IBUF,MAXX)                                                                                           
      ENDDO                                                                                                                         
      NR=NR+1                                                                                                                       
      NB=NB+1                                                                                                                       
                                                                                                                                    
      GO TO 120                                                                                                                     
C                                                                                                                                   
C-------------------------------------------------------------------------------                                                    
C                                                                                                                                   
 200  CONTINUE                                                                                                                      
C                                                                                                                                   
C     * INPUT FILE CONTAIN TIME SERIES (KIND=4HTIME)                                                                                
C                                                                                                                                   
      NR=0                                                                                                                          
      FAC=1.0E0/FLOAT(MAVG)                                                                                                         
 210  CALL GETFLD2(1,A,NC4TO8("TIME"),-1,-1,-1,IBUF,MAXX,OK)                                                                        
      IF(.NOT.OK) THEN                                                                                                              
        CALL PRTLAB(IBUF)                                                                                                           
        WRITE(6,6060) NR                                                                                                            
        CALL                                       XIT('MOVAVG',0)                                                                  
      ENDIF                                                                                                                         
      NR=NR+1                                                                                                                       
      NTIME=IBUF(5)                                                                                                                 
      NTOUT=NTIME-MAVG+1-NSKP                                                                                                       
      IF(NTOUT.LE.0.AND.LEND.NE.1)CALL             XIT('MOVAVG',-13)                                                                
      NBEG=MAVG/2                                                                                                                   
C                                                                                                                                   
C     * REPLACE MISSING VALUES WITH ZEROS                                                                                           
C                                                                                                                                   
      DO I=1,NTIME                                                                                                                  
        IF(ABS(A(I)-SPVAL).LT.SPVALT)THEN                                                                                           
          A(I)=0.E0                                                                                                                 
          IA(I)=0                                                                                                                   
        ELSE                                                                                                                        
          IA(I)=1                                                                                                                   
        ENDIF                                                                                                                       
      ENDDO                                                                                                                         
C                                                                                                                                   
C     * PREPEND MISSING VALUES AT THE BEGGINING, IF REQUESTED                                                                       
C                                                                                                                                   
      IF(LEND.EQ.1)THEN                                                                                                             
        DO I=1,NBEG                                                                                                                 
          B(I)=SPVAL                                                                                                                
        ENDDO                                                                                                                       
        IBUF(8)=1                                                                                                                   
        I1=NBEG+1                                                                                                                   
      ELSE                                                                                                                          
        I1=1                                                                                                                        
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * GET MOVING AVERAGES                                                                                                         
C                                                                                                                                   
      IF(NTIME-NSKP.GE.MAVG)THEN                                                                                                    
        B(I1)=0.E0                                                                                                                  
        IB(I1)=0                                                                                                                    
        DO I=1,MAVG                                                                                                                 
           B(I1)= B(I1)+ A(I+NSKP)                                                                                                  
          IB(I1)=IB(I1)+IA(I+NSKP)                                                                                                  
        ENDDO                                                                                                                       
        DO I=2,NTOUT                                                                                                                
           B(I+I1-1)= B(I+I1-2)+( A(I+MAVG+NSKP-1)- A(I+NSKP-1))                                                                    
          IB(I+I1-1)=IB(I+I1-2)+(IA(I+MAVG+NSKP-1)-IA(I+NSKP-1))                                                                    
        ENDDO                                                                                                                       
        DO I=1,NTOUT                                                                                                                
          IF(IB(I+I1-1).EQ.MAVG)THEN                                                                                                
            B(I+I1-1)=B(I+I1-1)*FAC                                                                                                 
          ELSE                                                                                                                      
            B(I+I1-1)=SPVAL                                                                                                         
          ENDIF                                                                                                                     
        ENDDO                                                                                                                       
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * APPEND MISSING VALUES AT THE END, IF REQUESTED                                                                              
C                                                                                                                                   
      IF(LEND.EQ.1)THEN                                                                                                             
        DO I=NTOUT+NBEG+1,NTIME-NSKP                                                                                                
          B(I)=SPVAL                                                                                                                
        ENDDO                                                                                                                       
        NTOUT=NTIME                                                                                                                 
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * SAVE THE RESULT                                                                                                             
C                                                                                                                                   
      IBUF(5)=NTOUT                                                                                                                 
      CALL PUTFLD2(2,B,IBUF,MAXX)                                                                                                   
                                                                                                                                    
      IF(NR.EQ.1) THEN                                                                                                              
        CALL PRTLAB(IBUF)                                                                                                           
        WRITE(6,6050)NTIME,NTOUT                                                                                                    
      ENDIF                                                                                                                         
                                                                                                                                    
      GO TO 210                                                                                                                     
C                                                                                                                                   
C     * E.O.F. ON INPUT.                                                                                                            
C                                                                                                                                   
 900  CALL                                         XIT('MOVAVG',-14)                                                                
 910  CALL                                         XIT('MOVAVG',-15)                                                                
C---------------------------------------------------------------------                                                              
 5010 FORMAT(10X,3I5)                                                           C4                                                  
 6010 FORMAT('0MOVING AVERAGE OF SIZE=',I5,'  NSKP=',I5,'  LEND=',I5)                                                               
 6020 FORMAT('0..MOVAVG *** ERROR: INPUT FILE IS EMPTY.')                                                                           
 6030 FORMAT('0NAME =',A4/'0NLEVS =',I5/                                                                                            
     1       '0LEVELS = ',15I6/100(10X,15I6/))                                                                                      
 6040 FORMAT('0MOVAVG READ',I10,' TIMESTEPS. SAVED',I10,' TIMESTEPS.')                                                              
 6045 FORMAT('0..MOVAVG 2ND INPUT FILE MUST BE A COPY OF THE 1ST ONE')                                                              
 6050 FORMAT('0MOVAVG  INPUT TIME SERIES LENGTH=',I10/                                                                              
     1       '0MOVAVG OUTPUT TIME SERIES LENGTH=',I10)                                                                              
 6060 FORMAT('0READ ',I10,' TIME SERIES.')                                                                                          
      END                                                                                                                           
