Merge pull request #442 from danieljprice/hyperbolic

(set_star/mesa) read any tabulated stellar profile using iprofile=5 in set_star

src/main/utils_filenames.f90

@@ -19,9 +19,11 @@ module fileutils
 !
 
  implicit none
- public :: getnextfilename,numfromfile,basename,get_ncolumns,skip_header,get_column_labels,split
+ public :: getnextfilename,numfromfile,basename,get_ncolumns,skip_header
+ public :: read_column_labels,get_column_labels,split
  public :: strip_extension,is_digit,files_are_sequential
  public :: ucase,lcase,make_tags_unique,get_nlines,string_delete,string_replace,nospaces
+ integer, parameter :: max_line_length = 10000 ! for finding number of columns
 
  private
 
@@ -531,22 +533,47 @@ pure subroutine split(string,delim,stringarr,nsplit)
 
 end subroutine split
 
+!-----------------------------------------------------------------
+!
+!  utility to count number of times a character appears in a string
+!
+!-----------------------------------------------------------------
+integer function count_char(string,mychar)
+ character(len=*), intent(in) :: string
+ character(len=1), intent(in) :: mychar
+ integer :: i
+
+ count_char = 0
+ do i=1,len(string)
+    if (string(i:i)==mychar) count_char = count_char + 1
+ enddo
+
+end function count_char
+
 !---------------------------------------------------------------------------
 !
 ! extract a list of labels from the header line of a file
 !
 !---------------------------------------------------------------------------
-subroutine get_column_labels(line,nlabels,labels,method)
+subroutine get_column_labels(line,nlabels,labels,method,ndesired,csv)
  character(len=*), intent(in)  :: line
  integer,          intent(out) :: nlabels
  character(len=*), dimension(:), intent(out) :: labels
  integer,          intent(out), optional :: method
- integer :: i1,i2,i,nlabelstmp,istyle
+ integer,          intent(in),  optional :: ndesired
+ logical,          intent(in),  optional :: csv
+ integer :: i1,i2,i,nlabelstmp,nlabels_prev,istyle,ntarget
  character(len=1) :: leadingchar
+ character(len=4), parameter :: spaces = '    '
+ logical :: is_csv
 
  nlabels = 0
  i1 = 1
  istyle = 0
+ ntarget = -1
+ is_csv = .false.
+ if (present(csv)) is_csv = csv
+ if (present(ndesired)) ntarget = ndesired
  !
  ! strip leading comment character ('#')
  !
@@ -558,25 +585,50 @@ subroutine get_column_labels(line,nlabels,labels,method)
  i1 = max(i1,index(line,'=')+1)
  i2 = i1
 
- if (index(nospaces(line),'][') > 0) then
+ if (index(nospaces(line),'][') > 0 .and. .not.is_csv) then
     !
     ! format style 1: # [ mylabel1 ] [ mylabel2 ] [ mylabel3 ]
     !
     istyle = 1
