Commit 1e9896a8 authored by Monkenbusch, Michael's avatar Monkenbusch, Michael
Browse files

new selfcontained extract functions

parent cb83c416

sources/drs_stamps.f90

0 → 100644
+81 −0
Original line number Diff line number Diff line 
!                                                                       

!   gfortran -o drs_stamps drs_stamps.f90 -L/usr/local/gr/lib -lGR -Wl,-rpath,/usr/local/gr/lib                       

!                                                                       

      program drs_stamps

      implicit none

!  

      integer, parameter :: WS_TYPE_XTERM              = 211   !  xterm

      integer, parameter :: WS_TYPE_EPS                = 62    !  eps

      integer, parameter :: WS_TYPE_PDF                = 101   !  pdf

      integer, parameter :: WS_TYPE_PDF_COMPRESSED     = 102   !  pdf





      integer, parameter :: mm=16!                                                                       

                                                                       

      double precision :: x(mm), y(mm), z(mm, mm) 

      integer          :: iz(mm,mm)

      double precision :: xq(5), yq(5)

      double precision :: f

      double precision :: red, green, blue

      integer          :: i,l,j ,lm,lp,  iq, jq, indx

      character(len=40) :: filename

!   





!              

       call gr_opengks()



dl:   do l=0,9



       write(filename,'(a,i0,a)')"teststamp",l,".pdf"

       call gr_openws(11,trim(filename),WS_TYPE_PDF_COMPRESSED)

       call gr_activatews(11)

 

       call gr_setwsviewport(0.01D0, 0.21D0, 0.01D0, 0.21d0)  

       call gr_setviewport(0.0D0, 1D0, 0.D0, 1D0) 

       call gr_setwindow(1d0, dble(mm), 1d0, dble(mm)) 

 

!! define elemntary square representing one pixed

       xq=[0d0,1d0,1d0,0d0,0d0]

       yq=[0d0,0d0,1d0,1d0,0d0]

       call gr_setfillintstyle(1) ! SOLID



!! setup color index table

      do indx=0,255

        red  = 1d0-indx/255d0

        green= 1d0-indx/255d0

        blue = 1d0-indx/255d0

        call gr_setcolorrep(indx, red, green, blue)

      enddo



!! create some example data

        f=0.015d0*(l+1)

        do i=1,mm

         x(i) = i

         do j=1,mm

          y(j) = j

          z(i,j) = (sin(i*f)*cos(j*f))**2 

          iz(i,j) = int(z(i,j)*255)+1

         enddo

        enddo

      

                                                       

!     call gr_surface(mm, mm, x, y, z, 5)  !! since surface smoothes we do it explicitly



!! fill the pixels with the color representing the contained value  

     do iq=0,mm-1

      do jq=0,mm-1

         call gr_setfillcolorind(iz(iq+1,jq+1))

         call gr_fillarea(5,xq+iq,yq+jq)

      enddo

     enddo





                                  

     call gr_updatews()  

     call gr_deactivatews(11) 

     call gr_closews(11)  

    enddo dl



end program drs_stamps

sources/extract_beta.f90

0 → 100644
+110 −0
Original line number Diff line number Diff line 
program extract_betas

! very simple extract beta tables from report tex file and write it to datreat

! usage:

! extract_figures < reportXYZ.tex > datreat

!

! Author: Michael Monkenbusch, Forschungszentrum Juelich

