[comp.os.vms] Dismap

derykm@psc90.UUCP (DEZ) (07/02/88)

Hi,

I am having really big problems converting this from CMS to VMS.
somehow I have to change the block size, record length, record format.
this is the exec file and fortran file. 
Any help would be greatly appreciated.

deryk


        
UUCP:
decvax!unhd!psc90!derykm

{uunet,decvax,dartvax}!psc90!derykm

BITNET :  D_MARIEN@UNHH
==============================================================================


==================================================================
  /* */
'filed 39 disk dismap location * (lrecl 80 blksize 80 recfm f perm'
'filed 40 disk dismap links * (lrecl 80 blksize 80 recfm f perm '
fortvs dismap
disspla dismap

=================================================================

C ****************************************************************
C
C        This program produces BITNet node maps using Disspla
C        Written By: Christopher C. Corke <CC06067@UAFSYSB.BITNET>
C        This program uses two input files which may be obtained
C        from the listserv at uafsysb.
C          1) DISMAP LINKS     (used for fortran unit 40)
C          2) DISMAP LOCATION  (used for fortran unit 39)
C
C        An exec file for CMS is available, it contains the needed
C        file defs.  If you are not using CMS, the files are:
C        RECORD LENGTH=80, BLOCK SIZE=80, RECORD FORMAT=FIXED
C
C        Release to Public Domain               03/30/88 9:00
C        Update (Fix Node In Ocean)             03/30/88 14:00
C        Update (Retrieve Date from Links File) 06/14/88 16:12
C ****************************************************************
C
C        An automatic subscription to the Dismap package may
C        be obtained by use of the AFD command.
C
C        First set up a password on our listserv:
C
C         Tell listserv at uafsysb pw add PASSWORD
C
C        Add the DISMAP package to your AFD List:
C
C         Tell listserv at uafsysb afd add dismap package uatools
C
C*********************************************************************
C
C THE FOLLOWING COMMAN AREA IS USED BY THE LAND BLANKING ROUTINE
       COMMON IWORK (9175)
C THE FOLLOWING ARRAYS HOLD THE LOCATIONS OF THE NODES AND LINKS
       REAL LON(3000), LAT(3000), LONG(2), LATT(2)
C THE FOLLOWING CALL TO IOMGR IS NEED WITH THE P7475 ONLY.
       REAL VER
       CHARACTER*1 A(14)
       A(1)='A'
       A(2)='s'
       A(3)=' '
       A(4)='O'
       A(5)='f'
       A(6)=' '
       A(9)='/'
       A(12)='/'
       READ (40, 35) VER,A(7),A(8),A(10),A(11),A(13),A(14)
C      CALL IOMGR(1, -105)
C      CALL P7475 (1)
       CALL GDDM3(1,32,80,1)
C      CALL ZETA(3653,33,-1)
C      CALL PTEKAL
C      CALL COMPRS
       CALL HWSCAL ('SCREEN')
       CALL SETDEV (0, 0)
       CALL BLOWUP (.85)
       CALL PAGE(11.,7.)
       CALL PHYSOR (.6,.6)
       CALL PROJCT ('CYLIN')
       CALL MAPMDE ('STRAI')
       CALL AREA2D(10.,5.3)
       CALL SWISSL
       CALL SHDCHR (45.,1,.002,1)
       CALL HEADIN ('BITNET TOPOLOGY$',100,1.3,2)
       CALL HEADIN (A,14, .5, 2)
       CALL XNAME ('Longitude', 9)
       CALL YNAME ('Latitude', 8)
C   THE FOLLOWING CALL TO MAPGR WILL GENERATE A WORLD MAP.
       CALL MAPGR (-185.,30.,185.,-85.,25.,85.)
C   THE FOLLOWING CALL TO MAPGR WILL GENERATE A MAP OF NORTH AMERICA.
C      CALL MAPGR (-170.,20.,-50.,0.,10.,70.)
C THE FOLLOWING CALL TO MAPFIL OUTLINES COASTS
       CALL MAPFIL ('COAS')
C THE FOLLOWING CALL TO MAPFIL OUTLINE COUNTRIES
       CALL MAPFIL ('POLI')
       I=0
10     READ (39,30,END=20) LAT(I), LON(I)
       IF ((LON(I).EQ.-1).AND.(LAT(I).EQ.-1))  THEN I=I-1
       I=I+1
       GO TO 10
20     CALL MARKER (16)
       CALL SCLPIC (.10)
       CALL SETCLR('BLUE')
       CALL CURVE (LON, LAT, I, -1)
       CALL SETCLR ('RED')
       I = 1
22     READ (40,34,END=29) LONG(1), LATT(1), LONG(2), LATT(2)
       IF ((LONG(1).EQ.-1).AND.(LATT(1).EQ.-1)) GO TO 23
       IF ((LONG(2).EQ.-1).AND.(LATT(2).EQ.-1)) GO TO 23
       CALL CURVE (LONG, LATT, 2, 0)
23     GO TO 22
29     CALL SETCLR ('BLUE')
       CALL LBLANK ('LAND', 9175)
       CALL GRID (2,2)
       CALL ENDPL(0)
       CALL DONEPL
30     FORMAT(10X,F7.2,2X,F7.2)
32     FORMAT(1X,I4,1X,F7.2,1X,F7.2)
34     FORMAT(F7.2,1X,F7.2,1X,F7.2,1X,F7.2)
35     FORMAT(F5.2,1X,2A1,1X,2A1,1X,2A1)
       STOP
       END