C SccsID = "@(#)drgppc.for 1.2 01/28/02" SUBROUTINE DRGPPC(CARDR,ICODE,FILFLAG,EWFLAG) IMPLICIT DOUBLE PRECISION(A-H,O-Z) DIMENSION SPCC(135,6),IZC(135),UTMC(60),ICODE(3) CHARACTER*5 GDVAL DIMENSION GDVAL(1001),GDNUM(1001) LOGICAL FILFLAG LOGICAL EWFLAG CHARACTER*1 AP(135) CHARACTER*4 ZN(135),ZONE CHARACTER*80 CARDR REAL*8 LAM,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/LATLON/LD,LM,SLAT,LOD,LOM,SLON COMMON/FILES/I3,I4,I2,ICON COMMON/DONUM/ISN COMMON/GEODS/GDNUM,GDVAL FI=(LD+(LM+SLAT/60.D0)/60.D0)/RAD LAM=(LOD+(LOM+SLON/60.D0)/60.D0)/RAD IF(EWFLAG) THEN LAM = (360.0D0/RAD) - LAM ENDIF 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(' IMPROPER STATE ZONE CODE-',I4) GO TO 10 ELSEIF(AP(IZ).EQ.'N') THEN WRITE(6,40)ICODE(J) 40 FORMAT(' THE 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 LAT AND LONG TO PCS * CALL LAMD1 (FI,LAM,NORTH,EAST,CONV,KP,ER,ESQ,E,CM,EO, & NB,SINFO,RB,K) * * PRINT OUTPUT * CALL FORMGP(CARDR,NORTH,EAST,CONV,KP,ZONE,FILFLAG,J) * *** 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 TCONST (ER,RF,SF,OR,ESQ,EPS,R,A,B,C,U,V,W,SO, & CM,FE,FN) * * CONVERT LAT AND LONG TO PCS * CALL TMGRID(FI,LAM,NORTH,EAST,CONV,KP,ER,ESQ,EPS,CM, & FE,FN,SF,SO,R,A,B,C,U,V,W) * * * PRINT OUTPUT * CALL FORMGP(CARDR,NORTH,EAST,CONV,KP,ZONE,FILFLAG,J) * *** 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 LAT AND LONG TO PCS * CALL SKEWD(FI,LAM,U,V,NORTH,EAST,CONV,KP,B,C,D,SGO,CGO, & GAMC,CGC,SGC,XI,E,ESQ,LONO,FN,FE) * PRINT OUTPUT * CALL FORMGP(CARDR,NORTH,EAST,CONV,KP,ZONE,FILFLAG,J) * ENDIF * * 10 CONTINUE * * RETURN END