C     g77 -O2 make_sumfiles.f /Users/rgaskell/toolkit/lib/spicelib.a -o make_sumfiles.e
C     ftn make_sumfiles.f /Users/rgaskell/toolkit/lib/spicelib.a -o make_sumfiles.e

      IMPLICIT NONE

C
C     SPICELIB Functions
C
      DOUBLE PRECISION      RPD
      DOUBLE PRECISION      HALFPI
      DOUBLE PRECISION      VDOT
      DOUBLE PRECISION      VNORM

C
C     Parameters
C
      CHARACTER*(*)         D2COL
      PARAMETER           ( D2COL = '(2X,A11,E23.16,5X,E23.16)' )
 
      INTEGER               FILEN
      PARAMETER           ( FILEN  = 128 )
 
      INTEGER               STRLEN
      PARAMETER           ( STRLEN =  32 )

C
C     Variables
C
      CHARACTER*(1)         CAM
      CHARACTER*(1)         OPT
      CHARACTER*(1)         ANS
      CHARACTER*(3)         FORMAT
      CHARACTER*(9)         TRANS
      CHARACTER*(9)         FRAME
      CHARACTER*(12)        PICNM
      CHARACTER*(12)        DIRNM
      CHARACTER*(20)        CH20
      CHARACTER*(13)        XNAME(200000)
      CHARACTER*(80)        INFILE
      CHARACTER*(80)        PICTFILE
      CHARACTER*(80)        LINE
      CHARACTER*(80)        XLINE(40000)
      CHARACTER*(80)        KERNEL
      CHARACTER*2880        RECORD
      CHARACTER*100         TLINE(100000)
      CHARACTER*160         SLINE(100000)
      CHARACTER*160         LABEL

      CHARACTER*(STRLEN)    ABCORR
      CHARACTER*(STRLEN)    IFRAME
      CHARACTER*(STRLEN)    BFRAME
      CHARACTER*(STRLEN)    INST
      CHARACTER*(STRLEN)    INSTX(100)
      CHARACTER*(STRLEN)    SCLK
      CHARACTER*(STRLEN)    UTC
      CHARACTER*(STRLEN)    UTCSTART
      CHARACTER*(STRLEN)    UTCSTOP

      DOUBLE PRECISION      ET, ET0, ET1, R0, T0
      DOUBLE PRECISION      LT
      DOUBLE PRECISION      SCOBJ(3)
      DOUBLE PRECISION      VDUM(6)
      DOUBLE PRECISION      VSUN(3)
      DOUBLE PRECISION      USUN(3)
      DOUBLE PRECISION      W0(3)
      DOUBLE PRECISION      S0(3)
      DOUBLE PRECISION      CX(3)
      DOUBLE PRECISION      CY(3)
      DOUBLE PRECISION      CZ(3)
      DOUBLE PRECISION      PX(3)
      DOUBLE PRECISION      PY(3)
      DOUBLE PRECISION      PZ(3)
      DOUBLE PRECISION      PX0
      DOUBLE PRECISION      LN0
      DOUBLE PRECISION      PX0X(100)
      DOUBLE PRECISION      LN0X(100)
      DOUBLE PRECISION      MMFL
      DOUBLE PRECISION      MMFLX(100)
      DOUBLE PRECISION      KMAT(2,3)
      DOUBLE PRECISION      KMATX(2,3,100)
      DOUBLE PRECISION      SIGMA_PXL
      DOUBLE PRECISION      RMS_PIC
      DOUBLE PRECISION      Z1, Z2, Z3, Z4, Z5, Z6
      DOUBLE PRECISION      RA
      DOUBLE PRECISION      DEC
      DOUBLE PRECISION      TW
      DOUBLE PRECISION      MA(3,3)
      DOUBLE PRECISION      MB(3,3)
      DOUBLE PRECISION      MC(3,3)
      DOUBLE PRECISION      SIG_VSO(3)
      DOUBLE PRECISION      SIG_PTG(3)
      DOUBLE PRECISION      SIG_VSOX(3,100)
      DOUBLE PRECISION      SIG_PTGX(3,100)
      DOUBLE PRECISION      ALPHA
      DOUBLE PRECISION      DX(4,100)
      DOUBLE PRECISION      D(4)
      DOUBLE PRECISION      V(3)
      
      LOGICAL               EX
      LOGICAL               UDI
      LOGICAL               UDC
      LOGICAL               UDG
      LOGICAL               UDS
      LOGICAL               UDP
          
      INTEGER               I
      INTEGER               J
      INTEGER               K
      INTEGER               KX
      INTEGER               KT, KS
      INTEGER               PREC
      INTEGER               HANDLE
      INTEGER               SCFT
      INTEGER               SCFTX(100)
      INTEGER               TARGET
      INTEGER               CAMIDENT
      INTEGER               SCANIDENT
      INTEGER               NPX
      INTEGER               NLN
      INTEGER               NPXX(100)
      INTEGER               NLNX(100)
      INTEGER               T1
      INTEGER               T2
      INTEGER               T1X(100)
      INTEGER               T2X(100)
      INTEGER               SLEN
      INTEGER               NCAM
      INTEGER               NSC
      INTEGER*4             NREC
      INTEGER*4             NSNR
      INTEGER*4             NSNH
      INTEGER*4             NEQI
      INTEGER*4             NEQH
      INTEGER*4             NIMG
      INTEGER*4             NHED
      INTEGER*4             NC
      INTEGER*4             NS
      INTEGER*4             SCL

      CALL RESLUN(10)
      CALL RESLUN(20)
      CALL RESLUN(30)
      CALL RESLUN(40)
      CALL RESLUN(22)

      SIGMA_PXL=0.5D0
      RMS_PIC=0.D0

