module in use itg_data implicit none integer :: movieon ! included for backwards compatibility. Does nothing. namelist/wdat/ld,nffty,nfftx,md,nd,dt0,nstp,nprnt,nfreq,nread, & lin,x0,xp,y0,z0,pmag,shr,qsf,epsn,eps,alpha,etai,dens,tiovte, & nueeff,nuii,rmu1,etaipar,vy,vz,dtadj,note,epse,iflow, & igradon,iphi00,iflr,mlow,mhi,ihdf,nspecies,etae,rmime, & ninterv,mfr,nfr,nperpmom,nparmom,nemom,iperiod,n0, & iodd,s_par,s_perp,ntrace,ifilter,iexp,ikx, & lambda1,lambda2,nu1,nu2,idt,inlpm,n_p,n_zpic,bmax, & nuar,nuai,nubr,nubi,nucr,nuci,nudr,nudi, & nu1r,nu1i,nu2r,nu2i,nu3r,nu3i,nu4r,nu4i,nu5r,nu5i,nu6r,nu6i, & nu7r,nu7i,nu8r,nu8i,nu9r,nu9i,nu10r,nu10i,nu11r,nu11i, & nu12r,nu12i,nu13r,nu13i,nu14r,nu14i,iseed,stochf, & tau,rmass,charge,eta,eta_par,Ln,n_I,jrad,binary, & icrit,gamma_0,rdiff_0,tol,igeo, debug_plotlabel, layout, movieon contains subroutine input ! ! Read RUNNAME.in input file, and set some default input values. ! integer i integer iargc,icount external iargc, getarg character command*80 pi=3.141592653589793 ! pi=abs(acos(-1.0)) ! machine independent form... layout='linear' note='ITG is a nonlinear gyrofluid turbulence simulation code.' gamma_0=0.1 ! set smaller for more accurate L_Tcrit estimate binary=.false. rdiff_0=0.05 icrit=0 igeo=0 jrad=1 n_p=500 n_zpic=32 bmax=1. tol=0.01 nffty=0 nfftx=0 md=0 nd=0 iflow=1 ninterv=10 nfreq=-2 xp=1.e10 x0=1.e10 stochf=0.0 dens=1.0 idt=1 dtadj=0.1 iperiod=0 ! default is old b.c.'s n0=10 epse=0.0 ! r/R for electrons, 0=adiabatic electrons only. igradon=1 s_par=0. ! particle shaping factor s_perp=0. ! particle shaping factor iexp=2 ! used in moment filter ikx=2 inlpm=1 ifilter=0 iphi00=2 iflr=8 rmu1=-1000.0 ! initialization for all diff values iodd=0 ! even and odd modes initialized by default ntrace=0 nperpmom=1 nparmom=3 nemom=3 etaipar=-100. ! arrays: eta = -100. eta_par = -100. tau = -100. rmass = -100. Ln = -100. charge = -100. Ln(1)=1.0 n_I(1)=1.0 lin=1 nspecies=1 rmime=1. etae=0. alpha=0. vy=0.0 vz=0.0 lambda1=1.0 lambda2=1.6 nu1=1.6 nu2=1.3 nu1r=-1.e10 ! values which will trigger default nu's. nucr=-1.e10 nudr=-1.e10 ! ! nu11-14 no longer used ! nu11r= 0. nu11i= 0. nu12r= 0. nu12i= 0. nu13r= 0. nu13i= 0. nu14r= 0. nu14i= 0. ihdf=1 ! 1->hdf movie, 0->arrays for particle code. iseed=1 debug_plotlabel=' ' ! determine the name of the input file: icount=iargc() if(icount >= 1) then call getarg(1,runname) else write(6,*) 'What is the name of the *.in input file?' write(6,*) '(without the .in suffix):' read(5,*) runname endif lrunname=index(runname,' ')-1 write(6,*) 'Running itg for ', runname(1:lrunname) ! Run a shell script to strip out tab characters and comments, which ! some compilers can't handle, from the namelist input file: command='gfbin/nmlstrip '//runname(1:lrunname)//'.in '//char(0) call ishell(command) ! ! read namelist ! open(unit=12,file=runname(1:lrunname)//'.ins',status='old') read(12,wdat) inquire(unit=21,name=fullname) close(unit=12) ! Check to see if nspecies > 10. if(nspecies > 10) then write(*,*) 'nspecies > 10 requires recoding the defaults in ' write(*,*) 'the file in.f90. Stopping.' stop endif open(unit=9,file=runname(1:lrunname)//'.out') ! Open output file ! ! Choose multiple of pi for x0 if x0<0: ! if(x0 == 1.e10) then x0=pi*2.5 else if(x0 < 0) x0=pi*abs(x0) endif if(xp == 1.e10) then xp=pi*2.5 else if(xp < 0) xp=pi*abs(xp) endif ! ! If searching for critical gradient, force linear run only: ! if(icrit /= 0 .and. lin == 0) then write(*,*) 'Forcing lin=1 because icrit /= 0' lin=1 endif if(icrit == 2 .and. rmu1 == -1000.) rmu1=0.01 ! Set default value of etaipar if(etaipar == -100.) etaipar=etai ! ! By definition these quantities are fixed: ! tau(1)=1.0 rmass(1)=1.0 ! Setup the different rho's, etc. for multiple species: do i=1,nspecies if(eta(i) == -100) eta(i)=etai if(eta_par(i) == -100.) eta_par(i)=eta(i) if(charge(i) == -100.) charge(i)=1. if(Ln(i) == -100.) Ln(i)=1. if(tau(i) == -100.) tau(i)=1. if(rmass(i) == -100.) rmass(i)=1. ! ! Derived quantities: ! rho(i)=sqrt(tau(i)*rmass(i))/charge(i) vt(i)=sqrt(tau(i)/rmass(i)) enddo nu_ii(1)=nuii if(nspecies >= 2) then do i=2,nspecies nu_ii(i)=nuii*charge(i)**4*n_I(i)*vt(i)/(n_I(1)*tau(i)**2) enddo endif ! ! check for errors or problems in the namelist input: if(nstp/nprnt < 2) then write(*,*) 'Warning: Reducing nprnt !' nprnt=nstp/2 endif if(nfreq == -2) nfreq = nprnt ! if(iperiod >= 0 .and. iperiod <= 2) then ! indomz=ndomz ! inconz=nconz ! if(indomz /= 1 .or. inconz /= 1) then ! write(*,*) 'Error: ndomz and nconz parameters in itg_data.f90' ! write(*,*) ' MUST be set to 1 for iperiod = 0, 1, or 2' ! call aborter(6,' aborter called from input.f') ! endif ! endif ! ! If closure coefficients aren't set in the namelist, then ! use the values from M.A.Beer Ph.D. thesis. ! if(nu1r == -1.e10) then write(*,*) 'setting default closure coefficients from Beer''s thesis' if (nperpmom == 2.and.nparmom == 4) then nu1r=2.019 nu1i=-1.620 nu2r=.433 nu2i= 1.018 nu3r=-.256 nu3i=1.487 nu4r=-.070 nu4i=-1.382 nu5r=-8.927 nu5i=12.649 nu6r= 8.094 nu6i= 12.638 nu7r= 13.720 nu7i= 5.139 nu8r= 3.368 nu8i= -8.110 nu9r= 1.974 nu9i= -1.984 nu10r= 8.269 nu10i= 2.060 elseif (nperpmom == 1.and.nparmom == 3) then nu1r=1.232 nu1i=.437 nu2r=-.912 nu2i=.362 nu3r=-1.164 nu3i=.294 nu4r=.478 nu4i=-1.926 nu5r=.515 nu5i=-.958 else call aborter(6,'only set up for 3+1 or 4+2 moments') endif endif if(nemom == 3) then if(nucr == -1.e10) then nuar=.290 nuai=-.071 nubr=-1.102 nubi=-.689 nucr=.817 nuci=1.774 endif elseif(nemom == 4) then if(nudr == -1.e10) then nuar=-.038 nuai=.073 nubr=.657 nubi=-.060 nucr=-1.522 nuci=-1.085 nudr=.905 nudi=2.073 endif else call aborter(6,'only set up for 3 or 4 electron moments') endif initx='Initial' initkx='Initial' initkp='Initial' inity='Initial' initky='Initial' stepnlps=0 end subroutine input end module in