C
C **********************************************************************
C
C     THIS PROGRAM IS FURNISHED BY THE GOVERNMENT AND IS ACCEPTED AND
C      USED BY THE RECIPIENT WITH THE EXPRESS UNDERSTANDING THAT THE
C      UNITED STATES GOVERNMENT MAKES NO WARRANTIES, EXPRESSED OR
C      IMPLIED, CONCERNING THE ACCURACY, COMPLETENESS, RELIABILITY,
C      USABILITY, OR SUITABILITY FOR ANY PARTICULAR PURPOSE OF THE
C      INFORMATION AND DATA CONTAINED IN THIS PROGRAM OR FURNISHED IN
C      CONNECTION THEREWITH, AND THE UNITED STATES SHALL BE UNDER NO
C      LIABILITY WHATSOEVER TO ANY PERSON BY REASON OF ANY USE MADE
C      THEREOF.  THE PROGRAM BELONGS TO THE GOVERNMENT, THEREFORE THE
C      RECIPIENT FURTHER AGREES NOT TO ASSERT ANY PROPRIETARY RIGHTS
C      THEREIN OR TO REPRESENT THIS PROGRAM TO ANYONE AS OTHER THAN A
C      GOVERNMENT PROGRAM.
C
C********************************************************************** 
C
C
        PROGRAM PROMPTER

* 
*   THIS IS A PROMPTING PROGRAN WHICH WILL MAKE *81* RECORDS OR *80* 
*   RECORDS. YOU CAN CREATE A NEW FILE OR ADD DATA TO EXISTING ONE
*

       CHARACTER*80 CARDR
       CHARACTER*30 INFILE
       CHARACTER*30 OUTFILE
       CHARACTER*1  ANS1
       CHARACTER*1  ANS2
       CHARACTER*1  ANS3
       CHARACTER*1  ANS4
       CHARACTER*1  ANS5
       
       INTEGER*4    FL2
       INTEGER*4    FL3

       FL2=2
       FL3=3
*
*      FIND OUT WHAT IF DATA IS BEING ADDED TO EXISTING FILE 
*      OR CREATING A NEW ONE.  PLUS OPEN ALL THE FILES
*

       PRINT *, '  PROMPTING PROGRAM  '
       PRINT *, '                     '
       PRINT *, '                     '
       PRINT *, '  DO YOU WANT TO CREATE A NEW FILE ? '
       PRINT *, '  ANSWER Y OR N '
       PRINT *, '  TYPE ANSWER '
       PRINT *, '   '

       READ(*,5) ANS1
  5    FORMAT(A1)

 15    IF((ANS1.EQ.'Y').OR.(ANS1.EQ.'y')) THEN
         PRINT *, ' NAME OF THE OUTPUT FILE '
         PRINT *, ' TYPE NAME '
         PRINT *, '   '
         READ(*,10) OUTFILE
 10      FORMAT(A30)
         OPEN(FL3,FILE=OUTFILE,STATUS='NEW',FORM='FORMATTED',ERR=600)
         OPEN(FL2,STATUS='SCRATCH',FORM='FORMATTED')
         GO TO 100
       ELSE
         OPEN(FL2,STATUS='SCRATCH',FORM='FORMATTED')
       ENDIF

 20    IF((ANS1.EQ.'N').OR.(ANS1.EQ.'N')) THEN

         PRINT *, ' NAME OF THE FILE WHICH THE RECORDS ARE TO BE '
         PRINT *, ' ADDED TOO. '
         PRINT *, ' TYPE NAME '
         PRINT *, '   '
         READ(*,10) INFILE

         OPEN(FL3,FILE=INFILE,STATUS='OLD',FORM='FORMATTED',ERR=610)

       ENDIF 


 100     CONTINUE
*
*        FIND OUT WHICH TYPES OF RECORDS ARE BEING CREATED
*        AND CHOOSE THE CORRECT SUBROUTINE
* 

       PRINT *, '  DO YOU WANT TO CREATE AN *80* RECORD WITH  ' 
       PRINT *, '  LATITUDES AND LONGITUDES ? '
       PRINT *, '  TYPE Y OR N . '
       PRINT *, '  TYPE ANSWER '
       PRINT *, '   '

       READ(*,5) ANS2

 150   CONTINUE

       IF((ANS2.EQ.'Y').OR.(ANS2.EQ.'y')) THEN
            CALL RCD80
        ENDIF
      
       IF((ANS2.EQ.'N').OR.(ANS2.EQ.'n')) THEN 
            CALL RCD81
       ENDIF
*
*      FIND OUT IF ANOTHER RECORD IS TO BE CREATED 
*
       
       PRINT *, ' DO YOU WANT TO ENTER ANOTHER RECORD ? '
       PRINT *, ' ANSWER (Y/N) '
       PRINT *, ' TYPE ANSWER '
       PRINT *, '   '
       READ(*,5) ANS5

       IF((ANS5.EQ.'Y').OR.(ANS5.EQ.'y')) THEN
            GO TO 150
       ELSE
            GO TO 900
       ENDIF
      
 

 600   PRINT *, ' THIS FILE ALREADY EXISTS, DO YOU WANT TO '
       PRINT *, ' WRITE OVER IT ( Y/N ) '
       PRINT *, ' TYPE ANSWER '
       PRINT *, '   '
       READ(*,5) ANS3

        IF((ANS3.EQ.'Y').OR.(ANS3.EQ.'y')) THEN
            OPEN(FL2,FILE=OUTFILE,STATUS='UNKNOWN',FORM='FORMATTED')
            GO TO 100
        ELSE
            GO TO 15
        ENDIF

 610    PRINT *, ' THIS FILE DOES NOT EXISTS, DO YOU WANT TO  '
        PRINT *, ' TRY AGAIN (Y/N) ? '
        PRINT *, ' TYPE ANSWER '
        PRINT *, '   '
        READ(*,5) ANS4
     
         IF((ANS4.EQ.'Y').OR.(ANS4.EQ.'y')) THEN
            GO TO 20
         ELSE
            GO TO 960
         ENDIF
 
 900     CONTINUE
*
*        STORE ALL THE DATA IN THE CORRECT FILE, PLUS CLOSE THE FILES
*
         READ(FL3,905,END=910) CARDR
 905     FORMAT(A80)
         GO TO 900
 910     BACKSPACE(FL3)
         REWIND FL2
 920     READ(FL2,905,END=950) CARDR
         WRITE(FL3,905) CARDR
         GO TO 920
 950     ENDFILE FL3
         
         CLOSE(FL2,STATUS='DELETE')
         CLOSE(FL3,STATUS='KEEP')



 960   STOP
       END

***********************************************************************
*
       SUBROUTINE RCD80
*

       CHARACTER*30 NAME
       CHARACTER*4  R80
       CHARACTER*2  STATE
       CHARACTER*1  ELC
       CHARACTER*1  NORS
       CHARACTER*1  EORW

       INTEGER*4    SEQ
       INTEGER*4    SSN
       INTEGER*4    SOT
       INTEGER*4    LTD
       INTEGER*4    LTM
       INTEGER*4    LND
       INTEGER*4    LNM
       INTEGER*4    INORTH
       INTEGER*4    IEAST
       INTEGER*4    ILAT
       INTEGER*4    ILON
       INTEGER*4    IELEV
       INTEGER*4    ILNS
       INTEGER*4    ILTS 
       INTEGER*4    FL3
       INTEGER*4    FL2

       REAL*8       LTS
       REAL*8       LNS
       REAL*8       ELEV

       R80 = '*80*'
       FL2 =2


*
*
*     PROMPT FOR ALL THE *80* RECORD INFORMATION 
*
      PRINT *, ' ENTER THE SEQUENCE NUMBER '
      PRINT *, ' THIS IS AN INTEGER UP TO SIX DIGITS '
      PRINT *, ' NOTE: THIS OPTIONAL INFORMATION AND IS NOT NEEDED IF '
      PRINT *, ' ARE DOING TRANSFORMATIONS WITH THIS DATA '
      PRINT *, ' JUST HIT THE CARRAGE RETURN TO ENTER BLANKS '
      PRINT *, ' TYPE INTEGER NOW '
      PRINT *, '   '
      READ(*,10) SEQ
 10   FORMAT (I6)

      PRINT *, ' ENTER THE STATION SERIAL NUMBER '
      PRINT *, ' THIS IS AN INTEGER UP TO THREE DIGITS '
      PRINT *, ' NOTE: THIS OPTIONAL INFORMATION AND IS NOT NEEDED IF '
      PRINT *, ' ARE DOING TRANSFORMATIONS WITH THIS DATA '
      PRINT *, ' JUST HIT THE CARRAGE RETURN TO ENTER BLANKS '
      PRINT *, ' TYPE INTEGER NOW '
      PRINT *, '   '
      READ(*,15) SSN
 15   FORMAT(I3)      

      PRINT *, ' ENTER THE STATION NAME '
      PRINT *, ' THIS IS CHARACTERS UP TO A LENGTH OF 30 '
      PRINT *, ' NOTE: THIS IS REQUIRED '
      PRINT *, ' TYPE NAME NOW '
      PRINT *, '   '
      READ(*,20) NAME
 20   FORMAT(A30)

      PRINT *, ' ENTER DEGREES OF LATITUDE '
      PRINT *, ' THIS IS AN INTEGER UP TO TWO DIGITS '
      PRINT *, ' TYPE VALUE NOW '
      PRINT *, '   '
      READ(*,25) LTD
 25   FORMAT(I2)

        IF(LTD.GT.90) THEN
          PRINT *, ' YOUR DEGREES OF LATITUDE VALUE IS TO LARGE '
          PRINT *, ' PLEASE DOUBLE CHECK YOUR VALUE AND TRY AGAIN '
          PRINT *, ' TYPE VALUE NOW '
          READ(*,25) LTD
        ENDIF

      PRINT *, ' ENTER MINUTES OF LATITUDE '
      PRINT *, ' THIS IS AN INTEGER UP TO TWO DIGITS '
      PRINT *, ' TYPE VALUE NOW '
      PRINT *, '   '
      READ(*,30) LTM
 30   FORMAT(I2)

        IF(LTM.GE.60) THEN
          PRINT *, ' YOUR MINUTES OF LATITUDE VALUE IS TO LARGE '
          PRINT *, ' PLEASE DOUBLE CHECK YOUR VALUE AND TRY AGAIN '
          PRINT *, ' TYPE VALUE NOW '
          READ(*,30) LTM
        ENDIF

      PRINT *, ' ENTER THE SECONDS OF LATITUDE '
      PRINT *, ' THIS IS A NUMBER UP TO FIVE DECIMAL PLACES '
      PRINT *, ' TYPE VALUE NOW '
      PRINT *, '   '
      READ(*,35) LTS
 35   FORMAT(F8.5)

        IF(LTS.GE.60.0D0) THEN
          PRINT *, ' YOUR SECONDS OF LATITUDE VALUE IS TO LARGE '
          PRINT *, ' PLEASE DOUBLE CHECK YOUR VALUE AND TRY AGAIN '
          PRINT *, ' TYPE VALUE NOW '
          READ(*,35) LTS
        ENDIF

        ILTS = (LTS * 100000.0D0 + 0.5D0)
      
      PRINT *, ' ENTER DIRECTION OF LATITUDE ( N OR S ) '
      PRINT *, ' TYPE DIRECTION NOW '
      PRINT *, '   '
      READ(*,40) NORS
