! coil design program
program coil
integer :: i, its, swg, nturns, outer
character*10 :: lorg
character*20 :: vstr, lmhstr, diastr
real :: dia, r, l, ld, lmh, n, dw, lcoil, extend, step, lactual, value
integer, parameter :: mswg=40, g1000(0:mswg) = &
(/324,300,276,256,236,212,192,176,160,144,128,116, &
  104, 92, 80, 72, 64, 56, 48, 40, 36, 32, 28, 24, &
   22, 20, 18, 16, 15, 14, 12, 12, 11, 10,  9,  8, &
    8,  7,  6,  5,  5 /)

call getarg (1,lorg)
call getarg (2, vstr)
call getarg (3,lmhstr)
call getarg (4,diastr)

! print '(a,a)', 'Mode is ', lorg
call s2r (vstr, value)
call s2r (lmhstr,lmh)
call s2r (diastr,dia)

if ((value<0.0) .or. (lorg==' ') .or. (lmhstr=='') .or. (diastr=='') &
  .or. (lmh<=0) .or. (dia<=0) ) then
 print *, '<h2> Bad data input!! </h2>'
 stop
end if

if (lorg=='l') l=value
if (lorg=='g') swg=value

! print *, 'Required inductance, microH:' ; read *, lmh
! print *, 'Diameter, inches:' ; read *, dia

if (dia<=0) stop

r=dia/2

if (lorg=='l') then
!  print *, 'Proposed coil length:' ; read *, l
 swg=-1
end if

if (lorg=='g') then
 l=-1
! print *, 'Wire SWG:' ; read *, swg
end if

do outer=1,5

if (lorg=='r') then ! repeat calculation 
 lorg='g' ! recalc only in 'g' mode
end if


if (lorg=='g') then ! *** Calculation using fixed swg, closewound
! or possibly recalculation

 if (swg>mswg) then
  print '(a,i4,a)' , '<p> Using smallest wire I have which is', mswg, ' SWG'
  swg=mswg
 end if

 if (l<=0.0)  l=dia ! estimated length

 dw = g1000(swg)/1000.0
!  print *, 'Wire diameter is ', dw, ' inches'

! print *, 'Wire diameter, inches:' ; read *, dw


 n = (lmh * (9 * r + 10 * l) / r ** 2) ** .5

 lcoil= n*dw

 its=100 ;  i=0

 if (lcoil<l) then
! print *, n, ' turns can be spaced to fill coil, or coil can be shortened'
  extend=-lcoil
  l=lcoil
  step=extend / its
  do i=1,its
   l=l+step
   n = (lmh * (9 * r + 10 * l) / r ** 2) ** .5
   lcoil= n*dw
!  print *, i, n, l, lcoil
   if (l<=0.4*dia) then
    print *, 'Coil length will be restricted to l/d=0.4'
    lcoil=0.4*dia ; l=lcoil
    n = (lmh * (9 * r + 10 * l) / r ** 2) ** .5
    exit
   end if
   if (lcoil>=l) exit
  end do
 else
! need to adjust length..
!  print *, &
! 'Coil will need to be longer than specified, at least ', lcoil, ' inches'
  extend=2*(lcoil-l)
  l=lcoil
  step=extend / its
  do i=1,its
   l=l+step
   n = (lmh * (9 * r + 10 * l) / r ** 2) ** .5
! print *, i, n, l
   lcoil= n*dw
   if (lcoil<=l) exit
  end do
 end if

 if (i>=its) then
!  print *, 'Cannot converge calculation, guess a better length!'
!  print *, 'Coil requires ', n, ' at least turns over ', lcoil,' inches'
  l=lcoil
  lorg='r'
  cycle
 end if 

else  ! Calculation with fixed length, choose swg
 ld=l/dia
 if (ld<0.4) then
  print *, '<p> Warning!, l/d should be > 0.4 <p> '
  l=dia*0.4
 end if

 swg=mswg+1 ! flag for failure
 lcoil=l
 n = (lmh * (9 * r + 10 * l) / r ** 2) ** .5
 
 dw = l/n
 do i=0, mswg
  if (dw>= g1000(i)/1000.0) then ; swg=i; exit ; endif
 end do
 if (swg>mswg) then
  print '(a,f7.3)', '<p> Sorry, you need wire with diameter less than ', dw
  print '(a,i4,a,f7.3)', &
   '<p> Smallest available is swg ', mswg, ' diameter', g1000(mswg)/1000.0
  print *, ' Using this gauge '
  swg=mswg ; lorg='r' ; l=-1  ! set recalc with fixed swg
  cycle
 end if
 
 print '(a,i4)' , '<p> Recommended wire gauge is ', swg
end if

! final calc...
l=lcoil
! n = (lmh * (9 * r + 10 * l) / r ** 2) ** .5

nturns=nint(n) 

print '(a,i8 ,a, i4 ,a, f10.2,a)', &
  '<p> <p> Coil has ', nturns, ' turns of ', swg, ' swg over ', lcoil,' inches'

print '(a,f11.2)', '<p> Nominal turns required are ', n


lactual=(r*nturns)**2/(9*r+10*lcoil)
print '(a,f10.2,a)', '<p> Actual inductance is', lactual, ' microHenries'

lorg='l' ; l=-1 ; swg=-1 ! reset flags, not needed now
stop ! make a one shot
end do

print *, '<p> WARNING, the calculation may be inacurate. '
print *, '<p> You must have specified some rather odd values! <p>'

contains 

subroutine s2r (string, value)
character*(*), intent(in) :: string
real, intent(out) :: value
character*20 :: hold
value=-1 ! default/fail
hold=adjustr(trim(string))
read (hold, '(f20.0)', err=100) value
100 continue
end subroutine

end