CODEWITHSUNDEEP
fortransubroutine
user8456254
user8456254

Reputation:

Transfer array from Fortran subprogram to main program

I have a subroutine that opens and reads a file. The final result is an array that contains the data from the input file in a re-organized fashion. I want to call the subroutine in the main program to use the aforementioned array.

The subroutine has all the variables necessary for it to run as a separate program declared in its file. I'm new using Fortran so I'm not sure how to correctly employ subroutines. Do I need to assign any formal variables to subroutine's first line, or should I have an empty set of parenthesis?

The subroutine is in a file (subroutine.f03) that's separate from the main program's file (main.f03).

Main program code:

PROGRAM main
IMPLICIT NONE

CALL readBasis
WRITE(*,*) basis(1,1)

END PROGRAM

Subroutine code:

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

Upvotes: 0

Views: 220

Answers (1)

FooAnon
FooAnon

Reputation: 574

A subroutine has "dummy variables" identified in the parenthesis at its inception. These can be input or output arguements of mixed data types, i.e. a mixture of integers, integer arrays, reals ,etc.. Each dummy variable must have a data type assigned to in the variable declarations section of the subroutine, before any procedural statements. It is good practice, IMO, to use the intent modifier to ensure clarity between input and output varaibles. Varaibles that exist locally in the subroutine and are not explicitly input or ouput do not need to be in the parens but do do need to be declared, unless they have an implicit data type. Here is an example:

subroutine MEGA_SUBROUTINE(X,Y,Z,OUTPUT_ARRAY)
   implicit none
   real, intent(in):: X,Y,Z
   real:: local_var
   real, intent(out):: OUTPUT_ARRAY
! begin procedural section
! do stuff with your variables here, assign a value to output array
end subroutine MEGA_SUBROUTINE

Upvotes: 0

Related Questions