RosettaCodeData/Task/Temperature-conversion/PL-I/temperature-conversion.pli

*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;