istp/gray
2
0
Fork 0
Code Issues Pull Requests Packages Projects Releases 1 Wiki Activity

remove unnecessary implicit statements

Browse Source 
Only a single `implicit none` at the start of each module is required.
This commit is contained in:
Michele Guerini Rocco 2024-01-27 12:09:56 +01:00
parent 86ff5ecb06
commit 73bd010458
Signed by: rnhmjoj
GPG Key ID: BFBAF4C975F76450
31 changed files with 33 additions and 382 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
src/beamdata.f90
View File

@ -1,5 +1,6 @@
module beamdata
use const_and_precisions, only : wp_
implicit none
integer, save :: nray,nrayr,nrayth,nstep,jkray1
@ -11,7 +12,6 @@ contains
tau0,alphaabs0,dids0,ccci0,p0jk,ext,eyt,iiv)
use gray_params, only : raytracing_parameters
use const_and_precisions, only : half,two
implicit none
type(raytracing_parameters), intent(inout) :: rtrparam
real(wp_), dimension(:,:), intent(out), pointer :: ywork,ypwork, &
gri,psjki,ppabs,ccci
@ -64,7 +64,6 @@ contains
subroutine pweight(p0,p0jk)
! power associated to jk-th ray p0jk(j) for total beam power p0
use const_and_precisions, only : wp_, zero, one, half, two
implicit none
! arguments
real(wp_), intent(in) :: p0
real(wp_), dimension(:), intent(out) :: p0jk
@ -106,7 +105,6 @@ contains
! indices to a single global index (i)
function rayi2jk(i) result(jk)
implicit none
integer, intent(in) :: i
integer, dimension(2) :: jk
integer :: ioff
@ -125,7 +123,6 @@ contains
function rayi2j(i) result(jr)
implicit none
integer, intent(in) :: i
integer :: jr
@ -140,7 +137,6 @@ contains
function rayi2k(i) result(kt)
implicit none
integer, intent(in) :: i
integer :: kt
@ -155,7 +151,6 @@ contains
function rayjk2i(jr,kt) result(i)
implicit none
integer, intent(in) :: jr,kt
integer :: i
@ -171,7 +166,6 @@ contains
subroutine alloc_beam(ywork,ypwork,xc,du1,gri,ggri,psjki,ppabs,ccci, &
tau0,alphaabs0,dids0,ccci0,p0jk,ext,eyt,iiv)
implicit none
real(wp_), dimension(:,:), intent(out), pointer :: ywork,ypwork, &
gri,psjki,ppabs,ccci
real(wp_), dimension(:,:,:), intent(out), pointer :: xc,du1,ggri
@ -194,7 +188,6 @@ contains
subroutine dealloc_beam(ywork,ypwork,xc,du1,gri,ggri,psjki,ppabs,ccci, &
tau0,alphaabs0,dids0,ccci0,p0jk,ext,eyt,iiv)
implicit none
real(wp_), dimension(:,:), intent(out), pointer :: ywork,ypwork, &
gri,psjki,ppabs,ccci
real(wp_), dimension(:,:,:), intent(out), pointer :: xc,du1,ggri

10
src/beams.f90
View File

@ -1,5 +1,6 @@
module beams
use const_and_precisions, only : wp_, one
implicit none
contains
@ -32,8 +33,6 @@ contains
use utils, only : get_free_unit
use logger, only : log_error
implicit none
! subroutine arguments
type(antenna_parameters), intent(inout) :: params
integer, intent(out) :: err
@ -104,8 +103,6 @@ contains
use utils, only : get_free_unit,locate
use logger, only : log_error
implicit none
! subroutine arguments
type(antenna_parameters), intent(inout) :: params
integer, intent(out) :: err
@ -260,8 +257,6 @@ contains
use dierckx, only : curfit, splev, surfit, bispev
use logger, only : log_error
implicit none
! subroutine arguments
type(antenna_parameters), intent(inout) :: params
integer, intent(in) :: beamid
@ -841,8 +836,6 @@ contains
use const_and_precisions, only : degree
use gray_params, only : antenna_parameters
implicit none
! subroutine arguments
type(antenna_parameters), intent(in) :: params
real(wp_), intent(out) :: N(3)
@ -880,7 +873,6 @@ contains
! 3. adimensional `xgcn` parameter (X = ω_p²/ω² = nq²/ε₀mω²).
use const_and_precisions, only : qe=>ecgs_, me=>mecgs_, &
vc=>ccgs_, pi, wce1_
implicit none
! subroutine arguments
real(wp_), intent(in) :: fghz

8
src/conical.f90
View File

@ -12,8 +12,6 @@ contains
! Ref. https://doi.org/10.1016/0010-4655(81)90129-6
use logger, only : log_error
implicit none
real(wp_), intent(in) :: x, tau
integer, intent(in) :: m
real(wp_) :: fconic
@ -300,8 +298,6 @@ contains
!
function clogam(z)
implicit none
complex(wp_) :: clogam
complex(wp_), intent(in) :: z
complex(wp_) :: v,h,r
@ -365,8 +361,6 @@ contains
! entry ellick(X)= E(x)
! entry ellice(X)= E(x)
implicit none
real(wp_), intent(in) :: xk
real(wp_) :: ellick, ellice
integer :: i
@ -440,8 +434,6 @@ contains
! entry bessel_i0(X)= I0(x)
! entry bessel_i1(X)= I1(x)
implicit none
real(wp_), intent(in) :: x
real(wp_) :: bessel_i,bessel_i0,bessel_i1
logical :: l,e

2
src/const_and_precisions.f90
View File

@ -1,5 +1,7 @@
module const_and_precisions
implicit none
public
!------------------------------------------------------------------------

18
src/coreprofiles.f90
View File

@ -52,8 +52,6 @@ contains
use gray_params, only : iprof
use logger, only : log_error
implicit none
! subroutine arguments
real(wp_), intent(in) :: psin ! normalised poloidal flux
real(wp_), intent(out) :: dens, ddens ! density and first derivative
@ -145,8 +143,6 @@ contains
! Note: temperature has units of keV.
use gray_params, only : iprof
implicit none
! subroutine arguments
real(wp_), intent(in) :: psin
real(wp_) :: temp
@ -175,8 +171,6 @@ contains
! function of the normalised poloidal flux.
use gray_params, only : iprof
implicit none
! subroutine arguments
real(wp_), intent(in) :: psin
real(wp_) :: fzeff
@ -204,8 +198,6 @@ contains
use gray_params, only : profiles_data
use logger, only : log_error
implicit none
! subroutine arguments
character(len=*), intent(in) :: filenm
type(profiles_data), intent(out) :: data
@ -265,8 +257,6 @@ contains
use utils, only : get_free_unit
use logger, only : log_error
implicit none
! subroutine arguments
character(len=*), intent(in) :: filenm
type(profiles_data), intent(out) :: data
@ -305,8 +295,6 @@ contains
! See the GRAY user manual for the explanation.
use gray_params, only : profiles_parameters, profiles_data
implicit none
! subroutine arguments
type(profiles_parameters), intent(in) :: params
real(wp_), intent(in) :: factb
@ -355,8 +343,6 @@ contains
use gray_params, only : profiles_parameters, profiles_data
use logger, only : log_debug, log_info, log_warning, log_error
implicit none
! subroutine arguments
type(profiles_parameters), intent(inout) :: params
type(profiles_data), intent(inout) :: data
@ -497,8 +483,6 @@ contains
subroutine unset_profiles_spline
! Unsets the splines global variables, see the top of this file.
implicit none
call dens_spline%deinit
call temp_spline%deinit
call zeff_spline%deinit
@ -510,8 +494,6 @@ contains
! global variables, see the top of this file.
use gray_params, only : profiles_parameters, profiles_data
implicit none
! subroutine arguments
type(profiles_parameters), intent(inout) :: params
type(profiles_data), intent(in) :: data

27
src/dierckx.f90
View File

@ -1,6 +1,7 @@
module dierckx
use const_and_precisions, only : wp_
implicit none
contains
@ -75,7 +76,6 @@ contains
!
! latest update : march 1987
!
implicit none
! arguments
integer, intent(in) :: nx, ny, kx, ky, mx, my, lwrk, kwrk
integer, intent(out) :: ier
@ -405,7 +405,6 @@ contains
! latest update : march 1987
!
! ..
implicit none
! ..scalar arguments..
real(wp_) xb,xe,yb,ye,s,eps,fp
integer iopt,m,kx,ky,nxest,nyest,nmax,nx,ny,lwrk1,lwrk2,kwrk,ier
@ -513,7 +512,6 @@ contains
nx0,tx,ny0,ty,c,fp,fp0,fpint,coord,f,ff,a,q,bx,by,spx,spy,h, &
idx,nummer,wrk,lwrk,ier)
! ..
implicit none
! ..scalar arguments..
real(wp_) xb,xe,yb,ye,s,eta,tol,fp,fp0
integer iopt,m,kxx,kyy,nxest,nyest,maxit,nmax,km1,km2,ib1,ib3, &
@ -1218,7 +1216,6 @@ contains
! equations a*c = z with a a n x n upper triangular matrix
! of bandwidth k.
! ..
implicit none
! arguments
integer, intent(in) :: n, k, nest
real(wp_), intent(in) :: a(nest,k), z(n)
@ -1246,7 +1243,6 @@ contains
end subroutine fpback
subroutine fpbisp(tx,nx,ty,ny,c,kx,ky,x,mx,y,my,z,wx,wy,lx,ly)
implicit none
! arguments
integer, intent(in) :: nx, ny, kx, ky, mx, my
integer, intent(out) :: lx(mx), ly(my)
@ -1330,7 +1326,6 @@ contains
! degree k at t(l) <= x < t(l+1) using the stable recurrence
! relation of de boor and cox.
! ..
implicit none
! arguments
integer, intent(in) :: n, k, l
real(wp_), intent(in) :: x, t(n)
@ -1373,7 +1368,6 @@ contains
! subset of data points y(j) such that
! t(j) < y(j) < t(j+k+1), j=1,2,...,n-k-1
! ..
implicit none
! arguments
integer, intent(in) :: m, n, k
real(wp_), intent(in) :: x(m), t(n)
@ -1423,7 +1417,6 @@ contains
subroutine fpdisc(t,n,k2,b,nest)
! subroutine fpdisc calculates the discontinuity jumps of the kth
! derivative of the b-splines of degree k at the knots t(k+2)..t(n-k-1)
implicit none
! arguments
integer, intent(in) :: n, k2, nest
real(wp_), intent(in) :: t(n)
@ -1481,7 +1474,6 @@ contains
! to the sum of squared residuals.
! rank : integer, which contains the rank of matrix a.
!
implicit none
! ..scalar arguments..
integer n,m,na,rank
real(wp_) tol,sq
@ -1706,7 +1698,6 @@ contains
! first data point in the jth panel while nummer(i),i=1,2,...,m gives
! the number of the next data point in the panel.
! ..
implicit none
! ..scalar arguments..
integer m,kx,ky,nx,ny,nreg
! ..array arguments..
@ -1751,7 +1742,6 @@ contains
! subroutine fpgivs calculates the parameters of a givens
! transformation .
! ..
implicit none
! arguments
real(wp_), intent(in) :: piv
real(wp_), intent(out) :: cs, sn
@ -1773,7 +1763,6 @@ contains
ty,ny,p,c,nc,fp,fpx,fpy,mm,mynx,kx1,kx2,ky1,ky2,spx,spy,right,q, &
ax,ay,bx,by,nrx,nry)
! ..
implicit none
! arguments
integer, intent(in) :: kx, kx1, kx2, ky, ky1, ky2, mm, mx, my, mz, &
mynx, nx, ny, nc
@ -2127,7 +2116,6 @@ contains
! istart indicates that the smallest data point at which the new knot
! may be added is x(istart+1)
! ..
implicit none
! arguments
integer, intent(in) :: m, nest, istart
integer, intent(inout) :: n, nrint, nrdata(nest)
@ -2186,7 +2174,6 @@ contains
reducy,fpintx,fpinty,lastdi,nplusx,nplusy,nrx,nry,nrdatx,nrdaty, &
wrk,lwrk,ier)
! ..
implicit none
! arguments
integer, intent(in) :: kx,ky,mx,my,mz,nxest,nyest,maxit,nc,lwrk,iopt
integer, intent(inout) :: nx,ny,lastdi,nplusx,nplusy, &
@ -2559,7 +2546,6 @@ contains
subroutine fprota(cs,sn,a,b)
! subroutine fprota applies a givens rotation to a and b.
! ..
implicit none
! arguments
real(wp_), intent(in) :: cs, sn
real(wp_), intent(inout) :: a, b
@ -2577,7 +2563,6 @@ contains
! gives the value of p such that the rational interpolating function
! of the form r(p) = (u*p+v)/(p+w) equals zero at p.
! ..
implicit none
real(wp_) :: fprati
! arguments
real(wp_), intent(in) :: p2, f2
@ -2872,7 +2857,6 @@ contains
! latest update : march 1989
!
! ..
implicit none
! arguments
integer, intent(in) :: iopt, mx, my, kx, ky, nxest, nyest, lwrk, kwrk
integer, intent(out) :: ier
@ -3029,7 +3013,6 @@ contains
!
! latest update : march 1989
!
implicit none
! arguments
integer, intent(in) :: nx, ny, kx, ky, nux, nuy, mx, my, lwrk, kwrk
integer, intent(out) :: ier
@ -3190,7 +3173,6 @@ contains
!
! latest update : march 1989
!
implicit none
! arguments
integer, intent(in) :: nx, ny, kx, ky, nux, nuy, lwrk
integer, intent(out) :: ier
@ -3492,7 +3474,6 @@ contains
! latest update : march 1987
!
! ..
implicit none
! arguments
integer, intent(in) :: iopt, m, k, nest, lwrk
integer, intent(out) :: ier
@ -3550,7 +3531,6 @@ contains
subroutine fpcurf(iopt,x,y,w,m,xb,xe,k,s,nest,tol,maxit,k1,k2, &
n,t,c,fp,fpint,z,a,b,g,q,nrdata,ier)
! ..
implicit none
! arguments
integer, intent(in) :: iopt, m, k, nest, maxit, k1, k2
integer, intent(out) :: ier
@ -4009,7 +3989,6 @@ contains
!
! latest update : march 1987
!
implicit none
! arguments
integer, intent(in) :: n, k, nu, m
integer, intent(out) :: ier
@ -4145,7 +4124,6 @@ contains
!
! latest update : march 1987
!
implicit none
! arguments
integer, intent(in) :: n, k, m
integer, intent(out) :: ier
@ -4233,7 +4211,6 @@ contains
! latest update : march 1987
!
! ..
implicit none
! ..scalar arguments..
integer, intent(in) :: n,mest
integer, intent(out) :: m,ier
@ -4440,7 +4417,6 @@ contains
!
! latest update : march 1987
!
implicit none
! ..scalar arguments..
integer,intent(in) :: iopt,nx,ny,kx,ky,nu
integer,intent(out) :: ier
@ -4526,7 +4502,6 @@ contains
! x : real array,length 3, which contains the real zeros of p(x)
! n : integer, giving the number of real zeros of p(x).
! ..
implicit none
! ..scalar arguments..
real(wp_), intent(in) :: a,b,c,d
integer, intent(out) :: n

13
src/dispersion.f90
View File

