getBasicHistoInfo.f File Reference

Go to the source code of this file.

Functions/Subroutines
program	__getbasichistoinfo.f__
subroutine	proclatbin

Function/Subroutine Documentation

__getbasichistoinfo.f__()

program __getbasichistoinfo.f__

(

)

Definition at line 17 of file getBasicHistoInfo.f.

References proclatbin().

      integer binorascii

Here is the call graph for this function:

proclatbin()

subroutine proclatbin

(

)

Definition at line 53 of file getBasicHistoInfo.f.

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

      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
      integer kwhistreadascii
      integer i
  

      call getarg(2, filename, status)
!      write(0,*) status, filename
      call getarg(3, 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

      do i = 1, ansites
         do code = 1, 4
            do ifai= 1, nfai
               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
      return
 100  continue
      write(0,*) ' unexpected EOF ' 
      stop 2345
!     **********************
      entry  proclatascii
!     **********************

      call getarg(2, filename, status)                          
!      write(0,*) status, filename
      call getarg(3, 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

!          web sector region
      do i = 1, ansites
         do code = 1, 4
            do ifai= 1, nfai
               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   

Here is the call graph for this function: