Skip to content

Fix REAL*8 statement-function declarations and tab warnings in r10vol1.f / r10tap.f (no numerical change) #18

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
d-diaz wants to merge 1 commit into
base: master
Choose a base branch
from
Open

Fix REAL*8 statement-function declarations and tab warnings in r10vol1.f / r10tap.f (no numerical change) #18

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
40 changes: 20 additions & 20 deletions r10tap.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -22,7 +22,7 @@ SUBROUTINE R10TAP(TAPEQU,DBHOB,HTTOT,HTUP,D2)
CHARACTER*2 ISP,IAC,IRC,IRA
REAL RH, DSI, RH32,BK,RH40
REAL HTTOT,HTUP,DBHOB,D2,D,H,BKAYC,BKWRC
REAL*8 BKAC,DVA,BKWR,DVR,BB,DD2MI,DVREDA
REAL BKAC,DVA,BKWR,DVR,BB,DD2MI,DVREDA
C
C
C PROFILE EQUATION (USED FOR DIAMETER CALCULATIONS)
Expand Down Expand Up @@ -155,11 +155,11 @@ SUBROUTINE R10TAP(TAPEQU,DBHOB,HTTOT,HTUP,D2)
C THIS IS THE SPRUCE-HEMLOCK AND RED ALDER PROFILE EQUATION CALCULATION

