Skip to content

Fix REAL(8) to REAL(4) conversion warnings in f_other.f #16

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) to REAL(4) conversion warnings in f_other.f #16

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
120 changes: 60 additions & 60 deletions f_other.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -67,7 +67,7 @@ SUBROUTINE BRK_OT(JSP,geosub,DBHOB,DOB,HT2,DBTBH,DIB,dbt)
C3 = BK(6,JSPR)
D0 = BK(7,JSPR)
D1 = BK(8,JSPR)
D2 = BK(9,JSPR)
D2 = BK(9,JSPR)

c**********************************************************************
C IF(HT2.LT.(THT-2.0)) THEN
Expand All @@ -83,7 +83,7 @@ SUBROUTINE BRK_OT(JSP,geosub,DBHOB,DOB,HT2,DBTBH,DIB,dbt)
IF (DBTBH.LE.0) THEN
IF(JSPR.LE.1) THEN
c Black Hills
DBHIB = DBHOB*(D0+D1*ALOG(DBHOB))
DBHIB = REAL(DBHOB*(D0+D1*ALOG(DBHOB)))
ELSE IF(JSPR.EQ.2) THEN
c San Juan Model
IF(GEOSUB.EQ.'07') THEN
Expand All @@ -92,7 +92,7 @@ SUBROUTINE BRK_OT(JSP,geosub,DBHOB,DOB,HT2,DBTBH,DIB,dbt)
C DBHIB = -0.789251+0.922976*DBHOB
ELSEIF(GEOSUB.EQ.'13')THEN
C Use San Juan bark model
DBHIB = DBHOB*(D0+D1*ALOG(DBHOB))
DBHIB = REAL(DBHOB*(D0+D1*ALOG(DBHOB)))
ELSE IF(GEOSUB.EQ.'01') THEN
C Use A-S, Gila bark model
DBHIB = -0.649171195+0.925582344*DBHOB
Expand All @@ -102,28 +102,28 @@ SUBROUTINE BRK_OT(JSP,geosub,DBHOB,DOB,HT2,DBTBH,DIB,dbt)
ENDIF
ELSE IF(JSPR.EQ.3) THEN
c Dixie Model
DBHIB = DBHOB*(D0+D1*ALOG(DBHOB))
DBHIB = REAL(DBHOB*(D0+D1*ALOG(DBHOB)))

ELSEIF (JSPR.EQ.4) THEN
c R2 Lodgepole model
IF(GEOSUB.EQ.'02') THEN
DBHIB = DBHOB*(0.925915+0.0153361 * alog(DBHOB))
ELSE
C Northern Wyoming Bark Model
DBHIB = DBHOB*(D0 + D1*ALOG(DBHOB))
DBHIB = REAL(DBHOB*(D0 + D1*ALOG(DBHOB)))
ENDIF
ELSE IF(JSPR.EQ.5)THEN
C Douglas Fir
DBHIB = D0 + D1*DBHOB
DBHIB = REAL(D0 + D1*DBHOB)
ELSE IF(JSPR.EQ.6)THEN
C White fir
DBHIB = D0 + D1*DBHOB
DBHIB = REAL(D0 + D1*DBHOB)
ELSE IF(JSPR.EQ.7)THEN
c Aspen Model
DBHIB = D0 + D1*DBHOB
DBHIB = REAL(D0 + D1*DBHOB)
ELSE IF(JSPR.EQ.8)THEN
C r3 ponderosa pine
DBHIB = D0 + D1*DBHOB + D2*DBHOB*DBHOB
DBHIB = REAL(D0 + D1*DBHOB + D2*DBHOB*DBHOB)
ENDIF
DBTBH = DBHOB - DBHIB
ELSE
Expand Down Expand Up @@ -155,7 +155,7 @@ SUBROUTINE BRK_OT(JSP,geosub,DBHOB,DOB,HT2,DBTBH,DIB,dbt)
ENDIF
C ENDIF

DBT = PY * DBTBH
DBT = REAL(PY * DBTBH)

DIB = DOB - DBT

Expand Down Expand Up @@ -353,28 +353,28 @@ SUBROUTINE SHP_OT(JSP,DBHOB,HTTOT,RFLW,RHFW)

c Define geometric parameters
c (These outcomes are SINGLE precision)
R1= dexp(U1)/ (1.0d0 + dexp(U1))
R2= dexp(U2)/ (1.0d0 + dexp(U2))
R3= dexp(U3)/ (1.0d0 + dexp(U3))
R4= dexp(U4)/ (1.0d0 + dexp(U4))
R1= REAL(dexp(U1)/ (1.0d0 + dexp(U1)))
R2= REAL(dexp(U2)/ (1.0d0 + dexp(U2)))
R3= REAL(dexp(U3)/ (1.0d0 + dexp(U3)))
R4= REAL(dexp(U4)/ (1.0d0 + dexp(U4)))
IF (U5 .le. 7.0d0) then
R5= 0.5d0 + 0.5d0*dexp(U5)/ (1.0d0 + dexp(U5))
R5= REAL(0.5d0 + 0.5d0*dexp(U5)/ (1.0d0 + dexp(U5)))
else
R5=1.0
endif

