c Given a schedule ID such as T4-C3 (coded as 4 3 3),
c this program produces a detailed description of
c the steps that this entails.
c
c
c Steve Verrill, 4/17/01
c
c
c
integer temp(5,14),depr(6,8)
integer numstepv(6)
integer id(6,10,2)
character*11 step(6,10)
character*80 argv,intwrite
character*1 asterisk
data ((temp(i,j),j=1,14),i=1,5)/100,100,110,110,120,120,130,
x 130,140,140,150,160,170,180,
x 105,110,120,120,130,130,140,140,150,150,160,170,180,190,
x 105,120,130,130,140,140,150,150,160,160,160,170,180,190,
x 115,130,140,140,150,150,160,160,160,170,170,180,190,200,
x 120,150,160,180,160,180,160,180,160,180,180,180,190,200/
data ((depr(i,j),j=1,8),i=1,6)/3,4,5,7,10,15,20,25,
x4,5,7,10,14,20,30,35,
x6,8,11,15,20,30,40,50,
x10,14,19,25,35,50,50,50,
x25,30,35,40,50,50,50,50,
x50,50,50,50,50,50,50,50/
data numstepv/6,6,7,8,9,10/
data (step(1,j),j=1,6)/"Above 30","30 to 25","25 to 20",
x "20 to 15","15 to 10","10 to final"/
data (step(2,j),j=1,6)/"Above 35","35 to 30","30 to 25",
x "25 to 20","20 to 15","15 to final"/
data (step(3,j),j=1,7)/"Above 40","40 to 35","35 to 30",
x "30 to 25","25 to 20","20 to 15",
x "15 to final"/
data (step(4,j),j=1,8)/"Above 50","50 to 40","40 to 35",
x "35 to 30","30 to 25","25 to 20",
x "20 to 15","15 to final"/
data (step(5,j),j=1,9)/"Above 60","60 to 50","50 to 40",
x "40 to 35","35 to 30","30 to 25",
x "25 to 20","20 to 15","15 to final"/
data (step(6,j),j=1,10)/"Above 70","70 to 60","60 to 50",
x "50 to 40","40 to 35","35 to 30",
x "30 to 25","25 to 20","20 to 15",
x "15 to final"/
c The 3 subscripts of id correspond to "moisture content schedule"
c (this takes on values 1 -- 6 corresponding to A -- F),"step in
c the final drying schedule" (this can take on values 1 -- 10), and
c "temperature and wbd rows" (the first element is the row in the
c temperature schedule; the second element is the row in the wet bulb
c depression schedule).
data ((id(1,j,k),k=1,2),j=1,6)/1,1,
x 2,2,
x 3,3,
x 4,4,
x 5,5,
x 5,6/
data ((id(2,j,k),k=1,2),j=1,6)/1,1,
x 1,2,
x 2,3,
x 3,4,
x 4,5,
x 5,6/
data ((id(3,j,k),k=1,2),j=1,7)/1,1,
x 1,2,
x 1,3,
x 2,4,
x 3,5,
x 4,6,
x 5,6/
data ((id(4,j,k),k=1,2),j=1,8)/1,1,
x 1,2,
x 1,3,
x 1,4,
x 2,5,
x 3,6,
x 4,6,
x 5,6/
data ((id(5,j,k),k=1,2),j=1,9)/1,1,
x 1,2,
x 1,3,
x 1,4,
x 1,5,
x 2,6,
x 3,6,
x 4,6,
x 5,6/
data ((id(6,j,k),k=1,2),j=1,10)/1,1,
x 1,2,
x 1,3,
x 1,4,
x 1,5,
x 1,6,
x 2,6,
x 3,6,
x 4,6,
x 5,6/
asterisk = "*"
call getarg(1,argv)
write(intwrite,7) argv
7 format(a80)
read(intwrite,*) idt
call getarg(2,argv)
write(intwrite,7) argv
read(intwrite,*) idmc
call getarg(3,argv)
write(intwrite,7) argv
read(intwrite,*) iddepr
iexit = 0
if (idt .lt. 1) then
iexit = 1
write(6,10)
10 format("
Error: The temperature value was below 1.",
x " Please contact Steve Verrill at",
x ' ',
x 'sverrill@fs.fed.us or 608-231-9375.
')
endif
if (idt .gt. 14) then
iexit = 1
write(6,12)
12 format("
Error: The temperature value was greater",
x " than 14.",
x " Please contact Steve Verrill at",
x ' ',
x 'sverrill@fs.fed.us or 608-231-9375.
')
endif
if (idmc .lt. 1) then
iexit = 1
write(6,18)
18 format("
Error: The moisture content value was ",
x "below 1.",
x " Please contact Steve Verrill at",
x ' ',
x 'sverrill@fs.fed.us or 608-231-9375.
')
endif
if (idmc .gt. 6) then
iexit = 1
write(6,20)
20 format("
Error: The moisture content value was ",
x "greater",
x " than 6.",
x " Please contact Steve Verrill at",
x ' ',
x 'sverrill@fs.fed.us or 608-231-9375.
')
endif
if (iddepr .lt. 1) then
iexit = 1
write(6,14)
14 format("
Error: The wet bulb depression value was ",
x "below 1.",
x " Please contact Steve Verrill at",
x ' ',
x 'sverrill@fs.fed.us or 608-231-9375.
')
endif
if (iddepr .gt. 8) then
iexit = 1
write(6,16)
16 format("
Error: The wet bulb depression value was ",
x "greater",
x " than 8.",
x " Please contact Steve Verrill at",
x ' ',
x 'sverrill@fs.fed.us or 608-231-9375.
')
endif
if (iexit .eq. 1) stop
c
c calculate and write the schedule
c
c write(6,80)
c 80 format('
The step, temp, depr, wbt, emc, rh, ctemp,'
c x' cdepr, and cwbt values are:
')
write(6,8010)
8010 format("Step | ",
x"Moisture content | ",
x"Temperature in degrees F | ", x"Equilibrium moisture content | ",
x"Relative humidity | ",
x"Temperature in degrees C | ||||
|---|---|---|---|---|---|---|---|---|---|
| Dry- bulb | ",
x"Wet bulb depression | ",
x"Wet- bulb | ",
x"Dry- bulb | ",
x"Wet bulb depression | ",
x"Wet- bulb | ||||
| ",i2," | ",a11," | ",i3, x " | ",i2, x " | ",i3," | ",f5.1," | ",i2, x " | ",f5.1," | ",f4.1," | ",f5.1, x " |
| ",i2," | ",a11," | ",i3, x " | ",i2, x " | ",i3,a1," | ",f5.1," | ",i2, x " | ",f5.1," | ",f4.1," | ",f5.1, x a1," |
',a1,' Wet bulb values below 90 degrees',
x ' Fahrenheit are set to 90 degrees.
')
endif
stop
end
subroutine rhemc(tdb,twb,rh,emc)
c This subroutine calculates relative humidity and
c equilibrium moisture content from dry bulb and wet
c bulb temperatures.
tdb2 = tdb*tdb
tdb3 = tdb*tdb2
twb2 = twb*twb
twb3 = twb*twb2
c
c rh
c
xlnps = -3.1216 + .04683*twb - (1.033e-4)*twb2
x + (1.3175e-7)*twb3
pswb = exp(xlnps)
ys = pswb/(1.61*(29.92 - pswb))
y = ((.24 + .44*ys)*(tdb - twb))/(1094. + .44*tdb - twb)
y = ys - y
p = (1.61*y*29.92)/(1. + 1.61*y)
xlnps = -3.1216 + .04683*tdb - (1.033e-4)*tdb2
x + (1.3175e-7)*tdb3
psdb = exp(xlnps)
rh = (p/psdb)*100.0
c
c emc
c
w = 330. + .452*tdb + .00415*tdb2
xk = .791 + (4.63e-4)*tdb - (8.44e-7)*tdb2
xk1 = 6.34 + (7.75e-4)*tdb - (9.35e-5)*tdb2
xk2 = 1.09 + .0284*tdb - (9.04e-5)*tdb2
frh = rh/100.0
term1 = xk1*xk*frh
term2 = xk1*xk2*xk*xk*frh*frh
x1 = term1 + 2.0*term2
x2 = 1.0 + term1 + term2
emc = xk*frh/(1.0 - xk*frh) + (x1/x2)
emc = (1800.0/w)*emc
return
end