ELSE
IF(ISP.EQ.IRA)THEN
BK = 0
ELSE
IF(ISP.EQ.IRA)THEN
BK = 0
ELSE
BK = BB(D,H)
ENDIF
ENDIF
RH = (H - HTUP)/(H - 4.5)
C----------
C IF R<0.078 (R^32<10^-38), R32 IS TRUNCATED AND USED IN
Expand All @@ -169,34 +169,34 @@ SUBROUTINE R10TAP(TAPEQU,DBHOB,HTTOT,HTUP,D2)
IF(RH.LE.0.0)THEN
RH = 0
RH32 = 0
RH40 = 0
D2 = 0
RETURN
RH40 = 0
D2 = 0
RETURN
ELSEIF(RH .LT. 0.078) THEN
RH40 = 0.15
RH40 = 0.15
RH32= 0.078
ELSEIF(RH .LT. 0.15) THEN
RH40 = 0.15
RH40 = 0.15
RH32= RH
ELSE
RH40 = RH
RH40 = RH
RH32= RH
ENDIF
C
IF(ISP.EQ.IRA)THEN
D2=DVREDA(RH,RH32,RH40,H,D)
ELSE
IF(ISP.EQ.IRA)THEN
D2=DVREDA(RH,RH32,RH40,H,D)
ELSE
D2=DD2MI(RH,RH32,D,H)
ENDIF
ENDIF
if(d2.lt.0.0) d2 = 0.0
IF(ISP.EQ.IRA)THEN
D2=(D2)**.5*D
ELSE
IF(ISP.EQ.IRA)THEN
D2=(D2)**.5*D
ELSE
D2=(D2*BK)**.5*D
ENDIF
ENDIF
ENDIF
C
C THIS IS THE END OF THE DIAMETER CALCULATIONS
C
900 RETURN
RETURN
END
112 changes: 57 additions & 55 deletions r10vol1.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -116,7 +116,7 @@ SUBROUTINE R10VOL1(EQNUM,MTOPP,MTOPS,HTTOT,HT1PRD,DBHOB,
C-- RULES IN THE VOLUME ESTIMATOR HANDBOOK FSH ???.

IF (HTTYPE.EQ.'L' .OR. HTTYPE.EQ.'l') THEN
NUMSEG = HT1PRD
NUMSEG = INT(HT1PRD)
NOLOGP=HT1PRD
IF(NUMSEG.GT.20)THEN
ERRFLAG = 12
Expand All @@ -127,10 +127,11 @@ SUBROUTINE R10VOL1(EQNUM,MTOPP,MTOPS,HTTOT,HT1PRD,DBHOB,
35 CONTINUE
IF (FLAG32) THEN
NSEG16=INT(HT1PRD*2.0)
DO 36 I=1,NSEG16
36 PIELEN(I)=16.0
DO I=1,NSEG16
PIELEN(I)=16.0
END DO
ENDIF
itmp = anint((ht1prd-int(ht1prd))*10)
itmp = INT(ANINT((ht1prd-int(ht1prd))*10))
IF (itmp .eq. 5) THEN
NUMSEG=NUMSEG+1
LOGLEN(NUMSEG)=MAXLEN/2.0
Expand Down Expand Up @@ -267,8 +268,9 @@ SUBROUTINE R10VOL1(EQNUM,MTOPP,MTOPS,HTTOT,HT1PRD,DBHOB,
ILOG=ILOG+1
252 CONTINUE

253 DO 254 I=1,NSEG16
254 LOGVOL(1,I)=PIEVOL(I)
253 DO I=1,NSEG16
LOGVOL(1,I)=PIEVOL(I)
END DO
ENDIF


Expand Down Expand Up @@ -531,7 +533,7 @@ SUBROUTINE R10_HTS(EQNUM,HTTOT,HT1PRD,DBHOB,HTTYPE,STUMP,TOP,
REAL LIMD,LOWD,LUPD,LMERCH,TAPER,HITOP,RH,DSX,BKWRC,DSI
REAL HTTOT, HT1PRD, DBHOB, STUMP, TOP,RXL,DXL,HTEST
REAL BKAYC,H,HEST,D,C,HTD,BK,RH32,RH40
REAL*8 BKAC,DVA,BKWR,DVR,BB,DD2MI,DVREDA
REAL BKAC,DVA,BKWR,DVR,BB,DD2MI,DVREDA
INTEGER I,K,KNOL,IMO
C
C SPRUCE-HEMLOCK TAPER EQUATION
Expand Down Expand Up @@ -638,11 +640,11 @@ SUBROUTINE R10_HTS(EQNUM,HTTOT,HT1PRD,DBHOB,HTTYPE,STUMP,TOP,
I = 1

IF(H.GE.0.01) THEN
IF(ISP.EQ.IRA)THEN
BK = 0
ELSE
IF(ISP.EQ.IRA)THEN
BK = 0
ELSE
BK = BB(D,H)
ENDIF
ENDIF
C FV = 0.005454154*D**2*(H - 4.5)*BK
ENDIF

Expand All @@ -653,10 +655,10 @@ SUBROUTINE R10_HTS(EQNUM,HTTOT,HT1PRD,DBHOB,HTTYPE,STUMP,TOP,
IF(HEST.GT.0.01) BK = BB(D,HEST)

IF(ISP.EQ.IRA)THEN
DST(I) = (LIMD**2)/(D**2)
ELSE
DST(I) = (LIMD**2)/(D**2)
ELSE
DST(I) = (LIMD**2)/(BK*D**2)
ENDIF
ENDIF

DSLO(I) = DST(I) - 0.0001
DSHI(I) = DST(I) + 0.0001
Expand All @@ -671,44 +673,44 @@ SUBROUTINE R10_HTS(EQNUM,HTTOT,HT1PRD,DBHOB,HTTYPE,STUMP,TOP,
IF(RH.LE.0.0)THEN
RH = 0
RH32 = 0
RH40 = 0
RH40 = 0
ELSEIF(RH .LT. 0.078) THEN
RH40 = 0.15
RH40 = 0.15
RH32= 0.078
ELSEIF(RH .LT. 0.15) THEN
RH40 = 0.15
RH40 = 0.15
RH32= RH
ELSE
RH40 = RH
RH40 = RH
RH32= RH
ENDIF

IF(ISP.EQ.IRA)THEN
DS(I) = DVREDA(RH,RH32,RH40,HEST,D)
IF(ISP.EQ.IRA)THEN
DS(I) = DVREDA(RH,RH32,RH40,HEST,D)
ELSE
DS(I) = DD2MI(RH,RH32,D,HEST)
ENDIF
ENDIF
if(ds(i).lt.0.0) ds(i) = 0.0

RXL = 0.9*RH
IF(RXL.LE.0.0)THEN
RH32 = 0
RH40 = 0
RH40 = 0
ELSEIF(RXL .LT. 0.078) THEN
RH40 = 0.15
RH40 = 0.15
RH32= 0.078
ELSEIF(RXL .LT. 0.15) THEN
RH40 = 0.15
RH40 = 0.15
RH32= RXL
ELSE
RH40 = RXL
RH40 = RXL
RH32= RXL
ENDIF
IF(ISP.EQ.IRA)THEN
DXL = DVREDA(RXL,RH32,RH40,HEST,D)
IF(ISP.EQ.IRA)THEN
DXL = DVREDA(RXL,RH32,RH40,HEST,D)
ELSE
DXL = DD2MI(RXL,RH32,D,HEST)
ENDIF
ENDIF
if(dxl.lt.0.0) dxl = 0.0
TAPER = (DS(I) - DXL)/(.1*RH)
ELSE
Expand All @@ -717,44 +719,44 @@ SUBROUTINE R10_HTS(EQNUM,HTTOT,HT1PRD,DBHOB,HTTYPE,STUMP,TOP,
IF(RH.LE.0.0)THEN
RH = 0
RH32 = 0
RH40 = 0
RH40 = 0
ELSEIF(RH .LT. 0.078) THEN
RH40 = 0.15
RH40 = 0.15
RH32= 0.078
ELSEIF(RH .LT. 0.15) THEN
RH40 = 0.13
RH40 = 0.13
RH32= RH
ELSE
RH40 = RH
RH40 = RH
RH32= RH
ENDIF
IF(ISP.EQ.IRA)THEN
DS(I) = DVREDA(RH,RH32,RH40,H,D)
IF(ISP.EQ.IRA)THEN
DS(I) = DVREDA(RH,RH32,RH40,H,D)
ELSE
DS(I) = DD2MI(RH,RH32,D,H)
ENDIF
ENDIF
if(ds(i).lt.0.0) ds(i) = 0.0

RXL = 0.9*RH
IF(RXL.LE.0.0)THEN
RXL = 0
RH32 = 0
RH40 = 0
RH40 = 0
ELSEIF(RXL .LT. 0.078) THEN
RH40 = 0.15
RH40 = 0.15
RH32= 0.078
ELSEIF(RXL .LT. 0.15) THEN
RH40 = 0.15
RH40 = 0.15
RH32= RXL
ELSE
RH40 = RXL
RH40 = RXL
RH32= RXL
ENDIF
IF(ISP.EQ.IRA)THEN
DXL = DVREDA(RXL,RH32,RH40,H,D)
IF(ISP.EQ.IRA)THEN
DXL = DVREDA(RXL,RH32,RH40,H,D)
ELSE
DXL = DD2MI(RXL,RH32,D,H)
ENDIF
ENDIF

if(dxl.lt.0.0) dxl = 0.0
TAPER = (DS(I) - DXL)/(.1*RH)
Expand All @@ -771,31 +773,31 @@ SUBROUTINE R10_HTS(EQNUM,HTTOT,HT1PRD,DBHOB,HTTYPE,STUMP,TOP,
IF(RH.LE.0.0)THEN
RH = 0
RH32 = 0
RH40 = 0
RH40 = 0
ELSEIF(RH .LT. 0.078) THEN
RH40 = 0.15
RH40 = 0.15
RH32= 0.078
ELSEIF(RH .LT. 0.15) THEN
RH40 = 0.15
RH40 = 0.15
RH32= RH
ELSE
RH40 = RH
RH40 = RH
RH32= RH
ENDIF
IF(H.LE.0.01) THEN
HEST = (HH(I) - 4.5*RH)/(1.0 - RH)
IF(ISP.EQ.IRA)THEN
DS(I) = DVREDA(RH,RH32,RH40,HEST,D)
ELSE
IF(ISP.EQ.IRA)THEN
DS(I) = DVREDA(RH,RH32,RH40,HEST,D)
ELSE
DS(I) = DD2MI(RH,RH32,D,HEST)
ENDIF
ENDIF
if(ds(i).lt.0.0) ds(i) = 0.0
ELSE
IF(ISP.EQ.IRA)THEN
DS(I) = DVREDA(RH,RH32,RH40,H,D)
ELSE
IF(ISP.EQ.IRA)THEN
DS(I) = DVREDA(RH,RH32,RH40,H,D)
ELSE
DS(I) = DD2MI(RH,RH32,D,H)
ENDIF
ENDIF
if(ds(i).lt.0.0) ds(i) = 0.0
ENDIF
245 CONTINUE
Expand Down Expand Up @@ -895,7 +897,7 @@ SUBROUTINE R10_HTS(EQNUM,HTTOT,HT1PRD,DBHOB,HTTYPE,STUMP,TOP,

C ALASKA YELLOW CEDAR TAPER EQUATION
ELSE
5546 CONTINUE
CONTINUE
DSX = DVA(RH,RH32,H,DBHOB)
BKAYC = BKAC(DBHOB,H)
if(dsx.lt.0) dsx = 0
Expand Down