home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / FORTRAN / D2SOURCE.ZIP / VDPL.FOR < prev    next >
Encoding:
Text File  |  1986-02-07  |  2.5 KB  |  80 lines
  1.       SUBROUTINE VDPL(QTTL,SY,SZ,D1,X,DX,DXA,XS,XCH,DP,DPA,SDEPL,INT)
  2.       COMMON VDM(41),UT,VDM1(23),FP,VDM2(8),Z0,VDM3(13),
  3.      +IPO,I2MC,IMA,VDM4(11),IM,IR,IL,VDM5(3),K33,K42
  4.       DIMENSION FKMS(6),Z0T(12),DDD(10),DDL(10),DDBR(10),
  5.      +ARD(10),PT(6,3),ITT(12),Y(10)
  6.       DATA PT/.05,.05,.1,.1,.15,.15,.05,.1,.15,.2,.25,.3,.1,
  7.      +.15,.2,.25,.3,.35/
  8.       DATA ITT/3,2,3,1,3,2,3,2,2,3,3,0/
  9.       DATA FKMS/.9,.8,.6,.4,.2,.05/
  10.       DATA Z0T/100.,.03,100.,.005,100.,10.,100.,100.,100.,
  11.      +100.,100.,100./
  12.       GOTO(101,102,103,104)INT
  13.  101  ITI=ITT(IL)
  14.       IF(K33.EQ.0.AND.IL.LT.12.AND.IM.LT.7) FP=PT(IM,ITI)
  15.       IF (K42.EQ.0.AND.IL.LT.12) Z0=Z0T(IL)
  16.       UZ=UT*.005**FP
  17.       USTR=FP*FKMS(IM)*UZ
  18.       DVF2=USTR/UZ
  19.       DVF1=DVF2*USTR
  20.       BINV=0.06*(19600.*USTR*Z0)**.45
  21.       DEPV=DVF1/(1.+DVF2*BINV)
  22.       WRITE(*,50)
  23.  50   FORMAT(/5X,'FP',7X,'FKMS',7X,'UT',7X,'USTR',
  24.      +6X,'BINV',6X,'DEPV',6X,'QTTL')
  25.       WRITE(*,60) FP,FKMS(IM),UT,USTR,BINV,DEPV,QTTL
  26.  60   FORMAT(1X,1P7E10.3)
  27.       DEPV60=DEPV*60.
  28.       RETURN
  29. C     ENTRY VDPL1(SY,SZ,D1)
  30.  102  DO 10 I=1,10
  31.  10   ARD(I)=0.
  32.       DDMX=QTTL/(188.496*SY*SZ*UT)
  33.       DDD(1)=D1/10.
  34.       DDDL=(ALOG(DDMX)-ALOG(DDD(1)))/9.
  35.       DDL(1)=ALOG(DDD(1))
  36.       DO 20 I=2,10
  37.       DDL(I)=DDL(I-1)+DDDL
  38.       DDD(I)=EXP(DDL(I))
  39.  20   DDBR(I-1)=(DDD(I-1)+DDD(I))/2.
  40.       IF (IPO.NE.4) RETURN
  41.       IF (IMA.GT.0) GO TO 35
  42.       WRITE(*,30) (DDD(I),I=1,10)
  43.  30   FORMAT(/6X,'DOSAGE CONTOURS',10F5.0)
  44.       WRITE(*,31)
  45.  31   FORMAT(/7X,'X',7X,'DP',4X,'CONTOUR HALF-WIDTHS')
  46.       RETURN
  47.  35   WRITE(*,37) (DDD(I),I=1,10)
  48.  37   FORMAT(/7X,'CONC. CONTOURS',10F5.0)
  49.       WRITE(*,38)
  50.  38   FORMAT(/7X,'X',7X,'CP',4X,'CONTOUR HALF-WIDTHS')
  51.       RETURN
  52. C     ENTRY VDPL2(X,DX,DXA,XS,XCH,DP,DPA,SDEPL)
  53.  103  DP=DP*SDEPL
  54.       DPA=DPA*SDEPL
  55.       IF (DPA.LE.0) RETURN
  56.       DPLA=ALOG(DPA)
  57.       DO 70 IY=1,10
  58.       ARG=DPLA-DDL(IY)
  59.       IF (ARG.LT.0.) GO TO 80
  60.       Y(IY)=1.41421*SY*SQRT(ARG)
  61.       IF (X.NE.XCH) ARD(IY)=ARD(IY)+Y(IY)*DXA
  62.       IF (X.EQ.XCH) ARD(IY)=ARD(IY)-Y(IY)*(XS+DX-XCH)
  63.  70   CONTINUE
  64.       IY=11
  65.  80   QD=0.
  66.       IF (IPO.GT.0) WRITE(*,'(F5.2)') SDEPL
  67.       IY=IY-1
  68.       DO 90 I=1,9
  69.  90   QD=QD+DDBR(I)*(ARD(I)-ARD(I+1))*DEPV60
  70.       SDEPL=(QTTL-QD)/QTTL
  71.       IF (SDEPL.LT.0.) SDEPL=1.E-20
  72.       IF (IPO.EQ.4) WRITE(*,100) X,DPA,(Y(I),I=1,IY)
  73.  100  FORMAT(1X,F10.0,1PE10.3,0P10F5.0)
  74.       RETURN
  75. C     ENTRY VDPL3
  76.  104  WRITE(*,*) '   C OR D     AREA'
  77.       WRITE(*,'(1X,1P2E10.3)') (DDD(I),ARD(I),I=10,1,-1)
  78.       RETURN
  79.       END
  80.