Programmer's ROM - The Computer Language Library/programmersrom.iso/ada/piwg/z000008.ada

Text File | 1988-05-03 | 13.3 KB | 452 lines

with PHYSICAL_UNITS_BASIC ; use PHYSICAL_UNITS_BASIC ;
with PHYSICAL_UNITS_MECHANICAL ; use PHYSICAL_UNITS_MECHANICAL ;
with PHYSICAL_UNITS_OTHER ; use PHYSICAL_UNITS_OTHER ;

-- This package defines operators needed to evaluate equations of
-- physics using dimensional and units checking. Only MKS units
-- are used. A conversion package is available to convert from
-- other metric units and English units to the MKS units.
--
-- This package is not complete. Completeness would imply all
-- possible operators that combine physical dimensions and yeild
-- other physical dimensions. Users can provide local definitions
-- or this package can be augmented.
--

package MKS_PHYSICS_MECHANICAL is

  function "*" ( LEFT , RIGHT : LENGTH_MKS ) return AREA_MKS ;

  function SQRT ( LEFT : AREA_MKS ) return LENGTH_MKS ;

  function "**" ( LEFT : LENGTH_MKS ;
                  RIGHT : INTEGER ) return AREA_MKS ;

  function "**" ( LEFT : LENGTH_MKS ;
                  RIGHT : INTEGER ) return VOLUME_MKS ;

  function "*" ( LEFT : AREA_MKS ;
                 RIGHT : LENGTH_MKS ) return VOLUME_MKS ;

  function "*" ( LEFT : LENGTH_MKS ;
                 RIGHT : AREA_MKS ) return VOLUME_MKS ;

  function CUBE_ROOT ( LEFT : VOLUME_MKS ) return LENGTH_MKS ;

  function "/" ( LEFT : VOLUME_MKS ;
                 RIGHT : LENGTH_MKS ) return AREA_MKS ;

  function "/" ( LEFT : LENGTH_MKS ;
                 RIGHT : TIME_SECOND ) return VELOCITY_MKS ;

  function "/" ( LEFT : LENGTH_MKS ;
                 RIGHT : TIME_SECOND_SQUARED ) return ACCELERATION_MKS ;

  function "*" ( LEFT , RIGHT : TIME_SECOND ) return TIME_SECOND_SQUARED ;

  function "**" ( LEFT : TIME_SECOND ;
                  RIGHT : INTEGER ) return TIME_SECOND_SQUARED ;

  function "**" ( LEFT : VELOCITY_MKS ;
                  RIGHT : INTEGER ) return VELOCITY_SQUARED_MKS ;

  function SQRT ( LEFT : TIME_SECOND_SQUARED ) return TIME_SECOND ;

  function "*" ( LEFT , RIGHT : VELOCITY_MKS ) return VELOCITY_SQUARED_MKS ;

  function SQRT ( LEFT : VELOCITY_SQUARED_MKS ) return VELOCITY_MKS ;

  function "*" ( LEFT : ACCELERATION_MKS ;
                 RIGHT : TIME_SECOND_SQUARED ) return LENGTH_MKS ;

  function "/" ( LEFT : LENGTH_MKS ;
                 RIGHT : ACCELERATION_MKS ) return TIME_SECOND_SQUARED ;

  function "*" ( LEFT : ACCELERATION_MKS ;
                 RIGHT : LENGTH_MKS ) return VELOCITY_SQUARED_MKS ;

  function "*" ( LEFT : LENGTH_MKS ;
                 RIGHT : ACCELERATION_MKS ) return VELOCITY_SQUARED_MKS ;

  function "*" ( LEFT : ACCELERATION_MKS ;
                 RIGHT : TIME_SECOND ) return VELOCITY_MKS ;

  function "*" ( LEFT : TIME_SECOND ;
                 RIGHT : ACCELERATION_MKS ) return VELOCITY_MKS ;

  function "*" ( LEFT : MASS_MKS ;
                 RIGHT : ACCELERATION_MKS ) return FORCE_MKS ;

  function "*" ( LEFT : ACCELERATION_MKS ;
                 RIGHT : MASS_MKS ) return FORCE_MKS ;

  function "*" ( LEFT : PRESSURE_MKS ;
                 RIGHT : AREA_MKS ) return FORCE_MKS ;

  function "*" ( LEFT : AREA_MKS ;
                 RIGHT : PRESSURE_MKS ) return FORCE_MKS ;

  function "/" ( LEFT : POWER_MKS ;
                 RIGHT : VELOCITY_MKS ) return FORCE_MKS ;

  function "/" ( LEFT : ENERGY_MKS ;
                 RIGHT : LENGTH_MKS ) return FORCE_MKS ;

  function "*" ( LEFT : PRESSURE_MKS ;
                 RIGHT : VOLUME_MKS ) return ENERGY_MKS ;

  function "*" ( LEFT : VOLUME_MKS ;
                 RIGHT : PRESSURE_MKS ) return ENERGY_MKS ;

  function "*" ( LEFT : FORCE_MKS ;
                 RIGHT : LENGTH_MKS ) return ENERGY_MKS ;

  function "*" ( LEFT : LENGTH_MKS ;
                 RIGHT : FORCE_MKS ) return ENERGY_MKS ;

  function "*" ( LEFT : MASS_MKS ;
                 RIGHT : VELOCITY_SQUARED_MKS ) return ENERGY_MKS ;

  function "*" ( LEFT : VELOCITY_SQUARED_MKS ;
                 RIGHT : MASS_MKS ) return ENERGY_MKS ;

  function "*" ( LEFT : POWER_MKS ;
                 RIGHT : TIME_SECOND ) return ENERGY_MKS ;

  function "*" ( LEFT : TIME_SECOND ;
                 RIGHT : POWER_MKS ) return ENERGY_MKS ;

  function "*" ( LEFT : FORCE_MKS ;
                 RIGHT : VELOCITY_MKS ) return POWER_MKS ;

  function "*" ( LEFT : VELOCITY_MKS ;
                 RIGHT : FORCE_MKS ) return POWER_MKS ;

  function "/" ( LEFT : ENERGY_MKS ;
                 RIGHT : TIME_SECOND ) return POWER_MKS ;


  pragma INLINE ( "*", "/" , "**", SQRT ) ;

