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

src/gray-externals.f90: remove

Browse Source 
Apparently, this module only constains old unused routines.
This commit is contained in:
Michele Guerini Rocco 2021-12-15 02:30:54 +01:00
parent 1648a7878a
commit 37ee881024
Signed by: rnhmjoj
GPG Key ID: BFBAF4C975F76450
1 changed files with 0 additions and 416 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

416
src/gray-externals.f90
View File

@ -1,416 +0,0 @@
! program gray
! use gray_params, only : ipass,igrad
! implicit none
!! local variables
! real(wp_) :: p0mw1
!! common/external functions/variables
! integer :: ierr,index_rt
! real(wp_) :: sox,p0mw,powrfl,taumn,taumx,pabstot,currtot,
!!
! common/ierr/ierr
! common/mode/sox
! common/p0/p0mw
! common/powrfl/powrfl
! common/index_rt/index_rt
! common/taumnx/taumn,taumx,pabstot,currtot
!!
! if (ipass.gt.1) then
!! second pass into plasma
! p0mw1=p0mw
! igrad=0
!!
! index_rt=2
! p0mw=p0mw1*powrfl
! call prfile
! call vectinit2
! call paraminit
! call ic_rt2
! call gray_integration
! call after_gray_integration
! pabstott=pabstott+pabstot
! currtott=currtott+currtot
!!
! index_rt=3
! sox=-sox
! p0mw=p0mw1*(1.0_wp_-powrfl)
! call prfile
! call vectinit2
! call paraminit
! call ic_rt2
! call gray_integration
! call after_gray_integration
! pabstott=pabstott+pabstot
! currtott=currtott+currtot
! end if
!!
! end program gray
!
!
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! ins_pl=inside_plasma(rrm,zzm)
! if (mod(iop(j,k),2).eq.0 .and. ins_pl) then
! iop(j,k)=iop(j,k)+1
! call pol_limit(sox,ext(j,k,iop(j,k)),eyt(j,k,iop(j,k)))
!
! if (ipass.gt.1 .and. index_rt.eq.1 .and.
! . iowmax.gt.1 .and. istore(j,k).eq.0) then
! istore(j,k)=istore(j,k)+1
! yyrfl(j,k,1:3)=xv
! yyrfl(j,k,4:6)=anv
! ihcd(j,k)=0
! end if
! else if (mod(iop(j,k),2).eq.1.and.
! . .not.ins_pl) then
! iop(j,k)=iop(j,k)+1
! call pol_limit(sox,ext(j,k,iop(j,k)),eyt(j,k,iop(j,k)))
! end if
!
! if (ipass.gt.1) then
! if (iow(j,k).eq.0 .and. inside(rlim,zlim,nlim,rrm,zzm)) then
! iow(j,k)=1
! else if (iow(j,k).eq.1 .and.
! . .not.inside(rlim,zlim,nlim,rrm,zzm)) then
! iow(j,k)=2
! if (ins_pl) then
! iop(j,k)=iop(j,k)+1
! call pol_limit(sox,ext(j,k,iop(j,k)),eyt(j,k,iop(j,k)))
! end if
! call wall_refl(xv-dst*anv,anv,ext(j,k,iop(j,k)),
! . eyt(j,k,iop(j,k)),xvrfl,anvrfl,extr,eytr,anw,irfl)
! istore(j,k)=istore(j,k)+1
! yyrfl(j,k,1:3)=xvrfl
! yyrfl(j,k,4:6)=anvrfl
! tau1v(j,k)=tauv(j,k,iiv(j,k))
! ext(j,k,iop(j,k))=extr
! eyt(j,k,iop(j,k))=eytr
! if (j.lt.jclosest) then
! jclosest=j
! anwcl=anw
! xwcl=xvrfl
! end if
! xv=xvrfl
! anv=anvrfl
! rrm=1.0e-2_wp_*sqrt(xv(1)**2+xv(2)**2)
! zzm=1.0e-2_wp_*xv(3)
! ywrk(1:3,j,k)=xv
! ywrk(4:6,j,k)=anv
! igrad=0
! call gwork(sox,xgcn,bres,j,k)
! if (ins_pl) then
! iop(j,k)=iop(j,k)+1
! call pol_limit(sox,ext(j,k,iop(j,k)),eyt(j,k,iop(j,k)))
! if (index_rt.eq.1) ihcd(j,k)=0
! end if
! end if
! end if
!
! if(index_rt.eq.1 .and. j.eq.1) psinv11=psinv
! if(iop(j,k).lt.iopmin) iopmin=iop(j,k)
! if(iow(j,k).lt.iowmin) iowmin=iow(j,k)
! if(iow(j,k).gt.iowmax) iowmax=iow(j,k)
!
! xvjk(:,j,k)=xv
! anvjk(:,j,k)=anv
!
! end do
! end do
! if(jclosest.le.nrayr) then
! aknmin=1.0_wp_
! do j=1,nrayr
! kkk=nrayth
! if(j.eq.1) kkk=1
! do k=1,kkk
! print*,i,j,k
! print*,anwcl,xwcl,anvjk(1:2,j,k)
! anwclr=(anwcl(1)*xwcl(1)+anwcl(2)*xwcl(2))
! . /sqrt(xwcl(1)**2+xwcl(2)**2)
! anvjkr=(anvjk(1,j,k)*xvjk(1,j,k)+anvjk(2,j,k)*xvjk(2,j,k))
! . /sqrt(xvjk(1,j,k)**2+xvjk(2,j,k)**2)
! akdotn=anwclr*anvjkr+anwcl(3)*anvjk(3,j,k)
! if(akdotn.lt.aknmin) aknmin=akdotn
! end do
! end do
! else
! aknmin=-1.0_wp_
! end if
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
!! single pass is stopped when all the rays have crossed the plasma
!! or complete absorption has occurred
!! same for successive passes of multi-pass simulations (here exit
!! from vessel is detected too
!! first pass in multi-pass simulation is stopped when at least one
!! ray has reflected and all rays are directed away from
!! reflection point, or when no reflection has occurred and
!! central ray re-enters the plasma
!
! if((ipass.eq.1 .and. ((iopmin.gt.1) .or.
! . (taumn.lt.1.0e+30_wp_.and.taumn.gt.taucr)))
! . .or.(index_rt.gt.1 .and. (iopmin.gt.1 .or. iowmin.gt.1 .or.
! . (taumn.lt.1.0e+30_wp_.and.taumn.gt.taucr)))) then
! istop=1
! else if(ipass.gt.1 .and. index_rt.eq.1 .and.
! . ((iowmin.gt.1 .and. aknmin.gt.0) .or.
! . (iowmax.le.1 .and. iop(1,1).gt.2))) then
!! flag second pass mode coupling as unset
! powrfl=-1.0_wp_
! qqout=0.0_wp_
! uuout=0.0_wp_
! vvout=0.0_wp_
! do j=1,nrayr
! kkk=nrayth
! if(j.eq.1) kkk=1
! do k=1,kkk
!! store missing initial conditions for the second pass
! if (istore(j,k).eq.0) then
! istore(j,k)=istore(j,k)+1
! yyrfl(j,k,1:3)=xvjk(:,j,k)
! yyrfl(j,k,4:6)=anvjk(:,j,k)
! tau1v(j,k)=tauv(j,k,iiv(j,k))
! end if
!! determine mode coupling at the plasma boundary
! if (powrfl.lt.0.0_wp_) then
! call vacuum_rt(xvjk(:,j,k),anvjk(:,j,k),xvvac,ivac)
!! look for first ray hitting the plasma, starting from the central
!! and evaluate polarization
! if (ivac.eq.1) then
! y(1:3)=xvjk(:,j,k)
! y(4:6)=anvjk(:,j,k)
! call fwork(sox,xgcn,bres,y,dery)
! call pol_limit(sox,exin2,eyin2)
! call stokes(exin2,eyin2,qqin2,uuin2,vvin2)
! powloop: do j1=1,nrayr
! kkkk=nrayth
! if(j1.eq.1) kkkk=1
! do k1=1,kkkk
!! look for first ray which completed the first pass in the plasma
! if (iop(j1,k1).gt.1) then
!! if found, use its polarization state to compute mode coupling
! call stokes(ext(j1,k1,2),eyt(j1,k1,2),
! . qqout,uuout,vvout)
! exit powloop
! end if
! end do
! end do powloop
!! if no ray completed a first pass in the plasma, use central ray
!! initial polarization (possibly reflected)
! if (qqout.le.0.0_wp_) then
! call stokes(ext(1,1,0),eyt(1,1,0),qqout,uuout,vvout)
! end if
! powrfl=0.5_wp_*(1.0_wp_+vvout*vvin2+
! . uuout*uuin2+qqout*qqin2)
! end if
! end if
! end do
! end do
! strfl11=i*dst
! write(6,*) ' '
! write(6,*) 'Reflected power fraction =',powrfl
! write(66,*) psipol,chipol,powrfl
! istop=1
! end if
!
! return
! end
!
!
!
! subroutine ic_rt(x00,y00,z00,anx0c,any0c,anz0c,ak0,xgcn,bres,
! . wcsi,weta,rcicsi,rcieta,phiw,phir,sox,psipol0,chipol0)
!! ray tracing initial conditions igrad=0
!!
! use const_and_precisions, only : wp_,izero,zero,one,pi,
! . cvdr=>degree,ui=>im
! use gray_params, only : ipol
! use beamdata, only : nrayr,nrayth,rwmax,ywrk0=>ywrk,ypwrk0=>ypwrk,
! . xc0=>xc,du10=>du1,dffiu,ddffiu,grad2,dgrad2v,gri,ggri,ext,eyt
! implicit none
!! arguments
! real(wp_), intent(in) :: x00,y00,z00,anx0c,any0c,anz0c
! real(wp_), intent(in) :: ak0,xgcn,bres
! real(wp_), intent(in) :: wcsi,weta,rcicsi,rcieta,phiw,phir
! real(wp_), intent(in) :: sox,psipol0,chipol0
!! local constants
! integer, parameter :: ndim=6,ndimm=3
!! local variables
! integer :: j,k,iv,jv,iproj,nfilp
! real(wp_) :: csth,snth,csps,snps,phiwrad,csphiw,snphiw,dr,da,u,
! . alfak,dcsiw,detaw,dx0t,dy0t,x0t,y0t,z0t,dx0,dy0,dz0,x0,y0,z0,
! . anzt,anxt,anyt,anx,any,anz,an20,an0,anx0,any0,anz0,vgradi,r0,
! . x0m,y0m,r0m,z0m,ancsi,aneta,ppcsi,ppeta,deltapol,qq,uu,vv
! real(wp_), dimension(ndim) :: ytmp,yptmp
!! common/external functions/variables
! real(wp_) :: dd,an2s,an2,fdia,bdotgr,ddi,ddr11,psinv,dens,ddens,
! . tekev,anpl,anpr,brr,bphi,bzz,ajphi,psipol,chipol,psinv11
!
!!
! common/ddd/dd,an2s,an2,fdia,bdotgr,ddi,ddr11
! common/nplr/anpl,anpr
! common/psival/psinv
! common/parpl/brr,bphi,bzz,ajphi
! common/dens/dens,ddens
! common/tete/tekev
! common/polcof/psipol,chipol
! common/psinv11/psinv11
!!
! csth=anz0c
! snth=sqrt(1.0_wp_-csth**2)
! csps=1.0_wp_
! snps=0.0_wp_
! if(snth.gt.0.0_wp_) then
! csps=any0c/snth
! snps=anx0c/snth
! end if
!!
! phiwrad=phiw*cvdr
! csphiw=cos(phiwrad)
! snphiw=sin(phiwrad)
!!
! dr=1.0_wp_
! if(nrayr.gt.1) dr=rwmax/dble(nrayr-1)
! da=2.0_wp_*pi/dble(nrayth)
! z0t=0.0_wp_
!!
! do j=1,nrayr
! u=dble(j-1)
! dffiu(j)=0.0_wp_
! ddffiu(j)=0.0_wp_
! do k=1,nrayth
! alfak=(k-1)*da
! dcsiw=dr*cos(alfak)*wcsi
! detaw=dr*sin(alfak)*weta
! dx0t=dcsiw*csphiw-detaw*snphiw
! dy0t=dcsiw*snphiw+detaw*csphiw
! x0t=u*dx0t
! y0t=u*dy0t
!!
!! csiw=u*dcsiw
!! etaw=u*detaw
!! csir=csiw
!! etar=etaw
!!
! dx0= x0t*csps+snps*(y0t*csth+z0t*snth)
! dy0=-x0t*snps+csps*(y0t*csth+z0t*snth)
! dz0= z0t*csth-y0t*snth
!!
! x0=x00+dx0
! y0=y00+dy0
! z0=z00+dz0
!!
! ppcsi=u*dr*cos(alfak)*rcicsi
! ppeta=u*dr*sin(alfak)*rcieta
!!
! anzt=1.0_wp_/sqrt(1.0_wp_+ppcsi**2+ppeta**2)
! ancsi=ppcsi*anzt
! aneta=ppeta*anzt
!!
! anxt=ancsi*csphiw-aneta*snphiw
! anyt=ancsi*snphiw+aneta*csphiw
!!
! anx= anxt*csps+snps*(anyt*csth+anzt*snth)
! any=-anxt*snps+csps*(anyt*csth+anzt*snth)
! anz= anzt*csth-anyt*snth
!!
! an20=1.0_wp_
! an0=sqrt(an20)
! anx0=anx
! any0=any
! anz0=anz
!!
! xc0(1,j,k)=x0
! xc0(2,j,k)=y0
! xc0(3,j,k)=z0
!!
! ywrk0(1,j,k)=x0
! ywrk0(2,j,k)=y0
! ywrk0(3,j,k)=z0
! ywrk0(4,j,k)=anx0
! ywrk0(5,j,k)=any0
! ywrk0(6,j,k)=anz0
!!
! ypwrk0(1,j,k) = anx0/an0
! ypwrk0(2,j,k) = any0/an0
! ypwrk0(3,j,k) = anz0/an0
! ypwrk0(4,j,k) = 0.0_wp_
! ypwrk0(5,j,k) = 0.0_wp_
! ypwrk0(6,j,k) = 0.0_wp_
!!
! ytmp=ywrk0(:,j,k)
! yptmp=ypwrk0(:,j,k)
! call fwork(sox,xgcn,bres,ytmp,yptmp)
!
! if(ipol.eq.0) then
! call pol_limit(sox,ext(j,k,0),eyt(j,k,0))
! qq=abs(ext(j,k,0))**2-abs(eyt(j,k,0))**2
! uu=2.0_wp_*dble(ext(j,k,0)*dconjg(eyt(j,k,0)))
! vv=2.0_wp_*dimag(ext(j,k,0)*dconjg(eyt(j,k,0)))
! call polellipse(qq,uu,vv,psipol0,chipol0)
! else
! qq=cos(2.0_wp_*chipol0*cvdr)*cos(2.0_wp_*psipol0*cvdr)
! uu=cos(2.0_wp_*chipol0*cvdr)*sin(2.0_wp_*psipol0*cvdr)
! vv=sin(2.0_wp_*chipol0*cvdr)
! if(qq**2.lt.1.0_wp_) then
!! deltapol=phix-phiy, phix =0
! deltapol=atan2(vv,uu)
! ext(j,k,0)= sqrt((1.0_wp_+qq)/2)
! eyt(j,k,0)= sqrt((1.0_wp_-qq)/2)*exp(-ui*deltapol)
! else
! if(qq.gt.0.0_wp_) then
! ext(j,k,0)= 1.0_wp_
! eyt(j,k,0)= 0.0_wp_
! else
! eyt(j,k,0)= 1.0_wp_
! ext(j,k,0)= 0.0_wp_
! end if
! end if
! endif
! psipol=psipol0
! chipol=chipol0
!!
! do iv=1,3
! gri(iv,j,k)=0.0_wp_
! dgrad2v(iv,j,k)=0.0_wp_
! du10(iv,j,k)=0.0_wp_
! do jv=1,3
! ggri(iv,jv,j,k)=0.0_wp_
! end do
! end do
! grad2(j,k)=0.0_wp_
!!
! dd=anx0**2+any0**2+anz0**2-an20
! vgradi=0.0_wp_
! ddi=2.0_wp_*vgradi
!!
! r0=sqrt(x0**2+y0**2)
! x0m=x0/1.0e2_wp_
! y0m=y0/1.0e2_wp_
! r0m=r0/1.0e2_wp_
! z0m=z0/1.0e2_wp_
! if(j.eq.nrayr) then
! write(33,111) izero,j,k,zero,x0m,y0m,r0m,z0m,
! . psinv,zero,anpl,zero,one
! end if
! if(j.eq.1.and.k.eq.1) then
! psinv11=psinv
! write(17,99) zero,zero,zero,zero
! write(4,99) zero,r0m,z0m,atan2(y0m,x0m)*180.0_wp_/pi,
! . psinv,one,dens,tekev,brr,bphi,bzz,
! . ajphi*1.0e-6_wp_,sqrt(anpl**2+anpr**2),anpl,zero,
! . zero,zero,zero,zero,zero,zero,zero,one
! end if
! end do
! end do
!
! call pweigth
!!
! if(nrayr.gt.1) then
! iproj=0
! nfilp=8
! call projxyzt(iproj,nfilp)
! end if
!!
! return
!99 format(24(1x,e16.8e3))
!111 format(3i5,20(1x,e16.8e3))
! end