@ -39,7 +39,6 @@ pure function colddisp(X, Y, Npl, sox) result(npr)
! returns the orthogonal one N⊥.
!
! Reference: IFP-CNR Internal Report FP 05/1 - App. A
implicit none
! subroutine arguments
@ -110,7 +109,6 @@ pure subroutine harmnumber(Y, mu, Npl2, weakly, nhmin, nhmax)
! A harmonic number is possible when its ellipse intersects a region
! containing a significant fraction of the electron population.
!
implicit none
! subroutine arguments
@ -228,7 +226,6 @@ subroutine warmdisp(X, Y, mu, Npl, Npr_cold, sox, &
use, intrinsic :: ieee_arithmetic, only : ieee_is_finite
use gray_errors, only : gray_error, warmdisp_convergence, warmdisp_result, &
raise_error
implicit none
! subroutine arguments
@ -483,8 +480,6 @@ subroutine dielectric_tensor(X, Y, mu, Npl, model, nlarmor, e330, epsl, error)
! Reference: https://doi.org/10.13182/FST08-A1660
use gray_errors, only : gray_error
implicit none
! subroutine arguments
! Inputs
@ -664,7 +659,6 @@ end subroutine dielectric_tensor
subroutine hermitian(rr,yg,mu,npl,cr,fast,lrm)
use eierf, only : calcei3
implicit none
! subroutine arguments
integer :: lrm,fast
@ -880,7 +874,6 @@ end subroutine hermitian
subroutine hermitian_2(rr,yg,mu,npl,cr,fast,lrm,error)
use gray_errors, only : gray_error, dielectric_tensor, raise_error
use quadpack, only : dqagsmv
implicit none
! local constants
integer,parameter :: lw=5000,liw=lw/4,npar=7
real(wp_), parameter :: epsa=zero,epsr=1.0e-4_wp_
@ -1029,7 +1022,6 @@ end subroutine hermitian_2
!
function fhermit(t,apar,npar)
use eierf, only : calcei3
implicit none
! arguments
integer, intent(in) :: npar
real(wp_), intent(in) :: t
@ -1081,7 +1073,6 @@ end function fhermit
!
!
subroutine antihermitian(ri,yg,mu,npl,ci,lrm)
implicit none
! local constants
integer, parameter :: lmx=20,nmx=lmx+2
! arguments
@ -1185,7 +1176,6 @@ end subroutine antihermitian
!
!
subroutine ssbi(zz,n,l,fsbi)
implicit none
! local constants
integer, parameter :: lmx=20,nmx=lmx+2
real(wp_), parameter :: eps=1.0e-10_wp_
@ -1215,7 +1205,6 @@ end subroutine ssbi
!
!
subroutine expinit
implicit none
! local variables
integer :: i
!
@ -1230,7 +1219,6 @@ end subroutine expinit
pure subroutine fsup(lrm, yg, npl, mu, cefp, cefm, error)
use gray_errors, only : gray_error, dielectric_tensor, raise_error
implicit none
! subroutine arguments
integer, intent(in) :: lrm
@ -1441,7 +1429,6 @@ pure subroutine zetac (xi, yi, zr, zi, iflag)
! reference - gpm poppe, cmj wijers; more efficient computation of
! the complex error-function, acm trans. math. software.
!
implicit none
real(wp_), intent(in) :: xi, yi
real(wp_), intent(out) :: zr, zi
integer, intent(out) :: iflag

10
src/eccd.f90
View File

@ -1,6 +1,8 @@
module eccd
use const_and_precisions, only : wp_
implicit none
real(wp_), parameter, private :: cst2min=1.0e-6_wp_ ! min width of trap. cone
integer, parameter, private :: nfpp=13, & ! number of extra parameters passed
nfpp1=nfpp+ 1, nfpp2=nfpp+ 2, & ! to the integrand function fpp
@ -100,7 +102,6 @@ module eccd
contains
subroutine setcdcoeff_notrap(zeff,cst2,eccdpar)
implicit none
real(wp_), intent(in) :: zeff
real(wp_), intent(out) :: cst2
real(wp_), dimension(:), pointer, intent(out) :: eccdpar
@ -119,7 +120,6 @@ contains
! Zeff < 31 !!!
! fp0s= P_a (alams)
use conical, only : fconic
implicit none
real(wp_), intent(in) :: zeff,rbn,rbx
real(wp_), intent(out) :: cst2
real(wp_), dimension(:), pointer, intent(out) :: eccdpar
@ -142,7 +142,6 @@ contains
use magsurf_data, only : ch,tjp,tlm,njpt,nlmt
use dierckx, only : profil
use logger, only : log_warning
implicit none
integer, parameter :: ksp=3
real(wp_), intent(in) :: zeff,rbx,fc,amu,rhop
real(wp_), intent(out) :: cst2
@ -178,7 +177,6 @@ contains
vcsi=>c_,qe=>ecgs_,me=>mecgs_,vc=>ccgs_,mc2=>mc2_
use gray_errors, only : fpp_integration, fcur_integration, raise_error
use quadpack, only : dqagsmv
implicit none
! local constants
real(wp_), parameter :: mc2m2=1.0_wp_/mc2**2, &
canucc=2.0e13_wp_*pi*qe**4/(me**2*vc**3),ceff=qesi/(mesi*vcsi)
@ -351,7 +349,6 @@ contains
!
use const_and_precisions, only : ui=>im
use math, only : fact
implicit none
! arguments
integer :: npar
real(wp_) :: upl,fpp
@ -434,7 +431,6 @@ contains
! extrapar(18) = fp0s
!
use conical, only : fconic
implicit none
! arguments
integer :: npar
real(wp_) :: upl,fjch
@ -497,7 +493,6 @@ contains
!
! extrapar(14) = zeff
!
implicit none
! arguments
real(wp_) :: upl,fjch0
integer :: npar
@ -549,7 +544,6 @@ contains
! extrapar(17+(npar-16)/2:npar) = chlm
!
use dierckx, only : splev,splder
implicit none
! arguments
integer :: npar
real(wp_) :: upl,fjncl

11
src/eierf.f90
View File

@ -1,7 +1,9 @@
module eierf
use const_and_precisions, only : wp_, zero, one
implicit none
real(wp_), parameter, private :: half=0.5_wp_, two=2.0_wp_, three=3.0_wp_, &
four=4.0_wp_, six=6.0_wp_, twelve=12._wp_, sixten=16.0_wp_, &
two4=24.0_wp_, fourty=40.0_wp_
@ -49,7 +51,6 @@ contains
! eone(x) x > 0 -ei(-x) 2
! expei(x) x /= 0 exp(-x)*ei(x) 3
!----------------------------------------------------------------------
implicit none
integer, intent(in) :: intt
real(wp_), intent(in) :: arg
real(wp_), intent(out) :: result
@ -311,7 +312,6 @@ contains
! latest modification: january 12, 1988
!
!--------------------------------------------------------------------
implicit none
integer :: intt
real(wp_) :: ei
real(wp_), intent(in) :: x
@ -334,7 +334,6 @@ contains
! latest modification: january 12, 1988
!
!--------------------------------------------------------------------
implicit none
integer :: intt
real(wp_) :: expei
real(wp_), intent(in) :: x
@ -356,7 +355,6 @@ contains
! latest modification: january 12, 1988
!
!--------------------------------------------------------------------
implicit none
integer :: intt
real(wp_) :: eone
real(wp_), intent(in) :: x
@ -406,7 +404,6 @@ contains
! eone(x) x > 0 -ei(-x) 2
! expei(x) x /= 0 exp(-x)*ei(x) 3
!----------------------------------------------------------------------
implicit none
real(wp_), intent(in) :: arg
real(wp_), intent(out) :: result
integer :: i
@ -708,7 +705,6 @@ contains
!! latest modification: march 19, 1990
!!
!!------------------------------------------------------------------
! implicit none
! real(wp_), intent(in) :: arg
! real(wp_), intent(out) :: result
! integer, intent(in) :: jintt
@ -852,7 +848,6 @@ contains
!! author/date: w. j. cody, january 8, 1985
!!
!!--------------------------------------------------------------------
! implicit none
! real(wp_) :: derf
! real(wp_), intent(in) :: x
! integer :: jintt
@ -872,7 +867,6 @@ contains
!! author/date: w. j. cody, january 8, 1985
!!
!!--------------------------------------------------------------------
! implicit none
! real(wp_) :: derfc
! real(wp_), intent(in) :: x
! integer :: jintt
@ -892,7 +886,6 @@ contains
!! author/date: w. j. cody, march 30, 1987
!!
!!------------------------------------------------------------------
! implicit none
! real(wp_) :: derfcx
! real(wp_), intent(in) :: x
! integer :: jintt

50
src/equilibrium.f90
View File

@ -90,8 +90,6 @@ contains
use utils, only : get_free_unit
use logger, only : log_error
implicit none
! subroutine arguments
type(equilibrium_parameters), intent(in) :: params
type(equilibrium_data), intent(out) :: data
@ -218,8 +216,6 @@ contains
use utils, only : get_free_unit
use logger, only : log_error
implicit none
! subroutine arguments
character(len=*), intent(in) :: filenm
integer, intent(in) :: ipass
@ -269,8 +265,6 @@ contains
use const_and_precisions, only : zero, one, pi
use gray_params, only : equilibrium_data
implicit none
! subroutine arguments
type(equilibrium_data), intent(inout) :: data
integer, intent(in) :: cocosin, cocosout
@ -315,7 +309,6 @@ contains
subroutine decode_cocos(cocos, exp2pi, phiccw, psiincr, qpos)
! Extracts the sign and units conventions from a COCOS index
implicit none
! subroutine arguments
integer, intent(in) :: cocos
@ -357,8 +350,6 @@ contains
use gray_params, only : equilibrium_parameters, equilibrium_data
use gray_params, only : iequil
implicit none
! subroutine arguments
type(equilibrium_parameters), intent(inout) :: params
type(equilibrium_data), intent(inout) :: data
@ -411,8 +402,6 @@ contains
use utils, only : vmaxmin, vmaxmini, inside
use logger, only : log_info
implicit none
! subroutine arguments
type(equilibrium_parameters), intent(in) :: params
type(equilibrium_data), intent(in) :: data
@ -703,8 +692,6 @@ contains
! rescales the contour by `t0` about `O` while ensuring the
! psi_spline stays monotonic within the new boundary.
implicit none
! subroutine arguments
type(contour), intent(inout) :: cont ! (R,z) contour
real(wp_), intent(in) :: O(2) ! center point
@ -738,7 +725,6 @@ contains
function s(t)
! Rescriction of ψ(R, z) on the line Q(t) = O + tN
implicit none
real(wp_), intent(in) :: t
real(wp_) :: s, Q(2)
@ -757,8 +743,6 @@ contains
use const_and_precisions, only : comp_eps
use dierckx, only : surfit
implicit none
! subroutine arguments
integer, intent(in) :: n
real(wp_), dimension(n), intent(in) :: x, y, z
@ -807,8 +791,6 @@ contains
! Computes the spline of the safety factor q(ψ)
use const_and_precisions, only : pi
implicit none
! subroutine arguments
real(wp_), dimension(:), intent(in) :: psinq,q
real(wp_), intent(in) :: psia
@ -839,8 +821,6 @@ contains
! in their respective global variables, see the top of this file.
use const_and_precisions, only : pi, one
implicit none
real(wp_) :: dq, gamma
btaxis = model%B0
@ -892,8 +872,6 @@ contains
! Computes the splines for converting between the poloidal (ρ_p)
! and toroidal (ρ_t) normalised radii
implicit none
! subroutine arguments
real(wp_), dimension(:), intent(in) :: rhop, rhot
@ -912,8 +890,6 @@ contains
use utils, only : inside
use const_and_precisions, only : pi
implicit none
! subroutine arguments
real(wp_), intent(in) :: R, z
real(wp_), intent(out), optional :: psi_n, dpsidr, dpsidz, &
@ -1062,8 +1038,6 @@ contains
! and (optionally) its derivative dF/dψ_n given ψ_n.
use gray_params, only : iequil
implicit none
! function arguments
real(wp_), intent(in) :: psi_n ! normalised poloidal flux
real(wp_), intent(out) :: fpol ! poloidal current
@ -1091,8 +1065,6 @@ contains
! Converts from poloidal (ρ_p) to toroidal (ρ_t) normalised radius
use gray_params, only : iequil
implicit none
! function arguments
real(wp_), intent(in) :: rho_p
real(wp_) :: frhotor
@ -1129,8 +1101,6 @@ contains
use gray_params, only : iequil
use const_and_precisions, only : comp_eps
implicit none
! function arguments
real(wp_), intent(in) :: rho_t
real(wp_) :: frhopol
@ -1160,7 +1130,6 @@ contains
subroutine equation(n, x, f, df, ldf, flag)
! The equation to solve: f(x) = ρ_t(x) - ρ_t₀ = 0
implicit none
! optimal step size
real(wp_), parameter :: e = comp_eps**(1/3.0_wp_)
@ -1189,8 +1158,6 @@ contains
! Note: this returns the absolute value of q.
use gray_params, only : iequil
implicit none
! function arguments
real(wp_), intent(in) :: psin
real(wp_) :: fq
@ -1217,8 +1184,6 @@ contains
!
! Note: all output arguments are optional.
implicit none
! subroutine arguments
real(wp_), intent(in) :: R, z
real(wp_), intent(out), optional :: B_R, B_z, B_phi
@ -1251,8 +1216,6 @@ contains
! Computes the toroidal current J_φ as a function of (R, z)
use const_and_precisions, only : mu0_
implicit none
! function arguments
real(wp_), intent(in) :: R, z
real(wp_) :: J_phi
@ -1287,8 +1250,6 @@ contains
function tor_curr_psi(psi_n) result(J_phi)
! Computes the toroidal current J_φ as a function of ψ
implicit none
! function arguments
real(wp_), intent(in) :: psi_n
real(wp_) :: J_phi
@ -1309,8 +1270,6 @@ contains
use dierckx, only : profil, sproota
use logger, only : log_error
implicit none
! subroutine arguments
real(wp_) :: psin,r1,r2
@ -1356,8 +1315,6 @@ contains
use minpack, only : hybrj1
use logger, only : log_error, log_debug
implicit none
! local constants
integer, parameter :: n=2,ldfjac=n,lwa=(n*(n+13))/2
@ -1392,8 +1349,6 @@ contains
subroutine fcnox(n,x,fvec,fjac,ldfjac,iflag)
use logger, only : log_error
implicit none
! subroutine arguments
integer, intent(in) :: n,iflag,ldfjac
real(wp_), dimension(n), intent(in) :: x
@ -1428,8 +1383,6 @@ contains
use minpack, only : hybrj1mv
use logger, only : log_error, log_debug
implicit none
! local constants
integer, parameter :: n=2,ldfjac=n,lwa=(n*(n+13))/2
@ -1465,8 +1418,6 @@ contains
subroutine fcntgo(n,x,f0,fvec,fjac,ldfjac,iflag)
use logger, only : log_error
implicit none
! subroutine arguments
integer, intent(in) :: n,ldfjac,iflag
real(wp_), dimension(n), intent(in) :: x,f0
@ -1498,7 +1449,6 @@ contains
subroutine unset_equil_spline
! Unsets the splines global variables, see the top of this file.
implicit none
call fpol_spline%deinit
call psi_spline%deinit

10
src/gray_cli.f90
View File

@ -83,8 +83,6 @@ contains
subroutine print_cli_options(opts)
! Prints the parsed CLI options (for debugging)
implicit none
! subroutine arguments
type(cli_options), intent(in) :: opts
@ -106,8 +104,6 @@ contains
use units, only : ucenr, usumm, all_enabled
use logger, only : WARNING
implicit none
! subroutine arguments
type(cli_options), intent(out) :: opts
@ -212,8 +208,6 @@ contains
use gray_params, only : gray_parameters, update_parameter
use ini_parser, only : ERR_VALUE, ERR_UNKNOWN
implicit none
! subroutine arguments
type(gray_parameters), intent(inout) :: params
@ -276,8 +270,6 @@ contains
subroutine get_next_command(i, arg)
! Reads a CLI argument into a deferred-length string
implicit none
! subroutine arguments
integer, intent(inout) :: i
character(len=:), allocatable, intent(inout) :: arg
@ -296,8 +288,6 @@ contains
subroutine deinit_cli_options(opts)
! Frees all memory allocated by the parse_cli_options subroutine
implicit none
! subroutine arguments
type(cli_options), intent(inout) :: opts

39
src/gray_core.f90
View File

@ -26,8 +26,6 @@ contains
wall_out
use logger, only : log_info, log_debug
implicit none
! subroutine arguments
type(gray_parameters), intent(inout) :: params
type(gray_data), intent(in) :: data
@ -619,7 +617,6 @@ contains
subroutine vectinit(psjki,ppabs,ccci,tau0,alphaabs0,dids0,ccci0,iiv)
use const_and_precisions, only : zero
implicit none
! arguments
real(wp_), dimension(:,:), intent(out) :: psjki,ppabs,ccci
real(wp_), dimension(:), intent(out) :: tau0,alphaabs0,dids0,ccci0
@ -655,8 +652,6 @@ contains
use gray_params, only : gray_parameters
use beamdata, only : nray,nrayr,nrayth,rwmax
implicit none
! subroutine arguments
type(gray_parameters), intent(in) :: params
real(wp_), dimension(3), intent(in) :: anv0c
@ -973,7 +968,6 @@ contains
! Runge-Kutta integrator
! use gray_params, only : igrad
use beamdata, only : h,hh,h6
implicit none
real(wp_), intent(in) :: bres,xgcn
real(wp_), dimension(6), intent(inout) :: y
real(wp_), dimension(6), intent(in) :: yp
@ -999,7 +993,6 @@ contains
subroutine rhs(sox,bres,xgcn,y,dgr,ddgr,dery,igrad)
! Compute right-hand side terms of the ray equations (dery)
! used in R-K integrator
implicit none
! arguments
real(wp_), dimension(6), intent(in) :: y
real(wp_), intent(in) :: bres,xgcn
@ -1025,7 +1018,6 @@ contains
! Compute right-hand side terms of the ray equations (dery)
! used after full R-K step and grad(S_I) update
use gray_errors, only : raise_error, large_npl
implicit none
! arguments
real(wp_), dimension(3), intent(in) :: xv,anv
real(wp_), dimension(3), intent(in) :: dgr
@ -1062,7 +1054,6 @@ contains
subroutine gradi_upd(ywrk,ak0,xc,du1,gri,ggri)
use const_and_precisions, only : zero,half
use beamdata, only : nray,nrayr,nrayth,twodr2
implicit none
real(wp_), intent(in) :: ak0
real(wp_), dimension(6,nray), intent(in) :: ywrk
real(wp_), dimension(3,nrayth,nrayr), intent(inout) :: xc,du1
@ -1210,7 +1201,6 @@ contains
! input vectors : dxv1, dxv2, dxv3, dff
! output vector : dgg
! dff=(1,0,0)
implicit none
! arguments
real(wp_), dimension(3), intent(in) :: dxv1,dxv2,dxv3
real(wp_), dimension(3), intent(out) :: dgg
@ -1230,7 +1220,6 @@ contains
subroutine solg3(dxv1,dxv2,dxv3,dff,dgg)
! rhs "matrix" dff, result in dgg
implicit none
! arguments
real(wp_), dimension(3), intent(in) :: dxv1,dxv2,dxv3
real(wp_), dimension(3,3), intent(in) :: dff
@ -1266,8 +1255,6 @@ contains
use equilibrium, only : psia, pol_flux, pol_curr, sgnbphi
use coreprofiles, only : density
implicit none
! subroutine arguments
real(wp_), dimension(3), intent(in) :: xv
real(wp_), intent(in) :: xgcn, bres
@ -1425,8 +1412,6 @@ contains
use const_and_precisions, only : zero, one, half, two
use gray_params, only : idst
implicit none
! subroutine arguments
! Inputs
@ -1704,7 +1689,6 @@ contains
use gray_errors, only : negative_absorption, raise_error
use magsurf_data, only : fluxval
implicit none
! subroutine arguments
@ -1855,8 +1839,6 @@ contains
use polarization, only : pol_limit, polellipse, &
stokes_ce, stokes_ell
implicit none
! subroutine arguments
real(wp_), dimension(6, nray), intent(in) :: ywrk0
real(wp_), intent(in) :: bres
@ -1915,7 +1897,6 @@ contains
subroutine cniteq(rqgrid,zqgrid,matr2dgrid,nr,nz,h,ncon,npts,icount,rcon,zcon)
! v2.01 12/07/95 -- written by d v bartlett, jet joint undertaking.
! (based on an older code)
implicit none
! arguments
integer, intent(in) :: nr,nz
real(wp_), dimension(nr), intent(in) :: rqgrid
@ -2131,8 +2112,6 @@ bb: do
unit_active, active_units
use gray_params, only : gray_parameters, headw, headl, print_parameters
implicit none
! subroutine arguments
type(gray_parameters), intent(in) :: params
@ -2183,8 +2162,6 @@ bb: do
use units, only : uprfin, unit_active
use magsurf_data, only : npsi
implicit none
! suborutine arguments
type(profiles_parameters), intent(in) :: params
@ -2217,8 +2194,6 @@ bb: do
use units, only : ubres, unit_active
use magsurf_data, only : npsi
implicit none
! subroutine arguments
real(wp_), intent(in) :: bres
@ -2284,8 +2259,6 @@ bb: do
use units, only : umaps, unit_active
use magsurf_data, only : npsi
implicit none
! subroutine arguments
real(wp_), intent(in) :: B_res ! resonant magnetic field, e/m_eω
real(wp_), intent(in) :: xgcn ! X normalisation, e²/ε₀m_eω²
@ -2336,8 +2309,6 @@ bb: do
use logger, only : log_info
use minpack, only : hybrj1
implicit none
! subroutine arguments
real(wp_), intent(in) :: qvals(:)
@ -2397,8 +2368,6 @@ bb: do
! The equation to solve: f(x) = q(x) - q₀ = 0
use const_and_precisions, only : comp_eps
implicit none
! subroutine arguments
integer, intent(in) :: n, ldf, flag
real(wp_), intent(in) :: x(n)
@ -2426,8 +2395,6 @@ bb: do
use beamdata, only : nray, nrayr, nrayth, rayi2jk
use units, only : uprj0, uwbm, unit_active
implicit none
! subroutine arguments
real(wp_), dimension(:), intent(in) :: stv
real(wp_), dimension(:,:), intent(in) :: ywrk
@ -2501,8 +2468,6 @@ bb: do
use beamdata, only : nray,nrayth,jkray1
use units, only : ucenr, uoutr, udisp, unit_active
implicit none
! subroutine arguments
integer, intent(in) :: i, jk, nhm, nhf, iokhawa, index_rt
real(wp_), dimension(3), intent(in) :: xv, bv, anv
@ -2566,8 +2531,6 @@ bb: do
use units, only : upec, unit_active
implicit none
! subroutine arguments
real(wp_), dimension(:), intent(in) :: rhop_tab, rhot_tab, jphi, jcd, &
dpdv, currins, pins
@ -2594,8 +2557,6 @@ bb: do
use units, only : ucenr, usumm, unit_active
implicit none
! subroutine arguments
real(wp_), intent(in) :: pabs, icd, dpdvp, jphip, rhotpav, rhotjava, &
drhotpav, drhotjava, dpdvmx, jphimx, rhotp, &

6
src/gray_errors.f90
View File

@ -87,8 +87,6 @@ contains
pure function is_critical(error)
! Checks whether critical errors have occurred
implicit none
! subroutines arguments
integer(kind=gray_error), intent(in) :: error
logical :: is_critical
@ -99,7 +97,6 @@ contains
pure function has_error(error, spec)
! Checks whether the `error` bitmask contains the error given by `spec`
implicit none
! function arguments
integer(kind=gray_error), intent(in) :: error
@ -113,7 +110,6 @@ contains
pure function raise_error(error, spec, subcase)
! Raise the bits of error `spec` (with optional `subcase` number)
! in the `error` bitmask.
implicit none
! function arguments
integer(kind=gray_error), intent(in) :: error
@ -133,7 +129,6 @@ contains
! is logged to the stderr using the logger module.
use const_and_precisions, only : wp_
implicit none
! subroutines arguments
integer, intent(in) :: error, step
@ -172,7 +167,6 @@ contains
! is logged to the stderr using the logger module.
use const_and_precisions, only : wp_
implicit none
! subroutines arguments
integer, intent(in) :: error, step

1
src/gray_jetto1beam.f90
View File

@ -6,7 +6,6 @@ subroutine gray_jetto1beam(ijetto, mr, mz, r, z, psin, psia, rax, zax, &
use gray_params, only: gray_parameters, gray_data, gray_results
use gray_core, only: gray_main
implicit none
! subroutine arguments
integer, intent(in) :: ijetto, mr, mz, nbnd, nrho, ibeam

12
src/gray_params.f90
View File

@ -1,7 +1,9 @@
module gray_params
use const_and_precisions, only : wp_
implicit none
integer, parameter :: lenfnm = 256
integer, parameter :: headw = 132, headl = 21
@ -141,7 +143,6 @@ module gray_params
contains
subroutine print_parameters(params, strout)
implicit none
! subroutine arguments
type(gray_parameters), intent(in) :: params
@ -253,8 +254,6 @@ contains
! Ex. update_parameter(params, 'raytracing.nrayr', '10')
use ini_parser, only : ini_error, ERR_SUCCESS, ERR_VALUE, ERR_UNKNOWN
implicit none
! function arguments
type(gray_parameters), intent(inout) :: params
character(*), intent(in) :: name, value
@ -277,7 +276,6 @@ contains
! Reads the GRAY parameters from the gray.ini configuration file
use ini_parser, only : parse_ini, property_handler, ini_error
implicit none
! subroutine arguments
character(len=*), intent(in) :: filename
@ -292,8 +290,6 @@ contains
! This function handles a single INI property and updates
! the `params` structure
implicit none
! function arguments
character(*), intent(in) :: section, name, value
integer(kind(ini_error)) :: err
@ -309,8 +305,6 @@ contains
use utils, only : get_free_unit
use logger, only : log_error
implicit none
! subrouting arguments
character(len=*), intent(in) :: filename
type(gray_parameters), intent(out) :: params
@ -373,8 +367,6 @@ contains
use logger, only : log_warning
implicit none
! subroutine arguments
type(gray_parameters), intent(inout) :: params

4
src/ini_parser.f90
View File

@ -14,6 +14,8 @@ module ini_parser
use logger, only : log_error
implicit none
! INI syntax constants
character, parameter :: comment_sign = ';'
character, parameter :: property_sep = '='
@ -60,8 +62,6 @@ contains
!
use utils, only : get_free_unit
implicit none
! function argument
character(*), intent(in) :: filepath
procedure(property_handler) :: handler

6
src/limiter.f90
View File

@ -1,6 +1,8 @@
module limiter
use const_and_precisions, only : wp_
implicit none
! Inner wall radius
real(wp_), save :: rwallm
@ -14,8 +16,6 @@ contains
! Set global variables exposed by this module.
use gray_params, only : equilibrium_data
implicit none
! subroutine arguments
type(equilibrium_data), intent(in) :: data
@ -33,8 +33,6 @@ contains
! Unset global variables exposed by this module.
use const_and_precisions, only : zero
implicit none
if(allocated(rlim)) deallocate(rlim)
if(allocated(zlim)) deallocate(zlim)
nlim = 0

14
src/logger.f90
View File

@ -10,6 +10,8 @@
! The format of the log is: [time] [module:procedure] [level] <message>
module logger
implicit none
! Log levels
enum, bind(C)
enumerator :: log_level = -1
@ -48,8 +50,6 @@ contains
use, intrinsic :: iso_fortran_env, only : error_unit
implicit none
! subroutine argument
character(*), intent(in) :: msg
integer(kind(log_level)), intent(in) :: level
@ -86,7 +86,6 @@ contains
subroutine log_error(msg, mod, proc)
! Logs an error
implicit none
character(*), intent(in) :: msg
character(*), intent(in) :: mod
character(*), intent(in), optional :: proc
@ -95,7 +94,6 @@ contains
subroutine log_warning(msg, mod, proc)
! Logs a warning
implicit none
character(*), intent(in) :: msg
character(*), intent(in) :: mod
character(*), intent(in), optional :: proc
@ -104,7 +102,6 @@ contains
subroutine log_info(msg, mod, proc)
! Logs an informational message
implicit none
character(*), intent(in) :: msg
character(*), intent(in) :: mod
character(*), intent(in), optional :: proc
@ -113,7 +110,6 @@ contains
subroutine log_debug(msg, mod, proc)
! Logs a debugging message
implicit none
character(*), intent(in) :: msg
character(*), intent(in) :: mod
character(*), intent(in), optional :: proc
@ -127,8 +123,6 @@ contains
! Only messages with a lower level than the current
! one will be actually logged.
implicit none
! subroutine arguments
integer(kind(log_level)), intent(in) :: level
character(25) :: msg
@ -143,8 +137,6 @@ contains
pure function level_color(level) result(escape)
! The color associated to a log level
implicit none
! function arguments
integer(kind(log_level)), intent(in) :: level
character(8) :: escape
@ -166,8 +158,6 @@ contains
pure function level_name(level) result(name)
! The human readable name of a log level
implicit none
! function arguments
integer(kind(log_level)), intent(in) :: level
character(7) :: name

12
src/magsurf_data.f90
View File

@ -25,7 +25,6 @@ module magsurf_data
contains
subroutine alloc_cnt(ierr)
implicit none
integer, intent(out) :: ierr
if(npsi.le.0.or.npoints.le.0) then
@ -38,7 +37,6 @@ contains
end subroutine alloc_cnt
subroutine dealloc_cnt
implicit none
if(allocated(psicon)) deallocate(psicon)
if(allocated(rcon)) deallocate(rcon)
if(allocated(zcon)) deallocate(zcon)
@ -46,7 +44,6 @@ contains
subroutine alloc_surfvec(ierr)
implicit none
integer, intent(out) :: ierr
if(npsi.le.0.or.npoints.le.0) then
@ -63,7 +60,6 @@ contains
end subroutine alloc_surfvec
subroutine dealloc_surfvec
implicit none
call dealloc_cnt
if(allocated(pstab)) deallocate(pstab)
if(allocated(rhot_eq)) deallocate(rhot_eq)
@ -104,7 +100,6 @@ contains
use equilibrium, only : btrcen,btaxis,rmaxis,zmaxis,phitedge,zbsup,zbinf, &
bfield,frhotor,fq,tor_curr,psia,pol_flux
use dierckx, only : regrid,coeff_parder
implicit none
! local constants
integer, parameter :: nnintp=101,ncnt=100,nlam=101,ksp=3, &
@ -409,7 +404,6 @@ contains
subroutine fluxval(rhop,area,vol,dervol,dadrhot,dvdrhot, &
rri,rbav,bmn,bmx,fc,ratja,ratjb,ratjpl)
use const_and_precisions, only : wp_
implicit none
! subroutine arguments
real(wp_), intent(in) :: rhop
@ -447,8 +441,6 @@ contains
kspl, points_tgo
use limiter, only : rwallm
implicit none
! local constants
integer, parameter :: mest=4
@ -529,8 +521,6 @@ contains
use const_and_precisions, only : wp_, comp_tiny
use units, only : ucnt, unit_active
implicit none
! subroutine arguments
real(wp_), intent(in) :: psin
real(wp_), dimension(:), intent(in) :: rc, zc
@ -560,8 +550,6 @@ contains
use const_and_precisions, only : wp_, comp_tiny
use units, only : uflx, unit_active
implicit none
! subroutine arguments
real(wp_), intent(in) :: psin, rhot, bav, bmx, bmn, area, vol, &
currp, ajphiav, ffc, ratja, ratjb, qq

16
src/main.f90
View File

@ -9,7 +9,6 @@ program main
use gray_params, only : gray_parameters, gray_data, gray_results, &
read_gray_params, read_gray_config, &
params_set_globals => set_globals
implicit none
! CLI options
@ -211,8 +210,6 @@ contains
set_equil_an, set_equil_spline, scale_equil
use logger, only : log_debug
implicit none
! subroutine arguments
type(gray_parameters), intent(inout) :: params
type(gray_data), intent(out) :: data
@ -255,8 +252,6 @@ contains
use gray_params, only : equilibrium_data
use equilibrium, only : unset_equil_spline
implicit none
! subroutine arguments
type(equilibrium_data), intent(inout) :: data
@ -282,8 +277,6 @@ contains
set_profiles_spline
use logger, only : log_debug
implicit none
! subroutine arguments
type(profiles_parameters), intent(inout) :: params
real(wp_), intent(in) :: factb
@ -338,8 +331,6 @@ contains
use gray_params, only : profiles_data
use coreprofiles, only : unset_profiles_spline
implicit none
! subroutine arguments
type(profiles_data), intent(inout) :: data
@ -359,8 +350,6 @@ contains
use beams, only : read_beam0, read_beam1, read_beam2
use gray_params, only : antenna_parameters
implicit none
! subroutine arguments
type(antenna_parameters), intent(inout) :: params
integer, intent(out) :: err
@ -389,8 +378,6 @@ contains
use limiter, only : limiter_set_globals=>set_globals
use const_and_precisions, only : cm
implicit none
! subroutine arguments
type(gray_parameters), intent(inout) :: params
type(gray_data), intent(inout) :: data
@ -453,8 +440,6 @@ contains
! Free all memory allocated by the init_misc subroutine.
use limiter, only : limiter_unset_globals=>unset_globals
implicit none
! Unset the global variables of the `limiter` module
call limiter_unset_globals
end subroutine deinit_misc
@ -476,7 +461,6 @@ contains
use gray_core, only : print_headers, print_finals, print_pec, &
print_bres, print_prof, print_maps, &
print_surfq
implicit none
! subroutine arguments
type(gray_parameters), intent(inout) :: params

1
src/math.f90
View File

@ -10,7 +10,6 @@ contains
! Note: the result is a real number
use const_and_precisions, only : wp_
implicit none
integer, intent(in) :: k
real(wp_) :: fact

15
src/minpack.f90
View File

@ -1,13 +1,13 @@
module minpack
use const_and_precisions, only : wp_
implicit none
contains
subroutine hybrj1(fcn,n,x,fvec,fjac,ldfjac,tol,info,wa,lwa)
use const_and_precisions, only : zero, one
implicit none
! arguments
integer, intent(in) :: n, ldfjac, lwa
integer, intent(out) :: info
@ -115,7 +115,6 @@ contains
interface
subroutine fcn(n,x,fvec,fjac,ldfjac,iflag)
use const_and_precisions, only : wp_
implicit none
integer, intent(in) :: n,ldfjac,iflag
real(wp_), intent(in) :: x(n)
real(wp_), intent(inout) :: fvec(n),fjac(ldfjac,n)
@ -149,7 +148,6 @@ contains
factor,nprint,info,nfev,njev,r,lr,qtf,wa1,wa2, &
wa3,wa4)
use const_and_precisions, only : zero, one, epsmch=>comp_eps
implicit none
! arguments
integer, intent(in) :: n, ldfjac, maxfev, mode, nprint, lr
integer, intent(out) :: info, nfev, njev
@ -313,7 +311,6 @@ contains
interface
subroutine fcn(n,x,fvec,fjac,ldfjac,iflag)
use const_and_precisions, only : wp_
implicit none
integer, intent(in) :: n,ldfjac,iflag
real(wp_), intent(in) :: x(n)
real(wp_), intent(inout) :: fvec(n),fjac(ldfjac,n)
@ -589,7 +586,6 @@ contains
subroutine hybrj1mv(fcn,n,x,f0,fvec,fjac,ldfjac,tol,info,wa,lwa)
use const_and_precisions, only : zero, one
implicit none
! arguments
integer, intent(in) :: n, ldfjac, lwa
integer, intent(out) :: info
@ -697,7 +693,6 @@ contains
interface
subroutine fcn(n,x,f0,fvec,fjac,ldfjac,iflag)
use const_and_precisions, only : wp_
implicit none
integer, intent(in) :: n,ldfjac,iflag
real(wp_), intent(in) :: x(n),f0(n)
real(wp_), intent(inout) :: fvec(n),fjac(ldfjac,n)
@ -731,7 +726,6 @@ contains
factor,nprint,info,nfev,njev,r,lr,qtf,wa1,wa2, &
wa3,wa4)
use const_and_precisions, only : zero, one, epsmch=>comp_eps
implicit none
! arguments
integer, intent(in) :: n, ldfjac, maxfev, mode, nprint, lr
integer, intent(out) :: info, nfev, njev
@ -895,7 +889,6 @@ contains
interface
subroutine fcn(n,x,f0,fvec,fjac,ldfjac,iflag)
use const_and_precisions, only : wp_
implicit none
integer, intent(in) :: n,ldfjac,iflag
real(wp_), intent(in) :: x(n),f0(n)
real(wp_), intent(inout) :: fvec(n),fjac(ldfjac,n)
@ -1171,7 +1164,6 @@ contains
subroutine dogleg(n,r,lr,diag,qtb,delta,x,wa1,wa2)
use const_and_precisions, only : zero, one, epsmch=>comp_eps
implicit none
! arguments
integer, intent(in) :: n, lr
real(wp_), intent(in) :: delta, r(lr), diag(n), qtb(n)
@ -1340,7 +1332,6 @@ contains
function enorm(n,x)
use const_and_precisions, only : zero, one
implicit none
real(wp_) :: enorm
integer, intent(in) :: n
real(wp_), dimension(n), intent(in) :: x
@ -1439,7 +1430,6 @@ contains
subroutine qform(m,n,q,ldq,wa)
use const_and_precisions, only : zero, one
implicit none
! arguments
integer, intent(in) :: m,n,ldq
real(wp_), intent(out) :: wa(m)
@ -1531,7 +1521,6 @@ contains
subroutine qrfac(m,n,a,lda,pivot,ipvt,lipvt,rdiag,acnorm,wa)
use const_and_precisions, only : zero, one, epsmch=>comp_eps
implicit none
! arguments
integer, intent(in) :: m, n, lda, lipvt
integer, intent(out) :: ipvt(lipvt)
@ -1694,7 +1683,6 @@ contains
subroutine r1mpyq(m,n,a,lda,v,w)
use const_and_precisions, only : one
implicit none
! arguments
integer, intent(in) :: m, n, lda
real(wp_), intent(in) :: v(n),w(n)
@ -1786,7 +1774,6 @@ contains
subroutine r1updt(m,n,s,ls,u,v,w,sing)
use const_and_precisions, only : zero, one, giant=>comp_huge
implicit none
! arguments
integer, intent(in) :: m, n, ls
logical, intent(out) :: sing

