bin2ascii.f

Go to the documentation of this file.

!     **********************
      module modbin2ascii
      integer,parameter:: ndepth=50
      integer fn1
      real*8  asdep(ndepth),  munit(ndepth)
      real*8  esize0(ndepth),
     *     age0(ndepth),  cogdep0(ndepth),
     *     seloss0(ndepth),
     *     ng0(ndepth), ne0(ndepth), nmu0(ndepth),
     *     cog0
      integer evno0

      contains
      subroutine get1hyb( rew )
      implicit none
      logical rew
      character*256 input0
      integer i, klena


!        data format
!        1   xxx 
!        1   xxx       
!        1   xxx 
!        1   xxx       
!      
!        2   xxx 
!        2   xxx       
!        2   xxx 
!        2   xxx       
!      
!        3   xxx 
!        3   xxx       
!        3   xxx 
!        3   xxx 
      if(rew) rewind fn1
      input0 = "x" 
      do while (input0(1:10) .ne. " ")
         input0=" "
         read( fn1 ,'(a)') input0
         if(input0(1:10) .ne. " ")  then
            read(input0(1:klena(input0)), *)
     *        evno0, i, asdep(i), esize0(i), age0(i),
     *        cogdep0(i), seloss0(i),
     *         munit(i), ng0(i), ne0(i), nmu0(i), cog0
         endif
      enddo
      end subroutine get1hyb
!     ***********************
      subroutine  mergehyb1(h1)
        use modhistogram1
        use modhistogram2
        use modhistogram3
      implicit none
      type(histogram1) h1
      type(histogram2) h2
      type(histogram3) h3


      integer klena
      integer j

      do while (h1%c%eventno .ne. evno0) 
         call get1hyb( h1%c%eventno .lt. evno0) 
      enddo
!
!       available variables
!     *      idx, ASdep(idx), Esize0(idx), age0(idx), 
!     *      SEloss0(idx), munit(idx), 
!     *      Ng0(idx), Ne0(idx), Nmu0(idx), 
!     *      ASdep(idx)/cog0, cog0
!
!        this part must be consistent with
!        FleshHist/interface.f output  for evid
      read(h1%c%id, '(i3)') j
      write(h1%c%id, 
     *   '(i3, i5,  f5.2, f5.2,
     *   i5,  i4)')
     *   j, int( asdep(j) ),
     *   age0(j), asdep(j)/cog0,
     *   int(munit(j)), int(cog0)
                                          
      return
!     *******************
      entry  mergehyb2(h2)
!     *******************
            

      do while (h2%c%eventno .ne. evno0) 
         call get1hyb( h2%c%eventno .lt. evno0) 
      enddo
      read(h2%c%id, '(i3)') j

      write(h2%c%id, 
     *   '(i3, i5,  f5.2, f5.2,
     *   i5,  i4)')
     *   j, int( asdep(j) ),
     *   age0(j), asdep(j)/cog0,
     *   int(munit(j)), int(cog0)

      return
!     *****************      
      entry mergehyb3(h3)
!     ****************
            

      do while (h3%c%eventno  .ne. evno0) 
         call get1hyb( h3%c%eventno  .lt. evno0) 
      enddo

      read(h3%c%id, '(i3)') j
      write(h3%c%id, 
     *   '(i3, i5,  f5.2, f5.2,
     *   i5,  i4)')
     *   j, int( asdep(j) ),
     *   age0(j), asdep(j)/cog0,
     *   int(munit(j)), int(cog0)


      end subroutine mergehyb1

      subroutine openhyb(icon)
      implicit none
      integer icon  ! output.  1--> hybrid must be read
                    !          0--> hybrid need not be used
      integer leng

      character*256  hyb0
      integer kgetenv2
 
      
      fn1= 3
      leng = kgetenv2("HYBFILE0", hyb0)
      call copenfw2(fn1, hyb0, 1, icon)
      if(icon .ne. 1)  then
         write(0,*)
     *    '*************** caution ************'
         write(0,*)
     *    "You haven't given env. var. HYBFILE0"
         write(0,*) 
     *    "or File specified by HYBFILE0"
         if( icon .eq. 0) then
            write(0,*) 'not exists'
         else
            write(0,*) ' cannot be opened '
         endif
         write(0,*) 
     *   "It's ok if you don't merge hybrid data file"
         icon = 0
      else
         write(0,*)  hyb0(1:leng), ' opened'
         icon = 1
      endif

      evno0 =0 
      
      end subroutine openhyb

      end module modbin2ascii

      program main
      use modhistogram1
      use modhistogram2
      use modhistogram3

      use modbin2ascii
      
      implicit none