C
C     Get all of the required inputs.
C
C     KERNEL = leapseconds file
C     PLCONS = Planetary constants file
C     EPHEM  = ephemeris data file
C     OBSRVR = observer #
C     TARGET = target #
C     ABCORR = LT+S, LT, or NONE
C     MAXPTS = number of points
C

      FORMAT = 'C'
      PREC   =  3
      IFRAME = 'J2000'

      INQUIRE(FILE='PICTLIST.TXT', EXIST=EX)
      IF(.NOT.EX) THEN
        OPEN(UNIT=20,FILE='PICTLIST.TXT',STATUS='NEW')
          WRITE(20,FMT='(A3,10X)') 'END'        
        CLOSE(UNIT=20)
      ENDIF

      WRITE(6,*) '0.  Create new SUMFILES & NOMINALS and ..'
      WRITE(6,*) '1.  Update old NOMINALS and ..'
      WRITE(6,*) '2.  Update old SUMFILES '
      READ(5,FMT='(A1)') OPT
      IF(OPT.EQ.'2') THEN
        UDI=.FALSE.
        UDC=.FALSE.
        UDG=.FALSE.
        UDS=.FALSE.
        UDP=.FALSE.
        WRITE(6,*) 'Update image thresholds? (y/n)'
        READ(5,FMT='(A1)') ANS
        IF(ANS.EQ.'y') UDI=.TRUE.
        WRITE(6,*) 'Update camera parameters? (y/n)'
        READ(5,FMT='(A1)') ANS
        IF(ANS.EQ.'y') UDC=.TRUE.
        WRITE(6,*) 'Reset geometry? (y/n)'
        READ(5,FMT='(A1)') ANS
        IF(ANS.EQ.'y') THEN
          WRITE(6,*) 'This will reset pointings.  Are you sure? (y/n)'
          READ(5,FMT='(A1)') ANS
        ENDIF
        IF(ANS.EQ.'y') UDG=.TRUE.
        WRITE(6,*) 'Reset sigmas? (y/n)'
        READ(5,FMT='(A1)') ANS
        IF(ANS.EQ.'y') UDS=.TRUE.
      ENDIF
      WRITE(6,*) 'Include Pole? (y/n)'
      READ(5,FMT='(A1)') ANS
      IF(ANS.EQ.'y') UDP=.TRUE.

      OPEN(UNIT=10, file='make_sumfiles.txt',status='old')
