	INTEGER SPCODE,CONDIR,UNITS,IOOPT
	CHARACTER*60 INFILE
	WRITE(*,*) 'STARTING CORPS27'
	READ(5,9) INFILE
    9 FORMAT(A60)
	READ(5,10) CONDIR
   10 FORMAT(I1)
	READ(5,25) UNITS
   25 FORMAT(I1)
	READ(5,30) SPCODE
   30 FORMAT(I4)
	READ(5,32) IOOPT
   32 FORMAT(I1)
	WRITE(*,*) 'CORPS27 INPUT PARAMETERS READ SUCCESSFULLY'
	CALL PCGP27(INFILE,SPCODE,UNITS,CONDIR,IOOPT)
	STOP
	END
C
	SUBROUTINE PCGP27(INFILE,SPCODE,UNITS,CONDIR,IOOPT)
	REAL*8 RHOSEC,SLAT,SLON,FLAT,FLON,X,Y,S,A,CSEC
	REAL*8 DDLAT,DDLON
	INTEGER STATE(2),SPCODE,CONDIR,II,UNITS,IOOPT
	INTEGER OLD,NZONE,COUNT
	INTEGER LATD,LATM,LOND,LONM,ICD,ICM
	CHARACTER*4 ICODE,IGP,IPC
	CHARACTER*25 NAME
	CHARACTER*60 INFILE
	LOGICAL*4 FOUND
	REAL*8 CORPSD(29)
	INTEGER*2 FLAG
	DATA RHOSEC/2.062648062471D05/,IGP/'GPPC'/,IPC/'PCGP'/

	OPEN(91,FILE=INFILE,ACCESS='SEQUENTIAL',FORM='BINARY',
     &ERR=25,STATUS='OLD')
	WRITE(*,*) 'CORPS27 INPUT FILE OPENED SUCCESSFULLY'
	OPEN(93,FILE='INT$OUT',ACCESS='SEQUENTIAL',FORM='BINARY',
     &ERR=25,STATUS='UNKNOWN')
	WRITE(*,*) 'CORPS27 OUTPUT FILE OPENED SUCCESSFULLY'
	OPEN(9,FILE='CORPS2.ERR',STATUS='UNKNOWN')
	OLD = SPCODE
	COUNT = 0
	IF (CONDIR.EQ.0) THEN
	 ICODE='GPPC'
	 GO TO 20
	ELSEIF (CONDIR.EQ.1) THEN
	 ICODE='PCGP'
	 GO TO 22
	ELSE
	 GO TO 25
	ENDIF
C
C     GP TO PC SECTION
C
  20  CONTINUE    
  11	 READ (91,END=25) NAME,(CORPSD(II),II=1,29),FLAG
	 DDLAT = CORPSD(9)
	 DDLON = CORPSD(10)
	 CALL GETNEW(OLD,NZONE,FOUND)
  15  FLAT = DBLE((DDLAT*3600.0D0)/RHOSEC)
	 FLON = DBLE((DDLON*3600.0D0)/RHOSEC)
c        IF (NZONE.EQ.0) GO TO 11
	 CALL DSPTCH (ICODE,NZONE,FLAT,FLON,STATE,X,Y,S,A,IERR)
	 IF (IERR.EQ.1) GO TO 25
	 CALL TODMS (A,ICD,ICM,CSEC)
	 IF (NZONE.EQ.30) LATD = -LATD
	 IF (UNITS.GT.1) THEN
		X = (X*1200.0D0)/3937.0D0
		Y = (Y*1200.0D0)/3937.0D0 
	 ENDIF
	 IF (UNITS.EQ.2) THEN
		X = (X*1250.0D0)/381.0D0
		Y = (Y*1250.0D0)/381.0D0 
	 ENDIF
	 CORPSD(1) = X
	 CORPSD(2) = Y
	 CORPSD(3) = DBLE(A*RHOSEC/3600.0D0)
c      IF (A.LT.0) THEN
c           CORPSD(3) = DBLE(ICD - ICM/60.0D0 - CSEC/3600.0D0)
c      ELSE
c           CORPSD(3) = DBLE(ICD + ICM/60.0D0 + CSEC/3600.0D0)
c      ENDIF
	 CORPSD(4) = S
	 write(*,*) 'ioopt = ',ioopt
	 IF(IOOPT.EQ.0) THEN
		CORPSD(27) = CORPSD(3)
		CORPSD(28) = CORPSD(4)
	 write(*,*) corpsd(27)
	 write(*,*) corpsd(28)
	 ENDIF
	 WRITE (93) NAME,CORPSD,FLAG
	 GO TO 11
C
C     PC TO GP SECTION
C
  22  CONTINUE
  31	 READ (91,END=25) NAME,(CORPSD(II),II=1,29),FLAG
	 X = CORPSD(1)
	 Y = CORPSD(2)
	 IF (UNITS.EQ.2) THEN
		X = (X*381.0D0)/1250.0D0
		Y = (Y*381.0D0)/1250.0D0 
	 ENDIF
	 IF (UNITS.GT.1) THEN
		X = (X*3937.0D0)/1200.0D0
		Y = (Y*3937.0D0)/1200.0D0 
	 ENDIF
	 CALL GETNEW (OLD,NZONE,FOUND)
c        IF (NZONE.EQ.TZONE) GO TO 40
c        TZONE=NZONE
   40 CALL DSPTCH (ICODE,NZONE,FLAT,FLON,STATE,X,Y,S,A,IERR)
	 IF (IERR.EQ.1) GO TO 25
	 CALL TODMS (FLAT,LATD,LATM,SLAT)
	 CALL TODMS (FLON,LOND,LONM,SLON)
	 CALL TODMS (A,ICD,ICM,CSEC)
	 CORPSD(9) = DBLE(LATD + LATM/60.0D0 + SLAT/3600.0D0)
	 CORPSD(10) = DBLE(LOND + LONM/60.0D0 + SLON/3600.0D0)
	 CORPSD(3) = DBLE(A*RHOSEC/3600.0D0)
c      IF (A.LT.0) THEN
c           CORPSD(3) = DBLE(ICD - ICM/60.0D0 - CSEC/3600.0D0)
c      ELSE
c           CORPSD(3) = DBLE(ICD + ICM/60.0D0 + CSEC/3600.0D0)
c      ENDIF
	 CORPSD(4) = S
	 IF(IOOPT.EQ.0) THEN
		CORPSD(27) = CORPSD(3)
		CORPSD(28) = CORPSD(4)
	 write(*,*) corpsd(27)
	 write(*,*) corpsd(28)
	 ENDIF
	 WRITE (93) NAME,CORPSD,FLAG
	GO TO 31
C
   25 CONTINUE
	CLOSE(91)
	CLOSE(93)
	CLOSE(9)
	WRITE(*,*) 'CORPS27 FILES CLOSED'
	WRITE(*,*) 'CORPS27 COMPLETE'
C
	RETURN
	END
