program cal34_1 *********************************************************************** * create calibration file (168) * * March 1, 2007 H. Koshiishi * *********************************************************************** c integer naxes(2),nantst(84),icimg(1000),iimg(1000), - pi(2000),pl(2000),pw(2000) integer*2 iccald(168) real gbeam(512,512,0:10),flx(84), - mapa(512,512),mapb(512,512), - cmap(1024,1024),pmat(4),pa(2000) character*80 filehd,infpar,infref,outf,outfft character*18 dattyp character*12 dateframe character*1 fform c ccc write(6,'(/'' input directory for output files : ''$)') read(5,'(a)') outf ccc write(6,'('' input rawdata filename header : ''$)') read(5,'(a)') filehd ccc write(6,'('' input parameter filename : ''$)') read(5,'(a)') infpar c ccc write(6,'('' input reference filename : ''$)') read(5,'(a)') infref c ccc write(6,'('' input first frame number : ''$)') read(5,*) ncfrst if (ncfrst.ne.0) then ccc write(6,'('' input last frame number : ''$)') read(5,*) ncfrend ccc write(6,'('' input frame interval : ''$)') read(5,*) ictvl ncimg=0 do 150 i=ncfrst,ncfrend,ictvl ncimg=ncimg+1 icimg(ncimg)=i 150 continue else ccc write(6,'('' input number of frames : ''$)') read(5,*) ncimg ccc write(6,'('' input frame numbers : ''$)') read(5,*) (icimg(i),i=1,ncimg) end if ccc write(6,'('' input integration frames'')') ccc write(6,'('' for calibration : ''$)') read(5,*) iccal ccc write(6,'('' for image processing : ''$)') read(5,*) ictgr c ccc write(6,'('' quiet : 1 / burst : 2 : ''$)') read(5,*) iqb c ccc write(6,'('' input pixel-size of the output files : ''$)') read(5,*) npix c ccc write(6,'('' input offset of the image center'')') ccc write(6,'('' unit(1:arcsec/2:pixel) & x-/y-offsets : ''$)') read(5,*) nuoff,xoffa,yoffa if (nuoff .eq. 1) then xoffp=xoffa/2.45553 yoffp=yoffa/2.45553 else xoffp=xoffa yoffp=yoffa xoffa=xoffp*2.45553 yoffa=yoffp*2.45553 endif c ccc write(6,'('' input first frame number : ''$)') read(5,*) nfrst if (nfrst.ne.0) then ccc write(6,'('' input last frame number : ''$)') read(5,*) nfrend ccc write(6,'('' input frame interval : ''$)') read(5,*) itvl nimg=0 do 160 i=nfrst,nfrend,itvl nimg=nimg+1 iimg(nimg)=i 160 continue else ccc write(6,'('' input number of frames : ''$)') read(5,*) nimg ccc write(6,'('' input frame numbers : ''$)') read(5,*) (iimg(i),i=1,nimg) end if ccc write(6,'('' input integration frames'')') ccc write(6,'('' for calibration : ''$)') read(5,*) ical ccc write(6,'('' for image processing : ''$)') read(5,*) itgr c ccc write(6,'('' input number limit of criterion : ''$)') read(5,*) nmaxa ccc write(6,'('' input lower limit of criterion : ''$)') read(5,*) cradd ccc write(6,'('' input factor of criterion : ''$)') read(5,*) crfac c ***** default parameters ***** c loutf=index(outf,' ')-1 c call cft512(mapa,mapb,0) c iunit=11 c call rdpar(iunit,infpar, - dec1,dec2,dec3,ha1,ha2,ha3, - solr1,solr2,solr3,solp1,solp2,solp3,solb1,solb2,solb3, - nantst) c call msrc(nantst,1.,gbeam) c iounit=2 nbit=32 naxis=2 naxes(1)=168 naxes(2)=1 c do 100 iifr=1,ncimg c iframe=icimg(iifr) c call snapuv34(iunit,filehd,iframe,iframe+ictgr-1, - nantst,iccal,iccald,1., - ndjst,msjst,msjsts,msjste,natt,nfalt,nfreq,nstat, - flx,mapa,mapb,nfrmst) if (nfrmst.ne.0) go to 100 c call cft512(mapa,mapb,-1) c call caleph(dec1,dec2,dec3,ha1,ha2,ha3, - solr1,solr2,solr3,solp1,solp2,solp3,solb1,solb2,solb3, - msjst,dec,ha,solr,solp,solb,az,alt,za,pmat) c ***** clean process ***** c pxew=999. pxns=999. nmaxa=2000 nmaxs=2000 c call clean34(2,mapa,pmat,solr*1.0125, - nantst,gbeam,cradd,crfac,cra,pxew,pxns,corf, - nmaxa,bgr,dskbr,pi,pl,pw,pa,cmap) c lfilehd=index(filehd,' ')-1 if (iframe.lt.10) - write(dateframe,'(a6,''_0000'',i1)') - filehd(lfilehd-5:lfilehd),iframe if (iframe.ge.10 .and. iframe.lt.100) - write(dateframe,'(a6,''_000'',i2)') - filehd(lfilehd-5:lfilehd),iframe if (iframe.ge.100 .and. iframe.lt.1000) - write(dateframe,'(a6,''_00'',i3)') - filehd(lfilehd-5:lfilehd),iframe if (iframe.ge.1000 .and. iframe.lt.10000) - write(dateframe,'(a6,''_0'',i4)') - filehd(lfilehd-5:lfilehd),iframe if (iframe.ge.10000) - write(dateframe,'(a6,''_'',i5)') - filehd(lfilehd-5:lfilehd),iframe c fform='p' c outfft=outf(1:loutf)//'/i'//fform//'c'//dateframe call ftinit(iounit,outfft,2880,istat) if (istat.ne.0) go to 900 dattyp='calibration_data' call puthdr(iounit,nbit,naxis,naxes, - ndjst,msjst,msjsts,msjste,iframe,iframe+ictgr-1, - 0,natt,nfalt,nfreq,nstat,dattyp) c call putcal(iounit,iccal,ictgr,pxew,pxns,corf) c call ftpdef(iounit,nbit,naxis,naxes,0,0,istat) call ftppri(iounit,0,1,naxes(1)*naxes(2),iccald,istat) call ftclos(iounit,istat) c if (istat.ne.0) go to 900 write(6,'('' out file :'',a40)') outfft c write(6,*) 'pxew , pxns =',pxew,',',pxns c 100 continue c 900 write(6,'('' istat ='',i8)') istat c end c c *********************************************************************** * putcal - write calibration parameters to fits file * * iunit : input,integer fortran unit number for fits file * * nfrcal : input,integer number of calibration frames * * nfrtgr : input,integer number of integration frames * * pxew : input,real x-offset of the center of dirty disk * * pxns : input,real y-offset of the center of dirty disk * * corf : input,real correlation of dirty disk and model * * January 30, 2007 H. Koshiishi * *********************************************************************** c subroutine putcal(iunit,nfrcal,nfrtgr,pxew,pxns,corf) c integer nfrcal,nfrtgr real pxew,pxns,corf character*44 cmnt c cmnt=' ' c call ftpkys(iunit,'progname','cal34_1 H.Koshiishi',cmnt,istat) call ftpkyj(iunit,'nfrcal',nfrcal,'number of calibration frames', - istat) call ftpkyj(iunit,'nfrtgr',nfrtgr,'number of integration frames', - istat) call ftpkye(iunit,'ddoff1',pxew,8, - 'x-offset of the dirty disk',istat) call ftpkye(iunit,'ddoff2',pxns,8, - 'y-offset of the dirty disk',istat) call ftpkyf(iunit,'ddcorr',corf,4, - 'correlation between dirty disk and model',istat) c if (istat.ne.0) write(6,'('' putcal : istat ='',i6)') istat return end