Dynamic array allocation in fortran90

半世苍凉 提交于 2020-01-17 06:11:30

问题


I am writing a generic subroutine in fortran90 that will read in a column of data (real values). The subroutine should first check to see that the file exists and can be opened, then it determines the number of elements (Array_Size) in the column by reading the number of lines until end of file. Next the subroutine rewinds the file back to the beginning and reads in the data points and assigns each to an array (Column1(n)) and also determines the largest element in the array (Max_Value). The hope is that this subroutine can be written to be completely generic and not require any prior knowledge of the number of data points in the file, which is why the number of elements is first determined so the array, "Column1", can be dynamically allocated to contain "Array_Size" number of data points. Once the array is passed to the main program, it is transferred to another array and the initial dynamically allocated array is deallocated so that the routine can be repeated for multiple other input files, although this example only reads in one data file.

As written below, the program compiles just fine on the Intel fortran compiler; however, when it runs it gives me a severe (174): SIGSEV fault. I place the write(,) statements before and after the allocate statement in the subroutine and it prints the first statement "Program works here", but not the second, which indicates that the problem is occurring at the ALLOCATE (Column1(Array_Size)) statement, between the two write(,) statements. I re-compiled it with -C flag and ran the executable, which fails again and states severe (408): "Attempt to fetch from allocatable variable MISC_ARRAY when it is not allocated". The variable MISC_ARRAY is the dummy variable in the main program, which seems to indicate that the compiler wants the array allocated in the main program and not in the subprogram. If I statically allocate the array, the program works just fine. In order to make the program generic and not require any knowledge of the size of each file, it needs to be dynamically allocated and this should happen in the subprogram, not the main program. Is there a way to accomplish this that I am not seeing?

         PROGRAM MAIN
         IMPLICIT NONE
  ! - variable Definitions for MAIN program
         INTEGER :: n
  ! - Variable Definitions for EXPENSE READER Subprograms
         REAL, DIMENSION(:), ALLOCATABLE :: Misc_Array,MISC_DATA
         INTEGER :: Size_Misc
         REAL :: Peak_Misc_Value
  !       REAL :: Misc_Array(365)
         CHARACTER(LEN=13) :: File_Name
        File_Name = "Misc.txt"
        CALL One_Column(File_Name,Size_Misc,Peak_Misc_Value,Misc_Array)
        ALLOCATE (MISC_DATA(Size_Misc))
        DO n = 1,Size_Misc ! Transfers array data
         MISC_DATA(n) = Misc_Array(n)
        END DO
        DEALLOCATE (Misc_Array)
        END PROGRAM MAIN

        SUBROUTINE One_Column(File_Name,Array_Size,Max_Value,Column1)

        IMPLICIT NONE
        REAL, DIMENSION(:), ALLOCATABLE,INTENT(OUT) :: Column1
   !     REAL :: Column1(365)
        REAL, INTENT(OUT) :: Max_Value
        CHARACTER,INTENT(IN) :: File_Name*13
        INTEGER, INTENT(OUT) :: Array_Size
        INTEGER :: Open_Status,Input_Status,n

   ! Open the file and check to ensure it is properly opened
        OPEN(UNIT=100,FILE = File_Name,STATUS = 'old',ACTION = 'READ', &
             IOSTAT = Open_Status)
        IF(Open_Status > 0) THEN
         WRITE(*,'(A,A)') "**** Cannot Open ",File_Name
         STOP
         RETURN
        END IF
   ! Determine the size of the file
        Array_Size = 0
        DO 300
        READ(100,*,IOSTAT = Input_Status)
        IF(Input_Status < 0) EXIT
        Array_Size = Array_Size + 1
   300  CONTINUE
        REWIND(100)
        WRITE(*,*) "Program works here"
        ALLOCATE (Column1(Array_Size))
        WRITE(*,*) "Program stops working here"
        Max_Value = 0.0
        DO n = 1,Array_Size
         READ(100,*) Column1(n)
         IF(Column1(n) .GT. Max_Value) Max_Value = Column1(n)
        END DO
        END SUBROUTINE One_Column

回答1:


This is an educated guess: I think that the subroutine One_Column ought to have an explicit interface. As written the source code has 2 compilation units, a program (called main) and an external subroutine (called One_Column).

At compile-time the compiler can't figure out the correct way to call the subroutine from the program. In good-old (emphasis on old) Fortran style it takes a leap of faith and leaves it to the linker to find a subroutine with the right name and crosses its fingers (as it were) and hopes that the actual arguments match the dummy arguments at run-time. This approach won't work on subroutines returning allocated data structures.

For a simple fix move end program to the end of the source file, in the line vacated enter the keyword contains. The compiler will then take care of creating the necessary interface.

For a more scalable fix, put the subroutine into a module and use-associate it.




回答2:


I think it is important to show the corrected code so that future users can read the question and also see the solution. I broke the subroutine into a series of smaller functions and one subroutine to keep the data as local as possible and implemented it into a module. The main program and module are attached. The main program includes a call to the functions twice, just to show that it can be used modularly to open multiple files.

          PROGRAM MAIN
   !
   !  - Author:  Jonathan A. Webb
   !  - Date:    December 11, 2014
   !  - Purpose: This code calls subprograms in module READ_COLUMNAR_FILE
   !             to determine the number of elements in an input file, the 
   !             largest element in the input file and reads in the column of
   !             data as an allocatable array
   !***************************************************************************
   !***************************************************************************
   !*********************                                **********************
   !*********************      VARIABLE DEFINITIONS      **********************
   !*********************                                **********************
   !***************************************************************************
   !***************************************************************************
          USE READ_COLUMNAR_FILE
          IMPLICIT NONE
          CHARACTER(LEN=13) :: File_Name
          INTEGER :: Size_Misc,Size_Bar,Unit_Number
          REAL :: Peak_Misc_Value,Peak_Bar_Value
          REAL, DIMENSION(:), ALLOCATABLE :: Misc_Array,Bar_Array
   !***************************************************************************
   !***************************************************************************
   !*********************                                **********************
   !*********************        FILE READER BLOCK       **********************
   !*********************                                **********************
   !***************************************************************************
   !***************************************************************************
   ! - This section reads in data from all of the columnar input decks.

        ! User defines the input file name and number
          File_Name = "Misc.txt"; Unit_Number = 100
        ! Determines the number of rows in the file
          Size_Misc = File_Length(File_Name,Unit_Number)
        ! Yields the allocatable array and the largest element in the array
          CALL Read_File(File_Name,Unit_Number,Misc_Array,Peak_Misc_Value)

          File_Name = "Bar.txt"; Unit_Number = 100
          Size_Bar = File_Length(File_Name,Unit_Number)
          CALL Read_File(File_Name,Unit_Number,Bar_Array,Peak_Bar_Value)

          END PROGRAM MAIN

          MODULE READ_COLUMNAR_FILE
   !***********************************************************************************
   !***********************************************************************************
   !                                                                                ***
   !  Author:        Jonathan A. Webb                                               ***
   !  Purpose:       Compilation of subprograms required to read in multi-column    ***
   !                 data files                                                     ***
   !  Drafted:       December 11, 2014                                              ***
   !                                                                                ***
   !***********************************************************************************
   !***********************************************************************************
   !
   !-----------------------------------
   ! Public functions and subroutines for this module
   !-----------------------------------
          PUBLIC :: Read_File
          PUBLIC :: File_Length
   !-----------------------------------
   ! Private functions and subroutines for this module
   !-----------------------------------
          PRIVATE :: Check_File
   !===============================================================================
          CONTAINS
   !===============================================================================
          SUBROUTINE Check_File(Unit_Number,Open_Status,File_Name)
          INTEGER,INTENT(IN) :: Unit_Number
          CHARACTER(LEN=13), INTENT(IN) :: File_Name
          INTEGER,INTENT(OUT) :: Open_Status

        ! Check to see if the file exists
          OPEN(UNIT=Unit_Number,FILE = File_Name,STATUS='old',ACTION='read', &
               IOSTAT = Open_Status)
          IF(Open_Status .GT. 0) THEN
           WRITE(*,*) "**** Cannot Open ", File_Name," ****"
           STOP
           RETURN
          END IF
          END SUBROUTINE Check_File
   !===============================================================================
          FUNCTION File_Length(File_Name,Unit_Number)
          INTEGER :: File_Length
          INTEGER, INTENT(IN) :: Unit_Number
          CHARACTER(LEN=13),INTENT(IN) :: File_Name
          INTEGER :: Open_Status,Input_Status

        ! Calls subroutine to check on status of file
          CALL Check_File(Unit_Number,Open_Status,File_Name)
          IF(Open_Status .GT. 0)THEN
           WRITE(*,*) "**** Cannot Read", File_Name," ****"
           STOP
           RETURN
          END IF

        ! Determine File Size
          File_Length = 0
          DO 300
           READ(Unit_Number,*,IOSTAT = Input_Status)
           IF(Input_Status .LT. 0) EXIT
           File_Length = File_Length + 1
     300  CONTINUE
          CLOSE(Unit_Number)
          END FUNCTION File_Length
   !===============================================================================
          SUBROUTINE Read_File(File_Name,Unit_Number,Column1,Max_Value)
          INTEGER, INTENT(IN) :: Unit_Number
          REAL, DIMENSION(:), ALLOCATABLE,INTENT(OUT) :: Column1
          CHARACTER(LEN=13),INTENT(IN) :: File_Name
          REAL, INTENT(OUT) :: Max_Value
          INTEGER :: Array_Size,n

        ! Determines the array size and allocates the array
          Array_Size = File_Length(File_Name,Unit_Number)
          ALLOCATE (Column1(Array_Size))

        ! - Reads in columnar array and determines the element with
        !   the largest value
           Max_Value = 0.0
           OPEN(UNIT= Unit_Number,File = File_Name)
           DO n = 1,Array_Size
            READ(Unit_Number,*) Column1(n)
            IF(Column1(n) .GT. Max_Value) Max_Value = Column1(n)
           END DO
           CLOSE(Unit_Number)
           END SUBROUTINE Read_File
   !===============================================================================
           END MODULE READ_COLUMNAR_FILE


来源:https://stackoverflow.com/questions/27417103/dynamic-array-allocation-in-fortran90

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!