I am new to Fortran. I am facing a weird problem and I don't know how to troubleshoot this. I have pasted the minimum working code to demonstrate the problem below.
In the code everything works except the cosine function call. It is giving wrong results. The most weird thing is the result changes if I uncomment the commented line below (which is in no way related to the returned value).
(As I've read in several SO questions this looks like a results of an invalid memory access, but couldn't figure anything out)
program prog
implicit none
double precision, dimension(2) :: vec1 = (/ 3, 4 /)
double precision, dimension(2) :: vec2 = (/ 4, 3 /)
print *, inner_product(2, vec1, vec2)
print *, norm(2, vec1)
print *, cosine(2, vec1, vec2)
contains
double precision function inner_product(N, V1, V2)
integer, intent(in) :: N
double precision, dimension(*), intent(in) :: V1
double precision, dimension(*), intent(in) :: V2
integer :: i
do i = 1, N
inner_product = inner_product + V1(i)*V2(i)
end do
end function inner_product
double precision function norm(N, V)
integer, intent(in) :: N
double precision, dimension(*), intent(in) :: V
norm = sqrt(inner_product(N, V, V))
end function norm
double precision function cosine(N, A, B)
integer, intent(in) :: N
double precision, dimension(*), intent(in) :: A
double precision, dimension(*), intent(in) :: B
double precision :: na
! na = norm(N, A)
cosine = inner_product(N, A, B) / (norm(N, A) * norm(N, B))
end function cosine
end program prog
UPDATE:
Running the posted code gives the following result,
24.000000000000000
5.0000000000000000
0.67882250993908555
Running the program after uncommenting the currently commented line gives the following,
24.000000000000000
5.0000000000000000
0.39191835884530846
None of them are true. The expected result is 0.96 (which is given by 24 / (5*5)).
Your problem is that gfortran doesn't detect your error unless optimization is in force:
D:\gfortran\clf\uninit>gfortran -O2 uninit.f90 -ouninit
D:\gfortran\clf\uninit>gfortran -Wall uninit.f90 -ouninit
uninit.f90:31:28:
double precision :: na
1
Warning: Unused variable 'na' declared at (1) [-Wunused-variable]
D:\gfortran\clf\uninit>gfortran -O2 -Wall uninit.f90 -ouninit
uninit.f90:31:28:
double precision :: na
1
Warning: Unused variable 'na' declared at (1) [-Wunused-variable]
uninit.f90:17:0:
inner_product = inner_product + V1(i)*V2(i)
Warning: '__result_inner_product' is used uninitialized in this function [-Wunin
itialized]
It's this last error you want to encourage gfortran to detect.
Related
I'm trying to implement Newton's method but I'm getting a confusing error message. In my code you'll see I called external with f1 and f2 which I assumes tells the computer to look for the function but it's treating them as variables based on the error message. I've read the stack overflow posts similar to my issue but none of the solutions seem to work. I've tried with and without the external but the issue still persists. Hoping someone could see what I'm missing.
implicit none
contains
subroutine solve(f1,f2,x0,n, EPSILON)
implicit none
real(kind = 2), external:: f1, f2
real (kind = 2), intent(in):: x0, EPSILON
real (kind = 2):: x
integer, intent(in):: n
integer:: iteration
x = x0
do while (abs(f1(x))>EPSILON)
iteration = iteration + 1
print*, iteration, x, f1(x)
x = x - (f1(x)/f2(x))
if (iteration >= n) then
print*, "No Convergence"
stop
end if
end do
print*, iteration, x
end subroutine solve
end module newton
Program Lab10
use newton
implicit none
integer, parameter :: n = 1000 ! maximum iteration
real(kind = 2), parameter :: EPSILON = 1.d-3
real(kind = 2):: x0, x
x0 = 3.0d0
call solve(f(x),fp(x),x0,n, EPSILON)
contains
real (kind = 2) function f(x) ! this is f(x)
implicit none
real (kind = 2), intent(in)::x
f = x**2.0d0-1.0d0
end function f
real (kind = 2) function fp(x) ! This is f'(x)
implicit none
real (kind = 2), intent(in)::x
fp = 2.0d0*x
end function fp
end program Lab10```
You seem to be passing function results to your subroutine and not the functions themselves. Remove (x) when calling solve() and the problem will be resolved. But more importantly, this code is a prime example of how to not program in Fortran. The attribute external is deprecated and you better provide an explicit interface. In addition, what is the meaning of kind = 2. Gfortran does not even comprehend it. Even if it comprehends the kind, it is not portable. Here is a correct portable modern implementation of the code,
module newton
use iso_fortran_env, only: RK => real64
implicit none
abstract interface
pure function f_proc(x) result(result)
import RK
real(RK), intent(in) :: x
real(RK) :: result
end function f_proc
end interface
contains
subroutine solve(f1,f2,x0,n, EPSILON)
procedure(f_proc) :: f1, f2
real(RK), intent(in) :: x0, EPSILON
integer, intent(in) :: n
real(RK) :: x
integer :: iteration
x = x0
do while (abs(f1(x))>EPSILON)
iteration = iteration + 1
print*, iteration, x, f1(x)
x = x - (f1(x)/f2(x))
if (iteration >= n) then
print*, "No Convergence"
stop
end if
end do
print*, iteration, x
end subroutine solve
end module newton
Program Lab10
use newton
integer, parameter :: n = 1000 ! maximum iteration
real(RK), parameter :: EPSILON = 1.e-3_RK
real(RK) :: x0, x
x0 = 3._RK
call solve(f,fp,x0,n, EPSILON)
contains
pure function f(x) result(result) ! this is f(x)
real (RK), intent(in) :: x
real (RK) :: result
result = x**2 - 1._RK
end function f
pure function fp(x) result(result) ! This is f'(x)
real (RK), intent(in) :: x
real (RK) :: result
result = 2 * x
end function fp
end program Lab10
If you expect to pass nonpure functions to the subroutine solve(), then remove the pure attribute. Note the use of real64 to declare 64-bit (double precision) real kind. Also notice how I have used _RK suffix to assign 64-bit precision to real constants. Also, notice I changed the exponents from real to integer as it is multiplication is more efficient than exponentiation computationally. I hope this answer serves more than merely the solution to Lab10.
I want to integrate a 3d array over space in r, theta and phi (spherical polar). For 1d I use Simpson's 1/3rd rule but I am confused about that for 3d. Also, would you like to suggest any other method for integration or subroutine? I am using Fortran 95.
I have written the Fortran code for integration in 3d, I thought I should share with you.
The code for calculating integration of a function is 3 dimension is:
!This program uses Simpson's 1/3 method to calulate volume
integral in r,theta & phi.
program SimpsonInteg3d
implicit none
integer::i,j,k
integer, parameter :: N=10,M=360,L=180
integer, parameter:: rmin=0,rmax=N,phimin=0,phimax=M,&
thetamin=0,thetamax=L
double precision,&
dimension(rmin:rmax,thetamin:thetamax,phimin:phimax)::U
real*8, parameter :: pi = 4*atan(1.0),dr=1./N,&
dtheta=pi/(L),dphi=2*pi/M
real*8 :: r(rmin:rmax)=(/(i*dr,i=rmin,rmax)/),&
theta(thetamin:thetamax)=(/(j*dtheta,j=thetamin,thetamax)/),&
p(phimin:phimax)=(/(k*dphi,k=phimin,phimax)/)
real*8::intg
do i=rmin,rmax
do j=thetamin, thetamax
do k=phimin,phimax
!The function which has to be integrated.
U(i,j,k)=r(i)* (sin((p(k)))**2) *sin(theta(j))
enddo
enddo
enddo
call Integration(Intg,U,r,theta,p)
print*,"Integration of function U using simpson's 1/3=", Intg
end program
!===============================================================!
!Subroutine for calculating integral of a function in 3d.
subroutine Integration(Intg,U,r,theta,p)
implicit none
integer::i,j,k
integer, parameter :: N=10,M=360,L=180
integer, parameter ::rmin=0,rmax=N,&
phimin=0,phimax=M,thetamin=0,thetamax=L
double precision,&
dimension(rmin:rmax,thetamin:thetamax,phimin:phimax):: U
real*8::
r(rmin:rmax),theta(thetamin:thetamax),p(phimin:phimax),Intg,Ia
double precision,dimension(rmin:rmax)::Itheta
real*8, parameter :: pi = 4*atan(1.0),dr=1./N,&
dtheta=pi/(L),dphi=2*pi/M
Intg=0
Ia=0
do i=rmin+1,rmax-1
call Integtheta(Itheta,i,U,r,theta,p)
if(mod(i,2).eq.0) then
Ia = Ia + 2*Itheta(i)*r(i)**2
else
Ia = Ia + 4*Itheta(i)*r(i)**2
endif
end do
call Integtheta(Itheta,rmin,U,r,theta,p)
call Integtheta(Itheta,rmax,U,r,theta,p)
Intg=(dr/3)*(Itheta(rmin)+Itheta(rmax)+ Ia)
end subroutine Integration
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!Subroutine for calculating integral of U along theta and phi
subroutine Integtheta(Itheta,i,U,r,theta,p)
implicit none
integer::i,j,k
integer, parameter :: N=10,M=360,L=180
integer, parameter ::rmin=0,rmax=N,&
phimin=0,phimax=M,thetamin=0,thetamax=L
double precision,&
dimension(rmin:rmax,thetamin:thetamax,phimin:phimax)::U
real*8:: r(rmin:rmax),theta(thetamin:thetamax),p(phimin:phimax)
double precision,dimension(rmin:rmax)::Itheta,Itha
double precision,dimension(rmin:rmax,thetamin:thetamax)::Ip
real*8, parameter :: pi = 4*atan(1.0),dr=1./N,&
dtheta=pi/(L),dphi=2*pi/M
Itheta(i)=0
Itha(i)=0
do j=thetamin+1,thetamax-1
call Integphi(Ip,i,j,U,r,theta,p)
if(mod(j,2).eq.0) then
Itha(i) = Itha(i) + 2*Ip(i,j)*sin(theta(j))
else
Itha(i) = Itha(i) + 4*Ip(i,j)*sin(theta(j))
endif
end do
call Integphi(Ip,i,thetamin,U,r,theta,p)
call Integphi(Ip,i,thetamax,U,r,theta,p)
Itheta(i)=(dtheta/3)*(Ip(i,thetamin)+Ip(i,thetamax)+ Itha(i))
end subroutine Integtheta
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!Subroutine for calculating integral of U along phi
subroutine Integphi(Ip,i,j,U,r,theta,p)
implicit none
integer::i,j,k
integer, parameter :: N=10,M=360,L=180
integer, parameter ::rmin=0,rmax=N,&
phimin=0,phimax=M,thetamin=0,thetamax=L
double precision,&
dimension(rmin:rmax,thetamin:thetamax,phimin:phimax)::U
real*8:: r(rmin:rmax),theta(thetamin:thetamax),p(phimin:phimax)
double precision,dimension(rmin:rmax,thetamin:thetamax)::Ip,Ipa
real*8, parameter :: pi = 4*atan(1.0),dr=1./N,&
dtheta=pi/(L),dphi=2*pi/M
Ipa(i,j)=0
do k=phimin+1,phimax-1
if(mod(k,2).eq.0) then
Ipa(i,j) = Ipa(i,j) + 2*U(i,j,k)
else
Ipa(i,j)= Ipa(i,j) + 4*U(i,j,k)
endif
end do
Ip(i,j)=(dphi/3)*(U(i,j,phimin)+U(i,j,phimax)+ Ipa(i,j))
end subroutine Integphi
It calculates the integration of the function U along phi first and then uses the function Ip to calculate integral along theta. Then finally the function Itheta is used to calculate integration along r.
I'm trying to use the MKL trust region algorithm to solve a nonlinear system of equations in a Fortran program. I started from the example provided online (ex_nlsqp_f90_x.f90 https://software.intel.com/en-us/node/501498) and everything works correctly. Now, because I have to use this in a much bigger program, I need the user defined objective function to be loaded from a separate module. Hence, I split the example into 2 separate files, but I'm not able to make it compile correctly.
So here is the code for module which contains user defined data structure and the objective function
module modFun
implicit none
private
public my_data, extended_powell
type :: my_data
integer a
integer sum
end type my_data
contains
subroutine extended_powell (m, n, x, f, user_data)
implicit none
integer, intent(in) :: m, n
real*8 , intent(in) :: x(n)
real*8, intent(out) :: f(m)
type(my_data) :: user_data
integer i
user_data%sum = user_data%sum + user_data%a
do i = 1, n/4
f(4*(i-1)+1) = x(4*(i-1)+1) + 10.0 * x(4*(i-1)+2)
f(4*(i-1)+2) = 2.2360679774998 * (x(4*(i-1)+3) - x(4*(i-1)+4))
f(4*(i-1)+3) = ( x(4*(i-1)+2) - 2.0 * x(4*(i-1)+3) )**2
f(4*(i-1)+4) = 3.1622776601684 * (x(4*(i-1)+1) - x(4*(i-1)+4))**2
end do
end subroutine extended_powell
end module modFun
and here the portion of the main program calling it
include 'mkl_rci.f90'
program EXAMPLE_EX_NLSQP_F90_X
use MKL_RCI
use MKL_RCI_type
use modFun
! user's objective function
! n - number of function variables
! m - dimension of function value
integer n, m
parameter (n = 4)
parameter (m = 4)
! precisions for stop-criteria (see manual for more details)
real*8 eps(6)
real*8 x(n)
real*8 fjac(m*n)
! number of iterations
integer fun
! Additional users data
type(my_data) :: m_data
m_data%a = 1
m_data%sum = 0
rs = 0.0
fun = djacobix(extended_powell,n,m,fjac,x,eps(1),%val(loc(m_data)))
end program EXAMPLE_EX_NLSQP_F90_X
Also djacobix code
INTERFACE
INTEGER FUNCTION DJACOBIX(fcn, n, m, fjac, x, eps, user_data)
USE, INTRINSIC :: ISO_C_BINDING
INTEGER, INTENT(IN) :: n
INTEGER, INTENT(IN) :: m
DOUBLE PRECISION, INTENT(IN) :: eps
DOUBLE PRECISION, INTENT(IN), DIMENSION(*) :: x
DOUBLE PRECISION, INTENT(OUT), DIMENSION(m, *) :: fjac
INTEGER(C_INTPTR_T) :: user_data
INTERFACE
SUBROUTINE fcn(m, n, x, f, user_data)
USE, INTRINSIC :: ISO_C_BINDING
INTEGER, INTENT(IN) :: n
INTEGER, INTENT(IN) :: m
DOUBLE PRECISION, INTENT(IN), DIMENSION(*) :: x
DOUBLE PRECISION, INTENT(OUT), DIMENSION(*) :: f
INTEGER(C_INTPTR_T), INTENT(IN) :: user_data
END SUBROUTINE
END INTERFACE
END FUNCTION
END INTERFACE
When i compile the following errors are generated:
mpiifort -g -t -mkl -I/apps/rhel6/intel/composer_xe_2015.3.187/mkl/include/intel64/lp64 -c modFun.f90
mpiifort -g -t -mkl -I/apps/rhel6/intel/composer_xe_2015.3.187/mkl/include/intel64/lp64 -c main.f90
main.f90(30): error #7065: The characteristics of dummy argument 5 of the associated actual procedure differ from the characteristics of dummy argument 5 of the dummy procedure. [EXTENDED_POWELL]
fun = djacobix(extended_powell,n,m,fjac,x,eps(1),%val(loc(m_data)))
-------------------^
I have the feeling I have to create an interface to override the check on the m_data, but I can't figure out where and how. Can anyone help me with this problem providing a working example?
I guess the reason is that the function djacobix passes the pointer instead of the true value of variable user_data.
You can check the manual at https://software.intel.com/content/www/us/en/develop/documentation/onemkl-developer-reference-c/top/nonlinear-optimization-problem-solvers/jacobian-matrix-calculation-routines/jacobix.html where a sentence shows that "You need to declare fcn as extern in the calling program."
I need make a dot product in Fortran. I can do with the intrinsic function dot_product from Fortran or use ddot from OpenBLAS. The problem is the ddot is slower. This is my code:
With BLAS:
program VectorBLAS
! time VectorBlas.e = 0.30s
implicit none
double precision, dimension(3) :: b
double precision :: result
double precision, external :: ddot
integer, parameter :: LargeInt_K = selected_int_kind (18)
integer (kind=LargeInt_K) :: I
DO I = 1, 10000000
b(:) = 3
result = ddot(3, b, 1, b, 1)
END DO
end program VectorBLAS
With dot_product
program VectorModule
! time VectorModule.e = 0.19s
implicit none
double precision, dimension (3) :: b
double precision :: result
integer, parameter :: LargeInt_K = selected_int_kind (18)
integer (kind=LargeInt_K) :: I
DO I = 1, 10000000
b(:) = 3
result = dot_product(b, b)
END DO
end program VectorModule
The two codes are compiled using:
gfortran file_name.f90 -lblas -o file_name.e
What am I doing wrong? BLAS not have to be faster?
While BLAS, and especially the optimized versions, are generally faster for larger arrays, the built-in functions are faster for smaller sizes.
This is especially visible from the linked source code of ddot, where additional work is spent on further functionality (e.g., different increments). For small array lengths, the work done here outweighs the performance gain of the optimizations.
If you make your vectors (much) larger, the optimized version should be faster.
Here is an example to illustrate this:
program test
use, intrinsic :: ISO_Fortran_env, only: REAL64
implicit none
integer :: t1, t2, rate, ttot1, ttot2, i
real(REAL64), allocatable :: a(:),b(:),c(:)
real(REAL64), external :: ddot
allocate( a(100000), b(100000), c(100000) )
call system_clock(count_rate=rate)
ttot1 = 0 ; ttot2 = 0
do i=1,1000
call random_number(a)
call random_number(b)
call system_clock(t1)
c = dot_product(a,b)
call system_clock(t2)
ttot1 = ttot1 + t2 - t1
call system_clock(t1)
c = ddot(100000,a,1,b,1)
call system_clock(t2)
ttot2 = ttot2 + t2 - t1
enddo
print *,'dot_product: ', real(ttot1)/real(rate)
print *,'BLAS, ddot: ', real(ttot2)/real(rate)
end program
The BLAS routines are quite a bit faster here:
OMP_NUM_THREADS=1 ./a.out
dot_product: 0.145999998
BLAS, ddot: 0.100000001
PROGRAM MPI
IMPLICIT NONE
INTEGER, PARAMETER :: nn=100
DOUBLE PRECISION h, L
DOUBLE PRECISION, DIMENSION (2*nn) :: y, ynew
DOUBLE PRECISION, DIMENSION (nn) :: qnew,vnew
DOUBLE PRECISION, DIMENSION (2*nn) :: k1,k2,k3,k4
INTEGER j, k
INTEGER i
INTEGER n
n=100 !particles
L=2.0d0
h=1.0d0/n
y(1)=1.0d0
DO k=1,2*n ! time loop
CALL RHS(y,k1)
CALL RHS(y+(h/2.0d0)*k1,k2)
CALL RHS(y+(h/2.0d0)*k2,k3)
CALL RHS(y+h*k3,k4)
ynew(1:2*n)=y(1:2*n) + (k1 + 2.0d0*(k2 + k3) + k4)*h/6.0d0
END DO
qnew(1:n)=ynew(1:n)
vnew(1:n)=ynew(n+1:2*n)
DO i=1,n
IF (qnew(i).GT. L) THEN
qnew(i) = qnew(i) - L
ENDIF
END DO
write(*,*) 'qnew=', qnew(1:n)
write(*,*) 'vnew=', vnew(1:n)
END PROGRAM MPI
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
! Right hand side of the ODE
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE RHS(y,z)
IMPLICIT NONE
INTEGER, PARAMETER :: nn=100
DOUBLE PRECISION, DIMENSION (2*nn) :: y
DOUBLE PRECISION, DIMENSION (2*nn) :: z
DOUBLE PRECISION, DIMENSION (nn) :: F
DOUBLE PRECISION, DIMENSION (nn) :: g
INTEGER n
INTEGER m
n=100
m=1/n
z(1:n)=y(n+1:2*n)
CAll FORCE(g,F)
z(n+1:2*n)=F(1:n)/m
RETURN
END
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
! Force acting on each particle
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE FORCE(g,F)
IMPLICIT NONE
INTEGER, PARAMETER :: nn=100
DOUBLE PRECISION, DIMENSION (nn) :: F
DOUBLE PRECISION, DIMENSION (nn) :: q
DOUBLE PRECISION, DIMENSION (nn) :: g
DOUBLE PRECISION u
INTEGER j, e
INTEGER n
n=100
e=1/n
DO j=2,n+1
CALL deriv((abs(q(j)-q(j-1)))/e,u)
g(j-1)=((y(j)-y(j-1))/(abs(y(j)-y(j-1))))*u
CALL deriv((abs(q(j)-q(j+1)))/e,u)
g(j+1)=((y(j)-y(j+1))/(abs(y(j)-y(j+1))))*u
F(j)=g(j-1)+g(j+1)
END DO
RETURN
END
SUBROUTINE deriv(c,u,n)
IMPLICIT NONE
INTEGER, INTENT(in) :: n
DOUBLE PRECISION, DIMENSION(n), INTENT(IN) :: c
DOUBLE PRECISION, DIMENSION(n), INTENT(OUT) :: u
INTEGER, PARAMETER :: p=2
INTEGER, PARAMETER :: cr=100
INTEGER :: i
DOUBLE PRECISION L
L=2.0d0
DO i= 1,n
IF (c(i) .LE. L) THEN
u(i)=cr*(L*(c(i)**(-p))-L**(1-p))
ELSE IF (c(i) .GT. L) THEN
u(i)=0
END IF
END DO
RETURN
END SUBROUTINE deriv
I am only getting one same error on line 85 and 87. It says:
y has no implicit type at y(j-1) ans at y(j+1).
There's a lot wrong here. We can point out some of the things, but you're going to have to sit down with a book and learn about programming, starting with smaller programs and getting them right, then building up.
Let's look at the last routine in the code you posted above. I've changed the syntax of some of the variable declarations just to make it shorter so more fits on screen at once.
SUBROUTINE deriv(c,u)
IMPLICIT NONE
DOUBLE PRECISION :: deriv, c, u
INTEGER :: p, x, cr, n
L=2.0d0
cr=100
p=2
n=100
DO i= 1,n
IF (c(i).LE. L) THEN
u(c)=cr*(L*c^(-p)-L^(1-p))
ELSE IF (c(i) .GT. L) THEN
u(c)=0
END IF
RETURN
END
So you've made deriv a double precision variable, but it's also the name of the subroutine. That's an error; maybe you meant to make this a function which returns a double precision value; then you're almost there, you'd need to change the procedure header to FUNCTION DERIV(c,u) -- but you never set deriv anywhere. So likely that should just be left out. So let's just get rid of that DOUBLE PRECISION deriv declaration. Also, L, which is used, is never declared, and x, which isn't, is declared.
Then you pass in to this subroutine two variables, c and u, which you define to be double precision. So far so good, but then you start indexing them: eg, c(i). So they should be arrays of double precisions, not just scalars. Looking at the do loop, I'm guessing they should both be of size n -- which should be passed in, presumably? . Also, the do loop is never terminated; there should be an end do after the end if.
Further, the ^ operator you're using I'm assuming you're using for exponentiation -- but in Fortran, that's **, not ^. And that c^(-p) should (I'm guessing here) be c(i)**(-p)?
Finally, you're setting u(c) -- but that's not very sensible, as c is an array of double precision numbers. Even u(c(i)) wouldn't make sense -- you can't index an array with a double precision number. Presumably, and I'm just guessing here, you mean the value of u corresponding to the just-calculated value of c -- eg, u(i), not u(c)?
So given the above, we'd expect the deriv subroutine to look like this:
SUBROUTINE deriv(c,u,n)
IMPLICIT NONE
INTEGER, INTENT(in) :: n
DOUBLE PRECISION, DIMENSION(n), intent(IN) :: c
DOUBLE PRECISION, DIMENSION(n), intent(OUT) :: u
INTEGER, PARAMETER :: p=2, cr=100
DOUBLE PRECISION, PARAMETER :: L=2.0
INTEGER :: i
DO i= 1,n
IF (c(i) .LE. L) THEN
u(i)=cr*(L*c(i)**(-p)-L**(1-p))
ELSE IF (c(i) .GT. L) THEN
u(i)=0
END IF
END DO
RETURN
END SUBROUTINE deriv
Note that in modern fortran, the do loop can be replaced with a where statement, and also you don't need to explicitly pass in the size; so then you could get away with the clearer and shorter:
SUBROUTINE DERIV(c,u)
IMPLICIT NONE
DOUBLE PRECISION, DIMENSION(:), intent(IN) :: c
DOUBLE PRECISION, DIMENSION(size(c,1)), intent(OUT) :: u
INTEGER, PARAMETER :: p=2, cr=100
DOUBLE PRECISION, PARAMETER :: L=2.0
WHERE (c <= L)
u=cr*(L*c**(-p)-L**(1-p))
ELSEWHERE
u=0
ENDWHERE
RETURN
END SUBROUTINE DERIV
But notice that I've already had to guess three times what you meant in this section of code, and this is only about 1/4th of the total of the code. Having us try to divine your intention in the whole thing and rewrite accordingly probably isn't the best use of anyone's time; why don't you proceed from here working on one particular thing and ask another question if you have a specific problem.