From 2bc9087c91dfbbc1161ba432d7ff0fd164e7c54a Mon Sep 17 00:00:00 2001 From: Daniele Micheletti Date: Mon, 25 May 2015 16:03:25 +0000 Subject: [PATCH] gray-jintrac: added modules graydata_par, graydata_flags, graydata_anequil --- Makefile | 8 +- Makefile.single | 11 +- Makefile.standalone | 11 +- src/gray-externals.f | 233 ++++++++++++++++++------------------------- src/gray_main.f90 | 6 +- 5 files changed, 122 insertions(+), 147 deletions(-) diff --git a/Makefile b/Makefile index f33d9c0..92cdccc 100644 --- a/Makefile +++ b/Makefile @@ -96,12 +96,16 @@ clean: # Dependencies # ------------ -gray_main.o: const_and_precisions.o -gray-externals.o: green_func_p.o reflections.o beamdata.o const_and_precisions.o dispersion.o +gray_main.o: const_and_precisions.o graydata_flags.o +gray-externals.o: green_func_p.o reflections.o beamdata.o const_and_precisions.o dispersion.o \ + graydata_par.o graydata_flags.o graydata_anequil.o green_func_p.o: const_and_precisions.o scatterspl.o: const_and_precisions.o beamdata.o: const_and_precisions.o dispersion.o: calcei.o dqagmv.o +graydata_par.o: const_and_precisions.o +graydata_flags.o: const_and_precisions.o +graydata_anequil.o: const_and_precisions.o # Special rule to preprocess source file and include svn revision # --------------------------------------------------------------- diff --git a/Makefile.single b/Makefile.single index 4b4893b..91d188d 100644 --- a/Makefile.single +++ b/Makefile.single @@ -4,7 +4,8 @@ EXE=gray-single # Objects list OBJ= gray-single.o gray_main.o gray-externals.o grayl.o beamdata.o \ const_and_precisions.o green_func_p.o reflections.o scatterspl.o \ - dispersion.o calcei.o dqagmv.o + dispersion.o calcei.o dqagmv.o graydata_par.o graydata_flags.o \ + graydata_anequil.o # Alternative search paths vpath %.f90 src @@ -63,12 +64,16 @@ clean: # Dependencies # ------------ gray-single.o: gray_main.o grayl.o -gray_main.o: const_and_precisions.o -gray-externals.o: green_func_p.o reflections.o beamdata.o const_and_precisions.o dispersion.o +gray_main.o: const_and_precisions.o graydata_flags.o +gray-externals.o: green_func_p.o reflections.o beamdata.o const_and_precisions.o dispersion.o \ + graydata_par.o graydata_flags.o graydata_anequil.o green_func_p.o: const_and_precisions.o scatterspl.o: const_and_precisions.o beamdata.o: const_and_precisions.o dispersion.o: calcei.o dqagmv.o +graydata_par.o: const_and_precisions.o +graydata_flags.o: const_and_precisions.o +graydata_anequil.o: const_and_precisions.o ## library name ## ------------ diff --git a/Makefile.standalone b/Makefile.standalone index 3eece41..c5c2f99 100644 --- a/Makefile.standalone +++ b/Makefile.standalone @@ -5,7 +5,7 @@ LIBFILE=lib$(EXE).a # Objects list OBJ=gray_main.o gray-externals.o grayl.o reflections.o scatterspl.o \ beamdata.o green_func_p.o const_and_precisions.o dispersion.o \ - calcei.o dqagmv.o + calcei.o dqagmv.o graydata_par.o graydata_flags.o graydata_anequil.o # Alternative search paths vpath %.f90 src @@ -30,12 +30,17 @@ $(LIBFILE): $(OBJ) # Dependencies on modules main.o: const_and_precisions.o -gray_main.o: const_and_precisions.o -gray-externals.o: green_func_p.o reflections.o beamdata.o dispersion.o +gray_main.o: const_and_precisions.o graydata_flags.o +gray-externals.o: green_func_p.o reflections.o beamdata.o dispersion.o \ + graydata_par.o graydata_flags.o graydata_anequil.o \ + const_and_precisions.o green_func_p.o: const_and_precisions.o scatterspl.o: const_and_precisions.o beamdata.o: const_and_precisions.o dispersion.o: calcei.o dqagmv.o +graydata_par.o: const_and_precisions.o +graydata_flags.o: const_and_precisions.o +graydata_anequil.o: const_and_precisions.o # General object compilation command %.o: %.f90 diff --git a/src/gray-externals.f b/src/gray-externals.f index 7ea0ca9..cd67c56 100644 --- a/src/gray-externals.f +++ b/src/gray-externals.f @@ -1,13 +1,13 @@ subroutine gray_integration use beamdata, only : nstep + use graydata_flags, only : dst implicit none integer istep,istop,index_rt - real*8 st,dst,strfl11 + real*8 st,strfl11 integer i real*8 st0 common/ss/st - common/dsds/dst common/istep/istep common/istop/istop common/strfl11/strfl11 @@ -39,28 +39,20 @@ c ray integration: end subroutine after_gray_integration(rhopin,nrho,dpdvout,ajcdout) use beamdata, only : nrayr + use graydata_flags, only : ibeam,iwarm,ilarm,iequil,iprof, + . filenmeqq,filenmprf,filenmbm + use graydata_anequil, only : dens0,te0 + implicit real*8 (a-h,o-z) parameter(zero=0.0d0) - character*255 filenmeqq,filenmprf,filenmbm dimension rhopin(nrho),dpdvout(nrho),ajcdout(nrho) c common/ss/st - common/ibeam/ibeam - common/warm/iwarm,ilarm - common/filesn/filenmeqq,filenmprf,filenmbm - common/iieq/iequil - common/iipr/iprof common/index_rt/index_rt c common/p0/p0mw - common/factb/factb common/taumnx/taumn,taumx,pabstot,currtot - common/scal/iscal - common/facttn/factt,factn - - common/pardens/dens0,aln1,aln2 - common/parqte/te0,dte0,alt1,alt2 c c print all ray positions in local reference system @@ -110,12 +102,13 @@ c use const_and_precisions, only : pi use beamdata, only : psjki,ppabs,ccci,iiv,tauv, . iop,iow,tau1v,yyrfl,nrayr,nrayth + use graydata_par, only : rwallm,psipol0,chipol0,psdbnd + use graydata_flags, only : iwarm,istpr0,istpl0,dst,ipass + implicit real*8 (a-h,o-z) parameter(taucr=12.0d0,cvdr=pi/180.0d0) dimension xv(3),anv(3),xvrfl(3),anvrfl(3) - common/warm/iwarm,ilarm - common/ist/istpr0,istpl0 common/istgr/istpr,istpl c common/psinv/psinv @@ -127,17 +120,12 @@ c common/cent/btrcen,rcen c common/p0/p0mw - common/pol0/psipol0,chipol0 common/ipol/ipolc common/iovmin/iopmin,iowmin - common/densbnd/psdbnd common/powrfl/powrfl common/dstvac/dstvac common/strfl11/strfl11 - common/dsds/dst common/index_rt/index_rt - common/ipass/ipass - common/rwallm/rwallm common/zbound/zbmin,zbmax pabstot=0.0d0 @@ -291,10 +279,12 @@ c use const_and_precisions, only : pi use beamdata, only : ywrk,psjki,tauv,alphav,pdjki, . currj,didst,q,tau1v,nrayr!,nrayth + use graydata_par, only : psdbnd + use graydata_flags, only : iequil,istpl0 + implicit real*8 (a-h,o-z) parameter(taucr=12.0d0) complex*16 ex,ey,ez - c common/nhn/nhn common/iokh/iohkawa @@ -303,8 +293,6 @@ c common/ss/st common/istgr/istpr,istpl - common/ist/istpr0,istpl0 - common/iieq/iequil c common/parpl/brr,bphi,bzz,ajphi common/btot/btot @@ -313,7 +301,6 @@ c common/dddens/dens,ddens common/tete/tekev common/absor/alpha,effjcd,akim,tau0 - common/densbnd/psdbnd common/epolar/ex,ey,ez c common/nplr/anpl,anpr @@ -453,6 +440,10 @@ c use green_func_p, only:Setup_SpitzFunc use const_and_precisions, only : pi use beamdata, only : nrayr,nrayth,nstep + use graydata_par + use graydata_flags + use graydata_anequil + implicit real*8 (a-h,o-z) integer ijetto, mr, mz, nrho, nbnd, beamid real*8 r(mr), z(mz), psin(mr,mz) @@ -465,61 +456,27 @@ c real*8 me character*8 wdat character*10 wtim - character*255 filenmeqq,filenmprf,filenmbm parameter(qe=4.8032d-10,me=9.1095d-28,vc=2.9979d+10) parameter(cvdr=pi/180.0d0) parameter(nbb=5000) real*8 rlim(nbb),zlim(nbb) c common/xgcn/xgcn - - common/ipec/ipec,nnd - common/ibeam/ibeam - common/ist/istpr0,istpl0 - common/warm/iwarm,ilarm - common/ieccd/ieccd - common/idst/idst - common/imx/imx c - common/filesn/filenmeqq,filenmprf,filenmbm -c - common/rwmax/rwmax - common/dsds/dst - common/igrad/igrad - common/ipass/ipass - common/rwallm/rwallm common/limiter/rlim,zlim,nlim - common/iieq/iequil - common/icocos/icocos - common/ixp/ixp - common/ipsn/ipsinorm - common/sspl/sspl - common/iipr/iprof - common/factb/factb - common/facttn/factt,factn common/cent/btrcen,rcen c common/parwv/ak0,akinv,fhz common/parbeam/wcsi,weta,rcicsi,rcieta,phiw,phir common/anic/anx0c,any0c,anz0c common/mirr/x00,y00,z00 - common/pol0/psipol0,chipol0 -c - common/pardens/dens0,aln1,aln2 - common/parban/b0,rr0m,zr0m,rpam - common/parqq/q0,qa,alq - common/parqte/te0,dte0,alt1,alt2 - common/zz/Zeffan c common/parbres/bres - common/densbnd/psdbnd common/nfile/neqdsk,nprof - common/sgnib/sgnbphi,sgniphi common/p0/p0mw c common/mode/sox common/angles/alpha0,beta0 - common/scal/iscal common/fghz/fghz c open(602,file='gray.data',status= 'old') @@ -855,8 +812,9 @@ c c subroutine surf_anal use const_and_precisions, only : pi + use graydata_anequil, only : b0,rr0m,zr0m,rpam + implicit real*8(a-h,o-z) - common/parban/b0,rr0m,zr0m,rpam common/parbres/bres c c print circular magnetic surfaces iequil=1 @@ -897,9 +855,10 @@ c@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ subroutine read_beams(beamid,iox) use const_and_precisions, only : pi use reflections, only : inside + use graydata_flags, only : filenmbm, sspl, ibeam + implicit real*8(a-h,o-z) c - character*255 filenmeqq,filenmprf,filenmbm character*20 beamname c integer beamid, nisteer, fdeg, jumprow, nbeam, nalpha, nbeta, @@ -918,11 +877,9 @@ c . ypolygA, xpolygB, ypolygB, xpolygC, ypolygC, xpolygD, ypolygD real*8 xvert(4), yvert(4) c - parameter(kspl=1,sspl=0.01d0) + parameter(kspl=1) parameter(vc=2.9979d+10) c - common/ibeam/ibeam - common/filesn/filenmeqq,filenmprf,filenmbm common/parbeam/wcsi,weta,rcicsi,rcieta,phiw,phir common/mirr/x00,y00,z00 common/angles/alpha0,beta0 @@ -934,6 +891,7 @@ c c ibeam=1 simple astigmatic beam c ibeam=2 general astigmatic beam c + sspl=0.01d0 nfbeam=603 open(file=trim(filenmbm),status= 'old',unit=nfbeam) c @@ -1608,6 +1566,9 @@ c . rax,zax,nbnd,rbnd,zbnd,mrho,psijet,fpjet,qjet) use const_and_precisions, only : pi use reflections, only : inside + use graydata_par, only : sgnbphi,sgniphi,factb + use graydata_flags, only : ipsinorm,sspl,ixp,icocos + implicit real*8 (a-h,o-z) integer ijetto,mr,mz,nbnd,mrho real*8 r(mr),z(mz),psin2d(mr,mz) @@ -1646,14 +1607,8 @@ c common/cpsin/rv,zv,psin common/cpsi/psi common/eqnn/nr,nz,nrho,npp,nintp - common/ipsn/ipsinorm - common/sspl/sspl common/nfile/neqdsk,nprof common/zbound/zbmin,zbmax - common/sgnib/sgnbphi,sgniphi - common/factb/factb - common/ixp/ixp - common/icocos/icocos common/coffeqt/tr,tz common/coffeqtp/tfp @@ -2220,6 +2175,9 @@ c c c subroutine profdata(mrho, psijet, te, dne, zeff) + use graydata_par, only : psdbnd,factb,factt,factn + use graydata_flags, only : iprof,iscal + implicit real*8 (a-h,o-z) c integer mrho @@ -2232,20 +2190,15 @@ c dimension tfn(npest),cfn(npest),wrkf(lwrkf),iwrkf(npest),wf(npmx) dimension densi(npest),ddensi(npest),d2densi(npest),wrkfd(npest) c - common/densbnd/psdbnd common/denspp/psnpp,aa,bb,cc common/eqnn/nr,nz,nrho,npp,nintp - common/iipr/iprof common/nfile/neqdsk,nprof common/crad/psrad,derad,terad,zfc common/coffte/ct common/coffz/cz - common/factb/factb common/coffdt/tfn common/coffdnst/nsfd common/cofffn/cfn - common/scal/iscal - common/facttn/factt,factn c c read plasma profiles from file if iprof>0 c @@ -2658,6 +2611,8 @@ c c subroutine contours_psi(h,np,rcn,zcn,ipr) use const_and_precisions, only : pi + use graydata_par, only : rwallm + implicit real*8 (a-h,o-z) parameter(mest=4,kspl=3) parameter(nnw=501,nnh=501) @@ -2672,7 +2627,6 @@ c common/coffeq/cc common/coffeqt/tr,tz common/cnt/rup,zup,rlw,zlw - common/rwallm/rwallm c ra=rup rb=rlw @@ -3125,15 +3079,15 @@ c use beamdata, only : jmx,kmx,nmx,psjki,tauv,alphav,pdjki,ppabs, . currj,didst,ccci,iiv,iop,iow,tau1v,nrayr,nrayth,nstep,alloc_beam use dispersion, only : expinit + use graydata_flags, only : iwarm c implicit none c internal integer i,j,k real(r8) dt c common - integer ierr,iwarm,ilarm + integer ierr c - common/warm/iwarm,ilarm common/ierr/ierr c if(nstep.gt.nmx) nstep=nmx @@ -3456,17 +3410,16 @@ c subroutine rkint4 use beamdata, only : nrayr,nrayth,ywrk,ypwrk,grad2,dgrad2v, . gri,ggri + use graydata_flags, only : dst,igrad + implicit real*8 (a-h,o-z) parameter(ndim=6) dimension y(ndim),yy(ndim) dimension fk1(ndim),fk2(ndim),fk3(ndim),fk4(ndim) dimension dgr2(3),dgr(3),ddgr(3,3) -c - common/dsds/dst c common/gr/gr2 common/dgr/dgr2,dgr,ddgr - common/igrad/igrad c h=dst hh=h*0.5d0 @@ -3519,12 +3472,12 @@ c c subroutine gwork(j,k) use beamdata, only : ywrk,ypwrk,grad2,dgrad2v,gri,ggri + use graydata_flags, only : igrad + implicit real*8 (a-h,o-z) parameter(ndim=6) dimension yy(ndim),yyp(ndim) dimension dgr2(3),dgr(3),ddgr(3,3) -c - common/igrad/igrad c common/gr/gr2 common/dgr/dgr2,dgr,ddgr @@ -3560,6 +3513,8 @@ c c c subroutine fwork(y,dery) + use graydata_flags, only : idst,igrad + implicit real*8 (a-h,o-z) dimension y(6),dery(6) dimension xv(3),anv(3),vgv(3),bv(3),derbv(3,3),derxg(3),deryg(3) @@ -3573,7 +3528,6 @@ c common/nplr/anpl,anpr common/bb/bv common/dbb/derbv - common/igrad/igrad common/xgxg/xg common/ygyg/yg common/dxgyg/derxg,deryg @@ -3582,7 +3536,6 @@ c common/ierr/ierr common/anv/anv common/xv/xv - common/idst/idst c xx=y(1) yy=y(2) @@ -3742,6 +3695,9 @@ c c subroutine plas_deriv(xx,yy,zz) use const_and_precisions, only : pi + use graydata_par, only : sgnbphi + use graydata_flags, only : iequil + implicit real*8 (a-h,o-z) dimension bv(3),derxg(3),deryg(3),derbv(3,3),dbtot(3) dimension bvc(3),dbvcdc(3,3),dbvdc(3,3),dbv(3,3) @@ -3755,10 +3711,8 @@ c common/dxgdps/dxgdpsi common/ygyg/yg common/dxgyg/derxg,deryg - common/iieq/iequil common/derip/dpsidr,dpsidz,ddpsidrr,ddpsidzz,ddpsidrz,fpolv,ffpv common/psinv/psinv - common/sgnib/sgnbphi,sgniphi c xg=0.0d0 yg=9.9d1 @@ -3905,22 +3859,21 @@ c c c subroutine equian(rrm,zzm) + use graydata_par, only : psdbnd,sgnbphi,sgniphi + use graydata_flags, only : iprof + use graydata_anequil, only : b0,rr0m,zr0m,rpam,q0,qa,alq + implicit real*8 (a-h,o-z) c - common/parqq/q0,qa,alq - common/parban/b0,rr0m,zr0m,rpam common/psinv/psinv common/pareq1/psia - common/densbnd/psdbnd common/derip/dpsidr,dpsidz,ddpsidrr,ddpsidzz,ddpsidrz,fpolv,ffpv common/xgxg/xg common/dxgdps/dxgdpsi common/xgcn/xgcn common/dddens/dens,ddens - common/sgnib/sgnbphi,sgniphi common/bmxmn/bmxi,bmni common/fc/fci - common/iipr/iprof c if(iprof.eq.0) psdbnd=1.0d0 c @@ -4189,15 +4142,16 @@ c c c subroutine density(arg) + use graydata_par, only : psdbnd + use graydata_flags, only : iprof + use graydata_anequil, only : dens0,aln1,aln2 + implicit real*8 (a-h,o-z) parameter(npmx=501,npest=npmx+4) dimension xxs(1),ffs(1) dimension tfn(npest),cfn(npest),wrkfd(npest) c - common/densbnd/psdbnd common/denspp/psnpp,aad,bbd,ccd - common/iipr/iprof - common/pardens/dens0,aln1,aln2 common/dddens/dens,ddens common/coffdt/tfn common/coffdnst/nsfd @@ -4249,12 +4203,13 @@ c c c function temperature(arg) + use graydata_flags, only : iprof + use graydata_anequil, only : te0,dte0,alt1,alt2 + implicit real*8 (a-h,o-z) parameter(npmx=501) dimension psrad(npmx),derad(npmx),terad(npmx),zfc(npmx),ct(npmx,4) c - common/parqte/te0,dte0,alt1,alt2 - common/iipr/iprof common/crad/psrad,derad,terad,zfc common/coffte/ct common/eqnn/nr,nz,nrho,npp,nintp @@ -4276,21 +4231,22 @@ c c c function fzeff(arg) + use graydata_flags, only : iprof + use graydata_anequil, only : zeffloc=>zeffan + implicit real*8 (a-h,o-z) parameter(npmx=501) dimension psrad(npmx),derad(npmx),terad(npmx),zfc(npmx),cz(npmx,4) c - common/iipr/iprof common/crad/psrad,derad,terad,zfc common/coffz/cz common/eqnn/nr,nz,nrho,npp,nintp - common/zz/Zeff c fzeff=1 ps=arg if(ps.gt.1.0d0.and.ps.lt.0.0d0) return if(iprof.eq.0) then - fzeff=zeff + fzeff=zeffloc else call vlocate(psrad,npp,ps,k) k=max(1,min(k,npp-1)) @@ -4307,6 +4263,8 @@ c use beamdata, only : nrayr,nrayth,ywrk0=>ywrk,ypwrk0=>ypwrk, . xc0=>xc,du10=>du1,dffiu,ddffiu,grad2,dgrad2v, . gri,ggri + use graydata_par, only : rwmax + implicit real*8 (a-h,o-z) parameter(zero=0.0d0,izero=0,one=1.0d0) parameter(cvdr=pi/180.0d0) @@ -4318,7 +4276,6 @@ c external catand c parameter(ui=(0.0d0,1.0d0)) c - common/rwmax/rwmax common/parwv/ak0,akinv,fhz common/parbeam/wcsi,weta,rcicsi,rcieta,phiw,phir common/anic/anx0c,any0c,anz0c @@ -4587,12 +4544,13 @@ c use beamdata, only : nrayr,nrayth,ywrk0=>ywrk,ypwrk0=>ypwrk, . xc0=>xc,du10=>du1,dffiu,ddffiu,grad2,dgrad2v, . gri,ggri + use graydata_par, only : rwmax + implicit real*8 (a-h,o-z) parameter(zero=0.0d0,izero=0,one=1.0d0) parameter(cvdr=pi/180.0d0) dimension ytmp(6),yptmp(6) c - common/rwmax/rwmax common/parbeam/wcsi,weta,rcicsi,rcieta,phiw,phir common/anic/anx0c,any0c,anz0c common/mirr/x00,y00,z00 @@ -4837,8 +4795,9 @@ c ray power weigth coefficient q(j) c subroutine pweigth use beamdata, only : nrayr,nrayth,q + use graydata_par, only : rwmax + implicit real*8(a-h,o-z) - common/rwmax/rwmax c dr=1.0d0 if(nrayr.gt.1) dr=rwmax/dble(nrayr-1) @@ -4931,19 +4890,19 @@ c use const_and_precisions, only : pi use beamdata, only : psjki,tauv,alphav,pdjki,ppabs,currj,didst, . ccci,q,tau1v + use graydata_par, only : sgnbphi + use graydata_flags, only : iequil,dst + use graydata_anequil, only : b0,rr0m,rpam + implicit real*8 (a-h,o-z) c common/p0/p0mw c - common/dsds/dst common/dersdst/dersdst - common/iieq/iequil c - common/parban/b0,rr0m,zr0m,rpam common/absor/alpha,effjcd,akim,tau0 c common/psinv/psinv - common/sgnib/sgnbphi,sgniphi common/bmxmn/bmxi,bmni common/fc/fci c @@ -4998,6 +4957,8 @@ c c use const_and_precisions, only : r8 use dispersion, only : larmornumber,warmdisp + use graydata_flags, only : iwarm,ilarm,ieccd,imx + use graydata_anequil, only : zeffloc=>zeffan c implicit none c parameters @@ -5010,9 +4971,9 @@ c internal integer lrm,ierr real(r8) ratiovgr,fzeff,temperature c common - integer ithn,nharm,nhf,err,iwarm,ilarm,ieccd,imx + integer ithn,nharm,nhf,err real(r8) yg,anpl,anprf,vgm,derdnm,anprre,anprim,alpha,effjcd, - . akim,tau,psinv,tekev,amu,xg,zeff,ak0,akinv,fhz,sox + . akim,tau,psinv,tekev,amu,xg,ak0,akinv,fhz,sox complex*16 :: ex,ey,ez C common/ithn/ithn @@ -5027,12 +4988,8 @@ C common/amut/amu common/xgxg/xg common/epolar/ex,ey,ez - common/warm/iwarm,ilarm - common/ieccd/ieccd - common/zz/Zeff common/parwv/ak0,akinv,fhz common/mode/sox - common/imx/imx c c absorption computation c @@ -5063,7 +5020,7 @@ c ithn=1 if(lrm.gt.nharm) ithn=2 c - zeff=fzeff(psinv) + zeffloc=fzeff(psinv) if(ieccd.gt.0) call eccd(effjcd) c return @@ -5073,14 +5030,17 @@ c c subroutine eccd(effjcd) use green_func_p + use graydata_flags, only : ieccd + use graydata_anequil, only : zeffloc=>Zeffan + implicit none real*8 anum,denom,resp,resj,effjcd,coullog,dens,tekev real*8 anucc,canucc,ddens - real*8 qesi,mesi,vcsi,qe,me,vc,ceff,Zeff + real*8 qesi,mesi,vcsi,qe,me,vc,ceff real*8 rbn,rbx,btot,bmin,bmax,alams,fp0s,pa,fc real*8 fjch,fjncl,fjch0,fconic real*8 cst,cst2 - integer ieccd,nharm,nhf,nhn + integer nharm,nhf,nhn external fjch,fjncl,fjch0 parameter(qesi=1.602176487d-19,mesi=9.10938215d-31) @@ -5092,10 +5052,8 @@ c common/nharm/nharm,nhf common/nhn/nhn - common/ieccd/ieccd common/tete/tekev common/dddens/dens,ddens - common/zz/Zeff common/btot/btot common/bmxmn/bmax,bmin common/fc/fc @@ -5128,7 +5086,7 @@ c fp0s= P_a (alams) if(cst2.lt.1d-6) cst2=0.0d0 cst=sqrt(cst2) alams=sqrt(1.0d0-bmin/bmax) - pa=sqrt(32.0d0/(Zeff+1.0d0)-1.0d0)/2.0d0 + pa=sqrt(32.0d0/(Zeffloc+1.0d0)-1.0d0)/2.0d0 fp0s=fconic(alams,pa,0) do nhn=nharm,nhf call curr_int(fjch,resj,resp) @@ -5154,7 +5112,7 @@ c rzfc=(1+Zeff)/fc cst2=1.0d0-rbx if(cst2.lt.1d-6) cst2=0.0d0 cst=sqrt(cst2) - call SpitzFuncCoeff(Tekev,Zeff,fc) + call SpitzFuncCoeff(Tekev,Zeffloc,fc) do nhn=nharm,nhf call curr_int(fjncl,resj,resp) anum=anum+resj @@ -5355,18 +5313,19 @@ c fjncl integrand for momentum conserv. model K(u) from Maruschenko c gg=F(u)/u with F(u) as in Cohen paper function fjch(upl) + use graydata_anequil, only : zeffloc=>Zeffan + implicit real*8 (a-h,o-z) common/gg/uplp,uplm,ygn common/nplr/anpl,anpr - common/zz/Zeff common/cohen/rb,alams,pa,fp0s upr2=(1.0d0-anpl**2)*(uplp-upl)*(upl-uplm) gam=anpl*upl+ygn u2=gam*gam-1.0d0 u=sqrt(u2) - z5=Zeff+5.0d0 + z5=Zeffloc+5.0d0 xi=1.0d0/z5**2 xib=1.0d0-xi xibi=1.0d0/xib @@ -5395,14 +5354,16 @@ c gg=F(u)/u with F(u) as in Cohen paper function fjch0(upl) + use graydata_anequil, only : zeffloc=>Zeffan + implicit real*8 (a-h,o-z) common/gg/uplp,uplm,ygn common/nplr/anpl,anpr - common/zz/Zeff + gam=anpl*upl+ygn u2=gam*gam-1.0d0 u=sqrt(u2) - z5=Zeff+5.0d0 + z5=Zeffloc+5.0d0 xi=1.0d0/z5**2 xib=1.0d0-xi xibi=1.0d0/xib @@ -5420,6 +5381,8 @@ c gg=F(u)/u with F(u) as in Cohen paper function fjncl(upl) use green_func_p + use graydata_anequil, only : zeffloc=>Zeffan + implicit real*8 (a-h,o-z) common/gg/uplp,uplm,ygn @@ -5429,7 +5392,6 @@ c gg=F(u)/u with F(u) as in Cohen paper common/psinv/psinv common/amut/amu common/tete/tekev - common/zz/Zeff gam=anpl*upl+ygn u2=gam*gam-1.0d0 @@ -5437,7 +5399,7 @@ c gg=F(u)/u with F(u) as in Cohen paper upr2=u2-upl*upl bth=sqrt(2.0d0/amu) uth=u/bth - call GenSpitzFunc(Tekev,Zeff,fc,uth,u,gam,fk,dfk) + call GenSpitzFunc(Tekev,Zeffloc,fc,uth,u,gam,fk,dfk) fk=fk*(4.0d0/amu**2) dfk=dfk*(2.0d0/amu)*bth @@ -5571,6 +5533,9 @@ c use const_and_precisions, only : pi use beamdata, only : psjki,iiv,ppabs,ccci,pdjki, . nrayr,nrayth,nstep + use graydata_flags, only : ipec,ieccd,iequil,nnd,dst + use graydata_anequil, only : rr0m,rpam + implicit real*8(a-h,o-z) parameter(rtbc=1.0d0) dimension rhopin(nrho),dpdvout(nrho),ajcdout(nrho) @@ -5582,15 +5547,10 @@ c dimension isev(llmx) c common/istep/istep - common/dsds/dst - common/ipec/ipec,nnd - common/ieccd/ieccd common/index_rt/index_rt c common/cent/btrcen,rcen common/angles/alpha0,beta0 - common/iieq/iequil - common/parban/b0,rr0m,zr0m,rpam common/taumnx/taumn,taumx,pabstot,currtot common/jmxmn/rhot1,rhot2,aj1,aj2 c @@ -5946,12 +5906,12 @@ c c c subroutine profwidth(nd,xx,yy,rhotmx,rhopmx,ypk,drhot,drhop) + use graydata_flags, only : ipec,iequil + implicit real*8(a-h,o-z) parameter(emn1=0.367879441171442d0) dimension xx(nd),yy(nd) common/jmxmn/rhotp,rhotm,ypkp,ypkm - common/ipec/ipec,nnd - common/iieq/iequil c call vmaxmini(yy,nd,ymn,ymx,imn,imx) ypk=0.0d0 @@ -6291,11 +6251,14 @@ c wave vector and electric field after reflection in lab frame subroutine vacuum_rt(xvstart,xvend,ivac) use reflections, only : inters_linewall,inside + use graydata_par, only : psdbnd + use graydata_flags, only : dst + implicit none integer*4 ivac integer nbb,nlim,i,imax parameter(nbb=5000) - real*8 st,rrm,zzm,psinv,dst,psdbnd,dstvac,smax + real*8 st,rrm,zzm,psinv,dstvac,smax real*8 anv(3),xvstart(3),xvend(3),walln(3),y(6),dery(6) real*8 xv0(3) real*8 rlim(nbb),zlim(nbb) @@ -6303,9 +6266,7 @@ c wave vector and electric field after reflection in lab frame common/wrefl/walln common/limiter/rlim,zlim,nlim common/anv/anv - common/dsds/dst common/psinv/psinv - common/densbnd/psdbnd common/dstvac/dstvac c ivac=1 first interface plasma-vacuum c ivac=2 second interface vacuum-plasma after wall reflection diff --git a/src/gray_main.f90 b/src/gray_main.f90 index 2059770..00e7ffb 100644 --- a/src/gray_main.f90 +++ b/src/gray_main.f90 @@ -3,6 +3,8 @@ subroutine gray_main(ijetto, mr, mz, r, z, psin, psiax, psibnd, & beamid, powin, alphain, betain, dpdv, jcd, pec, icd, ierr) use const_and_precisions, only : r8 + use graydata_flags, only : igrad, ipass + implicit none integer, intent(in) :: ijetto, mr, mz, nrho, nbnd, beamid @@ -15,21 +17,19 @@ subroutine gray_main(ijetto, mr, mz, r, z, psin, psiax, psibnd, & real(r8), intent(out) :: pec, icd integer, intent(out) :: ierr - integer :: istop, iercom, igrad, iopmin, iowmin, index_rt, ipass + integer :: istop, iercom, iopmin, iowmin, index_rt real(r8) :: sox, p0mw, powrfl, taumn, taumx, pabstot, currtot real(r8) :: p0mw1, powtr, pabstott, currtott real(r8), dimension(nrho) :: rhopol,dpdv1pass, jcd1pass common/istop/istop common/ierr/iercom - common/igrad/igrad common/iovmin/iopmin,iowmin common/mode/sox common/p0/p0mw common/powrfl/powrfl common/index_rt/index_rt common/taumnx/taumn,taumx,pabstot,currtot - common/ipass/ipass ! read data plus initialization index_rt=1