	program patternfilemake
	implicit none
c
c	This program takes the pattern CRX output.txt and generates the list of frames used to generate the pattern
c
	integer*4 i,ii,ic,k,kmax,icount,ipedcnt,idarkcnt,indx(2000),jpedcnt(2000),jdarkcnt(2000),indxx(10)
	real*4 ped,dark,darks(2000),seq(10),darksv(10)
	character*24 infile,infilesv,infile1st,infilelast
	character*25 outname
	character*20 infileuse
	character*1 one,two,three
	character*15 substit,dumname,patnames(2000),namesv(10)
	character*14 inname,innamesv
	data one,two,three /'1','2','3'/
	data outname /'cNcal_YYYY_DOY_HHMMSS.txt'/
	data infileuse /'cNm0_YYYY_DOY_HHMMSS'/
	ic=2
	if(ic.eq.1)then
		open (10,file='g:\Patterns\cam1_patterns_CRX.txt',readonly)
		kmax=14191
		write(outname(2:2),'(a1)')one
		write(infileuse(2:2),'(a1)')one
	endif
	if(ic.eq.2)then
		open (10,file='g:\Patterns\cam2_patterns_CRX.txt',readonly)
		kmax=13634
		write(outname(2:2),'(a1)')two
		write(infileuse(2:2),'(a1)')two
	endif
	if(ic.eq.3)then
		open (10,file='g:\Patterns\cam3_patterns_CRX.txt',readonly)
		kmax=6623
		write(outname(2:2),'(a1)')three
		write(infileuse(2:2),'(a1)')three
	endif
	icount=0
c	kmax=3000
	do k=1,kmax
	read(10,1)infile,ped,dark,ipedcnt,idarkcnt
1	format(17x,a24,2x,2f10.3,2i6)
	write(inname,'(a14)')infile(1:14)
	if(k.eq.1)then
		infilesv=infile
		infile1st=infile
		innamesv=inname
		do i=1,2000
		darks(i)=0.
		enddo
	endif
	if(k.eq.kmax)then		!don't forget, the main place for this section is below...
		icount=icount+1
		write(dumname,'(a15)')infile(6:20)
		patnames(icount)=dumname
		darks(icount)=dark
		if(ic.eq.1.and.(ipedcnt.lt.1950.or.idarkcnt.lt.2022))darks(icount)=0.
		if(ic.eq.1.and.k.gt.1000.and.(ipedcnt.lt.1950.or.idarkcnt.lt.2038))darks(icount)=0.
		if(ic.eq.2.and.k.gt.8000.and.(ipedcnt.lt.1940.or.idarkcnt.lt.2020))darks(icount)=0.
		if(ic.eq.2.and.k.gt.600.and.(ipedcnt.lt.1940.or.idarkcnt.lt.2000))darks(icount)=0.
		if(ic.eq.2.and.k.le.600.and.(ipedcnt.lt.1880.or.idarkcnt.lt.1955))darks(icount)=0.
		jpedcnt(icount)=ipedcnt
		jdarkcnt(icount)=idarkcnt
	endif
	if(inname.ne.innamesv.or.k.eq.kmax)then
		call indexx(icount,darks,indx)
		do i=1,10		!load up the 10 we're going to use
			ii=icount-i+1
			if(ic.eq.3)ii=i	!use minimum dark current for camera 3
			namesv(i)=patnames(indx(ii))
			seq(i)=float(indx(ii))
			darksv(i)=darks(indx(ii))
c			print *,i,seq(i),namesv(i),darksv(i),jpedcnt(indx(ii)),jdarkcnt(indx(ii))
		enddo
		call indexx(10,seq,indxx)
c		print 101,outname
		substit=namesv(indxx(5))
		write(outname(7:21),'(a15)')substit
		print 100,ic,outname,icount,infile1st(6:20),infilelast(6:20),k
