C SccsID = "@(#)drpcgp.for 1.2 01/28/02" SUBROUTINE DRPCGP(CARDR,ICODE,FILFLAG,FILPRT) IMPLICIT DOUBLE PRECISION(A-H,O-Z) DIMENSION SPCC(135,6),IZC(135),UTMC(60),ICODE(3) LOGICAL FILFLAG,FILPRT CHARACTER*1 AP(135) CHARACTER*4 ZN(135),ZONE CHARACTER*80 CARDR REAL*8 LAT,LON,NORTH,KP,NB,KC,LATC,LONC,LONO,K,KO,NO COMMON/TAB/SPCC,UTMC,IZC COMMON/CHAR/ZN,AP COMMON/CONST/RAD,ER,RF,ESQ,PI COMMON/XY/NORTH,EAST DO 10 J=1,3 IF(ICODE(J).EQ.0) RETURN IZ=0 DO 20 I=1,135 IF(IZC(I).EQ.ICODE(J)) IZ=I 20 CONTINUE IF(IZ.EQ.0) THEN WRITE(6,30) ICODE(J) 30 FORMAT('0IMPROPER STATE ZONE CODE-',I4) GO TO 10 ELSEIF(AP(IZ).EQ.'N') THEN WRITE(6,40)ICODE(J) 40 FORMAT('0THE ZONE CONSTANTS ARE NOT ', * 'YET AVAILABLE FOR -',I4) GO TO 10 ELSEIF(AP(IZ).EQ.'L') THEN *** PERFORM LAMBERT CONIC CONVERSION *** GET ALL THE ZONE CONSTANCES **** CM=SPCC(IZ,1)/RAD EO=SPCC(IZ,2) NB=SPCC(IZ,3) FIS=SPCC(IZ,4)/RAD FIN=SPCC(IZ,5)/RAD FIB=SPCC(IZ,6)/RAD **** FIND ZONE NAME ******** ZONE=ZN(IZ) * * * * COMPUTE ALL CONSTANCES FOR PROJECTION * CALL LCONST(ER,RF,FIS,FIN,FIB,ESQ,E,SINFO,RB,K,KO,NO, & G,NB) * * CONVERT PCS TO LAT AND LONG * CALL LAMR1 (NORTH,EAST,LAT,LON,CM,EO,NB,SINFO,RB,K, & ER,ESQ,CONV,KP) * * PRINT OUTPUT * CALL FORMPC(CARDR,LAT,LON,FILFLAG,J,FILPRT,ZONE,CONV,KP) * *** PERFORM TRANSVERSE MERCATOR ELSEIF(AP(IZ).EQ.'T') THEN CM=SPCC(IZ,1)/RAD FE=SPCC(IZ,2) OR=SPCC(IZ,3)/RAD SF=1.D0-1.D0/SPCC(IZ,4) FN=SPCC(IZ,5) **** FIND ZONE NAME ******** ZONE=ZN(IZ) IF(ZONE.EQ.'HI 5') THEN SF= 1.0D0 ENDIF * * * * COMPUTE ALL CONSTANCES FOR PROJECTION * CALL TCONPC (SF,OR,EPS,R,SO,V0,V2,V4,V6,ER,ESQ) * * CONVERT PCS TO LAT AND LONG * CALL TMGEOD(NORTH,EAST,LAT,LON,EPS,CM,FE,SF,SO,R,V0,V2, & V4,V6,FN,ER,ESQ,CONV,KP) * * * PRINT OUTPUT * CALL FORMPC(CARDR,LAT,LON,FILFLAG,J,FILPRT,ZONE,CONV,KP) * *** PERFORM OBLIQUE MERCATOR ELSEIF(AP(IZ).EQ.'O') THEN LONC=SPCC(IZ,1)/RAD FE=SPCC(IZ,2) FN=SPCC(IZ,3) GAMC=SPCC(IZ,4) LATC=SPCC(IZ,5)/RAD KC=1.D0-1.D0/SPCC(IZ,6) **** FIND ZONE NAME ******** ZONE=ZN(IZ) * * COMPUTE ALL CONSTANCES FOR PROJECTION * CALL OCONST(ER,RF,A,B,C,D,SGO,CGO,GAMC,SGC,CGC,XI,KC,LONO, & F0,F2,F4,F6,LATC,LONC,ESQ) * * CONVERT PCS TO LAT AND LONG * CALL SKEWR(NORTH,EAST,LAT,LON,B,C,D,SGO,CGO,SGC,CGC,LONO, & FE,FN,F0,F2,F4,F6,ESQ,CONV,KP,GAMC,XI) * PRINT OUTPUT * CALL FORMPC(CARDR,LAT,LON,FILFLAG,J,FILPRT,ZONE,CONV,KP) * ENDIF * * 10 CONTINUE * * RETURN END