40    FORMAT(A1)
  
      PRINT *, ' ENTER DEGREES OF LONGITUDE '
      PRINT *, ' THIS IS AN INTEGER UP TO THREE DIGITS '
      PRINT *, ' NOTE: IF THE VALUE IS LESS THAN 100 DEGREES '
      PRINT *, ' ENTER THE VALUE WITH A LEADING ZERO. '
      PRINT *, ' TYPE VALUE NOW '
      PRINT *, '   '
      READ(*,50) LND
 50   FORMAT(I3)

        IF(LND.GT.360) THEN
          PRINT *, ' YOUR DEGREES OF LONGITUDE VALUE IS TO LARGE '
          PRINT *, ' PLEASE DOUBLE CHECK YOUR VALUE AND TRY AGAIN '
          PRINT *, ' TYPE VALUE NOW '
          READ(*,50) LND
        ENDIF

      PRINT *, ' ENTER MINUTES OF LONGITUDE '
      PRINT *, ' THIS IS AN INTEGER UP TO TWO DIGITS '
      PRINT *, ' TYPE VALUE NOW '
      PRINT *, '   '
      READ(*,30) LNM
     
        IF(LNM.GE.60) THEN
          PRINT *, ' YOUR MINUTES OF LONGITUDE VALUE IS TO LARGE '
          PRINT *, ' PLEASE DOUBLE CHECK YOUR VALUE AND TRY AGAIN '
          PRINT *, ' TYPE VALUE NOW '
          READ(*,30) LNM
        ENDIF

      PRINT *, ' ENTER THE SECONDS OF LONGITUDE '
      PRINT *, ' THIS IS A NUMBER UP TO FIVE DECIMAL PLACES '
      PRINT *, ' TYPE VALUE NOW '
      PRINT *, '   '
      READ(*,35) LNS
  
        IF(LNS.GE.60.0D0) THEN
          PRINT *, ' YOUR SECONDS OF LONGITUDE VALUE IS TO LARGE '
          PRINT *, ' PLEASE DOUBLE CHECK YOUR VALUE AND TRY AGAIN '
          PRINT *, ' TYPE VALUE NOW '
          READ(*,35) LNS
        ENDIF
 
        ILNS = (LNS * 100000.0D0 + 0.5D0)

      PRINT *, ' ENTER DIRECTION OF LONGITUDE ( E OR W )  '
      PRINT *, ' TYPE DIRECTION NOW '
      PRINT *, '   '
      READ(*,40) EORW
 
      PRINT *, ' ENTER THE ELEVATION OF MARK ABOVE MSL IN METERS '
      PRINT *, ' THIS IS A NUMBER UP TO TWO DECIMAL PLACES '
      PRINT *, ' NOTE: THIS OPTIONAL INFORMATION AND IS NOT NEEDED IF '
      PRINT *, ' ARE DOING TRANSFORMATIONS WITH THIS DATA '
      PRINT *, ' JUST HIT THE CARRAGE RETURN TO ENTER BLANKS '
      PRINT *, ' TYPE VALUE NOW '
      PRINT *, '   '
      READ(*,55) ELEV
 55   FORMAT(F7.2)
         
        IF(ELEV.GE.9999.99D0) THEN
          PRINT *, ' YOUR ELEVATION VALUE IS TO LARGE '
          PRINT *, ' PLEASE DOUBLE CHECK THE VALUE AND TRY AGAIN '
          PRINT *, ' TYPE VALUE NOW '
          READ(*,55) ELEV
        ENDIF
   
         IELEV = (ELEV * 100.0D0 + 0.5D0)

      PRINT *, ' TYPE ELEVATION CODE '
      PRINT *, ' NOTE: THIS OPTIONAL INFORMATION AND IS NOT NEEDED IF '
      PRINT *, ' ARE DOING TRANSFORMATIONS WITH THIS DATA '
      PRINT *, ' JUST HIT THE CARRAGE RETURN TO ENTER BLANKS '
      PRINT *, ' TYPE ELEVATION CODE NOW '
      PRINT *, '   '
      READ(*,40) ELC

      PRINT *, ' TYPE THE STATE OR COUNTY CODE '
      PRINT *, ' NOTE: THIS OPTIONAL INFORMATION AND IS NOT NEEDED IF '
      PRINT *, ' ARE DOING TRANSFORMATIONS WITH THIS DATA '
      PRINT *, ' JUST HIT THE CARRAGE RETURN TO ENTER BLANKS '
      PRINT *, ' TYPE CODE NOW '
      PRINT *, '   '
      READ(*,60) STATE
 60   FORMAT(A2)

      PRINT *, ' TYPE THE STATION ORDER AND TYPE '
      PRINT *, ' THIS IS A TWO DIGIT INTEGER '
      PRINT *, ' NOTE: THIS OPTIONAL INFORMATION AND IS NOT NEEDED IF '
      PRINT *, ' ARE DOING TRANSFORMATIONS WITH THIS DATA '
      PRINT *, ' JUST HIT THE CARRAGE RETURN TO ENTER BLANKS '
      PRINT *, ' TYPE INTEGER NOW '
      PRINT *, '   '
      READ(*,30) SOT


      WRITE(FL2,100) SEQ,R80,SSN,NAME,LTD,LTM,ILTS,NORS,LND,LNM,ILNS,
     &              EORW,IELEV,ELC,STATE,SOT
 100  FORMAT(I6.6,T7,A4,I3.3,T15,A30,T45,I2.2,I2.2,I7,A1,I3.3,I2.2,
     &       I7,A1,I6.6,A1,A2,I2.2)

      RETURN
      END

