getBasicHistoInfo.f File Reference

Go to the source code of this file.

Functions/Subroutines
program	__getbasichistoinfo.f__
subroutine	proctimebin

Function/Subroutine Documentation

__getbasichistoinfo.f__()

program __getbasichistoinfo.f__

(

)

Definition at line 18 of file getBasicHistoInfo.f.

References proctimebin().

      integer binorascii

Here is the call graph for this function:

proctimebin()

subroutine proctimebin

(

)

Definition at line 60 of file getBasicHistoInfo.f.

References kwhistd(), kwhistr(), kwhists(), nfai, and nrbin.

      implicit none
#include "ZprivateSub.h"
#include "../../Hist/Z90histc.h"
#include "../../Hist/Z90histo.h"
#include "../../Hist/Z90hist1.h"
      character*80 buf

      type(histogram1) h10 ! 1D histogram area

      character*6 histid0  ! get histogram id  here
      integer icon
      real normf
      data normf/-1.0/     ! use normalization as already done
      integer ansites
      data ansites/1/   !  number of layers where histogram was taken
      integer fnot/31/     ! file number for hist
      integer fnow/32/     ! file number for working
      character*256 filename, tempfile

      integer ir, ifai
      integer code
      integer nbinhisto, mode, status, webonly
      integer kwhistreadascii
      integer i
  

      call getarg(2, buf, status)
      read(buf, *) webonly
      call getarg(3, filename, status)
!      write(0,*) status, filename
      call getarg(4, tempfile, status)

      open(fnot, file=filename,
     *         iostat=status, access='sequential',
     *         form='unformatted', action='read')
      if(status .ne. 0 ) then
         write(0,*) ' cannot open file ='
         write(0,*) filename
         stop 111
      endif
      open(fnow, file=tempfile,
     *         iostat=status, access='sequential',
     *         form='formatted', action='write')
      if(status .ne. 0 ) then
         write(0,*) ' cannot open file ='
         write(0,*) tempfile
         stop 222
      endif
      
!        skip time data for core region
      if(webonly .eq. 0) then
         do i = 1, ansites
            do code = 1, 4
               read( fnot, end=100 ) histid0
               if( histid0 .ne. '#hist1' ) then
                  write(0,*) ' histogram is not 1D: ',histid0
                  stop 111
               endif
!/////////
               write(0,*) ' reading core region'
!/////////////
               call kwhistr(h10, fnot, icon)
               call kwhists(h10, normf)
!                   deallocate
               call kwhistd( h10 )
            enddo
         enddo
      endif
!          web sector region
!           open memo file
!//////////////
      write(0,*) ' reading web region'
!//////////////
      do i = 1, ansites
         do code = 1, 4
            do ifai= 1, nfai
               do ir= 1, nrbin
                  read( fnot, end=100 ) histid0
                  if( histid0 .ne. '#hist1' ) then
                     write(0,*) ' histogram is not 1-D: ',histid0
                     stop 111
                  endif
                  call kwhistr(h10, fnot, icon)
                  write(fnow,'(a)') h10%c%id
!                        deallocate
                  call kwhistd( h10 )
                  close(fnow)
                  close(fnot)
                  return  !  *********
               enddo
            enddo  
         enddo   
      enddo
      return
 100  continue
      write(0,*) ' unexpected EOF ' 
      stop 2345
!     **********************
      entry  proctimeascii
!     **********************

      call getarg(2, buf, status)
      read(buf, *)  webonly
      call getarg(3, filename, status)                          
!      write(0,*) status, filename
      call getarg(4, tempfile, status)                          
      open(fnot, file=filename,
     *     iostat=status, access='sequential',
     *     form='formatted', action='read')
      if(status .ne. 0 ) then
         write(0,*) ' cannot open file ='
         write(0,*) filename
         stop 111
      endif
      open(fnow, file=tempfile,
     *     iostat=status, access='sequential',
     *     form='formatted', action='write')
      if(status .ne. 0 ) then
         write(0,*) ' cannot open file ='
         write(0,*) tempfile
         stop 111
      endif

      if(webonly .eq. 0 ) then
!        skip time data for core region
         do i = 1, ansites
            do code = 1, 4
               nbinhisto=kwhistreadascii(h10, fnot)
               if(nbinhisto .le. 0 ) then
                  write(0,*) ' ascii read  failed'
                  stop 111
               endif
               call kwhists(h10, normf)

!     deallocate
               call kwhistd( h10 )
            enddo
         enddo
      endif
!          web sector region
      do i = 1, ansites
         do code = 1, 4
            do ifai= 1, nfai
               do ir= 1, nrbin
                  nbinhisto=kwhistreadascii(h10, fnot)
                  if(nbinhisto .le. 0 ) then
                     write(0,*) ' ascii read  failed'
                     stop 111
                  endif
                  write(fnow,'(a)') h10%c%id
!                        deallocate
                  call kwhistd( h10 )
                  close(fnow)
                  close(fnot)
                  return  !  *********
               enddo
            enddo  
         enddo   
      enddo

Here is the call graph for this function: