subroutine ch_cap ( c ) !*****************************************************************************80 ! !! CH_CAP capitalizes a single character. ! ! Modified: ! ! 19 July 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input/output, character C, the character to capitalize. ! implicit none character c integer itemp itemp = ichar ( c ) if ( 97 <= itemp .and. itemp <= 122 ) then c = char ( itemp - 32 ) end if return end subroutine convert_units ( inu, inunit, outu, outunit, type ) !*****************************************************************************80 ! !! CONVERT_UNITS converts a given quantity to a new set of units. ! ! Modified: ! ! 07 January 1999 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real ( kind = 8 ) INU, the measurement in the input units. ! ! Input, character ( len = * ) INUNIT, the input measurement units. ! ! Output, real ( kind = 8 ) OUTU, the measurement in the output units. ! ! Input, character ( len = * ) OUTUNIT, the units to which the ! measurement is to be converted. ! ! Input/output, character ( len = * ) TYPE, the type of the unit. ! The user may specify TYPE as 'ANGLE', 'AREA', 'LENGTH', ! 'PRESSURE', 'TEMPERATURE', 'TIME', 'VOLUME', 'WEIGHT', or leave it ! blank. ! ! If TYPE is ' ' on input, then CONVERT will try to guess ! an appropriate unit. The first appropriate unit system ! found will be chosen, and returned in TYPE. If none, ! then TYPE is returned as '?'. ! implicit none real ( kind = 8 ) inu character ( len = * ) inunit logical s_eqi real ( kind = 8 ) outu character ( len = * ) outunit character ( len = * ) type if ( type == ' ' ) then call unit2_type ( inunit, outunit, type ) write ( *, '(a,a)' ) 'UNIT2_TYPE detects type = ', trim ( type ) end if if ( s_eqi ( type, 'ANGLE' ) ) then call angle_convert ( inu, inunit, outu, outunit ) else if ( s_eqi ( type, 'AREA' ) ) then call area_convert ( inu, inunit, outu, outunit ) else if ( s_eqi ( type, 'LENGTH' ) ) then call length_convert ( inu, inunit, outu, outunit ) else if ( s_eqi ( type, 'PRESSURE' ) ) then call press_convert ( inu, inunit, outu, outunit ) else if ( s_eqi ( type, 'TEMPERATURE' ) ) then call temp_convert ( inu, inunit, outu, outunit ) else if ( s_eqi ( type, 'TIME' ) ) then call time_convert ( inu, inunit, outu, outunit ) else if ( s_eqi ( type, 'VOLUME' ) ) then call volume_convert ( inu, inunit, outu, outunit ) else if ( s_eqi ( type, 'WEIGHT' ) ) then call weight_convert ( inu, inunit, outu, outunit ) else outu = 0.0D+00 type = '?' end if return end subroutine angle_convert ( inu, inunit, outu, outunit ) !*****************************************************************************80 ! !! ANGLE_CONVERT converts an angular measurement to another system. ! ! Example: ! ! To convert 7 degrees to radians, call with ! ! INU = 7, ! INUNIT = 'DEGREES', ! OUTUNIT = 'RADIANS'. ! ! Modified: ! ! 08 January 1999 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real ( kind = 8 ) INU, the number of units of type INUNIT. ! ! Input, character ( len = * ) INUNIT, the original angular measurement. ! ! Output, real ( kind = 8 ) OUTU, the number of units of type OUTUNIT ! that are equivalent to INU units of type INUNIT. ! ! Input, character ( len = * ) OUTUNIT, the angular measurement in ! which the converted value is desired. ! implicit none real ( kind = 8 ) divisor real ( kind = 8 ) factor integer ierror integer index real ( kind = 8 ) inu character ( len = * ) inunit real ( kind = 8 ) outu character ( len = * ) outunit index = 0 call angle_data ( index, inunit, factor, ierror ) if ( ierror /= 0 ) then write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'ANGLE_CONVERT - Warning!' write ( *, '(a)' ) ' Your first unit was not recognized!' write ( *, '(a)' ) trim ( inunit ) outu = 0.0D+00 return end if index = 0 call angle_data ( index, outunit, divisor, ierror ) if ( ierror /= 0 ) then write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'ANGLE_CONVERT - Warning!' write ( *, '(a)' ) ' Your second unit was not recognized!' write ( *, '(a)' ) trim ( outunit ) outu = 0.0D+00 return end if outu = inu * factor / divisor return end subroutine angle_data ( index, name, factor, ierror ) !*****************************************************************************80 ! !! ANGLE_DATA returns an angle conversion factor. ! ! Modified: ! ! 08 January 1999 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input/output, integer INDEX, the index of the unit. ! If the input value of INDEX is 0, then NAME must be specified on ! input, and INDEX will be set on output to the index of the unit. ! ! Input/output, character ( len = * ) NAME, the name of the unit. ! If INDEX is 0, then the user must specify the unit by name on input. ! If INDEX is nonzero, then NAME will be set to the (preferred) name ! of the unit on output. ! ! Output, real ( kind = 8 ) FACTOR, the conversion factor associated with ! the given unit. ! ! Output, integer IERROR, error flag. ! 0, no error occurred. FACTOR was found. ! 1, INDEX was negative or too large. ! 2, INDEX was zero, and NAME was not recognized. ! implicit none integer, parameter :: NUM_NAME = 20 integer, parameter :: NUM_UNIT = 8 real ( kind = 8 ), parameter :: RADIAN = 1.0D+00 real ( kind = 8 ), parameter :: PI = & 3.14159265358979323846264338327950288419716939937510D+00 * RADIAN real ( kind = 8 ), parameter :: CIRCLE = 2.0D+00 * PI * RADIAN real ( kind = 8 ), parameter :: RANGLE = PI / 2.0D+00 real ( kind = 8 ), parameter :: DEGREE = PI / 180.0D+00 real ( kind = 8 ), parameter :: MINUTE = DEGREE / 60.0D+00 real ( kind = 8 ), parameter :: GRAD = 9.0D+00 * DEGREE / 10.0D+00 real ( kind = 8 ), parameter :: SECOND = MINUTE / 60.0D+00 real ( kind = 8 ) factor integer i integer ierror integer index integer j integer jshift logical s_eqi character ( len = * ) name real ( kind = 8 ) unit_factor(NUM_UNIT) integer unit_num(NUM_UNIT) character ( len = 30 ) unit_name(NUM_NAME) data ( unit_name(i), i = 1, NUM_NAME ) / & 'circles', 'circle', 'degrees', 'degree', 'deg', & 'grads', 'grad','minutes', 'minute', 'min', & '''','pi', 'radians', 'radian','right angles', & 'right angle','seconds', 'second', 'sec', '"' / data ( unit_num(i), i = 1, NUM_UNIT ) / 2, 3, 2, 4, 1, 2, 2, 4 / data ( unit_factor(i), i = 1, NUM_UNIT ) / & CIRCLE, DEGREE, GRAD, MINUTE, PI, RADIAN, RANGLE, SECOND / ierror = 0 if ( index == 0 ) then jshift = 0 do i = 1, NUM_UNIT do j = 1, unit_num(i) if ( s_eqi ( unit_name(j+jshift), name ) ) then index = i factor = unit_factor(i) return end if end do jshift = jshift + unit_num(i) end do if ( index == 0 ) then ierror = 1 end if else if ( index <= NUM_UNIT) then factor = unit_factor(index) j = 0 do i = 1, index - 1 j = j + unit_num(i) end do name = unit_name(j+1) else ierror = 1 name = '?' factor = 0.0D+00 end if return end subroutine angle_table ( outnum, outunit ) !*****************************************************************************80 ! !! ANGLE_TABLE prints an angle measurement conversion table. ! ! Example: ! ! To see what 7 degrees is in all other measurements, call with ! OUTNUM = 7 ! OUTUNIT = 'DEGREES'. ! ! Modified: ! ! 07 January 1999 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real ( kind = 8 ) OUTNUM, the number of units to be converted. ! If OUTNUM = 1, then tables are printed "both ways", that is, ! a table is also printed of the values of 1 of all the other ! units in terms of the input unit. ! ! Input, character ( len = * ) OUTUNIT, the units to be used as the base. ! implicit none integer ierror integer index real ( kind = 8 ) infactor character ( len = 30 ) inunit real ( kind = 8 ) outfactor real ( kind = 8 ) outnum character ( len = * ) outunit index = 0 call angle_data ( index, outunit, outfactor, ierror ) if ( ierror /= 0 ) then write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'ANGLE_TABLE - Fatal error!' write ( *, '(a)' ) ' Unrecognized unit!' write ( *, '(a)' ) trim ( outunit ) return end if write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'Angular measurements:' write ( *, '(a,a)' ) ' Conversion from ', trim ( outunit ) write ( *, '(a)' ) ' ' index = 0 inunit = ' ' do index = index + 1 call angle_data ( index, inunit, infactor, ierror ) if ( ierror /= 0 ) then exit end if write ( *, '(g14.6,2x,a,a,2x,g14.6,2x,a)' ) outnum, trim ( outunit ), & ' = ', outfactor/infactor, trim ( inunit ) end do if ( outnum /= 1.0D+00 ) then return end if write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'Angular measurements:' write ( *, '(a,a)' ) ' Conversion to ', trim ( outunit ) write ( *, '(a)' ) ' ' index = 0 do index = index + 1 call angle_data ( index, inunit, infactor, ierror ) if ( ierror /= 0 ) then exit end if write ( *, '(g14.6,2x,a,a,2x,a)' ) infactor/outfactor, trim ( outunit ), & ' = 1 ', trim ( inunit ) end do return end subroutine area_convert ( inu, inunit, outu, outunit ) !*****************************************************************************80 ! !! AREA_CONVERT converts an area measurement to another system. ! ! Example: ! ! To convert 7 acres to square miles, call with ! ! INU = 7, ! INUNIT = 'ACRES', ! OUTUNIT = 'SQUARE MILES'. ! ! Modified: ! ! 09 January 1999 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real ( kind = 8 ) INU, the number of units of type INUNIT. ! ! Input, character ( len = * ) INUNIT, the original area measurement. ! ! Output, real ( kind = 8 ) OUTU, the number of units of type OUTUNIT ! that are equivalent to INU units of type INUNIT. ! ! Input, character ( len = * ) OUTUNIT, the area measurement in ! which the converted value is desired. ! implicit none real ( kind = 8 ) divisor real ( kind = 8 ) factor integer ierror integer index real ( kind = 8 ) inu character ( len = * ) inunit real ( kind = 8 ) outu character ( len = * ) outunit index = 0 call area_data ( index, inunit, factor, ierror ) if ( ierror /= 0 ) then write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'AREA_CONVERT - Warning!' write ( *, '(a)' ) ' Your first unit was not recognized!' write ( *, '(a)' ) trim ( inunit ) outu = 0.0D+00 return end if index = 0 call area_data ( index, outunit, divisor, ierror ) if ( ierror /= 0 ) then write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'AREA_CONVERT - Warning!' write ( *, '(a)' ) ' Your second unit was not recognized!' write ( *, '(a)' ) trim ( outunit ) outu = 0.0D+00 return end if outu = inu * factor / divisor return end subroutine area_data ( index, name, factor, ierror ) !*****************************************************************************80 ! !! AREA_DATA returns an area conversion factor. ! ! Modified: ! ! 09 January 1999 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input/output, integer INDEX, the index of the unit. ! If the input value of INDEX is 0, then NAME must be specified on ! input, and INDEX will be set on output to the index of the unit. ! ! Input/output, character ( len = * ) NAME, the name of the unit. ! If INDEX is 0, then the user must specify the unit by name on input. ! If INDEX is nonzero, then NAME will be set to the (preferred) name ! of the unit on output. ! ! Output, real ( kind = 8 ) FACTOR, the conversion factor associated with ! the given unit. ! ! Output, integer IERROR, error flag. ! 0, no error occurred. FACTOR was found. ! 1, INDEX was negative or too large. ! 2, INDEX was zero, and NAME was not recognized. ! implicit none integer, parameter :: NUM_NAME = 52 integer, parameter :: NUM_UNIT = 16 ! ! Note: ! Unimplemented: 1 square pole = 625 square links. ! real ( kind = 8 ), parameter :: CENTI = 1.0D+00 / 100.0D+00 real ( kind = 8 ), parameter :: HECT = 100.0D+00 real ( kind = 8 ), parameter :: METER = 1.0D+00 real ( kind = 8 ), parameter :: KILO = 1000.0D+00 real ( kind = 8 ), parameter :: MICRO = 1.0D+00 / 1000000.0D+00 real ( kind = 8 ), parameter :: MILLI = 1.0D+00 / 1000.0D+00 real ( kind = 8 ), parameter :: ARE = 100.0D+00 * METER**2 real ( kind = 8 ), parameter :: CENTIMETER = CENTI * METER real ( kind = 8 ), parameter :: INCH = 0.0254D+00 * METER real ( kind = 8 ), parameter :: KILOMETER = KILO * METER real ( kind = 8 ), parameter :: METERSQ = METER**2 real ( kind = 8 ), parameter :: MICROMETER = MICRO * METER real ( kind = 8 ), parameter :: MILLIMETER = MILLI * METER real ( kind = 8 ), parameter :: CMSQ = CENTIMETER**2 real ( kind = 8 ), parameter :: FOOT = 12.0D+00 * INCH real ( kind = 8 ), parameter :: HECTARE = HECT * ARE real ( kind = 8 ), parameter :: INCHSQ = INCH**2 real ( kind = 8 ), parameter :: KMSQ = KILOMETER**2 real ( kind = 8 ), parameter :: MICROMSQ = MICROMETER**2 real ( kind = 8 ), parameter :: MILLIMSQ = MILLIMETER**2 real ( kind = 8 ), parameter :: FTSQ = FOOT**2 real ( kind = 8 ), parameter :: MILE = 5280.0D+00 * FOOT real ( kind = 8 ), parameter :: ROD = 16.5D+00 * FOOT real ( kind = 8 ), parameter :: YARD = 3.0D+00 * FOOT real ( kind = 8 ), parameter :: MILESQ = MILE**2 real ( kind = 8 ), parameter :: ROAD = 40.0D+00 * ROD**2 real ( kind = 8 ), parameter :: RODSQ = ROD**2 real ( kind = 8 ), parameter :: ROOD = 1210.0D+00 * YARD**2 real ( kind = 8 ), parameter :: TOWNSHIP = ( 6.0D+00 * MILE )**2 real ( kind = 8 ), parameter :: YARDSQ = YARD**2 real ( kind = 8 ), parameter :: ACRE = 4.0D+00 * ROOD real ( kind = 8 ) factor integer i integer ierror integer index integer j integer jshift logical s_eqi character ( len = * ) name real ( kind = 8 ) unit_factor(NUM_UNIT) integer unit_num(NUM_UNIT) character ( len = 30 ) unit_name(NUM_NAME) data ( unit_name(i), i = 1, NUM_NAME ) / & 'acres', 'acre', 'ares', 'are', 'square centimeters', & 'square centimeter', 'centimeter**2', 'cm**2', 'square feet', & 'square foot', 'feet**2', 'foot**2', 'ft**2', 'hectares', 'hectare', & 'square inches', 'square inch', 'inch**2', 'in**2', 'square kilometers', & 'square kilometer', 'kilometer**2', 'km**2', 'square meters', & 'square meter', 'meter**2', 'm**2', 'square micrometers', & 'square micrometer', 'micrometer**2', 'square miles', 'square mile', & 'mile***2', 'section', 'sections', 'square millimeters', & 'square millimeter', 'millimeter**2', 'mm**2', 'roads', 'road', & 'square rods', 'square rod', 'rod**2', 'roods', 'rood', 'townships', & 'township', 'square yards', 'square yard', 'yd**2', 'yard**2' / data ( unit_num(i), i = 1, NUM_UNIT ) / & 2, 2, 4, 5, 2, 4, 4, 4, 3, 5, 4, 2, 3, 2, 2, 4 / data ( unit_factor(i), i = 1, NUM_UNIT ) / & ACRE, ARE, CMSQ, FTSQ, HECTARE, & INCHSQ, KMSQ, METERSQ, MICROMSQ, MILESQ, & MILLIMSQ, ROAD, RODSQ, ROOD, TOWNSHIP, & YARDSQ / ierror = 0 if ( index == 0 ) then jshift = 0 do i = 1, NUM_UNIT do j = 1, unit_num(i) if ( s_eqi ( unit_name(j+jshift), name ) ) then index = i factor = unit_factor(i) return end if end do jshift = jshift + unit_num(i) end do if ( index == 0 ) then ierror = 1 end if else if ( index <= NUM_UNIT) then factor = unit_factor(index) j = 0 do i = 1, index - 1 j = j + unit_num(i) end do name = unit_name(j+1) else ierror = 1 name = '?' factor = 0.0D+00 end if return end subroutine area_table ( outnum, outunit ) !*****************************************************************************80 ! !! AREA_TABLE prints an area measurement conversion table. ! ! Example: ! ! To see what 7 acres is in all measurements, call with ! OUTNUM = 7 ! OUTUNIT = 'ACRES'. ! ! Modified: ! ! 07 January 1999 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real ( kind = 8 ) OUTNUM, the number of units to be converted. ! If OUTNUM = 1, then tables are printed "both ways", that is, ! a table is also printed of the values of 1 of all the other ! units in terms of the input unit. ! ! Input, character ( len = * ) OUTUNIT, the units to be used as the base. ! implicit none integer ierror integer index real ( kind = 8 ) infactor character ( len = 30 ) inunit real ( kind = 8 ) outfactor real ( kind = 8 ) outnum character ( len = * ) outunit index = 0 call area_data ( index, outunit, outfactor, ierror ) if ( ierror /= 0 ) then write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'AREA_TABLE - Fatal error!' write ( *, '(a)' ) ' AREA did not recognize your unit!' write ( *, '(a)' ) trim ( outunit ) return end if write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'Area measurements:' write(*,'(a,a)')' Conversion from ', trim ( outunit ) write ( *, '(a)' ) ' ' index = 0 inunit = ' ' do index = index + 1 inunit = ' ' call area_data ( index, inunit, infactor, ierror ) if ( ierror /= 0 ) then exit end if write ( *, '(g14.6,2x,a,a,2x,g14.6,2x,a)' ) outnum, trim ( outunit ), & ' = ', outfactor/infactor, trim ( inunit ) end do if ( outnum /= 1.0D+00 ) then return end if write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'Area measurements:' write ( *, '(a,a)' ) ' Conversion to ', trim ( outunit ) write ( *, '(a)' ) ' ' index = 0 do index = index + 1 inunit = ' ' call area_data ( index, inunit, infactor, ierror ) if ( ierror /= 0 ) then exit end if write ( *, '(g14.6,2x,a,a,2x,a)' ) infactor/outfactor, trim ( outunit ), & ' = 1 ', trim ( inunit ) end do return end subroutine length_convert ( inu, inunit, outu, outunit ) !*****************************************************************************80 ! !! LENGTH_CONVERT converts a length measurement to another system. ! ! Example: ! ! To convert 7 miles to feet, call with ! ! INU = 7, ! INUNIT = 'MILES', ! OUTUNIT = 'FEET'. ! ! Modified: ! ! 11 January 1999 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real ( kind = 8 ) INU, the number of units of type INUNIT. ! ! Input, character ( len = * ) INUNIT, the original length units. ! ! Output, real ( kind = 8 ) OUTU, the number of units of type OUTUNIT ! that are equivalent to INU units of type INUNIT. ! ! Input, character ( len = * ) OUTUNIT, the length units in ! which the converted value is desired. ! implicit none real ( kind = 8 ) divisor real ( kind = 8 ) factor integer ierror integer index real ( kind = 8 ) inu character ( len = * ) inunit real ( kind = 8 ) outu character ( len = * ) outunit index = 0 call length_data ( index, inunit, factor, ierror ) if ( ierror /= 0 ) then write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'LENGTH_CONVERT - Warning!' write ( *, '(a)' ) ' Your first unit was not recognized!' write ( *, '(a)' ) trim ( inunit ) outu = 0.0D+00 return end if index = 0 call length_data ( index, outunit, divisor, ierror ) if ( ierror /= 0 ) then write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'LENGTH_CONVERT - Warning!' write ( *, '(a)' ) ' Your second unit was not recognized!' write ( *, '(a)' ) trim ( outunit ) outu = 0.0D+00 return end if outu = inu * factor / divisor return end subroutine length_data ( index, name, factor, ierror ) !*****************************************************************************80 ! !! LENGTH_DATA returns a length conversion factor. ! ! Modified: ! ! 11 November 2000 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input/output, integer INDEX, the index of the unit. ! If the input value of INDEX is 0, then NAME must be specified on ! input, and INDEX will be set on output to the index of the unit. ! ! Input/output, character ( len = * ) NAME, the name of the unit. ! If INDEX is 0, then the user must specify the unit by name on input. ! If INDEX is nonzero, then NAME will be set to the (preferred) name ! of the unit on output. ! ! Output, real ( kind = 8 ) FACTOR, the conversion factor associated with ! the given unit. ! ! Output, integer IERROR, error flag. ! 0, no error occurred. FACTOR was found. ! 1, INDEX was negative or too large. ! 2, INDEX was zero, and NAME was not recognized. ! implicit none integer, parameter :: NUM_NAME = 147 integer, parameter :: NUM_UNIT = 58 real ( kind = 8 ), parameter :: ATTO = 1.0D+00 / 1000000000000000000.0D+00 real ( kind = 8 ), parameter :: CENTI = 1.0D+00 / 100.0D+00 real ( kind = 8 ), parameter :: DECI = 1.0D+00 / 10.0D+00 real ( kind = 8 ), parameter :: FEMTO = 1.0D+00 / 1000000000000000.0D+00 real ( kind = 8 ), parameter :: KILO = 1000.0D+00 real ( kind = 8 ), parameter :: METER = 1.0D+00 real ( kind = 8 ), parameter :: MICRO = 1.0D+00 / 1000000.0D+00 real ( kind = 8 ), parameter :: MILLI = 1.0D+00 / 1000.0D+00 real ( kind = 8 ), parameter :: NANO = 1.0D+00 / 1000000000.0D+00 real ( kind = 8 ), parameter :: PI = & 3.14159265358979323846264338327950288419716939937510D+00 real ( kind = 8 ), parameter :: PICO = 1.0D+00 / 1000000000000.0D+00 real ( kind = 8 ), parameter :: ANGSTROM = 1.0E-10 * METER real ( kind = 8 ), parameter :: ASTROUNIT = 149500000.0D+00 * METER real ( kind = 8 ), parameter :: ATTOMETER = ATTO * METER real ( kind = 8 ), parameter :: BARN = METER * 1.0E-28 real ( kind = 8 ), parameter :: CENTIMETER = CENTI*METER real ( kind = 8 ), parameter :: DECIMETER = DECI*METER real ( kind = 8 ), parameter :: RADIAN_LAT = 6356912.0D+00 * METER real ( kind = 8 ), parameter :: DEGREE_LAT = RADIAN_LAT * ( 180.0D+00 / PI ) real ( kind = 8 ), parameter :: EQUCIRC = 2.0D+00 * PI * 6378388.0D+00 * METER real ( kind = 8 ), parameter :: EQURADIUS = 6378388.0D+00 * METER real ( kind = 8 ), parameter :: FEMTOMETER = FEMTO * METER real ( kind = 8 ), parameter :: INCH = 0.0254D+00 * METER real ( kind = 8 ), parameter :: KILOMETER = KILO * METER real ( kind = 8 ), parameter :: LIGHTYEAR = 299792500.0D+00 * 60.0D+00 * 60.0D+00 & * 24.0D+00 * 365.0D+00 * METER real ( kind = 8 ), parameter :: MICROMETER = MICRO * METER real ( kind = 8 ), parameter :: MILLIMETER = MILLI * METER real ( kind = 8 ), parameter :: NANOMETER = NANO * METER real ( kind = 8 ), parameter :: NMILE = 1852.0D+00 * METER real ( kind = 8 ), parameter :: PARSEC = 3.084E+16 * METER real ( kind = 8 ), parameter :: PICOMETER = PICO * METER real ( kind = 8 ), parameter :: POLECIRC = 2.0D+00 * PI * 6356912.0D+00 * METER real ( kind = 8 ), parameter :: POLERADIUS = 6356912.0D+00 * METER real ( kind = 8 ), parameter :: QUADRANT = 10002288.3D+00 * METER real ( kind = 8 ), parameter :: BARLEY = INCH / 3.0D+00 real ( kind = 8 ), parameter :: EM = INCH / 6.0D+00 real ( kind = 8 ), parameter :: FOOT = 12.0D+00 * INCH real ( kind = 8 ), parameter :: HAND = 4.0D+00 * INCH real ( kind = 8 ), parameter :: MIL = INCH / 1000.0D+00 real ( kind = 8 ), parameter :: NAIL = 2.25D+00 * INCH real ( kind = 8 ), parameter :: NLEAGUE = 3.0D+00 * NMILE real ( kind = 8 ), parameter :: PACE = 30.0D+00 * INCH real ( kind = 8 ), parameter :: PALM = 3.0D+00 * INCH real ( kind = 8 ), parameter :: PICA = INCH / 6.0D+00 real ( kind = 8 ), parameter :: PSPOINT = INCH / 72.0D+00 real ( kind = 8 ), parameter :: POINT = INCH / 72.27D+00 real ( kind = 8 ), parameter :: SPAN = 9.0D+00 * INCH real ( kind = 8 ), parameter :: BR_FOOT = 1.0000028D+00 * FOOT real ( kind = 8 ), parameter :: CUBIT = 1.5D+00 * FOOT real ( kind = 8 ), parameter :: YARD = 3.0D+00 * FOOT real ( kind = 8 ), parameter :: ROD = 16.5D+00 * FOOT real ( kind = 8 ), parameter :: ENG_CHAIN = 100.0D+00 * FOOT real ( kind = 8 ), parameter :: FURLONG = 660.0D+00 * FOOT real ( kind = 8 ), parameter :: MILE = 5280.0D+00 * FOOT real ( kind = 8 ), parameter :: FATHOM = 6.0D+00 * FOOT real ( kind = 8 ), parameter :: SHACKLE = 15.0D+00 * FATHOM real ( kind = 8 ), parameter :: CABLE = 8.0D+00 * SHACKLE real ( kind = 8 ), parameter :: SUR_CHAIN = 4.0D+00 * ROD real ( kind = 8 ), parameter :: ROMANPACE = MILE / 1000.0D+00 real ( kind = 8 ), parameter :: LEAGUE = 3.0D+00 * MILE real ( kind = 8 ), parameter :: SUR_LINK = SUR_CHAIN / 100.0D+00 real ( kind = 8 ), parameter :: QUARTER = 9.0D+00 * INCH real ( kind = 8 ), parameter :: ELL = 45.0D+00 * INCH real ( kind = 8 ), parameter :: BOLT = 120.0D+00 * FOOT ! ! French measurements. real ( kind = 8 ), parameter :: PIED = 0.3249D+00 * METER real ( kind = 8 ), parameter :: POUCE = PIED / 12.0D+00 real ( kind = 8 ), parameter :: LIGNE = POUCE / 12.0D+00 real ( kind = 8 ), parameter :: TOISE = 6.0D+00 * PIED real ( kind = 8 ) factor integer i integer ierror integer index integer j integer jshift logical s_eqi character ( len = * ) name real ( kind = 8 ) unit_factor(NUM_UNIT) integer unit_num(NUM_UNIT) character ( len = 30 ) unit_name(NUM_NAME) data ( unit_name(i), i = 1, 50 ) / & 'angstroms', 'angstrom', 'astronomical units', 'astronomical unit', & 'au', 'attometers', 'attometer', 'barleycorns', 'barleycorn', & 'barns', 'barn', 'bolts', 'bolt', 'British feet', 'British foot', & 'cables', 'cable', 'centimeters', 'centimeter', 'cm', 'cubits', & 'cubit', 'decimeters', 'decimeter', 'degrees of latitude', & 'degree of latitude', 'ells', 'ell', 'ems', 'em', 'engineer''s chains', & 'engineer''s chain', 'equators', 'equator', 'equatorial radii', & 'equatorial radius', 'equatorial radiuses', 'fathoms', 'fathom', & 'femtometers', 'femtometer', 'fermis', 'fermi', 'feet', 'foot', 'ft', & 'engineer''s links', 'engineer''s link', '''', 'furlongs' / data ( unit_name(i), i = 51, 100 ) / & 'furlong', 'hands', 'hand', 'inches', 'inch', 'in', '"', & 'kilometers', 'kilometer', 'km', 'leagues', 'league', 'statute leagues', & 'statute league', 'light years', 'light year', 'lignes', 'ligne', & 'meters', 'meter', 'm', 'micrometers', 'micrometer', 'microns', & 'micron', 'mils', 'mil', 'miles', 'mile', 'statute miles', & 'statute mile', 'millimeters', 'millimeter', 'mm', 'nails', 'nail', & 'nanometers', 'nanometer', 'nm', 'nautical leagues', 'nautical league', & 'nautical miles', 'nautical mile', 'paces', 'pace', 'palms', 'palm', & 'Paris feet', 'Paris foot', 'pieds' / data ( unit_name(i), i = 101, NUM_NAME ) / & 'pied', 'parsecs', 'parsec', 'picas', 'pica', 'picometers', 'picometer', & 'points', 'point', 'printer''s points', 'printer''s point', & 'polar circumferences', 'polar circumference', & 'polar radii', 'polar radius', 'polar radiuses', 'PostScript points', & 'PostScript point', 'pouces', 'pouce', 'quadrants', 'quadrant', & 'quarters', 'quarter', 'radians of latitude', 'radian of latitude', & 'rods', 'rod', 'roman paces', 'roman pace', 'shackle', 'shackles', & 'spans', 'span', & 'surveyor''s chains', 'surveyor''s chain', 'Gunter''s chains', & 'Gunter''s chain', 'surveyor''s links', 'surveyor''s link', & 'Gunter''s links', 'Gunter''s link', 'toises', 'toise', 'yards', & 'yard', 'yd' / data ( unit_num(i), i = 1, NUM_UNIT ) / & 2, 3, 2, 2, 2, 2, 2, 2, 3, 2, 2, 2, 2, 2, 2, 2, 3, 2, 4, 6, & 2, 2, 4, 3, 4, 2, 2, 3, 4, 2, 4, 3, 2, 3, 2, 2, 2, 2, 4, 2, & 2, 2, 4, 2, 3, 2, 2, 2, 2, 2, 2, 2, 2, 2, 4, 4, 2, 3 / data ( unit_factor(i), i = 1, NUM_UNIT ) / & ANGSTROM, ASTROUNIT, ATTOMETER, BARLEY, BARN, BOLT, BR_FOOT, CABLE, & CENTIMETER, CUBIT, DECIMETER, DEGREE_LAT, ELL, EM, ENG_CHAIN, & EQUCIRC, EQURADIUS, FATHOM, FEMTOMETER, FOOT, FURLONG, HAND, INCH, & KILOMETER, LEAGUE, LIGHTYEAR, LIGNE, METER, MICROMETER, MIL, MILE, & MILLIMETER, NAIL, NANOMETER, NLEAGUE, NMILE, PACE, PALM, PIED, PARSEC, & PICA, PICOMETER, POINT, POLECIRC, POLERADIUS, PSPOINT, POUCE, QUADRANT, & QUARTER, RADIAN_LAT, ROD, ROMANPACE, SHACKLE, SPAN, SUR_CHAIN, SUR_LINK, & TOISE, YARD / ierror = 0 if ( index == 0 ) then jshift = 0 do i = 1, NUM_UNIT do j = 1, unit_num(i) if ( s_eqi ( unit_name(j+jshift), name ) ) then index = i factor = unit_factor(i) return end if end do jshift = jshift + unit_num(i) end do if ( index == 0 ) then ierror = 1 end if else if ( index <= NUM_UNIT) then factor = unit_factor(index) j = 0 do i = 1, index - 1 j = j + unit_num(i) end do name = unit_name(j+1) else ierror = 1 name = '?' factor = 0.0D+00 end if return end subroutine length_table ( outnum, outunit ) !*****************************************************************************80 ! !! LENGTH_TABLE prints a length measurement conversion table. ! ! Example: ! ! To see what 7 miles is in all measurements, call with ! OUTNUM = 7 ! OUTUNIT = 'MILES'. ! ! Modified: ! ! 11 January 1999 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real ( kind = 8 ) OUTNUM, the number of units to be converted. ! If OUTNUM = 1, then tables are printed "both ways", that is, ! a table is also printed of the values of 1 of all the other ! units in terms of the input unit. ! ! Input, character ( len = * ) OUTUNIT, the units to be used as the base. ! implicit none integer ierror integer index real ( kind = 8 ) infactor character ( len = 30 ) inunit real ( kind = 8 ) outfactor real ( kind = 8 ) outnum character ( len = * ) outunit index = 0 call length_data ( index, outunit, outfactor, ierror ) if ( ierror /= 0 ) then write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'LENGTH_TABLE - Fatal error!' write ( *, '(a)' ) ' Your unit was not recognized!' write ( *, '(a)' ) trim ( outunit ) return end if write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'Lengths:' write ( *, '(a,a)' ) ' Conversion from ', trim ( outunit ) write ( *, '(a)' ) ' ' index = 0 inunit = ' ' do index = index + 1 call length_data ( index, inunit, infactor, ierror ) if ( ierror /= 0 ) then exit end if write ( *, '(g14.6,2x,a,a,2x,g14.6,2x,a)' ) outnum, trim ( outunit ), & ' = ', outfactor/infactor, trim ( inunit ) end do if ( outnum /= 1.0D+00 ) then return end if write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'Lengths:' write ( *, '(a,a)' ) ' Conversion to ', trim ( outunit ) write ( *, '(a)' ) ' ' index = 0 do index = index + 1 call length_data ( index, inunit, infactor, ierror ) if ( ierror /= 0 ) then exit end if write ( *, '(g14.6,2x,a,a,2x,a)' ) infactor/outfactor, trim ( outunit ), & ' = 1 ', trim ( inunit ) end do return end subroutine press_convert ( inu, inunit, outu, outunit ) !*****************************************************************************80 ! !! PRESS_CONVERT converts a pressure measurement into another system. ! ! Example: ! ! To convert 7 pascals to pounds/square inch, call with ! ! INU = 7, ! INUNIT = 'PASCALS', ! OUTUNIT = 'POUNDS/SQUARE INCHE'. ! ! Modified: ! ! 07 January 1999 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real ( kind = 8 ) INU, the number of units of type INUNIT. ! ! Input, character ( len = * ) INUNIT, the original pressure measurement. ! ! Output, real ( kind = 8 ) OUTU, the number of units of type OUTUNIT ! that are equivalent to INU units of type INUNIT. ! ! Input, character ( len = * ) OUTUNIT, the pressure measurement in ! which the converted value is desired. ! implicit none real ( kind = 8 ) divisor real ( kind = 8 ) factor integer ierror integer index real ( kind = 8 ) inu character ( len = * ) inunit real ( kind = 8 ) outu character ( len = * ) outunit index = 0 call press_data ( index, inunit, factor, ierror ) if ( ierror /= 0 ) then write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'PRESS_CONVERT - Warning!' write ( *, '(a)' ) ' Your first unit was not recognized!' write ( *, '(a)' ) trim ( inunit ) outu = 0.0D+00 return end if index = 0 call press_data ( index, outunit, divisor, ierror ) if ( ierror /= 0 ) then write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'PRESS_CONVERT - Warning!' write ( *, '(a)' ) ' Your second unit was not recognized!' write ( *, '(a)' ) trim ( outunit ) outu = 0.0D+00 return end if outu = inu * factor / divisor return end subroutine press_data ( index, name, factor, ierror ) !*****************************************************************************80 ! !! PRESS_DATA returns a pressure conversion factor. ! ! Modified: ! ! 16 January 1999 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input/output, integer INDEX, the index of the unit. ! If the input value of INDEX is 0, then NAME must be specified on ! input, and INDEX will be set on output to the index of the unit. ! ! Input/output, character ( len = * ) NAME, the name of the unit. ! If INDEX is 0, then the user must specify the unit by name on input. ! If INDEX is nonzero, then NAME will be set to the (preferred) name ! of the unit on output. ! ! Output, real ( kind = 8 ) FACTOR, the conversion factor associated with ! the given unit. ! ! Output, integer IERROR, error flag. ! 0, no error occurred. FACTOR was found. ! 1, INDEX was negative or too large. ! 2, INDEX was zero, and NAME was not recognized. ! implicit none integer, parameter :: NUM_NAME = 41 integer, parameter :: NUM_UNIT = 14 real ( kind = 8 ), parameter :: KGMMSQ = 1.0D+00 real ( kind = 8 ), parameter :: MEGA = 1000.0D+00 real ( kind = 8 ), parameter :: MILLI = 1.0D+00 / 1000.0D+00 real ( kind = 8 ), parameter :: ATM = 10333.0D+00 * KGMMSQ real ( kind = 8 ), parameter :: BAR = 10197.0D+00 * KGMMSQ real ( kind = 8 ), parameter :: DYSQCM = 0.01020D+00 * KGMMSQ real ( kind = 8 ), parameter :: FEETWATER = 304.79D+00 * KGMMSQ real ( kind = 8 ), parameter :: GMCMSQ = 10.0D+00 * KGMMSQ real ( kind = 8 ), parameter :: LBSFTSQ = 4.88241D+00 * KGMMSQ real ( kind = 8 ), parameter :: LBSINSQ = 703.07D+00 * KGMMSQ real ( kind = 8 ), parameter :: MERCINCH = 345.31D+00 * KGMMSQ real ( kind = 8 ), parameter :: MERCMM = ( 1.0D+00 / 0.07356D+00 ) * KGMMSQ real ( kind = 8 ), parameter :: PASCAL = 0.10197D+00 * KGMMSQ real ( kind = 8 ), parameter :: FEETAIR = 5.30E-04 * LBSINSQ real ( kind = 8 ), parameter :: MILLIBAR = MILLI * BAR real ( kind = 8 ), parameter :: MEGAPASCAL = MEGA * PASCAL real ( kind = 8 ) factor integer i integer ierror integer index integer j integer jshift logical s_eqi character ( len = * ) name real ( kind = 8 ) unit_factor(NUM_UNIT) integer unit_num(NUM_UNIT) character ( len = 30 ) unit_name(NUM_NAME) data ( unit_name(i), i = 1, NUM_NAME ) / & 'atmospheres', 'atmosphere', 'atm', 'bars', 'bar', & 'dynes/square centimeter', 'dyne/square centimeter', 'dyne/cm**2', & 'feet of air', 'foot of air', 'feet of water', 'foot of water', & 'grams/square centimeter', 'gram/square centimeter', 'gm/cm**2', & 'inches of mercury', 'inch of mercury', 'kilograms/square meter', & 'kilogram/square meter', 'kg/m**2', 'megapascals', 'megapascal', & 'MPa', 'millimeters of mercury', 'millimeter of mercury', & 'pounds/square foot', 'pound/square foot', 'lb/ft**2', & 'pounds/square inch', 'pound/square inch', 'lb/in**2', 'millibars', & 'millibar', 'pascals', 'pascal', 'Pa', 'newtons/square meter', & 'newton/square meter', 'newton/meter**2', 'newtons/meter**2', 'n/m**2' / data ( unit_num(i), i = 1, NUM_UNIT ) / & 3, 2, 3, 2, 2, 3, 2, 3, 3, 2, 3, 3, 2, 8 / data ( unit_factor(i), i = 1, NUM_UNIT ) / & ATM, BAR, DYSQCM, FEETAIR, FEETWATER, GMCMSQ, KGMMSQ, MEGAPASCAL, & MERCINCH, MERCMM, LBSFTSQ, LBSINSQ, MILLIBAR, PASCAL / ierror = 0 if ( index == 0 ) then jshift = 0 do i = 1, NUM_UNIT do j = 1, unit_num(i) if ( s_eqi ( unit_name(j+jshift), name ) ) then index = i factor = unit_factor(i) return end if end do jshift = jshift + unit_num(i) end do if ( index == 0 ) then ierror = 1 end if else if ( index <= NUM_UNIT) then factor = unit_factor(index) j = 0 do i = 1, index - 1 j = j + unit_num(i) end do name = unit_name(j+1) else ierror = 1 name = '?' factor = 0.0D+00 end if return end subroutine press_table ( outnum, outunit ) !*****************************************************************************80 ! !! PRESS_TABLE prints a pressure measurement conversion table. ! ! Example: ! ! To see what 7 pascals is in all measurements, call with ! OUTNUM = 7 ! OUTUNIT = 'PASCALS'. ! ! Modified: ! ! 12 January 1999 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real ( kind = 8 ) OUTNUM, the number of units to be converted. ! If OUTNUM = 1, then tables are printed "both ways", that is, ! a table is also printed of the values of 1 of all the other ! units in terms of the input unit. ! ! Input, character ( len = * ) OUTUNIT, the units to be used as the base. ! implicit none integer ierror integer index real ( kind = 8 ) infactor character ( len = 30 ) inunit real ( kind = 8 ) outfactor real ( kind = 8 ) outnum character ( len = * ) outunit index = 0 call press_data ( index, outunit, outfactor, ierror ) if ( ierror /= 0 ) then write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'PRESS_TABLE - Fatal error!' write ( *, '(a)' ) ' PRESS did not recognize your unit!' write ( *, '(a)' ) trim ( outunit ) return end if write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'Pressures:' write ( *, '(a,a)' ) ' Conversion from ', trim ( outunit ) write ( *, '(a)' ) ' ' index = 0 inunit = ' ' do index = index + 1 call press_data ( index, inunit, infactor, ierror ) if ( ierror /= 0 ) then exit end if write ( *, '(g14.6,2x,a,a,2x,g14.6,2x,a)' ) outnum, trim ( outunit ), & ' = ', outfactor/infactor, trim ( inunit ) end do if ( outnum /= 1.0D+00 ) then return end if write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'Pressures:' write ( *, '(a,a)' ) ' Conversion to ', trim ( outunit ) write ( *, '(a)' ) ' ' index = 0 do index = index + 1 call press_data ( index, inunit, infactor, ierror ) if ( ierror /= 0 ) then exit end if write ( *, '(g14.6,2x,a,a,2x,a)' ) infactor/outfactor, trim ( outunit ), & ' = 1 ', trim ( inunit ) end do return end function s_eqi ( strng1, strng2 ) !*****************************************************************************80 ! !! S_EQI is a case insensitive comparison of two strings for equality. ! ! Example: ! ! STRING_EQI ( 'Anjana', 'ANJANA' ) is .TRUE. ! ! Modified: ! ! 15 April 1999 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, character ( len = * ) STRNG1, STRNG2, the strings to compare. ! ! Output, logical STRING_EQI, the result of the comparison. ! implicit none integer i integer len1 integer len2 integer lenc character s1 character s2 character ( len = * ) strng1 character ( len = * ) strng2 logical s_eqi len1 = len ( strng1 ) len2 = len ( strng2 ) lenc = min ( len1, len2 ) s_eqi = .false. do i = 1, lenc s1 = strng1(i:i) s2 = strng2(i:i) call ch_cap ( s1 ) call ch_cap ( s2 ) if ( s1 /= s2 ) then return end if end do do i = lenc + 1, len1 if ( strng1(i:i) /= ' ' ) then return end if end do do i = lenc + 1, len2 if ( strng2(i:i) /= ' ' ) then return end if end do s_eqi = .true. return end subroutine temp_convert ( inu, inunit, outu, outunit ) !*****************************************************************************80 ! !! TEMP_CONVERT converts a temperature measurement into another system. ! ! Example: ! ! To convert 7 degrees Kelvin to Celsius, call with ! ! INU = 7, ! INUNIT = 'KELVIN', ! OUTUNIT = 'CELSIUS'. ! ! Modified: ! ! 13 January 1999 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real ( kind = 8 ) INU, the number of units of type INUNIT. ! ! Input, character ( len = * ) INUNIT, the original temperature measurement. ! ! Output, real ( kind = 8 ) OUTU, the number of units of type OUTUNIT ! that are equivalent to INU units of type INUNIT. ! ! Input, character ( len = * ) OUTUNIT, the temperature measurement in ! which the converted value is desired. ! implicit none real ( kind = 8 ) ibase integer ierror real ( kind = 8 ) ifactor integer index real ( kind = 8 ) inu character ( len = * ) inunit real ( kind = 8 ) obase real ( kind = 8 ) ofactor real ( kind = 8 ) outu character ( len = * ) outunit index = 0 call temp_data ( index, inunit, ifactor, ibase, ierror ) if ( ierror /= 0 ) then write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEMP_CONVERT - Warning!' write ( *, '(a)' ) ' Your first unit was not recognized!' write ( *, '(a)' ) trim ( inunit ) outu = 0.0D+00 return end if index = 0 call temp_data ( index, outunit, ofactor, obase, ierror ) if ( ierror /= 0 ) then write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEMP_CONVERT - Warning!' write ( *, '(a)' ) ' Your second unit was not recognized!' write ( *, '(a)' ) trim ( outunit ) outu = 0.0D+00 return end if outu = ( ( ifactor * inu + ibase ) - obase ) / ofactor return end subroutine temp_data ( index, name, factor, base, ierror ) !*****************************************************************************80 ! !! TEMP_DATA returns a temperature conversion factor and base. ! ! Modified: ! ! 13 January 1999 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input/output, integer INDEX, the index of the unit. ! If the input value of INDEX is 0, then NAME must be specified on ! input, and INDEX will be set on output to the index of the unit. ! ! Input/output, character ( len = * ) NAME, the name of the unit. ! If INDEX is 0, then the user must specify the unit by name on input. ! If INDEX is nonzero, then NAME will be set to the (preferred) name ! of the unit on output. ! ! Output, real ( kind = 8 ) FACTOR, BASE, the conversion factor and base ! associated with the given unit. ! ! Output, integer IERROR, error flag. ! 0, no error occurred. FACTOR was found. ! 1, INDEX was negative or too large. ! 2, INDEX was zero, and NAME was not recognized. ! implicit none integer, parameter :: NUM_NAME = 27 integer, parameter :: NUM_UNIT = 4 real ( kind = 8 ) base real ( kind = 8 ) factor integer i integer ierror integer index integer j integer jshift character ( len = * ) name logical s_eqi real ( kind = 8 ), save, dimension ( NUM_UNIT ) :: unit_base = & (/ 273.15D+00, 255.37222223D+00, 0.0D+00, 0.0D+00 /) real ( kind = 8 ), save, dimension ( NUM_UNIT ) :: unit_factor = & (/ 1.0D+00, 0.5555555D+00, 1.0D+00, 0.5555555D+00 /) integer, save, dimension ( NUM_UNIT ) :: unit_num = (/ 9, 6, 6, 6 /) character ( len = 30 ) unit_name(NUM_NAME) data ( unit_name(i), i = 1, NUM_NAME ) / & 'degrees Celsius', 'degree Celsius', 'degrees centigrade', & 'degree centigrade', 'degrees C', 'degree C', 'Celsius', & 'centigrade', 'C', 'degrees Fahrenheit', 'degree Fahrenheit', 'degrees F', & 'degree F', 'Fahrenheit', 'F', 'degrees Kelvin', 'degree Kelvin', & 'degrees K', 'degree K', 'Kelvin', 'K', 'degrees Rankin', 'degree Rankin', & 'degrees R', 'degree R', 'Rankin', 'R' / ierror = 0 if ( index == 0 ) then jshift = 0 do i = 1, NUM_UNIT do j = 1, unit_num(i) if ( s_eqi ( unit_name(j+jshift), name ) ) then index = i factor = unit_factor(i) base = unit_base(i) return end if end do jshift = jshift + unit_num(i) end do if ( index == 0 ) then ierror = 1 end if else if ( index <= NUM_UNIT) then factor = unit_factor(index) base = unit_base(index) j = 0 do i = 1, index - 1 j = j + unit_num(i) end do name = unit_name(j+1) else ierror = 1 name = '?' factor = 0.0D+00 base = 0.0D+00 end if return end subroutine temp_table ( outnum, outunit ) !*****************************************************************************80 ! !! TEMP_TABLE prints a temperature measurement conversion table. ! ! Example: ! ! To see what 7 degrees Celsius is in all measurements, call with ! OUTNUM = 7 ! OUTUNIT = 'C'. ! ! Modified: ! ! 13 January 1999 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real ( kind = 8 ) OUTNUM, the number of units to be converted. ! If OUTNUM = 1, then tables are printed "both ways", that is, ! a table is also printed of the values of 1 of all the other ! units in terms of the input unit. ! ! Input, character ( len = * ) OUTUNIT, the units to be used as the base. ! implicit none integer ierror real ( kind = 8 ) inbase integer index real ( kind = 8 ) infactor character ( len = 30 ) inunit real ( kind = 8 ) outbase real ( kind = 8 ) outfactor real ( kind = 8 ) outnum character ( len = * ) outunit real ( kind = 8 ) tk index = 0 call temp_data ( index, outunit, outfactor, outbase, ierror ) if ( ierror /= 0 ) then write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEMP_TABLE - Fatal error!' write ( *, '(a)' ) ' TEMP did not recognize your unit!' write ( *, '(a)' ) trim ( outunit ) return end if tk = outfactor * outnum + outbase write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'Temperature measurements:' write ( *, '(a,a)' ) ' Conversion from ', trim ( outunit ) write ( *, '(a)' ) ' ' index = 0 inunit = ' ' do index = index + 1 call temp_data ( index, inunit, infactor, inbase, ierror ) if ( ierror /= 0 ) then exit end if write ( *, '(g14.6,2x,a,a,2x,g14.6,2x,a)' ) outnum, trim ( outunit ), & ' = ', (tk-inbase)/infactor, trim ( inunit ) end do return end subroutine time_convert ( inu, inunit, outu, outunit ) !*****************************************************************************80 ! !! TIME_CONVERT converts a time measurment into another system. ! ! Example: ! ! To convert 7 hours to minutes, call with ! ! INU = 7, ! INUNIT = 'HOURS', ! OUTUNIT = 'MINUTES'. ! ! Modified: ! ! 07 January 1999 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real ( kind = 8 ) INU, the number of units of type INUNIT. ! ! Input, character ( len = * ) INUNIT, the original time measurement. ! ! Output, real ( kind = 8 ) OUTU, the number of units of type OUTUNIT ! that are equivalent to INU units of type INUNIT. ! ! Input, character ( len = * ) OUTUNIT, the time measurement in ! which the converted value is desired. ! implicit none real ( kind = 8 ) divisor real ( kind = 8 ) factor integer ierror integer index real ( kind = 8 ) inu character ( len = * ) inunit real ( kind = 8 ) outu character ( len = * ) outunit index = 0 call time_data ( index, inunit, factor, ierror ) if ( ierror /= 0 ) then write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TIME_CONVERT - Warning!' write ( *, '(a)' ) ' Your first unit was not recognized!' write ( *, '(a)' ) trim ( inunit ) outu = 0.0D+00 return end if index = 0 call time_data ( index, outunit, divisor, ierror ) if ( ierror /= 0 ) then write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TIME_CONVERT - Warning!' write ( *, '(a)' ) ' Your second unit was not recognized!' write ( *, '(a)' ) trim ( outunit ) outu = 0.0D+00 return end if outu = inu * factor / divisor return end subroutine time_data ( index, name, factor, ierror ) !*****************************************************************************80 ! !! TIME_DATA returns a time conversion factor. ! ! Modified: ! ! 14 January 1999 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input/output, integer INDEX, the index of the unit. ! If the input value of INDEX is 0, then NAME must be specified on ! input, and INDEX will be set on output to the index of the unit. ! ! Input/output, character ( len = * ) NAME, the name of the unit. ! If INDEX is 0, then the user must specify the unit by name on input. ! If INDEX is nonzero, then NAME will be set to the (preferred) name ! of the unit on output. ! ! Output, real ( kind = 8 ) FACTOR, the conversion factor associated with ! the given unit. ! ! Output, integer IERROR, error flag. ! 0, no error occurred. FACTOR was found. ! 1, INDEX was negative or too large. ! 2, INDEX was zero, and NAME was not recognized. ! implicit none integer, parameter :: NUM_NAME = 43 integer, parameter :: NUM_UNIT = 17 real ( kind = 8 ), parameter :: SECOND = 1.0D+00 real ( kind = 8 ), parameter :: MINUTE = 60.0D+00 * SECOND real ( kind = 8 ), parameter :: SIDEDAY = 86164.0D+00 * SECOND real ( kind = 8 ), parameter :: HOUR = 60.0D+00 * MINUTE real ( kind = 8 ), parameter :: MEANMONTH = 43805.0D+00 * MINUTE real ( kind = 8 ), parameter :: DAY = 24.0D+00 * HOUR real ( kind = 8 ), parameter :: ASTROMONTH = 30.6001D+00 * DAY real ( kind = 8 ), parameter :: FORTNIGHT = 14.0D+00 * DAY real ( kind = 8 ), parameter :: LEAPYEAR = 366.0D+00 * DAY real ( kind = 8 ), parameter :: MONTH = 30.0D+00 * DAY real ( kind = 8 ), parameter :: SIDEYEAR = 365.2564D+00 * DAY real ( kind = 8 ), parameter :: TROPYEAR = 365.2422D+00 * DAY ! ! Wasn't the sidereal year 366 days??? ! real ( kind = 8 ), parameter :: WEEK = 7.0D+00 * DAY real ( kind = 8 ), parameter :: YEAR = 365.0D+00 * DAY real ( kind = 8 ), parameter :: DECADE = 10.0D+00 * YEAR real ( kind = 8 ), parameter :: CENTURY = 100.0D+00 * YEAR real ( kind = 8 ), parameter :: MILLENNIUM = 1000.0D+00 * YEAR real ( kind = 8 ) factor integer i integer ierror integer index integer j integer jshift logical s_eqi character ( len = * ) name real ( kind = 8 ) unit_factor(NUM_UNIT) integer unit_num(NUM_UNIT) character ( len = 30 ) unit_name(NUM_NAME) data ( unit_name(i), i = 1, NUM_NAME ) / & 'astronomical months', 'astronomical month', 'centuries', 'century', & 'days', 'day', 'decades', 'decade', 'fortnights', 'fortnight', 'hours', & 'hour', 'hr', 'leap years', 'leap year', 'mean months', 'mean month', & 'millennia', 'millennium', 'millenniums', 'minutes', 'minute', 'min', & '''', 'months', 'month', 'mon', 'seconds', 'second', 'sec', '"', & 'sidereal days', 'sidereal day', 'sidereal years', 'sidereal year', & 'tropical years', 'tropical year', 'weeks', 'week', 'wk', 'years', & 'year', 'yr' / data ( unit_num(i), i = 1, NUM_UNIT ) / & & 2, 2, 2, 2, 2, 3, 2, 2, 3, 4, 3, 4, 2, 2, 2, 3, 3 / data ( unit_factor(i), i = 1, NUM_UNIT ) / & ASTROMONTH, CENTURY, DAY, DECADE, FORTNIGHT, HOUR, LEAPYEAR, & MEANMONTH, MILLENNIUM, MINUTE, MONTH, SECOND, SIDEDAY, SIDEYEAR, & TROPYEAR, WEEK, YEAR / ierror = 0 if ( index == 0 ) then jshift = 0 do i = 1, NUM_UNIT do j = 1, unit_num(i) if ( s_eqi ( unit_name(j+jshift), name ) ) then index = i factor = unit_factor(i) return end if end do jshift = jshift + unit_num(i) end do if ( index == 0 ) then ierror = 1 end if else if ( index <= NUM_UNIT) then factor = unit_factor(index) j = 0 do i = 1, index - 1 j = j + unit_num(i) end do name = unit_name(j+1) else ierror = 1 name = '?' factor = 0.0D+00 end if return end subroutine time_table ( outnum, outunit ) !*****************************************************************************80 ! !! TIME_TABLE prints a time measurement conversion table. ! ! Example: ! ! To see what 7 seconds is in all measurements, call with ! OUTNUM = 7, ! OUTUNIT = 'SECONDS'. ! ! Modified: ! ! 07 January 1999 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real ( kind = 8 ) OUTNUM, the number of units to be converted. ! If OUTNUM = 1, then tables are printed "both ways", that is, ! a table is also printed of the values of 1 of all the other ! units in terms of the input unit. ! ! Input, character ( len = * ) OUTUNIT, the units to be used as the base. ! implicit none integer ierror integer index real ( kind = 8 ) infactor character ( len = 30 ) inunit real ( kind = 8 ) outfactor real ( kind = 8 ) outnum character ( len = * ) outunit index = 0 call time_data ( index, outunit, outfactor, ierror ) if ( ierror /= 0 ) then write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TIME_TABLE - Fatal error!' write ( *, '(a)' ) ' Your unit was not recognized!' write ( *, '(a)' ) trim ( outunit ) return end if write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'Times:' write ( *, '(a,a)' ) ' Conversion from ', trim ( outunit ) write ( *, '(a)' ) ' ' index = 0 inunit = ' ' do index = index + 1 call time_data ( index, inunit, infactor, ierror ) if ( ierror /= 0 ) then exit end if write ( *, '(g14.6,2x,a,a,2x,g14.6,2x,a)' ) outnum, trim ( outunit ), & ' = ', outfactor/infactor, trim ( inunit ) end do if ( outnum /= 1.0D+00 ) then return end if write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'Times:' write ( *,'(a,a)' ) ' Conversion to ', trim ( outunit ) write ( *, '(a)' ) ' ' index = 0 do index = index + 1 call time_data ( index, inunit, infactor, ierror ) if ( ierror /= 0 ) then exit end if write ( *, '(g14.6,2x,a,a,2x,a)' ) infactor/outfactor, trim ( outunit ), & ' = 1 ', trim ( inunit ) end do return end subroutine timestamp ( ) !*****************************************************************************80 ! !! TIMESTAMP prints the current YMDHMS date as a time stamp. ! ! Example: ! ! May 31 2001 9:45:54.872 AM ! ! Modified: ! ! 31 May 2001 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! None ! implicit none character ( len = 8 ) ampm integer d character ( len = 8 ) date integer h integer m integer mm character ( len = 9 ), parameter, dimension(12) :: month = (/ & 'January ', 'February ', 'March ', 'April ', & 'May ', 'June ', 'July ', 'August ', & 'September', 'October ', 'November ', 'December ' /) integer n integer s character ( len = 10 ) time integer values(8) integer y character ( len = 5 ) zone call date_and_time ( date, time, zone, values ) y = values(1) m = values(2) d = values(3) h = values(5) n = values(6) s = values(7) mm = values(8) if ( h < 12 ) then ampm = 'AM' else if ( h == 12 ) then if ( n == 0 .and. s == 0 ) then ampm = 'Noon' else ampm = 'PM' end if else h = h - 12 if ( h < 12 ) then ampm = 'PM' else if ( h == 12 ) then if ( n == 0 .and. s == 0 ) then ampm = 'Midnight' else ampm = 'AM' end if end if end if write ( *, '(a,1x,i2,1x,i4,2x,i2,a1,i2.2,a1,i2.2,a1,i3.3,1x,a)' ) & trim ( month(m) ), d, y, h, ':', n, ':', s, '.', mm, trim ( ampm ) return end subroutine unit1_type ( inunit, type ) !*****************************************************************************80 ! !! UNIT1_TYPE determines the type of measurement represented by a unit. ! ! Modified: ! ! 15 January 1999 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, character ( len = * ) INUNIT, the measurement unit. ! ! Output, character ( len = * ) TYPE, the type of the unit. ! The routine will return the first measurement type it finds ! which includes INUNIT in its list of names. ! If successful, TYPE will be one of 'ANGLE', 'AREA', 'LENGTH', ! 'PRESSURE', 'TEMPERATURE', 'TIME', 'VOLUME', or 'WEIGHT'. ! Otherwise, TYPE will be returned as '?'. ! implicit none real ( kind = 8 ) base real ( kind = 8 ) factor integer ierror integer index character ( len = * ) inunit character ( len = * ) type type = '?' ! ! ANGLE? ! ierror = 0 index = 0 call angle_data ( index, inunit, factor, ierror ) if ( ierror == 0 ) then type = 'ANGLE' return end if ! ! AREA? ! ierror = 0 index = 0 call area_data ( index, inunit, factor, ierror ) if ( ierror == 0 ) then type = 'AREA' return end if ! ! LENGTH? ! ierror = 0 index = 0 call length_data ( index, inunit, factor, ierror ) if ( ierror == 0 ) then type = 'LENGTH' return end if ! ! PRESSURE? ! ierror = 0 index = 0 call press_data ( index, inunit, factor, ierror ) if ( ierror == 0 ) then type = 'PRESSURE' return end if ! ! TEMPERATURE? ! ierror = 0 index = 0 call temp_data ( index, inunit, factor, base, ierror ) if ( ierror == 0 ) then type = 'TEMPERATURE' return end if ! ! TIME? ! ierror = 0 index = 0 call time_data ( index, inunit, factor, ierror ) if ( ierror == 0 ) then type = 'TIME' return end if ! ! VOLUME? ! ierror = 0 index = 0 call volume_data ( index, inunit, factor, ierror ) if ( ierror == 0 ) then type = 'VOLUME' return end if ! ! WEIGHT? ! ierror = 0 index = 0 call weight_data ( index, inunit, factor, ierror ) if ( ierror == 0 ) then type = 'WEIGHT' return end if return end subroutine unit2_type ( inunit, outunit, type ) !*****************************************************************************80 ! !! UNIT2_TYPE determines the type of measurement represented by two units. ! ! Modified: ! ! 15 January 1999 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, character ( len = * ) INUNIT, the input measurement units. ! ! Input, character ( len = * ) OUTUNIT, the units to which the ! measurement is to be converted. ! ! Output, character ( len = * ) TYPE, the type of the unit. ! The routine will return the first measurement type it finds ! which includes both INUNIT and OUTUNIT in its list of names. ! If successful, TYPE will be one of 'ANGLE', 'AREA', 'LENGTH', ! 'PRESSURE', 'TEMPERATURE', 'TIME', 'VOLUME', or 'WEIGHT'. ! Otherwise, TYPE will be returned as '?'. ! implicit none real ( kind = 8 ) base real ( kind = 8 ) factor integer ierror integer index character ( len = * ) inunit character ( len = * ) outunit character ( len = * ) type type = '?' ! ! ANGLE? ! ierror = 0 index = 0 call angle_data ( index, inunit, factor, ierror ) if ( ierror == 0 ) then index = 0 call angle_data ( index, outunit, factor, ierror ) if ( ierror == 0 ) then type = 'ANGLE' return end if end if ! ! AREA? ! ierror = 0 index = 0 call area_data ( index, inunit, factor, ierror ) if ( ierror == 0 ) then index = 0 call area_data ( index, outunit, factor, ierror ) if ( ierror == 0 ) then type = 'AREA' return end if end if ! ! LENGTH? ! ierror = 0 index = 0 call length_data ( index, inunit, factor, ierror ) if ( ierror == 0 ) then index = 0 call length_data ( index, outunit, factor, ierror ) if ( ierror == 0 ) then type = 'LENGTH' return end if end if ! ! PRESSURE? ! ierror = 0 index = 0 call press_data ( index, inunit, factor, ierror ) if ( ierror == 0 ) then index = 0 call press_data ( index, outunit, factor, ierror ) if ( ierror == 0 ) then type = 'PRESSURE' return end if end if ! ! TEMPERATURE? ! ierror = 0 index = 0 call temp_data ( index, inunit, factor, base, ierror ) if ( ierror == 0 ) then index = 0 call temp_data ( index, outunit, factor, base, ierror ) if ( ierror == 0 ) then type = 'TEMPERATURE' return end if end if ! ! TIME? ! ierror = 0 index = 0 call time_data ( index, inunit, factor, ierror ) if ( ierror == 0 ) then index = 0 call time_data ( index, outunit, factor, ierror ) if ( ierror == 0 ) then type = 'TIME' return end if end if ! ! VOLUME? ! ierror = 0 index = 0 call volume_data ( index, inunit, factor, ierror ) if ( ierror == 0 ) then index = 0 call volume_data ( index, outunit, factor, ierror ) if ( ierror == 0 ) then type = 'VOLUME' return end if end if ! ! WEIGHT? ! ierror = 0 index = 0 call weight_data ( index, inunit, factor, ierror ) if ( ierror == 0 ) then index = 0 call weight_data ( index, outunit, factor, ierror ) if ( ierror == 0 ) then type = 'WEIGHT' return end if end if return end subroutine volume_convert ( inu, inunit, outu, outunit ) !*****************************************************************************80 ! !! VOLUME_CONVERT converts a volume measurement into another system. ! ! Example: ! ! To convert 7 gallons to pints, call with ! ! INU = 7, ! INUNIT = 'GALLONS', ! OUTUNIT = 'PINTS'. ! ! Modified: ! ! 07 January 1999 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real ( kind = 8 ) INU, the number of units of type INUNIT. ! ! Input, character ( len = * ) INUNIT, the original volume measurement. ! ! Output, real ( kind = 8 ) OUTU, the number of units of type OUTUNIT ! that are equivalent to INU units of type INUNIT. ! ! Input, character ( len = * ) OUTUNIT, the volume measurement in ! which the converted value is desired. ! implicit none real ( kind = 8 ) divisor real ( kind = 8 ) factor integer ierror integer index real ( kind = 8 ) inu character ( len = * ) inunit real ( kind = 8 ) outu character ( len = * ) outunit index = 0 call volume_data ( index, inunit, factor, ierror ) if ( ierror /= 0 ) then write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'VOLUME_CONVERT - Warning!' write ( *, '(a)' ) ' Your first unit was not recognized!' write ( *, '(a)' ) trim ( inunit ) outu = 0.0D+00 return end if index = 0 call volume_data ( index, outunit, divisor, ierror ) if ( ierror /= 0 ) then write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'VOLUME_CONVERT - Warning!' write ( *, '(a)' ) ' Your second unit was not recognized!' write ( *, '(a)' ) trim ( outunit ) outu = 0.0D+00 return end if outu = inu * factor / divisor return end subroutine volume_data ( index, name, factor, ierror ) !*****************************************************************************80 ! !! VOLUME_DATA returns a volume conversion factor. ! ! Modified: ! ! 28 April 1999 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input/output, integer INDEX, the index of the unit. ! If the input value of INDEX is 0, then NAME must be specified on ! input, and INDEX will be set on output to the index of the unit. ! ! Input/output, character ( len = * ) NAME, the name of the unit. ! If INDEX is 0, then the user must specify the unit by name on input. ! If INDEX is nonzero, then NAME will be set to the (preferred) name ! of the unit on output. ! ! Output, real ( kind = 8 ) FACTOR, the conversion factor associated with ! the given unit. ! ! Output, integer IERROR, error flag. ! 0, no error occurred. FACTOR was found. ! 1, INDEX was negative or too large. ! 2, INDEX was zero, and NAME was not recognized. ! implicit none integer, parameter :: NUM_NAME = 216 integer, parameter :: NUM_UNIT = 65 ! ! Note, unimplemented so far: ! 1 Runlet = 18 gallons. ! real ( kind = 8 ), parameter :: CENTI = 1.0D+00 / 100.0D+00 real ( kind = 8 ), parameter :: METER = 1.0D+00 real ( kind = 8 ), parameter :: BARRELD = 0.11562D+00 * METER**3 real ( kind = 8 ), parameter :: CENTIMETER = CENTI * METER real ( kind = 8 ), parameter :: INCH = 0.0254D+00 * METER real ( kind = 8 ), parameter :: LITER = 0.001000028D+00 * METER**3 real ( kind = 8 ), parameter :: CUBIC_METER = METER**3 real ( kind = 8 ), parameter :: CUBIC_CM = CENTIMETER**3 real ( kind = 8 ), parameter :: FOOT = 12.0D+00 * INCH real ( kind = 8 ), parameter :: CUBIC_INCH = INCH**3 real ( kind = 8 ), parameter :: CORD = 128.0D+00 * FOOT**3 real ( kind = 8 ), parameter :: CORDFOOT = 16.0D+00 * FOOT**3 real ( kind = 8 ), parameter :: BRITISH_FOOT = 1.0000028D+00 * FOOT real ( kind = 8 ), parameter :: CUBIC_FOOT = FOOT**3 real ( kind = 8 ), parameter :: REGISTER_TON = 100.0D+00 * FOOT**3 real ( kind = 8 ), parameter :: YARD = 3.0D+00 * FOOT real ( kind = 8 ), parameter :: CUBIC_BRITISH_FOOT = BRITISH_FOOT**3 real ( kind = 8 ), parameter :: ROOD = 1210.0D+00 * YARD**2 real ( kind = 8 ), parameter :: CUBIC_YARD = YARD**3 real ( kind = 8 ), parameter :: ACRE = 4.0D+00 * ROOD real ( kind = 8 ), parameter :: ACRE_FOOT = ACRE * FOOT real ( kind = 8 ), parameter :: ACRE_INCH = ACRE * INCH real ( kind = 8 ), parameter :: BRITISH_MINIM = 0.00000005919D+00 * METER**3 real ( kind = 8 ), parameter :: BRITISH_DRAM = 60.0D+00 * BRITISH_MINIM real ( kind = 8 ), parameter :: BRITISH_TEASPOON = 80.0D+00 * BRITISH_MINIM real ( kind = 8 ), parameter :: BRITISH_TABLESPOON = 4.0D+00 * BRITISH_DRAM real ( kind = 8 ), parameter :: BRITISH_OUNCE = 2.0D+00 * BRITISH_TABLESPOON real ( kind = 8 ), parameter :: BRITISH_GILL = 5.0D+00 * BRITISH_OUNCE real ( kind = 8 ), parameter :: BRITISH_CUP = 2.0D+00 * BRITISH_GILL real ( kind = 8 ), parameter :: BRITISH_PINT = 2.0D+00 * BRITISH_CUP real ( kind = 8 ), parameter :: BRITISH_QUART = 2.0D+00 * BRITISH_PINT real ( kind = 8 ), parameter :: BRITISH_POTTLE = 2.0D+00 * BRITISH_QUART real ( kind = 8 ), parameter :: BRITISH_GALLON = 2.0D+00 * BRITISH_POTTLE real ( kind = 8 ), parameter :: BRITISH_PECK = 2.0D+00 * BRITISH_GALLON real ( kind = 8 ), parameter :: BRITISH_BUCKET = 2.0D+00 * BRITISH_PECK real ( kind = 8 ), parameter :: BRITISH_BUSHEL = 2.0D+00 * BRITISH_BUCKET real ( kind = 8 ), parameter :: BRITISH_FIRKIN = 9.0D+00 * BRITISH_GALLON real ( kind = 8 ), parameter :: BRITISH_KILDERKIN = 18.0D+00 * BRITISH_GALLON real ( kind = 8 ), parameter :: BRITISH_CHALDRON = 32.0D+00 * BRITISH_BUSHEL real ( kind = 8 ), parameter :: BRITISH_BARREL = 31.5D+00 * BRITISH_GALLON real ( kind = 8 ), parameter :: BRITISH_TIERCE = 42.0D+00 * BRITISH_GALLON real ( kind = 8 ), parameter :: BRITISH_HOGSHEAD = 2.0D+00 * BRITISH_BARREL real ( kind = 8 ), parameter :: BRITISH_PIPE = 2.0D+00 * BRITISH_HOGSHEAD real ( kind = 8 ), parameter :: BRITISH_TUN = 2.0D+00 * BRITISH_PIPE real ( kind = 8 ), parameter :: BRITISH_PUNCHEON = 70.0D+00 * BRITISH_GALLON real ( kind = 8 ), parameter :: BRITISH_BEER_BUTT = 108.0D+00 * BRITISH_GALLON real ( kind = 8 ), parameter :: MINIMF = 0.00000006161D+00 * METER**3 real ( kind = 8 ), parameter :: DRAMF = 60.0D+00 * MINIMF real ( kind = 8 ), parameter :: TSPF = 80.0D+00 * MINIMF real ( kind = 8 ), parameter :: TBSF = 4.0D+00 * DRAMF real ( kind = 8 ), parameter :: OUNCEF = 2.0D+00 * TBSF real ( kind = 8 ), parameter :: GILLF = 4.0D+00 * OUNCEF real ( kind = 8 ), parameter :: CUPF = 2.0D+00 * GILLF real ( kind = 8 ), parameter :: PINTF = 2.0D+00 * CUPF real ( kind = 8 ), parameter :: QUARTF = 2.0D+00 * PINTF real ( kind = 8 ), parameter :: POTTLEF = 2.0D+00 * QUARTF real ( kind = 8 ), parameter :: GALLONF = 2.0D+00 * POTTLEF real ( kind = 8 ), parameter :: BUCKETF = 4.0D+00 * GALLONF real ( kind = 8 ), parameter :: FIRKINF = 9.0D+00 * GALLONF real ( kind = 8 ), parameter :: KILDERKINF = 18.0D+00 * GALLONF real ( kind = 8 ), parameter :: BARRELF = 31.5D+00 * GALLONF real ( kind = 8 ), parameter :: TIERCEF = 42.0D+00 * GALLONF real ( kind = 8 ), parameter :: HOGF = 2.0D+00 * BARRELF real ( kind = 8 ), parameter :: PIPEF = 2.0D+00 * HOGF real ( kind = 8 ), parameter :: TUNF = 2.0D+00 * PIPEF real ( kind = 8 ), parameter :: PUNCHF = 70.0D+00 * GALLONF real ( kind = 8 ), parameter :: OIL_BARREL = 42.0D+00 * GALLONF real ( kind = 8 ), parameter :: PINTD = 33.6003D+00 * INCH**3 real ( kind = 8 ), parameter :: QUARTD = 2.0D+00 * PINTD real ( kind = 8 ), parameter :: GALLOND = 4.0D+00 * QUARTD real ( kind = 8 ), parameter :: PECKD = 2.0D+00 * GALLOND real ( kind = 8 ), parameter :: BUCKETD = 2.0D+00 * PECKD real ( kind = 8 ), parameter :: BUSHD = 2.0D+00 * BUCKETD real ( kind = 8 ), parameter :: CHALDRON = 36.0D+00 * BUSHD real ( kind = 8 ) factor integer i integer ierror integer index integer j integer jshift logical s_eqi character ( len = * ) name real ( kind = 8 ) unit_factor(NUM_UNIT) integer unit_num(NUM_UNIT) character ( len = 30 ) unit_name(NUM_NAME) data ( unit_name(i), i = 1, 50 ) / & 'acre feet', 'acre foot', 'acre inches', 'acre inch', 'British barrels', & 'British barrel', 'British beer butts', 'British beer butt', 'beer butts', & 'beer butt', 'British buckets', 'British bucket', 'British bushels', & 'British bushel', 'British chaldrons', 'British chaldron', 'British cups', & 'British cup', 'British drams', 'British dram', 'drachms', 'drachm', & 'British firkins', 'British firkin', 'British gallons', 'British gallon', & 'Imperial gallons', 'Imperial gallon', 'British gills', 'British gill', & 'British noggins', 'British noggin', 'British hogsheads', & 'British hogshead', 'British kilderkins', 'British kilderkin', & 'British minims', 'British minim', 'British ounces', 'British ounce', & 'British pecks', 'British peck', 'British pints', 'British pint', & 'British pipes', 'British pipe', 'British wine butts', & 'British wine butt', 'British butts', 'British butt' / data ( unit_name(i), i = 51, 100 ) / & 'British pottles', 'British pottle', 'British puncheons', & 'British puncheon', 'British quarts', 'British quart', & 'British tablespoons', 'British tablespoon', 'British teaspoons', & 'British teaspoon', 'British tierces', 'British tierce', 'British tuns', & 'British tun', 'cords', 'cord', 'cord feet', 'cord foot', & 'cubic British feet', 'cubic British foot', 'cubic centimeters', & 'cubic centimeter', 'cm**3', 'cc', 'cubic feet', 'cubic foot', 'ft**3', & 'cubic inches', 'cubic inch', 'in**3', 'cubic meters', 'cubic meter', & 'steres', 'stere', 'm**3', 'cubic yards', 'cubic yard', 'yd**3', & 'liters', 'liter', 'oil barrels', 'oil barrel', 'register tons', & 'register ton', 'US chaldrons', 'US chaldron', 'chaldrons', & 'chaldron', 'US dry barrels', 'US dry barrel' / data ( unit_name(i), i = 101, 150 ) / & 'US dry buckets', 'US dry bucket', 'US dry bushels', 'US dry bushel', & 'US bushels', 'US bushel', 'bushels', 'bushel', 'US dry gallons', & 'US dry gallon', 'US dry pecks', 'US dry peck', 'US pecks', 'US peck', & 'pecks', 'peck', 'US dry pints', 'US dry pint', 'US dry quarts', & 'US dry quart', 'US firkins', 'US firkin', 'firkins', 'firkin', & 'US gills', 'US gill', 'US noggins', 'US noggin', 'noggins', & 'noggin', 'gills', 'gill', 'US hogsheads', 'US hogshead', & 'US kilderkins', 'US kilderkin', 'kilderkins', 'kilderkin', & 'US liquid barrels', 'US liquid barrel', 'US barrels', 'US barrel', & 'barrels', 'barrel', 'US liquid buckets', 'US liquid bucket', & 'US buckets', 'US bucket', 'buckets', 'bucket' / data ( unit_name(i), i = 151, 200 ) / & 'US liquid cups', 'US liquid cup', 'cups', 'cup', 'US liquid drams', & 'US liquid dram', 'drams', 'dram', 'US liquid gallons', & 'US liquid gallon', 'US gallons', 'US gallon', 'gallons', 'gallon', & 'US liquid ounces', 'US liquid ounce', 'US ounces', 'US ounce', 'ounces', & 'ounce', 'US liquid pints', 'US liquid pint', 'US pints', 'US pint', & 'pints', 'pint', 'US liquid quarts', 'US liquid quart', 'US quarts', & 'US quart', 'quarts', 'quart', 'US minims', 'US minim', 'minims', & 'minim', 'US pipes', 'US pipe', 'pipes', 'pipe', 'US pottles', & 'US pottle', 'pottles', 'pottle', 'US puncheons', 'US puncheon', & 'puncheons', 'puncheon', 'US tablespoons', 'US tablespoon' / data ( unit_name(i), i = 201, NUM_NAME ) / & 'tablespoons', 'tablespoon', 'tbs', 'US teaspoons', 'US teaspoon', & 'teaspoons', 'teaspoon', 'tsp', 'US tierces', 'US tierce', 'tierces', & 'tierce', 'US tuns', 'US tun', 'tuns', 'tun' / data ( unit_num(i), i = 1, NUM_UNIT ) / & 2, 2, 2, 4, 2, 2, 2, 2, 4, 2, 4, 4, 2, 2, 2, 2, 2, 2, 6, 2, & 2, 2, 2, 2, 2, 2, 2, 2, 2, 4, 3, 3, 5, 3, 2, 2, 2, 2, 2, 2, & 6, 2, 6, 2, 2, 4, 8, 2, 4, 6, 6, 4, 4, 6, 6, 6, 6, 4, 4, 4, & 4, 4, 4, 4, 4 / data ( unit_factor(i), i = 1, NUM_UNIT ) / & ACRE_FOOT, ACRE_INCH, BRITISH_BARREL, BRITISH_BEER_BUTT, & BRITISH_BUCKET, BRITISH_BUSHEL, BRITISH_CHALDRON, BRITISH_CUP, & BRITISH_DRAM, BRITISH_FIRKIN, BRITISH_GALLON, BRITISH_GILL, & BRITISH_HOGSHEAD, BRITISH_KILDERKIN, BRITISH_MINIM, BRITISH_OUNCE, & BRITISH_PECK, BRITISH_PINT, BRITISH_PIPE, BRITISH_POTTLE, & BRITISH_PUNCHEON, BRITISH_QUART, BRITISH_TABLESPOON, BRITISH_TEASPOON, & BRITISH_TIERCE, BRITISH_TUN, CORD, CORDFOOT, CUBIC_BRITISH_FOOT, & CUBIC_CM, CUBIC_FOOT, CUBIC_INCH, CUBIC_METER, CUBIC_YARD, LITER, & OIL_BARREL, REGISTER_TON, CHALDRON, BARRELD, BUCKETD, BUSHD, GALLOND, & PECKD, PINTD, QUARTD, FIRKINF, GILLF, HOGF, KILDERKINF, BARRELF, & BUCKETF, CUPF, DRAMF, GALLONF, OUNCEF, PINTF, QUARTF, MINIMF, PIPEF, & POTTLEF, PUNCHF, TBSF, TSPF, TIERCEF, TUNF / ierror = 0 if ( index == 0 ) then jshift = 0 do i = 1, NUM_UNIT do j = 1, unit_num(i) if ( s_eqi ( unit_name(j+jshift), name ) ) then index = i factor = unit_factor(i) return end if end do jshift = jshift + unit_num(i) end do if ( index == 0 ) then ierror = 1 end if else if ( index <= NUM_UNIT) then factor = unit_factor(index) j = 0 do i = 1, index - 1 j = j + unit_num(i) end do name = unit_name(j+1) else ierror = 1 name = '?' factor = 0.0D+00 end if return end subroutine volume_table ( outnum, outunit ) !*****************************************************************************80 ! !! VOLUME_TABLE prints a volume measurement conversion table. ! ! Example: ! ! To see what 7 liters is in all measurements, call with ! OUTNUM = 7 ! OUTUNIT = 'LITERS'. ! ! Modified: ! ! 07 January 1999 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real ( kind = 8 ) OUTNUM, the number of units to be converted. ! If OUTNUM = 1, then tables are printed "both ways", that is, ! a table is also printed of the values of 1 of all the other ! units in terms of the input unit. ! ! Input, character ( len = * ) OUTUNIT, the units to be used as the base. ! implicit none integer ierror integer index real ( kind = 8 ) infactor character ( len = 30 ) inunit real ( kind = 8 ) outfactor real ( kind = 8 ) outnum character ( len = * ) outunit index = 0 call volume_data ( index, outunit, outfactor, ierror ) if ( ierror /= 0 ) then write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'VOLUME_TABLE - Fatal error!' write ( *, '(a)' ) ' Your unit was not recognized!' write ( *, '(a)' ) trim ( outunit ) return end if write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'Volumes:' write ( *, '(a,a)' ) ' Conversion from ', trim ( outunit ) write ( *, '(a)' ) ' ' index = 0 inunit = ' ' do index = index + 1 call volume_data ( index, inunit, infactor, ierror ) if ( ierror /= 0 ) then exit end if write ( *, '(g14.6,2x,a,a,2x,g14.6,2x,a)' ) outnum, trim ( outunit ), & ' = ', outfactor/infactor, trim ( inunit ) end do if ( outnum /= 1.0D+00 ) then return end if write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'Volumes:' write ( *, '(a,a)' ) ' Conversion to ', trim ( outunit ) write ( *, '(a)' ) ' ' index = 0 do index = index + 1 call volume_data ( index, inunit, infactor, ierror ) if ( ierror /= 0 ) then exit end if write ( *, '(g14.6,2x,a,a,2x,a)' ) infactor/outfactor, trim ( outunit ), & ' = 1 ', trim ( inunit ) end do return end subroutine weight_convert ( inu, inunit, outu, outunit ) !*****************************************************************************80 ! !! WEIGHT_CONVERT converts a weight measurement into another system. ! ! Example: ! ! To convert 7 pounds to ounces, call with ! ! INU = 7, ! INUNIT = 'POUNDS', ! OUTUNIT = 'OUNCES'. ! ! Modified: ! ! 07 January 1999 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real ( kind = 8 ) INU, the number of units of type INUNIT. ! ! Input, character ( len = * ) INUNIT, the original weight measurement. ! ! Output, real ( kind = 8 ) OUTU, the number of units of type OUTUNIT ! that are equivalent to INU units of type INUNIT. ! ! Input, character ( len = * ) OUTUNIT, the weight measurement in ! which the converted value is desired. ! implicit none real ( kind = 8 ) divisor real ( kind = 8 ) factor integer ierror integer index real ( kind = 8 ) inu character ( len = * ) inunit real ( kind = 8 ) outu character ( len = * ) outunit index = 0 call weight_data ( index, inunit, factor, ierror ) if ( ierror /= 0 ) then write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'WEIGHT_CONVERT - Warning!' write ( *, '(a)' ) ' Your first unit was not recognized!' write ( *, '(a)' ) trim ( inunit ) outu = 0.0D+00 return end if index = 0 call weight_data ( index, outunit, divisor, ierror ) if ( ierror /= 0 ) then write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'WEIGHT_CONVERT - Warning!' write ( *, '(a)' ) ' Your second unit was not recognized!' write ( *, '(a)' ) trim ( outunit ) outu = 0.0D+00 return end if outu = inu * factor / divisor return end subroutine weight_data ( index, name, factor, ierror ) !*****************************************************************************80 ! !! WEIGHT_DATA returns a weight conversion factor. ! ! Modified: ! ! 28 April 1999 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input/output, integer INDEX, the index of the unit. ! If the input value of INDEX is 0, then NAME must be specified on ! input, and INDEX will be set on output to the index of the unit. ! ! Input/output, character ( len = * ) NAME, the name of the unit. ! If INDEX is 0, then the user must specify the unit by name on input. ! If INDEX is nonzero, then NAME will be set to the (preferred) name ! of the unit on output. ! ! Output, real ( kind = 8 ) FACTOR, the conversion factor associated with ! the given unit. ! ! Output, integer IERROR, error flag. ! 0, no error occurred. FACTOR was found. ! 1, INDEX was negative or too large. ! 2, INDEX was zero, and NAME was not recognized. ! implicit none integer, parameter :: NUM_NAME = 115 integer, parameter :: NUM_UNIT = 40 real ( kind = 8 ), parameter :: GRAM = 1.0D+00 real ( kind = 8 ), parameter :: MILLI = 1.0D+00 / 1000.0D+00 real ( kind = 8 ), parameter :: KILO = 1000.0D+00 real ( kind = 8 ), parameter :: MEGA = 1000000.0D+00 real ( kind = 8 ), parameter :: ASSAY_TON = 29.17D+00 * GRAM real ( kind = 8 ), parameter :: ATOM = 1.661E-24 * GRAM real ( kind = 8 ), parameter :: AVOGRAM = 1.66036E-24 * GRAM real ( kind = 8 ), parameter :: DYNE = 0.00101972D+00 * GRAM real ( kind = 8 ), parameter :: KILOGRAM = KILO * GRAM real ( kind = 8 ), parameter :: MEGAGRAM = MEGA * GRAM real ( kind = 8 ), parameter :: METRIC_CARAT = 0.2D+00 * GRAM real ( kind = 8 ), parameter :: METRIC_GRAIN = 0.050D+00 * GRAM real ( kind = 8 ), parameter :: METRIC_QUINTAL = 100000.0D+00 * GRAM real ( kind = 8 ), parameter :: MILLIGRAM = MILLI * GRAM real ( kind = 8 ), parameter :: NEWTON = 101.97D+00 * GRAM real ( kind = 8 ), parameter :: POUNDAL = 14.0981D+00 * GRAM real ( kind = 8 ), parameter :: GRAIN = ( 453.5924D+00 / 7000.0D+00 ) * GRAM real ( kind = 8 ), parameter :: DRAM = 1.771845D+00 * GRAM real ( kind = 8 ), parameter :: PENNY = 24.0D+00 * GRAIN real ( kind = 8 ), parameter :: SCRUPLE = 20.0D+00 * GRAIN real ( kind = 8 ), parameter :: TROY_DRAM = 60.0D+00 * GRAIN real ( kind = 8 ), parameter :: TROY_OUNCE = 8.0D+00 * TROY_DRAM real ( kind = 8 ), parameter :: TROY_POUND = 12.0D+00 * TROY_OUNCE real ( kind = 8 ), parameter :: APO_DRAM = 3.0D+00 * SCRUPLE real ( kind = 8 ), parameter :: APO_OUNCE = 8.0D+00 * APO_DRAM real ( kind = 8 ), parameter :: APO_POUND = 12.0D+00 * APO_OUNCE real ( kind = 8 ), parameter :: OUNCE = 16.0D+00 * DRAM real ( kind = 8 ), parameter :: POUND = 7000.0D+00 * GRAIN real ( kind = 8 ), parameter :: BRICK = 120.0D+00 * POUND real ( kind = 8 ), parameter :: CEMENT = 376.0D+00 * POUND real ( kind = 8 ), parameter :: SAND = 2700.0D+00 * POUND real ( kind = 8 ), parameter :: SLUG = 32.174D+00 * POUND real ( kind = 8 ), parameter :: WATER = 62.37D+00 * POUND real ( kind = 8 ), parameter :: CLOVE = 8.0D+00 * POUND real ( kind = 8 ), parameter :: STONE = 14.0D+00 * POUND real ( kind = 8 ), parameter :: LONG_QUARTER = 2.0D+00 * STONE real ( kind = 8 ), parameter :: LONG_HWT = 4.0D+00 * LONG_QUARTER real ( kind = 8 ), parameter :: LONG_TON = 20.0D+00 * LONG_HWT real ( kind = 8 ), parameter :: SHORT_QUARTER = 25.0D+00 * POUND real ( kind = 8 ), parameter :: SHORT_HWT = 4.0D+00 * SHORT_QUARTER real ( kind = 8 ), parameter :: SHORT_TON = 20.0D+00 * SHORT_HWT real ( kind = 8 ), parameter :: KILOTON = KILO * SHORT_TON real ( kind = 8 ), parameter :: MEGATON = MEGA * SHORT_TON real ( kind = 8 ) factor integer i integer ierror integer index integer j integer jshift logical s_eqi character ( len = * ) name real ( kind = 8 ) unit_factor(NUM_UNIT) integer unit_num(NUM_UNIT) character ( len = 30 ) unit_name(NUM_NAME) data ( unit_name(i), i = 1, 50 ) / & 'apothecary drams', 'apothecary dram', 'apothecary ounces', & 'apothecary ounces', 'apothecary pounds', 'apothecary pound', & 'assay ton', 'assay tons', 'atomic masses', 'atomic mass', 'avograms', & 'avogram', 'cement barrels', 'cement barrel', 'cloves', 'clove', & 'cubic feet of brick', 'cubic foot of brick', 'cubic feet of water', & 'cubic foot of water', 'cubic yards of sand', 'cubic yard of sand', & 'drams', 'dram', 'avoirdupois drams', 'avoirdupois dram', 'dynes', & 'dyne', 'grains', 'grain', 'grams', 'gram', 'gm', 'kilograms', & 'kilogram', 'kg', 'kilotons', 'kiloton', 'long hundredweights', & 'long hundredweight', 'British quintals', 'British quintal', 'centners', & 'centner', 'long hwt', 'long quarters', 'long quarter', 'long tons', & 'long ton', 'Megatons' / data ( unit_name(i), i = 51, NUM_NAME ) / & 'Megaton', 'metric carats', 'metric carat', 'metric grains', & 'metric grain', 'metric quintals', 'metric quintal', 'metric tons', & 'metric ton', 'tonnes', 'tonne', 'Megagrams', 'Megagram', 'Mgm', & 'milligrams', 'milligram', 'mg', 'newtons', 'newton', 'n', 'ounces', & 'ounce', 'avoirdupois ounces', 'avoirdupois ounce', 'oz', 'pennyweights', & 'pennyweight', 'pwt', 'pounds', 'pound', 'avoirdupois pounds', & 'avoirdupois pound', 'lb', 'poundals', 'poundal', 'scruples', 'scruple', & 'short hundredweights', 'short hundredweight', 'hundredweights', & 'hundredweight', 'centals', 'cental', 'hwt', 'short hwt', 'US quintals', & 'US quintal', 'short quarters', 'short quarter', 'quarters', 'quarter', & 'short tons', 'short ton', 'tons', 'ton', 'slugs', 'slug', 'stones', & 'stone', 'troy drams', 'troy dram', 'troy ounces', 'troy ounce', & 'troy pounds', 'troy pound' / data ( unit_num(i), i = 1, NUM_UNIT ) / & 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 4, 2, 2, 3, 3, 2, 7, 2, 2, & 2, 2, 2, 2, 7, 3, 3, 5, 3, 5, 2, 2, 10, 4, 4, 2, 2, 2, 2, 2 / data ( unit_factor(i), i = 1, NUM_UNIT ) / & APO_DRAM, APO_OUNCE, APO_POUND, ASSAY_TON, ATOM, AVOGRAM, CEMENT, & CLOVE, BRICK, WATER, SAND, DRAM, DYNE, GRAIN, GRAM, KILOGRAM, & KILOTON, LONG_HWT, LONG_QUARTER, LONG_TON, MEGATON, METRIC_CARAT, & METRIC_GRAIN, METRIC_QUINTAL, MEGAGRAM, MILLIGRAM, NEWTON, OUNCE, & PENNY, POUND, POUNDAL, SCRUPLE, SHORT_HWT, SHORT_QUARTER, SHORT_TON, & SLUG, STONE, TROY_DRAM, TROY_OUNCE, TROY_POUND / ierror = 0 if ( index == 0 ) then jshift = 0 do i = 1, NUM_UNIT do j = 1, unit_num(i) if ( s_eqi ( unit_name(j+jshift), name ) ) then index = i factor = unit_factor(i) return end if end do jshift = jshift + unit_num(i) end do if ( index == 0 ) then ierror = 1 end if else if ( index <= NUM_UNIT) then factor = unit_factor(index) j = 0 do i = 1, index - 1 j = j + unit_num(i) end do name = unit_name(j+1) else ierror = 1 name = '?' factor = 0.0D+00 end if return end subroutine weight_table ( outnum, outunit ) !*****************************************************************************80 ! !! WEIGHT_TABLE prints a weight measurement conversion table. ! ! Example: ! ! To see what 7 ounces is in all measurements, call with ! OUTNUM = 7 ! OUTUNIT = 'OUNCES'. ! ! Modified: ! ! 07 January 1999 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real ( kind = 8 ) OUTNUM, the number of units to be converted. ! If OUTNUM = 1, then tables are printed "both ways", that is, ! a table is also printed of the values of 1 of all the other ! units in terms of the input unit. ! ! Input, character ( len = * ) OUTUNIT, the units to be used as the base. ! implicit none integer ierror integer index real ( kind = 8 ) infactor character ( len = 30 ) inunit real ( kind = 8 ) outfactor real ( kind = 8 ) outnum character ( len = * ) outunit index = 0 call weight_data ( index, outunit, outfactor, ierror ) if ( ierror /= 0 ) then write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'WEIGHT_TABLE - Fatal error!' write ( *, '(a)' ) ' Your unit was not recognized!' write ( *, '(a)' ) trim ( outunit ) return end if write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'Weights:' write ( *, '(a,a)' ) ' Conversion from ', trim ( outunit ) write ( *, '(a)' ) ' ' index = 0 inunit = ' ' do index = index + 1 call weight_data ( index, inunit, infactor, ierror ) if ( ierror /= 0 ) then exit end if write ( *, '(g14.6,2x,a,a,2x,g14.6,2x,a)' ) outnum, trim ( outunit ), & ' = ', outfactor/infactor, trim ( inunit ) end do if ( outnum /= 1.0D+00 ) then return end if write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'Weights:' write ( *, '(a,a)' ) ' Conversion to ', trim ( outunit ) write ( *, '(a)' ) ' ' index = 0 do index = index + 1 call weight_data ( index, inunit, infactor, ierror ) if ( ierror /= 0 ) then exit end if write ( *, '(g14.6,2x,a,a,2x,a)' ) infactor/outfactor, trim ( outunit ), & ' = 1 ', trim ( inunit ) end do return end