subroutine fieldlal(filebz) c----------------------------------------------------------------------- c reading B field on a file (LAL) c----------------------------------------------------------------------- parameter (imaa=10000,imb=10,maxbuf=50,lmx=1000) parameter (nspl=10001) parameter (nsplc=nspl*3+2) character filebz*12 logical poiflag common/flags/poiflag common/flag1/ifld,ifoclal common/misc/irun,ip,nn,vv(100) common/bfield/bf(1002,0:6),zmin,zmax,dzz common/systeme/nel,ntype(0:lmx),zloc(0:lmx),el(11,0:lmx) common/spline/c(nsplc),zchp(nspl),chp(nspl),ivrai common/unit/nbz,nfld,nin,nsav,nschef,nav,ndes1,ndiag,ndpout, 1 nemit,nfield,nhist,nnout,nout1,nout2,nsemit,nstat, 2 ntrw,nuch,nsnap,nback,nback1,ndes2,nimp,ninput,npois dimension d(2),w(nsplc) dimension z(1000),bz(1000) c-------------------------------------------------------------------------- c* namelist/champ/chp c open (unit=nbz,file=filebz//'.inbz',status='old') nlast = index(filebz,' ') if(nlast.eq.0) nlast=len(filebz)+1 open (unit=nbz,file=filebz(1:nlast-1)//'.inbz',status='old') ifld=1 zmin=vv(1) zmax=vv(2) dzz=vv(3) nchp=vv(4) facbz=vv(5) iopt=vv(6) c--- if(iopt.eq.1) then c read field in namelist format, step constant write(nnout,*) 'Namelist format for Foclal ' write(nnout,9017) zmin,zmax,facbz zchp(1)=vv(1) do 10 i=2,nchp zchp(i)=zchp(i-1)+dzz 10 continue read(nbz,CHAMP) do 11 i=1,nchp chp(i)=chp(i)*facbz write(nnout,100) zchp(i),chp(i) 11 continue if(nchp.lt.nspl) then do 12 i=nchp+1,nspl chp(i)=0. 12 continue endif ivrai=nchp endif c--- if(iopt.eq.2) then c read field in free format z(cm), chp(Gauss), step constant in part c with field but we don't give z and bz for bz = 0. write(nnout,*) 'Free format for foclal' il=1 13 continue read(nbz,*,end=14) z(il),bz(il) bz(il)=bz(il)*facbz il=il+1 go to 13 c--- 14 continue nchp=il-1 zmin=z(1) zmax=z(nchp) dzz=z(2)-z(1) write(nnout,9017) zmin,zmax,facbz do 17 iw=1,nchp write(nnout,100) z(iw),bz(iw) 17 continue i=1 zchp(i)=zmin jp=1 15 continue if(abs(zchp(i)-z(jp)).le.1.e-04) then chp(i)=bz(jp) jp=jp+1 if(jp.gt.nchp) go to 18 else chp(i)=0. endif i=i+1 zchp(i)=zchp(i-1)+dzz if(zchp(i).le.zmax) go to 15 cbm if(abs(zmax-zchp(i)).gt.1.e-04) go to 15 18 continue ivrai=i endif c--- 9017 format ( . ' zmin = ',t40,g12.4,' cm'/ . ' zmax = ',t40,g12.4,' cm'/ . ' scaling factor = ',t40,g12.3) 100 format(1x,'z=',E13.5,5X,'chp. mag.=',E13.5) c---------------ecriture dans un fichier open(unit=nfield,file='parmfoc',access='sequential', * status='unknown',form='formatted') do 16 i=1,ivrai write(nfield,*) zchp(i),chp(i) 16 continue close(nfield) c------------------------------- J=1 D(1)=0. D(2)=0. C C---CALCUL DES COEFFS DU POLYNOME-INTERPOLATION SPLINE(DEG.3) C call spln1(ivrai,zchp,chp,j,d,c,w) return end c++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*