troubleshooting Question

Fortran -> VB.net conversion - Binary Files

Avatar of 970170
970170 asked on
Programming Languages-Other.NET Programming
45 Comments2 Solutions871 ViewsLast Modified:
Hi, I desparately need the following Fortran code to be explained and translated into VB.net (or any .NET lang, but will take more explaining) for me.  Its purpose is to take a single file as input, runs it through a process, and create a bunch of little files as an output.  

----------------------------------------------------------------------------------------------------------------------------------------------------------------------
!++
!
!       Call Sequence:  Assign/user    Input File     Input$file
!                       Assign/user    Output File    Output$file
!                       Run Convert_from_hasp
!
!       Errors:         None
!==

         Options        /Extend_source
         Program        Convert_from_hasp
         Implicit       None

         
         !==============
         !
         ! Include Files
         !
         !==============

         Include        '($Ssdef)'

         !===========
         !
         ! Constants:
         !
         !===========        

         Parameter      Blocksize = 32760

         !================
         !
         ! Local variables
         !
         !================        
 
         Character*80            Buffer          ! Buffer for data entry      ! 2
         Integer*4               Byte_count      ! Physical length of record      ! 5
         Character*(BLOCKSIZE)   Data_buf        ! Buffer for data blocks
         Logical*1               Eof_found       ! Flag, when true, indicates first EOF record found ! 6
         Integer*2               I               ! Byte counter                    ! 7
         Integer*4               Input_lun       ! Channel for input file
         Integer*4               J               ! Loop counter                    ! 5
         Integer*4               K               ! Dummy variable              ! 5
         Integer*4               Lib$free_lun    ! RTL routine to release a channel
         Integer*4               Lib$get_lun     ! RTL routine to assign a channel
         Integer*4               Line_count      ! Current line number              ! 6
         Character*80            Msg             ! Buffer for error messages
         Integer*4               Nchars          ! Number of characters read
         Integer*4               Output_lun      ! Channel for output file
         Character*2             Rewind_cmd      ! Byte count on rewind command      ! 4
         Character*1             Space           ! EBCDIC space character      ! 5
         Integer*4               Status          ! Status variable
         Integer*4               Status2         ! Status variable              ! 2
         Character*1             Temp_nchars (2) ! Buffer for NCHARS field      ! 2
         
         !============================================================
         !
         ! Force the longword containing the byte count to have both a
         ! logical and integer representation.
         !
         !============================================================

         Equivalence (Nchars, Temp_nchars)                                ! 2
                                                              ! 4
         Data  Eof_found         /.False./                                ! 6
         Data  Rewind_cmd(1:1)   /'90'x/                                ! 4
         Data  Rewind_cmd(2:2)   /'00'x/                                ! 4
         Data  Space             /'40'x/                                ! 5

                                                              ! 6
         !============================================
         !
         ! Get the channel numbers for the data files.
         !
         !============================================

         status = lib$get_lun (input_lun)
         if (status .ne. SS$_NORMAL) then
            encode (80, 10, msg) 'VMS', status, 'get channel for input file.'
10          format (a, ' status code ', z6, ' received trying to ', a)
            call lib$put_output (msg)
            go to 999
         end if

         status = lib$get_lun (output_lun)
         if (status .ne. SS$_NORMAL) then
            encode (80, 10, msg) 'VMS', status, 'get channel for output file.'
            call lib$put_output (msg)
            go to 999
         end if
         
         !==================================================================
         !
         ! Open the data files.  Open the output file as new since we want
         ! to create a new version for every file defined by the input file.
         !
         !==================================================================

         open (input_lun, status='old', recordtype='variable', iostat=status,
     &      recl=80, shared, readonly, name='INPUT$FILE')
         if (status .ne. 0) then
            encode (80, 10, msg) 'I/O', status, 'open input file.'
            call lib$put_output (msg)
            go to 999
         end if

         open (output_lun, status='new', recordtype='variable',
     &      iostat=status, recl=BLOCKSIZE, name='OUTPUT$FILE')
         if (status .ne. 0) then
            encode (80, 10, msg) 'I/O', status, 'open output file.'
            call lib$put_output (msg)
            go to 999
         end if
         
         !==============================================================
         !
         ! Start the looping process.  We start by looking for a control
         ! record.  If one is not found, the process is aborted.
         !
         !==============================================================

         read (input_lun, 20, iostat=status) byte_count, buffer                    ! 5