C
	SUBROUTINE DSPTCH (ICODE,ZNCODE,FLAT,FLON,STATE,X,Y,S,A,IERR)
	REAL*8 FLAT,FLON,X,Y,S,A
	CHARACTER*4 ICODE
	INTEGER ZNCODE,ZONE,STATE(2),SABR(56),CPNT(56),ZABR(40)
	DIMENSION MAXZ(56),NPNT(56),NFL(3),NNY(4),NMI(6)
	DATA SABR /2HAL,2HAK,2HAS,2HAZ,2HAR,2HCA,2H07,2HCO,2HCT,2HDE,
     1           2HDC,2HFL,2HGA,2HGU,2HHI,2HID,2HIL,2HIN,2HIA,2HKS,
     2           2HKY,2HLA,2HME,2HMD,2HMA,2HMI,2HMN,2HMS,2HMO,2HMT,
     3           2HNE,2HNV,2HNH,2HNJ,2HNM,2HNY,2HNC,2HND,2HOH,2HOK,
     4           2HOR,2HPA,2HPR,2HRI,2HSC,2HSD,2HTN,2HTX,2HUT,2HVT,
     5           2HVA,2H52,2HWA,2HWV,2HWI,2HWY/
	DATA CPNT /101,300,275,103,202,204,800,211,214,
     1        106,225,400,109,700,111,116,119,121,216,
     2        218,220,222,123,225,226,600,231,128,130,
     3        234,237,133,136,137,138,500,240,241,243,
     4        245,247,249,273,144,251,253,255,256,261,
     5        145,264,800,266,268,270,146/
	DATA MAXZ / 2, 9, 0, 3, 2, 7,-1, 3, 0, 0,
     1            0, 3, 2, 0, 5, 3, 2, 2, 2, 2,
     2            2, 3, 2, 0, 2, 6, 3, 2, 3, 3,
     3            2, 3, 0, 0, 3, 4, 0, 2, 2, 2,
     4            2, 2, 2, 0, 2, 2, 0, 5, 3, 0,
     5            2,-1, 2, 2, 3, 4/
	DATA ZABR /2H  ,2HE ,2HW ,2HN ,2HS ,2HOF,2HE ,2HC ,2HW ,2HLI,
     1           2HN ,2HC ,2HS ,2H10,2H1 ,2H2 ,2H3 ,2H4 ,2H5 ,2H6 ,
     2           2H7 ,2H8 ,2H9 ,2HM ,2HIS,2HE ,2HTC,2HW ,2HN ,2HLC,
     3           2HS ,2HN ,2HNC,2HC ,2HSC,2HS ,2HE ,2HEC,2HWC,2HW /
	DATA NPNT / 1,14, 0, 6, 3,14, 0,10, 0, 0,
     1            0, 1, 1, 0,14, 6, 1, 1, 3, 3,
     2            3, 3, 1, 0,23,25,10, 1, 6,10,
     3            3, 6, 0, 0, 6, 6, 0, 3, 3, 3,
     4            3, 3, 0, 0, 3, 3, 0,31,10, 0,
     5            3, 0, 3, 3,10,36/
	DATA NFL /7,8,15/
	DATA NNY /41,42,43,39/
	DATA NMI /25,26,27,28,29,30/
	IERR = 0
	IF (ZNCODE.LT.11 .OR. ZNCODE.GT.564) GO TO 100
	NST = ZNCODE/10
	STATE(1) = SABR(NST)
	ZONE = MOD(ZNCODE,10)
	IF (ZONE.GT.0) GO TO 5
	IF (NST.NE.2) GO TO 2
	STATE(2) = ZABR(14)
	GO TO 8
    2 IF (MAXZ(NST).GT.0) GO TO 100
	STATE(2) = ZABR(1)
	GO TO 8
    5 IF (ZONE.GT.MAXZ(NST)) GO TO 100
	N = NPNT(NST) + ZONE
	STATE(2) = ZABR(N)
    8 IPOINT = CPNT(NST)/100
	GO TO (10,20,30,40,50,60,70,80), IPOINT
C   TRANSVERSE MERCATOR PROJECTION
   10 IF (ZONE.EQ.0) ZONE = 1
	LOC = CPNT(NST) + ZONE - 101
   12 CALL MERCAT (ICODE,LOC,ZNCODE,FLAT,FLON,X,Y,A,S)
	RETURN
C   LAMBERT CONIC CONFORMAL PROJECTION
   20 IF (ZONE.EQ.0) ZONE = 1
	LOC = CPNT(NST) + ZONE - 201
   22 CALL LAMBER (ICODE,LOC,ZNCODE,FLAT,FLON,X,Y,A,S)
	RETURN
C   ALASKA SPECIAL
   30 IF (ZONE.GT.0) GO TO 35
	LOC = 1
	GO TO 22
   35 CALL AKSPEC (ICODE,ZONE,FLAT,FLON,X,Y,A,S)
	RETURN
C   FLORIDA SPECIAL
   40 LOC = NFL(ZONE)
	IF (ZONE-3) 12,22,70
C   NEW YORK SPECIAL
   50 LOC = NNY(ZONE)
	IF (ZONE-4) 12,22,70
C   MICHIGAN SPECIAL
   60 LOC = NMI(ZONE)
	IF (ZONE-4) 12,22,22
C   AZIMUTHAL EQUIDISTANT
   70 CALL AZMEQD (ICODE,FLAT,FLON,X,Y,A,S)
	RETURN
C   NO SUCH STATE EXISTS
   80 X=0.0
	Y=0.0
	A=0.0
	S=0.0
	FLAT=0.0
	FLON=0.0
	RETURN
  100 IERR = 1
	RETURN
	END
C
	SUBROUTINE AKSPEC (ICODE,NZN,FLAT,FLON,X,Y,CC,S)
	IMPLICIT REAL*8 (A-H,O-Z)
	CHARACTER*4 IGP,IPC,ICODE
	DIMENSION C29(9),CM(9)
	DATA C29/6*5.0D5,7.0D5,5.0D5,6.0D5/,CM/2*5.112D5,5.256D5,5.4D5,
     *  5.544D5,5.688D5,5.832D5,5.976D5,6.12D5/
	DATA B/1.00029977273D0/,C/4.47599131D-3/,D/6.38635267013D6/,
     *  F/0.327015517176D0/,G/0.945018968871D0/,H/0.3460412203D0/,
     *  T/6.8147849D-3/,E/8.2271854223003D-2/,EE/2.718281828459045D0/,
     *  PI/3.14159265358979D0/,RHOSEC/2.06264806247D5/
	DATA IPC/'PCGP'/
	IF (ICODE.EQ.IPC) GO TO 20
	COSP=DCOS(FLAT)
	SINP=DSIN(FLAT)
	IF (NZN.GT.1) GO TO 10
C   ALASKA, ZONE 1
	C2=DSQRT(1.D0-E*E*SINP*SINP)
	BDL=B*(FLON-1.7717540856301D0)
	SNBDL=DSIN(BDL)
	CSBDL=DCOS(BDL)
	BUC=B*(DLOG(DTAN(PI/4.D0+FLAT/2.D0))
     *  -E/2.D0*DLOG((1.D0+E*SINP)/(1.D0-E*SINP)))+ C
	EP=EE**BUC
	EN=EE**(-BUC)
	P=0.5D0*(EP-EN)
	Q=0.5D0*(EP+EN)
	U=D*DATAN((G*P+F*SNBDL)/CSBDL)
	V=D/2.D0*DLOG((Q+F*P-G*SNBDL)/(Q-F*P+G*SNBDL))
	X=3.28083333333D0*(5.D6-0.6D0*U+0.8D0*V)
	Y=3.28083333333D0*(0.6D0*V+0.8D0*U-5.D6)
	CC=DATAN((3.D0*Q*CSBDL-4.D0*P*SNBDL-4.D0*H)/
     *       (4.D0*Q*CSBDL+3.D0*P*SNBDL+3.D0*H))
	S=1.0015773595D0*C2*DCOS(U/D)/(COSP/CSBDL)
	RETURN
C   ALASKA, ZONE 2-9
   10 CONTINUE
	DLON=(CM(NZN)-FLON*RHOSEC)/1.D4
	DLON2=DLON*DLON
	DLON4=DLON2*DLON2
	COSP2=COSP*COSP
	COSP4=COSP2*COSP2
	COSP6=COSP4*COSP2
	S2=DSQRT(1.D0+T*COSP2)
	S3=DSQRT(1.D0-COSP2)*COSP
	X=C29(NZN)+1.01786215D6*COSP/S2*DLON*(1.D0-3.91740509D-4*DLON2*
     *    (1.D0-2.D0*COSP2-T*COSP4)+4.60382D-8*DLON4*(1.D0-20.D0*COSP2+
     *    23.6047D0*COSP4+0.4907D0*COSP6))
	Y=101.269278503D0*(FLAT*RHOSEC-1.9390005442D5-(1.052893943D3-
     *    4.483386D0*COSP2+2.3599D-2*COSP4)*S3)+2.46736748D4*S3/S2*DLON2
     *    *(1.D0+1.958703D-4*DLON2*(-1.D0+6.D0*COSP2+6.133306D-2*COSP4+
     *    1.8577D-4*COSP6)+1.5346D-8*DLON4*(1.D0-60.D0*COSP2+
     *    117.75D0*COSP4+4.089D0*COSP6))
	CC=S3/COSP*DLON*(1.D4+7.83481D0*DLON2*(COSP2+2.044D-2*COSP4
     *    +0.9D-4*COSP6)+0.3683D-2*DLON4*(3.D0*COSP4-COSP2))/RHOSEC
	S=0.9999D0*(1.D0+S2**4/8.81572821D2*((X-C29(NZN))/1.D6)**2)
	RETURN
   20 CONTINUE
	IF (NZN.GT.1) GO TO 30
C   ALASKA, ZONE 1
	U=-0.182880365761D00*X+0.243840487681D00*Y +7.D06
	V=0.243840487681D00*X +0.182880365761D0*Y -1.D06
	FAR=V/D
	EP=EE**FAR
	EM=EE**(-FAR)
	R=(EP-EM)/2.D0
	S=(EP+EM)/2.D0
	SINUD=DSIN(U/D)
	COSUD=DCOS(U/D)
	GSUD=G*SINUD
	EM=EE**(DLOG((S+F*R+GSUD)/(S-F*R-GSUD))/(2.D0*B)-C/B)
	XR=2.D0*DATAN(EM)-PI/2.D0
	SINXR=DSIN(XR)
	COSXR=DCOS(XR)
	COSXR2=COSXR*COSXR
	FLAT=XR+SINXR*COSXR*(6.761032571D-3 +COSXR2*(5.3172205D-5 +
     1 COSXR2*(5.73027D-7 +COSXR2*7.128D-9)))
	FLON=1.7717540856301D0+DATAN((F*SINUD-G*R)/COSUD)/B
	RETURN
C   ALASKA, ZONE 2-9
   30 CONTINUE
	O1SEC=1.93900054420D05 +9.87466302498D-3*Y
	COSO1=DCOS(O1SEC/RHOSEC)
	COSO12=COSO1*COSO1
	SINO1=DSIN(O1SEC/RHOSEC)
	P1SEC=O1SEC+SINO1*COSO1*(1.047546691D3+COSO12*(6.193011D0 +
     *  5.0699D-2*COSO12))
	COSP1=DCOS(P1SEC/RHOSEC)
	COSP12=COSP1*COSP1
	COSP14=COSP12*COSP12
	TANP1=DTAN(P1SEC/RHOSEC)
	TANP12=TANP1*TANP1
	W=1.D0+T*COSP12
	W2=W*W
	FAR=(X-C29(NZN))*1.D-6
	FAR2=FAR*FAR
	FAR4=FAR2*FAR2
	PSEC=P1SEC-2.33973645D2*FAR2*W2*TANP1*(1.D0-1.8905604D-4*FAR2*
     *  (1.9591113D0+3.D0/COSP12+8.1359D-2*COSP12+2.79D-4*COSP14)+
     *  1.42969D-8*FAR4*W*(15.5D0+45.D0/COSP14-0.307D0/COSP12+
     *  1.53D0*COSP12))
	ESEC=CM(NZN)-9.824513072D3*DSQRT(W)/COSP1*FAR*(1.D0-3.7811208D-4*W
     *  *FAR2*(2.D0*TANP12+W)+4.2890624D-8*W2*FAR4*(1.054D0+24.D0/COSP14
     *  -20.D0/COSP12-1.36D-2*COSP12))
	FLAT=PSEC/RHOSEC
	FLON=ESEC/RHOSEC
	RETURN
	END
C
	SUBROUTINE AZMEQD (ICODE,FLAT,FLON,X,Y,CC,S)
	IMPLICIT REAL*8 (A-H,O-Z)
	CHARACTER*4 IGP,IPC,ICODE
	DIMENSION AED(18)
	DATA AED/5.0D4,3.092241724D1,5.2109550254D5,6.7686580D-3,
     1  3.087002482D1,4.82632837578D4,1.052893943D3,4.483386D0,2.3559D-2
     2 ,1.27564128D-1,4.82632837702D4,3.239388390D-2,1.87770D0,
     3  1.047546691D3,6.193011D0,5.0699D-2,5.2109550254D5,3.092241724D1/
	DATA RHOSEC/2.062648062471D05/
	DATA IPC/'PCGP'/
	IF (ICODE.EQ.IPC) GO TO 20
C
	SINP = DSIN(FLAT)
	COSP = DCOS(FLAT)
	TANP = DTAN(FLAT)
	SQ = DSQRT(1.0 - AED(4)*SINP**2)
	X = AED(1) + AED(2)*(FLON*RHOSEC-AED(3))*COSP/SQ
	X1 = (X-AED(1))**2/1.0D8
	T1 = FLAT*RHOSEC - AED(6) - (AED(7)-AED(8)*COSP**2+AED(9)*COSP**4)
     1  *SINP*COSP
	T2 = X1*TANP*SQ/AED(10)
	Y = AED(1) + AED(5)*T1 + T2
	CC = 0.0D0
	S = 1.0D0
	RETURN
C
   20 X1 = (X-AED(1))**2/1.0D8
	DO 30 I=1,3
	IF (I.GT.1) GO TO 25
	T2 = X1*AED(13)
	GO TO 28
   25   T2 = X1*TANP*SQ/AED(10)
   28   OMEGA = AED(11) + AED(12)*(Y-AED(1)-T2)
	SINM = DSIN(OMEGA/RHOSEC)
	COSM = DCOS(OMEGA/RHOSEC)
	PSEC = OMEGA + (AED(14) + AED(15)*COSM**2 + AED(16)*COSM**4)
     1    *SINM*COSM
	   FLAT = PSEC/RHOSEC
	   SINP = DSIN(FLAT)
	   TANP = DTAN(FLAT)
	SQ = DSQRT(1.0 - AED(4)*SINP**2)
   30 CONTINUE
	COSP = DCOS(FLAT)
	ESEC = AED(17) + (X-AED(1))*SQ/AED(18)/COSP
	FLON = ESEC/RHOSEC
	RETURN
	END
C
	SUBROUTINE LAMBER (ICODE,I,IC,P,E,X,Y,THETA,XK)
	IMPLICIT REAL*8 (A-H,O-Z)
	REAL*8 SINP,COSP,R,P,R1
	CHARACTER*4 IGP,IPC,ICODE
	REAL*8 LCDATA,LC1,LC2,LC3,LC4,LC5,LC6,LC7,LC8,LC9,LC0,L1,L2,L3,
     1 L4,L5,L6,L78,L9,L10,L11
	DIMENSION LCDATA(600),LC1(64),LC2(64),LC3(64),LC4(64),LC5(64),
     *  LC6(64),LC7(64),LC8(64),LC9(64),LC0(24),S(4)
	EQUIVALENCE (LCDATA(  1),LC1(1)),(LCDATA( 65),LC2(1)),
     *            (LCDATA(129),LC3(1)),(LCDATA(193),LC4(1)),
     *            (LCDATA(257),LC5(1)),(LCDATA(321),LC6(1)),
     *            (LCDATA(385),LC7(1)),(LCDATA(449),LC8(1)),
     *            (LCDATA(513),LC9(1)),(LCDATA(577),LC0(1))
	DATA IPC/'PCGP'/
C
C  THESE CONSTANTS ARE TAKEN FROM *STATE PLANE COORDINATES BY AUTOMATIC
C    DATA PROCESSING* BY CHARLES N. CLAIRE, C+GS PUBLICATION 62-4.
C
	DATA LC1 /
     * 6.3360D5,15.89395036D6,16.56462877D6,.9998480641D0,.7969223940D0,      40
     *           1.8970787068D5,3.79919D0,5.91550D0,                          40
     * 3.3120D5,29.27759361D6,29.73288287D6,.9999359370D0,.5818991407D0,      51
     *           1.2760635656D5,3.81452D0,3.26432D0,                          51
     * 3.3120D5,31.01403923D6,31.51172420D6,.9999184698D0,.5596906871D0,      52
     *           1.2203694711D5,3.81550D0,3.08256D0,                          52
     * 4.3920D5,24.24535805D6,24.79243623D6,.9998946358D0,.6538843192D0,      61
     *           1.4648675847D5,3.80992D0,3.93575D0,                          61
     * 4.3920D5,25.79585031D6,26.31225765D6,.9999146793D0,.6304679732D0,      62
     *           1.4019081964D5,3.81147D0,3.70114D0,                          62
     * 4.3380D5,27.05747585D6,27.51299204D6,.9999291792D0,.6122320427D0,      63
     *           1.3539552018D5,3.81265D0,3.52998D0,                          63
     * 4.2840D5,28.18240533D6,28.65293196D6,.9999407628D0,.5965871443D0,      64
     *           1.3135035494D5,3.81362D0,3.39020D0,                          64
     * 4.2480D5,30.19414554D6,30.64942427D6,.9999221277D0,.5700119219D0,      65
     *           1.2461210305D5,3.81523D0,3.16593D0/
	DATA LC2 /
     * 4.1850D5,31.84657092D6,32.27126772D6,.9999541438D0,.5495175982D0,      66
     *           1.1952016335D5,3.81642D0,3.00292D0,                          66
     * 4.2600D5,30.89138210D6,35.05539631D6,.9999885350D0,.5612432071D0,      67
     *           1.2242288096D5,3.81572D0,3.09520D0,                          67
     * 3.7980D5,24.75189768D6,25.08606820D6,.9999568475D0,.6461334829D0,      81
     *           1.4438462308D5,3.81044D0,3.85610D0,                          81
     * 3.7980D5,25.78137691D6,26.24305274D6,.9999359117D0,.6306895773D0,      82
     *           1.4024965162D5,3.81146D0,3.70326D0,                          82
     * 3.7980D5,26.97713389D6,27.40223182D6,.9999453995D0,.6133780528D0,      83
     *           1.3569426662D5,3.81257D0,3.54046D0,                          83
     * 2.6190D5,23.65923356D6,23.91438902D6,.9999831405D0,.6630594147D0,      90
     *           1.4899967980D5,3.80929D0,4.03278D0,                          90
     * 3.0420D5,36.03044305D6,36.45492453D6,.9999484343D0,.5025259000D0,     123
     *           1.0814611701D5,3.81898D0,2.65643D0,                         123
     * 3.3660D5,22.73695034D6,23.16246159D6,.9999453686D0,.6777445518D0,     191
     *           1.5308002265D5,3.80827D0,4.19479D0/
	DATA LC3/
     * 3.3660D5,23.93658511D6,24.37409667D6,.9999483705D0,.6587010213D0,     192
     *           1.4780259905D5,3.80959D0,3.98630D0,                         192
     * 3.5280D5,25.64495912D6,25.97906857D6,.9999568556D0,.6327148646D0,     201
     *           1.4078797215D5,3.81133D0,3.72376D0,                         201
     * 3.5460D5,26.89602448D6,27.35152150D6,.9999359200D0,.6145281068D0,     202
     *           1.3599441020D5,3.81250D0,3.55102D0,                         202
     * 3.0330D5,26.37182068D6,26.72405182D6,.9999620817D0,.6220672671D0,     211
     *           1.3797063364D5,3.81202D0,3.62113D0,                         211
     * 3.0870D5,27.46786075D6,27.83223564D6,.9999453808D0,.6064623718D0,     212
     *           1.3389657874D5,3.81301D0,3.47771D0,                         212
     * 3.3300D5,33.62456836D6,34.07962933D6,.9999147417D0,.5287006734D0,     221
     *           1.1443268515D5,3.81758D0,2.84511D0,                         221
     * 3.2880D5,36.27138935D6,36.75655345D6,.9999257458D0,.5000126971D0,     222
     *           1.0754855026D5,3.81911D0,2.63885D0,                         222
     * 3.2880D5,41.09174954D6,41.57676239D6,.9998947956D0,.4540068519D0,     223
     *            .9677930342D5,3.82138D0,2.27436D0/
	DATA LC4 /
     * 2.7720D5,25.98947499D6,26.36911276D6,.9999498485D0,.6276341196D0,     240
     *           1.3943969369D5,3.81166D0,3.67392D0,                         240
     * 2.5740D5,23.11197514D6,23.54947732D6,.9999645506D0,.6717286561D0,     251
     *           1.5139953138D5,3.80870D0,4.12738D0,                         251
     * 2.5380D5,23.78467844D6,23.92439802D6,.9999984844D0,.6610953994D0,     252
     *           1.4845947463D5,3.80943D0,4.01174D0,                         252
     * 3.1320D5,20.04171618D6,20.58942009D6,.9999410344D0,.7227899381D0,     264
     *           1.6610225085D5,3.80501D0,4.68430D0,                         264
     * 3.0360D5,21.00171522D6,21.59476840D6,.9999509058D0,.7064074100D0,     265
     *           1.6127076661D5,3.80622D0,4.46875D0,                         265
     * 3.0360D5,22.56484851D6,23.06959722D6,.9999450783D0,.6805292633D0,     266
     *           1.5386223938D5,3.80808D0,4.15706D0,                         266
     * 3.3516D5,18.98431962D6,19.47139875D6,.9999028166D0,.7412196637D0,     271
     *           1.7168463011D5,3.80362D0,5.01609D0,                         271
     * 3.3930D5,20.00667972D6,20.49345715D6,.9999220223D0,.7233880702D0,     272
     *           1.6628089747D5,3.80497D0,4.76197D0/
	DATA LC5 /
     * 3.3840D5,21.32700606D6,21.87434914D6,.9999220448D0,.7009277824D0,     273
     *           1.5968012517D5,3.80662D0,4.46959D0,                         273
     * 3.9420D5,18.68949840D6,19.15787426D6,.9999714855D0,.7464518080D0,     301
     *           1.7330021285D5,3.80322D0,5.09490D0,                         301
     * 3.9420D5,19.43293976D6,19.91980636D6,.9999220151D0,.7333538278D0,     302
     *           1.6928196779D5,3.80422D0,4.90135D0,                         302
     * 3.9420D5,20.50065051D6,21.09682093D6,.9999107701D0,.7149012442D0,     303
     *           1.6376115820D5,3.80560D0,4.64814D0,                         303
     * 3.6000D5,23.00434629D6,23.36897746D6,.9999645501D0,.6734507906D0,     311
     *           1.5187930504D5,3.80858D0,4.14653D0,                         311
     * 3.5820D5,24.10456106D6,24.59078186D6,.9999220725D0,.6560764003D0,     312
     *           1.4708468139D5,3.80977D0,3.95865D0,                         312
     * 2.6640D5,24.23500080D6,24.46254530D6,.9999949000D0,.6540820950D0,     364
     *           1.4654064240D5,3.80990D0,3.93780D0,                         364
     * 2.8440D5,29.63705947D6,30.18361125D6,.9998725510D0,.5771707700D0,     370
     *           1.2641160353D5,3.81480D0,3.22483D0/
	DATA LC6 /
     * 3.6180D5,18.81984905D6,19.21551601D6,.9999358426D0,.7441333961D0,     381
     *           1.7258257950D5,3.80339D0,5.05972D0,                         381
     * 3.6180D5,19.66102779D6,20.08697718D6,.9999358523D0,.7293826040D0,     382
     *           1.6808045445D5,3.80452D0,4.84504D0,                         382
     * 2.9700D5,24.04873851D6,24.55915847D6,.9999391411D0,.6569503193D0,     391
     *           1.4732348125D5,3.80971D0,3.96783D0,                         391
     * 2.9700D5,25.52287581D6,26.02707112D6,.9999359346D0,.6345195439D0,     392
     *           1.4126863705D5,3.81121D0,3.74048D0,                         392
     * 3.5280D5,28.65787166D6,29.08283170D6,.9999454101D0,.5901470744D0,     401
     *           1.2970256887D5,3.81402D0,3.33440D0,                         401
     * 3.5280D5,30.38283106D6,30.83803296D6,.9999359432D0,.5676166827D0,     402
     *           1.2401248935D5,3.81537D0,3.14645D0,                         402
     * 4.3380D5,20.83625094D6,21.38385248D6,.9998945810D0,.7091860222D0,     411
     *           1.6208208858D5,3.80602D0,4.57382D0,                         411
     * 4.3380D5,22.34130943D6,22.88866715D6,.9998946058D0,.6841473833D0,     412
     *           1.5488274104D5,3.80782D0,4.26823D0/
	DATA LC7 /
     * 2.7990D5,23.75535127D6,24.21105037D6,.9999568410D0,.6615397363D0,     421
     *           1.4858157953D5,3.80940D0,4.01753D0,                         421
     * 2.7990D5,24.57780067D6,24.98482643D6,.9999595012D0,.6487931668D0,     422
     *           1.4510387979D5,3.81026D0,3.88319D0,                         422
     * 2.9160D5,30.63012553D6,31.12772475D6,.9999454207D0,.5644973800D0,     451
     *           1.2323344099D5,3.81555D0,3.12127D0,                         451
     * 2.9160D5,32.25212630D6,32.67688765D6,.9999326284D0,.5446515700D0,     452
     *           1.1832357839D5,3.81669D0,2.94381D0,                         452
     * 3.6000D5,20.92270409D6,21.36669703D6,.9999391116D0,.7077381841D0,     461
     *           1.6165893392D5,3.80612D0,4.55529D0,                         461
     * 3.6120D5,21.99357561D6,22.46193705D6,.9999068931D0,.6898519579D0,     462
     *           1.5650154370D5,3.80742D0,4.33519D0,                         462
     * 3.0960D5,29.01023109D6,29.53514991D6,.9999484030D0,.5854397296D0,     470
     *           1.2850428313D5,3.81431D0,3.29422D0,                         470
     * 3.6540D5,29.45690729D6,29.97295994D6,.9999108771D0,.5795358654D0,     481
     *           1.2700858548D5,3.81466D0,3.24452D0/
	DATA LC8 /
     * 3.5100D5,32.18780958D6,32.69165454D6,.9998726224D0,.5453944146D0,     482
     *           1.1850595074D5,3.81665D0,2.97107D0,                         482
     * 3.6120D5,34.85170346D6,35.33712123D6,.9998817443D0,.5150588857D0,     483
     *           1.1114162181D5,3.81832D0,2.74550D0,                         483
     * 3.5640D5,37.26150920D6,37.80744038D6,.9998632433D0,.4899126408D0,     484
     *           1.0515719059D5,3.81962D0,2.56899D0,                         484
     * 3.5460D5,41.09174954D6,41.57676239D6,.9998947956D0,.4540068519D0,     485
     *            .9677930342D5,3.82138D0,2.33094D0,                         485
     * 4.0140D5,23.89487245D6,24.22911029D6,.9999568422D0,.6593554910D0,     491
     *           1.4798196231D5,3.80955D0,3.99323D0,                         491
     * 4.0140D5,25.11717675D6,25.66411442D6,.9998988207D0,.6405785926D0,     492
     *           1.4288930066D5,3.81081D0,3.80024D0,                         492
     * 4.0140D5,27.02595535D6,27.43281288D6,.9999512939D0,.6126873424D0,     493
     *           1.3551416878D5,3.81262D0,3.53414D0,                         493
     * 2.8260D5,26.23020009D6,26.57644445D6,.9999483859D0,.6241178597D0,     511
     *           1.3851078682D5,3.81189D0,3.64047D0/
	DATA LC9 /
     * 2.8260D5,27.43480006D6,27.81131271D6,.9999454027D0,.6069248249D0,     512
     *           1.3401641072D5,3.81298D0,3.48187D0,                         512
     * 4.3500D5,18.79808167D6,19.20586343D6,.9999422551D0,.7445203390D0,     531
     *           1.7270215711D5,3.80336D0,5.06556D0,                         531
     * 4.3380D5,19.83265352D6,20.28911960D6,.9999145875D0,.7263957947D0,     532
     *           1.6718172121D5,3.80474D0,4.80336D0,                         532
     * 2.8620D5,25.30502912D6,25.71512655D6,.9999407460D0,.6377729696D0,     541
     *           1.4213752979D5,3.81099D0,3.77244D0,                         541
     * 2.9160D5,26.63932345D6,27.07062078D6,.9999256928D0,.6181953936D0,     542
     *           1.3695382207D5,3.81227D0,3.58491D0,                         542
     * 3.2400D5,20.12413305D6,20.48917967D6,.9999453461D0,.7213707913D0,     551
     *           1.6567904034D5,3.80511D0,4.73451D0,                         551
     * 3.2400D5,21.05074699D6,21.43091391D6,.9999407059D0,.7055766312D0,     552
     *           1.6102881363D5,3.80628D0,4.52782D0,                         552
     * 3.2400D5,22.16143225D6,22.67213466D6,.9999325474D0,.6871032423D0,     553
     *           1.5572001691D5,3.80761D0,4.30274D0/
	DATA  LC0 /
     * 2.3916D5,63.54222166D6,63.68747944D6,.9999939449D0,.3128882281D0,     431
     *            .6532844933D5,3.82699D0,1.51030D0,                         431
     * 2.3916D5,63.54222166D6,63.78747944D6,.9999939449D0,.3128882281D0,     432
     *            .6532844933D5,3.82699D0,1.51030D0,                         432
     * 6.1200D5,-82.31223465D6,-82.0D6,.9999999999D0,-.2464352205D0,
     *           -.5110953291D5,3.82892D0,-1.16664D0/