***********************************************************************
*
       SUBROUTINE RCD81
*

       CHARACTER*30 NAME
       CHARACTER*4  R81
       CHARACTER*2  STATE
       CHARACTER*1  ELC

       INTEGER*4    SEQ
       INTEGER*4    SSN
       INTEGER*4    SOT
       CHARACTER*11    ANORTH
       CHARACTER*10    AEAST
       CHARACTER*1     BUFF(20)
       INTEGER*4    IELEV
       INTEGER*4    ZONE
       INTEGER*4    FL2
   

       REAL*8       NORTH
       REAL*8       EAST
       REAL*8       ELEV

       R81 ='*81*'
       FL2=2
   


*
*
*     PROMPT FOR ALL THE *81* RECORD INFORMATION 
*
      PRINT *, ' ENTER THE SEQUENCE NUMBER '
      PRINT *, ' THIS IS AN INTEGER UP TO SIX DIGITS '
      PRINT *, ' NOTE: THIS OPTIONAL INFORMATION AND IS NOT NEEDED IF '
      PRINT *, ' ARE DOING TRANSFORMATIONS WITH THIS DATA '
      PRINT *, ' JUST HIT THE CARRAGE RETURN TO ENTER BLANKS '
      PRINT *, ' TYPE INTEGER NOW '
      PRINT *, '   '
      READ(*,10) SEQ
 10   FORMAT (I6)

      PRINT *, ' ENTER THE STATION SERIAL NUMBER '
      PRINT *, ' THIS IS AN INTEGER UP TO THREE DIGITS '
      PRINT *, ' NOTE: THIS OPTIONAL INFORMATION AND IS NOT NEEDED IF '
      PRINT *, ' ARE DOING TRANSFORMATIONS WITH THIS DATA '
      PRINT *, ' JUST HIT THE CARRAGE RETURN TO ENTER BLANKS '
      PRINT *, ' TYPE INTEGER NOW '
      PRINT *, '   '
      READ(*,15) SSN
 15   FORMAT(I3)      

      PRINT *, ' ENTER THE STATION NAME '
      PRINT *, ' THIS IS CHARACTERS UP TO A LENGTH OF 30 '
      PRINT *, ' NOTE: THIS IS REQUIRED '
      PRINT *, ' TYPE NAME NOW '
      PRINT *, '   '
      READ(*,20) NAME
 20   FORMAT(A30)
      
      PRINT *, ' ENTER THE X COORDINATE (EASTING) IN FEET '
      PRINT *, ' NOTE: FOR UTMs YOU ENTER THE METERS '
      PRINT *, ' THIS IS A NUMBER TO THREE DECIMAL PLACES '
      PRINT *, ' EXAMPLE: 2,270,288.086 SHOULD BE 2270288.086 '
      PRINT *, ' TYPE THE X COORDINATE NOW '
      PRINT *, '   '
 21   READ(*,25) EAST
 25   FORMAT(F11.3)

        IF((EAST.GE.9999999.999D0).OR.(EAST.LT.0.D0)) THEN
          PRINT *, ' YOUR X COORDINATE (EASTING) VALUE IS TO LARGE '
          PRINT *, ' PLEASE DOUBLE CHECK YOUR VALUE AND TRY AGAIN '
          PRINT *, ' TYPE THE X COORDINATE NOW '
          PRINT *, '   '
          GO TO 21
        ENDIF 
 
        CALL CHGDEC(11,3,EAST,BUFF)
     
          AEAST(1:1)  = BUFF(1)
          AEAST(2:2)  = BUFF(2)
          AEAST(3:3)  = BUFF(3)
          AEAST(4:4)  = BUFF(4)
          AEAST(5:5)  = BUFF(5)
          AEAST(6:6)  = BUFF(6)
          AEAST(7:7)  = BUFF(7)
          AEAST(8:8)  = BUFF(9)
          AEAST(9:9)  = BUFF(10)
          AEAST(10:10) = BUFF(11)




      PRINT *, ' ENTER THE Y COORDINATE (NORTHING) IN FEET '
      PRINT *, ' NOTE: FOR UTMs YOU ENTER THE METERS '
      PRINT *, ' THIS IS A NUMBER TO THREE DECIMAL PLACES '
      PRINT *, ' EXAMPLE: 2,270,288.086 SHOULD BE 2270288.086 '
      PRINT *, ' TYPE THE Y COORDINATE NOW '
      PRINT *, '   '
 26   READ(*,30) NORTH
 30   FORMAT(F12.3)
        
        IF((NORTH.GE.99999999.999D0).OR.(NORTH.LT.0.D0)) THEN
          PRINT *, ' YOUR Y COORDINATE (NORTHING) VALUE IS TO LARGE '
          PRINT *, ' PLEASE DOUBLE CHECK YOUR VALUE AND TRY AGAIN '
          PRINT *, ' TYPE THE Y COORDINATE NOW '
          PRINT *, '   '
          GO TO 26
        ENDIF

    
        CALL CHGDEC(12,3,NORTH,BUFF)
    
          ANORTH(1:1)  = BUFF(1)
          ANORTH(2:2)  = BUFF(2)
          ANORTH(3:3)  = BUFF(3)
          ANORTH(4:4)  = BUFF(4)
          ANORTH(5:5)  = BUFF(5)
          ANORTH(6:6)  = BUFF(6)
          ANORTH(7:7)  = BUFF(7)
          ANORTH(8:8)  = BUFF(8)
          ANORTH(9:9)  = BUFF(10)
          ANORTH(10:10) = BUFF(11)
          ANORTH(11:11) = BUFF(12)
           



      PRINT *, ' ENTER THE STATE AND ZONE CODE '
      PRINT *, ' NOTE: FOR UTMs ENTER THE ZONE NUMBER WITH LEADING '
      PRINT *, ' ZEROS  EXAMPLE "0014" FOR ZONE FOURTEEN '
      PRINT *, ' THIS A FOUR DIGIT INTEGER '
      PRINT *, ' TYPE THE STATE AND ZONE NOW '
      PRINT *, '   '
      READ(*,45) ZONE
 45   FORMAT(I4)
 
      PRINT *, ' ENTER THE ELEVATION OF MARK ABOVE MSL IN METERS '
      PRINT *, ' THIS IS A NUMBER UP TO TWO DECIMAL PLACES '
      PRINT *, ' NOTE: THIS OPTIONAL INFORMATION AND IS NOT NEEDED IF '
      PRINT *, ' ARE DOING TRANSFORMATIONS WITH THIS DATA '
      PRINT *, ' JUST HIT THE CARRAGE RETURN TO ENTER BLANKS '
      PRINT *, ' TYPE THE VALUE NOW '
      PRINT *, '   '
 54   READ(*,55) ELEV
 55   FORMAT(F7.2)
         
        IF(ELEV.GE.9999.99D0) THEN
          PRINT *, ' YOUR ELEVATION VALUE IS TO LARGE '
          PRINT *, ' PLEASE DOUBLE CHECK THE VALUE AND TRY AGAIN '
          PRINT *, ' TYPE VALUE NOW '
          PRINT *, '   '
          GO TO 54
        ENDIF
 
         IELEV = (ELEV * 100.0D0 + 0.5D0)

      PRINT *, ' TYPE ELEVATION CODE '
      PRINT *, ' NOTE: THIS OPTIONAL INFORMATION AND IS NOT NEEDED IF '
      PRINT *, ' ARE DOING TRANSFORMATIONS WITH THIS DATA '
      PRINT *, ' JUST HIT THE CARRAGE RETURN TO ENTER BLANKS '
      PRINT *, ' TYPE ELEVATION CODE NOW '
      PRINT *, '   '
      READ(*,40) ELC
 40   FORMAT(A1)

      PRINT *, ' TYPE THE STATE OR COUNTY CODE '
      PRINT *, ' NOTE: THIS OPTIONAL INFORMATION AND IS NOT NEEDED IF '
      PRINT *, ' ARE DOING TRANSFORMATIONS WITH THIS DATA '
      PRINT *, ' JUST HIT THE CARRAGE RETURN TO ENTER BLANKS '
      PRINT *, ' TYPE CODE NOW '
      PRINT *, '   '
      READ(*,60) STATE
 60   FORMAT(A2)

      PRINT *, ' TYPE THE STATION ORDER AND TYPE '
      PRINT *, ' THIS IS A TWO DIGIT INTEGER '
      PRINT *, ' NOTE: THIS OPTIONAL INFORMATION AND IS NOT NEEDED IF '
      PRINT *, ' ARE DOING TRANSFORMATIONS WITH THIS DATA '
      PRINT *, ' JUST HIT THE CARRAGE RETURN TO ENTER BLANKS '
      PRINT *, ' TYPE INTEGER NOW '
      PRINT *, '   '
      READ(*,65) SOT
 65   FORMAT(I2)

      WRITE(FL2,100) SSN,R81,SSN,NAME,AEAST,ANORTH,ZONE,
     &              IELEV,ELC,STATE,SOT
 100  FORMAT(I6.6,T7,A4,I3.3,T15,A30,T45,A10,T55,A11,I4.4,
     &       T70,I6,A1,A2,I2.2)
 
      RETURN
      END
