program fipd
c;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
c Fetch the Ionospheric Potential field Data 
c;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	dimension ubc(37,73), ubcc(37,73), ubcd(37,73)
	real 	dyno(74,36), heelis(74,36), ub(73,37)

	nrows= 36
	ncols= 74

	open (unit= 3, file= "/d/bill/GECM/pot.data", form= "unformatted", 
     &    access= "sequential", status= "old")
	do 10 lat= 1, nrows 
	  do 11 long= 1, ncols 
	    read(3) dyno(long, lat), heelis(long, lat)
	    ubcc(lat,long)= heelis(long,lat)
	    ubcd(lat,long)= dyno(long,lat)
	    ubc(lat,long)= heelis(long,lat) + dyno(long,lat)
  11      continue
  10    continue

c Fix the tailend of the arrays.  Note that the polar values have not been
c computed yet.
	c= 0.0
	d= 0.0
	do long= 1, ncols
	  c= c + ubcc(36,long)
	  d= d + ubcd(36,long)
	enddo
	ubcc(37,73)= c/72.0 
	ubcd(37,73)= d/72.0 
	ubc(37,73)= ubcc(37,73) + ubcd(37,73)

c Swap the array indices to the CORRECT order!
	do lat= 1, nrows+1
	  do long= 1, ncols+1
	    ub(long,lat)= ubc(lat,long)
	  enddo
	enddo

c Open GKS, open workstation (type1) and activate it.
	call gopks (6, idummy)
	call gopwk (1, 2, 1)
	call gacwk (1)

	call pltit(ub)

c Deactivate and close workstation, close GKS.
	call gdawk(1)
	call gclwk(1)
	call gclks

      	stop
      	end

	subroutine pltit(z)
	dimension rwrk(10000), iwrk(6000), z(73,37)

c Set up the mapping.
	call set (0.05, 0.98, 0.05, 0.98, -1.0, 1.0, -1.0, 1.0, 1)
	call cpseti('SET', 0)
	
	call cpsetr('XC1', -180.0)
	call cpsetr('XCM', 180.0)
	call cpsetr('YC1', -87.5)
	call cpsetr('YCN', 87.5)

	call cpsetr('ORV', 1.e12) 

c Specify the mapping - CONPACK will call my version of the
c 'cpcmxy'routine and  (I hope).  Let's try using 'MAPTRAN' first.
	call mapint
	call maplmb
	call cpseti ('MAP', 1)

c Specify that I would like to have 16 contour levels.
	call cpseti ('NCL', 16)

c Specify initialization for rectangular array.
	call cprect (z, 73, 73, 37, rwrk, 10000, iwrk, 6000)

c Tell CONPACK to pick the levels.
	call cppkcl (z, rwrk, iwrk)

c Draw the contours.
	call cpcldr (z, rwrk, iwrk)

c Draw a background around contours. 
	call cpback (z, rwrk, iwrk)
	call frame


	return
	end