9
src/multipass.f90
View File

@ -15,7 +15,6 @@ contains
! ------------------------------
subroutine plasma_in(i,xv,anv,bres,sox,cpl,psipol1,chipol1,iop,ext,eyt) ! ray enters plasma
implicit none
! arguments
integer, intent(in) :: i ! ray index
real(wp_), dimension(3), intent(in) :: xv,anv
@ -64,7 +63,6 @@ contains
end subroutine plasma_in
! ------------------------------
subroutine plasma_out(i,xv,anv,bres,sox,iop,ext,eyt) ! ray exits plasma
implicit none
! arguments
integer, intent(in) :: i ! ray index
real(wp_), dimension(3), intent(in) :: xv,anv
@ -91,14 +89,12 @@ contains
end subroutine plasma_out
! ------------------------------
! subroutine wall_in(i) ! ray enters vessel
! implicit none
! integer, intent(in) :: i ! ray index
!
! iow(i)=iow(i)+1
! end subroutine wall_in
! ------------------------------
subroutine wall_out(i,ins,xv,anv,bres,sox,psipol1,chipol1,iow,iop,ext,eyt) ! ray exits vessel
implicit none
! arguments
integer, intent(in) :: i ! ray index
logical, intent(in) :: ins ! inside plasma? (ins=1 plasma/wall overlap)
@ -138,7 +134,6 @@ contains
dpdv_beam,jcd_beam) ! initialization at beam propagation start
use logger, only : log_info, log_warning
implicit none
! arguments
integer, intent(in) :: i ! beam index
logical, dimension(:,:), intent(in), pointer :: iroff ! global ray status (F = active, T = inactive)
@ -169,7 +164,6 @@ contains
! ------------------------------
subroutine initmultipass(i,iox,iroff,yynext,yypnext,yw0,ypw0,stnext,p0ray, &
taus,tau1,etau1,cpls,cpl1,lgcpl1,psipv,chipv) ! initialization before pass loop
implicit none
! arguments
integer, intent(in) :: i, iox ! ipol, mode active on 1st pass
logical, dimension(:,:), intent(out), pointer :: iroff ! global ray status (F = active, T = inactive)
@ -197,7 +191,6 @@ contains
end subroutine initmultipass
! ------------------------------
subroutine turnoffray(jk,ip,ib,iroff) ! turn off ray propagation
implicit none
! arguments
integer, intent(in) :: jk, ip, ib ! ray (0=all rays), pass, beam indexes
logical, dimension(:,:), intent(out), pointer :: iroff ! global ray status (F = active, T = inactive)
@ -223,7 +216,6 @@ contains
subroutine alloc_multipass(dim,iwait,iroff,iop,iow,yynext,yypnext,yw0,ypw0,stnext, &
stv,p0ray,taus,tau1,etau1,cpls,cpl1,lgcpl1,jphi_beam, &
pins_beam,currins_beam,dpdv_beam,jcd_beam,psipv,chipv)
implicit none
integer :: dim
logical, dimension(:), intent(out), pointer :: iwait
logical, dimension(:,:), intent(out), pointer :: iroff
@ -253,7 +245,6 @@ contains
subroutine dealloc_multipass(iwait,iroff,iop,iow,yynext,yypnext,yw0,ypw0,stnext, &
stv,p0ray,taus,tau1,etau1,cpls,cpl1,lgcpl1,jphi_beam, &
pins_beam,currins_beam,dpdv_beam,jcd_beam,psipv,chipv)
implicit none
logical, dimension(:), intent(out), pointer :: iwait
logical, dimension(:,:), intent(out), pointer :: iroff
integer, dimension(:), intent(out), pointer :: iop,iow

5
src/numint.f90
View File

@ -1,6 +1,7 @@
module numint
use const_and_precisions, only : wp_, zero, one
implicit none
contains
@ -8,7 +9,6 @@ contains
subroutine simpson (n,h,fi,s)
! subroutine for integration over f(x) with the simpson rule. fi:
! integrand f(x); h: interval; s: integral. copyright (c) tao pang 1997.
implicit none
integer, intent(in) :: n
real(wp_), intent(in) :: h
real(wp_), dimension(n), intent(in) :: fi
@ -34,7 +34,6 @@ contains
! subroutine for integration with the trapezoidal rule.
! fi: integrand f(x); xi: abscissa x;
! s: integral Int_{xi(1)}^{xi(n)} f(x)dx
implicit none
integer, intent(in) :: n
real(wp_), dimension(n), intent(in) :: xi,fi
real(wp_), intent(out) :: s
@ -48,7 +47,6 @@ contains
end subroutine trapezoid
subroutine quanc8(fun,a,b,abserr,relerr,result,errest,nofun,flag)
implicit none
real(wp_), intent(in) :: a, b, abserr, relerr
real(wp_), intent(out) :: result, errest, flag
integer, intent(out) :: nofun
@ -88,7 +86,6 @@ contains
interface
function fun(x)
use const_and_precisions, only : wp_
implicit none
real(wp_), intent(in) :: x
real(wp_) :: fun
end function fun

