src: simplify handling of free units

This changes the behavior of `get_free_unit` to simplify the handling of
optional unit numbers.
This commit is contained in:
Michele Guerini Rocco 2021-12-15 18:40:16 +01:00
parent 095ee7ecf2
commit ef1617713f
Signed by: rnhmjoj
GPG Key ID: BFBAF4C975F76450
6 changed files with 32 additions and 62 deletions

View File

@ -22,11 +22,7 @@ contains
integer :: u integer :: u
real(wp_) :: ak0,zrcsi,zreta real(wp_) :: ak0,zrcsi,zreta
if (present(unit)) then u = get_free_unit(unit)
u = unit
else
u = get_free_unit()
end if
open(unit=u, file=trim(params%filenm), status='OLD', action='READ') open(unit=u, file=trim(params%filenm), status='OLD', action='READ')
read(u, *) params%fghz read(u, *) params%fghz
@ -69,11 +65,7 @@ contains
cbeta, cx0, cy0, cz0, cwaist1, cwaist2, & cbeta, cx0, cy0, cz0, cwaist1, cwaist2, &
crci1, crci2, cphi1, cphi2 crci1, crci2, cphi1, cphi2
if (present(unit)) then u = get_free_unit(unit)
u = unit
else
u = get_free_unit()
end if
open(unit=u, file=params%filenm, status='OLD', action='READ') open(unit=u, file=params%filenm, status='OLD', action='READ')
read(u,*) params%fghz read(u,*) params%fghz
@ -196,11 +188,7 @@ contains
integer, parameter :: kspl=1 integer, parameter :: kspl=1
real(wp_), parameter :: sspl=0.01_wp_ real(wp_), parameter :: sspl=0.01_wp_
if (present(unit)) then u = get_free_unit(unit)
u = unit
else
u = get_free_unit()
end if
open(unit=u, file=params%filenm, status='OLD', action='READ') open(unit=u, file=params%filenm, status='OLD', action='READ')
!======================================================================================= !=======================================================================================

View File

@ -151,11 +151,7 @@ contains
if(allocated(data%derad)) deallocate(data%derad) if(allocated(data%derad)) deallocate(data%derad)
if(allocated(data%zfc)) deallocate(data%zfc) if(allocated(data%zfc)) deallocate(data%zfc)
if (present(unit)) then u = get_free_unit(unit)
u = unit
else
u = get_free_unit()
end if
! Read number of rows and allocate the arrays ! Read number of rows and allocate the arrays
open(file=trim(filenm), status='old', action='read', unit=u) open(file=trim(filenm), status='old', action='read', unit=u)
@ -185,11 +181,7 @@ contains
! local variables ! local variables
integer :: u integer :: u
if (present(unit)) then u = get_free_unit(unit)
u=unit
else
u=get_free_unit()
end if
if(allocated(te)) deallocate(te) if(allocated(te)) deallocate(te)
if(allocated(ne)) deallocate(ne) if(allocated(ne)) deallocate(ne)

View File

@ -55,11 +55,7 @@ contains
real(wp_) :: dr, dz, dps, rleft, zmid, zleft, psiedge, psiaxis real(wp_) :: dr, dz, dps, rleft, zmid, zleft, psiedge, psiaxis
real(wp_) :: xdum ! dummy variable, used to discard data real(wp_) :: xdum ! dummy variable, used to discard data
if(present(unit)) then u = get_free_unit(unit)
u = unit
else
u = get_free_unit()
end if
! Open the G-EQDSK file ! Open the G-EQDSK file
open(file=trim(params%filenm), status='old', action='read', unit=u) open(file=trim(params%filenm), status='old', action='read', unit=u)
@ -169,11 +165,8 @@ contains
integer :: i, u, nlim integer :: i, u, nlim
real(wp_) :: rr0m,zr0m,rpam,b0,q0,qa,alq !,rcen,btrcen real(wp_) :: rr0m,zr0m,rpam,b0,q0,qa,alq !,rcen,btrcen
if (present(unit)) then u = get_free_unit(unit)
u=unit
else
u=get_free_unit()
end if
open(file=trim(filenm),status='old',action='read',unit=u) open(file=trim(filenm),status='old',action='read',unit=u)
read(u,*) rr0m,zr0m,rpam read(u,*) rr0m,zr0m,rpam
read(u,*) b0 read(u,*) b0

View File

@ -232,11 +232,7 @@ contains
! local variables ! local variables
integer :: u, iostat integer :: u, iostat
if (present(unit)) then u = get_free_unit(unit)
u = unit
else
u = get_free_unit()
end if
open(u, file=filename, status='old', action='read', iostat=iostat) open(u, file=filename, status='old', action='read', iostat=iostat)
if (iostat > 0) then if (iostat > 0) then

View File

@ -107,8 +107,7 @@ contains
use equilibrium, only : btrcen,btaxis,rmaxis,zmaxis,phitedge,zbsup,zbinf, & use equilibrium, only : btrcen,btaxis,rmaxis,zmaxis,phitedge,zbsup,zbinf, &
equian,equinum_psi,bfield,frhotor,fq,tor_curr equian,equinum_psi,bfield,frhotor,fq,tor_curr
use simplespline, only : difcs use simplespline, only : difcs
use dierckx, only : regrid,coeff_parder use dierckx, only : regrid,coeff_parder
use utils, only : get_free_unit
implicit none implicit none
! local constants ! local constants

View File

@ -246,33 +246,35 @@ contains
end do end do
end subroutine bubble end subroutine bubble
function get_free_unit(umin,umax) result(i)
function get_free_unit(unit) result(i)
! Returns `unit` back or the first free unit
! number `i` if `unit` is absent.
! When no unit is available, returns -1.
implicit none implicit none
! function arguments
integer :: i integer :: i
integer, intent(in), optional :: umin, umax integer, intent(in), optional :: unit
! local variables
integer, parameter :: max_allowed = 999 integer, parameter :: max_allowed = 999
integer :: ierr, iend integer :: error
logical :: ex, op logical :: ex, op
if (present(umin)) then if (present(unit)) then
i = max(0,umin) ! start searching from unit min i = unit
else return
i = 0
end if end if
if (present(umax)) then
iend = min(max(0,umax),max_allowed) do i=0,max_allowed
else inquire(unit=i, exist=ex, opened=op, iostat=error)
iend = max_allowed ! if unit i exists and is free
end if if (error == 0 .and. ex .and. .not. op) return
do
if (i>iend) then
i=-1 ! no free units found
exit
end if
inquire(unit=i,exist=ex,opened=op,iostat=ierr)
if (ierr==0.and.ex.and..not.op) exit ! unit i exists and is not open
i = i + 1
end do end do
i = -1
end function get_free_unit end function get_free_unit