SUBROUTINE EXTINCT(L,B,D,AVT,SAVT,AVC,JMAX,AV,SAV) C---------------------------------------------------------------------- C Subroutine EXTINCT (v. 2.0.5, May 13, 1999) C By Jon Hakkila, Jeannette Myers, Brett Stidham, & Dieter Hartmann. C Calculates visual interstellar extinction due to the Milky Way. C This code is described in AJ 114, 2043-2053 (1997). C C Changes implemented since version 1.0 (Dec. 2, 1996): C Updated error analysis for the FitzGerald subroutine. C Fixed a coding error in the FitzGerald subroutine that caused C extinction out of the Galactic plane to be overestimated at C distances larger than 1 kpc. C Fixed cell boundaries & extinction in Neckel & Klare subroutine. C More accurate angular cloud boundaries for the high-Galactic C clouds analyzed in the high-latitude study (formerly the Penprase C subroutine). This routine now also identifies additional high- C Galactic latitude clouds. C Systematic underrepresentation of extinction is corrected by using C an additional correction term. C Error corrected in Arenou routine - extinction is now reasonable slightly C above and below Galactic plane beyond 5 kpc. C Correction term now provides reasonable corrections slightly C above and below Galactic plane beyond 5 kpc. C---------------------------------------------------------------------- IMPLICIT REAL*4 (A-H,L-Z) DIMENSION AV(5), SAV(5) C---------------------------------------------------------------------- C L = Galactic longitude (degrees) 0 <= L < 360 C B = Galactic latitude (degrees) -90 <= B <= 90 C D = Source distance (in kpc) 0 <= D C AVT = Total visual extinction (magnitudes), using available subroutines. C SAVT = Total extinction error (magnitudes), using available subroutines. C AVC = Visual extinction correction (mag), using available subroutines. C The corrected extinction AVT+AVC removes suspected systematics. C JMAX = Number of subroutines used to calculate extinction. C AV(i) = Extinction calculated by the iTH subroutine. C SAV(i) = Error calculated by the iTH subroutine. C Specific subroutines used to calculate the extinction are returned C via AV(i): If AV(i) has a value not equal to -99. then the ith C study has been used in calculating extinction. C i=1 is from Fitzgerald, AJ 73, 983 (1968). C i=2 is from Neckel and Klare, A&A Supp 42, 251 (1980). C i=3 is from Berdnikov & Pavlovskaya, Sov. Astron. Lett. 17, 215 (1990). C i=4 is from Arenou et al., A&A 258, 104 (1992). C i=5 is from Penprase, ApJ. Supp. 83, 273 (1992), C Magnani et al., ApJ. 295, 402 (1985), C Keto & Myers, ApJ. 304, 466 (1986), C Desert et al., Ap.J. 334, 815 (1988), C Odenwald, Ap.J. 325, 320 (1988), C Hughes et al., A.J. 105, 571 (1993), C Kenyon et al., A.J. 108, 1872 (1994), C Cernis, ApSS 166, 315 (1990), C Cernis, Baltic Astron. 2, 214 (1993), C Rossano, AJ, 83, 234 (1978), C Rossano, AJ, 83, 241 (1978), C Kutner et al., ApJ, 215, 521 (1977). C C All studies have been modified to statistically account for C unsampled regions. C C A0 = 1.5 magnitudes per kpc C R = A0/E(B-V) = 3.0 C C---------------------------------------------------------------------- A0 = 1.5 R = 3.0 C---------------------------------------------------------------------- C If source is beyond Milky Way edge (assume Sun is 8.5 kpc from C Galactic Center and that Disk has a 15 kpc radius), then limit C extinction to what would be seen through Milky Way. C---------------------------------------------------------------------- XD=D !Distance XL=L !Galactic Longitude XB=B !Galactic Latitude DSUN=8.5 RGAL=15. T1=COSD(XB)*COSD(XL) T2=1.-(RGAL/DSUN)*(RGAL/DSUN) DMAX=8.5*(T1+SQRT(T1*T1-T2)) IF (D .GT. DMAX) XD=DMAX C---------------------------------------------------------------------- C Calculate extinction from desired subroutines. C---------------------------------------------------------------------- CALL FITZGERALD(XL,XB,XD,AV(1),SAV(1),A0,R) CALL NECKEL_KLARE(XL,XB,XD,AV(2),SAV(2),A0) CALL BERDNIKOV(XL,XB,XD,AV(3),SAV(3),A0) CALL ARENOU_ETAL(XL,XB,XD,AV(4),SAV(4),A0) CALL HIGH_LAT(XL,XB,XD,AV(5),SAV(5),IHFLG) C---------------------------------------------------------------------- C Combine outputs from subroutines. C---------------------------------------------------------------------- CALL COMBINE(AV,SAV,AVT,SAVT,JMAX,IHFLG) CALL CORRECT(XL,XB,XD,AVC) RETURN END SUBROUTINE FITZGERALD(L,B,DIST,AV,SAV,A0,R) C---------------------------------------------------------------------- C From Fitzgerald, AJ 73, 983 (1968). C---------------------------------------------------------------------- IMPLICIT REAL*4 (A-H,L-Z) IF (ABS(B) .GT. 0.) THEN D = DIST*COSD(B) ELSE D = DIST ENDIF A0R= A0/R IF (L .LT. 0.) L=L+360. IFLG=0 IF (B .NE. 0.) IFLG=1 BETA0=.114 IF ((L .GE. 10.) .AND. (L .LT. 60.)) THEN BETA=.045 GOTO 660 ENDIF IF ((L .GE. 60.) .AND. (L .LT. 100.)) THEN BETA=.040 GOTO 661 ENDIF IF ((L .GE. 100.) .AND. (L .LT. 130.)) THEN BETA=.055 GOTO 662 ENDIF IF ((L .GE. 130.) .AND. (L .LT. 160.)) THEN BETA=.170 GOTO 663 ENDIF IF ((L .GE. 160.) .AND. (L .LT. 190.)) THEN BETA=.105 GOTO 664 ENDIF IF ((L .GE. 190.) .AND. (L .LT. 220.)) THEN BETA=.070 GOTO 665 ENDIF IF ((L .GE. 220.) .AND. (L .LT. 250.)) THEN BETA=.065 GOTO 666 ENDIF IF ((L .GE. 250.) .AND. (L .LT. 280.)) THEN BETA=.080 GOTO 667 ENDIF IF ((L .GE. 280.) .AND. (L .LT. 310.)) THEN BETA=.040 GOTO 668 ENDIF IF ((L .GE. 310.) .AND. (L .LT. 340.)) THEN BETA=.060 GOTO 669 ENDIF IF ((L .GE. 340.) .AND. (L .LT. 360.)) THEN BETA=.100 GOTO 670 ENDIF IF ((L .GE. 0.) .AND. (L .LT. 10.)) THEN BETA=.100 GOTO 659 ENDIF 659 IF ((L .GE. 0.0) .AND. (L .LT. 4.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.5)) THEN EY = 0.0 GOTO 1000 ENDIF IF ((D .GE. 0.5) .AND. (D .LT. 0.8)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.0 + 2.7*(D-0.5) ELSE EY=EYFCN(2.7,0.5,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.8) .AND.(D .LT. 4.2)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.81 ELSE EY=EYFCN(2.7,0.5,0.8,B,BETA0) ENDIF GOTO 1000 ENDIF IF ((D .GE. 4.2)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.81 + A0R*(D-4.2) ELSE EY=EYFCN(2.7,0.5,0.8,B,BETA0)+EYFCN(A0R,4.2,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 4.0) .AND. (L .LT. 7.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.1)) THEN EY = 0.0 GOTO 1000 ENDIF IF ((D .GE. 0.1) .AND. (D .LT. 0.5)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.0 + 0.75*(D-0.1) ELSE EY=EYFCN(0.75,0.1,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.5) .AND. (D .LT. 1.2)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.3 ELSE EY=EYFCN(0.75,0.1,0.5,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.2) .AND. (D .LT. 1.8)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.3 + 1.38*(D-1.2) ELSE EY=EYFCN(0.75,0.1,0.5,B,BETA)+EYFCN(1.38,1.2,D,B,BETA0) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.8)) THEN IF ((IFLG .EQ. 0)) THEN EY = 1.128 + A0R*(D-1.8) ELSE EY=EYFCN(0.75,0.1,0.5,B,BETA)+EYFCN(1.38,1.2,1.8,B,BETA0) & +EYFCN(A0R,1.8,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 7.0) .AND. (L. LT. 10.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.2)) THEN EY = 0.0 GOTO 1000 ENDIF IF ((D .GE. 0.2) .AND. (D .LT. 0.5)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.0 + 1.17*(D-0.2) ELSE EY=EYFCN(1.17,0.2,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.5) .AND. (D .LT. 4.0)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.351 ELSE EY=EYFCN(1.17,0.2,0.5,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 4.0)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.351 + A0R*(D-4.0) ELSE EY=EYFCN(1.17,0.2,0.5,B,BETA)+EYFCN(A0R,4.0,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF 660 IF ((L .GE. 10.0) .AND. (L .LT. 12.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.1)) THEN EY = 0.0 GOTO 1000 ENDIF IF ((D .GE. 0.1) .AND. (D .LT. 0.45)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.0 + 1.43*(D-0.1) ELSE EY=EYFCN(1.43,0.1,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.45) .AND. (D .LT. 1.9)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.5005 ELSE EY=EYFCN(1.43,0.1,0.45,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.9) .AND. (D .LT. 2.3)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.5005 + 1.2488*(D-1.9) ELSE EY=EYFCN(1.43,0.1,0.45,B,BETA)+EYFCN(1.2488,1.9,D,B,BETA0) ENDIF GOTO 1000 ENDIF IF ((D .GE. 2.3)) THEN IF ((IFLG .EQ. 0)) THEN EY = 1.00002 + A0R*(D-2.3) ELSE EY=EYFCN(1.43,0.1,0.45,B,BETA)+EYFCN(1.2488,1.9,2.3,B,BETA0) & +EYFCN(A0R,2.3,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 12.0) .AND. (L .LT. 14.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.25)) THEN EY = 0.0 GOTO 1000 ENDIF IF ((D .GE. 0.25) .AND. (D .LT. 0.5)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.0 + 2.*(D-0.25) ELSE EY=EYFCN(2.,0.25,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.5) .AND. (D .LT. 1.9)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.5 ELSE EY=EYFCN(2.,0.25,0.5,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.9) .AND. (D .LT. 2.35)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.5 + 1.11*(D-1.9) ELSE EY=EYFCN(2.,0.25,0.5,B,BETA)+EYFCN(1.11,1.9,D,B,BETA0) ENDIF GOTO 1000 ENDIF IF ((D .GE. 2.35)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.9995 + A0R*(D-2.35) ELSE EY=EYFCN(2.,0.25,0.5,B,BETA)+EYFCN(1.11,1.9,2.35,B,BETA0) & +EYFCN(A0R,2.35,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 14.0) .AND. (L .LT. 16.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.6)) THEN EY = 0.0 GOTO 1000 ENDIF IF ((D .GE. 0.6) .AND. (D .LT. 1.0)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.0 + 1.5*(D-0.6) ELSE EY=EYFCN(1.5,0.6,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.0) .AND. (D .LT. 2.5)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.6 ELSE EY=EYFCN(1.5,0.6,1.,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 2.5) .AND. (D .LT. 3.0)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.6 + 1.2*(D-2.5) ELSE EY=EYFCN(1.5,0.6,1.0,B,BETA)+EYFCN(1.2,2.5,D,B,BETA0) ENDIF GOTO 1000 ENDIF IF ((D .GE. 3.0)) THEN IF ((IFLG .EQ. 0)) THEN EY = 1.2 + A0R*(D-3.0) ELSE EY=EYFCN(1.5,0.6,1.0,B,BETA)+EYFCN(1.2,2.5,3.,B,BETA0) & +EYFCN(A0R,3.0,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 16.0) .AND. (L .LT. 17.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.1)) THEN EY = 0.0 GOTO 1000 ENDIF IF ((D .GE. 0.1) .AND. (D .LT. 0.25)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.0 + 1.67*(D-0.1) ELSE EY=EYFCN(1.67,0.1,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.25) .AND. (D .LT. 0.5)) THEN IF ((IFLG .EQ. 0)) THEN EY=0.2505 ELSE EY=EYFCN(1.67,0.1,0.25,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.5) .AND. (D .LT. 0.9)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.2505 + 1.874*(D-0.5) ELSE EY=EYFCN(1.67,0.1,0.25,B,BETA)+EYFCN(1.874,0.5,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.9) .AND. (D .LT. 2.5)) THEN IF ((IFLG .EQ. 0)) THEN EY = 1.0001 ELSE EY=EYFCN(1.67,0.1,0.25,B,BETA)+EYFCN(1.874,0.5,0.9,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 2.5)) THEN IF ((IFLG .EQ. 0)) THEN EY = 1.0001 + A0R*(D-2.5) ELSE EY=EYFCN(1.67,0.1,0.25,B,BETA)+EYFCN(1.874,0.5,0.9,B,BETA) & +EYFCN(A0R,2.5,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 17.0) .AND. (L .LT. 18.5)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.2)) THEN IF ((IFLG .EQ. 0)) THEN EY = 2.*D ELSE EY=EYFCN(2.,0.,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.2) .AND. (D .LT. 0.75)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.4 ELSE EY=EYFCN(2.,0.,0.2,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.75) .AND. (D .LT. 1.0)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.4 + 2.8*(D-0.75) ELSE EY=EYFCN(2.,0.,0.2,B,BETA)+EYFCN(2.8,0.75,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.0) .AND. (D .LT. 3.1)) THEN IF ((IFLG .EQ. 0)) THEN EY = 1.1 ELSE EY=EYFCN(2.,0.,0.2,B,BETA)+EYFCN(2.8,0.75,1.,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 3.1)) THEN IF ((IFLG .EQ. 0)) THEN EY = 1.1 + A0R*(D-3.1) ELSE EY=EYFCN(2.,0.,0.2,B,BETA)+EYFCN(2.8,0.75,1.,B,BETA) & +EYFCN(A0R,3.1,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 18.5) .AND. (L .LT. 20.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.2)) THEN IF ((IFLG .EQ. 0)) THEN EY = 2.*D ELSE EY=EYFCN(2.,0.,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.2) .AND. (D .LT. 0.75)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.4 ELSE EY=EYFCN(2.,0.,0.2,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.75) .AND. (D .LT. 1.0)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.4 + 2.8*(D-0.75) ELSE EY=EYFCN(2.,0.,0.2,B,BETA)+EYFCN(2.8,0.75,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.0) .AND. (D .LT. 3.0)) THEN IF ((IFLG .EQ. 0)) THEN EY = 1.1 ELSE EY=EYFCN(2.,0.,0.2,B,BETA)+EYFCN(2.8,0.75,1.,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 3.0)) THEN IF ((IFLG .EQ. 0)) THEN EY = 1.1 + A0R*(D-3.0) ELSE EY=EYFCN(2.,0.,0.2,B,BETA)+EYFCN(2.8,0.75,1.,B,BETA) & +EYFCN(A0R,3.,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 20.0) .AND. (L .LT. 24.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.2)) THEN IF ((IFLG .EQ. 0)) THEN EY = 1.5*D ELSE EY=EYFCN(1.5,0.,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.2) .AND. (D .LT. 0.35)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.3 + 0.67*(D-0.2) ELSE EY=EYFCN(1.5,0.,0.2,B,BETA)+EYFCN(0.67,0.2,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.35) .AND. (D .LT. 0.85)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.4005 + 1.599*(D-0.35) ELSE EY=EYFCN(1.5,0.,0.2,B,BETA)+EYFCN(0.67,0.2,0.35,B,BETA) & +EYFCN(1.599,0.35,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.85) .AND. (D .LT. 2.75)) THEN IF ((IFLG .EQ. 0)) THEN EY = 1.2 ELSE EY=EYFCN(1.5,0.,0.2,B,BETA)+EYFCN(0.67,0.2,0.35,B,BETA) & +EYFCN(1.599,0.35,0.85,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 2.75)) THEN IF ((IFLG .EQ. 0)) THEN EY = 1.2 + A0R*(D-2.75) ELSE EY=EYFCN(1.5,0.,0.2,B,BETA)+EYFCN(0.67,0.2,0.35,B,BETA) & +EYFCN(1.599,0.35,0.85,B,BETA)+EYFCN(A0R,2.75,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 24.0) .AND. (L .LT. 30.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.2)) THEN EY = 0.0 GOTO 1000 ENDIF IF ((D .GE. 0.2) .AND. (D .LT. 0.45)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.0 + 1.6*(D-0.2) ELSE EY=EYFCN(1.6,0.2,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.45) .AND. (D .LT. 1.6)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.4 ELSE EY=EYFCN(1.6,0.2,0.45,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.6) .AND. (D .LT. 2.0)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.4 + 1.25*(D-1.6) ELSE EY=EYFCN(1.6,0.2,0.45,B,BETA)+EYFCN(1.25,1.6,D,B,BETA0) ENDIF GOTO 1000 ENDIF IF ((D .GE. 2.0) .AND. (D .LT. 4.0)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.9 ELSE EY=EYFCN(1.6,0.2,0.45,B,BETA)+EYFCN(1.25,1.6,2.,B,BETA0) ENDIF GOTO 1000 ENDIF IF ((D .GE. 4.0)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.9 + A0R*(D-4.0) ELSE EY=EYFCN(1.6,0.2,0.45,B,BETA)+EYFCN(1.25,1.6,2.,B,BETA0) & +EYFCN(A0R,4.,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 30.0) .AND. (L .LT. 40.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.15)) THEN EY = 0.0 GOTO 1000 ENDIF IF ((D .GE. 0.15) .AND. (D .LT. 0.6)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.0 + 2.*(D-0.15) ELSE EY=EYFCN(2.,0.15,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.6) .AND. (D .LT. 2.8)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.9 ELSE EY=EYFCN(2.,0.15,0.6,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 2.8)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.9 + A0R*(D-2.8) ELSE EY=EYFCN(2.,0.15,0.6,B,BETA)+EYFCN(A0R,2.8,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 40.0) .AND. (L .LT. 50.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.1)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.0 + D ELSE EY=EYFCN(1.,0.,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.1) .AND. (D .LT. 0.25)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.1 ELSE EY=EYFCN(1.,0.,0.1,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.25) .AND. (D .LT. 0.5)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.1 + 1.4*(D-0.25) ELSE EY=EYFCN(1.,0.,0.1,B,BETA)+EYFCN(1.4,0.25,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.5) .AND. (D .LT. 0.95)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.45 + 0.11*(D-0.5) ELSE EY=EYFCN(1.,0.,0.1,B,BETA)+EYFCN(1.4,0.25,0.5,B,BETA) & +EYFCN(0.11,0.5,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.95) .AND. (D .LT. 1.3)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.4995 + 0.86*(D-0.95) ELSE EY=EYFCN(1.,0.,0.1,B,BETA)+EYFCN(1.4,0.25,0.5,B,BETA) & +EYFCN(0.11,0.5,0.95,B,BETA)+EYFCN(0.86,0.95,D,B,BETA0) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.3) .AND. (D .LT. 3.0)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.8005 ELSE EY=EYFCN(1.,0.,0.1,B,BETA)+EYFCN(1.4,0.25,0.5,B,BETA) & +EYFCN(0.11,0.5,0.95,B,BETA)+EYFCN(0.86,0.95,1.3,B,BETA0) ENDIF GOTO 1000 ENDIF IF ((D .GE. 3.0)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.8005 + A0R*(D-3.0) ELSE EY=EYFCN(1.,0.,0.1,B,BETA)+EYFCN(1.4,0.25,0.5,B,BETA) & +EYFCN(0.11,0.5,0.95,B,BETA)+EYFCN(0.86,0.95,1.3,B,BETA0) & +EYFCN(A0R,3.,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 50.0) .AND. (L .LT. 60.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.25)) THEN EY = 0.0 GOTO 1000 ENDIF IF ((D .GE. 0.25) .AND. (D .LT. 0.4)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.0 + 3.*(D-0.25) ELSE EY=EYFCN(3.,0.25,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.4) .AND. (D .LT. 0.85)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.45 + 0.11*(D-0.4) ELSE EY=EYFCN(3.,0.25,0.4,B,BETA)+EYFCN(0.11,0.4,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.85) .AND. (D .LT. 1.1)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.4995 + 1.202*(D-0.85) ELSE EY=EYFCN(3.,0.25,0.4,B,BETA)+EYFCN(0.11,0.4,0.85,B,BETA) & +EYFCN(1.202,0.85,D,B,BETA0) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.1) .AND. (D .LT. 2.9)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.8 ELSE EY=EYFCN(3.,0.25,0.4,B,BETA)+EYFCN(0.11,0.4,0.85,B,BETA) & +EYFCN(1.202,0.85,1.1,B,BETA0) ENDIF GOTO 1000 ENDIF IF ((D .GE. 2.9)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.8 + A0R*(D-2.9) ELSE EY=EYFCN(3.,0.25,0.4,B,BETA)+EYFCN(0.11,0.4,0.85,B,BETA) & +EYFCN(1.202,0.85,1.1,B,BETA0)+EYFCN(A0R,2.9,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF 661 IF ((L .GE. 60.0) .AND. (L .LT. 62.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.3)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.33*D ELSE EY=EYFCN(0.33,0.,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.3) .AND. (D .LT. 0.7)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.099 + 2.2525*(D-0.3) ELSE EY=EYFCN(0.33,0.,0.3,B,BETA)+EYFCN(2.2525,0.3,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.7) .AND. (D .LT. 2.1)) THEN IF ((IFLG .EQ. 0)) THEN EY = 1.0 ELSE EY=EYFCN(0.33,0.,0.3,B,BETA)+EYFCN(2.2525,0.3,0.7,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 2.1)) THEN IF ((IFLG .EQ. 0)) THEN EY = 1.0 + A0R*(D-2.1) ELSE EY=EYFCN(0.33,0.,0.3,B,BETA)+EYFCN(2.2525,0.3,0.7,B,BETA) & +EYFCN(A0R,2.1,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 62.0) .AND. (L .LT. 63.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.3)) THEN EY = 0.0 GOTO 1000 ENDIF IF ((D .GE. 0.3) .AND. (D .LT. 1.25)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.0 + 1.05*(D-0.3) ELSE EY=EYFCN(1.05,0.3,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.25) .AND. (D .LT. 3.0)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.9975 ELSE EY=EYFCN(1.05,0.3,1.25,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 3.0)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.9975 + A0R*(D-3.0) ELSE EY=EYFCN(1.05,0.3,1.25,B,BETA)+EYFCN(A0R,3.,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 63.0) .AND. (L .LT. 70.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.4)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.38*D ELSE EY=EYFCN(0.38,0.,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.4) .AND. (D .LT. 0.6)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.152 + 1.49*(D-0.4) ELSE EY=EYFCN(0.38,0.,0.4,B,BETA)+EYFCN(1.49,0.4,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.6) .AND. (D .LT. 1.5)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.45 + 0.22*(D-0.6) ELSE EY=EYFCN(0.38,0.,0.4,B,BETA)+EYFCN(1.49,0.4,0.6,B,BETA) & +EYFCN(0.22,0.6,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.5) .AND. (D .LT. 2.5)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.648 + 0.102*(D-1.5) ELSE EY=EYFCN(0.38,0.,0.4,B,BETA)+EYFCN(1.49,0.4,0.6,B,BETA) & +EYFCN(0.22,0.6,1.5,B,BETA)+EYFCN(0.102,1.5,D,B,BETA0) ENDIF GOTO 1000 ENDIF IF ((D .GE. 2.5)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.75 + A0R*(D-2.5) ELSE EY=EYFCN(0.38,0.,0.4,B,BETA)+EYFCN(1.49,0.4,0.6,B,BETA) & +EYFCN(0.22,0.6,1.5,B,BETA)+EYFCN(0.102,1.5,2.5,B,BETA0) & +EYFCN(A0R,2.5,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 70.0) .AND. (L .LT. 72.0) .AND. (B .GE. -0.3)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.6)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.0 + 0.17*D ELSE EY=EYFCN(0.17,0.,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.6) .AND. (D .LT. 0.9)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.102 + 0.66*(D-0.6) ELSE EY=EYFCN(0.17,0.,0.6,B,BETA)+EYFCN(0.66,0.6,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.9) .AND. (D .LT. 2.0)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.3 + 1.5*(D-0.9) ELSE EY=EYFCN(0.17,0.,0.6,B,BETA)+EYFCN(0.66,0.6,0.9,B,BETA) & +EYFCN(1.5,0.9,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 2.0)) THEN IF ((IFLG .EQ. 0)) THEN EY = 1.95 + A0R*(D-2.0) ELSE EY=EYFCN(0.17,0.,0.6,B,BETA)+EYFCN(0.66,0.6,0.9,B,BETA) & +EYFCN(1.5,0.9,2.,B,BETA)+EYFCN(A0R,2.,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 70.0) .AND. (L .LT. 74.0) .AND. (B .LT. -0.3)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.6)) THEN EY = 0.0 GOTO 1000 ENDIF IF ((D .GE. 0.6) .AND. (D .LT. 1.1)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.0 + 3.2*(D-0.6) ELSE EY=EYFCN(3.2,0.6,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.1)) THEN IF ((IFLG .EQ. 0)) THEN EY = 1.6 + A0R*(D-1.1) ELSE EY=EYFCN(3.2,0.6,1.1,B,BETA)+EYFCN(A0R,1.1,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 72.0) .AND. (L .LT. 74.0) .AND. (B .GE. -0.3)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.6)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.0 + 0.25*D ELSE EY=EYFCN(0.25,0.,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.6) .AND. (D .LT. 0.9)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.15 + 0.83*(D-0.6) ELSE EY=EYFCN(0.25,0.,0.6,B,BETA)+EYFCN(0.83,0.6,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.9) .AND. (D .LT. 1.9)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.399 ELSE EY=EYFCN(0.25,0.,0.6,B,BETA)+EYFCN(0.83,0.6,0.9,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.9) .AND. (D .LT. 2.1)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.399 + 2.005*(D-1.9) ELSE EY=EYFCN(0.25,0.,0.6,B,BETA)+EYFCN(0.83,0.6,0.9,B,BETA) & +EYFCN(2.005,1.9,D,B,BETA0) ENDIF GOTO 1000 ENDIF IF ((D .GE. 2.1)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.8 + A0R*(D-2.1) ELSE EY=EYFCN(0.25,0.,0.6,B,BETA)+EYFCN(0.83,0.6,0.9,B,BETA) & +EYFCN(2.005,1.9,2.1,B,BETA0)+EYFCN(A0R,2.1,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 74.0) .AND. (L .LT. 75.5)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.45)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.33*D ELSE EY=EYFCN(0.33,0.,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.45) .AND. (D .LT. 1.0)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.1485 ELSE EY=EYFCN(0.33,0.,0.45,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.0) .AND. (D .LT. 1.55)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.1485 + 1.548*(D-1.0) ELSE EY=EYFCN(0.33,0.,0.45,B,BETA)+EYFCN(1.548,1.,D,B,BETA0) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.55) .AND. (D .LT. 4.0)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.9999 ELSE EY=EYFCN(0.33,0.,0.45,B,BETA)+EYFCN(1.548,1.,1.55,B,BETA0) ENDIF GOTO 1000 ENDIF IF ((D .GE. 4.0)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.9999 + A0R*(D-4.0) ELSE EY=EYFCN(0.33,0.,0.45,B,BETA)+EYFCN(1.548,1.,1.55,B,BETA0) & +EYFCN(A0R,4.,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 75.5) .AND. (L .LT. 77.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.25)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.4*D ELSE EY=EYFCN(0.4,0.,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.25) .AND. (D .LT. 0.6)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.1 ELSE EY=EYFCN(0.4,0.,0.25,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.6) .AND. (D .LT. 1.8)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.1 + 1.08*(D-0.6) ELSE EY=EYFCN(0.4,0.,0.25,B,BETA)+EYFCN(1.08,0.6,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.8)) THEN IF ((IFLG .EQ. 0)) THEN EY = 1.396 + A0R*(D-1.8) ELSE EY=EYFCN(0.4,0.,0.25,B,BETA)+EYFCN(1.08,0.6,1.8,B,BETA) & +EYFCN(A0R,1.8,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 77.0) .AND. (L .LT. 80.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.25)) THEN EY = 0.0 GOTO 1000 ENDIF IF ((D .GE. 0.25) .AND. (D .LT. 1.15)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.0 + 1.67*(D-0.25) ELSE EY=EYFCN(1.67,0.25,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.15)) THEN IF ((IFLG .EQ. 0)) THEN EY = 1.503 + A0R*(D-1.15) ELSE EY=EYFCN(1.67,0.25,1.15,B,BETA)+EYFCN(A0R,1.15,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 80.0) .AND. (L .LT. 84.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.15)) THEN EY = 0.0 GOTO 1000 ENDIF IF ((D .GE. 0.15) .AND. (D .LT. 0.85)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.0 + 3.57*(D-0.15) ELSE EY=EYFCN(3.57,0.15,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.85)) THEN IF ((IFLG .EQ. 0)) THEN EY = 2.499 + A0R*(D-0.85) ELSE EY=EYFCN(3.57,0.15,0.85,B,BETA)+EYFCN(A0R,0.85,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 84.0) .AND. (L .LT. 87.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.2)) THEN EY = 0.0 GOTO 1000 ENDIF IF ((D .GE. 0.2) .AND. (D .LT. 0.7)) THEN IF ((IFLG .EQ. 0)) THEN EY = 1.4*(D-0.2) ELSE EY=EYFCN(1.4,0.2,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.7) .AND. (D .LT. 2.65)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.7 ELSE EY=EYFCN(1.4,0.2,0.7,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 2.65)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.7 + A0R*(D-2.65) ELSE EY=EYFCN(1.4,0.2,0.7,B,BETA)+EYFCN(A0R,2.65,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 87.0) .AND. (L .LT. 90.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.25)) THEN EY = 0.0 GOTO 1000 ENDIF IF ((D .GE. 0.25) .AND. (D .LT. 0.4)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.0 + (D-0.25) ELSE EY=EYFCN(1.,0.25,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.4) .AND. (D .LT. 0.8)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.15 ELSE EY=EYFCN(1.,0.25,0.4,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.8) .AND. (D .LT. 2.0)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.15 + 0.42*(D-0.8) ELSE EY=EYFCN(1.,0.25,0.4,B,BETA)+EYFCN(0.42,0.8,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 2.0) .AND. (D .LT. 3.5)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.654 ELSE EY=EYFCN(1.,0.25,0.4,B,BETA)+EYFCN(0.42,0.8,2.,B,BETA0) ENDIF GOTO 1000 ENDIF IF ((D .GE. 3.5)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.654 + A0R*(D-3.5) ELSE EY=EYFCN(1.,0.25,0.4,B,BETA)+EYFCN(0.42,0.8,2.,B,BETA0) & +EYFCN(A0R,3.5,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 90.0) .AND. (L .LT. 97.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.25)) THEN EY = 0.0 GOTO 1000 ENDIF IF ((D .GE. 0.25) .AND. (D .LT. 0.8)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.0 + 1.45*(D-0.25) ELSE EY=EYFCN(1.45,0.25,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.8) .AND. (D .LT. 2.6)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.7975 ELSE EY=EYFCN(1.45,0.25,0.8,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 2.6)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.7975 + A0R*(D-2.6) ELSE EY=EYFCN(1.45,0.25,0.8,B,BETA)+EYFCN(A0R,2.6,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 97.0) .AND. (L .LT. 100.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.25)) THEN EY = 0.0 GOTO 1000 ENDIF IF ((D .GE. 0.25) .AND. (D .LT. 0.95)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.0 + (D-0.25) ELSE EY=EYFCN(1.,0.25,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.95) .AND. (D .LT. 2.5)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.7 ELSE EY=EYFCN(1.,0.25,0.95,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 2.5)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.7 + A0R*(D-2.5) ELSE EY=EYFCN(1.,0.25,0.95,B,BETA)+EYFCN(A0R,2.5,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF 662 IF ((L .GE. 100.0) .AND. (L .LT. 103.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.2)) THEN EY = 0.0 GOTO 1000 ENDIF IF ((D .GE. 0.2) .AND. (D .LT. 0.5)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.0 + 1.33*(D-0.2) ELSE EY=EYFCN(1.33,0.2,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.5) .AND. (D .LT. 0.55)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.399 + 1.02*(D-0.5) ELSE EY=EYFCN(1.33,0.2,0.5,B,BETA)+EYFCN(1.02,0.5,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.55) .AND. (D .LT. 1.3)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.45 + 0.6*(D-0.55) ELSE EY=EYFCN(1.33,0.2,0.5,B,BETA)+EYFCN(1.02,0.5,0.55,B,BETA) & +EYFCN(0.6,0.55,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.3) .AND. (D. LT. 4.0)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.9 ELSE EY=EYFCN(1.33,0.2,0.5,B,BETA)+EYFCN(1.02,0.5,0.55,B,BETA) & +EYFCN(0.6,0.55,1.3,B,BETA0) ENDIF GOTO 1000 ENDIF IF ((D .GE. 4.0)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.9 + A0R*(D-4.0) ELSE EY=EYFCN(1.33,0.2,0.5,B,BETA)+EYFCN(1.02,0.5,0.55,B,BETA) & +EYFCN(0.6,0.55,1.3,B,BETA0)+EYFCN(A0R,4.,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 103.0) .AND. (L .LT. 107.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.15)) THEN EY = 0.0 GOTO 1000 ENDIF IF ((D .GE. 0.15) .AND. (D .LT. 0.5)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.0 + 2.15*(D-0.15) ELSE EY=EYFCN(2.15,0.15,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.5) .AND. (D .LT. 4.4)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.7525 ELSE EY=EYFCN(2.15,0.15,0.5,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 4.4)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.7525 + A0R*(D-4.4) ELSE EY=EYFCN(2.15,0.15,0.5,B,BETA)+EYFCN(A0R,4.4,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 107.0) .AND. (L .LT. 110.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.5)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.5*D ELSE EY=EYFCN(0.5,0.,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.5) .AND. (D .LT. 0.95)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.25 + 1.33*(D-0.5) ELSE EY=EYFCN(0.5,0.,0.5,B,BETA)+EYFCN(1.33,0.5,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.95) .AND. (D .LT. 3.6)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.8485 ELSE EY=EYFCN(0.5,0.,0.5,B,BETA)+EYFCN(1.33,0.5,0.95,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 3.6)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.8485 + A0R*(D-3.6) ELSE EY=EYFCN(0.5,0.,0.5,B,BETA)+EYFCN(1.33,0.5,0.95,B,BETA0) & +EYFCN(A0R,3.6,D,B,BETA) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 110.0) .AND. (L .LT. 113.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.5)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.5*D ELSE EY=EYFCN(0.5,0.,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.5) .AND. (D .LT. 1.0)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.25 + 1.7*(D-0.5) ELSE EY=EYFCN(0.5,0.,0.5,B,BETA)+EYFCN(1.7,0.5,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.0) .AND. (D .LT. 3.3)) THEN IF ((IFLG .EQ. 0)) THEN EY = 1.1 ELSE EY=EYFCN(0.5,0.,0.5,B,BETA)+EYFCN(1.7,0.5,1.,B,BETA0) ENDIF GOTO 1000 ENDIF IF ((D .GE. 3.3)) THEN IF ((IFLG .EQ. 0)) THEN EY = 1.1 + A0R*(D-3.3) ELSE EY=EYFCN(0.5,0.,0.5,B,BETA)+EYFCN(1.7,0.5,1.,B,BETA0) & +EYFCN(A0R,3.3,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 113.0) .AND. (L .LT. 117.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.15)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.0 + 1.33*D ELSE EY=EYFCN(1.33,0.,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.15) .AND. (D .LT. 0.65)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.1995 ELSE EY=EYFCN(1.33,0.,0.15,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.65) .AND. (D .LT. 1.0)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.1995 + 1.287*(D-0.65) ELSE EY=EYFCN(1.33,0.,0.15,B,BETA)+EYFCN(1.287,0.65,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.0) .AND. (D .LT. 3.9)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.64995 ELSE EY=EYFCN(1.33,0.,0.15,B,BETA)+EYFCN(1.287,0.65,1.,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 3.9)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.64995 + A0R*(D-3.9) ELSE EY=EYFCN(1.33,0.,0.15,B,BETA)+EYFCN(1.287,0.65,1.,B,BETA) & +EYFCN(A0R,3.9,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 117.0) .AND. (L .LT. 120.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.95)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.0 + 0.63*D ELSE EY=EYFCN(0.63,0.,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.95) .AND. (D .LT. 3.7)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.5985 ELSE EY=EYFCN(0.63,0.,0.95,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 3.7)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.5985 + A0R*(D-3.7) ELSE EY=EYFCN(0.63,0.,0.95,B,BETA)+EYFCN(A0R,3.7,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 120.0) .AND. (L .LT. 122.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.1)) THEN EY = 0.0 GOTO 1000 ENDIF IF ((D .GE. 0.1) .AND. (D .LT. 0.3)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.0 + 1.25*(D-0.1) ELSE EY=EYFCN(1.25,0.1,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.3) .AND. (D .LT. 0.75)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.25 ELSE EY=EYFCN(1.25,0.1,0.3,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.75) .AND. (D .LT. 1.25)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.25 + 1.5*(D-0.75) ELSE EY=EYFCN(1.25,0.1,0.3,B,BETA)+EYFCN(1.5,0.75,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.25) .AND. (D .LT. 3.0)) THEN IF ((IFLG .EQ. 0)) THEN EY = 1.0 ELSE EY=EYFCN(1.25,0.1,0.3,B,BETA)+EYFCN(1.5,0.75,1.25,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 3.0)) THEN IF ((IFLG .EQ. 0)) THEN EY = 1.0 + A0R*(D-3.0) ELSE EY=EYFCN(1.25,0.1,0.3,B,BETA)+EYFCN(1.5,0.75,1.25,B,BETA) & +EYFCN(A0R,3.,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 122.0) .AND. (L .LT. 124.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.45)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.0 + 0.22*D ELSE EY=EYFCN(0.22,0.,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.45) .AND. (D .LT. 1.3)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.099 + 0.9424*(D-0.45) ELSE EY=EYFCN(0.22,0.,0.45,B,BETA)+EYFCN(0.9424,0.45,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.3) .AND. (D .LT. 4.1)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.90004 ELSE EY=EYFCN(0.22,0.,0.45,B,BETA)+EYFCN(0.9424,0.45,1.3,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 4.1)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.90004 + A0R*(D-4.1) ELSE EY=EYFCN(0.22,0.,0.45,B,BETA)+EYFCN(0.9424,0.45,1.3,B,BETA) & +EYFCN(A0R,4.1,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 124.0) .AND. (L .LT. 127.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.55)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.36*D ELSE EY=EYFCN(0.36,0.,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.55) .AND. (D .LT. 1.0)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.198 + 1.56*(D-0.55) ELSE EY=EYFCN(0.36,0.,0.55,B,BETA)+EYFCN(1.56,0.55,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.0) .AND. (D .LT. 3.65)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.9 ELSE EY=EYFCN(0.36,0.,0.55,B,BETA)+EYFCN(1.56,0.55,1.,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 3.65)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.9 + A0R*(D-3.65) ELSE EY=EYFCN(0.36,0.,0.55,B,BETA)+EYFCN(1.56,0.55,1.,B,BETA) & +EYFCN(A0R,3.65,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 127.0) .AND. (L .LT. 130.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.6)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.17*D ELSE EY=EYFCN(0.17,0.,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.6) .AND. (D .LT. 1.0)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.102 + 1.37*(D-0.6) ELSE EY=EYFCN(0.17,0.,0.6,B,BETA)+EYFCN(1.37,0.6,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.0) .AND. (D .LT. 4.45)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.65 ELSE EY=EYFCN(0.17,0.,0.6,B,BETA)+EYFCN(1.37,0.6,1.,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 4.45)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.65 + A0R*(D-4.45) ELSE EY=EYFCN(0.17,0.,0.6,B,BETA)+EYFCN(1.37,0.6,1.,B,BETA) & +EYFCN(A0R,4.45,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF 663 IF ((L .GE. 130.0) .AND. (L .LT. 132.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.5)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.2*D ELSE EY=EYFCN(0.2,0.,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.5) .AND. (D .LT. 1.2)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.1 + 1.07*(D-0.5) ELSE EY=EYFCN(0.2,0.,0.5,B,BETA)+EYFCN(1.07,0.5,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.2) .AND. (D .LT. 4.25)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.849 ELSE EY=EYFCN(0.2,0.,0.5,B,BETA)+EYFCN(1.07,0.5,1.2,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 4.25)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.849 + A0R*(D-4.25) ELSE EY=EYFCN(0.2,0.,0.5,B,BETA)+EYFCN(1.07,0.5,1.2,B,BETA) & +EYFCN(A0R,4.25,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 132.0) .AND. (L .LT. 134.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.2)) THEN EY = 0.0 GOTO 1000 ENDIF IF ((D .GE. 0.2) .AND. (D .LT. 0.4)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.0 + 2.5*(D-0.2) ELSE EY=EYFCN(2.5,0.2,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.4) .AND. (D .LT. 1.2)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.5 + 0.81*(D-0.4) ELSE EY=EYFCN(2.5,0.2,0.4,B,BETA)+EYFCN(0.81,0.4,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.2) .AND. (D .LT. 2.5)) THEN IF ((IFLG .EQ. 0)) THEN EY = 1.148 ELSE EY=EYFCN(2.5,0.2,0.4,B,BETA)+EYFCN(0.81,0.4,1.2,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 2.5)) THEN IF ((IFLG .EQ. 0)) THEN EY = 1.148 + A0R*(D-2.5) ELSE EY=EYFCN(2.5,0.2,0.4,B,BETA)+EYFCN(0.81,0.4,1.2,B,BETA) & +EYFCN(A0R,2.5,D,B,BETA) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 134.0) .AND. (L .LT. 137.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.1)) THEN EY = 0.0 GOTO 1000 ENDIF IF ((D .GE. 0.1) .AND. (D .LT. 0.3)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.0 + 1.5*(D-0.1) ELSE EY=EYFCN(1.5,0.1,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.3) .AND. (D .LT. 1.0)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.3 + 0.86*(D-0.3) ELSE EY=EYFCN(1.5,0.1,0.3,B,BETA)+EYFCN(0.86,0.3,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.0) .AND. (D .LT. 3.0)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.902 ELSE EY=EYFCN(1.5,0.1,0.3,B,BETA)+EYFCN(0.86,0.3,1.,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 3.0)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.902 + A0R*(D-3.0) ELSE EY=EYFCN(1.5,0.1,0.3,B,BETA)+EYFCN(0.86,0.3,1.,B,BETA) & +EYFCN(A0R,3.,D,B,BETA) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 137.0) .AND. (L .LT. 140.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.2)) THEN EY = 0.0 GOTO 1000 ENDIF IF ((D .GE. 0.2) .AND. (D .LT. 0.55)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.0 + (D-0.2) ELSE EY=EYFCN(1.,0.2,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.55) .AND. (D .LT. 0.9)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.35 + 1.71*(D-0.55) ELSE EY=EYFCN(1.,0.2,0.55,B,BETA)+EYFCN(1.71,0.55,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.9) .AND. (D .LT. 3.2)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.9485 ELSE EY=EYFCN(1.,0.2,0.55,B,BETA)+EYFCN(1.71,0.55,0.9,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 3.2)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.9485 + A0R*(D-3.2) ELSE EY=EYFCN(1.,0.2,0.55,B,BETA)+EYFCN(1.71,0.55,0.9,B,BETA) & +EYFCN(A0R,3.2,D,B,BETA) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 140.0) .AND. (L .LT. 150.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.2)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.5*D ELSE EY=EYFCN(0.5,0.,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.2) .AND. (D .LT. 0.5)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.1 ELSE EY=EYFCN(0.5,0.,0.2,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.5) .AND. (D .LT. 0.7)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.1 + 3.5*(D-0.5) ELSE EY=EYFCN(0.5,0.,0.2,B,BETA)+EYFCN(3.5,0.5,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.7) .AND. (D .LT. 2.5)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.8 ELSE EY=EYFCN(0.5,0.,0.2,B,BETA)+EYFCN(3.5,0.5,0.7,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 2.5) .AND. (D .LT. 3.3)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.8 + 0.5*(D-2.5) ELSE EY=EYFCN(0.5,0.,0.2,B,BETA)+EYFCN(3.5,0.5,0.7,B,BETA) & +EYFCN(0.5,2.5,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 3.3)) THEN IF ((IFLG .EQ. 0)) THEN EY = 1.2 + A0R*(D-3.3) ELSE EY=EYFCN(0.5,0.,0.2,B,BETA)+EYFCN(3.5,0.5,0.7,B,BETA) & +EYFCN(0.5,2.5,3.3,B,BETA)+EYFCN(A0R,3.3,D,B,BETA) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 150.0) .AND. (L .LT. 160.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.2)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.5*D ELSE EY=EYFCN(0.5,0.,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.2) .AND. (D .LT. 0.35)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.1 + 0.33*(D-0.2) ELSE EY=EYFCN(0.5,0.,0.2,B,BETA)+EYFCN(0.33,0.2,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.35) .AND. (D .LT. 0.75)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.1495 + 0.3763*(D-0.35) ELSE EY=EYFCN(0.5,0.,0.2,B,BETA)+EYFCN(0.33,0.2,0.35,B,BETA) & +EYFCN(0.3763,0.35,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.75) .AND. (D .LT. 0.95)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.3002 + 1.749*(D-0.75) ELSE EY=EYFCN(0.5,0.,0.2,B,BETA)+EYFCN(0.33,0.2,0.35,B,BETA) & +EYFCN(0.3763,0.35,0.75,B,BETA) & +EYFCN(1.749,0.75,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.95) .AND. (D .LT. 1.45)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.65 + 0.4*(D-0.95) ELSE EY=EYFCN(0.5,0.,0.2,B,BETA)+EYFCN(0.33,0.2,0.35,B,BETA) & +EYFCN(0.3763,0.35,0.75,B,BETA) & +EYFCN(1.749,0.75,0.95,B,BETA) & +EYFCN(0.4,0.95,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.45) .AND. (D .LT. 2.85)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.85 ELSE EY=EYFCN(0.5,0.,0.2,B,BETA)+EYFCN(0.33,0.2,0.35,B,BETA) & +EYFCN(0.3763,0.35,0.75,B,BETA) & +EYFCN(1.749,0.75,0.95,B,BETA) & +EYFCN(0.4,0.95,1.45,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 2.85)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.85 + A0R*(D-2.85) ELSE EY=EYFCN(0.5,0.,0.2,B,BETA)+EYFCN(0.33,0.2,0.35,B,BETA) & +EYFCN(0.3763,0.35,0.75,B,BETA) & +EYFCN(1.749,0.75,0.95,B,BETA) & +EYFCN(0.4,0.95,1.45,B,BETA)+EYFCN(A0R,2.85,D,B,BETA) ENDIF GOTO 1000 ENDIF ENDIF 664 IF ((L .GE. 160.0) .AND. (L .LT. 170.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.6)) THEN EY = 0.0 GOTO 1000 ENDIF IF ((D .GE. 0.6) .AND. (D .LT. 0.9)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.0 + 1.33*(D-0.6) ELSE EY=EYFCN(1.33,0.6,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.9) .AND. (D .LT. 2.5)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.399 ELSE EY=EYFCN(1.33,0.6,0.9,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 2.5) .AND. (D .LT. 3.0)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.399 + 0.802*(D-2.5) ELSE EY=EYFCN(1.33,0.6,0.9,B,BETA)+EYFCN(0.802,2.5,D,B,BETA0) ENDIF GOTO 1000 ENDIF IF ((D .GE. 3.0)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.8 + A0R*(D-3.0) ELSE EY=EYFCN(1.33,0.6,0.9,B,BETA)+EYFCN(0.802,2.5,3.,B,BETA0) & +EYFCN(A0R,3.,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 170.0) .AND. (L .LT. 174.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.1)) THEN EY = 0.0 GOTO 1000 ENDIF IF ((D .GE. 0.1) .AND. (D .LT. 0.5)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.0 + (D-0.1) ELSE EY=EYFCN(1.,0.1,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.5) .AND. (D .LT. 1.5)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.4 ELSE EY=EYFCN(1.,0.1,0.5,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.5) .AND. (D .LT. 1.85)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.4 + 0.43*(D-1.5) ELSE EY=EYFCN(1.,0.1,0.5,B,BETA)+EYFCN(0.43,1.5,D,B,BETA0) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.85) .AND. (D .LT. 3.0)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.5505 ELSE EY=EYFCN(1.,0.1,0.5,B,BETA)+EYFCN(0.43,1.5,1.85,B,BETA0) ENDIF GOTO 1000 ENDIF IF ((D .GE. 3.0)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.5505 + A0R*(D-3.0) ELSE EY=EYFCN(1.,0.1,0.5,B,BETA)+EYFCN(0.43,1.5,1.85,B,BETA0) & +EYFCN(A0R,3.,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 174.0) .AND. (L .LT. 184.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.5)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.6*D ELSE EY=EYFCN(0.6,0.,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.5) .AND. (D .LT. 1.95)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.3 ELSE EY=EYFCN(0.6,0.,0.5,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.95) .AND. (D .LT. 2.6)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.3 + (D-1.95) ELSE EY=EYFCN(0.6,0.,0.5,B,BETA)+EYFCN(1.,1.95,D,B,BETA0) ENDIF GOTO 1000 ENDIF IF ((D .GE. 2.6)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.95 + A0R*(D-2.6) ELSE EY=EYFCN(0.6,0.,0.5,B,BETA)+EYFCN(1.,1.95,2.6,B,BETA0) & +EYFCN(A0R,2.6,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 184.0) .AND. (L .LT. 190.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.05)) THEN EY = 0.0 GOTO 1000 ENDIF IF ((D .GE. 0.05) .AND. (D .LT. 0.25)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.5*(D-0.05) ELSE EY=EYFCN(0.5,0.05,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.25) .AND. (D .LT. 0.8)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.1 ELSE EY=EYFCN(0.5,0.05,0.25,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.8) .AND. (D .LT. 1.3)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.1 + 1.7*(D-0.8) ELSE EY=EYFCN(0.5,0.05,0.25,B,BETA)+EYFCN(1.7,0.8,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.3) .AND. (D .LT. 3.35)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.95 ELSE EY=EYFCN(0.5,0.05,0.25,B,BETA)+EYFCN(1.7,0.8,1.3,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 3.35)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.95 + A0R*(D-3.35) ELSE EY=EYFCN(0.5,0.05,0.25,B,BETA)+EYFCN(1.7,0.8,1.3,B,BETA) & +EYFCN(A0R,3.35,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF 665 IF ((L .GE. 190.0) .AND. (L .LT. 200.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.1)) THEN EY = 0.0 GOTO 1000 ENDIF IF ((D .GE. 0.1) .AND. (D .LT. 0.3)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.5*(D-0.1) ELSE EY=EYFCN(0.5,0.1,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.3) .AND. (D .LT. 0.65)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.1 ELSE EY=EYFCN(0.5,0.1,0.3,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.65) .AND. (D .LT. 1.05)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.1 + 0.88*(D-0.65) ELSE EY=EYFCN(0.5,0.1,0.3,B,BETA)+EYFCN(0.88,0.65,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.05) .AND. (D .LT. 1.8)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.452 ELSE EY=EYFCN(0.5,0.1,0.3,B,BETA)+EYFCN(0.88,0.65,1.05,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.8) .AND. (D .LT. 2.25)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.452 + 0.44*(D-1.8) ELSE EY=EYFCN(0.5,0.1,0.3,B,BETA)+EYFCN(0.88,0.65,1.05,B,BETA) & +EYFCN(0.44,1.8,D,B,BETA0) ENDIF GOTO 1000 ENDIF IF ((D .GE. 2.25) .AND. (D .LT. 4.4)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.65 ELSE EY=EYFCN(0.5,0.1,0.3,B,BETA)+EYFCN(0.88,0.65,1.05,B,BETA) & +EYFCN(0.44,1.8,2.25,B,BETA0) ENDIF GOTO 1000 ENDIF IF ((D .GE. 4.4)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.65 + A0R*(D-4.4) ELSE EY=EYFCN(0.5,0.1,0.3,B,BETA)+EYFCN(0.88,0.65,1.05,B,BETA) & +EYFCN(0.44,1.8,2.25,B,BETA0)+EYFCN(A0R,4.4,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 200.0) .AND. (L .LT. 205.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.2)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.25*D ELSE EY=EYFCN(0.25,0.,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.2) .AND. (D .LT. 0.6)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.05 ELSE EY=EYFCN(0.25,0.,0.2,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.6) .AND. (D .LT. 0.85)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.05 + 0.4*(D-0.6) ELSE EY=EYFCN(0.25,0.,0.2,B,BETA)+EYFCN(0.4,0.6,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.85) .AND. (D .LT. 1.75)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.15 ELSE EY=EYFCN(0.25,0.,0.2,B,BETA)+EYFCN(0.4,0.6,0.85,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.75) .AND. (D .LT. 2.0)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.15 + (D-1.75) ELSE EY=EYFCN(0.25,0.,0.2,B,BETA)+EYFCN(0.4,0.6,0.85,B,BETA) & +EYFCN(1.,1.75,D,B,BETA0) ENDIF GOTO 1000 ENDIF IF ((D .GE. 2.0) .AND. (D .LT. 3.65)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.4 ELSE EY=EYFCN(0.25,0.,0.2,B,BETA)+EYFCN(0.4,0.6,0.85,B,BETA) & +EYFCN(1.,1.75,2.,B,BETA0) ENDIF GOTO 1000 ENDIF IF ((D .GE. 3.65)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.4 + A0R*(D-3.65) ELSE EY=EYFCN(0.25,0.,0.2,B,BETA)+EYFCN(0.4,0.6,0.85,B,BETA) & +EYFCN(1.,1.75,2.,B,BETA0)+EYFCN(A0R,3.65,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 205.0) .AND. (L .LT. 210.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.65)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.0 + 0.15*D ELSE EY=EYFCN(0.15,0.,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.65) .AND. (D .LT. 1.25)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.0975 + 1.1708*(D-0.65) ELSE EY=EYFCN(0.15,0.,0.65,B,BETA)+EYFCN(1.1708,0.65,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.25)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.79998 + A0R*(D-1.25) ELSE EY=EYFCN(0.15,0.,0.65,B,BETA)+EYFCN(1.1708,0.65,1.25,B,BETA) & +EYFCN(A0R,1.25,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 210.0) .AND. (L .LT. 220.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.9)) THEN EY = 0.0 GOTO 1000 ENDIF IF ((D .GE. 0.9) .AND. (D .LT. 1.25)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.0 + (D-0.9) ELSE EY=EYFCN(1.,0.9,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.25) .AND. (D .LT. 3.0)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.35 ELSE EY=EYFCN(1.,0.9,1.25,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 3.0) .AND. (D .LT. 3.5)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.35 + 0.8*(D-3.) ELSE EY=EYFCN(1.,0.9,1.25,B,BETA)+EYFCN(0.8,3.,D,B,BETA0) ENDIF GOTO 1000 ENDIF IF ((D .GE. 3.5)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.75 + A0R*(D-3.5) ELSE EY=EYFCN(1.,0.9,1.25,B,BETA)+EYFCN(0.8,3.,3.5,B,BETA0) & +EYFCN(A0R,3.5,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF 666 IF ((L .GE. 220.0) .AND. (L .LT. 230.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.3)) THEN EY = 0.0 GOTO 1000 ENDIF IF ((D .GE. 0.3) .AND. (D .LT. 0.65)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.0 + (D-0.3) ELSE EY=EYFCN(1.,0.3,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.65) .AND. (D .LT. 1.75)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.35 ELSE EY=EYFCN(1.,0.3,0.65,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.75) .AND. (D .LT. 2.1)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.35 + 0.43*(D-1.75) ELSE EY=EYFCN(1.,0.3,0.65,B,BETA)+EYFCN(0.43,1.75,D,B,BETA0) ENDIF GOTO 1000 ENDIF IF ((D .GE. 2.1) .AND. (D .LT. 2.5)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.5005 ELSE EY=EYFCN(1.,0.3,0.65,B,BETA)+EYFCN(0.43,1.75,2.1,B,BETA0) ENDIF GOTO 1000 ENDIF IF ((D .GE. 2.5)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.5005 + A0R*(D-2.5) ELSE EY=EYFCN(1.,0.3,0.65,B,BETA)+EYFCN(0.43,1.75,2.1,B,BETA0) & +EYFCN(A0R,2.5,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 230.0) .AND. (L .LT. 240.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 1.5)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.1*D ELSE EY=EYFCN(0.1,0.,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.5)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.15 + A0R*(D-1.5) ELSE EY=EYFCN(0.1,0.,1.5,B,BETA)+EYFCN(A0R,1.5,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 240.0) .AND. (L .LT. 250.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.1)) THEN EY = 0.0 GOTO 1000 ENDIF IF ((D .GE. 0.1) .AND. (D .LT. 0.5)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.0 + 0.5*(D-0.1) ELSE EY=EYFCN(0.5,0.1,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.5) .AND. (D .LT. 3.4)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.2 ELSE EY=EYFCN(0.5,0.1,0.5,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 3.4) .AND. (D .LT. 4.5)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.2 + 0.27*(D-3.4) ELSE EY=EYFCN(0.5,0.1,0.5,B,BETA)+EYFCN(0.27,3.4,D,B,BETA0) ENDIF GOTO 1000 ENDIF IF ((D .GE. 4.5) .AND. (D .LT. 9.0)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.497 ELSE EY=EYFCN(0.5,0.1,0.5,B,BETA)+EYFCN(0.27,3.4,4.5,B,BETA0) ENDIF GOTO 1000 ENDIF IF ((D .GE. 9.0)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.497 + A0R*(D-9.0) ELSE EY=EYFCN(0.5,0.1,0.5,B,BETA)+EYFCN(0.27,3.4,4.5,B,BETA0) & +EYFCN(A0R,9.,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF 667 IF ((L .GE. 250.0) .AND. (L .LT. 257.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.4)) THEN EY = 0.0 GOTO 1000 ENDIF IF ((D .GE. 0.4) .AND. (D .LT. 0.6)) THEN IF ((IFLG .EQ. 0)) THEN EY = 1.25*(D-0.4) ELSE EY=EYFCN(1.25,0.4,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.6) .AND. (D .LT. 2.0)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.25 ELSE EY=EYFCN(1.25,0.4,0.6,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 2.0) .AND. (D .LT. 2.75)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.25 + 0.47*(D-2.) ELSE EY=EYFCN(1.25,0.4,0.6,B,BETA)+EYFCN(0.47,2.,D,B,BETA0) ENDIF GOTO 1000 ENDIF IF ((D .GE. 2.75) .AND. (D .LT. 4.25)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.6025 ELSE EY=EYFCN(1.25,0.4,0.6,B,BETA)+EYFCN(0.47,2.,2.75,B,BETA0) ENDIF GOTO 1000 ENDIF IF ((D .GE. 4.25)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.6025 + A0R*(D-4.25) ELSE EY=EYFCN(1.25,0.4,0.6,B,BETA)+EYFCN(0.47,2.,2.75,B,BETA0) & +EYFCN(A0R,4.25,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 257.0) .AND. (L .LT. 264.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.65)) THEN EY = 0.0 GOTO 1000 ENDIF IF ((D .GE. 0.65) .AND. (D .LT. 1.0)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.0 + 1.86*(D-0.65) ELSE EY=EYFCN(1.86,0.65,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.0) .AND. (D .LT. 3.0)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.651 ELSE EY=EYFCN(1.86,0.65,1.,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 3.0)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.651 + A0R*(D-3.0) ELSE EY=EYFCN(1.86,0.65,1.,B,BETA)+EYFCN(A0R,3.,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 264.0) .AND. (L .LT. 267.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.9)) THEN EY = 0.0 GOTO 1000 ENDIF IF ((D .GE. 0.9) .AND. (D .LT. 1.35)) THEN IF ((IFLG .EQ. 0)) THEN EY = 2.*(D-0.9) ELSE EY=EYFCN(2.,0.9,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.35) .AND. (D .LT. 3.1)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.9 ELSE EY=EYFCN(2.,0.9,1.35,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 3.1)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.9 + A0R*(D-3.1) ELSE EY=EYFCN(2.,0.9,1.35,B,BETA)+EYFCN(A0R,3.1,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 267.0) .AND. (L .LT. 270.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.95)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.105*D ELSE EY=EYFCN(0.105,0.,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.95) .AND. (D .LT. 1.25)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.09975 + 2.67*(D-0.95) ELSE EY=EYFCN(0.105,0.,0.95,B,BETA)+EYFCN(2.67,0.95,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.25) .AND. (D .LT. 3.2)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.90075 ELSE EY=EYFCN(0.105,0.,0.95,B,BETA)+EYFCN(2.67,0.95,1.25,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 3.2)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.90075 + A0R*(D-3.2) ELSE EY=EYFCN(0.105,0.,0.95,B,BETA)+EYFCN(2.67,0.95,1.25,B,BETA) & +EYFCN(A0R,3.2,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 270.0) .AND. (L .LT. 280.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 1.0)) THEN EY = 0.0 GOTO 1000 ENDIF IF ((D .GE. 1.0) .AND. (D .LT. 1.25)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.0 + 2.*(D-1.) ELSE EY=EYFCN(2.,1.,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.25) .AND. (D .LT. 3.9)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.5 ELSE EY=EYFCN(2.,1.,1.25,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 3.9)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.5 + A0R*(D-3.9) ELSE EY=EYFCN(2.,1.,1.25,B,BETA)+EYFCN(A0R,3.9,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF 668 IF ((L .GE. 280.0) .AND. (L .LT. 290.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.45)) THEN EY = 0.0 GOTO 1000 ENDIF IF ((D .GE. 0.45) .AND. (D .LT. 0.65)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.5*(D-0.45) ELSE EY=EYFCN(0.5,0.45,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.65) .AND. (D .LT. 1.3)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.1 ELSE EY=EYFCN(0.5,0.45,0.65,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.3) .AND. (D .LT. 1.5)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.1 + 1.5*(D-1.3) ELSE EY=EYFCN(0.5,0.45,0.65,B,BETA)+EYFCN(1.5,1.3,D,B,BETA0) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.5) .AND. (D .LT. 2.65)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.4 ELSE EY=EYFCN(0.5,0.45,0.65,B,BETA)+EYFCN(1.5,1.3,1.5,B,BETA0) ENDIF GOTO 1000 ENDIF IF ((D .GE. 2.65)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.4 + A0R*(D-2.65) ELSE EY=EYFCN(0.5,0.45,0.65,B,BETA)+EYFCN(1.5,1.3,1.5,B,BETA0) & +EYFCN(A0R,2.65,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 290.0) .AND. (L .LT. 291.5)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.55)) THEN EY = 0.0 GOTO 1000 ENDIF IF ((D .GE. 0.55) .AND. (D .LT. 1.0)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.0 + 1.11*(D-0.55) ELSE EY=EYFCN(1.11,0.55,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.0) .AND. (D .LT. 2.9)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.4995 ELSE EY=EYFCN(1.11,0.55,1.,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 2.9) .AND. (D .LT. 3.55)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.4995 + 1.1546*(D-2.9) ELSE EY=EYFCN(1.11,0.55,1.,B,BETA)+EYFCN(1.1546,2.9,D,B,BETA0) ENDIF GOTO 1000 ENDIF IF ((D .GE. 3.55)) THEN IF ((IFLG .EQ. 0)) THEN EY = 1.24999 + A0R*(D-3.55) ELSE EY=EYFCN(1.11,0.55,1.,B,BETA)+EYFCN(1.1546,2.9,3.55,B,BETA0) & +EYFCN(A0R,3.55,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 291.5) .AND. (L .LT. 293.5)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.25)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.4*D ELSE EY=EYFCN(0.4,0.,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.25) .AND. (D .LT. 0.8)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.1 ELSE EY=EYFCN(0.4,0.,0.25,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.8) .AND. (D .LT. 1.1)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.1 + (D-0.8) ELSE EY=EYFCN(0.4,0.,0.25,B,BETA)+EYFCN(1.,0.8,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.1) .AND. (D .LT. 4.0)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.4 ELSE EY=EYFCN(0.4,0.,0.25,B,BETA)+EYFCN(1.,0.8,1.1,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 4.0)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.4 + A0R*(D-4.0) ELSE EY=EYFCN(0.4,0.,0.25,B,BETA)+EYFCN(1.,0.8,1.1,B,BETA) & +EYFCN(A0R,4.0,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 293.5) .AND. (L .LT. 300.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.25)) THEN EY = 0.0 GOTO 1000 ENDIF IF ((D .GE. 0.25) .AND. (D .LT. 0.6)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.0 + (D-0.25) ELSE EY=EYFCN(1.,0.25,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.6) .AND. (D .LT. 4.5)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.35 ELSE EY=EYFCN(1.,0.25,0.6,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 4.5)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.35 + A0R*(D-4.5) ELSE EY=EYFCN(1.,0.25,0.6,B,BETA)+EYFCN(A0R,4.5,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 300.0) .AND. (L .LT. 310.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.15)) THEN EY = 0.0 GOTO 1000 ENDIF IF ((D .GE. 0.15) .AND. (D .LT. 0.5)) THEN IF ((IFLG .EQ. 0)) THEN EY = 1.57*(D-0.15) ELSE EY=EYFCN(1.57,0.15,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.5) .AND. (D .LT. 1.6)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.5495 ELSE EY=EYFCN(1.57,0.15,0.5,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.6) .AND. (D .LT. 1.95)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.5495 + 0.8586*(D-1.6) ELSE EY=EYFCN(1.57,0.15,0.5,B,BETA)+EYFCN(0.8586,1.6,D,B,BETA0) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.95)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.85001 + A0R*(D-1.95) ELSE EY=EYFCN(1.57,0.15,0.5,B,BETA)+EYFCN(0.8586,1.6,1.95,B,BETA0) & +EYFCN(A0R,1.95,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF 669 IF ((L .GE. 310.0) .AND. (L .LT. 320.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.15)) THEN EY = 0.0 GOTO 1000 ENDIF IF ((D .GE. 0.15) .AND. (D .LT. 0.4)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.8*(D-0.15) ELSE EY=EYFCN(0.8,0.15,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.4) .AND. (D .LT. 0.75)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.2 ELSE EY=EYFCN(0.8,0.15,0.4,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.75) .AND. (D .LT. 1.0)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.2 + 0.8*(D-0.75) ELSE EY=EYFCN(0.8,0.15,0.4,B,BETA)+EYFCN(0.8,0.75,D,B,BETA0) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.0)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.4 + A0R*(D-1.0) ELSE EY=EYFCN(0.8,0.15,0.4,B,BETA)+EYFCN(0.8,0.75,1.,B,BETA0) & +EYFCN(A0R,1.,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 320.0) .AND. (L .LT. 330.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.2)) THEN EY = 0.0 GOTO 1000 ENDIF IF ((D .GE. 0.2) .AND. (D .LT. 0.75)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.0 + 0.55*(D-0.2) ELSE EY=EYFCN(0.55,0.2,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.75) .AND. (D .LT. 3.1)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.3025 ELSE EY=EYFCN(0.55,0.2,0.75,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 3.1) .AND. (D .LT. 3.5)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.3025 + 1.13*(D-3.1) ELSE EY=EYFCN(0.55,0.2,0.75,B,BETA)+EYFCN(1.13,3.1,D,B,BETA0) ENDIF GOTO 1000 ENDIF IF ((D .GE. 3.5)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.7545 + A0R*(D-3.5) ELSE EY=EYFCN(0.55,0.2,0.75,B,BETA)+EYFCN(1.13,3.1,3.5,B,BETA0) & +EYFCN(A0R,3.5,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 330.0) .AND. (L .LT. 333.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.7)) THEN EY = 0.0 GOTO 1000 ENDIF IF ((D .GE. 0.7) .AND. (D .LT. 1.0)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.0 + 3.33*(D-0.7) ELSE EY=EYFCN(3.33,0.7,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.0) .AND. (D .LT. 4.3)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.999 ELSE EY=EYFCN(3.33,0.7,1.0,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 4.3)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.999 + A0R*(D-4.3) ELSE EY=EYFCN(3.33,0.7,1.0,B,BETA)+EYFCN(A0R,4.3,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 333.0) .AND. (L .LT. 337.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.15)) THEN EY = 0.0 GOTO 1000 ENDIF IF ((D .GE. 0.15) .AND. (D .LT. 0.25)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.0 + 1.5*(D-0.15) ELSE EY=EYFCN(1.5,0.15,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.25) .AND. (D .LT. 0.95)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.15 ELSE EY=EYFCN(1.5,0.15,0.25,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.95) .AND. (D .LT. 1.3)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.15 + 1.86*(D-0.95) ELSE EY=EYFCN(1.5,0.15,0.25,B,BETA)+EYFCN(1.86,0.95,D,B,BETA0) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.3) .AND. (D .LT. 3.5)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.801 ELSE EY=EYFCN(1.5,0.15,0.25,B,BETA)+EYFCN(1.86,0.95,1.3,B,BETA0) ENDIF GOTO 1000 ENDIF IF ((D .GE. 3.5)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.801 + A0R*(D-3.5) ELSE EY=EYFCN(1.5,0.15,0.25,B,BETA)+EYFCN(1.86,0.95,1.3,B,BETA0) & +EYFCN(A0R,3.5,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 337.0) .AND. (L .LT. 338.5)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.8)) THEN EY = 0.0 GOTO 1000 ENDIF IF ((D .GE. 0.8) .AND. (D .LT. 1.0)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.0 + 2.75*(D-0.8) ELSE EY=EYFCN(2.75,0.8,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.0) .AND. (D .LT. 2.05)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.55 ELSE EY=EYFCN(2.75,0.8,1.,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 2.05) .AND. (D .LT. 2.5)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.55 + 0.33*(D-2.05) ELSE EY=EYFCN(2.75,0.8,1.,B,BETA)+EYFCN(0.33,2.05,D,B,BETA0) ENDIF GOTO 1000 ENDIF IF ((D .GE. 2.5) .AND. (D .LT. 4.0)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.6985 ELSE EY=EYFCN(2.75,0.8,1.,B,BETA)+EYFCN(0.33,2.05,2.5,B,BETA0) ENDIF GOTO 1000 ENDIF IF ((D .GE. 4.0)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.6985 + A0R*(D-4.0) ELSE EY=EYFCN(2.75,0.8,1.,B,BETA)+EYFCN(0.33,2.05,2.5,B,BETA0) & +EYFCN(A0R,4.0,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 338.5) .AND. (L .LT. 340.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.1)) THEN EY = 0.0 GOTO 1000 ENDIF IF ((D .GE. 0.1) .AND. (D .LT. 0.3)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.0 + 2.5*(D-0.1) ELSE EY=EYFCN(2.5,0.1,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.3) .AND. (D .LT. 1.25)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.5 ELSE EY=EYFCN(2.5,0.1,0.3,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.25) .AND. (D .LT. 1.75)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.5 + 0.7*(D-1.25) ELSE EY=EYFCN(2.5,0.1,0.3,B,BETA)+EYFCN(0.7,1.25,D,B,BETA0) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.75) .AND. (D .LT. 2.85)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.85 ELSE EY=EYFCN(2.5,0.1,0.3,B,BETA)+EYFCN(0.7,1.25,1.75,B,BETA0) ENDIF GOTO 1000 ENDIF IF ((D .GE. 2.85)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.85 + A0R*(D-2.85) ELSE EY=EYFCN(2.5,0.1,0.3,B,BETA)+EYFCN(0.7,1.25,1.75,B,BETA0) & +EYFCN(A0R,2.85,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF 670 IF ((L .GE. 340.0) .AND. (L .LT. 343.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.35)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.0 + 0.29*D ELSE EY=EYFCN(0.29,0.,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.35) .AND. (D .LT. 0.65)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.1015 + 3.28*(D-0.35) ELSE EY=EYFCN(0.29,0.,0.35,B,BETA)+EYFCN(3.28,0.35,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.65)) THEN IF ((IFLG .EQ. 0)) THEN EY = 1.0855 + A0R*(D-0.65) ELSE EY=EYFCN(0.29,0.,0.35,B,BETA)+EYFCN(3.28,0.35,0.65,B,BETA) & +EYFCN(A0R,0.65,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 343.0) .AND. (L .LT. 350.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.3)) THEN EY = 0.0 GOTO 1000 ENDIF IF ((D .GE. 0.3) .AND. (D .LT. 0.95)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.0 + (D-0.3) ELSE EY=EYFCN(1.,0.3,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.95) .AND. (D .LT. 1.8)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.65 ELSE EY=EYFCN(1.,0.3,0.95,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.8)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.65 + A0R*(D-1.8) ELSE EY=EYFCN(1.,0.3,0.95,B,BETA)+EYFCN(A0R,1.8,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 350.0) .AND. (L .LT. 357.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 0.25)) THEN EY = 0.0 GOTO 1000 ENDIF IF ((D .GE. 0.25) .AND. (D .LT. 0.45)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.0 + 1.75*(D-0.25) ELSE EY=EYFCN(1.75,0.25,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 0.45) .AND. (D .LT. 1.15)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.35 ELSE EY=EYFCN(1.75,0.25,0.45,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.15) .AND. (D .LT. 1.55)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.35 + 2.63*(D-1.15) ELSE EY=EYFCN(1.75,0.25,0.45,B,BETA)+EYFCN(2.63,1.15,D,B,BETA0) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.55)) THEN IF ((IFLG .EQ. 0)) THEN EY = 1.402 + A0R*(D-1.55) ELSE EY=EYFCN(1.75,0.25,0.45,B,BETA)+EYFCN(2.63,1.15,1.55,B,BETA0) & +EYFCN(A0R,1.55,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF IF ((L .GE. 357.0) .AND. (L .LT. 360.0)) THEN IF ((D .GE. 0.0) .AND. (D .LT. 1.25)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.0 + 0.12*D ELSE EY=EYFCN(0.12,0.,D,B,BETA) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.25) .AND. (D .LT. 1.75)) THEN IF ((IFLG .EQ. 0)) THEN EY = 0.15 + 2.*(D-1.25) ELSE EY=EYFCN(0.12,0.,1.25,B,BETA)+EYFCN(2.,1.25,D,B,BETA0) ENDIF GOTO 1000 ENDIF IF ((D .GE. 1.75) .AND. (D .LT. 3.5)) THEN IF ((IFLG .EQ. 0)) THEN EY = 1.15 ELSE EY=EYFCN(0.12,0.,1.25,B,BETA)+EYFCN(2.,1.25,1.75,B,BETA0) ENDIF GOTO 1000 ENDIF IF ((D .GE. 3.5)) THEN IF ((IFLG .EQ. 0)) THEN EY = 1.15 + A0R*(D-3.5) ELSE EY=EYFCN(0.12,0.,1.25,B,BETA)+EYFCN(2.,1.25,1.75,B,BETA0) & +EYFCN(A0R,3.5,D,B,BETA0) ENDIF GOTO 1000 ENDIF ENDIF C--------------------------------------------------------------------------- C Error calculation (correlation coefficient r = 0.998). C--------------------------------------------------------------------------- c 1000 SEY= 0.059*EY*EY+0.218*EY+0.44 1000 AV = EY*R SAV= SQRT(0.132*0.132+AV*AV/9.) C SAV= SEY*R IF (ABS(B) .EQ. 90.) SAV=0.0 RETURN END FUNCTION EYFCN(S,D0,D,B,BETA) IMPLICIT REAL*4 (A-H,L-Z) C--------------------------------------------------------------------------- C This function calculates the color excess Ey for stars significantly C out of the Galactic plane (z > 55 pc), and is used in FITZGERALD. C VARIABLE DEFINITIONS: S is the differential color excess per kpc, C D0 is the distance to the front edge of the cloud, D is the distance C to the star (or distance to the back edge of the intervening cloud), C b is galactic latitude, and beta is the half width of the material C perpendicular to the galactic plane. C--------------------------------------------------------------------------- IF (ABS(B) .GT. 89.999) THEN EYFCN=0. RETURN ENDIF IF (D0 .GT. 0.) THEN E0=EXP(-D0*ABS(TAND(B))/BETA) ELSE E0=1. ENDIF E=EXP(-D*ABS(TAND(B))/BETA) EYFCN=BETA*S*(E0-E)/ABS(SIND(B)) RETURN END SUBROUTINE NECKEL_KLARE(LL,BB,D,AV,SAV,A0) C----------------------------------------------------------------------- C From Neckel and Klare, A&A Supp 42, 251 (1980). C----------------------------------------------------------------------- C MAIN SUBROUTINE FOR THE NECKEL AND KLARE PAPER C THERE ARE TWO FUNCTIONS AND 21 ADDITIONAL SUBROUTINES ASSOCIATED C WITH THIS COMPUTER MODEL OF THE NECKEL AND KLARE PAPER. C THE SUBROUTINES WITH THE NAMES MAP####(12 IN ALL) ARE THE SKYMAP C SELECTION SUBROUTINES. ONE FOR EACH OF THE 12 MAPS(PAGES 258 THRU C 261) GIVEN IN THE PAPER. THE SUBROUTINES WITH THE NAMES ENK#(8 C TOTAL)ARE THE EXTINCTION SUBROUTINES. THE VARIABLE CELL IN THE ENK# C SUBROUTINES IS ASSOCIATED WITH THE EXTINCTIONS PLOTS GIVEN IN THE C NK PAPER(PAGES 262 THRU 276). FINALLY THE SUBROUTINE ERR IS USED C FOR FINDING THE SAV OF THE EXTINCTION FOR A GIVEN DISTANCE. C----------------------------------------------------------------------- IMPLICIT REAL*4 (A-H,L-Z) C SETTING SENTINAL VALUES AV = -99.0 SAV = -99.0 C FORCING L AND B COORDINATES INTO 0.05 STEPS L = FORCE(LL) B = FORCE(BB) C SELECTING CORRECT SKYMAP ACCORDING TO L AND B COORDINATES IF ((B .GE. -10.0) .AND. (B .LT. 10.0)) THEN IF ((L .GE. 0.) .AND. (L .LT. 30.)) CALL MAP258A(L,B,D,AV,A0) IF ((L .GE. 30.) .AND. (L .LT. 60.)) CALL MAP258B(L,B,D,AV,A0) IF ((L .GE. 60.) .AND. (L .LT. 90.)) CALL MAP258C(L,B,D,AV,A0) IF ((L .GE. 90.) .AND. (L .LT. 120.)) CALL MAP259A(L,B,D,AV,A0) IF ((L .GE. 120.) .AND. (L .LT. 150.)) CALL MAP259B(L,B,D,AV,A0) IF ((L .GE. 150.) .AND. (L .LT. 180.)) CALL MAP259C(L,B,D,AV,A0) IF ((L .GE. 180.) .AND. (L .LT. 210.)) CALL MAP260A(L,B,D,AV,A0) IF ((L .GE. 210.) .AND. (L .LT. 240.)) CALL MAP260B(L,B,D,AV,A0) IF ((L .GE. 240.) .AND. (L .LT. 270.)) CALL MAP260C(L,B,D,AV,A0) IF ((L .GE. 270.) .AND. (L .LT. 300.)) CALL MAP261A(L,B,D,AV,A0) IF ((L .GE. 300.) .AND. (L .LT. 330.)) CALL MAP261B(L,B,D,AV,A0) IF ((L .GE. 330.) .AND. (L .LT. 360.)) CALL MAP261C(L,B,D,AV,A0) c AV = ROUND(AV,2) CALL ERR(D,SAV) ENDIF RETURN END C --------------------------------------------------------------- SUBROUTINE ERR(D,SAV) IMPLICIT REAL*4 (A-H,L-Z) C C Functional form for errors. C SAV=0.214*(10**(0.1057*D)) C C Errors as obtained from figures, if the user prefers these. C C IF ((D .GT. 0.0) .AND. (D .LE. 0.1)) SAV = 0.34 C IF ((D .GT. 0.1) .AND. (D .LE. 0.2)) SAV = 0.17 C IF ((D .GT. 0.2) .AND. (D .LE. 0.4)) SAV = 0.19 C IF ((D .GT. 0.4) .AND. (D .LE. 0.6)) SAV = 0.26 C IF ((D .GT. 0.6) .AND. (D .LE. 0.8)) SAV = 0.27 C IF ((D .GT. 0.8) .AND. (D .LE. 1.0)) SAV = 0.19 C IF ((D .GT. 1.0) .AND. (D .LE. 1.5)) SAV = 0.23 C IF ((D .GT. 1.5) .AND. (D .LE. 2.0)) SAV = 0.28 C IF ((D .GT. 2.0) .AND. (D .LE. 2.5)) SAV = 0.38 C IF ((D .GT. 2.5) .AND. (D .LE. 3.0)) SAV = 0.36 C IF ((D .GT. 3.0) .AND. (D .LE. 4.0)) SAV = 0.45 C IF ((D .GT. 4.0) .AND. (D .LE. 5.0)) SAV = 0.71 RETURN END C --------------------------------------------------------------- C THIS FUNCTION FORCES X INTO STEPS OF 0.05 REAL FUNCTION FORCE (X) REAL DIGIT,X C ROUNDING TO TWO PLACES X = ROUND(X,2) C FINDING THE VALUE OF THE LAST DIGIT OF X DIGIT = 10*(10*X - INT(10*X)) C ROUNDING DIGIT OFF TO THE NEAREST STEP IF( (DIGIT .GE. 0) .AND. (DIGIT .LT. 3) ) THEN DIGIT = 0.0 ELSE IF( (DIGIT .GE. 3) .AND. (DIGIT .LT. 8) ) THEN DIGIT = 0.5 ELSE IF( (DIGIT .GE. 8) .AND. (DIGIT .LE. 9) ) THEN DIGIT = 1.0 ENDIF ENDIF ENDIF C COMPUTING NEW COORDINATE FORCE = (INT(10*X) + DIGIT)/10 RETURN END C ROUNDS THE VALUE OF TAU TO N PLACES REAL FUNCTION ROUND (TAU,N) INTEGER N REAL TAU,TEMP, POWER POWER = 10.0 ** N TEMP = TAU * POWER ROUND = NINT(TEMP)/POWER RETURN END C --------------------------------------------------------------- SUBROUTINE MAP258A(L,B,D,AV,A0) IMPLICIT REAL*4 (A-H,L-Z) IF (((L .GE. 0.00) .AND. (L .LT. 1.01)) .AND. & ((B .GE. -0.87) .AND. (B .LT. 0.67*L -0.87))) THEN CALL ENK6(231,D,AV,A0) RETURN ENDIF IF (((L .GE. 0.00) .AND. (L .LT. 1.03)) .AND. & ((B .GE. -1.89) .AND. (B .LT. -0.87))) THEN CALL ENK6(231,D,AV,A0) RETURN ENDIF IF (((L .GE. 0.00) .AND. (L .LT. 1.03)) .AND. & ((B .LT. -1.89) .AND. (B .GE. 1.08*L -2.99))) THEN CALL ENK6(231,D,AV,A0) RETURN ENDIF IF (((L .GE. 0.00) .AND. (L .LT. 2.20)) .AND. & ((B .GE. 1.11) .AND. (B .LT. -0.46*L + 2.18))) THEN CALL ENK6(233,D,AV,A0) RETURN ENDIF IF (((L .GE. 0.00) .AND. (L .LT. 2.22)) .AND. & ((B .GE. -0.21) .AND. (B .LT. 1.13))) THEN CALL ENK6(233,D,AV,A0) RETURN ENDIF IF (((L .GE. 0.98) .AND. (L .LT. 2.23)) .AND. & ((B .GE. -0.87) .AND. (B .LT. -0.18))) THEN CALL ENK6(233,D,AV,A0) RETURN ENDIF IF (((L .GE. 0.00) .AND. (L .LT. 1.01)) .AND. & ((B .LT. -0.23) .AND. (B .GE. 0.67*L -0.87))) THEN CALL ENK6(233,D,AV,A0) RETURN ENDIF IF (((L .GE. 0.00) .AND. (L .LT. 1.00)) .AND. & ((B .GE. 2.17) .AND. (B .LT. 7.74))) THEN CALL ENK6(235,D,AV,A0) RETURN ENDIF IF (((L .GE. 0.00) .AND. (L .LT. 1.01)) .AND. & ((B .LT. 2.18) .AND. (B .GE. -0.45*L + 2.15))) THEN CALL ENK6(235,D,AV,A0) RETURN ENDIF IF (((L .GE. 5.66) .AND. (L .LT. 7.24)) .AND. & ((B .GE. -4.91) .AND. (B .LT. 0.63*L -8.50))) THEN CALL ENK6(237,D,AV,A0) RETURN ENDIF IF (((L .GE. 2.07) .AND. (L .LT. 4.99)) .AND. & ((B .GE. -4.93) .AND. (B .LT. -0.56*L -2.15))) THEN CALL ENK6(237,D,AV,A0) RETURN ENDIF IF (((L .GE. 0.00) .AND. (L .LT. 2.09)) .AND. & ((B .GE. -4.98) .AND. (B .LT. -3.30))) THEN CALL ENK6(237,D,AV,A0) RETURN ENDIF IF (((L .GE. 0.00) .AND. (L .LT. 7.23)) .AND. & ((B .GE. -6.97) .AND. (B .LT. -4.91))) THEN CALL ENK6(237,D,AV,A0) RETURN ENDIF IF (((L .GE. 10.02) .AND. (L .LT. 11.87)) .AND. & ((B .GE. -6.97) .AND. (B .LT. -1.94))) THEN CALL ENK6(238,D,AV,A0) RETURN ENDIF IF (((L .GE. 7.19) .AND. (L .LT. 10.02)) .AND. & ((B .GE. -3.90) .AND. (B .LT. -1.96))) THEN CALL ENK6(238,D,AV,A0) RETURN ENDIF IF (((L .GE. 0.00) .AND. (L .LT. 5.97)) .AND. & ((B .GE. -2.07) .AND. (B .LT. -1.91))) THEN CALL ENK6(238,D,AV,A0) RETURN ENDIF IF (((L .GE. 5.03) .AND. (L .LT. 5.95)) .AND. & ((B .GE. -2.12) .AND. (B .LT. 0.19*L -3.06))) THEN CALL ENK6(238,D,AV,A0) RETURN ENDIF IF (((L .GE. 0.87) .AND. (L .LT. 7.20)) .AND. & ((B .GE. -3.30) .AND. (B .LT. -2.08))) THEN CALL ENK6(238,D,AV,A0) RETURN ENDIF IF (((L .GE. 0.00) .AND. (L .LT. 1.03)) .AND. & ((B .GE. -3.30) .AND. (B .LT. 1.08*L -2.99))) THEN CALL ENK6(238,D,AV,A0) RETURN ENDIF IF (((L .GE. 0.00) .AND. (L .LT. 0.88)) .AND. & ((B .GE. -3.32) .AND. (B .LT. -3.01))) THEN CALL ENK6(238,D,AV,A0) RETURN ENDIF IF (((L .GE. 2.07) .AND. (L .LT. 3.17)) .AND. & ((B .LT. -3.24) .AND. (B .GE. -0.56*L -2.15))) THEN CALL ENK6(238,D,AV,A0) RETURN ENDIF IF (((L .GE. 3.16) .AND. (L .LT. 7.21)) .AND. & ((B .GE. -3.92) .AND. (B .LT. -3.21))) THEN CALL ENK6(238,D,AV,A0) RETURN ENDIF IF (((L .GE. 5.66) .AND. (L .LT. 7.24)) .AND. & ((B .LT. -3.89) .AND. (B .GE. 0.63*L -8.50))) THEN CALL ENK6(238,D,AV,A0) RETURN ENDIF IF (((L .GE. 4.98) .AND. (L .LT. 5.66)) .AND. & ((B .GE. -4.91) .AND. (B .LT. -3.89))) THEN CALL ENK6(238,D,AV,A0) RETURN ENDIF IF (((L .GE. 3.20) .AND. (L .LT. 4.99)) .AND. & ((B .LT. -3.92) .AND. (B .GE. -0.56*L -2.15))) THEN CALL ENK6(238,D,AV,A0) RETURN ENDIF IF (((L .GE. 5.01) .AND. (L .LT. 6.52)) .AND. & ((B .GE. -1.91) .AND. (B .LT. -0.91))) THEN CALL ENK6(239,D,AV,A0) RETURN ENDIF IF (((L .GE. 5.03) .AND. (L .LT. 5.97)) .AND. & ((B .LT. -1.93) .AND. (B .GE. 0.16*L -2.89))) THEN CALL ENK6(239,D,AV,A0) RETURN ENDIF IF (((L .GE. 8.10) .AND. (L .LT. 9.24)) .AND. & ((B .GE. 0.62) .AND. (B .LT. 0.35*L -2.10))) THEN CALL ENK6(240,D,AV,A0) RETURN ENDIF IF (((L .GE. 8.58) .AND. (L .LT. 9.25)) .AND. & ((B .GE. 0.09) .AND. (B .LT. 0.70))) THEN CALL ENK6(240,D,AV,A0) RETURN ENDIF IF (((L .GE. 6.49) .AND. (L .LT. 8.60)) .AND. & ((B .GE. -1.13) .AND. (B .LT. 0.69))) THEN CALL ENK6(240,D,AV,A0) RETURN ENDIF IF (((L .GE. 8.60) .AND. (L .LT. 9.25)) .AND. & ((B .LT. 0.12) .AND. (B .GE. 1.89*L -17.42))) THEN CALL ENK6(240,D,AV,A0) RETURN ENDIF IF (((L .GE. 5.01) .AND. (L .LT. 6.51)) .AND. & ((B .GE. -0.92) .AND. (B .LT. 0.70))) THEN CALL ENK6(240,D,AV,A0) RETURN ENDIF IF (((L .GE. 11.28) .AND. (L .LT. 11.68)) .AND. & ((B .LT. -0.12) .AND. (B .GE. 1.52*L -17.89))) THEN CALL ENK7(241,D,AV,A0) RETURN ENDIF IF (((L .GE. 10.92) .AND. (L .LT. 11.28)) .AND. & ((B .GE. -0.75) .AND. (B .LT. -0.10))) THEN CALL ENK7(241,D,AV,A0) RETURN ENDIF IF (((L .GE. 10.28) .AND. (L .LT. 10.92)) .AND. & ((B .GE. -0.75) .AND. (B .LT. 0.91*L -10.07))) THEN CALL ENK7(241,D,AV,A0) RETURN ENDIF IF (((L .GE. 10.26) .AND. (L .LT. 11.27)) .AND. & ((B .GE. -1.50) .AND. (B .LT. -0.70))) THEN CALL ENK7(241,D,AV,A0) RETURN ENDIF IF (((L .GE. 10.10) .AND. (L .LT. 10.35)) .AND. & ((B .GE. -1.52) .AND. (B .LT. -0.87))) THEN CALL ENK7(241,D,AV,A0) RETURN ENDIF IF (((L .GE. 10.06) .AND. (L .LT. 10.61)) .AND. & ((B .GE. -1.74) .AND. (B .LT. -1.54))) THEN CALL ENK7(241,D,AV,A0) RETURN ENDIF IF (((L .GE. 10.63) .AND. (L .LT. 10.84)) .AND. & ((B .LT. -1.54) .AND. (B .GE. 0.92*L -11.48))) THEN CALL ENK7(241,D,AV,A0) RETURN ENDIF IF (((L .GE. 10.05) .AND. (L .LT. 14.01)) .AND. & ((B .GE. 1.87) .AND. (B .LT. 4.08))) THEN CALL ENK7(242,D,AV,A0) RETURN ENDIF IF (((L .GE. 12.22) .AND. (L .LT. 13.08)) .AND. & ((B .LT. 1.90) .AND. (B .GE. 2.02*L -24.57))) THEN CALL ENK7(242,D,AV,A0) RETURN ENDIF IF (((L .GE. 10.06) .AND. (L .LT. 12.22)) .AND. & ((B .GE. 0.08) .AND. (B .LT. 1.90))) THEN CALL ENK7(242,D,AV,A0) RETURN ENDIF IF (((L .GE. 12.28) .AND. (L .LT. 13.31)) .AND. & ((B .GE. -0.89) .AND. (B .LT. -0.34*L + 3.62))) THEN CALL ENK7(243,D,AV,A0) RETURN ENDIF IF (((L .GE. 11.64) .AND. (L .LT. 12.28)) .AND. & ((B .GE. -0.89) .AND. (B .LT. -0.59))) THEN CALL ENK7(243,D,AV,A0) RETURN ENDIF IF (((L .GE. 11.67) .AND. (L .LT. 13.29)) .AND. & ((B .LT. -0.89) .AND. (B .GE. -0.31*L + 2.73))) THEN CALL ENK7(243,D,AV,A0) RETURN ENDIF IF (((L .GE. 13.08) .AND. (L .LT. 14.75)) .AND. & ((B .GE. 1.07) .AND. (B .LT. 1.89))) THEN CALL ENK7(244,D,AV,A0) RETURN ENDIF IF (((L .GE. 12.69) .AND. (L .LT. 13.08)) .AND. & ((B .GE. 1.07) .AND. (B .LT. 2.02*L -24.57))) THEN CALL ENK7(244,D,AV,A0) RETURN ENDIF IF (((L .GE. 13.85) .AND. (L .LT. 14.45)) .AND. & ((B .GE. 0.10) .AND. (B .LT. -1.61*L + 23.35))) THEN CALL ENK7(244,D,AV,A0) RETURN ENDIF IF (((L .GE. 12.71) .AND. (L .LT. 13.89)) .AND. & ((B .GE. 0.08) .AND. (B .LT. 1.10))) THEN CALL ENK7(244,D,AV,A0) RETURN ENDIF IF (((L .GE. 12.22) .AND. (L .LT. 12.71)) .AND. & ((B .GE. 0.06) .AND. (B .LT. 2.02*L -24.57))) THEN CALL ENK7(244,D,AV,A0) RETURN ENDIF IF (((L .GE. 13.29) .AND. (L .LT. 14.45)) .AND. & ((B .GE. -1.20) .AND. (B .LT. 0.08))) THEN CALL ENK7(244,D,AV,A0) RETURN ENDIF IF (((L .GE. 11.65) .AND. (L .LT. 13.28)) .AND. & ((B .GE. -0.60) .AND. (B .LT. 0.09))) THEN CALL ENK7(244,D,AV,A0) RETURN ENDIF IF (((L .GE. 12.28) .AND. (L .LT. 13.31)) .AND. & ((B .LT. -0.58) .AND. (B .GE. -0.34*L + 3.62))) THEN CALL ENK7(244,D,AV,A0) RETURN ENDIF IF (((L .GE. 13.20) .AND. (L .LT. 14.46)) .AND. & ((B .LT. -1.15) .AND. (B .GE. 0.28*L -5.25))) THEN CALL ENK7(244,D,AV,A0) RETURN ENDIF IF (((L .GE. 12.86) .AND. (L .LT. 12.88)) .AND. & ((B .GE. -1.33) .AND. (B .LT. 3.17*L -42.03))) THEN CALL ENK7(244,D,AV,A0) RETURN ENDIF IF (((L .GE. 12.86) .AND. (L .LT. 13.24)) .AND. & ((B .LT. -1.35) .AND. (B .GE. 0.28*L -5.25))) THEN CALL ENK7(244,D,AV,A0) RETURN ENDIF IF (((L .GE. 12.27) .AND. (L .LT. 12.86)) .AND. & ((B .LT. -1.28) .AND. (B .GE. -0.39*L + 3.45))) THEN CALL ENK7(244,D,AV,A0) RETURN ENDIF IF (((L .GE. 11.67) .AND. (L .LT. 13.29)) .AND. & ((B .GE. -1.34) .AND. (B .LT. -0.31*L + 2.73))) THEN CALL ENK7(244,D,AV,A0) RETURN ENDIF IF (((L .GE. 11.26) .AND. (L .LT. 11.67)) .AND. & ((B .GE. -1.32) .AND. (B .LT. -0.88))) THEN CALL ENK7(244,D,AV,A0) RETURN ENDIF IF (((L .GE. 11.27) .AND. (L .LT. 11.88)) .AND. & ((B .GE. -1.94) .AND. (B .LT. -1.35))) THEN CALL ENK7(244,D,AV,A0) RETURN ENDIF IF (((L .GE. 11.28) .AND. (L .LT. 11.68)) .AND. & ((B .GE. -0.88) .AND. (B .LT. 1.52*L -17.89))) THEN CALL ENK7(244,D,AV,A0) RETURN ENDIF IF (((L .GE. 10.04) .AND. (L .LT. 11.65)) .AND. & ((B .GE. -0.11) .AND. (B .LT. 0.07))) THEN CALL ENK7(244,D,AV,A0) RETURN ENDIF IF (((L .GE. 10.28) .AND. (L .LT. 10.92)) .AND. & ((B .LT. -0.06) .AND. (B .GE. 0.91*L -10.07))) THEN CALL ENK7(244,D,AV,A0) RETURN ENDIF IF (((L .GE. 10.06) .AND. (L .LT. 10.26)) .AND. & ((B .GE. -0.88) .AND. (B .LT. -0.11))) THEN CALL ENK7(244,D,AV,A0) RETURN ENDIF IF (((L .GE. 13.65) .AND. (L .LT. 14.48)) .AND. & ((B .GE. -1.97) .AND. (B .LT. -0.70*L + 8.14))) THEN CALL ENK7(245,D,AV,A0) RETURN ENDIF IF (((L .GE. 12.86) .AND. (L .LT. 13.65)) .AND. & ((B .GE. -1.54) .AND. (B .LT. 0.28*L -5.25))) THEN CALL ENK7(245,D,AV,A0) RETURN ENDIF IF (((L .GE. 12.27) .AND. (L .LT. 12.86)) .AND. & ((B .GE. -1.57) .AND. (B .LT. -0.39*L + 3.45))) THEN CALL ENK7(245,D,AV,A0) RETURN ENDIF IF (((L .GE. 11.86) .AND. (L .LT. 12.29)) .AND. & ((B .GE. -2.95) .AND. (B .LT. -1.34))) THEN CALL ENK7(245,D,AV,A0) RETURN ENDIF IF (((L .GE. 12.29) .AND. (L .LT. 12.91)) .AND. & ((B .GE. -2.96) .AND. (B .LT. -1.57))) THEN CALL ENK7(245,D,AV,A0) RETURN ENDIF IF (((L .GE. 12.89) .AND. (L .LT. 13.67)) .AND. & ((B .GE. -2.94) .AND. (B .LT. -1.54))) THEN CALL ENK7(245,D,AV,A0) RETURN ENDIF IF (((L .GE. 13.65) .AND. (L .LT. 14.48)) .AND. & ((B .GE. -2.95) .AND. (B .LT. -1.94))) THEN CALL ENK7(245,D,AV,A0) RETURN ENDIF IF (((L .GE. 14.46) .AND. (L .LT. 15.07)) .AND. & ((B .GE. -2.92) .AND. (B .LT. -1.61*L + 21.34))) THEN CALL ENK7(245,D,AV,A0) RETURN ENDIF IF (((L .GE. 14.66) .AND. (L .LT. 15.07)) .AND. & ((B .LT. -2.92) .AND. (B .GE. 4.03*L -63.58))) THEN CALL ENK7(245,D,AV,A0) RETURN ENDIF IF (((L .GE. 13.45) .AND. (L .LT. 14.66)) .AND. & ((B .GE. -4.58) .AND. (B .LT. -2.94))) THEN CALL ENK7(245,D,AV,A0) RETURN ENDIF IF (((L .GE. 11.86) .AND. (L .LT. 13.53)) .AND. & ((B .GE. -3.48) .AND. (B .LT. -2.93))) THEN CALL ENK7(245,D,AV,A0) RETURN ENDIF IF (((L .GE. 14.45) .AND. (L .LT. 16.76)) .AND. & ((B .GE. -1.19) .AND. (B .LT. 0.10))) THEN CALL ENK7(246,D,AV,A0) RETURN ENDIF IF (((L .GE. 14.45) .AND. (L .LT. 17.48)) .AND. & ((B .LT. -1.12) .AND. (B .GE. -0.17*L + 1.25))) THEN CALL ENK7(246,D,AV,A0) RETURN ENDIF IF (((L .GE. 16.72) .AND. (L .LT. 17.47)) .AND. & ((B .GE. -1.22) .AND. (B .LT. -0.44))) THEN CALL ENK7(246,D,AV,A0) RETURN ENDIF IF (((L .GE. 17.48) .AND. (L .LT. 18.08)) .AND. & ((B .GE. -0.91) .AND. (B .LT. -0.44))) THEN CALL ENK7(246,D,AV,A0) RETURN ENDIF IF (((L .GE. 18.05) .AND. (L .LT. 18.39)) .AND. & ((B .GE. -0.91) .AND. (B .LT. -1.38*L + 24.52))) THEN CALL ENK7(246,D,AV,A0) RETURN ENDIF IF (((L .GE. 15.05) .AND. (L .LT. 16.72)) .AND. & ((B .GE. 3.06) .AND. (B .LT. -0.61*L + 13.22))) THEN CALL ENK7(247,D,AV,A0) RETURN ENDIF IF (((L .GE. 14.69) .AND. (L .LT. 15.06)) .AND. & ((B .GE. 3.05) .AND. (B .LT. 4.09))) THEN CALL ENK7(247,D,AV,A0) RETURN ENDIF IF (((L .GE. 14.02) .AND. (L .LT. 14.74)) .AND. & ((B .GE. 1.87) .AND. (B .LT. 4.11))) THEN CALL ENK7(247,D,AV,A0) RETURN ENDIF IF (((L .GE. 14.73) .AND. (L .LT. 16.73)) .AND. & ((B .GE. 1.11) .AND. (B .LT. 3.05))) THEN CALL ENK7(247,D,AV,A0) RETURN ENDIF IF (((L .GE. 14.46) .AND. (L .LT. 16.74)) .AND. & ((B .GE. 0.10) .AND. (B .LT. 1.13))) THEN CALL ENK7(247,D,AV,A0) RETURN ENDIF IF (((L .GE. 13.85) .AND. (L .LT. 14.45)) .AND. & ((B .LT. 1.06) .AND. (B .GE. -1.61*L + 23.35))) THEN CALL ENK7(247,D,AV,A0) RETURN ENDIF IF (((L .GE. 16.07) .AND. (L .LT. 19.07)) .AND. & ((B .GE. -6.93) .AND. (B .LT. -1.33*L + 18.49))) THEN CALL ENK7(248,D,AV,A0) RETURN ENDIF IF (((L .GE. 16.12) .AND. (L .LT. 19.08)) .AND. & ((B .GE. -7.58) .AND. (B .LT. -6.93))) THEN CALL ENK7(248,D,AV,A0) RETURN ENDIF IF (((L .GE. 15.04) .AND. (L .LT. 16.12)) .AND. & ((B .GE. -6.94) .AND. (B .LT. -2.95))) THEN CALL ENK7(248,D,AV,A0) RETURN ENDIF IF (((L .GE. 13.10) .AND. (L .LT. 16.13)) .AND. & ((B .GE. -7.56) .AND. (B .LT. -6.91))) THEN CALL ENK7(248,D,AV,A0) RETURN ENDIF IF (((L .GE. 14.64) .AND. (L .LT. 15.07)) .AND. & ((B .GE. -4.57) .AND. (B .LT. 3.75*L -59.38))) THEN CALL ENK7(248,D,AV,A0) RETURN ENDIF IF (((L .GE. 11.86) .AND. (L .LT. 15.12)) .AND. & ((B .GE. -7.00) .AND. (B .LT. -4.54))) THEN CALL ENK7(248,D,AV,A0) RETURN ENDIF IF (((L .GE. 11.87) .AND. (L .LT. 13.47)) .AND. & ((B .GE. -4.55) .AND. (B .LT. -3.46))) THEN CALL ENK7(248,D,AV,A0) RETURN ENDIF IF (((L .GE. 16.75) .AND. (L .LT. 17.49)) .AND. & ((B .GE. 0.45) .AND. (B .LT. 1.45))) THEN CALL ENK7(249,D,AV,A0) RETURN ENDIF IF (((L .GE. 20.08) .AND. (L .LT. 21.07)) .AND. & ((B .GE. 0.01) .AND. (B .LT. -1.06*L + 22.35))) THEN CALL ENK7(250,D,AV,A0) RETURN ENDIF IF (((L .GE. 20.07) .AND. (L .LT. 21.07)) .AND. & ((B .GE. -0.42) .AND. (B .LT. 0.05))) THEN CALL ENK7(250,D,AV,A0) RETURN ENDIF IF (((L .GE. 20.10) .AND. (L .LT. 21.07)) .AND. & ((B .GE. -1.33) .AND. (B .LT. -0.41))) THEN CALL ENK7(250,D,AV,A0) RETURN ENDIF IF (((L .GE. 19.43) .AND. (L .LT. 20.09)) .AND. & ((B .LT. -0.42) .AND. (B .GE. -1.42*L + 27.14))) THEN CALL ENK7(250,D,AV,A0) RETURN ENDIF IF (((L .GE. 19.47) .AND. (L .LT. 20.10)) .AND. & ((B .GE. -0.43) .AND. (B .LT. 0.47))) THEN CALL ENK7(250,D,AV,A0) RETURN ENDIF IF (((L .GE. 17.42) .AND. (L .LT. 20.09)) .AND. & ((B .GE. 0.45) .AND. (B .LT. 1.14))) THEN CALL ENK7(250,D,AV,A0) RETURN ENDIF IF (((L .GE. 19.06) .AND. (L .LT. 20.05)) .AND. & ((B .GE. 1.13) .AND. (B .LT. -2.92*L + 59.75))) THEN CALL ENK7(250,D,AV,A0) RETURN ENDIF IF (((L .GE. 16.72) .AND. (L .LT. 19.06)) .AND. & ((B .GE. 3.12) .AND. (B .LT. 0.44*L -4.29))) THEN CALL ENK7(250,D,AV,A0) RETURN ENDIF IF (((L .GE. 17.46) .AND. (L .LT. 19.10)) .AND. & ((B .GE. 1.11) .AND. (B .LT. 3.10))) THEN CALL ENK7(250,D,AV,A0) RETURN ENDIF IF (((L .GE. 16.75) .AND. (L .LT. 17.46)) .AND. & ((B .GE. 1.45) .AND. (B .LT. 3.10))) THEN CALL ENK7(250,D,AV,A0) RETURN ENDIF IF (((L .GE. 19.56) .AND. (L .LT. 20.09)) .AND. & ((B .LT. -1.57) .AND. (B .GE. 3.16*L -65.09))) THEN CALL ENK7(251,D,AV,A0) RETURN ENDIF IF (((L .GE. 18.95) .AND. (L .LT. 19.35)) .AND. & ((B .GE. -1.56) .AND. (B .LT. -0.40*L + 6.25))) THEN CALL ENK7(251,D,AV,A0) RETURN ENDIF IF (((L .GE. 18.40) .AND. (L .LT. 19.30)) .AND. & ((B .GE. -1.59) .AND. (B .LT. -1.39))) THEN CALL ENK7(251,D,AV,A0) RETURN ENDIF IF (((L .GE. 18.39) .AND. (L .LT. 18.71)) .AND. & ((B .GE. -1.39) .AND. (B .LT. -1.38*L + 24.52))) THEN CALL ENK7(251,D,AV,A0) RETURN ENDIF IF (((L .GE. 18.28) .AND. (L .LT. 19.63)) .AND. & ((B .GE. -2.91) .AND. (B .LT. -1.60))) THEN CALL ENK7(251,D,AV,A0) RETURN ENDIF IF (((L .GE. 17.44) .AND. (L .LT. 18.42)) .AND. & ((B .GE. -2.94) .AND. (B .LT. -0.91))) THEN CALL ENK7(251,D,AV,A0) RETURN ENDIF IF (((L .GE. 15.05) .AND. (L .LT. 17.49)) .AND. & ((B .GE. -2.91) .AND. (B .LT. -1.82))) THEN CALL ENK7(251,D,AV,A0) RETURN ENDIF IF (((L .GE. 14.45) .AND. (L .LT. 17.48)) .AND. & ((B .GE. -1.82) .AND. (B .LT. -0.17*L + 1.25))) THEN CALL ENK7(251,D,AV,A0) RETURN ENDIF IF (((L .GE. 13.65) .AND. (L .LT. 14.46)) .AND. & ((B .GE. -1.39) .AND. (B .LT. 0.48*L -7.75))) THEN CALL ENK7(251,D,AV,A0) RETURN ENDIF IF (((L .GE. 13.65) .AND. (L .LT. 14.48)) .AND. & ((B .LT. -1.36) .AND. (B .GE. -0.70*L + 8.14))) THEN CALL ENK7(251,D,AV,A0) RETURN ENDIF IF (((L .GE. 14.45) .AND. (L .LT. 15.20)) .AND. & ((B .GE. -1.94) .AND. (B .LT. -1.71))) THEN CALL ENK7(251,D,AV,A0) RETURN ENDIF IF (((L .GE. 14.48) .AND. (L .LT. 15.07)) .AND. & ((B .LT. -1.91) .AND. (B .GE. -1.76*L + 23.51))) THEN CALL ENK7(251,D,AV,A0) RETURN ENDIF IF (((L .GE. 16.11) .AND. (L .LT. 17.71)) .AND. & ((B .LT. -2.94) .AND. (B .GE. -1.40*L + 19.61))) THEN CALL ENK7(251,D,AV,A0) RETURN ENDIF IF (((L .GE. 17.68) .AND. (L .LT. 18.95)) .AND. & ((B .GE. -5.17) .AND. (B .LT. -2.93))) THEN CALL ENK7(251,D,AV,A0) RETURN ENDIF IF (((L .GE. 18.93) .AND. (L .LT. 19.56)) .AND. & ((B .LT. -2.92) .AND. (B .GE. 3.16*L -65.09))) THEN CALL ENK7(251,D,AV,A0) RETURN ENDIF IF (((L .GE. 16.74) .AND. (L .LT. 19.48)) .AND. & ((B .GE. -0.45) .AND. (B .LT. 0.49))) THEN CALL ENK7(252,D,AV,A0) RETURN ENDIF IF (((L .GE. 19.36) .AND. (L .LT. 20.11)) .AND. & ((B .GE. -1.36) .AND. (B .LT. -1.38*L + 26.48))) THEN CALL ENK7(253,D,AV,A0) RETURN ENDIF IF (((L .GE. 18.70) .AND. (L .LT. 19.45)) .AND. & ((B .GE. -1.39) .AND. (B .LT. -0.45))) THEN CALL ENK7(253,D,AV,A0) RETURN ENDIF IF (((L .GE. 18.05) .AND. (L .LT. 18.71)) .AND. & ((B .LT. -0.46) .AND. (B .GE. -1.38*L + 24.52))) THEN CALL ENK7(253,D,AV,A0) RETURN ENDIF IF (((L .GE. 20.96) .AND. (L .LT. 22.06)) .AND. & ((B .GE. 2.06) .AND. (B .LT. -3.80*L + 85.89))) THEN CALL ENK7(254,D,AV,A0) RETURN ENDIF IF (((L .GE. 20.01) .AND. (L .LT. 21.05)) .AND. & ((B .GE. 1.14) .AND. (B .LT. 6.26))) THEN CALL ENK7(254,D,AV,A0) RETURN ENDIF IF (((L .GE. 20.08) .AND. (L .LT. 21.07)) .AND. & ((B .LT. 1.15) .AND. (B .GE. -1.06*L + 22.35))) THEN CALL ENK7(254,D,AV,A0) RETURN ENDIF IF (((L .GE. 21.04) .AND. (L .LT. 22.04)) .AND. & ((B .LT. 2.06) .AND. (B .GE. 2.03*L -42.75))) THEN CALL ENK7(254,D,AV,A0) RETURN ENDIF IF (((L .GE. 20.09) .AND. (L .LT. 22.08)) .AND. & ((B .LT. -5.05) .AND. (B .GE. 0.07*L -6.62))) THEN CALL ENK7(255,D,AV,A0) RETURN ENDIF IF (((L .GE. 21.09) .AND. (L .LT. 22.08)) .AND. & ((B .GE. -5.05) .AND. (B .LT. -3.57*L + 73.89))) THEN CALL ENK7(255,D,AV,A0) RETURN ENDIF IF (((L .GE. 21.13) .AND. (L .LT. 22.06)) .AND. & ((B .LT. -4.97) .AND. (B .GE. 0.14*L -8.03))) THEN CALL ENK7(255,D,AV,A0) RETURN ENDIF IF (((L .GE. 20.09) .AND. (L .LT. 21.13)) .AND. & ((B .GE. -5.07) .AND. (B .LT. -1.35))) THEN CALL ENK7(255,D,AV,A0) RETURN ENDIF IF (((L .GE. 17.37) .AND. (L .LT. 18.37)) .AND. & ((B .GE. -1.60) .AND. (B .LT. -1.38))) THEN CALL ENK7(255,D,AV,A0) RETURN ENDIF IF (((L .GE. 19.33) .AND. (L .LT. 20.09)) .AND. & ((B .LT. -1.34) .AND. (B .GE. -0.59*L + 9.77))) THEN CALL ENK7(255,D,AV,A0) RETURN ENDIF IF (((L .GE. 18.93) .AND. (L .LT. 20.09)) .AND. & ((B .GE. -5.19) .AND. (B .LT. 3.16*L -65.09))) THEN CALL ENK7(255,D,AV,A0) RETURN ENDIF IF (((L .GE. 21.61) .AND. (L .LT. 25.06)) .AND. & ((B .GE. -3.40) .AND. (B .LT. 0.01))) THEN CALL ENK7(256,D,AV,A0) RETURN ENDIF IF (((L .GE. 21.07) .AND. (L .LT. 21.61)) .AND. & ((B .GE. -1.35) .AND. (B .LT. 0.05))) THEN CALL ENK7(256,D,AV,A0) RETURN ENDIF IF (((L .GE. 21.04) .AND. (L .LT. 21.63)) .AND. & ((B .LT. -1.34) .AND. (B .GE. -3.40*L + 70.21))) THEN CALL ENK7(256,D,AV,A0) RETURN ENDIF IF (((L .GE. 22.09) .AND. (L .LT. 24.04)) .AND. & ((B .GE. 0.01) .AND. (B .LT. -1.02*L + 24.62))) THEN CALL ENK7(257,D,AV,A0) RETURN ENDIF IF (((L .GE. 21.04) .AND. (L .LT. 22.09)) .AND. & ((B .GE. 0.01) .AND. (B .LT. 1.92*L -40.32))) THEN CALL ENK7(257,D,AV,A0) RETURN ENDIF IF (((L .GE. 25.02) .AND. (L .LT. 27.44)) .AND. & ((B .GE. -5.31) .AND. (B .LT. -0.37))) THEN CALL ENK7(258,D,AV,A0) RETURN ENDIF IF (((L .GE. 28.22) .AND. (L .LT. 29.06)) .AND. & ((B .GE. -3.96) .AND. (B .LT. -4.77*L + 134.68))) THEN CALL ENK7(259,D,AV,A0) RETURN ENDIF IF (((L .GE. 27.41) .AND. (L .LT. 28.30)) .AND. & ((B .GE. -3.97) .AND. (B .LT. 0.02))) THEN CALL ENK7(259,D,AV,A0) RETURN ENDIF IF (((L .GE. 25.82) .AND. (L .LT. 27.40)) .AND. & ((B .GE. -0.39) .AND. (B .LT. 0.02))) THEN CALL ENK7(259,D,AV,A0) RETURN ENDIF IF (((L .GE. 25.01) .AND. (L .LT. 30.91)) .AND. & ((B .GE. 0.01) .AND. (B .LT. 7.12))) THEN CALL ENK7(260,D,AV,A0) RETURN ENDIF IF (((L .GE. 28.22) .AND. (L .LT. 29.08)) .AND. & ((B .LT. 0.03) .AND. (B .GE. -4.59*L + 129.44))) THEN CALL ENK7(260,D,AV,A0) RETURN ENDIF IF (((L .GE. 29.03) .AND. (L .LT. 30.96)) .AND. & ((B .GE. -3.98) .AND. (B .LT. 0.05))) THEN CALL ENK7(260,D,AV,A0) RETURN ENDIF IF (((L .GE. 37.24) .AND. (L .LT. 38.45)) .AND. & ((B .GE. -1.93) .AND. (B .LT. -0.50*L + 17.22))) THEN CALL ENK7(261,D,AV,A0) RETURN ENDIF IF (((L .GE. 36.86) .AND. (L .LT. 37.24)) .AND. & ((B .GE. -1.91) .AND. (B .LT. 1.61*L -61.19))) THEN CALL ENK7(261,D,AV,A0) RETURN ENDIF IF (((L .GE. 36.86) .AND. (L .LT. 38.01)) .AND. & ((B .LT. -1.90) .AND. (B .GE. -0.49*L + 16.04))) THEN CALL ENK7(261,D,AV,A0) RETURN ENDIF IF (((L .GE. 38.01) .AND. (L .LT. 38.50)) .AND. & ((B .LT. -1.90) .AND. (B .GE. 1.18*L -47.16))) THEN CALL ENK7(261,D,AV,A0) RETURN ENDIF IF (((L .GE. 44.03) .AND. (L .LT. 45.08)) .AND. & ((B .GE. -2.07) .AND. (B .LT. -1.46))) THEN CALL ENK7(262,D,AV,A0) RETURN ENDIF IF (((L .GE. 44.06) .AND. (L .LT. 45.06)) .AND. & ((B .GE. -2.08) .AND. (B .LT. -0.58*L + 24.20))) THEN CALL ENK7(262,D,AV,A0) RETURN ENDIF IF (((L .GE. 40.05) .AND. (L .LT. 45.06)) .AND. & ((B .GE. -7.70) .AND. (B .LT. -2.03))) THEN CALL ENK7(262,D,AV,A0) RETURN ENDIF IF (((L .GE. 47.12) .AND. (L .LT. 50.10)) .AND. & ((B .GE. 3.95) .AND. (B .LT. 4.38))) THEN CALL ENK7(264,D,AV,A0) RETURN ENDIF IF (((L .GE. 45.08) .AND. (L .LT. 50.10)) .AND. & ((B .GE. 0.36) .AND. (B .LT. 4.00))) THEN CALL ENK7(264,D,AV,A0) RETURN ENDIF IF (((L .GE. 41.09) .AND. (L .LT. 45.09)) .AND. & ((B .GE. 2.96) .AND. (B .LT. 3.95))) THEN CALL ENK7(264,D,AV,A0) RETURN ENDIF IF (((L .GE. 41.08) .AND. (L .LT. 45.11)) .AND. & ((B .LT. 3.01) .AND. (B .GE. -0.49*L + 23.06))) THEN CALL ENK7(264,D,AV,A0) RETURN ENDIF IF (((L .GE. 50.11) .AND. (L .LT. 57.29)) .AND. & ((B .GE. 1.53) .AND. (B .LT. 5.01))) THEN CALL ENK7(266,D,AV,A0) RETURN ENDIF IF (((L .GE. 50.09) .AND. (L .LT. 55.07)) .AND. & ((B .GE. -3.01) .AND. (B .LT. 1.60))) THEN CALL ENK7(266,D,AV,A0) RETURN ENDIF IF (((L .GE. 55.11) .AND. (L .LT. 55.47)) .AND. & ((B .GE. 0.02) .AND. (B .LT. 0.99))) THEN CALL ENK7(266,D,AV,A0) RETURN ENDIF IF (((L .GE. 50.09) .AND. (L .LT. 60.97)) .AND. & ((B .GE. 4.95) .AND. (B .LT. 7.67))) THEN CALL ENK7(267,D,AV,A0) RETURN ENDIF IF (((L .GE. 57.31) .AND. (L .LT. 60.97)) .AND. & ((B .GE. 2.04) .AND. (B .LT. 5.06))) THEN CALL ENK7(267,D,AV,A0) RETURN ENDIF IF (((L .GE. 55.48) .AND. (L .LT. 58.25)) .AND. & ((B .GE. 0.01) .AND. (B .LT. 1.62))) THEN CALL ENK7(268,D,AV,A0) RETURN ENDIF IF (((L .GE. 55.10) .AND. (L .LT. 55.49)) .AND. & ((B .GE. 1.01) .AND. (B .LT. 1.61))) THEN CALL ENK7(268,D,AV,A0) RETURN ENDIF IF (((L .GE. 57.28) .AND. (L .LT. 60.97)) .AND. & ((B .GE. 1.63) .AND. (B .LT. 2.07))) THEN CALL ENK7(269,D,AV,A0) RETURN ENDIF IF (((L .GE. 58.26) .AND. (L .LT. 60.98)) .AND. & ((B .GE. 0.05) .AND. (B .LT. 1.67))) THEN CALL ENK7(269,D,AV,A0) RETURN ENDIF IF (((L .GE. 59.44) .AND. (L .LT. 60.95)) .AND. & ((B .GE. -0.39) .AND. (B .LT. 0.09))) THEN CALL ENK7(269,D,AV,A0) RETURN ENDIF IF (((L .GE. 58.27) .AND. (L .LT. 59.44)) .AND. & ((B .LT. 0.06) .AND. (B .GE. -0.37*L + 21.92))) THEN CALL ENK7(269,D,AV,A0) RETURN ENDIF IF (((L .GE. 55.09) .AND. (L .LT. 60.97)) .AND. & ((B .GE. -5.05) .AND. (B .LT. -0.34))) THEN CALL ENK7(270,D,AV,A0) RETURN ENDIF IF (((L .GE. 58.27) .AND. (L .LT. 59.44)) .AND. & ((B .GE. -0.36) .AND. (B .LT. -0.33*L + 19.49))) THEN CALL ENK7(270,D,AV,A0) RETURN ENDIF IF (((L .GE. 55.09) .AND. (L .LT. 58.25)) .AND. & ((B .GE. -0.43) .AND. (B .LT. 0.05))) THEN CALL ENK7(270,D,AV,A0) RETURN ENDIF IF (((L .GE. 55.11) .AND. (L .LT. 60.02)) .AND. & ((B .GE. -7.58) .AND. (B .LT. -5.00))) THEN CALL ENK7(270,D,AV,A0) RETURN ENDIF END C --------------------------------------------------------------- SUBROUTINE MAP258B(L,B,D,AV,A0) IMPLICIT REAL*4 (A-H,L-Z) IF (((L .GE. 29.05) .AND. (L .LT. 35.05)) .AND. & ((B .GE. -4.18) .AND. (B .LT. 6.91))) THEN CALL ENK7(260,D,AV,A0) RETURN ENDIF IF (((L .GE. 37.24) .AND. (L .LT. 38.45)) .AND. & ((B .GE. -1.93) .AND. (B .LT. -0.50*L + 17.22))) THEN CALL ENK7(261,D,AV,A0) RETURN ENDIF IF (((L .GE. 36.86) .AND. (L .LT. 37.24)) .AND. & ((B .GE. -1.91) .AND. (B .LT. 1.61*L -61.19))) THEN CALL ENK7(261,D,AV,A0) RETURN ENDIF IF (((L .GE. 36.86) .AND. (L .LT. 38.01)) .AND. & ((B .LT. -1.90) .AND. (B .GE. -0.49*L + 16.04))) THEN CALL ENK7(261,D,AV,A0) RETURN ENDIF IF (((L .GE. 38.01) .AND. (L .LT. 38.50)) .AND. & ((B .LT. -1.90) .AND. (B .GE. 1.18*L -47.16))) THEN CALL ENK7(261,D,AV,A0) RETURN ENDIF IF (((L .GE. 44.06) .AND. (L .LT. 45.06)) .AND. & ((B .GE. -2.05) .AND. (B .LT. -1.28))) THEN CALL ENK7(262,D,AV,A0) RETURN ENDIF IF (((L .GE. 40.10) .AND. (L .LT. 44.06)) .AND. & ((B .GE. -2.05) .AND. (B .LT. 0.15*L -7.89))) THEN CALL ENK7(262,D,AV,A0) RETURN ENDIF IF (((L .GE. 40.10) .AND. (L .LT. 45.08)) .AND. & ((B .GE. -7.68) .AND. (B .LT. -2.03))) THEN CALL ENK7(262,D,AV,A0) RETURN ENDIF IF (((L .GE. 45.09) .AND. (L .LT. 50.10)) .AND. & ((B .GE. -3.04) .AND. (B .LT. 0.35))) THEN CALL ENK7(263,D,AV,A0) RETURN ENDIF IF (((L .GE. 47.12) .AND. (L .LT. 50.10)) .AND. & ((B .GE. 3.93) .AND. (B .LT. 4.38))) THEN CALL ENK7(264,D,AV,A0) RETURN ENDIF IF (((L .GE. 45.08) .AND. (L .LT. 50.10)) .AND. & ((B .GE. 0.36) .AND. (B .LT. 4.00))) THEN CALL ENK7(264,D,AV,A0) RETURN ENDIF IF (((L .GE. 41.09) .AND. (L .LT. 45.09)) .AND. & ((B .GE. 2.96) .AND. (B .LT. 3.95))) THEN CALL ENK7(264,D,AV,A0) RETURN ENDIF IF (((L .GE. 41.08) .AND. (L .LT. 45.11)) .AND. & ((B .LT. 3.01) .AND. (B .GE. -0.49*L + 23.06))) THEN CALL ENK7(264,D,AV,A0) RETURN ENDIF IF (((L .GE. 45.09) .AND. (L .LT. 54.11)) .AND. & ((B .GE. -7.66) .AND. (B .LT. -3.00))) THEN CALL ENK7(265,D,AV,A0) RETURN ENDIF IF (((L .GE. 50.11) .AND. (L .LT. 57.28)) .AND. & ((B .GE. 1.53) .AND. (B .LT. 5.01))) THEN CALL ENK7(266,D,AV,A0) RETURN ENDIF IF (((L .GE. 50.09) .AND. (L .LT. 55.07)) .AND. & ((B .GE. -3.01) .AND. (B .LT. 1.60))) THEN CALL ENK7(266,D,AV,A0) RETURN ENDIF IF (((L .GE. 50.10) .AND. (L .LT. 55.47)) .AND. & ((B .GE. -0.07) .AND. (B .LT. 1.01))) THEN CALL ENK7(266,D,AV,A0) RETURN ENDIF IF (((L .GE. 50.09) .AND. (L .LT. 60.97)) .AND. & ((B .GE. 4.95) .AND. (B .LT. 7.67))) THEN CALL ENK7(267,D,AV,A0) RETURN ENDIF IF (((L .GE. 57.28) .AND. (L .LT. 60.97)) .AND. & ((B .GE. 2.04) .AND. (B .LT. 5.06))) THEN CALL ENK7(267,D,AV,A0) RETURN ENDIF IF (((L .GE. 55.48) .AND. (L .LT. 58.25)) .AND. & ((B .GE. 0.01) .AND. (B .LT. 1.62))) THEN CALL ENK7(268,D,AV,A0) RETURN ENDIF IF (((L .GE. 55.07) .AND. (L .LT. 55.49)) .AND. & ((B .GE. 1.01) .AND. (B .LT. 1.61))) THEN CALL ENK7(268,D,AV,A0) RETURN ENDIF IF (((L .GE. 57.28) .AND. (L .LT. 60.97)) .AND. & ((B .GE. 1.63) .AND. (B .LT. 2.07))) THEN CALL ENK7(269,D,AV,A0) RETURN ENDIF IF (((L .GE. 58.20) .AND. (L .LT. 60.98)) .AND. & ((B .GE. 0.05) .AND. (B .LT. 1.67))) THEN CALL ENK7(269,D,AV,A0) RETURN ENDIF IF (((L .GE. 59.44) .AND. (L .LT. 60.98)) .AND. & ((B .GE. -0.39) .AND. (B .LT. 0.09))) THEN CALL ENK7(269,D,AV,A0) RETURN ENDIF IF (((L .GE. 58.07) .AND. (L .LT. 59.44)) .AND. & ((B .LT. 0.06) .AND. (B .GE. -0.33*L + 19.49))) THEN CALL ENK7(269,D,AV,A0) RETURN ENDIF IF (((L .GE. 55.09) .AND. (L .LT. 60.97)) .AND. & ((B .GE. -5.05) .AND. (B .LT. -0.34))) THEN CALL ENK7(270,D,AV,A0) RETURN ENDIF IF (((L .GE. 58.07) .AND. (L .LT. 59.44)) .AND. & ((B .GE. -0.36) .AND. (B .LT. -0.33*L + 19.49))) THEN CALL ENK7(270,D,AV,A0) RETURN ENDIF IF (((L .GE. 55.09) .AND. (L .LT. 58.25)) .AND. & ((B .GE. -0.43) .AND. (B .LT. 0.05))) THEN CALL ENK7(270,D,AV,A0) RETURN ENDIF IF (((L .GE. 55.11) .AND. (L .LT. 60.02)) .AND. & ((B .GE. -7.58) .AND. (B .LT. -5.00))) THEN CALL ENK7(270,D,AV,A0) RETURN ENDIF END C --------------------------------------------------------------- SUBROUTINE MAP258C(L,B,D,AV,A0) IMPLICIT REAL*4 (A-H,L-Z) IF (((L .GE. 63.28) .AND. (L .LT. 64.58)) .AND. & ((B .GE. 4.83) .AND. (B .LT. -1.81*L + 122.00))) THEN CALL ENK7(267,D,AV,A0) RETURN ENDIF IF (((L .GE. 59.15) .AND. (L .LT. 63.28)) .AND. & ((B .GE. 4.80) .AND. (B .LT. 7.45))) THEN CALL ENK7(267,D,AV,A0) RETURN ENDIF IF (((L .GE. 63.06) .AND. (L .LT. 64.56)) .AND. & ((B .GE. 1.14) .AND. (B .LT. 4.85))) THEN CALL ENK7(267,D,AV,A0) RETURN ENDIF IF (((L .GE. 59.16) .AND. (L .LT. 63.07)) .AND. & ((B .GE. 1.77) .AND. (B .LT. 4.83))) THEN CALL ENK7(267,D,AV,A0) RETURN ENDIF IF (((L .GE. 59.10) .AND. (L .LT. 63.05)) .AND. & ((B .GE. -0.60) .AND. (B .LT. 1.84))) THEN CALL ENK7(269,D,AV,A0) RETURN ENDIF IF (((L .GE. 59.08) .AND. (L .LT. 63.25)) .AND. & ((B .GE. -5.23) .AND. (B .LT. -0.56))) THEN CALL ENK7(270,D,AV,A0) RETURN ENDIF IF (((L .GE. 66.11) .AND. (L .LT. 67.49)) .AND. & ((B .GE. -1.01) .AND. (B .LT. -0.61*L + 40.00))) THEN CALL ENK7(271,D,AV,A0) RETURN ENDIF IF (((L .GE. 65.09) .AND. (L .LT. 66.12)) .AND. & ((B .GE. -1.02) .AND. (B .LT. -0.15))) THEN CALL ENK7(271,D,AV,A0) RETURN ENDIF IF (((L .GE. 65.09) .AND. (L .LT. 67.49)) .AND. & ((B .GE. -2.15) .AND. (B .LT. -1.00))) THEN CALL ENK7(271,D,AV,A0) RETURN ENDIF IF (((L .GE. 63.07) .AND. (L .LT. 65.09)) .AND. & ((B .GE. -0.56) .AND. (B .LT. 1.14))) THEN CALL ENK7(271,D,AV,A0) RETURN ENDIF IF (((L .GE. 63.25) .AND. (L .LT. 65.10)) .AND. & ((B .GE. -2.15) .AND. (B .LT. -0.54))) THEN CALL ENK7(271,D,AV,A0) RETURN ENDIF IF (((L .GE. 65.05) .AND. (L .LT. 71.67)) .AND. & ((B .GE. -6.20) .AND. (B .LT. -2.11))) THEN CALL ENK7(272,D,AV,A0) RETURN ENDIF IF (((L .GE. 63.25) .AND. (L .LT. 65.10)) .AND. & ((B .GE. -5.19) .AND. (B .LT. -2.11))) THEN CALL ENK7(272,D,AV,A0) RETURN ENDIF IF (((L .GE. 65.06) .AND. (L .LT. 66.25)) .AND. & ((B .GE. 1.86) .AND. (B .LT. 2.85))) THEN CALL ENK7(273,D,AV,A0) RETURN ENDIF IF (((L .GE. 66.25) .AND. (L .LT. 67.25)) .AND. & ((B .GE. 0.55) .AND. (B .LT. -1.29*L + 87.68))) THEN CALL ENK7(273,D,AV,A0) RETURN ENDIF IF (((L .GE. 65.08) .AND. (L .LT. 66.25)) .AND. & ((B .GE. 0.50) .AND. (B .LT. 1.87))) THEN CALL ENK7(273,D,AV,A0) RETURN ENDIF IF (((L .GE. 64.59) .AND. (L .LT. 65.11)) .AND. & ((B .GE. 1.13) .AND. (B .LT. 1.91))) THEN CALL ENK7(273,D,AV,A0) RETURN ENDIF IF (((L .GE. 65.09) .AND. (L .LT. 67.25)) .AND. & ((B .GE. -0.16) .AND. (B .LT. 0.56))) THEN CALL ENK7(273,D,AV,A0) RETURN ENDIF IF (((L .GE. 66.11) .AND. (L .LT. 67.41)) .AND. & ((B .LT. -0.14) .AND. (B .GE. -0.61*L + 40.00))) THEN CALL ENK7(273,D,AV,A0) RETURN ENDIF IF (((L .GE. 67.28) .AND. (L .LT. 67.47)) .AND. & ((B .GE. -0.83) .AND. (B .LT. -4.80*L + 322.53))) THEN CALL ENK7(273,D,AV,A0) RETURN ENDIF IF (((L .GE. 67.28) .AND. (L .LT. 67.47)) .AND. & ((B .LT. -0.83) .AND. (B .GE. -4.97*L + 334.03))) THEN CALL ENK7(273,D,AV,A0) RETURN ENDIF IF (((L .GE. 64.58) .AND. (L .LT. 69.70)) .AND. & ((B .GE. 2.87) .AND. (B .LT. 6.53))) THEN CALL ENK7(274,D,AV,A0) RETURN ENDIF IF (((L .GE. 63.70) .AND. (L .LT. 64.58)) .AND. & ((B .LT.