-    call split(line(i1:),']',labels,nlabels)
- elseif (index(line,',') > 1) then
+    i1 = max(index(line,'[')+1,i1)    ! strip leading square bracket
+    ! try with different number of spaces between brackets (if labels not found)
+    over_spaces1: do i=4,0,-1
+       call split(line(i1:),']'//spaces(1:i)//'[',labels,nlabels)
+       if (nlabels > 1) exit over_spaces1
+    enddo over_spaces1
+ elseif (index(line,',') > 1 .or. is_csv) then
     !
     ! format style 2: mylabel1,mylabel2,mylabel3
     !
     istyle = 2
     call split(line(i1:),',',labels,nlabelstmp)
-    nlabels = count_sensible_labels(nlabelstmp,labels)
+    if (is_csv) then
+       nlabels = nlabelstmp  ! allow blank/arbitrary labels in csv format
+    else
+       nlabels = count_sensible_labels(nlabelstmp,labels)
+    endif
  else
     !
     ! format style 3: #     mylabel1     mylabel2     mylabel3
     !
     istyle = 3
-    call split(line(i1:),'  ',labels,nlabelstmp)
+    ! try splitting with 4, then 3, then 2 spaces until the number of labels decreases
+    nlabels_prev = 0
+    over_spaces: do i=4,2,-1
+       call split(line(i1:),spaces(1:i),labels,nlabelstmp)
+       ! quit if we already have the target number of labels
+       if (nlabelstmp == ntarget) exit over_spaces
+
+       ! if the number of labels is > 1 but has decreased, quit, unless nlabels
+       ! still exceeds the number of labels we are hoping for (ntarget)
+       if ((nlabelstmp < nlabels_prev .or. nlabelstmp >= max(nlabels_prev,2)  &
+            .and. i < 4 .and. .not. (ntarget > 0 .and. nlabelstmp > ntarget))) then
+          ! take the answer with the previous number of spaces
+          call split(line(i1:),spaces(1:i+1),labels,nlabelstmp)
+          exit over_spaces
+       endif
+       nlabels_prev = nlabelstmp
+    enddo over_spaces
     !
     ! this style is dangerous, so perform sanity checks
     ! on the labels to ensure they are sensible
@@ -600,10 +652,6 @@ subroutine get_column_labels(line,nlabels,labels,method)
     ! delete brackets
     if (nlabels <= size(labels)) then
        call string_delete(labels(i),',')
-       if (istyle==1) then
-          call string_delete(labels(i),'[')
-          call string_delete(labels(i),']')
-       endif
        if (istyle==1 .or. istyle==2) then
           labels(i) = trim(adjustl(labels(i)))
           ! delete leading numbers
@@ -616,9 +664,66 @@ subroutine get_column_labels(line,nlabels,labels,method)
        labels(i) = trim(adjustl(labels(i)))
     endif
  enddo
+ ! delete loose trailing square bracket but only if not matching
+ if (istyle==1) then
+    if (index(labels(nlabels),']') > 0) then
+       i1 = count_char(labels(nlabels),'[') ! number of open brackets
+       i2 = count_char(labels(nlabels),']') ! number of closed brackets
+       if (i2 > i1) then ! if brackets do not match
+          ! find last trailing bracket
+          i2 = index(labels(nlabels),']',back=.true.)
+          ! delete it, but only if followed by spaces
+          if (i2==len_trim(labels(nlabels))) then
+             labels(nlabels) = labels(nlabels)(1:i2-1)
+          endif
+       endif
+    endif
+ endif
 
 end subroutine get_column_labels
 
+!---------------------------------------------------------------------------
+!
+! interface to the above routine that also searches for the line
+! containing the column labels in the list of header lines
+!
+!---------------------------------------------------------------------------
+subroutine read_column_labels(iunit,nheaderlines,ncols,nlabels,labels,csv,debug)
+ integer,          intent(in)  :: iunit,nheaderlines,ncols
+ integer,          intent(out) :: nlabels
+ character(len=*), dimension(:), intent(out) :: labels
+ logical, intent(in), optional :: csv,debug
+ character(len=len(labels(1))), dimension(size(labels)) :: tmplabel
+ character(len=max_line_length) :: line
+ logical :: is_csv,verbose,got_labels
+ integer :: i,imethod,ierr,nwanted
+
+ is_csv = .false.
+ verbose = .false.
+ if (present(csv)) is_csv = csv
+ if (present(debug)) verbose = debug
+ got_labels = .false.
+ nlabels = 0
+ nwanted = min(ncols,size(labels)) ! can either retrieve all labels or completely fill the labels array
+ labels = ''
+ rewind(iunit)
+ do i=1,nheaderlines
+    read(iunit,"(a)",iostat=ierr) line
+    !--try to match column labels from this header line, if not already matched (or dubious match)
+    call get_column_labels(trim(line),nlabels,tmplabel,method=imethod,ndesired=nwanted,csv=csv)
+    !--if we get nlabels > ncolumns, use them, but keep trying for a better match
+    if ((got_labels .and. nlabels == nwanted) .or. &
+        (.not.got_labels .and. nlabels >= nwanted  & ! only allow single-spaced labels if == ncols
+         .and. (.not.(imethod>=4) .or. nlabels==nwanted))) then
+       labels(1:nwanted) = tmplabel(1:nwanted)
+       got_labels = .true.
+    endif
+    if (verbose) print "(5(1x,a,i0))",'DEBUG: line ',i,'nlabels = ',nlabels,&
+                 'want ',ncols,'method=',imethod,'len_trim(line)=',len_trim(line) !,' LABELS= '//tmplabel(1:ncols)
+ enddo
+
+end subroutine read_column_labels
+
 !---------------------------------------------------------------------------
 !
 ! indicate if a character is a digit (number) or not