1!-----------------------------------------------------------------------------
2!
3!  Copyright (C) 1997-2013 Krzysztof M. Gorski, Eric Hivon,
4!                          Benjamin D. Wandelt, Anthony J. Banday,
5!                          Matthias Bartelmann, Hans K. Eriksen,
6!                          Frode K. Hansen, Martin Reinecke
7!
8!
9!  This file is part of HEALPix.
10!
11!  HEALPix is free software; you can redistribute it and/or modify
12!  it under the terms of the GNU General Public License as published by
13!  the Free Software Foundation; either version 2 of the License, or
14!  (at your option) any later version.
15!
16!  HEALPix is distributed in the hope that it will be useful,
17!  but WITHOUT ANY WARRANTY; without even the implied warranty of
18!  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
19!  GNU General Public License for more details.
20!
21!  You should have received a copy of the GNU General Public License
22!  along with HEALPix; if not, write to the Free Software
23!  Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
24!
25!  For more information about HEALPix see http://healpix.sourceforge.net
26!
27!-----------------------------------------------------------------------------
28! -*- f90 -*-
29
30!
31! v1.0: M. Reinecke
32! v1.1: 2002-09, E. Hivon, added concatnl, scan_directories, numeric_string
33!                     made interactive mode more user friendly
34! v1.2: added parse_summarize
35! v1.3: 2008-01-22, added parse_check_unused
36!       2008-01-29, addition of silent keyword in parse_init
37!       2008-03-25: expand environment variables (${XXX}) in parse_string
38! v1.4: 2008-10-15, avoid over-running keylist in parse_summarize
39! v1.5: 2009-09-07, introduces get_healpix_main_dir, get_healpix_data_dir, get_healpix_test_dir
40! v1.6: 2009-11-26: bug correction in get_healpix_*_dir
41! v1.7: 2011-01-03: addition of get_healpix_pixel_window_file & get_healpix_ring_weight_file
42! v1.8: 2012-10-29: replaced F90 inquire with misc_utils's file_present which will accept remote files
43! v1.9: 2012-11-14: deal correctly with undefined HEALPIX (or equivalent) in get_healpix_data_dir
44! v2.0: 2018-05-18: added get_healpix_pixel_weight_file and get_healpix_weight_file
45module paramfile_io
46  use healpix_types
47  use extension
48  use misc_utils
49  implicit none
50  private
51
52  public paramfile_handle, parse_init, parse_real, parse_double, parse_int, &
53         parse_long, parse_lgt, parse_string, parse_summarize, parse_finish, &
54         parse_check_unused
55
56  public concatnl, scan_directories
57
58  public get_healpix_main_dir, get_healpix_data_dir, get_healpix_test_dir
59
60  public get_healpix_pixel_window_file, get_healpix_ring_weight_file, &
61       get_healpix_pixel_weight_file, get_healpix_weight_file
62
63  type paramfile_handle
64    character(len=filenamelen) filename
65    character(len=filenamelen), pointer, dimension(:) :: keylist=>NULL()
66    character(len=filenamelen), pointer, dimension(:) :: valuelist=>NULL()
67    logical(LGT),               pointer, dimension(:) :: usedlist=>NULL()
68    logical interactive, verbose
69  end type paramfile_handle
70
71  character(len=*), parameter, public :: ret = achar(10)//' '
72  character(len=*), parameter, private :: swdef = ' <default>'
73
74contains
75
76!=====================================================================
77subroutine notify_user (keyname, rdef, rmin, rmax, ddef, dmin, dmax, &
78  idef, imin, imax, ldef, lmin, lmax, logdef, chdef, descr, ivalid)
79  !=====================================================================
80  ! prompts user for next parameter when in interactive mode
81  !=====================================================================
82  character(len=*), intent(in) :: keyname
83  real(sp), intent(in), optional :: rdef, rmin, rmax
84  real(dp), intent(in), optional :: ddef, dmin, dmax
85  integer(i4b), intent(in), optional :: idef, imin, imax
86  integer(i8b), intent(in), optional :: ldef, lmin, lmax
87  logical, intent(in), optional :: logdef
88  character(len=*), intent(in), optional :: chdef, descr
89  integer(i4b), intent(in), optional, dimension(1:) :: ivalid
90
91  if (present(descr)) then
92     write(*,'(a)') trim(descr)
93  else
94     print *, 'Please enter a value for the key ', keyname
95  endif
96  if (present(rmin) .and. present(rmax)) then
97     print *, "allowed range: ", rmin, rmax
98  else
99     if (present(rmin)) print *, "min value: ", rmin
100     if (present(rmax)) print *, "max value: ", rmax
101  endif
102  if (present(dmin) .and. present(dmax)) then
103     print *, "allowed range: ", dmin, dmax
104  else
105     if (present(dmin)) print *, "min value: ", dmin
106     if (present(dmax)) print *, "max value: ", dmax
107  endif
108  if (present(imin) .and. present(imax)) then
109     print *, "allowed range: ", imin, imax
110  else
111     if (present(imin)) print *, "min value: ", imin
112     if (present(imax)) print *, "max value: ", imax
113  endif
114  if (present(ivalid)) then
115     print *, "allowed values: ",ivalid(1:)
116  endif
117  if (present(lmin) .and. present(lmax)) then
118     print *, "allowed range: ", lmin, lmax
119  else
120     if (present(lmin)) print *, "min value: ", lmin
121     if (present(lmax)) print *, "max value: ", lmax
122  endif
123  if (present(rdef)) print *, "default value: ", rdef
124  if (present(ddef)) print *, "default value: ", ddef
125  if (present(idef)) print *, "default value: ", idef
126  if (present(ldef)) print *, "default value: ", ldef
127  if (present(logdef)) print *, "default value: ", logdef
128  if (present(chdef)) print *, "default value: ", trim(chdef)
129end subroutine notify_user
130
131!===================================================================
132function parse_init (fname, silent)
133  !===================================================================
134  character(len=*), intent(in) :: fname
135  type(paramfile_handle) parse_init
136  logical(LGT), intent(in), optional :: silent
137
138  integer  :: i,cnt
139  character(len=filenamelen) :: line, name, value
140  logical(LGT) :: myverbose
141
142  ! be verbose by default
143  myverbose = .true.
144  if (present(silent)) myverbose = .not.silent
145
146  if (len(trim(fname))==0) then
147    parse_init%filename    = ''
148    parse_init%interactive = .true.
149    parse_init%verbose     = .true.
150    parse_init%keylist     => NULL()
151    parse_init%valuelist   => NULL()
152    parse_init%usedlist    => NULL()
153    cnt = 30
154    allocate(parse_init%keylist(cnt),parse_init%valuelist(cnt))
155    allocate(parse_init%usedlist(cnt))
156    parse_init%keylist = ''
157    parse_init%valuelist = ''
158    parse_init%usedlist = .false.
159  else
160    call assert_present (fname)
161    call assert(len(fname)<=filenamelen, 'Parser: error: file name too long')
162    parse_init%filename    = fname
163    parse_init%interactive = .false.
164    parse_init%verbose     = myverbose
165    parse_init%keylist     => NULL()
166    parse_init%valuelist   => NULL()
167    parse_init%usedlist    => NULL()
168    ! count valid lines
169    open  (1, file=trim(fname))
170    cnt=0
171    do
172      read (1,'(a)',end=2) line
173      line = adjustl(line)
174      i=scan(line,'=')
175      if (i/=0 .and. line(1:1)/='#' .and. line(1:1)/='!') cnt=cnt+1
176    end do
1772   close (1)
178    ! read and parse valid lines
179    allocate(parse_init%keylist(cnt),parse_init%valuelist(cnt))
180    allocate(parse_init%usedlist(cnt))
181    open  (1, file=trim(fname))
182    cnt=0
183    do
184      read (1,'(a)',end=3) line
185      line = adjustl(line)
186      i=scan(line,'=')
187      if (i/=0 .and. line(1:1)/='#' .and. line(1:1)/='!') then
188        cnt=cnt+1
189        name = trim(adjustl(line(:i-1)))
190        value = trim(adjustl(line(i+1:)))
191        if (trim(value)=="") then
192           write(*,'(a)') ' '
193           write(*,'(a)') 'ERROR: Inputs of the form '
194           write(*,'(a)') trim(name)//' = '
195           write(*,'(a)') ' (ie, defined as a blank value) are not valid'
196           write(*,'(a)') 'To get the default value, comment out the keyword in '&
197                &         //trim(parse_init%filename)
198           write(*,'(a)') '# '//trim(name)//' = '
199           write(*,'(a)') "If you mean 'No file', use"
200           write(*,'(a)') trim(name)//" = ''   "
201           write(*,'(a)') ' '
202           call fatal_error
203        endif
204        parse_init%keylist(cnt) = name
205        parse_init%valuelist(cnt) = value
206        parse_init%usedlist(cnt) = .false.
207      endif
208    end do
2093   close (1)
210  endif
211
212  ! be verbose
213  if (parse_init%interactive) then
214     write(*,'(a)') 'Interactive mode. Answer the following questions.'
215     write(*,'(a)') 'If no answer is entered, the default value will be taken'
216  else
217     if (parse_init%verbose) then
218        write(*,'(a)') 'Reading run parameters from '//trim(parse_init%filename)
219        write(*,'(a)') ' parameters not defined in that file will be set to their default value'
220     endif
221  endif
222end function parse_init
223!===================================================================
224subroutine parse_summarize (handle, code, prec)
225  !===================================================================
226  type(paramfile_handle),     intent(in) :: handle
227  character(len=*), optional, intent(in) :: code
228  integer(i4b),     optional, intent(in) :: prec
229  !
230  integer(i4b) :: i, nkeys
231  character(len=filenamelen) :: name, value, next_name, command
232
233  if (handle%interactive) then
234     command = ''
235     if (present(code)) then
236        command = trim(code)
237        if (present(prec)) then
238           if (prec == SP) command = trim(command)//' --single'
239           if (prec == DP) command = trim(command)//' --double'
240        endif
241     endif
242     if (trim(command) /= '') then
243        print*,'  This run can be reproduced in non-interactive mode, with the command'
244        print*,trim(command)//' paramfile'
245        print*,'where paramfile contains'
246     else
247        print*,'  This run can be reproduced in non-interactive mode'
248        print*,'if a parameter file with the following content is provided:'
249     endif
250     nkeys = size(handle%keylist)
251     do i=1, nkeys
252        name = handle%keylist(i)
253        if (i < nkeys) then
254           next_name = handle%keylist(i+1)
255        else
256           next_name = ''
257        endif
258        value = handle%valuelist(i)
259        if (trim(name) /= '' .and. trim(name) /= trim(next_name)) then
260           if (trim(value) == '') then
261              write(*,'(a)') '# '//trim(name)
262           else
263              write(*,'(a)') trim(name)//' = '//trim(value)
264           endif
265        endif
266     enddo
267     print*,' '
268  endif
269end subroutine parse_summarize
270!===================================================================
271subroutine parse_check_unused(handle, code)
272  !===================================================================
273  ! print out unused keywords, if any
274  !===================================================================
275  type(paramfile_handle),     intent(in) :: handle
276  character(len=*), optional, intent(in) :: code
277  !
278  integer(i4b) :: i, unused
279  character(len=80) :: mycode
280!  character(len=filenamelen) :: name, value, next_name, command
281
282
283  ! non interactive mode
284  if (.not.handle%interactive) then
285     mycode = 'this code'
286     if (present(code)) mycode = trim(code)
287     ! count unused keywords in input parameter files
288     unused = 0
289     do i=1,size(handle%keylist)
290        if (.not. handle%usedlist(i)) unused = unused + 1
291     enddo
292     if (unused > 0) then
293        print*,' '
294        print*,' ====================================================='
295        print*,'  WARNING: the following keywords found in '//trim(handle%filename)
296        print*,'           have NOT been used by '//trim(mycode)
297        !print*,'           Make sure they are correctly spelled.'
298        do i=1,size(handle%keylist)
299           if (.not. handle%usedlist(i)) then
300              write(*,'(a)') trim(handle%keylist(i))//' = '//trim(handle%valuelist(i))
301           endif
302        enddo
303        print*,' ====================================================='
304        print*,' '
305     endif
306
307  end if
308  return
309end subroutine parse_check_unused
310
311!===================================================================
312subroutine parse_finish (handle)
313  !===================================================================
314  type(paramfile_handle), intent(inout) :: handle
315
316  if (associated(handle%keylist)) then
317     deallocate(handle%keylist, handle%valuelist)
318     deallocate(handle%usedlist)
319  endif
320end subroutine parse_finish
321
322!===================================================================
323subroutine find_param (handle,keyname,result,found,rdef,rmin,rmax, &
324    ddef,dmin,dmax,idef,imin,imax,ldef,lmin,lmax,logdef,chdef,descr, &
325    ivalid)
326  !===================================================================
327  ! extract parameter from file or read from standard input
328  !===================================================================
329  type(paramfile_handle), intent(inout) :: handle
330  character(len=*), intent(in) :: keyname
331  character(len=*), intent(out) :: result
332  logical, intent(out) :: found
333  real(sp), intent(in), optional :: rdef, rmin, rmax
334  real(dp), intent(in), optional :: ddef, dmin, dmax
335  integer(i4b), intent(in), optional :: idef, imin, imax
336  integer(i8b), intent(in), optional :: ldef, lmin, lmax
337  logical, intent(in), optional :: logdef
338  character(len=*), intent(in), optional :: chdef, descr
339  integer(i4b), intent(in), optional, dimension(1:) :: ivalid
340
341  character(len=filenamelen) :: line, name, value
342  integer i
343  !===================================================================
344
345  found=.false.
346
347  if (handle%interactive) then
348     call notify_user (keyname,rdef,rmin,rmax,ddef,dmin,dmax, &
349          &            idef,imin,imax,ldef,lmin,lmax,logdef,chdef,descr, &
350          &            ivalid)
351     read (*,'(a)',err=5) result
352     found = (trim(result)/='')
353     do i=1,size(handle%keylist)
354        if (trim(handle%keylist(i))=='') then
355           handle%keylist(i)   = trim(keyname)
356           if (found) then
357              handle%valuelist(i) = trim(result)
358              handle%usedlist(i)  = .true.
359           else
360              if (present(rdef)) write(handle%valuelist(i),*) rdef
361              if (present(ddef)) write(handle%valuelist(i),*) ddef
362              if (present(idef)) write(handle%valuelist(i),*) idef
363              if (present(ldef)) write(handle%valuelist(i),*) ldef
364              if (present(logdef)) write(handle%valuelist(i),*) logdef
365              if (present(chdef))  handle%valuelist(i) = chdef
366           endif
367           exit
368        end if
369     end do
370  else
371     do i=1,size(handle%keylist)
372        if (trim(handle%keylist(i))==keyname) then
373           result=trim(handle%valuelist(i))
374           found=.true.
375           handle%usedlist(i) = .true.
376        end if
377     end do
3782    close (1)
379  endif
380  return
381
3825 print*,'Parser: find_param: error reading value'
383  call fatal_error
384end subroutine find_param
385!===================================================================
386
387!===================================================================
388function parse_real (handle, keyname, default, vmin, vmax, descr)
389  !===================================================================
390  !===================================================================
391  type(paramfile_handle), intent(inout) :: handle
392  character(len=*), intent(in) :: keyname
393  real(sp), intent(in), optional :: default, vmin, vmax
394  character(len=*), intent(in), optional :: descr
395  real(sp) :: parse_real
396
397  character(len=filenamelen) :: result
398  character(len=30)          :: about_def
399  logical found
400  !===================================================================
401
40210 continue
403  about_def = ''
404  call find_param (handle, trim(keyname), result, found, rdef=default, &
405       &           rmin=vmin, rmax=vmax, descr=descr)
406  if (found) then
407     read (result,*,err=5) parse_real
408  else
409     if (present(default)) then
410!      print *,'Parser: warning: using default value for ',trim(keyname)
411        about_def = swdef
412        parse_real = default
413     else
414        print *,'Parser: error: ',trim(keyname),' not found.'
415        goto 2
416     endif
417  endif
418  if (handle%verbose) print *,'Parser: ',trim(keyname),' = ',parse_real, trim(about_def)
419  if (present(vmin)) then
420     if (parse_real<vmin) then
421        print *,'Parser: error: value for ', trim(keyname),' too small.'
422        goto 2
423     endif
424  endif
425  if (present(vmax)) then
426     if (parse_real>vmax) then
427        print *,'Parser: error: value for ', trim(keyname),' too large.'
428        goto 2
429     endif
430  endif
431
432  return ! normal exit
433
4345 print*,'Parser: parse_real: error reading value'
4352 if (handle%interactive) goto 10 ! try again
436  call fatal_error
437
438end function parse_real
439
440!===================================================================
441function parse_double (handle, keyname, default, vmin, vmax, descr)
442  !===================================================================
443  !===================================================================
444  type(paramfile_handle), intent(inout) :: handle
445  character(len=*), intent(in) :: keyname
446  real(dp), intent(in), optional :: default, vmin, vmax
447  character(len=*), intent(in), optional :: descr
448  real(dp) :: parse_double
449
450  character(len=filenamelen) :: result
451  character(len=30)          :: about_def
452  logical found
453  !===================================================================
454
45510 continue
456  about_def = ''
457  call find_param (handle, trim(keyname), result, found, ddef=default, &
458       &           dmin=vmin, dmax=vmax, descr=descr)
459  if (found) then
460    read (result,*,err=5) parse_double
461  else
462    if (present(default)) then
463!      print *,'Parser: warning: using default value for ',trim(keyname)
464        about_def = swdef
465      parse_double = default
466    else
467      print *,'Parser: error: ',trim(keyname),' not found.'
468      goto 2
469    endif
470  endif
471  if (handle%verbose) print *,'Parser: ',trim(keyname),' = ',parse_double, trim(about_def)
472  if (present(vmin)) then
473    if (parse_double<vmin) then
474      print *,'Parser: error: value for ', trim(keyname),' too small.'
475      goto 2
476    endif
477  endif
478  if (present(vmax)) then
479    if (parse_double>vmax) then
480      print *,'Parser: error: value for ', trim(keyname),' too large.'
481      goto 2
482    endif
483  endif
484
485  return ! normal exit
486
4875 print*,'Parser: parse_double: error reading value'
4882 if (handle%interactive) goto 10 ! try again
489  call fatal_error
490
491end function parse_double
492
493!==================================================================
494function parse_int (handle, keyname, default, vmin, vmax, descr, valid)
495  !==================================================================
496  ! parse 4 byte integer parameter
497  !==================================================================
498  type(paramfile_handle), intent(inout) :: handle
499  character(len=*), intent(in) :: keyname
500  integer(i4b), intent(in), optional :: default, vmin, vmax
501  integer(i4b), intent(in), optional, dimension(1:) :: valid
502  character(len=*), intent(in), optional :: descr
503  integer(i4b) :: parse_int
504
505  character(len=filenamelen) :: result
506  character(len=30)          :: about_def
507  logical :: found
508  integer(i4b) :: i
509  !==================================================================
510
51110 continue
512  about_def = ''
513  call find_param (handle, trim(keyname), result, found, idef=default, &
514       &           imin=vmin, imax=vmax, descr=descr, ivalid=valid)
515  if (found) then
516    read (result,*,err=5) parse_int
517  else
518    if (present(default)) then
519!      print *,'Parser: warning: using default value for ',trim(keyname)
520        about_def = swdef
521      parse_int = default
522    else
523      print *,'Parser: error: ',trim(keyname),' not found.'
524      goto 2
525    endif
526  endif
527  if (handle%verbose) print *,'Parser: ',trim(keyname),' = ',parse_int, trim(about_def)
528  if (present(vmin)) then
529    if (parse_int<vmin) then
530      print *,'Parser: error: value for ', trim(keyname),' too small.'
531      goto 2
532    endif
533  endif
534  if (present(vmax)) then
535    if (parse_int>vmax) then
536      print *,'Parser: error: value for ', trim(keyname),' too large.'
537      goto 2
538    endif
539  endif
540  if (present(valid)) then
541     found = .false.
542     do i=1, size(valid)
543        if (parse_int == valid(i)) found=.true.
544     enddo
545     if (.not.found) then
546        print *,'Parser: error: invalid value for '//trim(keyname)
547        goto 2
548     endif
549  endif
550
551  return ! normal exit
552
5535 print*,'Parser: parse_int: error reading value'
5542 if (handle%interactive) goto 10 ! try again
555  call fatal_error
556
557end function parse_int
558!==================================================================
559
560!==================================================================
561function parse_long (handle, keyname, default, vmin, vmax, descr)
562  !==================================================================
563  ! parse 8 byte integer parameter
564  !==================================================================
565  type(paramfile_handle), intent(inout) :: handle
566  character(len=*), intent(in) :: keyname
567  integer(i8b), intent(in), optional :: default, vmin, vmax
568  character(len=*), intent(in), optional :: descr
569  integer(i8b) :: parse_long
570
571  character(len=filenamelen) :: result
572  character(len=30)          :: about_def
573  logical found
574  !==================================================================
575
57610 continue
577  about_def = ''
578  call find_param (handle, trim(keyname), result, found, ldef=default, &
579                   lmin=vmin, lmax=vmax, descr=descr)
580  if (found) then
581    read (result,*,err=5) parse_long
582  else
583    if (present(default)) then
584!      print *,'Parser: warning: using default value for ',trim(keyname)
585        about_def = swdef
586      parse_long = default
587    else
588      print *,'Parser: error: ',trim(keyname),' not found.'
589      goto 2
590    endif
591  endif
592  if (handle%verbose) print *,'Parser: ',trim(keyname),' = ',parse_long, trim(about_def)
593  if (present(vmin)) then
594    if (parse_long<vmin) then
595      print *,'Parser: error: value for ', trim(keyname),' too small.'
596      goto 2
597    endif
598  endif
599  if (present(vmax)) then
600    if (parse_long>vmax) then
601      print *,'Parser: error: value for ', trim(keyname),' too large.'
602      goto 2
603    endif
604  endif
605
606  return ! normal exit
607
6085 print*,'Parser: parse_long: error reading value'
6092 if (handle%interactive) goto 10 ! try again
610  call fatal_error
611
612end function parse_long
613
614!===================================================================
615function parse_lgt (handle, keyname, default, descr)
616  !===================================================================
617  ! parse (1 byte) logical parameter
618  !===================================================================
619  type(paramfile_handle), intent(inout) :: handle
620  character(len=*), intent(in) :: keyname
621  logical, intent(in), optional :: default
622  character(len=*), intent(in), optional :: descr
623  logical :: parse_lgt
624
625  character(len=filenamelen) :: result
626  character(len=30)          :: about_def
627  logical found
628  !===================================================================
629
63010 continue
631  about_def = ''
632  call find_param (handle, trim(keyname), result, found, logdef=default, &
633       &           descr=descr)
634  if (found) then
635     select case (strupcase(result))
636     case ('Y','YES','T','TRUE', '.TRUE.','1')
637        parse_lgt = .true.
638     case ('N','NO', 'F','FALSE','.FALSE.','0')
639        parse_lgt= .false.
640     case default
641        goto 5
642     end select
643  else
644    if (present(default)) then
645!       print *,'Parser: warning: using default value for ',trim(keyname)
646      parse_lgt = default
647    else
648      print *,'Parser: error: ',trim(keyname),' not found.'
649      goto 2
650    endif
651  endif
652  if (handle%verbose) print *,'Parser: ',trim(keyname),' = ',parse_lgt, trim(about_def)
653
654  return ! normal exit
655
6565 print*,'Parser: parse_lgt: error reading value'
6572 if (handle%interactive) goto 10 ! try again
658  call fatal_error
659
660end function parse_lgt
661
662!===================================================================
663function parse_string (handle, keyname, default, descr, filestatus, options)
664  !===================================================================
665  ! parse a character string parameter
666  !
667  ! if filestatus is 'old', look for an existing file having the name of the string
668  !
669  ! if filestatus is 'new', no file with the exact same name as the string should exist
670  !
671  ! options is the list of valid options
672  !
673  !===================================================================
674  type(paramfile_handle), intent(inout) :: handle
675  character(len=*), intent(in) :: keyname
676  character(len=*), intent(in), optional :: default
677  character(len=*), intent(in), optional :: descr
678  character(len=*), intent(in), optional :: filestatus
679  character(len=*), intent(in), optional, dimension(1:) :: options
680
681  character(len=filenamelen) :: parse_string
682
683  character(len=filenamelen) :: result
684  character(len=30)          :: about_def
685  logical :: found, there
686  integer :: i
687  !===================================================================
688
68910 continue
690  about_def = ''
691  call find_param (handle, trim(keyname), result, found, chdef=default, &
692                   descr=descr)
693  if (found) then
694    parse_string = trim(result)
695  else
696    if (present(default)) then
697!       write(*,'(1x,a)') 'Parser: warning: using default value for '//trim(keyname)
698        about_def = swdef
699      parse_string = trim(default)
700    else
701      write(*,'(1x,a)') 'Parser: error: '//trim(keyname)//' not found.'
702      goto 2
703    endif
704  endif
705  parse_string = expand_env_var(parse_string)
706  if (handle%verbose) write(*,'(1x,a)') 'Parser: '//trim(keyname)//' = '//trim(parse_string)//trim(about_def)
707
708  ! 0 (zero), '' and ' ' (2 single quotes with nothing or one space in between)
709  !         are interpreted as "No File"
710  if (trim(adjustl(parse_string)) == "0" )  parse_string = ''
711  if (trim(adjustl(parse_string)) == "''")  parse_string = ''
712  if (trim(adjustl(parse_string)) == "' '") parse_string = ''
713
714  if (present(filestatus) .and. trim(parse_string) /= '') then
715     if (trim(filestatus)=='new' .or. trim(filestatus)=='NEW') then
716        !inquire(file=trim(parse_string),exist=there)
717        there = file_present(trim(parse_string))
718        if (there) then
719           print *, 'Parser: error: output file ' // trim(parse_string) // &
720                ' already exists!'
721           goto 2
722        end if
723     else if (trim(filestatus)=='old' .or. trim(filestatus)=='OLD') then
724        !inquire(file=trim(parse_string),exist=there)
725        there = file_present(trim(parse_string))
726        if (.not. there) then
727           print *, 'Parser: error: input file ' // trim(parse_string) // &
728                ' does not exist!'
729           goto 2
730        end if
731     else
732        print *, 'Parser: error: wrong value for filestatus :',filestatus
733        call fatal_error
734     endif
735  endif
736
737  if (present(options)) then
738     do i=1, size(options)
739        if (trim(adjustl(parse_string)) == trim(adjustl(options(i)))) goto 5
740     enddo
741     print*,'Invalid choice'
742     goto 2
7435   continue
744  endif
745
746  return ! normal exit
747
7482 if (handle%interactive) goto 10 ! try again
749  call fatal_error
750
751end function parse_string
752
753
754
755!========================================================================
756function concatnl(line1,line2,line3,line4,line5,line6,line7,line8,line9,line10)
757  !========================================================================
758  ! concatenate line1, line2, line3,... into one string,
759  ! while putting a char(10) Line Feed in between
760  !========================================================================
761
762  character(len=*), intent(in)           :: line1
763  character(len=*), intent(in), optional ::       line2,line3,line4,line5
764  character(len=*), intent(in), optional :: line6,line7,line8,line9,line10
765
766  character(len=filenamelen) :: concatnl
767
768  concatnl = trim(line1)
769  if (present(line2)) concatnl = trim(concatnl)//ret//trim(line2)
770  if (present(line3)) concatnl = trim(concatnl)//ret//trim(line3)
771  if (present(line4)) concatnl = trim(concatnl)//ret//trim(line4)
772  if (present(line5)) concatnl = trim(concatnl)//ret//trim(line5)
773  if (present(line6)) concatnl = trim(concatnl)//ret//trim(line6)
774  if (present(line7)) concatnl = trim(concatnl)//ret//trim(line7)
775  if (present(line8)) concatnl = trim(concatnl)//ret//trim(line8)
776  if (present(line9)) concatnl = trim(concatnl)//ret//trim(line9)
777  if (present(line10)) concatnl = trim(concatnl)//ret//trim(line10)
778
779
780end function concatnl
781!========================================================================
782
783!========================================================================
784function scan_directories(directories, filename, fullpath)
785  !========================================================================
786  ! scan directories in search of filename,
787  ! if found, returns .true. and the full path is in fullpath.
788  ! The search is *NOT* recursive
789  !
790  ! it assumes that the given directory and filename are separated by either
791  !  nothing, a / (slash) or a \ (backslash)
792  !
793  ! if several directories are to be searched (up to 20),
794  ! concatenate them into 'directories',
795  ! putting a special character (ASCII < 32) between them.
796  !  see concatnl
797  ! NB: a space is not a special character
798  !========================================================================
799  logical(LGT) :: scan_directories
800  character(len=*), intent(in)  :: filename, directories
801  character(len=*), intent(out) :: fullpath
802
803  logical :: found
804  integer(I4B), dimension(1:20) :: index
805  integer(I4B)                  :: i, k, nc, nspecial
806  character(len=1)              :: ch
807  character(len=filenamelen)    :: directory
808  character(len=3000)           :: string
809  character(LEN=1), DIMENSION(1:3) :: separator
810  character(len=*), parameter   :: code = 'scan_directories'
811  !========================================================================
812
813  ! define separators (this is the only way that works for all compilers)
814  separator(1) = char(32) ! ' '
815  separator(2) = char(47) ! '/'
816  separator(3) = char(92) ! '\'
817
818  ! find location of special characters
819  nc = len_trim(directories)
820  index(1) = 0
821  nspecial = 2
822  do i=1,nc
823     ch = directories(i:i)
824     if (iachar(ch) < 32) then
825        index(nspecial) = i
826        nspecial        = nspecial + 1
827     endif
828  enddo
829  index(nspecial) = nc + 1
830
831  ! test string between special character as potential directory
832  fullpath = ''
833  found = .false.
834  do i = 1, nspecial-1
835     directory=trim(adjustl(directories(index(i)+1:index(i+1)-1)))
836        do k = 1, size(separator)
837           string = trim(directory)//trim(separator(k))//trim(filename)
838!            inquire(&
839!                 &  file=string, &
840!                 &  exist=found)
841           found = file_present(string)
842           if (found) goto 10
843        enddo
844  enddo
845
84610 continue
847  if (found) then
848     if (len(fullpath) >= len_trim(string)) then
849        fullpath = trim(string)
850     else
851        print*,code
852        print*,'variable fullpath is not large enough'
853        print*,'requires ',len_trim(string),' characters'
854        print*,'has only ',trim(fullpath)
855        call fatal_error
856     endif
857  endif
858
859  scan_directories = found
860
861end function scan_directories
862
863
864  !-----------------------------------------------------------
865  function get_healpix_main_dir() result (hmd)
866    character(len=FILENAMELEN)    :: hmd
867    !-----------------------------------------------------------
868    ! healpix_dir = get_healpix_main_dir()
869    ! returns the full path to the HEALPIX main directory
870    ! using
871    ! 1) the preprocessing macros
872    ! 1a HEALPIX
873    ! 1b HEALPIXDIR
874    ! 2) the environment variable
875    ! 2a HEALPIX
876    !-----------------------------------------------------------
877    hmd = ''
878!    print*,'get_healpix_main'
879#ifdef HEALPIX
880    hmd = HEALPIX
881#else
882#ifdef HEALPIXDIR
883    hmd = HEALPIXDIR
884#else
885    call getEnvironment('HEALPIX',hmd)
886#endif
887#endif
888
889    if (trim(hmd) == '') then
890!!!       call fatal_error("Can not determine main HEALPIX directory")
891    else
892       hmd = trim(hmd) // '/'
893    endif
894
895    return
896  end function get_healpix_main_dir
897  !-----------------------------------------------------------
898
899  function get_healpix_data_dir() result (hdd)
900    character(len=FILENAMELEN)    :: hdd
901    character(len=FILENAMELEN)    :: def_dir, healpixdir
902    !-----------------------------------------------------------
903    ! healpix_data_dir = get_healpix_data_dir()
904    ! returns the full path to the HEALPIX DATA directory
905    ! using
906    ! 1) the preprocessing macro
907    !    HEALPIXDATA
908    ! 2) the environment variable
909    !    $HEALPIXDATA
910    ! otherwise, it will return the list of directories:
911    !  .
912    !  ../data
913    !  ./data
914    !  ..
915    !       (and if $HEALPIX is defined)
916    !  $HEALPIX
917    !  $HEALPIX/data
918    !  $HEALPIX/../data
919    !  $HEALPIX\data
920    ! separated by LineFeed
921    !
922    ! bug correction 2009-11-26
923    ! treat correctly the case where HEALPIX not defined 2012-11-14
924    !-----------------------------------------------------------
925    hdd = ''
926!    print*,'get_healpix_data'
927#ifdef HEALPIXDATA
928    hdd = HEALPIXDATA
929#else
930    call getEnvironment('HEALPIXDATA',hdd)
931
932    if (trim(hdd) == '') then
933       def_dir  = concatnl("","../data","./data","..")
934       healpixdir = get_healpix_main_dir()
935       if (trim(healpixdir) /= "") then ! if $HEALPIX defined
936!          def_dir = concatnl(&
937          hdd = concatnl(&
938               & def_dir, &
939               & healpixdir, &
940               & trim(healpixdir)//"/data", &
941               & trim(healpixdir)//"/../data", &
942               & trim(healpixdir)//char(92)//"data") !backslash
943       else ! if $HEALPIX (or equivalent) not defined
944          hdd = def_dir
945       endif
946    endif
947#endif
948
949    if (trim(hdd) == '') then
950!!!       call fatal_error("Can not determine HEALPIX DATA directory")
951    else
952       hdd = trim(hdd) // '/'
953    endif
954
955    return
956  end function get_healpix_data_dir
957
958  !-----------------------------------------------------------
959
960  function get_healpix_test_dir() result (htd)
961    character(len=FILENAMELEN)    :: htd
962    character(len=FILENAMELEN)    :: hmd
963    !-----------------------------------------------------------
964    ! healpix_test_dir = get_healpix_test_dir()
965    ! returns the full path to the HEALPIX TEST directory
966    ! using
967    ! 1) the preprocessing macro
968    !    HEALPIXTEST
969    ! 2) the environment variable
970    !    $HEALPIXTEST
971    ! 3)
972    !    $HEALPIX/test
973    ! bug correction 2009-11-26
974    !-----------------------------------------------------------
975    htd = ''
976!    print*,'get_healpix_test'
977#ifdef HEALPIXTEST
978    htd = HEALPIXTEST
979#else
980    call getEnvironment('HEALPIXTEST',htd)
981
982    if (trim(htd) == '') then
983       call getEnvironment('HEALPIX',hmd)
984       if (trim(hmd) /= '') then ! bug correction
985          htd = trim(hmd)//'/test'
986       endif
987
988    endif
989#endif
990
991    if (trim(htd) == '') then
992!!!       call fatal_error("Can not determine HEALPIX TEST directory")
993    else
994       htd = trim(htd) // '/'
995    endif
996
997    return
998  end function get_healpix_test_dir
999
1000
1001  !-----------------------------------------------------------
1002  ! file = get_healpix_pixel_window_file(nside)
1003  ! returns default file name of Healpix pixel window
1004  !-----------------------------------------------------------
1005  function get_healpix_pixel_window_file(nside) result(filename)
1006    integer(i4b),              intent(in) :: nside
1007    character(len=FILENAMELEN)            :: filename
1008    character(len=6) :: sstr
1009
1010    if (nside <= 8192) then
1011       sstr = adjustl(string(nside,'(i4.4)'))
1012    else
1013       sstr = adjustl(string(nside,'(i6.6)'))
1014    endif
1015    filename = "pixel_window_n"//trim(sstr)//".fits"
1016
1017  end function get_healpix_pixel_window_file
1018
1019  !-----------------------------------------------------------
1020  ! file = get_healpix_ring_weight_file(nside)
1021  ! returns default file name of Healpix ring weights
1022  !-----------------------------------------------------------
1023  function get_healpix_ring_weight_file(nside) result (filename)
1024    integer(i4b),              intent(in) :: nside
1025    character(len=FILENAMELEN)            :: filename
1026    character(len=6) :: sstr
1027
1028    if (nside <= 8192) then
1029       sstr = adjustl(string(nside,'(i5.5)'))
1030    else
1031       sstr = adjustl(string(nside,'(i6.6)'))
1032    endif
1033    filename = "weight_ring_n"//trim(sstr)//".fits"
1034
1035  end function get_healpix_ring_weight_file
1036
1037  !-----------------------------------------------------------
1038  ! file = get_healpix_pixel_weight_file(nside)
1039  ! returns default file name of Healpix pixel weights
1040  !-----------------------------------------------------------
1041  function get_healpix_pixel_weight_file(nside) result (filename)
1042    integer(i4b),              intent(in) :: nside
1043    character(len=FILENAMELEN)            :: filename
1044    character(len=6) :: sstr
1045
1046    if (nside <= 8192) then
1047       sstr = adjustl(string(nside,'(i5.5)'))
1048    else
1049       sstr = adjustl(string(nside,'(i6.6)'))
1050    endif
1051    filename = "weight_pixel_n"//trim(sstr)//".fits"
1052
1053  end function get_healpix_pixel_weight_file
1054
1055  !-----------------------------------------------------------
1056  ! file = get_healpix_weight_file(nside, type)
1057  ! returns default file name of Healpix ring weights (if type=1)
1058  ! or pixel weigts (if type=2)
1059  !-----------------------------------------------------------
1060  function get_healpix_weight_file(nside, type) result (filename)
1061    integer(i4b),              intent(in) :: nside, type
1062    character(len=FILENAMELEN)            :: filename
1063
1064    if (type == 0) then
1065       filename = ''
1066    else if (type == 1) then
1067       filename = get_healpix_ring_weight_file(nside)
1068    else if (type == 2) then
1069       filename = get_healpix_pixel_weight_file(nside)
1070    else
1071       print*,'Wrong choice of weight: must be either'
1072       print*,' 0: no weight'
1073       print*,' 1: ring-based weights'
1074       print*,' 2: pixel-based weights'
1075       print*,' value: '//string(type)
1076       call fatal_error
1077    endif
1078
1079  end function get_healpix_weight_file
1080
1081end module paramfile_io
1082