#! /bin/sh # # Last change: Mihai Dima 2001 # if [ $# -lt 3 ] then echo " " echo " ***** RUNNING MEANS ***** " echo " " echo " The program calculates running means " echo " " echo " Syntax: runmean " echo " " exit 0 else echo " " echo " ***** RUNNING MEANS ***** " echo " " echo "file1="$1 echo "file2="$2 echo "Averaging length="$3 cp $1 fort.1 fi cat > runmean.f < 0' PRINT *, 'ENTER NEW AVERAGE INTERVAL LENGTH (I10)' READ (5,*,END=10)NINT ELSE IF(ITEST.EQ.0) THEN PRINT *,' ERROR: AVERAGE INTERVAL LENGTH MUST BE ODD' PRINT *, 'ENTER NEW AVERAGE INTERVAL LENGTH (I10)' READ (5,*,END=20)NINT ENDIF NCHAN=1 CALL PARLES (NCHAN,NDIM,NSET) CALL RUNMEAN (NDIM,NSET,NINT) STOP 10 PRINT *,' FATAL ERROR: AVERAGE INTERVAL LENGTH = 0' STOP 20 PRINT *,' FATAL ERROR: AVERAGE INTERVAL LENGTH IS NOT ODD' STOP END C****************************************************************** SUBROUTINE PARLES (NCHAN,NDIM,NSET) IMPLICIT REAL (A-H,O-Z) C INTEGER I1,I2,I3 REAL F REWIND NCHAN READ(NCHAN,END=10) ITIME,INAME,ILEV,ISIZE REWIND NCHAN NSET=0 NDIM=0 1 READ (NCHAN,END=100) I1,I2,I3,I4 NDIM=MAX0(NDIM,I4) READ (NCHAN,END=101) NSET=NSET+1 GOTO1 101 PRINT *,' MORE HEADER THEN DATA ' 100 PRINT 1000,NCHAN,NDIM,NSET REWIND NCHAN RETURN 10 PRINT *,'INPUT FILE ON TAPE',NCHAN,' IS EMPTY' STOP 'MISTAKE' 1000 FORMAT (1X,' TAPE=',I2,', NDIM=',I5,', NSET=',I5) END C***************************************************************** SUBROUTINE RUNMEAN (IE,NTS,INTER) IMPLICIT REAL (A-H,O-Z) C C IF YOU USE THIS PROGRAM NOT ON A CRAY-2 DELETE THE C FOLLOWING TWO LINES C PARAMETER (IE77=9E12,UNDEF=0.9E+10,UNDEFE=0.99*UNDEF,MAL=2000) C DIMENSION X(IE,MAL), ID(4,MAL), JD(4), KUN(IE),XS(IE) C POINTER (NPX,X),(NPKUN,KUN),(NPXS,XS) C ALLOCATE(NPKUN,IE) C ALLOCATE(NPXS,IE) C ALLOCATE (NPX,IE*MAL) C AND ACTIVATE THE FOLLOWING TWO LINES PARAMETER (IE77=20000,MAL77=2000,UNDEF=0.9E+10,UNDEFE=0.99*UNDEF) DIMENSION X(IE77,MAL77),ID(4,MAL77),JD(4),KUN(IE77),XS(IE77) C NOW YOU HAVE DONE ALL CHANGES FOR STANDARD FORTRAN. LAVG=INTER LAVD = LAVG/2 IF(LAVD*2+1 .NE. LAVG) GOTO 19 LAVGM = LAVG - 1 ICNT = LAVD LAVDP = LAVD + 1 C C* PREPARATION. C DO 99 I = 1,IE KUN(I) = 0. DO 99 K = 1,11 99 X(I,K) = 0. C C* CHECK (TIME SERIES). C REWIND 1 READ(1,END=11) JD PRINT *, 'first record:', JD IE2 = JD(2) IE3 = JD(3) IE4 = JD(4) C C* MAIN OPERATION. C FIRST *LAVD+1* RECORDS. C REWIND 1 DO 300 K = 1,LAVG READ(1,END=17) (ID(I,K),I=1,4) IF(ID(2,K).NE.IE2) GOTO 12 IF(ID(3,K).NE.IE3) GOTO 13 C IF(ID(4,K).NE.IE4) GOTO 14 300 READ(1,END=15) (X(I,K),I=1,IE4) C C* RECORD #1. C DO 299 I=1,IE4 KUN(I) = 0 299 IF(X(I,1).LE.UNDEFE) KUN(I)=1 C DO 301 K = 2,LAVDP DO 301 I = 1,IE4 IF(X(I,K).GE.UNDEFE) GOTO 301 IF(X(I,1).LT.UNDEFE) THEN KUN(I) = KUN(I) + 1 X(I,1) = X(I,1) + X(I,K) ELSE KUN(I) = 1 X(I,1)=X(I,K) ENDIF 301 CONTINUE DO 302 I = 1, IE4 IF(X(I,1).LE.UNDEFE) THEN XS(I) = X(I,1)/KUN(I) ELSE XS(I) = X(I,1) ENDIF 302 CONTINUE WRITE(2) (ID(I,1),I=1,4) WRITE(2) (XS(I), I=1,IE4) C C* RECORDS #2...#*LAVD+1*. C DO 310 K = LAVD+2,LAVG DO 312 I = 1,IE4 IF(X(I,K).GE.UNDEFE) GOTO 312 IF(X(I,1).LT.UNDEFE) THEN KUN(I) = KUN(I) + 1 X(I,1) = X(I,1) + X(I,K) ELSE KUN(I) = 1 X(I,1)=X(I,K) ENDIF 312 CONTINUE DO 313 I = 1, IE4 313 IF(X(I,1).LE.UNDEFE) XS(I) = X(I,1)/KUN(I) WRITE(2) (ID(I,K-LAVD),I=1,4) 310 WRITE(2) (XS(I), I=1,IE4) C C* "INNER RECORDS" #*LAVD+2* ... #N - LAVD-1 (N ALL). C 100 READ(1,END=200) JD IF(JD(2).NE.IE2) GOTO 12 IF(JD(3).NE.IE3) GOTO 13 C IF(JD(4).NE.IE4) GOTO 14 ICNT=ICNT+1 DO 101 K = 1,LAVGM DO 102 I = 1,IE4 102 X(I,K) = X(I,K+1) DO 103 I = 1,4 103 ID(I,K) = ID(I,K+1) 101 CONTINUE DO 104 I = 1,4 104 ID(I,LAVG) = JD(I) READ(1,END=15) (X(I,LAVG),I=1,IE4) DO 110 I = 1,IE4 KUN(I) = 0 IF(X(I,1).LE.UNDEFE) KUN(I)=1 DO 110 K = 2, LAVG IF(X(I,K).GE.UNDEFE) GOTO 110 IF(X(I,1).LT.UNDEFE) THEN KUN(I) = KUN(I) + 1 X(I,1) = X(I,1) + X(I,K) ELSE KUN(I) = 1 X(I,1)=X(I,K) ENDIF 110 CONTINUE DO 111 I = 1, IE4 111 IF(X(I,1).LE.UNDEFE) X(I,1) = X(I,1)/KUN(I) WRITE(2) (ID(I,LAVDP),I=1,4) WRITE(2) (X(I,1),I=1,IE4) GOTO 100 C C* LAST RUNNING MEANS. C 200 CONTINUE DO 201 K = 1,LAVD ICNT = ICNT + 1 DO 202 I = 1,IE4 X(I,1) = UNDEF KUN(I) = 0. DO 202 L = K+1,LAVG IF(X(I,L).GE.UNDEFE) GOTO 202 IF(X(I,1).LT.UNDEFE) THEN KUN(I) = KUN(I) + 1 X(I,1) = X(I,1) + X(I,L) ELSE KUN(I) = 1 X(I,1)=X(I,L) ENDIF 202 CONTINUE DO 203 I = 1, IE4 IF(X(I,1).LE.UNDEFE) X(I,1) = X(I,1)/KUN(I) 203 CONTINUE WRITE(2) (ID(I,LAVDP+K),I=1,4) WRITE(2) (X(I,1),I=1,IE4) 201 CONTINUE GOTO 9920 C C* ABNORMAL TERMINATION. C 11 WRITE(6,6010) ' EMPTY ' GOTO 9910 12 WRITE(6,6010) 'VARIABLE DOES NOT MATCH:', JD, IE2, ICNT GOTO 9910 13 WRITE(6,6010) 'LEVEL DOES NOT MATCH:', JD, IE3, ICNT GOTO 9910 14 WRITE(6,6010) 'RECORD LENGTH INSUFFICIENT:', JD, IE4, ICNT GOTO 9910 15 WRITE(6,6010) 'READ ERROR: ', JD, ICNT GOTO 9910 17 WRITE(6,6010) 'UNEXPECTED *EOF* AT RECORD',K GOTO 9910 19 WRITE(6,6010) 'AVERAGE INTERVAL LENGTH EVEN: ', LAVG GOTO 9910 9910 CONTINUE C C* CAUSE AN ABORT. C STOP C C* NORMAL TERMINATION. C 9920 PRINT *, ' Last record: ', JD, ICNT PRINT *, '*RUNMEAN*: normal' STOP 6010 FORMAT(' *RUNMEAN*: ', A,6I10,/1X,8I10) END EOF f77 runmean.f -o runmean.x runmean.x $1 $2 << M $3 M cp fort.2 $2 rm fort.1 fort.2 rm runmean.x runmean.f exit