sync

fortran/src/read_prefilter.f90

@@ -4,115 +4,115 @@
 !call_pikaia. Only during a simulated measurement this value should be
 !considered!
 subroutine read_prefilter(file,prefilter_wlerr,wlin,nwl,prefilter,verbose)
-  use all_type
-  use interpol
-  use random
-  character(LEN=maxstr) :: file,line,word(2)
-  real(8),dimension(maxwl) :: wlin
-  real(8),dimension(maxcwl) :: wl
-  real(4),dimension(maxcwl) :: val
-  integer(4) :: err,cindex,sidx,j,idx(1),nw
-  integer(2) iw,verbose,nwl,ncwl,i
-  integer(4) :: iu
-  real(4) :: prefilter_wlerr,wlerr
-  type(prefiltertyp) :: prefilter
-
-  prefilter%nwl=0
-  prefilter%doprefilter=0
-
-  if (trim(file(1:1)).eq.' ') return
-
-  if (verbose.ge.1) write(*,*) 'Read prefilter file '//trim(file)
-
-  open(iu,file=trim(file),iostat=err,action='READ',form='FORMATTED')
-
-  if (err.ne.0) then
-     write(*,*) 'Could not open prefilter file: ',trim(file)
-     write(*,*) '****************************'
-     write(*,*) 'ERROR: no prefilter applied!'
-     write(*,*) '****************************'
-     prefilter%doprefilter=0
-     return
-  end if
-
-  iw=1
-  do while (err.eq.0)
-     read(iu, fmt='(a)',iostat=err) line
-     cindex=index(trim(line),';')-1
-     if ((cindex.lt.0).and.(len(trim(line)).gt.0)) then
-
-        j=1
-        sidx=1
-        word=''
-        !split input line into words separated by spaces
-        do while ((sidx.gt.0).and.(j.le.2).and.len(trim(line)).gt.0)
-           sidx=index(line,' ')
-           if (sidx.gt.1) then
-              word(j)=line(1:sidx-1)
-              line=trim(line(sidx+1:))
-              j=j+1
-           else
-              if (sidx.eq.1) line=trim(line(sidx+1:))
-           end if
-        end do
-        nw=j-1
-        sidx=index(trim(line),' ')
-        
-        if (iw.gt.maxcwl) then 
-           write(*,*) 'Max. # of WL points in prefilter-file&
-                & exceeded: ', iw,maxcwl
-           write(*,*) 'Change MAXCWL in all_type.f90 and maxpar.pro'
-           write(*,*) '****************************'
-           write(*,*) 'ERROR: no prefilter applied!'
-           write(*,*) '****************************'
-           prefilter%doprefilter=0
-           return
-        else
-           if (nw.ge.2) then
-              read(word(1),*) wl(iw)
-              read(word(2),*) val(iw)                
-              iw=iw+1
-           end if
+    use all_type
+    use interpol
+    use random
+    character(LEN=maxstr) :: file,line,word(2)
+    real(8),dimension(maxwl) :: wlin
+    real(8),dimension(maxcwl) :: wl
+    real(4),dimension(maxcwl) :: val
+    integer(4) :: err,cindex,sidx,j,idx(1),nw
+    integer(2) iw,verbose,nwl,ncwl,i
+    integer(4) :: iu
+    real(4) :: prefilter_wlerr,wlerr
+    type(prefiltertyp) :: prefilter
+
+    prefilter%nwl=0
+    prefilter%doprefilter=0
+
+    if (trim(file(1:1)).eq.' ') return
+
+    if (verbose.ge.1) write(*,*) 'Read prefilter file '//trim(file)
+
+    open(iu,file=trim(file),iostat=err,action='READ',form='FORMATTED')
+
+    if (err.ne.0) then
+        write(*,*) 'Could not open prefilter file: ',trim(file)
+        write(*,*) '****************************'
+        write(*,*) 'ERROR: no prefilter applied!'
+        write(*,*) '****************************'
+        prefilter%doprefilter=0
+        return
+    end if
+
+    iw=1
+    do while (err.eq.0)
+        read(iu, fmt='(a)',iostat=err) line
+        cindex=index(trim(line),';')-1
+        if ((cindex.lt.0).and.(len(trim(line)).gt.0)) then
+
+            j=1
+            sidx=1
+            word=''
+            !split input line into words separated by spaces
+            do while ((sidx.gt.0).and.(j.le.2).and.len(trim(line)).gt.0)
+                sidx=index(line,' ')
+                if (sidx.gt.1) then
+                    word(j)=line(1:sidx-1)
+                    line=trim(line(sidx+1:))
+                    j=j+1
+                else
+                    if (sidx.eq.1) line=trim(line(sidx+1:))
+                end if
+            end do
+            nw=j-1
+            sidx=index(trim(line),' ')
+
+            if (iw.gt.maxcwl) then
+                write(*,*) 'Max. # of WL points in prefilter-file&
+                    & exceeded: ', iw,maxcwl
+                write(*,*) 'Change MAXCWL in all_type.f90 and maxpar.pro'
+                write(*,*) '****************************'
+                write(*,*) 'ERROR: no prefilter applied!'
+                write(*,*) '****************************'
+                prefilter%doprefilter=0
+                return
+            else
+                if (nw.ge.2) then
+                    read(word(1),*) wl(iw)
+                    read(word(2),*) val(iw)
+                    iw=iw+1
+                end if
+            end if
         end if