7
src/pec.f90
View File

@ -1,6 +1,8 @@
module pec
use const_and_precisions, only : wp_,zero,one
implicit none
real(wp_), dimension(:), allocatable, save :: rhop_tab,rhot_tab
real(wp_), dimension(:), allocatable, save :: rtabpsi1
real(wp_), dimension(:), allocatable, save :: dvol,darea
@ -12,7 +14,6 @@ contains
use equilibrium, only : frhotor,frhopol
use gray_params, only : nnd
use magsurf_data, only : fluxval
implicit none
! arguments
integer, intent(in) :: ipec
real(wp_), dimension(nnd), intent(in), optional :: rt_in
@ -82,7 +83,6 @@ contains
subroutine spec(psjki,ppabs,ccci,iiv,pabs,currt,dpdv,ajphiv,ajcd,pins,currins)
use gray_params, only : nnd
use beamdata, only : nray,nstep
implicit none
! arguments
real(wp_), dimension(nray,nstep), intent(in) :: psjki,ppabs,ccci
integer, dimension(nray), intent(in) :: iiv
@ -245,7 +245,6 @@ contains
use gray_params, only : nnd
use equilibrium, only : frhopol
use magsurf_data, only : fluxval
implicit none
real(wp_), intent(in) :: pabs,currt
real(wp_), dimension(nnd), intent(in) :: rhot_tab
real(wp_), dimension(nnd), intent(in) :: dpdv,ajphiv
@ -317,7 +316,6 @@ contains
subroutine profwidth(nd,xx,yy,xpk,ypk,dxxe)
use const_and_precisions, only : wp_,emn1
use utils, only : locatex, locate, intlin, vmaxmini
implicit none
! arguments
integer :: nd
real(wp_), dimension(nd) :: xx,yy
@ -380,7 +378,6 @@ contains
end subroutine profwidth
subroutine dealloc_pec
implicit none
if (allocated(rhop_tab)) deallocate(rhop_tab)
if (allocated(rhot_tab)) deallocate(rhot_tab)

