generated from erosita/uds
111 lines
3.1 KiB
Fortran
111 lines
3.1 KiB
Fortran
!c===============================================================
|
|
subroutine read_co(dglon,dglat,dflux,tnrows)
|
|
!c--------------------------------------------------------------
|
|
!c write image to FITS file
|
|
!c
|
|
!c Created: Mon May 16 14:21:02 EDT 1994
|
|
!c--------------------------------------------------------------
|
|
implicit none
|
|
character filename*40
|
|
integer nxm,nx,ny,erange,n,m
|
|
logical anyf
|
|
logical exact,anynull
|
|
|
|
integer lnblnk
|
|
integer bitpix,pcount
|
|
real*8 norma0,norma1,slope0,slope1,dist,e1,e2,texp
|
|
real*8 crval1,crval2,crpix1,crpix2,cdelt1,cdelt2,crota2
|
|
integer naxes(3),naxis,gcount,extend
|
|
integer unit,status,block,extver,hdutype,simple
|
|
character*400 comment
|
|
integer nmapm,nmapx,nmapy
|
|
parameter(nmapm=2000)
|
|
integer nhdu,tnrows,tncols
|
|
integer ixc,iyc,ival
|
|
real skyexp(nmapm,nmapm)
|
|
real skydld(nmapm,nmapm)
|
|
real skyerr(nmapm,nmapm)
|
|
real image(nmapm,nmapm)
|
|
|
|
! cobe
|
|
integer TROWMAX,ipixno,irezid,istddev,iglat,iglon,iraw,isum,isel
|
|
parameter (TROWMAX=500000)
|
|
integer dpixno(TROWMAX),idx,sel(TROWMAX)
|
|
real dflux(TROWMAX),dglat(TROWMAX),dglon(TROWMAX)
|
|
real*8 dl,db
|
|
|
|
real dflux_49(TROWMAX)
|
|
integer*4 mask(TROWMAX)
|
|
|
|
|
|
|
|
call ftgiou(unit,status)
|
|
call ftopen(unit,'/afs/mpa/home/krivonos/results/latscan/CO/comap_list.fits',0,block,status)
|
|
if(status.ne.0) then
|
|
print*,'Bad file, skip it'
|
|
call ftclos(unit,status)
|
|
call ftfiou(unit,status)
|
|
status=0
|
|
call exit(0)
|
|
endif
|
|
call FTGHDN(unit,nhdu)
|
|
call ftmahd(unit,2,hdutype,status)
|
|
call FTGHDN(unit,nhdu)
|
|
call FTGNRW(unit,tnrows, status)
|
|
call FTGNCL(unit,tncols, status)
|
|
|
|
if(tnrows.gt.trowmax) then
|
|
print*,'Too many points',tnrows,trowmax
|
|
call ftclos(unit,status)
|
|
call ftfiou(unit,status)
|
|
stop
|
|
endif
|
|
exact=.false.
|
|
call ftgcno(unit,exact,'XCOORD',ixc,status)
|
|
call ftgcno(unit,exact,'YCOORD',iyc,status)
|
|
call ftgcno(unit,exact,'VALUE',ival,status)
|
|
|
|
do iraw=1,tnrows
|
|
call ftgcve(unit,ixc,iraw,1,1,0,dglon(iraw),anynull,status)
|
|
call ftgcve(unit,iyc,iraw,1,1,0,dglat(iraw),anynull,status)
|
|
call ftgcve(unit,ival,iraw,1,1,0.,dflux(iraw),anynull,status)
|
|
end do
|
|
|
|
call ftclos(unit,status)
|
|
call ftfiou(unit,status)
|
|
if(status.gt.0) then
|
|
print*,'Too many errors',tnrows,trowmax
|
|
call ftclos(unit,status)
|
|
call ftfiou(unit,status)
|
|
call exit(0)
|
|
endif
|
|
|
|
|
|
do iraw=1,tnrows
|
|
if (isnan(dflux(iraw))) then
|
|
!if(abs(Nint(dflux(iraw))) .eq. 32768) then
|
|
print*,dglon(iraw),dglat(iraw),dflux(iraw)
|
|
dflux(iraw)=0.0
|
|
endif
|
|
enddo
|
|
|
|
! modify coordinates
|
|
do iraw=1,tnrows
|
|
if(dglon(iraw) .gt. 180.0) then
|
|
dglon(iraw)=dglon(iraw)-360.0
|
|
endif
|
|
enddo
|
|
|
|
|
|
!RAW MAP
|
|
!do iraw=1,tnrows
|
|
! print*,dglon(iraw),dglat(iraw),dflux(iraw)
|
|
!enddo
|
|
!stop
|
|
|
|
|
|
|
|
return
|
|
end
|
|
|