PROGRAM BINFIT
C Program to fit the parameters (separation, position angle, diameters,
C flux ratio) of a binary star observed on a single night.  (It won't
C work if the position angle changes significantly during the night.)
C     Version 1.0     27 Dec 1990     J.T. Armstrong
C Pieces of this program are borrowed from the Caltech VLBI package as
C modified by R.S. Simon; other pieces are based on the nonlinear
C least-squares fitting programs of Numerical Recipes, W.H. Press et al.
C=====================================================================
C Subroutine calls from BINFIT:
C     PUTOUT
C     READFILE     
C     CGETMOD      
C     VARYMOD      
C     CADJMOD      
C     CAFOUT       
C     CGRADLS      
C     CGRIDLS      
C     CLISTRES
C Subroutine calls from READFILE:
C     READFK5      
C     READ_VIS     
C     APSTAR
C     SIDTIM
C     DIURN
C Subroutine calls from READFK5:
C     none
C Subroutine calls from READ_VIS:
C     none  
C Subroutine calls from CGETMOD:
C     PUTOUT
C     GETMNAME     
C     MNEWMOD      
C     ROLDMOD      
C     CADJMOD      
C     CWRITEMD     
C     UPCASE
C     CHNGMOD      
C     ADDMOD       
C Subroutine calls from VARYMOD:
C     WRITEHD      
C     CWRITEMD     
C Subroutine calls from CADJMOD:
C     none
C Subroutine calls from GETMNAME:
C     EXIT
C Subroutine calls from MNEWMOD:
C     EXIT
C     CREADMDL     
C     CWRITEMD     
C Subroutine calls from ROLDMOD:
C     CREADMDL     
C Subroutine calls from CWRITEMD:
C     WRITEHD      
C Subroutine calls from CHNGMOD:
C     CWRITEMD     
C     KEYIN
C Subroutine calls from ADDMOD:
C     CWRITEMD     
C     CREADMDL     
C Subroutine calls from CREADMDL:
C     SKIPBL
C     ERROR
C Subroutine calls from WRITEHD:
C     none
C Subroutine calls from CGRADLS:
C     CADJMOD      
C     BINVIS       
C     CWRITEMD     
C     CAGRFAC      
C     CAFOUT       
C     PUTOUT
C     CTRLCEN
C     CFIXMOD      
C Subroutine calls from BINVIS:
C     BWVIS       
C Subroutine calls from BWVIS:
C     none
C Subroutine calls from CAGRFAC:
C     none
C Subroutine calls from CAFOUT:
C     EXIT
C     MKHIST
C     CWRITEMD     
C Subroutine calls from CFIXMOD:
C     none
C Subroutine calls from CGRIDLS:
C     BINVIS       
C     CAGRFAC      
C     CAFOUT       
C     PUTOUT
C     CTRLCEN
C     CFIXMOD      
C Subroutine calls from CLISTRES:
C     EXIT
C     MKHIST
C     CWRITEMD     
C===============================================================

      INCLUDE 'BINFIT.INC'

      INTEGER*4 IER, L, GETIN, VLBOPE, WHERE

      CALL PUTOUT('Program BINFIT V1.0')
      CALL PUTOUT('Fits visibility squared to binary star data')
      CALL PUTOUT(' ')

C Zero some arrays:
      DO IG = 1, MXFILT
          LAMBDA0(IG) = 0.0
          DLAMBDA(IG) = 0.0
      END DO

C Get the names of the input files; read the data in:

      CALL READFILE

      FRSTRY = .TRUE.

C Line to come back to when trying a new model:

  100 CONTINUE

C  Reset all the VARY flags
      DO IC=1,NCOMP
          DO IG=1,NFILT
              DO J=1,8
                  VARY(IC,IG,J) = .FALSE.
              END DO
          END DO
      END DO

C Read in and edit the model file:

      CALL CGETMOD

  200 CALL VARYMOD          ! Get parameters to vary
C Do a final adjustment of the model
      CALL CADJMOD
      WRITE(OUTC,'(A)') ' Starting model: '
      CALL CAFOUT(1)
      CALL PUTOUT(' ')
C Try to set parameters to vary again if this isn't right
      IF (.NOT.QUERY(' Is this acceptable? (Y or N): ')) GO TO 200
C Save the initial model:
      DO IC = 1, NCOMP
          DO IG = 1, NFILT
              PARMSTRT(IC,IG,1) = SEP    (IC,IG)
              PARMSTRT(IC,IG,2) = POSANG (IC,IG)
              PARMSTRT(IC,IG,3) = DIAM   (IC,IG)
              PARMSTRT(IC,IG,4) = DRATIO (IC,IG)
              PARMSTRT(IC,IG,5) = DELMAG (IC,IG)
              PARMSTRT(IC,IG,6) = COLOR  (IC,IG)
              PARMSTRT(IC,IG,7) = FLUX   (IC,IG)
              PARMSTRT(IC,IG,8) = FLUXTOT(IC,IG)
          END DO
      END DO
C Fit the model:

      CALL PUTOUT(' ')
      IF (QUERY(' Well, shall we try a gradient search? (Y or N): '))
     1    THEN
          CALL CGRADLS
          WHERE = 1
          CALL CAFOUT(WHERE)      ! Write parameters to screen
      END IF

      CALL PUTOUT(' ')
      IF (QUERY(' Well, should we try a brute force (grid)'//
     1         ' fit? (Y or N):')) THEN
          CALL CGRIDLS
          WHERE = 1
          CALL CAFOUT(WHERE)
      END IF

      CALL PUTOUT(' ')
      IF (QUERY(' How about Levenberg-Marquardt? (Y or N): ')) THEN
          CALL MRQSHELL
          WHERE = 1
          CALL CAFOUT(WHERE)
      END IF

      WHERE = 0
      CALL CAFOUT(WHERE)          ! Write model and parameters to file

C Let the user try again, if s/he wants:

      IF(QUERY(' Would you like to try again? (Y or N): ')) THEN
          FRSTRY = .FALSE.
          GO TO 100
      END IF

C List the data and residuals to a file:

      CALL CLISTRES

      STOP 
      END