200     CONTINUE
        READ(10,FMT='(A80)') KERNEL
        IF(KERNEL(1:1).EQ.'#') GO TO 200
        READ(KERNEL,*) NCAM
        DO K=1,NCAM
          READ(10,*) INSTX(K)
          READ(10,*) NPXX(K), NLNX(K)
          READ(10,*) MMFLX(K), PX0X(K), LN0X(K)
          READ(10,*) KMATX(1,1,K),KMATX(1,2,K),KMATX(1,3,K),
     .               KMATX(2,1,K),KMATX(2,2,K),KMATX(2,3,K)
          READ(10,*) (DX(I,K), I=1,4)
          READ(10,*) T1X(K), T2X(K)
        ENDDO
        READ(10,*) NSC
        DO K=1,NSC
          READ(10,*) SCFTX(K)
          READ(10,*) (SIG_VSOX(I,K), I=1,3)
          READ(10,*) (SIG_PTGX(I,K), I=1,3)
        ENDDO
        READ(10,*) TARGET
        READ(10,*) BFRAME
        READ(10,*) ABCORR
        READ(10,*) 
210     CONTINUE
        READ(10,FMT='(A80)') KERNEL
        IF(KERNEL(1:1).EQ.'#') GO TO 210
        IF(KERNEL(1:9).NE.'END_KRNLS') THEN
          CALL FURNSH ( KERNEL )
          GO TO 210
        ENDIF
      CLOSE(UNIT=10)

      INFILE='make_sumfilesR.in'
      INQUIRE(FILE=INFILE, EXIST=EX)
      IF(.NOT.EX) INFILE='make_sumfiles.in' 
      OPEN(UNIT=10, file=INFILE,status='old')
220     CONTINUE
        READ(10,FMT='(A80)',END=230) LINE
        IF(LINE(1:1).EQ.'#') GO TO 220
        READ(LINE,FMT='(A12,4X,A24,3I5)') PICNM, UTC, NC, NS, SCL
        INST=INSTX(NC)
        NPX=NPXX(NC)/SCL
        NLN=NLNX(NC)/SCL
        T1=T1X(NC)
        T2=T2X(NC)
        MMFL=MMFLX(NC)
        PX0=0.5+(PX0X(NC)-0.5)/SCL
        LN0=0.5+(LN0X(NC)-0.5)/SCL
        DO I=1,2
        DO J=1,3
          KMAT(I,J)=KMATX(I,J,NC)/SCL
        ENDDO
        ENDDO
        DO I=1,4
          D(I)=DX(I,NC)
        ENDDO
        SCFT=SCFTX(NS)
        CALL VEQU(SIG_VSOX(1,NS),SIG_VSO) 
        CALL VEQU(SIG_PTGX(1,NS),SIG_PTG) 
        CALL UTC2ET ( UTC, ET )

        CALL SPKEZ (TARGET, ET, IFRAME, ABCORR, SCFT, VDUM, LT)
        CALL VEQU(VDUM(1),SCOBJ)
        CALL VEQU(VDUM(4),V)
        CALL VMINUS(V,V)

        CALL SPKEZ ( 10, ET-LT, IFRAME, ABCORR, TARGET, VDUM, Z1 )
        CALL VEQU(VDUM(1),VSUN)
        CALL VHAT ( VSUN, USUN )

        CALL PXFORM (IFRAME, BFRAME, ET-LT, MA)
        CALL MXV (MA,USUN,USUN)
        CALL MXV (MA,SCOBJ,SCOBJ)

        CALL PXFORM (INST, IFRAME, ET, MA)
        CALL PXFORM (IFRAME, BFRAME, ET-LT, MB)
        CALL MXM (MB,MA,MC)
        DO I=1,3
          CX(I)= -MC(I,1)
          CY(I)= -MC(I,2)
          CZ(I)= MC(I,3)
        ENDDO
        CALL M2EUL(MB,3,2,3,Z3,Z2,Z1)
        RA=Z1/RPD()
        DEC=(HALFPI()-Z2)/RPD()
        TW=Z3/RPD()

        WRITE(6,FMT='(A12,5X,A24)') PICNM, UTC


