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