*process source attributes xref; /* PL/I ************************************************************** * 15.08.2013 Walter Pachl translated from NetRexx * temperatures below 0K are considered invalid *********************************************************************/ temperature: Proc Options(main); Dcl sysin record Input; On Endfile(sysin) Goto eoj; On Record(sysin); Dcl 1 dat, 2 t Pic'SSSS9V.99', 2 * char( 1), 2 from char(10), 2 * char( 1), 2 to char(10); Do Forever; Read File(sysin) Into(dat); If tc(t,from,'KELVIN')<0 Then Put Edit('Input (',t,from,') invalid. Below absolute zero') (Skip,a,f(8,2),x(1),a,a); Else Put edit(t,from,' -> ',tc(t,from,to),to) (skip,f(8,2),x(1),a(10),a,f(8,2),x(1),a(10)); End; eoj: Return; tc: Procedure(T,scaleFrom,scaleTo) Returns(Dec Fixed(8,2)); Dcl t Pic'SSSS9V.99'; Dcl (val) Dec Fixed(8,2); Dcl (scaleFrom,scaleTo) Char(10); select(scaleFrom); when('KELVIN ') do; select(scaleTo); when('KELVIN ') val = T; when('CELSIUS ') val = T - 273.15; when('FAHRENHEIT') val = T * 9 / 5 - 459.67; when('RANKINE ') val = T * 9 / 5; when('DELISLE ') val = (373.15 - T) * 3 / 2; when('NEWTON ') val = (T - 273.15) * 33 / 100; when('REAUMUR ') val = (T - 273.15) * 4 / 5; when('ROEMER ') val = (T - 273.15) * 21 / 40 + 7.5; otherwise Do; Put Edit('scaleTo=',scaleTo)(Skip,a,a); Call err(1); End; end; end; when('CELSIUS') do; select(scaleTo); when('KELVIN ') val = T + 273.15; when('CELSIUS ') val = T; when('FAHRENHEIT') val = T * 9 / 5 + 32; when('RANKINE ') val = (T + 273.15) * 9 / 5; when('DELISLE ') val = (100 - T) * 3 / 2; when('NEWTON ') val = T * 33 / 100; when('REAUMUR ') val = T * 4 / 5; when('ROEMER ') val = T * 21 / 40 + 7.5; otherwise Call err(2); end; end; when('FAHRENHEIT') do; select(scaleTo); when('KELVIN ') val = (T + 459.67) * 5 / 9; when('CELSIUS ') val = (T - 32) * 5 / 9; when('FAHRENHEIT') val = T; when('RANKINE ') val = T + 459.67; when('DELISLE ') val = (212 - T) * 5 / 6; when('NEWTON ') val = (T - 32) * 11 / 60; when('REAUMUR ') val = (T - 32) * 4 / 9; when('ROEMER ') val = (T - 32) * 7 / 24 + 7.5; otherwise Call err(3); end; end; when('RANKINE') do; select(scaleTo); when('KELVIN ') val = T * 5 / 9; when('CELSIUS ') val = (T - 491.67) * 5 / 9; when('FAHRENHEIT') val = T - 459.67; when('RANKINE ') val = T; when('DELISLE ') val = (671.67 - T) * 5 / 6; when('NEWTON ') val = (T - 491.67) * 11 / 60; when('REAUMUR ') val = (T - 491.67) * 4 / 9; when('ROEMER ') val = (T - 491.67) * 7 / 24 + 7.5; otherwise Call err(4); end; end; when('DELISLE') do; select(scaleTo); when('KELVIN ') val = 373.15 - T * 2 / 3; when('CELSIUS ') val = 100 - T * 2 / 3; when('FAHRENHEIT') val = 212 - T * 6 / 5; when('RANKINE ') val = 671.67 - T * 6 / 5; when('DELISLE ') val = T; when('NEWTON ') val = 33 - T * 11 / 50; when('REAUMUR ') val = 80 - T * 8 / 15; when('ROEMER ') val = 60 - T * 7 / 20; otherwise Call err(5); end; end; when('NEWTON') do; select(scaleTo); when('KELVIN ') val = T * 100 / 33 + 273.15; when('CELSIUS ') val = T * 100 / 33; when('FAHRENHEIT') val = T * 60 / 11 + 32; when('RANKINE ') val = T * 60 / 11 + 491.67; when('DELISLE ') val = (33 - T) * 50 / 11; when('NEWTON ') val = T; when('REAUMUR ') val = T * 80 / 33; when('ROEMER ') val = T * 35 / 22 + 7.5; otherwise Call err(6); end; end; when('REAUMUR') do; select(scaleTo); when('KELVIN ') val = T * 5 / 4 + 273.15; when('CELSIUS ') val = T * 5 / 4; when('FAHRENHEIT') val = T * 9 / 4 + 32; when('RANKINE ') val = T * 9 / 4 + 491.67; when('DELISLE ') val = (80 - T) * 15 / 8; when('NEWTON ') val = T * 33 / 80; when('REAUMUR ') val = T; when('ROEMER ') val = T * 21 / 32 + 7.5; otherwise Call err(7); end; end; when('ROEMER') do; select(scaleTo); when('KELVIN ') val = (T - 7.5) * 40 / 21 + 273.15; when('CELSIUS ') val = (T - 7.5) * 40 / 21; when('FAHRENHEIT') val = (T - 7.5) * 24 / 7 + 32; when('RANKINE ') val = (T - 7.5) * 24 / 7 + 491.67; when('DELISLE ') val = (60 - T) * 20 / 7; when('NEWTON ') val = (T - 7.5) * 22 / 35; when('REAUMUR ') val = (T - 7.5) * 32 / 21; when('ROEMER ') val = T; otherwise Call err(8); end; end; otherwise Call err(9); end; return(val); err: Proc(e); Dcl e Dec fixed(1); Put Edit('error ',e,' invalid input')(Skip,a,f(1),a); val=0; End; End; End;