问题
I have a Fortran function in which I would like to initialize a large array at compile time. A simplified working example is below, where the parameter coeff
in fill_coefficients
has been reduced in size greatly.
How do I write similar code when coeff
is large, without exceeding the maximum of 255 continuation lines, or the maximum of 132 characters per line? Here fill_coefficients
should really be PURE
, which probably makes it impossible to read coeff
from a file once during runtime, and then store the result.
The file "main.f03":
PROGRAM main
USE coefficients
IMPLICIT NONE
REAL(dp), ALLOCATABLE, DIMENSION(:,:) :: matrix
CALL fill_coefficients(matrix,2)
PRINT *, "The first row of 'matrix':"
PRINT *, matrix(1,:)
END PROGRAM main
The file "coefficients.f03":
MODULE coefficients
USE iso_fortran_env
IMPLICIT NONE
INTEGER, PARAMETER :: dp = REAL64
CONTAINS
PURE SUBROUTINE fill_coefficients(my_coefficients, n)
IMPLICIT NONE
REAL(dp), ALLOCATABLE, DIMENSION(:,:), INTENT(OUT) :: my_coefficients
INTEGER, INTENT(IN) :: n
! The size of the following array would be roughly 200 x 200 = 40.000.
REAL(dp), DIMENSION(3,3), PARAMETER :: coeff = &
RESHAPE ( &
[ + 10.6770782520313112108115239655957106_dp, &
- 854.166260162504896864921917247656850_dp, &
- 85.4166260162504896864921917247656850_dp, &
+ 16250.5130995916556628551394756366716_dp, &
+ 6747.91345528378868523288314625648912_dp, &
+ 106.770782520313112108115239655957106_dp, &
- 123256.191341449456617608232658836883_dp, &
- 8328.12103658442274443298869316465429_dp, &
+ 500381.272281447399894682070647642979_dp ], &
[3,3] )
IF (ALLOCATED(my_coefficients)) DEALLOCATE(my_coefficients)
ALLOCATE(my_coefficients(n,n))
my_coefficients = coeff(1:n,1:n)
END SUBROUTINE fill_coefficients
END MODULE coefficients
The output:
The first row of 'matrix':
10.677078252031311 16250.513099591655
回答1:
From a maintenance perspective (and as perhaps suggested in the comments), I would read the data into a module variable in a separate non-pure subroutine that is called once at program start-up. fill_coefficients
then becomes a simple assignment from that module variable and can still be PURE.
MODULE coefficients
IMPLICIT NONE
...
! Could be PUBLIC, PROTECTED, then you could directly
! assign from it and dispense with fill_coefficients
! altogether.
REAL(dp), PRIVATE :: coeff(200,200)
CONTAINS
SUBROUTINE init
INTEGER :: unit
OPEN( NEWUNIT=unit, &
FILE='lots-of-numbers.bin', &
FORM='UNFORMATTED', &
! ACCESS='STREAM', & ! Maybe - depending on how you write it.
STATUS='OLD' )
READ (unit) coeff
CLOSE(unit)
END SUBROUTINE init
PURE SUBROUTINE fill_coefficients(my_coefficients, n)
! implicit none already in force due to the statement in
! the specification part of the host module.
! IMPLICIT NONE
REAL(dp), ALLOCATABLE, DIMENSION(:,:), INTENT(OUT) :: my_coefficients
INTEGER, INTENT(IN) :: n
! This test is redundant - my_coefficients is INTENT(OUT) so
! it must be not allocated at this point.
! IF (ALLOCATED(my_coefficients)) DEALLOCATE(my_coefficients)
! This allocate statement is redundant - allocation will
! happen automatically under F2003 with the assignment.
! ALLOCATE(my_coefficients(n,n))
my_coefficients = coeff(1:n,1:n)
END SUBROUTINE fill_coefficients
END MODULE coefficients
If you must have coeff
as a compile time parameter, then assemble it in source manageable chunks - perhaps column by column. Your limits per declaration are line length (132) and number of continuation lines (255).
REAL(dp), PARAMETER :: column_1(200) = [ &
+ 10.6770782520313112108115239655957106_dp, &
- 854.166260162504896864921917247656850_dp, &
- 85.4166260162504896864921917247656850_dp, &
... ]
REAL(dp), PARAMETER :: column_2(200) = [ ... ]
...
REAL(dp), PARAMETER :: column_200(200) = [ ... ]
REAL(dp), PARAMETER :: coeff(200,200) = RESHAPE( [ &
column_1, column_2, ..., column_200 ], &
SHAPE=[200,200] )
Things declared with PARAMETER are named constants. Conceptually these only exist at compile time - depending on what you do with a named constant the compiler may or may not set aside storage in the executable image for the constants.
Large named constants may result in the compiler having issues compiling the file.
来源:https://stackoverflow.com/questions/35412655/how-to-initialize-a-large-array-in-fortran