【发布时间】:2018-01-21 03:42:27
【问题描述】:
我有一个打开和读取文件的子程序。最终结果是一个数组,其中包含以重新组织方式输入文件中的数据。我想在主程序中调用子程序来使用上述数组。
子例程具有所有必要的变量,可以作为在其文件中声明的单独程序运行。我是使用 Fortran 的新手,所以我不确定如何正确使用子例程。我是否需要将任何形式变量分配给子程序的第一行,还是应该有一组空括号?
子程序位于与主程序文件 (main.f03) 分开的文件 (subroutine.f03) 中。
主程序代码:
PROGRAM main
IMPLICIT NONE
CALL readBasis
WRITE(*,*) basis(1,1)
END PROGRAM
子程序代码:
SUBROUTINE readBasis()
IMPLICIT NONE
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!! io_open = IOSTATUS FOR OPENING THE BASIS FILE !!
!! io_red = IOSTATUS FOR READING THE BASIS FILE !!
!! atom_num = NUMBER ASSIGNED TO A PARTICULAR ATOM IN THE BASIS FILE !!
!! end_of_line = 0, DEFAULT BASIS SET INPUT FORMAT !!
!! end_of_line_1 = 0.00 DEFAULT BASIS SET INPUT FORMAT !!
!! atom_end = **** INDICATES THE END OF THE BASIS SET INFO FOR A GIVEN ATOM !!
!! primitives = NUMBER OF PRIMITIVES IN A CONTRACTION !!
!! basis_type = ANGULAR MOMENTUM ASSOCIATED WITH A CONTRACTION !!
!! expo = GAUSSIAN PRIMITIVE EXPONENT !!
!! coeff = CONTRACTION COEFFICIENT FOR AN S, P, D PRIMITIVE RESPECTIVELY IN A S, P, D SHELL !!
!! s_coeff & p_coeff = CONTRACTION COEFFICIENTS FOR S AND P PRIMITIVES IN AN SP SHELL !!
!! basis = ARRAY CONTAINING ALL OF THE BASIS SET INFORMATION. THE FORMAT IS GIVEN BELLOW: !!
!! BASIS NUMBER | PRIMITIVE TYPE | EXPONENT | S COEFF | P COEFF | D COEFF | X COORDS | Y COORDS | Z COORDS !!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
INTEGER :: i, io_open, io_read, atom_num, end_of_line, primitives, gauss_i, gauss_f
INTEGER :: total_basis_functions, total_primitives, primitive_counter, primitive_num
INTEGER :: func_start, func_end, func_counter
CHARACTER (LEN=4) :: basis_type, atom_end
REAL :: scaling, end_of_line_1
REAL :: expo, coeff, s_coeff, p_coeff
REAL, ALLOCATABLE :: basis(:,:)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!! atom_loop WILL LET YOU READ THE BASIS FUNCTIONS FOR EVERY ATOM !!
!! contraction_loop WILL LET YOU READ EACH BASIS FUNCTION PER ATOM !!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
OPEN(UNIT=10, FILE="BASIS", STATUS="OLD", ACTION="READ", IOSTAT=io_open)
READ(10,*) total_basis_functions
READ(10,*) total_primitives
ALLOCATE(basis(total_primitives,6))
READ(10,*,IOSTAT=io_read) atom_num, end_of_line
READ(10,*) basis_type, primitives, scaling, end_of_line_1, func_start, func_end
atom_end = basis_type
primitive_num = 1
atom_loop: DO WHILE (io_read .EQ. 0)
contraction_loop: DO WHILE (atom_end .NE. "****")
orbital_type_loop: IF (basis_type == "S ") THEN
DO func_counter = func_start, func_end
DO primitive_counter = 1, primitives
READ(10,*) expo, coeff
basis(primitive_num,1) = REAL(func_counter)
basis(primitive_num,2) = REAL(0)
basis(primitive_num,3) = expo
basis(primitive_num,4) = coeff
basis(primitive_num,5) = REAL(0)
basis(primitive_num,6) = REAL(0)
primitive_num = primitive_num + 1
END DO
IF (func_counter .LT. func_end) THEN
DO primitive_counter = 1, primitives
BACKSPACE(10)
END DO
ELSE
CONTINUE
END IF
END DO
ELSE IF (basis_type .EQ. "P ") THEN
DO func_counter = func_start, func_end
DO primitive_counter = 1, primitives
READ(10,*) expo, coeff
basis(primitive_num,1) = REAL(func_counter)
basis(primitive_num,2) = REAL(1)
basis(primitive_num,3) = expo
basis(primitive_num,4) = REAL(0)
basis(primitive_num,5) = coeff
basis(primitive_num,6) = REAL(0)
primitive_num = primitive_num + 1
END DO
IF (func_counter .LT. func_end) THEN
DO primitive_counter = 1, primitives
BACKSPACE(10)
END DO
ELSE
CONTINUE
END IF
END DO
ELSE IF (basis_type == "D ") THEN
DO func_counter = func_start, func_end
DO primitive_counter = 1, primitives
READ(10,*) expo, coeff
basis(primitive_num, 1) = REAL(func_counter)
basis(primitive_num,2) = REAL(2)
basis(primitive_num,3) = expo
basis(primitive_num,4) = REAL(0)
basis(primitive_num,5) = REAL(0)
basis(primitive_num,6) = coeff
primitive_num = primitive_num + 1
END DO
IF (func_counter .LT. func_end) THEN
DO primitive_counter = 1, primitives
BACKSPACE(10)
END DO
ELSE
CONTINUE
END IF
END DO
ELSE IF (basis_type .EQ. "SP ") THEN
DO func_counter = func_start, func_end
DO primitive_counter = 1, primitives
READ(10,*) expo, s_coeff, p_coeff
basis(primitive_num,1) = REAL(func_counter)
basis(primitive_num,2) = REAL(10)
basis(primitive_num,3) = expo
basis(primitive_num,4) = s_coeff
basis(primitive_num,5) = p_coeff
basis(primitive_num,6) = REAL(0)
primitive_num = primitive_num + 1
END DO
IF (func_counter .LT. func_end) THEN
DO primitive_counter = 1, primitives
BACKSPACE(10)
END DO
ELSE
CONTINUE
END IF
END DO
END IF orbital_type_loop
READ(10,*) atom_end
IF (atom_end .EQ. "****") THEN
READ(10,*,IOSTAT=io_read) atom_num, end_of_line
IF (io_read < 0) THEN
EXIT atom_loop
ELSE IF (io_read > 0) THEN
WRITE(*,*) "FILE COULD NOT BE READ."
EXIT atom_loop
ELSE
READ(10,*) basis_type, primitives, scaling, end_of_line_1, func_start, func_end
atom_end = basis_type
EXIT contraction_loop
END IF
ELSE
BACKSPACE(10)
READ(10,*) basis_type, primitives, scaling, end_of_line_1, func_start, func_end
END IF
END DO contraction_loop
END DO atom_loop
CLOSE(10)
RETURN
END SUBROUTINE
【问题讨论】:
-
欢迎。请使用Tour,阅读How to Ask 并向我们展示您的代码示例。我们可以看到的代码比冗长的描述更有用。
-
如果问题是“是否允许有一个不带参数的子程序”,那么答案是“是”。那是你的问题吗?但是请注意,子程序不会影响主程序的任何变量 - 特别是
basis未在主程序中声明,这将导致编译错误。 -
This question,虽然关于在函数和子例程之间传递,您需要了解很多关于在主程序和子例程之间传递的知识。
-
@francescalus,我想将数组基础从子程序传递给主程序。我已经使用了SAVE语句,但是调用子程序后我仍然无法在主程序中使用基础。感谢您的帮助。
-
通常且明显的解决方案是将基础作为参数传递。目前尚不清楚您是否知道这一点并正在寻找替代方案或什么。
标签: fortran subroutine