maps

2024-04-19 19:51:52 +03:00
parent d1e1643f8a
commit 7393489332
24 changed files with 1337 additions and 8 deletions
--- a/data/allsky/inc/read_modelrxte.f
+++ b/data/allsky/inc/read_modelrxte.f
@@ -0,0 +1,104 @@
+!c===============================================================
+      subroutine read_modelrxte(dglon,dglat,dflux,tnrows)
+!c--------------------------------------------------------------         
+!c     write image to FITS file
+!c
+!c     Created: Mon May 16 14:21:02 EDT 1994
+!c-------------------------------------------------------------- 
+! see details /afs/mpa/project/integral/results/latscan/f90/modelrxte.f
+      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,fn
+      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)
+      integer lfblnk
+      ! cobe
+      integer TROWMAX,ipixno,irezid,istddev,iglat,iglon,iraw,isum,isel
+      parameter (TROWMAX=3000000)
+      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)
+
+      status=0
+      !fn='/afs/mpa/project/integral/results/latscan/f90/modelrxte_hires.bintab.fits'
+      fn='/afs/mpa/project/integral/results/latscan/f90/modelrxte_ait_wide.bintab.fits'
+      
+      print*,'Read file',fn(:lfblnk(fn))
+      call ftgiou(unit,status)
+      call ftopen(unit,fn,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,'GLON',ixc,status)
+      call ftgcno(unit,exact,'GLAT',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
+
+      return
+      end
+