C  ##############################################################
C   IFRAME ADDITION
C  ##############################################################
        CALL PXFORM (BFRAME, IFRAME, ET-LT, MA)
        CALL MXV(MA,SCOBJ,W0)
        CALL MXV(MA,CX,PX)
        CALL MXV(MA,CY,PY)
        CALL MXV(MA,CZ,PZ)
        CALL MXV(MA,USUN,S0)
        DO I=1,3
          MB(1,I)=PX(I) 
          MB(2,I)=PY(I) 
          MB(3,I)=PZ(I)
        ENDDO
        CALL M2EUL(MB,3,2,3,Z3,Z2,Z1) 
        CALL RECRAD(S0,Z4,Z5,Z6)
        KS=KS+1
        WRITE(SLINE(KS),FMT='(A12,4X,A24,3D20.10,5F12.5)') PICNM, UTC,
     .    (W0(I), I=1,3),Z1/RPD(),(HALFPI()-Z2)/RPD(),Z3/RPD(),
     .     Z5/RPD(),Z6/RPD()
        KT=KT+1
        WRITE(TLINE(KT),FMT='(1X,A12,4X,A24,4X,F15.5,2D20.10)') 
     .     PICNM, UTC, ET, VNORM(W0), VNORM(V)
C  ##############################################################

        I=0
        OPEN(UNIT=20,FILE='PICTLIST.TXT',STATUS='OLD')
120       CONTINUE
          I=I+1
          READ(20,FMT='(A13)') XNAME(I)
          IF(XNAME(I)(2:13).EQ.PICNM) THEN
            CLOSE(UNIT=20)
            IF(OPT.EQ.'0') GO TO 220
            IF(OPT.EQ.'1') GO TO 140
            IF(OPT.EQ.'2') GO TO 130
            GO TO 220
          ENDIF
          IF(XNAME(I)(1:3).NE.'END') GO TO 120
        CLOSE(UNIT=20)
        OPEN(UNIT=20,FILE='PICTLIST.TXT',STATUS='OLD')
          DO J=1,I-1  
            WRITE(20,FMT='(A13)') XNAME(J)
          ENDDO
          WRITE(20,FMT='(1X,A12)') PICNM        
          WRITE(20,FMT='(A3,10X)') 'END'        
        CLOSE(UNIT=20)

130     CONTINUE
        Z1=VNORM(SCOBJ)/(MMFL*KMAT(1,1))
        Z2=ACOS(-VDOT(USUN,CZ))/RPD()
        Z3=ACOS(VDOT(CZ,SCOBJ)/VNORM(SCOBJ))/RPD()
        WRITE(6,FMT='(3F10.3)') Z1, Z2, Z3

        I=SLEN(PICNM)
        PICTFILE='./SUMFILES/'//PICNM(1:I)//'.SUM'
        INQUIRE(FILE=PICTFILE, EXIST=EX)
        IF(EX) THEN
          J=0
          OPEN(UNIT=20,FILE=PICTFILE,STATUS='UNKNOWN')
