home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / FORTRAN / D2SOURCE.ZIP / WOODS.FOR < prev   
Encoding:
Text File  |  1985-11-13  |  1.6 KB  |  51 lines
  1.       SUBROUTINE WOODS(U,ALFA,SY100,BETA,SZ100,WT)
  2.       DIMENSION UT(4),W(4,5),ALW(4,5),SYW(4,5),BTW(5),SZW(4,5),WTT(5)   
  3.       CHARACTER*2 WTT,WT
  4.       DATA UT/.45,2.2,5.4,8.9/  
  5.       DATA W/.089,.45,1.1,1.8,.089,.36,.8,1.3,.089,.36,.8,1.3,  
  6.      $ .045,.22,.54,.89,.045,.13,.27,.45/   
  7.       DATA ALW/.8,1.,1.,1.1,.8,3*1.,.8,3*1.,.8,7*1./
  8.       DATA SYW/12.8,12.1,12.,12.,18.2,17.5,16.8,14.5,   
  9.      $ 23.5,22.5,19.,14.,29.,26.5,22.5,16.5,53.,36.,26.,23./
  10.       DATA SZW/8.97,9.66,2*10.35,12.96,3*13.78,14.59,   
  11.      $ 3*15.4,4*20.,4*34.5/ 
  12.       DATA BTW/1.2,1.3,1.3,1.4,1./  
  13.       DATA WTT/'DW','MW','CF','MS','RF'/
  14. C     36. WOODS TYPE
  15.    10 CALL DEF(36,IRT)  
  16.       IF (IRT.EQ.0) READ(*,30) WT   
  17.    30 FORMAT(A2)
  18.       DO 40 I=1,5   
  19.       IF (WTT(I).EQ.WT) GO TO 60
  20.    40 CONTINUE  
  21.       WRITE(*,50)   
  22.    50 FORMAT(' WOODS CODE NOT DEFINED') 
  23.       CALL DEF(76,IRT)  
  24.       GO TO 10
  25.    60 IF (U.GT.0.) GO TO 90 
  26.       U=ABS(U)  
  27.       DO 70 J=1,4   
  28.       IF (W(J,I) .GE. U) GO TO 130  
  29.    70 CONTINUE  
  30.    80 ALFA=ALW(4,I) 
  31.       SY100=SYW(4,I)
  32.       SZ100=SZW(4,I)
  33.       GO TO 140 
  34.    90 DO 100  J=1,4 
  35.       IF (UT(J).GE.U) GO TO 110 
  36.   100 CONTINUE  
  37.       J=4   
  38.   110 IF (J.NE.1) GO TO 120 
  39.       U=W(J,I)  
  40.       GO TO 130 
  41.   120 S=ALOG(W(J,I)/W(J-1,I))/ALOG(UT(J)/UT(J-1))   
  42.       U=W(J-1,I)*(U/UT(J-1))**S 
  43.       IF (U.GT.W(4,I)) GO TO 80 
  44.   130 DUW=(U-W(J-1,I))/(W(J,I)-W(J-1,I))
  45.       ALFA=ALW(J-1,I)+DUW*(ALW(J,I)-ALW(J-1,I)) 
  46.       SY100=SYW(J-1,I)+DUW*(SYW(J,I)-SYW(J-1,I))
  47.       SZ100=SZW(J-1,I)+DUW*(SZW(J,I)-SZW(J-1,I))
  48.   140 BETA=BTW(I)
  49.       RETURN
  50.       END
  51.