**********************************************************************
      SUBROUTINE CHGDEC (NNN,MMM,SS,CHAR)
C     -----------------------------------------------------
      CHARACTER*1  DASH,ZERO,DOL,BLK1,CHAR(*),IB(20),TT
      CHARACTER*20 JB
      INTEGER*4   IDG,MIN
      REAL*8      S,SS,DEC,W,SEC,TEN,TOL
C
      EQUIVALENCE (IB,JB)
C
      DATA BLK1,DOL,ZERO,DASH/' ','$','0','-'/,TEN/10.0D0/
C
C        CHAR      1-16      LENGTH OF CHARACTER ARRAY FIELD
C        NR        1-13      LENGTH OF FIELD TO BE USED FROM LEFT
C        NP        7-13      LOCATION OF DECIMAL POINT FROM RIGHT
C        NEG       CHAR(1)   PUT THE MINUS SIGN HERE
C        EXAMPLE:            RANGE NR=14 AND WITH A POINT NP=6
C                            W=  -3600.376541
C
C CHAR FIELD     1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16
C BLANK FILLED   B  B  B  B  B  B  B  B  B  B  B  B  B  B  B  B BLANK
C NR ADDED      |B  B  B  B  B  B  B  B  B  B  B  B  B  B| B  B LIMIT
C NP ADDED      |B  B  B  B  B  B  B  .  B  B  B  B  B  B| B  B POINT
C W ENTERED     |B  B  -  3  6  0  0  .  3  7  6  5  4  1| 8  4
C DOL (SIGN)    |B  B  -  3  6  0  0  .  3  7  6  5  4  1| $  4
C NEG (SIGN)    |B  B  -  3  6  0  0  .  3  7  6  5  4  1| $  4
C
C  -------------------------------
C     SETUP OUTSIDE CONSTANTS
C
      NR=NNN
      NP=MMM
      DEC=SS
