diff --git a/Makefile.Forthon b/Makefile.Forthon index df1b6129..5be1dea9 100644 --- a/Makefile.Forthon +++ b/Makefile.Forthon @@ -1,13 +1,13 @@ DEBUG = -v --fargs "-Ofast -DFORTHON -cpp" # -g #--fargs "-C=array" #--fargs "-CB -traceback" SO = so -PUBLICHOME = +PUBLICHOME = BUILDDIR = build DIRLIST = com aph api bbb flx grd svr wdf ncl MYPYTHON = python3 FORTHON = Forthon3 BUILDBASE = -v --build-base $(BUILDDIR) -INSTALLARGS = --pkgbase uedge $(BUILDBASE) +INSTALLARGS = --pkgbase uedge $(BUILDBASE) $(OMPFLAGS) all: mppl2f90 $(BUILDDIR)/compydep $(BUILDDIR)/grdpydep $(BUILDDIR)/flxpydep $(BUILDDIR)/bbbpydep $(BUILDDIR)/svrpydep $(BUILDDIR)/wdfpydep $(BUILDDIR)/aphpydep $(BUILDDIR)/apipydep $(BUILDDIR)/nclpydep rm -f uedgeC.so @@ -27,8 +27,8 @@ $(BUILDDIR)/apipydep: $(BUILDDIR)/compydep api/apifcn.F api/apip93.F api/apisorc $(FORTHON) -a $(INSTALLARGS) -a $(FCOMP) $(DEBUG) --interfacefile api/api.v -d com -f api/apifcn.F api api/apip93.F api/apisorc.F api/fimp.F api/fmombal.F api/inelrates.F api/sputt.F touch $@ -$(BUILDDIR)/bbbpydep: $(BUILDDIR)/compydep bbb/boundary.F bbb/convert.F bbb/geometry.F bbb/griddubl.F bbb/oderhs.F bbb/odesetup.F bbb/odesolve.F bbb/potencur.F bbb/turbulence.F bbb/ext_neutrals.F bbb/bbb.v com/com.v - $(FORTHON) -a $(INSTALLARGS) -a $(FCOMP) --interfacefile bbb/bbb.v $(DEBUG) --macros com/com.v $(READLINE) -d com -f bbb/boundary.F bbb bbb/convert.F bbb/geometry.F bbb/griddubl.F bbb/oderhs.F bbb/odesetup.F bbb/odesolve.F bbb/potencur.F bbb/turbulence.F bbb/ext_neutrals.F +$(BUILDDIR)/bbbpydep: $(BUILDDIR)/compydep $(BUILDDIR)/apipydep bbb/boundary.F bbb/convert.F bbb/geometry.F bbb/griddubl.F bbb/oderhs.F bbb/odesetup.F bbb/odesolve.F bbb/potencur.F bbb/turbulence.F bbb/ext_neutrals.F bbb/bbb.v com/com.v + $(FORTHON) -a $(INSTALLARGS) -a $(FCOMP) --interfacefile bbb/bbb.v $(DEBUG) --macros com/com.v $(READLINE) -d com -f bbb/boundary.F bbb bbb/convert.F bbb/geometry.F bbb/griddubl.F bbb/oderhs.F bbb/odesetup.F bbb/odesolve.F bbb/potencur.F bbb/turbulence.F bbb/ext_neutrals.F touch $@ $(BUILDDIR)/flxpydep: $(BUILDDIR)/compydep flx/flxcomp.F flx/flxdriv.F flx/flxread.F flx/flxwrit.F flx/flx.v com/com.v diff --git a/api/api.v b/api/api.v index d22d6bcb..bfcd1c98 100755 --- a/api/api.v +++ b/api/api.v @@ -157,7 +157,7 @@ work2(nwork2) _real # work array for B3VAL nwork3 integer # size of array work3 work3(nwork3) _real # work array for B3INT iworki(10) integer # work array for B3VAL -icont integer /0/ # input flag for B3VAL +icont integer /0/ +threadprivate # input flag for B3VAL kxords_api integer /4/ # order of spline fit versus x # kxords_api=4 (default) is cubic interpolation kyords_api integer /4/ # order of spline fit versus y diff --git a/api/fimp.m b/api/fimp.m index 989c5502..46e540e0 100755 --- a/api/fimp.m +++ b/api/fimp.m @@ -95,7 +95,7 @@ c rate parameters (sigma*v) for ionization, recombination, real tmpenonz,tmpinonz,xte,xti,dlogt,fxte,fxti,lrion,lrrec c real rcxr_zn6, rcxr_zn6b - external rcxr_zn6, rcxr_zn6b + external rcxr_zn6, rcxr_zn6b c rion = 0. rrec = 0. @@ -107,7 +107,7 @@ c rate parameters (sigma*v) for ionization, recombination, xti = log(tmpinonz/ev2) dlogt = rtlt(1) - rtlt(0) c -c ... Find index i1 in temperature table such that +c ... Find index i1 in temperature table such that c rtlt(i1) .le. xt .lt. rtlt(i1+1) c or, equivalently, c rtt(i1) .le. tmp .lt. rtt(i1+1). @@ -168,13 +168,13 @@ call xerrab("") c Compute rate parameters for transitions from table species ii. c if (za .lt. zamax) then - lrion = + lrion = . ( fy)*((1-fxte)*rtlsa(i1e,j1+1,ii)+fxte*rtlsa(i1e+1,j1+1,ii)) . + (1-fy)*((1-fxte)*rtlsa(i1e,j1 ,ii)+fxte*rtlsa(i1e+1,j1 ,ii)) rion = exp(lrion) if (za .eq. 0) return endif - lrrec = + lrrec = . ( fy)*((1-fxte)*rtlra(i1e,j1+1,ii)+fxte*rtlra(i1e+1,j1+1,ii)) . + (1-fy)*((1-fxte)*rtlra(i1e,j1 ,ii)+fxte*rtlra(i1e+1,j1 ,ii)) rrec = exp(lrrec) @@ -185,7 +185,7 @@ call xerrab("") if ( (iscxfit .gt. 0) .and. . (zn .eq. 6) .and. (za .le. zamax) ) then if (iscxfit.ge.1. .and. iscxfit.le.2.) then - rcxr = (2.-iscxfit)*rcxr_zn6 (tmpi, za) + + rcxr = (2.-iscxfit)*rcxr_zn6 (tmpi, za) + . (iscxfit-1.)*rcxr_zn6b(tmpi, za) endif ccc if (iscxfit .eq. 1) rcxr = rcxr_zn6 (tmpi, za) @@ -241,8 +241,8 @@ c Input (neutral hydrogen) temperature, tmp, is in [Joules/AMU]. c Output rate parameter (sigma-v) is in [m**3/sec]. c c This is a modified of the function rcxr_zn6; only za=1 case is -c changed to use a (lower) fit guided by plots from A. Pigarov. -c Other za's same as for rxcr_zn6 from thesis by C.F. Maggi (fit +c changed to use a (lower) fit guided by plots from A. Pigarov. +c Other za's same as for rxcr_zn6 from thesis by C.F. Maggi (fit c by T. Rognlien) c c local variables -- @@ -266,7 +266,7 @@ subroutine readmc(nzdf,mcfilename) character*256 mcfilename(*) character*256 fname Use(Multicharge) - Use(Math_problem_size) # neqmx +c Use(Math_problem_size) # neqmx Use(Flags) # iprint Use(Impdata) #apidir @@ -309,7 +309,7 @@ call xerrab("") c read header -- * un*formatted read for header data read (nget,'(2a8,i12,4x,a32)') idcod, idtyp, n, id1 - if (n .lt. 0 .and. iprt_imp_file == 1) then + if (n .lt. 0 .and. iprt_imp_file == 1) then if (iprint .ne. 0) then write(*,*) '***Impurity file using new 2012 format is ',mcfilename(i) endif @@ -426,7 +426,7 @@ function radmc(zmax, znuc, te, dene, denz, radz) real radz(0:zmax) c c ... Compute the radiation rates, radz(0:zmax), for all charge states -c of an impurity with nuclear charge, znuc, and return the total +c of an impurity with nuclear charge, znuc, and return the total c electron energy loss rate, radmc, including both the radiation c and binding energy contributions. c @@ -528,7 +528,7 @@ call xerrab("") . ( fy)*((1-fxt)*rtlqa(i1,j1+1,k0+k)+fxt*rtlqa(i1+1,j1+1,k0+k)) .+ (1-fy)*((1-fxt)*rtlqa(i1,j1 ,k0+k)+fxt*rtlqa(i1+1,j1 ,k0+k)) keelz = exp(leelz) - fac_rad = 1. + fac_rad = 1. if(ispradextrap==1 .and. k==0 .and. te real for mppl; ALOG10 -> log10 -c +c c ** -Input variables: c cion # integer atomic number of impurity, e.g., for carbon, cion=6 c cizb # integer max charge state of plasma ions; hydrogen cizb=1 @@ -20,7 +20,7 @@ SUBROUTINE SYLD96(MATT,MATP,CION,CIZB,CRMB) c matt # integer flag giving target material c matp # integer flag giving plasma material c -c########################################################################### +c########################################################################### C C ********************************************************************* C * * @@ -40,7 +40,7 @@ SUBROUTINE SYLD96(MATT,MATP,CION,CIZB,CRMB) cdtr include 'cyield' Use(Cyield) # ceth,cetf,cq,ntars,cidata - Use(Math_problem_size) # neqmx +c Use(Math_problem_size) # neqmx Use(Flags) # iprint real ETH(7,12), ETF(7,12), Q(7,12), EBD(12) @@ -74,7 +74,7 @@ C THE TWO COMPOUNDS (TITANIUM CARBIDE AND SILICON CARBIDE) C (APPROX 2X). C LORNE HORTON MAY 93 C - + DATA TARMAT/ & ' ALUMINIUM ',' BERYLLIUM ',' COPPER ', & ' GRAPHITE ',' TITANIUM ',' IRON ', @@ -83,10 +83,10 @@ C THE TWO COMPOUNDS (TITANIUM CARBIDE AND SILICON CARBIDE) & ' "DEUTERIUM" ',' "HELIUM" ',' "NEON" ', & ' "ARGON" ',' "OXYGEN" ',' "CHLORINE" ', & ' "NITROGEN" ' / - + DATA PLAMAT/ & ' H ',' D ',' T ',' HE4 ',' C ',' SELF ',' O '/ - + DATA ETH/ & 23.87, 14.86, 12.91, 12.51, 16.32, 24.02, 18.55, & 12.2 , 10.0 , 14.69, 13.9 , 28.08, 24.17, 32.71, @@ -271,17 +271,17 @@ SUBROUTINE SPUTCHEM(IOPTCHEM,E0,TEMP,FLUX,YCHEM) c######################################################################### c c ** -Modified 2/20/98 to use flux in MKS [1/m**2 s] rather than previous -c ** -[1/cm**2 s]; TDR -c +c ** -[1/cm**2 s]; TDR +c c ** -Code obtained from David Elder, 2/6/98; originally written by -c ** -Houyang Guo at JET +c ** -Houyang Guo at JET c c######################################################################### C C ********************************************************************* C * * C * CHEMICAL SPUTTERING FOR D --> C * -C * * +C * * C * IOPTCHEM - Options for chemical sputtering: * C * 1 - Garcia-Rosales' formula (EPS94) * C * 2 - according to Pospieszczyk (EPS95) * @@ -304,7 +304,7 @@ SUBROUTINE SPUTCHEM(IOPTCHEM,E0,TEMP,FLUX,YCHEM) c Change the flux from MKS to cgs units to use old cgs routines c conversion done on 2/20/98 FLUX_cgs = 1e4*FLUX - + IF (IOPTCHEM.EQ.1) THEN YCHEM = YGARCIA(E0,TEMP,FLUX_cgs) ELSE IF (IOPTCHEM.EQ.2) THEN @@ -338,7 +338,7 @@ FUNCTION YROTH96(E0,TEMP,FLUX) C ********************************************************************* C * * C * CHEMICAL SPUTTERING CALCULATED BY Garcia-Rosales FORMULA * -C * * +C * * C * ETHC (eV) - Threshold energy for D -> C physical sputtering * C * ETFC (eV) - Thomas-Fermi energy * C * SNC - Stopping power * @@ -359,14 +359,14 @@ FUNCTION YROTH96(E0,TEMP,FLUX) C Ychem = Ysurf+Ytherm*(1+D*Yphys) C --------------------------------------------------------- -C +C C 1> PHYSICAL SPUTTERING YIELD C ETHC = 27.0 - ETFC = 447.0 + ETFC = 447.0 QC = 0.1 C -C - Stopping Power +C - Stopping Power C SNC = 0.5*LOG(1.+1.2288*E0/ETFC)/(E0/ETFC > + 0.1728*SQRT(E0/ETFC) @@ -380,7 +380,7 @@ FUNCTION YROTH96(E0,TEMP,FLUX) YPHYS = 0.0 ENDIF C -C 2> YSURF: Surface Process +C 2> YSURF: Surface Process C CSURF = 1/(1.+1E13*EXP(-2.45*11604/TEMP)) CSP3 = CSURF*(2E-32*FLUX+EXP(-1.7*11604/TEMP)) @@ -407,8 +407,8 @@ CW WRITE(6,*) 'YROTH96 = ',YROTH96 RETURN END - - + + C ------------- c ------------------------------------------------------------------------c FUNCTION YGARCIA(E0,TEMP,FLUX) @@ -421,7 +421,7 @@ FUNCTION YGARCIA(E0,TEMP,FLUX) C ********************************************************************* C * * C * CHEMICAL SPUTTERING CALCULATED BY Garcia-Rosales FORMULA * -C * * +C * * C * ETHC (eV) - Threshold energy for D -> C physical sputtering * C * ETFC (eV) - Thomas-Fermi energy * C * SNC - Stopping power * @@ -432,22 +432,22 @@ FUNCTION YGARCIA(E0,TEMP,FLUX) C * YCHEM_ATH - Athermal mechanism * C * * C ********************************************************************* -C +C ETHC = 27.0 - ETFC = 447.0 + ETFC = 447.0 QC = 0.1 C C Check for impact energies below threshold C IF (E0.GT.ETHC) THEN C -C Stopping Power +C Stopping Power C SNC = 0.5*LOG(1.+1.2288*E0/ETFC)/(E0/ETFC > + 0.1728*SQRT(E0/ETFC) > + 0.008*(E0/ETFC)**0.1504) -C +C C Physical Sputtering Yield C YPHYS = QC*SNC*(1-(ETHC/E0)**(2./3.))*(1-ETHC/E0)**2 @@ -471,8 +471,8 @@ CW WRITE(6,*) 'YTH = ',YCHEM_TH,'YATH = ',YCHEM_ATH RETURN END - - + + C ------------- c ------------------------------------------------------------------------c @@ -484,7 +484,7 @@ FUNCTION YHAASZ(E0,TEMP) C * - poly. fit: Y = a0 + a1*log(E) + a2*log(E)^2 + a3*log(E)^3 * C * * C ********************************************************************* -C +C IMPLICIT NONE real E0,TEMP @@ -596,7 +596,7 @@ ELSE IF (E0.GT.200.0) THEN FITE0 = 200. ELSE FITE0 = E0 - ENDIF + ENDIF C YFIT = 0.0 DO I = 1,4 @@ -623,7 +623,7 @@ FUNCTION YHAASZ97(E0,TEMP) C * - poly. fit: Y = a0 + a1*log(E) + a2*log(E)^2 + a3*log(E)^3 * C * * C ********************************************************************* -C +C IMPLICIT NONE real E0,TEMP @@ -724,7 +724,7 @@ ELSE IF (E0.GT.200.0) THEN FITE0 = 200. ELSE FITE0 = E0 - ENDIF + ENDIF C YFIT = 0.0 DO I = 1,4 @@ -755,7 +755,7 @@ FUNCTION YHAASZ97M(E0,TEMP,reducf) C * Default value for reducf=0.2; change redf_haas * C * * C ********************************************************************* -C +C IMPLICIT NONE real E0, TEMP, reducf @@ -772,7 +772,7 @@ FUNCTION YHAASZ97M(E0,TEMP,reducf) YHAASZ97M = FRAC*YHAASZ97(E0,TEMP)+ (1.-FRAC)*YDAVIS98 ELSEIF (E0 .LT. 5.) THEN YDAVIS98 = reducf/(m2*((TEMP/m1)**2 - 1)**2 + m3) - YHAASZ97M = YDAVIS98 + YHAASZ97M = YDAVIS98 ENDIF RETURN diff --git a/bbb/bbb.v b/bbb/bbb.v index 8e702f5c..506aef0d 100755 --- a/bbb/bbb.v +++ b/bbb/bbb.v @@ -10,9 +10,9 @@ nispmxngspmx = nispmx*ngspmx # tot numb ion*gas species nstramx = 10 # maximum number of strata for MC neutrals code } -***** Com_Dim_Vars hidden: +***** Com_Dim_Vars hidden: dim_vars_hidden integer # Do not edit this group. It is used to build - # the Basis version of the code. + # the Basis version of the code. ***** Math_problem_size: neqmx integer # number of math. eqns to be solved/integrated @@ -25,18 +25,16 @@ csfaclb(nispmx,nxptmx) real /ndcsmx*1./ +input #frac of cs used for Bohm sheat csfacrb(nispmx,nxptmx) real /ndcsmx*1./ +input #frac of cs used for Bohm sheath b.c. csfacti real /1./ +input #Bohm speed = sqrt((te+csfacti*ti)/mi) cslim real /1./ +input #frac of cs used for limiter Bohm sheath b.c. -dcslim real /0./ +input - #reduce sonic flow at limiter by the factor - #cslim*[1-exp(-(iy-iy_lims+1)/dcslim)] +dcslim real /0./ +input #reduce sonic flow at limiter by the factor + #cslim*[1-exp(-(iy-iy_lims+1)/dcslim)] islnlamcon integer /0/ +input #=0, loglambda=Braginskii;if=1,loglambda=lnlam lnlam real /12./ +input #Coulomb log;shouldn't be constant methe integer /33/ +input #elec. eng. eqn: 22-cd, 33-uw, 44-hyb, 55-p-law methu integer /33/ +input #ion mom. eqn: 22-cd, 33-uw, 44-hyb, 55-p-law methn integer /33/ +input #ion cont. eqn: 22-harmonic average, 33-uw methi integer /33/ +input #ion eng. eqn: 22-cd, 33-uw, 44-hyb, 55-p-law -methg integer /33/ +input - #neut. gas eqn: 22-cd, 33-uw, 44-hyb, 55-p-law - #66 nonorth. log intrp, 77 nonorth. 1/ng intrp +methg integer /33/ +input #neut. gas eqn: 22-cd, 33-uw, 44-hyb, 55-p-law + #66 nonorth. log intrp, 77 nonorth. 1/ng intrp methp integer /33/ +input #potential eqn: 22-cd, 33-uw, 44-hyb, 55-p-law isgxvon integer /0/ +input #=0 uses gx in fmix; =1 for harmonic ave of gxf ishavisy integer /1/ +input #=1 uses harmonic ave for conxi up @@ -54,31 +52,27 @@ cphiatol real /1./ +input #multiplier for atol for phi tolbf real /1./ +input #multiplier for atol&rtol for the boundary eqns tadj real /10./ +input #reduces time step by 1/tadj if iopts=1 icnuiz integer /0/ +input #=1 constant ioniz. freq., cnuiz; =2 freezes -icnucx integer /0/ +input - #=0, var nucx;=1 const. nucx=cnucx; - # =2, use sigcx, so nucx~(Tg)**.5 +icnucx integer /0/ +input #=0, var nucx;=1 const. nucx=cnucx; + #=2, use sigcx, so nucx~(Tg)**.5 cnuiz real [1/s] /5.e+4/ +input #constant ioniz. freq. for icnuiz=1 cnucx real [1/s] /1.e+0/ +input #constant charge exhange freq. for icnucx=1 isrecmon integer /0/ +input - #flag to turn-on recombination (yes=1); use - #cfrecom to turn-off recomb after isrecmon was on + #flag to turn-on recombination (yes=1); use + #cfrecom to turn-off recomb after isrecmon was on cfrecom real /1./ +input #scale factor multiplying recombination freq. igas integer /0/ +input #=1 invokes local rate eqn. for ng ngbackg(ngspmx) real [1/m**3] /ngspmx*1.e14/ +input #background gas density -ingb integer /2/ +input - #background gas source=nuiz*ngbackg* +ingb integer /2/ +input #background gas source=nuiz*ngbackg* # (.9+.1*(ngbackg/ng)**ingb) -inflbg integer /4/ +input - #expon to force flalfg large near ng~ngback - #ex:flalfgx,y*(1.+(cflgb*ngbackg/ng)**inflbg) +inflbg integer /4/ +input #expon to force flalfg large near ng~ngback + #ex:flalfgx,y*(1.+(cflgb*ngbackg/ng)**inflbg) cflbg real /10./ +input #scaling fac for flalfgx,y using inflbg facngbackg2ngs(ngspmx) real /ngspmx*1.e-8/ +input #fraction of ngbackg add to initial ngs nzbackg(nispmx) real [1/m**3] /nispmx*1.e9/ +input #background impurity density -inzb integer /2/ +input - #background impurity source=nuiz*nzbackg* +inzb integer /2/ +input #background impurity source=nuiz*nzbackg* # (.9+.1*(nzbackg/nzi)**ingb) facnzbackg2nis(nispmx) real /nispmx*1.e-8/ +input #fraction of nzbackg add to initial nis @@ -91,7 +85,7 @@ tibg real [eV] /1.e-20/ +input #backgrd ion eng sor to limit te~tebg iteb integer /2/ +input #exponent of (tebg*ev/te)**iteb for bkg sor temin real [eV] /0.03/ +input #min value of te allow; if less, reset to temin2 real [eV] /0.03/ +input #soft floor with te=sqrt[te**2+(temin2*ev)**2] -tgmin real [eV] /0.03/ # min value of tg allowed +tgmin real [eV] /0.03/ # min value of tg allowed pwrbkg_c real [W/m**3] /1.e3/ +input #const background factor in pwrebkg express pwribkg_c real [W/m**3] /1.e3/ +input #const background factor in pwribkg express cfwjdotelim real /1./ +input #factor scaling reduction of wjdote if tefnix - #=2 gas sub. neudifgp uses pg for gas vel & fngx->fnix - #=3 gas sub. neudifl use log_ng, tg for gas vel - #otherwise, old case has ug=ui (strong cx coupling) +isxmpog integer /0/ +input #=1 sets fy0, fmy stencil to orthog values at ix=nxc-1 + # and ix=nxc+1 for geometry='dnbot' +iexclnxc1 integer /0/ +input #if=0; include nxc+1 for fee,iytotc if geometry=dnbot; + #if=1; exclude nxc+1 for fee,iytotc +ineudif integer /2/ +input #=1 gas sub. neudif uses ng, tg for gas vel & fngx->fnix + #=2 gas sub. neudifgp uses pg for gas vel & fngx->fnix + #=3 gas sub. neudifl use log_ng, tg for gas vel + #otherwise, old case has ug=ui (strong cx coupling) thetar real /0./ +input #rotate (R,Z) coordinates by angle theta (degrees) isbcwdt integer /0/ +solver #include dtreal in B.C. if isbcwdt=1 ishosor integer /0/ +input #if=1, integrate hydr. sources over cell; full RHS only @@ -182,10 +175,9 @@ iseesorave real /0./ +input #cell ave factor; 0 ctr only; 1 5 pt ave elec eng ispsorave real /0./ +input #cell ave factor; 0 ctr only; 1 5 pt ave of psorg,psor,etc. fsprd real /.0625 / +input #fraction of eng. sor. spread to each of 4 neighbors issyvxpt0 integer /0/ +input #if=1, set syv=0 around x-point; ambig. rad. mom. flux -isrrvave integer /0/ +input - #if=0, rrv from vertex B's; - #if=1, rrv=0.5*(rr_1+rr_2); - #if=2, average of cases 0 and 1 +isrrvave integer /0/ +input #if=0, rrv from vertex B's; + #if=1, rrv=0.5*(rr_1+rr_2); + #if=2, average of cases 0 and 1 rr_fac real /1./ +input #scale factor to multiple rr and rrv rrmin real /0./ +input #min rr used in calc of u_tor & fqy for potential calc. isdtsfscal integer /0/ +input #if=1, dt is included in sfscal Jac scaling factor @@ -249,16 +241,14 @@ fdttixy(0:nx+1,0:ny+1) _real /0./ #user:=1 for ti eqn off; =0 for eqn on fdtngxy(0:nx+1,0:ny+1,ngsp) _real /0./ #user:=1 for ng eqn off; =0 for eqn on fdttgxy(0:nx+1,0:ny+1,ngsp) _real /0./ #user:=1 for tg eqn off; =0 for eqn on fdtphixy(0:nx+1,0:ny+1) _real /0./ #user:=1 for phi eqn off; =0 for eqn on -isugfm1side integer /0/ +input - #=0, use pol ave gas vels in par up eqn - #=1, use 1-sided vals for domain decomp -isnupdot1sd integer /0/ +input - #=0, use 2-pt ndot for (n*up)_dot; +isugfm1side integer /0/ +input #=0, use pol ave gas vels in par up eqn + #=1, use 1-sided vals for domain decomp +isnupdot1sd integer /0/ +input #=0, use 2-pt ndot for (n*up)_dot; #=1, use 1-sided n_dot for (n*up)_dot isphicore0 integer /0/ +input #=1 sets phi=phi_mp in core if isphion=1 is_z0_imp_const integer /0/ +input #=0 use hydr Keilhacker;=1 z0_imp_const z0_imp_const real /1./ +input #z0 in therm force if is_z0_imp_const=1 - + ***** Model_choice restart: #Flags for choosing one or another calculation of a part of the model iondenseqn character*8 /"llnl"/ # ion continuity equation @@ -268,7 +258,7 @@ iondenseqn character*8 /"llnl"/ # ion continuity equation cnfx real /1./ +input #X-flux coef for conv. in n-eq. cnfy real /1./ +input #Y-flux coef for conv. in n-eq. cnsor real /1./ +input #Coef for particle src. in n-eq. -cfneut real /1./ +input #Coef for fluid neutrals contrib's to resid's +cfneut real /1./ +input +threadprivate #Coef for fluid neutrals contrib's to resid's cfnidh real /1./ +input #Coef for neutral-ion drift heating cfnidh2 real /0./ +input #the above coef (cfnidh=1.0) is not exactly the real coef for neutral-ion drift heating term. That's why we introduce cfnidh2 but only for testing. Default =0.0: nothing; =1.0 (only for testing), remove the drift heating term. cfnidhgy real /0./ +input # =1, consider vgy(,,1)**2 for n-i drift heating, assuming vy(,,0) negligible @@ -279,16 +269,16 @@ cfupcx real /1./ +input #Coef for nucx*(up_ion - up_gas) momentum cou cfticx real /1./ +input #Coef for nucx*(up_ion-up_gas)**2 heating in Ti Eq cfupimpg real /0./ +input #Coef for impur up Cx/elast drag on up=0 imp gas cftiimpg real /0./ +input #Coef for Ti cooling CX/elast loss to cold imp gas -cmneut real /0./ +input #Coef for Monte Carlo neutrals contrib's to resid's +cmneut real /0./ +input +threadprivate #Coef for Monte Carlo neutrals contrib's to resid's cnflux(ngspmx) real /ngspmx*1./ +input #coef for particle flux in n-eq. (resco) chradi real /1./ +input #Coef for hyd. ioniz. rad. loss in elec. eng. eq. chradr real /1./ +input #Coef for hyd. recomb. rad. loss in elec. eng. eq. chioniz real /1./ +input #Coef for hydrogen ionization in elec. eng. eq. -cfizmol real /0./ #..Tom: Coef adding hyd ioniz rate to molec dissociation - # rate to mimic ioniz of mols not in svdiss. - # Tom added it for me, however surprised it is not - # present in V8.0.0 -ifxnsgi integer /0/ +input #=1 sets ne for _i to cne_sgvi +cfizmol real /0./ # Tom: Coef adding hyd ioniz rate to molec dissociation + # rate to mimic ioniz of mols not in svdiss. + # Tom: added it for me, however surprised it is not + # present in V8.0.0 +ifxnsgi integer /0/ +input #=1 sets ne for _i to cne_sgvi cne_sgvi real [1/m**3] /1.e18/ +input #ne for _i if ifxnsgi=1 ctsor real /1./ +input #Coef for eng. src. in Ti eq. 0.5*mi*up**2*psor ceisor real /1./ +input #scale fac for ion energy source term (nu_i & eion) @@ -327,16 +317,16 @@ cfvisxy(1:nispmx) real /nispmx*1./ +input #Coef. mult fmixy(ifld) isvisxn_old integer /0/ +input #=1 uses sigcx,rrfac=1; =0 uses kelhihg, rrfac=rr**2 cfvxnrr real /1./ +input #=1 gives rr**2 in visx gas; =0 gives old 1 factor cfvisyn real /1./ +input #Coef. for neutral y-visc. in up(,,iispg) eqn -cfvcsx(1:nispmx) real /nispmx*1./ +input #Coefs for x-visc. in ti-eq. with ismcnon>0 -cfvcsy(1:nispmx) real /nispmx*1./ +input #Coefs for y-visc. in ti-eq. with ismcnon>0 +cfvcsx(1:nispmx) real /nispmx*1./ +input +threadprivate #Coefs for x-visc. in ti-eq. with ismcnon>0 +cfvcsy(1:nispmx) real /nispmx*1./ +input +threadprivate #Coefs for y-visc. in ti-eq. with ismcnon>0 isvhyha integer /0/ +input #switch (=1) for harmonic y-ave of up in visc heat upvhflr real /1.e2/ +input #min denom for up harmc ave (isvhyha=1); visc heat vboost real /1./ +input #previously scaled eqp; no longer in use cvgp real /1./ +input #Coef for v.Grad(p) ion/elec eng. terms cvgpg real /1./ +input #Coef for v.Grad(pg) gas eng. terms -cfvgpx(1:nispmx) real /nispmx*1./ +input #Coefs for x components of v.grad(p) in ti-eq +cfvgpx(1:nispmx) real /nispmx*1./ +input +threadprivate #Coefs for x components of v.grad(p) in ti-eq cftiexclg real /1./ +input #Coef =1.0 for including atom gas contrib. in Ti eq. Make it 0.0 when turn on atom temperature. -cfvgpy(1:nispmx) real /nispmx*1./ +input #Coefs for y components of v.grad(p) in ti-eq +cfvgpy(1:nispmx) real /nispmx*1./ +input +threadprivate #Coefs for y components of v.grad(p) in ti-eq cfbgt real /0./ +input #Coef for the B x Grad(T) terms. cfjhf real /1./ +input #Coef for convective cur (fqp) heat flow jhswitch integer /0/ +input #Coef for the Joule-heating terms @@ -348,7 +338,7 @@ cf2bf real /0./ +input #Coef for Grad B drift in 2-direction cfybf real /0./ +input #Coef for Grad B drift in y-direction cfcbti real /0./ +input #Coef for adding fnixcb & fniycb to Ti eqn. cfcurv real /1./ +input #Coef for curvature part of Grad_B drift -cfgradb real /1./ +input #Coef for p_perp part of Grad_B drift +cfgradb real /1./ +input #Coef for p_perp part of Grad_B drift cfq2bf real /0./ +input #Coef for Grad_B current in 2-direction cfqybf real /0./ +input #Coef for Grad_B current in y-direction cfqyn real /0./ +input #Coef for cx coll. rad current in y-direction @@ -362,7 +352,7 @@ cfvisxneov real /0./ +input #Coef for v-driven parallel viscosity cfvisxneoq real /0./ +input #Coef for q-driven parallel viscosity cfvycr real /0./ +input #Coef for thermal force class. vel. vycr cfvycf real /0./ +input #Coef for visc. force class. vel. vycf -cfvyavis real /0./ +input #Coef for vy from anom perp viscosity +cfvyavis real /0./ +input #Coef for vy from anom perp viscosity cfjve real /0./ +input #Coef for J-contribution to ve. cfjp2 real /0./ +input #Coef for B x gradP terms in div(J) eqn cfjpy real /0./ +input #Coef for B x gradP terms in div(J) eqn @@ -379,7 +369,7 @@ cfupjr real [ ] /0./ +input #coef to include u_par in Jr calc. cfcximp1 real [ ] /1./ +input #coef multi. kcxrz for imp(+1)+D(0)->imp(0)+D(+1) cfcximp2 real [ ] /1./ +input #coef mult. kcxrz;imp(+p)+D(0)->imp(p-1)+D(+1),p>1 cfnetap real [ ] /1./ +input #coef mult. netap*fqp term in frice express. -fcdif real [ ] /1./ +input #coef mult all constant anomal diff coef +fcdif real [ ] /1./ +input +threadprivate #coef mult all constant anomal diff coef cfmsor real [ ] /1./ +input #coef mult msor and msorxr in up eqn. cpiup(nispmx) real /nispmx*1./ +input #mult. press. grad term in up eqn cfloyi real [ ] /2.5/ +input #coef mult ion radial convective energy flow @@ -404,37 +394,33 @@ cfhcxgc(ngspmx) real /ngspmx*0./ +input # Coef constant pol heat conduct (chixg_ cfhcygc(ngspmx) real /ngspmx*0./ +input # Coef constant rad heat conduct (chiyg_use) cftgcond real /1./ +input #Coef for gas thermal cond (usually molecules) cftgeqp real /1.5/ +input #Coef for gas thermal equipartion (usually molecules) - + ***** Bcond restart: #Variables for setting the boundary conditions. -ibctepl integer /1/ +input - #Switch for ix=0 energy flux bc's - #=0, fixed te (see tepltl) - #=1, standard sheath transmission b.c. - #=2, zero poloidal gradients for te +ibctepl integer /1/ +input #Switch for ix=0 energy flux bc's + #=0, fixed te (see tepltl) + #=1, standard sheath transmission b.c. + #=2, zero poloidal gradients for te ibctipl integer /1/ +input # Same as ibctepl, with te --> ti -ibctepr integer /1/ +input - #Switch for ix=nx+1 energy flux bc's +ibctepr integer /1/ +input #Switch for ix=nx+1 energy flux bc's #=0, fixed te (see tepltr) #=1, standard sheath transmission b.c. #=2, zero poloidal gradients for te ibctipr integer /1/ +input # Same as ibctepr, with te --> ti -isphilbc integer /0/ +input - #Switch for ix=0 b.c. on phi +isphilbc integer /0/ +input #Switch for ix=0 b.c. on phi #=0, phi = phi0l + kappal * te #=1, phi = phi0l -isphirbc integer /0/ +input - #Switch for ix=nx+1 b.c. on phi +isphirbc integer /0/ +input #Switch for ix=nx+1 b.c. on phi #=0, phi = phi0r + kappar * te #=1, phi = phi0r -iphibcc integer /3/ +input #core BC at iy=1 when isnewpot=1;iy=0 +iphibcc integer /3/ +input #core BC at iy=1 when isnewpot=1;iy=0 #=1, d^2(ey)/dy^2=0 #=2, te=constant & ey(ixmp,0)=eycore #=3, phi=constant & ey(ixmp,0)=eycore #>3 or < 1 now unavailable, previously #dphi(ix,1)=dphi_iy1,isutcore ctrls ix=ixmp -iphibcwi integer /0/ +input #=0, d(ey)/dy=0 +iphibcwi integer /0/ +input #=0, d(ey)/dy=0 #=1, phi(ix,0) = phintewi*te(ix,0)/ev #=3, d(phi)/dy/phi = 1/lyphi(1) #=4, phi(ix,0)=phiwi(ix) in PF region @@ -461,10 +447,10 @@ isnicore(nispmx) integer /1,30*0/ +input #switch for ion-density core B. #=5, set d(ni)/dy=-ni/lynicore at midp & # ni constant poloidally isfniycbozero real /0./ +input # Switch for divergence-free fluxes on core boundary - #=0, allows divergence-free fluxes to modify net core flux - #=1, redistributes fluxes due to divergence-free term - # without affecting the net core boundary flux - #=-1,assumes no divergence-free fluxes on the core boundary + #=0, allows divergence-free fluxes to modify net core flux + #=1, redistributes fluxes due to divergence-free term + # without affecting the net core boundary flux + #=-1,assumes no divergence-free fluxes on the core boundary isupcore(nispmx) integer /nispmx*0/ +input #=0 sets up=upcore on core bdry #=1 sets d(up)/dy=0 on the core bdry #=2 sets d^2(up)/dy^2 = 0 @@ -649,8 +635,8 @@ issori(10) integer /10*0/ +input #starting ix cell index for inner source iesori(10) integer /10*0/ +input #ending ix cell index for inner source issoro(10) integer /10*0/ +input #starting ix cell index for outer source iesoro(10) integer /10*0/ +input #ending ix cell index for outer source -iwalli(10) real /10*0./ +input #current from inner source region isor for coupling -iwallo(10) real /10*0./ +input #current from outer source region isor for coupling +iwalli(10) real /10*0./ +input +threadprivate #current from inner source region isor for coupling +iwallo(10) real /10*0./ +input +threadprivate #current from outer source region isor for coupling ncpli(10) integer /10*0/ +input #flag for coupling between inner srce isor & ncpli ncplo(10) integer /10*0/ +input #flag for coupling between outer srce isor & ncpli cplsori(10) real /10*0./ +input #coeff. giving coupling from inner isor to ncpli @@ -659,11 +645,11 @@ iscpli(0:nx+1) _integer +maybeinput #(=1) => ix pt involved in inner bndry iscplo(0:nx+1) _integer +maybeinput #(=1) => ix pt involved in outer bndry coupling fwsori(0:nx+1,10) _real +maybeinput #profile of inner wall source isor (missing igasi) fwsoro(0:nx+1,10) _real +maybeinput #profile of outer wall source isor (missing igasi) -fngysi(0:nx+1,ngsp) _real +maybeinput +fngysi(0:nx+1,ngsp) _real +maybeinput +threadprivate #gas input flux from igasi on inner wall (calc) fngyi_use(0:nx+1,ngsp) _real [1/m**3s] +input #user supplied gas input flux*area fngysig(0:nxg+1,ngsp) _real +maybeinput #global value of fngysi if domain decomp (parll) -fngyso(0:nx+1,ngsp) _real +maybeinput +fngyso(0:nx+1,ngsp) _real +maybeinput +threadprivate #gas input flux from igaso on outer wall (calc) fngyo_use(0:nx+1,ngsp) _real [1/m**3s] +input #user supplied gas input flux*area fngysog(0:nxg+1,ngsp) _real +maybeinput #global value of fngyso if domain-decomp (parll) @@ -706,54 +692,43 @@ rlimiter real [m] /1.e20/ +input #position of limiter at ix=0 for isfixlb= islimsor integer /0/ +input #=1 extends sources into limiter region isutcore integer /0/ +input #Used for ix=ixcore phi BC ONLY IF iphibcc > 3 #=0, tor mom=lzcore on core; - #=1, d/dy=0; + #=1, d/dy=0; #>1, d^2(Ey)/dy^2=0 at outer midplane -isupwi(nispmx) integer /nispmx*2/ +input - #=0 sets up=0 on inner wall - #=1 sets fmiy=0 (parallel mom-dens y-flux) +isupwi(nispmx) integer /nispmx*2/ +input #=0 sets up=0 on inner wall + #=1 sets fmiy=0 (parallel mom-dens y-flux) #=2 sets dup/dy=0 on inner wall #=3 sets (1/up)dup/dy=1/lyup(1) scale length -isupwo(nispmx) integer /nispmx*2/ +input - #=0 sets up=0 on outer wall - #=1 sets fmiy=0 (parallel mom-dens y-flux) +isupwo(nispmx) integer /nispmx*2/ +input #=0 sets up=0 on outer wall + #=1 sets fmiy=0 (parallel mom-dens y-flux) #=2 sets dup/dy=0 on outer wall #=3 sets (1/up)dup/dy=1/lyup(2) scale length -islbcn integer /2/ +input - # b.c. for ni at limiter guard cells; +islbcn integer /2/ +input # b.c. for ni at limiter guard cells; # =0,1 set ni in 2 cells # =2 set ni in 1 cell, fnix at interface -islbcu integer /5/ +input - # b.c. for up at limiter guard cells; +islbcu integer /5/ +input # b.c. for up at limiter guard cells; # =0,1 set up in 3 cells # =2 set up in 2 cells, fmix at interface # =3,4,6 set fmix at interface # =5 set fmix-fmixy at interface -islbce integer /2/ +input - # b.c. for te at limiter guard cells; +islbce integer /2/ +input # b.c. for te at limiter guard cells; # =0,1 set te in 2 cells # =2 set te in 1 cell, feex at interface -islbci integer /2/ +input - # b.c. for ti at limiter guard cells; +islbci integer /2/ +input # b.c. for ti at limiter guard cells; # =0,1 set ti in 2 cells # =2 set ti in 1 cell, feix at interface -islbcg integer /2/ +input - # b.c. for ng at limiter guard cells; +islbcg integer /2/ +input # b.c. for ng at limiter guard cells; # =0,1 set ng in 2 cells # =2 set ng in 1 cell, fngx at interface -islbcp integer /2/ +input - # b.c. for phi at limiter guard cells; +islbcp integer /2/ +input # b.c. for phi at limiter guard cells; # =0,1 set phi in 2 cells # =2 set phi in 1 cell, fqx at interface -isph_sput(ngspmx) integer /ngspmx*0/ +input - #flag for plate sputtering; +isph_sput(ngspmx) integer /ngspmx*0/ +input #flag for plate sputtering; #0=old fixed case; 1=DIVIMP/JET phys sputt fits #=2 adds h-ion chem sputt;=3 adds h-neut c_sput -isi_sputw(ngspmx) integer /ngspmx*0/ +input - #flag for outer wall ion-based sputter; +isi_sputw(ngspmx) integer /ngspmx*0/ +input #flag for outer wall ion-based sputter; #=0, no ion sputtering #=1 adds phys ion sputt; =2 adds chem ion sputt -isi_sputpf(ngspmx) integer /ngspmx*0/ +input - #flag for priv flux ion-based sputter; +isi_sputpf(ngspmx) integer /ngspmx*0/ +input #flag for priv flux ion-based sputter; #=0, no ion sputtering #=1 adds phys ion sputt; =2 adds chem ion sputt matt integer #output flag from syld96 for sputt. target mat. @@ -761,11 +736,8 @@ matp integer #output flag from syld96 for sputt. plasma cion integer /6/ +input #input to syld96; atom num. of sputt. target cizb integer /1/ +input #input to syld96; max charge state of plasma crmb real /2./[AMU] +input #input to syld96; mass of plasma ions -isch_sput(ngspmx) integer /ngspmx*0/ +input - #chem sputt. opt; 0=old; - #5=Roth,G-R; - #6=Haasz97; - #7=Haasz97+Davis at low E +isch_sput(ngspmx) integer /ngspmx*0/ +input #chem sputt. opt; 0=old; + #5=Roth,G-R; #6=Haasz97; #7=Haasz97+Davis at low E eincid real [eV] +input #incident energy of ion or neut. for chem sputt t_wall real /300./ [K] +input #temp. of side wall; now use tvwallo,i t_plat real /300./ [K] +input #temp. of divertor plate; now use tvplatlb,rb @@ -775,8 +747,10 @@ tvplatlb(0:ny+1,nxptmx) _real /300./ [K] +input #user left plate temp if ispltte tvplatrb(0:ny+1,nxptmx) _real /300./ [K] +input #user left plate temp if isplttempc=0 flux_in real [1/m**2s] #incident ion or neutral flux for chem sputt ychem real #chem sputt. yield output from sputchem -yld_carbi(0:nx+1) _real #chem sputt. yield, inner wall if isch_sput=5,6 -yld_carbo(0:nx+1) _real #chem sputt. yield, outer wall if isch_sput=5,6 +yld_carbi(0:nx+1) _real +threadprivate #chem sputt. yield, inner wall if isch_sput=5,6 +yld_carbo(0:nx+1) _real +threadprivate #chem sputt. yield, outer wall if isch_sput=5,6 + + fchemygwi(ngspmx) _real /1./ +input #fac mult pf wall gas chem yield if isch_sput>0 fchemygwo(ngspmx) _real /1./ +input #fac mult outer wall gas chem yield; isch_sput>0 fchemyiwi(ngspmx) _real /1./ +input #fac mult pf wall ion chem yield if isch_sput>0 @@ -788,15 +762,15 @@ fchemyrb(ngspmx,nxptmx) _real /1./ +input #fac*outer plt gas chem yield; isch_sp fphysylb(ngspmx,nxptmx) _real /1./ +input #fac*inner plt ion phys sp yield;isch_sput>0 fphysyrb(ngspmx,nxptmx) _real /1./ +input #fac*outer plt ion phys sp yield;isch_sput>0 isexunif integer /0/ +maybeinput #=1 forces ex ~ uniform at div. plates -xcnearlb logical /FALSE/ #=TRUE if Jac'n "box" overlaps a left boundary -xcnearrb logical /FALSE/ #=TRUE if Jac'n "box" overlaps a right boundary -openbox logical /FALSE/ #=TRUE if Jac'n "box" is wide open +xcnearlb logical /FALSE/ +threadprivate #=TRUE if Jac'n "box" overlaps a left boundary +xcnearrb logical /FALSE/ +threadprivate #=TRUE if Jac'n "box" overlaps a right boundary +openbox logical /FALSE/ +threadprivate #=TRUE if Jac'n "box" is wide open kappa0 real /3.0/ +maybeinput #modified sheath drop (allows j>jsat) for kappa > kappa0 kappamx real /10.0/ +maybeinput #maximum kappa value -fqpsatlb(0:ny+1,nxptmx) _real #ion saturation current at left boundary -fqpsatrb(0:ny+1,nxptmx) _real #ion saturation current at right boundary +fqpsatlb(0:ny+1,nxptmx) _real +threadprivate #ion saturation current at left boundary +fqpsatrb(0:ny+1,nxptmx) _real +threadprivate #ion saturation current at right boundary cfueb real /1./ +input #scale factor for ueb in plate b.c.'s -ikapmod integer /0/ +input #=1 for new kappa model; =0 for qpfac model +ikapmod integer /0/ +input #=1 for new kappa model; =0 for qpfac model fvapi(10) real /10*0./ +input #scale factor for inner evap vapor source avapi(10) real /10*1./ +input #linear coeff. for inner evap vapor source bvapi(10) real /10*1./ +input #exponent coeff. for inner evap vapor source @@ -806,26 +780,25 @@ bvapo(10) real /10*1./ +input #exponent coeff. for outer evap vapor source tvapi(0:nx+1) _real [K] +input #inner wall temp for evap; input after alloc tvapo(0:nx+1) _real [K] +input #outer wall temp for evap; input after alloc cfvytanbc real /1./ +input #factor for adding vytan to plate B.C. -totfeexl(0:ny+1,nxpt) _real [W] +maybeinput #elec polod energy flux*area on "left" plate -totfeexr(0:ny+1,nxpt) _real [W] +maybeinput #elec polod energy flux*area on "right" plate -totfeixl(0:ny+1,nxpt) _real [W] +maybeinput #elec polod energy flux*area on "left" plate -totfeixr(0:ny+1,nxpt) _real [W] +maybeinput #elec polod energy flux*area on "right" plate +totfeexl(0:ny+1,nxpt) _real [W] +maybeinput +threadprivate #elec polod energy flux*area on "left" plate +totfeexr(0:ny+1,nxpt) _real [W] +maybeinput +threadprivate #elec polod energy flux*area on "right" plate +totfeixl(0:ny+1,nxpt) _real [W] +maybeinput +threadprivate #elec polod energy flux*area on "left" plate +totfeixr(0:ny+1,nxpt) _real [W] +maybeinput +threadprivate #elec polod energy flux*area on "right" plate cgpl real /0./ +input #scale fac atom eng plate loss; experim. cgpld real /0./ +input #scale fac disso eng loss; experim. -cgengpl real /0./ +input #new scale fac atom eng plate loss; old cgpl +cgengpl real /0./ +input #new scale fac atom eng plate loss; old cgpl cgengw real /0./ +input #new scale fac atom eng wall loss cgmompl real /1./ +input #scale fac atom par mom plate loss vgmomp real [m/s] /2.e3/ +input #vel used in exp factor of atom mom loss istglb(ngspmx) _integer /0/ +input #=0 for tg=tgwall; - #=1 for extrap; - #=3, Maxw flux; + #=1 for extrap; #=3, Maxw flux; #=4 for assuming half-Maxwellian for all kinds of neutral sources e.g. recycled, sputtered, pumped etc.; #=5 for tg = ti*cftgtipltl. istgrb(ngspmx) _integer /0/ +input #=0 for tg=tgwall; #=1 for extrap; - #=3, Maxw flux; - #=4 for assuming half-Maxwellian for all kinds of neutral sources e.g. recycled, sputtered, pumped etc.; - #=5 for tg = ti*cftgtipltr. + #=3, Maxw flux; + #=4 for assuming half-Maxwellian for all kinds of neutral sources e.g. recycled, sputtered, pumped etc.; + #=5 for tg = ti*cftgtipltr. cftgtipltl(ngspmx) real /ngspmx*1./ +input #left plate Tg B.C.: tg = cftgtipltl*ti if istglb=5 cftgtipltr(ngspmx) real /ngspmx*1./ +input #right plate Tg B.C.: tg = cftgtipltr*ti if istgrb=5 cgengmpl real /1./ +input #scale fac mol plate eng loss for Maxw @@ -873,18 +846,16 @@ ue_pot_engh2p1lb(0:ny+1,nxptmx) _real [J] #inner plt deut ion pot energy ue_pot_engh2p1rb(0:ny+1,nxptmx) _real [J] #outer plt deut ion pot energy ue_pot_engh2p1yi(0:nx+1) _real [J] #inner (PF) wall deut ion pot energy ue_pot_engh2p1yo(0:nx+1) _real [J] #outer (PF) wall deut ion pot energy - + ***** Rccoef: #Variables for recycling coeff. profiles on divertor plates #Set for ngspmx gas species -recylb(0:ny+1,ngspmx,nxptmx) _real +input - #tot inner plate recycling coeff. (calc) +recylb(0:ny+1,ngspmx,nxptmx) _real +input #tot inner plate recycling coeff. (calc) #if recylb > 0, recycling coeff #if in range [-1,0], acts as albedo #if in range (-2,-1), gives ng=nglfix #if recylb <= -2, gives ng(1)=ng(0) -recyrb(0:ny+1,ngspmx,nxptmx) _real +input - #tot outer plate recycling coeff. (calc) +recyrb(0:ny+1,ngspmx,nxptmx) _real +input #tot outer plate recycling coeff. (calc) #if recyrb > 0, recycling coeff #if in range [-1,0], acts as albedo #if in range (-2,-1), gives ng=ngrfix @@ -942,10 +913,10 @@ gamsec real /0./ +input #secondary elec emiss coeff on p sputtr real /0./ +input #sputtering coef. at plates sputtlb(0:ny+1,ngspmx,nxptmx) _real +input #set sputt coef. inner plate (iy,igsp) sputtrb(0:ny+1,ngspmx,nxptmx) _real +input #set sputt coef. outer plate (iy,igsp) -sputflxlb(0:ny+1,ngspmx,nxptmx) _real +maybeinput #calc sput flux inner plate (iy,igsp) -sputflxrb(0:ny+1,ngspmx,nxptmx) _real +maybeinput #calc sput flux outer plate (iy,igsp) -sputflxw(0:nx+1,ngspmx) _real +maybeinput #calc sput flux outer wall (ix,igsp) -sputflxpf(0:nx+1,ngspmx) _real +maybeinput #calc sput flux PF wall (ix,igsp) +sputflxlb(0:ny+1,ngspmx,nxptmx) _real +maybeinput +threadprivate #calc sput flux inner plate (iy,igsp) +sputflxrb(0:ny+1,ngspmx,nxptmx) _real +maybeinput +threadprivate #calc sput flux outer plate (iy,igsp) +sputflxw(0:nx+1,ngspmx) _real +maybeinput +threadprivate #calc sput flux outer wall (ix,igsp) +sputflxpf(0:nx+1,ngspmx) _real +maybeinput +threadprivate #calc sput flux PF wall (ix,igsp) ngplatlb(ngspmx,nxptmx) _real +input #ng on inner plate if sputti < -9.9 ngplatrb(ngspmx,nxptmx) _real +input #ng on outer plate if sputto < -9.9 ipsputt_s integer /1/ +input #start dens-index phys sputt species @@ -999,36 +970,36 @@ b1i real /.1111/ ***** Selec: #Variables for the calculation of the Jacobian locally. -i1 integer -i2 integer -i2p integer #used for 4th-order diffusion in x -i3 integer -i4 integer -i5 integer -i5m integer #same as i5, except restricted to ix 0 +isbohmcalc integer /1/ +input #if=1, calc Bohm diff if facb... > 0 #if=2, harmonic ave of Bohm, difni, etc. #if=3, D=difniv*(B0/B)**inbdif, etc facbni real [ ] /0./ +input #factor for Bohm density y-diff. coeff. @@ -1295,7 +1265,7 @@ isflxlde integer /0/ +input #=1,elec flux limit diff;=0, conv isflxldi integer /2/ +input #=1,ion flux limit diff;=0, conv/diff #=2, diff on individ hxcij kxe real /1./ +input #pol Braginsk elec heat conduc factor; - #prev 1.35->Balescu explain by M.Zhao + #prev 1.35->Balescu explain by M.Zhao alfkxi real /0./ +input #reduces ion thermal conduc, K_||, if #|ti(ix+1)-ti(ix)|0, set #tg=(1-istgcon)*rtg2ti*ti+istgcon*tgas*ev -tev(0:nx+1,0:ny+1) _real [J] #ion temperature at vertex of cell +tev(0:nx+1,0:ny+1) _real [J] +threadprivate #ion temperature at vertex of cell niv(0:nx+1,0:ny+1,1:nisp) _real [m^-3] #ion dens up-right vert[rm,zm(,,4)] upv(0:nx+1,0:ny+1,1:nisp) _real [m/s] #ion par vel up-right vert[rm,zm(,,4)] ngv(0:nx+1,0:ny+1,1:ngsp) _real [m^-3] #gas dens up-right vert[rm,zm(,,4)] -tiv(0:nx+1,0:ny+1) _real [J] #ion temperature at vertex of cell -niy0(0:nx+1,0:ny+1,1:nisp) _real [m^-3] #ion density below y-face center -niy1(0:nx+1,0:ny+1,1:nisp) _real [m^-3] #ion density above y-face center -niy0s(0:nx+1,0:ny+1,1:nisp) _real [m^-3] #old ion density below y-face center -niy1s(0:nx+1,0:ny+1,1:nisp) _real [m^-3] #old ion density above y-face center -ney0(0:nx+1,0:ny+1) _real [m^-3] #elec density below y-face center -ney1(0:nx+1,0:ny+1) _real [m^-3] #elec density above y-face center -nity0(0:nx+1,0:ny+1) _real [m^-3] #total ion density below y-face center -nity1(0:nx+1,0:ny+1) _real [m^-3] #total ion density above y-face center -tey0(0:nx+1,0:ny+1) _real [eV] #elec temp below y-face center -tey1(0:nx+1,0:ny+1) _real [eV] #elec temp above y-face center -tiy0(0:nx+1,0:ny+1) _real [eV] #ion temp below y-face center -tiy1(0:nx+1,0:ny+1) _real [eV] #ion temp above y-face center -tiy0s(0:nx+1,0:ny+1) _real [eV] #old ion temp below y-face center -tiy1s(0:nx+1,0:ny+1) _real [eV] #old ion temp above y-face center -tgy0(0:nx+1,0:ny+1,1:ngsp) _real [eV] #atom temp below y-face center -tgy1(0:nx+1,0:ny+1,1:ngsp) _real [eV] #atom temp above y-face center -ngy0(0:nx+1,0:ny+1,1:ngsp) _real [m^-3] #gas density below y-face center -ngy1(0:nx+1,0:ny+1,1:ngsp) _real [m^-3] #gas density above y-face center -pgy0(0:nx+1,0:ny+1,1:ngsp) _real [J/m^3] #gas pressure below y-face center -pgy1(0:nx+1,0:ny+1,1:ngsp) _real [J/m^3] #gas pressure above y-face center -pg(0:nx+1,0:ny+1,1:ngsp) _real [J/m^3] #gas pressure at cell center -phiy0(0:nx+1,0:ny+1) _real [V] #potential below y-face center -phiy1(0:nx+1,0:ny+1) _real [V] #potential above y-face center -phiy0s(0:nx+1,0:ny+1) _real [V] #old potential below y-face center -phiy1s(0:nx+1,0:ny+1) _real [V] #old potential above y-face center -pr(0:nx+1,0:ny+1) _real [J/m^3] #total pressure at center of cell -prev(0:nx+1,0:ny+1) _real [J/m^3] #elec pressure at vertex of cell -prtv(0:nx+1,0:ny+1) _real [J/m^3] #total pressure at vertex of cell -pri(0:nx+1,0:ny+1,1:nisp) _real [J/m^3] #ion plasma pressure -priv(0:nx+1,0:ny+1,1:nisp) _real [J/m^3] #ion pressure at vertex of cells -priy0(0:nx+1,0:ny+1,1:nisp) _real [J/m^3] #ion pressure below y-face center -priy1(0:nx+1,0:ny+1,1:nisp) _real [J/m^3] #ion pressure above y-face center -pre(0:nx+1,0:ny+1) _real [J/m^3] #el. plasma pressure -ne(0:nx+1,0:ny+1) _real [m^-3] #electron dens in primary cell (ix,iy) -nit(0:nx+1,0:ny+1) _real [m^-3] #tot ion dens in primary cell (ix,iy) +tiv(0:nx+1,0:ny+1) _real [J] +threadprivate #ion temperature at vertex of cell +niy0(0:nx+1,0:ny+1,1:nisp) _real [m^-3] +threadprivate #ion density below y-face center +niy1(0:nx+1,0:ny+1,1:nisp) _real [m^-3] +threadprivate #ion density above y-face center +niy0s(0:nx+1,0:ny+1,1:nisp) _real [m^-3] +threadprivate #old ion density below y-face center +niy1s(0:nx+1,0:ny+1,1:nisp) _real [m^-3] +threadprivate #old ion density above y-face center +ney0(0:nx+1,0:ny+1) _real [m^-3] +threadprivate #elec density below y-face center +ney1(0:nx+1,0:ny+1) _real [m^-3] +threadprivate #elec density above y-face center +nity0(0:nx+1,0:ny+1) _real [m^-3] +threadprivate #total ion density below y-face center +nity1(0:nx+1,0:ny+1) _real [m^-3] +threadprivate #total ion density above y-face center +tey0(0:nx+1,0:ny+1) _real [eV] +threadprivate #elec temp below y-face center +tey1(0:nx+1,0:ny+1) _real [eV] +threadprivate #elec temp above y-face center +tiy0(0:nx+1,0:ny+1) _real [eV] +threadprivate #ion temp below y-face center +tiy1(0:nx+1,0:ny+1) _real [eV] +threadprivate #ion temp above y-face center +tiy0s(0:nx+1,0:ny+1) _real [eV] +threadprivate #old ion temp below y-face center +tiy1s(0:nx+1,0:ny+1) _real [eV] +threadprivate #old ion temp above y-face center +tgy0(0:nx+1,0:ny+1,1:ngsp) _real [eV] +threadprivate #atom temp below y-face center +tgy1(0:nx+1,0:ny+1,1:ngsp) _real [eV] +threadprivate #atom temp above y-face center +ngy0(0:nx+1,0:ny+1,1:ngsp) _real [m^-3] +threadprivate #gas density below y-face center +ngy1(0:nx+1,0:ny+1,1:ngsp) _real [m^-3] +threadprivate #gas density above y-face center +pgy0(0:nx+1,0:ny+1,1:ngsp) _real [J/m^3] +threadprivate #gas pressure below y-face center +pgy1(0:nx+1,0:ny+1,1:ngsp) _real [J/m^3] +threadprivate #gas pressure above y-face center +pg(0:nx+1,0:ny+1,1:ngsp) _real [J/m^3] +threadprivate #gas pressure at cell center +phiy0(0:nx+1,0:ny+1) _real [V] +threadprivate #potential below y-face center +phiy1(0:nx+1,0:ny+1) _real [V] +threadprivate #potential above y-face center +phiy0s(0:nx+1,0:ny+1) _real [V] +threadprivate #old potential below y-face center +phiy1s(0:nx+1,0:ny+1) _real [V] +threadprivate #old potential above y-face center +pr(0:nx+1,0:ny+1) _real [J/m^3] +threadprivate #total pressure at center of cell +prev(0:nx+1,0:ny+1) _real [J/m^3] +threadprivate #elec pressure at vertex of cell +prtv(0:nx+1,0:ny+1) _real [J/m^3] +threadprivate #total pressure at vertex of cell +pri(0:nx+1,0:ny+1,1:nisp) _real [J/m^3] +threadprivate #ion plasma pressure +priv(0:nx+1,0:ny+1,1:nisp) _real [J/m^3] +threadprivate #ion pressure at vertex of cells +priy0(0:nx+1,0:ny+1,1:nisp) _real [J/m^3] +threadprivate #ion pressure below y-face center +priy1(0:nx+1,0:ny+1,1:nisp) _real [J/m^3] +threadprivate #ion pressure above y-face center +pre(0:nx+1,0:ny+1) _real [J/m^3] +threadprivate #el. plasma pressure +ne(0:nx+1,0:ny+1) _real [m^-3] +threadprivate #electron dens in primary cell (ix,iy) +nit(0:nx+1,0:ny+1) _real [m^-3] +threadprivate #tot ion dens in primary cell (ix,iy) nginit(0:nx+1,0:ny+1) _real [m^-3] #init gas dens in primary cell (ix,iy) -phi(0:nx+1,0:ny+1) _real [V] #potential in primary cell (ix,iy) -phiv(0:nx+1,0:ny+1) _real [V] #potential at vertex of cell -zeff(0:nx+1,0:ny+1) _real [ ] #Z_effective charge in cell (ix,iy) -loglambda(0:nx+1,0:ny+1) _real [ ] #Coulomb logarithm on "east" x-face -netap(0:nx+1,0:ny+1) _real [ ] #ne*parallel resistivity -znot(0:nx+1,0:ny+1) _real [ ] #=Sum(n_z * Z^2)/n_i in cell +phi(0:nx+1,0:ny+1) _real [V] +threadprivate #potential in primary cell (ix,iy) +phiv(0:nx+1,0:ny+1) _real [V] +threadprivate #potential at vertex of cell +zeff(0:nx+1,0:ny+1) _real [ ] +threadprivate #Z_effective charge in cell (ix,iy) +loglambda(0:nx+1,0:ny+1) _real [ ] +threadprivate #Coulomb logarithm on "east" x-face +netap(0:nx+1,0:ny+1) _real [ ] +threadprivate #ne*parallel resistivity +znot(0:nx+1,0:ny+1) _real [ ] +threadprivate #=Sum(n_z * Z^2)/n_i in cell zimpc(0:nx+1,0:ny+1) _real [ ] #Zimp (avg-ion model) in cell (ix,iy) nil(0:nx+1,0:ny+1,1:nisp) _real [m^-3] #ion density at last output upl(0:nx+1,0:ny+1,1:nisp) _real [m/s] #parallel ion velocity at last output @@ -1653,24 +1623,24 @@ tel(0:nx+1,0:ny+1) _real [J] #electron temperature at last output til(0:nx+1,0:ny+1) _real [J] #ion temperature at last output ngl(0:nx+1,0:ny+1,1:ngsp) _real [m^-3] #gas density at last output phil(0:nx+1,0:ny+1) _real [V] #potential at last output -upxpt(1:nusp,1:nxpt) _real [m/s] #parallel velocity at x-point -nixpt(1:nusp,1:nxpt) _real [m^-3] #ion density at x-point -visyxpt(1:nusp,1:nxpt) _real #ion viscosity at x-point -vyhxpt(1:nusp,1:nxpt) _real [m/s] #horiz. ion drift vel. at x-point -vyvxpt(1:nusp,1:nxpt) _real [m/s] #vert. ion drift vel. at x-point -fmihxpt(1:nusp,1:nxpt) _real [Nwt] #horiz. mom. flux at x-point -fmivxpt(1:nusp,1:nxpt) _real [Nwt] #vert. mom. flux at x-point +upxpt(1:nusp,1:nxpt) _real [m/s] +threadprivate #parallel velocity at x-point +nixpt(1:nusp,1:nxpt) _real [m^-3] +threadprivate #ion density at x-point +visyxpt(1:nusp,1:nxpt) _real +threadprivate #ion viscosity at x-point +vyhxpt(1:nusp,1:nxpt) _real [m/s] +threadprivate #horiz. ion drift vel. at x-point +vyvxpt(1:nusp,1:nxpt) _real [m/s] +threadprivate #vert. ion drift vel. at x-point +fmihxpt(1:nusp,1:nxpt) _real [Nwt] +threadprivate #horiz. mom. flux at x-point +fmivxpt(1:nusp,1:nxpt) _real [Nwt] +threadprivate #vert. mom. flux at x-point rtauxfac real /0./ #fac*rtaux, Ly-a optic depth to plate #=1 standard; <=0 skips rtau calc. rtauyfac real /1./ #fac*rtauy, Ly-a optic depth to wall rt_scal real /1.e-16/#factor to scale rtaux,y & thus rtau -rtaux(0:nx+1,0:ny+1) _real [1e-16 m^-2]/0./ #Norm. poloidal neutral line-dens., +rtaux(0:nx+1,0:ny+1) _real [1e-16 m^-2]/0./ +threadprivate #Norm. poloidal neutral line-dens., #Ly-a opacity to plates -rtauy(0:nx+1,0:ny+1) _real [1e-16 m^-2]/0./ #Norm. radial neutral line-dens., +rtauy(0:nx+1,0:ny+1) _real [1e-16 m^-2]/0./ +threadprivate #Norm. radial neutral line-dens., #norm. Ly-a opacity to radial wall -rtau(0:nx+1,0:ny+1) _real [1e-16 m^-2]/0./ #Min. norm neutral line-dens., +rtau(0:nx+1,0:ny+1) _real [1e-16 m^-2]/0./ +threadprivate #Min. norm neutral line-dens., #min. Ly-a opacity; min(rtaux,rtauy) -betap(0:nx+1,0:ny+1) _real /0./ #poloidal plasma beta +betap(0:nx+1,0:ny+1) _real /0./ +threadprivate #poloidal plasma beta fracvgpgp real /1./ #frac of vgp in vgradp eng terms ***** Postproc: @@ -1819,77 +1789,77 @@ vy0(0:nx+1,0:ny+1,1:nisp) _real [m/s] #old radial velocity ***** Comflo: #Variables in common -- flows -fqp(0:nx+1,0:ny+1) _real [Amp] #pol proj of par cur, east face -cfparcur real /0./ +input #scale fac fqp=cfparcur*parcurrent if +fqp(0:nx+1,0:ny+1) _real [Amp] +threadprivate #pol proj of par cur, east face +cfparcur real /0./ +input #scale fac fqp=cfparcur*parcurrent if #isimpon=5 (fmombal from Hirshman) -fq2(0:nx+1,0:ny+1) _real [Amp] #pol proj of 2 cur, east face -fqx(0:nx+1,0:ny+1) _real [Amp] #net poloidal current, east face -fqxb(0:nx+1,0:ny+1) _real [Amp] #poloidal cur from grad_B, east face -fdiaxlb(0:ny+1,1:nxpt) _real [Amp] #left boundary Dia current for bc -fdiaxrb(0:ny+1,1:nxpt) _real [Amp] #right boundary Dia current for bc -floxebgt(0:nx+1,0:ny+1) _real [W] #BxgradTe diamag part floxe (-> feex) -floxibgt(0:nx+1,0:ny+1,1:nisp) _real [W]#BxgradTi diamag part floxi (-> feex) -fqy(0:nx+1,0:ny+1) _real [Amp] #net radial current, north face -fqyb(0:nx+1,0:ny+1) _real [Amp] #radial current from grad_B, north face -fqyn(0:nx+1,0:ny+1) _real [Amp] #radial cur from cx coll, north face -fqym(0:nx+1,0:ny+1) _real [Amp] #radial cur from inertia, north face -fqymi(0:nx+1,0:ny+1,1:nisp) _real [Amp] #spec rad cur from inertia, north face -fqya(0:nx+1,0:ny+1) _real [Amp] #anomalous visc rad cur, north face -fqydt(0:nx+1,0:ny+1) _real [Amp] #time-dep inertial rad cur, north face -fqydti(0:nx+1,0:ny+1,1:nisp) _real [Amp]#spec time-dep inert rad cur, north face -fqyao(0:nx+1,0:ny+1) _real [Amp] #old anom mobil rad current, north face -fqyae(0:nx+1,0:ny+1) _real [Amp] #anom mobil rad current for electrons, north face -fqyai(0:nx+1,0:ny+1) _real [Amp] #anom mobil rad current for ions, north face -fqyd(0:nx+1,0:ny+1) _real [Amp] #diamag radial current; north face -fqygp(0:nx+1,0:ny+1) _real [Amp] #net radial curr. uses grad_P, north face -fq2d(0:nx+1,0:ny+1) _real [Amp] #diamag 2-current; east face +fq2(0:nx+1,0:ny+1) _real [Amp] +threadprivate #pol proj of 2 cur, east face +fqx(0:nx+1,0:ny+1) _real [Amp] +threadprivate #net poloidal current, east face +fqxb(0:nx+1,0:ny+1) _real [Amp] +threadprivate #poloidal cur from grad_B, east face +fdiaxlb(0:ny+1,1:nxpt) _real [Amp] +threadprivate #left boundary Dia current for bc +fdiaxrb(0:ny+1,1:nxpt) _real [Amp] +threadprivate #right boundary Dia current for bc +floxebgt(0:nx+1,0:ny+1) _real [W] +threadprivate #BxgradTe diamag part floxe (-> feex) +floxibgt(0:nx+1,0:ny+1,1:nisp) _real [W] +threadprivate #BxgradTi diamag part floxi (-> feex) +fqy(0:nx+1,0:ny+1) _real [Amp] +threadprivate #net radial current, north face +fqyb(0:nx+1,0:ny+1) _real [Amp] +threadprivate #radial current from grad_B, north face +fqyn(0:nx+1,0:ny+1) _real [Amp] +threadprivate #radial cur from cx coll, north face +fqym(0:nx+1,0:ny+1) _real [Amp] +threadprivate #radial cur from inertia, north face +fqymi(0:nx+1,0:ny+1,1:nisp) _real [Amp] +threadprivate #spec rad cur from inertia, north face +fqya(0:nx+1,0:ny+1) _real [Amp] +threadprivate #anomalous visc rad cur, north face +fqydt(0:nx+1,0:ny+1) _real [Amp] +threadprivate #time-dep inertial rad cur, north face +fqydti(0:nx+1,0:ny+1,1:nisp) _real [Amp] +threadprivate #spec time-dep inert rad cur, north face +fqyao(0:nx+1,0:ny+1) _real [Amp] +threadprivate #old anom mobil rad current, north face +fqyae(0:nx+1,0:ny+1) _real [Amp] +threadprivate #anom mobil rad current for electrons, north face +fqyai(0:nx+1,0:ny+1) _real [Amp] +threadprivate #anom mobil rad current for ions, north face +fqyd(0:nx+1,0:ny+1) _real [Amp] +threadprivate #diamag radial current; north face +fqygp(0:nx+1,0:ny+1) _real [Amp] +threadprivate #net radial curr. uses grad_P, north face +fq2d(0:nx+1,0:ny+1) _real [Amp] +threadprivate #diamag 2-current; east face fqypneo(0:nx+1,0:ny+1) _real [Amp] #rad-cur from neo particle flux fq2pneo(0:nx+1,0:ny+1) _real [Amp] #2-cur from neo particle flux fqyqneo(0:nx+1,0:ny+1) _real [Amp] #rad-cur from neo heat flux fq2qneo(0:nx+1,0:ny+1) _real [Amp] #2-cur from neo heat flux -fnix(0:nx+1,0:ny+1,1:nisp) _real [1/s] #ion poloidal current, east face -fnixcb(0:nx+1,0:ny+1,1:nisp) _real [1/s] #ion grad-B pol. current, east face -fniy(0:nx+1,0:ny+1,1:nisp) _real [1/s] #ion radial current, north face -fniy4ord(0:nx+1,0:ny+1,1:nisp) _real [1/s] #4th ord ion radial current, north face -fniycb(0:nx+1,0:ny+1,1:nisp) _real [1/s] #ion grad-B rad. current, north face +fnix(0:nx+1,0:ny+1,1:nisp) _real [1/s] +threadprivate #ion poloidal current, east face +fnixcb(0:nx+1,0:ny+1,1:nisp) _real [1/s] +threadprivate #ion grad-B pol. current, east face +fniy(0:nx+1,0:ny+1,1:nisp) _real [1/s] +threadprivate #ion radial current, north face +fniy4ord(0:nx+1,0:ny+1,1:nisp) _real [1/s] +threadprivate #4th ord ion radial current, north face +fniycb(0:nx+1,0:ny+1,1:nisp) _real [1/s] +threadprivate #ion grad-B rad. current, north face flnix(0:nx+1,0:ny+1,1:nisp) _real [1/s] #ion poloidal log-current, east face flniy(0:nx+1,0:ny+1,1:nisp) _real [1/s] #ion radial log-current, north face -fmix(0:nx+1,0:ny+1,1:nusp) _real [Nwt] #ion poloidal momentum current,east face -fmiy(0:nx+1,0:ny+1,1:nusp) _real [Nwt] #ion radial momentum current, north face -fmixy(0:nx+1,0:ny+1,1:nusp) _real [Nwt] #nonorthog ion pol. mom. curr., east f. -fmity(0:nx+1,0:ny+1,1:nisp) _real [ ] #rad flux of cross-field tor. mom*R/Bp; +fmix(0:nx+1,0:ny+1,1:nusp) _real [Nwt] +threadprivate #ion poloidal momentum current,east face +fmiy(0:nx+1,0:ny+1,1:nusp) _real [Nwt] +threadprivate #ion radial momentum current, north face +fmixy(0:nx+1,0:ny+1,1:nusp) _real [Nwt] +threadprivate #nonorthog ion pol. mom. curr., east f. +fmity(0:nx+1,0:ny+1,1:nisp) _real [ ] +threadprivate #rad flux of cross-field tor. mom*R/Bp; #nisp dimen, not nusp as for pot eqn fmgx(0:nx+1,0:ny+1,ngsp) _real [Nwt] #pol. neutral mom. current, east face ### IJ 2016/10/11 fmgy(0:nx+1,0:ny+1,ngsp) _real [Nwt] #rad. neutral mom. current, north face ### IJ 2016/10/11 -feex(0:nx+1,0:ny+1) _real [J/s] #poloidal electron thermal current, +feex(0:nx+1,0:ny+1) _real [J/s] +threadprivate #poloidal electron thermal current, #east face -feey(0:nx+1,0:ny+1) _real [J/s] #radial electron thermal current, +feey(0:nx+1,0:ny+1) _real [J/s] +threadprivate #radial electron thermal current, #north face -feexy(0:nx+1,0:ny+1) _real [J/s] #nonorthog elec. pol. therm cur, east f. -feey4ord(0:nx+1,0:ny+1) _real [J/s] #elec. pol. kye4order therm cur, east f. -feix(0:nx+1,0:ny+1) _real [J/s] #poloidal ion thermal current, east face -feiy(0:nx+1,0:ny+1) _real [J/s] #radial ion thermal current, north face -fegx(0:nx+1,0:ny+1,ngsp) _real [J/s] #poloidal neut thermal curr, east face ### IJ 2016/09/2 -fegy(0:nx+1,0:ny+1,ngsp) _real [J/s] #radial neut thermal curr, north face ### IJ 2016/09/22 -fegxy(0:nx+1,0:ny+1,ngsp) _real [J/s] #pol. nonog neut thermal curr, north face -isfegxyqflave integer /0/ +input #=0fegxy T*vt,ng ave;=1, use harm aves -cfegxy real /1./ +input #coeff multiple fegxy -qipar(0:nx+1,0:ny+1,nisp) _real [J/m**2s] #parallel conductive ion heat flux +feexy(0:nx+1,0:ny+1) _real [J/s] +threadprivate #nonorthog elec. pol. therm cur, east f. +feey4ord(0:nx+1,0:ny+1) _real [J/s] +threadprivate #elec. pol. kye4order therm cur, east f. +feix(0:nx+1,0:ny+1) _real [J/s] +threadprivate #poloidal ion thermal current, east face +feiy(0:nx+1,0:ny+1) _real [J/s] +threadprivate #radial ion thermal current, north face +fegx(0:nx+1,0:ny+1,ngsp) _real [J/s] +threadprivate #poloidal neutral thermal current, east face ### IJ 2016/09/22 +fegy(0:nx+1,0:ny+1,ngsp) _real [J/s] +threadprivate #radial neutral thermal current, north face ### IJ 2016/09/22 +fegxy(0:nx+1,0:ny+1,ngsp) _real [J/s] +threadprivate #pol. nonog neut thermal curr, north face +isfegxyqflave integer /0/ +input #=0fegxy T*vt,ng ave;=1, use harm aves +cfegxy real /1./ +input #coeff multiple fegxy +qipar(0:nx+1,0:ny+1,nisp) _real [J/m**2s] +threadprivate #parallel conductive ion heat flux qgpar(0:nx+1,0:ny+1,ngsp) _real [J/m**2s] #parallel conductive gas heat flux -fniycbo(0:nx+1,1:nisp) _real [1/s] #fniy cor. iy=0 bdry for grad_B, grad_P -feiycbo(0:nx+1) _real [J/s] #feiy cor. iy=0 bdry for grad_B, grad_P -feeycbo(0:nx+1) _real [J/s] #feey cor. iy=0 bdry for grad_B, grad_P -feixy(0:nx+1,0:ny+1) _real [J/s] #nonorthog ion pol. thermal cur, east f. -feiy4ord(0:nx+1,0:ny+1) _real [J/s] #ion pol. kyi4order therm cur, east f. -fngx(0:nx+1,0:ny+1,1:ngsp) _real [1/s] #neutral polodial current, east face -fngx4ord(0:nx+1,0:ny+1,1:ngsp) _real [1/s] #4th ord gas radial current, north face -flngx(0:nx+1,0:ny+1,1:ngsp) _real [1/s] #neutral pol. log-current, east face +fniycbo(0:nx+1,1:nisp) _real [1/s] +threadprivate #fniy cor. iy=0 bdry for grad_B, grad_P +feiycbo(0:nx+1) _real [J/s] +threadprivate #feiy cor. iy=0 bdry for grad_B, grad_P +feeycbo(0:nx+1) _real [J/s] +threadprivate #feey cor. iy=0 bdry for grad_B, grad_P +feixy(0:nx+1,0:ny+1) _real [J/s] +threadprivate #nonorthog ion pol. thermal cur, east f. +feiy4ord(0:nx+1,0:ny+1) _real [J/s] +threadprivate #ion pol. kyi4order therm cur, east f. +fngx(0:nx+1,0:ny+1,1:ngsp) _real [1/s] +threadprivate #neutral polodial current, east face +fngx4ord(0:nx+1,0:ny+1,1:ngsp) _real [1/s] +threadprivate #4th ord gas radial current, north face +flngx(0:nx+1,0:ny+1,1:ngsp) _real [1/s] +threadprivate #neutral pol. log-current, east face fngxs(0:nx+1,0:ny+1,1:ngsp) _real [1/s] #neutral pol cur w/o fngxy, east face -fngy(0:nx+1,0:ny+1,1:ngsp) _real [1/s] #neutral radial current, north face -fngy4ord(0:nx+1,0:ny+1,1:ngsp) _real [1/s] #4th ord gas radial current, north face -flngy(0:nx+1,0:ny+1,1:ngsp) _real [1/s] #neutral radial log-current, north face -fngxy(0:nx+1,0:ny+1,1:ngsp) _real [1/s] #nonorthog gas pol. cur., east face -flngxy(0:nx+1,0:ny+1,1:ngsp) _real [1/s] #nonorthog gas pol.log-cur., east face +fngy(0:nx+1,0:ny+1,1:ngsp) _real [1/s] +threadprivate #neutral radial current, north face +fngy4ord(0:nx+1,0:ny+1,1:ngsp) _real [1/s] +threadprivate #4th ord gas radial current, north face +flngy(0:nx+1,0:ny+1,1:ngsp) _real [1/s] +threadprivate #neutral radial log-current, north face +fngxy(0:nx+1,0:ny+1,1:ngsp) _real [1/s] +threadprivate #nonorthog gas pol. cur., east face +flngxy(0:nx+1,0:ny+1,1:ngsp) _real [1/s] +threadprivate #nonorthog gas pol.log-cur., east face fngyx(0:nx+1,0:ny+1,1:ngsp) _real [1/s] #nonorthog gas rad. cur., north face fnixtot(0:nx+1,0:ny+1) _real [1/s] #total poloidal ion cur. fniytot(0:nx+1,0:ny+1) _real [1/s] #total radial ion cur. @@ -1942,7 +1912,7 @@ bcei real /2.5/ +input #ion sheath energy trans. factor(newbc=0) bceew real /4./ +input #elec wall energy trans factor bceiw real /2.5/ +input #ion wall energy trans factor -bcen real /0./ +input #neut energy trans. factor on plates +bcen real /0./ +input #neut energy trans. factor on plates #For combined neutral+ion energy equation bcenw real /0./ +input #neut eng trans fac on walls isfdiax real /0./ +input #switch to turn on diamagnetic drift for sheath @@ -1955,58 +1925,58 @@ cfsigm real /1./ +input #scale factor for parallel cond. sigma1 rsigpl real /0./ +input #ad hoc radial electrical conductivity - global rsigplcore real /0./ +input #ad hoc radial electrical conduct - core only #ratio of perp to parallel conductivity -bcel(0:ny+1,nxpt) _real [ ] +maybeinput #electron sheath energy transmission factor +bcel(0:ny+1,nxpt) _real [ ] +maybeinput +threadprivate #electron sheath energy transmission factor #on the left boundary -bcer(0:ny+1,nxpt) _real [ ] +maybeinput #electron sheath energy transmission factor +bcer(0:ny+1,nxpt) _real [ ] +maybeinput +threadprivate #electron sheath energy transmission factor #on the right boundary -bcil(0:ny+1,nxpt) _real [ ] +maybeinput #ion sheath energy transmission factor +bcil(0:ny+1,nxpt) _real [ ] +maybeinput +threadprivate #ion sheath energy transmission factor #on the left boundary -bcir(0:ny+1,nxpt) _real [ ] +maybeinput #ion sheath energy transmission factor +bcir(0:ny+1,nxpt) _real [ ] +maybeinput +threadprivate #ion sheath energy transmission factor #on the right boundary -kappal(0:ny+1,nxpt) _real [ ] +maybeinput #sheath pot'l drop on left boundary, phi/Te -kappar(0:ny+1,nxpt) _real [ ] +maybeinput #sheath pot'l drop on right boundary, phi/Te -bctype(0:ny+1) _integer #/0,ny*0,0/+maybeinput +kappal(0:ny+1,nxpt) _real [ ] +maybeinput +threadprivate #sheath pot'l drop on left boundary, phi/Te +kappar(0:ny+1,nxpt) _real [ ] +maybeinput +threadprivate #sheath pot'l drop on right boundary, phi/Te +bctype(0:ny+1) _integer #/0,ny*0,0/+maybeinput phi0r(0:ny+1,nxpt) _real [V] /0./ +maybeinput #plate pot'l at right poloidal boundary phi0l(0:ny+1,nxpt) _real [V] /0./ +maybeinput #plate pot'l at left poloidal boundary -capx(1:ny) _real #/ny*0.0/+maybeinput -dphi_iy1(0:nx+1) _real [V] #/(nx+2)*0./ +maybeinput #incremental phi at iy=1 to have +capx(1:ny) _real #/ny*0.0/+maybeinput +dphi_iy1(0:nx+1) _real [V] +maybeinput +threadprivate #/(nx+2)*0./ #incremental phi at iy=1 to have #Te=constant for second phi BC -kincorlb(0:ny+1,nxpt) _real [ ] +maybeinput # kinetic corr. factor for elec part. loss, left b -kincorrb(0:ny+1,nxpt) _real [ ] +maybeinput # kinetic corr. factor for elec part. loss, right b +kincorlb(0:ny+1,nxpt) _real [ ] +maybeinput +threadprivate # kinetic corr. factor for elec part. loss, left b +kincorrb(0:ny+1,nxpt) _real [ ] +maybeinput +threadprivate # kinetic corr. factor for elec part. loss, right b cfkincor real [ ] /0.5/ +input # factor for kincorlb,rb denom. factor #Variables for the grid-sequencing. #yet to be defined? ***** Gradients: #Gradients of the different physical quantities. -ex(0:nx+1,0:ny+1) _real [V/m] #poloidal electric field -ey(0:nx+1,0:ny+1) _real [V/m] #radial electric field -eymask1d(0:nx+1,0:ny+1) _real [V/m] #set ey=0 in core+sep if isphicore0=1 -einduc real [V/m] +input #inductive tor. E-field - input -gpix(0:nx+1,0:ny+1,1:nisp) _real [Pa/m] #X-gradient of ion pressure -gpiy(0:nx+1,0:ny+1,1:nisp) _real [Pa/m] #Y-gradient of ion pressure -gpex(0:nx+1,0:ny+1) _real [Pa/m] #X-gradient of el. pressure -gpey(0:nx+1,0:ny+1) _real [Pa/m] #Y-gradient of el. pressure -gprx(0:nx+1,0:ny+1) _real [Pa/m] #X-gradient of total pressure -gpry(0:nx+1,0:ny+1) _real [Pa/m] #Y-gradient of total pressure -gtex(0:nx+1,0:ny+1) _real [J/m] #X-gradient of el. temperature -gtey(0:nx+1,0:ny+1) _real [J/m] #Y-gradient of el. temperature -gtix(0:nx+1,0:ny+1) _real [J/m] #X-gradient of ion temperature -gtiy(0:nx+1,0:ny+1) _real [J/m] #Y-gradient of ion temperature -gpondpotx(0:nx+1,0:ny+1) _real [V/m] #X-gradient of elec pondom pot +ex(0:nx+1,0:ny+1) _real [V/m] +threadprivate #poloidal electric field +ey(0:nx+1,0:ny+1) _real [V/m] +threadprivate #radial electric field +eymask1d(0:nx+1,0:ny+1) _real [V/m] +threadprivate #set ey=0 in core+sep if isphicore0=1 +einduc real [V/m] +input +threadprivate #inductive tor. E-field - input +gpix(0:nx+1,0:ny+1,1:nisp) _real [Pa/m] +threadprivate #X-gradient of ion pressure +gpiy(0:nx+1,0:ny+1,1:nisp) _real [Pa/m] +threadprivate #Y-gradient of ion pressure +gpex(0:nx+1,0:ny+1) _real [Pa/m] +threadprivate #X-gradient of el. pressure +gpey(0:nx+1,0:ny+1) _real [Pa/m] +threadprivate #Y-gradient of el. pressure +gprx(0:nx+1,0:ny+1) _real [Pa/m] +threadprivate #X-gradient of total pressure +gpry(0:nx+1,0:ny+1) _real [Pa/m] +threadprivate #Y-gradient of total pressure +gtex(0:nx+1,0:ny+1) _real [J/m] +threadprivate #X-gradient of el. temperature +gtey(0:nx+1,0:ny+1) _real [J/m] +threadprivate #Y-gradient of el. temperature +gtix(0:nx+1,0:ny+1) _real [J/m] +threadprivate #X-gradient of ion temperature +gtiy(0:nx+1,0:ny+1) _real [J/m] +threadprivate #Y-gradient of ion temperature +gpondpotx(0:nx+1,0:ny+1) _real [V/m] +threadprivate #X-gradient of elec pondom pot ***** Cfric: #Coulomb friction terms for parallel transport -frice(0:nx+1,0:ny+1) _real [J/m**4] +maybeinput #Electron parallel Coulomb friction -frici(0:nx+1,0:ny+1,nisp) _real [J/m**4] +maybeinput #Ion parallel Coulomb friction -fricnrl(0:nx+1,0:ny+1,nusp) _real [J/m**4] +maybeinput #NRL ion par fric ni*mi*nu*(up1-up2) +frice(0:nx+1,0:ny+1) _real [J/m**4] +maybeinput +threadprivate #Electron parallel Coulomb friction +frici(0:nx+1,0:ny+1,nisp) _real [J/m**4] +maybeinput +threadprivate #Ion parallel Coulomb friction +fricnrl(0:nx+1,0:ny+1,nusp) _real [J/m**4] +maybeinput +threadprivate #NRL ion par fric ni*mi*nu*(up1-up2) cfgti /1./ real +input #scale factor for ion thermal force cfgte /1./ real +input #scale factor for elec. thermal force cftaud /1./ real +input #scale factor for ion-ion drag time isalfecalc(1:nisp) /1/ _integer +input #=1 for internal calc of alfe isbetaicalc(1:nisp)/1/ _integer +input #=1 for internal calc of betai -alfe(1:nisp) /1./ _real +input #grad_Te thm force coeff isalfecalc=0 -betai(1:nisp) /1./ _real +input #grad_Ti thm force coeff isbetaicalc=0 +alfe(1:nisp) /1./ _real +input +threadprivate #grad_Te thm force coeff isalfecalc=0 +betai(1:nisp) /1./ _real +input +threadprivate #grad_Ti thm force coeff isbetaicalc=0 ***** Grid: ngrid /1/ integer +regrid @@ -2020,174 +1990,174 @@ ijactot /0/ integer # tot Jac calcs, used as check when icntnunk=1 ***** Wkspace: #Workspace arrays -w(0:nx+1,0:ny+1) _real -w0(0:nx+1,0:ny+1) _real -w1(0:nx+1,0:ny+1) _real -w2(0:nx+1,0:ny+1) _real -w3(0:nx+1,0:ny+1) _real +w(0:nx+1,0:ny+1) _real +threadprivate +w0(0:nx+1,0:ny+1) _real +threadprivate +w1(0:nx+1,0:ny+1) _real +threadprivate +w2(0:nx+1,0:ny+1) _real +threadprivate +w3(0:nx+1,0:ny+1) _real +threadprivate ***** Locflux: #Local arrays for the calculation of the fluxes and other quantities. -flox(0:nx+1,0:ny+1) _real -floy(0:nx+1,0:ny+1) _real -conx(0:nx+1,0:ny+1) _real -cony(0:nx+1,0:ny+1) _real -floxe(0:nx+1,0:ny+1) _real -floye(0:nx+1,0:ny+1) _real -floxi(0:nx+1,0:ny+1) _real -floyi(0:nx+1,0:ny+1) _real -floxg(0:nx+1,0:ny+1) _real -floyg(0:nx+1,0:ny+1) _real +flox(0:nx+1,0:ny+1) _real +threadprivate +floy(0:nx+1,0:ny+1) _real +threadprivate +conx(0:nx+1,0:ny+1) _real +threadprivate +cony(0:nx+1,0:ny+1) _real +threadprivate +floxe(0:nx+1,0:ny+1) _real +threadprivate +floye(0:nx+1,0:ny+1) _real +threadprivate +floxi(0:nx+1,0:ny+1) _real +threadprivate +floyi(0:nx+1,0:ny+1) _real +threadprivate +floxg(0:nx+1,0:ny+1) _real +threadprivate +floyg(0:nx+1,0:ny+1) _real +threadprivate fgtdx(0:nx+1) _real #scale factor for gas grad-x T vel fgtdy(0:ny+1) _real #scale factor for gas grad-x T vel -conxe(0:nx+1,0:ny+1) _real -conye(0:nx+1,0:ny+1) _real -conxi(0:nx+1,0:ny+1) _real -conyi(0:nx+1,0:ny+1) _real -conxg(0:nx+1,0:ny+1) _real -conyg(0:nx+1,0:ny+1) _real -floxge(0:nx+1,0:ny+1,1:ngsp) _real -floyge(0:nx+1,0:ny+1,1:ngsp) _real -conxge(0:nx+1,0:ny+1,1:ngsp) _real -conyge(0:nx+1,0:ny+1,1:ngsp) _real +conxe(0:nx+1,0:ny+1) _real +threadprivate +conye(0:nx+1,0:ny+1) _real +threadprivate +conxi(0:nx+1,0:ny+1) _real +threadprivate +conyi(0:nx+1,0:ny+1) _real +threadprivate +conxg(0:nx+1,0:ny+1) _real +threadprivate +conyg(0:nx+1,0:ny+1) _real +threadprivate +floxge(0:nx+1,0:ny+1,1:ngsp) _real +threadprivate +floyge(0:nx+1,0:ny+1,1:ngsp) _real +threadprivate +conxge(0:nx+1,0:ny+1,1:ngsp) _real +threadprivate +conyge(0:nx+1,0:ny+1,1:ngsp) _real +threadprivate ***** Conduc: #Variables for the common -- conduc -visx(0:nx+1,0:ny+1,1:nisp) _real [kg/m s]#poloidal viscosity coeff. -visy(0:nx+1,0:ny+1,1:nisp) _real [kg/m s]#radial viscosity coeff. -hcxe(0:nx+1,0:ny+1) _real [1/m s] #poloidal elec. therm. conduct. -hcye(0:nx+1,0:ny+1) _real [1/m s] #radial elec. therm. conduct. -hcxij(0:nx+1,0:ny+1,1:nisp) _real [1/m s] #j-species pol. ion therm. conduct. -hcyij(0:nx+1,0:ny+1,1:nisp) _real [1/m s] #j-species rad. ion therm. conduct. -hcxg(0:nx+1,0:ny+1,1:ngsp) _real [1/m s] #j-species pol. gas therm. conduct. -hcyg(0:nx+1,0:ny+1,1:ngsp) _real [1/m s] #j-species rad. gas therm. conduct. -hcxi(0:nx+1,0:ny+1) _real [1/m s] #summed pol. ion+neut therm. conduct. -hcxineo(0:nx+1,0:ny+1) _real [1/m s] #neocl. pol. ion+neut therm. conduct. -hcyi(0:nx+1,0:ny+1) _real [1/m s] #summed rad. ion+neut therm. conduct. -hcxn(0:nx+1,0:ny+1) _real [1/m s] #poloidal neutral therm. conduct. -hcyn(0:nx+1,0:ny+1) _real [1/m s] #radial neutral therm. conduct. -kxbohm(0:nx+1,0:ny+1) _real [m**2/s] +input #spatially depend. diff. on x-face +visx(0:nx+1,0:ny+1,1:nisp) _real [kg/m s] +threadprivate #poloidal viscosity coeff. +visy(0:nx+1,0:ny+1,1:nisp) _real [kg/m s] +threadprivate #radial viscosity coeff. +hcxe(0:nx+1,0:ny+1) _real [1/m s] +threadprivate #poloidal elec. therm. conduct. +hcye(0:nx+1,0:ny+1) _real [1/m s] +threadprivate #radial elec. therm. conduct. +hcxij(0:nx+1,0:ny+1,1:nisp) _real [1/m s] +threadprivate #j-species pol. ion therm. conduct. +hcyij(0:nx+1,0:ny+1,1:nisp) _real [1/m s] +threadprivate #j-species rad. ion therm. conduct. +hcxg(0:nx+1,0:ny+1,1:ngsp) _real [1/m s] +threadprivate #j-species pol. gas therm. conduct. +hcyg(0:nx+1,0:ny+1,1:ngsp) _real [1/m s] +threadprivate #j-species rad. gas therm. conduct. +hcxi(0:nx+1,0:ny+1) _real [1/m s] +threadprivate #summed pol. ion+neut therm. conduct. +hcxineo(0:nx+1,0:ny+1) _real [1/m s] +threadprivate #neocl. pol. ion+neut therm. conduct. +hcyi(0:nx+1,0:ny+1) _real [1/m s] +threadprivate #summed rad. ion+neut therm. conduct. +hcxn(0:nx+1,0:ny+1) _real [1/m s] +threadprivate #poloidal neutral therm. conduct. +hcyn(0:nx+1,0:ny+1) _real [1/m s] +threadprivate #radial neutral therm. conduct. +kxbohm(0:nx+1,0:ny+1) _real [m**2/s] +input +threadprivate #spatially depend. diff. on x-face #set by user; Bohm if isbohmcalc=1 -kybohm(0:nx+1,0:ny+1) _real [m**2/s] +input #spatially depend. diff. on y-face +kybohm(0:nx+1,0:ny+1) _real [m**2/s] +input +threadprivate #spatially depend. diff. on y-face #set by user; Bohm if isbohmcalc=1 vybohm(0:nx+1,0:ny+1) _real [m/s] +input #spatially depend. convect. y-vel #set user if isbohmcalc=0; else =0 -dif_use(0:nx+1,0:ny+1,1:nisp) _real [m**2/s] +input #spatially depend. diff; if +dif_use(0:nx+1,0:ny+1,1:nisp) _real [m**2/s] +input +threadprivate #spatially depend. diff; if #isbohmcalc=1, user input if all #facbni+facbup+facbee+facbei =0, # or kybohm if facbni, etc. > 0; # if isbohmcalc=2, then # D = difni*kybohm/(difni+kybohm) -difp_use(0:nx+1,0:ny+1,1:nisp) _real [m**2/s] +input #for gen pr diff; see dif_use comment -dif2_use(0:nx+1,0:ny+1,1:nisp) _real [m**2/s] +input #for dif2; see dif_use comment -tray_use(0:nx+1,0:ny+1,1:nisp) _real [m**2/s] +input #for travis; see dif_use comment -trax_use(0:nx+1,0:ny+1,1:nisp) _real [m**2/s] +input #pol. analog to tra_use -kye_use(0:nx+1,0:ny+1) _real [m**2/s] +input #for kye; see dif_use comment -kyi_use(0:nx+1,0:ny+1) _real [m**2/s] +input #for kyi; see dif_use comment -kxe_use(0:nx+1,0:ny+1) _real [m**2/s] +input #user elec pol. heat cond -kxi_use(0:nx+1,0:ny+1) _real [m**2/s] +input #user ion pol. heat cond. -kxg_use(0:nx+1,0:ny+1,1:ngsp) _real [m**2/s] +input #user gas pol. heat cond. -kyg_use(0:nx+1,0:ny+1,1:ngsp) _real [m**2/s] +input #user gas rad. heat cond. -dutm_use(0:nx+1,0:ny+1,1:nisp) _real [m**2/s] +input #for difutm; see dif_use comment -vy_use(0:nx+1,0:ny+1,1:nisp) _real [m/s] +input #user-set rad vel;for isbohmcalc=0 +difp_use(0:nx+1,0:ny+1,1:nisp) _real [m**2/s] +input +threadprivate #for gen pr diff; see dif_use comment +dif2_use(0:nx+1,0:ny+1,1:nisp) _real [m**2/s] +input +threadprivate #for dif2; see dif_use comment +tray_use(0:nx+1,0:ny+1,1:nisp) _real [m**2/s] +input +threadprivate #for travis; see dif_use comment +trax_use(0:nx+1,0:ny+1,1:nisp) _real [m**2/s] +input +threadprivate #pol. analog to tra_use +kye_use(0:nx+1,0:ny+1) _real [m**2/s] +input +threadprivate #for kye; see dif_use comment +kyi_use(0:nx+1,0:ny+1) _real [m**2/s] +input +threadprivate #for kyi; see dif_use comment +kxe_use(0:nx+1,0:ny+1) _real [m**2/s] +input +threadprivate #user elec pol. heat cond +kxi_use(0:nx+1,0:ny+1) _real [m**2/s] +input +threadprivate #user ion pol. heat cond. +kxg_use(0:nx+1,0:ny+1,1:ngsp) _real [m**2/s] +input #user gas pol. heat cond. +kyg_use(0:nx+1,0:ny+1,1:ngsp) _real [m**2/s] +input #user gas rad. heat cond. +dutm_use(0:nx+1,0:ny+1,1:nisp) _real [m**2/s] +input +threadprivate #for difutm; see dif_use comment +vy_use(0:nx+1,0:ny+1,1:nisp) _real [m/s] +input +threadprivate #user-set rad vel;for isbohmcalc=0 vyup_use(0:nx+1,0:ny+1) _real [m/s] +input #user-set conv vel of ion || vel, up vyte_use(0:nx+1,0:ny+1) _real [m/s] +input #user-set rad elec eng vel vyti_use(0:nx+1,0:ny+1) _real [m/s] +input #user-set rad ion eng vel -pondomfpare_use(0:nx+1,0:ny+1) _real [N/m**3] +input #user-in elec parallel pondero force -pondomfpari_use(0:nx+1,0:ny+1,1:nisp) _real [N/m**3] +input #user-in parallel ion ponder. force +pondomfpare_use(0:nx+1,0:ny+1) _real [N/m**3] +input +threadprivate #user-in elec parallel pondero force +pondomfpari_use(0:nx+1,0:ny+1,1:nisp) _real [N/m**3] +input +threadprivate #user-in parallel ion ponder. force fniyos_use(0:nx+1,0:ny+1,1:nisp) _real [1/s m**2] +input #user-set particle flux -feeyosn_use(0:nx+1,0:ny+1) _real [J/s m**2] +input #user-set Te energy flux -feiyosn_use(0:nx+1,0:ny+1) _real [J/s m**2] +input #user-set Ti energy flux -vy_cft(0:nx+1,0:ny+1,1:nisp) _real [m/s] #calc vy from fniyos_use (fix flux) -vyte_cft(0:nx+1,0:ny+1) _real [m/s] #calc vyte from feeyos_use (fix flux) -vyti_cft(0:nx+1,0:ny+1) _real [m/s] #calc vyte from feiyos_use (fix flux) -nuiz(0:nx+1,0:ny+1,ngsp) _real [1/s] #ionization rate (=ne*sigma*v) -nucx(0:nx+1,0:ny+1,ngsp) _real [1/s] #charge-exchg rate for neut(sigv*ni) -nucxi(0:nx+1,0:ny+1,nisp) _real [1/s] #charge-exchg rate for ion (sigv*ng) -nueli(0:nx+1,0:ny+1,nisp) _real [1/s] #elast scatt rate for ion (sigv*ng) -nuelg(0:nx+1,0:ny+1,ngsp) _real [1/s] #elast scatt rate for gas (sigv*nimp) -nuix(0:nx+1,0:ny+1,ngsp) _real [1/s] #fnuizx*nuiz+fnucxx*nucx +feeyosn_use(0:nx+1,0:ny+1) _real [J/s m**2] +input #user-set Te energy flux +feiyosn_use(0:nx+1,0:ny+1) _real [J/s m**2] +input #user-set Ti energy flux +vy_cft(0:nx+1,0:ny+1,1:nisp) _real [m/s] +threadprivate #calc vy from fniyos_use (fix flux) +vyte_cft(0:nx+1,0:ny+1) _real [m/s] +threadprivate #calc vyte from feeyos_use (fix flux) +vyti_cft(0:nx+1,0:ny+1) _real [m/s] +threadprivate #calc vyte from feiyos_use (fix flux) +nuiz(0:nx+1,0:ny+1,ngsp) _real [1/s] +threadprivate #ionization rate (=ne*sigma*v) +nucx(0:nx+1,0:ny+1,ngsp) _real [1/s] +threadprivate #charge-exchg rate for neut(sigv*ni) +nucxi(0:nx+1,0:ny+1,nisp) _real [1/s] +threadprivate #charge-exchg rate for ion (sigv*ng) +nueli(0:nx+1,0:ny+1,nisp) _real [1/s] +threadprivate #elast scatt rate for ion (sigv*ng) +nuelg(0:nx+1,0:ny+1,ngsp) _real [1/s] +threadprivate #elast scatt rate for gas (sigv*nimp) +nuix(0:nx+1,0:ny+1,ngsp) _real [1/s] +threadprivate #fnuizx*nuiz+fnucxx*nucx fnuizx real /0./ +input #fraction of nuiz in nuix (see nuix) fnucxx real /1./ +input #fraction of nucx in nuix (see nuix) -nurc(0:nx+1,0:ny+1,ngsp) _real [1/s] #recombination rate -nuvl(0:nx+1,0:ny+1,nisp) _real [1/s] #vol loss rate, ~cs/l_parloss for 1-D +nurc(0:nx+1,0:ny+1,ngsp) _real [1/s] +threadprivate #recombination rate +nuvl(0:nx+1,0:ny+1,nisp) _real [1/s] +threadprivate #vol loss rate, ~cs/l_parloss for 1-D cfvlh real +input #scal fac for hyd rate in nuvl cfvli(nisp) _real #/nisp*0./+input #scal fac for individ ion rate nuvl l_parloss real [m] /1.e20/ +input #parall length for nuvl loss rate -eqp(0:nx+1,0:ny+1) _real [1/m**3]#Te,i equipart. fact; needs *(Te-Ti)*vol -eqpg(0:nx+1,0:ny+1,ngsp) _real [1/m**3]#Tg,i equipart. fact; needs *(Tg-Ti)*vol +eqp(0:nx+1,0:ny+1) _real [1/m**3] +threadprivate #Te,i equipart. fact; needs *(Te-Ti)*vol +eqpg(0:nx+1,0:ny+1,ngsp) _real [1/m**3] +threadprivate #Tg,i equipart. fact; needs *(Tg-Ti)*vol #..: modified to incorporate the separation of Tg and Ti. engcoolm(0:nx+1,0:ny+1) _real [J/s] #cool rate ion/atoms by mols if ishymol=1 -eeli(0:nx+1,0:ny+1) _real [J] #electron energy loss per ionization -pradhyd(0:nx+1,0:ny+1) _real [W/m**3] /0./#power radiated by hydrogen +eeli(0:nx+1,0:ny+1) _real [J] +threadprivate #electron energy loss per ionization +pradhyd(0:nx+1,0:ny+1) _real [W/m**3] /0./ +threadprivate #power radiated by hydrogen tdiflim real [s] /0./ +input #lim on hcxe/ne; reduces hcxe if >0 lmfplim real [m] /1.e20/+input #hcxe,i -> hcxe,i/(1+lmfp/lmfelim) -eta1(0:nx+1,0:ny+1) _real [J-s/m**3] +maybeinput #Braginskii ion visc coeff eta_1 -cfeta1 real /0./ +input # scale factor for eta1 -rtaue(0:nx+1,0:ny+1) _real [s/kg] +maybeinput #Brag. R coeff (t_e/me)/(w_ce*t_e)**2 +eta1(0:nx+1,0:ny+1) _real [J-s/m**3] +maybeinput +threadprivate #Braginskii ion visc coeff eta_1 +cfeta1 real /0./ +input # scale factor for eta1 +rtaue(0:nx+1,0:ny+1) _real [s/kg] +maybeinput +threadprivate #Brag. R coeff (t_e/me)/(w_ce*t_e)**2 cfrtaue real /0./ +input # scale factor for cfrtaue -dclass_e(0:nx+1,0:ny+1) _real [m**2/s]#classical elec perp heat conduc. -dclass_i(0:nx+1,0:ny+1) _real [m**2/s]#classical ion perp heat conduc. +dclass_e(0:nx+1,0:ny+1) _real [m**2/s] +threadprivate #classical elec perp heat conduc. +dclass_i(0:nx+1,0:ny+1) _real [m**2/s] +threadprivate #classical ion perp heat conduc. cfcl_e real /0./ +input #scale fac for dclass_e cfcl_i real /0./ +input #scale fac for dclass_i omgci_taui real /10./ +input #ion gy_freq*coll_rate for cl_model omgce_taue real /10./ +input #elec gy_freq*coll_rate for cl_model nuneo real /0./ +input #neoclass pol. damping rate; for fqyn -visxneo(0:nx+1,0:ny+1,1:nisp) _real [kg/m s] #Braginskii eta_0 neo-modified -visvol_v(0:nx+1,0:ny+1,1:nisp) _real #vel-based viscosity in (n*m*up)^dot eqn -visvol_q(0:nx+1,0:ny+1,1:nisp) _real #heat-flux-based viscosity (n*m*up)^dot eqn -nuii(0:nx+1,0:ny+1,1:nisp) _real #Braginski nuii coll freq. -nuiistar(0:nx+1,0:ny+1,1:nisp)_real #neoclassical nuii coll freq. -alfneo(0:nx+1,0:ny+1,1:nisp) _real #neoclassical factor for q-based visc. -k2neo(0:nx+1,0:ny+1,1:nisp) _real #neoclassical coeff reducing therm cond -ktneo(0:nx+1,0:ny+1,1:nisp) _real #neoclassical coeff of grad Ti +visxneo(0:nx+1,0:ny+1,1:nisp) _real [kg/m s] +threadprivate #Braginskii eta_0 neo-modified +visvol_v(0:nx+1,0:ny+1,1:nisp) _real +threadprivate #vel-based viscosity in (n*m*up)^dot eqn +visvol_q(0:nx+1,0:ny+1,1:nisp) _real +threadprivate #heat-flux-based viscosity (n*m*up)^dot eqn +nuii(0:nx+1,0:ny+1,1:nisp) _real +threadprivate #Braginski nuii coll freq. +nuiistar(0:nx+1,0:ny+1,1:nisp)_real +threadprivate #neoclassical nuii coll freq. +alfneo(0:nx+1,0:ny+1,1:nisp) _real +threadprivate #neoclassical factor for q-based visc. +k2neo(0:nx+1,0:ny+1,1:nisp) _real +threadprivate #neoclassical coeff reducing therm cond +ktneo(0:nx+1,0:ny+1,1:nisp) _real +threadprivate #neoclassical coeff of grad Ti ***** Rhsides: #Variables to evaluate the sources and RHS's. -snic(0:nx+1,0:ny+1,1:nisp) _real -sniv(0:nx+1,0:ny+1,1:nisp) _real -psorc(0:nx+1,0:ny+1,1:nisp) _real [part/s] # cell ctr ioniz. sor plasma (>0) -psor(0:nx+1,0:ny+1,1:nisp) _real [part/s] # cell ave ioniz. sor plasma (>0) +snic(0:nx+1,0:ny+1,1:nisp) _real +threadprivate +sniv(0:nx+1,0:ny+1,1:nisp) _real +threadprivate +psorc(0:nx+1,0:ny+1,1:nisp) _real [part/s] +threadprivate # cell ctr ioniz. sor plasma (>0) +psor(0:nx+1,0:ny+1,1:nisp) _real [part/s] +threadprivate # cell ave ioniz. sor plasma (>0) psort(0:nx+1,0:ny+1,1:nisp) _real [part/s] # ioniz. source for plasma (>0) -psorxrc(0:nx+1,0:ny+1,1:nisp) _real [part/s] # cell ctr cx &recomb. for ions (<0) -psorxr(0:nx+1,0:ny+1,1:nisp) _real [part/s] # cell ave cx &recomb. for ions (<0) -psor_tmpov(0:nx+1,0:ny+1) _real [part/s] # work array for psor,etc for ave -psorgc(0:nx+1,0:ny+1,1:ngsp) _real [part/s] # cell ctr ioniz. sor neutral (<0) -psorg(0:nx+1,0:ny+1,1:ngsp) _real [part/s] # cell ave ioniz. sor neutral (<0) -psorrgc(0:nx+1,0:ny+1,1:ngsp) _real [part/s] # cell ctr recomb. source for neutrals -psorrg(0:nx+1,0:ny+1,1:ngsp) _real [part/s] # cell ave recomb. source for neutrals -psorcxgc(0:nx+1,0:ny+1,1:ngsp) _real [part/s] # cell ctr cx source for neutrals -psorcxg(0:nx+1,0:ny+1,1:ngsp) _real [part/s] # cell ave cx source for neutrals -psori(0:nx+1,0:ny+1,1:nisp) _real [part/s] # impurity gas source -psordis(0:nx+1,0:ny+1) _real [part/s] # diss. source of hydrogen -psorbgg(0:nx+1,0:ny+1,1:ngsp) _real [part/s] # diag artific neut backg source -psorbgz(0:nx+1,0:ny+1) _real [part/s] # diag artific impur backg source -erliz(0:nx+1,0:ny+1) _real [J/s] # H rad'n loss for ioniz'n -erlrc(0:nx+1,0:ny+1) _real [J/s] # H rad'n loss for recom'n -vsoreec(0:nx+1,0:ny+1) _real [J/s] # cell ctr tot elec vol eng source -vsoree(0:nx+1,0:ny+1) _real [J/s] # cell ave tot elec vol eng source -pwrebkg(0:nx+1,0:ny+1) _real [W/m**3] +psorxrc(0:nx+1,0:ny+1,1:nisp) _real [part/s] +threadprivate # cell ctr cx &recomb. for ions (<0) +psorxr(0:nx+1,0:ny+1,1:nisp) _real [part/s] +threadprivate # cell ave cx &recomb. for ions (<0) +psor_tmpov(0:nx+1,0:ny+1) _real [part/s] +threadprivate # work array for psor,etc for ave +psorgc(0:nx+1,0:ny+1,1:ngsp) _real [part/s] +threadprivate # cell ctr ioniz. sor neutral (<0) +psorg(0:nx+1,0:ny+1,1:ngsp) _real [part/s] +threadprivate # cell ave ioniz. sor neutral (<0) +psorrgc(0:nx+1,0:ny+1,1:ngsp) _real [part/s] +threadprivate # cell ctr recomb. source for neutrals +psorrg(0:nx+1,0:ny+1,1:ngsp) _real [part/s] +threadprivate # cell ave recomb. source for neutrals +psorcxgc(0:nx+1,0:ny+1,1:ngsp) _real [part/s] +threadprivate # cell ctr cx source for neutrals +psorcxg(0:nx+1,0:ny+1,1:ngsp) _real [part/s] +threadprivate # cell ave cx source for neutrals +psori(0:nx+1,0:ny+1,1:nisp) _real [part/s] +threadprivate # impurity gas source +psordis(0:nx+1,0:ny+1) _real [part/s] +threadprivate # diss. source of hydrogen +psorbgg(0:nx+1,0:ny+1,1:ngsp) _real [part/s] +threadprivate # diag artific neut backg source +psorbgz(0:nx+1,0:ny+1) _real [part/s] +threadprivate # diag artific impur backg source +erliz(0:nx+1,0:ny+1) _real [J/s] +threadprivate # H rad'n loss for ioniz'n +erlrc(0:nx+1,0:ny+1) _real [J/s] +threadprivate # H rad'n loss for recom'n +vsoreec(0:nx+1,0:ny+1) _real [J/s] +threadprivate # cell ctr tot elec vol eng source +vsoree(0:nx+1,0:ny+1) _real [J/s] +threadprivate # cell ave tot elec vol eng source +pwrebkg(0:nx+1,0:ny+1) _real [W/m**3] +threadprivate # elec energy backgrd source; limits te~tebg -pwribkg(0:nx+1,0:ny+1) _real [W/m**3] +pwribkg(0:nx+1,0:ny+1) _real [W/m**3] +threadprivate # ion energy backgrd source; limits ti~tibg -wjdote(0:nx+1,0:ny+1) _real [J/s] # Joule heating rate -wvh(0:nx+1,0:ny+1,1:nusp) _real [kg/m-s**3] #ion viscous heating -smoc(0:nx+1,0:ny+1,1:nusp) _real -smov(0:nx+1,0:ny+1,1:nusp) _real -msor(0:nx+1,0:ny+1,1:nisp) _real [kg-m/s**2]# ioniz. mom. source for ions -msorxr(0:nx+1,0:ny+1,1:nisp) _real [kg-m/s**2]# cx&recomb. mom. sink for ions -seec(0:nx+1,0:ny+1) _real -seev(0:nx+1,0:ny+1) _real -seic(0:nx+1,0:ny+1) _real -seiv(0:nx+1,0:ny+1) _real -segc(0:nx+1,0:ny+1,1:ngsp) _real [J/(sm**3)]#v_grad_P for neutral eng. eqn -resco(0:nx+1,0:ny+1,1:nisp) _real -resng(0:nx+1,0:ny+1,1:ngsp) _real -reseg(0:nx+1,0:ny+1,1:ngsp) _real -resmo(0:nx+1,0:ny+1,1:nusp) _real -resee(0:nx+1,0:ny+1) _real -resei(0:nx+1,0:ny+1) _real -resphi(0:nx+1,0:ny+1) _real +wjdote(0:nx+1,0:ny+1) _real [J/s] +threadprivate # Joule heating rate +wvh(0:nx+1,0:ny+1,1:nusp) _real [kg/m-s**3] +threadprivate #ion viscous heating +smoc(0:nx+1,0:ny+1,1:nusp) _real +threadprivate +smov(0:nx+1,0:ny+1,1:nusp) _real +threadprivate +msor(0:nx+1,0:ny+1,1:nisp) _real [kg-m/s**2] +threadprivate # ioniz. mom. source for ions +msorxr(0:nx+1,0:ny+1,1:nisp) _real [kg-m/s**2] +threadprivate # cx&recomb. mom. sink for ions +seec(0:nx+1,0:ny+1) _real +threadprivate +seev(0:nx+1,0:ny+1) _real +threadprivate +seic(0:nx+1,0:ny+1) _real +threadprivate +seiv(0:nx+1,0:ny+1) _real +threadprivate +segc(0:nx+1,0:ny+1,1:ngsp) _real [J/(sm**3)] +threadprivate #v_grad_P for neutral eng. eqn +resco(0:nx+1,0:ny+1,1:nisp) _real +threadprivate +resng(0:nx+1,0:ny+1,1:ngsp) _real +threadprivate +reseg(0:nx+1,0:ny+1,1:ngsp) _real +threadprivate +resmo(0:nx+1,0:ny+1,1:nusp) _real +threadprivate +resee(0:nx+1,0:ny+1) _real +threadprivate +resei(0:nx+1,0:ny+1) _real +threadprivate +resphi(0:nx+1,0:ny+1) _real +threadprivate ***** MCN_dim: # array bounds used in connection with Monte Carlo Neutrals @@ -2246,12 +2216,12 @@ cmneutsor_mi real /1/ +mcinput #coeff. for MC neutral momentum source in resmo cmneutsor_ei real /1/ +mcinput #coeff. for MC neutral energy source in resei cmneutsor_ee real /1/ +mcinput #coeff. for MC neutral energy source in resee -cfneutdiv real /1/ +mcinput #coeff. to turn on divergence of all fluid neutral fluxes +cfneutdiv real /1/ +mcinput +threadprivate #coeff. to turn on divergence of all fluid neutral fluxes cfneutdiv_fng real /1/ +mcinput #coeff. for div. fluid neutral particle flux in resng cfneutdiv_fmg real /1/ +mcinput #coeff. for div. fluid neutral momentum flux in resmo cfneutdiv_feg real /1/ +mcinput #coeff. for div. fluid neutral energy flux in resei -cmneutdiv real /0/ +mcinput #coeff. to turn on divergence of all MC neutral fluxes +cmneutdiv real /0/ +mcinput +threadprivate #coeff. to turn on divergence of all MC neutral fluxes cmneutdiv_fng real /1/ +mcinput #coeff. for div. fluid neutral particle flux in resng cmneutdiv_fmg real /1/ +mcinput #coeff. for div. fluid neutral momentum flux in resmo cmneutdiv_feg real /1/ +mcinput #coeff. for div. fluid neutral energy flux in resei @@ -2294,9 +2264,9 @@ tg_ue(0:nx+1,0:ny+1,nfl) _real [J] tg_ue_rsd(0:nx+1,0:ny+1,nfl) _real [#] # neutral gas temperature rsd from Monte-Carlo-Neutrals model -sng_ue(0:nx+1,0:ny+1,1:nfl) _real [part/m**3-s] #neutral particle source density (convective only) -smg_ue(0:nx+1,0:ny+1,1:nfl) _real [N/m**3] #neutral parallel momentum source density -seg_ue(0:nx+1,0:ny+1,1:nfl) _real [W/m**3] #neutral energy source density (convective only) +sng_ue(0:nx+1,0:ny+1,1:nfl) _real [part/m**3-s] +threadprivate #neutral particle source density (convective only) +smg_ue(0:nx+1,0:ny+1,1:nfl) _real [N/m**3] #neutral parallel momentum source density +seg_ue(0:nx+1,0:ny+1,1:nfl) _real [W/m**3] +threadprivate #neutral energy source density (convective only) ### Vectors ### @@ -2388,7 +2358,7 @@ fegy_ue_rsd(0:nx+1,0:ny+1,nfl) _real [#] - + ### Tensors ### @@ -2617,8 +2587,8 @@ bkcmd character*32 /"./readbackground"/ #degas2 readbackground executable bkufile character*32 /"uedata.u"/ #uedge output file for degas2 readbackground #NOTE: the same file(grid) must also be used for readgeometry, as specified in the geufile bkdfile character*32 /"bk_uers.nc"/ #degas2 readbackground output file -degas2outcmd character*32 /"./outputbrowser"/ #degas2 outputbrowser executable -degas2outscript character*32 /"output.input"/ #degas2 outputbrowser input file +degas2outcmd character*32 /"./outputbrowser"/ #degas2 outputbrowser executable +degas2outscript character*32 /"output.input"/ #degas2 outputbrowser input file degas2outsh character*32 /"seddata.sh *.dat"/ #sed script to clean up output files mcnflights(1:nstramx) integer /nstramx*500/ #number of mc pseudo-particle trajectories @@ -2660,10 +2630,10 @@ pnc_opt integer /0/ # specifies choice of plasma-neutral coupling pnc_step integer /0/ # step count for plasma-neutral coupling pnc_maxstep integer /10/ # maximum number of coupled plasma+neutral steps pnc_time real /0/ # time since beginning of coupled run -#pnc_ftol real /1e-4/ # ftol for PNC +#pnc_ftol real /1e-4/ # ftol for PNC dtneut real [s] /1.e20/ # time step for neutrals dtplasma real [s] /1e-6/ # time step for plasma-neutral coupling -dtold real [s] /1.e20/ # old time step +dtold real [s] /1.e20/ +threadprivate # old time step relax_p real /1./ # relaxation parameter for plasma relax_g real /1./ # relaxation parameter for neutral gas @@ -2756,15 +2726,15 @@ del_sni real #maximum absolute change in ion particle source del_smor real #maximum absolute change in radial ion momentum source del_smophi real #maximum absolute change in toroidal ion momentum source del_smoz real #maximum absolute change in vertical ion momentum source -del_sei real #maximum absolute change in ion energy source +del_sei real #maximum absolute change in ion energy source del_see real #maximum absolute change in electron energy source ***** Save_terms: #Arrays to hold unperturbed values of particle-source terms -psorold(1:nisp) _real [part/s] # unpert. ioniz. sources -psorxrold(1:nisp) _real [part/s] # unpert. recom. & cx sources -msorold(1:nisp) _real [kg-m/s**2] # unpert. ioniz. mom. sources -msorxrold(1:nisp) _real [kg-m/s**2] # unpert. recom. & cx mom. sources +psorold(1:nisp) _real [part/s] +threadprivate # unpert. ioniz. sources +psorxrold(1:nisp) _real [part/s] +threadprivate # unpert. recom. & cx sources +msorold(1:nisp) _real [kg-m/s**2] +threadprivate # unpert. ioniz. mom. sources +msorxrold(1:nisp) _real [kg-m/s**2] +threadprivate # unpert. recom. & cx mom. sources ***** Time_dep_nwt: #Old variables and time step for Newton iteration @@ -2828,7 +2798,7 @@ jcsc(neq+1) _integer # Nonzero structure of Jacobian matrix rcsc. # jcsc(j+1) - jcsc(j) = no. of nonzeros # in column j of rcsc. icsc(nnzmx) _integer # Row indices of nonzero entries in rcsc. -yldot_pert(neqmx) _real # Perturbed yldot within Jac_calc (diagnostic) +yldot_pert(neqmx) _real +threadprivate # Perturbed yldot within Jac_calc (diagnostic) yldot_unpt(neqmx) _real # Initial yldot with Jac_calc (diagnostic) @@ -2912,8 +2882,7 @@ iwkd2(ndiagmx) _integer # work array used by cdiagsrt ***** UEint: #Auxiliary variables for Ueinit. -GridFileName character*200 /"gridue"/ +input - # name of Grid file to be read +GridFileName character*200 /"gridue"/ +input # name of Grid file to be read newgeo integer /1/ +setup #flag to calculate new grid (1=yes) mhdgeo integer /-1/ +input #flag for grid geometry #mhdgeo = 2 ==> toroidal circular limiter @@ -2934,15 +2903,13 @@ tscal real /.5/ #ratio of initial Ti & Tg to Te ngscal(ngspmx) real /ngspmx*.1/ #ratio of initial gas density to ion dens xgscal real /1./ #exponential scale of initial gas (m) nibeg(1:nispmx) real /nispmx*2.e19/ #initial ion density -minu(1:nispmx) real /nispmx*2./ +input - #ion mass in units of proton mass (AMU) -ziin(1:nispmx) real /nispmx*1./ +input - #ion charge read in, used to reset zi in +minu(1:nispmx) real /nispmx*2./ +input #ion mass in units of proton mass (AMU) +ziin(1:nispmx) real /nispmx*1./ +input #ion charge read in, used to reset zi in #group Compla which gets erased on gallot znuclin(1:nispmx) integer /nispmx*1./ +input #total nuclear charge of ion (i.d. isotope) isallloc integer /0/ #=1 for local process. allocation with mpi newaph integer /1/ +input #=1 calls aphread for hyd. atomic data;=0 not -newapi integer /1/ +input #=1, call readmc for new imp. data;=0, no +newapi integer /1/ +input #=1, call readmc for new imp. data;=0, no pyrestart_file character*80 /""/ #Python file that can also be used to restart read_diffs integer /0/ +maybeinput #=0,a flag to signal whether to read diffusivities dif_io integer /0/ +maybeinput #=0,a flag to signal whether to read/write dif_use @@ -3120,7 +3087,7 @@ ivloc2sdgl(nvisendl) _integer #maps loc-var to glob-var, single domain ivloc2mdgl(nvisendl) _integer #maps loc-var to glob-var, mult domain ivl2gstnll(neq_locl,9*numvarl) _integer /0/ # 1st arg loc-eqn number; # 2nd arg poss Jac vars-global-mp -ispwrbcl integer /1/ #=1 if domain has cell for core power BC +ispwrbcl integer /1/ +threadprivate #=1 if domain has cell for core power BC ixpt1l integer /0/ #local ixpt1 before par_data gather ixpt2l integer /1/ #local ixpt2 before par_data gather iysptrx1l integer /1/ #local iysptrx1 before par_data gather @@ -3353,6 +3320,8 @@ aplsb(nrow,ncol,a:real,ja,ia,s:real,b:real,\ # out ierr error flag jacmap() subroutine # output Jacobian map to file +jacmm() subroutine + # output Jacobian matrix in IJ format to file map_var_jac1d() subroutine # compute Jacobian stencil ivl2gstnl with 1 where elements jacstnlout() subroutine @@ -3567,14 +3536,14 @@ fit_neteti() subroutine # out ix global poloidal index corresponding to 1D running lindex # out iy global radial index corresponding to 1D running lindex # out surfacename name of bounding surface corresponding to lindex -###set2dat2dpoint(darray:real,ix:integer,iy:integer,val:real) subroutine +###set2dat2dpoint(darray:real,ix:integer,iy:integer,val:real) subroutine # Sets value of 2D array "darray" at global index point ix,iy to value "val". # Assumes that darray is dimensioned (0:nx+1,0:ny+1). # out darray(*,*) global array being set # in ix poloidal index at which darray is set # in iy radial index at which darray is set # in val value to which darray(ix,iy) is set -###set1dat1dpoint(darray:real,lindex:integer,val:real) subroutine +###set1dat1dpoint(darray:real,lindex:integer,val:real) subroutine # Sets value of 1D array "darray" at global index point ix,iy to value "val". # out darray(*) global array being set # in index poloidal index at which darray is set @@ -3590,7 +3559,7 @@ fit_neteti() subroutine # in darray(*,*) global darray being set # in lindex poloidal index at which darray is set ru_active(amumass:integer,znucleus:integer,charge:integer) integer function - # tests if given mass, charge, znucleus ion is active + # tests if given mass, charge, znucleus ion is active # in amumass is particle mass in AMU # in znucleus is the total charge of the atomic nucleus # in charge is particle charge in abs value of fundamental charge @@ -3691,7 +3660,7 @@ mcnblend(out:real,uevar:real,mcvar:real,out_rsd:real,mcrsd:real,alpha:real) subr # interpolation between fluid and MC kinetic results based on rel. std. dev. # out = mcvar*(1-mcrsd)**alpha + uevar*(1-(1-mcrsd)**alpha) -mult23(var2:real,var3:real,n3:integer) function +mult23(var2:real,var3:real,n3:integer) function # component-wise multiplication of 2d*3d variable along x and y directions mult24(var2:real,var4:real,n3:integer,n4:integer) function @@ -3729,29 +3698,29 @@ ismctab integer /1/ +input # =2 tables generated by code from B. Braams, # data file name is specified by mcfilename=..., # corresponding rate evaluation routines are mcrates and radmc. -nzloc(0:nzspmx) _real [/m**3] +nzloc(0:nzspmx) _real [/m**3] +threadprivate # imp. dens. for each Z at one grid cell -impradloc(0:nzspmx) _real [Watts/m**3] +impradloc(0:nzspmx) _real [Watts/m**3] +threadprivate # rad. power loss density for each Z at one grid cell -pwrzec(0:nx+1,0:ny+1) _real [Watts/m**3] +pwrzec(0:nx+1,0:ny+1) _real [Watts/m**3] +threadprivate # elec energy loss via impurities at cell-cntr -pwrze(0:nx+1,0:ny+1) _real [Watts/m**3] +pwrze(0:nx+1,0:ny+1) _real [Watts/m**3] +threadprivate # elec energy loss via impurities; cell-ave -pradc(0:nx+1,0:ny+1) _real [Watts/m**3] +pradc(0:nx+1,0:ny+1) _real [Watts/m**3] +threadprivate # cell ctr total impurity radiation -pradcff(0:nx+1,0:ny+1) _real [Watts/m**3] +pradcff(0:nx+1,0:ny+1) _real [Watts/m**3] +threadprivate # cell ctr impurity radiation (fixed-fraction) -prad(0:nx+1,0:ny+1) _real [Watts/m**3] +prad(0:nx+1,0:ny+1) _real [Watts/m**3] +threadprivate # cell ave total impurity radiation -pradzc(0:nx+1,0:ny+1,0:nzspmx,1:ngsp-1) _real [Watts/m**3] +pradzc(0:nx+1,0:ny+1,0:nzspmx,1:ngsp-1) _real [Watts/m**3] +threadprivate # cell ctr imp rad due to each imp. ch. state -pradz(0:nx+1,0:ny+1,0:nzspmx,1:ngsp-1) _real [Watts/m**3] +pradz(0:nx+1,0:ny+1,0:nzspmx,1:ngsp-1) _real [Watts/m**3] +threadprivate # cell ave imp rad due to each imp. ch. state -na(0:nx+1,0:ny+1) _real [/m**3] +na(0:nx+1,0:ny+1) _real [/m**3] +threadprivate # atomic density of impurity (=afrac*ne) -ntau(0:nx+1,0:ny+1) _real [sec/m**3] +ntau(0:nx+1,0:ny+1) _real [sec/m**3] +threadprivate # confinement parameter for impurity (=atau*ne) -nratio(0:nx+1,0:ny+1) _real +nratio(0:nx+1,0:ny+1) _real +threadprivate # ratio of neutrals to electrons afrac(0:nx+1,0:ny+1) _real /.00/ +maybeinput # atomic impur conc; set internally to afracs @@ -3771,12 +3740,12 @@ misotope integer # number of isotopes (including electrons) nchstate integer # maximum charge state among all isotopes natomic(1:MXMISO) integer # maximum charge state of each isotope amu(1:misotope) _real [none] # atomic mass, relative to proton -tempa(1:misotope) _real [J] # temperature +tempa(1:misotope) _real [J] +threadprivate # temperature qneut(1:misotope) _real [J/m**2-s] # parallel heat flux of neutral uneut(1:misotope) _real [m/s] # parallel flow speed of neutral -den(1:misotope,0:nchstate) _real [1/m**3] # density -gradp(1:misotope,1:nchstate) _real [J/m**4] # parallel pressure grad -gradt(1:misotope,1:nchstate) _real [J/m**4] # parallel temp gradient +den(1:misotope,0:nchstate) _real [1/m**3] +threadprivate # density +gradp(1:misotope,1:nchstate) _real [J/m**4] +threadprivate # parallel pressure grad +gradt(1:misotope,1:nchstate) _real [J/m**4] +threadprivate # parallel temp gradient friction(1:misotope,1:nchstate) _real [J/m**4] # parallel friction force friccomp(1:misotope,1:nchstate,1:5) _real [J/m**4] # par friction components #friccomp(,,1)~ upi-upj @@ -3788,7 +3757,7 @@ nuion(1:misotope,0:nchstate) _real [1/s] # ionization rate nurec(1:misotope,1:nchstate) _real [1/s] # recombination rate qcond(1:misotope,1:nchstate) _real [J/m**2-s] # parallel heat flux ucond(1:misotope,1:nchstate) _real [m/s] # parallel flow speed -dztot(1:misotope) _real [1/m**3] # total local isotope density +dztot(1:misotope) _real [1/m**3] +threadprivate # total local isotope density ***** Bdy_indexlims: # Limits of running index that goes around boundary @@ -3944,7 +3913,7 @@ tendoned real /0.1/ # final time ndtmax integer /10000/ # max number of timesteps allowed ntim integer /50/ # number of output times ito integer /1/ -xcz(1:nxx) _real +xcz(1:nxx) _real xfz(1:nxx) _real vrz(1:nxx) _real drz(1:nxx) _real diff --git a/bbb/exmain.c b/bbb/exmain.c index 6828f483..984f3028 100755 --- a/bbb/exmain.c +++ b/bbb/exmain.c @@ -27,7 +27,7 @@ static struct sigaction act,oact; static sigjmp_buf ev; -/* +/* Handler for SIGINT signal */ void int_handler() { @@ -36,59 +36,57 @@ void int_handler() { printf("\nType \"cont\" to continue exmain(), \"abort\" (not compatible with openmp) or \"stop\" (with openmp) to return to Python prompt \n"); printf("or a single line to be evaluated by Python.\n"); #pragma omp master - { -int condition; -condition=1; - while(1){ + { + /* int condition=1; */ + while(1){ #ifdef HAS_READLINE - ret = readline("Debug>>> "); - if(ret == (char *)NULL)return; - add_history(ret); - strncpy(mymyline,ret,sizeof(mymyline)-1); - free(ret); + ret = readline("Debug>>> "); + if(ret == (char *)NULL) break; + add_history(ret); + strncpy(mymyline,ret,sizeof(mymyline)-1); + free(ret); #else - printf("Debug>>> "); - ret = fgets(mymyline,150,stdin); - if(ret == (char *)NULL)return; + printf("Debug>>> "); + ret = fgets(mymyline,150,stdin); + if(ret == (char *)NULL)break; #endif - if(strncmp(mymyline,"cont",4) == 0){ - return; - } else if (strncmp(mymyline,"abort",5) == 0) { - PyRun_SimpleString("bbb.exmain_aborted = True"); - siglongjmp(ev,1); - } else if (strncmp(mymyline,"stop",4) == 0) { - PyRun_SimpleString("print(\"Stopping exmain ... Please wait...\")"); - PyRun_SimpleString("bbb.exmain_aborted = True"); - return; - } else if (strncmp(mymyline,"exit",4) == 0) { - PyRun_SimpleString("bbb.exmain_aborted = True"); - siglongjmp(ev,1); - } else { - PyRun_SimpleString(mymyline); - /* matplotlib seems to unset the hander - so it is set again just in case */ - sigfillset(&block_mask); - act.sa_handler = int_handler; - act.sa_mask = block_mask; - act.sa_flags = 0; - sigaction(SIGINT,&act,NULL); - } + if(strncmp(mymyline,"cont",4) == 0){ + break; + } else if (strncmp(mymyline,"abort",5) == 0) { + PyRun_SimpleString("bbb.exmain_aborted = True"); + siglongjmp(ev,1); + } else if (strncmp(mymyline,"stop",4) == 0) { + PyRun_SimpleString("print(\"Stopping exmain ... Please wait...\")"); + PyRun_SimpleString("bbb.exmain_aborted = True"); + break; + } else if (strncmp(mymyline,"exit",4) == 0) { + PyRun_SimpleString("bbb.exmain_aborted = True"); + siglongjmp(ev,1); + } else { + PyRun_SimpleString(mymyline); + /* matplotlib seems to unset the hander + so it is set again just in case */ + sigfillset(&block_mask); + act.sa_handler = int_handler; + act.sa_mask = block_mask; + act.sa_flags = 0; + sigaction(SIGINT,&act,NULL); + } + } } - -} } #endif -/* FORTHON is defined by the Python build. This exmain does nothing when +/* FORTHON is defined by the Python build. This exmain does nothing when compiled for the basis version of the code, it just drops through to the Fortran routine. */ #if defined(FC_FUNC) -void FC_FUNC(exmain_f, EXMAIN_F)(void); +void FC_FUNC(exmain_f, EXMAIN_F)(void); #else -void exmain_f_(void); +void exmain_f_(void); #endif #if defined(FC_FUNC) @@ -99,40 +97,40 @@ void exmain_() { #ifdef FORTHON sigset_t block_mask; int ival; + int err = 0; #pragma omp master -{ - ival = sigsetjmp(ev,1); - if(ival != 0){ - sigaction(SIGINT,&oact,NULL); - return; - } + { + ival = sigsetjmp(ev,1); + if(ival != 0) { + sigaction(SIGINT,&oact,NULL); + err = 1; + } } - + + if (err) { return; } /* setup to catch SIGINT and save the previous handler to be restored on return */ #pragma omp master -{ - sigfillset(&block_mask); - act.sa_handler = int_handler; - act.sa_mask = block_mask; - act.sa_flags = 0; - sigaction(SIGINT,&act,&oact); - - PyRun_SimpleString("from uedge import bbb"); - PyRun_SimpleString("bbb.exmain_aborted = False"); + { + sigfillset(&block_mask); + act.sa_handler = int_handler; + act.sa_mask = block_mask; + act.sa_flags = 0; + sigaction(SIGINT,&act,&oact); + + PyRun_SimpleString("from uedge import bbb"); + PyRun_SimpleString("bbb.exmain_aborted = False"); } - #endif - /* now call the Fortran version of exmain */ #if defined(FC_FUNC) FC_FUNC(exmain_f, EXMAIN_F)(); #else - exmain_f_(); + exmain_f_(); #endif #ifdef FORTHON sigaction(SIGINT,&oact,NULL); diff --git a/bbb/jaccalc.c b/bbb/jaccalc.c new file mode 100644 index 00000000..d2ae2d82 --- /dev/null +++ b/bbb/jaccalc.c @@ -0,0 +1,392 @@ +#include +#include +#include +#include +#include +#include +#if defined(UEDGE_WITH_OMP) +#include +#endif +typedef long Int; +typedef double real; + +#define DO_TIMING 1 +#define PRINT_LEVEL 1 +#define uedge_min(a,b) (((a)<(b)) ? (a) : (b)) + +/* Fortran protos */ +extern void jac_calc_iv_(Int *iv, Int *neq, real *t, real* yl, real *yldot00, Int *ml, Int *mu, + real *wk, Int *nnzmx, real *jac, Int *ja, Int *ia, real *yldot_pert, Int *nnz); + +int +jac_calc_seq_c_(Int *neq, + real *t, + real *yl, + real *yldot00, + Int *ml, + Int *mu, + real *wk, + Int *nnzmx, + real *jac, + Int *ja, + Int *ia, + real *yldot_pert, + Int *nnz) +{ + if (PRINT_LEVEL > 0) + { + printf(" =============================================\n" + " Jac_calc C SEQ version \n" + " ** n = %ld, nnzmx = %ld ** \n" + " =============================================\n", + *neq, *nnzmx); + } + + Int iv; + + *nnz = 1; + for (iv = 1; iv <= *neq; iv++) + { + jac_calc_iv_(&iv, neq, t, yl, yldot00, ml, mu, wk, nnzmx, jac, ja, ia, yldot_pert, nnz); + } + ia[*neq] = *nnz; + + return 0; +} + +#if defined(UEDGE_WITH_OMP) + +#define USE_OMP_VERSION 1 +#define SEQ_CHECK 0 + +typedef struct +{ + Int num_threads; + Int neq; + Int nnzmx; + Int nnzmx_t; + real nnzmx_f; + real *yl; + real *yldot00; + real *wk; + real *jac; + Int *ja; + real *yldot_pert; +} jac_calc_omp_data; + +jac_calc_omp_data *jcod = NULL; + +extern void omp_copy_module_(void); + +/* partition range [0, 1, ..., n) */ +void +jac_calc_1dpartition(Int num_threads, + Int thread_id, + Int *begin, + Int *end, + Int n) +{ + Int n_per_thread = (n + num_threads - 1) / num_threads; + *begin = uedge_min(n_per_thread * thread_id, n); + *end = uedge_min(*begin + n_per_thread, n); +} + +jac_calc_omp_data * +jac_calc_omp_data_create(void) +{ + jac_calc_omp_data *data = (jac_calc_omp_data *) calloc(1, sizeof(jac_calc_omp_data)); + + return data; +} + +/* allocate private memory for threads */ +int +jac_calc_omp_data_init(Int num_threads, + Int neq, + Int nnzmx, + real nnzmx_f, + jac_calc_omp_data *data) +{ + if (num_threads == data -> num_threads && + neq == data -> neq && + nnzmx == data -> nnzmx && + nnzmx_f == data -> nnzmx_f) + { + return 0; + } + + const Int nnzmx_0 = (nnzmx + num_threads - 1) / num_threads; + const Int nnzmx_t = (Int) (nnzmx * nnzmx_f + nnzmx_0 * (1.0 - nnzmx_f)); + + data -> num_threads = num_threads; + data -> neq = neq; + data -> nnzmx = nnzmx; + data -> nnzmx_t = nnzmx_t; + data -> nnzmx_f = nnzmx_f; + + Int nt = num_threads - 1; + + data -> yl = (real *) realloc(data -> yl, nt * (neq + 2) * sizeof(real)); + data -> yldot00 = (real *) realloc(data -> yldot00, nt * (neq + 2) * sizeof(real)); + data -> wk = (real *) realloc(data -> wk, nt * neq * sizeof(real)); + data -> jac = (real *) realloc(data -> jac, nt * nnzmx_t * sizeof(real)); + data -> ja = (Int *) realloc(data -> ja, nt * nnzmx_t * sizeof(Int)); + data -> yldot_pert = (real *) realloc(data -> yldot_pert, nt * neq * sizeof(real)); + + return 0; +} + +int +jac_calc_omp_data_destroy(jac_calc_omp_data *data) +{ + if (!data) + { + return 0; + } + + free(data -> yl); + free(data -> yldot00); + free(data -> wk); + free(data -> jac); + free(data -> ja); + free(data -> yldot_pert); + + return 0; +} + +int +jac_calc_omp_get_thread_data(Int thread_id, + real *yl, + real *yldot00, + real *wk, + real *jac, + Int *ja, + real *yldot_pert, + jac_calc_omp_data *data, + jac_calc_omp_data *thread_data) +{ + thread_data -> num_threads = data -> num_threads; + thread_data -> neq = data -> neq; + thread_data -> nnzmx = data -> nnzmx; + thread_data -> nnzmx_t = data -> nnzmx_t; + + if (thread_id) + { + Int j, tid = thread_id - 1; + thread_data -> yl = data -> yl + tid * (data -> neq + 2); + thread_data -> yldot00 = data -> yldot00 + tid * (data -> neq + 2); + thread_data -> wk = data -> wk + tid * (data -> neq); + thread_data -> jac = data -> jac + tid * (data -> nnzmx_t); + thread_data -> ja = data -> ja + tid * (data -> nnzmx_t); + thread_data -> yldot_pert = data -> yldot_pert + tid * (data -> neq); + + for (j = 0; j < data -> neq + 2; j++) + { + thread_data -> yl[j] = yl[j]; + thread_data -> yldot00[j] = yldot00[j]; + } + } + else + { + thread_data -> yl = yl; + thread_data -> yldot00 = yldot00; + thread_data -> wk = wk; + thread_data -> jac = jac; + thread_data -> ja = ja; + thread_data -> yldot_pert = yldot_pert; + } + + return 0; +} + +int +jac_calc_omp_init(void) +{ + omp_set_dynamic(0); + omp_copy_module_(); + + return 0; +} + +int +jac_calc_omp_c_(Int *neq, + real *t, + real *yl, + real *yldot00, + Int *ml, + Int *mu, + real *wk, + Int *nnzmx, + real nnzmx_f, + real *jac, + Int *ja, + Int *ia, + real *yldot_pert, + Int *nnz) +{ + Int num_threads = omp_get_max_threads(); + + if (PRINT_LEVEL > 0) + { + printf(" =============================================\n" + " Jac_calc OpenMP C version, Num. Threads = %ld\n" + " ** n = %ld, nnzmx = %ld, nnzmx_f = %.2f ** \n" +#if SEQ_CHECK + " ** Check with serial version is ON ** \n" +#endif + " =============================================\n", + num_threads, *neq, *nnzmx, nnzmx_f); + } + +#if SEQ_CHECK + Int nnz_s = 0; + Int *ia_s = (Int *) calloc(*neq + 1, sizeof(Int)); + Int *ja_s = (Int *) calloc(*nnzmx, sizeof(Int)); + real *jac_s = (real *) calloc(*nnzmx, sizeof(real)); + jac_calc_seq_c_(neq, t, yl, yldot00, ml, mu, wk, nnzmx, jac_s, ja_s, ia_s, yldot_pert, &nnz_s); +#endif + + /* copy global variables in Fortran modules into thread privates*/ + jac_calc_omp_init(); + + if (!jcod) + { + jcod = jac_calc_omp_data_create(); + } + jac_calc_omp_data_init(num_threads, *neq, *nnzmx, nnzmx_f, jcod); + + Int *neq_all = (Int *) malloc((num_threads + 1) * sizeof(Int)); + Int *nnz_all = (Int *) malloc((num_threads + 1) * sizeof(Int)); + + #pragma omp parallel + { + Int iv, iv_start, iv_end, thread_id = omp_get_thread_num(); + Int ml_t = *ml, mu_t = *mu, nnz_t = 1; + real t_t = *t; + jac_calc_omp_data jcod_t; + + jac_calc_omp_get_thread_data(thread_id, yl, yldot00, wk, jac, ja, yldot_pert, jcod, &jcod_t); + jac_calc_1dpartition(num_threads, thread_id, &iv_start, &iv_end, *neq); + + for (iv = iv_start + 1; iv <= iv_end; iv++) + { + jac_calc_iv_(&iv, &jcod_t.neq, &t_t, jcod_t.yl, jcod_t.yldot00, &ml_t, &mu_t, jcod_t.wk, + &jcod_t.nnzmx_t, jcod_t.jac, jcod_t.ja, ia, jcod_t.yldot_pert, &nnz_t); + } + + if (PRINT_LEVEL > 1) + { + printf("thread %ld: [%ld, %ld], nnz %ld\n", thread_id, iv_start+1, iv_end, nnz_t); + } + + neq_all[thread_id + 1] = iv_end - iv_start; + nnz_all[thread_id + 1] = nnz_t - 1; + + #pragma omp barrier + #pragma omp master + { + neq_all[0] = nnz_all[0] = 0; + for (iv = 1; iv < num_threads; iv ++) + { + neq_all[iv + 1] += neq_all[iv]; + nnz_all[iv + 1] += nnz_all[iv]; + } + assert(neq_all[num_threads] == *neq); + } + #pragma omp barrier + + if (thread_id) + { + for (iv = neq_all[thread_id]; iv < neq_all[thread_id + 1]; iv ++) + { + ia[iv] = ia[iv] + nnz_all[thread_id]; + } + + for (iv = nnz_all[thread_id]; iv < nnz_all[thread_id + 1]; iv ++) + { + ja[iv] = jcod_t.ja[iv - nnz_all[thread_id]]; + jac[iv] = jcod_t.jac[iv - nnz_all[thread_id]]; + } + } + else + { + ia[*neq] = *nnz = nnz_all[num_threads] + 1; + } + } /* #pragma omp parallel */ + +#if SEQ_CHECK + Int i; + if (nnz_s != *nnz) { printf("SEQ_CHECK: nnz error %ld %ld\n", nnz_s, *nnz); exit(0); } + for (i = 0; i <= *neq; i++) { if (ia_s[i] != ia[i]) { printf("SEQ_CHECK: ia error, i %ld, %ld %ld\n", i, ia_s[i], ia[i]); exit(0); } } + for (i = 0; i <= *nnz; i++) { if (ja_s[i] != ja[i]) { printf("SEQ_CHECK: ja error, \n"); exit(0); } } + for (i = 0; i <= *nnz; i++) { if (jac_s[i] != jac[i]) { printf("SEQ_CHECK: jac error, i = %ld: %e %e\n", i, jac_s[i], jac[i]); exit(0);} } + printf(" SEQ_CHECK: OK...\n"); + free(ia_s); + free(ja_s); + free(jac_s); +#endif + + free(neq_all); + free(nnz_all); + + jac_calc_omp_data_destroy(jcod); free(jcod); jcod = NULL; + + return 0; +} +#endif + +int +jac_calc_c_(Int *neq, + real *t, + real *yl, + real *yldot00, + Int *ml, + Int *mu, + real *wk, + Int *nnzmx, + real *nnzmx_f, + real *jac, + Int *ja, + Int *ia, + real *yldot_pert, + Int *nnz) +{ +#if DO_TIMING + struct timeval t1, t2; + gettimeofday(&t1, NULL); +#endif + +#if USE_OMP_VERSION + int ret = jac_calc_omp_c_(neq, t, yl, yldot00, ml, mu, wk, nnzmx, *nnzmx_f, jac, ja, ia, yldot_pert, nnz); +#else + int ret = jac_calc_seq_c_(neq, t, yl, yldot00, ml, mu, wk, nnzmx, jac, ja, ia, yldot_pert, nnz); +#endif + +#if DO_TIMING + gettimeofday(&t2, NULL); + double elapsedTime = (t2.tv_sec - t1.tv_sec); + elapsedTime += (t2.tv_usec - t1.tv_usec) / 1e6; + printf(" @@Time jac_calc_c@@ %e s\n", elapsedTime); +#endif + + return ret; +} + +int jacmm_c_(Int *neq, real *jac, Int *ja, Int *ia) +{ + Int i, j; + FILE *fp = fopen("Jacobian.IJ", "w"); + + fprintf(fp, "%% %ld %ld %ld\n", *neq, *neq, ia[*neq] - 1); + + for (i = 0; i < *neq; i++) + { + for (j = ia[i]; j < ia[i + 1]; j++) + { + fprintf(fp, "%ld %ld %.15e\n", i + 1, ja[j - 1], jac[j - 1]); + } + } + fclose(fp); + + return 0; +} diff --git a/bbb/oderhs.m b/bbb/oderhs.m index 9e7ec16d..315440c6 100755 --- a/bbb/oderhs.m +++ b/bbb/oderhs.m @@ -10,7 +10,7 @@ subroutine fd2tra (nx, ny, flox, floy, difx, dify, phi, *//documentation// * * -* 1. purpose +* 1. purpose * * FD2TRA computes the two-dimensional field of flow of some * quantity that is transported by convection and conduction. @@ -19,7 +19,7 @@ subroutine fd2tra (nx, ny, flox, floy, difx, dify, phi, * 2. specification * * subroutine fd2tra (nx, ny, flox, floy, difx, dify, phi, -* . trax, tray, pos, meth) +* . trax, tray, pos, meth) * * integer nx, ny, pos, meth * (0:*) 'real' flox, floy, difx, dify, phi, trax, tray @@ -335,12 +335,12 @@ call xerrab('** methy(isnonog=1) has improper value in fd2tra **') 201 continue do 203 iy = j1, j5-posy do 202 ix = i4, i8 - py0 = fxm (ix,iy,0)*phi(ixm1(ix,iy) ,iy ) + + py0 = fxm (ix,iy,0)*phi(ixm1(ix,iy) ,iy ) + . fx0 (ix,iy,0)*phi(ix ,iy ) + . fxp (ix,iy,0)*phi(ixp1(ix,iy) ,iy ) + . fxmy(ix,iy,0)*phi(ixm1(ix,iy+1),iy+1) + . fxpy(ix,iy,0)*phi(ixp1(ix,iy+1),iy+1) - py1 = fxm (ix,iy,1)*phi(ixm1(ix,iy+1),iy+1) + + py1 = fxm (ix,iy,1)*phi(ixm1(ix,iy+1),iy+1) + . fx0 (ix,iy,1)*phi(ix ,iy+1) + . fxp (ix,iy,1)*phi(ixp1(ix,iy+1),iy+1) + . fxmy(ix,iy,1)*phi(ixm1(ix,iy) ,iy ) + @@ -356,12 +356,12 @@ call xerrab('** methy(isnonog=1) has improper value in fd2tra **') 210 continue do 214 iy = j1, j5-posy do 212 ix = i4, i8 - py0 = fxm (ix,iy,0)*phi(ixm1(ix,iy) ,iy ) + + py0 = fxm (ix,iy,0)*phi(ixm1(ix,iy) ,iy ) + . fx0 (ix,iy,0)*phi(ix ,iy ) + . fxp (ix,iy,0)*phi(ixp1(ix,iy) ,iy ) + . fxmy(ix,iy,0)*phi(ixm1(ix,iy+1),iy+1) + . fxpy(ix,iy,0)*phi(ixp1(ix,iy+1),iy+1) - py1 = fxm (ix,iy,1)*phi(ixm1(ix,iy+1),iy+1) + + py1 = fxm (ix,iy,1)*phi(ixm1(ix,iy+1),iy+1) + . fx0 (ix,iy,1)*phi(ix ,iy+1) + . fxp (ix,iy,1)*phi(ixp1(ix,iy+1),iy+1) + . fxmy(ix,iy,1)*phi(ixm1(ix,iy) ,iy ) + @@ -373,16 +373,16 @@ call xerrab('** methy(isnonog=1) has improper value in fd2tra **') * --------------------------------------------------------------------- * -- /meth/ = 2 -- -* Regular central differencing. +* Regular central differencing. 220 continue do 223 iy = j1, j5-posy do 222 ix = i4, i8 - py0 = fxm (ix,iy,0)*phi(ixm1(ix,iy) ,iy ) + + py0 = fxm (ix,iy,0)*phi(ixm1(ix,iy) ,iy ) + . fx0 (ix,iy,0)*phi(ix ,iy ) + . fxp (ix,iy,0)*phi(ixp1(ix,iy) ,iy ) + . fxmy(ix,iy,0)*phi(ixm1(ix,iy+1),iy+1) + . fxpy(ix,iy,0)*phi(ixp1(ix,iy+1),iy+1) - py1 = fxm (ix,iy,1)*phi(ixm1(ix,iy+1),iy+1) + + py1 = fxm (ix,iy,1)*phi(ixm1(ix,iy+1),iy+1) + . fx0 (ix,iy,1)*phi(ix ,iy+1) + . fxp (ix,iy,1)*phi(ixp1(ix,iy+1),iy+1) + . fxmy(ix,iy,1)*phi(ixm1(ix,iy) ,iy ) + @@ -399,12 +399,12 @@ call xerrab('** methy(isnonog=1) has improper value in fd2tra **') 230 continue do 233 iy = j1, j5-posy do 232 ix = i4, i8 - py0 = fxm (ix,iy,0)*phi(ixm1(ix,iy) ,iy ) + + py0 = fxm (ix,iy,0)*phi(ixm1(ix,iy) ,iy ) + . fx0 (ix,iy,0)*phi(ix ,iy ) + . fxp (ix,iy,0)*phi(ixp1(ix,iy) ,iy ) + . fxmy(ix,iy,0)*phi(ixm1(ix,iy+1),iy+1) + . fxpy(ix,iy,0)*phi(ixp1(ix,iy+1),iy+1) - py1 = fxm (ix,iy,1)*phi(ixm1(ix,iy+1),iy+1) + + py1 = fxm (ix,iy,1)*phi(ixm1(ix,iy+1),iy+1) + . fx0 (ix,iy,1)*phi(ix ,iy+1) + . fxp (ix,iy,1)*phi(ixp1(ix,iy+1),iy+1) + . fxmy(ix,iy,1)*phi(ixm1(ix,iy) ,iy ) + @@ -421,12 +421,12 @@ call xerrab('** methy(isnonog=1) has improper value in fd2tra **') 240 continue do 243 iy = j1, j5-posy do 242 ix = i4, i8 - py0 = fxm (ix,iy,0)*phi(ixm1(ix,iy) ,iy ) + + py0 = fxm (ix,iy,0)*phi(ixm1(ix,iy) ,iy ) + . fx0 (ix,iy,0)*phi(ix ,iy ) + . fxp (ix,iy,0)*phi(ixp1(ix,iy) ,iy ) + . fxmy(ix,iy,0)*phi(ixm1(ix,iy+1),iy+1) + . fxpy(ix,iy,0)*phi(ixp1(ix,iy+1),iy+1) - py1 = fxm (ix,iy,1)*phi(ixm1(ix,iy+1),iy+1) + + py1 = fxm (ix,iy,1)*phi(ixm1(ix,iy+1),iy+1) + . fx0 (ix,iy,1)*phi(ix ,iy+1) + . fxp (ix,iy,1)*phi(ixp1(ix,iy+1),iy+1) + . fxmy(ix,iy,1)*phi(ixm1(ix,iy) ,iy ) + @@ -444,12 +444,12 @@ call xerrab('** methy(isnonog=1) has improper value in fd2tra **') 250 continue do 253 iy = j1, j5-posy do 252 ix = i4, i8 - py0 = fxm (ix,iy,0)*phi(ixm1(ix,iy) ,iy ) + + py0 = fxm (ix,iy,0)*phi(ixm1(ix,iy) ,iy ) + . fx0 (ix,iy,0)*phi(ix ,iy ) + . fxp (ix,iy,0)*phi(ixp1(ix,iy) ,iy ) + . fxmy(ix,iy,0)*phi(ixm1(ix,iy+1),iy+1) + . fxpy(ix,iy,0)*phi(ixp1(ix,iy+1),iy+1) - py1 = fxm (ix,iy,1)*phi(ixm1(ix,iy+1),iy+1) + + py1 = fxm (ix,iy,1)*phi(ixm1(ix,iy+1),iy+1) + . fx0 (ix,iy,1)*phi(ix ,iy+1) + . fxp (ix,iy,1)*phi(ixp1(ix,iy+1),iy+1) + . fxmy(ix,iy,1)*phi(ixm1(ix,iy) ,iy ) + @@ -468,16 +468,16 @@ call xerrab('** methy(isnonog=1) has improper value in fd2tra **') 260 continue do 263 iy = j1, j5-posy do 262 ix = i4, i8 - py0 = exp( fxm (ix,iy,0)*log(phi(ixm1(ix,iy) ,iy )) + + py0 = exp( fxm (ix,iy,0)*log(phi(ixm1(ix,iy) ,iy )) + . fx0 (ix,iy,0)*log(phi(ix ,iy )) + . fxp (ix,iy,0)*log(phi(ixp1(ix,iy) ,iy )) + . fxmy(ix,iy,0)*log(phi(ixm1(ix,iy+1),iy+1)) + - . fxpy(ix,iy,0)*log(phi(ixp1(ix,iy+1),iy+1)) ) - py1 = exp( fxm (ix,iy,1)*log(phi(ixm1(ix,iy+1),iy+1)) + + . fxpy(ix,iy,0)*log(phi(ixp1(ix,iy+1),iy+1)) ) + py1 = exp( fxm (ix,iy,1)*log(phi(ixm1(ix,iy+1),iy+1)) + . fx0 (ix,iy,1)*log(phi(ix ,iy+1)) + . fxp (ix,iy,1)*log(phi(ixp1(ix,iy+1),iy+1)) + . fxmy(ix,iy,1)*log(phi(ixm1(ix,iy) ,iy )) + - . fxpy(ix,iy,1)*log(phi(ixp1(ix,iy) ,iy )) ) + . fxpy(ix,iy,1)*log(phi(ixp1(ix,iy) ,iy )) ) tray(ix,iy+posy) = upwind(floy(ix,iy+posy), py0, py1) - . dify(ix,iy+posy)*(py1-py0) 262 continue @@ -490,12 +490,12 @@ call xerrab('** methy(isnonog=1) has improper value in fd2tra **') 270 continue do 273 iy = j1, j5-posy do 272 ix = i4, i8 - py0 = 1/( fxm (ix,iy,0)/phi(ixm1(ix,iy) ,iy ) + + py0 = 1/( fxm (ix,iy,0)/phi(ixm1(ix,iy) ,iy ) + . fx0 (ix,iy,0)/phi(ix ,iy ) + . fxp (ix,iy,0)/phi(ixp1(ix,iy) ,iy ) + . fxmy(ix,iy,0)/phi(ixm1(ix,iy+1),iy+1) + . fxpy(ix,iy,0)/phi(ixp1(ix,iy+1),iy+1) ) - py1 = 1/( fxm (ix,iy,1)/phi(ixm1(ix,iy+1),iy+1) + + py1 = 1/( fxm (ix,iy,1)/phi(ixm1(ix,iy+1),iy+1) + . fx0 (ix,iy,1)/phi(ix ,iy+1) + . fxp (ix,iy,1)/phi(ixp1(ix,iy+1),iy+1) + . fxmy(ix,iy,1)/phi(ixm1(ix,iy) ,iy ) + @@ -514,13 +514,13 @@ call xerrab('** methy(isnonog=1) has improper value in fd2tra **') do 282 ix = i4, i8 ix1=ixp1(ix,iy) py0= ( - . fxmv (ix,iy,0)*phi(ixm1(ix,iy) ,iy )+ + . fxmv (ix,iy,0)*phi(ixm1(ix,iy) ,iy )+ . fx0v (ix,iy,0)*phi(ix ,iy )+ . fxpv (ix,iy,0)*phi(ixp1(ix,iy) ,iy )+ . fxmyv(ix,iy,0)*phi(ixm1(ix,iy+1),iy+1)+ . fxpyv(ix,iy,0)*phi(ixp1(ix,iy+1),iy+1) ) py1= ( - . fxmv (ix,iy,1)*phi(ixm1(ix,iy+1),iy+1)+ + . fxmv (ix,iy,1)*phi(ixm1(ix,iy+1),iy+1)+ . fx0v (ix,iy,1)*phi(ix ,iy+1)+ . fxpv (ix,iy,1)*phi(ixp1(ix,iy+1),iy+1)+ . fxmyv(ix,iy,1)*phi(ixm1(ix,iy) ,iy )+ @@ -541,9 +541,9 @@ subroutine pandf (xc, yc, neq, time, yl, yldot) c Definitions for argument list c c Input variables: -c xc is poloidal index of perturbed variablefor Jacobian calc, +c xc is poloidal index of perturbed variablefor Jacobian calc, c or =-1 for full RHS evaluation -c yc is radial index for perturbed variable for Jacobian calc, +c yc is radial index for perturbed variable for Jacobian calc, c or =-1 for full RHS evaluation c neq is the total number of variables c time is the present physical time; useable by VODPK but not NKSOL @@ -554,7 +554,7 @@ subroutine pandf (xc, yc, neq, time, yl, yldot) implicit none * -- input arguments - integer xc, yc, neq + integer xc, yc, neq real time, yl(*),yldot(*) * -- set local array dimension @@ -564,15 +564,15 @@ subroutine pandf (xc, yc, neq, time, yl, yldot) * -- slocal variables integer ifld, jfld, zn, k, k1, k2, jx, ixt, ixt1, ixr, ixr1, iixt, . ixt0 - real fxet, fxit, qr, vt0, vt1, vtn, vtn2, pradold, eeliold, + real fxet, fxit, qr, vt0, vt1, vtn, vtn2, pradold, eeliold, . erlizold, erlrcold, psorrgold(nigmx), psorcxgold(nigmx), . nuizold(nigmx), nucxold(nigmx), nurcold(nigmx), nuixold(nigmx), . psorgold(nigmx), tsfe, tsjf, niavex, niavey, teave, tiave, tgavex, - . zeffave, noavex, noavey, tiavey, tgavey, psordisold, + . zeffave, noavex, noavey, tiavey, tgavey, psordisold, . nucxiold(nigmx), nueliold(nigmx), nuelgold(nigmx), rrfac, visxtmp, . vttn, vttp, neavex, pwrebkgold, pwribkgold, feexflr, feixflr, . naavex,naavey,nuelmolx,nuelmoly,fniycboave - real fqpo, fqpom, friceo, friceom, upeo, upeom, fricio(100), + real fqpo, fqpom, friceo, friceom, upeo, upeom, fricio(100), . friciom(100), upio(100), upiom(100), uupo(100), uupom(100) real nevol, ngvol, kionz, krecz, kcxrz, kionm, krecm, kcxrm, nzbg, . niz_floor, hflux, zflux, psorv, kionz0, pscx0, pxri, kcxrzig, @@ -641,7 +641,7 @@ subroutine pandf (xc, yc, neq, time, yl, yldot) Use(Conduc) # lmfplim Use(Rhsides) Use(Save_terms) # psorold,psorxrold - Use(Indexes) + Use(Indexes) Use(Ynorm) # isflxvar,nnorm,ennorm,fnorm,n0,n0g Use(Poten) # bcee,bcei,cthe,cthi Use(Comtra) # parvis,travis,difni,difnit,difpr,difni2, @@ -675,7 +675,7 @@ subroutine pandf (xc, yc, neq, time, yl, yldot) Use(Indices_domain_dcg) # ndomain Use(Npes_mpi) # mype Use(RZ_grid_info) # bpol - Use(Interp) # ngs, tgs + Use(Interp) # ngs, tgs Use(ParallelEval) # ParallelJac,ParallelPandf1 Use(PandfTiming) @@ -689,7 +689,7 @@ subroutine pandf (xc, yc, neq, time, yl, yldot) external radmc, svdiss real tick,tock external tick,tock - + ccc save * -- procedures -- @@ -742,7 +742,7 @@ call xerrab('Only ismcnon=0 is validated with openmp. c Set switches for neutrals-related source terms in plasma equations c (MER 1996/10/28) -c (IJ 2015/04/06) add ismcnon>=3 for external call to run_neutrals +c (IJ 2015/04/06) add ismcnon>=3 for external call to run_neutrals if (ismcnon .eq. 1) then # use MC sources only: if (svrpkg .eq. "cvode") then call xerrab('*** ismcnon=1 not allowed for cvode ***') @@ -781,33 +781,33 @@ call xerrab('*** PANDF: ismcnon=2 & yl(neq+1)=0 ???') if (yl(neq+1) .gt. 0) then # use fluid model for preconditioner if (extneutmeth .eq. 1) then #fluid source & implicit MC flux cfneut=1. #turn on fluid sources - cfneutdiv=0. #turn off fluid div fluxes + cfneutdiv=0. #turn off fluid div fluxes cmneut=0. #turn off MC sources - cmneutdiv=1. #turn on MC div fluxes + cmneutdiv=1. #turn on MC div fluxes if (isupgon(1) .eq. 1) then cfvgpx(iigsp)=1. cfvgpy(iigsp)=1. cfvcsx(iigsp)=1. cfvcsy(iigsp)=1. - endif + endif else #fluid source & fluid flux cfneut=1. #turn on fluid sources - cfneutdiv=1. #turn on fluid div fluxes + cfneutdiv=1. #turn on fluid div fluxes cmneut=0. #turn off MC sources - cmneutdiv=0. #turn off MC div fluxes + cmneutdiv=0. #turn off MC div fluxes if (isupgon(1) .eq. 1) then cfvgpx(iigsp)=1. cfvgpy(iigsp)=1. cfvcsx(iigsp)=1. cfvcsy(iigsp)=1. endif - endif + endif elseif (yl(neq+1) .lt. 0) then # use MC model for RHS evaluation if (extneutmeth .eq. 1) then #fluid source & implicit MC flux cfneut=1. #turn on fluid sources - cfneutdiv=0. #turn off fluid div fluxes + cfneutdiv=0. #turn off fluid div fluxes cmneut=0. #turn off MC sources - cmneutdiv=1. #turn on MC div fluxes + cmneutdiv=1. #turn on MC div fluxes if (isupgon(1) .eq. 1) then cfvgpx(iigsp)=1. cfvgpy(iigsp)=1. @@ -816,16 +816,16 @@ call xerrab('*** PANDF: ismcnon=2 & yl(neq+1)=0 ???') endif else #MC source & fluid flux cfneut=0. #turn off fluid sources - cfneutdiv=1. #turn on fluid div fluxes + cfneutdiv=1. #turn on fluid div fluxes cmneut=1. #turn on MC sources - cmneutdiv=0. #turn off MC div fluxes + cmneutdiv=0. #turn off MC div fluxes if (isupgon(1) .eq. 1) then cfvgpx(iigsp)=0. cfvgpy(iigsp)=0. cfvcsx(iigsp)=0. cfvcsy(iigsp)=0. endif - endif + endif else call xerrab('*** PANDF: ismcnon=3 & yl(neq+1)=0 ???') @@ -865,8 +865,8 @@ c write(*,*) parvis tsjf = gettime(sec4) endif - if ( (xc .lt. 0) .or. - . ((0<=yc).and.(yc-yinc<=0)).and.isjaccorall==1 ) then + if ( (xc .lt. 0) .or. + . ((0<=yc).and.(yc-yinc<=0)).and.isjaccorall==1 ) then # use full ix range near yc=0 # with integrated core flux BC i1 = 0 # 1-ixmnbcl @@ -892,19 +892,19 @@ c write(*,*) parvis i8 = min(nx+1, xc+xrinc) endif if (yc .lt. 0) then - j1 = 0 + j1 = 0 j1p = 0 j2 = 1 j2p = 1 - j3 = 0 - j4 = 0 + j3 = 0 + j4 = 0 j5 = ny j5m = ny-1 - j6 = ny+1 + j6 = ny+1 j5p = ny j6p = ny+1 - j7 = ny+1 - j8 = ny+1 + j7 = ny+1 + j8 = ny+1 else j1 = max(0, yc-yinc-1) j2 = max(1, yc-yinc) @@ -953,14 +953,14 @@ c write(*,*) parvis endif if (xccuts .or. xcturb) then - i1 = 0 + i1 = 0 i2 = 1 - i3 = 0 - i4 = 0 + i3 = 0 + i4 = 0 i5 = nx - i6 = nx+1 - i7 = nx+1 - i8 = nx+1 + i6 = nx+1 + i7 = nx+1 + i8 = nx+1 endif c... Define range for source terms to minimize calls to adpak-based routines @@ -981,14 +981,14 @@ c write(*,*) parvis ixs1 = xc ixf6 = xc if (xrinc .ge. 20) then - ixs1 = 0 - ixf6 = nx+1 + ixs1 = 0 + ixf6 = nx+1 endif iys1 = yc iyf6 = yc if (yinc .ge. 20) then - iys1 = 0 - iyf6 = ny+1 + iys1 = 0 + iyf6 = ny+1 endif endif @@ -1079,7 +1079,7 @@ call convsr_aux (xc, yc) . * ((bpol(ixmp,iysptrx,3)+bpol(ixmp,iysptrx,4))/ . (bpol(ix,iy,3)+bpol(ix,iy,4)+bpolmin))**inbpdif dif_use(ix,iy,ifld) = difniv(iy,ifld)*bscalf - difp_use(ix,iy,ifld) = difprv(iy,ifld)*bscalf + difp_use(ix,iy,ifld) = difprv(iy,ifld)*bscalf dif2_use(ix,iy,ifld) = difniv2(iy,ifld)*bscalf tray_use(ix,iy,ifld) = travisv(iy,ifld)*bscalf kye_use(ix,iy) = kyev(iy)*bscalf @@ -1107,10 +1107,10 @@ call convsr_aux (xc, yc) . (bpol(ix,iy,3)+bpol(ix,iy,4)+bpolmin))**inbpdif dif_use(ix,iy,ifld) = difniv(iy,ifld)*bscalf + . dfacbp*bpfac - difp_use(ix,iy,ifld) = difprv(iy,ifld)*bscalf - dif2_use(ix,iy,ifld) = difniv2(iy,ifld)*bscalf + + difp_use(ix,iy,ifld) = difprv(iy,ifld)*bscalf + dif2_use(ix,iy,ifld) = difniv2(iy,ifld)*bscalf + . dfacbp*bpfac - tray_use(ix,iy,ifld) = travisv(iy,ifld)*bscalf + + tray_use(ix,iy,ifld) = travisv(iy,ifld)*bscalf + . trfacbp*bpfac trax_use(ix,iy,ifld) = trfacbp*bpfac kye_use(ix,iy) = kyev(iy)*bscalf + kefacbp*bpfac @@ -1127,7 +1127,7 @@ call convsr_aux (xc, yc) ************************************************************************ -* Transverse Drifts in y-direction and in 2-direction +* Transverse Drifts in y-direction and in 2-direction * (normal to B and y) ************************************************************************ * --------------------------------------------------------------------- @@ -1177,21 +1177,21 @@ call convsr_aux (xc, yc) do 17 ix = i1, i6 ix3 = ixm1(ix,iy) ix4 = ixm1(ix,iy+1) - temp1 = + temp1 = . ( ex(ix ,iy) + ex(ix ,iy+1) + . ex(ix3,iy) + ex(ix4,iy+1) ) c... sknam: grad P from priv, prev temp1 = (-4.0)*(phiv(ix,iy) - phiv(ix3,iy))*gxc(ix,iy) - temp2 = 4.0*(priv(ix,iy,ifld) - priv(ix3,iy,ifld))*gxc(ix,iy) - temp3 = 4.0*(prev(ix,iy) - prev(ix3,iy))*gxc(ix,iy) - + temp2 = 4.0*(priv(ix,iy,ifld) - priv(ix3,iy,ifld))*gxc(ix,iy) + temp3 = 4.0*(prev(ix,iy) - prev(ix3,iy))*gxc(ix,iy) + c...MER NOTE: For a full double-null configuration, the following test will c... use the radial index of the innermost separatrix (see iysptrx definition c... in subroutine nphygeo) if ( isxpty(ix,iy)==0 .and. iysptrx.gt.0 ) then temp1 = (-4.0)*(phiv(ix,iy) - phiv(ix3,iy))*gxc(ix,iy) - temp2 = 4.0*(priv(ix,iy,ifld) - priv(ix3,iy,ifld))*gxc(ix,iy) - temp3 = 4.0*(prev(ix,iy) - prev(ix3,iy))*gxc(ix,iy) + temp2 = 4.0*(priv(ix,iy,ifld) - priv(ix3,iy,ifld))*gxc(ix,iy) + temp3 = 4.0*(prev(ix,iy) - prev(ix3,iy))*gxc(ix,iy) endif c... Calc collisionality factors nu_s/(1 + nu_s) = 1/(1 + lambda_s) lambd_ci = 1e16*(ti(ix,iy)/ev)**2/nit(ix,iy) # approx @@ -1235,7 +1235,7 @@ call convsr_aux (xc, yc) . btot(ix,iy+1)**2/etaper(ix,iy+1) ) vydd(ix,iy,ifld) = vcony(ifld) + vy_use(ix,iy,ifld) + . vy_cft(ix,iy,ifld) - - . (difpr(ifld) + difp_use(ix,iy,ifld)) * + . (difpr(ifld) + difp_use(ix,iy,ifld)) * . ( 2*gpry(ix,iy)/(pr(ix,iy+1) + pr(ix,iy)) - . 3.0*gtey(ix,iy)/(tey1(ix,iy)+tey0(ix,iy)) ) c ... Note that the density grad. term for vydd added below @@ -1245,7 +1245,7 @@ call convsr_aux (xc, yc) . (0.5*(niy1(ix,iy,1)+niy0(ix,iy,1))) - . 1.5*gtey(ix,iy) ) endif - if (cfeta1.ne.0. .and. iy.le.ny-1 .and. iy.gt.0) then + if (cfeta1.ne.0. .and. iy.le.ny-1 .and. iy.gt.0) then #special classical vis. term geyym = 2*gpiy(ix,iym1,1)/(ney1(ix,iym1)+ney0(ix,iym1))- . qe*ey(ix,iym1) @@ -1280,34 +1280,34 @@ c reduced by the factor difnit(ifld). The mixing ratio is given by c... in subroutine nphygeo) cc if (difnit(ifld) .gt. 1.e-20 .and. zi(ifld) .eq. 1. cc . .and. iy .gt. iysptrx) then -cc difnimix = (1. - cdifnit) * +cc difnimix = (1. - cdifnit) * cc . (fcdif*difni(ifld) + dif_use(ix,iy,ifld)) + cc . cdifnit * difnit(ifld) * difnimix cc endif - vydd(ix,iy,ifld) = vydd(ix,iy,ifld) + vydd(ix,iy,ifld) = vydd(ix,iy,ifld) . -1. * difnimix * ( . 2*(1-isvylog)*( (niy1(ix,iy,ifld) - niy0(ix,iy,ifld)) / . dynog(ix,iy) ) / (niy1(ix,iy,ifld)+niy0(ix,iy,ifld))+ - . isvylog*(log(niy1(ix,iy,ifld)) - + . isvylog*(log(niy1(ix,iy,ifld)) - . log(niy0(ix,iy,ifld))) /dynog(ix,iy) ) c ... Compute total radial velocity. vy(ix,iy,ifld) = cfydd *bfacyrozh(ix,iy) * - . vycp(ix,iy,ifld) + + . vycp(ix,iy,ifld) + . cfrd * vyrd(ix,iy,ifld) + - . vydd(ix,iy,ifld) + + . vydd(ix,iy,ifld) + . cfyef * vyce(ix,iy,ifld) + . cfybf * vycb(ix,iy,ifld) + - . cfvycf * vycf(ix,iy) + + . cfvycf * vycf(ix,iy) + . cfvycr * vycr(ix,iy) c ... Compute radial vel v_grad_P eng eqn terms;cfydd+cfybf=1 or 0 vygp(ix,iy,ifld) = (cfydd+cfybf)*bfacyrozh(ix,iy) * - . vycp(ix,iy,ifld) + + . vycp(ix,iy,ifld) + . cfrd * vyrd(ix,iy,ifld) + - . vydd(ix,iy,ifld) + + . vydd(ix,iy,ifld) + . cfyef * vyce(ix,iy,ifld) + - . cfvycf * vycf(ix,iy) + + . cfvycf * vycf(ix,iy) + . cfvycr * vycr(ix,iy) if (isybdrywd == 1) then #make vy diffusive in wall cells if (iy==0 .and. matwalli(ix) > 0) then @@ -1322,7 +1322,7 @@ cc if (difnit(ifld) .gt. 1.e-20 .and. zi(ifld) .eq. 1. do 20 iy = j1, j6 do 19 ix = i1, i6 iy1 = max(0,iy-1) # does iy=0 properly - iy2 = min(ny+1,iy+1) # use ex*fqx since phi(0,) may be large + iy2 = min(ny+1,iy+1) # use ex*fqx since phi(0,) may be large ix2 = ixp1(ix,iy) ix4 = ixp1(ix,iy1) ix6 = ixp1(ix,iy2) @@ -1396,22 +1396,22 @@ cc if (difnit(ifld) .gt. 1.e-20 .and. zi(ifld) .eq. 1. v2dd(ix,iy,ifld) = - 2. * difpr2(ifld) * gprx(ix,iy) / . ( pr(ix2,iy)/rbfbt(ix2,iy) + . pr(ix,iy)/rbfbt(ix,iy) ) - - . 2. * (fcdif*difni2(ifld) + dif2_use(ix,iy,ifld)) * + . 2. * (fcdif*difni2(ifld) + dif2_use(ix,iy,ifld)) * . (ni(ix2,iy,ifld)-ni(ix,iy,ifld)) / . (ni(ix2,iy,ifld)/(rbfbt(ix2,iy)*gx(ix2,iy))+ . ni(ix,iy,ifld)/(rbfbt(ix,iy)*gx(ix,iy))) v2(ix,iy,ifld) = cf2dd * bfacxrozh(ix,iy) * - . v2cd(ix,iy,ifld) + + . v2cd(ix,iy,ifld) + . cfrd * v2rd(ix,iy,ifld) + - . v2dd(ix,iy,ifld) + + . v2dd(ix,iy,ifld) + . cf2ef * v2ce(ix,iy,ifld) + . cf2bf * v2cb(ix,iy,ifld) c ... Compute v2 for v2x_gradx_P eng terms; cf2dd+cf2bf=1 or 0 v2xgp(ix,iy,ifld) = 0.5*(rbfbt(ix,iy)+rbfbt(ix2,iy)) * ( . (cf2dd+cf2bf) * bfacxrozh(ix,iy) * - . v2cd(ix,iy,ifld) + + . v2cd(ix,iy,ifld) + . cfrd * v2rd(ix,iy,ifld) + - . v2dd(ix,iy,ifld) + + . v2dd(ix,iy,ifld) + . cf2ef * v2ce(ix,iy,ifld) ) if (isnonog.eq.1 .and. iy.le.ny) then c grdnv = ( 1/( fym (ix,iy,1)/ni(ix2,iy1,ifld) + @@ -1421,34 +1421,34 @@ cc if (difnit(ifld) .gt. 1.e-20 .and. zi(ifld) .eq. 1. c . fypx(ix,iy,1)/ni(ix, iy2,ifld) ) - c . 1/( fym (ix,iy,0)/ni(ix ,iy1,ifld) + c . fy0 (ix,iy,0)/ni(ix ,iy ,ifld) + -c . fyp (ix,iy,0)/ni(ix ,iy2,ifld) + +c . fyp (ix,iy,0)/ni(ix ,iy2,ifld) + c . fymx(ix,iy,0)/ni(ix4,iy1,ifld) + c . fypx(ix,iy,0)/ni(ix6,iy2,ifld) ) ) c . / dxnog(ix,iy) -cc grdnv = ( exp( fym (ix,iy,1)*log(ni(ix2,iy1,ifld)) + +cc grdnv = ( exp( fym (ix,iy,1)*log(ni(ix2,iy1,ifld)) + cc . fy0 (ix,iy,1)*log(ni(ix2,iy ,ifld)) + cc . fyp (ix,iy,1)*log(ni(ix2,iy2,ifld)) + cc . fymx(ix,iy,1)*log(ni(ix ,iy1,ifld)) + -cc . fypx(ix,iy,1)*log(ni(ix, iy2,ifld)) ) -cc . -exp( fym (ix,iy,0)*log(ni(ix ,iy1,ifld)) + +cc . fypx(ix,iy,1)*log(ni(ix, iy2,ifld)) ) +cc . -exp( fym (ix,iy,0)*log(ni(ix ,iy1,ifld)) + cc . fy0 (ix,iy,0)*log(ni(ix ,iy ,ifld)) + cc . fyp (ix,iy,0)*log(ni(ix ,iy2,ifld)) + cc . fymx(ix,iy,0)*log(ni(ix4,iy1,ifld)) + cc . fypx(ix,iy,0)*log(ni(ix6,iy2,ifld)) ) ) / cc . dxnog(ix,iy) - grdnv = ( ( fym (ix,iy,1)*log(ni(ix2,iy1,ifld)) + + grdnv = ( ( fym (ix,iy,1)*log(ni(ix2,iy1,ifld)) + . fy0 (ix,iy,1)*log(ni(ix2,iy ,ifld)) + . fyp (ix,iy,1)*log(ni(ix2,iy2,ifld)) + . fymx(ix,iy,1)*log(ni(ix ,iy1,ifld)) + - . fypx(ix,iy,1)*log(ni(ix, iy2,ifld)) ) - . -( fym (ix,iy,0)*log(ni(ix ,iy1,ifld)) + + . fypx(ix,iy,1)*log(ni(ix, iy2,ifld)) ) + . -( fym (ix,iy,0)*log(ni(ix ,iy1,ifld)) + . fy0 (ix,iy,0)*log(ni(ix ,iy ,ifld)) + . fyp (ix,iy,0)*log(ni(ix ,iy2,ifld)) + . fymx(ix,iy,0)*log(ni(ix4,iy1,ifld)) + . fypx(ix,iy,0)*log(ni(ix6,iy2,ifld)) ) ) / . dxnog(ix,iy) vytan(ix,iy,ifld)=(fcdif*difni(ifld) + dif_use(ix,iy,ifld)) * - . (grdnv/cos(angfx(ix,iy)) - + . (grdnv/cos(angfx(ix,iy)) - . (log(ni(ix2,iy,ifld)) - log(ni(ix,iy,ifld))) . * gxf(ix,iy) ) if (islimon.eq.1.and. ix.eq.ix_lim.and. iy.ge.iy_lims) then @@ -1464,7 +1464,7 @@ cc if (difnit(ifld) .gt. 1.e-20 .and. zi(ifld) .eq. 1. 20 continue do 21 ix = i1, i6 - vy(ix,ny+1,ifld) = 0.0 + vy(ix,ny+1,ifld) = 0.0 21 continue else # test on zi > 1.e-10 to skip whole loop endif @@ -1473,7 +1473,7 @@ cc if (difnit(ifld) .gt. 1.e-20 .and. zi(ifld) .eq. 1. c ... Save values returned by Hirshman mombal for Jacobian calc. to c ... minimize calls - restore the "m" or ix-1 values at the end of pandf c ... The Jacobian ix loop can then be reduced to only include ix-1 and ix -c ... Suffix "o" refers to "old" value at ix, and suffix "om" means "old" +c ... Suffix "o" refers to "old" value at ix, and suffix "om" means "old" c ... value at ix-1. if (xc.ge.0 .and. yc.ge.0) then @@ -1509,7 +1509,7 @@ cc if (difnit(ifld) .gt. 1.e-20 .and. zi(ifld) .eq. 1. enddo enddo enddo - endif + endif c ... Calc friction forces from Braginskii; no individ chg-states;isimpon < 5. @@ -1546,7 +1546,7 @@ cc if (difnit(ifld) .gt. 1.e-20 .and. zi(ifld) .eq. 1. if (ix==ixlb(jx) .and. ixmnbcl==1) then ix1 = ixlb(jx) + 1 elseif (ix==ixrb(jx) .and. ixmxbcl==1) then - ix1 = ixrb(jx) - 1 + ix1 = ixrb(jx) - 1 endif enddo ix2 = ixp1(ix1,iy) @@ -1559,7 +1559,7 @@ cc if (difnit(ifld) .gt. 1.e-20 .and. zi(ifld) .eq. 1. . -( gpex(ix1,iy)/nexface + . cthe*flxlimf*gtex(ix1,iy) )/qe - . gpondpotx(ix,iy) + - . pondomfpare_use(ix,iy)/(qe*rrv(ix,iy)*nexface) ) + + . pondomfpare_use(ix,iy)/(qe*rrv(ix,iy)*nexface) ) + . isphiofft * ( . (phi(ix1,iy)-phi(ix2,iy))*gxf(ix1,iy) ) enddo @@ -1599,7 +1599,7 @@ call mombalni (ix1,ix,iy) argx = abs((2-2*upi(ix1,iy,ifld)/ . (upi(ix1,iy,1)+cutlo3))**3) argx = min(20., argx) - upi(ix1,iy,ifld) = upi(ix1,iy,1) + + upi(ix1,iy,ifld) = upi(ix1,iy,1) + . (upi(ix1,iy,ifld)-upi(ix1,iy,1))*exp(-argx) endif # end if-test on zi endif # end if-test on ix @@ -1631,7 +1631,7 @@ call mombalni (ix,ix2,iy) argx = abs((2-2*upi(ix,iy,ifld)/ . (upi(ix,iy,1)+cutlo3))**3) argx = min(20., argx) - upi(ix,iy,ifld) = upi(ix,iy,1) + + upi(ix,iy,ifld) = upi(ix,iy,1) + . (upi(ix,iy,ifld)-upi(ix,iy,1))*exp(-argx) endif # end if-test on zi endif # end if-test on ix @@ -1686,7 +1686,7 @@ call mombalni (ix,ix2,iy) if(isimpon > 0) then do jx = 1, nxpt ixt0 = ixlb(jx) - ixt = ixrb(jx)+1 + ixt = ixrb(jx)+1 ixt1 = ixrb(jx) do ifld = nhsp+1, nfsp if(ifld > nusp) then #species without full mom eqn @@ -1766,12 +1766,12 @@ ccc if(isphion+isphiofft .eq. 1) call calc_currents do 731 iy = j1, j6 # ExB same all species;if cf2dd=1, no imp yet do 730 ix = i1, i6 ix1 = ixp1(ix,iy) - vex(ix,iy) = upe(ix,iy)*rrv(ix,iy) + - . (cf2ef*v2ce(ix,iy,1) + cf2bf*ve2cb(ix,iy) + + vex(ix,iy) = upe(ix,iy)*rrv(ix,iy) + + . (cf2ef*v2ce(ix,iy,1) + cf2bf*ve2cb(ix,iy) + . cf2dd*bfacxrozh(ix,iy)*ve2cd(ix,iy,1) ) * . 0.5*(rbfbt(ix,iy) + rbfbt(ix1,iy)) - - . vytan(ix,iy,1) - + . vytan(ix,iy,1) + 730 continue 731 continue @@ -1790,7 +1790,7 @@ ccc if(isphion+isphiofft .eq. 1) call calc_currents . (0.5*( ney0(ix,iy)+ney1(ix,iy) )) 35 continue 36 continue - + c ... if isnewpot=0, vey(,0) needs to be redone since fqy(,0)=0 if (isnewpot==1) then do ix = i1, i6 # ExB vyce same all species @@ -1806,7 +1806,7 @@ ccc if(isphion+isphiofft .eq. 1) call calc_currents if (matwallo(ix) > 0) vey(ix,ny) = vydd(ix,ny,1) enddo endif - + ************************************************************************ * We Calculate the source terms now. @@ -1931,7 +1931,7 @@ ccc if(isphion+isphiofft .eq. 1) call calc_currents c... The particle source can be frozen if ifixpsor.ne.0 if(ifixpsor .eq. 0) then - + igsp = 0 do ifld = 1, nhsp # Hydrogen-only loop if (zi(ifld) > 0.) then #calc only for hydrogen ions @@ -1954,7 +1954,7 @@ ccc if(isphion+isphiofft .eq. 1) call calc_currents nuiz(ix,iy,igsp) = cnuiz endif if (isrecmon == 1) then - nurc(ix,iy,igsp) = cfrecom * ne(ix,iy) + nurc(ix,iy,igsp) = cfrecom * ne(ix,iy) . * rra(te(ix,iy),ne(ix,iy),rtau(ix,iy),1) if (xc .ge. 0) then # limit Jacobian element nurc(ix,iy,igsp) = fnnuiz*nurc(ix,iy,igsp) + @@ -1964,7 +1964,7 @@ ccc if(isphion+isphiofft .eq. 1) call calc_currents nurc(ix,iy,igsp) = 0. endif psorbgg(ix,iy,igsp) = ngbackg(igsp)*( (0.9 + 0.1* - . (ngbackg(igsp)/ng(ix,iy,igsp))**ingb) ) * + . (ngbackg(igsp)/ng(ix,iy,igsp))**ingb) ) * . nuiz(ix,iy,igsp) * vol(ix,iy) psorgc(ix,iy,igsp) = -ng(ix,iy,igsp)*nuiz(ix,iy,igsp)*vol(ix,iy) + . psorbgg(ix,iy,igsp) @@ -1989,7 +1989,7 @@ ccc we omit the weak velocity dependence as it brings in ni(ix+1) in Jac nucx(ix,iy,igsp) = sqrt(t0/mi(ifld))* . sigcx*(ni(ix,iy,ifld)+rnn2cx*ng(ix,iy,igsp)) endif - nuix(ix,iy,igsp) = fnuizx*nuiz(ix,iy,igsp) + + nuix(ix,iy,igsp) = fnuizx*nuiz(ix,iy,igsp) + . fnucxx*nucx(ix,iy,igsp) #dont use neutral-neutral collisions here c @@ -2036,7 +2036,7 @@ ccc we omit the weak velocity dependence as it brings in ni(ix+1) in Jac else # Jacobian eval j2pwr = max(1, yc-1) j5pwr = min(ny, yc+1) - endif + endif do iy = j2pwr, j5pwr if (xc < 0) then #full RHS eval i2pwr = i2 @@ -2049,18 +2049,18 @@ ccc we omit the weak velocity dependence as it brings in ni(ix+1) in Jac ix1 = ixm1(ix,iy) ix2 = ixp1(ix,iy) psorg(ix,iy,igsp) = (1.-ispsorave*0.5)* - . psorgc(ix,iy,igsp)+ + . psorgc(ix,iy,igsp)+ . 0.125*ispsorave*vol(ix,iy)* - . ( psorgc(ix,iy-1,igsp)/vol(ix,iy-1) + + . ( psorgc(ix,iy-1,igsp)/vol(ix,iy-1) + . psorgc(ix,iy+1,igsp)/vol(ix,iy+1) + - . psorgc(ix1,iy,igsp)/vol(ix1,iy) + + . psorgc(ix1,iy,igsp)/vol(ix1,iy) + . psorgc(ix2,iy,igsp)/vol(ix2,iy) ) psorxr(ix,iy,ifld) = (1.-ispsorave*0.5)* - . psorxrc(ix,iy,ifld) + + . psorxrc(ix,iy,ifld) + . 0.125*ispsorave*vol(ix,iy)* - . ( psorxrc(ix,iy-1,ifld)/vol(ix,iy-1) + + . ( psorxrc(ix,iy-1,ifld)/vol(ix,iy-1) + . psorxrc(ix,iy+1,ifld)/vol(ix,iy+1) + - . psorxrc(ix1,iy,ifld)/vol(ix1,iy) + + . psorxrc(ix1,iy,ifld)/vol(ix1,iy) + . psorxrc(ix2,iy,ifld)/vol(ix2,iy) ) psor(ix,iy,ifld) = -psorg(ix,iy,igsp) psorrg(ix,iy,igsp) = -psorxr(ix,iy,ifld) @@ -2115,7 +2115,7 @@ call mcrates(ne(ix,iy),te(ix,iy), endif kionz0 = kionz0 + sigvi_floor psorbgg(ix,iy,jg)= ngbackg(jg)* - . (0.9+0.1*(ngbackg(jg)/ng(ix,iy,jg))**ingb) * + . (0.9+0.1*(ngbackg(jg)/ng(ix,iy,jg))**ingb) * . nevol*kionz0 psorg(ix,iy,jg) = -ng(ix,iy,jg)*nevol*kionz0 + . psorbgg(ix,iy,jg) @@ -2135,19 +2135,19 @@ call mcrates(ne(ix,iy), te(ix,iy), kcxrzig = rcxighg(jg)*kcxrz # K_cx of ng(jg)+ni(1)-> niz_floor = nzbackg(ifld_fcs) * (0.9 + 0.1* . (nzbackg(ifld_fcs)/ni(ix,iy,ifld_fcs))**inzb) - pscx0 = ngvol*(ni(ix,iy,ifld_fcs)-niz_floor)*kcxrz - + pscx0 = ngvol*(ni(ix,iy,ifld_fcs)-niz_floor)*kcxrz - . ng(ix,iy,jg)*ni(ix,iy,1)*vol(ix,iy)* . kcxrzig psorcxg(ix,iy,jg) = pscx0 psorcxg(ix,iy,1) = -pscx0 psorrg(ix,iy,jg) = nevol*(ni(ix,iy,ifld_fcs)- . niz_floor)*krecz - psorxr(ix,iy,ifld_fcs)= -psorrg(ix,iy,jg) - pscx0 + psorxr(ix,iy,ifld_fcs)= -psorrg(ix,iy,jg) - pscx0 psorxr(ix,iy,1) = psorxr(ix,iy,1) + pscx0 cc Note: summed over ion/neutrals here backgrd source=0 massfac = cfmassfac*16*mi(1)/(3*(mg(jg)+mi(1))) nuiz(ix,iy,jg) = kionz0*ne(ix,iy) - nuix(ix,iy,jg) = fnuizx*nuiz(ix,iy,jg) + + nuix(ix,iy,jg) = fnuizx*nuiz(ix,iy,jg) + . kcxrzig*ni(ix,iy,1) + . massfac*( kelighi(jg)*ni(ix,iy,1) + . kelighg(jg)*ng(ix,iy,1) ) @@ -2165,7 +2165,7 @@ call mcrates(ne(ix,iy), te(ix,iy), else # no impurity gas present izch = nint(zi(ifld_fcs)) if (ismctab .eq. 1) then - call imprates(te(ix,iy), izch, nzsp(jz), + call imprates(te(ix,iy), izch, nzsp(jz), . kionz, krecz, kcxrz) elseif (ismctab .eq. 2) then call mcrates(ne(ix,iy), te(ix,iy), @@ -2183,9 +2183,9 @@ call mcrates(ne(ix,iy), te(ix,iy), endif # end if-branches for Z=1 with/wo impurity gas if (znucl(ifld_fcs)==1) then # hydrogenic impurity: include cx on ifld_fcs in nuix - nuix(ix,iy,jg) = nuix(ix,iy,jg) + + nuix(ix,iy,jg) = nuix(ix,iy,jg) + . kcxrz*ni(ix,iy,ifld_fcs) - nuix(ix,iy,1) = nuix(ix,iy,1) + + nuix(ix,iy,1) = nuix(ix,iy,1) + . kcxrzig*ni(ix,iy,ifld_fcs) endif @@ -2196,7 +2196,7 @@ call mcrates(ne(ix,iy), te(ix,iy), do ifld = ifld_fcs + 1, ifld_lcs # for charge states Z > 1 izch = nint(zi(ifld)) if (ismctab .eq. 1) then - call imprates(te(ix,iy), izch, nzsp(jz), + call imprates(te(ix,iy), izch, nzsp(jz), . kionz, krecz, kcxrz) elseif (ismctab .eq. 2) then call mcrates(ne(ix,iy), te(ix,iy), @@ -2220,7 +2220,7 @@ call mcrates(ne(ix,iy), te(ix,iy), . kionm msor(ix,iy,ifld_fcs) = msor(ix,iy,ifld_fcs)- . nevol*(ni(ix,iy,ifld_fcs))* - . kionm*mi(ifld_fcs)*up(ix,iy,ifld_fcs) + . kionm*mi(ifld_fcs)*up(ix,iy,ifld_fcs) pxri = psorxr(ix,iy,ifld_fcs) #set in Z=1 loop z1fac = 0. endif @@ -2272,7 +2272,7 @@ call mcrates(ne(ix,iy), te(ix,iy), if (ifld .eq. ifld_lcs) then # last charge-state psorxr(ix,iy,ifld) = -(nevol * krecz + . ngvol * kcxrz) * - . (ni(ix,iy,ifld)-niz_floor) + . (ni(ix,iy,ifld)-niz_floor) psorbgz(ix,iy) = psorbgz(ix,iy) + niz_floor * . (nevol*krecz + ngvol*kcxrz) msorxr(ix,iy,ifld) = -(nevol * krecz + @@ -2327,17 +2327,17 @@ call xerrab('*** nhgsp must exceed 1 for ishymol=1 ***') endif do iy = iys1, iyf6 do ix = ixs1, ixf6 - nuiz(ix,iy,2) = ne(ix,iy) * ( #.. Tom + nuiz(ix,iy,2) = ne(ix,iy) * ( #.. Tom . svdiss( te(ix,iy) ) . + cfizmol*rsa(te(ix,iy),ne_sgvi,rtau(ix,iy),0) . + sigvi_floor ) massfac = 16*mi(1)/(3*(mg(2)+mi(1))) - nuix(ix,iy,2)= fnuizx*nuiz(ix,iy,2) + + nuix(ix,iy,2)= fnuizx*nuiz(ix,iy,2) + . massfac*( kelighi(2)*ni(ix,iy,1)+ . kelighg(2)*ng(ix,iy,1) ) c ... molecule-molecule collisions would enter viscosity, not nuix - psorbgg(ix,iy,2) = ngbackg(2)* - . (0.9+0.1*(ngbackg(2)/ng(ix,iy,2))**ingb ) * + psorbgg(ix,iy,2) = ngbackg(2)* + . (0.9+0.1*(ngbackg(2)/ng(ix,iy,2))**ingb ) * . nuiz(ix,iy,2) * vol(ix,iy) psorgc(ix,iy,2) = - ng(ix,iy,2)*nuiz(ix,iy,2)*vol(ix,iy) + . psorbgg(ix,iy,2) @@ -2347,7 +2347,7 @@ call xerrab('*** nhgsp must exceed 1 for ishymol=1 ***') psor(ix,iy,iigsp) = psor(ix,iy,iigsp) + psordis(ix,iy) endif enddo - enddo + enddo endif # end of loop for ishymol=1 (hydrogen molecules on) @@ -2359,38 +2359,38 @@ call xerrab('*** nhgsp must exceed 1 for ishymol=1 ***') if (svrpkg.eq."cvode") then # cannot access yl(neq+1) call xerrab('*** svrpkg=cvode not allowed for ishosor=1 **') - endif + endif if (yl(neq+1).lt.0) then #full RHS eval c ... integ. sources over cells (but not for Jac) for higher-order accuracy do ifld = 1, nfsp # loop over ions - call volave(nx, ny, j2, j5, i2, i5, ixp1(0:nx+1,0:ny+1), - . ixm1(0:nx+1,0:ny+1),fsprd, vol(0:nx+1,0:ny+1), + call volave(nx, ny, j2, j5, i2, i5, ixp1(0:nx+1,0:ny+1), + . ixm1(0:nx+1,0:ny+1),fsprd, vol(0:nx+1,0:ny+1), . psor_tmpov(0:nx+1,0:ny+1), psor(0:nx+1,0:ny+1,ifld)) - call volave(nx, ny, j2, j5, i2, i5, ixp1(0:nx+1,0:ny+1), - . ixm1(0:nx+1,0:ny+1), fsprd, vol(0:nx+1,0:ny+1), + call volave(nx, ny, j2, j5, i2, i5, ixp1(0:nx+1,0:ny+1), + . ixm1(0:nx+1,0:ny+1), fsprd, vol(0:nx+1,0:ny+1), . psor_tmpov(0:nx+1,0:ny+1), psorxr(0:nx+1,0:ny+1,ifld)) enddo c *** Now do the gas do igsp = 1, ngsp # now loop over gas species - call volave(nx, ny, j2, j5, i2, i5, ixp1(0:nx+1,0:ny+1), - . ixm1(0:nx+1,0:ny+1), fsprd, vol(0:nx+1,0:ny+1), + call volave(nx, ny, j2, j5, i2, i5, ixp1(0:nx+1,0:ny+1), + . ixm1(0:nx+1,0:ny+1), fsprd, vol(0:nx+1,0:ny+1), . psor_tmpov(0:nx+1,0:ny+1), psorg(0:nx+1,0:ny+1,igsp)) - call volave(nx, ny, j2, j5, i2, i5, ixp1(0:nx+1,0:ny+1), - . ixm1(0:nx+1,0:ny+1), fsprd, vol(0:nx+1,0:ny+1), + call volave(nx, ny, j2, j5, i2, i5, ixp1(0:nx+1,0:ny+1), + . ixm1(0:nx+1,0:ny+1), fsprd, vol(0:nx+1,0:ny+1), . psor_tmpov(0:nx+1,0:ny+1), psorrg(0:nx+1,0:ny+1,igsp)) - call volave(nx, ny, j2, j5, i2, i5, ixp1(0:nx+1,0:ny+1), - . ixm1(0:nx+1,0:ny+1), fsprd, vol(0:nx+1,0:ny+1), + call volave(nx, ny, j2, j5, i2, i5, ixp1(0:nx+1,0:ny+1), + . ixm1(0:nx+1,0:ny+1), fsprd, vol(0:nx+1,0:ny+1), . psor_tmpov(0:nx+1,0:ny+1), psorcxg(0:nx+1,0:ny+1,igsp)) enddo - + endif # end of if (yl(neq+1).lt.0) test endif # end of integrating over sources and ishosor test - - endif # end of big loop starting if (ifixpsor .eq. 0) + + endif # end of big loop starting if (ifixpsor .eq. 0) *----------------------------------------------------------------------- * -- Calculates the fixed source if it is on @@ -2474,11 +2474,11 @@ ccc if (isupgon .eq. 1 .and. zi(ifld) .eq. 0.0) call neudif ix2 = ixp1(ix,iy) nexface = 0.5*(ne(ix2,iy)+ne(ix,iy)) t1old =.5*cvgp*(upe(ix,iy)*rrv(ix,iy)* - . ave(gx(ix,iy),gx(ix2,iy))*gpex(ix,iy)/gxf(ix,iy) + - . upe(ix1,iy)*rrv(ix1,iy)* - . ave(gx(ix,iy),gx(ix1,iy))*gpex(ix1,iy)/gxf(ix1,iy) ) + . ave(gx(ix,iy),gx(ix2,iy))*gpex(ix,iy)/gxf(ix,iy) + + . upe(ix1,iy)*rrv(ix1,iy)* + . ave(gx(ix,iy),gx(ix1,iy))*gpex(ix1,iy)/gxf(ix1,iy) ) t2old = 1.e-20* 0.25*(fqp(ix,iy)+fqp(ix1,iy))* - . (ex(ix,iy)+ex(ix1,iy))/gx(ix,iy) + . (ex(ix,iy)+ex(ix1,iy))/gx(ix,iy) iyp1 = min(iy+1,ny+1) iym1 = max(iy-1,0) t1new = .5*cvgp*( vex(ix,iy)* @@ -2496,7 +2496,7 @@ ccc if (isupgon .eq. 1 .and. zi(ifld) .eq. 0.0) call neudif if (nusp-isupgon(1).eq.1) smoc(ix,iy,1)=(( -cpgx*gpex(ix,iy)- . qe*nexface*gpondpotx(ix,iy) )*rrv(ix,iy) + . pondomfpare_use(ix,iy) )*sx(ix,iy)/gxf(ix,iy) - enddo + enddo enddo * -- Now loop over all ion species for seec, seic, and smoc -- @@ -2527,8 +2527,8 @@ ccc if (isupgon .eq. 1 .and. zi(ifld) .eq. 0.0) call neudif t0 = t0 +( qe*zi(ifld)*0.5*( ni(ix2,iy,ifld)+ . ni(ix,iy,ifld) )*ex(ix,iy)*rrv(ix,iy) + . frici(ix,iy,ifld) )* sx(ix,iy)/gxf(ix,iy) - if (ifld <= nusp) smoc(ix,iy,ifld) = - . smoc(ix,iy,ifld) + cpgx*t0 + if (ifld <= nusp) smoc(ix,iy,ifld) = + . smoc(ix,iy,ifld) + cpgx*t0 endif c... Add friction part of Q_e here tv = 0.25*(frice(ix,iy)+frice(ix1,iy))* @@ -2536,7 +2536,7 @@ ccc if (isupgon .eq. 1 .and. zi(ifld) .eq. 0.0) call neudif . upi(ix,iy,ifld) - upi(ix1,iy,ifld) ) seec(ix,iy) = seec(ix,iy) - zi(ifld)**2*ni(ix,iy,ifld)* . tv*vol(ix,iy)/nz2(ix,iy) - + 30 continue 31 continue @@ -2546,20 +2546,20 @@ ccc if (isupgon .eq. 1 .and. zi(ifld) .eq. 0.0) call neudif if (isgpye == 0) then ix1 = ixm1(ix,iy) ix2 = ixp1(ix,iy) - vyiy0 = fracvgpgp*vygp(ix,iy,ifld) + vyiy0 = fracvgpgp*vygp(ix,iy,ifld) . +(1.-fracvgpgp)*vycb(ix,iy,ifld) - vyiym1 = fracvgpgp*vygp(ix,iy-1,ifld) + vyiym1 = fracvgpgp*vygp(ix,iy-1,ifld) . +(1.-fracvgpgp)*vycb(ix,iy-1,ifld) - v2ix0 = fracvgpgp*v2xgp(ix,iy,ifld) + v2ix0 = fracvgpgp*v2xgp(ix,iy,ifld) . +(1.-fracvgpgp)*v2cb(ix,iy,ifld) - v2ixm1 = fracvgpgp*v2xgp(ix1,iy,ifld) + v2ixm1 = fracvgpgp*v2xgp(ix1,iy,ifld) . +(1.-fracvgpgp)*v2cb(ix1,iy,ifld) - t1 =.5*cvgp*( vygp(ix,iy ,ifld)*gpiy(ix,iy ,ifld) + + t1 =.5*cvgp*( vygp(ix,iy ,ifld)*gpiy(ix,iy ,ifld) + . vygp(ix,iy-1,ifld)*gpiy(ix,iy-1,ifld) + . v2xgp(ix ,iy,ifld)*ave(gx(ix,iy),gx(ix2,iy))* - . gpix(ix ,iy,ifld)/gxf(ix ,iy) + + . gpix(ix ,iy,ifld)/gxf(ix ,iy) + . v2xgp(ix1,iy,ifld)*ave(gx(ix,iy),gx(ix1,iy))* - . gpix(ix1,iy,ifld)/gxf(ix1,iy) ) + . gpix(ix1,iy,ifld)/gxf(ix1,iy) ) t2 = t1 elseif (isgpye == 1) then # Old B2 model with Jperp=0 t1 = -0.5*( vy(ix,iy ,ifld)*gpey(ix,iy ) + @@ -2581,7 +2581,7 @@ ccc if (isupgon .eq. 1 .and. zi(ifld) .eq. 0.0) call neudif c ... Now include seic contribution from hydrogen atoms if isupgon=1 c ... Then "ion" species 2 (redundant as gas species 1) is hydr atom - if(isupgon(1)==1 .and. zi(2)<1.e-20) then # .and. istgon(1)==0) then + if(isupgon(1)==1 .and. zi(2)<1.e-20) then # .and. istgon(1)==0) then if(cfvgpx(2) > 0.) then do iy = j2, j5 do ix = i2, i5 @@ -2589,11 +2589,11 @@ ccc if (isupgon .eq. 1 .and. zi(ifld) .eq. 0.0) call neudif ix2 = ixp1(ix,iy) iy1 = max(0,iy-1) seic(ix,iy) = seic(ix,iy) + cftiexclg - . *0.5*cfvgpx(2)*( + . *0.5*cfvgpx(2)*( . uuxg(ix, iy,1)*gpix(ix,iy,2) + . uuxg(ix1,iy,1)*gpix(ix1,iy,2) )*vol(ix,iy) seic(ix,iy) = seic(ix,iy) + cftiexclg - . *0.5*cfvgpy(2)*( + . *0.5*cfvgpy(2)*( . vyg(ix, iy,1)*gpiy(ix,iy,2) + . vyg(ix,iy1,1)*gpiy(ix,iy1,2) )*vol(ix,iy) enddo @@ -2637,29 +2637,29 @@ ccc if (isupgon .eq. 1 .and. zi(ifld) .eq. 0.0) call neudif vtn = sqrt(max(tg(ix,iy,1),tgmin*ev)/mi(ifld)) qfl = flalfvgxa(ix)*nm(ix,iy,ifld)*vtn**2 if(isvisxn_old == 1) then - lmfpn = 1./(sigcx * + lmfpn = 1./(sigcx * . (ni(ix,iy,1) + rnn2cx*ni(ix,iy,ifld))) elseif(isvisxn_old==0 .and. ishymol==0) then lmfppar = vtn/(kelhihg*ni(ix,iy,1) + . kelhghg*ni(ix,iy,ifld)) - lmfpperp = vtn/( vtn*sigcx*ni(ix,iy,1) + + lmfpperp = vtn/( vtn*sigcx*ni(ix,iy,1) + . kelhihg*ni(ix,iy,1)+kelhghg*ni(ix,iy,ifld) ) rrfac = rr(ix,iy)*rr(ix,iy) lmfpn = lmfppar*rrfac + lmfpperp*(1-rrfac) else # (isvisxn_old=0 .and. ishymol=1) then #with mols lmfppar = vtn/(kelhihg*ni(ix,iy,1) + . kelhghg*ni(ix,iy,ifld) + kelhmhg*ng(ix,iy,2)) - lmfpperp = vtn/( vtn*sigcx*ni(ix,iy,1) + + lmfpperp = vtn/( vtn*sigcx*ni(ix,iy,1) + . kelhihg*ni(ix,iy,1) +kelhghg*ni(ix,iy,ifld) + . kelhmhg*ng(ix,iy,2) ) rrfac = rr(ix,iy)*rr(ix,iy) lmfpn = lmfppar*rrfac + lmfpperp*(1-rrfac) endif csh = lmfpn*nm(ix,iy,ifld)*vtn* - . lgvmax/(lgvmax + lmfpn) + . lgvmax/(lgvmax + lmfpn) qsh = csh * (up(ix1,iy,ifld)-up(ix,iy,ifld)) * . gx(ix,iy) - visx(ix,iy,ifld)= cfvisxn*csh/ + visx(ix,iy,ifld)= cfvisxn*csh/ . (1 + (abs(qsh/(qfl+cutlo))**flgamvg))**(1./flgamvg) . + cfanomvisxg*travis(ifld)*nm(ix,iy,ifld) @@ -2680,7 +2680,7 @@ ccc if (isupgon .eq. 1 .and. zi(ifld) .eq. 0.0) call neudif if(ishymol == 0) then lmfppar = vtn/(kelhihg*n1upyface + . kelhghg*ngupyface) - lmfpperp = vtn/( vtn*sigcx*n1upyface + + lmfpperp = vtn/( vtn*sigcx*n1upyface + . kelhihg*n1upyface+kelhghg*ngupyface ) lmfpn = lmfppar*rrfac + lmfpperp*(1-rrfac) else # ishymol=1 @@ -2689,19 +2689,19 @@ ccc if (isupgon .eq. 1 .and. zi(ifld) .eq. 0.0) call neudif . ng(ix3,iyp1,2) ) lmfppar = vtn/(kelhihg*n1upyface + . kelhghg*n1upyface + kelhmhg*ng2upyface) - lmfpperp = vtn/( vtn*sigcx*n1upyface + + lmfpperp = vtn/( vtn*sigcx*n1upyface + . kelhihg*n1upyface +kelhghg*ngupyface + . kelhmhg*ng2upyface ) lmfpn = lmfppar*rrfac + lmfpperp*(1-rrfac) endif - + csh = lmfpn*ngupyface*mi(ifld)*vtn* - . lgvmax/(lgvmax + lmfpn) + . lgvmax/(lgvmax + lmfpn) qfl = flalfvgya(iy)*ngupyface*mi(ifld)*vtn**2 - qsh = csh * (up(ix,iy,ifld)-up(ix,iyp1,ifld)) * + qsh = csh * (up(ix,iy,ifld)-up(ix,iyp1,ifld)) * . gyf(ix,iy) - visy(ix,iy,ifld)= cfvisyn*csh / + visy(ix,iy,ifld)= cfvisyn*csh / . (1 + (abs(qsh/(qfl+cutlo))**flgamvg))**(1./flgamvg) . + cfanomvisyg*travis(ifld)*nmxface c @@ -2748,22 +2748,22 @@ ccc if (isupgon .eq. 1 .and. zi(ifld) .eq. 0.0) call neudif . (1./(1.+epstmp**(-1.5)/nuiistar(ix,iy,ifld)))* . (1./(1.+1./nuiistar(ix,iy,ifld))) rt2nus = 1.414*nuiistar(ix,iy,ifld) - ktneo(ix,iy,ifld) = (-0.17 + 1.05*rt2nus**.5 + + ktneo(ix,iy,ifld) = (-0.17 + 1.05*rt2nus**.5 + . 2.7*rt2nus**2*epstmp**3) / ( 1.+ . 0.7*rt2nus**.5 + rt2nus**2*epstmp**3 ) alfneo(ix,iy,ifld) = (8./15.)*(ktneo(ix,iy,ifld) - 1.)* . (1./(1.+epstmp**(-1.5)/nuiistar(ix,iy,ifld)))* . ( 1./(1.+1./nuiistar(ix,iy,ifld)) ) - k2neo(ix,iy,ifld) =(.66 + 1.88*epstmp**.5 - 1.54*epstmp)/ + k2neo(ix,iy,ifld) =(.66 + 1.88*epstmp**.5 - 1.54*epstmp)/ . (1. + 1.03*rt2nus**.5 + 0.31*rt2nus) + . 1.17*epstmp**3*rt2nus/(1. + 0.74*epstmp**1.5*rt2nus) -c... flux limit the viscosity; beware of using visx(0,iy) and +c... flux limit the viscosity; beware of using visx(0,iy) and c... visx(nx+1,iy) as they are meaningless when flux limited ix1 = ixm1(ix,iy) t0 = max (ti(ix,iy), temin*ev) vtn = sqrt(t0/mi(ifld)) mfl = flalfv * nm(ix,iy,ifld) * rr(ix,iy) * - . vol(ix,iy) * gx(ix,iy) * (t0/mi(ifld)) + . vol(ix,iy) * gx(ix,iy) * (t0/mi(ifld)) ccc Distance between veloc. cell centers: if (isgxvon .eq. 0) then # dx(ix)=1/gx(ix) csh = visx(ix,iy,ifld) * vol(ix,iy) * gx(ix,iy) @@ -2772,7 +2772,7 @@ ccc if (isupgon .eq. 1 .and. zi(ifld) .eq. 0.0) call neudif csh = visx(ix,iy,ifld) * vol(ix,iy) * gx(ix,iy) . * 2*gxf(ix,iy)*gxf(ix1,iy)/(gxf(ix,iy)+gxf(ix1,iy)) endif -ccc +ccc msh = abs( csh*(upi(ix1,iy,ifld) - upi(ix,iy,ifld)) ) visx(ix,iy,ifld) = visx(ix,iy,ifld) . / (1 + (msh/(mfl+1.e-20*msh))**flgamv )**(1/flgamv) @@ -2833,12 +2833,12 @@ ccc if (isupgon .eq. 1 .and. zi(ifld) .eq. 0.0) call neudif do 50 ix = i1, i6 ix1 = ixp1(ix,iy) w1(ix,iy) = w1(ix,iy) + tv*(ni(ix,iy,jfld)*gx(ix,iy) + - . ni(ix1,iy,jfld)*gx(ix1,iy)) / + . ni(ix1,iy,jfld)*gx(ix1,iy)) / . (gx(ix,iy) + gx(ix1,iy)) w2(ix,iy) = w2(ix,iy) + a*(ni(ix,iy,jfld)*gx(ix,iy) + - . ni(ix1,iy,jfld)*gx(ix1,iy)) / + . ni(ix1,iy,jfld)*gx(ix1,iy)) / . (gx(ix,iy) + gx(ix1,iy)) - 50 continue + 50 continue 51 continue 52 continue @@ -2853,7 +2853,7 @@ ccc if (isupgon .eq. 1 .and. zi(ifld) .eq. 0.0) call neudif fxet = fxe fxit = fxi do jx = 1, nxpt #reduce kxe inside sep by rkxecore fac - if ( (iy.le.iysptrx) .and. + if ( (iy.le.iysptrx) .and. . ix.gt.ixpt1(jx) .and. ix.le.ixpt2(jx) ) then fxet = fxe/( 1. + (rkxecore-1.)* . (yyf(iy)/(yyf(0)+4.e-50))**inkxc ) @@ -2896,7 +2896,7 @@ ccc iysptrx is the last closed flux surface (see S.R. nphygeo) 59 continue 103 continue - + c ... Add ion temp. dep. for pol. terms, flux limit, & build total ion hcx,yi do 595 ifld = 1, nisp if (zi(ifld) .eq. 0.e0) goto 595 @@ -2957,7 +2957,7 @@ ccc iysptrx is the last closed flux surface (see S.R. nphygeo) . (ti(ix,iy)-ti(ix1,iy))/rrv(ix,iy) enddo enddo - 595 continue + 595 continue c... Now include elec. temp and other dep. in poloidal terms + diff. neut. do 61 iy = j1, j6 @@ -3030,31 +3030,31 @@ ccc iysptrx is the last closed flux surface (see S.R. nphygeo) . (gx(ix,iy) + gx(ix1,iy)) noavey = 0.5*(niy0(ix,iy1,iigsp) + niy1(ix,iy1,iigsp)) -c Set up flux-limit variables (no rrv here) +c Set up flux-limit variables (no rrv here) c First limit the poloidal coeff, then radial c IJ 2016/10/10 add cfneutsor_ei multiplier to control fraction of neutral energy to add qflx = flalftgxa(ix) * sqrt(tgavex/mi(iigsp)) * noavex * . tgavex lmfpn = 1./(sigcx * (niavex + rnn2cx*noavex)) - cshx = lmfpn*sqrt(tgavex/mi(iigsp))*noavex * + cshx = lmfpn*sqrt(tgavex/mi(iigsp))*noavex * . lgtmax(iigsp)/(lmfpn + lgtmax(iigsp)) qshx = cshx * (tg(ix,iy,1)-tg(ix1,iy,1)) * gxf(ix,iy) - hcxn(ix,iy) = cshx / + hcxn(ix,iy) = cshx / . (1 + (abs(qshx/qflx))**flgamtg)**(1./flgamtg) - hcxi(ix,iy) = hcxi(ix,iy) + + hcxi(ix,iy) = hcxi(ix,iy) + . cftiexclg*cfneut*cfneutsor_ei*hcxn(ix,iy) c Now for the radial flux limit - good for nonorthog grid too qfly = flalftgya(iy) * sqrt(tgavey/mi(iigsp)) * noavey * . tgavey lmfpn = 1./(sigcx * (niavey + rnn2cx*noavey)) - cshy = lmfpn*sqrt(tgavey/mi(iigsp))*noavey * + cshy = lmfpn*sqrt(tgavey/mi(iigsp))*noavey * . lgtmax(iigsp)/(lmfpn + lgtmax(iigsp)) qshy = cshy * (tgy0(ix,iy1,1)-tgy1(ix,iy1,1))/dynog(ix,iy) - hcyn(ix,iy) = cshy / + hcyn(ix,iy) = cshy / . (1 + (abs(qshy/qfly))**flgamtg)**(1./flgamtg) - hcyi(ix,iy) = hcyi(ix,iy) + + hcyi(ix,iy) = hcyi(ix,iy) + . cftiexclg*cfneut*cfneutsor_ei*hcyn(ix,iy) -c +c 63 continue 62 continue endif @@ -3125,29 +3125,29 @@ ccc iysptrx is the last closed flux surface (see S.R. nphygeo) noavey = 0.5*(ngy0(ix,iy1,igsp) + ngy1(ix,iy1,igsp)) niavey = 0.5*(niy0(ix,iy1,1) + niy1(ix,iy1,1)) naavey = 0.5*(niy0(ix,iy1,2) + niy1(ix,iy1,2)) - nuelmolx = noavex*kelhmhm + niavex*kelhmhg + + nuelmolx = noavex*kelhmhm + niavex*kelhmhg + . naavex*kelhmhg qflx = flalftmx*sqrt(tgavex/mg(igsp))*noavex*tgavex cshx = cftgcond*noavex*tgavex/(mg(igsp)*nuelmolx) #assume K not fcn Tg qshx = cshx * (tg(ix,iy,igsp)-tg(ix1,iy,igsp)) * gxf(ix,iy) - hcxg(ix,iy,igsp) = cshx / + hcxg(ix,iy,igsp) = cshx / . (1.+ (abs(qshx/qflx))**flgamtg)**(1./flgamtg) hcxg(ix,iy,igsp)=(1.-cfhcxgc(igsp))*hcxg(ix,iy,igsp)+ . cfhcxgc(igsp)*noavex*kxg_use(ix,iy,igsp) c.. Now radial direction - nuelmoly = noavey*kelhmhm + niavey*kelhmhg + + nuelmoly = noavey*kelhmhm + niavey*kelhmhg + . naavey*kelhmhg qfly = flalftmy*sqrt(tgavey/mg(igsp))*noavey*tgavey cshy = cftgcond*noavey*tgavey/(mg(igsp)*nuelmoly) #assume Kel_s not fcn Tg qshy = cshy*(tgy0(ix,iy1,igsp)-tgy1(ix,iy1,igsp))/ . dynog(ix,iy) - hcyg(ix,iy,igsp) = cshy / + hcyg(ix,iy,igsp) = cshy / . (1 + (abs(qshy/qfly))**flgamtg)**(1./flgamtg) hcyg(ix,iy,igsp)=(1-cfhcygc(igsp))*hcyg(ix,iy,igsp)+ . cfhcygc(igsp)*noavey*kyg_use(ix,iy,igsp) enddo enddo - if (igsp.eq.1 .and. isupgon(igsp).eq.1) then + if (igsp.eq.1 .and. isupgon(igsp).eq.1) then hcxg(:,:,igsp) = hcxn(:,:) hcyg(:,:,igsp) = hcyn(:,:) endif @@ -3215,12 +3215,12 @@ ccc iysptrx is the last closed flux surface (see S.R. nphygeo) else # interp. ave or harmonic ave depending on wind*grad t0 = ( ni(ix, iy,ifld)*gx(ix, iy) + - . ni(ix2,iy,ifld)*gx(ix2,iy) ) / + . ni(ix2,iy,ifld)*gx(ix2,iy) ) / . ( gx(ix,iy)+gx(ix2,iy) ) t1 = ( gx(ix,iy)+gx(ix2,iy) ) * ni(ix,iy,ifld) * . ni(ix2,iy,ifld) / ( cutlo + ni(ix,iy,ifld)* . gx(ix2,iy) + ni(ix2,iy,ifld)*gx(ix,iy) ) - if( uu(ix,iy,ifld)*(ni(ix,iy,ifld)-ni(ix2,iy,ifld)) + if( uu(ix,iy,ifld)*(ni(ix,iy,ifld)-ni(ix2,iy,ifld)) . .ge. 0.) then t2 = t0 else @@ -3247,7 +3247,7 @@ ccc iysptrx is the last closed flux surface (see S.R. nphygeo) vytan(nxc-1,iy,ifld) = 0. vytan(nxc ,iy,ifld) = 0. vytan(nxc+1,iy,ifld) = 0. - + endif if (islimon.ne.0 .and. iy.ge.iy_lims) fnix(ix_lim,iy,ifld)=0. if (nxpt==2 .and. ixmxbcl==1) fnix(ixrb(1)+1,iy,ifld)=0. @@ -3279,7 +3279,7 @@ ccc iysptrx is the last closed flux surface (see S.R. nphygeo) else # interp. ave or harmonic ave depending on wind*grad t0 = ( niy0(ix,iy,ifld)*gy(ix,iy ) + - . niy1(ix,iy,ifld)*gy(ix,iy+1) ) / + . niy1(ix,iy,ifld)*gy(ix,iy+1) ) / . ( gy(ix,iy)+gy(ix,iy+1) ) t1 = ( gy(ix,iy)+gy(ix,iy+1) ) * niy0(ix,iy,ifld)* . niy1(ix,iy,ifld) / ( cutlo + niy0(ix,iy,ifld)* @@ -3290,9 +3290,9 @@ ccc iysptrx is the last closed flux surface (see S.R. nphygeo) else t2 = t1 endif - + endif - + fniy(ix,iy,ifld) = cnfy*vy(ix,iy,ifld)*sy(ix,iy)*t2 fniycb(ix,iy,ifld) = cnfy*vycb(ix,iy,ifld)*sy(ix,iy)*t2 if (vy(ix,iy,ifld)*(ni(ix,iy,ifld)-ni(ix,iy+1,ifld)) @@ -3306,7 +3306,7 @@ ccc iysptrx is the last closed flux surface (see S.R. nphygeo) 82 continue 83 continue -c ... cosmetic setting of fniy - not used +c ... cosmetic setting of fniy - not used do ix = i4, i8 fniy(ix,ny+1,ifld) = 0.0e0 enddo @@ -3348,7 +3348,7 @@ ccc iysptrx is the last closed flux surface (see S.R. nphygeo) enddo c ... Normalize core flux to zero to avoid introducing artifical core source/sink - if (isfniycbozero .gt. 0) then + if (isfniycbozero .gt. 0) then fniycboave = 0 do ifld = 1, nfsp do ix = ixpt1(1)+1, ixpt2(1) @@ -3359,14 +3359,14 @@ ccc iysptrx is the last closed flux surface (see S.R. nphygeo) fniycbo(ix, ifld) = fniycbo(ix, ifld) - isfniycbozero*fniycboave end do end do - else if (isfniycbozero .lt. 0) then + else if (isfniycbozero .lt. 0) then do ifld = 1, nfsp do ix = ixpt1(1)+1, ixpt2(1) fniycbo(ix, ifld) = 0 end do end do end if - + c----------------------------------------------------------------------c @@ -3391,7 +3391,7 @@ c write(*,*) 'TEST ISMCNON START: ismcnon=',ismcnon do 86 iy = j2, j5 do 85 ix = i2, i5 if(isnionxy(ix,iy,ifld) == 1) then - resco(ix,iy,ifld) = + resco(ix,iy,ifld) = . snic(ix,iy,ifld)+sniv(ix,iy,ifld)*ni(ix,iy,ifld) + . volpsor(ix,iy,ifld) + . cfneut * cfneutsor_ni * cnsor * psor(ix,iy,ifld) + @@ -3421,15 +3421,15 @@ c if (ifld .ne. iigsp) then resco(ix,iy,ifld) = resco(ix,iy,ifld) . - cfneutdiv*cfneutdiv_fng*( (fnix(ix,iy,ifld)-fnix(ix1,iy, ifld)) . + fluxfacy*(fniy(ix,iy,ifld)-fniy(ix,iy-1,ifld)) ) - + c ... IJ 2016/10/19 add MC neutral flux if flags set - if (get_neutral_moments .and. cmneutdiv_fng .ne. 0.0) then + if (get_neutral_moments .and. cmneutdiv_fng .ne. 0.0) then jfld=1 ## assume main ions in ifld=1 sng_ue(ix,iy,jfld) = - ( (fngx_ue(ix,iy,jfld) - fngx_ue(ix1,iy, jfld)) . + fluxfacy*(fngy_ue(ix,iy,jfld) - fngy_ue(ix,iy-1,jfld)) ) . *( (ng(ix,iy,jfld)*ti(ix,iy))/(ng(ix,iy,jfld)*ti(ix,iy)) ) c if (ix .eq. 1 .and. iy .eq. 1) write(*,*) 'sng_ue', ifld, jfld - resco(ix,iy,ifld) = resco(ix,iy,ifld) + + resco(ix,iy,ifld) = resco(ix,iy,ifld) + . cmneutdiv*cmneutdiv_fng*sng_ue(ix,iy,jfld) endif endif @@ -3575,7 +3575,7 @@ c The convective component is already already added through uu(ix,iy). ix1 = ixm1(ix,iy) ix3 = ixm1(ix,iy1) ix5 = ixm1(ix,iy+1) - grdnv = ( + grdnv = ( . fymv (ix,iy,1)*up(ix ,iy1 ,ifld)+ . fy0v (ix,iy,1)*up(ix ,iy ,ifld)+ . fypv (ix,iy,1)*up(ix ,iy+1,ifld)+ @@ -3589,12 +3589,12 @@ c The convective component is already already added through uu(ix,iy). . (dxnog(ix,iy)+dxnog(ix1,iy)) if (isgxvon .eq. 0) then fmixy(ix,iy,ifld) = cfvisxy(ifld)*visy(ix,iy,ifld) * - . ( grdnv/cos(0.5*(angfx(ix1,iy)+angfx(ix,iy))) - + . ( grdnv/cos(0.5*(angfx(ix1,iy)+angfx(ix,iy))) - . (up(ix,iy,ifld) - up(ix1,iy,ifld))*gx(ix,iy) ) * . 0.5*(sx(ix1,iy)+sx(ix,iy)) elseif (isgxvon .eq. 1) then fmixy(ix,iy,ifld) = cfvisxy(ifld)*visy(ix,iy,ifld) * - . ( grdnv/cos(0.5*(angfx(ix1,iy)+angfx(ix,iy))) - + . ( grdnv/cos(0.5*(angfx(ix1,iy)+angfx(ix,iy))) - . (up(ix,iy,ifld) - up(ix1,iy,ifld))* . ( 2*gxf(ix,iy)*gxf(ix1,iy) / . (gxf(ix,iy)+gxf(ix1,iy)) ) ) * @@ -3620,8 +3620,8 @@ c The convective component is already already added through uu(ix,iy). do ix = i2, i5 ix1 = ixm1(ix,iy) ix2 = ixp1(ix,iy) -c ... First, the short mfp drag - b_ctr = 0.5*(btot(ix,iy)+btot(ix2,iy)) +c ... First, the short mfp drag + b_ctr = 0.5*(btot(ix,iy)+btot(ix2,iy)) # derviatives dbds_m and dbds_p are one-sided dbds_m = (btot(ix,iy) - btot(ix1,iy))* . gxf(ix1,iy)*rrv(ix1,iy) @@ -3649,7 +3649,7 @@ c The convective component is already already added through uu(ix,iy). enddo enddo endif - + c... Compute total viscosity for nonuniform B-field; put in visvol_v,q if (cfvisxneov+cfvisxneoq > 0.) call upvisneo @@ -3674,18 +3674,18 @@ c The convective component is already already added through uu(ix,iy). endif if( ((2*(yc-iysptrx1(k1))-1)/4 .le. 1) .or. j1 == 0 ) then - if( ((2*(xc-ixpt1(k1))-1)/4)*((2*(xc-ixpt2(k2))-1)/4).eq.0 .or. + if( ((2*(xc-ixpt1(k1))-1)/4)*((2*(xc-ixpt2(k2))-1)/4).eq.0 .or. . i1.eq.0 ) then if(isnfmiy .eq. 1) then fmiy(ixpt1(k1),iysptrx1(k1),ifld) = 0. fmiy(ixpt2(k2),iysptrx2(k2),ifld) = 0. - nixpt(ifld,k1) = 0.125 * ( + nixpt(ifld,k1) = 0.125 * ( . ni(ixpt1(k1),iysptrx1(k1) ,ifld) + ni(ixpt1(k1)+1,iysptrx1(k1) ,ifld) . + ni(ixpt1(k1),iysptrx1(k1)+1,ifld) + ni(ixpt1(k1)+1,iysptrx1(k1)+1,ifld) . + ni(ixpt2(k2),iysptrx2(k2) ,ifld) + ni(ixpt2(k2)+1,iysptrx2(k2) ,ifld) . + ni(ixpt2(k2),iysptrx2(k2)+1,ifld) + ni(ixpt2(k2)+1,iysptrx2(k2)+1,ifld) ) - visyxpt(ifld,k1) = 0.125 * ( + visyxpt(ifld,k1) = 0.125 * ( . visy(ixpt1(k1),iysptrx1(k1) ,ifld) + visy(ixpt1(k1)+1,iysptrx1(k1) ,ifld) . + visy(ixpt1(k1),iysptrx1(k1)+1,ifld) + visy(ixpt1(k1)+1,iysptrx1(k1)+1,ifld) . + visy(ixpt2(k2),iysptrx2(k2) ,ifld) + visy(ixpt2(k2)+1,iysptrx2(k2) ,ifld) @@ -3709,15 +3709,15 @@ c The convective component is already already added through uu(ix,iy). . vyvxpt(ifld,k1)*upxpt(ifld,k1) . - sxyxpt*visyxpt(ifld,k1)*(up(ixpt2(k2),iysptrx2(k2),ifld) . - up(ixpt1(k1),iysptrx1(k1),ifld))*gvxpt ) - smoc(ixpt1(k1),iysptrx1(k1)+1,ifld) = smoc(ixpt1(k1),iysptrx1(k1)+1,ifld) + smoc(ixpt1(k1),iysptrx1(k1)+1,ifld) = smoc(ixpt1(k1),iysptrx1(k1)+1,ifld) . - fmihxpt(ifld,k1) - smoc(ixpt2(k2),iysptrx2(k2)+1,ifld) = smoc(ixpt2(k2),iysptrx2(k2)+1,ifld) + smoc(ixpt2(k2),iysptrx2(k2)+1,ifld) = smoc(ixpt2(k2),iysptrx2(k2)+1,ifld) . + fmihxpt(ifld,k1) - smoc(ixpt1(k1),iysptrx1(k1) ,ifld) = smoc(ixpt1(k1),iysptrx1(k1) ,ifld) + smoc(ixpt1(k1),iysptrx1(k1) ,ifld) = smoc(ixpt1(k1),iysptrx1(k1) ,ifld) . - fmivxpt(ifld,k1) - smoc(ixpt2(k2),iysptrx2(k2) ,ifld) = smoc(ixpt2(k2),iysptrx2(k2) ,ifld) + smoc(ixpt2(k2),iysptrx2(k2) ,ifld) = smoc(ixpt2(k2),iysptrx2(k2) ,ifld) . + fmivxpt(ifld,k1) - + endif # end if-test on isnfmiy endif # end if-test on xc endif # end if-test on yc @@ -3732,9 +3732,9 @@ c The convective component is already already added through uu(ix,iy). if (zi(ifld) .ne. 0) then # additions only for charged ions dp1 = cngmom(ifld)*(1/fac2sp)* . ( ng(ix2,iy,1)*tg(ix2,iy,1)- - . ng(ix ,iy,1)*tg(ix ,iy,1) ) + . ng(ix ,iy,1)*tg(ix ,iy,1) ) resmo(ix,iy,ifld) = 0. - resmo(ix,iy,ifld) = + resmo(ix,iy,ifld) = . smoc(ix,iy,ifld) . + smov(ix,iy,ifld) * up(ix,iy,ifld) . - cfneut * cfneutsor_mi * sx(ix,iy) * rrv(ix,iy) * dp1 @@ -3782,13 +3782,13 @@ c The convective component is already already added through uu(ix,iy). elseif ((isupgon(1) .eq. 1) .and. ifld .eq. iigsp) then c The neutral species, momentum coupling AND other source terms: resmo(ix,iy,iigsp) = # TR resmo(ix,iy,ifld) #IJ 2016 - . - cmneut * cmneutsor_mi * uesor_up(ix,iy,1) - . -sx(ix,iy) * rrv(ix,iy) * + . - cmneut * cmneutsor_mi * uesor_up(ix,iy,1) + . -sx(ix,iy) * rrv(ix,iy) * . cpgx*( cftiexclg*(ni(ix2,iy,iigsp)*ti(ix2,iy)- . ni(ix,iy,iigsp)*ti(ix,iy))+ . (1.0-cftiexclg)* . (ni(ix2,iy,iigsp)*tg(ix2,iy,1)- - . ni(ix,iy,iigsp)*tg(ix,iy,1)) ) + . ni(ix,iy,iigsp)*tg(ix,iy,1)) ) . -cfupcx*0.25*volv(ix,iy)* . (nucx(ix,iy,1)+nucx(ix2,iy,1))* . (nm(ix,iy,iigsp)+nm(ix2,iy,iigsp))* @@ -3810,7 +3810,7 @@ c The convective component is already already added through uu(ix,iy). do 3051 iy = j2, j5 do 3061 ix = i2, i5 ix2 = ixp1(ix,iy) -c ... IJ 2016/10/10 use cfneutdiv_fmg multiplier for neutrals +c ... IJ 2016/10/10 use cfneutdiv_fmg multiplier for neutrals c if (ifld .ne. iigsp) then if(zi(ifld) > 1.e-20) then # IJ 2016; depends if ion or neut resmo(ix,iy,ifld) = resmo(ix,iy,ifld) @@ -3818,7 +3818,7 @@ c if (ifld .ne. iigsp) then else resmo(ix,iy,ifld) = resmo(ix,iy,ifld) . + cfneutdiv*cfneutdiv_fmg*(fmixy(ix2,iy,ifld) - fmixy(ix,iy,ifld)) -c*** IJ 2017/09/21: Need to add similar fmgxy calculation for MC neutrals on nonorthogonal mesh *** +c*** IJ 2017/09/21: Need to add similar fmgxy calculation for MC neutrals on nonorthogonal mesh *** endif 3061 continue 3051 continue @@ -3827,7 +3827,7 @@ c if (ifld .ne. iigsp) then do 305 iy = j2, j5 do 306 ix = i2, i5 ix2 = ixp1(ix,iy) -c IJ 2016/10/10 add cfneutdiv_fmg multiplier for neutrals to control fraction of momentum to add +c IJ 2016/10/10 add cfneutdiv_fmg multiplier for neutrals to control fraction of momentum to add c if (ifld .ne. iigsp) then c ... IJ 2016 resmo contrib changes if ion or neut if(zi(ifld) > 1.e-20) then @@ -3838,7 +3838,7 @@ c if (ifld .ne. iigsp) then resmo(ix,iy,ifld) = resmo(ix,iy,ifld) . - cfneutdiv*cfneutdiv_fmg*(fmix(ix2,iy,ifld) - fmix(ix,iy ,ifld) . + fluxfacy*(fmiy(ix ,iy,ifld) - fmiy(ix,iy-1,ifld)) ) - if(cmneutdiv_fmg .ne. 0.0) then + if(cmneutdiv_fmg .ne. 0.0) then jfld=1 resmo(ix,iy,ifld) = resmo(ix,iy,ifld) . - cmneutdiv*cmneutdiv_fmg*( (fmgx_ue(ix2,iy,jfld) - fmgx_ue(ix,iy ,jfld)) @@ -3970,7 +3970,7 @@ c if (ifld .ne. iigsp) then . isflxldi*csh / (1 + abs(qsh/qfl)**flgam)**(1/flgam) floxi(ix,iy) = floxi(ix,iy) + (sign(qr*qr,qsh)/(1 + qr)**2) . *flalfia(ix) * sx(ix,iy) *( ne(ix,iy)*rr(ix,iy)* - . vt0 + ne(ix2,iy)*rr(ix2,iy)*vt1 ) / 2 + . vt0 + ne(ix2,iy)*rr(ix2,iy)*vt1 ) / 2 else conxi(ix,iy) = sx(ix,iy) * hcxi(ix,iy) * gxf(ix,iy) endif @@ -4005,7 +4005,7 @@ c if (ifld .ne. iigsp) then * --------------------------------------------------------------------- do 126 iy = j4, j8 - do 125 ix = i1, i5 + do 125 ix = i1, i5 ix1 = ixp1(ix,iy) ltmax = min( abs(te(ix,iy)/(rrv(ix,iy)*gtex(ix,iy) + cutlo)), . lcone(ix,iy) ) @@ -4018,13 +4018,13 @@ c if (ifld .ne. iigsp) then floxe(nx+1,iy) = 0.0e0 126 continue -c IJ 2016/10/10 add cfneutsor_ei multiplier to control fraction of neutral energy to add +c IJ 2016/10/10 add cfneutsor_ei multiplier to control fraction of neutral energy to add do 729 ifld = 1, nfsp if ((isupgon(1) .eq. 1) .and. (ifld .eq. iigsp)) then #neutrals do 726 iy = j4, j8 do 725 ix = i1, i5 floxi(ix,iy) = floxi(ix,iy) + - . cftiexclg*cfcvti*2.5*cfneut*cfneutsor_ei*fnix(ix,iy,ifld) + . cftiexclg*cfcvti*2.5*cfneut*cfneutsor_ei*fnix(ix,iy,ifld) 725 continue # next correct for incoming neut pwr = 0 do jx = 1, nxpt #if at plate, sub (1-cfloxiplt)*neut-contrib if(ixmnbcl==1) then #real plate-need for parallel UEDGE @@ -4054,7 +4054,7 @@ c if (ifld .ne. iigsp) then 728 continue endif - 729 continue + 729 continue * -- compute floye and floyi -- @@ -4085,7 +4085,7 @@ c if (ifld .ne. iigsp) then do ix = i4, i8 if (matwallo(ix) > 0 .and. recycwot(ix,1)>0.) then fniy_recy = max(recycwot(ix,1)*fac2sp*fniy(ix,ny,1), 0.) - floyi(ix,ny) = floyi(ix,ny) + + floyi(ix,ny) = floyi(ix,ny) + . cftiexclg*cfneut*cfneutsor_ei*2.5*(1.-cfloygwall)*fniy_recy endif if (matwalli(ix) > 0 .and. recycwit(ix,1,1)>0.) then @@ -4093,7 +4093,7 @@ c if (ifld .ne. iigsp) then floyi(ix,0) = floyi(ix,0) + . cftiexclg*cfneut*cfneutsor_ei*2.5*(1.-cfloygwall)*fniy_recy endif - enddo + enddo else do 628 iy = j1, j5 # note: cfloyi usually = 2.5 or 1.5 (ExB turb) @@ -4138,7 +4138,7 @@ c if (ifld .ne. iigsp) then 131 continue 132 continue 133 continue - + do 136 ifld = 1, nfsp do 135 iy = j1, j5 do 134 ix = i4, i8 @@ -4154,8 +4154,8 @@ c if (ifld .ne. iigsp) then if ( isxpty(ix,iy)==0 .and. iysptrx.gt.0 ) . temp1 = 4.0*(tiv(ix,iy) - tiv(ix3,iy))*gxc(ix,iy) if (zi(ifld) > 1.e-10) then - floyi(ix,iy) = floyi(ix,iy) - - . cfbgt*( 5*sy(ix,iy) / (32*qe*zi(ifld) )) * + floyi(ix,iy) = floyi(ix,iy) - + . cfbgt*( 5*sy(ix,iy) / (32*qe*zi(ifld) )) * . ( ni(ix,iy,ifld) + ni(ix,iy+1,ifld) ) * . ( rbfbt2(ix,iy) + rbfbt2(ix,iy+1) ) * . temp1 @@ -4186,7 +4186,7 @@ c if (ifld .ne. iigsp) then floxe(ix,iy) = floxe(ix,iy) - cfbgt*floxebgt(ix,iy) 137 continue 138 continue - + do 140 iy = j1, j5 do 139 ix = i4, i8 ix3 = ixm1(ix,iy) @@ -4200,8 +4200,8 @@ c if (ifld .ne. iigsp) then cccMER For full double-null configuration, iysptrx is last closed flux surface. if ( isxpty(ix,iy)==0 .and. iysptrx.gt.0 ) . temp1 = 4.0*(tev(ix,iy) - tev(ix3,iy))*gxc(ix,iy) - floye(ix,iy) = floye(ix,iy) + - . cfbgt*( 5*sy(ix,iy) / (32*qe) ) * + floye(ix,iy) = floye(ix,iy) + + . cfbgt*( 5*sy(ix,iy) / (32*qe) ) * . ( ne(ix,iy) + ne(ix,iy+1) ) * . ( rbfbt2(ix,iy) + rbfbt2(ix,iy+1) ) * . temp1 @@ -4282,22 +4282,22 @@ c if (ifld .ne. iigsp) then do 150 iy = j2, j5 do 149 ix = i2, i5 - resee(ix,iy) = + resee(ix,iy) = . seec(ix,iy) + seev(ix,iy) * te(ix,iy) . + pwrsore(ix,iy) . + cmneut * cmneutsor_ee * uesor_te(ix,iy) - . - nuvl(ix,iy,1)*vol(ix,iy)*bcee*ne(ix,iy)*te(ix,iy) - resei(ix,iy) = + . - nuvl(ix,iy,1)*vol(ix,iy)*bcee*ne(ix,iy)*te(ix,iy) + resei(ix,iy) = . seic(ix,iy) + seiv(ix,iy) * ti(ix,iy) . + pwrsori(ix,iy) . + cmneut * cmneutsor_ei * uesor_ti(ix,iy) - . - nuvl(ix,iy,1)*vol(ix,iy)*bcei*ne(ix,iy)*ti(ix,iy) + . - nuvl(ix,iy,1)*vol(ix,iy)*bcei*ne(ix,iy)*ti(ix,iy) 149 continue 150 continue * -- divergence of electron and ion energy flows -- -c... Add y-component of nonorthogonal diffusive flux; convective component +c... Add y-component of nonorthogonal diffusive flux; convective component c... already added to uu(ix,iy) if (isnonog .eq. 1) then @@ -4312,23 +4312,23 @@ c if (ifld .ne. iigsp) then ix4 = ixp1(ix,iy1) ix5 = ixm1(ix,iy+1) ix6 = ixp1(ix,iy+1) - grdnv=( ( fym (ix,iy,1)*log(te(ix2,iy1 )) + + grdnv=( ( fym (ix,iy,1)*log(te(ix2,iy1 )) + . fy0 (ix,iy,1)*log(te(ix2,iy )) + - . fyp (ix,iy,1)*log(te(ix2,iy+1)) + + . fyp (ix,iy,1)*log(te(ix2,iy+1)) + . fymx(ix,iy,1)*log(te(ix ,iy1 )) + - . fypx(ix,iy,1)*log(te(ix ,iy+1)) ) + . fypx(ix,iy,1)*log(te(ix ,iy+1)) ) . -( fym (ix,iy,0)*log(te(ix ,iy1 )) + . fy0 (ix,iy,0)*log(te(ix ,iy )) + . fyp (ix,iy,0)*log(te(ix ,iy+1)) + - . fymx(ix,iy,0)*log(te(ix4,iy1 )) + - . fypx(ix,iy,0)*log(te(ix6,iy+1)) ) ) / - . dxnog(ix,iy) + . fymx(ix,iy,0)*log(te(ix4,iy1 )) + + . fypx(ix,iy,0)*log(te(ix6,iy+1)) ) ) / + . dxnog(ix,iy) feexy(ix,iy) = exp( 0.5* - . (log(te(ix2,iy)) + log(te(ix,iy))) )* + . (log(te(ix2,iy)) + log(te(ix,iy))) )* . (fcdif*kye+kye_use(ix,iy))*0.5* . (ne(ix2,iy)+ne(ix,iy))* - . (grdnv/cos(angfx(ix,iy)) - - . (log(te(ix2,iy)) - log(te(ix,iy)))* + . (grdnv/cos(angfx(ix,iy)) - + . (log(te(ix2,iy)) - log(te(ix,iy)))* . gxf(ix,iy))*sx(ix,iy) c... Now do the Ti equation. @@ -4340,17 +4340,17 @@ c if (ifld .ne. iigsp) then c --- Note: this four-point average results in not getting the full Jac. for c --- a nonorthogonal mesh because of niy1,0 - see def. of hcyn - grdnv =( ( fym (ix,iy,1)*log(ti(ix2,iy1 )) + + grdnv =( ( fym (ix,iy,1)*log(ti(ix2,iy1 )) + . fy0 (ix,iy,1)*log(ti(ix2,iy )) + - . fyp (ix,iy,1)*log(ti(ix2,iy+1)) + + . fyp (ix,iy,1)*log(ti(ix2,iy+1)) + . fymx(ix,iy,1)*log(ti(ix ,iy1 )) + - . fypx(ix,iy,1)*log(ti(ix ,iy+1)) ) + . fypx(ix,iy,1)*log(ti(ix ,iy+1)) ) . -( fym (ix,iy,0)*log(ti(ix ,iy1 )) + . fy0 (ix,iy,0)*log(ti(ix ,iy )) + . fyp (ix,iy,0)*log(ti(ix ,iy+1)) + - . fymx(ix,iy,0)*log(ti(ix4,iy1 )) + - . fypx(ix,iy,0)*log(ti(ix6,iy+1)) ) ) / - . dxnog(ix,iy) + . fymx(ix,iy,0)*log(ti(ix4,iy1 )) + + . fypx(ix,iy,0)*log(ti(ix6,iy+1)) ) ) / + . dxnog(ix,iy) feixy(ix,iy) = exp( 0.5* . (log(ti(ix2,iy)) + log(ti(ix,iy))) )* . ( (fcdif*kyi+kyi_use(ix,iy))*0.5* @@ -4365,7 +4365,7 @@ c if (ifld .ne. iigsp) then t1 = max(ti(ix2,iy),temin*ev) vttn = t0*sqrt( t0/mi(1) ) vttp = t1*sqrt( t1/mi(1) ) - qfl = flalftxy * (cftiexclg*0.125+(1.-cftiexclg)*0.25) * sx(ix,iy) * (vttn + vttp) * + qfl = flalftxy * (cftiexclg*0.125+(1.-cftiexclg)*0.25) * sx(ix,iy) * (vttn + vttp) * . (ni(ix,iy,1)+cftiexclg*ng(ix,iy,1)+ni(ix2,iy,1)+cftiexclg*ng(ix2,iy,1)) feixy(ix,iy) = feixy(ix,iy) / . sqrt(1. + (feixy(ix,iy)/qfl)**2) @@ -4442,12 +4442,12 @@ c if (ifld .ne. iigsp) then . - ( feex(ix,iy) - feex(ix1,iy) . + fluxfacy*(feey(ix,iy) - feey(ix,iy-1)) ) c ... ## IJ 2017 cfneutsor_ei flags above control neutral contrib. - resei(ix,iy) = resei(ix,iy) + resei(ix,iy) = resei(ix,iy) . - ( feix(ix,iy) - feix(ix1,iy) . + fluxfacy*(feiy(ix,iy) - feiy(ix,iy-1)) ) c ... ## IJ 2016/10/19 add MC neutral flux - if(get_neutral_moments .and. cmneutdiv_feg .ne. 0.0) then + if(get_neutral_moments .and. cmneutdiv_feg .ne. 0.0) then jfld=1 seg_ue(ix,iy,jfld)=-( (fegx_ue(ix,iy,jfld)-fegx_ue(ix1,iy, jfld)) . + fluxfacy*(fegy_ue(ix,iy,jfld)-fegy_ue(ix, iy-1,jfld)) ) @@ -4455,7 +4455,7 @@ c if (ifld .ne. iigsp) then resei(ix,iy) = resei(ix,iy) + . cftiexclg*cmneutdiv*cmneutdiv_feg*seg_ue(ix,iy,jfld) reseg(ix,iy,1) = reseg(ix,iy,1) + - . cmneutdiv*cmneutdiv_feg*seg_ue(ix,iy,jfld) + . cmneutdiv*cmneutdiv_feg*seg_ue(ix,iy,jfld) endif 309 continue 310 continue @@ -4482,16 +4482,16 @@ c if (ifld .ne. iigsp) then else # compute from other data files erliz(ix,iy) = chradi * . erl1(te(ix,iy),ne_sgvi,rtau(ix,iy)) - . * (ng(ix,iy,1)-ngbackg(1)* - . (0.9+0.1*(ngbackg(1)/ng(ix,iy,1))**ingb) ) * + . * (ng(ix,iy,1)-ngbackg(1)* + . (0.9+0.1*(ngbackg(1)/ng(ix,iy,1))**ingb) ) * . vol(ix,iy) if (isrecmon .ne. 0) erlrc(ix,iy) = chradr * . erl2(te(ix,iy),ne_sgvi,rtau(ix,iy)) . * fac2sp*ni(ix,iy,1) * vol(ix,iy) endif eeliold = eeli(ix,iy) - if (icnuiz.le.1 .and. psor(ix,iy,1).ne.0.) - . eeli(ix,iy) = 13.6*ev + + if (icnuiz.le.1 .and. psor(ix,iy,1).ne.0.) + . eeli(ix,iy) = 13.6*ev + . erliz(ix,iy)/(fac2sp*psor(ix,iy,1)) pradhyd(ix,iy)= ( (eeli(ix,iy)-ebind*ev)*psor(ix,iy,1)+ @@ -4514,7 +4514,7 @@ ccc if (ishosor.eq.1) then #full RHS eval ccc ccc if (svrpkg.eq."cvode") then # cannot access yl(neq+1) ccc call xerrab('*** svrpkg=cvode not allowed for ishosor=1 **') -ccc endif +ccc endif ccc ccc if (yl(neq+1).lt.0) then #full RHS eval ccc @@ -4522,7 +4522,7 @@ ccc if (yl(neq+1).lt.0) then #full RHS eval ccc ccc call volave(nx, ny, j2, j5, i2, i5, ixp1(0,0), ixm1(0,0), ccc . fsprd, vol(0,0), psor_tmpov(0,0), vsoree) -ccc +ccc ccc endif # end of if (yl(neq+1).lt.0) test ccc endif # end of integrating over sources and ishosor test @@ -4536,7 +4536,7 @@ ccc call volave(nx, ny, j2, j5, i2, i5, ixp1(0,0), ixm1(0,0), enddo enddo - elseif (iseesorave > 0.) + elseif (iseesorave > 0.) if (xc < 0) then #full RHS eval j2pwr = j2 @@ -4544,7 +4544,7 @@ ccc call volave(nx, ny, j2, j5, i2, i5, ixp1(0,0), ixm1(0,0), else # Jacobian j2pwr = max(1, yc-1) j5pwr = min(ny, yc+1) - endif + endif do iy = j2pwr, j5pwr if (xc < 0) then #full RHS eval i2pwr = i2 @@ -4557,11 +4557,11 @@ ccc call volave(nx, ny, j2, j5, i2, i5, ixp1(0,0), ixm1(0,0), ix1 = ixm1(ix,iy) ix2 = ixp1(ix,iy) vsoree(ix,iy) = (1.-iseesorave*0.5)* - . vsoreec(ix,iy)+ + . vsoreec(ix,iy)+ . 0.125*iseesorave*vol(ix,iy)* - . ( vsoreec(ix,iy-1)/vol(ix,iy-1) + + . ( vsoreec(ix,iy-1)/vol(ix,iy-1) + . vsoreec(ix,iy+1)/vol(ix,iy+1) + - . vsoreec(ix1,iy)/vol(ix1,iy) + + . vsoreec(ix1,iy)/vol(ix1,iy) + . vsoreec(ix2,iy)/vol(ix2,iy) ) enddo enddo @@ -4587,15 +4587,15 @@ ccc call volave(nx, ny, j2, j5, i2, i5, ixp1(0,0), ixm1(0,0), t0 = 1.5*( tg(ix,iy,1)* (psor(ix,iy,1)+tv) . -ti(ix,iy) * (psorrg(ix,iy,1)+tv) ) resei(ix,iy) = resei(ix,iy) + w0(ix,iy) - . + cfneut * cfneutsor_ei * cfnidh * 0.5*mi(1) * - . ( (t1-t2)*(t1-t2)+temp3+temp4 ) * + . + cfneut * cfneutsor_ei * cfnidh * 0.5*mi(1) * + . ( (t1-t2)*(t1-t2)+temp3+temp4 ) * . ( psor(ix,iy,1) + cftiexclg*psorrg(ix,iy,1) . + tv + cftiexclg * tv ) . + (1.0-cftiexclg) * t0 . + cftiexclg * cfneut * cfneutsor_ei * cnsor . *( eion*ev+cfnidhdis* - . 0.5*mg(1)*(t2*t2+temp3+temp4) )*psordis(ix,iy) - . + cfnidh2* + . 0.5*mg(1)*(t2*t2+temp3+temp4) )*psordis(ix,iy) + . + cfnidh2* . ( -mi(1)*t1*t2*(psor(ix,iy,1)+tv) . +0.5*mi(1)*t1*t1* . (psor(ix,iy,1)+psorrg(ix,iy,1)+2*tv) ) @@ -4605,7 +4605,7 @@ ccc call volave(nx, ny, j2, j5, i2, i5, ixp1(0,0), ixm1(0,0), . * (psorrg(ix,iy,1)+tv) . + ( eion*ev + cfnidh*cfnidhdis* . 0.5*mg(1)*(t2*t2+temp3+temp4) )*psordis(ix,iy) - . + cfnidh2* + . + cfnidh2* . ( -mg(1)*t1*t2*(psorrg(ix,iy,1)+tv) . +0.5*mg(1)*(t2*t2+temp3+temp4)* . (psor(ix,iy,1)+psorrg(ix,iy,1)+2*tv) ) @@ -4625,7 +4625,7 @@ ccc call volave(nx, ny, j2, j5, i2, i5, ixp1(0,0), ixm1(0,0), c ... If molecules are present as gas species 2, add ion/atom cooling - # energy transfer between ions and molecueles due to + # energy transfer between ions and molecueles due to # ion/molecule elastic collisions have been moved in # engbalg subroutine, so comment the following lines... # if(ishymol == 1) then @@ -4678,7 +4678,7 @@ ccc call volave(nx, ny, j2, j5, i2, i5, ixp1(0,0), ixm1(0,0), elseif (isimpon .ge. 4) then # multi-charge model pradc(ix,iy) = 0. pwrzec(ix,iy) = 0. - nsm1 = nhsp + nsm1 = nhsp do igsp = nhgsp+1, ngsp # loop over diff imp species jz = igsp - nhgsp zn = znucl(nsm1+nzsp(jz)) @@ -4692,14 +4692,14 @@ ccc call volave(nx, ny, j2, j5, i2, i5, ixp1(0,0), ixm1(0,0), if(del_te_ro.lt. 100.) fac_rad=0.5*(1+tanh(argth)) if (ismctab .eq. 1) then pwrzec(ix,iy)= pwrzec(ix,iy) + fac_rad* - . radimpmc (nzsp(jz), te(ix,iy), + . radimpmc (nzsp(jz), te(ix,iy), . ne(ix,iy), nzloc, impradloc) elseif (ismctab .eq. 2) then pwrzec(ix,iy)= pwrzec(ix,iy) + fac_rad* - . radmc(nzsp(jz), zn, te(ix,iy), + . radmc(nzsp(jz), zn, te(ix,iy), . ne(ix,iy), nzloc, impradloc) endif - + do ifld = 0, nzsp(jz) pradzc(ix,iy,ifld,jz) = impradloc(ifld) pradc(ix,iy) = pradc(ix,iy)+impradloc(ifld) @@ -4737,8 +4737,8 @@ cc if (ishosor.eq.0) then #use only single-cell value enddo enddo -cc elseif (ishosor .ne. 0) - elseif (iseesorave > 0.) +cc elseif (ishosor .ne. 0) + elseif (iseesorave > 0.) if (xc < 0) then #full RHS eval j2pwr = j2 @@ -4746,7 +4746,7 @@ cc elseif (ishosor .ne. 0) else # Jacobian j2pwr = max(1, yc-1) j5pwr = min(ny, yc+1) - endif + endif do iy = j2pwr, j5pwr if (xc < 0) then #full RHS eval i2pwr = i2 @@ -4758,13 +4758,13 @@ cc elseif (ishosor .ne. 0) do ix = i2pwr, i5pwr ix1 = ixm1(ix,iy) ix2 = ixp1(ix,iy) - pwrze(ix,iy) = (1.-iseesorave*0.5)*pwrzec(ix,iy) + + pwrze(ix,iy) = (1.-iseesorave*0.5)*pwrzec(ix,iy) + . 0.125*iseesorave* . ( pwrzec(ix,iy-1)+ pwrzec(ix,iy+1)+ . pwrzec(ix1,iy) + pwrzec(ix2,iy) ) if (isimpon < 4) prad(ix,iy) = pwrze(ix,iy) if (isimpon >= 4) then #prad, pradz only diagnostic - prad(ix,iy) = (1.-iseesorave*0.5)*pradc(ix,iy) + + prad(ix,iy) = (1.-iseesorave*0.5)*pradc(ix,iy) + . 0.125*iseesorave* . ( pradc(ix,iy-1)+ pradc(ix,iy+1)+ . pradc(ix1,iy) + pradc(ix2,iy) ) @@ -4772,7 +4772,7 @@ cc elseif (ishosor .ne. 0) jz = igsp - nhgsp do ifld = 0, nzsp(jz) pradz(ix,iy,ifld,jz) = (1.-iseesorave*0.5)* - . pradzc(ix,iy,ifld,jz) + + . pradzc(ix,iy,ifld,jz) + . 0.125*iseesorave* . ( pradzc(ix,iy-1,ifld,jz)+ pradzc(ix,iy+1,ifld,jz)+ . pradzc(ix1,iy,ifld,jz) + pradzc(ix2,iy,ifld,jz) ) @@ -4799,10 +4799,10 @@ cc elseif (ishosor .ne. 0) enddo c****************************************************************** -c... Update resee over whole "box" because initially set to zero +c... Update resee over whole "box" because initially set to zero c****************************************************************** do 536 iy = j2, j5 - do 535 ix = i2, i5 + do 535 ix = i2, i5 resee(ix,iy) = resee(ix,iy) - . cnimp*pwrze(ix,iy)*vol(ix,iy) + . pwrebkg(ix,iy)*vol(ix,iy) @@ -4811,7 +4811,7 @@ cc elseif (ishosor .ne. 0) if (istimingon .eq. 1) call timimpfj (tsimp, xc) endif #loop for isimpon==2 - + * -- joule heating -- if (jhswitch > 0) then # relies on div(J)=0, so omit iy=1 & ny @@ -4824,10 +4824,10 @@ cc elseif (ishosor .ne. 0) endif if (jhswitch == 1) then # div(J)=0 gives -grad(phi).J=-div(phi.J) do iy = max(iy_min, j2), min(iy_max, j5) - do ix = i2, i5 + do ix = i2, i5 ix1 = ixm1(ix,iy) ix2 = ixp1(ix,iy) - wjdote(ix,iy) = + wjdote(ix,iy) = . - 0.5*(fqp(ix,iy)+fq2(ix,iy))* . (phi(ix2,iy)+phi(ix,iy)) . + 0.5*(fqp(ix1,iy)+fq2(ix1,iy))* @@ -4842,14 +4842,14 @@ cc elseif (ishosor .ne. 0) enddo else # for jhswitch > 1 do iy = max(iy_min, j2), min(iy_max, j5) - do ix = i2, i5 # use ex*fqx since phi(0,) may be large + do ix = i2, i5 # use ex*fqx since phi(0,) may be large ix1 = ixm1(ix,iy) ix2 = ixp1(ix,iy) - wjdote(ix,iy) = + wjdote(ix,iy) = . 0.5*( ex(ix1,iy) *fqx(ix1,iy) + . ex(ix, iy) *fqx(ix, iy) )/gx(ix,iy) . + 0.5*( ey(ix, iy) *fqy(ix, iy) + - . ey(ix,iy-1)*fqy(ix,iy-1) )/gy(ix,iy) + . ey(ix,iy-1)*fqy(ix,iy-1) )/gy(ix,iy) resee(ix,iy) = resee(ix,iy) + wjdote(ix,iy) enddo enddo @@ -4890,7 +4890,7 @@ cc elseif (ishosor .ne. 0) . ( (upxave0+upxavem1)**2 + upvhflr**2 ) dupdy = (upf0 - upfm1)*gy(ix,iy) else #V7.08.04 option - linear ave in y-direction - dupdy = 0.25*( (upi(ix,iy+1,ifld)+upi(ix2,iy+1,ifld) - + dupdy = 0.25*( (upi(ix,iy+1,ifld)+upi(ix2,iy+1,ifld) - . upi(ix,iy ,ifld)-upi(ix1,iy ,ifld))* . gyf(ix,iy) + . (upi(ix,iy ,ifld)+upi(ix1,iy ,ifld) - @@ -4902,11 +4902,11 @@ cc elseif (ishosor .ne. 0) wvh(ix,iy,ifld) = wvh(ix,iy,ifld) - . sin(thetacc)*cfvcsy(ifld)*cfvisy* . visy(ix,iy,ifld)*dupdx*dupdy - if (zi(ifld)==0.0 .and. ifld.eq.iigsp) then + if (zi(ifld)==0.0 .and. ifld.eq.iigsp) then resei(ix,iy) = resei(ix,iy) + cftiexclg*wvh(ix,iy,ifld)*vol(ix,iy) reseg(ix,iy,1) = reseg(ix,iy,1) + wvh(ix,iy,ifld)*vol(ix,iy) else - resei(ix,iy) = resei(ix,iy) + wvh(ix,iy,ifld)*vol(ix,iy) + resei(ix,iy) = resei(ix,iy) + wvh(ix,iy,ifld)*vol(ix,iy) endif 155 continue # loop over up species ifld 156 continue @@ -4922,7 +4922,7 @@ cc elseif (ishosor .ne. 0) pwribkg(ix,iy) = (tibg*ev/ti(ix,iy))**iteb*pwribkg_c enddo enddo - + do iy = j2, j5 do ix = i2, i5 resei(ix,iy) = resei(ix,iy) + pwribkg(ix,iy)*vol(ix,iy) @@ -4982,8 +4982,8 @@ cc elseif (ishosor .ne. 0) c ... subroutine bouncon. -c POTEN calculates the electrostatic potential, and BOUNCON calculates the -c equations for the boundaries. For the vodpk solver, the B.C. are ODEs +c POTEN calculates the electrostatic potential, and BOUNCON calculates the +c equations for the boundaries. For the vodpk solver, the B.C. are ODEs c in time (rate equations). Both bouncon and poten must be called before c the perturbed variables are reset below to get Jacobian correct @@ -5057,7 +5057,7 @@ subroutine mombal0 (nisp, nhsp, nzsp, minu, ziin, . misotope, natomic, nchstate) c ... Compute 'misotope', 'nchstate', and 'natomic', and allocate memory c for arrays used in subroutine mombal. - + implicit none c ... Input arguments: @@ -5074,7 +5074,7 @@ integer natomic(*) # maximum charge state of each isotope c ... Local variables: integer misa, ifld, jz - + c ... Loop over ion species, looking for change to a new isotope, and c finding maximum charge state. natomic(1) = 1 # electrons are "isotope 1" @@ -5082,7 +5082,7 @@ integer natomic(*) # maximum charge state of each isotope misa = 2 do ifld = 1, nhsp natomic(misa) = max(nint(ziin(ifld)), 1) # must be .ge. 1 - nchstate = max(nchstate, natomic(misa)) + nchstate = max(nchstate, natomic(misa)) if (ifld .eq. nhsp) go to 50 if (minu(ifld+1) .ne. minu(ifld)) misa = misa + 1 enddo @@ -5097,7 +5097,7 @@ call remark("increase the value of MXMISO and recompile.") call xerrab("") endif natomic(misotope) = nzsp(jz) - nchstate = max(nchstate, natomic(misotope)) + nchstate = max(nchstate, natomic(misotope)) enddo c ... Allocate memory for arrays used in subroutine mombal. @@ -5195,7 +5195,7 @@ subroutine mombal (ix,ix1,iy) den(misa,0) = 0. # impurity neutral density if (ismctab .eq. 1) then call imprates(tempa(1), 0, natomic(misa), - . nuion(misa,0), rdum, rdum) + . nuion(misa,0), rdum, rdum) nuion(misa,0) = den(1,1)*nuion(misa,0) #sigv-->ne*sigv elseif (ismctab .eq. 2) then call mcrates(den(1,1), tempa(1), 0., 0, natomic(misa), @@ -5210,7 +5210,7 @@ call mcrates(den(1,1), tempa(1), 0., 0, natomic(misa), den(misa,nz) = 0.5 * (ni(ix,iy,ifld) + ni(ix1,iy,ifld)) gradp(misa,nz) = flxlimf*rrv(ix,iy) * gpix(ix,iy,ifld) tempa(misa) = 0.5 * (ti(ix,iy) + ti(ix1,iy)) - gradt(misa,nz) = flxlimf*rrv(ix,iy) * gtix(ix,iy) + gradt(misa,nz) = flxlimf*rrv(ix,iy) * gtix(ix,iy) c ....... Get ionization and recombination rates. c Note that nuion has no meaning for the fully-stripped state, c but space is available to store zero returned by imprates. @@ -5380,7 +5380,7 @@ ccc frici(ix,iy,1) = - frice(ix,iy) # needed for hydrogen . rrv(ix,iy)*0.5*(ne(ix,iy)+ne(ix1,iy)) ) upi(ix,iy,1) = up(ix,iy,1) den(2,1) = 0.5 * (ni(ix,iy,1) + ni(ix1,iy,1)) - + c ... Loop over isotopes for friction coefficients ifld = 1 do misa = 3, misotope # only executed if impurities are present @@ -5394,7 +5394,7 @@ ccc frici(ix,iy,1) = - frice(ix,iy) # needed for hydrogen gradp(misa,nz) = rrv(ix,iy) * gpix(ix,iy,ifld) - . pondomfpari_use(ix,iy,ifld) tempa(misa) = 0.5 * (ti(ix,iy) + ti(ix1,iy)) - gradt(misa,nz) = rrv(ix,iy) * gtix(ix,iy) + gradt(misa,nz) = rrv(ix,iy) * gtix(ix,iy) zeffv = 0.5*(zeff(ix,iy)+zeff(ix1,iy)) if (is_z0_imp_const == 0) then z0 = den(1,1)*zeffv/den(2,1) - 1. @@ -5403,7 +5403,7 @@ ccc frici(ix,iy,1) = - frice(ix,iy) # needed for hydrogen endif if (isbetaicalc(ifld) == 1) then betai(ifld)=cfgti*1.56*zi(ifld)**2*(1+1.414*z0)*(1+.52*z0)/ - . ( (1+2.65*z0)*(1+.285*z0)*( z0 + + . ( (1+2.65*z0)*(1+.285*z0)*( z0 + . sqrt( 0.5*(mi(1)+mi(ifld))/mi(ifld)) ) ) . + 0.6*(zi(ifld)**2*den(misa,nz)/dzz2tot - 1.) endif @@ -5419,20 +5419,20 @@ ccc frici(ix,iy,1) = - frice(ix,iy) # needed for hydrogen . ( den(1,1)*(1+.24*z0)*(1+.93*z0) ) upi(ix,iy,ifld) = up(ix,iy,1) + (taudeff/mi(1)) * ( . - gradp(misa,nz)/den(misa,nz) - . + alfe(ifld)*gradt(1,1) - . + betai(ifld)*gradt(misa,nz) - . + qe*zi(ifld)*rrv(ix,iy)*ex(ix,iy) + . + alfe(ifld)*gradt(1,1) + . + betai(ifld)*gradt(misa,nz) + . + qe*zi(ifld)*rrv(ix,iy)*ex(ix,iy) . + volmsor(ix,iy,ifld)/ . (den(misa,nz)*vol(ix,iy)) ) c ... For force balance, frici just balances E-field and pressure c ... No flxlimf for 1st option; it only enhances (1/taudeff) if (nusp-isupgon(1) .eq. 1) then #only frici(,,1) used here frici(ix,iy,ifld) =-qe*zi(ifld)*den(misa,nz)* - . rrv(ix,iy)*ex(ix,iy) + gradp(misa,nz) + . rrv(ix,iy)*ex(ix,iy) + gradp(misa,nz) else # multi ion mom eqns; drag calc elsewhere (w0) if isofric=1 - frici(ix,iy,ifld) =flxlimf*den(misa,nz)*( - . alfe(ifld)*gradt(1,1) + - . betai(ifld)*gradt(misa,nz) + + frici(ix,iy,ifld) =flxlimf*den(misa,nz)*( + . alfe(ifld)*gradt(1,1) + + . betai(ifld)*gradt(misa,nz) + . (1-isofric)*mi(1)* . (up(ix,iy,1)-up(ix,iy,ifld))/ taudeff ) endif @@ -5598,7 +5598,7 @@ c If we are solving for the neutral parallel momentum (isupgon=1) Use(Locflux) # floxg,floyg,conxg,conyg Use(Indices_domain_dcl) # iymnbcl,iymxbcl Use(Volsrc) # volpsorg - + * -- procedures -- real ave ave(t0,t1) = 2*t0*t1 / (cutlo+t0+t1) @@ -5606,7 +5606,7 @@ c If we are solving for the neutral parallel momentum (isupgon=1) c ------------------ methgx = mod(methg, 10) methgy = methg/10 - + do 895 igsp = 1, ngsp c.... First the flux in the x-direction @@ -5650,16 +5650,16 @@ c If we are solving for the neutral parallel momentum (isupgon=1) . fypx(ix,iy,1)*log(tg(ix, iy2,igsp)) ) . -( fym (ix,iy,0)*log(tg(ix ,iy1,igsp)) + . fy0 (ix,iy,0)*log(tg(ix ,iy ,igsp)) + - . fyp (ix,iy,0)*log(tg(ix ,iy2,igsp)) + + . fyp (ix,iy,0)*log(tg(ix ,iy2,igsp)) + . fymx(ix,iy,0)*log(tg(ix4,iy1,igsp)) + - . fypx(ix,iy,0)*log(tg(ix6,iy2,igsp)) ) )/ + . fypx(ix,iy,0)*log(tg(ix6,iy2,igsp)) ) )/ . dxnog(ix,iy) vygtan(ix,iy,igsp) = exp( 0.5* . (log(tg(ix2,iy,igsp))+log(tg(ix,iy,igsp))) )* . ( cngfx(igsp) / (mg(igsp)*0.5*(nu1+nu2)) ) * - . ( grdnv/cos(angfx(ix,iy)) - + . ( grdnv/cos(angfx(ix,iy)) - . (log(tg(ix2,iy,igsp)) - log(tg(ix,iy,igsp))) - . * gxf(ix,iy) ) + . * gxf(ix,iy) ) if (islimon.eq.1.and. ix.eq.ix_lim.and. iy.ge.iy_lims) then vygtan(ix,iy,igsp) = 0. endif @@ -5696,7 +5696,7 @@ c If we are solving for the neutral parallel momentum (isupgon=1) c... the temperature gradient term is included in floxg floxg(ix,iy) = qtgf / (1 + qr**flgamg)**(1/flgamg) c... now add the convective velocity for charge-exchange neutrals - if(igsp .eq. 1) floxg(ix,iy) = + if(igsp .eq. 1) floxg(ix,iy) = . floxg(ix,iy) + cngflox(1)*sx(ix,iy)*uu(ix,iy,1) 887 continue @@ -5714,47 +5714,47 @@ c If we are solving for the neutral parallel momentum (isupgon=1) nu1 = nuix(ix,iy,igsp) + vtn/lgmax(igsp) nu2 = nuix(ix,iy+1,igsp) + vtnp/lgmax(igsp) qfl = flalfgya(iy,igsp) * sy(ix,iy) * (vtn + vtnp)*rt8opi* - . ( ngy0(ix,iy,igsp)*gy(ix,iy) + - . ngy1(ix,iy,igsp)*gy(ix,iy+1) ) / + . ( ngy0(ix,iy,igsp)*gy(ix,iy) + + . ngy1(ix,iy,igsp)*gy(ix,iy+1) ) / . (8*(gy(ix,iy)+gy(ix,iy+1))) csh = (1-isgasdc) * cdifg(igsp) *sy(ix,iy)/(dynog(ix,iy)) * . ave(vtn**2/nu1, vtnp**2/nu2) + . isgasdc * sy(ix,iy) * gyf(ix,iy) * difcng + . rld2dyg(igsp)**2*sy(ix,iy)*(1/gyf(ix,iy))* . 0.5*(nuiz(ix,iy,igsp)+nuiz(ix,iy+1,igsp)) - qtgf = cngfy(igsp) * fgtdy(iy) * sy(ix,iy) * + qtgf = cngfy(igsp) * fgtdy(iy) * sy(ix,iy) * . ave(gy(ix,iy)/nu1, gy(ix,iy+1)/nu2) . * (vtn**2 - vtnp**2) if (isnonog.eq.1 .and. iy.le.ny) then if (isintlog .eq. 0 ) then - ty0 = fxm (ix,iy,0)*tg(ixm1(ix,iy) ,iy ,igsp) + + ty0 = fxm (ix,iy,0)*tg(ixm1(ix,iy) ,iy ,igsp) + . fx0 (ix,iy,0)*tg(ix ,iy ,igsp) + . fxp (ix,iy,0)*tg(ixp1(ix,iy) ,iy ,igsp) + . fxmy(ix,iy,0)*tg(ixm1(ix,iy+1),iy+1,igsp) + . fxpy(ix,iy,0)*tg(ixp1(ix,iy+1),iy+1,igsp) - ty1 = fxm (ix,iy,1)*tg(ixm1(ix,iy+1),iy+1,igsp) + + ty1 = fxm (ix,iy,1)*tg(ixm1(ix,iy+1),iy+1,igsp) + . fx0 (ix,iy,1)*tg(ix ,iy+1,igsp) + . fxp (ix,iy,1)*tg(ixp1(ix,iy+1),iy+1,igsp) + . fxmy(ix,iy,1)*tg(ixm1(ix,iy) ,iy ,igsp) + . fxpy(ix,iy,1)*tg(ixp1(ix,iy) ,iy ,igsp) elseif (isintlog .eq. 1) then - ty0=exp(fxm (ix,iy,0)*log(tg(ixm1(ix,iy) ,iy ,igsp)) + + ty0=exp(fxm (ix,iy,0)*log(tg(ixm1(ix,iy) ,iy ,igsp)) + . fx0 (ix,iy,0)*log(tg(ix ,iy ,igsp)) + . fxp (ix,iy,0)*log(tg(ixp1(ix,iy) ,iy ,igsp)) + . fxmy(ix,iy,0)*log(tg(ixm1(ix,iy+1),iy+1,igsp)) + . fxpy(ix,iy,0)*log(tg(ixp1(ix,iy+1),iy+1,igsp)) ) - ty1=exp(fxm (ix,iy,1)*log(tg(ixm1(ix,iy+1),iy+1,igsp)) + + ty1=exp(fxm (ix,iy,1)*log(tg(ixm1(ix,iy+1),iy+1,igsp)) + . fx0 (ix,iy,1)*log(tg(ix ,iy+1,igsp)) + . fxp (ix,iy,1)*log(tg(ixp1(ix,iy+1),iy+1,igsp)) + . fxmy(ix,iy,1)*log(tg(ixm1(ix,iy) ,iy ,igsp)) + . fxpy(ix,iy,1)*log(tg(ixp1(ix,iy) ,iy ,igsp)) ) endif - qtgf = cngfy(igsp) * fgtdy(iy)* sy(ix,iy) * + qtgf = cngfy(igsp) * fgtdy(iy)* sy(ix,iy) * . ave(gy(ix,iy)/nu1, gy(ix,iy+1)/nu2) * . (ty0 - ty1)/mg(igsp) endif # Better interpolation of nuix could be done here nconv = 2.0*(ngy0(ix,iy,igsp)*ngy1(ix,iy,igsp)) / - . (ngy0(ix,iy,igsp)+ngy1(ix,iy,igsp)) + . (ngy0(ix,iy,igsp)+ngy1(ix,iy,igsp)) c... Use upwind for "convective" grad T term if methgy .ne. 2 if(methgy.ne.2) nconv = . ngy0(ix,iy,igsp)*0.5*(1+sign(1.,qtgf)) + @@ -5775,7 +5775,7 @@ c If we are solving for the neutral parallel momentum (isupgon=1) c... the temperature gradient term is included in floyg floyg(ix,iy) = qtgf / (1 + qr**flgamg)**(1/flgamg) c... now add the convective velocity for the charge-exchange species - if(igsp .eq. 1) floyg(ix,iy) = + if(igsp .eq. 1) floyg(ix,iy) = . floyg(ix,iy)+cngfloy(1)*sy(ix,iy)*vy(ix,iy,1) 889 continue @@ -5800,7 +5800,7 @@ call fd2tra (nx,ny,floxg,floyg,conxg,conyg, ix3 = ixm1(ix,iy1) ix4 = ixp1(ix,iy1) ix5 = ixm1(ix,iy+1) - ix6 = ixp1(ix,iy+1) + ix6 = ixp1(ix,iy+1) t0 = max(tg(ix ,iy,igsp),temin*ev) t1 = max(tg(ix2,iy,igsp),temin*ev) vtn = sqrt( t0/mg(igsp) ) @@ -5816,38 +5816,38 @@ call fd2tra (nx,ny,floxg,floyg,conxg,conyg, if (methgx .eq. 6) then # log interpolation grdnv =( ( fym (ix,iy,1)*log(ng(ix2,iy1 ,igsp)) + . fy0 (ix,iy,1)*log(ng(ix2,iy ,igsp)) + - . fyp (ix,iy,1)*log(ng(ix2,iy+1,igsp)) + + . fyp (ix,iy,1)*log(ng(ix2,iy+1,igsp)) + . fymx(ix,iy,1)*log(ng(ix ,iy1 ,igsp)) + . fypx(ix,iy,1)*log(ng(ix, iy+1,igsp)) ) . -( fym (ix,iy,0)*log(ng(ix ,iy1 ,igsp)) + . fy0 (ix,iy,0)*log(ng(ix ,iy ,igsp)) + . fyp (ix,iy,0)*log(ng(ix ,iy+1,igsp)) + - . fymx(ix,iy,0)*log(ng(ix4,iy1 ,igsp)) + - . fypx(ix,iy,0)*log(ng(ix6,iy+1,igsp)) ) )/ + . fymx(ix,iy,0)*log(ng(ix4,iy1 ,igsp)) + + . fypx(ix,iy,0)*log(ng(ix6,iy+1,igsp)) ) )/ . dxnog(ix,iy) elseif (methgx .eq. 7) then # inverse interpolation - grdnv =( 1/(fym (ix,iy,1)/ng(ix2,iy1 ,igsp) + + grdnv =( 1/(fym (ix,iy,1)/ng(ix2,iy1 ,igsp) + . fy0 (ix,iy,1)/ng(ix2,iy ,igsp) + - . fyp (ix,iy,1)/ng(ix2,iy+1,igsp) + + . fyp (ix,iy,1)/ng(ix2,iy+1,igsp) + . fymx(ix,iy,1)/ng(ix ,iy1 ,igsp) + . fypx(ix,iy,1)/ng(ix, iy+1,igsp)) . - 1/(fym (ix,iy,0)/ng(ix ,iy1 ,igsp) + . fy0 (ix,iy,0)/ng(ix ,iy ,igsp) + . fyp (ix,iy,0)/ng(ix ,iy+1,igsp) + - . fymx(ix,iy,0)/ng(ix4,iy1 ,igsp) + - . fypx(ix,iy,0)/ng(ix6,iy+1,igsp)) ) / + . fymx(ix,iy,0)/ng(ix4,iy1 ,igsp) + + . fypx(ix,iy,0)/ng(ix6,iy+1,igsp)) ) / . dxnog(ix,iy) else # linear interpolation - grdnv =( (fym (ix,iy,1)*ng(ix2,iy1 ,igsp) + + grdnv =( (fym (ix,iy,1)*ng(ix2,iy1 ,igsp) + . fy0 (ix,iy,1)*ng(ix2,iy ,igsp) + - . fyp (ix,iy,1)*ng(ix2,iy+1,igsp) + + . fyp (ix,iy,1)*ng(ix2,iy+1,igsp) + . fymx(ix,iy,1)*ng(ix ,iy1 ,igsp) + . fypx(ix,iy,1)*ng(ix, iy+1,igsp)) . - (fym (ix,iy,0)*ng(ix ,iy1 ,igsp) + . fy0 (ix,iy,0)*ng(ix ,iy ,igsp) + . fyp (ix,iy,0)*ng(ix ,iy+1,igsp) + - . fymx(ix,iy,0)*ng(ix4,iy1 ,igsp) + - . fypx(ix,iy,0)*ng(ix6,iy+1,igsp)) ) / + . fymx(ix,iy,0)*ng(ix4,iy1 ,igsp) + + . fypx(ix,iy,0)*ng(ix6,iy+1,igsp)) ) / . dxnog(ix,iy) endif difgx2 = ave( tg(ix ,iy,igsp)/nu1, @@ -5916,7 +5916,7 @@ call fd2tra (nx,ny,floxg,floyg,conxg,conyg, fngy(ix,iy,igsp) = fngy(ix,iy,igsp)/ . sqrt(1 + (fngy(ix,iy,igsp)/qfl)**2) enddo - enddo + enddo endif c... Finished with nonorthogonal mesh part @@ -5925,7 +5925,7 @@ call fd2tra (nx,ny,floxg,floyg,conxg,conyg, c ... diagnostic if isupgon=0, but used for uu and vy of the inertial c ... gas if isupgon=1. However, even when isupgon=1, the particle c ... fluxes are fngx -> fnix and fngy -> fniy in pandf, i.e., methg -c ... determines the differencing for the inertial particle fluxes, not +c ... determines the differencing for the inertial particle fluxes, not c ... methn do iy = j1, j5 do ix = i1,i5 @@ -5974,7 +5974,7 @@ cc uu(ix,iy,iigsp) = uug(ix,iy,igsp) ix1 = ixm1(ix,iy) resng(ix,iy,igsp) = cngsor * (psorg(ix,iy,igsp) + . psorcxg(ix,iy,igsp) + psorrg(ix,iy,igsp)) - . + volpsorg(ix,iy,igsp) + . + volpsorg(ix,iy,igsp) . - fngx(ix,iy,igsp) + fngx(ix1,iy ,igsp) . - fluxfacy*(fngy(ix,iy,igsp) - fngy(ix ,iy-1,igsp)) . + psgov_use(ix,iy,igsp)*vol(ix,iy) @@ -5993,7 +5993,7 @@ cc uu(ix,iy,iigsp) = uug(ix,iy,igsp) lmfp = sqrt(2*tg(ix,1,1)/(mi(1)*nuiz(ix,1,1)*nucx(ix,1,1))) tnuiz = tnuiz + exp(-pcolwid/lmfp + agdc*(ix-ixgb))* . nuiz(ix,1,1)/gx(ix,1) - enddo + enddo do ix = ixgb, nx+1 lmfp = sqrt(2*tg(ix,1,1)/(mi(1)*nuiz(ix,1,1)*nucx(ix,1,1))) tnuiz = tnuiz + exp(-pcolwid/lmfp)*nuiz(ix,1,1)/gx(ix,1) @@ -6026,7 +6026,7 @@ cc uu(ix,iy,iigsp) = uug(ix,iy,igsp) c -------------------------------------------------------------------------- c ====================================================================== -c Below neudifpg similar to neudif, except that the neutral pressure, ng*tg, +c Below neudifpg similar to neudif, except that the neutral pressure, ng*tg, c is the dependent variable differenced, rather than ng and tg separately c Here we do the neutral gas diffusion model, if isngon=1. c The diffusion is flux limited using the thermal flux. @@ -6085,8 +6085,8 @@ c If we are solving for the neutral parallel momentum (isupgon=1) Use(Ext_neutrals) # get_neutral_moments, ... Use(MCN_dim) # ngsp, ... Use(MCN_sources) # cfneut_sng, cfneutdiv_fng, ... mcfngx, mcfngy, ... - Use(Interp) # ngs, tgs - Use(Bfield) # rbfbt + Use(Interp) # ngs, tgs + Use(Bfield) # rbfbt * -- procedures -- real ave @@ -6095,7 +6095,7 @@ c If we are solving for the neutral parallel momentum (isupgon=1) c ------------------ methgx = mod(methg, 10) methgy = methg/10 - + c write (*,*) "neudifpg" do 895 igsp = 1, ngsp @@ -6103,7 +6103,7 @@ c write (*,*) "neudifpg" c.... First the flux in the x-direction c ********************************************* -c ..Timing;initialize +c ..Timing;initialize if(istimingon==1) tsngxlog = gettime(sec4) do 888 iy = j4, j8 @@ -6148,16 +6148,16 @@ c write (*,*) "neudifpg" . fypx(ix,iy,1)*log(tg(ix, iy2,igsp)) ) . -( fym (ix,iy,0)*log(tg(ix ,iy1,igsp)) + . fy0 (ix,iy,0)*log(tg(ix ,iy ,igsp)) + - . fyp (ix,iy,0)*log(tg(ix ,iy2,igsp)) + + . fyp (ix,iy,0)*log(tg(ix ,iy2,igsp)) + . fymx(ix,iy,0)*log(tg(ix4,iy1,igsp)) + - . fypx(ix,iy,0)*log(tg(ix6,iy2,igsp)) ) )/ + . fypx(ix,iy,0)*log(tg(ix6,iy2,igsp)) ) )/ . dxnog(ix,iy) vygtan(ix,iy,igsp) = exp( 0.5* . (log(tg(ix2,iy,igsp))+log(tg(ix,iy,igsp))) )* . ( alftng / (mg(igsp)*0.5*(nu1+nu2)) ) * - . ( grdnv/cos(angfx(ix,iy)) - + . ( grdnv/cos(angfx(ix,iy)) - . (log(tg(ix2,iy,igsp)) - log(tg(ix,iy,igsp))) - . * gxf(ix,iy) ) + . * gxf(ix,iy) ) if (islimon.eq.1.and. ix.eq.ix_lim.and. iy.ge.iy_lims) then vygtan(ix,iy,igsp) = 0. endif @@ -6203,7 +6203,7 @@ c write (*,*) "neudifpg" floxg(ix,iy) = floxg(ix,iy) + . cngniflox(ifld,igsp)*sx(ix,iy)*uu(ix,iy,ifld)/tgf enddo - endif + endif 887 continue conxg(nx+1,iy) = 0 @@ -6232,8 +6232,8 @@ c write (*,*) "neudifpg" flalfgy_adj = flalfgya(iy,igsp)*( 1. + . (cflbg*ngbackg(igsp)/ngyface)**inflbg ) qfl = flalfgy_adj * sy(ix,iy) * (vtn + vtnp)*rt8opi* - . ( ngy0(ix,iy,igsp)*gy(ix,iy) + - . ngy1(ix,iy,igsp)*gy(ix,iy+1) ) / + . ( ngy0(ix,iy,igsp)*gy(ix,iy) + + . ngy1(ix,iy,igsp)*gy(ix,iy+1) ) / . (8*(gy(ix,iy)+gy(ix,iy+1))) if (iy==0) then #at bdry, ng ave to avoid ng->0 prob qfl = flalfgy_adj * sy(ix,iy) * (vtn + vtnp)*rt8opi* @@ -6245,39 +6245,39 @@ c write (*,*) "neudifpg" . rld2dyg(igsp)**2*sy(ix,iy)*dynog(ix,iy)* . 0.5*(nuiz(ix,iy,igsp)+nuiz(ix,iy+1,igsp))/tgf - qtgf = alftng * fgtdy(iy) * sy(ix,iy) * + qtgf = alftng * fgtdy(iy) * sy(ix,iy) * . ave(gy(ix,iy)/nu1, gy(ix,iy+1)/nu2) . * (vtn**2 - vtnp**2) if (isnonog.eq.1 .and. iy.le.ny) then if (isintlog .eq. 0 ) then - ty0 = fxm (ix,iy,0)*tg(ixm1(ix,iy) ,iy ,igsp) + + ty0 = fxm (ix,iy,0)*tg(ixm1(ix,iy) ,iy ,igsp) + . fx0 (ix,iy,0)*tg(ix ,iy ,igsp) + . fxp (ix,iy,0)*tg(ixp1(ix,iy) ,iy ,igsp) + . fxmy(ix,iy,0)*tg(ixm1(ix,iy+1),iy+1,igsp) + . fxpy(ix,iy,0)*tg(ixp1(ix,iy+1),iy+1,igsp) - ty1 = fxm (ix,iy,1)*tg(ixm1(ix,iy+1),iy+1,igsp) + + ty1 = fxm (ix,iy,1)*tg(ixm1(ix,iy+1),iy+1,igsp) + . fx0 (ix,iy,1)*tg(ix ,iy+1,igsp) + . fxp (ix,iy,1)*tg(ixp1(ix,iy+1),iy+1,igsp) + . fxmy(ix,iy,1)*tg(ixm1(ix,iy) ,iy ,igsp) + . fxpy(ix,iy,1)*tg(ixp1(ix,iy) ,iy ,igsp) elseif (isintlog .eq. 1) then - ty0=exp(fxm (ix,iy,0)*log(tg(ixm1(ix,iy) ,iy ,igsp)) + + ty0=exp(fxm (ix,iy,0)*log(tg(ixm1(ix,iy) ,iy ,igsp)) + . fx0 (ix,iy,0)*log(tg(ix ,iy ,igsp)) + . fxp (ix,iy,0)*log(tg(ixp1(ix,iy) ,iy ,igsp)) + . fxmy(ix,iy,0)*log(tg(ixm1(ix,iy+1),iy+1,igsp)) + . fxpy(ix,iy,0)*log(tg(ixp1(ix,iy+1),iy+1,igsp)) ) - ty1=exp(fxm (ix,iy,1)*log(tg(ixm1(ix,iy+1),iy+1,igsp)) + + ty1=exp(fxm (ix,iy,1)*log(tg(ixm1(ix,iy+1),iy+1,igsp)) + . fx0 (ix,iy,1)*log(tg(ix ,iy+1,igsp)) + . fxp (ix,iy,1)*log(tg(ixp1(ix,iy+1),iy+1,igsp)) + . fxmy(ix,iy,1)*log(tg(ixm1(ix,iy) ,iy ,igsp)) + . fxpy(ix,iy,1)*log(tg(ixp1(ix,iy) ,iy ,igsp)) ) endif - qtgf = alftng * fgtdy(iy)* sy(ix,iy) * + qtgf = alftng * fgtdy(iy)* sy(ix,iy) * . ave(gy(ix,iy)/nu1, gy(ix,iy+1)/nu2) * . (ty0 - ty1)/mg(igsp) endif # Better interpolation of nuix could be done here nconv = 2.0*(ngy0(ix,iy,igsp)*ngy1(ix,iy,igsp)) / - . (ngy0(ix,iy,igsp)+ngy1(ix,iy,igsp)) + . (ngy0(ix,iy,igsp)+ngy1(ix,iy,igsp)) c... Use upwind for "convective" grad T term if methgy .ne. 2 if(methgy.ne.2) nconv = . ngy0(ix,iy,igsp)*0.5*(1+sign(1.,qtgf)) + @@ -6301,7 +6301,7 @@ c write (*,*) "neudifpg" if(igsp .eq. 1) floyg(ix,iy) = floyg(ix,iy) + . cngfloy(1)*sy(ix,iy)*vy(ix,iy,1)/tgf c... For impurities, add convect vel for elastic scattering with ions - if(igsp == 2 .and. ishymol == 0) then #Caution; need to weight uu + if(igsp == 2 .and. ishymol == 0) then #Caution; need to weight uu do ifld = nhsp+1, nisp floyg(ix,iy) = floyg(ix,iy) + . cngnifloy(ifld,igsp)*sy(ix,iy)*vy(ix,iy,ifld)/tgf @@ -6339,7 +6339,7 @@ call fd2tra (nx,ny,floxg,floyg,conxg,conyg, ix3 = ixm1(ix,iy1) ix4 = ixp1(ix,iy1) ix5 = ixm1(ix,iy+1) - ix6 = ixp1(ix,iy+1) + ix6 = ixp1(ix,iy+1) t0 = max(tg(ix ,iy,igsp),temin*ev) t1 = max(tg(ix2,iy,igsp),temin*ev) vtn = sqrt( t0/mg(igsp) ) @@ -6353,40 +6353,40 @@ call fd2tra (nx,ny,floxg,floyg,conxg,conyg, . (ix==ixrb(jx).and.ixmxbcl==1) ) isxyfl = .false. enddo if (methgx .eq. 6) then # log interpolation - grdnv =( ( fym (ix,iy,1)*log(pg(ix2,iy1 ,igsp)) + + grdnv =( ( fym (ix,iy,1)*log(pg(ix2,iy1 ,igsp)) + . fy0 (ix,iy,1)*log(pg(ix2,iy ,igsp)) + - . fyp (ix,iy,1)*log(pg(ix2,iy+1,igsp)) + + . fyp (ix,iy,1)*log(pg(ix2,iy+1,igsp)) + . fymx(ix,iy,1)*log(pg(ix ,iy1 ,igsp)) + . fypx(ix,iy,1)*log(pg(ix, iy+1,igsp)) ) . -( fym (ix,iy,0)*log(pg(ix ,iy1 ,igsp)) + . fy0 (ix,iy,0)*log(pg(ix ,iy ,igsp)) + . fyp (ix,iy,0)*log(pg(ix ,iy+1,igsp)) + - . fymx(ix,iy,0)*log(pg(ix4,iy1 ,igsp)) + - . fypx(ix,iy,0)*log(pg(ix6,iy+1,igsp)) ) )/ + . fymx(ix,iy,0)*log(pg(ix4,iy1 ,igsp)) + + . fypx(ix,iy,0)*log(pg(ix6,iy+1,igsp)) ) )/ . dxnog(ix,iy) elseif (methgx .eq. 7) then # inverse interpolation - grdnv =( 1/(fym (ix,iy,1)/pg(ix2,iy1 ,igsp) + + grdnv =( 1/(fym (ix,iy,1)/pg(ix2,iy1 ,igsp) + . fy0 (ix,iy,1)/pg(ix2,iy ,igsp) + - . fyp (ix,iy,1)/pg(ix2,iy+1,igsp) + + . fyp (ix,iy,1)/pg(ix2,iy+1,igsp) + . fymx(ix,iy,1)/pg(ix ,iy1 ,igsp) + . fypx(ix,iy,1)/pg(ix, iy+1,igsp)) . - 1/(fym (ix,iy,0)/pg(ix ,iy1 ,igsp) + . fy0 (ix,iy,0)/pg(ix ,iy ,igsp) + . fyp (ix,iy,0)/pg(ix ,iy+1,igsp) + - . fymx(ix,iy,0)/pg(ix4,iy1 ,igsp) + - . fypx(ix,iy,0)/pg(ix6,iy+1,igsp)) ) / + . fymx(ix,iy,0)/pg(ix4,iy1 ,igsp) + + . fypx(ix,iy,0)/pg(ix6,iy+1,igsp)) ) / . dxnog(ix,iy) else # linear interpolation - grdnv =( (fym (ix,iy,1)*pg(ix2,iy1 ,igsp) + + grdnv =( (fym (ix,iy,1)*pg(ix2,iy1 ,igsp) + . fy0 (ix,iy,1)*pg(ix2,iy ,igsp) + - . fyp (ix,iy,1)*pg(ix2,iy+1,igsp) + + . fyp (ix,iy,1)*pg(ix2,iy+1,igsp) + . fymx(ix,iy,1)*pg(ix ,iy1 ,igsp) + . fypx(ix,iy,1)*pg(ix, iy+1,igsp)) . - (fym (ix,iy,0)*pg(ix ,iy1 ,igsp) + . fy0 (ix,iy,0)*pg(ix ,iy ,igsp) + . fyp (ix,iy,0)*pg(ix ,iy+1,igsp) + - . fymx(ix,iy,0)*pg(ix4,iy1 ,igsp) + - . fypx(ix,iy,0)*pg(ix6,iy+1,igsp)) ) / + . fymx(ix,iy,0)*pg(ix4,iy1 ,igsp) + + . fypx(ix,iy,0)*pg(ix6,iy+1,igsp)) ) / . dxnog(ix,iy) endif difgx2 = ave( 1./nu1, @@ -6460,7 +6460,7 @@ call fd2tra (nx,ny,floxg,floyg,conxg,conyg, fngy(ix,iy,igsp) = fngy(ix,iy,igsp)/ . sqrt(1 + (fngy(ix,iy,igsp)/qfl)**2) enddo - enddo + enddo endif c... Finished with nonorthogonal mesh part @@ -6510,12 +6510,12 @@ call fd2tra (nx,ny,floxg,floyg,conxg,conyg, c ... diagnostic if isupgon=0, but used for uu and vy of the inertial c ... gas if isupgon=1. However, even when isupgon=1, the particle c ... fluxes are fngx -> fnix and fngy -> fngy in pandf, i.e., methg -c ... determines the differencing for the inertial particle fluxes, not +c ... determines the differencing for the inertial particle fluxes, not c ... methn do iy = j1, j5 do ix = i1,i5 ix1 = ixp1(ix,iy) - if (1.-rrv(ix,iy) > 1.e-4 .or. isupgon(igsp)==0) then + if (1.-rrv(ix,iy) > 1.e-4 .or. isupgon(igsp)==0) then #combine binormal/par comps or x only diffusive uug(ix,iy,igsp) = fngx(ix,iy,igsp) / ( . 0.5*(ng(ix,iy,igsp)+ng(ix1,iy,igsp)) @@ -6544,7 +6544,7 @@ call fd2tra (nx,ny,floxg,floyg,conxg,conyg, do iy = j4, j6 do ix = i1, i6 uu(ix,iy,iigsp) = uug(ix,iy,igsp) - v2(ix,iy,iigsp) = ( uuxg(ix,iy,igsp) + v2(ix,iy,iigsp) = ( uuxg(ix,iy,igsp) . - up(ix,iy,iigsp)*rrv(ix,iy) ) . /(rbfbt(ix,iy) + rbfbt(ixp1(ix,iy),iy))*2. enddo @@ -6555,7 +6555,7 @@ call fd2tra (nx,ny,floxg,floyg,conxg,conyg, if (isupgon(igsp).eq.0) then do 892 iy = j2, j5 - if ((isudsym==1.or.geometry.eq.'dnXtarget') .and. nxc > 1) then + if ((isudsym==1.or.geometry.eq.'dnXtarget') .and. nxc > 1) then fngx(nxc-1,iy,igsp) = 0. fngx(nxc, iy,igsp) = 0. fngx(nxc+1,iy,igsp) = 0. @@ -6578,14 +6578,14 @@ call fd2tra (nx,ny,floxg,floyg,conxg,conyg, . fluxfacy*(fngy(ix,iy,igsp) - fngy(ix,iy-1,igsp)) ) c ... IJ 2016/10/19 add MC neut flux if flags set - if (get_neutral_moments .and. cmneutdiv_fng .ne. 0.0) then - jfld=1 - sng_ue(ix,iy,jfld) = - ( + if (get_neutral_moments .and. cmneutdiv_fng .ne. 0.0) then + jfld=1 + sng_ue(ix,iy,jfld) = - ( . (fngx_ue(ix,iy,jfld)-fngx_ue(ix1,iy, jfld)) . +fluxfacy*(fngy_ue(ix,iy,jfld)-fngy_ue(ix,iy-1,jfld)) ) . *( (ng(ix,iy,jfld)*ti(ix,iy))/ . (ng(ix,iy,jfld)*ti(ix,iy)) ) - resng(ix,iy,igsp) = resng(ix,iy,igsp) + + resng(ix,iy,igsp) = resng(ix,iy,igsp) + . cmneutdiv*cmneutdiv_fng*sng_ue(ix,iy,igsp) endif @@ -6602,7 +6602,7 @@ call fd2tra (nx,ny,floxg,floyg,conxg,conyg, lmfp = sqrt(2*tg(ix,1,1)/(mi(1)*nuiz(ix,1,1)*nucx(ix,1,1))) tnuiz = tnuiz + exp(-pcolwid/lmfp + agdc*(ix-ixgb))* . nuiz(ix,1,1)/gx(ix,1) - enddo + enddo do ix = ixgb, nx+1 lmfp = sqrt(2*tg(ix,1,1)/(mi(1)*nuiz(ix,1,1)*nucx(ix,1,1))) tnuiz = tnuiz + exp(-pcolwid/lmfp)*nuiz(ix,1,1)/gx(ix,1) @@ -6637,7 +6637,7 @@ call fd2tra (nx,ny,floxg,floyg,conxg,conyg, c -------------------------------------------------------------------------- c Below subroutine neudifl is just like subroutine neudif, except that the -c log of the gas density is used, and then converted back to give the +c log of the gas density is used, and then converted back to give the c physically meaningful gas variables (flux, velocity, etc) c -------------------------------------------------------------------------- @@ -6676,7 +6676,7 @@ c physically meaningful gas variables (flux, velocity, etc) Use(Locflux) # floxg,floyg,conxg,conyg Use(Indices_domain_dcl) # iymnbcl,iymxbcl Use(Volsrc) # volpsorg - + * -- procedures -- real ave ave(t0,t1) = 2*t0*t1 / (cutlo+t0+t1) @@ -6684,7 +6684,7 @@ c physically meaningful gas variables (flux, velocity, etc) c ------------------ methgx = mod(methg, 10) methgy = methg/10 - + do 895 igsp = 1, ngsp c.... First the flux in the x-direction @@ -6724,17 +6724,17 @@ c physically meaningful gas variables (flux, velocity, etc) . fypx(ix,iy,1)*log(tg(ix, iy2,igsp)) ) . -( fym (ix,iy,0)*log(tg(ix ,iy1,igsp)) + . fy0 (ix,iy,0)*log(tg(ix ,iy ,igsp)) + - . fyp (ix,iy,0)*log(tg(ix ,iy2,igsp)) + + . fyp (ix,iy,0)*log(tg(ix ,iy2,igsp)) + . fymx(ix,iy,0)*log(tg(ix4,iy1,igsp)) + - . fypx(ix,iy,0)*log(tg(ix6,iy2,igsp)) ) )/ + . fypx(ix,iy,0)*log(tg(ix6,iy2,igsp)) ) )/ . dxnog(ix,iy) vygtan(ix,iy,igsp) = exp( 0.5* . (log(tg(ix2,iy,igsp))+log(tg(ix,iy,igsp))) )* . ( cngfx(igsp) / (mg(igsp)*0.5* . (nuix(ix,iy,igsp)+nuix(ix2,iy,igsp))) ) * - . ( grdnv/cos(angfx(ix,iy)) - + . ( grdnv/cos(angfx(ix,iy)) - . (log(tg(ix2,iy,igsp)) - log(tg(ix,iy,igsp))) - . * gxf(ix,iy) ) + . * gxf(ix,iy) ) if (islimon.eq.1.and. ix.eq.ix_lim.and. iy.ge.iy_lims) then vygtan(ix,iy,igsp) = 0. endif @@ -6765,7 +6765,7 @@ c physically meaningful gas variables (flux, velocity, etc) c... the temperature gradient term is included in floxg floxg(ix,iy) = qtgf / (1 + qr**flgamg)**(1/flgamg) c... now add the convective velocity for charge-exchange neutrals - if(igsp .eq. 1) floxg(ix,iy) = + if(igsp .eq. 1) floxg(ix,iy) = . floxg(ix,iy) + cngflox(1)*sx(ix,iy)*uu(ix,iy,1) floxg(ix,iy) = floxg(ix,iy)*2/(lng(ix,iy,igsp)+lng(ix2,iy,igsp)) @@ -6790,41 +6790,41 @@ c physically meaningful gas variables (flux, velocity, etc) . 0.5*(nuiz(ix,iy,igsp)+nuiz(ix,iy+1,igsp)) c csh = sy(ix,iy) * gyf(ix,iy) * ( (vtn**2+vtnp**2)/ c . (nuix(ix,iy,igsp)+nuix(ix,iy+1,igsp)) ) - qtgf = cngfy(igsp) * fgtdy(iy) * sy(ix,iy) * + qtgf = cngfy(igsp) * fgtdy(iy) * sy(ix,iy) * . ave( gy(ix,iy)/nuix(ix,iy,igsp) , . gy(ix,iy+1)/nuix(ix,iy+1,igsp) ) . * (vtn**2 - vtnp**2) if (isnonog.eq.1 .and. iy.le.ny) then if (isintlog .eq. 0 ) then - ty0 = fxm (ix,iy,0)*tg(ixm1(ix,iy) ,iy ,igsp) + + ty0 = fxm (ix,iy,0)*tg(ixm1(ix,iy) ,iy ,igsp) + . fx0 (ix,iy,0)*tg(ix ,iy ,igsp) + . fxp (ix,iy,0)*tg(ixp1(ix,iy) ,iy ,igsp) + . fxmy(ix,iy,0)*tg(ixm1(ix,iy+1),iy+1,igsp) + . fxpy(ix,iy,0)*tg(ixp1(ix,iy+1),iy+1,igsp) - ty1 = fxm (ix,iy,1)*tg(ixm1(ix,iy+1),iy+1,igsp) + + ty1 = fxm (ix,iy,1)*tg(ixm1(ix,iy+1),iy+1,igsp) + . fx0 (ix,iy,1)*tg(ix ,iy+1,igsp) + . fxp (ix,iy,1)*tg(ixp1(ix,iy+1),iy+1,igsp) + . fxmy(ix,iy,1)*tg(ixm1(ix,iy) ,iy ,igsp) + . fxpy(ix,iy,1)*tg(ixp1(ix,iy) ,iy ,igsp) elseif (isintlog .eq. 1) then - ty0=exp(fxm (ix,iy,0)*log(tg(ixm1(ix,iy) ,iy ,igsp)) + + ty0=exp(fxm (ix,iy,0)*log(tg(ixm1(ix,iy) ,iy ,igsp)) + . fx0 (ix,iy,0)*log(tg(ix ,iy ,igsp)) + . fxp (ix,iy,0)*log(tg(ixp1(ix,iy) ,iy ,igsp)) + . fxmy(ix,iy,0)*log(tg(ixm1(ix,iy+1),iy+1,igsp)) + . fxpy(ix,iy,0)*log(tg(ixp1(ix,iy+1),iy+1,igsp)) ) - ty1=exp(fxm (ix,iy,1)*log(tg(ixm1(ix,iy+1),iy+1,igsp)) + + ty1=exp(fxm (ix,iy,1)*log(tg(ixm1(ix,iy+1),iy+1,igsp)) + . fx0 (ix,iy,1)*log(tg(ix ,iy+1,igsp)) + . fxp (ix,iy,1)*log(tg(ixp1(ix,iy+1),iy+1,igsp)) + . fxmy(ix,iy,1)*log(tg(ixm1(ix,iy) ,iy ,igsp)) + . fxpy(ix,iy,1)*log(tg(ixp1(ix,iy) ,iy ,igsp )) ) endif - qtgf = cngfy(igsp) * fgtdy(iy) * sy(ix,iy) * + qtgf = cngfy(igsp) * fgtdy(iy) * sy(ix,iy) * . ave( gy(ix,iy)/nuix(ix,iy,igsp) , . gy(ix,iy+1)/nuix(ix,iy+1,igsp) ) * . (ty0 - ty1)/mg(igsp) endif # Better interpolation of nuix could be done here nconv = 2.0*(ngy0(ix,iy,igsp)*ngy1(ix,iy,igsp)) / - . (ngy0(ix,iy,igsp)+ngy1(ix,iy,igsp)) + . (ngy0(ix,iy,igsp)+ngy1(ix,iy,igsp)) c... Use upwind for "convective" grad T term if methgy .ne. 2 if(methgy.ne.2) nconv = . ngy0(ix,iy,igsp)*0.5*(1+sign(1.,qtgf)) + @@ -6845,7 +6845,7 @@ c physically meaningful gas variables (flux, velocity, etc) c... the temperature gradient term is included in floyg floyg(ix,iy) = qtgf / (1 + qr**flgamg)**(1/flgamg) c... now add the convective velocity for the charge-exchange species - if(igsp .eq. 1) floyg(ix,iy) = + if(igsp .eq. 1) floyg(ix,iy) = . floyg(ix,iy)+cngfloy(1)*sy(ix,iy)*vy(ix,iy,1) floyg(ix,iy)=floyg(ix,iy)*2/(lng(ix,iy,igsp)+lng(ix,iy+1,igsp)) @@ -6871,23 +6871,23 @@ call fd2tra (nx,ny,floxg,floyg,conxg,conyg, ix3 = ixm1(ix,iy1) ix4 = ixp1(ix,iy1) ix5 = ixm1(ix,iy+1) - ix6 = ixp1(ix,iy+1) + ix6 = ixp1(ix,iy+1) ccc MER: Set flag to apply xy flux limit except at target plates isxyfl = .true. do jx = 1, nxpt if ( (ix==ixlb(jx).and.ixmnbcl==1) .or. . (ix==ixrb(jx).and.ixmxbcl==1) )isxyfl = .false. enddo - grdnv =( (fym (ix,iy,1)*lng(ix2,iy1 ,igsp) + + grdnv =( (fym (ix,iy,1)*lng(ix2,iy1 ,igsp) + . fy0 (ix,iy,1)*lng(ix2,iy ,igsp) + - . fyp (ix,iy,1)*lng(ix2,iy+1,igsp) + + . fyp (ix,iy,1)*lng(ix2,iy+1,igsp) + . fymx(ix,iy,1)*lng(ix ,iy1 ,igsp) + . fypx(ix,iy,1)*lng(ix, iy+1,igsp)) . - (fym (ix,iy,0)*lng(ix ,iy1 ,igsp) + . fy0 (ix,iy,0)*lng(ix ,iy ,igsp) + . fyp (ix,iy,0)*lng(ix ,iy+1,igsp) + - . fymx(ix,iy,0)*lng(ix4,iy1 ,igsp) + - . fypx(ix,iy,0)*lng(ix6,iy+1,igsp)) ) / + . fymx(ix,iy,0)*lng(ix4,iy1 ,igsp) + + . fypx(ix,iy,0)*lng(ix6,iy+1,igsp)) ) / . dxnog(ix,iy) difgx2 = ave( tg(ix ,iy,igsp)/nuix(ix ,iy,igsp), @@ -6928,7 +6928,7 @@ call fd2tra (nx,ny,floxg,floyg,conxg,conyg, c ... diagnostic if isupgon=0, but used for uu and vy of the inertial c ... gas if isupgon=1. However, even when isupgon=1, the particle c ... fluxes are fngx -> fnix and fngy -> fngy in pandf, i.e., methg -c ... determines the differencing for the inertial particle fluxes, not +c ... determines the differencing for the inertial particle fluxes, not c ... methn do iy = j1, j5 do ix = i1,i5 @@ -6985,7 +6985,7 @@ cc uu(ix,iy,iigsp) = uug(ix,iy,igsp) ix1 = ixm1(ix,iy) resng(ix,iy,igsp) = cngsor * (psorg(ix,iy,igsp) + . psorcxg(ix,iy,igsp) + psorrg(ix,iy,igsp)) - . + volpsorg(ix,iy,igsp) + . + volpsorg(ix,iy,igsp) . - fngx(ix,iy,igsp) + fngx(ix1,iy ,igsp) . - fluxfacy*(fngy(ix,iy,igsp) - fngy(ix ,iy-1,igsp)) . + psgov_use(ix,iy,igsp)*vol(ix,iy) @@ -7005,7 +7005,7 @@ cc uu(ix,iy,iigsp) = uug(ix,iy,igsp) lmfp = sqrt(2*tg(ix,1,1)/(mi(1)*nuiz(ix,1,1)*nucx(ix,1,1))) tnuiz = tnuiz + exp(-pcolwid/lmfp + agdc*(ix-ixgb))* . nuiz(ix,1,1)/gx(ix,1) - enddo + enddo do ix = ixgb, nx+1 lmfp = sqrt(2*tg(ix,1,1)/(mi(1)*nuiz(ix,1,1)*nucx(ix,1,1))) tnuiz = tnuiz + exp(-pcolwid/lmfp)*nuiz(ix,1,1)/gx(ix,1) @@ -7075,7 +7075,7 @@ cc uu(ix,iy,iigsp) = uug(ix,iy,igsp) Use(Locflux) # floxg,floyg,conxg,conyg Use(Indices_domain_dcl) # iymnbcl,iymxbcl Use(Volsrc) # volpsorg - + * -- procedures -- real ave ave(t0,t1) = 2*t0*t1 / (cutlo+t0+t1) @@ -7125,7 +7125,7 @@ cc uu(ix,iy,iigsp) = uug(ix,iy,igsp) . fypx(ix,iy,1)*tg(ix, iy2,igsp) - . fym (ix,iy,0)*tg(ix ,iy1,igsp) - . fy0 (ix,iy,0)*tg(ix ,iy ,igsp) - - . fyp (ix,iy,0)*tg(ix ,iy2,igsp) - + . fyp (ix,iy,0)*tg(ix ,iy2,igsp) - . fymx(ix,iy,0)*tg(ix4,iy1,igsp) - . fypx(ix,iy,0)*tg(ix6,iy2,igsp) )/dxnog(ix,iy) elseif (isintlog .eq. 1) then @@ -7136,16 +7136,16 @@ cc uu(ix,iy,iigsp) = uug(ix,iy,igsp) . fypx(ix,iy,1)*log(tg(ix, iy2,igsp)) ) . -exp( fym (ix,iy,0)*log(tg(ix ,iy1,igsp)) + . fy0 (ix,iy,0)*log(tg(ix ,iy ,igsp)) + - . fyp (ix,iy,0)*log(tg(ix ,iy2,igsp)) + + . fyp (ix,iy,0)*log(tg(ix ,iy2,igsp)) + . fymx(ix,iy,0)*log(tg(ix4,iy1,igsp)) + - . fypx(ix,iy,0)*log(tg(ix6,iy2,igsp)) ) )/ + . fypx(ix,iy,0)*log(tg(ix6,iy2,igsp)) ) )/ . dxnog(ix,iy) endif vygtan(ix,iy,igsp) = ( cngfx(igsp) / (mg(igsp)*0.5* . (nuix(ix,iy,igsp)+nuix(ix2,iy,igsp))) ) * - . ( grdnv/cos(angfx(ix,iy)) - + . ( grdnv/cos(angfx(ix,iy)) - . (tg(ix2,iy,igsp) - tg(ix,iy,igsp)) - . * gxf(ix,iy) ) + . * gxf(ix,iy) ) if (islimon.eq.1.and. ix.eq.ix_lim.and. iy.ge.iy_lims) then vygtan(ix,iy,igsp) = 0. endif @@ -7179,7 +7179,7 @@ cc uu(ix,iy,iigsp) = uug(ix,iy,igsp) c... the temperature gradient term is included in floxg floxg(ix,iy) = qtgf / (1 + qr**flgamg)**(1/flgamg) c... now add the convective velocity for charge-exchange neutrals - if(igsp .eq. 1) floxg(ix,iy) = + if(igsp .eq. 1) floxg(ix,iy) = . floxg(ix,iy) + cngflox(1)*sx(ix,iy)*uu(ix,iy,1) 887 continue @@ -7195,8 +7195,8 @@ cc uu(ix,iy,iigsp) = uug(ix,iy,igsp) vtn = sqrt( t0/mg(igsp) ) vtnp = sqrt( t1/mg(igsp) ) qfl = flalfgya(iy,igsp) * sy(ix,iy) * (vtn + vtnp)*rt8opi* - . ( ngy0(ix,iy,igsp)*gy(ix,iy) + - . ngy1(ix,iy,igsp)*gy(ix,iy+1) ) / + . ( ngy0(ix,iy,igsp)*gy(ix,iy) + + . ngy1(ix,iy,igsp)*gy(ix,iy+1) ) / . (8*(gy(ix,iy)+gy(ix,iy+1))) csh = (1-isgasdc) * (cdifg(igsp) *sy(ix,iy) /dynog(ix,iy)) * . ave( vtn**2/nuix(ix,iy,igsp) , @@ -7206,41 +7206,41 @@ cc uu(ix,iy,iigsp) = uug(ix,iy,igsp) . 0.5*(nuiz(ix,iy,igsp)+nuiz(ix,iy+1,igsp)) c csh = sy(ix,iy) * ( ((vtn**2+vtnp**2)/ dynog(ix,iy)) / c . (nuix(ix,iy,igsp)+nuix(ix,iy+1,igsp)) ) - qtgf = cngfy(igsp) * fgtdy(iy) * sy(ix,iy) * + qtgf = cngfy(igsp) * fgtdy(iy) * sy(ix,iy) * . ave( gy(ix,iy)/nuix(ix,iy,igsp) , . gy(ix,iy+1)/nuix(ix,iy+1,igsp) ) . * (vtn**2 - vtnp**2) if (isnonog.eq.1 .and. iy.le.ny) then if (isintlog .eq. 0) then - ty0 = fxm (ix,iy,0)*tg(ixm1(ix,iy) ,iy ,igsp) + + ty0 = fxm (ix,iy,0)*tg(ixm1(ix,iy) ,iy ,igsp) + . fx0 (ix,iy,0)*tg(ix ,iy ,igsp) + . fxp (ix,iy,0)*tg(ixp1(ix,iy) ,iy ,igsp) + . fxmy(ix,iy,0)*tg(ixm1(ix,iy+1),iy+1,igsp) + . fxpy(ix,iy,0)*tg(ixp1(ix,iy+1),iy+1,igsp) - ty1 = fxm (ix,iy,1)*tg(ixm1(ix,iy+1),iy+1,igsp) + + ty1 = fxm (ix,iy,1)*tg(ixm1(ix,iy+1),iy+1,igsp) + . fx0 (ix,iy,1)*tg(ix ,iy+1,igsp) + . fxp (ix,iy,1)*tg(ixp1(ix,iy+1),iy+1,igsp) + . fxmy(ix,iy,1)*tg(ixm1(ix,iy) ,iy ,igsp) + . fxpy(ix,iy,1)*tg(ixp1(ix,iy) ,iy ,igsp) elseif (isintlog .eq. 1) then - ty0=exp(fxm (ix,iy,0)*log(tg(ixm1(ix,iy) ,iy ,igsp)) + + ty0=exp(fxm (ix,iy,0)*log(tg(ixm1(ix,iy) ,iy ,igsp)) + . fx0 (ix,iy,0)*log(tg(ix ,iy ,igsp)) + . fxp (ix,iy,0)*log(tg(ixp1(ix,iy) ,iy ,igsp)) + . fxmy(ix,iy,0)*log(tg(ixm1(ix,iy+1),iy+1,igsp)) + . fxpy(ix,iy,0)*log(tg(ixp1(ix,iy+1),iy+1,igsp)) ) - ty1=exp(fxm (ix,iy,1)*log(tg(ixm1(ix,iy+1),iy+1,igsp)) + + ty1=exp(fxm (ix,iy,1)*log(tg(ixm1(ix,iy+1),iy+1,igsp)) + . fx0 (ix,iy,1)*log(tg(ix ,iy+1,igsp)) + . fxp (ix,iy,1)*log(tg(ixp1(ix,iy+1),iy+1,igsp)) + . fxmy(ix,iy,1)*log(tg(ixm1(ix,iy) ,iy ,igsp)) + . fxpy(ix,iy,1)*log(tg(ixp1(ix,iy) ,iy ,igsp)) ) endif - qtgf = cngfy(igsp) * fgtdy(iy) * sy(ix,iy) * + qtgf = cngfy(igsp) * fgtdy(iy) * sy(ix,iy) * . ave( gy(ix,iy)/nuix(ix,iy,igsp) , . gy(ix,iy+1)/nuix(ix,iy+1,igsp) ) * . (ty0 - ty1)/mg(igsp) endif # Better interpolation of nuix could be done here nconv = 2.0*(ngy0(ix,iy,igsp)*ngy1(ix,iy,igsp)) / - . (ngy0(ix,iy,igsp)+ngy1(ix,iy,igsp)) + . (ngy0(ix,iy,igsp)+ngy1(ix,iy,igsp)) c... Use upwind for "convective" grad T term if methgy .ne. 2 if(methgy.ne.2) nconv = . ngy0(ix,iy,igsp)*0.5*(1+sign(1.,qtgf)) + @@ -7259,9 +7259,9 @@ cc uu(ix,iy,iigsp) = uug(ix,iy,igsp) if (isdifyg_aug .eq. 1) conyg(ix,iy) = csh*(1+qr) #augment diffusion c... the temperature gradient term is included in floyg - floyg(ix,iy) = qtgf / (1 + qr**flgamg)**(1/flgamg) + floyg(ix,iy) = qtgf / (1 + qr**flgamg)**(1/flgamg) c... now add the convective velocity for the charge-exchange species - if(igsp .eq. 1) floyg(ix,iy) = + if(igsp .eq. 1) floyg(ix,iy) = . floyg(ix,iy)+cngfloy(1)*sy(ix,iy)*vy(ix,iy,1) 889 continue @@ -7306,8 +7306,8 @@ call fd2tra (nx,ny,floxg,floyg,conxg,conyg, . ng(ix,iy,igsp)/ng(ix,iy+1,igsp)) ) endif enddo - enddo - endif + enddo + endif c... Addition for nonorthogonal mesh if (isnonog .eq. 1) then @@ -7320,42 +7320,42 @@ call fd2tra (nx,ny,floxg,floyg,conxg,conyg, ix3 = ixm1(ix,iy1) ix4 = ixp1(ix,iy1) ix5 = ixm1(ix,iy+1) - ix6 = ixp1(ix,iy+1) + ix6 = ixp1(ix,iy+1) if (methgx .eq. 6) then # log interpolation - grdnv =( exp(fym (ix,iy,1)*log(ng(ix2,iy1 ,igsp)) + + grdnv =( exp(fym (ix,iy,1)*log(ng(ix2,iy1 ,igsp)) + . fy0 (ix,iy,1)*log(ng(ix2,iy ,igsp)) + - . fyp (ix,iy,1)*log(ng(ix2,iy+1,igsp)) + + . fyp (ix,iy,1)*log(ng(ix2,iy+1,igsp)) + . fymx(ix,iy,1)*log(ng(ix ,iy1 ,igsp)) + . fypx(ix,iy,1)*log(ng(ix, iy+1,igsp))) . - exp(fym (ix,iy,0)*log(ng(ix ,iy1 ,igsp)) + . fy0 (ix,iy,0)*log(ng(ix ,iy ,igsp)) + . fyp (ix,iy,0)*log(ng(ix ,iy+1,igsp)) + - . fymx(ix,iy,0)*log(ng(ix4,iy1 ,igsp)) + - . fypx(ix,iy,0)*log(ng(ix6,iy+1,igsp))) ) / + . fymx(ix,iy,0)*log(ng(ix4,iy1 ,igsp)) + + . fypx(ix,iy,0)*log(ng(ix6,iy+1,igsp))) ) / . dxnog(ix,iy) elseif (methgx .eq. 7) then # inverse interpolation - grdnv =( 1/(fym (ix,iy,1)/ng(ix2,iy1 ,igsp) + + grdnv =( 1/(fym (ix,iy,1)/ng(ix2,iy1 ,igsp) + . fy0 (ix,iy,1)/ng(ix2,iy ,igsp) + - . fyp (ix,iy,1)/ng(ix2,iy+1,igsp) + + . fyp (ix,iy,1)/ng(ix2,iy+1,igsp) + . fymx(ix,iy,1)/ng(ix ,iy1 ,igsp) + . fypx(ix,iy,1)/ng(ix, iy+1,igsp)) . - 1/(fym (ix,iy,0)/ng(ix ,iy1 ,igsp) + . fy0 (ix,iy,0)/ng(ix ,iy ,igsp) + . fyp (ix,iy,0)/ng(ix ,iy+1,igsp) + - . fymx(ix,iy,0)/ng(ix4,iy1 ,igsp) + - . fypx(ix,iy,0)/ng(ix6,iy+1,igsp)) ) / + . fymx(ix,iy,0)/ng(ix4,iy1 ,igsp) + + . fypx(ix,iy,0)/ng(ix6,iy+1,igsp)) ) / . dxnog(ix,iy) else # linear interpolation - grdnv =( (fym (ix,iy,1)*ng(ix2,iy1 ,igsp) + + grdnv =( (fym (ix,iy,1)*ng(ix2,iy1 ,igsp) + . fy0 (ix,iy,1)*ng(ix2,iy ,igsp) + - . fyp (ix,iy,1)*ng(ix2,iy+1,igsp) + + . fyp (ix,iy,1)*ng(ix2,iy+1,igsp) + . fymx(ix,iy,1)*ng(ix ,iy1 ,igsp) + . fypx(ix,iy,1)*ng(ix, iy+1,igsp)) . - (fym (ix,iy,0)*ng(ix ,iy1 ,igsp) + . fy0 (ix,iy,0)*ng(ix ,iy ,igsp) + . fyp (ix,iy,0)*ng(ix ,iy+1,igsp) + - . fymx(ix,iy,0)*ng(ix4,iy1 ,igsp) + - . fypx(ix,iy,0)*ng(ix6,iy+1,igsp)) ) / + . fymx(ix,iy,0)*ng(ix4,iy1 ,igsp) + + . fypx(ix,iy,0)*ng(ix6,iy+1,igsp)) ) / . dxnog(ix,iy) endif difgx2 = ave( tg(ix ,iy,igsp)/nuix(ix ,iy,igsp), @@ -7404,7 +7404,7 @@ call fd2tra (nx,ny,floxg,floyg,conxg,conyg, ix1 = ixm1(ix,iy) resng(ix,iy,igsp) = cngsor * (psorg(ix,iy,igsp) + . psorcxg(ix,iy,igsp) + psorrg(ix,iy,igsp)) - . + volpsorg(ix,iy,igsp) + . + volpsorg(ix,iy,igsp) . - fngx(ix,iy,igsp) + fngx(ix1,iy ,igsp) . - fngy(ix,iy,igsp) + fngy(ix ,iy-1,igsp) . + psgov_use(ix,iy,igsp)*vol(ix,iy) @@ -7422,7 +7422,7 @@ call fd2tra (nx,ny,floxg,floyg,conxg,conyg, c --- The fngxy contribution could have been kept separate and added to c --- fnix in PARBAL, but we include it here so that it automatically gets c --- taken into account in PARBAL and MOMBAL_B2. -c --- By multiplying uu(,,2) with sx*ng in PARBAL we get the +c --- By multiplying uu(,,2) with sx*ng in PARBAL we get the c --- TOTAL neutral particle flux out of the poloidal face. c --- By multiplying uu(,,2) with sx*ng*mi(1)*up(,,iigsp) in MOMBAL_B2 c --- we get the TOTAL parallel momentum flux out of the poloidal face. @@ -7451,7 +7451,7 @@ call fd2tra (nx,ny,floxg,floyg,conxg,conyg, lmfp = sqrt(2*tg(ix,1,1)/(mi(1)*nuiz(ix,1,1)*nucx(ix,1,1))) tnuiz = tnuiz + exp(-pcolwid/lmfp + agdc*(ix-ixgb))* . nuiz(ix,1,1)/gx(ix,1) - enddo + enddo do ix = ixgb, nx+1 lmfp = sqrt(2*tg(ix,1,1)/(mi(1)*nuiz(ix,1,1)*nucx(ix,1,1))) tnuiz = tnuiz + exp(-pcolwid/lmfp)*nuiz(ix,1,1)/gx(ix,1) @@ -7545,7 +7545,7 @@ call fd2tra (nx,ny,floxg,floyg,conxg,conyg, enddo do igsp = 1, ngsp - if(istgon(igsp) == 1) then + if(istgon(igsp) == 1) then do iy = j2, j5 do ix = i2, i5 ix1 = ixm1(ix,iy) @@ -7553,7 +7553,7 @@ call fd2tra (nx,ny,floxg,floyg,conxg,conyg, iy1 = max(0,iy-1) tv = (pg(ix2,iy,igsp) - pg(ix ,iy,igsp)) t1 = (pg(ix ,iy,igsp) - pg(ix1,iy,igsp)) - segc(ix,iy,igsp) = 0.5*cvgpg*( + segc(ix,iy,igsp) = 0.5*cvgpg*( , uuxg(ix, iy,igsp)*ave(gx(ix2,iy),gx(ix, iy))*tv + . uuxg(ix1,iy,igsp)*ave(gx(ix ,iy),gx(ix1,iy))*t1 )* . vol(ix,iy) @@ -7596,7 +7596,7 @@ call fd2tra (nx,ny,floxg,floyg,conxg,conyg, vt0 = sqrt(t0/mg(igsp)) vt1 = sqrt(t1/mg(igsp)) c... flux-limit occurs in building hcxg - do not flux-limit 2nd time - conxge(ix,iy,igsp) = sx(ix,iy) * hcxg(ix,iy,igsp) * gxf(ix,iy) + conxge(ix,iy,igsp) = sx(ix,iy) * hcxg(ix,iy,igsp) * gxf(ix,iy) enddo conxge(nx+1,iy,igsp) = 0 enddo @@ -7663,7 +7663,7 @@ call fd2tra (nx,ny,floxg,floyg,conxg,conyg, enddo enddo enddo - + * -- Correct bdry:remove any inward power from walls; ok in parallel do igsp = 1, ngsp do ix = i4, i8 @@ -7690,7 +7690,7 @@ call fd2tra (nx,ny,floxg,floyg,conxg,conyg, * -- Combine conduction/convection to compute thermal energy flow -- do igsp = 1,ngsp if(istgon(igsp) == 1) then - call fd2tra (nx,ny,floxge(0:nx+1,0:ny+1,igsp), + call fd2tra (nx,ny,floxge(0:nx+1,0:ny+1,igsp), . floyge(0:nx+1,0:ny+1,igsp), conxge(0:nx+1,0:ny+1,igsp), . conyge(0:nx+1,0:ny+1,igsp),tg(0:nx+1,0:ny+1,igsp), . fegx(0:nx+1,0:ny+1,igsp),fegy(0:nx+1,0:ny+1,igsp), @@ -7698,7 +7698,7 @@ call fd2tra (nx,ny,floxge(0:nx+1,0:ny+1,igsp), endif enddo -c... Add y-component of nonorthogonal diffusive flux; convective component +c... Add y-component of nonorthogonal diffusive flux; convective component c... already added to uug(ix,iy,igsp) if (isnonog == 1) then do igsp = 1, ngsp @@ -7713,7 +7713,7 @@ call fd2tra (nx,ny,floxge(0:nx+1,0:ny+1,igsp), ix4 = ixp1(ix,iy1) ix5 = ixm1(ix,iy+1) ix6 = ixp1(ix,iy+1) - t0 = max(tg(ix,iy,igsp),tgmin*ev) + t0 = max(tg(ix,iy,igsp),tgmin*ev) t1 = max(tg(ix2,iy,igsp),tgmin*ev) vtn = sqrt( t0/mg(igsp) ) vtnp = sqrt( t1/mg(igsp) ) @@ -7723,17 +7723,17 @@ call fd2tra (nx,ny,floxge(0:nx+1,0:ny+1,igsp), c --- Note: this four-point average results in not getting the full Jac. for c --- a nonorthogonal mesh because of ngy1,0 - see def. of hcyn - grdnv =( ( fym (ix,iy,1)*log(tg(ix2,iy1 ,igsp)) + + grdnv =( ( fym (ix,iy,1)*log(tg(ix2,iy1 ,igsp)) + . fy0 (ix,iy,1)*log(tg(ix2,iy ,igsp)) + - . fyp (ix,iy,1)*log(tg(ix2,iy+1,igsp)) + + . fyp (ix,iy,1)*log(tg(ix2,iy+1,igsp)) + . fymx(ix,iy,1)*log(tg(ix ,iy1 ,igsp)) + - . fypx(ix,iy,1)*log(tg(ix ,iy+1,igsp)) ) + . fypx(ix,iy,1)*log(tg(ix ,iy+1,igsp)) ) . -( fym (ix,iy,0)*log(tg(ix ,iy1 ,igsp)) + . fy0 (ix,iy,0)*log(tg(ix ,iy ,igsp)) + . fyp (ix,iy,0)*log(tg(ix ,iy+1,igsp)) + - . fymx(ix,iy,0)*log(tg(ix4,iy1 ,igsp)) + - . fypx(ix,iy,0)*log(tg(ix6,iy+1,igsp)) ) ) / - . dxnog(ix,iy) + . fymx(ix,iy,0)*log(tg(ix4,iy1 ,igsp)) + + . fypx(ix,iy,0)*log(tg(ix6,iy+1,igsp)) ) ) / + . dxnog(ix,iy) difgx2 = ave( tg(ix ,iy,igsp)/nu1, . tg(ix2,iy,igsp)/nu2 )/mg(igsp) . + rld2dxg(igsp)**2*(1/gxf(ix,iy)**2)* @@ -7751,10 +7751,10 @@ call fd2tra (nx,ny,floxge(0:nx+1,0:ny+1,igsp), vttn = t0*sqrt( t0/mg(igsp) ) vttp = t1*sqrt( t1/mg(igsp) ) if(isfegxyqflave == 0) then - qfl = flalftgxy(igsp)*0.25*sx(ix,iy) * (vttn+vttp) * + qfl = flalftgxy(igsp)*0.25*sx(ix,iy) * (vttn+vttp) * . (ng(ix,iy,igsp)+ng(ix2,iy,igsp)) else #use harmonic average of T*vt and ng to face - qfl = flalftgxy(igsp) * sx(ix,iy) * ave(vttn,vttp) * + qfl = flalftgxy(igsp) * sx(ix,iy) * ave(vttn,vttp) * . ave(ng(ix,iy,igsp),ng(ix2,iy,igsp)) endif fegxy(ix,iy,igsp) = fegxy(ix,iy,igsp) / @@ -7779,7 +7779,7 @@ call fd2tra (nx,ny,floxge(0:nx+1,0:ny+1,igsp), reseg(ix,iy,igsp)= -( fegx(ix,iy,igsp)-fegx(ix1,iy, igsp)+ . fegy(ix,iy,igsp)-fegy(ix, iy1,igsp) ) . + segc(ix,iy,igsp) - reseg(ix,iy,igsp)= reseg(ix,iy,igsp) + vol(ix,iy)* + reseg(ix,iy,igsp)= reseg(ix,iy,igsp) + vol(ix,iy)* . eqpg(ix,iy,igsp)*(ti(ix,iy)-tg(ix,iy,igsp))#+ # . cftgdiss(igsp)*psorg(ix,iy,igsp)*tg(ix,iy,igsp) if (igsp.eq.1) then #..for D0, we should include D+ and D0 in Ti @@ -7830,9 +7830,9 @@ call fd2tra (nx,ny,floxge(0:nx+1,0:ny+1,igsp), if((isudsym==1.or.geometry.eq.'dnXtarget') .and. nxc > 1) then do igsp = 1, ngsp do iy = j2, j5 - fegx(nxc-1,iy,igsp) = 0. - fegx(nxc ,iy,igsp) = 0. - fegx(nxc+1,iy,igsp) = 0. + fegx(nxc-1,iy,igsp) = 0. + fegx(nxc ,iy,igsp) = 0. + fegx(nxc+1,iy,igsp) = 0. enddo enddo endif @@ -7865,14 +7865,14 @@ call fd2tra (nx,ny,floxge(0:nx+1,0:ny+1,igsp), c----------------------------------------------------------------------- subroutine pandf1(xc, yc, ieq, neq, time, yl, yldot) -c ... Calculates matrix A and the right-hand side depending on the +c ... Calculates matrix A and the right-hand side depending on the c values of xc, yc. c Definitions for argument list c c Input variables: -c xc is poloidal index of perturbed variablefor Jacobian calc, +c xc is poloidal index of perturbed variablefor Jacobian calc, c or =-1 for full RHS evaluation -c yc is radial index for perturbed variable for Jacobian calc, +c yc is radial index for perturbed variable for Jacobian calc, c or =-1 for full RHS evaluation c ieq is the eqn number for Jacobian eval; not presently used c neq is the total number of variables @@ -7940,7 +7940,7 @@ call pandf (xc, yc, neq, time, yl, yldot) call xerrab('***Both 1/nufak and dtreal < 1.e5 - illegal***') endif -c... Add a real timestep, dtreal, to the nksol equations +c... Add a real timestep, dtreal, to the nksol equations c... NOTE!! condition yl(neq+1).lt.0 means a call from nksol, not jac_calc if(dtreal < 1.e15) then @@ -7956,7 +7956,7 @@ call xerrab('***Both 1/nufak and dtreal < 1.e5 - illegal***') j5l = ny+1-(1-iymxbcl) i2l = (1-ixmnbcl) i5l = nx+1-(1-ixmxbcl) - endif + endif do iy = j2l, j5l # if j2l=j2, etc., omit the boundary equations do ix = i2l, i5l do ifld = 1, nisp @@ -7971,7 +7971,7 @@ call xerrab('***Both 1/nufak and dtreal < 1.e5 - illegal***') endif endif enddo - if(ix.ne.nx+2*isbcwdt) then + if(ix.ne.nx+2*isbcwdt) then # nx test - for algebr. eq. unless isbcwdt=1 do ifld = 1, nusp if(isuponxy(ix,iy,ifld).eq.1) then @@ -7984,7 +7984,7 @@ call xerrab('***Both 1/nufak and dtreal < 1.e5 - illegal***') if (isteonxy(ix,iy) == 1) then iv = idxte(ix,iy) yldot(iv) = (1.-fdttexy(ix,iy))*yldot(iv) - yldot(iv) = yldot(iv) - (yl(iv)-ylodt(iv))/dtuse(iv) + yldot(iv) = yldot(iv) - (yl(iv)-ylodt(iv))/dtuse(iv) endif if (istionxy(ix,iy) == 1) then iv1 = idxti(ix,iy) @@ -8018,7 +8018,7 @@ call xerrab('***Both 1/nufak and dtreal < 1.e5 - illegal***') enddo enddo - + C... Now do an additional relaxation of the potential equations with c... timestep dtphi if (dtphi < 1e10) then @@ -8110,12 +8110,12 @@ ccc if (isngonxy(ix,iy,1) .eq. 1) nbidot = cngtgx(1)*yldot(idxg(ix,iy if (isuponxy(ix,iy,ifld) .eq. 1) then ix1 = ixp1(ix,iy) iv2 = idxu(ix,iy,ifld) - if (iseqalg(iv2)== 0.and.isnionxy(ix,iy,ifld)==1) then + if (iseqalg(iv2)== 0.and.isnionxy(ix,iy,ifld)==1) then iv = idxn(ix,iy,ifld) iv1 = idxn(ix1,iy,ifld) yldot_np1 = resco(ix1,iy,ifld)/(vol(ix1,iy)*n0(ifld)) # need to use resco rather than yldot if dtreal is added; recursive prob. -c .... Fix limiter case with algebraic eqns, not ODEs +c .... Fix limiter case with algebraic eqns, not ODEs if (iseqalg(iv).eq.1) then if (isnupdot1sd == 0) then nbvdot = yldot_np1*n0(ifld) @@ -8143,15 +8143,15 @@ ccc if (isngonxy(ix,iy,1) .eq. 1) nbidot = cngtgx(1)*yldot(idxg(ix,iy if(isteonxy(ix,iy) == 1) then iv = idxte(ix,iy) if(iseqalg(iv) == 0) then - yldot(iv) = ( yldot(iv)*nnorm - + yldot(iv) = ( yldot(iv)*nnorm - . yl(iv)*nbedot ) / ne(ix,iy) endif endif if(istionxy(ix,iy) == 1) then iv1 = idxti(ix,iy) - if (iseqalg(iv1) == 0) then + if(iseqalg(iv1) == 0) then if(isupgon(1)==1) then - yldot(iv1) = ( yldot(iv1)*nnorm - + yldot(iv1) = ( yldot(iv1)*nnorm - . yl(iv1)*(nbidot + cftiexclg*nbgdot) ) / . (nit(ix,iy) + cftiexclg*ni(ix,iy,2) ) else @@ -8161,10 +8161,10 @@ ccc if (isngonxy(ix,iy,1) .eq. 1) nbidot = cngtgx(1)*yldot(idxg(ix,iy endif endif endif - do igsp = 1, ngsp + do igsp = 1, ngsp if (igsp == 1 .and. isupgon(1) == 1) then - if (istgonxy(ix,iy,igsp) == 1) then - iv = idxtg(ix,iy,igsp) + if(istgonxy(ix,iy,igsp) == 1) then + iv = idxtg(ix,iy,igsp) if (iseqalg(iv).eq.0) then # yldot(iv) = ( yldot(iv)*n0g(igsp) - # . yl(iv)*yldot(idxn(ix,iy,iigsp))*n0(ifld) ) @@ -8182,9 +8182,9 @@ ccc if (isngonxy(ix,iy,1) .eq. 1) nbidot = cngtgx(1)*yldot(idxg(ix,iy # . yl(iv)*yldot(idxg(ix,iy,igsp))*n0g(igsp) ) # . /ng(ix,iy,igsp) #..the above one causes problem when turning off ng(:,:,2) - yldot(iv) = ( yldot(iv)*n0g(igsp) - - . yl(iv)*nbg2dot(igsp) ) / ng(ix,iy,igsp) - endif + yldot(iv) = ( yldot(iv)*n0g(igsp) - + . yl(iv)*nbg2dot(igsp) )/ng(ix,iy,igsp) + endif endif endif enddo @@ -8198,7 +8198,7 @@ ccc if (isngonxy(ix,iy,1) .eq. 1) nbidot = cngtgx(1)*yldot(idxg(ix,iy c ------------------------------------------------------------------------- subroutine volsor -* VOLSOR defines volume particle and power sources for the ions and +* VOLSOR defines volume particle and power sources for the ions and * electrons. Input is total current, power, and shape of 2-D Gaussians implicit none @@ -8229,7 +8229,7 @@ ccc if (isngonxy(ix,iy,1) .eq. 1) nbidot = cngtgx(1)*yldot(idxg(ix,iy c... Initialize values and arrays nj = nxomit - effvni = 0. + effvni = 0. effvup = 0. effvpe = 0. effvpi = 0. @@ -8253,7 +8253,7 @@ call s2fill (nx+2, ny+2, 0., volmsor(0:nx+1,0:ny+1,ifld), 1, nx+2) do igsp = 1, ngsp call s2fill (nx+2, ny+2, 0., volpsorg(0:nx+1,0:ny+1,igsp), 1, nx+2) ivolcurgt = ivolcurgt + ivolcurg(igsp) - enddo + enddo cccMER NOTE: generalize the following for multiple x-points cc Define index ranges for a localized ion-loss sink; crude & temporary if (ix_sjcsor .gt. 0) then @@ -8290,20 +8290,20 @@ call s2fill (nx+2, ny+2, 0., volpsorg(0:nx+1,0:ny+1,igsp), 1, nx+2) . (zm(ix+nj,iy,0)-z0ni)*sin(thetarot) if (zc.lt.zcutmin .or. rc.lt.rcutmin) goto 10 argz = min(25., ((zc-z0ni)/zwni)**2) - argr = min(25., ((rc-r0ni)/rwni)**2) + argr = min(25., ((rc-r0ni)/rwni)**2) effvni = effvni + vol(ix,iy) * exp(-argz -argr) argz = min(25., ((zc-z0up)/zwup)**2) - argr = min(25., ((rc-r0up)/rwup)**2) + argr = min(25., ((rc-r0up)/rwup)**2) effvup = effvup + vol(ix,iy) * exp(-argz -argr) argz = min(25., ((zc-z0pe)/zwpe)**2) - argr = min(25., ((rc-r0pe)/rwpe)**2) + argr = min(25., ((rc-r0pe)/rwpe)**2) effvpe = effvpe + vol(ix,iy) * exp(-argz -argr) argz = min(25., ((zc-z0pi)/zwpi)**2) - argr = min(25., ((rc-r0pi)/rwpi)**2) + argr = min(25., ((rc-r0pi)/rwpi)**2) effvpi = effvpi + vol(ix,iy) * exp(-argz -argr) do igsp = 1, ngsp argz = min(25., ((zc-z0ng(igsp))/zwng(igsp))**2) - argr = min(25., ((rc-r0ng(igsp))/rwng(igsp))**2) + argr = min(25., ((rc-r0ng(igsp))/rwng(igsp))**2) effvng(igsp) = effvng(igsp) + vol(ix,iy)*exp(-argz-argr) enddo cccMER For full double-null configuration, iysptrx is last closed flux surface. @@ -8313,7 +8313,7 @@ cc Temporary localized current source (for prompt ion loss) effvjel = effvjel + vol(ix,iy) endif endif - 10 continue + 10 continue endif 20 continue @@ -8326,27 +8326,27 @@ cc Temporary localized current source (for prompt ion loss) . (zm(ix+nj,iy,0)-z0ni)*sin(thetarot) if (zc < zcutmin .or. rc < rcutmin) goto 30 argz = min(25., ((zc-z0pe)/zwpe)**2) - argr = min(25., ((rc-r0pe)/rwpe)**2) + argr = min(25., ((rc-r0pe)/rwpe)**2) pwrsore(ix,iy) =pvole*vol(ix,iy)*exp(-argz-argr)/effvpe argz = min(25., ((zc-z0pi)/zwpi)**2) - argr = min(25., ((rc-r0pi)/rwpi)**2) + argr = min(25., ((rc-r0pi)/rwpi)**2) pwrsori(ix,iy) =pvoli*vol(ix,iy)*exp(-argz-argr)/effvpi argz = min(25., ((zc-z0pondp)/zwpondp)**2) - argr = min(25., ((rc-r0pondp)/rwpondp)**2) + argr = min(25., ((rc-r0pondp)/rwpondp)**2) pondpot(ix,iy) = ponderompot*exp(-argz-argr) do ifld = 1, nisp argz = min(25., ((zc-z0ni)/zwni)**2) - argr = min(25., ((rc-r0ni)/rwni)**2) + argr = min(25., ((rc-r0ni)/rwni)**2) volpsor(ix,iy,ifld) = ivolcur(ifld) * vol(ix,iy) * . exp(-argz-argr)/(effvni*ev) argz = min(25., ((zc-z0up)/zwup)**2) - argr = min(25., ((rc-r0up)/rwup)**2) + argr = min(25., ((rc-r0up)/rwup)**2) volmsor(ix,iy,ifld) = mvolcur(ifld) * vol(ix,iy) * . exp(-argz-argr)/(effvup*ev) enddo do igsp = 1, ngsp argz = min(25., ((zc-z0ng(igsp))/zwng(igsp))**2) - argr = min(25., ((rc-r0ng(igsp))/rwng(igsp))**2) + argr = min(25., ((rc-r0ng(igsp))/rwng(igsp))**2) volpsorg(ix,iy,igsp) = ivolcurg(igsp) * vol(ix,iy) * . exp(-argz-argr)/(effvng(igsp)*ev) enddo @@ -8459,13 +8459,13 @@ real yldot(neq) # right-hand sides c ... Beginning of execution for call rhsvd (by vodpk), check constraints entry rhsvd (neq, t, yl, yldot, rpar, ipar, ifail) - - if (icflag .gt. 0) then + + if (icflag .gt. 0) then if (icflag .eq. 2) rlxl = rlx - do 5 i = 1, neq + do 5 i = 1, neq ylchng(i) = yl(i) - ylprevc(i) 5 continue - call cnstrt (neq,ylprevc,ylchng,icnstr,tau,rlxl,ifail,ivar) + call cnstrt (neq,ylprevc,ylchng,icnstr,tau,rlxl,ifail,ivar) if (ifail .ne. 0) then call remark ('***Constraint failure in VODPK, dt reduced***') write (*,*) 'variable index = ',ivar,' time = ',t @@ -8480,13 +8480,13 @@ call scopy (neq, yl, 1, ylprevc, 1) #put yl into ylprevc c ... Beginning of execution for call rhsdpk (by daspk), check constraints entry rhsdpk (neq, t, yl, yldot, ifail) - - if (icflag .gt. 0 .and. t .gt. 0.) then + + if (icflag .gt. 0 .and. t .gt. 0.) then if (icflag .eq. 2) rlxl = rlx - do 6 i = 1, neq + do 6 i = 1, neq ylchng(i) = yl(i) - ylprevc(i) 6 continue - call cnstrt (neq,ylprevc,ylchng,icnstr,tau,rlxl,ifail,ivar) + call cnstrt (neq,ylprevc,ylchng,icnstr,tau,rlxl,ifail,ivar) if (ifail .ne. 0) then call remark ('***Constraint failure in DASPK, dt reduced***') write (*,*) 'variable index = ',ivar,' time = ',t @@ -8495,7 +8495,7 @@ call remark ('***Constraint failure in DASPK, dt reduced***') else ifail = 0 endif - call scopy (neq, yl, 1, ylprevc, 1) #put yl into ylprevc + call scopy (neq, yl, 1, ylprevc, 1) #put yl into ylprevc 8 tloc = t go to 10 @@ -8512,34 +8512,47 @@ ccc call convsr_aux (-1,-1, yl) # test new convsr placement 20 continue return end -c----------------------------------------------------------------------- - subroutine jac_calc (neq, t, yl, yldot00, ml, mu, wk, - . nnzmx, jac, ja, ia) -c ... Calculate Jacobian matrix (derivatives with respect to each -c dependent variable of the right-hand side of each rate equation). -c Lower and upper bandwidths are used to select for computation -c only those Jacobian elements that may be nonzero. -c Estimates of Jacobian elements are computed by finite differences. -c The Jacobian is stored in compressed sparse row format. +c!ifdef UEDGE_WITH_OMP + subroutine omp_copy_module() + implicit none + use OmpCopycom + use OmpCopybbb + use OmpCopyapi + call OmpCopyPointercom + call OmpCopyScalarcom + call OmpCopyPointerbbb + call OmpCopyScalarbbb + call OmpCopyPointerapi + call OmpCopyScalarapi + end +c!endif + + subroutine jac_calc_iv(iv, neq, t, yl, yldot00, ml, mu, wk, + . nnzmx, csc_a, csc_ja, csc_ia, yldot_pert, + . nnz) implicit none c ... Input arguments: + integer iv integer neq # total number of equations (all grid points) real t # physical time real yl(*) # dependent variables real yldot00(neq+2) # right-hand sides evaluated at yl integer ml, mu # lower and upper bandwidths integer nnzmx # maximum number of nonzeros in Jacobian - + integer nnz +c ... Output arguments: + real csc_a(nnzmx) # nonzero Jacobian elements + integer csc_ja(nnzmx) # row indices of nonzero Jacobian elements + integer csc_ia(neq+1) # pointers to beginning of each col + real yldot_pert(neq) c ... Work-array argument: real wk(neq) # work space available to this subroutine - -c ... Output arguments: - real jac(nnzmx) # nonzero Jacobian elements - integer ja(nnzmx) # col indices of nonzero Jacobian elements - integer ia(neq+1) # pointers to beginning of each row in jac,ja +c ... Local variables: + integer ii, ii1, ii2, ix, iy, xc, yc + real yold, jacelem, dyl c ... Common blocks: Use(Dim) # nx,ny, @@ -8550,7 +8563,6 @@ integer ia(neq+1) # pointers to beginning of each row in jac,ja Use(Indexes) # igyl,iseqalg Use(Variable_perturbation) # del,dylconst Use(Jacobian_clipping) # jaccliplim,istopjac,irstop,icstop - Use(Jacobian_csc) # rcsc,jcsc,icsc,yldot_pert Use(Ynorm) # suscal,sfscal Use(UEpar) # isphion,isnewpot,svrpkg,isbcwdt Use(Model_choice) # iondenseqn @@ -8561,42 +8573,6 @@ integer ia(neq+1) # pointers to beginning of each row in jac,ja Use(Time_dep_nwt) # nufak,dtreal,ylodt,dtuse Use(Selec) # yinc Use(Jacaux) # ExtendedJacPhi - Use(Flags) # ExtendedJacPhi - -c ... Functions: - logical tstguardc - real(Size4) gettime -cc real(Size4) ranf - -c ... Local variables: - integer nnz, ii, iv, ii1, ii2, xc, yc, ix, iy - real yold, dyl, jacelem - real(Size4) sec4, tsjstor, tsimpjf, dtimpjf - -ccc save - -c ... Get initial value of system cpu timer. - if (istimingon .eq. 1) tsjstor = gettime(sec4) - -c ... Pause from BASIS if a ctrl_c is typed - call ruthere - - ijac(ig) = ijac(ig) + 1 - - if ((svrpkg.eq.'nksol') .and. (iprint .ne. 0)) write(*,*) ' Updating Jacobian, npe = ', - . ijac(ig) - -c ... Set up diagnostic arrays for debugging - do iv = 1, neq - yldot_unpt(iv) = yldot00(iv) # for diagnostic only - yldot_pert(iv) = 0. - enddo - -c############################################ -c ... Begin loop over dependent variables. -c############################################ - nnz = 1 - do iv = 1, neq ccc ... Only perturb variables that are being solved for (for Daspk option) ccc if (iseqon(iv) .eq. 0) goto 18 @@ -8665,7 +8641,8 @@ call pandf1 (xc, yc, iv, neq, t, yl, wk) c ... Calculate possibly nonzero Jacobian elements for this variable, c and store nonzero elements in compressed sparse column format. - jcsc(iv) = nnz # sets index for first Jac. elem. of var. iv + + csc_ia(iv) = nnz # sets index for first Jac. elem. of var. iv do ii = ii1, ii2 jacelem = (wk(ii) - yldot00(ii)) / dyl ccc jacelem = (wk(ii) - yldot0(ii)) / (2*dyl) # for 2nd order Jac @@ -8683,7 +8660,7 @@ call pandf1 (xc, yc, iv, neq, t, yl, wk) c ... Add a pseudo timestep to the diagonal ## if eqn is not algebraic if (svrpkg .ne. "cvode" .and. nufak .gt. 0) then - if (iv.eq.ii .and. yl(neq+1).eq.1) + if (iv.eq.ii .and. yl(neq+1).eq.1) . jacelem = jacelem - nufak #omit .and. iseqalg(iv).eq.0) endif if (abs(jacelem*sfscal(iv)) .gt. jaccliplim) then @@ -8692,14 +8669,14 @@ call pandf1 (xc, yc, iv, neq, t, yl, wk) . '*** jac_calc -- More storage needed for Jacobian.', . ' Storage exceeded at (i,j) = (',ii,',',iv,').', . ' Increase lenpfac.' - call xerrab("") + call xerrab("") endif cc if (rdoff.ne.0.e0) jacelem=jacelem*(1.0e0+ranf()*rdoff) - rcsc(nnz) = jacelem - icsc(nnz) = ii + csc_a(nnz) = jacelem + csc_ja(nnz) = ii nnz = nnz + 1 endif - + if (istopjac.gt.0 .and. ii.eq.irstop .and. iv.eq.icstop) then yldot_pert(ii) = wk(ii) # for diagnostic only if (istopjac == 2) then @@ -8717,18 +8694,106 @@ call xerrab("") yl(iv) = yold call pandf1 (xc, yc, iv, neq, t, yl, wk) -c... If this is the last variable before jumping to new cell, reset pandf +c... If this is the last variable before jumping to new cell, reset pandf ccc Call not needed because goto 18 svrpkg=daspk option disabled above ccc if (mod(iv,numvar).eq.0 .and. isjacreset.ge.1) then ccc call pandf1 (xc, yc, iv, neq, t, yl, wk) ccc endif - -c ... End loop over dependent variables and finish Jacobian storage. -c############################################################## - enddo # end of main iv-loop over yl variables + end + +c----------------------------------------------------------------------- + subroutine jac_calc (neq, t, yl, yldot00, ml, mu, wk, + . nnzmx, jac, ja, ia) + +c ... Calculate Jacobian matrix (derivatives with respect to each +c dependent variable of the right-hand side of each rate equation). +c Lower and upper bandwidths are used to select for computation +c only those Jacobian elements that may be nonzero. +c Estimates of Jacobian elements are computed by finite differences. +c The Jacobian is stored in compressed sparse row format. + + implicit none + +c ... Input arguments: + integer neq # total number of equations (all grid points) + real t # physical time + real yl(*) # dependent variables + real yldot00(neq+2) # right-hand sides evaluated at yl + integer ml, mu # lower and upper bandwidths + integer nnzmx # maximum number of nonzeros in Jacobian + +c ... Work-array argument: + real wk(neq) # work space available to this subroutine + +c ... Output arguments: + real jac(nnzmx) # nonzero Jacobian elements + integer ja(nnzmx) # col indices of nonzero Jacobian elements + integer ia(neq+1) # pointers to beginning of each row in jac,ja + +c ... Common blocks: + Use(Dim) # nx,ny, + # nusp[for fnorm not used here] + Use(Timing) # istimingon,ttjstor,ttotjf,ttimpjf + Use(Math_problem_size) # neqmx,numvar + Use(Grid) # ngrid,ig,ijac,ijactot + Use(Indexes) # igyl,iseqalg + Use(Variable_perturbation) # del,dylconst + Use(Jacobian_clipping) # jaccliplim,istopjac,irstop,icstop + Use(Jacobian_csc) # rcsc,jcsc,icsc,yldot_pert + Use(Ynorm) # suscal,sfscal + Use(UEpar) # isphion,isnewpot,svrpkg,isbcwdt + Use(Model_choice) # iondenseqn + Use(Imprad) # isimpon + Use(Bcond) # isextrnpf,isextrtpf,isextrngc, + # isextrnw,isextrtw + Use(Parallv) # nxg,nyg + Use(Time_dep_nwt) # nufak,dtreal,ylodt,dtuse + Use(Selec) # yinc + Use(Jacaux) # ExtendedJacPhi + +c ... Functions: + logical tstguardc + real(Size4) gettime +cc real(Size4) ranf + +c ... Local variables: + integer nnz, iv + real(Size4) sec4, tsjstor, tsimpjf, dtimpjf + +ccc save + +c ... Get initial value of system cpu timer. + if (istimingon .eq. 1) tsjstor = gettime(sec4) + +c ... Pause from BASIS if a ctrl_c is typed + call ruthere + +c ... Count Jacobian evaluations, both for total and for this case + ijactot = ijactot + 1 #note: ijactot set 0 in exmain if icntnunk=0 + ijac(ig) = ijac(ig) + 1 + + if (svrpkg.eq.'nksol') write(*,*) ' Updating Jacobian, npe = ', + . ijac(ig) + +c ... Set up diagnostic arrays for debugging + do iv = 1, neq + yldot_unpt(iv) = yldot00(iv) # for diagnostic only + yldot_pert(iv) = 0. + enddo + +c############################################ +c ... Begin loop over dependent variables. +c############################################ +c nnz = 1 +c do iv = 1, neq +c call jac_calc_iv(iv, neq, t, yl, yldot00, ml, mu, wk, nnzmx, +c . rcsc, icsc, jcsc, yldot_pert, nnz) +c enddo # end of main iv-loop over yl variables +c jcsc(neq+1) = nnz c############################################################## - jcsc(neq+1) = nnz + call jac_calc_c(neq, t, yl, yldot00, ml, mu, wk, + . nnzmx, 0.0, rcsc, icsc, jcsc, yldot_pert, nnz) c ... Convert Jacobian from compressed sparse column to compressed c sparse row format. @@ -8758,7 +8823,7 @@ integer ia(neq+1) # pointers to beginning of each row in jac,ja c ... Output arguments: real wp(*) # matrix elements of LU integer iwp(*) # sizes and array indices for elements of LU - + c ... Common blocks: Use(Timing) # ttmatfac Use(Decomp) # lbw,ubw @@ -8780,6 +8845,10 @@ integer iwp(*) # sizes and array indices for elements of LU real(Size4) sec4 real tsmatfac + real,external::tick,tock + real t_start_ilu + t_start_ilu = tick() + c ... Convert compressed sparse row to banded format and use exact c factorization routine sgbco from Linpack/SLATEC. if (premeth .eq. 'banded') then @@ -8814,7 +8883,7 @@ call jac_reorder (neq, jac, ja, ia, wp, iwp(neq+2), iwp) tsmatfac = gettime(sec4) call ilut (neq,jac,ja,ia,lfililut,tolilut,wp,iwp(neq+1), . iwp,lenplumx,rwk1,rwk2,iwk1, - . iwk2,iwk3,ierr) + . iwk2,iwk3,ierr) if (ierr .ne. 0) then write(STDOUT,*) ' Error return from ilut: ierr = ',ierr write(STDOUT,9000) @@ -8867,6 +8936,8 @@ call precond5 (neq, ndiag, ndiagm, adiag, wp, rwk2, rwk1, c ... Accumulate cpu time spent here. 99 ttmatfac = ttmatfac + (gettime(sec4) - tsmatfac) + + print *, '@@Time ILU@@ ', tock(t_start_ilu), 's' return end c----------------------------------------------------------------------- @@ -9089,7 +9160,7 @@ real pd(*) # matrix A in (Linpack) banded format ubw = ipar(3) c ... Calculate right-hand sides at unperturbed values of variables for -c ... Jacobian calculation. +c ... Jacobian calculation. call ffun (neq, t, yl, yldot0) c ... Calculate Jacobian of right-hand sides of UEDGE equations. @@ -9128,7 +9199,7 @@ subroutine jacd2 (resid, ires, neq, t, yl, yldot, rewt, savr, wk, real yl(*) # most recent iterate of solution vector real yldot(neq) # most recent iterate of time-derivative of yl # (not used) - real rewt(neq) # reciprocal error weights + real rewt(neq) # reciprocal error weights real savr(neq) # residual values G(t,yl,yldot) (not used) real h # step size (not used) real cj # scalar provided by daspk @@ -9338,7 +9409,7 @@ real v3(neq) # work space available to this subroutine c ... Calculate Jacobian. - call jac_calc (neq, tp, yl, f0, lbw, ubw, v1, nnzmx, + call jac_calc (neq, tp, yl, f0, lbw, ubw, v1, nnzmx, . jac, jacj, jaci) c ... Jacobian elements could be saved here for reuse if change in hrl1 @@ -9408,6 +9479,9 @@ real wp(*) # matrix elements of LU integer iwp(*) # array indices for elements of LU integer ierr # error flag (0 means success, else failure) + real,external::tick,tock + real t_start_pset + c ... Common blocks: Use(Decomp) # lbw,ubw Use(Jacobian) # nnzmx,jac,jacj,jaci @@ -9427,7 +9501,7 @@ integer iwp(*) # array indices for elements of LU c ... Calculate maximum of f0*sf to control yl(neq+2) = nufak ydt_max = 1.e-100 do i = 1, neq # need to avoid neq+1 and neq+2 - if (abs(f0(i)*sf(i)) .gt. ydt_max) + if (abs(f0(i)*sf(i)) .gt. ydt_max) . ydt_max = abs(f0(i)*sf(i)) enddo if (ydt_max0 .eq. 0) ydt_max0 = ydt_max @@ -9439,14 +9513,14 @@ integer iwp(*) # array indices for elements of LU endif if (expnuf.ne.0.) write(*,*) ' nufak = ', nufak ydt_max0 = ydt_max - + c ... Flag these calls to RHS (pandf) as for the Jacobian yl(neq+1) = 1. c ... Call pandf to set terms with yl(neq+1) flag on for Jacobian call rhsnk (neq, yl, f0) -c ... Calculate Jacobian matrix. +c ... Calculate Jacobian matrix. tp = 0. call jac_calc_interface (neq, tp, yl, f0, lbw, ubw, wk, . nnzmx, jac, jacj, jaci) @@ -9542,7 +9616,7 @@ real yl(neq) # most recent iterate of solution vector real yldot(neq) # most recent iterate of time-derivative of yl real f0(neq) # G(t,yl,yldot) (not used) real cj # scalar provided by daspk (not used) - real wght(neq) # error weights + real wght(neq) # error weights real wp(*) # matrix elements of LU integer iwp(*) # dimensions and array indices for elements of LU real eplin # bound on solution error (not used) @@ -9642,7 +9716,7 @@ call psolbody (neq, usingsu, su, wk, wp, iwp, bl, ierr) return end c----------------------------------------------------------------------- - subroutine FPSOL (neq, t, yl, f0, wk, hrl1, rewt, delta, nfe, bl, + subroutine FPSOL (neq, t, yl, f0, wk, hrl1, rewt, delta, nfe, bl, . lr, zl, ierr) c ... Interface between linear-system solver pvode and subroutine @@ -9841,7 +9915,7 @@ call jac_calc_interface (neq, tp, yl, yldot0, lbw, ubw, wk, yl(neq+1) = -1. # Turn-off Jacobian flag for pandf c ... Compute inverse of column-scaling vector, and perform column -c scaling. +c scaling. do i = 1, neq sf(i) = 1. / su(i) enddo @@ -9919,7 +9993,7 @@ call rhsnk (neq, yl, f0) # Reset f0 with nufak off endif enddo - if(ix.ne.nx+2*isbcwdt) then + if(ix.ne.nx+2*isbcwdt) then # nx test - for algebr. eq. unless isbcwdt=1 do ifld = 1, nusp if(isuponxy(ix,iy,ifld).eq.1) then @@ -9933,7 +10007,7 @@ call rhsnk (neq, yl, f0) # Reset f0 with nufak off up_5ca = ( abs(ylodt(iv)) + abs(ylodt(iv1)) + . abs(ylodt(iv2))+ abs(ylodt(iv3)) + . abs(ylodt(iv4)) )/5 - if (abs(f0(iv)).gt.cutlo) dtoptv(iv) = + if (abs(f0(iv)).gt.cutlo) dtoptv(iv) = . deldt*abs(up_5ca/(f0(iv))) if (model_dt .eq. 0) then dtuse(iv) = dtreal @@ -10032,7 +10106,7 @@ call rhsnk (neq, yl, f0) # Reset f0 with nufak off c ... section to define time-step based on cell minimum-step, dtoptx ccc if (model_dt .lt. 4) goto 23 - do iy = 1-iymnbcl, ny+iymxbcl + do iy = 1-iymnbcl, ny+iymxbcl do ix = 1-ixmnbcl, nx+ixmxbcl do ifld = 1, nisp if(isnionxy(ix,iy,ifld) .eq. 1) then @@ -10047,7 +10121,7 @@ call rhsnk (neq, yl, f0) # Reset f0 with nufak off endif endif enddo - if(ix.ne.nx+2*isbcwdt) then + if(ix.ne.nx+2*isbcwdt) then # nx test - for algebr. eq. unless isbcwdt=1 do ifld = 1, nusp if(isuponxy(ix,iy,ifld).eq.1) then @@ -10192,6 +10266,24 @@ call jmap (neq, jacfull, us) return end c----------------------------------------------------------------------- + subroutine jacmm + + implicit none + +c ... Common blocks: + Use(Dim) # nusp(for array fnorm in Ynorm not used here) + Use(Math_problem_size) # neqmx + Use(Lsode) # neq,yldot + Use(Ynorm) # sfscal + Use(Jacobian) # jac,jacj,jaci + Use(UEpar) # svrpkg + + call jacmm_c(neq, jac, jacj, jaci) + + return + end +c----------------------------------------------------------------------- + subroutine jacout implicit none @@ -10237,15 +10329,15 @@ call prtmt (neq,neq,jac,jacj,jaci,yldot, return end -******* end of subroutine jacout ******* +******* end of subroutine jacout ******* c----------------------------------------------------------------------- subroutine engbal(pwrin) implicit none -c ... Calculates various components of the 2-D energy flow and the +c ... Calculates various components of the 2-D energy flow and the c ... ionization and radiation for use in the postprocessing file -c ... balancee to determine energy balance; these 2-D loops become +c ... balancee to determine energy balance; these 2-D loops become c ... expensive when done from the parser. c ... Input arguments: @@ -10277,14 +10369,14 @@ subroutine engbal(pwrin) c ... Implicit function: ave(a1,a2) = a1 * a2 / (a1 + a2 + cutlo) - + if (ishosor .eq. 1) then # averge power terms is ishosor=1 call volavenv(nx, ny, 1, ny, 1, nx, ixp1(0:nx+1,0:ny+1), ixm1(0:nx+1,0:ny+1), . fsprd, psor_tmpov(0:nx+1,0:ny+1), prad) do igsp = nhgsp+1, ngsp jz = igsp - nhgsp - do iimp = 0, nzsp(jz) + do iimp = 0, nzsp(jz) call volavenv(nx, ny, 1, ny, 1, nx, ixp1(0:nx+1,0:ny+1), ixm1(0:nx+1,0:ny+1), . fsprd, psor_tmpov(0:nx+1,0:ny+1), pradz(0:nx+1,0:ny+1,iimp,jz)) enddo @@ -10313,9 +10405,9 @@ call volavenv(nx, ny, 1, ny, 1, nx, ixp1(0:nx+1,0:ny+1), ixm1(0:nx+1,0:ny+1), . cfvisy*0.5*sy(ix,iy)*gyf(ix,iy)*eta_dup2dy fetx(ix,iy) = fetx(ix,iy) + 0.5*mi(id)*upi(ix,iy,id)**2* . fnix(ix,iy,id) - cfvisx*0.25*sx(ix,iy)*( - . visx(ix ,iy,id)*gx(ix ,iy)*cos(thetaix)* + . visx(ix ,iy,id)*gx(ix ,iy)*cos(thetaix)* . ( upi(ix,iy,id)**2 - upi(ix1,iy,id)**2 ) + - . visx(ix2,iy,id)*gx(ix2,iy)*cos(thetaix2)* + . visx(ix2,iy,id)*gx(ix2,iy)*cos(thetaix2)* . ( upi(ix2,iy,id)**2 - upi(ix,iy,id)**2 ) ) fetx(ix,iy) = fetx(ix,iy) - upi(ix,iy,id)*fmixy(ix,iy,id) enddo @@ -10341,7 +10433,7 @@ call volavenv(nx, ny, 1, ny, 1, nx, ixp1(0:nx+1,0:ny+1), ixm1(0:nx+1,0:ny+1), . ckinfl*0.5*sx(ixt,iy)*visx(ixt1,iy,id)*gx(ixt1,iy)* . ( up(ixt1,iy,id)**2 - up(ixt,iy,id)**2 ) fetx(ixr,iy) = fetx(ixr,iy) + - . 0.5*mi(id)*up(ixr,iy,id)**2*fnix(ixr,iy,id) - + . 0.5*mi(id)*up(ixr,iy,id)**2*fnix(ixr,iy,id) - . ckinfl*0.5*sx(ixr,iy)*visx(ixr,iy,id)*gx(ixr,iy)* . ( up(ixr,iy,id)**2 - up(ixr1,iy,id)**2 ) enddo @@ -10352,7 +10444,7 @@ call volavenv(nx, ny, 1, ny, 1, nx, ixp1(0:nx+1,0:ny+1), ixm1(0:nx+1,0:ny+1), endif # test on ckinfl-1 pvmomcx = 0.e0 - ptjdote = 0.e0 + ptjdote = 0.e0 do jx = 1, nxpt do ix=ixlb(jx)+1,ixrb(jx) @@ -10381,7 +10473,7 @@ cc jdote(ix,iy) = - # this energy is included in resee, not lost if (isupgon(1) .eq. 0) then pmomv(ix,iy)=cngmom(1)*up(ix,iy,1)*sx(ix,iy)*rrv(ix,iy)* - . ( ng(ix2,iy,1)*tg(ix2,iy,1)- + . ( ng(ix2,iy,1)*tg(ix2,iy,1)- . ng(ix ,iy,1)*tg(ix ,iy,1) ) + . cmwall(1)*0.125*mi(1)*(up(ix,iy,1)+up(ix1,iy,1))**2* . ng(ix,iy,1)*nucx(ix,iy,1)*vol(ix,iy) @@ -10427,9 +10519,9 @@ cc jdote(ix,iy) = - # this energy is included in resee, not lost pradimp(iimp,igsp) = 0. enddo endif - enddo + enddo pradfft = 0. - + do jx = 1, nxpt do ix = ixlb(jx)+1,ixrb(jx) do iy = 1, ny @@ -10455,18 +10547,18 @@ cc jdote(ix,iy) = - # this energy is included in resee, not lost do ix = ixlb(jx)+1, ixrb(jx) ix1 = ixm1(ix,iy) pradrc = pradrc + cnsor*erlrc(ix,iy) - pradiz = pradiz + (eeli(ix,iy)-ebind*ev) * psor(ix,iy,1) + pradiz = pradiz + (eeli(ix,iy)-ebind*ev) * psor(ix,iy,1) pbinde = pbinde + ebind*ev * psor(ix,iy,1) pbindrc = pbindrc + ebind*ev*psorrg(ix,iy,1) prdiss = prdiss + ediss * ev * (0.5*psordis(ix,iy)) pibirth = pibirth + ceisor* eion*ev * (psordis(ix,iy)) - . ccoldsor*ng(ix,iy,1)*(1.5*ti(ix,iy)-eion*ev)* - . nucx(ix,iy,1)*vol(ix,iy) + . nucx(ix,iy,1)*vol(ix,iy) enddo enddo enddo pradht = pradiz + pradrc - + if (isimpon .eq. 2 .or. isimpon .eq. 7) then #fixed fraction model do iy = 1, ny do jx = 1, nxpt @@ -10500,9 +10592,9 @@ cc jdote(ix,iy) = - # this energy is included in resee, not lost enddo enddo endif - + return - end + end ******* end of subroutine engbal ******* @@ -10529,18 +10621,18 @@ cc jdote(ix,iy) = - # this energy is included in resee, not lost #pwr_pfwallz, pwr_pfwallh c ... Local variables - real prdu(0:nx+1,0:ny+1) + real prdu(0:nx+1,0:ny+1) real theta_ray1, theta_ray2, dthgy, dthgx, sxo, frth integer ixv, iyv, nj, ix, iy, ip, iodd # Initialize arrays - call sfill ((ny+2)*2*nxpt, 0., pwr_pltz, 1) - call sfill ((ny+2)*2*nxpt, 0., pwr_plth, 1) - call sfill ((nx+2), 0., pwr_wallz, 1) - call sfill ((nx+2), 0., pwr_wallh, 1) - call sfill ((nx+2)*nxpt, 0., pwr_pfwallz, 1) - call sfill ((nx+2)*nxpt, 0., pwr_pfwallh, 1) - + call sfill ((ny+2)*2*nxpt, 0., pwr_pltz, 1) + call sfill ((ny+2)*2*nxpt, 0., pwr_plth, 1) + call sfill ((nx+2), 0., pwr_wallz, 1) + call sfill ((nx+2), 0., pwr_wallh, 1) + call sfill ((nx+2)*nxpt, 0., pwr_pfwallz, 1) + call sfill ((nx+2)*nxpt, 0., pwr_pfwallh, 1) + if (isimpon > 0) then # use prdu since prad might not be dimensioned call s2copy (nx+2,ny+2, prad,1,nx+2, prdu,1,nx+2) #prad --> prdu else @@ -10560,14 +10652,14 @@ call s2fill (nx+2, ny+2, 0., prdu, 1, nx+2) do iyv = 1, ny # loop over viewing ix do iy = 1, ny # loop over source iy do ix = 1, nx # loop over source ix - theta_ray1 = atan2( zm(ixv+nj,iyv,1)-zm(ix+nj,iy,0), + theta_ray1 = atan2( zm(ixv+nj,iyv,1)-zm(ix+nj,iy,0), . rm(ixv+nj,iyv,1)-rm(ix+nj,iy,0) ) - theta_ray2 = atan2( zm(ixv+nj,iyv,3)-zm(ix+nj,iy,0), + theta_ray2 = atan2( zm(ixv+nj,iyv,3)-zm(ix+nj,iy,0), . rm(ixv+nj,iyv,3)-rm(ix+nj,iy,0) ) dthgy = abs(theta_ray1-theta_ray2) frth = min(dthgy, 2*pi-dthgy)/(2*pi) # frac.; need angle < pi sxo = sx(ixv,iyv)/(cos(angfx(ixv,iyv))) - pwr_pltz(iyv,ip) = pwr_pltz(iyv,ip) + + pwr_pltz(iyv,ip) = pwr_pltz(iyv,ip) + . prdu(ix,iy)*vol(ix,iy)*frth/sxo pwr_plth(iyv,ip) = pwr_plth(iyv,ip) + ( . (eeli(ix,iy)-ebind*ev)*psor(ix,iy,1) @@ -10576,9 +10668,9 @@ call s2fill (nx+2, ny+2, 0., prdu, 1, nx+2) enddo enddo c ... Set corner values - pwr_pltz(0,ip) = pwr_pltz(1,ip) + pwr_pltz(0,ip) = pwr_pltz(1,ip) pwr_pltz(ny+1,ip) = pwr_pltz(ny,ip) - pwr_plth(0,ip) = pwr_plth(1,ip) + pwr_plth(0,ip) = pwr_plth(1,ip) pwr_plth(ny+1,ip) = pwr_plth(ny,ip) enddo # end of ip loop over divertor plates @@ -10593,13 +10685,13 @@ call s2fill (nx+2, ny+2, 0., prdu, 1, nx+2) . rm(ixv+nj,iyv,1)-rm(ix+nj,iy,0) ) theta_ray2 = atan2( zm(ixv+nj,iyv,2)-zm(ix+nj,iy,0), . rm(ixv+nj,iyv,2)-rm(ix+nj,iy,0) ) - dthgx = abs(theta_ray1-theta_ray2) + dthgx = abs(theta_ray1-theta_ray2) frth = min(dthgx, 2*pi-dthgx)/(2*pi) # frac; need angle < pi - pwr_wallz(ixv) = pwr_wallz(ixv) + - . prdu(ix,iy)*vol(ix,iy)*frth/sy(ixv,iyv) + pwr_wallz(ixv) = pwr_wallz(ixv) + + . prdu(ix,iy)*vol(ix,iy)*frth/sy(ixv,iyv) pwr_wallh(ixv) = pwr_wallh(ixv) + ( . (eeli(ix,iy)-ebind*ev)*psor(ix,iy,1) + - . erlrc(ix,iy) )*frth/sy(ixv,iyv) + . erlrc(ix,iy) )*frth/sy(ixv,iyv) enddo enddo enddo @@ -10618,13 +10710,13 @@ call s2fill (nx+2, ny+2, 0., prdu, 1, nx+2) . rm(ixv+nj,iyv,1)-rm(ix+nj,iy,0) ) theta_ray2 = atan2( zm(ixv+nj,iyv,2)-zm(ix+nj,iy,0), . rm(ixv+nj,iyv,2)-rm(ix+nj,iy,0) ) - dthgx = abs(theta_ray1-theta_ray2) + dthgx = abs(theta_ray1-theta_ray2) frth = min(dthgx, 2*pi-dthgx)/(2*pi) # frac; need angle < pi - pwr_pfwallz(ixv,ip) = pwr_pfwallz(ixv,ip) + - . prdu(ix,iy)*vol(ix,iy)*frth/sy(ixv,iyv) + pwr_pfwallz(ixv,ip) = pwr_pfwallz(ixv,ip) + + . prdu(ix,iy)*vol(ix,iy)*frth/sy(ixv,iyv) pwr_pfwallh(ixv,ip) = pwr_pfwallh(ixv,ip) + ( . (eeli(ix,iy)-ebind*ev)*psor(ix,iy,1) + - . erlrc(ix,iy) )*frth/sy(ixv,iyv) + . erlrc(ix,iy) )*frth/sy(ixv,iyv) enddo enddo if(ixv>ixpt1(ip) .and. ixv nmcmx') @@ -11846,7 +11938,7 @@ real vol(0:n1+1,0:n2+1), ps_tmp(0:n1+1,0:n2+1), ps(0:n1+1,0:n2+1) c *** Local variables integer iy, ix, ix1, ix2, iy1, iy2 real fs0, signps - + fs0 = 1. - 4*fsprd # fraction to central cell do iy = j2, j5 @@ -11877,7 +11969,7 @@ real vol(0:n1+1,0:n2+1), ps_tmp(0:n1+1,0:n2+1), ps(0:n1+1,0:n2+1) end #----------------------------------------------------------------------# - subroutine volavenv(n1, n2, j2, j5, i2, i5, ixp, ixm, fsprd, + subroutine volavenv(n1, n2, j2, j5, i2, i5, ixp, ixm, fsprd, . ps_tmp, ps) c ... This subroutine does a volume integral, or average, of cell source-like c ... quantities by including interpolation based on adjacent-cell quantities @@ -11911,7 +12003,7 @@ real ps_tmp(0:n1+1,0:n2+1), ps(0:n1+1,0:n2+1) c *** Local variables integer iy, ix, ix1, ix2, iy1, iy2 real fs0, signps - + fs0 = 1. - 4*fsprd # fraction to central cell do iy = j2, j5 @@ -11974,7 +12066,7 @@ real ps_tmp(0:n1+1,0:n2+1), ps(0:n1+1,0:n2+1) Use(Compla) # mi, zi, ni, uu, up, v2, v2ce, vygtan, mg Use(Comflo) # flnix,flniy Use(Indices_domain_dcl) # ixmxbcl - + c ------------------ do 104 ifld = 1, nfsp @@ -12009,12 +12101,12 @@ real ps_tmp(0:n1+1,0:n2+1), ps(0:n1+1,0:n2+1) else # interp. ave or harmonic ave depending on wind*grad t0 = ( lni(ix, iy,ifld)*gx(ix, iy) + - . lni(ix2,iy,ifld)*gx(ix2,iy) ) / + . lni(ix2,iy,ifld)*gx(ix2,iy) ) / . ( gx(ix,iy)+gx(ix2,iy) ) t1 = ( gx(ix,iy)+gx(ix2,iy) ) * lni(ix,iy,ifld) * . lni(ix2,iy,ifld) / ( cutlo + lni(ix,iy,ifld)* . gx(ix2,iy) + lni(ix2,iy,ifld)*gx(ix,iy) ) - if( uu(ix,iy,ifld)*(lni(ix,iy,ifld)-lni(ix2,iy,ifld)) + if( uu(ix,iy,ifld)*(lni(ix,iy,ifld)-lni(ix2,iy,ifld)) . .ge. 0.) then t2 = t0 else @@ -12029,7 +12121,7 @@ real ps_tmp(0:n1+1,0:n2+1), ps(0:n1+1,0:n2+1) . (nlimix(ifld)/lni(ix ,iy,ifld))**2 ) endif 80 continue - if ((isudsym==1.or.geometry.eq.'dnXtarget') + if ((isudsym==1.or.geometry.eq.'dnXtarget') . .and. nxc > 1) flnix(nxc,iy,ifld)=0. if (islimon.ne.0 .and. iy.ge.iy_lims) flnix(ix_lim,iy,ifld)=0. if (nxpt==2.and.ixmxbcl==1) flnix(ixrb(1)+1,iy,ifld)=0. @@ -12058,7 +12150,7 @@ real ps_tmp(0:n1+1,0:n2+1), ps(0:n1+1,0:n2+1) else # interp. ave or harmonic ave depending on wind*grad t0 = ( niy0(ix,iy,ifld)*gy(ix,iy ) + - . niy1(ix,iy,ifld)*gy(ix,iy+1) ) / + . niy1(ix,iy,ifld)*gy(ix,iy+1) ) / . ( gy(ix,iy)+gy(ix,iy+1) ) t1 = ( gy(ix,iy)+gy(ix,iy+1) ) * niy0(ix,iy,ifld)* . niy1(ix,iy,ifld) / ( cutlo + niy0(ix,iy,ifld)* @@ -12069,9 +12161,9 @@ real ps_tmp(0:n1+1,0:n2+1), ps(0:n1+1,0:n2+1) else t2 = t1 endif - + endif - + flniy(ix,iy,ifld) = cnfy*vy(ix,iy,ifld)*sy(ix,iy)*t2 if (vy(ix,iy,ifld)*(lni(ix,iy,ifld)-lni(ix,iy+1,ifld)) . .lt. 0.) then @@ -12082,7 +12174,7 @@ real ps_tmp(0:n1+1,0:n2+1), ps(0:n1+1,0:n2+1) endif 82 continue 83 continue - + do ix = i4, i8 flniy(ix,ny+1,ifld) = 0.0e0 enddo @@ -12096,7 +12188,7 @@ real ps_tmp(0:n1+1,0:n2+1), ps(0:n1+1,0:n2+1) c subroutine upvisneo -c ... This subroutine calculates the total up ion viscosity term with +c ... This subroutine calculates the total up ion viscosity term with c ... neoclassical effects implicit none @@ -12126,11 +12218,11 @@ real ps_tmp(0:n1+1,0:n2+1), ps(0:n1+1,0:n2+1) do ix = i2, i5 ix1 = ixp1(ix,iy) ix2 = ixm1(ix,iy) -c First do the viscosity driven by particle flux - tempp = b12(ix1,iy)*( up(ix1,iy,ifld) + +c First do the viscosity driven by particle flux + tempp = b12(ix1,iy)*( up(ix1,iy,ifld) + . (v2cd(ix1,iy,ifld)+v2ce(ix1,iy,ifld))* . rbfbt(ix1,iy)/rrv(ix1,iy) ) - tempm = b12(ix,iy)*( up(ix,iy,ifld) + + tempm = b12(ix,iy)*( up(ix,iy,ifld) + . (v2cd(ix,iy,ifld)+v2ce(ix,iy,ifld))* . rbfbt(ix,iy)/rrv(ix,iy) ) if(ix < nx) then @@ -12141,7 +12233,7 @@ real ps_tmp(0:n1+1,0:n2+1), ps(0:n1+1,0:n2+1) . 2.*gx(nx,iy)/bsqr(ix1,iy) endif tempp = tempm - tempm = b12(ix2,iy)*( up(ix2,iy,ifld) + + tempm = b12(ix2,iy)*( up(ix2,iy,ifld) + . (v2cd(ix2,iy,ifld)+v2ce(ix2,iy,ifld))* . rbfbt(ix2,iy)/rrv(ix2,iy) ) diffm = (visxneo(ix,iy,ifld)/rr(ix,iy))*(tempp-tempm)* @@ -12149,10 +12241,10 @@ real ps_tmp(0:n1+1,0:n2+1), ps(0:n1+1,0:n2+1) visvol_v(ix,iy,ifld)=(4./3.)*rrv(ix,iy)* . b32(ix,iy)*(diffp-diffm)* . gxf(ix,iy)*volv(ix,iy) -c Now do the viscosity driven by heat flux - tempp = b12(ix1,iy)*( qipar(ix1,iy,ifld) + +c Now do the viscosity driven by heat flux + tempp = b12(ix1,iy)*( qipar(ix1,iy,ifld) + . q2cd(ix1,iy,ifld)*rbfbt(ix1,iy)/rrv(ix1,iy) ) - tempm = b12(ix,iy)*( qipar(ix,iy,ifld) + + tempm = b12(ix,iy)*( qipar(ix,iy,ifld) + . q2cd(ix,iy,ifld)*rbfbt(ix,iy)/rrv(ix,iy) ) if(ix < nx) then diffp = alfneo(ix1,iy,ifld)*rr(ix1,iy)*(tempp-tempm)* @@ -12162,7 +12254,7 @@ real ps_tmp(0:n1+1,0:n2+1), ps(0:n1+1,0:n2+1) . 2.*gx(nx,iy) / (nuii(ix1,iy,ifld)*bsqr(ix1,iy)) endif tempp = tempm - tempm = b12(ix2,iy)*( qipar(ix2,iy,ifld) + + tempm = b12(ix2,iy)*( qipar(ix2,iy,ifld) + . q2cd(ix2,iy,ifld)*rbfbt(ix2,iy)/rrv(ix2,iy) ) diffm = alfneo(ix,iy,ifld)*rr(ix,iy)*(tempp-tempm)* . gx(ix,iy) / (nuii(ix,iy,ifld)*bsqr(ix,iy)) @@ -12210,14 +12302,14 @@ real ps_tmp(0:n1+1,0:n2+1), ps(0:n1+1,0:n2+1) do ix = i2, i5 ix1 = ixp1(ix,iy) ix2 = ixm1(ix,iy) -c First do the current driven by neoclassical particle flux - tempp = up(ix1,iy,ifld) + +c First do the current driven by neoclassical particle flux + tempp = up(ix1,iy,ifld) + . (v2cd(ix1,iy,ifld)+v2ce(ix1,iy,ifld))* . rbfbt(ix1,iy)/rrv(ix1,iy) - temp0 = up(ix,iy,ifld) + + temp0 = up(ix,iy,ifld) + . (v2cd(ix2,iy,ifld)+v2ce(ix2,iy,ifld))* . rbfbt(ix2,iy)/rrv(ix2,iy) - tempm = up(ix2,iy,ifld) + + tempm = up(ix2,iy,ifld) + . (v2cd(ix,iy,ifld)+v2ce(ix,iy,ifld))* . rbfbt(ix,iy)/rrv(ix,iy) gradx_vpiv = (visxneo(ix,iy,ifld)*b12(ix,iy)*rrv(ix,iy)/3.) @@ -12227,12 +12319,12 @@ real ps_tmp(0:n1+1,0:n2+1), ps(0:n1+1,0:n2+1) fqypneo(ix,iy) = 0.5*(rbfbt(ix,iy)+rbfbt(ix1,iy))* . gradx_vpiv*dbm2dx(ix1,iy) -c Now do the current driven by neoclassical heat flux - tempp = qipar(ix1,iy,ifld) + +c Now do the current driven by neoclassical heat flux + tempp = qipar(ix1,iy,ifld) + . q2cd(ix1,iy,ifld)*rbfbt(ix1,iy)/rrv(ix1,iy) - temp0 = qipar(ix,iy,ifld) + + temp0 = qipar(ix,iy,ifld) + . q2cd(ix,iy,ifld)*rbfbt(ix,iy)/rrv(ix,iy) - tempm = qipar(ix2,iy,ifld) + + tempm = qipar(ix2,iy,ifld) + . q2cd(ix2,iy,ifld)*rbfbt(ix2,iy)/rrv(ix2,iy) gradx_vpiq =( alfneo(ix,iy,ifld)*0.24* . b12(ix,iy)*rrv(ix,iy)/nuii(ix,iy,ifld) )* diff --git a/com/com.v b/com/com.v index 1db21009..127b3d08 100755 --- a/com/com.v +++ b/com/com.v @@ -25,7 +25,7 @@ nzspt integer /1/ # total number of impurity species nzspmx integer /10/ # maximum of nzsp(igsp) used for storage allocation nisp integer /1/ +input # number of ion species nusp integer +input # number of parallel momentum equations -nfsp integer +input # number of cont. eqns or flux species (calc internal) +nfsp integer +input +threadprivate # number of cont. eqns or flux species (calc internal) ngsp integer /1/ +input +regrid # number of gas species nhgsp integer /1/ +input # number of hydrogen gas species (prepare for tritium) imx integer /50/ # size in x of Zagorski arrays @@ -101,7 +101,7 @@ xlim(nlim) _real [m] +griddata ylim(nlim) _real [m] +griddata # vertical coordinates of limiter/vessel boundary from EFIT bscoef(nxefit,nyefit) _real - # 2-d spline coefficients + # 2-d spline coefficients kxord integer /4/ # order of the 2-d spline in the x-direction kyord integer /4/ @@ -138,9 +138,9 @@ ycurve(npts,jdim) _real [m] # vertical position of nth data point on jth contour segment npoint(jdim) _integer # number of data points on jth contour segment -geqdskfname character*128 /'neqdsk'/ +geqdskfname character*128 /'neqdsk'/ #File name for geqdsk/neqdsk EFIT file - + ***** Aeqflxgrd: # information read from the A-file produced by the EFIT code vmonth integer # EFIT version month @@ -174,11 +174,11 @@ mco2v integer /3/ # number of vertical co2 chords mco2r integer /1/ # number of radial co2 chords -rco2v(mco2v) _real +rco2v(mco2v) _real # radial positions of vertical co2 chords dco2v(mco2v) _real # densities for vertical co2 chords -rco2r(mco2r) _real +rco2r(mco2r) _real # vertical positions of radial co2 chords dco2r(mco2r) _real # densities for radial co2 chords @@ -198,7 +198,7 @@ nesum integer /2/ # number of e-coils eccurt(nesum) _real # data from e-coils -aeqdskfname character*128 /'aeqdsk'/ +aeqdskfname character*128 /'aeqdsk'/ #File name for aeqdsk EFIT file ***** RZ_grid_info: @@ -424,9 +424,9 @@ hxv(0:nx+1,0:ny+1) _real [1/m] #harmonic average of neighboring gx's syv(0:nx+1,0:ny+1) _real sygytotc real [1/m**3] #total volume for iy=1 cell of core region area_core real [1/m**3] #area of core boundary at iy=0 -ghxpt real [m^-1] #1/(horiz dist.) between x-pt velocity centers -gvxpt real [m^-1] #1/(vert. dist.) between x-pt velocity centers -sxyxpt real [m^2] #average velocity cell area touching x-point +ghxpt real [m^-1] +threadprivate #1/(horiz dist.) between x-pt velocity centers +gvxpt real [m^-1] +threadprivate #1/(vert. dist.) between x-pt velocity centers +sxyxpt real [m^2] +threadprivate #average velocity cell area touching x-point ghxpt_lower real [m^-1] #1/(horiz dist.) between x-pt velocity centers gvxpt_lower real [m^-1] #1/(vert. dist.) between x-pt velocity centers sxyxpt_lower real [m^2] #average velocity cell area touching x-point @@ -501,10 +501,10 @@ redopltvtag integer /0/ #if=1, redo plate vtag if numerically inaccur ***** Timing: istimingon integer /1/ # =1 calcs timing data; call wtottim to output iprinttim integer /0/ # =1 to write timing report to terminal -ttotfe real /0./ # time spent in full f evaluation (pandf) -ttimpfe real /0./ # time spent in full f eval. for impurities -ttotjf real /0./ # time spent in Jacobian f evaluation (pandf) -ttimpjf real /0./ # time spent in Jac. eval. for impurities +ttotfe real /0./ +threadprivate # time spent in full f evaluation (pandf) +ttimpfe real /0./ +threadprivate # time spent in full f eval. for impurities +ttotjf real /0./ +threadprivate # time spent in Jacobian f evaluation (pandf) +ttimpjf real /0./ +threadprivate # time spent in Jac. eval. for impurities ttmatfac real /0./ # time spent in factoring Jacobian ttmatsol real /0./ # time spent in backsolve for using Jacobian ttjstor real /0./ # time spent in storing Jacobian @@ -513,11 +513,11 @@ ttjreorder real /0./ # time spent in row and column reordering ttimpc real /0./ # time spent in impurity calculations tstart real /0./ # initial time from function second tend real /0./ # final time from function second -ttnpg real /0./ # time spent in neudifpg -ttngxlog real /0./ # time spent for fngx in neudifpg -ttngylog real /0./ # time spent for fngy in neudifpg -ttngfd2 real /0./ # time spent in fd2tra for neudifpg -ttngfxy real /0./ # time spent for fngxy in neudifpg +ttnpg real /0./ +threadprivate # time spent in neudifpg +ttngxlog real /0./ +threadprivate # time spent for fngx in neudifpg +ttngylog real /0./ +threadprivate # time spent for fngy in neudifpg +ttngfd2 real /0./ +threadprivate # time spent in fd2tra for neudifpg +ttngfxy real /0./ +threadprivate # time spent for fngxy in neudifpg ***** Linkbbb: # information shared by bbb and wdf packages @@ -562,7 +562,7 @@ fngysobbb(0:nx+1) _real ***** Timespl: # Timing data for splines -totb2val real /0./ # time spent in spline b2val routine +totb2val real /0./ +threadprivate # time spent in spline b2val routine totintrv real /0./ # time spent in spline intrv routine ***** Limiter: @@ -683,13 +683,13 @@ eprofile_fit(num_elem) _real /0./ #expt profile values at epsi_fit xerrab(msg:string) subroutine # interface to remark and kaboom readne_dat(fname:string) subroutine - # reads tanh coeffs for radial elec density profile fits + # reads tanh coeffs for radial elec density profile fits # in fname the filename readte_dat(fname:string) subroutine - # reads tanh coeffs for radial elec temp profile fits + # reads tanh coeffs for radial elec temp profile fits # in fname the filename readti_dat(fname:string) subroutine - # reads spline coeffs for radial ion temp profile fits + # reads spline coeffs for radial ion temp profile fits # in fname the filename fit_neteti() subroutine # fits ne and te to radial tanh profile; ti to radial spline diff --git a/setup.py b/setup.py index eb4ac85c..1d585507 100644 --- a/setup.py +++ b/setup.py @@ -10,6 +10,7 @@ from Forthon.compilers import FCompiler import getopt import logging +import sysconfig version='8.1.0-beta.0' @@ -33,6 +34,7 @@ fcomp = None parallel = 0 petsc = 0 +OMP=False for o in optlist: if o[0] == '-g': @@ -46,8 +48,31 @@ elif o[0] == '--petsc': petsc = 1 elif o[0] == '--omp': + OMP = True os.putenv("OMP","1") - + +CARGS=[] +FARGS=['-g -fmax-errors=15', '-DFORTHON','-cpp','-Wconversion','-fimplicit-none'] + +if OMP: + FARGS=FARGS+['-fopenmp', '-DUEDGE_WITH_OMP=1'] + CARGS=CARGS+['-fopenmp'] + OMPargs=['--omp'] +else: + OMPargs=[] +OMPFLAGS='OMPFLAGS = {}'.format(' '.join(OMPargs)) + +FARGSDEBUG=['-fbacktrace','-ffree-line-length-0', '-fcheck=all','-ffpe-trap=invalid,overflow,underflow -finit-real=snan','-Og'] +FARGSOPT=['-Ofast'] + +if debug==1: + FARGS=FARGS+FARGSDEBUG +else: + FARGS=FARGS+FARGSOPT + +FLAGS ='DEBUG = -v --fargs "{}"'.format(' '.join(FARGS)) +if CARGS!=[]: + FLAGS =FLAGS+' --cargs="{}"'.format(' '.join(CARGS)) if petsc == 1 and os.getenv('PETSC_DIR') == None: @@ -77,7 +102,7 @@ def run(self): raise SystemExit("Python versions < 3 not supported") else: if petsc == 0: - status = call(['make', '-f','Makefile.Forthon']) + status = call(['make', FLAGS,OMPFLAGS, '-f','Makefile.Forthon']) else: status = call(['make', '-f', 'Makefile.PETSc']) if status != 0: raise SystemExit("Build failure") @@ -155,11 +180,16 @@ def makeobjects(pkg): # check for readline rlncom = "echo \"int main(){}\" | gcc -x c -lreadline - " rln = os.system(rlncom) -if rln == 0: +if rln == 0: define_macros = define_macros + [("HAS_READLINE","1")] os.environ["READLINE"] = "-l readline" libraries = ['readline'] + libraries +if OMP: + define_macros = define_macros + [("UEDGE_WITH_OMP",1)] + C_OMPARGS=['-fopenmp'] +else: + C_OMPARGS=[] setup(name="uedge", version=version, @@ -176,17 +206,16 @@ def makeobjects(pkg): ext_modules=[Extension('uedge.uedgeC', ['uedgeC_Forthon.c', os.path.join(builddir, 'Forthon.c'), - 'com/handlers.c', 'com/vector.c','bbb/exmain.c'], + 'com/handlers.c', 'com/vector.c','bbb/exmain.c', 'bbb/jaccalc.c'], include_dirs=[builddir, numpy.get_include()], library_dirs=library_dirs, libraries=libraries, define_macros=define_macros, extra_objects=uedgeobjects, - extra_link_args=['-g','-DFORTHON'] + + extra_link_args=CARGS+['-g','-DFORTHON'] + fcompiler.extra_link_args, - extra_compile_args=fcompiler.extra_compile_args + extra_compile_args=fcompiler.extra_compile_args + C_OMPARGS )], - cmdclass={'build': uedgeBuild, 'clean': uedgeClean}, test_suite="pytests", install_requires=['forthon'], diff --git a/svr/nksol.m b/svr/nksol.m index 7f3b3bdb..bf0b107a 100755 --- a/svr/nksol.m +++ b/svr/nksol.m @@ -77,7 +77,7 @@ c as implicit none (Gary R. Smith). c with vnorm included in some versions of lsode source c (Gary R. Smith). c 11-16-93 Added epscon1 and epscon2 as input variables to define the -c tolerance level for the linear iteration: +c tolerance level for the linear iteration: c epsfac = epscon1 * min(epscon2, frnm) (Tom Rognlien) c 8-07-95 added arrays su and sf to the calling sequence for psol. c the calling sequence for dogstp needed to add sf. @@ -102,7 +102,7 @@ c nksol solves nonlinear systems f(u)=0 rewritten in the form c equations are solved only approximately by a linear krylov iteration, c coupled with either a linesearch or dogleg global strategy. the c user may optionally choose either arnoldi-s method (with linesearch -c backtracking) or the generalized minimum residual method (gmres) +c backtracking) or the generalized minimum residual method (gmres) c (with either the linesearch or dogleg strategy) as the krylov c iteration technique, with or without preconditioning. c @@ -116,7 +116,7 @@ c nksol generates a sequence of approximations u(k) to a root of f. c the stopping criteria for the nonlinear iteration are the c following.. c -c 1. maxnorm( sf*f(u(k)) ) .le. ftol, +c 1. maxnorm( sf*f(u(k)) ) .le. ftol, c c where maxnorm() is the maximum norm function and ftol is a c user-supplied stopping tolerance. @@ -208,7 +208,7 @@ c and pass it to f (or jac), pset, and/or psol. c f = the name of the user-supplied subroutine for defining the c nonlinear system f(u) = 0. f is a vector-valued function c of the vector u. subroutine f is to compute the function -c f. it is to have the form +c f. it is to have the form c subroutine f(n, u, savf) c dimension u(*), savf(n) c where n and u are input and the array savf = f(u) is output. @@ -291,7 +291,7 @@ c value of mmax(=10), c lrw = integer scalar containing the length of the array rwork, c as declared by the user. (this will be checked by the c solver). -c +c c iwork = an integer work array. the length of iwork must be at least c 20 + mmax + lenimp, c where lenimp is the length of the user-defined integer work @@ -342,7 +342,7 @@ c value (i.e., increase the maximum dimension of the c maximum stepsize limit) have been taken. either c norm(f) asymptotes from above to a finite value c in some direction, or stepmx is too small. stepmx -c is computed internally as +c is computed internally as c stepmx = 1000*max(norm(su*u0),norm(su)), c where u0 is the initial guess, and norm() is the c euclidean norm. norm(su) here means the euclidean @@ -383,7 +383,7 @@ c norm(f) asymptotes from above to a finite value c value for the minimum needed length of iwork. c iterm=-10 means that the initial guess u did not c satisfy the constraints. -c +c c pset = the name of the optional user-supplied subroutine for c calculating any matrix data associated with the c preconditioner p. it is to have the form @@ -510,7 +510,7 @@ c lenimp iwork(4) length of the integer work array iwmp for c of lenimp is 0. c c iprint iwork(5) flag indicating whether optional statistics are -c desired. +c desired. c iprint=0 means no statistics are printed. c this is the default. c iprint=1 means the nonlinear iteration count, @@ -763,8 +763,11 @@ dimension icnstr(n) c----------------------------------------------------------------------- real pthrsh common /nks003/ pthrsh, ipcur, nnipset, incpset + real,external::tick,tock + real t_start_nksol c save + t_start_nksol = tick() zero=0. one=1.0 two=2.0 @@ -794,7 +797,7 @@ c call (i.e., icntnu = 0). c pthrsh = two if (icntnu .eq. 0) then pthrsh = two - else + else c set pthrsh = 0 pthrsh = zero c set ipcur = 0 to indicate that the preconditioner is from an earlier @@ -837,7 +840,7 @@ call errgen(ierr,zero,zero,0,0) elseif (mf .eq. -1) then methn = 0 methk = 2 -ccc MVU: 15-jan-2020 +ccc MVU: 15-jan-2020 c elseif (mf .ge. 2) then c methn = 2 c methk = mf - 1 @@ -974,7 +977,7 @@ call errgen(ierr,zero,zero,liw,leniw) endif if (itermx .eq. 0) itermx = 200 nbcfmx = 10 - if (iprint.gt.1) write(*,*)'0) sptol,epsmch', stptol,epsmch + if (iprint.gt.1) write(*,*)'0) sptol,epsmch', stptol,epsmch if (stptol .eq. 0.0) stptol = epsmch**(2.0/3.0) if (iprint.gt.1) write(*,*)'1) sptol', stptol if (stepmx .eq. zero) then @@ -1119,6 +1122,8 @@ call infgen (iterm,zero,zero,0,0) rwork(1) = stepmx rwork(2) = fnrm rwork(3) = tau + + print *, '@@Time nksol@@ ', tock(t_start_nksol), 's' return c----------------------- end of subroutine nksol ----------------------- end @@ -1200,7 +1205,7 @@ c failed to reduce norm(f) sufficiently. either u c maximum stepsize limit) have been taken. either c norm(f) asymptotes from above to a finite value c in some direction, or stepmx is too small. -c +c c----------------------------------------------------------------------- implicit none integer n, iret, iter, itermx, ncscmx, iterm, locwmp, locimp @@ -1421,7 +1426,7 @@ dimension v(n), s(n) subroutine model(n, wm, lenwm, iwm, leniwm, u, savf, x, f, jac, * su, sf, pset, psol) c----------------------------------------------------------------------- -c this routine interfaces to subroutine solpk for the approximate +c this routine interfaces to subroutine solpk for the approximate c solution of the newton equations in the newton iteration. c c on entry @@ -2547,7 +2552,7 @@ subroutine dogdrv (n, wm, lenwm, iwm, leniwm, u, savf, f1nrm, x, c----------------------------------------------------------------------- c this is the real version of subroutine dogdrv, which is the driver for c the dogleg step. its purpose is to find a unew on the dogleg curve -c such that f(unew) .le. f(u) + alpha*gt(unew-u) (alpha=1.e-4 used), +c such that f(unew) .le. f(u) + alpha*gt(unew-u) (alpha=1.e-4 used), c and scaled steplength = tau, starting with the input tau but c increasing or decreasing tau if necessary. also, it produces the c starting trust region size tau for the next iteration. @@ -2730,7 +2735,7 @@ subroutine dogstp (m, mp1, mmaxp1, ygm, ycp, beta, hes, tau, ynew, real ygm, ycp, beta, hes, tau, ynew, xnew, xnewl, v real wk, wmp, u, su, sf, savf dimension ygm(m), ycp(m), hes(mmaxp1,m), ynew(mp1), xnew(n), - * v(n,m), wk(n), wmp(*), iwmp(*), u(*), su(n), sf(n), + * v(n,m), wk(n), wmp(*), iwmp(*), u(*), su(n), sf(n), * savf(n) logical dog1, nwttkn c----------------------------------------------------------------------- @@ -2902,7 +2907,7 @@ call psol (n, u, savf, su, sf, f, jac, wk, wmp, iwmp, xnew, ier) end subroutine trgupd (m, mp1, mmaxp1, n, np1, u, savf, f1nrm, x, xl, * ynew, su, sf, nwttkn, stepmx, beta, hes, - * stptol, mxtkn, tau, uprev, fprev, f1prv, upls, + * stptol, mxtkn, tau, uprev, fprev, f1prv, upls, * f1pls, wk, ivio, iret, f) implicit none integer m, mp1, mmaxp1, n, np1, ivio, iret, locwmp, locimp @@ -3097,7 +3102,7 @@ c f1(upls) sufficiently small. call saxpy (mp1, ynew(i), hes(1,i), 1, wk, 1) 50 continue dfpred = slpi + pt5*sdot (mp1, wk, 1, wk, 1) - if ( (iret.ne.2) .and. + if ( (iret.ne.2) .and. * ( (abs(dfpred-delf).le.pt1*abs(delf)) .or. * (delf.le.slpi) ) .and. (.not.nwttkn) .and. * (tau.le.pt99*stepmx) .and. (ivio.eq.0) ) then @@ -3288,7 +3293,7 @@ call sswap(n, u, 1, unew, 1) fnrmp = vnormnk(n,savf,sf) f1nrmp = fnrmp*fnrmp/two acond=f1nrmp/adjf1 - f1nrm + alpha*slpi*rl - + if (iprint .gt. 1) then write(iunit,125) rl,f1nrm,f1nrmp,acond,nfe endif @@ -3322,7 +3327,7 @@ call sswap(n, u, 1, unew, 1) * (rl .lt. rlmax) ) go to 130 endif if ( (rl.lt.one) .or. - * ((rl.gt.one).and.(f1nrmp/adjf1.gt.f1nrm+alpha*slpi*rl)) ) + * ((rl.gt.one).and.(f1nrmp/adjf1.gt.f1nrm+alpha*slpi*rl)) ) * then rllo = min(rl,rlprev) rldiff = abs(rlprev-rl) @@ -3350,7 +3355,7 @@ call sswap(n, u, 1, unew, 1) rldiff = rldiff - rlincr f1lo = f1nrmp endif - + if (iprint .gt. 1) then mcond=rldiff-rlmin acond=f1nrmp/adjf1 - f1nrm + alpha*slpi*rl @@ -3529,7 +3534,7 @@ c if icnstr(i) .gt. 0, then u(i)+x(i) must be .gt. 0, c if icnstr(i) .lt. 0, then u(i)+x(i) must be .lt. 0, while c if icnstr(i) .eq. 0, then u(i)+x(i) is not constrained. c -c rlx = real scalar restricting update to abs(x/u) < fac2*rlx +c rlx = real scalar restricting update to abs(x/u) < fac2*rlx c c tau = the current size of the trust region. it is the trust c region size tried at the beginning of the dogleg step. @@ -3656,7 +3661,7 @@ dimension u(*), icnstr(n) iret = 1 ivar = i return - endif + endif endif 100 continue return @@ -3664,7 +3669,7 @@ dimension u(*), icnstr(n) end subroutine infgen (iterm, v1, v2, i1, i2) c----------------------------------------------------------------------- -c this routine prints informational messages from the driver nksol. +c this routine prints informational messages from the driver nksol. c the output from this routine can be turned off by setting a flag in c iwork. c-----------------------------------------------------------------------