the next program has an error and I don't know which is the trouble with.
IMPLICIT NONE
DOUBLE PRECISION X(100),W(100),lambdainv,g,lambda,alfac
INTEGER i, N
N=100
alfac=939.D0*2.D22
CALL GAUSS_L(1.D0,100.D0,100,X,W)
lambdainv=0.D0
DO i=1,N
lambdainv=lambdainv+((W(i)*(X(i))**2)/(alfac+
> (X(i))**2))*g(X(i)))**2
END DO
lambda=lambdainv**(-1)
WRITE(*,*)'lambda=', lambda
STOP
END
c Funcion g
DOUBLE PRECISION FUNCTION g(X)
IMPLICIT NONE
DOUBLE PRECISION X, mu, pi
c Inicializamos las variables
mu=138.d0
pi=ATAN(1.D0)*4.D0
g=(2.d0*sqrt(mu**3))/((sqrt(pi))*(mu**2+X**2))
RETURN
END
The error is:
lambdainv=lambdainv+((W(i)*(X(i))**2)/(alfac+
1
Error: Unclassifiable statement at (1)
thanks!!
Your brackets are unbalanced in the corresponding line, when you take into account the continuation of that line!
Do you mean:
lambdainv=lambdainv+( W(i)*X(i)**2 / (alfac+
> X(i)**2)*g(X(i)))**2
(This is a wild guess, of course!)
Related
I am having 2 compiler errors on this function called kawa.
The first error is on the first line, saying
error 471 - Invalid item(s) in argument list
I think that I am supposed to write function kawa(dd,ee,owari2,r,t,ttt,s,at12) instead.
The second error is on the line
t(i)=0
saying invalid argument on the left
I tried the following:
t(i)=0.0 , but it still failed.
declare t as double precision in the main program.
function kawa(dd,ee,owari2,r(all),t(all),ttt(all),s(all),at12(all))
integer m,i
double precision denmin, denmax,sumgosa,alfa,sumgosa3
double precision w(250),nmax(250),ice(250),bata(250)
double precision sumw,sumr,fw,sumdp,batat,gosa,sumfw
double precision ttt(250)
double precision dp(250),den(250),k(250),n
denmin=dd
denmax=0.5
sumgosa=0
alfa=ee
do i=0, owari2,+1
w(i)=r(i)
if(t(i)<0) then
t(i)=0
else
ttt(i)=tttt(i)+2
endif
if(ttt(i)<0) then
ttt(i)=0
else
k(i)=((denmin+(denmax-denmin)*t(i)/3)/denmin)**2.0
nmax(i)=denmax*denmax/denmin/denmin-k(i)
ice(i)=r(i)
endif
if(at(i)>2)then
ice(i)=0
else
bata(i)=alfa*ttt(i)
end if
enddo
sumfw=0
sumr=0
do m=0, owari2,+1
fw=0
sumdp=0
sumw=0
sumr=0
i=m
batat=bata(i)
do i=m,0,-1
n=m-i
if(ice(i)-batat<=0) then
dp(i)=0
fw=w(i)+fw
w(i)=0
batat=batat-ice(i)
ice(i)=0
else if(n>nmax(i)) then
dp(i)=(ice(i)-batat)/denmax
else
dp(i)=(ice(i)-batat)/denmin*((k(i)+n)**0.5)
ice(i)=ice(i)-batat
batat=0
den(i)=(w(i)+fw)/dp(i)
w(i)=w(i)+fw
fw=0
endif
if(den(i)>denmax) then
den(i)=denmax
fw=w(i)-dp(i)*denmax
w(i)=dp(i)*denmax
endif
sumdp=sumdp+dp(i)
sumw=sumw+w(i)
sumr=sumr+r(i)
enddo
sumfw=sumfw+fw
i=m
if(s(i)==32767)then
gosa=0
goto 10
else
gosa=(sumdp-s(i))*(sumdp-s(i))
endif
enddo
10 sumgosa =sumgosa+gosa
kawa=sumgosa**0.5
end function kawa
So I'm getting an invalid float error that's causing my code to crash from the following subroutine. The subroutine sums together my distribution function over angle and energy (so I just have a distribution in radius), then I compute my average optical depth, and then I look for the radial zone where that optical depth crosses 2/3. The code is designed to be run over multiple time steps, and in this particular simulation it had run through 49 time steps and then crashed on the 50th, which is confusing me even more.
subroutine SAPass(state, step)
use state_vector_module
use boltztran_memory_module, only: fe, trmfpe
use boltztran_parameter_module
use units_module
implicit none
real, dimension(102) :: Fse
real, dimension(102,8) :: taue
real, dimension(102) :: Te
inetger :: cycsav = -1
integer :: nsze
call opdep(trmfpe, taue)
Fse = 0.
do i=1,102
do j=1,4
do k=1,8
Fse(i) = Fse(i) + fe(i,j,k)
end do
end do
end do
do i=1,102
do j=1,4
do k=1,8
if (Fse(i).eq.0.) then
Te(i) = 0.
else
Te(i) = Te(i) + (fe(i,j,k)*taue(i,k))/Fse(i)
end if
end do
end do
end do
write(*,*) Te !debug check to look for where the error is happening
nsze = 1
do i=1,101
if(Te(i).eq.(2./3.)) then ! This is the line the invalid float error is reported on.
nsze = i
else if((Te(i).gt.(2./3.)).and.(Te(i+1).lt.(2./3.))) then
nsze = i
end if
end do
if(step.eq.cycsav) then
continue
else
cycsav = istep
call tauwrite(taue,step,1)
open(17,name="NSZones.dat",status="unknown",position="append")
write(17,i5) nsze
close(17)
end if
On time step 50 the code crashes and I get the following error:
forrtl: error (65): floating invalid
And it references the specified line in the code. When I look at the print outs for Te during time step 50 the entry for i=4 is a 'NaN' and I can't figure out what in the code could be causing this to become a NaN. The distribution function numbers all look normal for that time step and zone.
You use
Fse(i).eq.0.
Te(i).eq.(2./3.)
It is a very bad idea to compare two floating point numbers for equality. You are probably dividing by an almost-zero in
Te(i) = Te(i) + (fe(i,j,k)*taue(i,k))/Fse(i)
and that results in an error.
It is impossible to say more, because we can't see what fe is and which values it has nor which values taue has.
I am trying to write a FORTRAN subroutine for ABAQUS that would modify the seepage coefficient and thus the flow depending on whether there is contact on the surface. In order to do so I need 2 subroutines URDFIL to retrieve the node data and FLOW to modify the seepage coefficient.
However, when I compile my subroutine I get the following errors:
flow_us.for(81): error #6837: The leftmost part-ref in a data-ref can not be a function reference. [K_ELE_DETAILS]
IF(K_ELE_DETAILS(E_INDX)%IS_CONT(N_INDX).EQ.0)THEN
----------^
flow_us.for(81): error #6158: The structure-name is invalid or is missing. [K_ELE_DETAILS]
IF(K_ELE_DETAILS(E_INDX)%IS_CONT(N_INDX).EQ.0)THEN
Obviously it is repeated for the 3 lines (if's) that contain such structure (81,8, and 89).
Please find the code below and hopefully someone will be able to help
****************************************************************************************
***SUBROUTINE FOR ADAPTIVE FLUID FLOW
****************************************************************************************
****************************************************************************************
**
**
**
*USER SUBROUTINE
SUBROUTINE URDFIL(LSTOP,LOVRWRT, KSTEP, KINC, DTIME, TIME)
INCLUDE 'ABA_PARAM.INC'
C
DIMENSION ARRAY(513),JRRAY(NPRECD,513),TIME(2)
EQUIVALENCE (ARRAY(1),JRRAY(1,1))
C DECLARATIONS
TYPE ELE_DATA
SEQUENCE
DOUBLE PRECISION :: NODE_COORD(9)
DOUBLE PRECISION :: OPP_NODE_COORD(9)
DOUBLE PRECISION :: IPT_COORD(9)
DOUBLE PRECISION :: POR(3)
DOUBLE PRECISION :: OPP_POR(3)
INTEGER :: ELE_NUM
INTEGER :: OPP_ELE_NUM
INTEGER :: NODE_NUM(3)
INTEGER :: OPP_NODE_NUM(3)
INTEGER :: IPT_NUM(3)
INTEGER :: OPP_IS_CONT(3)
END TYPE ELE_DATA
TYPE(ELE_DATA)::K_ELE_DETAILS(500)
COMMON K_ELE_DETAILS
PARAMETER (THRESHOLD_CSTRESS=1.0E-6)
*******************************************************
INTEGER :: NO_OF_NODES
INTEGER :: NO_OF_ELEMENTS
INTEGER :: NO_OF_DIM
COMMON NO_OF_DIM, NO_OF_NODES, NO_OF_ELEMENTS
********************************************************
C INITIALIZE
LSTOP=0
LOVRWRT=1
LOP=0
NO_OF_NODES=10000
NO_OF_ELEMENTS=10000
NO_OF_DIM=2
DO K1=1,999999
CALL DBFILE(0, ARRAY,JRCD)
IF (JCRD.NE.0) GO TO 110
KEY=JRRAY(1,2)
*******************************************************
C THE KEYS USED IN THE FOLLOWING LINES REFER
C TO INFORMATION ON THE SURFACE, NODES, CONTACT ETC
IF (KEY.EQ.1501) THEN
ELSE IF (KEY.EQ.1502)THEN
ELSE IF(KEY.EQ.1911) THEN
ELSE IF(KEY.EQ.108.AND.SURFACE_N_SET.EQ.'N_TOP') THEN
ELSE IF(KEY.EQ.107.AND.SURFACE_N_SET.EQ.'N_TOP') THEN
ELSE IF(KEY.EQ.1503)THEN
ELSE IF(KEY.EQ.1504.AND.K_NODE_SET.EQ.'N_TOP')THEN
ELSE IF(KEY.EQ.1511.AND.K_NODE_SET.EQ.'N_TOP')THEN
C IS THE NODE IN CONTACT?
120 CONTINUE
END IF
END DO
110 CONTINUE
RETURN
END
**********************************************************
**********************************************************
*USER SUBROUTINE
SUBROUTINE FLOW(H, SINK, KSTEP, KINC, TIME, NOEL, NPT, COORDS,
1 JLTYP,SNAME)
INCLUDE 'ABA_PARAM.INC'
C
DIMENSION TIME(2), COORDS(3)
CHARACTER*80 SNAME
MIN_DIST=10E-20
DO K25=1,NO_OF_ELEMENTS
DO K26=1,NO_OF_NODES
C FINDS THE CLOSEST NODE TO THE INTEGRATION POINT NPT
END DO
END DO
C NOT IN CONTACT
IF(K_ELE_DETAILS(E_INDX)%IS_CONT(N_INDX).EQ.0)THEN
IF(K_ELE_DETAILS(E_INDX)%POR(N_INDX).GE.0) THEN
SINK=0
H=0.001
ELSE
SINK=0
H=1
END IF
ELSE IF(K_ELE_DETAILS(E_INDX)%IS_CONT(N_INDX).EQ.1)THEN
C IF THERE IS CONTACT
SINK=0
H=0
END IF
RETURN
END
I think you meant to write
IF(K_ELE_DETAILS(E_INDX)%OPP_IS_CONT(N_INDX).EQ.0) THEN
instead of
IF(K_ELE_DETAILS(E_INDX)%IS_CONT(N_INDX).EQ.0)THEN
Also, if you intent to extend this code with type-bound procedures, you cannot reference a component of a function result of derived data type without an appropriate interface. Such issues are rarely encountered if the type declaration is confined to a module. The module will automatically generate the correct interface for type-bound procedures.
I was assigned the following problem:
Make a Fortran program which will be able to read a degree[0-360] checking validity range(not type) and it will be able to calculate and print the cos(x) from the following equation, where x is in radians:
cos(x)=1-x^2/2! + x^4/4!-x^6/6!+x^8/8!-...
As a convergence criteria assume 10^(-5) using the absolute error between two successive repeats (I suppose it means do's).
For the calculation of the ! the greatest possible kind of integer should be used. Finally the total number of repeats should be printed on screen.
So my code is this:
program ex6_pr2
implicit none
!Variables and Constants
integer::i
real*8::fact,fact2 !fact=factorial
real,parameter::pi=3.14159265
double precision::degree,radiants,cosradiants,s,oldcosradiants,difference !degree,radiants=angle
print*,'This program reads and calculates an angle`s co-sinus'
print*,'Please input the degrees of the angle'
read*,degree
do while(degree<0 .or. degree>360) !number range
read*,degree
print*,'Error input degree'
cycle
end do
radiants=(degree*pi/180)
fact=1
fact2=1
s=0
cosradiants=0
!repeat structure
do i=2,200,1
fact=fact*i
fact2=fact2*(i+2)
oldcosradiants=cosradiants
cosradiants=(-(radiants)**i/fact)+(((radiants)**(i+2))/fact2)
difference=cosradiants-oldcosradiants
s=s+cosradiants
if(abs(difference)<1e-5) exit
end do
!Printing results
print*,s+1.
end program
I get right results for angles such as 45 degrees (or pi/4) and wrong for other for example 90 degrees or 180.
I have checked my factorials where I believe the error is hidden (at least for me).
Well I created another code which seems unable to run due to the following error:FUNCTION name,(RESULT of PROJECT2_EX6~FACT),used where not expected,perhaps missing '()'
program project2_ex6
implicit none
integer(kind=3)::degrees,i,sign
integer::n
double precision::x,err_limit,s_old,s
real,parameter::pi=3.14159265359
print*,'This program calculates the cos(x)'
print*,"Enter the angle's degrees"
read*,degrees
do
if(degrees<0.or.degrees>360) then
print*,'Degrees must be between 0-360'
else
x=pi*degrees/180
exit
end if
end do
sign=1
sign=sign*(-1)
err_limit=1e-5
n=0
s=0
s_old=0
do
do i=1,n
end do
s=(((-1.)**n/(fact(2.*n)))*x**(2.*n))*sign
s=s+s_old
n=n+1
if(abs(s-s_old)<1e-5) then
exit
else
s_old=s
cycle
end if
end do
print*,s,i,n
contains
real function fact(i)
double precision::fact
integer::i
if(i>=1) then
fact=i*fact(i-1)
else
fact=1
end if
return
end function
end program
Although it is your homework, I will help you here. The first thing which is wrong is ýour factorial which you need to replace with
fact = 1
do j = 1,i
fact = fact*j
enddo
second it is easier if you let your do loop do the job so run it as
do i=4,200,2
and predefine cosradians outside the do loob with
cosradiants = 1-radiants**2/2
additionally you need to take into account the changing sign which you can do in the loop using
sign = sign*(-1)
and starting it off with sign = 1 before the loop
in the loop its then
cosradiants= cosradiants+sign*radiants**i/fact
If you have included these things it should work (at least with my code it does)
I have a code in Fortran IV that I need to run. I was told to try to compile it in Fortran 77 and fix the error. So I named the file with a .f extension and tried to compile it with gfortran. I got the next error referring to the Fortran IV function copied below:
abel.f:432.24:
REAL FUNCTION DGDT*8(IX,NV,XNG,FNG,GNG,X)
1
Error: Expected formal argument list in function definition at (1)
Since I'm not too familiar with Fortran I'd appreciate if someone can tell me how to fix this problem .
REAL FUNCTION DGDT*8(IX,NV,XNG,FNG,GNG,X) AAOK0429
C AAOK0430
C THIS SUBROUTINE COMPUTES THE VALUE OF THE DERIVATIVE OF THE AAOK0431
C G-FUNCTION FOR A SLIT TRANSMISSION FUNCTION GIVEN BY A AAOK0432
C PIECE-WISE CUBIC SPLINE , WHOSE PARAMETERS ARE AAOK0433
C CONTAINED IN XNG,FNG AND GNG. AAOK0434
C AAOK0435
IMPLICIT REAL*8(A-H,O-Z) AAOK0436
C AAOK0437
C ALLOWABLE ROUNDING ERROR ON POINTS AT EXTREAMS OF KNOT RANGE AAOK0438
C IS 2**IEPS*MAX(!XNG(1)!,!XNG(NV)!). AAOK0439
INTEGER*4 IFLG/0/,IEPS/-50/ AAOK0440
DIMENSION XNG(1),FNG(1),GNG(1) AAOK0441
C AAOK0442
C TEST WETHER POINT IN RANGE. AAOK0443
IF(X.LT.XNG(1)) GO TO 990 AAOK0444
IF(X.GT.XNG(NV)) GO TO 991 AAOK0445
C AAOK0446
C ESTIMATE KNOT INTERVAL BY ASSUMING EQUALLY SPACED KNOTS. AAOK0447
12 J=DABS(X-XNG(1))/(XNG(NV)-XNG(1))*(NV-1)+1 AAOK0448
C ENSURE CASE X=XNG(NV) GIVES J=NV-1 AAOK0449
J=MIN0(J,NV-1) AAOK0450
C INDICATE THAT KNOT INTERVAL INSIDE RANGE HAS BEEN USED. AAOK0451
IFLG=1 AAOK0452
C SEARCH FOR KNOT INTERVAL CONTAINING X. AAOK0453
IF(X.LT.XNG(J)) GO TO 2 AAOK0454
C LOOP TILL INTERVAL FOUND. AAOK0455
1 J=J+1 AAOK0456
11 IF(X.GT.XNG(J+1)) GO TO 1 AAOK0457
GO TO 7 AAOK0458
2 J=J-1 AAOK0459
IF(X.LT.XNG(J)) GO TO 2 AAOK0460
C AAOK0461
C CALCULATE SPLINE PARAMETERS FOR JTH INTERVAL. AAOK0462
7 H=XNG(J+1)-XNG(J) AAOK0463
Q1=H*GNG(J) AAOK0464
Q2=H*GNG(J+1) AAOK0465
SS=FNG(J+1)-FNG(J) AAOK0466
B=3D0*SS-2D0*Q1-Q2 AAOK0467
A=Q1+Q2-2D0*SS AAOK0468
C AAOK0469
C CALCULATE SPLINE VALUE. AAOK0470
8 Z=(X-XNG(J))/H AAOK0471
C TF=((A*Z+B)*Z+Q1)*Z+FNG(J) AAOK0472
C TG=((3.*A*Z+2.*B)*Z+Q1)/H AAOK0473
C DGDT=(TG-TF/X)/X AAOK0474
DGDT=(3.*A*Z*Z+2.*B*Z+Q1)/H AAOK0475
RETURN AAOK0476
C TEST IF X WITHIN ROUNDING ERROR OF XNG(1). AAOK0477
990 IF(X.LE.XNG(1)-2D0**IEPS*DMAX1(DABS(XNG(1)),DABS(XNG(NV)))) GO AAOK0478
1 TO 99 AAOK0479
J=1 AAOK0480
GO TO 7 AAOK0481
C TEST IF X WITHIN ROUNDING ERROR OF XNG(NV). AAOK0482
991 IF(X.GE.XNG(NV)+2D0**IEPS*DMAX1(DABS(XNG(1)),DABS(XNG(NV)))) GO AAOK0483
1 TO 99 AAOK0484
J=NV-1 AAOK0485
GO TO 7 AAOK0486
99 IFLG=0 AAOK0487
C FUNCTION VALUE SET TO ZERO FOR POINTS OUTSIDE THE RANGE. AAOK0488
DGDT=0D0 AAOK0489
RETURN AAOK0490
END AAOK0491
This doesn't look so bad. Modern compilers still accept the real*8 syntax although it isn't standard. So you should (as mentioned) replace the line
REAL FUNCTION DGDT*8(IX,NV,XNG,FNG,GNG,X) AAOK0429
with
REAL*8 FUNCTION DGDT(IX,NV,XNG,FNG,GNG,X) AAOK0429
which compiled successfully for me using gfortran 4.6.2 using gfortran -c DGDT.f.
Good luck, and be on the lookout for other problems. Just because the code compiles does not mean it is running the same way it was designed!
Not really an answer, see the one from Ross. But I just can't stand the requirement for fixed form. Here is how this code probably would look like in F90 with free form:
function DGDT(IX, NV, XNG, FNG, GNG, X)
! THIS FUNCTION COMPUTES THE VALUE OF THE DERIVATIVE OF THE
! G-FUNCTION FOR A SLIT TRANSMISSION FUNCTION GIVEN BY A
! PIECE-WISE CUBIC SPLINE, WHOSE PARAMETERS ARE
! CONTAINED IN XNG,FNG AND GNG.
implicit none
integer, parameter :: rk = selected_real_kind(15)
integer :: ix, nv
real(kind=rk) :: dgdt
real(kind=rk) :: xng(nv)
real(kind=rk) :: fng(nv)
real(kind=rk) :: gng(nv)
real(kind=rk) :: x
! ALLOWABLE ROUNDING ERROR ON POINTS AT EXTREAMS OF KNOT RANGE
! IS 2**IEPS*MAX(!XNG(1)!,!XNG(NV)!).
integer, parameter :: ieps = -50
integer, save :: iflg = 0
integer :: j
real(kind=rk) :: tolerance
real(kind=rk) :: H
real(kind=rk) :: A, B
real(kind=rk) :: Q1, Q2
real(kind=rk) :: SS
real(kind=rk) :: Z
tolerance = 2.0_rk**IEPS * MAXVAL(ABS(XNG([1,NV])))
! TEST WETHER POINT IN RANGE.
if ((X < XNG(1) - tolerance) .or. (X > XNG(NV) + tolerance)) then
! FUNCTION VALUE SET TO ZERO FOR POINTS OUTSIDE THE RANGE.
iflg = 0
DGDT = 0.0_rk
return
end if
! ESTIMATE KNOT INTERVAL BY ASSUMING EQUALLY SPACED KNOTS.
J = abs(x-xng(1)) / (xng(nv)-xng(1)) * (nv-1) + 1
! ENSURE CASE X=XNG(NV) GIVES J=NV-1
J = MIN(J,NV-1)
! INDICATE THAT KNOT INTERVAL INSIDE RANGE HAS BEEN USED.
IFLG = 1
! SEARCH FOR KNOT INTERVAL CONTAINING X.
do
if ( (x >= xng(j)) .or. (j==1) ) EXIT
j = j-1
! LOOP TILL INTERVAL FOUND.
end do
do
if ( (x <= xng(j+1)) .or. (j==nv-1) ) EXIT
j = j+1
! LOOP TILL INTERVAL FOUND.
end do
! CALCULATE SPLINE PARAMETERS FOR JTH INTERVAL.
H = XNG(J+1) - XNG(J)
Q1 = H*GNG(J)
Q2 = H*GNG(J+1)
SS = FNG(J+1) - FNG(J)
B = 3.0_rk*SS - 2.0_rk*Q1 - Q2
A = Q1 + Q2 - 2.0_rk*SS
! CALCULATE SPLINE VALUE.
Z = (X-XNG(J))/H
DGDT = ( (3.0_rk*A*Z + 2.0_rk*B)*Z + Q1 ) / H
end function DGDT
Note, I did not test this in any way, also there might be some wrong guesses in there, like that ieps should be a constant. Also, I am not so sure about iflg, and the ix argument does not appear to be used at all. So I might got something wrong. For the tolerance it is better to use a factor instead of a difference and a 2.**-50 will not change the value for a the maxval in a double precision number here. Also note, I am using some other F90 features besides the free form now.
DISCLAIMER: Just mentioning a possible solution here, not recommending it...
As much as all other answers are valid and that supporting some Fortran IV code as is is a nightmare, you still might want / need to avoid touching it as much as possible. And since Fortran IV had some strange behaviours when it comes to loops for example (with loops always cycled at least once IINM), using a "proper" Fortran IV compiler might be a "good" idea.
Anyway, all this to say that the Intel compiler for example, supports Fortran IV natively with the -f66 compiler switch, and I'm sure other compilers do as well. This may be worth checking.