A3=U6
RHI1 = dexp(U7) / ( 1.0d0 + dexp(U7) )
A3=REAL(U6)
RHI1 = REAL(dexp(U7) / ( 1.0d0 + dexp(U7) ))
if (RHI1.gt. 0.5 ) RHI1=0.5

RHLONGI= U9
RHLONGI= REAL(U9)
RHI2 = RHI1 + RHLONGI

c RHC = RHI2 + (1.0D0 - RHI2) * dexp(U8)/( 1.0d0 + dexp(U8))
c If (RHC .lt. RHI2 +0.01) then
c RHC = MIN( RHI2+0.01, (RHI2+1.0)/2.0 )
c endif
RHC=U8
RHC=REAL(U8)
if (RHC .lt. RHI2+.01) RHC= min( RHI2+.01, (RHI2+1.)/2.0 )

C PUT COEFFICIENTS INTO AN ARRAY FOR EASIER PASSING
Expand Down Expand Up @@ -474,25 +474,25 @@ FUNCTION COR_OT(JSP,HTTOT,HI,HJ)
c both heights are above BH
t3=(h1-bh)/(HTTOT-bh)
t4=(h2-bh)/(HTTOT-bh)
CORR = exp( q1*(t4-t3) + q2*(t4*t4-t3*t3)/2.0D0
> +q3*(t4*t4*t4 - t3*t3*t3)/3.0D0)
CORR = REAL(exp( q1*(t4-t3) + q2*(t4*t4-t3*t3)/2.0D0
> +q3*(t4*t4*t4 - t3*t3*t3)/3.0D0))
GO TO 100
endif

if(h2.gt. bh) then
c h1 < Bh and h2 > BH
t3=(h2-bh)/(HTTOT-bh)
T2 = (BH-H1)/BH
CORR = q5*exp( q4*t2 + q1*t3 +q2*t3*t3/2.0d0
> +q3*t3**3 / 3.0d0 )
CORR = REAL(q5*exp( q4*t2 + q1*t3 +q2*t3*t3/2.0d0
> +q3*t3**3 / 3.0d0 ))
go to 100
endif

c h1 < Bh and H2 < Bh
c note: t2 < t1
T2 = (BH-H2)/BH
T1 = (BH-H1)/BH
CORR=exp( q4* (t1-t2))
CORR=REAL(exp( q4* (t1-t2)))

C100 IF ( abs(CORR) .gt. 1.0 .and. ier_UNIT.ne.0)
C 1 write(IER_UNIT,102) JSP, H1,H2, CORR
Expand Down Expand Up @@ -610,35 +610,35 @@ SUBROUTINE VAR_OT(JSP,DBHOB,HTTOT,H,SE_LNX)

JSPR = JSP - 22

VA00 = V(1, JSPR)
VA01 = V(2, JSPR)
VA02 = V(3, JSPR)
VB00 = V(4, JSPR)
VB01 = V(5, JSPR)
VC0 = V(6, JSPR)
VA00 = REAL(V(1, JSPR))
VA01 = REAL(V(2, JSPR))
VA02 = REAL(V(3, JSPR))
VB00 = REAL(V(4, JSPR))
VB01 = REAL(V(5, JSPR))
VC0 = REAL(V(6, JSPR))

VX1 = V(7,JSPR)
VX2 = V(8,JSPR)
VX3 = V(9,JSPR)

VA03 = V(10, JSPR)
VE00 = V(11, JSPR)
VE01 = V(12, JSPR)
VE02 = V(13, JSPR)
VF00 = V(14, JSPR)
VF01 = V(15, JSPR)
VG0 = V(16, JSPR)
VX1 = REAL(V(7,JSPR))
VX2 = REAL(V(8,JSPR))
VX3 = REAL(V(9,JSPR))

VA03 = REAL(V(10, JSPR))
VE00 = REAL(V(11, JSPR))
VE01 = REAL(V(12, JSPR))
VE02 = REAL(V(13, JSPR))
VF00 = REAL(V(14, JSPR))
VF01 = REAL(V(15, JSPR))
VG0 = REAL(V(16, JSPR))

BH = 4.5

DMEDIAN = F(10,JSPR) *(HTTOT - BH)**(F(11,JSPR)+F(12,JSPR)*HTTOT)
DRATIO = DBHOB/DMEDIAN
LOGHT = log(HTTOT)

VA0 = VA00 + VA01*LOGHT + VA02*DRATIO + VA03*LOGHT*DRATIO
VA0 = REAL(VA00 + VA01*LOGHT + VA02*DRATIO + VA03*LOGHT*DRATIO)
VB0 = VB00 + VB01*LOGHT

VE0 = VE00 + VE01*LOGHT + VE02*DRATIO
VE0 = REAL(VE00 + VE01*LOGHT + VE02*DRATIO)
VF0 = VF00 + VF01*LOGHT

