guilhem_lavaux/mangle
0
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Init2

Browse source
This commit is contained in:
Guilhem Lavaux 2021-06-21 16:38:20 +02:00
parent a0f0371126
commit 7f3ae182e1
76 changed files with 76901 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

3
masks/healpix/healpix_conversion_scripts/call Executable file
View file

@ -0,0 +1,3 @@
# Call a fortran program with up to 25 parameters:
echo $2 $3 $4 $5 $6 $7 $8 $9 $10 $11 $12 $13 $14 $15 $16 $17 $18 $19 $20 $21 $22 $23 $24 $25 $26 >args.dat
$1

420
masks/healpix/healpix_conversion_scripts/dat2fits_binary.f Normal file
View file

@ -0,0 +1,420 @@
Program dat2fits_binary
call go
end
subroutine usage
implicit none
print *,
& 'Converts a CMBfast test file (or mangle healpix_weight file)',
& ' into a fits file'
c print *, 'COMPILE: a f 'f77 dat2fits_binary.f -o dat2fits_binary.x libcfitsio.a'
print *,
& 'USAGE: call dat2fits_binary.x <ptype> <nside> <in> <out>'
print *,
& 'EXAMPLE: call dat2fits_binary.x 1 512 qaz_map_data.dat',
& ' mytest.fits'
return
end
!=======================================================================
subroutine go
!=======================================================================
implicit none
integer polar_type, nmap, nside, npix, nnpix
integer nlheader, i, j
parameter(nnpix=12*1024**2, nlheader=80)
real map(0:nnpix,4)
character*80 header(nlheader), infile, outfile, card
c ----------------------------------------------------------------
c get the arguments
c ----------------------------------------------------------------
open (2,file='args.dat',status='old',err=777)
read (2,*,err=777,end=777) polar_type, nside, infile, outfile
close(2)
npix = 12*nside**2
if (npix.gt.nnpix) pause 'npix TOO LARGE'
if (polar_type.eq.1) then
nmap = 1
else
nmap = 4
endif
write(*,*) 'Polar_Type____', polar_type
write(*,*) 'nmap__________', nmap
write(*,*) 'Nside_________', nside
write(*,*) 'Npix__________', npix
write(*,*) 'Infile________', infile (1:lnblnk( infile))
write(*,*) 'Outfile_______', outfile(1:lnblnk(outfile))
c ----------------------------------------------------------------
c loading the ascii file
c ----------------------------------------------------------------
print *, 'Loading ', infile(1:lnblnk(infile))
open (2,file=infile)
do i=0,npix-1
read (2,*) (map(i,j),j=1,nmap)
enddo
close(2)
c ----------------------------------------------------------------
c writing the header
c ----------------------------------------------------------------
do i=1,nlheader
header(i) = ' '
enddo
call a_add_card(header,'COMMENT','---------------------','')
call a_add_card(header,'COMMENT',' Sky Map Keywords ','')
call a_add_card(header,'COMMENT','---------------------','')
call a_add_card
& (header,'PIXTYPE' ,'HEALPIX','HEALPIX Pixelisation' )
call a_add_card
& (header,'ORDERING','NESTED' ,'Pixel ordering scheme' )
call i_add_card
& (header,'NSIDE' ,nside ,'Resolution for HEALPIX' )
call i_add_card
& (header,'FIRSTPIX',0 ,'First pixel # (0 based)')
call i_add_card
& (header,'LASTPIX' ,npix-1 ,'Last pixel # (0 based)')
call v_add_card(header)
call a_add_card(header,'COMMENT','----------------','')
call a_add_card(header,'COMMENT',' Data Keywords ','')
call a_add_card(header,'COMMENT','----------------','')
call a_add_card
& (header,'TTYPE1', 'TEMPERATURE','Temperature map')
call a_add_card(header,'TUNIT1', 'unknown','map unit')
call v_add_card(header)
if (polar_type.ne.1) then
call a_add_card
& (header,'TTYPE2', 'Q-POLARIZATION','Q Polar map')
call a_add_card
& (header,'TUNIT2', 'unknown','map unit')
call v_add_card(header)
call a_add_card
& (header,'TTYPE3', 'U-POLARIZATION','U Polar map')
call a_add_card
& (header,'TUNIT3', 'unknown','map unit')
call v_add_card(header)
endif
c nlheader = SIZE(header)
c print *, 'Writing Header'
c call headerLine('COMMENT ------------------',hd(1))
c call headerLine('COMMENT = Healpix' ,hd(2))
c call headerLine('COMMENT ------------------',hd(3))
c call headerLine('PIXTYPE = HEALPIX',hd(4))
c call headerLine('ORDERING = NESTED' ,hd(5))
c call headerLine(card,hd(6))
c write (card,'("NSIDE",i8," /Resolution for HEALPIX")') nside
c call headerLine(card,hd(7))
c write (card,'("FIRSTPIX",i8," /First pixel")') 0
c call headerLine(card,hd(8))
c write (card,'("LASTPIX" ,i16," /Last pixel")') npix-1
c call headerLine('COMMENT ------------------',hd(9))
c call headerLine('COMMENT = Data Description',hd(10))
c call headerLine('COMMENT ------------------',hd(11))
c call headerLine('TTYPE1 = TEMPERATURE',hd(12))
c call headerLine('TUNIT1 = unknown' ,hd(13))
c nh = 13
c if (polar_type.ne.1) then
c call headerLine('TTYPE2 = Q-POLARIZATION',hd(14))
c call headerLine('TUNIT2 = unknown' ,hd(15))
c call headerLine('TTYPE3 = U-POLARIZATION',hd(16))
c call headerLine('TUNIT3 = unknown' ,hd(17))
c nh = 17
c endif
do i=1,nlheader
print *, header(i)
enddo
print *, 'Saving file'
call write_bintab (map,npix,nmap,header,nlheader,outfile)
return
777 call usage
end
SUBROUTINE a_add_card(header, kwd, value, comment) ! character
CHARACTER*(*) value
CHARACTER*80 header
CHARACTER*(*) kwd
CHARACTER*(*) comment
CHARACTER*240 st_value, st_comment
st_value = ''
st_comment = ''
write(st_value, '(a)') value
write(st_comment,'(a)') comment
call write_hl(header, kwd, st_value, st_comment)
RETURN
END
SUBROUTINE v_add_card(header) ! blank line
CHARACTER*80 header
call write_hl(header, 'COMMENT', ' ', ' ')
END
SUBROUTINE i_add_card(header, kwd, value, comment) ! integer (i*4)
INTEGER value
CHARACTER*80 header
CHARACTER*(*) kwd
CHARACTER*(*) comment
CHARACTER*20 st_value
write(st_value,'(i20)') value
call write_hl(header, kwd, st_value, comment)
RETURN
END
SUBROUTINE write_hl(header, kwd, st_value, comment)
IMPLICIT none
CHARACTER*80 header(80)
CHARACTER*(*) kwd
CHARACTER*(*) comment
CHARACTER*(*) st_value
INTEGER hdtype, status
INTEGER iw, lnblnk
CHARACTER*240 headerline
CHARACTER*80 buffheader
CHARACTER*10 pad10
iw = 1
do while(header(iw) /= '')
iw = iw + 1
enddo
pad10=''
buffheader =''
headerline = kwd (1:lnblnk(kwd)) //' '//
& st_value(1:lnblnk(st_value))//' '//
& comment (1:lnblnk(comment))
if (headerline .eq. 'COMMENT') then ! COMMENT alone
header(iw) = 'COMMENT'
iw = iw + 1
RETURN
endif
hdtype = 0
status = 0
CALL ftgthd(headerline(1:79), buffheader, hdtype, status)
header(iw) = buffheader
if (len_trim(headerline) > 79) then
status = 0
CALL ftgthd(pad10//headerline(80:149),
& buffheader, hdtype, status)
iw = iw + 1
header(iw) = buffheader
endif
if (len_trim(headerline) > 149) then
status = 0
CALL ftgthd(pad10//headerline(150:219),
& buffheader, hdtype, status)
iw = iw + 1
header(iw) = buffheader
endif
if (len_trim(headerline) > 219) then
status = 0
CALL ftgthd(pad10//headerline(220:240),
& buffheader, hdtype, status)
iw = iw + 1
header(iw) = buffheader
endif
iw = iw + 1
RETURN
END
!=======================================================================
subroutine write_bintab (map,npix,nmap,header,nlheader,filename)
!=======================================================================
! Create a FITS file containing a binary table extension with
! the temperature map in the first column
! written by EH from writeimage and writebintable
! (fitsio cookbook package)
!
! slightly modified to deal with vector column (ie TFORMi = '1024E')
! in binary table EH/IAP/Jan-98
!
! simplified the calling sequence, the header sould be filled in
! before calling the routine
!=======================================================================
IMPLICIT none
INTEGER npix, nmap, nlheader
REAL map(0:npix-1,1:nmap)
CHARACTER*80 header(1:nlheader)
CHARACTER*(*) filename
INTEGER status,unit,blocksize,bitpix,naxis,naxes(1)
INTEGER group,fpixel,nelements,i
LOGICAL simple,extend
CHARACTER*80 svalue, comment
REAL*8 bscale,bzero
INTEGER maxdim !number of columns in the extension
PARAMETER (maxdim = 20)
INTEGER nrows, tfields, varidat
INTEGER frow, felem, colnum
CHARACTER*20 ttype(maxdim), tform(maxdim), tunit(maxdim), extname
CHARACTER*8 date
CHARACTER*10 fulldate
CHARACTER*10 card
CHARACTER*2 stn
INTEGER itn
!-----------------------------------------------------------------------
status= 0
unit = 100
! ----------------------
! create the new empty FITS file
! ----------------------
blocksize=1
call ftinit(unit,filename,blocksize,status)
! ----------------------
! initialize parameters about the FITS image
! ----------------------
simple =.true.
bitpix =32 ! integer*4
naxis =0 ! no image
naxes(1)=0
extend =.true. ! there is an extension
! ----------------------
! primary header
! ----------------------
! write the required header keywords
call ftphpr
&(unit,simple,bitpix,naxis,naxes,0,1,extend,status)
! writes supplementary keywords : none
! write the current date
call ftpdat(unit,status) ! format (dd/mm/yy)
! update the date (format ccyy-mm-dd)
call date_and_time(date)
fulldate = date(1:4)//'-'//date(5:6)//'-'//date(7:8)
comment = 'FITS file creation date ccyy-mm-dd'
call ftukys(unit,'DATE',fulldate,comment,status)
! ----------------------
! image : none
! ----------------------
! ----------------------
! extension
! ----------------------
! creates an extension
call ftcrhd(unit, status)
! writes required keywords
nrows = npix / 1024 ! naxis1
tfields = nmap
do i=1,nmap
tform(i) = '1024E'
if (npix .lt. 1024) then ! for nside <= 8
nrows = npix
tform(i) = '1E'
endif
ttype(i) = 'simulation' ! will be updated
tunit(i) = '' ! optional, will not appear
enddo
extname = '' ! optional, will not appear
varidat = 0
call ftphbn
&(unit,nrows,tfields,ttype,tform,tunit,extname,varidat,status)
! write the header literally, putting TFORM1 at the desired place
do i=1,nlheader
card = header(i)
if (card(1:5) == 'TTYPE') then ! if TTYPE1 is explicitely given
stn = card(6:6)
read(stn,'(i1)') itn
! discard at their original location:
call ftmcrd(unit,'TTYPE'//stn,'COMMENT',status) ! old TTYPEi and
call ftmcrd(unit,'TFORM'//stn,'COMMENT',status) ! TFORMi
call ftprec(unit,header(i), status) ! write new TTYPE1
comment = 'data format of field: 4-byte REAL'
call ftpkys(unit,'TFORM'//stn,tform(1),comment,status) ! and write new TFORM1 right after
elseif (header(i).NE.' ') then
call ftprec(unit,header(i), status)
endif
10 continue
enddo
! write the extension one column by one column
frow = 1 ! starting position (row)
felem = 1 ! starting position (element)
do colnum = 1, nmap
call ftpcle
& (unit,colnum,frow,felem,npix,map(0,colnum),status)
enddo
! ----------------------
! close and exit
! ----------------------
call ftclos(unit, status)
! ----------------------
! check for any error, and if so print out error messages
! ----------------------
if (status .gt. 0) call printerror(status)
return
end
subroutine printerror(status)
!=======================================================================
! Print out the FITSIO error messages to the user
!=======================================================================
implicit none
INTEGER status
CHARACTER*30 errtext
CHARACTER*80 errmessage
!-----------------------------------------------------------------------
! check if status is OK (no error); if so, simply return
if (status .le. 0)return
! get the text string which describes the error
call ftgerr(status,errtext)
print *,'FITSIO Error Status =',status,': ',errtext
! read and print out all the error messages on the FITSIO stack
call ftgmsg(errmessage)
do while (errmessage .ne. ' ')
print *,errmessage
call ftgmsg(errmessage)
end do
open(unit = 20, file = "dat2fitserr.temp")
write(20,*) status
close(20)
return
end
c --------------------------------------------------------------------
c return formatted header line
c --------------------------------------------------------------------
subroutine headerLine(line,hdLine)
implicit none
integer hdtype,status
character*(*) line
character*80 hdLine
hdtype=0
status=0
call ftgthd(line,hdLine,hdtype,status)
if (status.gt.0) call errorMessage(status)
end
c --------------------------------------------------------------------
c print error message and stop
c --------------------------------------------------------------------
subroutine errorMessage(status)
implicit none
integer status
character*30 errmsg
call ftgerr(status,errmsg)
print '("FITS error ",i3,": ",a)', status,errmsg
stop
end

247
masks/healpix/healpix_conversion_scripts/fits2dat_binary.f Normal file
View file

@ -0,0 +1,247 @@
Program fits2dat_binary
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Angelica Costa Jan/03: From f90 to g77
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
call go
end
subroutine usage
implicit none
print *, 'Converts a map from fits to text'
print *,
& 'COMPILE: g77 fits2dat_binary.f -o fits2dat_binary.x',
& '/home3/max/healpix/cfitsio/libcfitsio.a'
print *,
& 'USAGE: call fits2dat_binary.x <PolarType>',
& ' <Nside> <infile> <outfile>'
print *,
& 'EXAMPLE: call fits2dat_binary.x 1 32 qaz_map???.fits',
& 'qaz_map.dat'
return
end
subroutine go
implicit none
INTEGER npixtot, nnpixtot, nmaps, nnmaps, naxis
parameter(nnpixtot=12*1024**2, nnmaps=4)
REAL map(0:nnpixtot-1,1:nnmaps)
REAL nullval
LOGICAL anynull
CHARACTER*80 infile, outfile
INTEGER status, unit, readwrite, blocksize, naxes(2), nfound, naxis
INTEGER group, firstpix, nbuffer, npix, i, polar_type, Nside, lnblnk
REAL blank, testval
REAL*8 bscale, bzero
LOGICAL extend
INTEGER nmove, hdutype
INTEGER column, frow, imap
INTEGER datacode, repeat, width
CHARACTER*80 comment
INTEGER maxdim !number of columns in the extension
PARAMETER(maxdim=20)
INTEGER nrows, tfields, varidat
CHARACTER*20 ttype(maxdim), tform(maxdim), tunit(maxdim), extname
c ----------------------------------------------------------------
c get the arguments
c ----------------------------------------------------------------
open (2,file='args.dat',status='old',err=777)
read (2,*,err=777,end=777) polar_type, Nside, infile, outfile
close(2)
npixtot = 12*Nside**2
if (npixtot.gt.nnpixtot) pause 'npixtot SIZE ERROR'
if (polar_type.eq.1) then
nmaps = 1
else
nmaps = 4
endif
write(*,*) 'Polarization_Type_________________', polar_type
write(*,*) 'Nside_____________________________', Nside
write(*,*) 'npix______________________________', npixtot
write(*,*) 'Infile____________________________',
& infile (1:lnblnk( infile))
write(*,*) 'Outfile___________________________',
& outfile(1:lnblnk(outfile))
c ----------------------------------------------------------------
c loading the file
c ----------------------------------------------------------------
status = 0
unit = 150
naxes(1) = 1
naxes(2) = 1
nfound = -1
anynull = .false.
bscale = 1.0d0
bzero = 0.0d0
blank = -2.e25
nullval = bscale*blank + bzero
readwrite=0
call ftopen(unit,infile,readwrite,blocksize,status)
if (status .gt. 0) call printerror(status)
! -----------------------------------------
! determines the presence of image
call ftgkyj(unit,'NAXIS', naxis, comment, status)
if (status .gt. 0) call printerror(status)
! determines the presence of an extension
call ftgkyl(unit,'EXTEND', extend, comment, status)
if (status .gt. 0) status = 0 ! no extension :
! to be compatible with first version of the code
if (naxis .gt. 0) then ! there is an image
! determine the size of the image (look naxis1 and naxis2)
call ftgknj(unit,'NAXIS',1,2,naxes,nfound,status)
! check that it found only NAXIS1
if (nfound .eq. 2 .and. naxes(2) .gt. 1) then
print *,'multi-dimensional image'
print *,'expected 1-D data.'
stop
end if
if (nfound .lt. 1) then
call printerror(status)
print *,'can not find NAXIS1.'
stop
endif
npix=naxes(1)
if (npix .ne. npixtot) then
print *,'found ',npix,' pixels'
print *,'expected ',npixtot
stop
endif
call ftgkyd(unit,'BSCALE',bscale,comment,status)
if (status .eq. 202) then ! BSCALE not found
bscale = 1.0d0
status = 0
endif
call ftgkyd(unit,'BZERO', bzero, comment,status)
if (status .eq. 202) then ! BZERO not found
bzero = 0.0d0
status = 0
endif
call ftgkye(unit,'BLANK', blank, comment,status)
if (status .eq. 202) then ! BLANK not found
! (according to fitsio BLANK is integer)
blank = -2.e25
status = 0
endif
nullval = bscale*blank + bzero
! -----------------------------------------
group = 1
firstpix = 1
call ftgpve
& (unit,group,firstpix,npix,nullval,map,anynull,status)
! if there are any NaN pixels, (real data)
! or BLANK pixels (integer data) they will take nullval value
! and anynull will switch to .true.
! otherwise, switch it by hand if necessary
testval = 1.e-6 * ABS(nullval)
do i=0, npix-1
if (ABS(map(i,1)-nullval) .lt. testval) then
anynull = .true.
c goto 111
endif
enddo
c 111 continue
else if (extend) then ! there is an extension
nmove = +1
call ftmrhd(unit, nmove, hdutype, status)
!cc write(*,*) hdutype
if (hdutype .ne. 2) then ! not a binary table
stop 'this is not a binary table'
endif
! reads all the keywords
call ftghbn
& (unit, maxdim,nrows,tfields,ttype,tform,
& tunit,extname,varidat,status)
if (tfields .lt. nmaps) then
print *,'found ',tfields,' maps in the file'
print *,'expected ',nmaps
stop
endif
! finds the bad data value
call ftgkye(unit,'BAD_DATA',nullval,comment,status)
if (status .eq. 202) then ! bad_data not found
nullval = -1.6375e30 ! default value
status = 0
endif
do imap = 1, nmaps
!parse TFORM keyword to find out the length of the column vector
call ftbnfm(tform(imap), datacode, repeat, width, status)
!reads the columns
column = imap
frow = 1
firstpix = 1
npix = nrows * repeat
if (npix .ne. npixtot) then
print *,'found ',npix,' pixels'
print *,'expected ',npixtot
stop
endif
call ftgcve
& (unit, column, frow, firstpix, npix, nullval,
& map(0,imap), anynull, status)
enddo
else ! no image no extension, you are dead, man
stop ' No image, no extension'
endif
! close the file
call ftclos(unit, status)
! saving text file
print *, 'Saving ', outfile
open (2,file=outfile)
do i = 0, npix-1
write (2,*) (map(i,imap),imap=1,nmaps)
enddo
close(2)
! check for any error, and if so print out error messages
if (status .gt. 0) call printerror(status)
return
777 call usage
end
subroutine printerror(status)
!=======================================================================
! Print out the FITSIO error messages to the user
!=======================================================================
implicit none
INTEGER status
CHARACTER*30 errtext
CHARACTER*80 errmessage
!-----------------------------------------------------------------------
! check if status is OK (no error); if so, simply return
if (status .le. 0)return
! get the text string which describes the error
call ftgerr(status,errtext)
print *,'FITSIO Error Status =',status,': ',errtext
! read and print out all the error messages on the FITSIO stack
call ftgmsg(errmessage)
do while (errmessage .ne. ' ')
print *,errmessage
call ftgmsg(errmessage)
end do
return
end

43
masks/healpix/healpix_conversion_scripts/plotmap.sh Executable file
View file

@ -0,0 +1,43 @@
#!/bin/sh
# USAGE: plotmap.sh <Nside_out> <fits_infile> <gif_outfile>
# EXAMPLE: plotmap.sh 512 qaz.fits qaz.gif
#check command line arguments
if [ $# -lt 3 ]; then
echo >&2 "ERROR: enter the output Nside value, the name of the input file,"
echo >&2 "and the name of the output file as command line arguments."
echo >&2 ""
echo >&2 "USAGE: plotmap.sh <Nside_out> <fits_infile> <gif_outfile>"
echo >&2 "EXAMPLE: plotmap.sh 512 qaz.fits qaz.gif"
exit 1
fi
echo ""
echo "NOTE: This script requires a HEALPix installation"
echo "Creating $3..."
#echo 'WARNING: plotmap disabled'
#exit
res=$1
infile=$2
outfile="qaz_plotmap.fits"
echo 'nside_out = '$res >qaz_ud_grade.dat
echo 'infile = '$infile >>qaz_ud_grade.dat
echo 'outfile = '$outfile >>qaz_ud_grade.dat
if [ -e $outfile ] ; then
/bin/rm $outfile
fi
ud_grade qaz_ud_grade.dat
if [ -e $3 ] ; then
/bin/rm $3
fi
# default mangle limits (weights range from 0 to 1)
map2gif -inp qaz_plotmap.fits -out $3 -bar .true. -add 0 -min 0 -max 1
# default WMAP limits
#map2gif -inp qaz_plotmap.fits -out $1.gif -bar .true. -add 0.2 -min 0 -max 0.4
rm qaz_plotmap.fits qaz_ud_grade.dat