subroutine fieldlal(filebz) c----------------------------------------------------------------------- c reading B field on a file (LAL) c----------------------------------------------------------------------- c include 'param_sz.h' include 'bfieldcom.h' include 'flagcom.h' include 'misccom.h' include 'syscom.h' include 'ucom.h' c character filebz*12 common/spline/c(nsplc),zchp(nspl),chp(nspl),ivrai dimension d(2),w(nsplc) cbm28/09/09 dimension z(1000),bz(1000) dimension z(nptcb),bz(nptcb) 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) write(nnout,*) 'Number of used values for B ',nchp if(nchp.gt.nptcb) then write(nnout,*) * ' Number of points for magnetic field gt ',nptcb stop endif 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 cibm read(nbz,CHAMP) read(nbz,champ,iostat=ios) 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) cbm10/2009 dzz=z(2)-z(1) dzz=(zmax-zmin)/(nchp-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++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*