src: use the logging system everywhere
This commit is contained in:
Michele Guerini Rocco
parent
f2f41ec023
commit
add59dbdda
GPG Key ID:
BFBAF4C975F76450
@ -11,6 +11,7 @@ contains
|
||||
use const_and_precisions, only : pi, vc=>ccgs_
|
||||
use gray_params, only : antenna_parameters
|
||||
use utils, only : get_free_unit
|
||||
use logger, only : log_error
|
||||
|
||||
implicit none
|
||||
|
||||
@ -20,11 +21,18 @@ contains
|
||||
|
||||
! local variables
|
||||
integer :: u
|
||||
integer :: err
|
||||
real(wp_) :: ak0,zrcsi,zreta
|
||||
|
||||
u = get_free_unit(unit)
|
||||
|
||||
open(unit=u, file=trim(params%filenm), status='OLD', action='READ')
|
||||
open(unit=u, file=params%filenm, status='old', action='read', iostat=err)
|
||||
if (err /= 0) then
|
||||
call log_error('opening beams file ('//trim(params%filenm)//') failed!', &
|
||||
mod='beams', proc="read_beam0")
|
||||
call exit(1)
|
||||
end if
|
||||
|
||||
read(u, *) params%fghz
|
||||
read(u, *) params%pos
|
||||
read(u, *) params%w, params%ri, params%phi(1)
|
||||
@ -49,6 +57,7 @@ contains
|
||||
use gray_params, only : antenna_parameters
|
||||
use simplespline, only : spli, difcs
|
||||
use utils, only : get_free_unit,locate
|
||||
use logger, only : log_error
|
||||
|
||||
implicit none
|
||||
|
||||
@ -64,10 +73,16 @@ contains
|
||||
z00v, waist1v, waist2v, rci1v, rci2v, phi1v, phi2v, &
|
||||
cbeta, cx0, cy0, cz0, cwaist1, cwaist2, &
|
||||
crci1, crci2, cphi1, cphi2
|
||||
integer :: err
|
||||
|
||||
u = get_free_unit(unit)
|
||||
|
||||
open(unit=u, file=params%filenm, status='OLD', action='READ')
|
||||
open(unit=u, file=params%filenm, status='old', action='read', iostat=err)
|
||||
if (err /= 0) then
|
||||
call log_error('opening beams file ('//trim(params%filenm)//') failed!', &
|
||||
mod='beams', proc="read_beam1")
|
||||
call exit(1)
|
||||
end if
|
||||
read(u,*) params%fghz
|
||||
read(u,*) nisteer
|
||||
|
||||
@ -155,6 +170,7 @@ contains
|
||||
use utils, only : get_free_unit, intlin, locate
|
||||
use reflections, only : inside
|
||||
use dierckx, only : curfit, splev, surfit, bispev
|
||||
use logger, only : log_error
|
||||
|
||||
implicit none
|
||||
|
||||
@ -187,10 +203,17 @@ contains
|
||||
real(wp_), dimension(1) :: fi
|
||||
integer, parameter :: kspl=1
|
||||
real(wp_), parameter :: sspl=0.01_wp_
|
||||
integer :: err
|
||||
|
||||
u = get_free_unit(unit)
|
||||
|
||||
open(unit=u, file=params%filenm, status='OLD', action='READ')
|
||||
open(unit=u, file=params%filenm, status='old', action='read', iostat=err)
|
||||
if (err /= 0) then
|
||||
call log_error('opening beams file ('//trim(params%filenm)//') failed!', &
|
||||
mod='beams', proc="read_beam1")
|
||||
call exit(1)
|
||||
end if
|
||||
|
||||
!=======================================================================================
|
||||
! # of beams
|
||||
read(u,*) nbeam
|
||||
|
||||
@ -29,12 +29,14 @@ contains
|
||||
complex(wp_) v0,v1,v2,vv,w(19)
|
||||
|
||||
logical lm0,lm1,lta
|
||||
character(256) :: msg
|
||||
|
||||
fconic=0.0_wp_
|
||||
lm0=m == 0
|
||||
lm1=m == 1
|
||||
if(.not.(lm0 .or. lm1)) then
|
||||
write(*,"(1x,'fconic ... illegal value for m = ',i4)") m
|
||||
write (msg, '("invalid value for m: ",g0)') m
|
||||
call log_error(msg, mod='conical', proc='fconic')
|
||||
return
|
||||
end if
|
||||
fm=m
|
||||
@ -204,7 +206,9 @@ contains
|
||||
do
|
||||
n=n+1
|
||||
if(n > nmax) then
|
||||
write(*,200) x,tau,m
|
||||
write (msg, '(a," x=",g0.4," tau=",g0.4," m=",g0)') &
|
||||
"convergence difficulties for c function:", x, tau, m
|
||||
call log_error(msg, mod='conical', proc='fconical')
|
||||
return
|
||||
end if
|
||||
rr=r
|
||||
@ -258,7 +262,9 @@ contains
|
||||
if(abs(r-rr) < eps) exit
|
||||
end do
|
||||
if (n > nmax) then
|
||||
write(*,200) x,tau,m
|
||||
write (msg, '(a," x=",g0.4," tau=",g0.4," m=",g0)') &
|
||||
"convergence difficulties for c function:", x, tau, m
|
||||
call log_error(msg, mod='conical', proc='fconical')
|
||||
return
|
||||
end if
|
||||
end if
|
||||
@ -287,10 +293,6 @@ contains
|
||||
return
|
||||
end if
|
||||
end if
|
||||
!
|
||||
200 format(1x,'fconic ... convergence difficulties for c function, x = ', &
|
||||
e12.4,5x,'tau = ',e12.4,5x,'m = ',i5)
|
||||
!
|
||||
end function fconic
|
||||
|
||||
!
|
||||
@ -312,11 +314,10 @@ contains
|
||||
+8.4175084175084e-4_wp_, -1.9175269175269e-3_wp_, &
|
||||
+6.4102564102564e-3_wp_, -2.9550653594771e-2_wp_, &
|
||||
+1.7964437236883e-1_wp_, -1.3924322169059e+0_wp_/)
|
||||
!
|
||||
|
||||
x=real(z)
|
||||
t=aimag(z)
|
||||
if(-abs(x) == aint(x) .and. t == 0.0_wp_) then
|
||||
write(*,'(1x,f20.2)') x
|
||||
clogam=(0.0_wp_,0.0_wp_)
|
||||
return
|
||||
end if
|
||||
@ -360,7 +361,12 @@ contains
|
||||
end function clogam
|
||||
|
||||
function ellick(xk)
|
||||
! Computes the complete elliptic integrals K(x), E(x):
|
||||
! entry ellick(X)= E(x)
|
||||
! entry ellice(X)= E(x)
|
||||
|
||||
implicit none
|
||||
|
||||
real(wp_), intent(in) :: xk
|
||||
real(wp_) :: ellick, ellice
|
||||
integer :: i
|
||||
|
||||
@ -13,23 +13,28 @@ contains
|
||||
subroutine density(psin,dens,ddens)
|
||||
use gray_params, only : iprof
|
||||
use dierckx, only : splev,splder
|
||||
use logger, only : log_error
|
||||
|
||||
implicit none
|
||||
! arguments
|
||||
|
||||
! subroutine arguments
|
||||
real(wp_), intent(in) :: psin
|
||||
real(wp_), intent(out) :: dens,ddens
|
||||
|
||||
! local variables
|
||||
integer :: ier,nu
|
||||
real(wp_) :: profd,dprofd,dpsib,tt,fp,dfp,fh,dfh
|
||||
real(wp_), dimension(1) :: xxs,ffs
|
||||
real(wp_), dimension(npp+4) :: wrkfd
|
||||
character(256) :: msg
|
||||
|
||||
!
|
||||
! computation of density [10^19 m^-3] and derivative wrt psi
|
||||
! Computation of density [10¹⁹ m⁻³] and derivative wrt ψ
|
||||
!
|
||||
dens=zero
|
||||
ddens=zero
|
||||
if((psin >= psdbnd) .or. (psin < zero)) return
|
||||
!
|
||||
|
||||
if(iprof == 0) then
|
||||
if(psin > one) return
|
||||
profd=(one-psin**aln1)**aln2
|
||||
@ -40,7 +45,7 @@ contains
|
||||
else
|
||||
if(psin > psnpp) then
|
||||
|
||||
! smooth interpolation for psnpp < psi < psdbnd
|
||||
! Smooth interpolation for psnpp < psi < psdbnd
|
||||
! dens = fp * fh
|
||||
! fp: parabola matched at psi=psnpp with given profile density
|
||||
! fh=(1-t)^3(1+3t+6t^2) is a smoothing function:
|
||||
@ -65,14 +70,15 @@ contains
|
||||
ddens=ffs(1)
|
||||
if(abs(dens) < 1.0e-10_wp_) dens=zero
|
||||
end if
|
||||
if(dens < zero) print*,'psin = ',psin,': DENSITY NEGATIVE ne=',dens
|
||||
! if(dens < zero) then
|
||||
! dens=zero
|
||||
! ddens=zero
|
||||
! end if
|
||||
if(dens < zero) then
|
||||
write (msg, '("negative density:", 2(x,a,"=",g0.3))') &
|
||||
'ne', dens, 'ψ', psin
|
||||
call log_error(msg, mod='coreprofiles', proc='density')
|
||||
end if
|
||||
end if
|
||||
end subroutine density
|
||||
|
||||
|
||||
function temp(psin)
|
||||
use const_and_precisions, only : wp_,zero,one
|
||||
use gray_params, only : iprof
|
||||
@ -134,6 +140,7 @@ contains
|
||||
! 2. The first line is a header specifying the number of rows.
|
||||
use utils, only : get_free_unit
|
||||
use gray_params, only : profiles_data
|
||||
use logger, only : log_error
|
||||
|
||||
implicit none
|
||||
|
||||
@ -144,6 +151,7 @@ contains
|
||||
|
||||
! local variables
|
||||
integer :: u, i, nrows
|
||||
integer :: err
|
||||
|
||||
! Free the arrays when already allocated
|
||||
if(allocated(data%psrad)) deallocate(data%psrad)
|
||||
@ -154,7 +162,13 @@ contains
|
||||
u = get_free_unit(unit)
|
||||
|
||||
! Read number of rows and allocate the arrays
|
||||
open(file=trim(filenm), status='old', action='read', unit=u)
|
||||
open(file=filenm, status='old', action='read', unit=u, iostat=err)
|
||||
if (err /= 0) then
|
||||
call log_error('opening profiles file ('//trim(filenm)//') failed!', &
|
||||
mod='coreprofiles', proc="read_profiles")
|
||||
call exit(1)
|
||||
end if
|
||||
|
||||
read(u, *) nrows
|
||||
allocate(data%psrad(nrows), data%terad(nrows), &
|
||||
data%derad(nrows), data%zfc(nrows))
|
||||
@ -173,6 +187,8 @@ contains
|
||||
|
||||
subroutine read_profiles_an(filenm,te,ne,zeff,unit)
|
||||
use utils, only : get_free_unit
|
||||
use logger, only : log_error
|
||||
|
||||
implicit none
|
||||
! arguments
|
||||
character(len=*), intent(in) :: filenm
|
||||
@ -180,6 +196,7 @@ contains
|
||||
integer, optional, intent(in) :: unit
|
||||
! local variables
|
||||
integer :: u
|
||||
integer :: err
|
||||
|
||||
u = get_free_unit(unit)
|
||||
|
||||
@ -188,7 +205,13 @@ contains
|
||||
if(allocated(zeff)) deallocate(zeff)
|
||||
allocate(te(4),ne(3),zeff(1))
|
||||
|
||||
open(file=trim(filenm),status='old',action='read',unit=u)
|
||||
open(file=filenm, status='old', action='read', unit=u, iostat=err)
|
||||
if (err /= 0) then
|
||||
call log_error('opening profiles file ('//trim(filenm)//') failed!', &
|
||||
mod='coreprofiles', proc='read_profiles_an')
|
||||
call exit(1)
|
||||
end if
|
||||
|
||||
read(u,*) ne(1:3) ! dens0,aln1,aln2
|
||||
read(u,*) te(1:4) ! te0,dte0,alt1,alt2
|
||||
read(u,*) zeff(1) ! zeffan
|
||||
@ -247,6 +270,7 @@ contains
|
||||
use simplespline, only : difcs
|
||||
use dierckx, only : curfit, splev, splder
|
||||
use gray_params, only : profiles_parameters, profiles_data
|
||||
use logger, only : log_info, log_warning
|
||||
|
||||
implicit none
|
||||
|
||||
@ -261,6 +285,7 @@ contains
|
||||
real(wp_), dimension(:), allocatable :: wf, wrkf
|
||||
integer, dimension(:), allocatable :: iwrkf
|
||||
real(wp_), dimension(1) :: dedge,ddedge,d2dedge
|
||||
character(256) :: msg ! for log messages formatting
|
||||
|
||||
n=size(data%psrad)
|
||||
npest=n+4
|
||||
@ -301,7 +326,8 @@ contains
|
||||
nsfd,tfn,cfn,fp,wrkf,lwrkf,iwrkf,ier)
|
||||
! if ier=-1 data are re-fitted using sspl=0
|
||||
if(ier == -1) then
|
||||
write(*,*) 'density curfit: ier=-1. Re-fitting with interpolating spline'
|
||||
call log_warning('curfit failed with error -1: re-fitting with '// &
|
||||
's=0', mod='coreprofiles', proc='density')
|
||||
ssplne_loc=0.0_wp_
|
||||
call curfit(iopt,n,data%psrad,data%derad,wf,xb,xe,kspl,ssplne_loc,npest, &
|
||||
nsfd,tfn,cfn,fp,wrkf,lwrkf,iwrkf,ier)
|
||||
@ -334,7 +360,8 @@ contains
|
||||
else if (xxp > psnpp) then
|
||||
psdbnd=min(psdbnd,xxp)
|
||||
end if
|
||||
write(*,'(a,f5.3)') 'density psdbnd=', psdbnd
|
||||
write (msg, '(a,g0.3)') 'density boundary: ψ=', psdbnd
|
||||
call log_info(msg, mod="coreprofiles", proc="set_prfspl")
|
||||
end if
|
||||
|
||||
deallocate(iwrkf,wrkf,wf)
|
||||
|
||||
@ -41,6 +41,7 @@ contains
|
||||
use const_and_precisions, only : one
|
||||
use gray_params, only : equilibrium_parameters, equilibrium_data
|
||||
use utils, only : get_free_unit
|
||||
use logger, only : log_error
|
||||
|
||||
implicit none
|
||||
|
||||
@ -54,11 +55,17 @@ contains
|
||||
character(len=48) :: string
|
||||
real(wp_) :: dr, dz, dps, rleft, zmid, zleft, psiedge, psiaxis
|
||||
real(wp_) :: xdum ! dummy variable, used to discard data
|
||||
integer :: err
|
||||
|
||||
u = get_free_unit(unit)
|
||||
|
||||
! Open the G-EQDSK file
|
||||
open(file=trim(params%filenm), status='old', action='read', unit=u)
|
||||
open(file=params%filenm, status='old', action='read', unit=u, iostat=err)
|
||||
if (err /= 0) then
|
||||
call log_error('opening eqdsk file ('//trim(params%filenm)//') failed!', &
|
||||
mod='equilibrium', proc='read_eqdsk')
|
||||
call exit(1)
|
||||
end if
|
||||
|
||||
! get size of main arrays and allocate them
|
||||
if (params%idesc == 1) then
|
||||
@ -155,6 +162,8 @@ contains
|
||||
|
||||
subroutine read_equil_an(filenm,ipass,rv,zv,fpol,q,rlim,zlim,unit)
|
||||
use utils, only : get_free_unit
|
||||
use logger, only : log_error
|
||||
|
||||
implicit none
|
||||
! arguments
|
||||
character(len=*), intent(in) :: filenm
|
||||
@ -163,11 +172,18 @@ contains
|
||||
real(wp_), dimension(:), allocatable, intent(out) :: rv,zv,fpol,q,rlim,zlim
|
||||
! local variables
|
||||
integer :: i, u, nlim
|
||||
integer :: err
|
||||
real(wp_) :: rr0m,zr0m,rpam,b0,q0,qa,alq !,rcen,btrcen
|
||||
|
||||
u = get_free_unit(unit)
|
||||
|
||||
open(file=trim(filenm),status='old',action='read',unit=u)
|
||||
open(file=filenm, status='old', action='read', unit=u, iostat=err)
|
||||
if (err /= 0) then
|
||||
call log_error('opening equilibrium file ('//trim(filenm)//') failed!', &
|
||||
mod='equilibrium', proc='read_equil_an')
|
||||
call exit(1)
|
||||
end if
|
||||
|
||||
read(u,*) rr0m,zr0m,rpam
|
||||
read(u,*) b0
|
||||
read(u,*) q0,qa,alq
|
||||
@ -338,6 +354,7 @@ contains
|
||||
use gray_params, only : iequil
|
||||
use reflections, only : inside
|
||||
use utils, only : vmaxmin, vmaxmini
|
||||
use logger, only : log_info
|
||||
|
||||
implicit none
|
||||
|
||||
@ -358,6 +375,7 @@ contains
|
||||
real(wp_), dimension(:), allocatable :: rv1d,zv1d,fvpsi,wf,wrk
|
||||
integer, dimension(:), allocatable :: iwrk
|
||||
integer :: ier,ixploc,info,i,j,ij
|
||||
character(256) :: msg ! for log messages formatting
|
||||
|
||||
! compute array sizes and prepare working space arrays
|
||||
nr=size(data%rv)
|
||||
@ -526,7 +544,10 @@ contains
|
||||
rax0=data%rax
|
||||
zax0=data%zax
|
||||
call points_ox(rax0,zax0,rmaxis,zmaxis,psinoptmp,info)
|
||||
print'(a,2f8.4,es12.5)','O-point',rmaxis,zmaxis,psinoptmp
|
||||
|
||||
write (msg, '("O-point found:", 3(x,a,"=",g0.3))') &
|
||||
'r', rmaxis, 'z', zmaxis, 'ψ', psinoptmp
|
||||
call log_info(msg, mod='equilibrium', proc='set_eqspl')
|
||||
|
||||
! search for X-point if params%ixp /= 0
|
||||
|
||||
@ -535,7 +556,10 @@ contains
|
||||
if(ixploc<0) then
|
||||
call points_ox(rbinf,zbinf,r1,z1,psinxptmp,info)
|
||||
if(psinxptmp/=-1.0_wp_) then
|
||||
print'(a,2f8.4,es12.5)','X-point',r1,z1,psinxptmp
|
||||
write (msg, '("X-point found:", 3(x,a,"=",g0.3))') &
|
||||
'r', r1, 'z', z1, 'ψ', psinxptmp
|
||||
call log_info(msg, mod='equilibrium', proc='set_eqspl')
|
||||
|
||||
zbinf=z1
|
||||
psinop=psinoptmp
|
||||
psiant=psinxptmp-psinop
|
||||
@ -547,7 +571,10 @@ contains
|
||||
else
|
||||
call points_ox(rbsup,zbsup,r1,z1,psinxptmp,info)
|
||||
if(psinxptmp.ne.-1.0_wp_) then
|
||||
print'(a,2f8.4,e16.8)','X-point',r1,z1,psinxptmp
|
||||
write (msg, '("X-point found:", 3(x,a,"=",g0.3))') &
|
||||
'r', r1, 'z', z1, 'ψ', psinxptmp
|
||||
call log_info(msg, mod='equilibrium', proc='set_eqspl')
|
||||
|
||||
zbsup=z1
|
||||
psinop=psinoptmp
|
||||
psiant=psinxptmp-psinop
|
||||
@ -572,9 +599,10 @@ contains
|
||||
call points_tgo(rmaxis,0.5_wp_*(zmaxis+zbinf),r1,z1,one,info)
|
||||
zbinf=z1
|
||||
rbinf=r1
|
||||
print'(a,4f8.4)','no X-point ',rbinf,zbinf,rbsup,zbsup
|
||||
write (msg, '("X-point not found in", 2(x,a,"∈[",g0.3,",",g0.3,"]"))') &
|
||||
'r', rbinf, rbsup, 'z', zbinf, zbsup
|
||||
call log_info(msg, mod='equilibrium', proc='set_eqspl')
|
||||
end if
|
||||
print*,' '
|
||||
|
||||
! Save Bt value on axis (required in flux_average and used in Jcd def)
|
||||
! and vacuum value B0 at ref. radius data%rvac (used in Jcd_astra def)
|
||||
@ -583,8 +611,9 @@ contains
|
||||
btaxis = btaxis/rmaxis
|
||||
btrcen = fpolas/data%rvac
|
||||
rcen = data%rvac
|
||||
print '(a,f8.4)', 'BT_centr=', btrcen
|
||||
print '(a,f8.4)', 'BT_axis =', btaxis
|
||||
|
||||
write (msg, '(2(a,g0.3))') 'Bt_center=', btrcen, ' Bt_axis=', btaxis
|
||||
call log_info(msg, mod='equilibrium', proc='set_eqspl')
|
||||
|
||||
! Compute rho_pol/rho_tor mapping based on input q profile
|
||||
call setqphi_num(data%psinr,abs(data%qpsi),abs(psia),rhotn)
|
||||
@ -1074,16 +1103,22 @@ contains
|
||||
use const_and_precisions, only : wp_
|
||||
use gray_params, only : iequil
|
||||
use dierckx, only : profil, sproota
|
||||
use logger, only : log_error
|
||||
|
||||
implicit none
|
||||
|
||||
! subroutine arguments
|
||||
real(wp_) :: psin,r1,r2
|
||||
|
||||
! local constants
|
||||
integer, parameter :: mest=4
|
||||
! arguments
|
||||
real(wp_) :: psin,r1,r2
|
||||
|
||||
! local variables
|
||||
integer :: iopt,ier,m
|
||||
real(wp_) :: zc,val
|
||||
real(wp_), dimension(mest) :: zeroc
|
||||
real(wp_), dimension(nsr) :: czc
|
||||
character(64) :: msg
|
||||
|
||||
if (iequil < 2) then
|
||||
val=frhotor(sqrt(psin))
|
||||
@ -1093,7 +1128,11 @@ contains
|
||||
iopt=1
|
||||
zc=zmaxis
|
||||
call profil(iopt,tr,nsr,tz,nsz,cceq,kspl,kspl,zc,nsr,czc,ier)
|
||||
if(ier.gt.0) print*,' profil =',ier
|
||||
if (ier > 0) then
|
||||
write (msg, '("profil failed with error ",g0)') ier
|
||||
call log_error(msg, mod='equilibrium', proc='psi_raxis')
|
||||
end if
|
||||
|
||||
val=psin*psiant+psinop
|
||||
call sproota(val,tr,nsr,czc,zeroc,mest,m,ier)
|
||||
r1=zeroc(1)
|
||||
@ -1119,26 +1158,34 @@ contains
|
||||
subroutine points_ox(rz,zz,rf,zf,psinvf,info)
|
||||
use const_and_precisions, only : comp_eps
|
||||
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
|
||||
|
||||
! arguments
|
||||
real(wp_), intent(in) :: rz,zz
|
||||
real(wp_), intent(out) :: rf,zf,psinvf
|
||||
integer, intent(out) :: info
|
||||
|
||||
! local variables
|
||||
real(wp_) :: tol
|
||||
real(wp_), dimension(n) :: xvec,fvec
|
||||
real(wp_), dimension(lwa) :: wa
|
||||
real(wp_), dimension(ldfjac,n) :: fjac
|
||||
character(256) :: msg
|
||||
|
||||
xvec(1)=rz
|
||||
xvec(2)=zz
|
||||
tol = sqrt(comp_eps)
|
||||
call hybrj1(fcnox,n,xvec,fvec,fjac,ldfjac,tol,info,wa,lwa)
|
||||
if(info.gt.1) then
|
||||
print'(a,i2,a,2f8.4)',' info subr points_ox =',info, &
|
||||
' O/X coord.',xvec
|
||||
if(info /= 1) then
|
||||
write (msg, '("O,X coordinates:",2(x,", ",g0.3))') xvec
|
||||
call log_debug(msg, mod='equilibrium', proc='points_ox')
|
||||
write (msg, '("hybrj1 failed with error ",g0)') info
|
||||
call log_error(msg, mod='equilibrium', proc='points_ox')
|
||||
end if
|
||||
rf=xvec(1)
|
||||
zf=xvec(2)
|
||||
@ -1148,14 +1195,19 @@ contains
|
||||
|
||||
|
||||
subroutine fcnox(n,x,fvec,fjac,ldfjac,iflag)
|
||||
use logger, only : log_error
|
||||
|
||||
implicit none
|
||||
! arguments
|
||||
|
||||
! subroutine arguments
|
||||
integer, intent(in) :: n,iflag,ldfjac
|
||||
real(wp_), dimension(n), intent(in) :: x
|
||||
real(wp_), dimension(n), intent(inout) :: fvec
|
||||
real(wp_), dimension(ldfjac,n), intent(inout) :: fjac
|
||||
|
||||
! local variables
|
||||
real(wp_) :: dpsidr,dpsidz,ddpsidrr,ddpsidzz,ddpsidrz
|
||||
character(64) :: msg
|
||||
|
||||
select case(iflag)
|
||||
case(1)
|
||||
@ -1170,7 +1222,8 @@ contains
|
||||
fjac(2,1) = ddpsidrz/psia
|
||||
fjac(2,2) = ddpsidzz/psia
|
||||
case default
|
||||
print*,'iflag undefined'
|
||||
write (msg, '("invalid iflag: ",g0)')
|
||||
call log_error(msg, mod='equilibrium', proc='fcnox')
|
||||
end select
|
||||
end subroutine fcnox
|
||||
|
||||
@ -1179,13 +1232,19 @@ contains
|
||||
subroutine points_tgo(rz,zz,rf,zf,psin0,info)
|
||||
use const_and_precisions, only : comp_eps
|
||||
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
|
||||
|
||||
! arguments
|
||||
real(wp_), intent(in) :: rz,zz,psin0
|
||||
real(wp_), intent(out) :: rf,zf
|
||||
integer, intent(out) :: info
|
||||
character(256) :: msg
|
||||
|
||||
! local variables
|
||||
real(wp_) :: tol
|
||||
real(wp_), dimension(n) :: xvec,fvec,f0
|
||||
@ -1198,9 +1257,11 @@ contains
|
||||
f0(2)=0.0_wp_
|
||||
tol = sqrt(comp_eps)
|
||||
call hybrj1mv(fcntgo,n,xvec,f0,fvec,fjac,ldfjac,tol,info,wa,lwa)
|
||||
if(info.gt.1) then
|
||||
print'(a,i2,a,5f8.4)',' info subr points_tgo =',info, &
|
||||
' R,z coord.',xvec,rz,zz,psin0
|
||||
if(info /= 1) then
|
||||
write (msg, '("R,z coordinates:",5(x,g0.3))') xvec, rz, zz, psin0
|
||||
call log_debug(msg, mod='equilibrium', proc='points_tgo')
|
||||
write (msg, '("hybrj1mv failed with error ",g0)') info
|
||||
call log_error(msg, mod='equilibrium', proc='points_tgo')
|
||||
end if
|
||||
rf=xvec(1)
|
||||
zf=xvec(2)
|
||||
@ -1210,14 +1271,19 @@ contains
|
||||
|
||||
subroutine fcntgo(n,x,f0,fvec,fjac,ldfjac,iflag)
|
||||
use const_and_precisions, only : wp_
|
||||
use logger, only : log_error
|
||||
|
||||
implicit none
|
||||
! arguments
|
||||
|
||||
! subroutine arguments
|
||||
integer, intent(in) :: n,ldfjac,iflag
|
||||
real(wp_), dimension(n), intent(in) :: x,f0
|
||||
real(wp_), dimension(n), intent(inout) :: fvec
|
||||
real(wp_), dimension(ldfjac,n), intent(inout) :: fjac
|
||||
! internal variables
|
||||
|
||||
! local variables
|
||||
real(wp_) :: psinv,dpsidr,dpsidz,ddpsidrr,ddpsidrz
|
||||
character(64) :: msg
|
||||
|
||||
select case(iflag)
|
||||
case(1)
|
||||
@ -1232,7 +1298,8 @@ contains
|
||||
fjac(2,1) = ddpsidrr/psia
|
||||
fjac(2,2) = ddpsidrz/psia
|
||||
case default
|
||||
print*,'iflag undefined'
|
||||
write (msg, '("invalid iflag: ",g0)')
|
||||
call log_error(msg, mod='equilibrium', proc='fcntgo')
|
||||
end select
|
||||
end subroutine fcntgo
|
||||
|
||||
|
||||
@ -10,13 +10,13 @@ module gray_cli
|
||||
! 2. the print_cli_options() subroutine
|
||||
type cli_options
|
||||
! Switches
|
||||
logical :: verbose
|
||||
logical :: quiet
|
||||
! Files
|
||||
character(len=:), allocatable :: output_dir
|
||||
character(len=:), allocatable :: params_file
|
||||
character(len=:), allocatable :: sum_filelist
|
||||
! others
|
||||
integer :: verbose
|
||||
integer, allocatable :: units(:)
|
||||
end type
|
||||
|
||||
@ -40,8 +40,9 @@ contains
|
||||
print '(a)', 'Options:'
|
||||
print '(a)', ' -h, --help display this help and exit'
|
||||
print '(a)', ' -V, --version display version information and exit'
|
||||
print '(a)', ' -v, --verbose print additional information messages'
|
||||
print '(a)', ' -q, --quiet suppress all messages on standard output'
|
||||
print '(a)', ' -v, --verbose print more information messages;'
|
||||
print '(a)', ' repeating -v increase the log verbosity'
|
||||
print '(a)', ' -q, --quiet suppress all non-critical messages'
|
||||
print '(a)', ' -o, --output-dir DIR specify where to write the output files'
|
||||
print '(a)', ' (default: current directory)'
|
||||
print '(a)', ' -p, --params-file FILE set the parameters file'
|
||||
@ -77,7 +78,6 @@ contains
|
||||
type(cli_options), intent(in) :: opts
|
||||
|
||||
print '(a)' , 'switches:'
|
||||
print '(a,l)' , ' - verbose: ' , opts%verbose
|
||||
print '(a,l)' , ' - quiet: ' , opts%quiet
|
||||
print '(a)' , 'files:'
|
||||
print '(a,a)' , ' output-dir: ' , opts%output_dir
|
||||
@ -85,6 +85,7 @@ contains
|
||||
print '(a,a)' , ' sum: ' , opts%sum_filelist
|
||||
print '(a)' , 'others:'
|
||||
print '(a,20i3)' , ' - units: ' , opts%units
|
||||
print '(a,l)' , ' - verbose: ' , opts%verbose
|
||||
end subroutine
|
||||
|
||||
|
||||
@ -92,6 +93,7 @@ contains
|
||||
! Parse the CLI arguments and initialise the options
|
||||
|
||||
use units, only : ucenr, usumm
|
||||
use logger, only : WARNING
|
||||
|
||||
implicit none
|
||||
|
||||
@ -105,7 +107,7 @@ contains
|
||||
integer :: error, commas
|
||||
|
||||
! Default option values
|
||||
opts%verbose = .false.
|
||||
opts%verbose = WARNING
|
||||
opts%quiet = .false.
|
||||
opts%params_file = 'gray_params.data'
|
||||
opts%units = [ucenr, usumm]
|
||||
@ -131,7 +133,7 @@ contains
|
||||
call exit(0)
|
||||
|
||||
case ('-v', '--verbose')
|
||||
opts%verbose = .true.
|
||||
opts%verbose = opts%verbose + 1
|
||||
|
||||
case ('-q', '--quiet')
|
||||
opts%quiet = .true.
|
||||
|
||||
@ -24,6 +24,7 @@ contains
|
||||
use multipass, only : alloc_multipass, dealloc_multipass, initbeam, &
|
||||
initmultipass, turnoffray, plasma_in, plasma_out, wall_out
|
||||
use units, only : ucenr
|
||||
use logger, only : log_info, log_debug
|
||||
|
||||
implicit none
|
||||
|
||||
@ -81,6 +82,8 @@ contains
|
||||
|
||||
! parameters log in file headers
|
||||
character(len=headw), dimension(headl) :: strheader
|
||||
! buffer for formatting log messages
|
||||
character(256) :: msg
|
||||
|
||||
! ======== set environment BEGIN ========
|
||||
! Number of limiter contourn points
|
||||
@ -129,13 +132,16 @@ contains
|
||||
call print_parameters(params, strheader)
|
||||
call print_headers(strheader)
|
||||
|
||||
! print ψ surface for q=1.5 and q=2 on file and psi,rhot,rhop on stdout
|
||||
! print ψ surface for q=1.5 and q=2 on file and log psi,rhot,rhop
|
||||
call print_surfq([1.5_wp_, 2.0_wp_])
|
||||
|
||||
! print initial position
|
||||
print *, ''
|
||||
print '(a,2f8.3)', 'alpha0, beta0 = ', params%antenna%alpha, params%antenna%beta
|
||||
print '(a,4f8.3)', 'x00, y00, z00 = ', params%antenna%pos
|
||||
write (msg, '("initial position:",3(x,g0.3))') params%antenna%pos
|
||||
call log_info(msg, mod='gray_core', proc='gray_main')
|
||||
|
||||
write (msg, '("initial direction:",2(x,a,"=",g0.2))') &
|
||||
'α', params%antenna%alpha, 'β', params%antenna%beta
|
||||
call log_info(msg, mod='gray_core', proc='gray_main')
|
||||
|
||||
! print Btot=Bres
|
||||
! print ne, Te, q, Jphi versus psi, rhop, rhot
|
||||
@ -169,7 +175,10 @@ contains
|
||||
nbeam_pass=1 ! max n of beam per pass
|
||||
index_rt=0 ! global beam index: 1,O 2,X 1st pass
|
||||
! | | | |
|
||||
do ip=1,ipass ! 3,O 4,X 5,O 6,X 2nd pass
|
||||
call log_debug('pass loop start', mod='gray_core', proc='gray_main') ! 3,O 4,X 5,O 6,X 2nd pass
|
||||
do ip=1,ipass
|
||||
write (msg, '("pass: ",g0)') ip
|
||||
call log_info(msg, mod='gray_core', proc='gray_main')
|
||||
|
||||
pabs_pass = zero
|
||||
icd_pass = zero
|
||||
@ -184,6 +193,7 @@ contains
|
||||
end if
|
||||
|
||||
! =========== beam loop BEGIN ===========
|
||||
call log_debug('beam loop start', mod='gray_core', proc='gray_main')
|
||||
do ib=1,nbeam_pass
|
||||
|
||||
sox = -sox ! invert mode
|
||||
@ -195,8 +205,12 @@ contains
|
||||
call initbeam(index_rt,iroff,iboff,iwait,stv,jphi_beam, &
|
||||
pins_beam,currins_beam,dpdv_beam,jcd_beam)
|
||||
|
||||
write(msg, '(" beam: ",g0," (",a1," mode)")') index_rt, mode(iox)
|
||||
call log_info(msg, mod='gray_core', proc='gray_main')
|
||||
|
||||
if(iboff) then ! no propagation for current beam
|
||||
istop_pass = istop_pass +1 ! * +1 non propagating beam
|
||||
call log_info(" beam is off", mod='gray_core', proc='gray_main')
|
||||
cycle
|
||||
end if
|
||||
|
||||
@ -248,8 +262,9 @@ contains
|
||||
if(nray>1 .and. all(.not.iwait)) call print_projxyzt(stv,yw,0) ! iproj=0 ==> nfilp=8
|
||||
|
||||
! ======= propagation loop BEGIN =======
|
||||
do i=1,nstep
|
||||
call log_debug(' propagation loop start', mod='gray_core', proc='gray_main')
|
||||
|
||||
do i=1,nstep
|
||||
! advance one step with "frozen" grad(S_I)
|
||||
do jk=1,nray
|
||||
if(iwait(jk)) cycle ! jk ray is waiting for next pass
|
||||
@ -309,9 +324,9 @@ contains
|
||||
cpls(jk,index_rt) = cpl(iox)
|
||||
|
||||
if(jk.eq.1) then
|
||||
write(*,*)
|
||||
write(*,'("1st pass coupling (central ray, ",a1,"-mode)",f9.4)') &
|
||||
write (msg,'(" 1st pass - central ray (",a1,"-mode) c=",g0.4)') &
|
||||
mode(iox), cpl(iox)
|
||||
call log_info(msg, mod='gray_core', proc='gray_main')
|
||||
psipv(index_rt) = psipol ! + polarization angles at plasma boundary for central ray
|
||||
chipv(index_rt) = chipol
|
||||
end if
|
||||
@ -481,6 +496,7 @@ contains
|
||||
exit
|
||||
end if
|
||||
end do
|
||||
call log_debug(' propagation loop end', mod='gray_core', proc='gray_main')
|
||||
! ======== propagation loop END ========
|
||||
|
||||
! print all ray positions in local reference system
|
||||
@ -515,17 +531,27 @@ contains
|
||||
end if
|
||||
|
||||
! print final results for pass on screen
|
||||
write(*,*)
|
||||
write(*,'("End of propagation for beam ",i5," (pass ",i3,", ",a1," mode)")') &
|
||||
index_rt,ip,mode(iox)
|
||||
write(*,'(a,f9.4)') 'final step (s, ct, Sr) = ',stv(1)
|
||||
write(*,'(a,2e12.5)') 'taumn, taumx = ', taumn,taumx
|
||||
write(*,'(a,f9.4)') 'Pabs_tot (MW) = ',pabs_beam
|
||||
write(*,'(a,f9.4)') 'I_tot (kA) = ',icd_beam*1.0e3_wp_
|
||||
if(ip.lt.ipass) then
|
||||
write(*,'(a,2(f9.4,1x))') 'Coupling (average, O/X):',cpl_beam1,cpl_beam2 ! average coupling for next O/X beams (=0 if no ray re-entered plasma)
|
||||
if(iop(1).gt.2) write(*,'(a,2(f9.4,1x))') 'Coupling (ctr ray, O/X):', &
|
||||
cpl_cbeam1,cpl_cbeam2 ! central ray coupling for next O/X beams
|
||||
call log_info(' partial results:', mod='gray_core', proc='gray_main')
|
||||
write(msg, '(3x,a,g0.4)') 'final step: (s, ct, Sr)=' ,stv(1)
|
||||
call log_info(msg, mod='gray_core', proc='gray_main')
|
||||
|
||||
write(msg, '(3x,a,2(x,a,"=",g0.4))') 'optical depth:', 'τ_min', taumn, 'τ_max', taumx
|
||||
call log_info(msg, mod='gray_core', proc='gray_main')
|
||||
|
||||
write(msg, '(3x,a,g0.3," MW")') 'absoption: P=', pabs_beam
|
||||
call log_info(msg, mod='gray_core', proc='gray_main')
|
||||
|
||||
write(msg, '(3x,a,g0.3," MW")') 'current drive: I=', icd_beam*1.0e3_wp_
|
||||
call log_info(msg, mod='gray_core', proc='gray_main')
|
||||
|
||||
if(ip < ipass) then
|
||||
write (msg,'(3x,a,(g0.4,", ",g0.4))') & ! average coupling for next O/X beams (=0 if no ray re-entered plasma)
|
||||
'next couplings [O,X mode]: c=', cpl_beam1, cpl_beam2
|
||||
call log_info(msg, mod='gray_core', proc='gray_main')
|
||||
if(iop(1) > 2) then
|
||||
write(msg, '(3x,a,(g0.4,", ",g0.4))') &
|
||||
'coupling [ctr ray, O/X]:', cpl_cbeam1, cpl_cbeam2 ! central ray coupling for next O/X beams
|
||||
end if
|
||||
end if
|
||||
|
||||
write(ucenr,*) ''
|
||||
@ -544,6 +570,7 @@ contains
|
||||
! ============ post-proc END ============
|
||||
|
||||
end do
|
||||
call log_debug('beam loop end', mod='gray_core', proc='gray_main')
|
||||
! ============ beam loop END ============
|
||||
|
||||
! ======= cumulative prints BEGIN =======
|
||||
@ -551,24 +578,22 @@ contains
|
||||
results%icd = results%icd + sum(icd_pass)
|
||||
|
||||
! print final results for pass on screen
|
||||
write(*,*)
|
||||
write(*,'("# End of pass ",i3)') ip
|
||||
write(*,'(a,f9.4,f9.4)') '# Pabs_tot (MW) [O,X mode] = ',pabs_pass(1),pabs_pass(2)
|
||||
write(*,'(a,f9.4,f9.4)') '# I_tot (kA) [O,X mode] = ', &
|
||||
call log_info(' comulative results:', mod='gray_core', proc='gray_main')
|
||||
|
||||
write(msg, '(" absoption [O,X mode] P=",g0.4,", ",g0.4," MW")') &
|
||||
pabs_pass(1), pabs_pass(2)
|
||||
call log_info(msg, mod='gray_core', proc='gray_main')
|
||||
|
||||
write(msg, '(" current drive [O,X mode] I=",g0.4,", ",g0.4," kA")') &
|
||||
icd_pass(1)*1.0e3_wp_, icd_pass(2)*1.0e3_wp_
|
||||
call log_info(msg, mod='gray_core', proc='gray_main')
|
||||
! ======== cumulative prints END ========
|
||||
|
||||
if(istop_pass == nbeam_pass) exit ! no active beams
|
||||
|
||||
end do
|
||||
call log_debug('pass loop end', mod='gray_core', proc='gray_main')
|
||||
! ============ main loop END ============
|
||||
|
||||
! print final results on screen
|
||||
write(*,*)
|
||||
write(*,'(a)') '## Final results:'
|
||||
write(*,'(a,f9.4)') '## Pabs_tot (MW) = ', results%pabs
|
||||
write(*,'(a,f9.4)') '## I_tot (kA) = ', results%icd*1.0e3_wp_
|
||||
|
||||
! ========== free memory BEGIN ==========
|
||||
call dealloc_surfvec
|
||||
call dealloc_beam(yw,ypw,xc,du1,gri,ggri,psjki,ppabs,ccci,tau0, &
|
||||
@ -2039,30 +2064,36 @@ bb: do
|
||||
end subroutine print_maps
|
||||
|
||||
|
||||
|
||||
|
||||
subroutine print_surfq(qval)
|
||||
use equilibrium, only : psinr,nq,fq,frhotor,rmaxis,zmaxis, &
|
||||
zbsup,zbinf
|
||||
use equilibrium, only : psinr, nq, fq, frhotor, &
|
||||
rmaxis, zmaxis, zbsup, zbinf
|
||||
use magsurf_data, only : contours_psi, npoints, print_contour
|
||||
use utils, only : locate, intlin
|
||||
use logger, only : log_info
|
||||
|
||||
implicit none
|
||||
! arguments
|
||||
|
||||
! subroutine arguments
|
||||
real(wp_), dimension(:), intent(in) :: qval
|
||||
|
||||
! local variables
|
||||
integer :: i1,i
|
||||
real(wp_) :: rup,zup,rlw,zlw,rhot,psival
|
||||
real(wp_), dimension(npoints) :: rcn,zcn
|
||||
real(wp_), dimension(nq) :: qpsi
|
||||
character(256) :: msg ! for log messages formatting
|
||||
|
||||
! build q profile on psin grid
|
||||
do i=1,nq
|
||||
qpsi(i) = fq(psinr(i))
|
||||
end do
|
||||
! locate psi surface for q=qval
|
||||
print*
|
||||
|
||||
! locate ψ surface for q=qval
|
||||
call log_info('constant ψ surfaces for:', &
|
||||
mod='gray_core', proc='print_surfq')
|
||||
do i=1,size(qval)
|
||||
call locate(abs(qpsi),nq,qval(i),i1) !!!! check for non monotonous q profile
|
||||
! FIXME: check for non monotonous q profile
|
||||
call locate(abs(qpsi),nq,qval(i),i1)
|
||||
if (i1>0.and.i1<nq) then
|
||||
call intlin(abs(qpsi(i1)),psinr(i1),abs(qpsi(i1+1)),psinr(i1+1), &
|
||||
qval(i),psival)
|
||||
@ -2073,12 +2104,13 @@ bb: do
|
||||
call contours_psi(psival,rcn,zcn,rup,zup,rlw,zlw)
|
||||
call print_contour(psival,rcn,zcn)
|
||||
rhot=frhotor(sqrt(psival))
|
||||
print'(4(a,f8.5))','q = ',qval(i), ' psi = ',psival, &
|
||||
' rhop = ',sqrt(psival),' rhot = ',rhot
|
||||
write (msg, '(4(x,a,"=",g0.3))') &
|
||||
'q', qval(i), 'ψ', psival, 'rhop', sqrt(psival), 'rhot', rhot
|
||||
call log_info(msg, mod='gray_core', proc='print_surfq')
|
||||
end if
|
||||
end do
|
||||
end subroutine print_surfq
|
||||
|
||||
end subroutine print_surfq
|
||||
|
||||
|
||||
subroutine print_projxyzt(stv,ywrk,iproj)
|
||||
|
||||
@ -222,6 +222,8 @@ contains
|
||||
|
||||
subroutine read_parameters(filename, params, unit)
|
||||
use utils, only : get_free_unit
|
||||
use logger, only : log_error
|
||||
|
||||
implicit none
|
||||
|
||||
! subrouting arguments
|
||||
@ -230,13 +232,14 @@ contains
|
||||
integer, intent(in), optional :: unit
|
||||
|
||||
! local variables
|
||||
integer :: u, iostat
|
||||
integer :: u, err
|
||||
|
||||
u = get_free_unit(unit)
|
||||
|
||||
open(u, file=filename, status='old', action='read', iostat=iostat)
|
||||
if (iostat > 0) then
|
||||
print '(3a)', 'gray_params file (', filename ,') not found!'
|
||||
open(u, file=filename, status='old', action='read', iostat=err)
|
||||
if (err /= 0) then
|
||||
call log_error('opening gray_params file ('//filename//') failed!', &
|
||||
mod='gray_params', proc='read_parameters')
|
||||
call exit(1)
|
||||
end if
|
||||
|
||||
@ -345,6 +348,10 @@ contains
|
||||
|
||||
|
||||
subroutine set_globals(params)
|
||||
! Set global variables exposed by this module.
|
||||
|
||||
use logger, only : log_warning
|
||||
|
||||
implicit none
|
||||
|
||||
! subroutine arguments
|
||||
@ -365,8 +372,8 @@ contains
|
||||
|
||||
if (params%raytracing%nrayr < 5) then
|
||||
igrad = 0
|
||||
print *, ' nrayr < 5 ! => OPTICAL CASE ONLY'
|
||||
print *, ' '
|
||||
call log_warning('nrayr < 5 ⇒ optical case only', &
|
||||
mod="gray_params", proc="set_globals")
|
||||
end if
|
||||
|
||||
iwarm = params%ecrh_cd%iwarm
|
||||
|
||||
40
src/main.f90
40
src/main.f90
@ -1,5 +1,6 @@
|
||||
program main
|
||||
use const_and_precisions, only : wp_, one, zero
|
||||
use logger, only : INFO, ERROR, set_log_level, log_message
|
||||
use gray_cli, only : cli_options, parse_cli_options
|
||||
use gray_core, only : gray_main
|
||||
use gray_params, only : gray_parameters, gray_data, gray_results, &
|
||||
@ -13,11 +14,15 @@ program main
|
||||
type(gray_parameters) :: params ! Inputs
|
||||
type(gray_data) :: data !
|
||||
type(gray_results) :: results ! Outputs
|
||||
integer :: error ! Exit code
|
||||
integer :: err ! Exit code
|
||||
|
||||
! Parse the command-line options
|
||||
call parse_cli_options(opts)
|
||||
|
||||
! Initialise logging
|
||||
if (opts%quiet) opts%verbose = ERROR
|
||||
call set_log_level(opts%verbose)
|
||||
|
||||
! Load the parameters and also copy them into
|
||||
! global variables exported by the gray_params
|
||||
call read_parameters(opts%params_file, params)
|
||||
@ -33,12 +38,15 @@ program main
|
||||
! Change the current directory to output files here
|
||||
if (allocated(opts%output_dir)) then
|
||||
if (chdir(opts%output_dir) /= 0) then
|
||||
print '(3a)', 'chdir to output_dir (', opts%output_dir, ') failed!'
|
||||
call log_message(level=ERROR, mod='main', &
|
||||
msg='chdir to output_dir ('//opts%output_dir//') failed!')
|
||||
call exit(1)
|
||||
end if
|
||||
end if
|
||||
|
||||
if (allocated(opts%sum_filelist)) then
|
||||
call log_message(level=INFO, mod='main', msg='summing profiles')
|
||||
|
||||
sum: block
|
||||
real(wp_) :: pabs, icd, pec
|
||||
real(wp_), dimension(:), allocatable :: dpdv, jcd, jphi
|
||||
@ -52,11 +60,23 @@ program main
|
||||
pins(params%output%nrho), rtin(params%output%nrho), &
|
||||
rpin(params%output%nrho))
|
||||
|
||||
open(100, file=opts%sum_filelist, action='read', status='old')
|
||||
open(100, file=opts%sum_filelist, action='read', status='old', iostat=err)
|
||||
if (err /= 0) then
|
||||
call log_message(level=ERROR, mod='main', &
|
||||
msg='opening file list ('//opts%sum_filelist//') failed!')
|
||||
call exit(1)
|
||||
end if
|
||||
|
||||
read(100, *) n, ngam
|
||||
do i=1,n
|
||||
read(100, *) filename
|
||||
open(100 + i, file=filename, action='read', status='old')
|
||||
open(100 + i, file=filename, action='read', status='old', iostat=err)
|
||||
if (err /= 0) then
|
||||
call log_message(level=ERROR, mod='main', &
|
||||
msg='opening summand file ('//trim(filename)//') failed!')
|
||||
call exit(1)
|
||||
end if
|
||||
|
||||
do j=1,22
|
||||
read(100 + i, *)
|
||||
end do
|
||||
@ -103,12 +123,16 @@ program main
|
||||
deallocate(dpdv, jcd, jphi, currins, pins, rtin, rpin)
|
||||
end block sum
|
||||
else
|
||||
call gray_main(params, data, results, error)
|
||||
call gray_main(params, data, results, err)
|
||||
end if
|
||||
|
||||
print '(a)'
|
||||
print '(a,f9.4)', 'Pabs (MW)=', results%pabs
|
||||
print '(a,f9.4)', 'Icd (kA)=', results%icd * 1.0e3_wp_
|
||||
print_res: block
|
||||
character(256) :: msg
|
||||
write(msg, '(a,g0.3," MW")') 'total absoption: P=', results%pabs
|
||||
call log_message(msg, level=INFO, mod='main')
|
||||
write(msg, '(a,g0.3," kA")') 'total current drive: I=', results%icd * 1.0e3_wp_
|
||||
call log_message(msg, level=INFO, mod='main')
|
||||
end block print_res
|
||||
|
||||
! Free memory
|
||||
call deinit_equilibrium(data%equilibrium)
|
||||
|
||||
@ -133,6 +133,8 @@ contains
|
||||
! ------------------------------
|
||||
subroutine initbeam(i,iroff,iboff,iwait,stv,jphi_beam,pins_beam,currins_beam, &
|
||||
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
|
||||
@ -141,16 +143,15 @@ contains
|
||||
logical, dimension(:), intent(out), pointer :: iwait
|
||||
real(wp_), dimension(:), intent(out), pointer :: jphi_beam,pins_beam, &
|
||||
currins_beam,dpdv_beam,jcd_beam,stv
|
||||
character(256) :: msg ! buffer for formatting log messages
|
||||
|
||||
iboff = .false. ! beam status (F = active, T = inactive)
|
||||
iwait = iroff(:,i) ! copy ray status for current beam from global ray status
|
||||
if(all(iwait)) then ! no rays active => stop beam
|
||||
iboff = .true.
|
||||
write(*,*)
|
||||
write(*,'("Beam ",i5," inactive")') i
|
||||
else if(.not.all(.not.iwait)) then ! only some rays active
|
||||
write(*,*)
|
||||
write(*,'("WARNING: not all rays in beam ",i5," are active")') i
|
||||
write (msg,'(" beam ",g0,": some rays are active!")') i
|
||||
call log_warning(msg, mod='multipass', proc='initbeam')
|
||||
end if
|
||||
|
||||
stv = zero ! starting step
|
||||
|
||||
Loading…
Reference in New Issue
Block a user