source: PSPA/parmelaPSPA/trunk/fieldlal.old @ 404

      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++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*