C
	DATA C1/1.012794065D2/,C2/1.052893882D3/,C3/4.483344D0/,
     * C4/2.352D-2/,C5/2.092583216D7/,D1/9.873675553D-3/,
     * D2/1.04754671D3/,D3/6.19276D0/,D4/5.0912D-2/,ESQR/6.768658D-3/,
     * RHOSEC/2.062648062471D5/
C
	IF (IC.EQ.30) P = -P
C
	L1 = 2.0D6
C   ALASKA, ZONE 0
	IF (IC.EQ.20) L1 = 3.0D6
C   CALIFORNIA, ZONE 7
	IF (IC.EQ.67) L1 = 4.18669258D6
C   CONN       MASS, ZONE 1
	IF (IC.EQ.90 .OR. IC.EQ.251) L1 = 6.0D5
C   MARYLAND
	IF (IC.EQ.110 .OR. IC.EQ.240) L1 = 8.0D5
C   MASS, ZONE 2
	IF (IC.EQ.252) L1 = 2.0D5
C   PUERTO RICO      SAMOA
	IF (IC.EQ.431.OR.IC.EQ.432 .OR. IC.EQ.30) L1 = 5.0D5
C
	L11 = 0.0
C   ALASKA, ZONE 0
	IF (IC.EQ.20) L11 = 44.D0
C   LOUISIANA, ZONE 3
	IF (IC.EQ.223) L11 = 25.D0
C   MICHIGAN, ZONES 4 - 6
	IF (IC.EQ.264) L11 = 36.D0
	IF (IC.EQ.265) L11 = 35.D0
	IF (IC.EQ.266) L11 = 33.D0
C
	L=I*8
	L2=LCDATA(L-7)
	L3=LCDATA(L-6)
	L4=LCDATA(L-5)
	L5=LCDATA(L-4)
	L6=LCDATA(L-3)
	L78=LCDATA(L-2)
	L9=LCDATA(L-1)
	L10=LCDATA(L)
C
	IF (ICODE.EQ.IPC) GO TO 10
	SINP=DSIN(P)
	COSP=DCOS(P)
	COSP2=COSP*COSP
	SS=C1*(L78-P*RHOSEC+(C2-(C3-C4*COSP2)*COSP2)*SINP*COSP)
	S8=SS*1.0D-8
	S82=S8*S8
	R1=DBLE(L9-S8*L10+S82*L11)
	R=DBLE(L3+SS*L5*(1.D0+S82*R1))
	THETA=L6*(L2-E*RHOSEC)/RHOSEC
	X=L1+R*DSIN(THETA)
	Y=L4-R+2.D0*R*DSIN(THETA*0.5D0)**2
c      XK=DBLE(L6*R*DSQRT(1.D0-ESQR*SINP*SINP))
c      XK=DBLE(XK/C5/COSP)
	XK=(L6*R*DSQRT(1.D0-ESQR*DSIN(P)*DSIN(P))/C5)/DCOS(P)
	IF (IC.EQ.264 .OR. IC.EQ.265 .OR. IC.EQ.266) THEN
	 XK = XK/1.0000382D0
	ENDIF
	write(9,*) "Scale",XK,IC
	RETURN
