-+-+-+-+-+-+-+-+ START OF PART 175 -+-+-+-+-+-+-+-+
X       INTEGER stid, llim, ulim
X       external ptk_drawcolourtable`20
X
X       call ptk_drawcolourtable(%val(stid), %val(llim), %val(ulim))
X
X       RETURN
X       END
X
X       SUBROUTINE ptkf_copycolourtable(sourcewsid, destwsid)
X       INTEGER sourcewsid, destwsid
X       external ptk_copycolourtable`20
X
X       call ptk_copycolourtable(%val(sourcewsid), %val(destwsid))
X
X       RETURN
X       END
X
X       SUBROUTINE ptkf_copylinetable(sourcewsid, destwsid)
X       INTEGER sourcewsid, destwsid
X       external ptk_copylinetable`20
X
X       call ptk_copylinetable(%val(sourcewsid), %val(destwsid))
X
X       RETURN
X       END
X
X       SUBROUTINE ptkf_copymarkertable(sourcewsid, destwsid)
X       INTEGER sourcewsid, destwsid
X       external ptk_copymarkertable`20
X
X       call ptk_copymarkertable(%val(sourcewsid), %val(destwsid))
X
X       RETURN
X       END
X
X       SUBROUTINE ptkf_copytexttable(sourcewsid, destwsid)
X       INTEGER sourcewsid, destwsid
X       external ptk_copytexttable`20
X
X       call ptk_copytexttable(%val(sourcewsid), %val(destwsid))
X
X       RETURN
X       END
X
X       SUBROUTINE ptkf_copyinttable(sourcewsid, destwsid)
X       INTEGER sourcewsid, destwsid
X       external ptk_copyinttable`20
X
X       call ptk_copyinttable(%val(sourcewsid), %val(destwsid))
X
X       RETURN
X       END
X
X       SUBROUTINE ptkf_copyedgetable(sourcewsid, destwsid)
X       INTEGER sourcewsid, destwsid
X       external ptk_copyedgetable`20
X
X       call ptk_copyedgetable(%val(sourcewsid), %val(destwsid))
X
X       RETURN
X       END
X
X       SUBROUTINE ptkf_copypattable(sourcewsid, destwsid)
X       INTEGER sourcewsid, destwsid
X       external ptk_copypattable`20
X
X       call ptk_copypattable(%val(sourcewsid), %val(destwsid))
X
X       RETURN
X       END
X
X       SUBROUTINE ptkf_copyviewtable(sourcewsid, destwsid)
X       INTEGER sourcewsid, destwsid
X       external ptk_copyviewtable`20
X
X       call ptk_copyviewtable(%val(sourcewsid), %val(destwsid))
X
X       RETURN
X       END
X
X       SUBROUTINE ptkf_copywssttable(sourcewsid, destwsid)
X       INTEGER sourcewsid, destwsid
X       external ptk_copywssttable`20
X
X       call ptk_copywssttable(%val(sourcewsid), %val(destwsid))
X
X       RETURN
X       END
X
X       SUBROUTINE ptkf_copypostedstruct(sourcewsid, destwsid)
X       INTEGER sourcewsid, destwsid
X       external ptk_copypostedstruct`20
X
X       call ptk_copypostedstruct(%val(sourcewsid), %val(destwsid))
X
X       RETURN
X       END
X
X       SUBROUTINE ptkf_copyhilightfilter(sourcewsid, destwsid)
X       INTEGER sourcewsid, destwsid
X       external ptk_copyhilightfilter`20
X
X       call ptk_copyhilightfilter(%val(sourcewsid), %val(destwsid))
X
X       RETURN
X       END
X
X       SUBROUTINE ptkf_copyinvisfilter(sourcewsid, destwsid)
X       INTEGER sourcewsid, destwsid
X       external ptk_copyinvisfilter`20
X
X       call ptk_copyinvisfilter(%val(sourcewsid), %val(destwsid))
X
X       RETURN
X       END
X
X       SUBROUTINE ptkf_copyhlhsrmode(sourcewsid, destwsid)
X       INTEGER sourcewsid, destwsid
X       external ptk_copyhlhsrmode`20
X
X       call ptk_copyhlhsrmode(%val(sourcewsid), %val(destwsid))
X
X       RETURN
X       END
X
X       SUBROUTINE ptkf_inqmaxdevicecoords(wsid, maxdevx, maxdevy)
X       INTEGER wsid
X       REAL maxdevx, maxdevy
X       external ptk_inqmaxdevicecoords`20
X
X       call ptk_inqmaxdevicecoords(%val(wsid), maxdevx, maxdevy)
X
X       RETURN
X       END
X
X       SUBROUTINE ptkf_inqmaxdevicecoords3(wsid, maxdevx, maxdevy)
X       INTEGER wsid
X       REAL maxdevx, maxdevy, maxdevz
X       external ptk_inqmaxdevicecoords3`20
X
X       call ptk_inqmaxdevicecoords3(%val(wsid), maxdevx, maxdevy,`20
X     : maxdevz)
X
X       RETURN
X       END
X
X       SUBROUTINE ptkf_arrow(length, width, centre, angle)
X       REAL length, width, centre(3), angle
X       external ptkc_arrow`20
X
X       call ptkc_arrow(length, width, centre, angle)
X
X       RETURN
X       END
X
X       SUBROUTINE ptkf_grid(stid)
X       INTEGER stid
X       external ptk_grid`20
X
X       call ptk_grid(%val(stid))
X
X       RETURN
X       END
X
X       SUBROUTINE ptkf_framebox(boxcentre, boxsize, framesize, boxcolour,`20
X     : edgecolour, tlcolour, brcolour)
X       REAL boxcentre(3), boxsize(2), framesize(2)
X       INTEGER boxcolour, edgecolour, tlcolour, brcolour
X       external ptk_framebox`20
X
X       call ptk_framebox(boxcentre, boxsize, framesize, %val(boxcolour),`20
X     : %val(edgecolour), %val(tlcolour), %val(brcolour))
X
X       RETURN
X       END
X
XC end of plib.f`20
$ CALL UNPACK [.FORTRAN.SOURCE.LIBRARY]PLIB.FOR;1 1681721580
$ create 'f'
X
X
X       SUBROUTINE ptkf_structcontent(wsid, stid, firstel, lastel,`20
X     : elemptr, font, error)
X       INTEGER wsid, stid, firstel, lastel, elemptr, font, error
X       external ptk_structcontent`20
X
X       call ptk_structcontent(%val(wsid), %val(stid), %val(firstel),`20
X     : %val(lastel), %val(elemptr), %val(font), error)
X
X       RETURN
X       END
X
X       SUBROUTINE ptkf_inqstructcontentrange(contentstid, firstel,`20
X     : lastel, err)
X       INTEGER contentstid, firstel, lastel, err
X       external ptk_inqstructcontentrange`20
X
X       call ptk_inqstructcontentrange(%val(contentstid), firstel,`20
X     : lastel, err)
X
X       RETURN
X       END
X
X       SUBROUTINE ptkf_setstructcontentelemptr(contentstid, elemptr)
X       INTEGER contentstid, elemptr
X       external ptk_setstructcontentelemptr`20
X
X       call ptk_setstructcontentelemptr(%val(contentstid),`20
X     : %val(elemptr))
X
X       RETURN
X       END
X
X       SUBROUTINE ptkf_inqstructcontentelemptr(contentstid, elemptr,
X     : err)
X       INTEGER contentstid, elemptr, err
X       external ptk_inqstructcontentelemptr`20
X     : !$PRAGMA C(ptk_inqstructcontentelemptr)
X
X       call ptk_inqstructcontentelemptr(%val(contentstid),`20
X     : elemptr, err)
X
X       RETURN
X       END
X
XC end of stct.f
X
$ CALL UNPACK [.FORTRAN.SOURCE.LIBRARY]STCT.FOR;1 371721462
$ create 'f'
X
X       SUBROUTINE ptkf_createtopology(topid, root, error)
X       INTEGER topid, root, error
X       external ptk_createtopology`20
X
X       call ptk_createtopology(%val(topid), %val(root), error)
X
X       RETURN
X       END
X
X       SUBROUTINE ptkf_settopologyattrs(topid, txfont, linecol,`20
X     : textcol, edgecol, intcol, htedgecol, htintcol)
X       INTEGER topid, txfont, linecol
X       INTEGER textcol, edgecol, intcol, htedgecol, htintcol
X       external ptk_settopologyattrs
X
X       call ptk_settopologyattrs(%val(topid), %val(txfont),`20
X     : %val(linecol), %val(textcol), %val(edgecol), %val(intcol),`20
X     : %val(htedgecol), %val(htintcol))
X
X       RETURN
X       END
X
X       SUBROUTINE ptkf_inqtopologyattrs(topid, txfont, linecol,`20
X     : textcol, edgecol, intcol, htedgecol, htintcol, err)
X       INTEGER topid, txfont, linecol
X       INTEGER textcol, edgecol, intcol, htedgecol, htintcol, err
X       external ptk_inqtopologyattrs
X
X       call ptk_inqtopologyattrs(%val(topid), txfont, linecol,`20
X     : textcol, edgecol, intcol, htedgecol, htintcol, err)
X
X       RETURN
X       END
X
X       SUBROUTINE ptkf_settopologytype(topid, toptype)
X       INTEGER topid, toptype
X       external ptk_settopologytype`20
X
X       call ptk_settopologytype(%val(topid), %val(toptype))
X
X       RETURN
X       END
X
X       SUBROUTINE ptkf_inqtopologytype(topid, toptype, err)
X       INTEGER topid, toptype, err
X       external ptk_inqtopologytype
X
X       call ptk_inqtopologytype(%val(topid), toptype, err)
X
X       RETURN
X       END
X
X       SUBROUTINE ptkf_setnodeposition(topid, structid, nodept,`20
X     : nodetype)
X       INTEGER topid, structid
X       REAL nodept(3)
X       INTEGER nodetype
X       external ptk_setnodeposition`20
X
X       call ptk_setnodeposition(%val(topid), %val(structid), nodept,`20
X     : %val(nodetype))
X
X       RETURN
X       END
X
X       SUBROUTINE ptkf_inqnodeposition(topid, structid, nodept, err)
X       INTEGER topid, structid
X       REAL nodept(3)
X       INTEGER err
X       external ptk_inqnodeposition
X
X       call ptk_inqnodeposition(%val(topid), %val(structid),`20
X     : nodept, err)
X
X       RETURN
X       END
X
X       SUBROUTINE ptkf_tidytopology(wsid, topid, nodetype, pickdev,`20
X     : pickpet, pldr, pdatrec, locdev, locpet, lldr, ldatrec)
X       INTEGER wsid, topid, nodetype, pickdev, pickpet, pldr
X       CHARACTER*80 pdatrec(*)
X       INTEGER locdev, locpet, lldr
X       CHARACTER*80 ldatrec(*)
X       INTEGER nodeid
X       REAL point(3)
X       INTEGER incl(10), excl(10)
X       INTEGER i, err
X       LOGICAL found
X       REAL echo(6)
X       REAL maxdevx, maxdevy, maxdevz
X       INTEGER topname, topstid
X       INTEGER pp(3, 10), ppath(3, 10)
X       INTEGER stat, ppd
X
X       include '`5B`5Dvmsphigs77.for'
X       include '`5B`5Dvmsptk77.for'
X`20
XC       implicit undefined (P, p, E, e)
X
X       call ptkf_inqtopologyname(topid, topname, err)`20
X       call ptkf_inqtopologystructid(topid, topstid, err)
X       call ptkf_inqmaxdevicecoords3(wsid, maxdevx, maxdevy, maxdevz)
X       call ptkf_limit3(0.0, maxdevx, 0.0, maxdevy, 0.0, maxdevz, echo)
X
XC  pick topology node`20
X  `20
X       call pspkm(wsid, pickdev, PREQU, PECHO)
X       call pinpk3(wsid, pickdev, PNPICK, 0, pp, pickpet, echo, pldr,`20
X     : pdatrec, PPOBOT)`20
X
X       incl(1) = topname
X       call pspkft(wsid, pickdev, 1, incl, 0, excl)
X
X       call prqpk(wsid, pickdev, 10, stat, ppd, ppath)
X
X       if (stat .ne. POK) then
X         RETURN
X       endif
X
XC  find picked node`20
X       i = 0
X       found = .FALSE.
X10     if (found .ne. .TRUE. .and. i .lt. 10) then`20
X         if (ppath(1, i) .eq. topstid) then
X           nodeid = ppath(2, i)
X           found = .TRUE.
X           goto 20
X         endif
X         i = i + 1
X         goto 10
X       endif
X
XC  locate point
X20     call pinlc3(wsid, locdev, 0, 0.5, 0.5, 0.0, locpet, echo, lldr,`20
X     : ldatrec)
X       call pslcm(wsid, locdev, PREQU, PECHO)
X       call prqlc3(wsid, locdev, stat, view, point(1), point(2),`20
X     : point(3))
X
X       if (stat .ne. POK) then
X         RETURN
X       endif
X      `20
X       call ptkf_setnodeposition(topid, nodeid, point, nodetype)
X
X       RETURN
X       END
X
X       SUBROUTINE ptkf_posttopology(wsid, topid, priority)
X       INTEGER wsid, topid
X       REAL priority
X       REAL*4 dppriority
X       external ptk_posttopology`20
X
X       dppriority = priority
X       call ptk_posttopology(%val(wsid), %val(topid), %val(dppriority))
X
X       RETURN
X       END
X
X       SUBROUTINE ptkf_unposttopology(wsid, topid)
X       INTEGER wsid, topid
X       external ptk_unposttopology`20
X
X       call ptk_unposttopology(%val(wsid), %val(topid))
X
X       RETURN
X       END
X
X       LOGICAL FUNCTION ptkf_deltopology(topid)
X       INTEGER topid
X       LOGICAL*1 ptk_deltopology, ans
X       external ptk_deltopology`20
X
X       ans = ptk_deltopology(%val(topid))
X       if (ans .eq. 1) then
X          ptkf_deltopology = .TRUE.
X       else
X          ptkf_deltopology = .FALSE.
X       endif
X
X       RETURN
X       END
X
X       SUBROUTINE ptkf_storetopologylayout(fileptr, topid)
X       INTEGER fileptr, topid
X       external ptk_storetopologylayout`20
X
X       call ptk_storetopologylayout(%val(fileptr),`20
X     : %val(topid))
X
X       RETURN
X       END
X
X       SUBROUTINE ptkf_restoretopologylayout(fileptr, topid)
X       INTEGER fileptr, topid
X       external ptk_restoretopologylayout`20
X
X       call ptk_restoretopologylayout(%val(fileptr),`20
X     : %val(topid))
X
X       RETURN
X       END
X
X       SUBROUTINE ptkf_inqpostedtopologies(wsid, num, topids, totalnum,
X     : err)
X       INTEGER wsid, num, topids(num), totalnum, err
X       external ptkc_inqpostedtopologies`20
X
X       call ptkc_inqpostedtopologies(%val(wsid), %val(num), topids,`20
X     : totalsize, err)
X
X       RETURN
X       END
X
X       SUBROUTINE ptkf_inqtopologyids(num, topids, totalnum, err)
X       INTEGER num, topids, totalnum, err
X       external ptkc_inqtopologyids`20
X
X       call ptkc_inqtopologyids(%val(num), topids, totalnum, err)
X
X       RETURN
X       END
X
X       SUBROUTINE ptkf_inqtopologystructid(topid, topstid, err)
X       INTEGER topid, topstid, err
X       external ptk_inqtopologystructid`20
X
X       call ptk_inqtopologystructid(%val(topid), topstid, err)
X
X       RETURN
X       END
X
X       SUBROUTINE ptkf_inqtopologyname(topid, topname, err)
X       INTEGER topid, topname, err
X       external ptk_inqtopologyname`20
X
X       call ptk_inqtopologyname(%val(topid), topname, err)
X
X       RETURN
X       END
X
X       SUBROUTINE ptkf_settopologyhighlightnode(topid, topnodestid)
X       INTEGER topid, topnodestid
X       external ptk_settopologyhighlightnode`20
X
X       call ptk_settopologyhighlightnode(%val(topid), %val(topnodestid))
X
X       RETURN
X       END
X
X       SUBROUTINE ptkf_inqtopologyhighlightnode(topid, topnodestid,
X     : err)
X       INTEGER topid, topnodestid, err
X       external ptk_inqtopologyhighlightnode`20
X
X       call ptk_inqtopologyhighlightnode(%val(topid), topnodestid,
X     : err)
X
X       RETURN
X       END
X
XC end of topo.for
$ CALL UNPACK [.FORTRAN.SOURCE.LIBRARY]TOPO.FOR;1 359501734
$ create 'f'
XC       fortran interface to tran.c`20
X
XC`09subroutine fred(a,b,c)
XC       `20
XC        VMS
XC        ---
XC`09record/xx
XC       `20
XC`09x.a= a
XC       `20
XC  `09call ptk_xxx(X)
XC       `20
XC`09return
XC`09end
X
X        LOGICAL FUNCTION ptkf_equal(one, two)
X`09REAL one, two
X`09REAL*4 dpone, dptwo
X`09BYTE ans
X        LOGICAL *1 ptk_equal
X        external ptk_equal`20
X
X        dpone = one
X        dptwo = two
X`09ans = ptk_equal(%val(dpone), %val(dptwo))
X`09if (ans .eq. 1) then
X`09`09ptkf_equal = .TRUE.
X`09else
X`09`09ptkf_equal = .FALSE.
X`09endif
X
X`09RETURN
X`09END
X
X`09SUBROUTINE ptkf_point(x, y, pt)
X`09REAL x, y, pt(2)
X`09pt(1) = x
X`09pt(2) = y
X
X`09RETURN
X`09END
+-+-+-+-+-+-+-+-  END  OF PART 175 +-+-+-+-+-+-+-+-