100	format('Camera ',i1,' calibration, outfile = ',a25,', ',i6,' frames, from ',a15,' to ',a15,', frame ',i5)
		if(ic.ne.3)print 101,outname
		if(ic.eq.3)print 1013,outname
		print 102,infile1st(1:20),infilelast(1:20)
		do i=1,10
			write(infileuse(6:20),'(a15)')namesv(indxx(i))
			print 104,i,seq(indxx(i)),infileuse,darksv(indxx(i))
		enddo
101	format('; Pattern ',a21,/,';',/,'; Shutter closed, engineering mode (mode 0), T = -XX.X C (maximum)',/)
1013	format('; Pattern ',a21,/,';',/,'; Shutter closed, engineering mode (mode 0), T = -XX.X C (minimum)',/)
102	format(a20,5x,'Start time',/a20,5x,'End time')
c		do i=1,20
c			ii=icount-i+1
c			print 103,i,indx(ii),patnames(indx(ii)),darks(indx(ii)),jpedcnt(indx(ii)),jdarkcnt(indx(ii))
103	format(2i6,2x,a15,2x,f10.3,2i6)	
104	format(i6,2x,f5.0,2x,a20,2x,f10.3)	
c		enddo			
		open(11,file=outname)
		if(ic.ne.3)write(11,101)outname
		if(ic.eq.3)write(11,1013)outname
		write(11,102)infile1st(1:20),infilelast(1:20)
		do i=1,10
			write(infileuse(6:20),'(a15)')namesv(indxx(i))
			write(11,105)infileuse
105	format(a20)			
		enddo
		close(11)
		icount=0
		innamesv=inname
		infilesv=infile
		infile1st=infile
		do i=1,2000
			darks(i)=0.
		enddo
	endif
	icount=icount+1
	write(dumname,'(a15)')infile(6:20)
	patnames(icount)=dumname
	darks(icount)=dark
		if(ic.eq.1.and.(ipedcnt.lt.1950.or.idarkcnt.lt.2022))darks(icount)=0.
		if(ic.eq.1.and.k.gt.1000.and.(ipedcnt.lt.1950.or.idarkcnt.lt.2038))darks(icount)=0.
		if(ic.eq.2.and.k.gt.8000.and.(ipedcnt.lt.1940.or.idarkcnt.lt.2020))darks(icount)=0.
		if(ic.eq.2.and.k.gt.600.and.(ipedcnt.lt.1940.or.idarkcnt.lt.2000))darks(icount)=0.
		if(ic.eq.2.and.k.le.600.and.(ipedcnt.lt.1880.or.idarkcnt.lt.1955))darks(icount)=0.
	jpedcnt(icount)=ipedcnt
	jdarkcnt(icount)=idarkcnt
	infilelast=infile
	enddo
	stop 'done'
	end
c*********************************************************************************
      SUBROUTINE INDEXX(N,ARRIN,INDX)	!from Numerical Receipes...
      implicit none
      integer*4 N
      integer*4 INDX(N),I,J,L,IR,INDXT	!Absoft Compiler dislikes INDX(N), etc.
      real*4 ARRIN(N),Q
      DO 11 J=1,N
        INDX(J)=J
11    CONTINUE
      L=N/2+1
      IR=N
10    CONTINUE
        IF(L.GT.1)THEN
          L=L-1
          INDXT=INDX(L)
          Q=ARRIN(INDXT)
        ELSE
          INDXT=INDX(IR)
          Q=ARRIN(INDXT)
          INDX(IR)=INDX(1)
          IR=IR-1
          IF(IR.EQ.1)THEN
            INDX(1)=INDXT
            RETURN
          ENDIF
        ENDIF
        I=L
        J=L+L
20      IF(J.LE.IR)THEN
          IF(J.LT.IR)THEN
            IF(ARRIN(INDX(J)).LT.ARRIN(INDX(J+1)))J=J+1
          ENDIF
          IF(Q.LT.ARRIN(INDX(J)))THEN
            INDX(I)=INDX(J)
            I=J
            J=J+J
          ELSE
            J=IR+1
          ENDIF
        GO TO 20
        ENDIF
        INDX(I)=INDXT
      GO TO 10
      END

