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