-     end if
-  end do
-  ncwl=iw-1
-  close(iu)
-
-  if (prefilter_wlerr.gt.0) then 
-     CALL random_seed()
-     wlerr=gennor(0.,prefilter_wlerr)
-     if (verbose.ge.1) write(*,'(a,2f7.3)') &
-          'Adding WL error (\AA) to prefilter (normal noise): ',&
-          prefilter_wlerr,wlerr
-     wl=wl+wlerr
-  endif
-
-
-
-  prefilter%doprefilter=1
-
-                                !the WL bins for the prefilter must
-  ! be the
-                                !same as for the observations.
-  
-                                ! manual interpolation routine (to be
-                                ! consistent with the fortran version)
-  if ((minval(wlin(1:nwl)).lt.minval(wl(1:ncwl))).or.&
-       (maxval(wlin(1:nwl)).ge.maxval(wl(1:ncwl)))) then
-    write(*,*) 'Prefilter curve does not cover the full WL range of the'//&
-      ' observations. Please extend the WL coverage for the prefilter curve.'
-    stop
- end if
-  prefilter%wl(1:nwl)=wlin(1:nwl)
-  do i=1,nwl 
-     idx=minloc(abs(wlin(i)-wl(1:ncwl)))
-     prefilter%val(i)=(val(idx(1)+1)-val(idx(1)))/(wl(idx(1)+1)-wl(idx(1)))* &
-          (wlin(i)-wl(idx(1)))+val(idx(1))
-  end do
-    
-                                !normalize prefilter function to it's max
-!  prefilter%val(1:nwl)= prefilter%val(1:nwl)/maxval(prefilter%val(1:nwl))
-  prefilter%nwl=nwl
-
- end subroutine read_prefilter
+    end do
+    ncwl=iw-1
+    close(iu)
+
+    if (prefilter_wlerr.gt.0) then
+        CALL random_seed()
+        wlerr=gennor(0.,prefilter_wlerr)
+        if (verbose.ge.1) write(*,'(a,2f7.3)') &
+            'Adding WL error (\AA) to prefilter (normal noise): ',&
+            prefilter_wlerr,wlerr
+        wl=wl+wlerr
+    endif
+
+
+
+    prefilter%doprefilter=1
+
+    !the WL bins for the prefilter must
+    ! be the
+    !same as for the observations.
+
+    ! manual interpolation routine (to be
+    ! consistent with the fortran version)
+    if ((minval(wlin(1:nwl)).lt.minval(wl(1:ncwl))).or.&
+        (maxval(wlin(1:nwl)).ge.maxval(wl(1:ncwl)))) then
+        write(*,*) 'Prefilter curve does not cover the full WL range of the'//&
+            ' observations. Please extend the WL coverage for the prefilter curve.'
+        stop
+    end if
+    prefilter%wl(1:nwl)=wlin(1:nwl)
+    do i=1,nwl
+        idx=minloc(abs(wlin(i)-wl(1:ncwl)))
+        prefilter%val(i)=(val(idx(1)+1)-val(idx(1)))/(wl(idx(1)+1)-wl(idx(1)))* &
+            (wlin(i)-wl(idx(1)))+val(idx(1))
+    end do
+
+    !normalize prefilter function to it's max
+    !  prefilter%val(1:nwl)= prefilter%val(1:nwl)/maxval(prefilter%val(1:nwl))
+    prefilter%nwl=nwl
+
+end subroutine read_prefilter