C
C     CHECK TO SEE IF NR AND NF ARE WITHIN LIMITS
C
      NNP=IABS(NP)
      KTST=0
      M=IABS(NR)
C
C     IF NR IS GREATER THAN ZERO -- DECIMAL NUMBER
C
      IF(NR.GT.0)GOTO 1
C -------------------------------------
C     THIS IS A DEG-MIN-SEC FORMAT
C
      IF(NNP.GT.5)NNP=5
C
C     ENTRY IS DDD-MM-SS.SS
C           OR  HH-MM-SS.SS
C
      DEC=DABS(DEC)
      SEC=DEC*3600.0D0
      IDG=SEC/3600.0D0
      SEC=SEC-DBLE(FLOAT(IDG))*3600.0D0
      MIN=SEC/60.0D0
      SEC=SEC-DBLE(FLOAT(MIN))*60.0D0
      DEC=DBLE(FLOAT(IDG))*1000000.0D0+DBLE(FLOAT(MIN))*1000.0D0+SEC
C
      KTST=1
      M=15
C
C     ROUND THE DECIMAL NUMBER
C
    1 IP=-1*(NNP+1)
      TOL=5.0D0*(TEN**IP)
      W=(DABS(DEC) + TOL)
      IF(DEC.LT.0.0D0) W=-W
      DEC=W
