home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / FORTRAN / D2SOURCE.ZIP / HD42.FOR < prev    next >
Encoding:
Text File  |  1985-12-20  |  1.3 KB  |  44 lines
  1. C  FIT TO ORG 40 PAR FOR 4.2/ CGW
  2.       SUBROUTINE HD42
  3.       COMMON NQI,QT(6),TWL(6),D(10),DL(10)
  4.       COMMON TIM,DXT,HT,HML,SXS,SYS,SZS,TIVCH,UT,BR,SF,TMP,ALFA,SY100,
  5.      1BETA,SZ100,Z,RC,V,QS
  6.       COMMON HDM(33),IPR(1),ND,IPO,I2MC,IMA,OPC,IMM,IDD,IHS,NOV,INP,MRL,
  7.      1NMU,ID2,IDEP,IMTCH,IM,IR,IL,IRL,ISM,IVD
  8.       DIMENSION FWT(10),FST(3),ALBT4(3),SZR4(3)
  9.       DATA FWT/1.6,.89,.64,.52,.43,.37,.33,.3,.27,.25/
  10.       DATA FST/.7,1.,1.25/
  11.       DATA SYR4/6.82/
  12.       DATA ALBT4/3.33,1.4,1.02/
  13.       DATA SZR4/287.,12.84,6.97/
  14.       TF=1.8*TMP+32.
  15.       IF (TF.LT.50.) GO TO 4
  16.       IUT=UT+.5
  17.       IF (IUT.GT.10) IUT=10
  18.       IMT=(IM+1)/2
  19.       IF (TF.LE.80.) FT=EXP(3.6889-.046052*TF)
  20.       IF (TF.GT.80.) FT=EXP(3.4239-.042799*TF)
  21. C     22. TIME AFTER FUNCTIONING
  22.  1    CALL READA (22,IRT,3,TIM)
  23.       IF (IRT.LT.0) GO TO 1
  24.       FEL=ALOG(FST(IMT)*FWT(IUT)*FT*120./TIM)
  25.       R=1.
  26.       IF (FEL.LT.-1.2) GO TO 3
  27.       R=EXP(.36464-.86189*FEL)
  28.       IF (FEL.GT..4) R=R-EXP(-.05129-1.6767*FEL)
  29.       IF (FEL.LE..4) R=R-EXP(-.24846-1.1373*FEL)
  30.  3    QT(1)=QS*R*NMU
  31.       SY100=SYR4
  32.       SZ100=SZR4(IMT)
  33.       ALFA=ALBT4(IMT)
  34.       BETA=ALBT4(IMT)
  35.       SYS=3.8
  36.       SZS=.2
  37.       SXS=SYS
  38.       RETURN
  39.  4    WRITE(*,5)
  40.  5    FORMAT(' TEMPERATURE FUNCTION NOT DEFINED BELOW 10 DEG C')
  41.       QT(1)=0.
  42.       RETURN
  43.       END
  44.