150         CONTINUE
            J=J+1
            READ(20,FMT='(A80)') XLINE(J)
            IF(XLINE(J)(1:8).NE.'END FILE') GO TO 150
            KX=J
          CLOSE(UNIT=20)
        ELSE
          KX=16
          WRITE(XLINE(14),FMT='(A9,71X)')  'LANDMARKS'
          WRITE(XLINE(15),FMT='(A9,71X)')  'LIMB FITS'
          WRITE(XLINE(16),FMT='(A8,72X)')  'END FILE'
        ENDIF
        IF(UDI.OR.(.NOT.EX)) THEN
          WRITE(XLINE(1),FMT='(A12,68X)') PICNM
          WRITE(XLINE(2),FMT='(A24,56X)') UTC
          WRITE(XLINE(3),FMT='(4I6,36X,A20)') NPX, NLN, T1, T2,
     .                                '  NPX, NLN, THRSH  '
        ENDIF
        IF(UDC.OR.(.NOT.EX)) THEN
          WRITE(XLINE(4),FMT='(3D20.10,A20)') MMFL, PX0, LN0,
     .                                '  MMFL, CTR        '
          WRITE(XLINE(10),FMT='(6F10.5,A20)') KMAT(1,1),KMAT(1,2),
     .                         KMAT(1,3),KMAT(2,1),KMAT(2,2),KMAT(2,3),
     .                                '  K-MATRIX         '
        ENDIF
        IF(UDP) THEN
          WRITE(XLINE(11),FMT='(3D20.10,A20)') RA, DEC, TW,
     .                                '  POLE             ' 
        ELSE
          WRITE(XLINE(11),FMT='(4D15.5,A20)') (D(I), I=1,4),
     .                                '  DISTORTION       '
        ENDIF
        IF(UDG.OR.(.NOT.EX)) THEN
          WRITE(XLINE(5),FMT='(3D20.10,A20)') (SCOBJ(I), I=1,3), 
     .                                  '  SCOBJ            '
          WRITE(XLINE(6),FMT='(3D20.10,A20)') (CX(I), I=1,3),
     .                                 '  CX               ' 
          WRITE(XLINE(7),FMT='(3D20.10,A20)') (CY(I), I=1,3),
     .                                '  CY               ' 
          WRITE(XLINE(8),FMT='(3D20.10,A20)') (CZ(I), I=1,3),
     .                                '  CZ               ' 
          WRITE(XLINE(9),FMT='(3D20.10,A20)') (USUN(I), I=1,3),
     .                                '  SZ               ' 
        ENDIF
        IF(UDS.OR.(.NOT.EX)) THEN
          WRITE(XLINE(12),FMT='(3D20.10,A20)') (SIG_VSO(I), I=1,3),
     .                                '  SIGMA_VSO        ' 
          WRITE(XLINE(13),FMT='(3D20.10,A20)') (SIG_PTG(I), I=1,3),
     .                                  '  SIGMA_PTG        ' 
        ENDIF
        OPEN(UNIT=20,FILE=PICTFILE,STATUS='UNKNOWN')
          DO J=1,KX
            WRITE(20,FMT='(A80)') XLINE(J)
          ENDDO
        CLOSE(UNIT=20)

140     CONTINUE          

        I=SLEN(PICNM)
        PICTFILE='./NOMINALS/'//PICNM(1:I)//'.NOM'
        OPEN(UNIT=20,FILE=PICTFILE,STATUS='UNKNOWN')
          WRITE(20,FMT='(A12,68X)') PICNM
          WRITE(20,FMT='(3D20.10,20X)') (V(I), I=1,3) 
          WRITE(20,FMT='(3D20.10,A20)') (SCOBJ(I), I=1,3), 
     .                                '  SCOBJ            '
          WRITE(20,FMT='(3D20.10,A20)') (SIG_VSO(I), I=1,3),
     .                                '  SIGMA_VSO        ' 
          WRITE(20,FMT='(3D20.10,A20)') (CX(I), I=1,3),
     .                                '  CX               ' 
          WRITE(20,FMT='(3D20.10,A20)') (CY(I), I=1,3),
     .                                '  CY               ' 
          WRITE(20,FMT='(3D20.10,A20)') (CZ(I), I=1,3),
     .                                '  CZ               ' 
          WRITE(20,FMT='(3D20.10,A20)') (SIG_PTG(I), I=1,3),
     .                                '  SIGMA_PTG        ' 
          WRITE(20,FMT='(A8,72X)')  'END FILE'
        CLOSE(UNIT=20)

        FRAME='BOD_FRAME'
        CALL INSERTINNOM_FRAME(PICNM,FRAME)

        GO TO 220
230     CONTINUE          
      CLOSE(UNIT=10)

      DO I=1,160
        LABEL(I:I)=' '
      ENDDO
      LABEL(4:8)='PICNM'
      LABEL(27:29)='UTC'
      LABEL(49:54)='SCOBJx'
      LABEL(69:74)='SCOBJy'
      LABEL(89:94)='SCOBJz'
      LABEL(107:108)='RA'
      LABEL(119:121)='DEC'
      LABEL(130:134)='TWIST'
      LABEL(142:144)='SRA'
      LABEL(154:157)='SDEC'
      OPEN(UNIT=40, FILE='IFRAME.TXT', status='UNKNOWN')
        WRITE(40,FMT='(A160)') LABEL
        WRITE(40,*)
        DO I=1,KS
          WRITE(40,FMT='(A160)') SLINE(I)
        ENDDO
        WRITE(40,FMT='(A3,157X)') 'END'
      CLOSE(UNIT=40)

      DO I=2,KT
      DO J=I-1,1,-1
        IF(TLINE(J+1)(46:54).LT.TLINE(J)(46:54)) THEN
          TLINE(KT+1)=TLINE(J)
          TLINE(J)=TLINE(J+1)
          TLINE(J+1)=TLINE(KT+1)
        ENDIF
      ENDDO
      ENDDO

      OPEN(UNIT=40, FILE='RandV.TXT', STATUS='UNKNOWN')
        DO I=1,KT
          WRITE(40,FMT='(A100)') TLINE(I)
        ENDDO
        WRITE(40,FMT='(A3,197X)') 'END'
      CLOSE(UNIT=40)

      STOP
      END

