C ALGORITHM 462, COLLECTED ALGORITHMS FROM ACM. C THIS WORK PUBLISHED IN COMMUNICATIONS OF THE ACM C VOL. 16, NO. 10, October, 1973, P.638. #! /bin/sh # This is a shell archive, meaning: # 1. Remove everything above the #! /bin/sh line. # 2. Save the resulting text in a file. # 3. Execute the file with /bin/sh (not csh) to create the files: # Fortran/ # Fortran/Dp/ # Fortran/Dp/Drivers/ # Fortran/Dp/Drivers/Makefile # Fortran/Dp/Drivers/driver.f # Fortran/Dp/Drivers/res # Fortran/Dp/Src/ # Fortran/Dp/Src/erf.f # Fortran/Dp/Src/src.f # This archive created: Thu Dec 15 13:28:10 2005 export PATH; PATH=/bin:$PATH if test ! -d 'Fortran' then mkdir 'Fortran' fi cd 'Fortran' if test ! -d 'Dp' then mkdir 'Dp' fi cd 'Dp' if test ! -d 'Drivers' then mkdir 'Drivers' fi cd 'Drivers' if test -f 'Makefile' then echo shar: will not over-write existing file "'Makefile'" else cat << "SHAR_EOF" > 'Makefile' all: Res src.o: src.f $(F77) $(F77OPTS) -c src.f erf.o: erf.f $(F77) $(F77OPTS) -c erf.f driver.o: driver.f $(F77) $(F77OPTS) -c driver.f DRIVERS= driver RESULTS= Res Objs1= driver.o src.o erf.o driver: $(Objs1) $(F77) $(F77OPTS) -o driver $(Objs1) $(SRCLIBS) Res: driver ./driver >Res diffres:Res res echo "Differences in results from driver" $(DIFF) Res res clean: rm -rf *.o $(DRIVERS) $(CLEANUP) $(RESULTS) SHAR_EOF fi # end of overwriting check if test -f 'driver.f' then echo shar: will not over-write existing file "'driver.f'" else cat << "SHAR_EOF" > 'driver.f' program main c*********************************************************************** c cc TOMS462_PRB tests BIVNOR. c implicit none double precision ah double precision ak double precision bivnor double precision cdf double precision expect double precision r write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TOMS462_PRB' write ( *, '(a)' ) ' Test TOMS algorithm 462,' write ( *, '(a)' ) ' bivariate normal distribution.' write ( *, '(a)' ) ' ' write ( *, '(a)' ) ' ' write ( *, '(a)' ) & ' H K R BIVNOR EXPECT' write ( *, '(a)' ) ' ' ah = 0.8D+00 ak = -1.5D+00 r = -0.9D+00 expect = 0.148D+00 cdf = bivnor ( ah, ak, r ) write ( *, '(2x,f9.5,2x,f9.5,2x,f9.5,2x,g14.6,2x,g14.6)' ) & ah, ak, r, cdf, expect ah = 0.6D+00 ak = -1.4D+00 r = -0.7D+00 expect = 0.208D+00 cdf = bivnor ( ah, ak, r ) write ( *, '(2x,f9.5,2x,f9.5,2x,f9.5,2x,g14.6,2x,g14.6)' ) & ah, ak, r, cdf, expect ah = 0.2D+00 ak = -1.0D+00 r = -0.5D+00 expect = 0.304D+00 cdf = bivnor ( ah, ak, r ) write ( *, '(2x,f9.5,2x,f9.5,2x,f9.5,2x,g14.6,2x,g14.6)' ) & ah, ak, r, cdf, expect ah = -1.2D+00 ak = 0.1D+00 r = 0.0D+00 expect = 0.407D+00 cdf = bivnor ( ah, ak, r ) write ( *, '(2x,f9.5,2x,f9.5,2x,f9.5,2x,g14.6,2x,g14.6)' ) & ah, ak, r, cdf, expect ah = -1.2D+00 ak = -0.1D+00 r = 0.3D+00 expect = 0.501D+00 cdf = bivnor ( ah, ak, r ) write ( *, '(2x,f9.5,2x,f9.5,2x,f9.5,2x,g14.6,2x,g14.6)' ) & ah, ak, r, cdf, expect ah = -0.4D+00 ak = -0.9D+00 r = 0.6D+00 expect = 0.601D+00 cdf = bivnor ( ah, ak, r ) write ( *, '(2x,f9.5,2x,f9.5,2x,f9.5,2x,g14.6,2x,g14.6)' ) & ah, ak, r, cdf, expect write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TOMS462_PRB' write ( *, '(a)' ) ' Normal end of execution.' stop end SHAR_EOF fi # end of overwriting check if test -f 'res' then echo shar: will not over-write existing file "'res'" else cat << "SHAR_EOF" > 'res' TOMS462_PRB Test TOMS algorithm 462, bivariate normal distribution. H K R BIVNOR EXPECT 0.80000 -1.50000 -0.90000 0.147355 0.148000 0.60000 -1.40000 -0.70000 0.208116 0.208000 0.20000 -1.00000 -0.50000 0.304155 0.304000 -1.20000 0.10000 0.00000 0.407220 0.407000 -1.20000 -0.10000 0.30000 0.501097 0.501000 -0.40000 -0.90000 0.60000 0.601731 0.601000 TOMS462_PRB Normal end of execution. SHAR_EOF fi # end of overwriting check cd .. if test ! -d 'Src' then mkdir 'Src' fi cd 'Src' if test -f 'erf.f' then echo shar: will not over-write existing file "'erf.f'" else cat << "SHAR_EOF" > 'erf.f' SUBROUTINE CALERF(ARG,RESULT,JINT) C------------------------------------------------------------------ C C This packet evaluates erf(x), erfc(x), and exp(x*x)*erfc(x) C for a real argument x. It contains three FUNCTION type C subprograms: ERF, ERFC, and ERFCX (or DERF, DERFC, and DERFCX), C and one SUBROUTINE type subprogram, CALERF. The calling C statements for the primary entries are: C C Y=ERF(X) (or Y=DERF(X)), C C Y=ERFC(X) (or Y=DERFC(X)), C and C Y=ERFCX(X) (or Y=DERFCX(X)). C C The routine CALERF is intended for internal packet use only, C all computations within the packet being concentrated in this C routine. The function subprograms invoke CALERF with the C statement C C CALL CALERF(ARG,RESULT,JINT) C C where the parameter usage is as follows C C Function Parameters for CALERF C call ARG Result JINT C C ERF(ARG) ANY REAL ARGUMENT ERF(ARG) 0 C ERFC(ARG) ABS(ARG) .LT. XBIG ERFC(ARG) 1 C ERFCX(ARG) XNEG .LT. ARG .LT. XMAX ERFCX(ARG) 2 C C The main computation evaluates near-minimax approximations C from "Rational Chebyshev approximations for the error function" C by W. J. Cody, Math. Comp., 1969, PP. 631-638. This C transportable program uses rational functions that theoretically C approximate erf(x) and erfc(x) to at least 18 significant C decimal digits. The accuracy achieved depends on the arithmetic C system, the compiler, the intrinsic functions, and proper C selection of the machine-dependent constants. C C******************************************************************* C******************************************************************* C C Explanation of machine-dependent constants C C XMIN = the smallest positive floating-point number. C XINF = the largest positive finite floating-point number. C XNEG = the largest negative argument acceptable to ERFCX; C the negative of the solution to the equation C 2*exp(x*x) = XINF. C XSMALL = argument below which erf(x) may be represented by C 2*x/sqrt(pi) and above which x*x will not underflow. C A conservative value is the largest machine number X C such that 1.0 + X = 1.0 to machine precision. C XBIG = largest argument acceptable to ERFC; solution to C the equation: W(x) * (1-0.5/x**2) = XMIN, where C W(x) = exp(-x*x)/[x*sqrt(pi)]. C XHUGE = argument above which 1.0 - 1/(2*x*x) = 1.0 to C machine precision. A conservative value is C 1/[2*sqrt(XSMALL)] C XMAX = largest acceptable argument to ERFCX; the minimum C of XINF and 1/[sqrt(pi)*XMIN]. C C Approximate values for some important machines are: C C XMIN XINF XNEG XSMALL C C CDC 7600 (S.P.) 3.13E-294 1.26E+322 -27.220 7.11E-15 C CRAY-1 (S.P.) 4.58E-2467 5.45E+2465 -75.345 7.11E-15 C IEEE (IBM/XT, C SUN, etc.) (S.P.) 1.18E-38 3.40E+38 -9.382 5.96E-8 C IEEE (IBM/XT, C SUN, etc.) (D.P.) 2.23D-308 1.79D+308 -26.628 1.11D-16 C IBM 195 (D.P.) 5.40D-79 7.23E+75 -13.190 1.39D-17 C UNIVAC 1108 (D.P.) 2.78D-309 8.98D+307 -26.615 1.73D-18 C VAX D-Format (D.P.) 2.94D-39 1.70D+38 -9.345 1.39D-17 C VAX G-Format (D.P.) 5.56D-309 8.98D+307 -26.615 1.11D-16 C C C XBIG XHUGE XMAX C C CDC 7600 (S.P.) 25.922 8.39E+6 1.80X+293 C CRAY-1 (S.P.) 75.326 8.39E+6 5.45E+2465 C IEEE (IBM/XT, C SUN, etc.) (S.P.) 9.194 2.90E+3 4.79E+37 C IEEE (IBM/XT, C SUN, etc.) (D.P.) 26.543 6.71D+7 2.53D+307 C IBM 195 (D.P.) 13.306 1.90D+8 7.23E+75 C UNIVAC 1108 (D.P.) 26.582 5.37D+8 8.98D+307 C VAX D-Format (D.P.) 9.269 1.90D+8 1.70D+38 C VAX G-Format (D.P.) 26.569 6.71D+7 8.98D+307 C C******************************************************************* C******************************************************************* C C Error returns C C The program returns ERFC = 0 for ARG .GE. XBIG; C C ERFCX = XINF for ARG .LT. XNEG; C and C ERFCX = 0 for ARG .GE. XMAX. C C C Intrinsic functions required are: C C ABS, AINT, EXP C C C Author: W. J. Cody C Mathematics and Computer Science Division C Argonne National Laboratory C Argonne, IL 60439 C C Latest modification: March 19, 1990 C C------------------------------------------------------------------ INTEGER I,JINT CS REAL DOUBLE PRECISION 1 A,ARG,B,C,D,DEL,FOUR,HALF,P,ONE,Q,RESULT,SIXTEN,SQRPI, 2 TWO,THRESH,X,XBIG,XDEN,XHUGE,XINF,XMAX,XNEG,XNUM,XSMALL, 3 Y,YSQ,ZERO DIMENSION A(5),B(4),C(9),D(8),P(6),Q(5) C------------------------------------------------------------------ C Mathematical constants C------------------------------------------------------------------ CS DATA FOUR,ONE,HALF,TWO,ZERO/4.0E0,1.0E0,0.5E0,2.0E0,0.0E0/, CS 1 SQRPI/5.6418958354775628695E-1/,THRESH/0.46875E0/, CS 2 SIXTEN/16.0E0/ DATA FOUR,ONE,HALF,TWO,ZERO/4.0D0,1.0D0,0.5D0,2.0D0,0.0D0/, 1 SQRPI/5.6418958354775628695D-1/,THRESH/0.46875D0/, 2 SIXTEN/16.0D0/ C------------------------------------------------------------------ C Machine-dependent constants C------------------------------------------------------------------ CS DATA XINF,XNEG,XSMALL/3.40E+38,-9.382E0,5.96E-8/, CS 1 XBIG,XHUGE,XMAX/9.194E0,2.90E3,4.79E37/ DATA XINF,XNEG,XSMALL/1.79D308,-26.628D0,1.11D-16/, 1 XBIG,XHUGE,XMAX/26.543D0,6.71D7,2.53D307/ C------------------------------------------------------------------ C Coefficients for approximation to erf in first interval C------------------------------------------------------------------ CS DATA A/3.16112374387056560E00,1.13864154151050156E02, CS 1 3.77485237685302021E02,3.20937758913846947E03, CS 2 1.85777706184603153E-1/ CS DATA B/2.36012909523441209E01,2.44024637934444173E02, CS 1 1.28261652607737228E03,2.84423683343917062E03/ DATA A/3.16112374387056560D00,1.13864154151050156D02, 1 3.77485237685302021D02,3.20937758913846947D03, 2 1.85777706184603153D-1/ DATA B/2.36012909523441209D01,2.44024637934444173D02, 1 1.28261652607737228D03,2.84423683343917062D03/ C------------------------------------------------------------------ C Coefficients for approximation to erfc in second interval C------------------------------------------------------------------ CS DATA C/5.64188496988670089E-1,8.88314979438837594E0, CS 1 6.61191906371416295E01,2.98635138197400131E02, CS 2 8.81952221241769090E02,1.71204761263407058E03, CS 3 2.05107837782607147E03,1.23033935479799725E03, CS 4 2.15311535474403846E-8/ CS DATA D/1.57449261107098347E01,1.17693950891312499E02, CS 1 5.37181101862009858E02,1.62138957456669019E03, CS 2 3.29079923573345963E03,4.36261909014324716E03, CS 3 3.43936767414372164E03,1.23033935480374942E03/ DATA C/5.64188496988670089D-1,8.88314979438837594D0, 1 6.61191906371416295D01,2.98635138197400131D02, 2 8.81952221241769090D02,1.71204761263407058D03, 3 2.05107837782607147D03,1.23033935479799725D03, 4 2.15311535474403846D-8/ DATA D/1.57449261107098347D01,1.17693950891312499D02, 1 5.37181101862009858D02,1.62138957456669019D03, 2 3.29079923573345963D03,4.36261909014324716D03, 3 3.43936767414372164D03,1.23033935480374942D03/ C------------------------------------------------------------------ C Coefficients for approximation to erfc in third interval C------------------------------------------------------------------ CS DATA P/3.05326634961232344E-1,3.60344899949804439E-1, CS 1 1.25781726111229246E-1,1.60837851487422766E-2, CS 2 6.58749161529837803E-4,1.63153871373020978E-2/ CS DATA Q/2.56852019228982242E00,1.87295284992346047E00, CS 1 5.27905102951428412E-1,6.05183413124413191E-2, CS 2 2.33520497626869185E-3/ DATA P/3.05326634961232344D-1,3.60344899949804439D-1, 1 1.25781726111229246D-1,1.60837851487422766D-2, 2 6.58749161529837803D-4,1.63153871373020978D-2/ DATA Q/2.56852019228982242D00,1.87295284992346047D00, 1 5.27905102951428412D-1,6.05183413124413191D-2, 2 2.33520497626869185D-3/ C------------------------------------------------------------------ X = ARG Y = ABS(X) IF (Y .LE. THRESH) THEN C------------------------------------------------------------------ C Evaluate erf for |X| <= 0.46875 C------------------------------------------------------------------ YSQ = ZERO IF (Y .GT. XSMALL) YSQ = Y * Y XNUM = A(5)*YSQ XDEN = YSQ DO 20 I = 1, 3 XNUM = (XNUM + A(I)) * YSQ XDEN = (XDEN + B(I)) * YSQ 20 CONTINUE RESULT = X * (XNUM + A(4)) / (XDEN + B(4)) IF (JINT .NE. 0) RESULT = ONE - RESULT IF (JINT .EQ. 2) RESULT = EXP(YSQ) * RESULT GO TO 800 C------------------------------------------------------------------ C Evaluate erfc for 0.46875 <= |X| <= 4.0 C------------------------------------------------------------------ ELSE IF (Y .LE. FOUR) THEN XNUM = C(9)*Y XDEN = Y DO 120 I = 1, 7 XNUM = (XNUM + C(I)) * Y XDEN = (XDEN + D(I)) * Y 120 CONTINUE RESULT = (XNUM + C(8)) / (XDEN + D(8)) IF (JINT .NE. 2) THEN YSQ = AINT(Y*SIXTEN)/SIXTEN DEL = (Y-YSQ)*(Y+YSQ) RESULT = EXP(-YSQ*YSQ) * EXP(-DEL) * RESULT END IF C------------------------------------------------------------------ C Evaluate erfc for |X| > 4.0 C------------------------------------------------------------------ ELSE RESULT = ZERO IF (Y .GE. XBIG) THEN IF ((JINT .NE. 2) .OR. (Y .GE. XMAX)) GO TO 300 IF (Y .GE. XHUGE) THEN RESULT = SQRPI / Y GO TO 300 END IF END IF YSQ = ONE / (Y * Y) XNUM = P(6)*YSQ XDEN = YSQ DO 240 I = 1, 4 XNUM = (XNUM + P(I)) * YSQ XDEN = (XDEN + Q(I)) * YSQ 240 CONTINUE RESULT = YSQ *(XNUM + P(5)) / (XDEN + Q(5)) RESULT = (SQRPI - RESULT) / Y IF (JINT .NE. 2) THEN YSQ = AINT(Y*SIXTEN)/SIXTEN DEL = (Y-YSQ)*(Y+YSQ) RESULT = EXP(-YSQ*YSQ) * EXP(-DEL) * RESULT END IF END IF C------------------------------------------------------------------ C Fix up for negative argument, erf, etc. C------------------------------------------------------------------ 300 IF (JINT .EQ. 0) THEN RESULT = (HALF - RESULT) + HALF IF (X .LT. ZERO) RESULT = -RESULT ELSE IF (JINT .EQ. 1) THEN IF (X .LT. ZERO) RESULT = TWO - RESULT ELSE IF (X .LT. ZERO) THEN IF (X .LT. XNEG) THEN RESULT = XINF ELSE YSQ = AINT(X*SIXTEN)/SIXTEN DEL = (X-YSQ)*(X+YSQ) Y = EXP(YSQ*YSQ) * EXP(DEL) RESULT = (Y+Y) - RESULT END IF END IF END IF 800 RETURN C---------- Last card of CALERF ---------- END CS REAL FUNCTION ERF(X) DOUBLE PRECISION FUNCTION DERF(X) C-------------------------------------------------------------------- C C This subprogram computes approximate values for erf(x). C (see comments heading CALERF). C C Author/date: W. J. Cody, January 8, 1985 C C-------------------------------------------------------------------- INTEGER JINT CS REAL X, RESULT DOUBLE PRECISION X, RESULT C------------------------------------------------------------------ JINT = 0 CALL CALERF(X,RESULT,JINT) CS ERF = RESULT DERF = RESULT RETURN C---------- Last card of DERF ---------- END CS REAL FUNCTION ERFC(X) DOUBLE PRECISION FUNCTION DERFC(X) C-------------------------------------------------------------------- C C This subprogram computes approximate values for erfc(x). C (see comments heading CALERF). C C Author/date: W. J. Cody, January 8, 1985 C C-------------------------------------------------------------------- INTEGER JINT CS REAL X, RESULT DOUBLE PRECISION X, RESULT C------------------------------------------------------------------ JINT = 1 CALL CALERF(X,RESULT,JINT) CS ERFC = RESULT DERFC = RESULT RETURN C---------- Last card of DERFC ---------- END CS REAL FUNCTION ERFCX(X) DOUBLE PRECISION FUNCTION DERFCX(X) C------------------------------------------------------------------ C C This subprogram computes approximate values for exp(x*x) * erfc(x). C (see comments heading CALERF). C C Author/date: W. J. Cody, March 30, 1987 C C------------------------------------------------------------------ INTEGER JINT CS REAL X, RESULT DOUBLE PRECISION X, RESULT C------------------------------------------------------------------ JINT = 2 CALL CALERF(X,RESULT,JINT) CS ERFCX = RESULT DERFCX = RESULT RETURN C---------- Last card of DERFCX ---------- END SHAR_EOF fi # end of overwriting check if test -f 'src.f' then echo shar: will not over-write existing file "'src.f'" else cat << "SHAR_EOF" > 'src.f' DOUBLE PRECISION FUNCTION BIVNOR ( AH, AK, R ) C BIVNOR IS A CONTROLLED PRECISION C FORTRAN FUNCTION TO CALCULATE THE C BIVARIATE NORMAL UPPER RIGHT AREA, VIZ., C THE PROBABILITY FOR TWO NORMAL C VARIATES X AND Y WHOSE CORRELATION C IS R, THAT X .GT. AH AND Y .GT. AK. INTEGER IDIG, I, IS DOUBLE PRECISION TWOPI, B, AH, AK, R, GH, GK, RR, GAUSS, & DERF, H2, A2, H4, EX, W2, AP, S2, SP, S1, SN, SQR, & CON, WH, WK, GW, SGN, T, G2, CONEX, & CN GAUSS ( T ) = ( 1.0D0 + DERF ( T / SQRT ( 2.0D0 ) ) ) / 2.0D0 C GAUSS IS A UNIVARIATE LOWER NORMAL C TAIL AREA CALCULATED HERE FROM THE C CENTRAL ERROR FUNCTION DERF. C IT MAY BE REPLACED BY THE ALGORITHM IN C HILL,I.D. AND JOYCE,S.A. ALGORITHM 304, C NORMAL CURVE INTEGRAL(515), COMM.A.C.M.(10) C (JUNE,1967),P.374. C SOURCE: OWERN, D.B. ANN.MATH.STAT. C VOL. 27(1956), P.1075. C TWOPI = 2. * PI TWOPI = 6.283185307179587D0 B = 0.0D0 IDIG = 15 C THE PARAMETER 'IDIG' GIVES THE C NUMBER OF SIGNIFICANT DIGITS C TO THE RIGHT OF THE DECIMAL POINT C DESIRED IN THE ANSWER, IF C IT IS WITHIN THE COMPUTER'S C CAPACITY OF COURSE. GH = GAUSS ( -AH ) / 2.0D0 GK = GAUSS ( -AK ) / 2.0D0 IF ( R ) 10, 30, 10 10 RR = 1.0D0 - R * R IF ( RR ) 20, 40, 100 20 WRITE ( *, 99999 ) R C ERROR EXIT FOR ABS(R) .GT. 1.0D= 99999 FORMAT (' BIVNOR R IS', D26.16 ) STOP 30 B = 4.0D0 * GH * GK GO TO 350 40 IF ( R ) 50, 70, 70 50 IF ( AH + AK ) 60, 350, 350 60 B = 2.0D0 * ( GH + GK ) - 1.0D0 GO TO 350 70 IF ( AH - AK ) 80, 90, 90 80 B = 2.0D0 * GK GO TO 350 90 B = 2.0D0 * GH GO TO 350 100 SQR = SQRT ( RR ) IF ( IDIG - 15 ) 120, 110, 120 110 CON = TWOPI * 1.D-15 / 2.0D0 GO TO 140 120 CON = TWOPI / 2.0D0 DO 130 I = 1, IDIG CON = CON / 10.0D0 130 CONTINUE 140 IF ( AH ) 170, 150, 170 150 IF ( AK ) 190, 160, 190 160 B = ATAN ( R / SQR ) / TWOPI * 0.25D0 GO TO 350 170 B = GH IF ( AH * AK ) 180, 200, 190 180 B = B - 0.5D0 190 B = B + GK IF ( AH ) 200, 340, 200 200 WH = -AH WK = ( AK / AH - R ) / SQR GW = 2.0D0 * GH IS = -1 210 SGN = -1.0D0 T = 0.0D0 IF ( WK ) 220, 320, 220 220 IF ( ABS ( WK ) - 1.0D0 ) 270, 230, 240 230 T = WK * GW * ( 1.0D0 - GW ) / 2.0D0 GO TO 310 240 SGN = -SGN WH = WH * WK G2 = GAUSS ( WH ) WK = 1.0D0 / WK IF ( WK ) 250, 260, 260 250 B = B + 0.5D0 260 B = B - ( GW + G2 ) / 2.0D0 + GW * G2 270 H2 = WH * WH A2 = WK * WK H4 = H2 / 2.0D0 EX = EXP ( - H4 ) W2 = H4 * EX AP = 1.0D0 S2 = AP - EX SP = AP S1 = 0.0D0 SN = S1 CONEX = ABS ( CON / WK ) GO TO 290 280 SN = SP SP = SP + 1.0D0 S2 = S2 - W2 W2 = W2 * H4 / SP AP = - AP * A2 290 CN = AP * S2 / ( SN + SP ) S1 = S1 + CN IF ( ABS ( CN ) - CONEX ) 300, 300, 280 300 T = ( ATAN ( WK ) - WK * S1 ) / TWOPI 310 B = B + SGN * T 320 IF ( IS ) 330, 350, 350 330 IF ( AK ) 340, 350, 340 340 WH = -AK WK = ( AH / AK - R ) / SQR GW = 2.0D0 * GK IS = 1 GO TO 210 350 IF ( B ) 360, 370, 370 360 B = 0.0D0 370 IF ( B - 1.0D0 ) 390, 390, 380 380 B = 1.0D0 390 BIVNOR = B RETURN END SHAR_EOF fi # end of overwriting check cd .. cd .. cd .. # End of shell archive exit 0