C
      N=NNP
      IF(M.GT.15)M=15
      IF(M.LT.4)M=4
      IF(N.GE.M)N=M-1
      W=DEC
C
C     CONVERT THE DECIMAL NUMBER
C
      WRITE(JB,100) W
  100 FORMAT(F20.10)
C
C     BLANK FILL THE ARRAY
C
      DO 5 IQ=1,16
    5 CHAR(IQ)=BLK1
C
C     LOOK FOR THE FIRST NON-BLANK CHARACTER
C
      DO 6 I=1,10
      TT=IB(I)
    6 IF(TT.NE.BLK1)GOTO 7
C
C     COMPUTE THE PROPER NUMBER LENGTH WITH THE PROPER DECIMALS
C
    7 K=11-I
      K=K+N
      IF(K.GT.M)M=K
      L=10-(M-N)
      IF(L.LE.0)L=0
C
      MM=M+1
      J=0
      IDEC=0
      DO 30 I=1,MM
      K=I+L
      IF(K.GT.20)K=20
      J=J+1
      CHAR(J)=IB(K)
   30 IF(CHAR(J).EQ.'.') IDEC=J
      N=IDEC+NNP+1
C
      IF(KTST.EQ.0)GOTO 40
C
C     FILL-OUT THE DEG-MIN-SEC FIELD
C
      CHAR(4)=DASH
      CHAR(7)=DASH
C
C     ZERO-OUT ALL BLANK CHARACTERS
C
      DO 10 I=1,9
   10 IF(CHAR(I).EQ.BLK1)CHAR(I)=ZERO
C
   40 CHAR(N)=DOL
C
      RETURN
      END