!       binary hist file:  binary output file made by programs
!       in UserHook/Hist
!       Generic routine for converting a binary hist file
!       to an ascii hist file.
!  Usage: compile:  make -f bin2ascii.mk
!         execution:
!            set environmental variable HISTFILE0 to be
!            a binary hist file.
!            Optionally you may give another env. var.
!            HYBFILE0 to be a hybrid data output file
!            made by a program in UserHook/DisPara/FleshHist
!            or UserHook/ForTA.  If this is not given, 
!            no special treatment of mergining hybrid result.
!            (If the event is generated by using DisPara,
!             you need to merge hybrid data, otherwise
!             the hybrid data in the binary hist is not
!             correct. )
!        bin2ascii$ARCH > xxxx.hist
!
      type(histogram1) h10
      type(histogram2) h20
      type(histogram3) h30


      integer kgetenv2
      integer leng, i, fn0
      integer icon0, iconhyb
      character*256 hist0
      character*6 histid0, oldhist
      real normf
      data normf/-1.0/

      fn0 = 2
      leng = kgetenv2("HISTFILE0", hist0)
      call copenfw2(fn0, hist0, 2, icon0)
      if(icon0 .ne. 1)  then
         write(0,*) "File specified by HISTFILE0 "
         write(0,*) hist0
         if( icon0 .eq. 0) then
            write(0,*) 'not exists'
         else
            write(0,*) ' cannot be opened '
         endif
         write(0,*) ' icon=',icon0
         stop 9999
      else
         write(0,*)  hist0(1:leng), ' opened'
      endif
      leng = kgetenv2("OLDHIST", oldhist)
      if( oldhist .eq. "yes") then
         write(0,*) ' old histogram format is assumed'
         call kwhistfmt(.true.) ! for old fomat     
      else
         call kwhistfmt(.false.)
      endif
      call openhyb(iconhyb)
      do while(.true.)
         read( fn0, end=1000 ) histid0
!/////////////
!         write(0,*) ' id=', histid0
!/////////////////////
 100     continue
         if( histid0 .eq. '#hist1' ) then
!//////////////
!            write(0,*) ' reading hist'
!//////////// 
           call kwhistr(h10, fn0, icon0)
!           if(iconhyb .eq. 1)  then
           if(icon0 .eq. 1)  then
              call mergehyb1(h10)
           endif
           call kwhists(h10, normf)
           call kwhistpr(h10, -6) !  to stdout
           call kwhistd(h10)
        elseif(histid0 .eq. '#hist2' ) then
           call kwhistr2(h20, fn0, icon0)
           if(icon0 .eq. 1) then
              call mergehyb2(h20)
           endif
           call kwhists2(h20, normf)
           call kwhistpr2(h20, -6) !  to stdout
           call kwhistd2(h20)
        elseif(histid0 .eq. '#hist3' ) then
           call kwhistr3(h30, fn0, icon0)
           if(icon0 .eq. 1) then
              call mergehyb3(h30)
           endif
           call kwhists3(h30, normf)
           call kwhistpr3(h30, -6)
           call kwhistd3(h30)
        else
           write(0,*) 'histid=', histid0, ' invalid'
           stop 9000
        endif
      enddo
 1000 continue
      write(0,*) 'all events processed '
      end program main