end MKS_PHYSICS_MECHANICAL ;

with REFUNCT ; use REFUNCT ;
with PHYSICAL_REAL ; use PHYSICAL_REAL ;

package body MKS_PHYSICS_MECHANICAL is

  function "*" ( LEFT , RIGHT : LENGTH_MKS ) return AREA_MKS is

  begin
    return AREA_MKS'  --
        ( DIMENSION( UNDIMENSION( LEFT ) * UNDIMENSION ( RIGHT ))) ;
  end "*" ;

  function SQRT ( LEFT : AREA_MKS ) return LENGTH_MKS is

  begin
    return LENGTH_MKS' ( DIMENSION( SQRT( UNDIMENSION( LEFT )))) ;
  end SQRT ;

  function "**" ( LEFT : LENGTH_MKS ;
                  RIGHT : INTEGER ) return AREA_MKS is

  begin
    if RIGHT /= 2 then
      raise NUMERIC_ERROR ;
    end if ;
    return AREA_MKS'  --
        ( DIMENSION( UNDIMENSION( LEFT ) * UNDIMENSION ( LEFT ))) ;
  end "**" ;

  function "**" ( LEFT : LENGTH_MKS ;
                  RIGHT : INTEGER ) return VOLUME_MKS is

  begin
    if RIGHT /= 3 then
      raise NUMERIC_ERROR ;
    end if ;
    return VOLUME_MKS'  --
        ( DIMENSION( UNDIMENSION( LEFT ) * UNDIMENSION ( LEFT ) * UNDIMENSION
        ( LEFT ))) ;
  end "**" ;

  function "*" ( LEFT : AREA_MKS ;
                 RIGHT : LENGTH_MKS ) return VOLUME_MKS is

  begin
    return VOLUME_MKS'  --
        ( DIMENSION( UNDIMENSION( LEFT ) * UNDIMENSION ( RIGHT ))) ;
  end "*" ;

  function "*" ( LEFT : LENGTH_MKS ;
                 RIGHT : AREA_MKS ) return VOLUME_MKS is

  begin
    return VOLUME_MKS'  --
        ( DIMENSION( UNDIMENSION( LEFT ) * UNDIMENSION ( RIGHT ))) ;
  end "*" ;

  function CUBE_ROOT ( LEFT : VOLUME_MKS ) return LENGTH_MKS is

  begin
    return LENGTH_MKS' ( DIMENSION( UNDIMENSION( LEFT ) ** ( 1.0 / 3.0 ))) ;
  end CUBE_ROOT ;

  function "/" ( LEFT : VOLUME_MKS ;
                 RIGHT : LENGTH_MKS ) return AREA_MKS is

  begin
    return AREA_MKS'  --
        ( DIMENSION( UNDIMENSION( LEFT ) / UNDIMENSION ( RIGHT ))) ;
  end "/" ;

  function "/" ( LEFT : LENGTH_MKS ;
                 RIGHT : TIME_SECOND ) return VELOCITY_MKS is

  begin
    return VELOCITY_MKS'  --
        ( DIMENSION( UNDIMENSION( LEFT ) / UNDIMENSION ( RIGHT ))) ;
  end "/" ;

  function "/" ( LEFT : LENGTH_MKS ;
                 RIGHT : TIME_SECOND_SQUARED ) return ACCELERATION_MKS is

  begin
    return ACCELERATION_MKS'  --
        ( DIMENSION( UNDIMENSION( LEFT ) / UNDIMENSION ( RIGHT ))) ;
  end "/" ;

  function "*" ( LEFT , RIGHT : TIME_SECOND ) return TIME_SECOND_SQUARED is

  begin
    return TIME_SECOND_SQUARED'  --
        ( DIMENSION( UNDIMENSION( LEFT ) * UNDIMENSION ( RIGHT ))) ;
  end "*" ;

  function "**" ( LEFT : TIME_SECOND ;
                  RIGHT : INTEGER ) return TIME_SECOND_SQUARED is

  begin
    if RIGHT /= 2 then
      raise NUMERIC_ERROR ;
    end if ;
    return TIME_SECOND_SQUARED'  --
        ( DIMENSION( UNDIMENSION( LEFT ) * UNDIMENSION ( LEFT ))) ;
  end "**" ;

  function "**" ( LEFT : VELOCITY_MKS ;
                  RIGHT : INTEGER ) return VELOCITY_SQUARED_MKS is

  begin
    if RIGHT /= 2 then
      raise NUMERIC_ERROR ;
    end if ;
    return VELOCITY_SQUARED_MKS'  --
        ( DIMENSION( UNDIMENSION( LEFT ) * UNDIMENSION ( LEFT ))) ;
  end "**" ;

  function SQRT ( LEFT : TIME_SECOND_SQUARED ) return TIME_SECOND is

  begin
    return TIME_SECOND' ( DIMENSION( SQRT( UNDIMENSION( LEFT )))) ;
  end SQRT ;

  function "*" ( LEFT , RIGHT : VELOCITY_MKS ) return VELOCITY_SQUARED_MKS is

  begin
    return VELOCITY_SQUARED_MKS'  --
        ( DIMENSION( UNDIMENSION( LEFT ) * UNDIMENSION ( RIGHT ))) ;
  end "*" ;

  function SQRT ( LEFT : VELOCITY_SQUARED_MKS ) return VELOCITY_MKS is

  begin
    return VELOCITY_MKS' ( DIMENSION( SQRT( UNDIMENSION( LEFT )))) ;
  end SQRT ;

  function "*" ( LEFT : ACCELERATION_MKS ;
                 RIGHT : TIME_SECOND_SQUARED ) return LENGTH_MKS is

  begin
    return LENGTH_MKS'  --
        ( DIMENSION( UNDIMENSION( LEFT ) * UNDIMENSION ( RIGHT ))) ;
  end "*" ;

  function "/" ( LEFT : LENGTH_MKS ;
                 RIGHT : ACCELERATION_MKS ) return TIME_SECOND_SQUARED is

  begin
    return TIME_SECOND_SQUARED'  --
        ( DIMENSION( UNDIMENSION( LEFT ) / UNDIMENSION ( RIGHT ))) ;
  end "/" ;

  function "*" ( LEFT : ACCELERATION_MKS ;
                 RIGHT : LENGTH_MKS ) return VELOCITY_SQUARED_MKS is

  begin
    return VELOCITY_SQUARED_MKS'  --
        ( DIMENSION( UNDIMENSION( LEFT ) * UNDIMENSION ( RIGHT ))) ;
  end "*" ;

  function "*" ( LEFT : LENGTH_MKS ;
                 RIGHT : ACCELERATION_MKS ) return VELOCITY_SQUARED_MKS is

  begin
    return VELOCITY_SQUARED_MKS'  --
        ( DIMENSION( UNDIMENSION( LEFT ) * UNDIMENSION ( RIGHT ))) ;
  end "*" ;

  function "*" ( LEFT : ACCELERATION_MKS ;
                 RIGHT : TIME_SECOND ) return VELOCITY_MKS is

  begin
    return VELOCITY_MKS'  --
        ( DIMENSION( UNDIMENSION( LEFT ) * UNDIMENSION ( RIGHT ))) ;
  end "*" ;

  function "*" ( LEFT : TIME_SECOND ;
                 RIGHT : ACCELERATION_MKS ) return VELOCITY_MKS is

  begin
    return VELOCITY_MKS'  --
        ( DIMENSION( UNDIMENSION( LEFT ) * UNDIMENSION ( RIGHT ))) ;
  end "*" ;

  function "*" ( LEFT : MASS_MKS ;
                 RIGHT : ACCELERATION_MKS ) return FORCE_MKS is

  begin
    return FORCE_MKS'  --
        ( DIMENSION( UNDIMENSION( LEFT ) * UNDIMENSION ( RIGHT ))) ;
  end "*" ;

  function "*" ( LEFT : ACCELERATION_MKS ;
                 RIGHT : MASS_MKS ) return FORCE_MKS is

  begin
    return FORCE_MKS'  --
        ( DIMENSION( UNDIMENSION( LEFT ) * UNDIMENSION ( RIGHT ))) ;
  end "*" ;

  function "*" ( LEFT : PRESSURE_MKS ;
                 RIGHT : AREA_MKS ) return FORCE_MKS is

  begin
    return FORCE_MKS'  --
        ( DIMENSION( UNDIMENSION( LEFT ) * UNDIMENSION ( RIGHT ))) ;
  end "*" ;

  function "*" ( LEFT : AREA_MKS ;
                 RIGHT : PRESSURE_MKS ) return FORCE_MKS is

  begin
    return FORCE_MKS'  --
        ( DIMENSION( UNDIMENSION( LEFT ) * UNDIMENSION ( RIGHT ))) ;
  end "*" ;

  function "/" ( LEFT : POWER_MKS ;
                 RIGHT : VELOCITY_MKS ) return FORCE_MKS is

  begin
    return FORCE_MKS'  --
        ( DIMENSION( UNDIMENSION( LEFT ) / UNDIMENSION ( RIGHT ))) ;
  end "/" ;

  function "/" ( LEFT : ENERGY_MKS ;
                 RIGHT : LENGTH_MKS ) return FORCE_MKS is

  begin
    return FORCE_MKS'  --
        ( DIMENSION( UNDIMENSION( LEFT ) / UNDIMENSION ( RIGHT ))) ;
  end "/" ;

  function "*" ( LEFT : PRESSURE_MKS ;
                 RIGHT : VOLUME_MKS ) return ENERGY_MKS is

  begin
    return ENERGY_MKS'  --
        ( DIMENSION( UNDIMENSION( LEFT ) * UNDIMENSION ( RIGHT ))) ;
  end "*" ;

  function "*" ( LEFT : VOLUME_MKS ;
                 RIGHT : PRESSURE_MKS ) return ENERGY_MKS is

  begin
    return ENERGY_MKS'  --
        ( DIMENSION( UNDIMENSION( LEFT ) * UNDIMENSION ( RIGHT ))) ;
  end "*" ;

  function "*" ( LEFT : FORCE_MKS ;
                 RIGHT : LENGTH_MKS ) return ENERGY_MKS is

  begin
    return ENERGY_MKS'  --
        ( DIMENSION( UNDIMENSION( LEFT ) * UNDIMENSION ( RIGHT ))) ;
  end "*" ;

  function "*" ( LEFT : LENGTH_MKS ;
                 RIGHT : FORCE_MKS ) return ENERGY_MKS is

  begin
    return ENERGY_MKS'  --
        ( DIMENSION( UNDIMENSION( LEFT ) * UNDIMENSION ( RIGHT ))) ;
  end "*" ;

  function "*" ( LEFT : MASS_MKS ;
                 RIGHT : VELOCITY_SQUARED_MKS ) return ENERGY_MKS is

  begin
    return ENERGY_MKS'  --
        ( DIMENSION( UNDIMENSION( LEFT ) * UNDIMENSION ( RIGHT ))) ;
  end "*" ;

  function "*" ( LEFT : VELOCITY_SQUARED_MKS ;
                 RIGHT : MASS_MKS ) return ENERGY_MKS is

  begin
    return ENERGY_MKS'  --
        ( DIMENSION( UNDIMENSION( LEFT ) * UNDIMENSION ( RIGHT ))) ;
  end "*" ;

  function "*" ( LEFT : POWER_MKS ;
                 RIGHT : TIME_SECOND ) return ENERGY_MKS is

  begin
    return ENERGY_MKS'  --
        ( DIMENSION( UNDIMENSION( LEFT ) * UNDIMENSION ( RIGHT ))) ;
  end "*" ;

  function "*" ( LEFT : TIME_SECOND ;
                 RIGHT : POWER_MKS ) return ENERGY_MKS is

  begin
    return ENERGY_MKS'  --
        ( DIMENSION( UNDIMENSION( LEFT ) * UNDIMENSION ( RIGHT ))) ;
  end "*" ;

  function "*" ( LEFT : FORCE_MKS ;
                 RIGHT : VELOCITY_MKS ) return POWER_MKS is

  begin
    return POWER_MKS'  --
        ( DIMENSION( UNDIMENSION( LEFT ) * UNDIMENSION ( RIGHT ))) ;
  end "*" ;

  function "*" ( LEFT : VELOCITY_MKS ;
                 RIGHT : FORCE_MKS ) return POWER_MKS is

  begin
    return POWER_MKS'  --
        ( DIMENSION( UNDIMENSION( LEFT ) * UNDIMENSION ( RIGHT ))) ;
  end "*" ;

  function "/" ( LEFT : ENERGY_MKS ;
                 RIGHT : TIME_SECOND ) return POWER_MKS is

  begin
    return POWER_MKS'  --
        ( DIMENSION( UNDIMENSION( LEFT ) / UNDIMENSION ( RIGHT ))) ;
  end "/" ;
end MKS_PHYSICS_MECHANICAL ;