subroutine aptcang (a1, am1, as1, au1, tol,
& deg, grad, rad, adeg, am2, as2, nerr)
ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c SUBROUTINE APTCANG
c
c call aptcang (a1, am1, as1, au1, tol,
c & deg, grad, rad, adeg, am2, as2, nerr)
c
c Version: aptcang Updated 2000 August 8 13:45.
c aptcang Originated 2000 July 18 16:00.
c
c Author: Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123.
c
c
c Purpose: For angle a1 or angle a1, am1 and as1, in units au1 = "degrees",
c "grads", "radians" or "dms" (degrees, arc minutes, arc seconds),
c to return deg in degrees, grad in grads, rad in radians, and
c adeg, am2 and as2 in degrees, arc minutes and arc seconds,
c respectively.
c
c The absolute value of the input angle, in degrees, must not
c exceed the largest machine integer.
c
c Degrees, arc degrees, arc minutes and arc seconds will be
c changed to the nearest integer if the difference is less than
c the estimated error in the calculation, based on tol.
c
c An input error is indicated by a nonzero value of nerr.
c
c Input: a1, (am1, as1), au1, tol.
c
c Output: deg, grad, rad, adeg, am2, as2, nerr.
c
c Glossary:
c
c a1 Input Input angle (a real number). Units are:
c degrees if au1 is "degrees",
c grads if au1 is "grads",
c radians if au1 is "radians",
c degrees (a whole number) if au1 is "dms".
c
c adeg Output Output degrees (a real whole number). The remaining
c part of the angle is given by am2 and as2
c
c am1 Input Input arc minutes if au1 is "dms", Otherwise, null.
c
c am2 Output Output arc minutes (a real whole number).
c
c as1 Input Input arc seconds if au1 is "dms", Otherwise, null.
c
c as2 Output Output arc seconds (a real number).
c
c au1 Input Indicates the input angle units:
c "degrees" for a1 in degrees, am1 and as1 null.
c "radians" for a1 in radians, am1 and as1 null.
c "grads " for a1 in grads , am1 and as1 null.
c "dms " for a1 in degrees, am1 in arc minutes, and
c as1 in arc seconds.
c Synonyms: [degrees, degree, deg],
c [radians, rads, rad], [grads, grad].
c
c deg Output The equivalent of the input angle in degrees (decimal).
c Truncated to the nearest integer if within precision
c tol of that integer. A full circle is 360 degrees.
c The absolute value can not exceed the largest machine
c integer.
c
c grad Output The equivalent of the input angle in grads (decimal).
c A full circle is 400 grads.
c
c nerr Output Indicates an input error, if not 0. Integer.
c 1 if au1 is not "degrees", "radians", "grads" or
c "dms".
c 2 if the absolute value of the angle, in degrees,
c exceeds the largest machine integer.
c
c rad Output The equivalent of the input angle in radians (decimal).
c A full circle is 2 * pi radians.
c
c tol Input Numerical tolerance limit. Recommend 1.e-5 to 1.e-11
c for machines with 64-bit floating point numbers.
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
ccend.
implicit none
c.... Input character variables.
character*8 au1 ! Input angle units.
character*8 au2 ! Output angle units.
c.... Other variables.
integer ideg, imin, isec, nerr
real a1, adeg, am1, am2, as1, as2, deg, grad, pi, rad, tol
real xdeg, xmin, xsec
cbugc***DEBUG begins.
cbug 9901 format (/ 'aptcang converting angles from ',a8,
cbug & '. tol =',1pe22.14 /
cbug & 'a1 = ',1pe22.14)
cbug 9902 format (' am1,as1 = ',22x,1p2e22.14)
cbug write ( 3, 9901) au1, tol, a1
cbug if (au1 .eq. 'dms') then
cbug write ( 3, 9902) am1, as1
cbug endif
cbugc***DEBUG ends.
c.... Initialize.
c.... Mathematical constant, pi.
pi = 3.14159265358979323
c.... Test for input errors.
nerr = 0
if ((au1 .ne. 'degrees') .and.
& (au1 .ne. 'degree') .and.
& (au1 .ne. 'deg') .and.
& (au1 .ne. 'grads') .and.
& (au1 .ne. 'grad') .and.
& (au1 .ne. 'radians') .and.
& (au1 .ne. 'rads') .and.
& (au1 .ne. 'rad') .and.
& (au1 .ne. 'dms')) then
nerr = 1
go to 210
endif
c.... Convert from input units to output units.
if ((au1 .eq. 'degrees') .or.
& (au1 .eq. 'deg') .or.
& (au1 .eq. 'deg')) then
deg = a1
grad = a1 / 0.9
rad = a1 * pi / 180.0
elseif ((au1 .eq. 'grads') .or.
& (au1 .eq. 'grad')) then
grad = a1
deg = 0.9 * a1
rad = a1 * pi / 200.0
elseif ((au1 .eq. 'radians') .or.
& (au1 .eq. 'rads') .or.
& (au1 .eq. 'rad')) then
rad = a1
deg = a1 * 180.0 / pi
grad = a1 * 200.0 / pi
elseif (au1 .eq. 'dms') then
deg = a1 + am1 / 60.0 + as1 / 3600.0
grad = deg / 0.9
rad = deg * pi / 180.0
endif
c.... Round off, find degrees, arc degrees, minutes, seconds.
ideg = nint (deg)
xdeg = ideg
if (abs (deg - xdeg) .gt. 0.5) then
nerr = 2
go to 210
elseif (abs (deg - xdeg) .le. tol * abs (deg)) then
deg = xdeg
endif
adeg = int (deg)
am2 = (deg - adeg) * 60.0
imin = nint (am2)
xmin = imin
if (abs (am2 - xmin) .le. tol * 60.0 * abs (deg)) then
am2 = xmin
endif
am2 = int (am2)
as2 = (deg - adeg - am2 / 60.0) * 3600.0
isec = nint (as2)
xsec = isec
if (abs (as2 - xsec) .le. tol * 3600.0 * abs (deg)) then
as2 = xsec
endif
210 continue
cbugc***DEBUG begins.
cbug 9903 format (/ 'aptcang final values. nerr =',i2 /
cbug & 'deg,grad,rad=',1p3e22.14 /
cbug & 'adeg,am2,as2=',1p3e22.14 )
cbug write ( 3, 9903) nerr, deg, grad, rad, adeg, am2, as2
cbugc***DEBUG ends.
return
c.... End of subroutine aptcang. (+1 line.)
end
UCRL-WEB-209832