!

 implicit none

 integer                :: fn = 0

 integer                :: datr_output = 6

 character(len=128)     :: comment



 character(len=4096)    :: line_buf



 logical                :: beta_start  = .false.

 logical                :: beta_values = .false.

 integer                :: ibeta       = 0



 integer                :: nq, ntau

 integer                :: i, l, ic1 , ic2, inex

 double precision       :: q, beta, beta_err









 r1:  do 

        read(5,'(a)',end=999) line_buf





        if( index(line_buf,"};") > 0  ) then

           if(beta_values) then

               write(datr_output,'(a)'        )   " "   

               write(datr_output,'(a)'        )   "#nxt "   

           endif

           beta_start  = .false.

           beta_values = .false.

        endif





        if(beta_values) then

           read( line_buf, *)     q, beta, beta_err

           write(datr_output, '(3f16.7)')  q, beta, beta_err

        endif







        if( index(line_buf,"%%+++DRSPINE-PLOT") > 0   .and.  &

            index(line_buf,"Derived beta"     ) > 0          ) then 

            beta_start = .true.

            ibeta      = ibeta  + 1

            comment    = line_buf(6:133)

            ic1        = index(line_buf,"[",back=.true.)

            ic2        = index(line_buf,"]",back=.true.)

            inex       = min(1,index(line_buf,"(nex)"))

            read(line_buf(ic1+1:ic2-1),*) nq, ntau



            call filter(comment)



            write(datr_output,'(a)'        )   comment

            write(datr_output,'(a,i0,a,i8)')   "beta",ibeta,"  beta  vs  q  ",ibeta

            write(datr_output,'(a)'        )   "parameter"

            write(datr_output,'(a,i8)'     )   "nq   ",nq

            write(datr_output,'(a,i8)'     )   "ntau ",ntau  

            write(datr_output,'(a,i8)'     )   "inex ",inex  

            write(datr_output,'(a)'        )   " "          

            write(datr_output,'(a)'        )   "values "          

        endif



        if( beta_start .and. index(line_buf,"table [") > 0 ) then

           read(5,'(a)',end=999) line_buf

           beta_values = .true.

        endif



      enddo r1



 999 continue



 contains



 subroutine filter( cstring )

  character(len=*) :: cstring



  character(len=2*len(cstring)) :: buffer



  integer :: is, id, i, il

  

  il = len_trim(cstring)

  id = 0

  do i=1, il

    id = id+1

    buffer(id:id) = cstring(i:i)

    if( cstring(i:i) == "\" ) then

        id = max(1,id-1)

    endif



    if( cstring(i:i) == "[" ) then

        buffer(id:id) = "("

    endif



    if( cstring(i:i) == "]" ) then

        buffer(id:id) = ")"

    endif

  enddo



  id = min(il,id)

  cstring = buffer(1:id)

  

 end subroutine filter



end program extract_betas

sources/extract_deffs.f90

+2 −0
Original line number Diff line number Diff line
@@ -2,6 +2,8 @@ program extract_deffs 
! very simple extract deff tables from report tex file and write it to datreat

! usage:

! extract_figures < reportXYZ.tex > datreat

!

! Author: Michael Monkenbusch, Forschungszentrum Juelich

!

 implicit none

 integer                :: fn = 0

sources/extract_sqavet.f90

0 → 100644
+91 −0
Original line number Diff line number Diff line 
program extract_sqavets

! very simple extract sqt tables from report tex file and write it to table

! usage:

! extract_figures < reportXYZ.tex > tab

!

! Author: Michael Monkenbusch, Forschungszentrum Juelich

!

 implicit none

 integer                :: datr_output = 6

 integer                :: tab_output  = 6

 character(len=128)     :: comment



 character(len=4096)    :: line_buf



 integer                :: ios, i, j

 integer, parameter     :: maxtab =5000

 integer, parameter     :: maxqs  =100

 integer, parameter     :: maxtaus=300

 integer                :: ntab, nq

 double precision       :: tab(7,maxtab)  ! keeping the value enables later sorting if required



 double precision       :: sqt(maxqs, maxtaus,4) = 0d0

 double precision       :: qval(maxqs)           = 0d0

 integer                :: nqval(maxqs)          = 1

 integer                :: ntau(maxqs)           



 double precision       :: dq = 0.01d0

 double precision       :: qref



 ntab = 1

 nq   = 1

 ntau = 1



        read(5,'(a)',iostat=ios) comment

        if(ios .ne. 0) stop "data not readable!"





 r1:  do 

        read(5,'(a)',iostat=ios) line_buf

        if(ios .ne. 0) exit



        read(line_buf,*,iostat=ios) tab(:,ntab)

        if(ios .ne. 0) cycle

        write(datr_output,'(4f18.7)') tab(7,ntab), tab(1:3,ntab)

        ntab = ntab+1



      enddo r1

      ntab = ntab-1

 

      nq = 1

      qval(1) =  tab(7,1)

q1:   do i = 2, ntab

        if(abs(qval(nq)/nqval(nq)-tab(7,i)) > dq) then

          nq = nq+1

          qval(nq) = tab(7,i) 

        else

          qval(nq) = qval(nq)  + tab(7,i) 

          nqval(nq)= nqval(nq) + 1

        endif 

      enddo q1



      qval = qval/nqval



!      write(*,'(f12.6)') qval(1:nq)





qt:   do j=1,nq

         ntau(j) = 0  

tt:      do i=1,ntab

             if(abs(qval(j)-tab(7,i)) > dq) cycle tt

             ntau(j) = ntau(j)+1

             sqt(j,ntau(j),1:3) = tab(1:3,i) 

             sqt(j,ntau(j),  4) = tab(7,i) 

         enddo tt

      enddo qt



!      write(*,'(i8)') ntau(1:nq)



      write(tab_output,'(a)') trim(comment)

      write(tab_output,'(a)') "    tau/ns    s(q,t)/s(q) sqt-error             q-exact"





      do j=1,nq

        write(tab_output,'("q=",f12.6)') qval(j)

        do i=1,ntau(j)

          write(tab_output,'(f10.4,3x,f10.7,2x,f10.7,10x,f10.5)') sqt(j,i,1:4)

        enddo

      enddo





end program extract_sqavets

sources/extract_sqt.f90

0 → 100644
+33 −0
Original line number Diff line number Diff line 
program extract_sqts

! very simple extract sqt tables from report tex file and write it to table

! usage:

! extract_figures < reportXYZ.tex > tab

!

! Author: Michael Monkenbusch, Forschungszentrum Juelich

!

 implicit none

 integer                :: datr_output = 6

 character(len=128)     :: comment



 character(len=4096)    :: line_buf



 integer                :: ios

 integer, parameter     :: maxtab=5000

 integer                :: ntab

 double precision       :: tab(7,maxtab)  ! keeping the value enables later sorting if required





 ntab = 1



 r1:  do 

        read(5,'(a)',iostat=ios) line_buf

        if(ios .ne. 0) exit



        read(line_buf,*,iostat=ios) tab(:,ntab)

        if(ios .ne. 0) cycle

        write(datr_output,'(4f18.7)') tab(7,ntab), tab(1:3,ntab)

        ntab = ntab+1



      enddo r1



end program extract_sqts