-+-+-+-+-+-+-+-+ START OF PART 176 -+-+-+-+-+-+-+-+
X       `20
X        SUBROUTINE ptkf_point3(x, y, z, pt)
X        REAL x, y, z, pt(3)
X       `20
X`09pt(1) = x
X`09pt(2) = y
X        pt(3) = z
X
X        RETURN
X        END
X       `20
X        SUBROUTINE ptkf_limit(xmin, xmax, ymin, ymax, lt)
X        REAL xmin, xmax, ymin, ymax, lt(4)
X       `20
X`09lt(1) = xmin
X`09lt(2) = xmax
X        lt(3) = ymin
X        lt(4) = ymax
X
X        RETURN
X        END
X       `20
X        SUBROUTINE ptkf_limit3(xmin, xmax, ymin, ymax, zmin, zmax, lt)
X        REAL xmin, xmax, ymin, ymax, zmin, zmax, lt(6)
X       `20
X`09lt(1) = xmin
X`09lt(2) = xmax
X        lt(3) = ymin
X        lt(4) = ymax
X        lt(5) = zmin
X        lt(6) = zmax
X
X        RETURN
X        END
X
X`09REAL FUNCTION ptkf_dotv3(v1, v2)
X`09REAL v1(3), v2(3)
X        REAL ptk_dotv3
X        external ptk_dotv3`20
X
X`09ptkf_dotv3 = ptk_dotv3(v1, v2)
X
X`09RETURN
X`09END
X
X`09REAL FUNCTION ptkf_dotv(v1, v2)
X`09REAL v1(2), v2(2)
X        REAL ptk_dotv
X        external ptk_dotv`20
X     `20
X`09ptkf_dotv = ptk_dotv(v1, v2)
X
X`09RETURN
X`09END
X
X        SUBROUTINE ptkf_crossv3(v1, v2, v3)
X        REAL v1(3), v2(3), v3(3)
X        `20
X        v3(1) = v1(2) * v2(3) - v1(3) * v2(2)
X        v3(2) = v1(3) * v2(1) - v1(1) * v2(3)
X        v3(3) = v1(1) * v2(2) - v1(2) * v2(1)
X       `20
X        RETURN
X        END
X               `20
X        LOGICAL FUNCTION ptkf_nullv3(vec)
X        REAL vec(3)
X        BYTE ans
X        LOGICAL *1 ptk_nullv3
X        external ptk_nullv3`20
X
X        ans = ptk_nullv3(vec)
X`09if (ans .eq. 1) then
X`09`09ptkf_nullv3 = .TRUE.
X`09else
X`09`09ptkf_nullv3 = .FALSE.
X`09endif
X       `20
X        RETURN
X        END
X       `20
X        LOGICAL FUNCTION ptkf_nullv(vec)
X        REAL vec(3)
X        BYTE ans
X        LOGICAL *1 ptk_nullv
X        external ptk_nullv`20
X
X        ans = ptk_nullv(vec)
X`09if (ans .eq. 1) then
X`09`09ptkf_nullv = .TRUE.
X`09else
X`09`09ptkf_nullv = .FALSE.
X`09endif
X       `20
X        RETURN
X        END
X       `20
X        REAL FUNCTION ptkf_modv3(vec)
X        REAL vec(3)
X        REAL ptk_modv3
X        external ptk_modv3`20
X
X        ptkf_modv3 = ptk_modv3(vec)
X       `20
X        RETURN
X        END
X       `20
X        REAL FUNCTION ptkf_modv(vec)
X        REAL vec(3)
X        REAL ptk_modv
X        external ptk_modv`20
X       `20
X        ptkf_modv = ptk_modv(vec)
X       `20
X        RETURN
X        END
X       `20
X        SUBROUTINE ptkf_unitv3(vec, uvec)
X        REAL vec(3), uvec(3), modu
X        REAL ptkf_modv3
X        LOGICAL ptkf_equal
X
X        modu = ptkf_modv3(vec)
X        if (ptkf_equal(modu, 0.0) .eq. .FALSE.) then
X          call ptkf_point3(vec(1) / modu, vec(2) / modu, vec(3) / modu,`20
X     : uvec)
X        else`20
X          call ptkf_point3(0.0, 0.0, 0.0, uvec)
X        endif
X       `20
X        RETURN
X        END
X       `20
X        SUBROUTINE ptkf_unitv(vec, uvec)
X        REAL vec(2), uvec(2), modu
X        REAL ptkf_modv
X        LOGICAL ptkf_equal
X
X        modu = ptkf_modv(vec)
X        if (ptkf_equal(modu, 0.0) .eq. .FALSE.) then
X          call ptkf_point(vec(1) / modu, vec(2) / modu, uvec)
X        else`20
X          call ptkf_point(0.0, 0.0, uvec)
X        endif       `20
X       `20
X        RETURN
X        END
X       `20
X        SUBROUTINE ptkf_scalev3(vec, scale, svec)
X        REAL vec(3), scale, svec(3)
X
X        call ptkf_point3(vec(1) * scale, vec(2) * scale, vec(3) * scale,`20
X     : svec)
X      `20
X        RETURN
X        END
X       `20
X        SUBROUTINE ptkf_scalev(vec, scale, svec)
X        REAL vec(2), scale, svec(2)
X
X        call ptkf_point(vec(1) * scale, vec(2) * scale, svec)
X
X        RETURN
X        END
X       `20
X        SUBROUTINE ptkf_subv3(p1, p2, p3)
X        REAL p1(3), p2(3), p3(3)
X       `20
X        call ptkf_point3(p1(1) - p2(1), p1(2) - p2(2), p1(3) - p2(3),`20
X     : p3)
X       `20
X        RETURN
X        END
X       `20
X        SUBROUTINE ptkf_subv(p1, p2, p3)
X        REAL p1(2), p2(2), p3(2)
X               `20
X        call ptkf_point(p1(1) - p2(1), p1(2)- p2(2), p3)
X
X        RETURN
X        END
X       `20
X        SUBROUTINE ptkf_addv3(p1, p2, p3)
X        REAL p1(3), p2(3), p3(3)
X       `20
X        call ptkf_point3(p1(1) + p2(1), p1(2) + p2(2), p1(3) + p2(3),`20
X     : p3)
X       `20
X        RETURN
X        END
X       `20
X        SUBROUTINE ptkf_addv(p1, p2, p3)
X        REAL p1(2), p2(2), p3(2)
X       `20
X        call ptkf_point(p1(1) + p2(1), p1(2) + p2(2), p3)
X       `20
X        RETURN
X        END
X               `20
X`09SUBROUTINE ptkf_unitmatrix(matrix)
X`09REAL matrix(3,3)
X        external ptk_unitmatrix`20
X       `20
X  `09call  ptk_unitmatrix(matrix)
X       `20
X`09RETURN
X`09END
X       `20
X`09SUBROUTINE ptkf_unitmatrix3(matrix)
X`09REAL matrix(4,4)
X        external ptk_unitmatrix3`20
X       `20
X  `09call  ptk_unitmatrix3 (matrix)
X       `20
X`09RETURN
X`09END
X       `20
X        SUBROUTINE ptkf_transposematrix3(matrix, result)
X        REAL matrix(4,4), result(4,4)
X        external ptk_transposematrix3`20
X       `20
X        call  ptk_transposematrix3(matrix, result)
X       `20
X        RETURN
X        END
X       `20
X        SUBROUTINE ptkf_transposematrix(matrix, result)
X        REAL matrix(3,3), result(3,3)
X        external ptk_transposematrix`20
X
X        call  ptk_transposematrix(matrix, result)
X       `20
X        RETURN
X        END
X       `20
X`09SUBROUTINE ptkf_multiplymatrix3(matrix1, matrix2, result)
X`09REAL matrix1(4,4), matrix2(4,4), result(4,4)
X        external ptk_multiplymatrix3`20
X
X  `09call  ptk_multiplymatrix3(matrix1, matrix2, result)
X       `20
X`09RETURN
X`09END
X       `20
X        SUBROUTINE ptkf_multiplymatrix(matrix1, matrix2, result)
X        REAL matrix1(3,3), matrix2(3,3), result(3,3)
X        external ptk_multiplymatrix`20
X
X        call  ptk_multiplymatrix(matrix1, matrix2, result)
X       `20
X        RETURN
X        END
X       `20
X        SUBROUTINE ptkf_concatenatematrix3(operation, matrix1,`20
X     : matrix2, result)
X        INTEGER operation
X        REAL matrix1(4,4), matrix2(4,4), result(4,4)
X        external ptk_concatenatematrix3`20
X
X        call ptk_concatenatematrix3(%val(operation), matrix1,`20
X     : matrix2, result)
X        `20
X        RETURN
X        END
X  `20
X        SUBROUTINE ptkf_concatenatematrix(operation, matrix1,`20
X     : matrix2, result)
X        INTEGER operation
X        REAL matrix1(3,3), matrix2(3,3), result(3,3)
X        external ptk_concatenatematrix`20
X       `20
X        call ptk_concatenatematrix(%val(operation), matrix1,`20
X     : matrix2, result)
X       `20
X        RETURN
X        END
X       `20
X        SUBROUTINE ptkf_shift3(shift, operation, matrix)
X        REAL shift(3)
X        INTEGER operation
X        REAL matrix(4,4)
X        external ptk_shift3`20
X       `20
X        call  ptk_shift3(shift, %val(operation), matrix)
X       `20
X        RETURN
X        END
X       `20
X`09SUBROUTINE ptkf_shift(shift, operation, matrix)
X`09REAL shift(2)
X        INTEGER operation
X`09REAL matrix(3,3)
X`09external ptk_shift`20
X       `20
X  `09call  ptk_shift(shift, %val(operation), matrix)
X       `20
X`09RETURN
X`09END
X       `20
X`09SUBROUTINE ptkf_scale3(scale, operation, matrix)
X`09REAL scale(3)
X        INTEGER operation
X`09REAL matrix(4,4)
X`09external ptk_scale3`20
X       `20
X  `09call  ptk_scale3(scale, %val(operation), matrix)
X       `20
X`09RETURN
X`09END
X       `20
X`09SUBROUTINE ptkf_scale(scale, operation, matrix)
X`09REAL scale(2)
X        INTEGER operation
X`09REAL matrix(3,3)
X`09external ptk_scale`20
X`09
X  `09call  ptk_scale(scale, %val(operation), matrix)
X       `20
X`09RETURN
X`09END
X       `20
X`09SUBROUTINE ptkf_rotatecs3(costheta, sinetheta, axis, operation,`20
X     : matrix)
X`09REAL costheta, sinetheta
X        INTEGER axis, operation
X`09REAL matrix(4,4)
X        REAL*4 dpcostheta, dpsinetheta
X`09external ptk_rotatecs3`20
X       `20
X        dpcostheta = costheta
X        dpsinetheta = sinetheta
X  `09call ptk_rotatecs3(%val(dpcostheta), %val(dpsinetheta), %val(axis),
X     : %val(operation), matrix)
X       `20
X        RETURN
X        END
X       `20
X        SUBROUTINE ptkf_rotatecs(costheta, sinetheta, axis, operation,`20
X     : matrix)
X        REAL costheta, sinetheta
X        INTEGER axis, operation
X        REAL matrix(3,3)
X        REAL*4 dpcostheta, dpsinetheta
X        external ptk_rotatecs`20
X       `20
X        dpcostheta = costheta
X        dpsinetheta = sinetheta
X        call  ptk_rotatecs(%val(dpcostheta), %val(dpsinetheta),`20
X     : %val(axis), %val(operation), matrix)
X       `20
X        RETURN
X        END
X       `20
X        SUBROUTINE ptkf_rotate3(rotation, axis, operation, matrix)
X        REAL rotation
X        INTEGER axis, operation
X        REAL matrix(4,4)
X        REAL*4 dprotation
X
X        external ptk_rotate3`20
X       `20
X        dprotation = rotation
X        call  ptk_rotate3(%val(dprotation), %val(axis), %val(operation),
X     : matrix)
X       `20
X        RETURN
X        END
X       `20
X        SUBROUTINE ptkf_rotate(rotation, axis, operation, matrix)
X        REAL rotation
X        INTEGER axis, operation
X        REAL matrix(3,3)
X        REAL*4 dprotation
X        external ptk_rotate`20
X       `20
X        dprotation = rotation
X        call  ptk_rotate(%val(dprotation), %val(axis), %val(operation),
X     : matrix)
X       `20
X        RETURN
X        END
X       `20
X        SUBROUTINE ptkf_shear3(shearaxis, sheardir, shearfactor, operation,
X     : matrix)
X        INTEGER shearaxis, sheardir
X        REAL shearfactor
X        INTEGER operation
X        REAL matrix(4,4)
X        REAL*4 dpshearfactor
X        external ptk_shear3`20
X       `20
X        dpshearfactor = shearfactor
X        call ptk_shear3(%val(shearaxis), %val(sheardir),
X     : %val(dpshearfactor), %val(operation), matrix)
X       `20
X        RETURN
X        END
X       `20
X        SUBROUTINE ptkf_shear(shearaxis, sheardir, shearfactor, operation,`2
V0
X     : matrix)
X        INTEGER shearaxis, sheardir
X        REAL shearfactor
X        INTEGER operation
X        REAL matrix(3,3)
X        REAL*4 dpshearfactor
X        external ptk_shear`20
X       `20
X        dpshearfactor = shearfactor
X        call  ptk_shear(%val(shearaxis), %val(sheardir),`20
X     : %val(dpshearfactor), %val(operation), matrix)
X       `20
X        RETURN
X        END
X       `20
X        SUBROUTINE ptkf_rotatevv3(v1, v2, operation, matrix, error)
X        REAL v1(3), v2(3)
X        INTEGER operation
X        REAL matrix(4,4)
X        INTEGER error
X        external ptk_rotatevv3`20
X       `20
X        call  ptk_rotatevv3(v1, v2, %val(operation), matrix, error)
X       `20
X        RETURN
X        END
X       `20
X        SUBROUTINE ptkf_rotatevv(v1, v2, operation, matrix, error)
X        REAL v1(2), v2(2)
X        INTEGER operation
X        REAL matrix(3,3)
X        INTEGER error
X        external ptk_rotatevv`20
X       `20
X        call  ptk_rotatevv(v1, v2, %val(operation), matrix, error)
X       `20
X        RETURN
X        END
X       `20
X        SUBROUTINE ptkf_rotateline3(p1, p2, theta, operation, matrix,`20
X     : error)
X        REAL p1(3), p2(3), theta
X        INTEGER operation
X        REAL matrix(4,4)
X        INTEGER error
X        REAL*4 dptheta
X        external ptk_rotateline3`20
X
X        dptheta = theta
X        call  ptk_rotateline3(p1, p2, %val(dptheta), %val(operation),`20
X     : matrix, error)
X       `20
X        RETURN
X        END
X       `20
X        SUBROUTINE ptkf_rotateline(p1, p2, theta, operation, matrix,`20
X     : error)
X        REAL p1(2), p2(2), theta
X        INTEGER operation
X        REAL matrix(3,3)
X        INTEGER error
X        REAL*4 dptheta
X        external ptk_rotateline`20
X       `20
X        dptheta = theta
X        call  ptk_rotateline(p1, p2, %val(dptheta), %val(operation),`20
X     : matrix, error)
X       `20
X        RETURN
X        END
X       `20
X        SUBROUTINE ptkf_pt3topt4(pt, pt4)
X        REAL pt(3), pt4(4)
X
X        pt4(1) = pt(1)
X        pt4(2) = pt(2)
X        pt4(3) = pt(3)
X        pt4(4) = 1.0
X       `20
X        RETURN
X        END
X       `20
X        SUBROUTINE ptkf_pt4topt3(pt, pt3)
X        REAL pt(4), pt3(3), w
X        LOGICAL ptkf_equal, ans
X `20
X        ans = ptkf_equal(pt(4), 0.0)
X        if (ans .eq. .TRUE.) then
X          w = 1.0 / 1.0e-7
X        else
X          w = 1.0 / pt(4)
X        endif
X
X        pt3(1) = pt(1) * w
X        pt3(2) = pt(2) * w
X        pt3(3) = pt(3) * w
X       `20
X        RETURN
X        END
X       `20
X        SUBROUTINE ptkf_transform4(matrix, point, tpoint)
X        REAL matrix(4,4), point(4), tpoint(4)
X
X        tpoint(1) = matrix(1, 1) * point(1) + matrix(1, 2) * point(2) +`20
X     : matrix(1, 3) * point(3) + matrix(1, 4) * point(4)
X        tpoint(2) = matrix(2, 1) * point(1) + matrix(2, 2) * point(2) +`20
X     : matrix(2, 3) * point(3) + matrix(2, 4) * point(4)
X        tpoint(3) = matrix(3, 1) * point(1) + matrix(3, 2) * point(2) +`20
X     : matrix(3, 3) * point(3) + matrix(3, 4) * point(4)
X        tpoint(4) = matrix(4, 1) * point(1) + matrix(4, 2) * point(2) +`20
X     : matrix(4, 3) * point(3) + matrix(4, 4) * point(4)
X       `20
X        RETURN
X        END
X       `20
X        SUBROUTINE ptkf_transform3(matrix, point, tpoint)
X        REAL matrix(4,4), point(3), tpoint(3), temp(4)
X
X        temp(1) = matrix(1, 1) * point(1) + matrix(1, 2) * point(2) +`20
X     : matrix(1, 3) * point(3) + matrix(1, 4)
X        temp(2) = matrix(2, 1) * point(1) + matrix(2, 2) * point(2) +`20
X     : matrix(2, 3) * point(3) + matrix(2, 4)
X        temp(3) = matrix(3, 1) * point(1) + matrix(3, 2) * point(2) +`20
X     : matrix(3, 3) * point(3) + matrix(3, 4)
X        temp(4) = matrix(4, 1) * point(1) + matrix(4, 2) * point(2) +`20
X     : matrix(4, 3) * point(3) + matrix(4, 4)
X
X        call ptkf_pt4topt3(temp, tpoint)
X       `20
X        RETURN
X        END
X       `20
+-+-+-+-+-+-+-+-  END  OF PART 176 +-+-+-+-+-+-+-+-