source: PSPA/parmelaPSPA/trunk/fieldlal.f

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