C+ C NAME: C A_mod_mainf C PURPOSE: C This is the main Fortran program to index TMO/SMEI data using utilizing C Spatial Index functions from the c++ file A_mod_L12_all.cpp C CATEGORY: C SMEI data analysis C CALLING SEQUENCE: C INPUTS: C Various parameters are presently specified by data statements at the top C This program presently combines data from a single SMEI camera C OUTPUTS: C A data file listing pedestal and dark current values versus frame number C A grid file containing the resulting sky map C CALLS: C set_flatfields !sets the appropriate flatfields for the selected camera C read_frame !reads a frame of data C pedestalr !removes pedestal from empty pixels C darkr !removes dark current from covered pixels C cosmicra !cosmic ray removal C lsff !large scale flatfield C ssff !small scale flatfield C rotate8 !euler angle rotation C indexframe !frame indexing routine C SEE ALSO: C INCLUDE: C COMMON BLOCKS: C PROCEDURE: C This program uses the hierarchical triangle coordinate system from Johns Hopkins, C as a base upon which the photometric measurements from a single SMEI camera are C combined and then averaged to produce a surface-brightness sky map. The "level" C parameter governs the granularityof the triangular coordinate frame. The C coordinates of the four corners of a pixel (or bin) are transformed down into C this frame, and the photometric surface brightness as measured by that pixel is C added to all triangles whose centers lie within the rectangle. C This surface brightness is corrected by 1/cosine of the pixel's angle to the camera C axis, and by r/r0 the pixel's1 fractional distance to the FOV's rotational center C When the data sequence is finished, all triangle response sums are C averaged and the resulting sky map binned into an output surface brightness map. C MODIFICATION HISTORY: C 2002,2003 Aaron Smith (UCSD/CASS) C 2002->Original version C 2003->removed most C++ functions and re-wrote in fortran as subroutines C ->add quaternion capabilities C DEC-2002, Paul Hick (UCSD/CASS; pphick@ucsd.edu) C Defined LEVEL and KMAX as parameters. KMAX is determined from LEVEL. C KMAX is then used to dimension arrays node, nodeid and hits C JAN-2003, Andrew Buffington (UCSD/CASS) C Integrated standard pedestal and dark current routines, FORTRAN C Rendered names compliant with those of B.V. Jackson C Incorporated 1/cosine surface-brightness correction for aperture perspective (currently in indexframe routine) C Incorporated large and small scale flatfield corrections C Incorporated FORTRAN read subroutine C- PROGRAM A_mod_mainf implicit none ! Dimensions for node, nodeid, hits above must be at least 2*(4**(level+1)) ! For LEVEL = 12, KMAX = 134217728 ! For LEVEL = 8, KMAX = 524288 integer*2 TOP_LEVEL parameter ( TOP_LEVEL = 12 ) integer*8 TOP_KMAX parameter ( TOP_KMAX = 2*(4**(TOP_LEVEL+1)) ) real*4 node ( TOP_KMAX ) !/TOP_KMAX*0.0/ integer*8 nodeid( TOP_KMAX ) !/TOP_KMAX*0 / integer*2 hits ( TOP_KMAX ) !/TOP_KMAX*0 / integer*2 level /TOP_LEVEL/ integer*8 kmax /TOP_KMAX/ C real*4 frame (1272,256) C real*4 framessff (1272,256) C real*4 framelsff (1272,256) C real*4 framelsffu (1272,256) real*4 frame (636,128) real*4 frame2 (636,128) real*4 framessff (636,128) real*4 framelsff (636,128) real*4 framelsffu (636,128) real*4 pattern (636,128) real*4 patmore (636,128) /81408*0./ real*4 pattotal (636,128) real*4 cutout (720,360) /64800*0./ real*4 cutcount (720,360) real*4 cutcounter (720,360) real*4 ped /0./ real*4 dark /0./ C real*4 avg (1272,256) /0./ real*4 avg (636,128) /0./ real*4 hroom /49400./ !'headroom'=new onboard value of 65k ADUs real*4 adu2e real*4 skytime (720,360) real*8 t0 /86201.9D0/ !time of day in day 365 of 2002 (23h 56m 41.9s) real*8 orbitperiod !now calculated- changes with time real*8 orbitbegintime real*8 orbitendtime real*8 affine(6) /6*0.0D0/ ! Affine parameters zero for now real*8 cra real*8 cdec real*8 alfa real*8 beta real*8 gamma real*8 euler(3) real*8 camlat real*8 degperminute real*8 ra0 real*8 arg real*8 arg1 real*8 dusk integer*2 coarseskyhits(720,360) /259200*0/ integer*4 coarsesky(720,360) /259200*0/ !coarse all sky map integer*4 BadPix(636,128) /81408*0/ integer*4 mode /2/ !onboard binning mode integer*4 ic /3/ !Camera # integer*4 ifm /0/ !ROI mask (0=no,1=yes) integer*4 id /636/ !1280 for TMO integer*4 jd /128/ !600 for TMO integer*4 neighbors /0/ C integer*4 iframemask (1272,256) /325632*1/ C integer*4 ihit(1272,256) integer*4 iframemask (636,128) /81408*1/ integer*4 ihit(636,128) integer*4 ihist(250) integer*4 image1(1200,1200) /1440000*0/ integer*4 image2(1200,1200) /1440000*0/ integer*4 image3(1200,1200) /1440000*0/ integer*4 npolarimage(1600,1600) /2560000*0/ integer*4 spolarimage(1600,1600) /2560000*0/ integer*4 s integer*4 offset,k !changed k from integer*8 to Integer*4 integer*4 firstorbit integer*4 firstdataorbit integer*4 lastorbit integer*4 firstlocalorbit integer*4 lastlocalorbit integer*4 lss integer*4 globalorbit integer*4 leaps integer*8 tcount integer*8 ttotal integer*8 ttemp /0/ character patname*36 /' DATA_SMEI/c3pattern_orbit###.grd'/ c character patname*36 /'DATA_SMEI/c3pattern_296_orbit###.grd'/ c c AARON'S DECLARATIONS c originally infile*44 c ***NOTE:the line below is for compiling for ZIGGY. CTRL+F search for "ziggy" to get other line. Also a line in read_frame_q.f character infile*63,infile2*47, listfile*32,listfile2*32,framename*25, mytime*6, badtime*6, dum1*2, dum2*2, dum3*2, dum c character infile*64,infile2*47, listfile*32,listfile2*32,framename*25, mytime*6, badtime*6, dum1*2, dum2*2, dum3*2, dum character outfile1*44,outfile2*44,outfile3*44,outfile4*44,outfile5*44 character outfile6*44,outfile7*44,outfile8*44,outfile9*44,outfile10*44 character hhead(5)*10,fname1*6,fname2*1,fname3*1,fname4*4 integer*4 idarkcr, icra, meascnt, date, hour integer*4 i, j, ss, fcnt,iarg,jarg,ii,jj,iii,jjj,icorrcnt,iffix,doy,fyear,fdoy,fh,fm,fs,listtop integer*4 orbyear,orbdoy,orbhh,orbmm,orbss,globloctest real*4 acorr(1280,301),acorrsum,flatcorr(636,128),patcorr,patdark,orbitfraction,bottompercent,toppercent real*8 phi, rlat, f, pixsum, pixdiff,ftime C real*8 x(4), y(4), ra(4), dec(4) real*8 qcam(3,4), qc(4), qsc(4), qandy(4), qdum(4), qignore(4), qfinal(4) data ihist /250*0/ data ihit /81408*0/ 963 continue c print*,'enter 0 for local numbering, 1 for global numbering' c read*,globloctest print*,'Camera 3, May 2003, day 149 through 150, orbits 65 through 91' globloctest=0 if(globloctest.eq.1)then print*, 'please enter first orbit number' read*,firstorbit print*,'please enter last orbit number' read*,lastorbit elseif(globloctest.eq.0)then c print*, 'please enter first global orbit number of first orbit in data section' c read*,firstorbit firstorbit=2035 print*,'please enter first local orbit number (>64)' read*,firstlocalorbit print*,'please enter last local orbit number (<92)' read*,lastlocalorbit lastorbit=firstorbit+(lastlocalorbit-1) firstorbit=firstorbit+(firstlocalorbit-1) else print*,'invalid entry' go to 963 endif !! updated test quaternions (e1=-86.10, e2=59.05, e3=-6.75) qcam(2,1) = -0.268131D0 qcam(2,2) = 0.0170381D0 qcam(2,3) = 0.962053D0 qcam(2,4) = 0.0476403D0 !! refined camera 1 quaternions [-28.5,70.4,-21.5] qcam(1,1) = -0.237689D0 qcam(1,2) = 0.467706D0 qcam(1,3) = 0.848236D0 qcam(1,4) = 0.0724612D0 !! test quaternion for camera 3 [-143.3, 63.43, -0.42] qcam(3,1) = 0.203781D0 qcam(3,2) = 0.437286D0 qcam(3,3) = -0.869462D0 qcam(3,4) = -0.106259D0 !!quaternion to rotate Andy's coordinates to Don's qandy(1)=0.5D0 qandy(2)=0.5D0 qandy(3)=0.5D0 qandy(4)=0.5D0 meascnt=0 print*, 'Fortran In ...' c print*, 'Level: ', level, ' (array size: ', kmax,')' adu2e=4.5*65536./hroom c call set_flatfields(ic,framessff,framelsff,framelsffu) !note dimensions should be checked before ff is done... c call set_cr_backgnd(mode,ic,ifm,id,jd,avg) offset=13 open(10,file='DATA_SMEI/newfltgrd3.GRD',readonly) open(11,file='DATA_SMEI/pattern3.grd',readonly) read(11,9)dum read(11,9)dum read(11,9)dum read(11,9)dum read(11,9)dum do j=1,jd read(11,11)(pattern(i,j),i=1,id) enddo c read(11,159)patdark c159 format(f10.4) patdark=8.18 c print*, 'Patdark: ',patdark 9 format(a10) 11 format(20f9.3) close(11) read(10,1)hhead 1 format(a10) read(10,3)((acorr(i,j),i=1,1280),j=1,301) 3 format(20f10.5) iffix=0 do i=5,id-5 do j=5,jd-5 iarg=2+mode*(i-1) jarg=offset+mode*(j-1) if(acorr(iarg,jarg).eq.0.)then acorrsum=0. icorrcnt=0 do ii=-1,1 do jj=-1,1 if(ii.ne.0.or.jj.ne.0)then if(acorr(iarg+mode*ii,jarg+mode*jj).ne.0.)then acorrsum=acorrsum + acorr(iarg+mode*ii,jarg+mode*jj) icorrcnt=icorrcnt+1 endif endif enddo enddo if(icorrcnt.ge.5)then acorrsum=acorrsum/float(icorrcnt) iffix=iffix+1 do iii=0,mode-1 do jjj=0,mode-1 acorr(iarg+iii,jarg+jjj)=acorrsum enddo enddo endif endif enddo enddo print *,iffix,'large scale flatfield entries filled in with neighbors average.' do i=1,id do j=1,jd iarg=2+mode*(i-1) jarg=offset+mode*(j-1) flatcorr(i,j)=acorr(iarg,jarg) enddo enddo close(10) c firstorbit = 4185 !Orbit number in all smei- year: 2003 / day: 296 / time: 05h 13m 0.6s !read off begining of list open(100,file='DATA_SMEI/start_times2.txt',readonly) do s=1,firstorbit-1 read(100,1000)globalorbit,orbyear,orbdoy,orbhh,orbmm,orbss,orbitperiod,orbitbegintime 1000 format(i7,2x,i6,2x,i5,4x,i2.2,1x,i2.2,1x,i2.2,2x,f10.3,2x,f17.3) enddo C**************************************************************** !! loop to index many orbits separately do ss=1,lastorbit-(firstorbit-1) ! last orbit that CAN be done is 184 (when all data frames are unzipped from day 152 through day 157 )(???) globalorbit = firstorbit+ss-1 lss = firstlocalorbit+ss-1 c if(lss.eq.17.or.lss.ge.190)then if(lss.ge.0)then !!!!use this when no orbits are to be skipped read(100,1000)globalorbit,orbyear,orbdoy,orbhh,orbmm,orbss,orbitperiod,orbitbegintime !should be able to take the values being read in above orbitperiod = 6096.49D0-0.84D-04*float(globalorbit) orbitbegintime=t0+dfloat(globalorbit-1)*6096.49D0-0.84D-04*dfloat((globalorbit-1)*globalorbit)/2.D0 orbitendtime=orbitbegintime+orbitperiod do i=1,720 do j=1,360 coarsesky(i,j)=0 coarseskyhits(i,j)=0 skytime(i,j)=0. cutout(i,j)=0. cutcount(i,j)=0. cutcounter(i,j)=0. if(i.le.id.and.j.le.jd)then BadPix(i,j)=0 patmore(i,j)=0. endif enddo enddo print 1004,globalorbit !ss 1004 format(' Beginning orbit # ',i5) listtop=1000000 !25000 !! total # of frames in list "cam3_296to310_CRX.txt" write(listfile,'(A32)') 'DATA_SMEI/cam3_144to157_CRXe.txt' if(lss.ge.2)then write(patname(30:32),'(I3.3)')lss open(13,file=patname,readonly) print *, 'reading in ',patname,'...' read(13,9)dum read(13,9)dum read(13,9)dum read(13,9)dum read(13,9)dum do j=1,jd read(13,130)(patmore(i,j),i=1,id) enddo 130 format(20f9.3) elseif(lss.eq.1)then do i=1,id do j=1,jd patmore(i,j)=0. enddo enddo endif !NOTE, Corrections below are AD-HOC, and will likely need refinement do j=1,jd do i=1,636 if(abs(patmore(i,j)).lt.10.)patmore(i,j)=0. if(patmore(i,j).lt.0.)patmore(i,j)=patmore(i,j)+5. if(patmore(i,j).gt.10.)patmore(i,j)=patmore(i,j)-15. if(pattern(i,j)+patmore(i,j).lt.0.)patmore(i,j)=0. !cures white measle troubles pattotal(i,j)=pattern(i,j)+patmore(i,j) enddo enddo close(13) do k=1,kmax node(k)=0.0 nodeid(k)=0 hits(k)=0 enddo open(12,file=listfile,status='old') C open(12,file=listfile,readonly) do k=1,listtop read(12,12)fname1,fyear,fname2,fdoy,fname3,fh,fm,fs,fname4,doy,ped,dark,qdum,meascnt,pixsum,pixdiff 12 format(a6,I4,a1,I3,a1,3I2.2,a4,I3,2f10.3,4f13.9,I6,2f10.2) leaps=int(float((fyear-1)-2000)/4.)-int((float(fyear-1)-2000)/100.)+int((float(fyear-1)-2000)/400.) ftime = (365.D0)*24.D0*3600.D0*(dfloat(fyear)-2002.D0)+24.D0*3600.D0*(dfloat(fdoy)-365.D0+dfloat(leaps)) & +3600.D0*dfloat(fh)+60.D0*dfloat(fm)+dfloat(fs) c**** Andy's note here: what do we think/do about leap year??? **************************************** if(ftime.gt.orbitendtime)then go to 99 !!get out of k frame loop endif orbitfraction=(ftime-orbitbegintime)/orbitperiod !!use these to pick portion of orbit to do, 1% ~ 15 frames. bottompercent=0.25 !! 0.15 to start 15% through orbit toppercent=0.2600 !! 0.75 to end 75% through orbit c if(orbitbegintime.le.ftime.and.dark.le.-9999.)print*, 'BAD DARK CURRENT VALUE IN FRAME ',framename if(orbitbegintime.le.ftime.and.ped.le.-9999.)print*, 'BAD PEDESTAL VALUE IN FRAME ',framename if(orbitbegintime.le.ftime.and.dark.gt.-9999..and.ped.gt.-9999.)then c print*, orbitfraction if(bottompercent.lt.orbitfraction.and.orbitfraction.le.toppercent)then write(framename,'(a6,I4.4,a1,I3.3,a1,3I2.2,a4)')fname1,fyear,fname2,fdoy,fname3,fh,fm,fs,fname4 c ZIGGY line below if(doy.eq.149)write(infile,'(A38,A25)') '/zappa/zone/2003_149_150/data2/c3_149/',framename if(doy.eq.150)write(infile,'(A38,A25)') '/zappa/zone/2003_149_150/data3/c3_150/',framename c write(infile,'(A22,I1.1,A1,I3.3,A1,A25)') '/ziggy/zone/frames/cam',ic,'_',doy,'/',framename c write(infile,'(A33,I1.1,A1,I3.3,A1,A25)') '../../../../../mnt/big/Orbits/cam',ic,'_',doy,'/',framename ***************** if(mod(k,1).eq.0) print 1001,lss,k,infile,meascnt,pixdiff, & pattern(270,30)+patmore(270,30),orbitfraction 1001 format(i3,i7,': ',a63,i6,f10.2,f9.3,5x,f5.3) call read_frame_q(infile,mode,ic,id,jd,frame,qignore) !qignore quaternions never used. Replaced with Andy's quaternions patcorr=(dark)/patdark !!the 0.5 must be removed when new list is generated do i=1,id do j=1,jd arg=frame(i,j) arg = arg !Headroom adjustment (may noy comply with engineering data and cam3) arg=arg-ped !Remove pedestal if(i.gt.8.and.i.lt.635)arg=arg-pattotal(i,j)*patcorr !Remove dark current and pattern if(flatcorr(i,j).ne.0.)arg=arg/flatcorr(i,j) !Flat Field Correction if(frame(i,j).ne.0.)frame(i,j)=arg C if(i.eq.159)then C print 1003, frame(i,j), frame2(i,j), i, j,frame(i,j)-frame2(i,j),pattern(i,j)+patmore(i,j) C1003 format('NIC = ',f9.2, ', BIN = ',f9.2 ', (i,j) = (',I3,',',I3,') ,NIC-BIN = ',f9.2,', Pattern =',f9.2) C endif enddo enddo C go to 98 !! input quaternion is of form ai+bj+ck+d, not d+ai+bj+cK -> swap with new quaternion qsc(1)=qdum(4) qsc(2)=qdum(1) qsc(3)=qdum(2) qsc(4)=qdum(3) !! multiply camera quaternion into spacecraft(frame) quaternion and take the inverse !! of camera quaternion because it goes from sky to ccd qc(1)=qcam(ic,1) qc(2)=-qcam(ic,2) qc(3)=-qcam(ic,3) qc(4)=-qcam(ic,4) call qmultiply(qsc,qc,qdum) call qmultiply(qdum,qandy,qfinal) !!take inverse of final quaternion: going from ccd to sky, not the other way around C qfinal(1)=qfinal(1) qfinal(2)=-qfinal(2) qfinal(3)=-qfinal(3) qfinal(4)=-qfinal(4) C find ra/dec of center of FOV for a frame C find ra of center of the first frame; use to calculate ra bounds in final image c car/cdec calculated from thetax=thetay=0 C cra=0.D0 C cdec=90.D0 C call rotateq(qfinal,cra,cdec) !!rotate to standard system C print*, day144name,' [',cra,',',cdec,']' tcount=1 call indexframe(mode,ic,id,jd,level,TOP_KMAX,node,nodeid,hits,frame,affine,qfinal,tcount,ttotal,BadPix, & cutout,cutcount,cutcounter,pattotal,patdark,coarsesky,coarseskyhits,skytime,orbitfraction) endif !!end if block to include specific orbit(s) endif !! end if block to specify fractions within an orbit enddo !!end k frame loop 99 continue close(12) print 1002, lss 1002 format('Orbit #',I3,' indexed. Calling average night') call averagenight_allsky(node,nodeid,hits,TOP_KMAX,level,image1,image2,image3, npolarimage, spolarimage) print*, 'Night Averaged, Writing Files...' if(lss.lt.10000)then do i=1,720 do j=1,360 if(coarseskyhits(i,j).ne.0)then coarsesky(i,j)=coarsesky(i,j)/coarseskyhits(i,j) skytime(i,j)=skytime(i,j)/float(coarseskyhits(i,j)) endif if(cutcount(i,j).ne.0.)cutout(i,j)=cutout(i,j)/cutcount(i,j) if(cutcounter(i,j).ne.0.)cutcount(i,j)=cutcount(i,j)/cutcounter(i,j) enddo enddo 1234 format(A20,I1.1,A4,I4,A1,I3.3,A1,3i2.2,A4) !!Write image1(sky atlas) to file C write (outfile1,'(I4.4,A1,I2.2,A13)') date,'_',hour,'_EqPlot_1.grd' c write (outfile1,'(A1,I1.1,A1,I3.3,A7,I3.3,A4)') 'c',ic,'eq1_',orbdoy,'_Orbit_',ss,'_Eq1.grd' write (outfile1,1234) '/zappa/zone/Orbits/c',ic,'_',orbyear,'_',orbdoy,'_',orbhh,orbmm,orbss,'.grd' open (10,file = outfile1, form = 'formatted') write(10,10) 10 format('DSAA'/'1200 1200'/'0 120'/'-60 60'/'0 1400') do j=1,1200 write(10,'(20i6)')(image1(i,j),i=1,1200) enddo close(10) C write (outfile2,'(I4.4,A1,I2.2,A13)') date,'_',hour,'_EqPlot_2.grd' c write (outfile2,'(A1,I1.1,A1,I3.3,A7,I3.3,A8)') 'c',ic,'_',orbdoy,'_Orbit_',ss,'_Eq2.grd' write (outfile2,1234) '/zappa/zone/Orbits/c',ic,'eq2_',orbyear,'_',orbdoy,'_',orbhh,orbmm,orbss,'.grd' open (13,file = outfile2, form = 'formatted') write(13,13) 13 format('DSAA'/'1200 1200'/'120 240'/'-60 60'/'0 1400') do j=1,1200 write(13,'(20i6)')(image2(i,j),i=1,1200) enddo close(13) C write (outfile3,'(I4.4,A1,I2.2,A13)') date,'_',hour,'_EqPlot_3.grd' c write (outfile3,'(A1,I1.1,A1,I3.3,A7,I3.3,A8)') 'c',ic,'_',orbdoy,'_Orbit_',ss,'_Eq3.grd' write (outfile3,1234) '/zappa/zone/Orbits/c',ic,'eq3_',orbyear,'_',orbdoy,'_',orbhh,orbmm,orbss,'.grd' open (14,file = outfile3, form = 'formatted') write(14,14) 14 format('DSAA'/'1200 1200'/'240 360'/'-60 60'/'0 1400') do j=1,1200 write(14,'(20i6)')(image3(i,j),i=1,1200) enddo close(14) C write (outfile4,'(I4.4,A1,I2.2,A11)') date,'_',hour,'_npolar.grd' c write (outfile4,'(A1,I1.1,A1,I3.3,A7,I3.3,A11)') 'c',ic,'_',orbdoy,'_Orbit_',ss,'_Npolar.grd' write (outfile4,1234) '/zappa/zone/Orbits/c',ic,'npl_',orbyear,'_',orbdoy,'_',orbhh,orbmm,orbss,'.grd' open (15,file = outfile4, form = 'formatted') write(15,15) 15 format('DSAA'/'1600 1600'/'-40 40'/'-40 40'/'0 1400') do j=1,1600 write(15,'(20i6)')(npolarimage(i,j),i=1,1600) enddo close(15) C write (outfile5,'(I4.4,A1,I2.2,A11)') date,'_',hour,'_spolar.grd' c write (outfile5,'(A1,I1.1,A1,I3.3,A7,I3.3,A11)') 'c',ic,'_',orbdoy,'_Orbit_',ss,'_Spolar.grd' write (outfile5,1234) '/zappa/zone/Orbits/c',ic,'spl_',orbyear,'_',orbdoy,'_',orbhh,orbmm,orbss,'.grd' open (16,file = outfile5, form = 'formatted') write(16,16) 16 format('DSAA'/'1600 1600'/'-40 40'/'-40 40'/'0 1400') do j=1,1600 write(16,'(20i6)')(spolarimage(i,j),i=1,1600) enddo close(16) c write (outfile6,'(A1,I1.1,A1,I3.3,A7,I3.3,A11)') 'c',ic,'_',orbdoy,'_Orbit_',ss,'_BadPix.grd' write (outfile6,1234) '/zappa/zone/Orbits/c',ic,'bpx_',orbyear,'_',orbdoy,'_',orbhh,orbmm,orbss,'.grd' open (17,file = outfile6, form = 'formatted') write(17,17) 17 format('DSAA'/'636 128'/'0 636'/'0 128'/'0 20000') do j=1,128 write(17,'(20i8)')(BadPix(i,j),i=1,636) enddo close(17) c write (outfile7,'(A1,I1.1,A1,I3.3,A7,I3.3,A11)') 'c',ic,'_',orbdoy,'_Orbit_',ss,'_Cutout.grd' write (outfile7,1234) '/zappa/zone/Orbits/c',ic,'cut_',orbyear,'_',orbdoy,'_',orbhh,orbmm,orbss,'.grd' open (18,file = outfile7, form = 'formatted') write(18,18) 18 format('DSAA'/'720 360'/'0 360'/'-90 90'/'0 1400') do j=1,360 write(18,'(20f10.2)')(cutout(i,j),i=1,720) enddo close(18) c write (outfile8,'(A1,I1.1,A1,I3.3,A7,I3.3,A13)') 'c',ic,'_',orbdoy,'_Orbit_',ss,'_CutCount.grd' write (outfile8,1234) '/zappa/zone/Orbits/c',ic,'cnt_',orbyear,'_',orbdoy,'_',orbhh,orbmm,orbss,'.grd' open (19,file = outfile8, form = 'formatted') write(19,19) 19 format('DSAA'/'720 360'/'0 360'/'-90 90'/'0 1') do j=1,360 write(19,'(20f8.2)')(cutcount(i,j),i=1,720) enddo close(19) c write (outfile9,'(A1,I1.1,A1,I3.3,A7,I3.3,A14)') 'c',ic,'_',orbdoy,'_Orbit_',ss,'_AllSkyMap.grd' write (outfile9,1234) '/zappa/zone/Orbits/c',ic,'asm_',orbyear,'_',orbdoy,'_',orbhh,orbmm,orbss,'.grd' open (20,file = outfile9, form = 'formatted') write(20,20) 20 format('DSAA'/'720 360'/'0 360'/'-90 90'/'0 1400') do j=1,360 write(20,'(20i8)')(coarsesky(i,j),i=1,720) enddo close(20) write (outfile10,1234) '/zappa/zone/Orbits/c',ic,'tmp_',orbyear,'_',orbdoy,'_',orbhh,orbmm,orbss,'.grd' open (21,file = outfile10, form = 'formatted') write(21,21) 21 format('DSAA'/'720 360'/'0 360'/'-90 90'/'0 1') do j=1,360 write(21,'(20f8.3)')(skytime(i,j),i=1,720) enddo close(21) endif !!don't waste time writing files when testing endif enddo !!end ss loop to separately index many orbits close(100) print*, ' ' 98 continue print*, 'All Orbits Finished!!!' END