VC = VC0 + VX1*LOGHT
Expand Down Expand Up @@ -746,22 +746,22 @@ SUBROUTINE SHP_BH(DBHOB,HTTOT,RFLW,RHFW)
if (u9.lt. 0.0d0) U9 = 0.0d0

c This code taken from RF_SHP2 from the REG1 program
R1 = dexp(U1) / ( 1.0d0 + dexp(U1) )
R2 = dexp(U2) / ( 1.0d0 + dexp(U2) )
R3 = dexp(U3) / ( 1.0d0 + dexp(U3) )
R4 = dexp(U4) / ( 1.0d0 + dexp(U4) )
R5 = 0.5 + 0.5*dexp(U5) / ( 1.0d0 + dexp(U5) )
R1 = REAL(dexp(U1) / ( 1.0d0 + dexp(U1) ))
R2 = REAL(dexp(U2) / ( 1.0d0 + dexp(U2) ))
R3 = REAL(dexp(U3) / ( 1.0d0 + dexp(U3) ))
R4 = REAL(dexp(U4) / ( 1.0d0 + dexp(U4) ))
R5 = REAL(0.5 + 0.5*dexp(U5) / ( 1.0d0 + dexp(U5) ))

IF (U5 .gt. 7.0) R5 = 1.0

a3 = U6
RHI1 = dexp(U7) / ( 1.0d0 + dexp(U7) )
a3 = REAL(U6)
RHI1 = REAL(dexp(U7) / ( 1.0d0 + dexp(U7) ))

IF (RHI1.GT. 0.5) RHI1=0.5

RHLONGI = U9
RHLONGI = REAL(U9)
RHI2 = RHI1 + RHLONGI
RHC = U8
RHC = REAL(U8)
IF (RHC.LT.RHI2+0.01) RHC = MIN(RHI2 + 0.01,
> (RHI2 + 1.0)/2.0)
RHFW(1) = RHI1
Expand Down Expand Up @@ -822,8 +822,8 @@ FUNCTION COR_BH(HTTOT,H30,HT2)
c both heights are above BH
T3=(H1-4.5)/(HTTOT-4.5)
T4=(H2-4.5)/(HTTOT-4.5)
COR_BH = exp( Q1 * (T4 - T3) + Q2 * (T4*T4 - T3*T3)/2.0d0 +
> Q3 * (T4*T4*T4 - T3*T3*T3)/3.0d0)
COR_BH = REAL(exp( Q1*(T4 - T3) + Q2*(T4*T4-T3*T3)/2.0d0 +
> Q3 * (T4*T4*T4 - T3*T3*T3)/3.0d0))
IF(COR_BH.GT.0.999) COR_BH = 0.999
RETURN
ENDIF
Expand All @@ -832,8 +832,8 @@ FUNCTION COR_BH(HTTOT,H30,HT2)
c h1 < Bh and h2 > BH
T3 = (H2 - 4.5)/(HTTOT - 4.5)
T2 = (4.5 - H1)/4.5
COR_BH = Q5 * exp( Q4 * T2 + Q1 * T3 + Q2*T3*T3/2.0d0 +
> Q3*T3*T3*T3 / 3.0d0)
COR_BH = REAL(Q5 * exp( Q4 * T2 + Q1 * T3 + Q2*T3*T3/2.0d0 +
> Q3*T3*T3*T3 / 3.0d0))
IF(COR_BH .GT. 0.999) COR_BH = 0.999
IF(COR_BH .LT.-0.999) COR_BH = -0.999
RETURN
Expand All @@ -845,7 +845,7 @@ FUNCTION COR_BH(HTTOT,H30,HT2)
T1 = (4.5 - H1)/4.5
CORR = exp( Q4 * (T1-T2))

COR_BH = CORR
COR_BH = REAL(CORR)
RETURN

END
Expand Down Expand Up @@ -873,15 +873,15 @@ SUBROUTINE VAR_BH (DBHOB,HTTOT,HUP,SE)

c below BH
IF (HUP .LT. 4.5) THEN
LVARHAT = -.15512542D+01-.82366251*HUP +.10190777*DBHOB
LVARHAT = REAL(-.15512542D+01-.82366251*HUP+.10190777*DBHOB)
VARHAT = exp(LVARHAT)
c above breast height
ELSEIF (HUP .GT. 4.5) THEN

RH = (HUP - 4.5)/(HTTOT - 4.5)
LVARHAT = (-.72335700D+01 + .22333875D+01*LOG(DBHOB)) +
LVARHAT = REAL((-.72335700D+01 + .22333875D+01*LOG(DBHOB)) +
> (.25870429D+01-.43950365D-01*LOG(DBHOB)) *
> RH**(-.57411597D+00 + .67914946D+00*log(DBHOB))
> RH**(-.57411597D+00 + .67914946D+00*log(DBHOB)))
VARHAT = exp(LVARHAT)
c at breast height
ELSE
Expand Down