20       format (q, a80)                                            ! 5
         line_count = 1                                                  ! 6
         do while ((status .eq. 0) .and. (status2 .eq. 0))                    ! 2
           
            !============================================================      ! 5
            !                                                        ! 5
            ! Handle the possibility that Hexadecimal 40 may be a valid              ! 6
            ! byte count.  The problem is that the SNA/Gateway strips off      ! 5
            ! trailing EBCDIC spaces (Hex 40) before transmitting the              ! 6
            ! record.  We have to examine the number of bytes read in order      ! 5
            ! to determine if we have to replace the EBCDIC spaces.              ! 5
            !                                                        ! 5
            !============================================================      ! 5
                                                              ! 5
            if (byte_count .eq. 0) then                                      ! 5
               buffer(2:2) = space                                      ! 5
               buffer(3:3) = space                                      ! 5
            else if (byte_count .eq. 2) then                                ! 5
               buffer(3:3) = space                                      ! 5
            end if                                                  ! 5
                                                              ! 5
            temp_nchars(2) = buffer(2:2)                                ! 3
            temp_nchars(1) = buffer(3:3)                                ! 3
                                                              ! 4
            !========================================================              ! 3
            !
            ! The number of bytes to read is zero.  Assume that the              ! 4
            ! record is an end-of-file record and create a new output              ! 3
            ! file.                                                  ! 3
            !
            !========================================================              ! 3
                                                              ! 4
            if (nchars .eq. 0) then                                      ! 3
                                                              ! 3
               close (output_lun, status='save', iostat=status)
                                                              ! 7
               if (eof_found) then                                      ! 6
                  status = -1                                            ! 6
                  go to 60                                            ! 6
               end if                                                  ! 6
               eof_found = .true.                                      ! 6
                                                              ! 6
               open (output_lun, status='new', recordtype='variable',
     &            iostat=status, recl=BLOCKSIZE, name='OUTPUT$FILE')
               if (status .ne. 0) then
                  encode (80, 10, msg) 'I/O', status, 'open output file.'
                  call lib$put_output (msg)
                  status = -1
                  go to 999
               end if
           
            else if (buffer(2:3) .eq. rewind_cmd) then                          ! 4
               status = -1                                            ! 4
               go to 60                                                  ! 4
                                                              ! 4
            else                                                  ! 4
                                                              ! 2
               !=========================================
               !
               ! Make sure we do not overflow the buffer.
               !
               !=========================================

               eof_found = .false.                                      ! 6
               if (nchars .gt. BLOCKSIZE) then
                  write (6, 25) line_count, buffer                          ! 6
25                format ('0Byte count of record exceeds buffer size.  Routine aborted.'/ ! 6
     &                    ' Error occurred at line number ', i8, ', record read was ',/ ! 6
     &                    '0', a80)                                      ! 6
                  status = -1
                  go to 999
               end if
               
               !=========================================================
               !
               ! Read the required number of bytes from the data file and
               ! write them out as one big record.
               !
               !=========================================================

               byte_count = 0                                            ! 6
               do while (byte_count .lt. nchars)                          ! 5
                  read (input_lun, 40, iostat=status) k, buffer                    ! 5
40                format (q, a80)                                      ! 5
                  line_count = line_count + 1                                ! 6
                                                              ! 6
                  !============================================================      ! 5
                  !                                                  ! 5
                  ! Because the SNA/Gateway strips off trailing spaces, if the      ! 6
                  ! byte count does not match the number of bytes that are      ! 6
                  ! supposed to be on the record, insert EBCDIC spaces to fill      ! 5
                  ! out the record.                                      ! 5
                  !                                                  ! 5
                  !============================================================      ! 5
                                                              ! 5
                  if (k .ne. 80) then                                      ! 5
                     do j = k + 1, 80                                      ! 5
                        buffer(j:j) = space                                ! 5
                     end do                                            ! 5
                  end if                                            ! 5
                                                              ! 5
                  i = nchars - byte_count                                ! 7
                  if (i .gt. 79) i = 79                                      ! 7
                                                              ! 7
                  data_buf(byte_count+1:) = buffer(2:i+1)                    ! 7
                  byte_count = byte_count + i                                ! 7
               end do                                                  ! 2

               write (output_lun, 50, iostat=status2) data_buf(1:nchars)      ! 2
50             format (a<nchars>)

            end if

            read (input_lun, 20, iostat=status) byte_count, buffer              ! 5
            line_count = line_count + 1                                      ! 6
60       end do
         
         !==========================
         !
         ! Close the files and exit.
         !
         !==========================

         close (input_lun)
         close (output_lun)

         status = lib$free_lun (input_lun)
         status = lib$free_lun (output_lun)

999      call exit (status)
         end
Join the community to see this answer!
Join our exclusive community to see this answer & millions of others.
Unlock 2 Answers and 45 Comments.
Join the Community
Learn from the best

Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.

Andrew Hancock - VMware vExpert
See if this solution works for you by signing up for a 7 day free trial.
Unlock 2 Answers and 45 Comments.
Try for 7 days

”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.

-Mike Kapnisakis, Warner Bros