C
   10 CONTINUE
	THETA=DATAN((X-L1)/(L4-Y))
	THSEC=THETA*RHOSEC
	ESEC=L2-THSEC/L6
	E=ESEC/RHOSEC
	COSTH=DCOS(THETA)
	SHLFT=(DSIN(THETA/2.D0))**2
	R=(L4-Y)/COSTH
	S1=(L4-L3-Y+2.D0*R*SHLFT)/L5
	S(1)=S1
	DO 20 I=1,3
	 FAR=S(I)*1.D-8
	 S(I+1)=S1/(1.D0+FAR*FAR*(L9-FAR*L10+FAR*FAR*L11))
   20    CONTINUE
	OMSEC=L78-D1*S(4)
	OMEGA=OMSEC/RHOSEC
	SINO=DSIN(OMEGA)
	COSO=DCOS(OMEGA)
	COS2O=COSO*COSO
	PSEC=OMSEC+(D2+(D3+D4*COS2O)*COS2O)*SINO*COSO
	P=PSEC/RHOSEC
	SINP=DSIN(P)
	COSP=DCOS(P)
c      XK=DBLE(L6*R*DSQRT(1.D0-ESQR*SINP*SINP))
c      XK=DBLE(XK/C5/COSP)
	XK=(L6*R*DSQRT(1.D0-ESQR*DSIN(P)*DSIN(P))/C5)/DCOS(P)
	IF (IC.EQ.264 .OR. IC.EQ.265 .OR. IC.EQ.266) THEN
	 XK = XK/1.0000382D0
	ENDIF
	write(9,*) "Scale",XK,IC
	RETURN
	END
C
	SUBROUTINE MERCAT (ICODE,I,IC,P,E,X,Y,DA,XK)
	IMPLICIT REAL*8 (A-H,O-Z)
	DIMENSION TMDATA(196),TM1(64),TM2(64),TM3(68)
	CHARACTER*4 IGP,IPC,ICODE
	EQUIVALENCE (TMDATA(1),TM1(1)),(TMDATA(65),TM2(1)),
     *            (TMDATA(129),TM3(1))
	DATA IPC/'PCGP'/
C                                                                        06NOV72
C  THESE CONSTANTS ARE TAKEN FROM *STATE PLANE COORDINATES BY AUTOMATIC
C    DATA PROCESSING* BY CHARLES N. CLAIRE, C+GS PUBLICATION 62-4.
C
	DATA TM1 /                                                         06NOV72
     *  3.090D5,  109341.00903D0,  0.9999600000D0,  0.3817065D0,         06NOV72
     *  3.150D5,  107545.53386D0,  0.9999333333D0,  0.3817477D0,         06NOV72
     *  3.966D5,  111136.62358D0,  0.9999000000D0,  0.3816485D0,         06NOV72
     *  4.029D5,  111136.62358D0,  0.9999000000D0,  0.3816485D0,         06NOV72
     *  4.095D5,  111136.62358D0,  0.9999333333D0,  0.3815948D0,         06NOV72
     *  2.715D5,  136290.53702D0,  0.9999950281D0,  0.3811454D0,         06NOV72
     *  2.916D5,   87206.09287D0,  0.9999411765D0,  0.3821090D0,         06NOV72
     *  2.952D5,   87206.09287D0,  0.9999411765D0,  0.3821090D0,         06NOV72
     *  2.958D5,  107545.53386D0,  0.9999000000D0,  0.3817593D0,         06NOV72
     *  3.030D5,  107545.53386D0,  0.9999000000D0,  0.3817593D0,         06NOV72
     *  5.598D5,   67479.52714D0,  0.9999666667D0,  0.3826496D0,         06NOV72
     *  5.640D5,   72858.21554D0,  0.9999666667D0,  0.3825762D0,         06NOV72
     *  5.688D5,   75846.77497D0,  0.9999900000D0,  0.3825176D0,         06NOV72
     *  5.742D5,   78237.83623D0,  0.9999900000D0,  0.3824812D0,         06NOV72
     *  5.766D5,   77640.05280D0,  0.9999999999D0,  0.3824867D0,         06NOV72
     *  4.038D5,  149478.35156D0,  0.9999473684D0,  0.3807624D0/
	DATA TM2 /                                                         06NOV72
     *  4.104D5,  149478.35156D0,  0.9999473684D0,  0.3807624D0,         06NOV72
     *  4.167D5,  149478.35156D0,  0.9999333333D0,  0.3806227D0,         06NOV72
     *  3.180D5,  131497.04639D0,  0.9999750000D0,  0.3811074D0,         06NOV72
     *  3.246D5,  131497.04639D0,  0.9999411765D0,  0.3811332D0,         06NOV72
     *  3.084D5,  134492.84965D0,  0.9999666667D0,  0.3811064D0,         06NOV72
     *  3.135D5,  134492.84965D0,  0.9999666667D0,  0.3811064D0,         06NOV72
     *  2.466D5,  157275.15187D0,  0.9999000000D0,  0.3806180D0,         06NOV72
     *  2.526D5,  153676.25668D0,  0.9999666667D0,  0.3806575D0,         06NOV72
     *  3.012D5,  148878.72150D0,  0.9999428571D0,  0.3807283D0,         06NOV72
     *  3.087D5,  148878.72150D0,  0.9999090909D0,  0.3807541D0,         06NOV72
     *  3.195D5,  148878.72150D0,  0.9999090909D0,  0.3805361D0,         06NOV72
     *  3.198D5,  106348.62716D0,  0.9999600000D0,  0.3817257D0,         06NOV72
     *  3.252D5,  109341.00903D0,  0.9999411765D0,  0.3816986D0,         06NOV72
     *  3.258D5,  128501.66790D0,  0.9999333333D0,  0.3812643D0,         06NOV72
     *  3.330D5,  128501.66790D0,  0.9999333333D0,  0.3812422D0,         06NOV72
     *  3.402D5,  129699.76857D0,  0.9999411765D0,  0.3812362D0/
	DATA TM3 /                                                         06NOV72
     *  4.161D5,  124608.30429D0,  0.9999000000D0,  0.3812311D0,         06NOV72
     *  4.200D5,  124608.30429D0,  0.9999000000D0,  0.3812311D0,         06NOV72
     *  4.269D5,  124608.30429D0,  0.9999000000D0,  0.3812311D0,         06NOV72
     *  2.580D5,  152476.76677D0,  0.9999666667D0,  0.3807327D0,         06NOV72
     *  2.688D5,  139287.02745D0,  0.9999750295D0,  0.3810845D0,         06NOV72
     *  3.756D5,  111136.62358D0,  0.9999090909D0,  0.3816135D0,
     *  3.825D5,  111136.62358D0,  0.9999000000D0,  0.3816204D0,
     *  3.882D5,  111136.62358D0,  0.9999166667D0,  0.3816288D0,         06NOV72
     *  2.676D5,  143482.84247D0,  0.9999666667D0,  0.3808377D0,         06NOV72
     *  2.757D5,  143482.84247D0,  0.9999375000D0,  0.3808450D0,         06NOV72
     *  2.829D5,  143482.84247D0,  0.9999375000D0,  0.3808750D0,         06NOV72
     *  2.574D5,  147379.72344D0,  0.9999937500D0,  0.3809220D0,         06NOV72
     *  2.610D5,  152476.76677D0,  0.9999642857D0,  0.3807420D0,         06NOV72
     *  3.786D5,  145880.83533D0,  0.9999411765D0,  0.3808422D0,         06NOV72
     *  3.864D5,  145880.83533D0,  0.9999411765D0,  0.3808422D0,         06NOV72
     *  3.915D5,  145880.83533D0,  0.9999411765D0,  0.3808422D0,         06NOV72
     *  3.963D5,  145880.83533D0,  0.9999411765D0,  0.3808422D0/
C
	DATA ESQ,C1,C2,C3,C4,C5,C6,C7,C8,C9,C10,C11,EPSQ,RHOSEC/
     1 6.768658D-3,3.092241724D01,3.9174D00,4.0831D00,3.28083333D00,
     2 2.552381D-9,1.012794065D02,1.052893882D03,4.483344D0,2.352D-2,
     3 1.9587D-12,8.81749162D02,6.8147849D-3,2.062648062471D05/
	DATA D1,D2,D3,D4,D5,D6,D7,D8,D9/
     1 0.3048006099D00,0.9873675553D-2,1.047546710D03,
     2 6.192760D00,5.0912D-2,2.552381D01,4.0831D00,3.092241724D01,
     3 3.9174D00/
C
	T1=0.5D6
C   NEW JERSEY
	IF (IC.EQ.340) T1=2.0D6
C
	L=I*4
	T2=TMDATA(L-3)
	T34=TMDATA(L-2)
	T5=TMDATA(L-1)
	T6=TMDATA(L)
C
	IF (ICODE.EQ.IPC) GO TO 10
C
	SINP=DSIN(P)
	COSP=DCOS(P)
	COSP2=COSP*COSP
	SINP2=SINP*SINP
	TANP=DTAN(P)
	W2=1.D0-ESQ*SINP2
	V2=1.D0+EPSQ*COSP2
	PSEC=P*RHOSEC
	ESEC=E*RHOSEC
C
	S1=C1*COSP*(T2-ESEC-C2*((T2-ESEC)/1.D04)**3)/DSQRT(W2)
	SM=S1+C3*(S1*1.D-5)**3
	X=T1+C4*SM*T5+T6*((C4*SM*T5*1.D-5)**3)
	P1SEC=PSEC+C5*SM*SM*W2*W2*TANP
	P1=P1SEC/RHOSEC
	SINP1=DSIN(P1)
	TANP1=DTAN(P1)
	W2=1.D0-ESQ*SINP1*SINP1
	P2SEC=PSEC+C5*SM*SM*W2*W2*TANP1
	P2=P2SEC/RHOSEC
	COSP2=DCOS(P2)
	COSP2S=COSP2*COSP2
	SINP2=DSIN(P2)
	SINM=DSIN((P+P2)/2.D0)
	COSM=DCOS((P+P2)/2.D0)
	TMS=T2-ESEC
	Y=C6*T5*(P2SEC-T34-(C7-(C8-C9*COSP2S)*COSP2S)*SINP2*COSP2)
	DASEC=TMS*SINM*(1.D0+C10*TMS*TMS*COSM*COSM)
	DA=DASEC/RHOSEC
	XK=T5*(1.D0+(V2*V2*((X-T1)*1.D-6)**2)/(C11*T5*T5))
	RETURN
C
   10 CONTINUE
	SG1=(X-T1)*(1.D0-T6*1.D-15*(X-T1)*(X-T1))
	SM=D1*(X-T1-T6*1.D-15*SG1**3)/T5
	OMSEC=T34+D2*Y/T5
	OMEGA=OMSEC/RHOSEC
	SINO=DSIN(OMEGA)
	COSO=DCOS(OMEGA)
	COS2O=COSO*COSO
	P1SEC=OMSEC+(D3+(D4+D5*COS2O)*COS2O)*SINO*COSO
	P1RAD=P1SEC/RHOSEC
	SINP1=DSIN(P1RAD)
	SIN2P1=SINP1*SINP1
	TANP1=DTAN(P1RAD)
	W=1.D0-ESQ*SIN2P1
	PSEC=P1SEC-D6*W*W*TANP1*SM*SM*1.D-10
	SA=SM*(1.D0-D7*SM*SM*1.D-15)
	S1=SM-D7*1.D-15*SA**3
	P=PSEC/RHOSEC
	SINP=DSIN(P)
	COSP=DCOS(P)
	W=DSQRT(1.D0-ESQ*SINP*SINP)
	DL1SEC=S1*W/(D8*COSP)
	DLASEC=DL1SEC*(1.D0+D9*DL1SEC*DL1SEC*1.D-12)
	ESEC=T2-DL1SEC-D9*1.D-12*DLASEC**3
	E=ESEC/RHOSEC
c convergence
	SINP=DSIN(P)
	COSP=DCOS(P)
	COSP2=COSP*COSP
	SINP2=SINP*SINP
	TANP=DTAN(P)
	W2=1.D0-ESQ*SINP2
	V2=1.D0+EPSQ*COSP2
	PSEC=P*RHOSEC
	ESEC=E*RHOSEC
C
	S1=C1*COSP*(T2-ESEC-C2*((T2-ESEC)/1.D04)**3)/DSQRT(W2)
	SM=S1+C3*(S1*1.D-5)**3
	P1SEC=PSEC+C5*SM*SM*W2*W2*TANP
	P1=P1SEC/RHOSEC
	SINP1=DSIN(P1)
	TANP1=DTAN(P1)
	W2=1.D0-ESQ*SINP1*SINP1
	P2SEC=PSEC+C5*SM*SM*W2*W2*TANP1
	P2=P2SEC/RHOSEC
	SINM=DSIN((P+P2)/2.D0)
	COSM=DCOS((P+P2)/2.D0)
	TMS=T2-ESEC
	DASEC=TMS*SINM*(1.D0+C10*TMS*TMS*COSM*COSM)
	DA=DASEC/RHOSEC
c
	COSP2=COSP*COSP
	V2=1.D0+EPSQ*COSP2
	XK=T5*(1.D0+(V2*V2*((X-T1)*1.D-6)**2)/(C11*T5*T5))
	RETURN
	END
C
	SUBROUTINE TODMS(RAD,IDG,MIN,SEC)                                     0745
C                                                                           0746
C     RADIANS TO DEGREES,MINUTES AND SECONDS                                0747
C                                                                           0748
	REAL*8 RAD,SEC,RHOSEC
	DATA RHOSEC/2.062648062471D05/
	SEC=RAD*RHOSEC                                                        0750
	IDG=SEC/3600.D0
	SEC=SEC-DBLE(IDG*3600)
	MIN=SEC/60.D0
	SEC=SEC-DBLE(MIN*60)
	IF((60.D0-DABS(SEC)).GT.5.D-6) GO TO 100
	SEC=SEC-DSIGN(60.D0,SEC)
	MIN=MIN+ISIGN(1,MIN)
  100 IF(IABS(MIN).LT.60) GO TO 101
	MIN=MIN-ISIGN(60,MIN)
	IDG=IDG+ISIGN(1,IDG)
  101 MIN=IABS(MIN)
	SEC=DABS(SEC)
	IF(RAD.GE.0.D0) GO TO 102
	IF(IDG.EQ.0) MIN=-MIN
	IF(IDG.EQ.0.AND.MIN.EQ.0)SEC=-SEC                                     0761
  102 RETURN                                                                0762
	END                                                                   0763
C
	SUBROUTINE GETNEW(OLD, NZONE, FOUND)

* PARAMETERS

	 LOGICAL*4     FOUND
	 INTEGER*4     NZONE
	 INTEGER*4     OLD

*  LOCAL STATIC VARIABLES

	 INTEGER*4     ZOLD(134)
	 INTEGER*4     ZNEW(134)

*  ALABAMA

	DATA (ZOLD(I), I=1, 2) /0101, 0102 /

	DATA (ZNEW(I), I=1, 2) /011, 012 /


*  ALASKA

	DATA (ZOLD(I), I=3, 12) /5001, 5002, 5003, 5004,
     .                         5005, 5006, 5007, 5008,
     .                         5009, 5010 /

	DATA (ZNEW(I), I=3, 12) /021, 022, 023, 024, 025, 026,
     .                          027, 028, 029, 020 /


*  ARIZONA

	DATA (ZOLD(I), I=13, 15) /0201, 0202, 0203 /

	DATA (ZNEW(I), I=13, 15) /041, 042, 043 /


*  ARKANSAS

	DATA (ZOLD(I), I=16, 17) /0301, 0302/
	DATA (ZNEW(I), I=16, 17) /051, 052 /

* CALIFONIA

	DATA (ZOLD(I), I=18, 24) /0401, 0402, 0403, 0404, 0405,
     .                          0406, 0407 /
	DATA (ZNEW(I), I=18, 24) /061, 062, 063, 064, 065, 066,
     .                          067 /

*  COLORADO

	DATA (ZOLD(I), I=25, 27) /0501, 0502, 0503 /
	DATA (ZNEW(I), I=25, 27) /081, 082, 083 /

*  CONNECTICUT

	DATA (ZOLD(I), I=28, 28) /0600 /
	DATA (ZNEW(I), I=28, 28) /090 /

*  DELAWARE

	DATA (ZOLD(I), I=29, 29) /0700 /
	DATA (ZNEW(I), I=29, 29) /100 /
 
*  FLORIDA
 
	DATA (ZOLD(I), I=30, 32) /0901, 0902, 0903/
	DATA (ZNEW(I), I=30, 32) /121, 122, 123 /
 
*  GEORGIA
 
	DATA (ZOLD(I), I=33, 34) /1001, 1002 /
	DATA (ZNEW(I), I=33, 34) /131, 132 /
 
*  HAWAII
 
	DATA (ZOLD(I), I=35, 39) /5101, 5102, 5103, 5104, 5105 /
	DATA (ZNEW(I), I=35, 39) /151, 152, 153, 154, 155 /
 
*  IDAHO

	DATA (ZOLD(I), I=40, 42) /1101, 1102, 1103 /
	DATA (ZNEW(I), I=40, 42) /161, 162, 163 /
 
*  ILLINOIS
 
	DATA (ZOLD(I), I=43, 44) /1201, 1202 /
	DATA (ZNEW(I), I=43, 44) /171, 172 /
 
*  INDIANA
 
	DATA (ZOLD(I), I=45, 46) /1301, 1302 /
	DATA (ZNEW(I), I=45, 46) /181, 182 /
 
*  IOWA
 
	DATA (ZOLD(I), I=47, 48) /1401, 1402 /
	DATA (ZNEW(I), I=47, 48) /191, 192 /
 
*  KANSAS

	DATA (ZOLD(I), I=49, 50) /1501, 1502 /
	DATA (ZNEW(I), I=49, 50) /201, 202 /
 
*  KENTUCKY
 
	DATA (ZOLD(I), I=51, 52) /1601, 1602/
	DATA (ZNEW(I), I=51, 52) /211, 212 /
 
*  LOUISIANA
 
	DATA (ZOLD(I), I=53, 55) /1701, 1702, 1703 /
	DATA (ZNEW(I), I=53, 55) /221, 222, 223 /
 
*  MAINE
 
	DATA (ZOLD(I), I=56, 57) /1801, 1802 /
	DATA (ZNEW(I), I=56, 57) /231, 232 /
 
*  MARYLAND

	DATA (ZOLD(I), I=58, 58) /1900 /
	DATA (ZNEW(I), I=58, 58) /240 /
 
*  MASSACHUSETTS
 
	DATA (ZOLD(I), I=59, 60) /2001, 2002 /
	DATA (ZNEW(I), I=59, 60) /251, 252 /
 
*MICHIGAN
 
	DATA (ZOLD(I), I=61, 66) /2101, 2102, 2103, 2111, 2112, 2113 /
	DATA (ZNEW(I), I=61, 66) /261, 262, 263, 264, 265, 266 /
 
*  MINNESOTA
 
	DATA (ZOLD(I), I=67, 69) /2201, 2202, 2203 /
	DATA (ZNEW(I), I=67, 69) /271, 272, 273 /
 
*  MISSISSIPPI

	DATA (ZOLD(I), I=70, 71) /2301, 2302 /
	DATA (ZNEW(I), I=70, 71) /281, 282 /
 
*  MISSOURI
 
	DATA (ZOLD(I), I=72, 74) /2401, 2402, 2403 /
	DATA (ZNEW(I), I=72, 74) /291, 292, 293 /
 
*  MONTANA
 
	DATA (ZOLD(I), I=75, 77) /2501, 2502, 2503 /
	DATA (ZNEW(I), I=75, 77) /301, 302, 303 /
 
*  NEBRASKA
 
	DATA (ZOLD(I), I=78, 79) /2601, 2602 /
	DATA (ZNEW(I), I=78, 79) /311, 312 /
 
*  NEVADA

	DATA (ZOLD(I), I=80, 82) /2701, 2702, 2703 /
	DATA (ZNEW(I), I=80, 82) /321, 322, 323 /
 
*  NEW HAMPSHIRE
 
	DATA (ZOLD(I), I=83,83) /2800 /
	DATA (ZNEW(I), I=83,83) /330 /
 
*  NEW JERSEY
 
	DATA (ZOLD(I), I=84,84) /2900 /
	DATA (ZNEW(I), I=84,84) /340 /
 
*  NEW MEXICO
 
	DATA (ZOLD(I), I=85,87) /3001, 3002, 3003 /
	DATA (ZNEW(I), I=85,87) /351, 352, 353 /
 
*  NEW YORK

	DATA (ZOLD(I), I=88,91) /3101, 3102, 3103, 3104 /
	DATA (ZNEW(I), I=88,91) /361, 362, 363, 364 /
 
*  NORTH CAROLINA
 
	DATA (ZOLD(I), I=92,92) /3200 /
	DATA (ZNEW(I), I=92,92) /370 /
 
*  NORTH DAKOTA
 
	DATA (ZOLD(I), I=93,94) /3301, 3302 /
	DATA (ZNEW(I), I=93,94) /381, 382 /
 
*  OHIO
 
	DATA (ZOLD(I), I=95,96) /3401, 3402 /
	DATA (ZNEW(I), I=95,96) /391 , 392 /
 
*  OKLAHOMA

	DATA (ZOLD(I), I=97,98) /3501, 3502 /
	DATA (ZNEW(I), I=97,98) /401, 402 /
 
*  OREGON
 
	DATA (ZOLD(I), I=99,100) /3601, 3602 /
	DATA (ZNEW(I), I=99,100) /411, 412 /
 
*  PENNSYLVANIA
 
	DATA (ZOLD(I), I=101,102) /3701, 3702 /
	DATA (ZNEW(I), I=101,102) /421, 422 /
 
*  RHODE ISLAND
 
	DATA (ZOLD(I), I=103,103) / 3800 /
	DATA (ZNEW(I), I=103,103) /440 /
 
*  SOUTH CAROLINA

	DATA (ZOLD(I), I=104,105) /3901, 3902 /
	DATA (ZNEW(I), I=104,105) /451, 452 /
 
*  SOUTH DAKOTA
 
	DATA (ZOLD(I), I=106,107) /4001, 4002 /
	DATA (ZNEW(I), I=106,107) /461, 462 /
 
*  TENNESSEE
 
	DATA (ZOLD(I), I=108,108) /4100 /
	DATA (ZNEW(I), I=108,108) /470 /
 
*  TEXAS
 
	DATA (ZOLD(I), I=109,113) /4201, 4202, 4203, 4204, 4205/
	DATA (ZNEW(I), I=109,113) /481, 482, 483, 484, 485 /
 
*  UTAH

	DATA (ZOLD(I), I=114,116) /4301, 4302, 4303 /
	DATA (ZNEW(I), I=114,116) /491, 492, 493 /
 
*  VERMONT
 
	DATA (ZOLD(I), I=117,117) /4400 /
	DATA (ZNEW(I), I=117,117) /500 /
 
*  VIRGINIA
 
	DATA (ZOLD(I), I=118,119) /4501, 4502 /
	DATA (ZNEW(I), I=118,119) /511, 512 /
 
*  WASHINGTON
 
	DATA (ZOLD(I), I=120,121) /4601, 4602 /
	DATA (ZNEW(I), I=120,121) /531 ,532 /
 
*  WEST VIRGINIA

	DATA (ZOLD(I), I=122,123) /4701 ,4702 /
	DATA (ZNEW(I), I=122,123) /541, 542 /
 
*  WISCONSIN
 
	DATA (ZOLD(I), I=124,126) /4801, 4802, 4803 /
	DATA (ZNEW(I), I=124,126) /551, 552, 553 /
 
*  WYOMING
 
	DATA (ZOLD(I), I=127,130) /4901, 4902, 4903, 4904 /
	DATA (ZNEW(I), I=127,130) /561, 562, 563, 564 /
 
*  AMERICIAN SOMOA
 
	DATA (ZOLD(I), I=131,131) /5300 /
	DATA (ZNEW(I), I=131,131) /030 /
 
*  GUAM

	DATA (ZOLD(I), I=132,132) /5400 /
	DATA (ZNEW(I), I=132,132) /140 /
 
*  PUERTO RICO AND VIRGIN ISLANDS
 
	DATA (ZOLD(I), I=133,133) /5201 /
	DATA (ZNEW(I), I=133,133) /431 /
 
*  ST. CROIX
	DATA (ZOLD(I), I=134,134) /5202 /
	DATA (ZNEW(I), I=134,134) /432 /
 
	 FOUND=.FALSE.
	DO 100 I=1, 134
	IF(OLD.EQ.ZOLD(I)) THEN
	 FOUND=.TRUE.
	 K=I
	 NZONE=ZNEW(K)
	 RETURN
	ENDIF
 
 100  CONTINUE
 
	 RETURN
	 END