8
src/polarization.f90
View File

@ -1,4 +1,7 @@
module polarization
implicit none
interface stokes
module procedure stokes_ce,stokes_ell
end interface
@ -6,7 +9,6 @@ module polarization
contains
subroutine stokes_ce(ext,eyt,qq,uu,vv)
use const_and_precisions, only : wp_
implicit none
! arguments
complex(wp_), intent(in) :: ext,eyt
real(wp_), intent(out) :: qq,uu,vv
@ -19,7 +21,6 @@ contains
subroutine stokes_ell(chi,psi,qq,uu,vv)
use const_and_precisions, only : wp_,two
implicit none
! arguments
real(wp_), intent(in) :: chi,psi
real(wp_), intent(out) :: qq,uu,vv
@ -32,7 +33,6 @@ contains
subroutine polellipse(qq,uu,vv,psi,chi)
use const_and_precisions, only : wp_,half
implicit none
! arguments
real(wp_), intent(in) :: qq,uu,vv
real(wp_), intent(out) :: psi,chi
@ -48,7 +48,6 @@ contains
subroutine pol_limit(anv,bv,bres,sox,ext,eyt) !,gam)
use const_and_precisions, only : wp_,ui=>im,zero,one
implicit none
! arguments
real(wp_), dimension(3), intent(in) :: anv,bv
real(wp_), intent(in) :: bres
@ -100,7 +99,6 @@ contains
subroutine polarcold(anpl,anpr,xg,yg,sox,exf,eyif,ezf,elf,etf)
use const_and_precisions, only : wp_,zero,one
implicit none
! arguments
real(wp_), intent(in) :: anpl,anpr,xg,yg,sox
real(wp_), intent(out) :: exf,eyif,ezf,elf,etf

17
src/quadpack.f90
View File

@ -1,6 +1,7 @@
module quadpack
use const_and_precisions, only : wp_
implicit none
contains
@ -160,7 +161,6 @@ contains
!***end prologue dqags
!
!
implicit none
real(wp_), intent(in) :: a,b,epsabs,epsrel
integer, intent(in) :: lenw,limit
real(wp_), intent(out) :: abserr,result
@ -347,7 +347,6 @@ contains
!
use const_and_precisions, only : epmach=>comp_eps, uflow=>comp_tiny, &
oflow=>comp_huge
implicit none
real(wp_), intent(in) :: a,b,epsabs,epsrel
integer, intent(in) :: limit
real(wp_), intent(out) :: result,abserr
@ -708,7 +707,6 @@ contains
!***end prologue dqelg
!
use const_and_precisions, only : epmach=>comp_eps, oflow=>comp_huge
implicit none
real(wp_), intent(out) :: abserr,result
real(wp_), dimension(52), intent(inout) :: epstab
real(wp_), dimension(3), intent(inout) :: res3la
@ -903,7 +901,6 @@ contains
!***end prologue dqk21
!
use const_and_precisions, only : epmach=>comp_eps, uflow=>comp_tiny
implicit none
real(wp_), intent(in) :: a,b
real(wp_), intent(out) :: result,abserr,resabs,resasc
real(wp_), external :: f
@ -1086,7 +1083,6 @@ contains
!
!***end prologue dqpsrt
!
implicit none
integer, intent(in) :: last,limit
real(wp_), intent(out) :: ermax
integer, intent(inout) :: maxerr,nrmax
@ -1327,7 +1323,6 @@ contains
!***routines called dqagie,xerror
!***end prologue dqagi
!
implicit none
integer, intent(in) :: lenw,limit,inf
real(wp_), intent(in) :: bound,epsabs,epsrel
real(wp_), intent(out) :: result,abserr
@ -1510,7 +1505,6 @@ contains
!***end prologue dqagie
use const_and_precisions, only : epmach=>comp_eps, uflow=>comp_tiny, &
oflow=>comp_huge
implicit none
integer, intent(in) :: limit,inf
real(wp_), intent(in) :: bound,epsabs,epsrel
real(wp_), intent(out) :: result,abserr
@ -1897,7 +1891,6 @@ contains
!***end prologue dqk15i
!
use const_and_precisions, only : epmach=>comp_eps, uflow=>comp_tiny
implicit none
real(wp_), intent(in) :: a,b,boun
integer, intent(in) :: inf
real(wp_), intent(out) :: result,abserr,resabs,resasc
@ -2206,7 +2199,6 @@ contains
!***routines called dqagpe,xerror
!***end prologue dqagp
!
implicit none
real(wp_), intent(in) :: a,b,epsabs,epsrel
integer, intent(in) :: npts2,lenw,leniw
real(wp_), intent(in), dimension(npts2) ::points
@ -2438,7 +2430,6 @@ contains
!***end prologue dqagpe
use const_and_precisions, only : epmach=>comp_eps, uflow=>comp_tiny, &
oflow=>comp_huge
implicit none
real(wp_) :: a,abseps,abserr,alist,area,area1,area12,area2,a1, &
a2,b,blist,b1,b2,correc,defabs,defab1,defab2, &
dres,elist,epsabs,epsrel,erlarg,erlast,errbnd, &
@ -2977,7 +2968,6 @@ contains
!***end prologue dqagsmv
!
!
implicit none
real(wp_), intent(in) :: a,b,epsabs,epsrel
integer, intent(in) :: lenw,limit,np
real(wp_), dimension(np), intent(in) :: apar
@ -3169,7 +3159,6 @@ contains
!
use const_and_precisions, only : epmach=>comp_eps, uflow=>comp_tiny, &
oflow=>comp_huge
implicit none
real(wp_), intent(in) :: a,b,epsabs,epsrel
integer, intent(in) :: limit,np
real(wp_), dimension(np), intent(in) :: apar
@ -3537,7 +3526,6 @@ contains
!***end prologue dqk21mv
!
use const_and_precisions, only : epmach=>comp_eps, uflow=>comp_tiny
implicit none
real(wp_), intent(in) :: a,b
integer, intent(in) :: np
real(wp_), dimension(np), intent(in) :: apar
@ -3830,7 +3818,6 @@ contains
!***routines called dqagiemv,xerror
!***end prologue dqagimv
!
implicit none
integer, intent(in) :: lenw,limit,inf,np
real(wp_), intent(in) :: bound,epsabs,epsrel
real(wp_), dimension(np), intent(in) :: apar
@ -4018,7 +4005,6 @@ contains
!***end prologue dqagiemv
use const_and_precisions, only : epmach=>comp_eps, uflow=>comp_tiny, &
oflow=>comp_huge
implicit none
integer, intent(in) :: limit,inf,np
real(wp_), intent(in) :: bound,epsabs,epsrel
real(wp_), dimension(np), intent(in) :: apar
@ -4410,7 +4396,6 @@ contains
!***end prologue dqk15imv
!
use const_and_precisions, only : epmach=>comp_eps, uflow=>comp_tiny
implicit none
real(wp_), intent(in) :: a,b,boun
integer, intent(in) :: inf,np
real(wp_), dimension(np), intent(in) :: apar

8
src/reflections.f90
View File

@ -1,5 +1,6 @@
module reflections
use const_and_precisions, only : wp_, comp_tiny, comp_eps, comp_huge, zero, one
implicit none
private
@ -10,7 +11,6 @@ module reflections
contains
subroutine reflect(ki,nsurf,ko)
implicit none
real(wp_), intent(in), dimension(3) :: ki
real(wp_), intent(in), dimension(3) :: nsurf
real(wp_), intent(out), dimension(3) :: ko
@ -27,7 +27,6 @@ end subroutine reflect
subroutine inters_linewall(xv,kv,rw,zw,nw,sint,normw)
implicit none
real(wp_), intent(in), dimension(3) :: xv,kv
integer, intent(in) :: nw
real(wp_), dimension(nw), intent(in) :: rw,zw
@ -83,7 +82,6 @@ end subroutine inters_linewall
subroutine linecone_coord(xv,kv,rs,zs,s,t,n)
use utils, only : bubble
implicit none
real(wp_), intent(in), dimension(3) :: xv,kv
real(wp_), intent(in), dimension(2) :: rs,zs
real(wp_), dimension(2), intent(out) :: s,t
@ -155,7 +153,6 @@ end subroutine linecone_coord
subroutine interssegm_coord(xa,ya,xb,yb,s,t,ierr)
implicit none
real(wp_), dimension(2), intent(in) :: xa,ya,xb,yb
real(wp_), intent(out) :: s,t
integer, intent(out) :: ierr
@ -179,7 +176,6 @@ end subroutine interssegm_coord
function interssegm(xa,ya,xb,yb)
implicit none
real(wp_), dimension(2), intent(in) :: xa,ya,xb,yb
logical :: interssegm
real(wp_) :: s,t
@ -194,7 +190,6 @@ end function interssegm
subroutine wall_refl(xv,anv,ext,eyt,xvrfl,anvrfl,extr,eytr,walln,irfl)
use limiter, only : rlim,zlim,nlim
use utils, only : inside
implicit none
! arguments
integer :: irfl
real(wp_), dimension(3) :: xv,anv,xvrfl,anvrfl,walln
@ -268,4 +263,3 @@ subroutine wall_refl(xv,anv,ext,eyt,xvrfl,anvrfl,extr,eytr,walln,irfl)
end subroutine wall_refl
end module reflections

