#define _LINUX_ .true. subroutine buff2pix_r4(buff,pix,n1,nt) implicit none byte buff(2880) real pix(*) integer n1,nt byte b(4) real r equivalence(r,b) integer i, npu, nbu do i = 1, 720 npu = n1+i-1 nbu = (i-1)*4 if (.not.(_LINUX_)) then b(1) = buff(nbu+1) b(2) = buff(nbu+2) b(3) = buff(nbu+3) b(4) = buff(nbu+4) endif if ((_LINUX_)) then b(4) = buff(nbu+1) b(3) = buff(nbu+2) b(2) = buff(nbu+3) b(1) = buff(nbu+4) endif if (npu.ge.1.and.npu.le.nt) pix(npu) = r enddo return end c------------------------------------------------------- c c subroutine buff2pix_r4_edge(buff,pix,n1,nt, . NXP,NYP,NXF,NYF) implicit none c character buff(2880) byte buff(2880) integer NXP,NYP real pix(NXP,NYP) integer n1,nt integer NXF,NYF real pbuff(720) common /sneaky/pbuff integer i integer npu, nbu integer NX, NY byte b(4) real r equivalence(r,b) do i = 1, 720 npu = n1+i-1 nbu = (i-1)*4 if (npu.ge.1.and.npu.le.nt) then NX = npu - (npu-1)/NXF*NXF NY = 1 + (npu-1)/NXF if (NX.le.NXP.and.NY.le.NYP) then if (.not.(_LINUX_)) then b(1) = buff(nbu+1) b(2) = buff(nbu+2) b(3) = buff(nbu+3) b(4) = buff(nbu+4) endif if ((_LINUX_)) then b(4) = buff(nbu+1) b(3) = buff(nbu+2) b(2) = buff(nbu+3) b(1) = buff(nbu+4) endif if (npu.ge.1.and.npu.le.nt) pix(NX,NY) = r endif endif enddo return end c------------------------------------------------------- c c subroutine pix2buff_r4(buff,pix,n1,nt) implicit none byte buff(2880) real*4 pix(*) integer n1,nt byte b(4) real*4 r equivalence(r,b) integer i, npu, nbu do i = 1, 720 npu = n1+i-1 nbu = (i-1)*4 if (npu.ge.1.and.npu.le.nt) r = pix(npu) if (.not.(_LINUX_)) then buff(nbu+1) = b(1) buff(nbu+2) = b(2) buff(nbu+3) = b(3) buff(nbu+4) = b(4) endif if ((_LINUX_)) then buff(nbu+1) = b(4) buff(nbu+2) = b(3) buff(nbu+3) = b(2) buff(nbu+4) = b(1) endif enddo return end subroutine buff2pix_i4(buff,pix,n1,nt) implicit none byte buff(2880) integer*4 pix(*) integer n1,nt byte b(4) integer ii equivalence(ii,b) integer i, npu, nbu do i = 1, 720 npu = n1+i-1 nbu = (i-1)*4 if (.not.(_LINUX_)) then b(1) = buff(nbu+1) b(2) = buff(nbu+2) b(3) = buff(nbu+3) b(4) = buff(nbu+4) endif if ((_LINUX_)) then b(4) = buff(nbu+1) b(3) = buff(nbu+2) b(2) = buff(nbu+3) b(1) = buff(nbu+4) endif if (npu.ge.1.and.npu.le.nt) pix(npu) = ii enddo return end subroutine buff2pix_i2(buff,pix,n1,nt) implicit none byte buff(2880) integer*2 pix(*) integer n1,nt byte b(2) integer ii equivalence(ii,b) integer i, npu, nbu do i = 1, 1440 npu = n1+i-1 nbu = (i-1)*2 if (.not.(_LINUX_)) then b(1) = buff(nbu+1) b(2) = buff(nbu+2) endif if ((_LINUX_)) then b(2) = buff(nbu+1) b(1) = buff(nbu+2) endif if (npu.ge.1.and.npu.le.nt) pix(npu) = ii enddo return end subroutine pix2buff_i2(buff,pix,n1,nt) implicit none byte buff(2880) integer*2 pix(*) integer n1,nt byte b(2) integer*2 ii equivalence(ii,b) integer i, npu, nbu do i = 1, 1440 npu = n1+i-1 nbu = (i-1)*2 if (npu.ge.1.and.npu.le.nt) ii = pix(npu) if (.not.(_LINUX_)) then buff(nbu+1) = b(1) buff(nbu+2) = b(2) endif if ((_LINUX_)) then buff(nbu+1) = b(2) buff(nbu+2) = b(1) endif enddo return end subroutine pix2buff_i4(buff,pix,n1,nt) implicit none byte buff(2880) integer*4 pix(*) integer n1,nt byte b(4) integer ii equivalence(ii,b) integer i, npu, nbu do i = 1, 720 npu = n1+i-1 nbu = (i-1)*4 if (npu.ge.1.and.npu.le.nt) ii = pix(npu) if (.not.(_LINUX_)) then buff(nbu+1) = b(1) buff(nbu+2) = b(2) buff(nbu+3) = b(3) buff(nbu+4) = b(4) endif if ((_LINUX_)) then buff(nbu+1) = b(4) buff(nbu+2) = b(3) buff(nbu+3) = b(2) buff(nbu+4) = b(1) endif enddo return end subroutine writfits_i2_32K(FILE,pix,PXDIMX,PXDIMY) implicit none integer PXDIMX,PXDIMY character*80 FILE integer*2 pix(PXDIMX,PXDIMY) integer nbyte0 integer nbyteE integer nbyte1 integer nbyte2 integer nbper integer i,ios character*2880 buffc byte buffb(2880) equivalence (buffb,buffc) integer ifirst, i1, i2 integer np1, np2, npt character*70 HDR(25) common/HDR/HDR character*80 FILEU FILEU = FILE do i = 75,2,-1 if (FILE(i:i+4).eq.'.fits') FILEU = FILE(1:i+4) enddo c write(*,'(''ENTER writfits_i2_32K: '',80a)') FILEU open(10,file=FILEU, . status='unknown', . err =900, . recl =2880, . form ='UNFORMATTED', . access='DIRECT') i = 1 write(buffc( 0*80+1: 1*80),'(''SIMPLE = T '')') write(buffc( 1*80+1: 2*80),'(''BITPIX = 16 '')') write(buffc( 2*80+1: 3*80),'(''NAXIS = '',i12)') 2 write(buffc( 3*80+1: 4*80),'(''NAXIS1 = '',i12)') PXDIMX write(buffc( 4*80+1: 5*80),'(''NAXIS2 = '',i12)') PXDIMY write(buffc( 5*80+1: 6*80),'(''DATATYPE= '',9a)') . ' ''INTEGER*2 ''' write(buffc( 6*80+1: 7*80),'(''DATE = '',11a)') . ' ''28/01/00''' write(buffc( 7*80+1: 8*80),'(''BSCALE = '',i12)') 00001 write(buffc( 8*80+1: 9*80),'(''BZERO = '',i12)') 32000 write(buffc(09*80+1:10*80),'(''CRPIX1 = '',a20)') HDR(01) write(buffc(10*80+1:11*80),'(''CRPIX2 = '',a20)') HDR(02) write(buffc(11*80+1:12*80),'(''CRVAL1 = '',a20)') HDR(03) write(buffc(12*80+1:13*80),'(''CRVAL2 = '',a20)') HDR(04) write(buffc(13*80+1:14*80),'(''CTYPE1 = '',a20)') HDR(05) write(buffc(14*80+1:15*80),'(''CTYPE2 = '',a20)') HDR(06) write(buffc(15*80+1:16*80),'(''CD1_1 = '',a20)') HDR(07) write(buffc(16*80+1:17*80),'(''CD1_2 = '',a20)') HDR(08) write(buffc(17*80+1:18*80),'(''CD2_1 = '',a20)') HDR(09) write(buffc(18*80+1:19*80),'(''CD2_2 = '',a20)') HDR(10) write(buffc(19*80+1:20*80),'(''ORIENTAT= '',a20)') HDR(11) write(buffc(20*80+1:21*80),'(''PA_APER = '',a20)') HDR(12) write(buffc(21*80+1:22*80),'(''PA_V3 = '',a20)') HDR(13) write(buffc(22*80+1:23*80),'(''DATE-OBS= '',a20)') HDR(14) write(buffc(23*80+1:24*80),'(''TIME-OBS= '',a20)') HDR(15) write(buffc(24*80+1:25*80),'(''EXPTIME = '',a20)') HDR(16) write(buffc(25*80+1:26*80),'(''ROOTNAME= '',a20)') HDR(17) write(buffc(26*80+1:27*80),'(''TARGNAME= '',a20)') HDR(18) write(buffc(27*80+1:28*80),'(''RA_TARG = '',a20)') HDR(19) write(buffc(28*80+1:29*80),'(''DEC_TARG= '',a20)') HDR(20) write(buffc(29*80+1:30*80),'(''PROPOSID= '',a20)') HDR(21) write(buffc(30*80+1:31*80),'(''FILTER1 = '',a20)') HDR(22) write(buffc(31*80+1:32*80),'(''FILTER2 = '',a20)') HDR(23) write(buffc(32*80+1:33*80),'(''VAFACTOR= '',a20)') HDR(24) write(buffc(33*80+1:34*80),'(''COMMENT '')') write(buffc(34*80+1:35*80),'(''COMMENT '')') write(buffc(35*80+1:36*80),'(''END '')') write(10,rec=i,iostat=ios) buffc ifirst = i+1 i1 = i i2 = i nbper = 2*PXDIMX*PXDIMY npt = PXDIMX*PXDIMY nbyte1 = 1 nbyte2 = nbper i1 = i+1 + nbyte1/2880 i2 = i+1 + nbyte2/2880 do i = i1, i2, 1 nbyte0 = (i-ifirst)*2880+ 1 nbyteE = (i-ifirst)*2880+2880 np1 = (nbyte0-nbyte1)/4 + 1 np2 = (nbyteE-nbyte1)/4 + 1 np1 = (nbyte0-nbyte1)/2 + 1 np2 = (nbyteE-nbyte1)/2 + 1 !if (i.lt.0010) print*,'i: ',i,i1,i2,np1,np2,nbyte0 !if (i.gt.2900) print*,'i: ',i,i1,i2,np1,np2,nbyte0 call pix2buff_i2(buffb,pix,np1,npt) write(10,rec=i,iostat=ios) buffc enddo close(10) return 900 continue print*,'WRITFITS.f ERROR' stop end c------------------------------------------------------ c c this routine will write an integer*4 array into c a 2-dimensional fits image c subroutine writfits_i4(FILE,pix,PXDIMX,PXDIMY) implicit none integer PXDIMX,PXDIMY character*80 FILE integer*4 pix(PXDIMX,PXDIMY) integer nbyte0 integer nbyteE integer nbyte1 integer nbyte2 integer nbper integer i,ios integer ii, jj character*2880 buffc byte buffb(2880) equivalence (buffc,buffb) integer ifirst, i1, i2 integer np1, np2, npt logical DIAG data DIAG/.false./ character*70 HDR(25) common/HDR/HDR character*80 FILEU FILEU = FILE do i = 75,2,-1 if (FILE(i:i+4).eq.'.fits') FILEU = FILE(1:i+4) enddo open(10,file=FILEU, . status='unknown', . err =900, . recl =2880, . form ='UNFORMATTED', . access='DIRECT') write(buffc( 0*80+1: 1*80),'(''SIMPLE = T '')') write(buffc( 1*80+1: 2*80),'(''BITPIX = 32 '')') write(buffc( 2*80+1: 3*80),'(''NAXIS ='',i12)') 2 write(buffc( 3*80+1: 4*80),'(''NAXIS1 ='',i12)') PXDIMX write(buffc( 4*80+1: 5*80),'(''NAXIS2 ='',i12)') PXDIMY write(buffc( 5*80+1: 6*80),'(''DATATYPE='',9a)') . ' ''INTEGER*4''' write(buffc( 6*80+1: 7*80),'(''DATE ='',11a)') . ' ''00/00/00''' write(buffc( 7*80+1: 8*80),'(''BSCALE ='',i12)') 00001 write(buffc( 8*80+1: 9*80),'(''BZERO ='',i12)') 00000 write(buffc(09*80+1:10*80),'(''CRPIX1 ='',a20)') HDR(01) write(buffc(10*80+1:11*80),'(''CRPIX2 ='',a20)') HDR(02) write(buffc(11*80+1:12*80),'(''CRVAL1 ='',a20)') HDR(03) write(buffc(12*80+1:13*80),'(''CRVAL2 ='',a20)') HDR(04) write(buffc(13*80+1:14*80),'(''CTYPE1 ='',a20)') HDR(05) write(buffc(14*80+1:15*80),'(''CTYPE2 ='',a20)') HDR(06) write(buffc(15*80+1:16*80),'(''CD1_1 ='',a20)') HDR(07) write(buffc(16*80+1:17*80),'(''CD1_2 ='',a20)') HDR(08) write(buffc(17*80+1:18*80),'(''CD2_1 ='',a20)') HDR(09) write(buffc(18*80+1:19*80),'(''CD2_2 ='',a20)') HDR(10) write(buffc(19*80+1:20*80),'(''ORIENTAT='',a20)') HDR(11) write(buffc(20*80+1:21*80),'(''PA_APER ='',a20)') HDR(12) write(buffc(21*80+1:22*80),'(''PA_V3 ='',a20)') HDR(13) write(buffc(22*80+1:23*80),'(''DATE-OBS='',a20)') HDR(14) write(buffc(23*80+1:24*80),'(''TIME-OBS='',a20)') HDR(15) write(buffc(24*80+1:25*80),'(''EXPTIME ='',a20)') HDR(16) write(buffc(25*80+1:26*80),'(''ROOTNAME='',a20)') HDR(17) write(buffc(26*80+1:27*80),'(''TARGNAME='',a20)') HDR(18) write(buffc(27*80+1:28*80),'(''RA_TARG ='',a20)') HDR(19) write(buffc(28*80+1:29*80),'(''DEC_TARG='',a20)') HDR(20) write(buffc(29*80+1:30*80),'(''PROPOSID='',a20)') HDR(21) write(buffc(30*80+1:31*80),'(''FILTER1 ='',a20)') HDR(22) write(buffc(31*80+1:32*80),'(''FILTER2 ='',a20)') HDR(23) write(buffc(33*80+1:34*80),'(''VAFACTOR='',a20)') HDR(24) write(buffc(32*80+1:33*80),'(''CCDGAIN ='',a20)') HDR(25) write(buffc(34*80+1:35*80),'(''COMMENT '')') write(buffc(35*80+1:36*80),'(''END '')') i = 1 write(10,rec=i,iostat=ios) buffc ifirst = i+1 i1 = i i2 = i nbper = 4*PXDIMX*PXDIMY npt = PXDIMX*PXDIMY nbyte1 = 1 nbyte2 = nbper i1 = i+1 + nbyte1/2880 i2 = i+1 + nbyte2/2880 if (DIAG) then print*,'-----> i1: ',i1 print*,'-----> i2: ',i2 print*,'-----> PXDIMX: ',PXDIMX print*,'-----> PXDIMY: ',PXDIMY print*,'-----> nbper: ',nbper print*,'-----> npt: ',npt print*,'-----> C' endif do ii = 1, PXDIMX do jj = 1, PXDIMY pix(ii,jj) = pix(ii,jj) enddo enddo do i = i1, i2, 1 nbyte0 = (i-ifirst)*2880+ 1 nbyteE = (i-ifirst)*2880+2880 np1 = (nbyte0-nbyte1)/4 + 1 np2 = (nbyteE-nbyte1)/4 + 1 call pix2buff_i4(buffb,pix,np1,npt) write(10,rec=i,iostat=ios) buffc enddo close(10) return 900 continue print*,' ' print*,'WRITFITS_i4 ERROR: ' print*,' COULD NOT OPEN FILE: ' print*,' FILE: ',FILEU print*,' ' stop end c-------------------------------------- c c bubble-sorts a real*4 list into ascending order c subroutine rbubble(r1,NTOT) implicit none real r1(1) real temp integer NTOT integer n logical change 777 continue change = .false. do n = 1, NTOT-1 if (r1(n).gt.r1(n+1)) then temp = r1(n) r1(n) = r1(n+1) r1(n+1) = temp change = .true. endif enddo if (change) goto 777 end c-------------------------------------- c c bubble-sorts a real*8 list into ascending order c subroutine dbubble(r1,NTOT) implicit none real*8 r1(1) integer NTOT integer n real*8 temp logical change 777 continue change = .false. do n = 1, NTOT-1 if (r1(n).gt.r1(n+1)) then temp = r1(n) r1(n) = r1(n+1) r1(n+1) = temp change = .true. endif enddo if (change) goto 777 end #define _PXDIMX_ 1014 #define _PXDIMY_ 1014 #define _LOFLAG_ 1 #define _HIFLAG_ 9e9 program q implicit none real pix(_PXDIMX_,_PXDIMY_), pmax integer*2 pox(_PXDIMX_,_PXDIMY_) integer pux(_PXDIMX_,_PXDIMY_) integer i, j integer ii,jj real xsum, ysum, psum, msky real xbar, ybar, mag real mbar_sky character*80 FILENAME character*70 INFO(10) common / fitsinfo / INFO real EXPTIME integer k real pval integer ival c integer ix(5),iy(5) c data ix/0831,0197,4003,4734,0831/ c data iy/0123,4042,5025,1099,0123/ real pixi(1014,1014) real pixr(1014,1014) real pixh(1014,1014) integer*2 pixo(1014,1014) integer NARG, NARGs, iargc real rsum real dd integer Ls real plist(9) integer NIT, NFIXN, NFIXT do NARG = 1, iargc() call getarg(NARG,FILENAME) call readfits_r4e(FILENAME,pixi,_PXDIMX_,_PXDIMY_,1) read(INFO(1),*) EXPTIME print*,'---> EXPTIME: ',EXPTIME c c set the wagon wheel to a badflag c do i = -23, 23 do j = -23, 23 if (i**2+j**2.lt.23.5**2) then pixi(360+i,055+j) = -25 endif enddo enddo NFIXT = 0 do NIT = 1, 5 NFIXN = 0 do i = 2, 1023 do j = 2, 1023 pixr(i,j) = pixi(i,j) if (pixi(i,j).gt.10) goto 5 Ls = 0 do ii = i-1,i+1 do jj = j-1,j+1 Ls = Ls + 1 plist(Ls) = pixi(ii,jj) enddo enddo call rbubble(plist,Ls) if (plist(6).gt.500) then pixr(i,j) = 40000 pixi(i,j) = 40000 NFIXN = NFIXN + 1 NFIXT = NFIXT + 1 endif 5 continue enddo enddo write(*,'('' NIT: '',i2,1x,2i6)') NIT, NFIXN, NFIXT enddo do i = 1, 1014 do j = 1, 1014 pixh(i,j) = pixr(i,j) enddo enddo do i = 1, 1014 do j = 1, 1014 rsum = 0. if (pixr(i,j).ge.40000) then do ii = max(0001,i-5), min(1014,i+5) do jj = max(0001,j-5), min(1014,j+5) dd = sqrt(1.*(i-ii)**2+(j-jj)**2) if (dd.le.5.5) then rsum = rsum + 10.0/(1+dd)*pixh(i,j)/40000 endif enddo enddo pixr(i,j) = pixr(i,j) + rsum endif enddo enddo do i = 1, _PXDIMX_ do j = 1, _PXDIMY_ pval = pixr(i,j) ival = int(pval)-32000 if (ival.lt.-32700) ival = -32700 if (ival.gt. 32700) ival = 32700 pox(i,j) = ival enddo enddo do i = 1, _PXDIMX_ do j = 1, _PXDIMY_ pux(i,j) = int(pixr(i,j)*EXPTIME+1000.5)-1000 enddo enddo FILENAME = FILENAME(1:9) // '_IR4.fits' call writfits_i4(FILENAME,pux,_PXDIMX_,_PXDIMY_) 1 continue enddo stop end c c c subroutine readfits_r4e(FILE,pix,NDIMX,NDIMY,NEXTENU) implicit none character*80 FILE integer NDIMX,NDIMY real pix(NDIMX,NDIMY) integer NEXTENU character*80 FILEU character*70 INFO(10) common / fitsinfo / INFO integer naxes integer laxis(3) integer NXF integer NYF character*8 field character*40 stream integer nbyte0 integer nbyteE integer nbyte1 integer nbyte2 integer nbper integer i,ios, k integer j character*2880 buffc byte buffb(2880) equivalence (buffc,buffb) integer ifirst, i1, i2 integer np1, np2, npt integer nextend integer nread real bscale, bzero integer bitpix character*70 HDR(25) common/HDR/HDR logical DIAG data DIAG /.false./ integer NEND FILEU = FILE do i = 75,2,-1 if (FILE(i:i+4).eq.'.fits') FILEU = FILE(1:i+4) enddo if (DIAG) then print*,'enter readfits_r4...' print*,'FILE: ',FILE(1:60) endif open(10,file=FILE,status='old', . err=900,recl=2880,form='UNFORMATTED', . access='DIRECT') if (DIAG) print*,'...opened' naxes = -1 laxis(1) = 1 laxis(2) = 1 laxis(3) = 1 nextend = 0 do i = 1, 10 INFO(i) = ' ' enddo BSCALE = 1.0 BZERO = 0.0 NEND = 0 i = 0 nread = 0 100 continue i = i + 1 if (DIAG) print*,'READREC: ',i read(10,rec=i,iostat=ios) buffc do k = 0, 35, 1 if (DIAG) write(*,'(i4,1x,i4,1x,a80)') . i,k,buffc(k*80+1:k*80+80) field = buffc(k*80+01:k*80+08) stream = buffc(k*80+11:k*80+51) if (field.eq.'NAXIS ') read(stream,*) naxes if (field.eq.'NAXIS1 ') read(stream,*) laxis(1) if (field.eq.'NAXIS2 ') read(stream,*) laxis(2) if (field.eq.'NAXIS3 ') read(stream,*) laxis(3) if (field.eq.'NEXTEND ') read(stream,*) nextend if (field.eq.'BITPIX ') read(stream,*) bitpix if (field.eq.'BSCALE ') read(stream,*) bscale if (field.eq.'BZERO ') read(stream,*) bzero if (field.eq.'EXPTIME ') INFO(1) = stream if (field.eq.'FILTER ') INFO(2) = stream if (field.eq.'FILTNAM1') INFO(2) = stream if (field.eq.'FILENAME') INFO(3) = stream if (field.eq.'DATE-OBS') INFO(4) = stream if (field.eq.'TIME-OBS') INFO(5) = stream if (field.eq.'DEC_TARG') INFO(6) = stream if (field.eq.'RA_TARG ') INFO(7) = stream if (field.eq.'PA_V3 ') INFO(8) = stream if (field.eq.'PROPOSID') INFO(9) = stream if (field.eq.'CRPIX1 ') HDR(01) = stream if (field.eq.'CRPIX2 ') HDR(02) = stream if (field.eq.'CRVAL1 ') HDR(03) = stream if (field.eq.'CRVAL2 ') HDR(04) = stream if (field.eq.'CTYPE1 ') HDR(05) = stream if (field.eq.'CTYPE2 ') HDR(06) = stream if (field.eq.'CD1_1 ') HDR(07) = stream if (field.eq.'CD1_2 ') HDR(08) = stream if (field.eq.'CD2_1 ') HDR(09) = stream if (field.eq.'CD2_2 ') HDR(10) = stream if (field.eq.'ORIENTAT') HDR(11) = stream if (field.eq.'PA_APER ') HDR(12) = stream if (field.eq.'PA_V3 ') HDR(13) = stream if (field.eq.'DATE-OBS') HDR(14) = stream if (field.eq.'TIME-OBS') HDR(15) = stream if (field.eq.'EXPTIME ') HDR(16) = stream if (field.eq.'ROOTNAME') HDR(17) = stream if (field.eq.'TARGNAME') HDR(18) = stream if (field.eq.'RA_TARG ') HDR(19) = stream if (field.eq.'DEC_TARG') HDR(20) = stream if (field.eq.'PROPOSID') HDR(21) = stream if (field.eq.'FILTER ') HDR(22) = stream if (field.eq.'FILTER1 ') HDR(22) = stream if (field.eq.'FILTER2 ') HDR(23) = stream if (field.eq.'VAFACTOR') HDR(24) = stream if (field.eq.'END ') then !print*,' ---> NEND: ',NEND,NEXTENU if (NEND.eq.NEXTENU) goto 101 NEND = NEND + 1 endif enddo goto 100 101 continue nread = nread + 1 if (DIAG) then print*,'----------------------------------------' print*,' NREAD: ',nread print*,'NEXTEND: ',nextend print*,' NAXIS: ',naxes print*,' LAXIS: ',laxis(1),laxis(2),laxis(3) print*,' BITPIX: ',bitpix print*,' BSCALE: ',bscale print*,' BZERO: ',bzero endif ifirst = i+1 i1 = i i2 = i NXF = laxis(1) NYF = laxis(2) nbper = 4*laxis(1)*laxis(2) npt = laxis(1)*laxis(2) nbyte1 = 1 nbyte2 = nbper i1 = i+1 + nbyte1/2880 i2 = i+1 + nbyte2/2880 if (BITPIX.ne.-32) then print*,'prob' stop endif do i = i1, i2, 1 if (DIAG) print*,' i: ',i,i1,i2 read(10,rec=i,iostat=ios) buffc nbyte0 = (i-ifirst)*2880+ 1 nbyteE = (i-ifirst)*2880+2880 np1 = (nbyte0-nbyte1)/4 + 1 np2 = (nbyteE-nbyte1)/4 + 1 call buff2pix_r4(buffb,pix,np1,npt) if (DIAG) write(*,1115) i,np1,np2,npt 1115 format(1x,i8,1x,i10,1x,i10,1x,i10) enddo close(10) return 900 continue print*,'READFITS ERROR' stop end