C   ..................................................
      FUNCTION SLEN(STRING)
C   ..................................................

      IMPLICIT NONE
      
      INTEGER*4         SLEN, I
      CHARACTER*(*)     STRING
      
      SLEN=LEN(STRING)
      DO I=1,SLEN
      IF(STRING(I:I).EQ.' ') THEN
        SLEN=I-1
        RETURN
      ENDIF
      ENDDO

      RETURN
      END            
      
C$Procedure
 
C   ..................................................
      SUBROUTINE INSERTINNOM_FRAME(PICNM,FRAME)
C   ..................................................

C$ Abstract
C     This routine updates the frame type for the second entry in
C     image nominal <PICNM>.NOM file
C
C$ Disclaimer
C     None
C
C$ Required_Reading
C
C     R.W. Gaskell, et.al, "Characterizing and navigating small bodies
C           with imaging data", Meteoritics & Planetary Science 43,
C           Nr 6, 1049-1061 (2008)
C
C$ Declarations
 
      IMPLICIT NONE

      INTEGER             I, KLEN, SLEN

      CHARACTER*9         FRAME
      CHARACTER*12        PICNM
      CHARACTER*72        PICTFILE
      CHARACTER*80        XLINE(10000)

      LOGICAL             EX
 
C$ Variable_I/O
C
C     Variable  I/O  Description
C     --------  ---  --------------------------------------------------
C     PICNM      I   Base name of the nominal file to be modified
C     FRAME      I   New frame variable to be updated
C
C$ File_I/O
C
C     Filename                      I/O  Description
C     ----------------------------  ---  -------------------------------
C     <PICNM>.NOM                    O   Nominal file to be updated
C
C$ Restrictions
C
C
C$ Software_Documentation
C
C     OSIRIS-REx Stereophotoclinometry Software Design Document
C     OSIRIS-REx Stereophotoclinometry Software User's Guide
C
C$ Author_and_Institution
C
C     R.W. Gaskell    (PSI)
C
C$ Version
C
C
C
C$ SPC_functions_called
C     SLEN
C
C$ SPC_subroutines_called
C     None
C
C$ SPICELIB_functions_called
C     None
C
C$ SPICELIB_subroutines_called
C     None
C
C$ Called_by_SPC_Programs
C     DYNAMICS
C

      I=SLEN(PICNM)
      PICTFILE='./NOMINALS/'//PICNM(1:I)//'.NOM'
      INQUIRE(FILE=PICTFILE, EXIST=EX)
      IF(.NOT. EX) THEN
        WRITE(6,*) PICTFILE, ' does not exist.'
        RETURN
      ENDIF
      OPEN(UNIT=22,FILE=PICTFILE,STATUS='OLD')
      KLEN=0
10    CONTINUE
      KLEN=KLEN+1

C     Read nominal file into buffer
      READ(22,FMT='(A80)') XLINE(KLEN)
      IF(XLINE(KLEN)(1:8).NE.'END FILE') GO TO 10
      CLOSE(UNIT=22)

C     Update the frame variable in the buffer
      XLINE(2)(64:72)=FRAME

C     Regenerate the nominal file with new frame entry.
      OPEN(UNIT=22,FILE=PICTFILE,STATUS='UNKNOWN')
      DO I=1,KLEN
        WRITE(22,FMT='(A80)') XLINE(I)
      ENDDO
      CLOSE(UNIT=22)

      RETURN
      END