32
src/splines.f90
View File

@ -78,8 +78,6 @@ contains
subroutine spline_simple_init(self, x, y, n)
! Initialises the spline
implicit none
! subroutine arguments
class(spline_simple), intent(inout) :: self
integer, intent(in) :: n
@ -97,7 +95,6 @@ contains
subroutine spline_simple_deinit(self)
! Deinitialises a simple_spline
implicit none
! subroutine arguments
class(spline_simple), intent(inout) :: self
@ -112,8 +109,6 @@ contains
! Evaluates the spline at x
use utils, only : locate
implicit none
! subroutine arguments
class(spline_simple), intent(in) :: self
real(wp_), intent(in) :: x
@ -133,8 +128,6 @@ contains
function spline_simple_raw_eval(self, i, dx) result(y)
! Evaluates the i-th polynomial of the spline at dx
implicit none
! subroutine arguments
class(spline_simple), intent(in) :: self
integer, intent(in) :: i
@ -150,7 +143,6 @@ contains
! Computes the derivative of the spline at x
use utils, only : locate
implicit none
! subroutine arguments
class(spline_simple), intent(in) :: self
@ -170,7 +162,6 @@ contains
subroutine spline_simple_coeffs(x, y, n, c)
! Computes the cubic coefficients of all n polynomials
implicit none
! subroutine arguments
integer, intent(in) :: n
@ -278,8 +269,6 @@ contains
! err: error code of `curfit`
use dierckx, only : curfit
implicit none
! subroutine arguments
class(spline_1d), intent(inout) :: self
real(wp_), intent(in) :: x(n)
@ -322,7 +311,6 @@ contains
subroutine spline_1d_deinit(self)
! Deinitialises a spline_1d
implicit none
class(spline_1d), intent(inout) :: self
@ -336,8 +324,6 @@ contains
! Evaluates the spline at x
use dierckx, only : splev
implicit none
! subroutine arguments
class(spline_1d), intent(in) :: self
real(wp_), intent(in) :: x
@ -356,8 +342,6 @@ contains
! Evaluates the spline n-th order derivative at x
use dierckx, only : splder
implicit none
! subroutine arguments
class(spline_1d), intent(in) :: self
real(wp_), intent(in) :: x
@ -391,8 +375,6 @@ contains
! err: error code of `curfit`
use dierckx, only : regrid
implicit none
! subroutine arguments
class(spline_2d), intent(inout) :: self
real(wp_), intent(in) :: x(nx)
@ -440,7 +422,6 @@ contains
subroutine spline_2d_deinit(self)
! Deinitialises a spline_2d
implicit none
class(spline_2d), intent(inout) :: self
@ -467,8 +448,6 @@ contains
! Evaluates the spline at (x, y)
use dierckx, only : fpbisp
implicit none
! subroutine arguments
class(spline_2d), intent(in) :: self
real(wp_), intent(in) :: x, y
@ -499,8 +478,6 @@ contains
! Note: for simplicity, only up to second-order is supported.
use dierckx, only : coeff_parder
implicit none
! subroutine arguments
class(spline_2d), intent(inout) :: self
integer, intent(in) :: p, q ! grid dimensions
@ -535,8 +512,6 @@ contains
! initialised with init_deriv before calling this method.
use dierckx, only : fpbisp
implicit none
! subroutine arguments
class(spline_2d), intent(in) :: self
real(wp_), intent(in) :: x, y
@ -560,8 +535,6 @@ contains
subroutine linear_1d_init(self, x, y, n)
! Initialises the spline
implicit none
! subroutine arguments
class(linear_1d), intent(inout) :: self
integer, intent(in) :: n
@ -579,7 +552,6 @@ contains
subroutine linear_1d_deinit(self)
! Deinitialises a linear_1d
implicit none
! subroutine arguments
class(linear_1d), intent(inout) :: self
@ -594,8 +566,6 @@ contains
! Evaluates the linear interpolated data at x
use utils, only : locate
implicit none
! subroutine arguments
class(linear_1d), intent(in) :: self
real(wp_), intent(in) :: x
@ -613,8 +583,6 @@ contains
function linear_1d_raw_eval(self, i, x) result(y)
! Performs the linear interpolation in the i-th interval
implicit none
! subroutine arguments
class(linear_1d), intent(in) :: self
integer, intent(in) :: i

8
src/units.f90
View File

@ -2,6 +2,8 @@
! all the GRAY output ifles and a mechanism to toggle them
module units
implicit none
! Unit numbers
#ifdef JINTRAC
! JINTRAC
@ -31,8 +33,6 @@ contains
! All units are inactive by default and no output
! will be directed to them.
implicit none
! subroutine arguments
integer, intent(in) :: units(:)
@ -44,8 +44,6 @@ contains
subroutine close_units
! Close all the active units to flush the buffer.
implicit none
integer :: i
if (allocated(active_units)) then
@ -61,8 +59,6 @@ contains
function unit_active(unit) result(on)
! Checks whether the given `unit` is active
implicit none
! function arguments
integer, intent(in) :: unit
logical :: on

19
src/utils.f90
View File

@ -1,6 +1,7 @@
module utils
use const_and_precisions, only : wp_
implicit none
contains
@ -11,7 +12,6 @@ contains
! a(j) < x <= a(j+1) for a increasing, and such that
! a(j+1) < x <= a(j) for a decreasing.
! j=0 or j=n indicate that x is out of range (Numerical Recipes)
implicit none
integer, intent(in) :: n
real(wp_), dimension(n), intent(in) :: a
real(wp_), intent(in) :: x
@ -33,7 +33,6 @@ contains
end function locatef
subroutine locate(xx,n,x,j)
implicit none
integer, intent(in) :: n
real(wp_), intent(in) :: xx(n), x
integer, intent(out) :: j
@ -60,7 +59,6 @@ contains
end subroutine locate
subroutine locatex(xx,n,n1,n2,x,j)
implicit none
integer, intent(in) :: n,n1,n2
real(wp_), intent(in) :: xx(n), x
integer, intent(out) :: j
@ -91,8 +89,6 @@ contains
! `n` locations `locs` such that `value` is between
! `array(locs(i))` and `array(locs(i+i))`, in whichever order.
implicit none
! subroutine arguments
real(wp_), intent(in) :: array(:)
real(wp_), intent(in) :: value
@ -125,7 +121,6 @@ contains
!linear interpolation
!must be x1 != x2
use const_and_precisions, only : one
implicit none
real(wp_),intent(in) :: x1,y1,x2,y2,x
real(wp_) :: y
real(wp_) :: a
@ -134,7 +129,6 @@ contains
end function intlinf
subroutine intlin(x1,y1,x2,y2,x,y)
implicit none
real(wp_), intent(in) :: x1,y1,x2,y2,x
real(wp_), intent(out) :: y
real(wp_) :: dx,aa,bb
@ -149,7 +143,6 @@ contains
end subroutine intlin
subroutine vmax(x,n,xmax,imx)
implicit none
integer, intent(in) :: n
real(wp_), intent(in) :: x(n)
real(wp_), intent(out) :: xmax
@ -171,7 +164,6 @@ contains
end subroutine vmax
subroutine vmin(x,n,xmin,imn)
implicit none
integer, intent(in) :: n
real(wp_), intent(in) :: x(n)
real(wp_), intent(out) :: xmin
@ -193,7 +185,6 @@ contains
end subroutine vmin
subroutine vmaxmini(x,n,xmin,xmax,imn,imx)
implicit none
integer, intent(in) :: n
real(wp_), intent(in) :: x(n)
real(wp_), intent(out) :: xmin, xmax
@ -220,7 +211,6 @@ contains
end subroutine vmaxmini
subroutine vmaxmin(x,n,xmin,xmax)
implicit none
integer, intent(in) :: n
real(wp_), intent(in) :: x(n)
real(wp_), intent(out) :: xmin, xmax
@ -242,7 +232,6 @@ contains
subroutine order(p,q)
! returns p,q in ascending order
implicit none
real(wp_), intent(inout) :: p,q
real(wp_) :: temp
if (p>q) then
@ -254,7 +243,6 @@ contains
subroutine bubble(a,n)
! bubble sorting of array a
implicit none
integer, intent(in) :: n
real(wp_), dimension(n), intent(inout) :: a
integer :: i, j
@ -277,8 +265,6 @@ contains
! (xmin, ymin)╚═════╝(xmin, ymax)
!
implicit none
! subroutine arguments
real(wp_), intent(in) :: xmin, xmax, ymin, ymax
real(wp_), intent(out), dimension(5) :: x, y
@ -292,7 +278,6 @@ contains
! Tests whether the point (`x0`, `y0`) lies inside the
! simple polygon of vertices `vertx`, `verty`.
implicit none
! subroutine arguments
real(wp_), dimension(:), intent(in) :: vertx, verty
@ -337,8 +322,6 @@ contains
! number `i` if `unit` is absent.
! When no unit is available, returns -1.
implicit none
! function arguments
integer :: i
integer, intent(in), optional :: unit