I need some technical help in modifying my FORTRAN coding. I have searched the Internet but I can't fine one which can solve my need.
Basically I am analyzing simulation data using FORTRAN program. Firstly, I shall explain the format of my data to make easy the understanding of what I want. I have 10 files. Each file contains x, y z, data for 1000 frames and each frame contains 20736 (x,y,z) data. Since the total size of all data is about 10 GB for all 10,000 frames, I have to break them into small chunks (10 files) to avoid any crash during calculation. At the beginning of each file (first line) there is a text which can be neglected and each frame ending with information of the box size (bx,by,bz). This is the format of my data files.
I have attached the coding which I have been using for analysis.
The current codding will do calculation file after file and frame after frame in the sequential order. But now I want to do the calculation on selected frames only by jumping frame after frame with certain pattern. For example, I choose frame 1, 4, 8, 12, 16.... and so on until the last frame (10,000).
I have no idea how to choose the frames which are more then 1000 which fall in the second or third files.
I have shown my code below:
module all_parameter
integer,parameter :: MAXATOM=20736
integer,parameter :: nat = 20736
integer, parameter :: startFiles=31
integer, parameter :: endFiles=40
integer,parameter :: NO_OF_FILES=10
integer,parameter :: FRAMES_IN=1000
integer, parameter :: totalFrames = ( NO_OF_FILES * FRAMES_IN )
integer :: i, j, k, IFram, nhb, nlipid, jjj
integer :: BIN, iat, jat
!real :: DELR, fnid, GNRM, RCUT, rlower, rupper
real :: junk, dR, bx, by, bz, bbx
real :: only_head, only_tail, only_water
real :: mass_head, mass_tail, mass_water
character*4 at(MAXATOM)
real,dimension(MAXATOM) :: x, y, z
real,dimension(3) :: rcm
real,dimension(MAXATOM) :: rx, ry, rz
real,dimension(MAXATOM) :: mass
integer, parameter :: startlipid=1
integer, parameter :: endlipid=64
integer, parameter :: lipidNo=64
real, parameter :: PI = (22.0/7.0)
real, dimension(startlipid:endlipid) :: array_UniVekLx, array_UniVekLy, array_UniVekLz
integer :: no, no2, c71, c72, c80, c81
real :: p1x, p1y, p1z, p2x, p2y, p2z, vekx, veky, vekz
real :: mag_vekp1p2, unit_vekx, unit_veky, unit_vekz
real :: sum_UniVekLx, sum_UniVekLy, sum_UniVekLz
real :: avg_frame_vekx, avg_frame_veky, avg_frame_vekz
real :: xx, yy, zz, frame_MagLipVek, theta,theta2, uni_frame_Vekx, uni_frame_Veky, uni_frame_Vekz
real :: xxx, yyy, zzz,UniVekLx, UniVekLy, UniVekLz, FrameAvgUniVekMag
real :: avg_UniVekLx, avg_UniVekLy,avg_UniVekLz, MagLipVek
end module all_parameter
PROGRAM order_parameter
use all_parameter
implicit none
!=========================================================================
! Open files to be read and to write on
!=========================================================================
!
! Topology file !CHANGE
open(unit=31,status="old",file="../malto_thermoNEW_Ori_50ns-set1.traj ")
open(unit=32,status="old",file="../malto_thermoNEW_Ori_50ns-set2.traj ")
open(unit=33,status="old",file="../malto_thermoNEW_Ori_50ns-set3.traj ")
open(unit=34,status="old",file="../malto_thermoNEW_Ori_50ns-set4.traj ")
open(unit=35,status="old",file="../malto_thermoNEW_Ori_50ns-set5.traj ")
open(unit=36,status="old",file="../malto_thermoNEW_Ori_50ns-set6.traj ")
open(unit=37,status="old",file="../malto_thermoNEW_Ori_50ns-set7.traj ")
open(unit=38,status="old",file="../malto_thermoNEW_Ori_50ns-set8.traj ")
open(unit=39,status="old",file="../malto_thermoNEW_Ori_50ns-set9.traj ")
open(unit=40,status="old",file="../malto_thermoNEW_Ori_50ns-set10.traj ")
! Open New Files
open(unit=51,status="unknown",file="BOXinfo.dat ")
open(unit=75,status="unknown",file="magnitude_theta_lipid-thermo-malto.dat")
do k = startlipid, endlipid
array_UniVekLx(k) =0.0
array_UniVekLy(k) =0.0
array_UniVekLz(k) =0.0
end do
! READ COORDINATES IN FRAMES FROM TRAJ file
INPUTFILES: do jjj = startFiles, endFiles
! LOOP OVER FRAMES
IFram = 1
read(jjj,'(a)') junk
!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
!IFram = 1
WHOLE: do while ( IFram <= FRAMES_IN)
read(jjj,'(10F8.3)') (x(i),y(i),z(i),i = 1,nat) ! reading TRAJ file
read(jjj,'(3F8.3)') bx,by,bz
write(51,'(a,3F8.3)') 'BOXINFO', bx,by,bz
! LOOP OVER ATOMS
loop1: do j = startlipid, endlipid !nat in lipids
loop2: do i = 45, 45 !,3 !atoms in a lipid
no= i + (j-1)*81
!no2= (no + 18)
c71=no
c72=(no+3)
p1x=((x(c71) + x(c72))/2.0 )
p1y=((y(c71) + y(c72))/2.0 )
p1z=((z(c71) + z(c72))/2.0 )
.
.
.
.
enddo loop2 ! going to next lipid
!CLOSE LOOP OVER ATOMS
enddo loop1 ! going to next frame , before that
!CLOSE LOOP OVER A FRAME
IFram = IFram + 1
enddo WHOLE
!CLOSE LOOP OVER ALL FILES
enddo INPUTFILES
end program order_parameter
I really appreciate your help in advance.
Thanks.
Well, in the loop, unless mod(framenumber, 4) == 0 skip to the next iteration (the CYCLE statement does that in Fortran). That way, you'll process only every fourth frame.
Also, you way want to use a somewhat more precise value for PI. 22/7, WTF?
Obviously the program needs to know which file it is reading, 1, 2... 10. Call that ifile. Then the frame with the file, say frame_in_file. Then you have frame = (ifile-1) * frame_in_file. Do you have a rule to decide whether you want to process "frame"? If the rule is to process every fourth, use mod and cycle as suggested #janneb. Otherwise, I'm not sure what you are asking.
With ten files, it would be easier to write the filename to a string and process them with a loop, opening each file in turn with the same unit number and closing at the end of the loop. This would be a little easier if you used the convention that the number in the file name was always two digits, with a leading zero if less than 10:
do ifile=1, 10
write (filename, '( "myfile_number", I2.2, ".data" )' ) ifile
open (unit=30, file=filename, ...)
loop: read from the file...
calculate overall frame number ...
cycle out of read loop if unsuitable frame...
process the frame...
end read loop
close (unit=30)
end do
Related
Making it short, my code is supposed to return a txt with my intensity values, instead, for all rs but 0, my intensity returns a value of +infinity. Don't know where my mistake is. This exercise is supposed to make us practice integration via Simpson's 1/3 method. All Bessels Jx txt values are working fine, the only problem relies within my intensity file. First code block is responsible for creating and filling Bessel Jx values in a txt file. Second part is responsible for creating and filling intensity values through a Bessel function (this is where the error is supposed to be, but i'm not sure). Third and fourth blocks are the Simpson 1/3 method and my Bessel function, respectively.
program intensidade
implicit none
real,parameter::pi=acos(-1.),lambda=500e-9
real::k,r,kr,intensidade1
real,external::bessel,simpson13
real::i
integer::j
open(0,file='besselj0.txt')
open(1,file='besselj1.txt')
open(2,file='besselj2.txt')
open(3,file='intensidade.txt')
do j=0,2
i=0
do while (i<=20)
write(j,*)i,simpson13(bessel,j,i,0.,pi)
i=i+1
enddo
enddo
close(0);
close(1);
close(2);
r=0
k=2*pi/lambda
kr=k*r*10e-6
do while (r<=1)
if(r==0) then
write(3,*)r,(1/2)**2
else
write(3,*)r,(simpson13(bessel,1,kr,0.,pi)/kr)**2
endif
r=r+0.1
enddo
close(3)
pause
end program intensidade
real function simpson13(funcao,m,x,a,b)
implicit none
real,external::funcao
real,intent(in)::a,b,x
integer,intent(in)::m
integer::i
real::h
h=(b-a)/1000
simpson13=funcao(m,x,a)-funcao(m,x,b)
do i=1,499
simpson13=simpson13+4*funcao(m,x,a+h*(2*i-1))+2*funcao(m,x,a+2*h*i)
enddo
simpson13=(h/3)*simpson13
end function simpson13
real function bessel(m,x,teta)
implicit none
real,parameter::pi=acos(-1.)
real,intent(in)::x,teta
integer,intent(in)::m
bessel=cos(m*teta-x*sin(teta))/pi
end function bessel
The main error arises because kr is not redefined in each loop.
Other improvements
style: align and indent your code
use file units provided by the system, i.e. open (newunit=...)
remove the pause command
Furthermore, your line write(..)r,(1/2)**2 uses integer arithmetic s.t. 1/2 yields zero and (1/2)**2 is zero as well.
The following is a possible way to rewrite your program
program intensidade
implicit none
real, parameter :: pi=acos(-1.0), lambda=500e-9
real :: k, r, kr
real, external :: bessel, simpson13
integer :: ir, funit, ix, m
character(128) :: fname
do m = 0, 2
write (fname, "(A7, I1, A4)") 'besselj', m, '.txt'
open (newunit=funit, file=fname)
do ix = 0, 20
write (funit, *) ix, simpson13(bessel, m, real(ix), 0.0, pi)
end do
close (funit)
end do
open (newunit=funit, file='intensidade.txt')
r = 0
k = 2*pi/lambda
write (funit, *) r, (0.5)**2
do ir = 1, 10
r = ir/10.0
kr = k*r*10e-6
write (funit, *) r, (simpson13(bessel, 1, kr, 0.0, pi)/kr)**2
end do
close (funit)
end program
this is the program. and I got an error why?
''''code'''''
I don't know why the whole doesn't appear, I tried to determine the area and volume for a random number.
----------------why-------------
'''Fortran
'program exercise2'
!
integer :: N,i
type :: Values
double precision :: radius,area,volume
end type
!
!
type(Values),allocatable, dimension(:) :: s
integer :: bi
!
!Read the data to create the random number
write(6,*) 'write your number '
read(5,*) N
allocate(s(N))
bi = 3.14
!create the random number
call random_seed()
do i=1,N
call random_number(s(i)%radius)
s(i)%area=areacircle(s(i)%radius)
s(i)%volume=volumesphere(s(i)%radius)
end do
!
open(15,file='radius.out',status='new')
write(15,*) s(i)%radius
open(16,file='output2.out',status='new')
r = real(s(i)%radius)
!Two function
contains
double precision function areacircle (s)
implicit none
double precision :: s
do i=1 , N
areacircle=bi*r**2
end do
return
end function areacircle
!
!
double precision function volumesphere (s)
implicit none
double precision :: s
do i=1,N
volumesphere=4/3*bi*r**3
end do
return
write(16,*) r , areacircle , volumesphere
end function volumesphere
'end program exercise2'
'''''''
so anyone know why?
This likely does what you want. As the computation of area and volume involve a single input that does not change, I've changed your functions to be elemental. This allows an array argument where the function is executed for each element of the array. I also changed double precision to use Fortran kind type parameter mechanism, because typing is real(dp) is much shorter.
Finally, never write a Fortran program without the implicit none statement.
program exercise2
implicit none ! Never write a program without this statement
integer, parameter :: dp = kind(1.d0) ! kind type parameter
integer n, i
type values
real(dp) radius, area, volume
end type
type(values), allocatable :: s(:)
real(dp) bi ! integer :: bi?
! Read the data to create the random number
write(6,*) 'write your number '
read(5,*) n
! Validate n is validate.
if (n < 1) stop 'Invalid number'
allocate(s(n))
bi = 4 * atan(1.d0) ! bi = 3.14? correctly determine pi
call random_seed() ! Use default seeding
call random_number(s%radius) ! Fill radii with random numbers
s%area = areacircle(s%radius) ! Compute area
s%volume = volumesphere(s%radius) ! Compute volume
write(*,'(A)') ' Radii Area Volume'
do i = 1, n
write(*, '(3F9.5)') s(i)
end do
contains
elemental function areacircle(s) result(area)
real(dp) area
real(dp), intent(in) :: s
area = bi * s**2
end function areacircle
elemental function volumesphere(s) result(volume)
real(dp) volume
real(dp), intent(in) :: s
volume = (4 * bi / 3) * s**3
end function volumesphere
end program exercise2
I am struggling with reading a text string in. Am using gfortran 4.9.2.
Below I have written a little subroutine in which I would like to submit the write format as argument.
Ideally I'd like to be able to call it with
call printarray(mat1, "F8.3")
to print out a matrix mat1 in that format for example. The numbers of columns should be determined automatically inside the subroutine.
subroutine printarray(x, udf_temp)
implicit none
real, dimension(:,:), intent(in) :: x ! array to be printed
integer, dimension(2) :: dims ! array for shape of x
integer :: i, j
character(len=10) :: udf_temp ! user defined format, eg "F8.3, ...
character(len = :), allocatable :: udf ! trimmed udf_temp
character(len = 10) :: udf2
character(len = 10) :: txt1, txt2
integer :: ncols ! no. of columns of array
integer :: udf_temp_length
udf_temp_length = len_trim(udf_temp)
allocate(character(len=udf_temp_length) :: udf)
dims = shape(x)
ncols = dims(2)
write (txt1, '(I5)') ncols
udf2 = trim(txt1)//adjustl(udf)
txt2 = "("//trim(udf2)//")"
do i = 1, dims(1)
write (*, txt2) (x(i, j), j = 1, dims(2)) ! this is line 38
end do
end suroutine printarray
when I set len = 10:
character(len=10) :: udf_temp
I get compile error:
call printarray(mat1, "F8.3")
1
Warning: Character length of actual argument shorter than of dummy argument 'udf_temp' (4/10) at (1)
When I set len = *
character(len=*) :: udf_temp
it compiles but at runtime:
At line 38 of file where2.f95 (unit = 6, file = 'stdout')
Fortran runtime error: Unexpected element '( 8
What am I doing wrong?
Is there a neater way to do this?
Here's a summary of your question that I will try to address: You want to have a subroutine that will print a specified two-dimensional array with a specified format, such that each row is printed on a single line. For example, assume we have the real array:
real, dimension(2,8) :: x
x = reshape([1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16], shape=[2,8], order=[2,1])
! Then the array is:
! 1.000 2.000 3.000 4.000 5.000 6.000 7.000 8.000
! 9.000 10.000 11.000 12.000 13.000 14.000 15.000 16.000
We want to use the format "F8.3", which prints floating point values (reals) with a field width of 8 and 3 decimal places.
Now, you are making a couple of mistakes when creating the format within your subroutine. First, you try to use udf to create the udf2 string. This is a problem because although you have allocated the size of udf, nothing has been assigned to it (pointed out in a comment by #francescalus). Thus, you see the error message you reported: Fortran runtime error: Unexpected element '( 8.
In the following, I make a couple of simplifying changes and demonstrate a few (slightly) different techniques. As shown, I suggest the use of * to indicate that the format can be applied an unlimited number of times, until all elements of the output list have been visited. Of course, explicitly stating the number of times to apply the format (ie, "(8F8.3)" instead of "(*(F8.3))") is fine, but the latter is slightly less work.
program main
implicit none
real, dimension(2,8) :: x
character(len=:), allocatable :: udf_in
x = reshape([1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16], shape=[2,8], order=[2,1])
udf_in = "F8.3"
call printarray(x, udf_in)
contains
subroutine printarray(x, udf_in)
implicit none
real, dimension(:,:), intent(in) :: x
character(len=*), intent(in) :: udf_in
integer :: ncols ! size(x,dim=2)
character(len=10) :: ncols_str ! ncols, stringified
integer, dimension(2) :: dims ! shape of x
character(len=:), allocatable :: udf0, udf1 ! format codes
integer :: i, j ! index counters
dims = shape(x) ! or just use: ncols = size(x, dim=2)
ncols = dims(2)
write (ncols_str, '(i0)') ncols ! use 'i0' for min. size
udf0 = "(" // ncols_str // udf_in // ")" ! create string: "(8F8.3)"
udf1 = "(*(" // udf_in // "))" ! create string: "(*(F8.3))"
print *, "Version 1:"
do i = 1, dims(1)
write (*, udf0) (x(i, j), j = 1,ncols) ! implied do-loop over j.
end do
print *, "Version 2:"
do i = 1, dims(1)
! udf1: "(*(F8.3))"
write (*, udf1) (x(i, j), j = 1,ncols) ! implied do-loop over j
end do
print *, "Version 3:"
do i = 1, size(x,dim=1) ! no need to create nrows/ncols vars.
write(*, udf1) x(i,:) ! let the compiler handle the extents.
enddo
end subroutine printarray
end program main
Observe: the final do-loop ("Version 3") is very simple. It does not need an explicit count of ncols because the * takes care of it automatically. Due to its simplicity, there is really no need for a subroutine at all.
besides the actual error (not using the input argument), this whole thing can be done much more simply:
subroutine printarray(m,f)
implicit none
character(len=*)f
real m(:,:)
character*10 n
write(n,'(i0)')size(m(1,:))
write(*,'('//n//f//')')transpose(m)
end subroutine
end
note no need for the loop constructs as fortran will automatically write the whole array , line wrapping as you reach the length of data specified by your format.
alternately you can use a loop construct, then you can use a '*' repeat count in the format and obviate the need for the internal write to construct the format string.
subroutine printarray(m,f)
implicit none
character(len=*)f
real m(:,:)
integer :: i
do i=1,size(m(:,1))
write(*,'(*('//f//'))')m(i,:)
enddo
end subroutine
end
so reading the following question (Correct use of FORTRAN INTENT() for large arrays) I learned that defining a variable with intent(in) isn't enough, since when the variable is passed to another subroutine/function, it can be changed again. So how can I avoid this? In the original thread they talked about putting the subroutine into a module, but that doesn't help for me. For example I want to calculate the determinant of a matrix with a LU-factorization. Therefore I use the Lapack function zgetrf, but however this function alters my input matrix and the compiler don't displays any warnings. So what can I do?
module matHelper
implicit none
contains
subroutine initMat(AA)
real*8 :: u
double complex, dimension(:,:), intent(inout) :: AA
integer :: row, col, counter
counter = 1
do row=1,size(AA,1)
do col=1,size(AA,2)
AA(row,col)=cmplx(counter ,0)
counter=counter+1
end do
end do
end subroutine initMat
!subroutine to write a Matrix to file
!Input: AA - double complex matrix
! fid - integer file id
! fname - file name
! stat - integer status =replace[0] or old[1]
subroutine writeMat(AA,fid, fname, stat)
integer :: fid, stat
character(len=*) :: fname
double complex, dimension(:,:), intent(in) :: AA
integer :: row, col
character (len=64) :: fmtString
!opening file with given options
if(fid /= 0) then
if(stat == 0) then
open(unit=fid, file=fname, status='replace', &
action='write')
else if(stat ==1) then
open(unit=fid, file=fname, status='old', &
action='write')
else
print*, 'Error while trying to open file with Id', fid
return
end if
end if
!initializing matrix print format
write(fmtString,'(I0)') size(aa,2)
fmtString = '('// trim(fmtString) //'("{",ES10.3, ",", 1X, ES10.3,"}",:,1X))'
!write(*,*) fmtString
!writing matrix to file by iterating through each row
do row=1,size(aa,1)
write(fid,fmt = fmtString) AA(row,:)
enddo
write(fid,*) ''
end subroutine writeMat
!function to calculate the determinant of the input
!Input: AA - double complex matrix
!Output determinantMat - double complex,
! 0 if AA not a square matrix
function determinantMat(AA)
double complex, dimension(:,:), intent(in) :: AA
double complex :: determinantMat
integer, dimension(min(size(AA,1),size(AA,2)))&
:: ipiv
integer :: ii, info
!check if not square matrix, then set determinant to 0
if(size(AA,1)/= size(AA,2)) then
determinantMat = 0
return
end if
!compute LU facotirzation with LAPACK function
call zgetrf(size(AA,1),size(AA,2), AA,size(AA,1), ipiv,info)
if(info /= 0) then
determinantMat = cmplx(0.D0, 0.D0)
return
end if
determinantMat = cmplx(1.D0, 0.D0)
!determinant of triangular matrix is product of diagonal elements
do ii=1,size(AA,1)
if(ipiv(ii) /= ii) then
!a permutation was done, so a factor of -1
determinantMat = -determinantMat *AA(ii,ii)
else
!no permutation, so no -1
determinantMat = determinantMat*AA(ii,ii)
end if
end do
end function determinantMat
end module matHelper
!***********************************************************************
!module which stores matrix elements, dimension, trace, determinant
program test
use matHelper
implicit none
double complex, dimension(:,:), allocatable :: AA, BB
integer :: n, fid
fid = 0;
allocate(AA(3,3))
call initMat(AA)
call writeMat(AA,0,' ', 0)
print*, 'Determinante: ',determinantMat(AA) !changes AA
call writeMat(AA,0, ' ', 0)
end program test
PS: I am using the ifort compiler v15.0.3 20150407
I do not have ifort at home, but you may want to try compiling with '-check interfaces' and maybe with '-ipo'. You may need the path to 'zgetrf' for the '-check interfaces' to work, and if that is not source then it may not help.
If you declare 'function determinantMat' as 'PURE FUNCTION determinantMat' then I am pretty sure it would complain because 'zgetrf' is not known to be PURE nor ELEMENTAL. Try ^this stuff^ first.
If LAPACK has a module, then zgetrf could be known to be, or not be, PURE/ELEMENTAL. https://software.intel.com/en-us/articles/blas-and-lapack-fortran95-mod-files
I would suggest you add to your compile line:
-check interfaces -ipo
During initial build I like (Take it out for speed once it works):
-check all -warn all
Making a temporary array is one way around it. (I have not compiled this, so it is only a conceptual exemplar.)
PURE FUNCTION determinantMat(AA)
USE LAPACK95 !--New Line--!
IMPLICIT NONE !--New Line--!
double complex, dimension(:,:) , intent(IN ) :: AA
double complex :: determinantMat !<- output
!--internals--
integer, dimension(min(size(AA,1),size(AA,2))) :: ipiv
!!--Next line is new--
double complex, dimension(size(AA,1),size(AA,2)) :: AA_Temp !!<- I have no idea if this will work, you may need an allocatable??
integer :: ii, info
!check if not square matrix, then set determinant to 0
if(size(AA,1)/= size(AA,2)) then
determinantMat = 0
return
end if
!compute LU factorization with LAPACK function
!!--Next line is new--
AA_Temp = AA !--Initialise AA_Temp to be the same as AA--!
call zgetrf(size(AA_temp,1),size(AA_Temp,2), AA_Temp,size(AA_Temp,1), ipiv,info)
if(info /= 0) then
determinantMat = cmplx(0.D0, 0.D0)
return
end if
determinantMat = cmplx(1.D0, 0.D0)
!determinant of triangular matrix is product of diagonal elements
do ii=1,size(AA_Temp,1)
if(ipiv(ii) /= ii) then
!a permutation was done, so a factor of -1
determinantMat = -determinantMat *AA_Temp(ii,ii)
else
!no permutation, so no -1
determinantMat = determinantMat*AA_Temp(ii,ii)
end if
end do
end function determinantMat
With the 'USE LAPACK95' you probably do not need PURE, but if you wanted it to be PURE then you want to explicitly say so.
I'm using a subroutine to output an array gathered from a previous function. After running my program and only calling the subroutine once, my intended file name, testf.txt, is given as "testf.txtÑ #." Thinking it was a hidden character generated by a portion I borrowed from a friend, I retyped the whole section but nothing changed. When I do multiple calls, the names of the the files add onto one another. Intended, "testf.txt" "testg.txt" "testh.txt", given, "testf.txttestg" "testg.txttesth" and "testh.txt". The content is fine, the name being the only issue. Would that be caused by hidden characters in the code, or a logic error in how the subroutine hold information?
Thanks,
Thomas
Main Program
program Main
implicit none
!DATA DICTIONARY
character :: selection ! Method of summation
! L = left Riemann sum
! R = right Riemann sum
! M = Midpoint rule
! T = Trapezoidal rule sum
! S = Simpson's rule
integer :: n ! Number of subintervals the integral is to
! be divided into
integer :: func ! The function to be integrated
! f = (28.0/5) + 2*sin(4*x) - (1/x)
! g = ln(4x) + (19x)^3 - 43
! h = 1/(sqrt(2.0*PI))*exp(-(x**2)/2.0)
character(20) :: filename
real, external :: f
real, external :: g
real, external :: h
real, dimension(1000) :: area
!Declare functions used
real :: Quad
write(*,*) "Written in the form ",
+ "Quad(func, n, left, right, selection):"
write(*,*) " "
!Test Drivers
write(*, *) Quad(f, 10, 0.2, 3.2, 'T', area)
call Out(10, area, 'testf.txt')
write(*, *) Quad(g, 10, 5.0, 10.0, 'L', area)
call Out(10, area, 'testg.txt')
write(*, *) Quad(h, 25, 1.0, 10.0, 'L', area)
call Out(10, area, 'testh.txt')
end program Main
Actual Out subroutine
subroutine Out(n, area, filename)
!PRE: n > 0
! area is the initialized array area(1...n)
! filename is initialized
implicit none
integer, intent(in) :: n
real, dimension(n), intent(in) :: area
character(20), intent(in) :: filename
integer :: i
open(unit=1, file=filename, form='formatted', !Writes area(1...n) to a file
+ action='write', status='replace')
do i = 1, n, 1
write(1,*) area(i)
end do
close(unit=1)
end subroutine Out
This sort of error is normally an indication of one or more of:
Array overruns - i.e. if your data is in an array of size 10 followed by your filen ame in memory and you write to array element 11 it will corrupt the file name.
Array under run - similar to the above but at the start of the array
Parameter corruption - if the text for the file name is passed as a read write parameter then it can be overwritten in the code.
You can often sort out this sort of issue by a) turn on all compiler error checking and fix all the warnings and/or b running the code through a lint equivalent such as ftnchek and fixing the issues it finds.