      program mga
c     
      include 'fbtmgams.inc'
      include 'mga.inc'
c     
      integer ishot
      character*8 strshot
      ishot = 1
      call get_command_argument(ishot,strshot)
      read (strshot,*) ishot
      print *,'ishot',ishot
c     
      namelist/data/ri,ro,zu,nr,nz,ilie,rlim1,rlim2,zlim1,zlim2,
     1     ilia,rlia1,rlia2,zlia1,zlia2,eftlim,ritlim,botlim,toplim,
     1     ibro,rbro,zbro,ibzo,rbzo,zbzo,placu1,placu2,placex,icur,rvf,
     2     zvf,cvf,ivsec,vsec,ttfac1,ttfac2,ell1,ell2,emm1,emm2,ppfac,ppal,
     2     itamax,testa,mei,ncosei,isaddl,ievolv,nruns,
     3     capaj,bzero,qzero,psirat,weitam,weitex,omega,
     3     icvx,cvx1,cvx2,cvx3,cvx4,cvx5,cvx6,cvx7,cvx8,cvx9,cvx10,cvx11,
     4     cvx12,cvx13,cvx14,cvx15,cvx16,icoilon,zeecorb,zeecort,
     4     dissi,strki,rbee,zbee,thbee,nprob,rflu,zflu,nloop,neqtcv,
     5     iansha,rmajo1,rmajo2,rmino1,rmino2,cappa1,cappa2,delta1,delta2,
     5     hlamd1,hlamd2,zmajo1,zmajo2,timeeq,inova,ierat,iwrida,ides,
     6     imeas,ilarg,ikriz,npsi,size,xor,yor,itcvpl,ifour,iplot,ixdr,
     6     nvvel,nfilae,nfilaf,nfast,     rampt,nelz,xip,xop,zlp,zup,gain,
     7     ddd,eee,nmatrx,istop,iscramb,iprcinc,ohsame,ohsami,ipra,iprml,
     7     ipreps,iprvol,iprx,vscal,wscal,uc1,uc2,uc3,iprmea,iprmax,ipr16,
     8     ipripz,iscale,rshift1,rshift2,rshift3,zshift,rliaa,zliaa,ilimre,
     8     ohback,veback,gapin,gapout,emgain,aipgain,boost,amagic,zeecorr,
     9     ntoft,toft,deltat,hpla,wpla,f36same,psifac,numeq,relovo,ggain,
     9     ntmax,diohdt,mvloop,timefac,flattop,iohfb,if36fb,ohcorr,hgain,
     9     gainr,gainz,gainvz,gainze,gainvze,deltar,egain,fgain,ohgain,
     9     bzpzero,bzmzero,curfac,aipdel,dpszero,dpsfac,delipz,aipipz,
     9     brpzero,brmzero,bzpzerb,bzmzerb,brpzerb,brmzerb,
     9     gainext,fastm,alpha,nzaxel,nzaxre
c
      tpi    = 2.*3.14159265     
c
c     
c     ------------------default values------------------------------
c     
      call default
c     
c     read input data
c     
c     
c     
      if(ishot.eq.0) then
         open(unit=48,file='asdd.dat',readonly,status='old')
         read(48,data)
         close(unit=48)
      endif
c     Do not load MDS value now, wait for defaults to be read
c     
c     
c     Read from "default" fbtmeas.dat, values shot-dependent will be overwritten
c     when reading the MDS nodes.
c     NOTE: [AM 16/06/2017] This should be in DEFAULT subroutine (?)
      open(unit=49,file='fbtmeas.dat',readonly,status='old')
      open(unit=50,file='aammll.dat',status='replace')
      read(49,3001) nruns,icur,nprob,nloop,
     1     nr,nz,iallf,ngroup
      read(49,3000) ri,ro,zu,rhocu,filfac,rhovv
      read(49,3000) (rvf(i),i=1,iallf)
      read(49,3000) (zvf(i),i=1,iallf)
      read(49,3000) (hvf(i),i=1,iallf)
      read(49,3000) (wvf(i),i=1,iallf)
      read(49,3000) (tvf(i),i=1,iallf)
      read(49,3001) (kgroup(i),i=1,iallf)
      read(49,3001) (isvf(k),k=1,ngroup)
      read(49,3001) (isvl(k),k=1,ngroup)
      read(49,3001) (itype(k),k=1,ngroup)
      read(49,3000) (rbee(n),n=1,nprob)
      read(49,3000) (zbee(n),n=1,nprob)
      read(49,3000) (thbee(n),n=1,nprob)
      read(49,3000) (rflu(n),n=1,nloop)
      read(49,3000) (zflu(n),n=1,nloop)
c     
c     Increased nruns maximum from 21 to 40 (SC, 30/01/03)
c     Increased nruns maximum from 40 to 101 (SC, 22/03/10)
      if(nruns.gt.101) nruns=101
c     
      do 8 m=1,nruns
         read(49,3001) nrun,ilie,ilia,ibro,ibzo
         read(49,3000) placur(m),zax(m),bzeroe(m),rze(m),timeqe(m)
         read(49,3000) raxt(m),zaxt(m),raxb(m),zaxb(m)
         read(49,3000) zecorb(m),zecort(m)
         read(49,3000) betai(m),eli(m),diamag(m),qedge(m),qzeroe(m)
         read(49,3000) area(m),cappab(m),shvsec(m)
         read(49,3000) (gcurr(m,i),i=1,ngroup)
         read(49,3000) (bee(m,n),n=1,nprob)
         read(49,3000) (flux(m,n),n=1,nloop)
         if(ilie.gt.0) then
            read(49,3000) (rlim(m,i),i=1,ilie)
            read(49,3000) (zlim(m,i),i=1,ilie)
         endif
         if(ilia.gt.0) then
            read(49,3000) (rlia(m,i),i=1,ilia)
            read(49,3000) (zlia(m,i),i=1,ilia)
         endif
         if(ibro.gt.0)
     1        read(49,3000) (rbroe(m,i),i=1,ibro),(zbroe(m,i),i=1,ibro)
         if(ibzo.gt.0)
     1        read(49,3000) (rbzoe(m,i),i=1,ibzo),(zbzoe(m,i),i=1,ibzo)
c     
c     
    8 continue
c     
      if(ishot.ne.0) then
         call fbtmdsopen    (ishot)
! Reads aipdel,aipgain(6),aipipz,alpha,amagic,boost,brmzerb,brmzero,brpzerb,brpzero,bzmzerb
!       bzmzero,bzpzerb,bzpzero,curfac,delipz,deltar,diohdt(mh),dpsfac
!       dpszero,egain,emgain,f36same,fastm,fgain,flattop,gain(6),gainext(17)
!       gainr,gainvz,gainvze,gainz,gainze,gapin,gapout,ggain,hgain,hpla
!       ierat,if36fb,ifour,ikriz,inova,iohfb,ipr16,iprcinc,ipripz,
!       iprmax,iscale,iscramb,istop,iwrida,ixdr,mei,mvloop,ncosei,nelz,neqtcv,nfast,npsi,nr,nruns,ntmax,
!       numeq,nvvel,nz,nzaxel,nzaxre,ohback,ohcorr,ohgain,ohsame,ohsami,psifac,rampt,relovo,
!       ri,ro,rshift1,rshift2,rshift3,timefac,toft(mh),uc1,uc2,uc3,veback,
!       vscal,wpla,wscal,xip,xop,zeecorr,zlp,zshift(3),zu,zup
         call fbtmdsgetconst(ishot)
! Reads shvsec(nruns),placur(nruns),eli(nruns),area(nruns),cappab(nruns),
!       rze(nruns), raxt(nruns),zaxt(nruns),raxb(nruns),zaxb(nruns)
         call fbttomdsgetconst(ishot)
         do mj=1,nruns
! Reads botlim,bzero,capaj,cappa1,delta1,dissi,eftlim,ell1,emm1,hlamd1,
!       iansha,ibro,ibzo,icoilon,ilia,ilie,isaddl,itamax,ivsec,omega,
!       placex,placu1,ppal,ppfac,psirat,qzero,rbro(mbro),rbzo(mbzo),
!       ritlim,rlia1(mabp),rlim1(mebp),rmajo1,rmino1,strki,testa,
!       timeeq,toplim,ttfac1,vsec,weitam,weitex,zbro(mbro),zbzo(mbzo),
!       zlia1(mabp),zlim1(mebp),zmajo1,ilie,ilia,ibro,ibzo,ivsec
            call fbtmdsgetvar(ishot,mj)
! Reads gcurr_t(ngroup), bee_t(nprob), flux_t(nloop)
            call fbttomdsgetvar(ishot,mj)
!
! ---------- Modifications by amerle on 17/OCT/2018 -------------------
! iscramb values larger than 1000 indicate that we are using the full
! F-coil set for Ipz control [Work by Federico Pesamosca]
            iscramb = mod(iscramb,1000)
! ------ End of Modifications by amerle on 17/OCT/2018 ----------------
!
            do kj=1,ngroup
               gcurr(mj,kj)=gcurr_t(kj)
            enddo
            do kj=1,nprob
               bee(mj,kj)=bee_t(kj)
            enddo
            do kj=1,nloop
               flux(mj,kj)=flux_t(kj)
            enddo
            zax(mj)=zaxt(mj)
            bzeroe(mj)=bzero
            timeqe(mj)=timeeq
            do ij=1,ilie
               rlim(mj,ij)=rlim1(ij)
               zlim(mj,ij)=zlim1(ij)
            enddo
            do ij=1,ilia
               rlia(mj,ij)=rlia1(ij)
               zlia(mj,ij)=zlia1(ij)
            enddo
            do ij=1,ibro
               rbroe(mj,ij)=rbro(ij)
               zbroe(mj,ij)=zbro(ij)
            enddo
            do ij=1,ibzo
               rbzoe(mj,ij)=rbzo(ij)
               zbzoe(mj,ij)=zbzo(ij)
            enddo
C           Unsure what this is supposed to do [amerle - 27/JUL/2020]
c           if (ilimre.eq.1) then
c              do i=1,ilia
c                 rlia(m,i) = rliaa(i)
c                 zlia(m,i) = zliaa(i)
c              enddo
c           endif
            if (iansha.eq.1) then
C              Using *1 is enough since this is used only in the Kappa observer
               do ij=1,ilia
                  win         = (tpi*float(ij-1))/float(ilia)
                  rlia(mj,ij) = rmajo1+rmino1*cos(win+delta1*sin(win)-hlamd1*sin(win*2.))
                  zlia(mj,ij) = zmajo1 + rmino1*cappa1*sin(win)
                  write(*,*) "rzlia",mj,ij,rlia(mj,ij),zlia(mj,ij)
               enddo
            endif
            if(istop.eq.8) then
               do m=1,nruns
                  print 3000, (rlim(m,i),i=1,ilie)
                  print 3000, (zlim(m,i),i=1,ilie)
                  print 3000, (rlia(m,i),i=1,ilia)
                  print 3000, (zlia(m,i),i=1,ilia)
                  print 3000, (rbroe(m,i),i=1,ibro),(zbroe(m,i),i=1,ibro)
                  print 3000, (rbzoe(m,i),i=1,ibzo),(zbzoe(m,i),i=1,ibzo)
               enddo
            endif
         enddo
      endif
      write(6,data)
c     
      call const
      call observ
      call coilnum
      call brbzeq
      call scenari
      call backoff
      call initial
c---------------------------start time loop---------------------
      iiout = 0
      open (unit=51,file='pos_cor.dat',status='replace')
      do 6996 itti=1,ntmax
         it=itti
         call update
         call refer
         if(iiout.eq.1) go to 6998
         call mutbrbz
         call current
         if((iprcinc.eq.1).and.(ttwo.ge.f36same).and.
     1        (ttwo.lt.f36same+deltat)) call diagnos
         call wavgen1
 6996 continue
 6998 continue
      itmax=itti-1
c     
      call wavgen2
      call mmatrix
      call amatrix
      call gmatrix
      if((iprcinc.eq.2).and.(nvvel.eq.19)) call fluxerr
      call wrimxdr ! Removed all xdr functionality except if XDR is defined
      call mgamdsput
      write (51,7420) itti
 7420 format (1x,i5)
      close (unit=51,status='keep')
c     
 3000 format(1x,6e12.5)
 3001 format(1x,12i6)
 3500 close(unit=49)
      close(unit=50)
 5000 stop
      end
c     
c     
c     
c     
c     
c     
c     
c     
      subroutine default
      include 'fbtmgams.inc'
      include 'mga.inc'
c     
      nzaxel=10
      nzaxre=1
      nmatrx=1
      istop=0
      iscramb=1
      iprcinc=1
      ilimre=0
      ipra=0
      iprml=0
      ipreps=0
      iprx=0
      iprvol=0
      iprmea=0
      iprmax=0
      ipr16=0
      ipripz=0
      iscale=0
      gain=0.
      ggain=0.1
      ohsame=1.0
      emgain=200.
      gainr=0.
      gainz=0.
      gainvz=0.
      gainze=0.
      gainvze=0.
      egain=3.
      fgain=2.
      ohgain=0.5
      ohcorr=0.
      f36same=-0.000
      aipgain(1)=0.0000
      ohback=1.10
      veback=0.93
      bzpzero=-0.00015
      bzmzero=-0.00015
      brpzero=-0.0
      brmzero=-0.0
      bzpzerb=-0.00015
      bzmzerb=-0.00015
      brpzerb=-0.0
      brmzerb=-0.0
      rampt=0.5
      nelz=2
      xip=0.65
      xop=1.11
      zlp=-0.24
      zup=0.24
      iohfb=1
      if36fb=1
      gapin=0.04
      gapout=0.10
      ntmax=900
      deltat1=0.001
      deltat2=0.002
      deltat5=0.010
      hpla=0.1
      wpla=0.1
      mvloop(1)=0
      timefac=0.8
      curfac=0.75
      boost=0.
      amagic=1.
      rshift3 = 0.
      zeecorr = 0.
      aipdel=0.
      flattop=0.250
      psifac=5000.
      dpsfac=1.
      deltar=0.01
      numeq=7
      ntoft=29
      dissi=3.0e-10
c     UNTRANSLATED
      zshift(1)=0.00
c     END UNTRANSLATED
      do n=1,mh
         ddd(n) = 1.
         eee(n) = 1.
      enddo
      vscal=10000.
      wscal=10000.
      uc1=0.0e-8
      uc2=1.0e-8
      uc3=1.0e-8
      relovo = 1.5
      fastm  = 0.0
      gainext(1)= 0.0
      alpha  = 0.0
c     
      return
      end
c     
c     
c     
c     
c     
c     
c     
c     
      subroutine const
      include 'fbtmgams.inc'
      include 'mga.inc'
c     
c-------------------negative plasma current---------------------
c     
      if(iohfb.eq.-1) then
         zeecorb = -zeecorb
         zeecort = -zeecort
         rshift3 = -rshift3
         zshift(1)  = -zshift(1)
         zeecorr = -zeecorr
         relovo  = -relovo
         bzpzero = -bzpzero
         bzmzero = -bzmzero
         brpzero = -brpzero
         brmzero = -brmzero
         bzpzerb = -bzpzerb
         bzmzerb = -bzmzerb
         brpzerb = -brpzerb
         brmzerb = -brmzerb
         aipdel  = -aipdel
         dpszero = -dpszero
         delipz  = -delipz
         aipipz  = -aipipz
         do m=1,nruns
c     Using FBT nodes the current already has sign
c     placur(m) = -placur(m)
            shvsec(m) = -shvsec(m)
            do i=1,ngroup
               gcurr(m,i) = -gcurr(m,i)
            enddo
            do n=1,nprob
               bee(m,n)   = -bee(m,n)
            enddo
            do n=1,nloop
               flux(m,n)  = -flux(m,n)
            enddo
         enddo
      endif
c     IERAT=4 case added (SC, 07/10/11)
c     IERAT=-1 (SC, 16/06/20)
c     Incompatibility with mvloop(1)=11 or 21 (Vloop control)
      if ((ierat.eq.4.or.ierat.eq.-1).and.
     +     (mvloop(1).eq.11.or.mvloop(1).eq.21)) then
         mvloop(1)=7;
      endif
c-------------------------------------------------------------------
c     constants
c     
c     call gf(ineg,0,0.500,0.0,1.0,0.0,ans)
c     print 3000,ans
c     call gf(ineg,0,0.510,0.0,1.0,0.0,ans)
c     print 3000,ans
c     call gradgf(ineg,0,10.05,0.0,10.0,0.0,gradx,gradz)
c     beex=(gradz/10.)*2.0e-7
c     beez=-(gradx/10.)*2.0e-7
c     print 3000,beex,beez
c     call gradgf(ineg,0,10.0,0.05,10.0,0.0,gradx,gradz)
c     beex=(gradz/10.)*2.0e-7
c     beez=-(gradx/10.)*2.0e-7
c     print 3000,beex,beez
c     call gradgf(ineg,0,10.0,-.05,10.0,0.0,gradx,gradz)
c     beex=(gradz/10.)*2.0e-7
c     beez=-(gradx/10.)*2.0e-7
c     print 3000,beex,beez
c     call gradgf(ineg,0,9.95,0.0,10.0,0.0,gradx,gradz)
c     beex=(gradz/10.)*2.0e-7
c     beez=-(gradx/10.)*2.0e-7
c     print 3000,beex,beez
c     
c     
      if(nr.gt.30)        nr=30
      if(nz.gt.32)        nz=32
      if(numeq.gt.nruns)  numeq=nruns
      if(nzaxel.gt.numeq) nzaxel=numeq
      if(nzaxre.gt.numeq) nzaxre=numeq
c     
      if((mvloop(1).eq.8).or.(mvloop(1).eq.18))  midplan = 8
c     
      omal = 1.-alpha
      opal = 1.+alpha
      ompsq = 2./(omal*omal+opal*opal)
      ompsq2 = 3./(2.*omal*omal+opal*opal)
      if ((iscramb.eq.25).or.(iscramb.eq.26)) then
         ompsq3 = 6./(3.*omal*omal+opal*opal+2.*omal*opal)
      else
         ompsq3 = 6./(opal*opal*opal*opal+2.*omal*omal*omal*omal
     1        +3.*opal*opal*omal*omal)
      end if
c     
      if((midplan.ne.8).and.(iscramb.ne.4).and.(iscramb.ne.14)) then
         zutile = 0.75
         zaxinp = (zlp+zup)*0.5
         zaxdel = zax(nzaxel)-zaxinp
         zlp    = zlp + zaxdel
         zup    = zup + zaxdel
         if(zlp.lt.-zutile) then
            zup = zup + zlp + zutile
            zlp = -zutile
         endif
         if(zup.gt.zutile) then
            zlp = zlp + zup - zutile
            zup = zutile
         endif
      endif
      if(midplan.eq.8) then
         nelz= 6
         xip = 0.65
         xop = 1.11
         zlp = -.70
         zup = 0.70
      endif
c     
c     
      dt     = 1.
      if(nruns.ne.1) dt = rampt/float(nruns-1)
      nfob   = ilie + ilia
      nbxob  = ibro
      nbzob  = ibzo
      nfoo   = nfob - 1
      nob    = nfoo + nbxob + nbzob
      nob1   = nob + 1
      nob2   = nob + 2
      nob3   = nob + 3
      ngroup1= ngroup + 1
      nshap  = 0
      noh    = 0
      nvvel  = 0
      do 2 k = 1,ngroup
         if(itype(k).eq.1) nshap=nshap+1
         if(itype(k).eq.2) noh=noh+1
         if(itype(k).eq.4) nvvel=nvvel+1
    2 continue
      nshap1 = nshap + 1
      nshaoh = nshap + noh
      nshafa = ngroup - nvvel
      tpi    = 2.*3.14159265
      usdi   = 2.*tpi*1.0e-7
c     uc1r   = uc1/(uc1+uc2+uc3)
c     uc2r   = uc2/(uc1+uc2+uc3)
c     uc3r   = uc3/(uc1+uc2+uc3)
      uc1r   = 0.
      uc2r   = uc2/(uc2+uc3)
      uc3r   = uc3/(uc2+uc3)
      do 9 n=1,nshap
         dddd(n) = ddd(n)*dissi
    9 continue
c     
c     
c     
c     maximum values of measurements
c     
c     
c     
      plcmax = 0.
      curmax = 0.
      beemax = 0.
      fldmax = 0.
      do 20 m=1,nruns
         if(placur(m).gt.plcmax) plcmax=placur(m)
         do 14 i=1,ngroup
            if(abs(gcurr(m,i)).gt.curmax) curmax=abs(gcurr(m,i))
 14      continue
         do 16 n=1,nprob
            if(abs(bee(m,n)).gt.beemax) beemax=abs(bee(m,n))
 16      continue
         do 18 n=2,nloop
            if(abs(flux(m,n)-flux(m,1)).gt.fldmax)
     1           fldmax=abs(flux(m,n)-flux(m,1))
 18      continue
 20   continue
      if(istop.eq.21) then
         print 21
 21      format(28h plcmax,curmax,beemax,fldmax)
         print 3000, plcmax,curmax,beemax,fldmax
      endif
c     
c     
c     
c     compute poloidal distance between B-probes
c     NOTE:
c     B-probes must be numbered consecutively!
c     
c     
      do 25 n=2,nprob
         prlen(n) = sqrt((rbee(n-1)-rbee(n))**2+(zbee(n-1)-zbee(n))**2)
 25   continue
      prlen(1)=sqrt((rbee(nprob)-rbee(1))**2+(zbee(nprob)-zbee(1))**2)
      prlen(nprob+1) = prlen(1)
      do 26 n=1,nprob
         prlen(n) = 0.5*(prlen(n)+prlen(n+1))
 26   continue
      do 27 n=1,nprob
         prlen(n) = prlen(n)/usdi
 27   continue
c     
c     
c     
c     
c     mesh
c     
c     
c     
c     
      dr = (ro-ri)/float(nr)
      jmax = nr+1
      do 30 j=1,jmax
         r(j) = ri + (float(j-1)*dr)
 30   continue
      dz = zu/float(nz)
      kmax = 2*nz + 1
      do 32 k=1,kmax
         z(k) = float(k-1-nz)*dz
 32   continue
c     
c     
c     
c     shaping coil electrical parameters
c     
c     
      do 34 k=1,ngroup
         if(k.le.nshafa) rhog = rhocu/filfac
         if(k.gt.nshafa) rhog = rhovv
         resis(k) = 0.
         ifi = isvf(k)
         ila = isvl(k)
         do 33 i=ifi,ila
            resis(k) = resis(k) +
     1           (tvf(i)*tvf(i)*rhog*tpi*rvf(i))/(hvf(i)*wvf(i))
 33      continue
         gamma(k) = 0.
         if(k.gt.nshafa) gamma(k) = 1./resis(k)
 34   continue
      gamma(ngroup1) = -1.
c--------------------------use values in static tree ---------------------------
c     
      do i=1,8
         resis(i) = 0.01180
      enddo
      do i=9,16
         resis(i) = 0.03908
      enddo
      resis(17) = 0.01495-0.00070
      resis(18) = 0.01333
c     
      v12(1)  = 1.2711
      v12(2)  = 1.2738
      v12(3)  = 1.2738
      v12(4)  = 1.2738
      v12(5)  = 1.2738
      v12(6)  = 1.2738
      v12(7)  = 1.2895
      v12(8)  = 1.3213
      v12(9)  = 1.6773
      v12(10) = 2.0924
      v12(11) = 2.3368
      v12(12) = 2.7809
      v12(13) = 2.6548
      v12(14) = 2.1638
      v12(15) = 3.0275
      v12(16) = 3.5829
      v12(17) = 3.3532
      v12(18) = 3.2480
      v12(19) = 3.4017
      v12(20) = 3.7648
      v12(21) = 3.4017
      v12(22) = 3.2480
      v12(23) = 3.3153
      v12(24) = 3.4573
      v12(25) = 2.9508
      v12(26) = 2.0713
      v12(27) = 2.3129
      v12(28) = 2.5959
      v12(29) = 2.5119
      v12(30) = 2.1984
      v12(31) = 1.7093
      v12(32) = 1.3174
      v12(33) = 1.2824
      v12(34) = 1.2738
      v12(35) = 1.2738
      v12(36) = 1.2738
      v12(37) = 1.2738
      v12(38) = 1.2738
c     
      if(midplan.eq.8) then
c----------------------------symmetrization--------------------------
c     do n=2,19
c     v12(n)=0.5*(v12(n)+v12(40-n))
c     v12(40-n)=v12(n)
c     enddo
c-------------for M backoffs, use
c     topfac = 1.1938
c     botfac = 1.1938
c     outfac = 0.894
c-------------for G backoffs, use
         topfac = 1.
         botfac = 1.
         outfac = 1.
         do n=8,14
            v12(n)    = v12(n)*topfac
            v12(n+18) = v12(n+18)*botfac
         enddo
         do n=15,25
            v12(n)    = v12(n)*outfac
         enddo
      endif
c     
      if(nvvel.eq.38) then
         do n=1,38
            k=n+nshafa
            resis(k) = v12(n)*0.001
         enddo
      endif
c     
      if(nvvel.eq.19) then
         resis(1+nshafa) = 0.002/(1./v12(38)+2./v12(1)+1./v12(2))
         do n=2,19
            k=n+nshafa
            resis(k) = 0.002/(1./v12(2*n-2)+2./v12(2*n-1)+1./v12(2*n))
         enddo
         do n=1,19
            k=n+nshafa
            print *,'resis(k) Rv',k,resis(k)
         enddo
      endif
c-------------------------------------------------------------------------------
c     
      do 44 k1=1,ngroup
         ifi1 = isvf(k1)
         ila1 = isvl(k1)
         do 42 k2=1,ngroup
            ifi2 = isvf(k2)
            ila2 = isvl(k2)
            els  = 0.
            do 40 i1 = ifi1,ila1
               do 38 i2 = ifi2,ila2
                  if(i1.eq.i2) go to 36
                  els = els + amutlrc(
     1                 rvf(i1),zvf(i1),hvf(i1),wvf(i1),tvf(i1),
     2                 rvf(i2),zvf(i2),hvf(i2),wvf(i2),tvf(i2),4)
                  go to 38
 36               els = els + selfrc(
     1                 rvf(i1),hvf(i1),wvf(i1),tvf(i1),8)
 38            continue
 40         continue
            elss(k1,k2) = els
 42      continue
 44   continue
c     
      if(istop.eq.54) then
         print 3000,(resis(k),k=1,ngroup)
c     print 3000,elss(43,44)
c     print 3000,(elss(44,i),i=43,44)
c     print 3000,(elss(45,i),i=44,46)
c     print 3000,elss(46,45)
c     print 3000,elss(30,31)
c     print 3000,(elss(31,i),i=30,32)
c     print 3000,(elss(32,i),i=32,33)
c     print 3000,elss(33,32)
         call primat('ELSS      ',elss,1000.,ngroup,ngroup)
      endif
c     
c     do m=1,3
c     rdee = 0.25 + float(m-1)*0.1
c     do n=1,5
c     zdee = 0.35 + float(n-1)*0.2
c     elpla=selfrc(0.88,zdee,rdee,1.0,20)
c     print 50,rdee,zdee,elpla
c     50 format(6h rdee=,e11.4,6h zdee=,e11.4,7h elpla=,e11.4)
c     enddo
c     enddo
c     
c     
c     
c     
c     
c     
c     weight = inverse of square of measurements error
c     vvv = weight of B,  www = weight of psi
c     
c     
c     
      do 60 n=1,nloop
         www(n) = wscal
 60   continue
      if(ipr16.eq.0) then
         www(10) = 0.
         www(11) = 0.
         www(12) = 0.
         www(28) = 0.
         www(29) = 0.
         www(30) = 0.
      endif
      do 62 n=1,nprob
         vvv(n) = vscal
 62   continue
c     if(nfast.ne.0) then
      do n=13,27
         if((n.le.16).or.(n.ge.24)) then
            vvv(n) = 0.
            www(n) = 0.
         endif
      enddo
c     endif
c     if(midplan.eq.8) then
c     do n=1,7
c     vvv(n+1) = vscal*0.5
c     vvv(39-n) = vscal*0.5
c     enddo
c     vvv(1) = vscal*0.5
c     vvv(37) = 0.
c     endif

c     
c     
c     
c     
c     green's functions
c     
c     
c     
c     
      nelr=2
      if (imeas.gt.2) nelr=imeas
      dxel = (xop-xip)/float(nelr+1)
      dzel = (zup-zlp)/float(nelz+1)
      mmax = nelr*nelz
      aph  = (dxel*dzel)/(dr*dz)
      do 102 ie=1,nelr
         do 101 je=1,nelz
            m = (ie-1)*nelz + je
            xel(m) = xip+(dxel*float(ie))
            zel(m) = zlp+(dzel*float(je))
 101     continue
 102  continue
      do 107 m=1,mmax
         do 106 j=1,jmax
            do 105 k=1,kmax
               coe(j,k,m) =((1.-abs(r(j)-xel(m))/dxel)*
     1              (1.-abs(z(k)-zel(m))/dzel))*usdi
               if(abs(r(j)-xel(m))/dxel.ge.1.)  coe(j,k,m)=-1.
               if(abs(z(k)-zel(m))/dzel.ge.1.)  coe(j,k,m)=-1.
c     print *,'COE(J,K,M)',j,k,m,r(j),z(k),xel(m),zel(m),coe(j,k,m)
 105        continue
 106     continue
 107  continue
c     
c     
      pio180 = 3.14159265/180.
      do 120 n=1,nprob
         coth(n) = cos(thbee(n)*pio180)
         sith(n) = sin(thbee(n)*pio180)
 120  continue
c     
      do 154 l=1,nloop
         do 152 k=1,ngroup
            gx(l,k) = 0.
            ifi = isvf(k)
            ila = isvl(k)
            do 150 i=ifi,ila
               call gf(ineg,0,rflu(l),zflu(l),rvf(i),zvf(i),ans)
               if(k.le.nshafa) gx(l,k) = gx(l,k) + ans*tvf(i)*usdi
               if(k.gt.nshafa) gx(l,k) = gx(l,k) + (ans*tvf(i)*usdi)/resis(k)
 150        continue
 152     continue
         gx(l,ngroup1) = 0.
 154  continue
c     
c     
      do 158 k=1,ngroup
         do 156 l=2,nloop
            gx(l,k) = gx(l,k) -gx(1,k)
 156     continue
         gx(1,k) = 0.
 158  continue
c     
      if(istop.eq.158) call primat('GX        ',gx,1000.,nloop,ngroup)
c     
c     
      do 174 n=1,nprob
         do 173 k=1,ngroup
            dex(n,k) = 0.
            ifi = isvf(k)
            ila = isvl(k)
            do 172 i=ifi,ila
               call gradgf(ineg,0,rbee(n),zbee(n),rvf(i),zvf(i),
     1              gradx,gradz)
               if(k.le.nshafa) dex(n,k)=dex(n,k)+(tvf(i)*usdi*(gradz*coth(n)-
     1              gradx*sith(n)))/(rbee(n)*tpi)
               if(k.gt.nshafa) dex(n,k)=dex(n,k)+(tvf(i)*usdi*(gradz*coth(n)-
     1              gradx*sith(n)))/(rbee(n)*tpi*resis(k))
 172        continue
 173     continue
         dex(n,ngroup1) = 0.
 174  continue
c     
      if(istop.eq.174) call primat('DEX    ',dex,1000.,nprob,ngroup)
c     
c     
      do 182 l=1,nloop
         do 175 m=1,mmax
            gp(m,l) = 0.
 175     continue
         do 178 j=1,jmax
            do 177 k=1,kmax
               if((r(j).lt.xip).or.(r(j).gt.xop)) go to 177
               if((z(k).lt.zlp).or.(z(k).gt.zup)) go to 177
               call gf(ineg,0,rflu(l),zflu(l),r(j),z(k),ans)
               do 176 m=1,mmax
                  if(coe(j,k,m).le.0.) go to 176
                  gp(m,l) = gp(m,l) + (ans*coe(j,k,m))
 176           continue
 177        continue
 178     continue
 182  continue
      do 186 m=1,mmax
         do 184 l=2,nloop
            gp(m,l) = gp(m,l) - gp(m,1)
 184     continue
         gp(m,1) = 0.
 186  continue
c     
      if(istop.eq.186) call primat('GP       ',gp,1000.,mmax,nloop)
c     
c     
      do 198 n=1,nprob
         do 190 m=1,mmax
            dp(m) = 0.
            ep(m) = 0.
 190     continue
         do 194 j=1,jmax
            do 192 k=1,kmax
               if((r(j).lt.xip).or.(r(j).gt.xop)) go to 192
               if((z(k).lt.zlp).or.(z(k).gt.zup)) go to 192
               call gradgf(ineg,0,rbee(n),zbee(n),r(j),z(k),gradx,gradz)
               do 191 m=1,mmax
                  if(coe(j,k,m).le.0.) go to 191
                  dp(m) = dp(m) + gradz*coe(j,k,m)
                  ep(m) = ep(m) - gradx*coe(j,k,m)
 191           continue
 192        continue
 194     continue
         do 197 m=1,mmax
            dep(m,n) = (dp(m)*coth(n)+ep(m)*sith(n))/(rbee(n)*tpi)
 197     continue
 198  continue
      if(istop.eq.198) call primat('DEP       ',dep,1000.,mmax,nprob)
c     
 3000 format(1x,6e12.5)
 3001 format(1x,12i6)
      return
      end
c     
c     
c     
c     
c     
c     
c     
c     
      subroutine observ
      include 'fbtmgams.inc'
      include 'mga.inc'
c     
      call mdmt(gp,mmax,nloop,www,nloop,b1)
      if(istop.eq.199) call primat('B1        ',b1,1.,mmax,mmax)
      if(istop.eq.199) call primat('WWW       ',www,1.,nloop,1)
      call mdmt(dep,mmax,nprob,vvv,nprob,b2)
      if(istop.eq.200) call primat('B2        ',b2,1.,mmax,mmax)
c     
c     
      do 201 i=1,mmax
         do 200 j=1,mmax
c     b2(i,j) = b2(i,j)+aph*aph*(uc1+uc2)
            b2(i,j) = b2(i,j)+aph*aph*uc2
            axx(i,j) = b1(i,j)+b2(i,j)
 200     continue
 201  continue
c     
      if(istop.eq.201) call primat('AXX       ',axx,1000.,mmax,mmax)
      call inver(axx,mmax,axi)
      call inver(b1,mmax,axiw)
      call inver(b2,mmax,axiv)
c     
      if(istop.eq.202) call primat('AXI       ',axi,0.001,mmax,mmax)
c     
      call mulmd(gp,mmax,nloop,www,nloop,b1)
      call mulmd(dep,mmax,nprob,vvv,nprob,b2)
c     coefficients for fast coil control with B-dot signals
c     construct observer even with nfast=-3 even though not used (for tests)
      if((ikriz.eq.2).and.(nfast.eq.-5.or.nfast.eq.-3)) then
         vvv(1)=0.
         vvv(7)=0.
         vvv(9)=0.
         vvv(10)=0.
         vvv(12)=0.
         vvv(13)=0.
         vvv(14)=0.
         vvv(15)=0.
         vvv(16)=0.
         vvv(20)=0.
         vvv(24)=0.
         vvv(25)=0.
         vvv(26)=0.
         vvv(27)=0.
         vvv(28)=0.
         vvv(30)=0.
         vvv(31)=0.
         vvv(33)=0.
         call mdmt(dep,mmax,nprob,vvv,nprob,b3)
         do i=1,mmax
            do j=1,mmax
               b3(i,j) = b3(i,j)+aph*aph*uc2
            enddo
         enddo
         call inver(b3,mmax,axiv)
         call mulmd(dep,mmax,nprob,vvv,nprob,b3)
      endif
      do 211 m=1,mmax
         do 210 n=1,nprob
            b2(m,n) = b2(m,n) + uc2*aph*prlen(n)
 210     continue
 211  continue
c     
      if(istop.eq.211) call primat('B1        ',b1,1.,mmax,nloop)
      if(istop.eq.212) call primat('B2        ',b2,1.,mmax,nprob)
c     
      call mulmm(b1,mmax,nloop,gx,nloop,ngroup1,b4)
      call mulmm(b2,mmax,nprob,dex,nprob,ngroup1,b5)
c     
      if(istop.eq.213) call primat('B4        ',b4,1.,mmax,ngroup1)
      if(istop.eq.214) call primat('B5        ',b5,1.,mmax,ngroup1)
      do 221 i=1,mmax
         do 220 j=1,ngroup1
c     b6(i,j)=b4(i,j)+b5(i,j)+aph*uc1*gamma(j)
            b6(i,j)=b4(i,j)+b5(i,j)
 220     continue
 221  continue
      if(istop.eq.221) call primat('B6        ',b6,1.,mmax,ngroup1)
c     
c     
      zsq=0.
      do m=1,mmax
         zsq=zsq+aph*(zel(m)-zax(nzaxre))*(zel(m)-zax(nzaxre))
      enddo
      print *,'zax',zax(nzaxre),zax
      do 222 m=1,mmax
         azel(m) = aph*(zel(m)-zax(nzaxre))
         if (mod(ifour,10).eq.5) then
            print *,'azel',aph,zel(m),zax(nzaxre),nzaxre
            azels(m) = aph*(zel(m)-zax(nzaxre))*(zel(m)-zax(nzaxre))
c     azels(m) = aph*(zel(m)-zax(nzaxre))*(zel(m)-zax(nzaxre))-
c     1                    zsq/float(mmax)
c     New observer (SC, 13/05/04)
         else if (mod(ifour,10).eq.4) then
            azels(m) = aph*abs(zel(m)-zax(nzaxre))
         else
            azels(m) = 0.
         end if
         if(midplan.eq.8) then
            azel(m) = aph*zel(m)
            azels(m) = aph*zel(m)*zel(m)
         endif
c     if(midplan.eq.8) then
c     azelb(m) = aph*(-zel(m)-zax(1))
c     azelt(m) = aph*(zel(m)-zax(1))
c     if((m.eq.3).or.(m.eq.4).or.(m.eq.7).or.(m.eq.8)) azelb(m)=0.
c     if((m.eq.1).or.(m.eq.2).or.(m.eq.5).or.(m.eq.6)) azelt(m)=0.
c     aphvb(m) = aph
c     aphvt(m) = aph
c     if((m.eq.3).or.(m.eq.4).or.(m.eq.7).or.(m.eq.8)) aphvb(m)=0.
c     if((m.eq.1).or.(m.eq.2).or.(m.eq.5).or.(m.eq.6)) aphvt(m)=0.
c     endif
         aphv(m) = aph
 222  continue
      call mulvm(azel,mmax,axi,mmax,mmax,v1)
      call mulvm(v1,mmax,b1,mmax,nloop,a2ipz)
      call mulvm(v1,mmax,b2,mmax,nprob,a3ipz)
      call mulvm(v1,mmax,b6,mmax,ngroup1,a4ipz)
      if (istop.eq.230) then
         call primat('A2IPZ     ',a2ipz,1.,nloop,1)
         call primat('A3IPZ     ',a3ipz,1.,nprob,1)
         if(nfast.ne.0) then
            call primat('A4IPZ     ',a4ipz,1.,ngroup1+1,1)
         else
            call primat('A4IPZ     ',a4ipz,1.,ngroup1,1)
         endif
         call primat('A3IPZ3    ',a3ipz3,1.,nprob,1)
         call primat('A4IPZ3    ',a4ipz3,1.,ngroup1,1)
      endif
      if((ikriz.eq.2).and.(nfast.eq.-2)) then
         call mulvm(azel,mmax,axiv,mmax,mmax,v1)
         call mulvm(v1,mmax,b2,mmax,nprob,a3ipz3)
         call mulvm(v1,mmax,b5,mmax,ngroup1,a4ipz3)
      endif
      if((ikriz.eq.2).and.(nfast.eq.-5.or.nfast.eq.-3)) then
         call mulvm(azel,mmax,axiv,mmax,mmax,v1)
         call mulvm(v1,mmax,b3,mmax,nprob,a3ipz3)
      endif
      if (istop.eq.231) then
         call primat('A2IPZ     ',a2ipz,1.,nloop,1)
         call primat('A3IPZ     ',a3ipz,1.,nprob,1)
         if(nfast.ne.0) then
            call primat('A4IPZ     ',a4ipz,1.,ngroup1+1,1)
         else
            call primat('A4IPZ     ',a4ipz,1.,ngroup1,1)
         endif
         call primat('A3IPZ3    ',a3ipz3,1.,nprob,1)
         call primat('A4IPZ3    ',a4ipz3,1.,ngroup1,1)
      endif
c     
      if((nfast.eq.-3).or.(nfast.eq.-4).or.
     1     (nfast.eq.-5)) then
c     UNTRANSLATED
         do 223 l=1,nloop
            gxf(l) = 0.
            call gf(ineg,0,rflu(l),zflu(l),1.114,0.630,ans)
            gxf(l) = gxf(l) - ans*tvf(i)*usdi
            call gf(ineg,0,rflu(l),zflu(l),1.114,-.630,ans)
            gxf(l) = gxf(l) + ans*tvf(i)*usdi
 223     continue
         do 213 l=2,nloop
            gxf(l) = gxf(l) - gxf(1)
 213     continue
         gxf(1) = 0.
c     END UNTRANSLATED
         do 224 n=1,nprob
            dexf(n) = 0.
            call gradgf(ineg,0,rbee(n),zbee(n),1.099,0.648,
     1           gradx,gradz)
            dexf(n)=dexf(n) - (tvf(i)*usdi*(gradz*coth(n)-
     1           gradx*sith(n)))/(rbee(n)*tpi)
            call gradgf(ineg,0,rbee(n),zbee(n),1.099,-.648,
     1           gradx,gradz)
            dexf(n)=dexf(n) + (tvf(i)*usdi*(gradz*coth(n)-
     1           gradx*sith(n)))/(rbee(n)*tpi)
            call gradgf(ineg,0,rbee(n),zbee(n),1.114,0.630,
     1           gradx,gradz)
            dexf(n)=dexf(n) - (tvf(i)*usdi*(gradz*coth(n)-
     1           gradx*sith(n)))/(rbee(n)*tpi)
            call gradgf(ineg,0,rbee(n),zbee(n),1.114,-.630,
     1           gradx,gradz)
            dexf(n)=dexf(n) + (tvf(i)*usdi*(gradz*coth(n)-
     1           gradx*sith(n)))/(rbee(n)*tpi)
            call gradgf(ineg,0,rbee(n),zbee(n),1.129,0.612,
     1           gradx,gradz)
            dexf(n)=dexf(n) - (tvf(i)*usdi*(gradz*coth(n)-
     1           gradx*sith(n)))/(rbee(n)*tpi)
            call gradgf(ineg,0,rbee(n),zbee(n),1.129,-.612,
     1           gradx,gradz)
            dexf(n)=dexf(n) + (tvf(i)*usdi*(gradz*coth(n)-
     1           gradx*sith(n)))/(rbee(n)*tpi)
c     
            call gradgf(ineg,0,rbee(n),zbee(n),1.120,0.677,
     1           gradx,gradz)
            dexf(n)=dexf(n) + (tvf(i)*usdi*(gradz*coth(n)-
     1           gradx*sith(n)))/(rbee(n)*tpi)
            call gradgf(ineg,0,rbee(n),zbee(n),1.120,-.677,
     1           gradx,gradz)
            dexf(n)=dexf(n) - (tvf(i)*usdi*(gradz*coth(n)-
     1           gradx*sith(n)))/(rbee(n)*tpi)
            call gradgf(ineg,0,rbee(n),zbee(n),1.144,0.657,
     1           gradx,gradz)
            dexf(n)=dexf(n) + (tvf(i)*usdi*(gradz*coth(n)-
     1           gradx*sith(n)))/(rbee(n)*tpi)
            call gradgf(ineg,0,rbee(n),zbee(n),1.144,-.657,
     1           gradx,gradz)
            dexf(n)=dexf(n) - (tvf(i)*usdi*(gradz*coth(n)-
     1           gradx*sith(n)))/(rbee(n)*tpi)
            call gradgf(ineg,0,rbee(n),zbee(n),1.160,0.616,
     1           gradx,gradz)
            dexf(n)=dexf(n) + (tvf(i)*usdi*(gradz*coth(n)-
     1           gradx*sith(n)))/(rbee(n)*tpi)
            call gradgf(ineg,0,rbee(n),zbee(n),1.160,-.616,
     1           gradx,gradz)
            dexf(n)=dexf(n) - (tvf(i)*usdi*(gradz*coth(n)-
     1           gradx*sith(n)))/(rbee(n)*tpi)
 224     continue
c     
      endif
c     
      if((nfast.eq.-3).or.(nfast.eq.-5)) then
c     do j=1,38
c     do i=1,38
c     a1(i,j) = 0.
c     enddo
c     enddo
c     do j=1,37
c     a1(j,j) = 1.
c     a1(38,j) = gxf(j+1)
c     a1(j,38) = a1(38,j)
c     v11(j)   = gp(2,j+1)+gp(4,j+1)-gp(1,j+1)-gp(3,j+1)
c     a1(j,39) = v11(j)
c     if(ipr16.eq.0) then
c     if((j.eq.9).or.(j.eq.10).or.(j.eq.11).or.
c     1        (j.eq.27).or.(j.eq.28).or.(j.eq.29).or.
c     1        (j.eq.13).or.(j.eq.14).or.
c     1        (j.eq.24).or.(j.eq.25)) then
c     a1(38,j) = 0.
c     a1(j,38) = 0.
c     v11(j)   = 0.
c     a1(j,39) = 0.
c     endif
c     endif
c     enddo
c     call gauss(38,a1,v12)
c     coef = 0.
c     do j=1,37
c     coef = coef + v11(j)*v12(j)
c     enddo
c     coef= (2.*aph*dzel)/coef
c     do j=1,37
c     a2ipz(j+1) = 0.5*v12(j)*coef
c     enddo
c     a2ipz(1) = 0.
c     
         do j=1,39
            do i=1,39
               a1(i,j) = 0.
            enddo
         enddo
         do j=1,38
            a1(j,j) = 1.
            a1(39,j) = dexf(j)
            a1(j,39) = a1(39,j)
c     v11(j)   = dep(2,j)+dep(4,j)-dep(1,j)-dep(3,j)
            v11(j)   = 2.*dep(2,j)-2.*dep(1,j)
            a1(j,40) = v11(j)
            if((j.eq.14).or.(j.eq.15).or.
     1           (j.eq.25).or.(j.eq.26)) then
               a1(39,j) = 0.
               a1(j,39) = 0.
               v11(j)   = 0.
               a1(j,40) = 0.
            endif
         enddo
c     a1(39,37) = 0.
c     a1(37,39) = 0.
c     v11(37)   = 0.
c     a1(37,40) = 0.
         call gauss(39,a1,v12)
         coef = 0.
         do j=1,38
            coef = coef + v11(j)*v12(j)
         enddo
         coef= (2.*aph*dzel)/coef
         do j=1,38
c     a3ipz3(j) = v12(j)*coef
            if((ikriz.ne.2).or.(nfast.ne.-5.and.nfast.ne.-3)) then
               a3ipz3(j) = a3ipz(j)
            endif
         enddo
      endif
c     
      if((nelz.eq.2).and.(nfast.eq.-4).and.(iscramb.eq.2)) then
c     
         if((zax(1).le.0.11).and.(zax(1).ge.-0.11)) mmshift=0
         if(zax(1).lt.-0.11)                        mmshift=-1
         if(zax(1).gt.0.11)                         mmshift=1
         do j=1,38
            do i=1,38
               a1(i,j) = 0.
            enddo
         enddo
         do j=1,37
            a1(j,j) = 1.
            a1(38,j) = gx(j+1,10+mmshift)+gx(j+1,11+mmshift)
     1           -gx(j+1,14+mmshift)-gx(j+1,15+mmshift)
            a1(j,38) = a1(38,j)
            v11(j)   = gp(2,j+1)+gp(4,j+1)-gp(1,j+1)-gp(3,j+1)
            a1(j,39) = v11(j)
            if(ipr16.eq.0) then
               if((j.eq.9).or.(j.eq.10).or.(j.eq.11).or.
     1              (j.eq.27).or.(j.eq.28).or.(j.eq.29).or.
     1              (j.eq.13).or.(j.eq.14).or.
     1              (j.eq.24).or.(j.eq.25)) then
                  a1(38,j) = 0.
                  a1(j,38) = 0.
                  v11(j)   = 0.
                  a1(j,39) = 0.
               endif
            endif
         enddo
         call gauss(38,a1,v12)
         coef = 0.
         do j=1,37
            coef = coef + v11(j)*v12(j)
         enddo
         coef= (2.*aph*dzel)/coef
         do j=1,37
            a2ipz(j+1) = 0.5*v12(j)*coef
         enddo
         a2ipz(1) = 0.
c     
         do j=1,39
            do i=1,39
               a1(i,j) = 0.
            enddo
         enddo
         do j=1,38
            a1(j,j) = 1.
            a1(39,j) = dex(j,10+mmshift)+dex(j,11+mmshift)
     1           -dex(j,14+mmshift)-dex(j,15+mmshift)
            a1(j,39) = a1(39,j)
            v11(j)   = dep(2,j)+dep(4,j)-dep(1,j)-dep(3,j)
            a1(j,40) = v11(j)
            if((j.eq.14).or.(j.eq.15).or.
     1           (j.eq.25).or.(j.eq.26)) then
               a1(39,j) = 0.
               a1(j,39) = 0.
               v11(j)   = 0.
               a1(j,40) = 0.
            endif
         enddo
c     a1(39,37) = 0.
c     a1(37,39) = 0.
c     v11(37)   = 0.
c     a1(37,40) = 0.
         call gauss(39,a1,v12)
         coef = 0.
         do j=1,38
            coef = coef + v11(j)*v12(j)
         enddo
         coef= (2.*aph*dzel)/coef
         do j=1,38
            a3ipz(j) = 0.5*v12(j)*coef
         enddo
      endif
c     
      if((nfast.eq.-3).or.(nfast.eq.-4).or.
     1     (nfast.eq.-5)) then
c     
c     call mulvm(a2ipz,nloop,gx,nloop,ngroup1,v11)
         call mulvm(a3ipz3,nprob,dex,nprob,ngroup1,a4ipz3)
         if((ikriz.eq.2).and.(nfast.eq.-5.or.nfast.eq.-3)) then
            call mulvm(a3ipz,nprob,dex,nprob,ngroup1,a4ipz3)
         endif
c     do n=1,ngroup1
c     a4ipz(n) = a4ipz(n)+v11(n)
c     enddo
c     
      endif
c     
      if(nfast.ne.0) then
         do 227 n=1,nvvel
            do 226 m=1,nvvel
               a1(n,m) = elss(nshafa+n,nshafa+m)
 226        continue
            a1(n,nvvel+1) = elss(nshafa+n,nshafa)
 227     continue
         mat = nvvel
         call gauss(mat,a1,v12)
         write(50,225)
 225     format(16h vessel currents)
         write(50,3000) (v12(i),i=1,nvvel)
         a4ipz(ngroup1+1) = 0.
         do 228 n=1,nvvel
            a4ipz(ngroup1+1) =
     1           a4ipz(ngroup1+1)-v12(n)*a4ipz(nshafa+n)*resis(nshafa+n)
 228     continue
      endif
      if (istop.eq.232) then
         call primat('A2IPZ     ',a2ipz,1.,nloop,1)
         call primat('A3IPZ     ',a3ipz,1.,nprob,1)
         if(nfast.ne.0) then
            call primat('A4IPZ     ',a4ipz,1.,ngroup1+1,1)
         else
            call primat('A4IPZ     ',a4ipz,1.,ngroup1,1)
         endif
         call primat('A3IPZ3    ',a3ipz3,1.,nprob,1)
         call primat('A4IPZ3    ',a4ipz3,1.,ngroup1,1)
      endif
c     
c     KAPPA OBSERVER
c     
c     
      call mulvm(azels,mmax,axi,mmax,mmax,v1)
      print *,'azels',azels
      call mulvm(v1,mmax,b1,mmax,nloop,a2ipzs)
      call mulvm(v1,mmax,b2,mmax,nprob,a3ipzs)
      call mulvm(v1,mmax,b6,mmax,ngroup1,a4ipzs)
c     
      if(midplan.eq.8) then
c     call mulvm(azelb,mmax,axiw,mmax,mmax,v11)
c     call mulvm(azelt,mmax,axiw,mmax,mmax,v12)
c     call mulvm(v11,mmax,b1,mmax,nloop,a2ipzb)
c     call mulvm(v12,mmax,b1,mmax,nloop,a2ipzt)
c     call mulvm(v11,mmax,b4,mmax,ngroup1,v4)
c     call mulvm(v12,mmax,b4,mmax,ngroup1,v5)
c     
c     print 229,v4(9),v4(12),v4(13),v4(16)
c     print 230,v5(9),v5(12),v5(13),v5(16)
c     229    format(27h vvv=0, a4ipzb(9,12,13,16)=,4e12.5)
c     230    format(27h vvv=0, a4ipzt(9,12,13,16)=,4e12.5)
c     
c     call mulvm(azelb,mmax,axiv,mmax,mmax,v11)
c     call mulvm(azelt,mmax,axiv,mmax,mmax,v12)
c     call mulvm(v11,mmax,b2,mmax,nprob,a3ipzb)
c     call mulvm(v12,mmax,b2,mmax,nprob,a3ipzt)
c     call mulvm(v11,mmax,b5,mmax,ngroup1,v4)
c     call mulvm(v12,mmax,b5,mmax,ngroup1,v5)
c     
c     print 7229,v4(9),v4(12),v4(13),v4(16)
c     print 7230,v5(9),v5(12),v5(13),v5(16)
c     7229    format(27h www=0, a4ipzb(9,12,13,16)=,4e12.5)
c     7230    format(27h www=0, a4ipzt(9,12,13,16)=,4e12.5)
c     
c     v4(1) = a3ipzb(38)
c     v5(1) = a3ipzt(38)
c     do k=1,38
c     v4(k+1) = a3ipzb(k)
c     v5(k+1) = a3ipzt(k)
c     enddo
c     v4(40) = a3ipzb(1)
c     v5(40) = a3ipzt(1)
c     do k=1,38
c     a3ipzb(k)=(0.5*v4(k)+v4(k+1)+0.5*v4(k+2))/2.
c     a3ipzt(k)=(0.5*v5(k)+v5(k+1)+0.5*v5(k+2))/2.
c     enddo
c     
         do j=1,42
            do i=1,41
               a1(i,j) = 0.
            enddo
         enddo
         do j=1,37
            a1(j,j) = 1.
            a1(38,j) = gp(1,j+1)+gp(7,j+1)
            a1(j,38) = a1(38,j)
            a1(39,j) = gp(2,j+1)+gp(8,j+1)
            a1(j,39) = a1(39,j)
            a1(40,j) = gx(j+1,9)-gx(j+1,12)
            a1(j,40) = a1(40,j)
            a1(41,j) = gp(6,j+1)+gp(12,j+1)+gp(5,j+1)+gp(11,j+1)
            a1(j,41) = a1(41,j)
            v11(j)   = gp(6,j+1)+gp(12,j+1)-gp(5,j+1)-gp(11,j+1)
            a1(j,42) = v11(j)
            if(ipr16.eq.0) then
               if((j.eq.9).or.(j.eq.10).or.(j.eq.11).or.
     1              (j.eq.27).or.(j.eq.28).or.(j.eq.29)) then
                  a1(38,j) = 0.
                  a1(j,38) = 0.
                  a1(39,j) = 0.
                  a1(j,39) = 0.
                  a1(40,j) = 0.
                  a1(j,40) = 0.
                  a1(41,j) = 0.
                  a1(j,41) = 0.
                  v11(j)   = 0.
                  a1(j,42) = 0.
               endif
            endif
         enddo
         call gauss(41,a1,v12)
         coef = 0.
         do j=1,37
            coef = coef + v11(j)*v12(j)
         enddo
         coef= (2.*aph*dzel)/coef
         do j=1,37
            a2ipzt(j+1) = v12(j)*coef
         enddo
         a2ipzt(1) = 0.
         a2ipzb(1) = 0.
c     
         do j=1,43
            do i=1,42
               a1(i,j) = 0.
            enddo
         enddo
         do j=1,38
            a1(j,j) = 1.
            a1(39,j) = dep(1,j)+dep(7,j)
            a1(j,39) = a1(39,j)
            a1(40,j) = dep(2,j)+dep(8,j)
            a1(j,40) = a1(40,j)
            a1(41,j) = dex(j,9)-dex(j,12)
            a1(j,41) = a1(41,j)
            a1(42,j) = dep(6,j)+dep(12,j)+dep(5,j)+dep(11,j)
            a1(j,42) = a1(42,j)
            v11(j)   = dep(6,j)+dep(12,j)-dep(5,j)-dep(11,j)
            a1(j,43) = v11(j)
         enddo
         call gauss(42,a1,v12)
         coef = 0.
         do j=1,38
            coef = coef + v11(j)*v12(j)
         enddo
         coef= (2.*aph*dzel)/coef
         do j=1,38
            a3ipzt(j) = v12(j)*coef
         enddo
         a3ipzb(1) = a3ipzt(1)
         do j=2,38
            a2ipzb(j) = a2ipzt(40-j)
            a3ipzb(j) = a3ipzt(40-j)
         enddo
c     
c     do j=1,38
c     do i=1,38
c     a1(i,j) = 0.
c     enddo
c     enddo
c     do j=1,37
c     a1(j,j) = 1.
c     a1(38,j) = gx(j+1,13)+gx(j+1,16)-gx(j+1,9)-gx(j+1,12)
c     a1(j,38) = a1(38,j)
c     v11(j)   = gp(4,j+1)+gp(8,j+1)+gp(3,j+1)+gp(7,j+1)
c     1          -gp(1,j+1)-gp(5,j+1)-gp(2,j+1)-gp(6,j+1)
c     a1(j,39) = v11(j)
c     enddo
c     if(ipr16.eq.0) then
c     do i=1,3
c     a1(i+8,39)  = 0.
c     a1(i+26,39) = 0.
c     enddo
c     endif
c     call gauss(38,a1,v12)
c     coef = 0.
c     do j=1,37
c     coef = coef + v11(j)*v12(j)
c     enddo
c     coef= (8.*aph*dzel)/coef
c     do j=1,37
c     a2ipz(j+1) = v12(j)*coef
c     enddo
c     a2ipz(1) = 0.
c     
c     do j=1,39
c     do i=1,39
c     a1(i,j) = 0.
c     enddo
c     enddo
c     do j=1,38
c     a1(j,j) = 1.
c     a1(39,j) = dex(j,13)+dex(j,16)-dex(j,9)-dex(j,12)
c     a1(j,39) = a1(39,j)
c     v11(j)   = dep(4,j)+dep(8,j)+dep(3,j)+dep(7,j)
c     1          -dep(1,j)-dep(5,j)-dep(2,j)-dep(6,j)
c     a1(j,40) = v11(j)
c     enddo
c     call gauss(39,a1,v12)
c     coef = 0.
c     do j=1,38
c     coef = coef + v11(j)*v12(j)
c     enddo
c     coef= (8.*aph*dzel)/coef
c     do j=1,38
c     a3ipz(j) = v12(j)*coef
c     enddo
c     
      endif
c     
c     call mulvm(aphv,mmax,axi,mmax,mmax,v2)
c     call mulvm(v2,mmax,b1,mmax,nloop,v4)
c     call mulvm(v2,mmax,b2,mmax,nprob,v5)
c     call mulvm(v2,mmax,b6,mmax,ngroup1,v6)
c     
c     if(midplan.eq.8) then
c     call mulvm(aphvb,mmax,axi,mmax,mmax,v2)
c     call mulvm(v2,mmax,b1,mmax,nloop,v4b)
c     call mulvm(v2,mmax,b2,mmax,nprob,v5b)
c     call mulvm(v2,mmax,b6,mmax,ngroup1,v6b)
c     call mulvm(aphvt,mmax,axi,mmax,mmax,v2)
c     call mulvm(v2,mmax,b1,mmax,nloop,v4t)
c     call mulvm(v2,mmax,b2,mmax,nprob,v5t)
c     call mulvm(v2,mmax,b6,mmax,ngroup1,v6t)
c     endif
c     
      if(ipripz.eq.1) then
c     
         print 231
 231     format(45h   placur      aipmea      zax         zaxmea)
         do 240 m=1,numeq
            aipmea = 0.
            do 232 n=1,38
               aipmea = aipmea + bee(m,n)*prlen(n)
 232        continue
            aipzmea = 0.
            do 234 n=1,38
               aipzmea = aipzmea -
     1              (flux(m,n)-flux(m,1))*a2ipz(n)+bee(m,n)*a3ipz(n)
 234        continue
            do 236 i=1,nshafa
               aipzmea = aipzmea - gcurr(m,i)*a4ipz(i)
 236        continue
            do 237 i=1,nvvel
               aipzmea = aipzmea + gcurr(m,i+nshafa)*a4ipz(i+nshafa)
 237        continue
            zaxmea = aipzmea/aipmea
            print 242,placur(m),aipmea,zax(m),zaxmea
 240     continue
 242     format(1x,4e12.5)
c     
         write(50,250)
 250     format(25h r-coordinates of coils  )
         write(50,3000) (rvf(i),i=1,16),rvf(37),rvf(38)
         write(50,252)
 252     format(25h z-coordinates of coils  )
         write(50,3000) (zvf(i),i=1,16),zvf(37),zvf(38)
         write(50,262)
 262     format(28h r-coordinates of flux loops)
         write(50,3000) (rflu(n),n=1,nloop)
         write(50,263)
 263     format(28h z-coordinates of flux loops)
         write(50,3000) (zflu(n),n=1,nloop)
         write(50,264)
 264     format(28h r-coordinates of B-probes  )
         write(50,3000) (rbee(n),n=1,nprob)
         write(50,265)
 265     format(28h z-coordinates of B-probes  )
         write(50,3000) (zbee(n),n=1,nprob)
         write(50,266)
 266     format(44h angle of B-probe with respect to horizontal)
         write(50,3000) (thbee(n),n=1,nprob)
         write(50,267)
 267     format(27h coeff. of flux differences)
         write(50,3000) (a2ipz(n),n=1,nloop)
         write(50,268)
 268     format(32h coeff. of magnetic field values)
         write(50,3000) (a3ipz(n),n=1,nprob)
         write(50,269)
 269     format(32h coeff. of coil currents        )
         write(50,3000) (-a4ipz(n),n=1,nshafa),-a4ipz(ngroup1+1)
         write(50,270)
 270     format(32h coeff. of psidot               )
         write(50,3000) (-a4ipz(n+nshafa),n=1,nvvel)
      endif
      if(midplan.eq.8) then
         write(50,271)
 271     format(10h a2ipzb(k))
         write(50,3000) (a2ipzb(n),n=1,nloop)
         write(50,272)
 272     format(10h a2ipzt(k))
         write(50,3000) (a2ipzt(n),n=1,nloop)
         write(50,273)
 273     format(10h a3ipzb(k))
         write(50,3000) (a3ipzb(n),n=1,nloop)
         write(50,274)
 274     format(10h a3ipzt(k))
         write(50,3000) (a3ipzt(n),n=1,nloop)
      endif
c     
c     
c     
c     
c     
c     
c     
c     
c     do 271 n=1,nloop
c     a2(nob1,n) = v4(n)*uc3r
c     a2(nob2,n) = a2ipz(n)
c     271 continue
c     do 272 n=1,nprob
c     a3(nob1,n) = prlen(n)*uc2r + v5(n)*uc3r
c     a3(nob2,n) = a3ipz(n)
c     272 continue
c     do 274 k=1,ngroup1
c     coeff = 0.
c     do 273 n=1,nprob
c     coeff = coeff + dex(n,k)*prlen(n)
c     273 continue
c     a4(nob1,k) = -gamma(k)*uc1r - coeff*uc2r - v6(k)*uc3r
c     a4(nob2,k) = -a4ipz(k)
c     274 continue
c     
c     
c     Flux matrix diagnostic (everywhere)
c     
      if (istop.eq.1969) then
         open (unit=51,file='flux_matrix.dat',status='replace')
         write (51,'(I5)') kmax
         write (51,'(I5)') jmax
         write (51,'(I5)') nloop
         write (51,'(I5)') nprob
         write (51,'(I5)') ngroup1
         do kk=1,kmax
            write(51,7460) z(kk)
         enddo
         do l=1,jmax
            write(51,7460) r(l)
         enddo
         do kk=1,kmax
            do l=1,jmax
               do m=1,mmax
                  a1(l,m) = 0.
               enddo
               do j=1,jmax
                  if ((r(j).ge.xip).and.(r(j).le.xop)) then
                     do k=1,kmax
                        if((z(k).ge.zlp).and.(z(k).le.zup)) then
                           call gf(ineg,0,r(l),z(kk),r(j),z(k),ans)
                           do m=1,mmax
                              if(coe(j,k,m).gt.0.) then
                                 a1(l,m) = a1(l,m) + (ans*coe(j,k,m))
                              endif
                           enddo
                        endif
                     enddo
                  endif
               enddo
            enddo
            call mulmm(a1,jmax,mmax,axi,mmax,mmax,b3)
            call mulmm(b3,jmax,mmax,b1,mmax,nloop,a2)
            call mulmm(b3,jmax,mmax,b2,mmax,nprob,a3)
            call mulmm(b3,jmax,mmax,b6,mmax,ngroup1,b7)
            do n=1,nloop
               do nn=1,jmax
                  write (51,7460) a2(nn,n)
               enddo
            enddo
            do n=1,nprob
               do nn=1,jmax
                  write (51,7460) a3(nn,n)
               enddo
            enddo
            do n=1,ngroup1
               do nn=1,jmax
                  write (51,7460) b7(nn,n)
               enddo
            enddo
         enddo
         close (unit=51,status='keep')
      endif
c     
c     
c------------------------------time evolution------------------------
c     
c-----------------------new kappa observer 21.12.98------------------
c     
c     mvloop(1)=6 (plasma elongation control by ECRH) option added (SC, 02/11/06)
c     if(((iscramb.eq.12).or.(iscramb.eq.19).or.(iscramb.eq.16)
c     +          .or.(iscramb.eq.15).or.(iscramb.eq.25).or.(iscramb.eq.26)
c     +   .or.(iscramb.eq.36).or.(mvloop(1).eq.6))
c     +                 .and.(mod(ifour,10).eq.6)) then
c     Generate observer and reference always
      if (mod(ifour,10).eq.6) then
c     
c     Use equilibrium #nzaxre instead (SC, 28/10/03)
c     m = numeq
         m = nzaxre
         if(ilie.gt.0) then
            do 308 i=1,ilie
               xfob(i) = rlim(m,i)
               zfob(i) = zlim(m,i)
 308        continue
         endif
         if(ilia.gt.0) then
            do 309 i=1,ilia
               xfob(i+ilie) = rlia(m,i)
               zfob(i+ilie) = zlia(m,i)
 309        continue
         endif
c     
         do 382 l=1,nfob
            do 375 m=1,mmax
               a1(l,m) = 0.
 375        continue
            do 378 j=1,jmax
               do 377 k=1,kmax
                  if((r(j).lt.xip).or.(r(j).gt.xop)) go to 377
                  if((z(k).lt.zlp).or.(z(k).gt.zup)) go to 377
                  call gf(ineg,0,xfob(l),zfob(l),r(j),z(k),ans)
                  do 376 m=1,mmax
                     if(coe(j,k,m).le.0.) go to 376
                     a1(l,m) = a1(l,m) + (ans*coe(j,k,m))
 376              continue
 377           continue
 378        continue
 382     continue
c     
         call mulmm(a1,nfob,mmax,axi,mmax,mmax,b3)
         call mulmm(b3,nfob,mmax,b1,mmax,nloop,a2)
         call mulmm(b3,nfob,mmax,b2,mmax,nprob,a3)
         call mulmm(b3,nfob,mmax,b6,mmax,ngroup1,b7)
c     
         zzzmax=-100.
         zzzmin= 100.
         rrrmax=-100.
         rrrmin= 100.
         do n=1,nfob
            if(xfob(n).gt.rrrmax) then
               rrrmax=xfob(n)
               nrmax=n
            endif
            if(xfob(n).lt.rrrmin) then
               rrrmin=xfob(n)
               nrmin=n
            endif
            if(zfob(n).gt.zzzmax) then
               zzzmax=zfob(n)
               nzmax=n
            endif
            if(zfob(n).lt.zzzmin) then
               zzzmin=zfob(n)
               nzmin=n
            endif
         enddo
c     
c     Flux matrix diagnostic (boundary only)
c     
         if (istop.eq.1968) then
            open (unit=51,file='flux_matrix.dat',status='replace')
            write (51,'(I5)') nfob
            write (51,'(I5)') nloop
            write (51,'(I5)') nprob
            write (51,'(I5)') ngroup1
            do n=1,nloop
               do nn=1,nfob
                  write (51,7460) a2(nn,n)
               enddo
            enddo
            do n=1,nprob
               do nn=1,nfob
                  write (51,7460) a3(nn,n)
               enddo
            enddo
            do n=1,ngroup1
               do nn=1,nfob
                  write (51,7460) b7(nn,n)
               enddo
            enddo
            close (unit=51,status='keep')
         endif
 7460    format (1x,e12.5)
c     
         do n=1,nloop
            a2ipzs(n) =(-a2(nzmax,n)-a2(nzmin,n)+a2(nrmax,n)+a2(nrmin,n))
     1           *69000.
         enddo
         do n=1,nprob
            a3ipzs(n) =(-a3(nzmax,n)-a3(nzmin,n)+a3(nrmax,n)+a3(nrmin,n))
     1           *69000.
         enddo
c     Add coil correction term (SC, 13/05/04)
         do n=1,ngroup1
            a4ipzs(n) =(-b7(nzmax,n)-b7(nzmin,n)+b7(nrmax,n)+b7(nrmin,n))
     1           *69000.
         enddo
c     a
      endif
c     
 3000 format(1x,6e12.5)
c     3001 format(1x,12i6)
      return
      end
c     
c     
c     
c     
c     
c     
c     
c     
      subroutine coilnum
      include 'fbtmgams.inc'
      include 'mga.inc'
c     
      print *,'coilnum:zax(1),mvloop(1)',zax(1),mvloop(1)
      if((zax(nzaxre).le.0.11).and.(zax(nzaxre).ge.-0.11).and.
     1     (mvloop(1).ne.8).and.(mvloop(1).ne.18))     midplan = 1
      if((zax(nzaxre).lt.-0.11).and.
     1     (mvloop(1).ne.8).and.(mvloop(1).ne.18))     midplan = 37
      if((zax(nzaxre).gt.0.11).and.
     1     (mvloop(1).ne.8).and.(mvloop(1).ne.18))     midplan = 3
      if(iscale.gt.2)                            iscale  = 2
      if(iscale.lt.-2)                           iscale  = -2
c     
      moh5 = 1
      moh6 = 4
      moh7 = 5
      moh8 = 8
      if(midplan.eq.1) then
         midplad = 1+iscale
         if(midplad.lt.1) midplad=midplad+38
         midout  = 20-iscale
         mu1 = 4
         mu2 = 5
         mu3 = 11
         mu4 = 14
         moh1 = 10
         moh2 = 12
         moh3 = 13
         moh4 = 15
      endif
      if(midplan.eq.37) then
         midplad = 37+iscale
         if(midplad.gt.38) midplad=midplad-38
         midout  = 22-iscale
         mu1 = 3
         mu2 = 4
         mu3 = 10
         mu4 = 13
         moh1 = 9
         moh2 = 11
         moh3 = 12
         moh4 = 14
         moh5 = 1
      endif
      if(midplan.eq.3) then
         midplad = 3+iscale
         midout  = 18-iscale
         mu1 = 5
         mu2 = 6
         mu3 = 12
         mu4 = 15
         moh1 = 11
         moh2 = 13
         moh3 = 14
         moh4 = 16
         moh5 = 8
         moh6 = 9
         moh7 = 4
         moh8 = 7
      endif
      if(midplan.eq.8) then
         midplab = 35
         midplat = 5
         midoutb = 24
         midoutt = 16
         mu1 = 6
         mu2 = 7
         mu3 = 13
         mu4 = 16
         mu5 = 3
         mu6 = 2
         mu7 = 12
         mu8 = 9
         moh1 = 10
         moh2 = 11
         moh3 = 14
         moh4 = 15
         moh5 = 1
         moh6 = 4
         moh7 = 5
         moh8 = 8
         if(ifour.eq.8) then
            moh1 = 2
            moh2 = 3
            moh3 = 6
            moh4 = 7
            moh5 = 1
            moh6 = 4
            moh7 = 5
            moh8 = 8
            mu1 = 9
            mu2 = 10
            mu3 = 11
            mu4 = 12
            mu5 = 13
            mu6 = 14
            mu7 = 15
            mu8 = 16
         endif
      endif
c     
      return
      end
c     
c     
c     
c     
c     
c     
c     
c     
      subroutine brbzeq
      include 'fbtmgams.inc'
      include 'mga.inc'
c     
c--------vertical field and in-out flux difference------------------
c     
      do 5179 m=1,numeq
c     
         zdee      = sqrt(area(m)*cappab(m))
         rdee      = zdee/cappab(m)
         elplas(m) = selfrc(rze(m),zdee,rdee,1.0,20) +
     1        eli(m)*rze(m)*usdi*0.5
c     
         beezep(m) = bzpzero
         beezem(m) = bzmzero
         beearp(m) = brpzero
         beearm(m) = brmzero
c     
         if(midplan.ne.8) then
            do 5174 ii=1,2
               if(ii.eq.1) rzepm = rze(m) + deltar
               if(ii.eq.2) rzepm = rze(m) - deltar
               do 5173 k=1,nshaoh
                  dexk = 0.
                  deyk = 0.
                  ifi = isvf(k)
                  ila = isvl(k)
                  do 5172 i=ifi,ila
                     call gradgf(ineg,0,rzepm,zax(m),rvf(i),zvf(i),gradx,gradz)
                     dexk = dexk-(tvf(i)*usdi*gradx)/(rzepm*tpi)
                     deyk = deyk+(tvf(i)*usdi*gradz)/(rzepm*tpi)
 5172             continue
                  if(ii.eq.1) beezep(m) = beezep(m) + dexk*gcurr(m,k)
                  if(ii.eq.2) beezem(m) = beezem(m) + dexk*gcurr(m,k)
                  if(ii.eq.1) beearp(m) = beearp(m) + deyk*gcurr(m,k)
                  if(ii.eq.2) beearm(m) = beearm(m) + deyk*gcurr(m,k)
 5173          continue
 5174       continue
         endif
c     
         if(midplan.eq.8) then
            if(m.eq.1) then
               iplatop=0
               if(raxb(m).lt.0.01) then
                  if(zaxt(m).lt.0.) iplatop=-1
                  if(zaxt(m).gt.0.) iplatop=1
               endif
               print 6000,iplatop
 6000          format(10h  iplatop=,i2)
            endif
            if(raxb(m).lt.0.01) then
               raxb(m) = raxt(m)
               zaxb(m) =-zaxt(m)
            endif
            if(zaxt(m).lt.0.) then
               zaxt(m) = -zaxt(m)
               zaxb(m) = -zaxb(m)
            endif
            beezepb(m) = bzpzerb
            beezemb(m) = bzmzerb
            beearpb(m) = brpzerb
            beearmb(m) = brmzerb
            do 5177 ii=1,4
               if(ii.eq.1) raxpm = raxt(m) + deltar
               if(ii.eq.2) raxpm = raxt(m) - deltar
               if(ii.eq.3) raxpm = raxb(m) + deltar
               if(ii.eq.4) raxpm = raxb(m) - deltar
               if((ii.eq.1).or.(ii.eq.2)) zaxpm = zaxt(m)
               if((ii.eq.3).or.(ii.eq.4)) zaxpm = zaxb(m)
               do 5176 k=1,nshaoh
                  dexk = 0.
                  deyk = 0.
                  ifi = isvf(k)
                  ila = isvl(k)
                  do 5175 i=ifi,ila
                     call gradgf(ineg,0,raxpm,zaxpm,rvf(i),zvf(i),gradx,gradz)
                     dexk = dexk-(tvf(i)*usdi*gradx)/(raxpm*tpi)
                     deyk = deyk+(tvf(i)*usdi*gradz)/(raxpm*tpi)
 5175             continue
                  if(ii.eq.1) beezep(m) = beezep(m) + dexk*gcurr(m,k)
                  if(ii.eq.1) beearp(m) = beearp(m) + deyk*gcurr(m,k)
                  if(ii.eq.2) beezem(m) = beezem(m) + dexk*gcurr(m,k)
                  if(ii.eq.2) beearm(m) = beearm(m) + deyk*gcurr(m,k)
                  if(ii.eq.3) beezepb(m) = beezepb(m) + dexk*gcurr(m,k)
                  if(ii.eq.3) beearpb(m) = beearpb(m) + deyk*gcurr(m,k)
                  if(ii.eq.4) beezemb(m) = beezemb(m) + dexk*gcurr(m,k)
                  if(ii.eq.4) beearmb(m) = beearmb(m) + deyk*gcurr(m,k)
 5176          continue
 5177       continue
         endif
c     
c     if(midplan.ne.8) then
c     delpsi(m) = flux(m,midplad) - flux(m,midout)
c     1          + (bee(m,midplad)*gapin*rbee(midplad)*tpi)
c     2          - (bee(m,midout)*gapout*rbee(midout)*tpi)
c     endif
c     if(midplan.eq.8) then
c     delpsib(m) = flux(m,midplab) - flux(m,midoutb)
c     1          + (bee(m,midplab)*gapin*rbee(midplab)*tpi)
c     2          - (bee(m,midoutb)*gapout*rbee(midoutb)*tpi)
c     delpsit(m) = flux(m,midplat) - flux(m,midoutt)
c     1          + (bee(m,midplat)*gapin*rbee(midplat)*tpi)
c     2          - (bee(m,midoutt)*gapout*rbee(midoutt)*tpi)
c     endif
         print 5180,beezep(m),beezem(m),delpsi(m)
 5179 continue
 5180 format(8h beezep=,e12.5,8h beezem=,e12.5,8h delpsi=,e12.5)
c     
      return
      end
c     
c     
c     
c     
c     
c     
c     
c     
      subroutine scenari
      include 'fbtmgams.inc'
      include 'mga.inc'
c     
c------------------------input parameters----------------------------
c     
c     Increase ebias to 100. to prevent coils from sticking at zero (SC, 25/10/05)
c     if(iohfb.eq.1) ebias  = 50.
      if(iohfb.eq.1) ebias  = 100.
      if((iohfb.eq.-1).and.(if36fb.eq.1)) ebias  = -100.
      if((iohfb.eq.-1).and.(if36fb.eq.-1)) ebias  = -100.
      if(midplan.eq.8) ebias  = 50.
      nip    = 4
      nipm1  = nip-1
      nip1   = nip+1
      nip10  = nip+10
      nip11  = nip+11
      nflat  = nip10+numeq-1
      nflat1 = nflat+1
c     Amagic<=0 option added (SC, 7/1/03)
      if (amagic.gt.0.) then
         nend = nflat+numeq
      else
         nend = nflat
      end if
c     
      ntoft  = nend+2
      ntoftm1= ntoft-1
c     
      do m=1,numeq
         timeqe(m) = timeqe(m)*timefac
      enddo
c     
      do n=1,ntoft
         if(iohfb.eq.1) diohdt(n) = diohdt(n)*1000.
         if(iohfb.eq.-1) diohdt(n) = -diohdt(n)*1000.
      enddo
c     
      do n=1,nip
         aipoft(n) = 0.
         bzeroft(n) = bzeroe(1)
         if(n.eq.1) bzeroft(n) = 0.
         do k=1,16
            polcur(n,k) = 0.
            if((k.ge.1).and.(k.le.8)) polcur(n,k)=ebias
         enddo
         if((midplan.eq.8).and.((n.eq.2).or.(n.eq.3))) then
c     
c           efoh         = 100./(0.17*34.)
c           polcur(n,1)  = 69.65 *efoh
c           polcur(n,2)  = 34.   *efoh
c           polcur(n,3)  = 34.   *efoh
c           polcur(n,4)  = 34.   *efoh
c           polcur(n,5)  = 34.   *efoh
c           polcur(n,6)  = 34.   *efoh
c           polcur(n,7)  = 34.   *efoh
c           polcur(n,8)  = 69.65 *efoh
c           polcur(n,9)  = 63.0  *efoh
c           polcur(n,10) = -24.6 *efoh
c           polcur(n,11) = -15.4 *efoh
c           polcur(n,12) =   9.7 *efoh
c           polcur(n,13) =   9.7 *efoh
c           polcur(n,14) = -15.4 *efoh
c           polcur(n,15) = -24.6 *efoh
c           polcur(n,16) = 63.0  *efoh
c     
         endif
         polcur(n,mu1)=0.
         polcur(n,mu2)=0.
         if(midplan.eq.8) polcur(n,mu5)=0.
         if(midplan.eq.8) polcur(n,mu6)=0.
         do k=1,38
            fluxoft(n,k) = 0.
            beeoft(n,k)  = 0.
         enddo
         bzpoft(n)  = bzpzero
         bzmoft(n)  = bzmzero
         bzpoftb(n) = bzpzerb
         bzmoftb(n) = bzmzerb
         brpoft(n)  = brpzero
         brmoft(n)  = brmzero
         brpoftb(n) = brpzerb
         brmoftb(n) = brmzerb
         if((n.eq.2).or.(n.eq.3)) then
            if(iohfb.eq.1) then
               if(midplan.eq.1) bzramp=0.0
c              if(midplan.ne.1) bzramp=0.01
               if(midplan.ne.1) bzramp=0.0
               if(midplan.eq.8) bzramp=uc1
            endif
            if(iohfb.eq.-1) bzramp=-0.01
            bzpoft(n)  = bzpzero + bzramp
            bzmoft(n)  = bzmzero + bzramp
            bzpoftb(n) = bzpzerb + bzramp
            bzmoftb(n) = bzmzerb + bzramp
         endif
c        if(bzpzero.eq.0.) bzpoft(n)  =-0.00005
c        if(bzmzero.eq.0.) bzmoft(n)  =-0.00010
         aroft(n)  = rze(1)
         zeoft(n)  = zax(1)
         if(midplan.eq.8) then
            aroft(n)  = raxt(1)
            aroftb(n) = raxb(1)
            zeoft(n)  = zaxt(1)
            zeoftb(n) = zaxb(1)
         endif
c        dpsoft(n) = dpszero
c        dpsoftb(n) = dpszero
c        dpsoftt(n) = dpszero
         zecorrb(n) = zecorb(1)
         zecorrt(n) = zecort(1)
      enddo
c     
      do n=nip1,nip10
         tfra       = (toft(n)-toft(nip))/(toft(nip10)-toft(nip))
         tfrasq     = tfra*tfra
         tfrasqr    = sqrt(tfra)
         aipoft(n)  = placur(1)*tfrasqr
         bzeroft(n) = bzeroe(1)
         do k=1,16
            polcur(n,k) = gcurr(1,k)*tfrasq
            if((k.ge.1).and.(k.le.8)) polcur(n,k)=polcur(n,k)+ebias
         enddo
c        if(midplan.eq.8) then
c           polcur(n,1)=polcur(n,1)+(1.-tfra)*polcur(nip,1)
c           polcur(n,4)=polcur(n,4)+(1.-tfra)*polcur(nip,4)
c           polcur(n,5)=polcur(n,5)+(1.-tfra)*polcur(nip,5)
c           polcur(n,8)=polcur(n,8)+(1.-tfra)*polcur(nip,8)
c           polcur(n,10)=polcur(n,10)+(1.-tfra)*polcur(nip,10)
c           polcur(n,11)=polcur(n,11)+(1.-tfra)*polcur(nip,11)
c           polcur(n,14)=polcur(n,14)+(1.-tfra)*polcur(nip,14)
c           polcur(n,15)=polcur(n,15)+(1.-tfra)*polcur(nip,15)
c        endif
         polcur(n,mu1)=polcur(n,mu1)-ebias
         polcur(n,mu2)=polcur(n,mu2)-ebias
         if(midplan.eq.8) polcur(n,mu5)=polcur(n,mu5)-ebias
         if(midplan.eq.8) polcur(n,mu6)=polcur(n,mu6)-ebias
         do k=1,38
            fluxoft(n,k) = (flux(1,k)-flux(1,1))*tfrasq
            beeoft(n,k)  = bee(1,k)*tfrasq
         enddo
         bzpoft(n) = bzpoft(nip) + (beezep(1)-bzpoft(nip))*(tfra**1.63)
         bzmoft(n) = bzmoft(nip) + (beezem(1)-bzmoft(nip))*(tfra**1.63)
         brpoft(n) = brpoft(nip) + (beearp(1)-brpoft(nip))*(tfra**1.63)
         brmoft(n) = brmoft(nip) + (beearm(1)-brmoft(nip))*(tfra**1.63)
         if(midplan.eq.8) then
            bzpoftb(n) = bzpoftb(nip) + (beezepb(1)-bzpoftb(nip))*(tfra**1.63)
            bzmoftb(n) = bzmoftb(nip) + (beezemb(1)-bzmoftb(nip))*(tfra**1.63)
            brpoftb(n) = brpoftb(nip) + (beearpb(1)-brpoftb(nip))*(tfra**1.63)
            brmoftb(n) = brmoftb(nip) + (beearmb(1)-brmoftb(nip))*(tfra**1.63)
         endif
         aroft(n)  = rze(1)
         zeoft(n)  = zax(1)
         if(midplan.eq.8) then
            aroft(n)  = raxt(1)
            aroftb(n) = raxb(1)
            zeoft(n)  = zaxt(1)
            zeoftb(n) = zaxb(1)
         endif
c        dpsoft(n) = dpszero + (delpsi(1)*dpsfac)*(tfra**1.78)
         if(midplan.eq.8) then
c           dpsoftb(n) = dpszero + (delpsib(1)*dpsfac)*(tfra**1.78)
c           dpsoftt(n) = dpszero + (delpsit(1)*dpsfac)*(tfra**1.78)
            zecorrb(n) = zecorb(1)
            zecorrt(n) = zecort(1)
         endif
      enddo
c     
      do n=nip11,nflat
         m = n-nip10+1
         aipoft(n) = placur(m)
         bzeroft(n) = bzeroe(m)
         do k=1,16
            polcur(n,k) = gcurr(m,k)
            if((k.ge.1).and.(k.le.8)) polcur(n,k)=polcur(n,k)+ebias
         enddo
         polcur(n,mu1)=polcur(n,mu1)-ebias
         polcur(n,mu2)=polcur(n,mu2)-ebias
         if(midplan.eq.8) polcur(n,mu5)=polcur(n,mu5)-ebias
         if(midplan.eq.8) polcur(n,mu6)=polcur(n,mu6)-ebias
         do k=1,38
            fluxoft(n,k) = flux(m,k)-flux(m,1)
            beeoft(n,k)  = bee(m,k)
         enddo
         bzpoft(n) = beezep(m)
         bzmoft(n) = beezem(m)
         brpoft(n) = beearp(m)
         brmoft(n) = beearm(m)
         aroft(n)  = rze(m)
         zeoft(n)  = zax(m)
         if(midplan.eq.8) then
            bzpoftb(n) = beezepb(m)
            bzmoftb(n) = beezemb(m)
            brpoftb(n) = beearpb(m)
            brmoftb(n) = beearmb(m)
            aroft(n)  = raxt(m)
            zeoft(n)  = zaxt(m)
            aroftb(n)  = raxb(m)
            zeoftb(n)  = zaxb(m)
         endif
c        dpsoft(n) = delpsi(m)*dpsfac + dpszero
         if(midplan.eq.8) then
c           dpsoftb(n) = delpsib(m)*dpsfac + dpszero
c           dpsoftt(n) = delpsit(m)*dpsfac + dpszero
            zecorrb(n) = zecorb(m)
            zecorrt(n) = zecort(m)
         endif
         if(m.gt.1) toft(n)=timeqe(m)-timeqe(1)+toft(nip10)
         if(n.lt.nflat) then
            dvsi   = elplas(m+1)*placur(m+1)-elplas(m)*placur(m)
            dvsr   = relovo*(timeqe(m+1)-timeqe(m))
c           Next instruction used for He breakdown, to boost initial Vloop
c           if (timeqe(m)<0.06) dvsr   = -9*(timeqe(m+1)-timeqe(m))
            dvss   = -shvsec(m+1)+shvsec(m)
            dvsoh  = dvsi+dvsr-dvss
            vloopoh= dvsoh/(timeqe(m+1)-timeqe(m))
            if(ierat.ne.2) diohdt(n) = -vloopoh*15504.
            if((ierat.eq.2).and.(toft(n).gt.0.05))
     1           diohdt(n) = -vloopoh*15504.
         endif
      enddo
c     
      diohdt(nflat) = -relovo*15504.
      toft(nflat1)  = toft(nflat)+flattop
c     
      do n=nflat1,nend
         nm = nflat+nflat1-n
         m  = numeq+nflat1-n
         aipoft(n) = aipoft(nm)
         bzeroft(n) = bzeroft(nm)
         do k=1,16
            polcur(n,k) = polcur(nm,k)
         enddo
         do k=1,38
            fluxoft(n,k) = fluxoft(nm,k)
            beeoft(n,k)  = beeoft(nm,k)
         enddo
         bzpoft(n) = bzpoft(nm)
         bzmoft(n) = bzmoft(nm)
         brpoft(n) = brpoft(nm)
         brmoft(n) = brmoft(nm)
         aroft(n)  = aroft(nm)
         zeoft(n)  = zeoft(nm)
         if(midplan.eq.8) then
            bzpoftb(n) = bzpoftb(nm)
            bzmoftb(n) = bzmoftb(nm)
            brpoftb(n) = brpoftb(nm)
            brmoftb(n) = brmoftb(nm)
            aroftb(n)  = aroftb(nm)
            zeoftb(n)  = zeoftb(nm)
         endif
c        dpsoft(n) = dpsoft(nm)
c        dpsoftb(n) = dpsoftb(nm)
c        dpsoftt(n) = dpsoftt(nm)
         zecorrb(n) = zecorrb(nm)
         zecorrt(n) = zecorrt(nm)
         if(n.gt.nflat1)  toft(n)=toft(nflat1)
     1        +(timeqe(numeq)-timeqe(m))*(amagic/timefac)
         if(n.lt.nend)   then
            dvsi   = elplas(m-1)*placur(m-1)-elplas(m)*placur(m)
            dvsr   = relovo*((timeqe(m)-timeqe(m-1))*(amagic/timefac))
            dvss   = -shvsec(m-1)+shvsec(m)
            dvsoh  = dvsi+dvsr-dvss
            vloopoh= dvsoh/((timeqe(m)-timeqe(m-1))*(amagic/timefac))
            diohdt(n) = -vloopoh*15504.
         endif
      enddo
c     
      diohdt(nend)  = diohdt(nend-1)
      toft(ntoftm1) = toft(nend)    + 0.015
      toft(ntoft)   = toft(ntoftm1) + 0.250
c     
      do n=ntoftm1,ntoft
         aipoft(n) = 0.
         bzeroft(n) = bzeroe(1)
         if(n.eq.ntoft) bzeroft(n) = 0.
         do k=1,16
            polcur(n,k) = 0.
         enddo
         do k=1,38
            fluxoft(n,k) = 0.
            beeoft(n,k)  = 0.
         enddo
         bzpoft(n)  = bzpzero
         bzmoft(n)  = bzmzero
         brpoft(n)  = brpzero
         brmoft(n)  = brmzero
         aroft(n)  = rze(1)
         zeoft(n)  = zax(1)
         if(midplan.eq.8) then
            bzpoftb(n) = bzpzerb
            bzmoftb(n) = bzmzerb
            brpoftb(n) = brpzerb
            brmoftb(n) = brmzerb
            aroft(n)  = raxt(1)
            zeoft(n)  = zaxt(1)
            aroftb(n)  = raxb(1)
            zeoftb(n)  = zaxb(1)
         endif
c        dpsoft(n) = 0.
c        dpsoftb(n) = 0.
c        dpsoftt(n) = 0.
         zecorrb(n) = 0.
         zecorrt(n) = 0.
      enddo
c     
      ohcur(1) = 0.
      do n=2,ntoftm1
         ohcur(n) = ohcur(n-1)+(diohdt(n-1)*(toft(n)-toft(n-1)))
      enddo
      ohcur(ntoft) = 0.
c     
      diohdt(ntoftm1) = -ohcur(ntoftm1)/(toft(ntoft)-toft(ntoftm1))
      diohdt(ntoft)   = 0.
c     
      do n=1,ntoft
         aipcor(n) = (aipoft(n)*curfac) + aipdel
      enddo
c     
      do n=1,mt
         do k=1,17
            efcur(n,k) = 0.
         enddo
         arref(n)  = 0.
         arrefb(n) = 0.
         zeref(n)  = 0.
         zerefb(n) = 0.
         zerefm(n) = 0.
         do kk=1,24
            efwave(n,kk) = 0.
         enddo
         cayref(n) = 0.
      enddo
c     
      print 5200
 5200 format (7h diohdt)
      print 3000,(diohdt(m),m=1,ntoft)
 3000 format(1x,6e12.5)
 3001 format(1x,12i6)
      return
      end
c     
c     
c     
c     
c     
c     
c     
c     
      subroutine backoff
      include 'fbtmgams.inc'
      include 'mga.inc'
c     
c----------------------initial conditions------------------------------
c     
c     note: coefficients were computed for OHCUR=10kA and VLOOP=7 Volts
c     F-coils have 36 turns
c     VLOOP=1Volt corresponds to diohdt=15504 Amps per sec
c     
      if(midplan.eq.1) then
c---------rbi=0.62, rbo=0.92, zbl=-0.15, zbu=0.15----------------------
         oh1 = ohback*(3.04/360.)
         oh2 = ohback*(4.03/360.)
         oh3 = ohback*(4.03/360.)
         oh4 = ohback*(3.04/360.)
         ve1 = -(veback*0.1385)/(36.*7.*0.18)
         ve2 = -(veback*0.0538)/(36.*7.*0.18)
         ve3 = -(veback*0.0538)/(36.*7.*0.18)
         ve4 = -(veback*0.1385)/(36.*7.*0.18)
c     
c     oh1 = ohback*(2.996/360.)
c     oh2 = ohback*(4.054/360.)
c     oh3 = ohback*(4.054/360.)
c     oh4 = ohback*(2.996/360.)
c     ve1 = -(veback*0.1290)/(36.*7.*0.18)
c     ve2 = -(veback*0.0627)/(36.*7.*0.18)
c     ve3 = -(veback*0.0627)/(36.*7.*0.18)
c     ve4 = -(veback*0.1290)/(36.*7.*0.18)
c     
         if(if36fb.eq.1) then
            oh1 =  (180.+64.)*(ohback/21267.)
            oh2 =  (237.-70.)*(ohback/21267.)
            oh3 =  237.*(ohback/21267.)
            oh4 =  (180.+52.)*(ohback/21267.)
            oh5 =  190.*(ohback/21267.)
            oh6 =  0.
            oh7 =  0.
            oh8 =  0.
            ve1 = -442.*(veback/168780.)
            ve2 = -172.*(veback/168780.)
            ve3 = -149.*(veback/168780.)
            ve4 = -450.*(veback/168780.)
            if((bzeroe(1).lt.1.3).and.(iscramb.eq.5)) then
               ve1 = -292.*(veback/168780.)
               ve2 = -122.*(veback/168780.)
               ve3 = -099.*(veback/168780.)
               ve4 = -300.*(veback/168780.)
            endif
            ve5 =  0.
            ve6 =  0.
            ve7 =  0.
            ve8 =  0.
            if(iscramb.eq.7) then
               ve1 = -532.*(veback/168780.)
               ve2 = -92.*(veback/168780.)
               ve3 = -124.*(veback/168780.)
               ve4 = -440.*(veback/168780.)
            endif
c     New coil combination for small plasmas (SC, 02/09/04 - 18/01/05)
            if(iscramb.eq.8.or.iscramb.eq.10) then
               ve1 = -476.*(veback/168780.)
               ve2 = -178.*(veback/168780.)
               ve3 = -116.*(veback/168780.)
               ve4 = -439.*(veback/168780.)
            endif
         endif
c     
         if(if36fb.eq.-1) then
c     oh1 =  (180.+162.)*(ohback/21267.)
c     oh2 =  (237.-63.)*(ohback/21267.)
c     oh3 =  (237.+36.)*(ohback/21267.)
c     oh4 =  (180.+162.)*(ohback/21267.)
c     oh5 =  135.*(ohback/21267.)
c     New coefficients 11/2012 (JS -> SC)
            oh1 =  112.*(ohback/21267.)
            oh2 =  249.*(ohback/21267.)
            oh3 =  240.*(ohback/21267.)
            oh4 =  102.*(ohback/21267.)
            oh5 =  -29.*(ohback/21267.)
            oh6 =  0.
            oh7 =  0.
            oh8 =  0.
c     modified by SC, 22/08/08
c     ve1 = -442.*(veback/168780.)
c     ve2 = -172.*(veback/168780.)
c     ve3 = -149.*(veback/168780.)
c     ve4 = -450.*(veback/168780.)
c     ve1 = -586.*(veback/168780.)
c     ve2 = -167.*(veback/168780.)
c     ve3 = -195.*(veback/168780.)
c     ve4 = -412.*(veback/168780.)
c     ve5 =  0.
c     New coefficients 11/2012 (JS -> SC)
            ve1 = -477.*(veback/168780.)
            ve2 = -205.*(veback/168780.)
            ve3 = -188.*(veback/168780.)
            ve4 = -494.*(veback/168780.)
            ve5 = -119.*(veback/168780.)
            ve6 =  0.
            ve7 =  0.
            ve8 =  0.
         endif
c     
      endif
      if(midplan.eq.37) then
         oh1 = ohback*(-.706/360.)
         oh2 = ohback*(4.296/360.)
         oh3 = ohback*(2.593/360.)
         oh4 = ohback*(6.245/360.)
         ve1 = -(veback*0.1274)/(36.*7.*0.18)
         ve2 = -(veback*0.0376)/(36.*7.*0.18)
         ve3 = -(veback*0.0406)/(36.*7.*0.18)
         ve4 = -(veback*0.1596)/(36.*7.*0.18)
c-------rbi=0.62,rbo=0.92,zbl=-0.38,zbu=0.08-----------------
         oh1 = ohback*(0.42/360.)
         oh2 = ohback*(0.29/360.)
         oh3 = ohback*(7.26/360.)
         oh4 = ohback*(3.78/360.)
         ve1 = -(veback*0.1192)/(36.*7.*0.18)
         ve2 = -(veback*0.0775)/(36.*7.*0.18)
         ve3 =  (veback*0.0097)/(36.*7.*0.18)
         ve4 = -(veback*0.1894)/(36.*7.*0.18)
c     
         oh1 =   38.0*(ohback/21267.)
         oh2 =  -10.4*(ohback/21267.)
         oh3 =  453.5*(ohback/21267.)
         oh4 =  213.9*(ohback/21267.)
         oh5 =  0.
         oh6 =  0.
         oh7 =  0.
         oh8 =  0.
         ve1 = -391.*(veback/168780.)
         ve2 = -245.*(veback/168780.)
         ve3 =   29.*(veback/168780.)
         ve4 = -538.*(veback/168780.)
         ve5 =  0.
         ve6 =  0.
         ve7 =  0.
         ve8 =  0.
c--------------------rbi=0.62, rbo=1.12, zbl=-0.50, zbu=0.50--------
         if(if36fb.eq.1) then
            oh1 =  -34.*(ohback/21267.)
            oh2 =  225.*(ohback/21267.)
            oh3 =  202.*(ohback/21267.)
            oh4 =  330.*(ohback/21267.)
            oh5 =  100.*(ohback/21267.)
            ve1 = -442.*(veback/168780.)
            ve2 =  -90.*(veback/168780.)
            ve3 = -162.*(veback/168780.)
            ve4 = -405.*(veback/168780.)
            ve5 =  100.*(veback/168780.)
         endif
c     
         if(if36fb.eq.-1) then
            oh1 = -154.*(ohback/21267.)
            oh2 =  225.*(ohback/21267.)
            oh3 =  202.*(ohback/21267.)
            oh4 =  230.*(ohback/21267.)
            oh5 =   20.*(ohback/21267.)
            ve1 = -442.*(veback/168780.)
            ve2 =  -90.*(veback/168780.)
            ve3 = -162.*(veback/168780.)
            ve4 = -405.*(veback/168780.)
            ve5 =   20.*(veback/168780.)
         endif
c     
      endif
      if(midplan.eq.3) then
         oh4 = ohback*(-.706/360.)
         oh3 = ohback*(4.296/360.)
         oh2 = ohback*(2.593/360.)
         oh1 = ohback*(6.245/360.)
         ve4 = -(veback*0.1274)/(36.*7.*0.18)
         ve3 = -(veback*0.0376)/(36.*7.*0.18)
         ve2 = -(veback*0.0406)/(36.*7.*0.18)
         ve1 = -(veback*0.1596)/(36.*7.*0.18)
c-----rbi=0.62, rbo=0.92, zbl=0.08, zbu=0.38------------------------
         oh4 = ohback*(0.42/360.)
         oh3 = ohback*(0.29/360.)
         oh2 = ohback*(7.26/360.)
         oh1 = ohback*(3.78/360.)
         ve4 = -(veback*0.1192)/(36.*7.*0.18)
         ve3 = -(veback*0.0775)/(36.*7.*0.18)
         ve2 = -(veback*0.0097)/(36.*7.*0.18)
         ve1 = -(veback*0.1894)/(36.*7.*0.18)
c     
         oh4 =   38.0*(ohback/21267.)
         oh3 =  -10.4*(ohback/21267.)
         oh2 =  453.5*(ohback/21267.)
         oh1 =  213.9*(ohback/21267.)
         oh5 =  0.
         oh6 =  0.
         oh7 =  0.
         oh8 =  0.
         ve1 = -525.*(veback/168780.)
         ve2 =  -30.*(veback/168780.)
         ve3 = -172.*(veback/168780.)
         ve4 = -411.*(veback/168780.)
         ve5 =  0.
         ve6 =  0.
         ve7 =  0.
         ve8 =  0.
c--------------------rbi=0.62, rbo=1.12, zbl=-0.50, zbu=0.50--------
         if(if36fb.eq.-1) then
            oh1 =  230.*(ohback/21267.)
            oh2 =  202.*(ohback/21267.)
            oh3 =  225.*(ohback/21267.)
            oh4 =  -34.*(ohback/21267.)
            oh5 =    0.*(ohback/21267.)
            oh6 =  -80.*(ohback/21267.)
c     modified by SC, 21/08/08
c     ve1 = -359.*(veback/168780.)
c     ve2 = -163.*(veback/168780.)
c     ve3 =  -86.*(veback/168780.)
c     ve4 = -307.*(veback/168780.)
            ve1 = -419.*(veback/168780.)
            ve2 = -172.*(veback/168780.)
            ve3 =  -82.*(veback/168780.)
            ve4 = -329.*(veback/168780.)
            ve5 =    0.*(veback/168780.)
            ve6 =  -80.*(veback/168780.)
         endif
         if(if36fb.eq.1) then
            oh1 =  310.*(ohback/21267.)
            oh2 =  224.*(ohback/21267.)
            oh3 =  215.*(ohback/21267.)
            oh4 =  -51.*(ohback/21267.)
            oh5 =  100.*(ohback/21267.)
            oh6 =  0.
            oh7 =  0.
            oh8 =  0.
c     modif CN 27.11.96
            ve1 = (-461.-100.)*(veback/168780.)
            ve2 = (-117.-130.)*(veback/168780.)
            ve3 =  (-91.-130.)*(veback/168780.)
            ve4 = (-435.+320.)*(veback/168780.)
            ve5 =  100.*(veback/168780.)
            ve6 =  0.
            ve7 =  0.
            ve8 =  0.*(veback/168780.)
         endif
c     
      endif
      if(midplan.eq.8) then
c------optimization region: rbi=0.62, rbo=0.92, zbl=-0.59, zbu=0.59
c------tcvcoin, 4 optimized currents (F2,F3,F6,F7)
         oh1 = ohback*(-5.502/360.)
         oh2 = ohback*(10.140/360.)
         oh3 = ohback*(10.140/360.)
         oh4 = ohback*(-5.502/360.)
         oh5 = 0.
         oh6 = 0.
         oh7 = 0.
         oh8 = 0.
c-----------------vessel backoff sign has been inversed !! --------
         ve1 = (veback*0.1465)/(36.*7.*0.18)
         ve2 = (veback*0.0535)/(36.*7.*0.18)
         ve3 = (veback*0.0535)/(36.*7.*0.18)
         ve4 = (veback*0.1465)/(36.*7.*0.18)
         ve5 = 0.
         ve6 = 0.
         ve7 = 0.
         ve8 = 0.
c     
c     c------optimization region: rbi=0.62, rbo=0.92, zbl=-0.59, zbu=0.59
c------tcvcosy, 6 optimized groups
c     
c     oh1 = ohback*(21.4/360.)
c     oh2 = ohback*(-2.94/360.)
c     oh3 = ohback*(-2.94/360.)
c     oh4 = ohback*(21.4/360.)
c     ve1 = (veback*0.297)/(36.*7.*0.18)
c     ve2 = -(veback*0.149)/(36.*7.*0.18)
c     ve3 = -(veback*0.149)/(36.*7.*0.18)
c     ve4 = (veback*0.297)/(36.*7.*0.18)
c     
c------optimization region: rbi=0.62, rbo=0.92, zbl=0.25, zbu=0.55
c---------tcvcosy, 8 optimized groups
c     oh1 = ohback*(14.9/360.)
c     oh2 = ohback*(-0.6/360.)
c     oh3 = ohback*(-0.6/360.)
c     oh4 = ohback*(14.9/360.)
c     oh5 = ohback*(5.6/340.)
c     oh6 = ohback*(1.9/340.)
c     oh7 = ohback*(1.9/340.)
c     oh8 = ohback*(5.6/340.)
c     ve1 =  (veback*0.224)/(36.*7.*0.18)
c     ve2 = -(veback*0.133)/(36.*7.*0.18)
c     ve3 = -(veback*0.133)/(36.*7.*0.18)
c     ve4 =  (veback*0.224)/(36.*7.*0.18)
c     ve5 = (veback*0.080)/(34.*7.*0.18)
c     ve6 = (veback*0.018)/(34.*7.*0.18)
c     ve7 = (veback*0.018)/(34.*7.*0.18)
c     ve8 = (veback*0.080)/(34.*7.*0.18)
c-------------G backoffs 15.11.95-------------------------------
         oh1 = ohback*(-254./21267.)
         oh2 = ohback*(536./21267.)
         oh3 = ohback*(536./21267.)
         oh4 = ohback*(-254./21267.)
         oh5 = ohback*(150./21267.)
         oh6 = 0.
         oh7 = 0.
         oh8 = ohback*(150./21267.)
         ve1 = veback*(-454./169160.)
         ve2 = veback*(-131./169160.)
         ve3 = veback*(-108./169160.)
         ve4 = veback*(-444./169160.)
         ve5 = veback*(-150./169160.)
         ve6 = 0.
         ve7 = 0.
         ve8 = veback*(-150./169160.)
c----------------------I backoffs---------------------
         oh5 = ohback*(50./21267.)
         oh8 = ohback*(50./21267.)
         ve5 = veback*(-50./169160.)
         ve8 = veback*(-50./169160.)
c-----------corrections of Jan 16, 2002 --------------------------
         ve3 = veback*(-68./169160.)
         ve4 = veback*(-404./169160.)
c     ve1 = veback*(-414./169160.)
c     ve2 = veback*(-91./169160.)
c-----------------------------------------------------------------
         if(ifour.eq.8) then
            oh1 = 0.
            oh2 = 0.
            oh3 = 0.
            oh4 = 0.
            oh5 = 0.
            oh6 = 0.
            oh7 = 0.
            oh8 = 0.
            ve1 = 0.
            ve2 = 0.
            ve3 = 0.
            ve4 = 0.
            ve5 = veback*(-100./169160.)
            ve6 = veback*(-200./169160.)
            ve7 = veback*(-200./169160.)
            ve8 = veback*(-100./169160.)
         endif
c-----------------M backoffs 14.12.95-------------------
c     rbi=0.62, rbo=0.92, zbl=0.25, zbu=0.55
c     if(ifour.ne.8) then
c     oh1 = ohback*(000./21267.)
c     oh2 = ohback*(442./21267.)
c     oh3 = ohback*(442./21267.)
c     oh4 = ohback*(000./21267.)
c     oh5 = ohback*(631./21267.)
c     oh6 = ohback*(275./21267.)
c     oh7 = ohback*(275./21267.)
c     oh8 = ohback*(631./21267.)
c     ve1 = veback*(-100./195000.)
c     ve2 = veback*(-514./195000.)
c     ve3 = veback*(-530./195000.)
c     ve4 = veback*(-100./195000.)
c     ve5 = veback*(499./195000.)
c     ve6 = veback*(-56./195000.)
c     ve7 = veback*(-50./195000.)
c     ve8 = veback*(421./195000.)
c     endif
c-----------------N backoffs 5.1.96-------------------
c     oh1 = ohback*(000./21267.)
c     oh2 = ohback*(442./21267.)
c     oh3 = ohback*(442./21267.)
c     oh4 = ohback*(000./21267.)
c     oh5 = ohback*(631./21267.)
c     oh6 = ohback*(275./21267.)
c     oh7 = ohback*(275./21267.)
c     oh8 = ohback*(631./21267.)
c     ve1 = veback*(000./195000.)
c     ve2 = veback*(-319./195000.)
c     ve3 = veback*(-334./195000.)
c     ve4 = veback*(000./195000.)
c     ve5 = veback*(661./195000.)
c     ve6 = veback*(077./195000.)
c     ve7 = veback*(085./195000.)
c     ve8 = veback*(590./195000.)
c     
c---------------------Q backoffs------11.4.96----------------------
c     rbi=0.62, rbo=0.92, zbl=0.00, zbu=0.60
c     oh1 = ohback*(000./21267.)
c     oh2 = ohback*(464./21267.)
c     oh3 = ohback*(464./21267.)
c     oh4 = ohback*(000./21267.)
c     oh5 = ohback*(589./21267.)
c     oh6 = ohback*(244./21267.)
c     oh7 = ohback*(244./21267.)
c     oh8 = ohback*(589./21267.)
c     ve1 = veback*(000./195000.)
c     ve2 = veback*(-482./195000.)
c     ve3 = veback*(-496./195000.)
c     ve4 = veback*(000./195000.)
c     ve5 = veback*(480./195000.)
c     ve6 = veback*(240./195000.)
c     ve7 = veback*(240./195000.)
c     ve8 = veback*(470./195000.)
c     
      endif
      print *,'midplan,ve1,ve2,ve3,ve4,ve5,ve6,ve7,ve8',midplan,ve1,ve2,ve3,ve4,ve5,ve6,ve7,ve8
      print *,'midplan,oh1,oh2,oh3,oh4,oh5,oh6,oh7,oh8',midplan,oh1,oh2,oh3,oh4,oh5,oh6,oh7,oh8
      return
      end
c     
c     
c     
c     
c     
c     
c     
c     
      subroutine initial
      include 'fbtmgams.inc'
      include 'mga.inc'
c     
      tone = toft(1)
      do 6000 n=1,ngroup
         vecone(n) = 0.
         vectwo(n) = 0.
 6000 continue
      vescur  = 0.
      arone   = aroft(1)
      zeone   = zeoft(1)
      bzpone  = bzpoft(1)
      bzmone  = bzmoft(1)
      brpone  = brpoft(1)
      brmone  = brmoft(1)
      if(midplan.eq.8) then
         aroneb   = aroftb(1)
         zeoneb   = zeoftb(1)
         bzponeb  = bzpoftb(1)
         bzmoneb  = bzmoftb(1)
         brponeb  = brpoftb(1)
         brmoneb  = brmoftb(1)
      endif
      aipone  = aipoft(1)
      vecone(17) = ohcur(1)
      vecone(18) = vecone(17)
      print 6001
 6001 format(79h ttwo aiptwo ohctwo vescur bztwo bznow  entwo e45two f36two f27two f45two vloop)
      return
      end
c     
c     
c     
c     
c     
c     
c     
c     
      subroutine update
      include 'fbtmgams.inc'
      include 'mga.inc'
c     
c-------------------------update variables-----------------------------
      if(it.ne.1) then
         tone    = ttwo
         arone   = artwo
         zeone   = zetwo
         bzpone  = bzptwo
         bzmone  = bzmtwo
         brpone  = brptwo
         brmone  = brmtwo
         if(midplan.eq.8) then
            aroneb   = artwob
            zeoneb   = zetwob
            bzponeb  = bzptwob
            bzmoneb  = bzmtwob
            brponeb  = brptwob
            brmoneb  = brmtwob
         endif
         aipone  = aiptwo
         do 6002 n=1,ngroup
            vecone(n)  = vectwo(n)
            vectwo(n)  = 0.
 6002    continue
         do 6003 n=1,ngroup
            elpvone(n) = elpvtwo(n)
            if(midplan.eq.8) elponeb(n) = elptwob(n)
 6003    continue
      endif
c     
      return
      end
c     
c     
c     
c     
c     
c     
c     
c     
      subroutine refer
      include 'fbtmgams.inc'
      include 'mga.inc'
c     
c---------compute input variables at end of time step------------------
c     
      if((tone.ge.toft(1)).and.(tone.lt.(toft(2)-0.02)))
     1     deltat=deltat2
      if((tone.ge.(toft(2)-0.02)).and.(tone.lt.toft(nip10+4)))
     1     deltat=deltat1
      if((tone.ge.toft(nip10+4)).and.(tone.lt.(toft(nflat)+0.02)))
     1     deltat=deltat2
      if((tone.ge.(toft(nflat)+0.02)).and.(tone.lt.(toft(nflat1)-0.02)))
     1     deltat=deltat5
      if(tone.ge.(toft(nflat1)-0.02))
     1     deltat=deltat2
c     
      ttwo   = tone + deltat
      if(ttwo.gt.(toft(ntoft)+deltat)) then
         iiout = 1
         go to 6998
      endif
      do 6004 n=1,ntoft
         if(toft(n).gt.ttwo) go to 6005
 6004 continue
 6005 tfra    = (ttwo-toft(n-1))/(toft(n)-toft(n-1))
      artwo   = aroft(n-1)+(aroft(n)-aroft(n-1))*tfra
      zetwo   = zeoft(n-1)+(zeoft(n)-zeoft(n-1))*tfra
      bzptwo  = bzpoft(n-1)+(bzpoft(n)-bzpoft(n-1))*tfra
      bzmtwo  = bzmoft(n-1)+(bzmoft(n)-bzmoft(n-1))*tfra
      brptwo  = brpoft(n-1)+(brpoft(n)-brpoft(n-1))*tfra
      brmtwo  = brmoft(n-1)+(brmoft(n)-brmoft(n-1))*tfra
      if(midplan.eq.8) then
         artwob   = aroftb(n-1)+(aroftb(n)-aroftb(n-1))*tfra
         zetwob   = zeoftb(n-1)+(zeoftb(n)-zeoftb(n-1))*tfra
         bzptwob  = bzpoftb(n-1)+(bzpoftb(n)-bzpoftb(n-1))*tfra
         bzmtwob  = bzmoftb(n-1)+(bzmoftb(n)-bzmoftb(n-1))*tfra
         brptwob  = brpoftb(n-1)+(brpoftb(n)-brpoftb(n-1))*tfra
         brmtwob  = brmoftb(n-1)+(brmoftb(n)-brmoftb(n-1))*tfra
      endif
      aiptwo  = aipoft(n-1)+(aipoft(n)-aipoft(n-1))*tfra
c     dpstwo  = dpsoft(n-1)+(dpsoft(n)-dpsoft(n-1))*tfra
c     dpstwob = dpsoftb(n-1)+(dpsoftb(n)-dpsoftb(n-1))*tfra
c     dpstwot = dpsoftt(n-1)+(dpsoftt(n)-dpsoftt(n-1))*tfra
      zectwob = zecorrb(n-1)+(zecorrb(n)-zecorrb(n-1))*tfra
      zectwot = zecorrt(n-1)+(zecorrt(n)-zecorrt(n-1))*tfra
      do 6006 k=1,16
         if((k.eq.mu1).or.(k.eq.mu2).or.(k.eq.mu3).or.(k.eq.mu4))
     1        go to 6006
         if(midplan.eq.8) then
            if((k.eq.mu5).or.(k.eq.mu6).or.(k.eq.mu7).or.(k.eq.mu8))
     1           go to 6006
         endif
         vectwo(k) = polcur(n-1,k)+(polcur(n,k)-polcur(n-1,k))*tfra
 6006 continue
      do k=1,38
         fluxtwo(k) = fluxoft(n-1,k)+(fluxoft(n,k)-fluxoft(n-1,k))*tfra
         beetwo(k)  = beeoft(n-1,k)+(beeoft(n,k)-beeoft(n-1,k))*tfra
      enddo
      vectwo(17) = ohcur(n-1)+(ohcur(n)-ohcur(n-1))*tfra
      write (*,*) 'OHCUR!!! ',ttwo,vectwo(17)
      vectwo(18) = vectwo(17)
      if(midplan.ne.8) vescus = vescur
c     
      if(midplan.eq.8) then
         if(ttwo.le.0.) vescus=195000.*((toft(1)-ttwo)/toft(1))
         if((ttwo.gt.0.).and.(ttwo.le.0.05))
     1        vescus=195000.*(1.-ttwo*14.)
         if((ttwo.gt.0.05).and.(ttwo.le.toft(nflat)))
     1        vescus=195000.*(0.3-((ttwo-0.05)*0.15)/(toft(nflat)-0.05))
         if((ttwo.gt.toft(nflat)).and.(ttwo.le.toft(nflat1)))
     1        vescus=195000.*0.15
         if(ttwo.gt.toft(nflat1)) vescus=195000.*0.15
     1        *(1.-((ttwo-toft(nflat1))/(toft(ntoft)-toft(nflat1))))
c     
         if(ttwo.le.-0.015)
     1        vescut=195000.*((toft(1)-ttwo)/(toft(1)+0.015))
         if((ttwo.gt.-0.015).and.(ttwo.le.0.))
     1        vescut=195000.*(-ttwo/0.015)
         if(ttwo.gt.0.) vescut=0.
      endif
c     if((midplan.eq.8).or.(iscramb.gt.10)) then
c     vescnew= (-200./155.)*((vectwo(17)-vecone(17))/deltat)
c     vescdif= vescnew-vescus
c     if(vescdif.gt.30000.) vescdif=30000.
c     if(vescdif.lt.-30000.) vescdif=-30000.
c     vescus = vescus+vescdif
c     endif
c     
c     if((ttwo.le.0.).and.((midplan.eq.8).or.(iscramb.gt.10)))
c     1              vescus=169160.*((toft(1)-ttwo)/toft(1))
c     
      if(midplan.ne.8) vescus=vescur
      if(midplan.ne.8) vescut=vescur
      print *,'vescus',vescus
      vescut=vescur
      vescus=vescur
c     
      if(midplan.ne.8)
     1     vectwo(moh1) = vectwo(moh1) + vectwo(17)*oh1+vescus*ve1
      if(midplan.eq.8)
     1     vectwo(moh1) = vectwo(moh1) + vectwo(17)*oh1+vescut*ve1
      vectwo(moh2) = vectwo(moh2) +
     1     vectwo(17)*oh2+vescus*ve2
      vectwo(moh3) = vectwo(moh3) +
     1     vectwo(17)*oh3+vescus*ve3
      if(midplan.ne.8)
     1     vectwo(moh4) = vectwo(moh4) + vectwo(17)*oh4+vescus*ve4
      if(midplan.eq.8)
     1     vectwo(moh4) = vectwo(moh4) + vectwo(17)*oh4+vescut*ve4
      vectwo(moh5) = vectwo(moh5) +
     1     vectwo(17)*oh5+vescus*ve5
      vectwo(moh6) = vectwo(moh6) +
     1     vectwo(17)*oh6+vescus*ve6
      vectwo(moh7) = vectwo(moh7) +
     1     vectwo(17)*oh7+vescus*ve7
      vectwo(moh8) = vectwo(moh8) +
     1     vectwo(17)*oh8+vescus*ve8
c     
 6998 continue
c     
      return
      end
c     
c     
c     
c     
c     
c     
c     
c     
      subroutine mutbrbz
      include 'fbtmgams.inc'
      include 'mga.inc'
c     
c-------compute mutual between plasma current and vessel elements-----
c     
      do 6058 i=1,2
         if(i.eq.1) then
            arpla = artwo
            zepla = zetwo
         endif
         if(i.eq.2) then
            arpla = arone
            zepla = zeone
         endif
         do 6054 k1=1,ngroup
            ifi1 = isvf(k1)
            ila1 = isvl(k1)
            els  = 0.
            do 6050 i1 = ifi1,ila1
               els = els + amutlrc(
     1              rvf(i1),zvf(i1),hvf(i1),wvf(i1),tvf(i1),
     2              arpla,zepla,hpla,wpla,1.,8)
 6050       continue
            if(i.eq.1) elpvtwo(k1) = els
            if(i.eq.2) elpvone(k1) = els
 6054    continue
         if(it.ne.1) go to 6059
 6058 continue
 6059 continue
c     
      if(midplan.eq.8) then
         do 6068 i=1,2
            if(i.eq.1) then
               arpla = artwob
               zepla = zetwob
            endif
            if(i.eq.2) then
               arpla = aroneb
               zepla = zeoneb
            endif
            do 6064 k1=1,ngroup
               ifi1 = isvf(k1)
               ila1 = isvl(k1)
               els  = 0.
               do 6060 i1 = ifi1,ila1
                  els = els + amutlrc(
     1                 rvf(i1),zvf(i1),hvf(i1),wvf(i1),tvf(i1),
     2                 arpla,zepla,hpla,wpla,1.,8)
 6060          continue
               if(i.eq.1) elptwob(k1) = els
               if(i.eq.2) elponeb(k1) = els
 6064       continue
            if(it.ne.1) go to 6070
 6068    continue
 6070    continue
      endif
c     
c--------compute vertical field at r=artwo due to unit currents
c     in shaping coils and vessel elements
c     
      do 6175 ii=1,2
         if(ii.eq.1) then
            arpla=artwo+deltar
            zepla=zetwo
         endif
         if(ii.eq.2) then
            arpla=artwo-deltar
            zepla=zetwo
         endif
         do 6173 k=1,ngroup
            dexk = 0.
            dexj = 0.
            ifi = isvf(k)
            ila = isvl(k)
            do 6172 i=ifi,ila
               call gradgf(ineg,0,arpla,zepla,rvf(i),zvf(i),gradx,gradz)
               dexk=dexk-(tvf(i)*usdi*gradx)/(arpla*tpi)
               dexj=dexj+(tvf(i)*usdi*gradz)/(arpla*tpi)
 6172       continue
            if(ii.eq.1) then
               gbtwo(k,1) = dexk
               gbtwo(k,2) = dexj
            endif
            if(ii.eq.2) then
               gbtwo(k,3) = dexk
               gbtwo(k,4) = dexj
            endif
 6173    continue
 6175 continue
c     
      arpla=artwo+deltar
      zepla=zetwo
      call gradgf(ineg,0,arpla,zepla,1.554,-0.78,gradx,gradz)
      gbtwo(60,1) = +((usdi*gradx)/(arpla*tpi))*(26./68.)
      gbtwo(60,2) = -((usdi*gradz)/(arpla*tpi))*(26./68.)
      call gradgf(ineg,0,arpla,zepla,1.717,-0.78,gradx,gradz)
      gbtwo(60,1) = gbtwo(60,1)+((usdi*gradx)/(arpla*tpi))*(42./68.)
      gbtwo(60,2) = gbtwo(60,2)-((usdi*gradz)/(arpla*tpi))*(42./68.)
      call gradgf(ineg,0,arpla,zepla,1.754,-0.78,gradx,gradz)
      gbtwo(60,1) = gbtwo(60,1)-((usdi*gradx)/(arpla*tpi))
      gbtwo(60,2) = gbtwo(60,2)+((usdi*gradz)/(arpla*tpi))
      arpla=artwo-deltar
      zepla=zetwo
      call gradgf(ineg,0,arpla,zepla,1.554,-0.78,gradx,gradz)
      gbtwo(60,3) = +((usdi*gradx)/(arpla*tpi))*(26./68.)
      gbtwo(60,4) = -((usdi*gradz)/(arpla*tpi))*(26./68.)
      call gradgf(ineg,0,arpla,zepla,1.717,-0.78,gradx,gradz)
      gbtwo(60,3) = gbtwo(60,3)+((usdi*gradx)/(arpla*tpi))*(42./68.)
      gbtwo(60,4) = gbtwo(60,4)-((usdi*gradz)/(arpla*tpi))*(42./68.)
      call gradgf(ineg,0,arpla,zepla,1.754,-0.78,gradx,gradz)
      gbtwo(60,3) = gbtwo(60,3)-((usdi*gradx)/(arpla*tpi))
      gbtwo(60,4) = gbtwo(60,4)+((usdi*gradz)/(arpla*tpi))
c     
      if(midplan.eq.8) then
         do 6185 ii=1,2
            if(ii.eq.1) then
               arpla=artwob+deltar
               zepla=zetwob
            endif
            if(ii.eq.2) then
               arpla=artwob-deltar
               zepla=zetwob
            endif
            do 6183 k=1,ngroup
               dexk = 0.
               dexj = 0.
               ifi = isvf(k)
               ila = isvl(k)
               do 6182 i=ifi,ila
                  call gradgf(ineg,0,arpla,zepla,rvf(i),zvf(i),gradx,gradz)
                  dexk=dexk-(tvf(i)*usdi*gradx)/(arpla*tpi)
                  dexj=dexj+(tvf(i)*usdi*gradz)/(arpla*tpi)
 6182          continue
               if(ii.eq.1) then
                  gbtwo(k,5) = dexk
                  gbtwo(k,6) = dexj
               endif
               if(ii.eq.2) then
                  gbtwo(k,7) = dexk
                  gbtwo(k,8) = dexj
               endif
 6183       continue
 6185    continue
c     
         arpla=artwob+deltar
         zepla=zetwob
         call gradgf(ineg,0,arpla,zepla,1.554,-0.78,gradx,gradz)
         gbtwo(60,5) = +((usdi*gradx)/(arpla*tpi))*(26./68.)
         gbtwo(60,6) = -((usdi*gradz)/(arpla*tpi))*(26./68.)
         call gradgf(ineg,0,arpla,zepla,1.717,-0.78,gradx,gradz)
         gbtwo(60,5) = gbtwo(60,5)+((usdi*gradx)/(arpla*tpi))*(42./68.)
         gbtwo(60,6) = gbtwo(60,6)-((usdi*gradz)/(arpla*tpi))*(42./68.)
         call gradgf(ineg,0,arpla,zepla,1.754,-0.78,gradx,gradz)
         gbtwo(60,5) = gbtwo(60,5)-((usdi*gradx)/(arpla*tpi))
         gbtwo(60,6) = gbtwo(60,6)+((usdi*gradz)/(arpla*tpi))
         arpla=artwob-deltar
         zepla=zetwob
         call gradgf(ineg,0,arpla,zepla,1.554,-0.78,gradx,gradz)
         gbtwo(60,7) = +((usdi*gradx)/(arpla*tpi))*(26./68.)
         gbtwo(60,8) = -((usdi*gradz)/(arpla*tpi))*(26./68.)
         call gradgf(ineg,0,arpla,zepla,1.717,-0.78,gradx,gradz)
         gbtwo(60,7) = gbtwo(60,7)+((usdi*gradx)/(arpla*tpi))*(42./68.)
         gbtwo(60,8) = gbtwo(60,8)-((usdi*gradz)/(arpla*tpi))*(42./68.)
         call gradgf(ineg,0,arpla,zepla,1.754,-0.78,gradx,gradz)
         gbtwo(60,7) = gbtwo(60,7)-((usdi*gradx)/(arpla*tpi))
         gbtwo(60,8) = gbtwo(60,8)+((usdi*gradz)/(arpla*tpi))
c     
      endif
c     
      return
      end
c     
c     
c     
c     
c     
c     
c     
c     
      subroutine current
      include 'fbtmgams.inc'
      include 'mga.inc'
c     
c----------------currents at end of time step---------------------
c     
      print *,'current:tone,ttwo',tone,ttwo
      if(if36fb.eq.1)  bphbacq =  bzeroe(1)/1.43
      if(if36fb.eq.-1) bphbacq = -bzeroe(1)/1.43
c     
      if(midplan.ne.8) then
         mau = nvvel+5
         mat = nvvel+4
         m1  = nvvel+1
         m2  = nvvel+2
         m3  = nvvel+3
         m4  = nvvel+4
         do 6220 i=1,nvvel
            ip = i+nshafa
            do 6210 j=1,nvvel
               jp = j+nshafa
               a1(i,j) = elss(ip,jp)
               a2(i,j) = elss(ip,jp)
               if(i.eq.j)      a1(i,j) = a1(i,j)+deltat*resis(jp)
 6210       continue
 6220    continue
         do 6222 j=1,nvvel
            jp = j+nshafa
            do i=1,4
               a1(nvvel+i,j) = gbtwo(jp,i)
            enddo
 6222    continue
         do 6224 i=1,nvvel
            ip = i+nshafa
            a1(i,m1) = elss(mu1,ip)
            a1(i,m2) = elss(mu2,ip)
            a1(i,m3) = elss(mu3,ip)
            a1(i,m4) = elss(mu4,ip)
 6224    continue
         do i=1,4
            mx = nvvel+i
            a1(mx,m1) = gbtwo(mu1,i)
            a1(mx,m2) = gbtwo(mu2,i)
            a1(mx,m3) = gbtwo(mu3,i)
            a1(mx,m4) = gbtwo(mu4,i)
         enddo
c     
         do 6226 i=1,nvvel
            ip = i+nshafa
            v10(i) = vecone(ip)
 6226    continue
c     
         call mulmv(a2,nvvel,nvvel,v10,nvvel,v11)
c     
         do 6230 i=1,nvvel
            ip = i+nshafa
            v11(i) = v11(i) - elpvtwo(ip)*aiptwo + elpvone(ip)*aipone
            do 6228 j=1,nshafa
               v11(i) = v11(i) - elss(j,ip)*(vectwo(j)-vecone(j))
 6228       continue
 6230    continue
         if(midplan.eq.3) then
            v11(m1) = bzptwo - 0.00015*bphbacq
            v11(m2) = brptwo + 0.00042*bphbacq
            v11(m3) = bzmtwo - 0.00015*bphbacq
            v11(m4) = brmtwo + 0.00042*bphbacq
         endif
         if(midplan.eq.1) then
            v11(m1) = bzptwo + 0.00021*bphbacq
            v11(m2) = brptwo + 0.00069*bphbacq
            v11(m3) = bzmtwo + 0.00021*bphbacq
            v11(m4) = brmtwo + 0.00069*bphbacq
         endif
         if(midplan.eq.37) then
            v11(m1) = bzptwo + 0.00086*bphbacq
            v11(m2) = brptwo + 0.00091*bphbacq
            v11(m3) = bzmtwo + 0.00086*bphbacq
            v11(m4) = brmtwo + 0.00091*bphbacq
c     if(iprmax.eq.2) then
c     v11(m1) = bzptwo + 0.00086*bphbacq + 0.0021
c     v11(m2) = brptwo + 0.00091*bphbacq + 0.0005
c     v11(m3) = bzmtwo + 0.00086*bphbacq + 0.0020
c     v11(m4) = brmtwo + 0.00091*bphbacq + 0.0005
c     endif
         endif
         print *,'bzp,brp,bzm,brm',bzptwo,brptwo,bzmtwo,brmtwo
         print *,'v11',v11(m1),v11(m2),v11(m3),v11(m4)
         do 6232 n=1,nshafa
            do i=1,4
               mx = nvvel+i
               v11(mx) = v11(mx) - gbtwo(n,i)*vectwo(n)
               print *,'gb,vectwo',n,i,gbtwo(n,i),vectwo(n)
            enddo
 6232    continue
         print *,'v11',v11(m1),v11(m2),v11(m3),v11(m4)
         do 6234 i=1,mat
            a1(i,mau) = v11(i)
 6234    continue
         call primat('A1        ',a1,100000.,mat,mau)
c     
         call gauss(mat,a1,v12)
c     
         do 6236 j=1,nvvel
            vectwo(j+nshafa) = v12(j)
            print *,'V12(J) Iv',it,j,v12(j)
 6236    continue
         vectwo(mu1) = v12(m1)
         vectwo(mu2) = v12(m2)
         vectwo(mu3) = v12(m3)
         vectwo(mu4) = v12(m4)
         print *,'V12(M1..M4)',it,m1,m2,m3,m4,mu1,mu2,mu3,mu4,v12(m1),v12(m2),v12(m3),v12(m4)                      
      endif
c     
      if(midplan.eq.8) then
         mau = nvvel+9
         mat = nvvel+8
         m1  = nvvel+1
         m2  = nvvel+2
         m3  = nvvel+3
         m4  = nvvel+4
         m5  = nvvel+5
         m6  = nvvel+6
         m7  = nvvel+7
         m8  = nvvel+8
         do 6240 i=1,nvvel
            ip = i+nshafa
            do 6238 j=1,nvvel
               jp = j+nshafa
               a1(i,j) = elss(ip,jp)
               a2(i,j) = elss(ip,jp)
               if(i.eq.j)      a1(i,j) = a1(i,j)+deltat*resis(jp)
 6238       continue
 6240    continue
         do 6242 j=1,nvvel
            jp = j+nshafa
            do i=1,8
               a1(nvvel+i,j) = gbtwo(jp,i)
            enddo
 6242    continue
         do 6244 i=1,nvvel
            ip = i+nshafa
            a1(i,m1) = elss(mu1,ip)
            a1(i,m2) = elss(mu2,ip)
            a1(i,m3) = elss(mu3,ip)
            a1(i,m4) = elss(mu4,ip)
            a1(i,m5) = elss(mu5,ip)
            a1(i,m6) = elss(mu6,ip)
            a1(i,m7) = elss(mu7,ip)
            a1(i,m8) = elss(mu8,ip)
 6244    continue
         do i=1,8
            mx = nvvel+i
            a1(mx,m1) = gbtwo(mu1,i)
            a1(mx,m2) = gbtwo(mu2,i)
            a1(mx,m3) = gbtwo(mu3,i)
            a1(mx,m4) = gbtwo(mu4,i)
            a1(mx,m5) = gbtwo(mu5,i)
            a1(mx,m6) = gbtwo(mu6,i)
            a1(mx,m7) = gbtwo(mu7,i)
            a1(mx,m8) = gbtwo(mu8,i)
         enddo
         do 6246 i=1,nvvel
            ip = i+nshafa
            v10(i) = vecone(ip)
 6246    continue
c     
         call mulmv(a2,nvvel,nvvel,v10,nvvel,v11)
c     
         do 6250 i=1,nvvel
            ip = i+nshafa
            if(iplatop.eq.0)  v11(i) = v11(i)
     1           -0.5*aiptwo*(elpvtwo(ip)+elptwob(ip))
     2           +0.5*aipone*(elpvone(ip)+elponeb(ip))
            if(iplatop.eq.1)  v11(i) = v11(i)
     1           -aiptwo*elpvtwo(ip) + aipone*elpvone(ip)
            if(iplatop.eq.-1) v11(i) = v11(i)
     1           -aiptwo*elptwob(ip) + aipone*elponeb(ip)
            do 6248 j=1,nshafa
               v11(i) = v11(i) - elss(j,ip)*(vectwo(j)-vecone(j))
 6248       continue
 6250    continue
c     v11(m1) = bzptwo  - 0.000298*bphbacq
c     v11(m2) = brptwo  + 0.000286*bphbacq
c     v11(m3) = bzmtwo  - 0.000282*bphbacq
c     v11(m4) = brmtwo  + 0.000283*bphbacq
c     v11(m5) = bzptwob + 0.001467*bphbacq
c     v11(m6) = brptwob + 0.001002*bphbacq
c     v11(m7) = bzmtwob + 0.001453*bphbacq
c     v11(m8) = brmtwob + 0.000946*bphbacq
         v11(m1) = bzptwo  - gbtwo(60,1)*65000.*bphbacq
         v11(m2) = brptwo  - gbtwo(60,2)*65000.*bphbacq
         v11(m3) = bzmtwo  - gbtwo(60,3)*65000.*bphbacq
         v11(m4) = brmtwo  - gbtwo(60,4)*65000.*bphbacq
         v11(m5) = bzptwob - gbtwo(60,5)*65000.*bphbacq
         v11(m6) = brptwob - gbtwo(60,6)*65000.*bphbacq
         v11(m7) = bzmtwob - gbtwo(60,7)*65000.*bphbacq
         v11(m8) = brmtwob - gbtwo(60,8)*65000.*bphbacq
         do 6252 n=1,nshafa
            do i=1,8
               mx = nvvel+i
               v11(mx) = v11(mx) - gbtwo(n,i)*vectwo(n)
            enddo
 6252    continue
         do 6254 i=1,mat
            a1(i,mau) = v11(i)
 6254    continue
c     
         call gauss(mat,a1,v12)
c     
         do 6256 j=1,nvvel
            vectwo(j+nshafa) = v12(j)
 6256    continue
         vectwo(mu1) = v12(m1)
         vectwo(mu2) = v12(m2)
         vectwo(mu3) = v12(m3)
         vectwo(mu4) = v12(m4)
         vectwo(mu5) = v12(m5)
         vectwo(mu6) = v12(m6)
         vectwo(mu7) = v12(m7)
         vectwo(mu8) = v12(m8)
      endif
c     
      do 6375 ii=1,2
         if(ii.eq.1) arpla=artwo+deltar
         if(ii.eq.2) arpla=artwo-deltar
         zepla = zetwo
         do 6373 k=1,ngroup
            dexk = 0.
            ifi = isvf(k)
            ila = isvl(k)
            do 6372 i=ifi,ila
               call gradgf(ineg,0,arpla,zepla,rvf(i),zvf(i),gradx,gradz)
               dexk = dexk-(tvf(i)*usdi*gradx)/(arpla*tpi)
 6372       continue
            if(ii.eq.1) v11(k) = dexk
            if(ii.eq.2) v12(k) = dexk
 6373    continue
 6375 continue
      bzplus = 0.
      bzminu = 0.
      do 6378 j=1,ngroup
         bzplus = bzplus + v11(j)*vectwo(j)
         bzminu = bzminu + v12(j)*vectwo(j)
 6378 continue
      bzmean = 0.5*(bzplus+bzminu)
      entwo = ((bzplus-bzminu)*artwo)/(2.*deltar*bzmean)
c     
      vloop = 0.
      do 6380 i=1,ngroup
         vloop = vloop - elpvtwo(i)*((vectwo(i)-vecone(i))/deltat)
 6380 continue
c     
      vescur = 0.
      do 6385 i=1,nvvel
         vescur = vescur + vectwo(i+nshafa)
 6385 continue
c     
      return
      end
c     
c     
c     
c     
c     
c     
c     
c     
      subroutine diagnos
      include 'fbtmgams.inc'
      include 'mga.inc'
c     
c-------------------breakdown fields at time=f36same---------------
c     
      do n=1,nvvel
         k = n+nshafa
         hvvel = 0.
         ifi = isvf(k)
         ila = isvl(k)
         do i=ifi,ila
            hvvel = hvvel+hvf(i)
         enddo
         amlsw(1,n,6)=vectwo(k)/hvvel
         if(n.le.18) amlsw(2,n,6)=vectwo(n)
         amlsw(3,n,6)=vectwo(k)
      enddo
c     
c-------------decoupled current measurement-two currents-----------------
c     
      do k=1,2
         do j=1,40
            do i=1,39
               a1(i,j) = 0.
            enddo
         enddo
         do j=1,38
            a1(j,j) = 1.
            if(midplan.ne.8)
     1           call gradgf(ineg,0,rbee(j),zbee(j),0.86,0.23,gradx,gradz)
            if(midplan.eq.8)
     1           call gradgf(ineg,0,rbee(j),zbee(j),0.86,0.40,gradx,gradz)
            gtop = (usdi*(gradz*coth(j)-gradx*sith(j)))/(rbee(j)*tpi)
            if(midplan.ne.8)
     1           call gradgf(ineg,0,rbee(j),zbee(j),0.86,-.23,gradx,gradz)
            if(midplan.eq.8)
     1           call gradgf(ineg,0,rbee(j),zbee(j),0.86,-.40,gradx,gradz)
            gbot = (usdi*(gradz*coth(j)-gradx*sith(j)))/(rbee(j)*tpi)
            if(k.eq.2) then
               gint = gbot
               gbot = gtop
               gtop = gint
            endif
            a1(39,j) = gbot
            a1(j,39) = gbot
            v11(j)   = gtop
            a1(j,40) = gtop
         enddo
c     a1(39,37) = 0.
c     a1(37,39) = 0.
c     v11(37)   = 0.
c     a1(37,40) = 0.
         call gauss(39,a1,v12)
         coef = 0.
         do j=1,38
            coef = coef + v11(j)*v12(j)
         enddo
         do j=1,38
            amlsw(3+k,j,6) = v12(j)/coef
         enddo
c     
         call mulvm(v12,nprob,dex,nprob,18,v11)
         do j=1,18
            amlsw(5+k,j,6) = v11(j)/coef
         enddo
c     
      enddo
c---------------------------three currents----------------------------
      do k=1,3
         do j=1,41
            do i=1,40
               a1(i,j) = 0.
            enddo
         enddo
         do j=1,38
            a1(j,j) = 1.
            call gradgf(ineg,0,rbee(j),zbee(j),0.78,0.40,gradx,gradz)
            gee1 = (usdi*(gradz*coth(j)-gradx*sith(j)))/(rbee(j)*tpi)
            call gradgf(ineg,0,rbee(j),zbee(j),0.78,-.40,gradx,gradz)
            gee2 = (usdi*(gradz*coth(j)-gradx*sith(j)))/(rbee(j)*tpi)
            call gradgf(ineg,0,rbee(j),zbee(j),0.78,0.00,gradx,gradz)
            gee3 = (usdi*(gradz*coth(j)-gradx*sith(j)))/(rbee(j)*tpi)
            if(k.eq.1) hee1 = gee1
            if(k.eq.1) hee2 = gee2
            if(k.eq.1) hee3 = gee3
            if(k.eq.2) hee1 = gee2
            if(k.eq.2) hee2 = gee3
            if(k.eq.2) hee3 = gee1
            if(k.eq.3) hee1 = gee3
            if(k.eq.3) hee2 = gee1
            if(k.eq.3) hee3 = gee2
            a1(39,j) = hee2
            a1(j,39) = hee2
            a1(40,j) = hee3
            a1(j,40) = hee3
            v11(j)   = hee1
            a1(j,41) = hee1
         enddo
c     a1(39,37) = 0.
c     a1(37,39) = 0.
c     a1(40,37) = 0.
c     a1(37,40) = 0.
c     v11(37)   = 0.
c     a1(37,41) = 0.
         call gauss(40,a1,v12)
         coef = 0.
         do j=1,38
            coef = coef + v11(j)*v12(j)
         enddo
         do j=1,38
            amlsw(7+k,j,6) = v12(j)/coef
         enddo
c     
         call mulvm(v12,nprob,dex,nprob,18,v11)
         do j=1,18
            amlsw(10+k,j,6) = v11(j)/coef
         enddo
c     
      enddo
c     
c------------------------four currents-------------------------------
c     do k=1,4
c     do j=1,42
c     do i=1,41
c     a1(i,j) = 0.
c     enddo
c     enddo
c     do j=1,38
c     a1(j,j) = 1.
c     call gradgf(ineg,0,rbee(j),zbee(j),0.75,0.53,gradx,gradz)
c     gee1 = (usdi*(gradz*coth(j)-gradx*sith(j)))/(rbee(j)*tpi)
c     call gradgf(ineg,0,rbee(j),zbee(j),1.01,0.53,gradx,gradz)
c     gee2 = (usdi*(gradz*coth(j)-gradx*sith(j)))/(rbee(j)*tpi)
c     call gradgf(ineg,0,rbee(j),zbee(j),0.75,0.27,gradx,gradz)
c     gee3 = (usdi*(gradz*coth(j)-gradx*sith(j)))/(rbee(j)*tpi)
c     call gradgf(ineg,0,rbee(j),zbee(j),1.01,0.27,gradx,gradz)
c     gee4 = (usdi*(gradz*coth(j)-gradx*sith(j)))/(rbee(j)*tpi)
c     if(k.eq.1) then
c     hee1 = gee1
c     hee2 = gee2
c     hee3 = gee3
c     hee4 = gee4
c     endif
c     if(k.eq.2) then
c     hee1 = gee2
c     hee2 = gee3
c     hee3 = gee4
c     hee4 = gee1
c     endif
c     if(k.eq.3) then
c     hee1 = gee3
c     hee2 = gee4
c     hee3 = gee1
c     hee4 = gee2
c     endif
c     if(k.eq.4) then
c     hee1 = gee4
c     hee2 = gee1
c     hee3 = gee2
c     hee4 = gee3
c     endif
c     a1(39,j) = hee2
c     a1(j,39) = hee2
c     a1(40,j) = hee3
c     a1(j,40) = hee3
c     a1(41,j) = hee4
c     a1(j,41) = hee4
c     v11(j)   = hee1
c     a1(j,42) = hee1
c     enddo
c     call gauss(41,a1,v12)
c     coef = 0.
c     do j=1,38
c     coef = coef + v11(j)*v12(j)
c     enddo
c     do j=1,38
c     amlsw(k,j,5) = v12(j)/coef
c     enddo
c     
c     amlsw(k,1,4) = amlsw(k,1,5)
c     do j=2,38
c     amlsw(k,j,4) = amlsw(k,40-j,5)
c     enddo
c     
c     call mulvm(v12,nprob,dex,nprob,18,v11)
c     do j=1,38
c     amlsw(4+k,j,5) = v11(j)/coef
c     enddo
c     
c     v11(1) = v12(1)
c     do j=2,38
c     v11(j) = v12(40-j)
c     enddo
c     call mulvm(v11,nprob,dex,nprob,18,v12)
c     do j=1,38
c     amlsw(4+k,j,4) = v12(j)/coef
c     enddo
c     
c     enddo
      if(midplan.eq.8) then
         do j=1,38
            amlsw(14,j,6) = gp(1,j)+gp(7,j)
            amlsw(15,j,6) = gp(2,j)+gp(8,j)
            amlsw(16,j,6) = dep(1,j)+dep(7,j)
            amlsw(17,j,6) = dep(2,j)+dep(8,j)
         enddo
      endif
c---------------tow currents on top or bottom---------------------------
      do k=1,4
         do j=1,40
            do i=1,39
               a1(i,j) = 0.
            enddo
         enddo
         do j=1,38
            a1(j,j) = 1.
            if(midplan.ne.8) then
               call gradgf(ineg,0,rbee(j),zbee(j),0.75,0.23,gradx,gradz)
               gee1 = (usdi*(gradz*coth(j)-gradx*sith(j)))/(rbee(j)*tpi)
               call gradgf(ineg,0,rbee(j),zbee(j),1.01,0.23,gradx,gradz)
               gee2 = (usdi*(gradz*coth(j)-gradx*sith(j)))/(rbee(j)*tpi)
            endif
            if(midplan.eq.8) then
               call gradgf(ineg,0,rbee(j),zbee(j),0.75,0.40,gradx,gradz)
               gee1 = (usdi*(gradz*coth(j)-gradx*sith(j)))/(rbee(j)*tpi)
               call gradgf(ineg,0,rbee(j),zbee(j),1.01,0.40,gradx,gradz)
               gee2 = (usdi*(gradz*coth(j)-gradx*sith(j)))/(rbee(j)*tpi)
            endif
            if(midplan.ne.8) then
               call gradgf(ineg,0,rbee(j),zbee(j),0.75,-.23,gradx,gradz)
               gee3 = (usdi*(gradz*coth(j)-gradx*sith(j)))/(rbee(j)*tpi)
               call gradgf(ineg,0,rbee(j),zbee(j),1.01,-.23,gradx,gradz)
               gee4 = (usdi*(gradz*coth(j)-gradx*sith(j)))/(rbee(j)*tpi)
            endif
            if(midplan.eq.8) then
               call gradgf(ineg,0,rbee(j),zbee(j),0.75,-.40,gradx,gradz)
               gee3 = (usdi*(gradz*coth(j)-gradx*sith(j)))/(rbee(j)*tpi)
               call gradgf(ineg,0,rbee(j),zbee(j),1.01,-.40,gradx,gradz)
               gee4 = (usdi*(gradz*coth(j)-gradx*sith(j)))/(rbee(j)*tpi)
            endif
            if(k.eq.1) hee1 = gee1
            if(k.eq.1) hee2 = gee2
            if(k.eq.2) hee1 = gee2
            if(k.eq.2) hee2 = gee1
            if(k.eq.3) hee1 = gee3
            if(k.eq.3) hee2 = gee4
            if(k.eq.4) hee1 = gee4
            if(k.eq.4) hee2 = gee3
            a1(39,j) = hee2
            a1(j,39) = hee2
            v11(j)   = hee1
            a1(j,40) = hee1
         enddo
c     a1(39,37) = 0.
c     a1(37,39) = 0.
c     v11(37)   = 0.
c     a1(37,40) = 0.
         call gauss(39,a1,v12)
         coef = 0.
         do j=1,38
            coef = coef + v11(j)*v12(j)
         enddo
         do j=1,38
            amlsw(k,j,5) = v12(j)/coef
         enddo
c     
         call mulvm(v12,nprob,dex,nprob,18,v11)
         do j=1,18
            amlsw(4+k,j,5) = v11(j)/coef
         enddo
c     
      enddo
c---------------------------------------------------------------------
      rstep = (1.14-0.62)/19.
      zstep = 1.5/39.
      do m=1,20
         do n=1,40
            amlsw(m,n,7)  = 0.
            amlsw(m,n,8)  = 0.
            amlsw(m,n,9)  = 0.
            arpla = 0.62 + float(m-1)*rstep
            zepla = -0.75 + float(n-1)*zstep
            do k = 1,ngroup
               dexk = 0.
               deyk = 0.
               dezk = 0.
               ifi = isvf(k)
               ila = isvl(k)
               do i=ifi,ila
                  call gf(ineg,0,arpla,zepla,rvf(i),zvf(i),ans)
                  call gradgf(ineg,0,arpla,zepla,rvf(i),zvf(i),gradx,gradz)
                  dexk = dexk-(tvf(i)*usdi*gradx)/(arpla*tpi)
                  deyk = deyk+(tvf(i)*usdi*gradz)/(arpla*tpi)
                  dezk = dezk+ ans*tvf(i)*usdi
               enddo
               tobofac=1.
               if(((k-nshafa).ge.8).and.((k-nshafa).le.14))
     1              tobofac=1.+float(ilarg)/100.
               if(((k-nshafa).ge.26).and.((k-nshafa).le.32))
     1              tobofac=1.+float(ilarg)/100.
               if(((k-nshafa).ge.15).and.((k-nshafa).le.25))
     1              tobofac=1.+float(iwrida)/100.
               amlsw(m,n,7)  = amlsw(m,n,7)  + dezk*(vectwo(k)/tobofac)
               amlsw(m,n,8)  = amlsw(m,n,8)  + dexk*(vectwo(k)/tobofac)
               amlsw(m,n,9)  = amlsw(m,n,9)  + deyk*(vectwo(k)/tobofac)
            enddo
            call gf(ineg,0,arpla,zepla,1.554,-0.78,ans)
            call gradgf(ineg,0,arpla,zepla,1.554,-0.78,gradx,gradz)
            dexk = -(usdi*gradx)/(arpla*tpi)
            deyk = +(usdi*gradz)/(arpla*tpi)
            dezk = ans*usdi
            amlsw(m,n,7)  = amlsw(m,n,7)  - dezk*65000.*(26./68.)*bphbacq
            amlsw(m,n,8)  = amlsw(m,n,8)  - dexk*65000.*(26./68.)*bphbacq
            amlsw(m,n,9)  = amlsw(m,n,9)  - deyk*65000.*(26./68.)*bphbacq
            call gf(ineg,0,arpla,zepla,1.717,-0.78,ans)
            call gradgf(ineg,0,arpla,zepla,1.717,-0.78,gradx,gradz)
            dexk = -(usdi*gradx)/(arpla*tpi)
            deyk = +(usdi*gradz)/(arpla*tpi)
            dezk = ans*usdi
            amlsw(m,n,7)  = amlsw(m,n,7)  - dezk*65000.*(42./68.)*bphbacq
            amlsw(m,n,8)  = amlsw(m,n,8)  - dexk*65000.*(42./68.)*bphbacq
            amlsw(m,n,9)  = amlsw(m,n,9)  - deyk*65000.*(42./68.)*bphbacq
            call gf(ineg,0,arpla,zepla,1.754,-0.78,ans)
            call gradgf(ineg,0,arpla,zepla,1.754,-0.78,gradx,gradz)
            dexk = -(usdi*gradx)/(arpla*tpi)
            deyk = +(usdi*gradz)/(arpla*tpi)
            dezk = ans*usdi
            amlsw(m,n,7)  = amlsw(m,n,7)  + dezk*65000.*bphbacq
            amlsw(m,n,8)  = amlsw(m,n,8)  + dexk*65000.*bphbacq
            amlsw(m,n,9)  = amlsw(m,n,9)  + deyk*65000.*bphbacq
         enddo
      enddo
c     
c--------------------------backoff currents------------------------
c     
      if(midplan.eq.3) then
         rbi = 0.62
         rbo = 1.12
         zbl = -.50
         zbu = 0.50
      endif
      if(midplan.eq.1) then
         rbi = 0.62
         rbo = 0.92
         zbl = -.15
         zbu = 0.15
      endif
      if(midplan.eq.37) then
         rbi = 0.62
         rbo = 1.12
         zbl = -.50
         zbu = 0.50
      endif
      if(midplan.eq.8) then
         rbi = 0.62
         rbo = 0.92
         zbl = 0.
         zbu = 0.60
      endif
c     
      kopt = 4
      nopt(1) = moh1
      nopt(2) = moh2
      nopt(3) = moh3
      nopt(4) = moh4
c     
      if(midplan.eq.8) then
         kopt = 12
         nopt(1) = 1
         nopt(2) = 2
         nopt(3) = 3
         nopt(4) = 4
         nopt(5) = 5
         nopt(6) = 6
         nopt(7) = 7
         nopt(8) = 8
         nopt(9) = 9
         nopt(10)= 11
         nopt(11)= 14
         nopt(12)= 16
      endif
c     
      do i=1,24
         ropt(i) = rbi+float(i-1)*((rbo-rbi)/23.)
      enddo
c     
      do j=1,24
         zopt(j) = zbl+float(j-1)*((zbu-zbl)/23.)
      enddo
c     
      if(midplan.eq.8) then
         do j=1,12
            zopt(j) = zbl+float(j-1)*((zbu-zbl)/11.)
            zopt(j+12) = -zopt(j)
         enddo
      endif
c     
      do i=1,24
         do j=1,24
            do k=1,kopt
               n = nopt(k)
               gzijk = 0.
               grijk = 0.
               ifi = isvf(n)
               ila = isvl(n)
               do ii=ifi,ila
                  call gradgf(ineg,0,ropt(i),zopt(j),rvf(ii),zvf(ii),gradx,gradz)
                  gzijk = gzijk-(tvf(ii)*usdi*gradx)/(ropt(i)*tpi)
                  grijk = grijk+(tvf(ii)*usdi*gradz)/(ropt(i)*tpi)
               enddo
               g1sw(i,j,k) = gzijk
               g2sw(i,j,k) = grijk
            enddo
         enddo
      enddo
c     
      do k1=1,kopt
         do k2=1,kopt
            a1opt = 0.
            do i=1,24
               do j=1,24
                  a1opt = a1opt + g1sw(i,j,k1)*g1sw(i,j,k2)
     1                 + g2sw(i,j,k1)*g2sw(i,j,k2)
               enddo
            enddo
            a1(k1,k2) = a1opt
            a4(k1,k2) = a1opt
         enddo
      enddo
c     
c----------------------------------oh coil-------------------------
c     
      do i=1,24
         do j=1,24
            a2(i,j) = 0.
            a3(i,j) = 0.
            do n=17,18
               gzoh = 0.
               groh = 0.
               ifi = isvf(n)
               ila = isvl(n)
               do ii=ifi,ila
                  call gradgf(ineg,0,ropt(i),zopt(j),rvf(ii),zvf(ii),gradx,gradz)
                  gzoh = gzoh-(tvf(ii)*usdi*gradx)/(ropt(i)*tpi)
                  groh = groh+(tvf(ii)*usdi*gradz)/(ropt(i)*tpi)
               enddo
               a2(i,j) = a2(i,j) + gzoh*vectwo(n)
               a3(i,j) = a3(i,j) + groh*vectwo(n)
            enddo
         enddo
      enddo
c     
      do k=1,kopt
         a1(k,kopt+1) = 0.
         do i=1,24
            do j=1,24
               a1(k,kopt+1) = a1(k,kopt+1)
     1              - a2(i,j)*g1sw(i,j,k) - a3(i,j)*g2sw(i,j,k)
            enddo
         enddo
      enddo
c     
      call gauss(kopt,a1,v12)
      print 6388,(nopt(k),k=1,kopt)
 6388 format(29h oh-backoff currents in coils,10i4)
      print 6389,(v12(k),k=1,kopt)
 6389 format(10f7.1)
c     
c-------------------------------vessel-----------------------------
c     
      do k1=1,kopt
         do k2=1,kopt
            a1(k1,k2) = a4(k1,k2)
         enddo
      enddo
c     
      do i=1,24
         do j=1,24
            a2(i,j) = 0.
            a3(i,j) = 0.
            do k=1,nvvel
               n=k+nshafa
               gzve = 0.
               grve = 0.
               ifi = isvf(n)
               ila = isvl(n)
               do ii=ifi,ila
                  call gradgf(ineg,0,ropt(i),zopt(j),rvf(ii),zvf(ii),gradx,gradz)
                  gzve = gzve-(tvf(ii)*usdi*gradx)/(ropt(i)*tpi)
                  grve = grve+(tvf(ii)*usdi*gradz)/(ropt(i)*tpi)
               enddo
               a2(i,j) = a2(i,j) + gzve*vectwo(n)
               a3(i,j) = a3(i,j) + grve*vectwo(n)
            enddo
         enddo
      enddo
c     
      do k=1,kopt
         a1(k,kopt+1) = 0.
         do i=1,24
            do j=1,24
               a1(k,kopt+1) = a1(k,kopt+1)
     1              - a2(i,j)*g1sw(i,j,k) - a3(i,j)*g2sw(i,j,k)
            enddo
         enddo
      enddo
c     
      call gauss(kopt,a1,v12)
      print 6390,(nopt(k),k=1,kopt)
 6390 format(33h vessel-backoff currents in coils,10i4)
      print 6391,(v12(k),k=1,kopt)
 6391 format(10f7.1)
c     
      return
      end
c     
c     
c     
c     
c     
c     
c     
c     
      subroutine wavgen1
      include 'fbtmgams.inc'
      include 'mga.inc'
c     
c----------------------------coil voltages-------------------------
c----------resistive voltage is normally added through the M-matrix
c----------and is not included in the feedforward voltages
      do 6393 n=1,ngroup
         v10(n) = vectwo(n) - vecone(n)
 6393 continue
      call mulmv(elss,nshafa,ngroup,v10,ngroup,v11)
      do 6394 j=1,nshafa
         if(midplan.ne.8) then
            v11(j) = v11(j) + elpvtwo(j)*aiptwo - elpvone(j)*aipone
         endif
         if(midplan.eq.8) then
            if(iplatop.eq.0)  v11(j) = v11(j)
     1           +0.5*aiptwo*(elpvtwo(j)+elptwob(j))
     2           -0.5*aipone*(elpvone(j)+elponeb(j))
            if(iplatop.eq.1)  v11(j) = v11(j)
     1           +aiptwo*elpvtwo(j) - aipone*elpvone(j)
            if(iplatop.eq.-1) v11(j) = v11(j)
     1           +aiptwo*elptwob(j) - aipone*elponeb(j)
         endif
c---------------------------------------
c     1                + (0.5*deltat*resis(j)*(vectwo(j)+vecone(j)))
c     v11(j) = v11(j) + (0.5*deltat*resis(j)*(vectwo(j)+vecone(j)))
c---------------------------------------
         v11(j) = v11(j)/deltat
 6394 continue
c     
c------------------------wavegen traces---------------------------
c     
      tevol(it) = ttwo
      do 6401 n=1,nshafa
         volts(n,it) = v11(n)
         amps(n,it)  = vectwo(n)
 6401 continue
      write (*,*) 'AMPS1 = ',ttwo,amps(17,it)
c     
c----------fluxes and fields for times less than zero--------------
      tswitch = 0.01
      do k=1,38
         if(ttwo.le.tswitch) then
            fluxpre = 0.
            beepre  = 0.
            do n=1,ngroup
               if(n.le.nshafa) then
                  fluxpre = fluxpre - gx(k,n)*vectwo(n)
                  beepre  = beepre  + dex(k,n)*vectwo(n)
               endif
               if(n.gt.nshafa) then
                  fluxpre = fluxpre - gx(k,n)*vectwo(n)*resis(n)
                  beepre  = beepre  + dex(k,n)*vectwo(n)*resis(n)
               endif
            enddo
         endif
         if(ttwo.le.0.) then
            fluxxx(k) = fluxpre
            beexx(k)  = beepre
            dpsfact   = 1.
         endif
         if((ttwo.gt.0.).and.(ttwo.le.tswitch)) then
            tfra  = ttwo/tswitch
            fluxxx(k) = fluxpre + tfra*(fluxtwo(k)-fluxpre)
            beexx(k)  = beepre + tfra*(beetwo(k)-beepre)
            dpsfact   = 1. + tfra*(dpsfac-1.)
         endif
         if(ttwo.gt.tswitch) then
            fluxxx(k) = fluxtwo(k)
            beexx(k)  = beetwo(k)
            dpsfact   = dpsfac
         endif
      enddo
c     
      if(midplan.ne.8) then
c     
         aipzcor = 0.
         aipzco3 = 0.
         aipzco4 = 0.
c     Coil correction for vertical observer (in case kappa feedback is used)
c     removed (SC, 26/05/04)
c     
c     Coil correction allowed for inova=3 or 4 (SC, 31/03/05)
         if(inova.ne.3.and.inova.ne.4) then
            do n=1,16
               aipzcor = aipzcor - vectwo(n)*a4ipz(n)
            enddo
         endif
c     Ohcorr correction disabled for time < 0 (when vertical control is inactive
c     anyway) to avoid triggering disruption detector (SC, 16/02/05)
         if(ttwo.gt.0.) then
            if(inova.ne.3.and.inova.ne.4) then
               aipzcor = aipzcor - vectwo(17)*a4ipz(17)*(1.-ohcorr)
               aipzcor = aipzcor - vectwo(18)*a4ipz(18)*(1.+ohcorr)
            else
c     
c     Coil correction allowed for inova=3 or 4 (SC, 31/03/05)
               aipzcor = aipzcor - vectwo(17)*a4ipz(17)*(-ohcorr)
               aipzcor = aipzcor - vectwo(18)*a4ipz(18)*ohcorr
            endif
         endif
c     
         do n=1,nvvel
            k = n+nshafa
            aipzcor = aipzcor - vectwo(k)*resis(k)*a4ipz(k)
         enddo
         print *,'AIPZCOR',ttwo,aipzcor
         if(ikriz.eq.2.or.nfast.eq.0) then
c     if(ikriz.eq.2) then
c     
c     No coil correction in derivative feedback (SC, 31/03/05)
            do n=1,16
c     inova=4 option introduced (SC, 21/04/05)
               if(inova.ne.4) then
                  aipzco3 = aipzco3 - vectwo(n)*a4ipz3(n)
               else
                  aipzco3 = aipzco3 - vectwo(n)*a4ipz(n)
                  aipzco4 = aipzco4 - vectwo(n)*a4ipz3(n)
               endif
            enddo
c     Ohcorr correction disabled for time < 0 (when vertical control is inactive
c     anyway) to avoid triggering disruption detector (SC, 16/02/05)
            if(ttwo.gt.0.) then
               if(inova.ne.4) then
                  aipzco3 = aipzco3 - vectwo(17)*a4ipz3(17)*(1.-ohcorr)
                  aipzco3 = aipzco3 - vectwo(18)*a4ipz3(18)*(1.+ohcorr)
               else
                  aipzco3 = aipzco3 - vectwo(17)*a4ipz(17)*(1.-ohcorr)
                  aipzco3 = aipzco3 - vectwo(18)*a4ipz(18)*(1.+ohcorr)
                  aipzco4 = aipzco4 - vectwo(17)*a4ipz3(17)*(1.-ohcorr)
                  aipzco4 = aipzco4 - vectwo(18)*a4ipz3(18)*(1.+ohcorr)
               endif
            endif
c     
            do n=1,nvvel
               k = n+nshafa
               if(inova.ne.4) then
                  aipzco3 = aipzco3 - vectwo(k)*resis(k)*a4ipz3(k)
               else
                  aipzco3 = aipzco3 - vectwo(k)*resis(k)*a4ipz(k)
                  aipzco4 = aipzco4 - vectwo(k)*resis(k)*a4ipz3(k)
               endif
            enddo
         endif
c     
c-------------------------reference check---------------------------
c     aipzch = 0.
c     do k=1,38
c     aipzch = aipzch - a2ipz(k)*fluxxx(k) + a3ipz(k)*beexx(k)
c     enddo
c     print 6403,aipzch,aipzcor
c     6403 format(8h aipzch=,e12.5,9h aipzcor=,e12.5)
c     
         if(ttwo.le.0.) aipsss=0.
         if(ttwo.gt.0.) aipsss=5000.
         aipscal = aiptwo*1.0e-6
c     
c-----------------------------wobble--------------------------------
c     
         tofla  = toft(nflat)
         wobble = 0.
         wobfreq = abs(float(ipripz))
         if (zshift(2).eq.0.) zshift(2)=tofla
         if (zshift(3).eq.0.) zshift(3)=toft(nflat1)
c     if((ttwo.gt.tofla).and.(ttwo.le.toft(nflat1))) then
         if((ttwo.gt.zshift(2)).and.(ttwo.le.zshift(3))) then
            if (ipripz.ge.0) then
               if(sin((ttwo-tofla)*tpi*wobfreq).gt.0.)    wobble=1.
               if(sin((ttwo-tofla)*tpi*wobfreq).lt.0.)    wobble=-1.
            else
               wobble=sin((ttwo-zshift(2))*tpi*wobfreq)
            endif
         endif
         zeecor = wobble*zshift(1) + zeecorr
c     
c-------------------------------------------------------------------
c     
         zeec = aipscal*aipscal*zeecor + (zetwo-zax(nzaxre))*aiptwo
c     UNTRANSLATED
         amps(nshafa+8,it) = (zetwo*aiptwo-zeone*aipone)/deltat
c     END UNTRANSLATED
c     if(aiptwo.lt.100000.) aipzcc=aipscal*10.0*aipzcor
c     if(aiptwo.ge.100000.) aipzcc=aipzcor
         aipzcc=aipzcor
         amps(nshafa+1,it) = delipz + aipsss*aipipz + zeec - aipzcc
c     UNTRANSLATED
         if(ikriz.eq.2.or.nfast.eq.0) then
c     if(ikriz.eq.2) then
c     END UNTRANSLATED
            amps(nshafa+3,it) = delipz + aipsss*aipipz + zeec - aipzco3
c     inova=4 option introduced (SC, 21/04/05)
            if(inova.eq.4)
     1           amps(nshafa+7,it) = delipz + aipsss*aipipz + zeec - aipzco4
         endif
c-------------delpsi for time less than toft(nip) -------------------
c     if(ttwo.le.toft(nip)) then
c     fluximo  = 0.
c     beei     = 0.
c     beeo     = 0.
c     do n=1,ngroup
c     gximo    = gx(midplad,n) - gx(midout,n)
c     if(n.gt.nshafa) gximo=gximo*resis(n)
c     fluximo  = fluximo - gximo*vectwo(n)
c------------------------minus sign because gx produces negative fluxes
c     dexi     = dex(midplad,n)
c     if(n.gt.nshafa) dexi=dexi*resis(n)
c     beei     = beei + dexi*vectwo(n)
c     dexo     = dex(midout,n)
c     if(n.gt.nshafa) dexo=dexo*resis(n)
c     beeo     = beeo + dexo*vectwo(n)
c     enddo
c     dpstlz   = fluximo + beei*gapin*rbee(midplad)*tpi
c     1                         - beeo*gapout*rbee(midout)*tpi
c     2                         + dpszero
c     dpstwo   = dpstlz
c     endif
c     if((ttwo.gt.toft(nip)).and.(ttwo.le.toft(nip10))) then
c     tfra = (ttwo-toft(nip))/(toft(nip10)-toft(nip))
c     dpstwo = dpstlz+(delpsi(1)*dpsfac)*(tfra**1.78)
c     endif
c     
         dpstwo = (fluxxx(midplad) - fluxxx(midout)
     1        + (beexx(midplad)*gapin*rbee(midplad)*tpi)
     2        - (beexx(midout)*gapout*rbee(midout)*tpi))*dpsfact
     3        + dpszero
c     
         tfra   = (ttwo-toft(nip))/(toft(nend)-toft(nip))
         rshift = rshift1 + tfra*(rshift2-rshift1)
         amps(nshafa+2,it)=-dpstwo*psifac+(aiptwo*1.0e-6)*rshift*psifac
     1        +     (aiptwo*1.0e-6)*(aiptwo*1.0e-6)*rshift3*psifac
c     
      endif
c     
      if(midplan.eq.8) then
         if(ttwo.le.0.) aipsss=0.
         if(ttwo.gt.0.) aipsss=5000.
         aipzb = 0.
         aipzt = 0.
         aipzdb = 0.
         aipzdt = 0.
         aipzm = 0.
         aipb  = 0.
         aipt  = 0.
         do k=1,38
            aipzb = aipzb - rampt*a2ipzb(k)*fluxxx(k)
     1           + (1.-rampt)*a3ipzb(k)*beexx(k)
            aipzt = aipzt - rampt*a2ipzt(k)*fluxxx(k)
     1           + (1.-rampt)*a3ipzt(k)*beexx(k)
c     aipzdb = aipzdb + a3ipzb(k)*beexx(k)
c     aipzdt = aipzdt + a3ipzt(k)*beexx(k)
            aipzm = aipzm - rampt*a2ipz(k)*fluxxx(k)
     1           + (1.-rampt)*a3ipz(k)*beexx(k)
c     aipb  = aipb+v4b(k)*fluxtwo(k)+v5b(k)*beetwo(k)
c     aipt  = aipt+v4t(k)*fluxtwo(k)+v5t(k)*beetwo(k)
         enddo
c     do n=1,nshafa
c     aipb  = aipb-v6b(n)*vectwo(n)
c     aipt  = aipt-v6t(n)*vectwo(n)
c     enddo
c     if(aipb.lt.0.) then
c     aipb = 0.
c     aipt = aiptwo
c     endif
c     if(aipt.lt.0.) then
c     aipt = 0.
c     aipb = aiptwo
c     endif
c     aipscab = aipb*1.0e-6
c     aipscat = aipt*1.0e-6
         aipscal = aiptwo*1.0e-6
c     zeecb   = aipscab*aipscab*zeecorr
c     zeect   = aipscat*aipscat*zeecorr
c     
         zeecb = -aipscal*aipscal*zeecorr
         zeect = aipscal*aipscal*zeecorr
c     
c     if(aipscab.gt.0.40) zeecb=0.40*aipscab*zeecorr
c     if(aipscat.gt.0.40) zeect=0.40*aipscat*zeecorr
         amps(nshafa+1,it) = delipz + aipsss*aipipz + zeect + aipzt
         amps(nshafa+3,it) = -delipz + aipsss*aipipz + zeecb + aipzb
c     Ohcorr correction disabled for time < 0 (when vertical control is inactive
c     anyway) to avoid triggering disruption detector (SC, 16/02/05)
         if(ttwo.gt.0.) then
            amps(nshafa+1,it) = amps(nshafa+1,it)
     1           + ohcorr*aipscal*aipscal*vectwo(17)
            amps(nshafa+3,it) = amps(nshafa+3,it)
     1           + ohcorr*aipscal*aipscal*vectwo(17)
         endif
c     
         amps(nshafa+5,it) = aipzm
c     amps(nshafa+7,it) = aipzdb
c     amps(nshafa+8,it) = aipzdt
c     if(ttwo.le.toft(nip)) then
c     fluximo  = 0.
c     beei     = 0.
c     beeo     = 0.
c     do n=1,ngroup
c     gximo    = gx(midplat,n) - gx(midoutt,n)
c     if(n.gt.nshafa) gximo=gximo*resis(n)
c     fluximo  = fluximo - gximo*vectwo(n)
c------------------------minus sign because gx produces negative fluxes
c     dexi     = dex(midplat,n)
c     if(n.gt.nshafa) dexi=dexi*resis(n)
c     beei     = beei + dexi*vectwo(n)
c     dexo     = dex(midoutt,n)
c     if(n.gt.nshafa) dexo=dexo*resis(n)
c     beeo     = beeo + dexo*vectwo(n)
c     enddo
c     dpstlzt  = fluximo + beei*gapin*rbee(midplat)*tpi
c     1                         - beeo*gapout*rbee(midoutt)*tpi
c     2                         + dpszero
c     dpstwot  = dpstlzt
c     endif
c     if((ttwo.gt.toft(nip)).and.(ttwo.le.toft(nip10))) then
c     tfra = (ttwo-toft(nip))/(toft(nip10)-toft(nip))
c     dpstwot = dpstlzt+(delpsit(1)*dpsfac)*(tfra**1.78)
c     endif
c     
         dpstwot = (fluxxx(midplat) - fluxxx(midoutt)
     1        + (beexx(midplat)*gapin*rbee(midplat)*tpi)
     2        - (beexx(midoutt)*gapout*rbee(midoutt)*tpi))*dpsfact
     3        + dpszero
c     
         tfra   = (ttwo-toft(nip))/(toft(nend)-toft(nip))
         rshift = rshift1 + tfra*(rshift2-rshift1)
         amps(nshafa+2,it)=-dpstwot*psifac+(aiptwo*1.0e-6)*rshift*psifac
     1        +     (aiptwo*1.0e-6)*(aiptwo*1.0e-6)*rshift3*psifac
c     
c     if(ttwo.le.toft(nip)) then
c     fluximo  = 0.
c     beei     = 0.
c     beeo     = 0.
c     do n=1,ngroup
c     gximo    = gx(midplab,n) - gx(midoutb,n)
c     if(n.gt.nshafa) gximo=gximo*resis(n)
c     fluximo  = fluximo - gximo*vectwo(n)
c------------------------minus sign because gx produces negative fluxes
c     dexi     = dex(midplab,n)
c     if(n.gt.nshafa) dexi=dexi*resis(n)
c     beei     = beei + dexi*vectwo(n)
c     dexo     = dex(midoutb,n)
c     if(n.gt.nshafa) dexo=dexo*resis(n)
c     beeo     = beeo + dexo*vectwo(n)
c     enddo
c     dpstlzb  = fluximo + beei*gapin*rbee(midplab)*tpi
c     1                         - beeo*gapout*rbee(midoutb)*tpi
c     2                         + dpszero
c     dpstwob  = dpstlzb
c     endif
c     if((ttwo.gt.toft(nip)).and.(ttwo.le.toft(nip10))) then
c     tfra = (ttwo-toft(nip))/(toft(nip10)-toft(nip))
c     dpstwob  = dpstlzb+(delpsib(1)*dpsfac)*(tfra**1.78)
c     endif
c     
         dpstwob = (fluxxx(midplab) - fluxxx(midoutb)
     1        + (beexx(midplab)*gapin*rbee(midplab)*tpi)
     2        - (beexx(midoutb)*gapout*rbee(midoutb)*tpi))*dpsfact
     3        + dpszero
c     
         tfra   = (ttwo-toft(nip))/(toft(nend)-toft(nip))
         rshift = rshift1 + tfra*(rshift2-rshift1)
         amps(nshafa+4,it)=-dpstwob*psifac+(aiptwo*1.0e-6)*rshift*psifac
     1        +     (aiptwo*1.0e-6)*(aiptwo*1.0e-6)*rshift3*psifac
      endif
c     
c     Added kappa reference correctors (SC, 14/05/04)
      aipzs = gainext(2) + abs(aipscal)*gainext(3)
      print *,'AIPZS-T',ttwo,aipzs
      if (ifour.lt.20) then
         do k=1,38
            aipzs = aipzs - a2ipzs(k)*fluxtwo(k) + a3ipzs(k)*beetwo(k)
            print *,'AIPZS',k,a2ipzs(k),fluxtwo(k),a3ipzs(k),beetwo(k)
         enddo
      else
         if (mod(ifour,10).eq.5) then
            aipzs = aipzs+(zetwo-zax(nzaxre))*(zetwo-zax(nzaxre))*aiptwo
         else if (mod(ifour,10).eq.4) then
            aipzs = aipzs+abs(zetwo-zax(nzaxre))*aiptwo
         else if (mod(ifour,10).eq.6) then
c     This is not implemented yet, needs fluxerr (?)
            aipzs = aipzs
         end if
      end if
c     
c     Added the possibility of subtracting coil + vessel current corrections
c     (SC, 13/05/04)
c     
      if (ifour.ge.10.and.ifour.lt.20) then
         do k=1,nshafa
            aipzs = aipzs - a4ipzs(k)*vectwo(k)
         enddo
c     do n=1,nvvel
c     k=n+nshafa
c     aipzs = aipzs - a4ipzs(k)*vectwo(k)*resis(k)
c     enddo
      end if
      if (ifour.ge.20.and.ifour.lt.30) then
         do k=1,nshafa
            aipzs = aipzs + a4ipzs(k)*vectwo(k)
         enddo
c     do n=1,nvvel
c     k=n+nshafa
c     aipzs = aipzs + a4ipzs(k)*vectwo(k)*resis(k)
c     enddo
      end if
c     
      amps(nshafa+6,it) = aipzs
c     
c-----------------------------print results--------------------------
c     
      if(midplan.ne.8) go to 6411
      if(it.eq.1) then
         itp = 0
         print 6409
 6409    format(5h ttwo,7x,5h aipb,7x,5h aipt,7x,10h aipt+aipb,2x,
     1        7h aiptwo)
         go to 6411
      endif
      itp = itp + 1
      if(itp.ge.20) then
         print 6410,ttwo,aipb,aipt,aipt+aipb,aiptwo,aipzt,aipzb
 6410    format(7e11.4)
         itp = 0
      endif
 6411 continue
      ttwop   = ttwo*1000.
      aiptwop = aiptwo/1000.
      ohctwop = vectwo(17)/1000.
      vescurp = vescur/1000.
      bztwop  = (bzptwo+bzmtwo)*5000.
      bznowp  = bzmean*10000.
      e45twop = vectwo(4)/1000.
      f36twop = vectwo(11)/1000.
      f27twop = vectwo(10)/1000.
      f45twop = vectwo(12)/1000.
c     if(midplan.ne.8) then
      print 6500, ttwop,aiptwop,ohctwop,vescurp,bztwop,bznowp,entwo,
     1     e45twop,f36twop,f27twop,f45twop,vloop
c     endif
 6500 format(1x,f5.0,f7.2,f7.3,f7.2,2f6.0,f7.1,4f7.3,f6.2)
      return
      end
c     
c     
c     
c     
c     
c     
c     
c     
      subroutine wavgen2
      include 'fbtmgams.inc'
      include 'mga.inc'
c     
      do j=1,nshafa+8
         if(j.le.nshafa) then
            volts(j,1) = 0.
            volts(j,2) = volts(j,2)*0.03
            volts(j,3) = volts(j,3)*0.12
            volts(j,4) = volts(j,4)*0.24
            volts(j,5) = volts(j,5)*0.37
            volts(j,6) = volts(j,6)*0.50
            volts(j,7) = volts(j,7)*0.63
            volts(j,8) = volts(j,8)*0.76
            volts(j,9) = volts(j,9)*0.88
            volts(j,10)= volts(j,10)*0.97
         endif
         if(j.lt.nshafa-1.or.j.gt.nshafa) then
            amps(j,1)  = 0.
            amps(j,2)  = amps(j,2)*0.03
            amps(j,3)  = amps(j,3)*0.12
            amps(j,4)  = amps(j,4)*0.24
            amps(j,5)  = amps(j,5)*0.37
            amps(j,6)  = amps(j,6)*0.50
            amps(j,7)  = amps(j,7)*0.63
            amps(j,8)  = amps(j,8)*0.76
            amps(j,9)  = amps(j,9)*0.88
            amps(j,10) = amps(j,10)*0.97
         endif
      enddo
c     
      do iuu=1,40
         write (*,*) 'AMPS17 = ', tevol(iuu), amps(17,iuu)
      enddo
      toh(1)     = tevol(1)
      n=2
      do i=3,itmax,2
         if(tevol(i).gt.(toft(2)-0.02)) go to 7000
         toh(n)     = tevol(i)
         do j=1,nshafa+8
            if(j.le.nshafa) volts(j,n) =
     1           (volts(j,i-1)+2.*volts(j,i)+volts(j,i+1))/4.
            amps(j,n)  = (amps(j,i-1)+2.*amps(j,i)+amps(j,i+1))/4.
         enddo
         n=n+1
         write (*,*) 'NEWAMPS17 = ', toh(n),amps(17,n)
      enddo
 7000 istart=i
      do i=istart,itmax
         if(tevol(i).gt.(toft(nip10+4))) go to 7001
         toh(n)     = tevol(i)
         do j=1,nshafa+8
            if(j.le.nshafa) volts(j,n) = (volts(j,i-2)+2.*volts(j,i-1)
     1           +2.*volts(j,i)+2.*volts(j,i+1)+volts(j,i+2))/8.
            amps(j,n)  = (amps(j,i-1)+2.*amps(j,i)+amps(j,i+1))/4.
         enddo
         n=n+1
      enddo
 7001 istart=i
      do i=istart,itmax-1,3
         toh(n)     = tevol(i)
         do j=1,nshafa+8
            if(j.le.nshafa) volts(j,n) =
     1           (volts(j,i-2)+2.*volts(j,i-1)+3.*volts(j,i)
     1           +2.*volts(j,i+1)+volts(j,i+2))/9.
c     UNTRANSLATED
            if((j.ne.nshafa+1).or.(zshift(1).eq.0.))
     1           amps(j,n) = (amps(j,i-2)+2.*amps(j,i-1)+3.*amps(j,i)
     1           +2.*amps(j,i+1)+amps(j,i+2))/9.
            if((j.eq.nshafa+1).and.(zshift(1).ne.0.))
     1           amps(j,n)  = amps(j,i)
c     END UNTRANSLATED
         enddo
         n=n+1
      enddo
      noht=n-1
c     
c     
      do n=1,ntoft
         ohcur(n) = 0.
      enddo
c     
c     
      do n=1,noht
         do k=1,18
            efvolt(n,k) = 0.
         enddo
      enddo
c     
      do n=2,noht
         do k=1,18
            efvolt(n,k) = volts(k,n)
         enddo
      enddo
c     
c     
      bphback = 0.
      do n=2,noht
         do k=1,17
            efcur(n,k) = amps(k,n)
         enddo
         zeref(n)  = amps(nshafa+1,n)
         arref(n)  = amps(nshafa+2,n)
         zerefb(n) = amps(nshafa+3,n)
         arrefb(n) = amps(nshafa+4,n)
         zerefm(n) = amps(nshafa+5,n)
         cayref(n) = amps(nshafa+6,n)
c     if(midplan.eq.8) then
c     efwave(n,17) = amps(nshafa+7,n)
c     efwave(n,18) = amps(nshafa+8,n)
c     endif
         do k=1,16
            efwave(n,k) = efcur(n,k)
         enddo
         if(midplan.ne.8) then
            efwave(n,18) = arref(n)
            if(iscramb.eq.1) then
               efwave(n,mu3) = 0.5*(efcur(n,mu3)-efcur(n,mu4))
               efwave(n,mu4) = 0.5*(efcur(n,mu3)+efcur(n,mu4))
            endif
            if(iscramb.eq.2) then
               efwave(n,moh1) = 0.5*(efcur(n,moh1)-efcur(n,mu3))
               efwave(n,moh4) = 0.5*(efcur(n,moh4)-efcur(n,mu4))
               efwave(n,mu3)  = 0.5*(efcur(n,moh1)+efcur(n,mu3))
               efwave(n,mu4)  = 0.5*(efcur(n,moh4)+efcur(n,mu4))
            endif
c     New coil combination for snowflake TOP-4 coils (FP, 05/02/09)
            if(iscramb.eq.61) then
               efwave(n,13)   = 0.5*(efcur(n,13)-efcur(n,14))
               efwave(n,16)   = 0.5*(efcur(n,16)-efcur(n,15))
               efwave(n,14)   = 0.5*(efcur(n,13)+efcur(n,14))
               efwave(n,15)   = 0.5*(efcur(n,16)+efcur(n,15))
            endif
c     New coil combination for snowflake BOT-4 coils (FP, 05/02/09)
            if(iscramb.eq.62) then
               efwave(n,11)   = 0.5*(efcur(n,11)-efcur(n,12))
               efwave(n,14)   = 0.5*(efcur(n,14)-efcur(n,13))
               efwave(n,12)   = 0.5*(efcur(n,11)+efcur(n,12))
               efwave(n,13)   = 0.5*(efcur(n,14)+efcur(n,13))
            endif
c     New coil combination for lower snowflake BOT-4 coils (SC, 22/04/16)
            if(iscramb.eq.63) then
               efwave(n,10)   = 0.5*(efcur(n,10)-efcur(n,11))
               efwave(n,14)   = 0.5*(efcur(n,14)-efcur(n,13))
               efwave(n,11)   = 0.5*(efcur(n,10)+efcur(n,11))
               efwave(n,13)   = 0.5*(efcur(n,14)+efcur(n,13))
            endif
            if(iscramb.eq.7) then
               efwave(n,11)   = 0.5*(efcur(n,11)-efcur(n,12))
               efwave(n,15)   = 0.5*(efcur(n,15)-efcur(n,14))
               efwave(n,12)   = 0.5*(efcur(n,11)+efcur(n,12))
               efwave(n,14)   = 0.5*(efcur(n,15)+efcur(n,14))
            endif
c     New coil combination for small plasmas (SC, 06/09/04)
            if(iscramb.eq.36) then
               efwave(n,14)   = 0.25*(-efcur(n,11)-efcur(n,12)
     1              +efcur(n,13)+efcur(n,14))
               efwave(n,12)   = 0.25*(+efcur(n,11)+efcur(n,12)
     1              +efcur(n,13)+efcur(n,14))
               efwave(n,13)   = 0.25*(-efcur(n,11)+efcur(n,12)
     1              +efcur(n,13)-efcur(n,14))
               efwave(n,11)   = 0.25*(+efcur(n,11)-efcur(n,12)
     1              +efcur(n,13)-efcur(n,14))
            endif
c     New coil combination for small plasmas (SC, 03/09/04)
            if(iscramb.eq.8) then
               efwave(n,12)   = 0.25*(efcur(n,12)-efcur(n,13)
     1              +efcur(n,14)-efcur(n,15))
               efwave(n,15)   = 0.25*(efcur(n,12)*omal-efcur(n,13)*opal
     1              -efcur(n,14)*opal+efcur(n,15)*omal)*ompsq
               efwave(n,13)   = 0.25*(-efcur(n,12)-efcur(n,13)
     1              +efcur(n,14)+efcur(n,15))
               efwave(n,14)   = 0.25*(efcur(n,12)*opal+efcur(n,13)*omal
     1              +efcur(n,14)*omal+efcur(n,15)*opal)*ompsq
            endif
c     New coil combination for small plasmas at the top (SC, 18/01/05)
            if(iscramb.eq.10) then
               efwave(n,13)   = 0.25*(efcur(n,13)-efcur(n,14)
     1              +efcur(n,15)-efcur(n,16))
               efwave(n,16)   = 0.25*(efcur(n,13)*omal-efcur(n,14)*opal
     1              -efcur(n,15)*opal+efcur(n,16)*omal)*ompsq
               efwave(n,14)   = 0.25*(-efcur(n,13)-efcur(n,14)
     1              +efcur(n,15)+efcur(n,16))
               efwave(n,15)   = 0.25*(efcur(n,13)*opal+efcur(n,14)*omal
     1              +efcur(n,15)*omal+efcur(n,16)*opal)*ompsq
            endif
c     New coil combination for smallish plasmas at the top (SC, 19/03/13)
            if(iscramb.eq.11) then
               efwave(n,12)   = 0.25*(efcur(n,12)-efcur(n,13)
     1              +efcur(n,15)-efcur(n,16))
               efwave(n,16)   = 0.25*(efcur(n,12)*omal-efcur(n,13)*opal
     1              -efcur(n,15)*opal+efcur(n,16)*omal)*ompsq
               efwave(n,13)   = 0.25*(-efcur(n,12)-efcur(n,13)
     1              +efcur(n,15)+efcur(n,16))
               efwave(n,15)   = 0.25*(efcur(n,12)*opal+efcur(n,13)*omal
     1              +efcur(n,15)*omal+efcur(n,16)*opal)*ompsq
            endif
            if((iscramb.eq.12).or.(iscramb.eq.22)) then
               efwave(n,moh1) = ( efcur(n,moh1) +efcur(n,mu3)
     1              +efcur(n,moh2) +efcur(n,moh3)
     1              +efcur(n,mu4)  +efcur(n,moh4))/6.
               efwave(n,mu3)  = (-efcur(n,moh1) +efcur(n,mu3)
     1              -efcur(n,mu4)  +efcur(n,moh4))/4.
               efwave(n,moh2) = (-efcur(n,moh2) +efcur(n,moh3))/2.
               efwave(n,moh3) = (-efcur(n,moh1) -efcur(n,mu3)
     1              +efcur(n,mu4)  +efcur(n,moh4))/4.
               efwave(n,mu4)  = ( efcur(n,moh1) +efcur(n,moh2)
     1              +efcur(n,moh3) +efcur(n,moh4))/6.
     1              -( efcur(n,mu3)  +efcur(n,mu4))/3.
               efwave(n,moh4) = ( efcur(n,moh1) -efcur(n,moh2)
     1              -efcur(n,moh3) +efcur(n,moh4))/4.
            endif
c     
c     New coil combination for small plasmas (SC, 03/09/04)
            if(iscramb.eq.19) then
               efwave(n,12) = ( efcur(n,12)*omal +efcur(n,11)*opal
     1              +efcur(n,13)*omal+efcur(n,14)*omal
     1              +efcur(n,16)*opal+efcur(n,15)*omal)/6.*ompsq2
               efwave(n,11)  = (-efcur(n,12) +efcur(n,11)
     1              -efcur(n,16)  +efcur(n,15))/4.
               efwave(n,13) = (-efcur(n,13) +efcur(n,14))/2.
               efwave(n,14) = (-efcur(n,12) -efcur(n,11)
     1              +efcur(n,16)  +efcur(n,15))/4.
               efwave(n,16)  = (( efcur(n,12)+efcur(n,13)
     1              +efcur(n,14)+efcur(n,15))*opal/6.
     1              -( efcur(n,11)  +efcur(n,16))*omal/3.)*ompsq2
               efwave(n,15) = ( efcur(n,12) -efcur(n,13)
     1              -efcur(n,14) +efcur(n,15))/4.
            endif
c     New coil combination (SC, 03/09/04)
            if(iscramb.eq.15) then
               efwave(n,12) = ( efcur(n,12)*omal +efcur(n,11)*omal
     1              +efcur(n,10)*opal+efcur(n,16)*opal
     1              +efcur(n,15)*omal+efcur(n,14)*omal)/6.*ompsq2
               efwave(n,11)  = (-efcur(n,12) +efcur(n,11)
     1              -efcur(n,15)  +efcur(n,14))/4.
               efwave(n,10) = (-efcur(n,10) +efcur(n,16))/2.
               efwave(n,16) = (-efcur(n,12) -efcur(n,11)
     1              +efcur(n,15)  +efcur(n,14))/4.
               efwave(n,15)  = ( efcur(n,12)*omal*omal +efcur(n,10)*omal*opal
     1              +efcur(n,16)*omal*opal +efcur(n,14)*omal*omal
     1              -(efcur(n,11)  +efcur(n,15))*(omal*omal+opal*opal))/6.
     1              *ompsq3
               efwave(n,14) = ( efcur(n,12)*opal -efcur(n,10)*omal
     1              -efcur(n,16)*omal +efcur(n,14)*opal)/4.*ompsq
            endif
c     New coil combination (SC, 03/09/04)
            if(iscramb.eq.16) then
               efwave(n,12) = ( efcur(n,12)*omal +efcur(n,11)*omal
     1              +efcur(n,10)*opal+efcur(n,15)*opal
     1              +efcur(n,14)*omal+efcur(n,13)*omal)/6.*ompsq2
               efwave(n,11)  = (-efcur(n,12) +efcur(n,11)
     1              -efcur(n,14)  +efcur(n,13))/4.
               efwave(n,10) = (-efcur(n,10) +efcur(n,15))/2.
               efwave(n,15) = (-efcur(n,12) -efcur(n,11)
     1              +efcur(n,14)  +efcur(n,13))/4.
               efwave(n,14)  = ( efcur(n,12)*omal*omal +efcur(n,10)*omal*opal
     1              +efcur(n,15)*omal*opal +efcur(n,13)*omal*omal
     1              -(efcur(n,11)  +efcur(n,14))*(omal*omal+opal*opal))/6.
     1              *ompsq3
               efwave(n,13) = ( efcur(n,12)*opal -efcur(n,10)*omal
     1              -efcur(n,15)*omal +efcur(n,13)*opal)/4.*ompsq
            endif
c     New coil combination (SC, 03/09/04)
            if(iscramb.eq.25) then
               efwave(n,12) = ( efcur(n,12)*omal +efcur(n,11)*omal
     1              +efcur(n,10)*opal+efcur(n,16)*opal
     1              +efcur(n,15)*omal+efcur(n,14)*omal)/6.*ompsq2
               efwave(n,11)  = (efcur(n,12) -efcur(n,11) +efcur(n,10)
     1              -efcur(n,16)+efcur(n,15)-efcur(n,14))/6.
               efwave(n,10)  = (-efcur(n,12) +efcur(n,11) +2.*efcur(n,10)
     1              -2.*efcur(n,16)-efcur(n,15)+efcur(n,14))/6.
               efwave(n,16) = (-efcur(n,12) -efcur(n,11)
     1              +efcur(n,15)  +efcur(n,14))/4.
               efwave(n,15)  = ((efcur(n,10)+efcur(n,12)+efcur(n,14)
     1              +efcur(n,16))*omal
     1              -(efcur(n,11)+efcur(n,15))*(omal+opal))/6.*ompsq3
               efwave(n,14) = ( efcur(n,12) -efcur(n,10)
     1              -efcur(n,16)+efcur(n,14))/4.
            endif
c     New coil combination (SC, 03/09/04)
            if(iscramb.eq.26) then
               efwave(n,12) = ( efcur(n,12)*omal +efcur(n,11)*omal
     1              +efcur(n,10)*opal+efcur(n,15)*opal
     1              +efcur(n,14)*omal+efcur(n,13)*omal)/6.*ompsq2
               efwave(n,11)  = (efcur(n,12) -efcur(n,11) +efcur(n,10)
     1              -efcur(n,15)+efcur(n,14)-efcur(n,13))/6.
               efwave(n,10)  = (-efcur(n,12) +efcur(n,11) +2.*efcur(n,10)
     1              -2.*efcur(n,15)-efcur(n,14)+efcur(n,13))/6.
               efwave(n,15) = (-efcur(n,12) -efcur(n,11)
     1              +efcur(n,14)  +efcur(n,13))/4.
               efwave(n,14)  = ((efcur(n,10)+efcur(n,12)+efcur(n,13)
     1              +efcur(n,15))*omal
     1              -(efcur(n,11)+efcur(n,14))*(omal+opal))/6.*ompsq3
               efwave(n,13) = ( efcur(n,12) -efcur(n,10)
     1              -efcur(n,15)+efcur(n,13))/4.
            endif
c     
            if((iscramb.eq.3).or.(iscramb.eq.13)) then
c     New coil combination for the case zax<0 (SC, 17/02/05)
               if(zax(nzaxre).ge.0..or.iscramb.eq.13) then
                  efwave(n,11) =   0.25*(+efcur(n,10)*omal    -efcur(n,12)*opal
     1                 -efcur(n,14)*opal    +efcur(n,16)*omal)*ompsq
                  efwave(n,10) =   0.25*(-efcur(n,11)    +efcur(n,10)
     1                 +efcur(n,15)    -efcur(n,16))
                  efwave(n,12) =   0.25*(+efcur(n,10)*opal    +efcur(n,12)*omal
     1                 +efcur(n,14)*omal    +efcur(n,16)*opal)*ompsq
                  efwave(n,14) =    0.5*(-efcur(n,12)    +efcur(n,14))
                  efwave(n,15) =    0.5*(+efcur(n,11)    +efcur(n,15))
                  efwave(n,16) =   0.25*(-efcur(n,11)    -efcur(n,10)
     1                 +efcur(n,15)    +efcur(n,16))
               else
                  efwave(n,10) =   0.25*(+efcur(n,9)*omal    -efcur(n,11)*opal
     1                 -efcur(n,13)*opal    +efcur(n,15)*omal)*ompsq
                  efwave(n,9) =   0.25*(-efcur(n,10)    +efcur(n,9)
     1                 +efcur(n,14)    -efcur(n,15))
                  efwave(n,11) =   0.25*(+efcur(n,9)*opal    +efcur(n,11)*omal
     1                 +efcur(n,13)*omal    +efcur(n,15)*opal)*ompsq
                  efwave(n,13) =    0.5*(-efcur(n,11)    +efcur(n,13))
                  efwave(n,14) =    0.5*(+efcur(n,10)    +efcur(n,14))
                  efwave(n,15) =   0.25*(-efcur(n,10)    -efcur(n,9)
     1                 +efcur(n,14)    +efcur(n,15))
               endif
            endif
            if(iscramb.eq.13) then
               efwave(n,2)  =    0.5*(+efcur(n,2)     -efcur(n,8))
               efwave(n,4)  =    0.5*(+efcur(n,4)     -efcur(n,6))
               efwave(n,6)  =   0.25*(+efcur(n,2)     +efcur(n,4)
     1              +efcur(n,6)     +efcur(n,8))
               efwave(n,8)  =   0.25*(+efcur(n,2)     -efcur(n,4)
     1              -efcur(n,6)     +efcur(n,8))
     1              -(alpha/4.)*(efcur(n,10)    +efcur(n,12)
     1              +efcur(n,14)    +efcur(n,16))
               efwave(n,12) =   0.25*(+efcur(n,10)    +efcur(n,12)
     1              +efcur(n,14)    +efcur(n,16))
     1              +(alpha/4.)*(+efcur(n,2)     -efcur(n,4)
     1              -efcur(n,6)     +efcur(n,8))
            endif
            if((iscramb.eq.4).or.(iscramb.eq.14)) then
               efwave(n,9)  =   0.25*(+efcur(n,10)    -efcur(n,11)
     1              -efcur(n,14)    +efcur(n,15))
               efwave(n,10) =   0.25*(-efcur(n,9)     +efcur(n,10)
     1              -efcur(n,15)    +efcur(n,16))
               efwave(n,11) =   0.25*(+efcur(n,10)    +efcur(n,11)
     1              +efcur(n,14)    +efcur(n,15))
               efwave(n,14) =    0.5*(-efcur(n,11)    +efcur(n,14))
               efwave(n,15) =    0.5*(+efcur(n,9)     +efcur(n,16))
               efwave(n,16) =   0.25*(-efcur(n,9)     -efcur(n,10)
     1              +efcur(n,15)    +efcur(n,16))
            endif
            if(iscramb.eq.14) then
               efwave(n,1)  =    0.5*(+efcur(n,1)     -efcur(n,8))
               efwave(n,4)  =    0.5*(+efcur(n,4)     -efcur(n,5))
               efwave(n,5)  =   0.25*(+efcur(n,1)     +efcur(n,4)
     1              +efcur(n,5)     +efcur(n,8))
               efwave(n,8)  =   0.25*(+efcur(n,1)     -efcur(n,4)
     1              -efcur(n,5)     +efcur(n,8))
     1              -(alpha/4.)*(efcur(n,10)    +efcur(n,11)
     1              +efcur(n,14)    +efcur(n,15))
               efwave(n,11) =   0.25*(+efcur(n,10)    +efcur(n,11)
     1              +efcur(n,14)    +efcur(n,15))
     1              +(alpha/4.)*(+efcur(n,1)     -efcur(n,4)
     1              -efcur(n,5)     +efcur(n,8))
            endif
            if(iscramb.eq.5) then
               efwave(n,11) =   0.25*(-efcur(n,10)*omal    +efcur(n,12)*opal
     1              +efcur(n,14)*opal    -efcur(n,16)*omal)*ompsq
               efwave(n,10) =   0.25*(-efcur(n,11)    +efcur(n,12)
     1              +efcur(n,15)    -efcur(n,14))
               efwave(n,12) =   0.25*(+efcur(n,10)*opal    +efcur(n,12)*omal
     1              +efcur(n,14)*omal    +efcur(n,16)*opal)*ompsq
               efwave(n,14) =    0.5*(-efcur(n,10)    +efcur(n,16))
               efwave(n,15) =    0.5*(+efcur(n,11)    +efcur(n,15))
               efwave(n,16) =   0.25*(-efcur(n,11)    -efcur(n,12)
     1              +efcur(n,15)    +efcur(n,14))
            endif
            if(iscramb.eq.6) then
               efwave(n,9)  =   0.25*(-efcur(n,9)*omal    +efcur(n,11)*opal
     1              +efcur(n,14)*opal    -efcur(n,16)*omal)*ompsq
               efwave(n,11) =   0.25*(efcur(n,11)    -efcur(n,12)
     1              +efcur(n,13)    -efcur(n,14))
               efwave(n,12) =   0.25*(+efcur(n,9)*opal    +efcur(n,11)*omal
     1              +efcur(n,14)*omal    +efcur(n,16)*opal)*ompsq
               efwave(n,13) =    0.5*(-efcur(n,9)    +efcur(n,16))
               efwave(n,14) =    0.5*(+efcur(n,12)    +efcur(n,13))
               efwave(n,16) =   0.25*(-efcur(n,11)    -efcur(n,12)
     1              +efcur(n,13)    +efcur(n,14))
            endif
c     New coil combination for small plasmas (SC, 03/09/04)
            if(iscramb.eq.9) then
               efwave(n,11)  =   0.25*(+efcur(n,12)*omal-efcur(n,13)*opal
     1              -efcur(n,14)*opal+efcur(n,15)*omal)*ompsq
               efwave(n,12) =   0.25*(-efcur(n,11)     +efcur(n,12)
     1              -efcur(n,15)    +efcur(n,16))
               efwave(n,13) =   0.25*(+efcur(n,12)*opal+efcur(n,13)*omal
     1              +efcur(n,14)*omal+efcur(n,15)*opal)*ompsq
               efwave(n,14) =    0.5*(-efcur(n,13)    +efcur(n,14))
               efwave(n,15) =    0.5*(+efcur(n,11)     +efcur(n,16))
               efwave(n,16) =   0.25*(-efcur(n,11)     -efcur(n,12)
     1              +efcur(n,15)    +efcur(n,16))
            endif
         endif
c     
         if(midplan.eq.8) then
            efwave(n,20)=zeref(n)
            efwave(n,22)=zerefb(n)
            efwave(n,23)=arrefb(n)
            efwave(n,18)=arref(n)
            efwave(n,9) =
     1           .540*efcur(n,9)-.580*efcur(n,12)+.264*efcur(n,13)-.064*efcur(n,16)
            efwave(n,12)=
     1           .226*efcur(n,9)+.908*efcur(n,12)-.765*efcur(n,13)+.212*efcur(n,16)
            efwave(n,13)=
     1           .212*efcur(n,9)-.765*efcur(n,12)+.908*efcur(n,13)+.226*efcur(n,16)
            efwave(n,16)=
     1           .064*efcur(n,9)-.264*efcur(n,12)+.580*efcur(n,13)-.540*efcur(n,16)
         endif
         if(ikriz.eq.2.or.nfast.eq.0) then
c     if(ikriz.eq.2) then
            efwave(n,23)  = zerefb(n)
c     inova=4 option introduced (SC, 21/04/05)
            if(inova.eq.4) efwave(n,3) = amps(nshafa+7,n)
c     UNTRANSLATED
c     Uncomment to have nonzero reference for fast Ip*z observer based on
c     instantaneous probe measurements
c     if(nfast.eq.-5) efwave(n,24) = amps(nshafa+8,n)
c     END UNTRANSLATED
         endif
      enddo
c     
      print 636
 636  format(25h toft,aipoft,ohcur,dpsoft)
      do n=1,ntoft
         print 637,toft(n),aipoft(n),ohcur(n),
     1        dpsoft(n)
      enddo
 637  format(1x,7e10.3,e9.2)
      print 638
 638  format(59h th,e4ff,e4oft,f2ff,f2oft,f3ff,f6oft,f4ff,f4oft,oh1ff,oh
     1     2ff)
      do n=1,noht
         print 639,toh(n),efvolt(n,4),efcur(n,4),efvolt(n,10),efcur(n,10),
     1        efvolt(n,11),efcur(n,14),efvolt(n,12),efcur(n,12),
     1        efvolt(n,17),efvolt(n,18)
      enddo
 639  format(1x,f7.4,10f7.0)
c     
      return
      end
c     
c     
c     
c     
c     
c     
c     
c     
      subroutine mmatrix
      include 'fbtmgams.inc'
      include 'mga.inc'
c     
c-----------------------------test10 matrices --------------------
      nra = 24
      nca = 120
      nrg = 22
      ncg = 24
      nrm = 20
      ncm = 40
c-------------------------------------------------M-matrix
      do 642 k=1,nshaoh
         do 641 n=1,nshaoh
            ame(k,n) = 0.
 641     continue
         do 640 n=1,nshaoh
            ami(k,n) = 0.
 640     continue
 642  continue
c     
c--------gains, below, give maximum load_mat elements of 0.495---------
c     egain  = (0.495*650.7)/(elss(1,1)*(2020./50.))
c     fgain  = (0.495*1250.1)/(elss(9,9)*(2020./50.))
c     ohgain = (0.495*1398.6)/(elss(17,17)*(6868./50.))
c     
      do 644 n=1,nshaoh
         if((n.ge.1).and.(n.le.8))       ame(n,n) = egain*emgain
         if((n.ge.9).and.(n.le.16))      ame(n,n) = fgain*emgain
         if((n.eq.17).or.(n.eq.18))      ame(n,n) = ohgain*emgain
 644  continue
      if (iscramb.ne.0) then
c     mvloop(1)=11 or =21 (Vloop feedback) option added (SC, 23/9/03)
c     IERAT=4 case added (SC, 07/10/11)
         if((mvloop(1).eq.1).or.(mvloop(1).eq.11).or.(mvloop(1).eq.21).or.
     +        (mvloop(1).eq.2).or.(mvloop(1).eq.12).or.
     +        ierat.eq.4) ame(1,1) = 0.
c     mvloop(1)=2 (two-component IOH feedback) option added (SC, 06/04/05)
         if(mvloop(1).eq.2.or.mvloop(1).eq.12) ame(2,2) = 0.
c     mvloop(1)=5 (plasma current control by ECRH power) option added (SC, 01/11/06)
         if(mod(mvloop(1),10).eq.5) ame(1,1) = 0.
         if(mod(mvloop(1),100).eq.25) ame(2,2) = 0.
c     mvloop(1)=6 (plasma elongation control by ECRH) option added (SC, 02/11/06)
         if(mvloop(1).eq.6) then
            do imv=1,2
               if (mvloop(imv+1).ne.0) ame(imv,imv) = 0.
            enddo
            do imv=3,7
               if (mvloop(imv+1).ne.0) ame(imv+1,imv+1) = 0.
            enddo
         end if
c     inova=4 option added (SC, 25/04/05)
         if(inova.eq.4) ame(3,3)=0.
      end if
c------------------------------------compute inductive voltages
c     
      call mulmm(elss,nshaoh,nshaoh,ame,nshaoh,nshaoh,amle)
      call mulmm(elss,nshaoh,nshaoh,ami,nshaoh,nshaoh,amli)
c     
c-------------------------------------add resistive voltages
      do 711 i=1,nshaoh
         amli(i,i) = amli(i,i)+resis(i)
 711  continue
c--------------------------------scaling to show load_mat---
c     do 715 i=1,nshaoh
c     do 714 j=1,nshaoh
c     calib = 1.
c     if(i.le.8)                 calib=calib/650.7
c     if((i.gt.8).and.(i.le.16)) calib=calib/1250.1
c     if(i.gt.16)                calib=calib/1398.6
c     if(j.le.8)                 calib=calib*(2020./50.)
c     if((j.gt.8).and.(j.le.16)) calib=calib*(2020./50.)
c     if(j.gt.16)                calib=calib*(6868./50.)
c     amle(i,j) = amle(i,j)*calib
c     714 continue
c     715 continue
c     call primat('AMLE      ',amle,1.0,nshaoh,nshaoh)
c-------------------------------------------------------------------
      do 727 i=1,20
         do 726 j=1,40
            b7(i,j) = 0.
 726     continue
 727  continue
      do 729 i=1,nshaoh
         do 728 j=1,nshaoh
            b7(i,j) = amle(i,j)
            b7(i,j+nshaoh+4) = amli(i,j)
 728     continue
 729  continue
c     
c     mvloop(1)=5 (plasma current control by ECRH power) option added (SC, 01/11/06)
c     UNTRANSLATED
      if (iscramb.ne.0) then
c     END UNTRANSLATED
         if(mod(mvloop(1),10).eq.5) then
            do j=2,2*nshaoh+4
               b7(1,j) = 0.
            enddo
            b7(1,1) = 0.0343
         endif
         if(mod(mvloop(1),100).eq.25) then
            do j=1,2*nshaoh+4
               b7(2,j) = 0.
            enddo
            b7(2,2) = 0.0343
         endif
c     
c     mvloop(1)=6 (plasma elongation control by ECRH) option added (SC, 02/11/06)
         if(mvloop(1).eq.6) then
            do imv=1,7
               if (imv.lt.3) then
                  ioutch=imv
               else
                  ioutch=imv+1
               endif
               if (mvloop(imv+1).ne.0) then
                  do j=1,2*nshaoh+4
                     b7(ioutch,j) = 0.
                  enddo
c     second digit of mvloop(imv+1) defines RHVPS (1-2) or mirror (3-8)
                  if (mod(mvloop(imv+1),10).lt.3) then
                     b7(ioutch,ioutch) = 0.034
                  else
                     b7(ioutch,ioutch) = 0.143
                  endif
               endif
            enddo
         endif
c     UNTRANSLATED
      endif
c     END UNTRANSLATED
c-----------------------------------------fast--------------------
      if(nfast.ne.0) b7(20,22) = fastm
c     UNTRANSLATED
c     account for difference in observer, Nuno Cruz calculates 85% reduction needed
c     for nfast=-5 (SC, 18/03/10)
      if(nfast.eq.-5) fastm = fastm*.85
c     END UNTRANSLATED
c-----------------------------------------add gas-----------------
      b7(19,21) = 6.0
c     
      do n=1,msw
         if((iprcinc.eq.1).and.((n.ge.4).and.(n.le.10))) go to 781
         do i=1,nrm
            do j=1,ncm
               amlsw(i,j,n) = b7(i,j)
            enddo
         enddo
 781     continue
         if(iprcinc.eq.1) then
            do i=1,nrm
               do j=1,ncm
                  amlsw(i,j,10) = sqrt((amlsw(i,j,8)*amlsw(i,j,8)) +
     1                 (amlsw(i,j,9)*amlsw(i,j,9)))
               enddo
            enddo
         endif
      enddo
c     
      return
      end
c     
c     
c     
c     
c     
c     
c     
c     
      subroutine amatrix
      include 'fbtmgams.inc'
      include 'mga.inc'
c     
c-----------------------------A-matrix---------------------------
c     a phys_mat element of 1.0 gives a load_mat element of 0.5
      do 739 i=1,24
         do 738 n=1,120
            aaa(i,n) = 0.
 738     continue
 739  continue
c---------------------------------------------plasma current
      do 740 j=1,38
         aaa(19,j+38) = prlen(j)
 740  continue
      if((midplan.eq.8).and.((ixdr.eq.8).or.(ixdr.eq.9))) then
         do j=1,38
            aaa(19,j+38) = amlsw(ixdr-4,j,6)
         enddo
         do j=1,18
            aaa(19,j+76) = -amlsw(ixdr-2,j,6)
         enddo
c     do n=1,19
c     aaa(19,n+94) = 1340./19.
c     enddo
c     aaa(18,115)  = 0.
      endif
c     
c---------------------------------------------------Ip*z
c     note that a2ipz is based on flux with minimum on magnetic axis,
c     whereas the measured flux has maximum on axis.
c     also note that measured loop voltages are used here as vessel currents,
c     and negative loop voltages give positive vessel currents.
c     
c     for shot 3130 gains we have:
c     psi inputs:  load = phys/600000
c     ipol inputs: load = phys/30
c     bpol inputs: load = -phys/173000 !!!
c     
      do 741 j=1,38
         if((midplan.ne.8).and.(nfast.eq.0)) then
            aaa(20,j)    = -a2ipz(j)
            aaa(20,j+38) =  a3ipz(j)
         endif
         if((midplan.ne.8).and.(nfast.ne.0)) then
            aaa(20,j)    = -2.*rampt*a2ipz(j)
            aaa(20,j+38) =  2.*(1.-rampt)*a3ipz(j)
c     next two lines fix a bug whereby nfast=0 and inova.ne.0 yielded no
c     slow differential observer (SC, 31/03/13)
         endif
         if(midplan.ne.8) then
c     UNTRANSLATED
            if(ikriz.eq.2.or.nfast.eq.0) then
c     if(ikriz.eq.2) then
c     END UNTRANSLATED
c     inova=4 option introduced (SC, 21/04/05)
               if(inova.ne.4) then
                  aaa(23,j+38) =  a3ipz3(j)
c     UNTRANSLATED
                  if(nfast.eq.-5.or.nfast.eq.-3.or.nfast.eq.0) then
c     if(nfast.eq.-5.or.nfast.eq.-3) then
c     END UNTRANSLATED
                     aaa(23,j+38) =  a3ipz(j)
                  endif
               else
c     UNTRANSLATED
                  if(nfast.ne.0) then
c     END UNTRANSLATED
                     aaa(23,j)    = -2.*rampt*a2ipz(j)
                     aaa(23,j+38) =  2.*(1.-rampt)*a3ipz(j)
c     UNTRANSLATED
                  else
                     aaa(23,j)    = -a2ipz(j)
                     aaa(23,j+38) =  a3ipz(j)
                  endif
c     END UNTRANSLATED
c     aaa(3,j+38) =  a3ipz3(j)
                  if (iscramb.ne.0) aaa(3,j+38) =  a3ipz3(j)
                  if((nfast.eq.-5.or.nfast.eq.-3).and.iscramb.ne.0) then
                     aaa(3,j+38) =  a3ipz(j)
                  endif
               endif
            endif
c---------------------------------------------------------
         endif
         if(midplan.eq.8) then
            aaa(20,j)    =     -rampt *a2ipzt(j)
            aaa(20,j+38) =  (1.-rampt)*a3ipzt(j)
            aaa(22,j)    =     -rampt *a2ipzb(j)
            aaa(22,j+38) =  (1.-rampt)*a3ipzb(j)
            aaa(24,j)    =     -rampt *a2ipz(j)
            aaa(24,j+38) =  (1.-rampt)*a3ipz(j)
         endif
 741  continue
      if((midplan.ne.8).and.(nfast.ne.0)) then
         aaa(20,14+38) =  boost
         aaa(20,26+38) = -boost
c--------------typical value is boost=-4000.--------------------
         if((ikriz.eq.2).and.(nfast.eq.-5.or.nfast.eq.-3)) then
c     aaa(24,95)  = a3ipz(2)
c     aaa(24,96)  = a3ipz(3)
c     aaa(24,97)  = a3ipz(4)
c     aaa(24,98)  = a3ipz(5)
c     aaa(24,99)  = a3ipz(6)
c     aaa(24,100) = a3ipz(8)
c     aaa(24,101) = a3ipz(11)
c     aaa(24,102) = a3ipz(17)
c     aaa(24,103) = a3ipz(18)
c     aaa(24,104) = a3ipz(19)
c     aaa(24,105) = a3ipz(21)
c     aaa(24,106) = a3ipz(22)
c     aaa(24,107) = a3ipz(23)
c     aaa(24,108) = a3ipz(29)
c     aaa(24,109) = a3ipz(32)
c     aaa(24,110) = a3ipz(34)
c     aaa(24,111) = a3ipz(35)
c     aaa(24,112) = a3ipz(36)
c     aaa(24,113) = a3ipz(37)
c     aaa(24,114) = a3ipz(38)
            aaa(24,95)  = a3ipz3(2)
            aaa(24,96)  = a3ipz3(3)
            aaa(24,97)  = a3ipz3(4)
            aaa(24,98)  = a3ipz3(5)
            aaa(24,99)  = a3ipz3(6)
            aaa(24,100) = a3ipz3(8)
            aaa(24,101) = a3ipz3(11)
            aaa(24,102) = a3ipz3(17)
            aaa(24,103) = a3ipz3(18)
            aaa(24,104) = a3ipz3(19)
            aaa(24,105) = a3ipz3(21)
            aaa(24,106) = a3ipz3(22)
            aaa(24,107) = a3ipz3(23)
            aaa(24,108) = a3ipz3(29)
            aaa(24,109) = a3ipz3(32)
            aaa(24,110) = a3ipz3(34)
            aaa(24,111) = a3ipz3(35)
            aaa(24,112) = a3ipz3(36)
            aaa(24,113) = a3ipz3(37)
            aaa(24,114) = a3ipz3(38)
         endif
      endif
c     if(nfast.eq.-5) aaa(24,118)=uc1
c     if(nfast.eq.-3) aaa(23,117)=uc1
      if((nfast.eq.-3).and.(midplan.ne.8)) then
         aaa(23,52)=-uc1
         aaa(23,64)=uc1
c     if(inova.eq.4) then
         if(inova.eq.4.and.iscramb.ne.0) then
            aaa(3,52)=-uc1
            aaa(3,64)=uc1
         endif
      endif
c     
c     Coil correction for vertical observer (in case kappa feedback is used)
c     removed (SC, 26/05/04)
c     if(((iscramb.eq.12).or.(iscramb.eq.19).or.(iscramb.eq.16)
c     +          .or.(iscramb.eq.15).or.(iscramb.eq.25).or.(iscramb.eq.26)
c     +   .or.(iscramb.eq.36)).and.(inova.eq.2)) then
c     
c     Coil correction allowed for inova=3 or 4 (SC, 31/03/05)
      if(inova.eq.3.or.inova.eq.4) then
         do 742 n=1,18
            aaa(20,n+76) = -a4ipz(n)
 742     continue
      endif
c     
c     
c     
c     if(nvvel.eq.19) then
c     do 743 n=1,19
c     aaa(20,n+94) = a4ipz(n+nshafa)
c     743    continue
c     endif
c     if(nvvel.eq.38) then
c     do 744 n=2,19
c     aaa(20,n+94) = a4ipz(nshafa+2*n-1)
c     1          + 0.5*a4ipz(nshafa+2*n) + 0.5*a4ipz(nshafa+2*n-2)
c     744    continue
c     n=1
c     aaa(20,n+94) = a4ipz(nshafa+2*n-1)
c     1          + 0.5*a4ipz(nshafa+2*n) + 0.5*a4ipz(nshafa+38)
c     endif
c     
c-------------------------------E and F coils -------------------
      if(midplan.ne.8) then
c     
         do i=1,16
            aaa(i,76+i)  = 1.
         enddo
c     mvloop(1)=11 or =21 (Vloop feedback) option added (SC, 23/9/03)
         if(iscramb.ne.0) then
c     IERAT=4 case added (SC, 07/10/11)
            if((mvloop(1).eq.1).or.(mvloop(1).eq.11).or.(mvloop(1).eq.21).or.
     +           (mvloop(1).eq.2).or.(mvloop(1).eq.12).or.
     +           ierat.eq.4) aaa(1,76+1)  = 0.
c     mvloop(1)=2 (two-component IOH feedback) option added (SC, 06/04/05)
            if(mvloop(1).eq.2.or.mvloop(1).eq.12) aaa(2,76+2) = 0.
c     IERAT=4 case added (SC, 07/10/11)
            if((mvloop(1).eq.1).or.(mvloop(1).eq.2).or.(mvloop(1).eq.12).or.
     +           ierat.eq.4) aaa(1,93)    = 1.
c     IERAT=-1 (SC, 16/06/20)
            if(ierat.eq.-1) aaa(22,93) = 1.
c     mvloop(1)=5 (plasma current control by ECRH power) option added (SC, 01/11/06)
            if(mod(mvloop(1),10).eq.5) then
               aaa(1,76+1)  = 0.
               aaa(1,93)    = 1.
               if (mvloop(1).gt.100) then
                  aaa(4,76+4)  = 0.
                  do j=1,38
                     aaa(4,j+38) = prlen(j)
                  end do
                  if((midplan.eq.8).and.((ixdr.eq.8).or.(ixdr.eq.9))) then
                  do j=1,38
                     aaa(4,j+38) = amlsw(ixdr-4,j,6)
                  enddo
                  do j=1,18
                     aaa(4,j+76) = -amlsw(ixdr-2,j,6)
                  enddo
               endif
            endif
         endif
         if(mvloop(1).eq.6) then
            aaa(1,76+1)  = 0.
         endif
c     
         if(mvloop(1).eq.11) aaa(1,119)  = 1.
         if(mvloop(1).eq.21) aaa(1,1)  = 1.
c     inova=4 option added (SC, 25/04/05)
         if(inova.eq.4) aaa(3,76+3) = 0.
      endif
c     
      aaa(18,midplad)    = -psifac
      aaa(18,midout)     =  psifac
      aaa(18,38+midplad) = -gapin*rbee(midplad)*tpi*psifac
      aaa(18,38+midout)  =  gapout*rbee(midout)*tpi*psifac
      if((iscramb.eq.1).or.(iscramb.eq.2)) then
         aaa(mu3,76+mu3)    =  0.5
         aaa(mu3,76+mu4)    = -0.5
         aaa(mu4,76+mu3)    =  0.5
         aaa(mu4,76+mu4)    =  0.5
      endif
      if(iscramb.eq.2) then
         aaa(moh1,76+mu3)   = -0.5
         aaa(moh1,76+moh1)  =  0.5
         aaa(moh4,76+mu4)   = -0.5
         aaa(moh4,76+moh4)  =  0.5
         aaa(mu3,76+moh1)   =  0.5
         aaa(mu3,76+mu3)    =  0.5
         aaa(mu3,76+mu4)    =  0.
         aaa(mu4,76+mu3)    =  0.
         aaa(mu4,76+mu4)    =  0.5
         aaa(mu4,76+moh4)   =  0.5
      endif
c     New coil combination for Snowflake TOP - 4 coils (FP, 05/02/09)
      if(iscramb.eq.61) then
         aaa(13,76+14)  = -0.5
         aaa(13,76+13)  =  0.5
         aaa(16,76+15)  = -0.5
         aaa(16,76+16)  =  0.5
         aaa(14,76+13)  =  0.5
         aaa(14,76+14)  =  0.5
         aaa(14,76+15)  =  0.
         aaa(15,76+14)  =  0.
         aaa(15,76+15)  =  0.5
         aaa(15,76+16)  =  0.5
      endif
c     New coil combination for Snowflake BOT - 4 coils (FP, 05/02/09)
      if(iscramb.eq.62) then
         aaa(11,76+12)  = -0.5
         aaa(11,76+11)  =  0.5
         aaa(14,76+13)  = -0.5
         aaa(14,76+14)  =  0.5
         aaa(12,76+11)  =  0.5
         aaa(12,76+12)  =  0.5
         aaa(12,76+13)  =  0.
         aaa(13,76+12)  =  0.
         aaa(13,76+13)  =  0.5
         aaa(13,76+14)  =  0.5
      endif
c     New coil combination for lower snowflake BOT-4 coils (SC, 22/04/16)
      if(iscramb.eq.63) then
         aaa(10,76+11)  = -0.5
         aaa(10,76+10)  =  0.5
         aaa(14,76+13)  = -0.5
         aaa(14,76+14)  =  0.5
         aaa(11,76+10)  =  0.5
         aaa(11,76+11)  =  0.5
         aaa(11,76+13)  =  0.
         aaa(13,76+11)  =  0.
         aaa(13,76+13)  =  0.5
         aaa(13,76+14)  =  0.5
      endif
      if(iscramb.eq.7) then
         aaa(11,76+12)  = -0.5
         aaa(11,76+11)  =  0.5
         aaa(15,76+14)  = -0.5
         aaa(15,76+15)  =  0.5
         aaa(12,76+11)  =  0.5
         aaa(12,76+12)  =  0.5
         aaa(12,76+14)  =  0.
         aaa(14,76+12)  =  0.
         aaa(14,76+14)  =  0.5
         aaa(14,76+15)  =  0.5
      endif
c     New coil combination for small plasmas (SC, 06/09/04)
      if(iscramb.eq.36) then
         aaa(14,76+11)  = -0.5
         aaa(14,76+12)  = -0.5
         aaa(14,76+13)  = +0.5
         aaa(14,76+14)  = +0.5
         aaa(12,76+11)  = +0.5
         aaa(12,76+12)  = +0.5
         aaa(12,76+13)  = +0.5
         aaa(12,76+14)  = +0.5
         aaa(13,76+11)  = -0.5
         aaa(13,76+12)  = +0.5
         aaa(13,76+13)  = +0.5
         aaa(13,76+14)  = -0.5
         aaa(11,76+11)  = +0.5
         aaa(11,76+12)  = -0.5
         aaa(11,76+13)  = +0.5
         aaa(11,76+14)  = -0.5
      endif
c     New coil combination for small plasmas (SC, 03/09/04)
      if(iscramb.eq.8) then
         aaa(13,76+12)  = -0.25
         aaa(13,76+13)  = -0.25
         aaa(13,76+14)  =  0.25
         aaa(13,76+15)  =  0.25
         aaa(14,76+12)  =  0.25*opal*ompsq
         aaa(14,76+13)  =  0.25*omal*ompsq
         aaa(14,76+14)  =  0.25*omal*ompsq
         aaa(14,76+15)  =  0.25*opal*ompsq
         aaa(12,76+12)  =  0.25
         aaa(12,76+13)  = -0.25
         aaa(12,76+14)  =  0.25
         aaa(12,76+15)  = -0.25
         aaa(15,76+12)  =  0.25*omal*ompsq
         aaa(15,76+13)  = -0.25*opal*ompsq
         aaa(15,76+14)  = -0.25*opal*ompsq
         aaa(15,76+15)  =  0.25*omal*ompsq
      endif
c     New coil combination for small plasmas at the top (SC, 18/01/05)
      if(iscramb.eq.10) then
         aaa(14,76+13)  = -0.25
         aaa(14,76+14)  = -0.25
         aaa(14,76+15)  =  0.25
         aaa(14,76+16)  =  0.25
         aaa(15,76+13)  =  0.25*opal*ompsq
         aaa(15,76+14)  =  0.25*omal*ompsq
         aaa(15,76+15)  =  0.25*omal*ompsq
         aaa(15,76+16)  =  0.25*opal*ompsq
         aaa(13,76+13)  =  0.25
         aaa(13,76+14)  = -0.25
         aaa(13,76+15)  =  0.25
         aaa(13,76+16)  = -0.25
         aaa(16,76+13)  =  0.25*omal*ompsq
         aaa(16,76+14)  = -0.25*opal*ompsq
         aaa(16,76+15)  = -0.25*opal*ompsq
         aaa(16,76+16)  =  0.25*omal*ompsq
      endif
c     New coil combination for smallish plasmas at the top (SC, 19/03/13)
      if(iscramb.eq.11) then
         aaa(13,76+12)  = -0.25
         aaa(13,76+13)  = -0.25
         aaa(13,76+15)  =  0.25
         aaa(13,76+16)  =  0.25
         aaa(15,76+12)  =  0.25*opal*ompsq
         aaa(15,76+13)  =  0.25*omal*ompsq
         aaa(15,76+15)  =  0.25*omal*ompsq
         aaa(15,76+16)  =  0.25*opal*ompsq
         aaa(12,76+12)  =  0.25
         aaa(12,76+13)  = -0.25
         aaa(12,76+15)  =  0.25
         aaa(12,76+16)  = -0.25
         aaa(16,76+12)  =  0.25*omal*ompsq
         aaa(16,76+13)  = -0.25*opal*ompsq
         aaa(16,76+15)  = -0.25*opal*ompsq
         aaa(16,76+16)  =  0.25*omal*ompsq
      endif
      if((iscramb.eq.12).or.(iscramb.eq.22)) then
         aaa(moh1,76+moh1)    =  1./6.
         aaa(moh1,76+mu3)     =  1./6.
         aaa(moh1,76+moh2)    =  1./6.
         aaa(moh1,76+moh3)    =  1./6.
         aaa(moh1,76+mu4)     =  1./6.
         aaa(moh1,76+moh4)    =  1./6.
c     
         aaa(mu3,76+moh1)     = -1./4.
         aaa(mu3,76+mu3)      =  1./4.
         aaa(mu3,76+moh2)     =  0.
         aaa(mu3,76+moh3)     =  0.
         aaa(mu3,76+mu4)      = -1./4.
         aaa(mu3,76+moh4)     =  1./4.
c     
         aaa(moh2,76+moh1)    =  0.
         aaa(moh2,76+mu3)     =  0.
         aaa(moh2,76+moh2)    = -1./2.
         aaa(moh2,76+moh3)    =  1./2.
         aaa(moh2,76+mu4)     =  0.
         aaa(moh2,76+moh4)    =  0.
c     
         aaa(moh3,76+moh1)    = -1./4.
         aaa(moh3,76+mu3)     = -1./4.
         aaa(moh3,76+moh2)    =  0.
         aaa(moh3,76+moh3)    =  0.
         aaa(moh3,76+mu4)     =  1./4.
         aaa(moh3,76+moh4)    =  1./4.
c     
         aaa(mu4,76+moh1)     =  1./6.
         aaa(mu4,76+mu3)      = -1./3.
         aaa(mu4,76+moh2)     =  1./6.
         aaa(mu4,76+moh3)     =  1./6.
         aaa(mu4,76+mu4)      = -1./3.
         aaa(mu4,76+moh4)     =  1./6.
c     
         aaa(moh4,76+moh1)    =  1./4.
         aaa(moh4,76+mu3)     =  0.
         aaa(moh4,76+moh2)    = -1./4.
         aaa(moh4,76+moh3)    = -1./4.
         aaa(moh4,76+mu4)     =  0.
         aaa(moh4,76+moh4)    =  1./4.
c     
      endif
c     
c     New coil combination for small plasmas (SC, 03/09/04)
      if(iscramb.eq.19) then
         aaa(12,76+12)    =  1.*omal/6.*ompsq2
         aaa(12,76+11)     = 1.*opal/6.*ompsq2
         aaa(12,76+13)    =  1.*omal/6.*ompsq2
         aaa(12,76+14)    =  1.*omal/6.*ompsq2
         aaa(12,76+16)     = 1.*opal/6.*ompsq2
         aaa(12,76+15)    =  1.*omal/6.*ompsq2
c     
         aaa(11,76+12)     = -1./4.
         aaa(11,76+11)      =  1./4.
         aaa(11,76+13)     =  0.
         aaa(11,76+14)     =  0.
         aaa(11,76+16)      = -1./4.
         aaa(11,76+15)     =  1./4.
c     
         aaa(13,76+12)    =  0.
         aaa(13,76+11)     =  0.
         aaa(13,76+13)    = -1./2.
         aaa(13,76+14)    =  1./2.
         aaa(13,76+16)     =  0.
         aaa(13,76+15)    =  0.
c     
         aaa(14,76+12)    = -1./4.
         aaa(14,76+11)     = -1./4.
         aaa(14,76+13)    =  0.
         aaa(14,76+14)    =  0.
         aaa(14,76+16)     =  1./4.
         aaa(14,76+15)    =  1./4.
c     
         aaa(16,76+12)     =  1.*opal/6.*ompsq2
         aaa(16,76+11)     = -1.*omal/3.*ompsq2
         aaa(16,76+13)     =  1.*opal/6.*ompsq2
         aaa(16,76+14)     =  1.*opal/6.*ompsq2
         aaa(16,76+16)     = -1.*omal/3.*ompsq2
         aaa(16,76+15)     =  1.*opal/6.*ompsq2
c     
         aaa(15,76+12)    =  1./4.
         aaa(15,76+11)     =  0.
         aaa(15,76+13)    = -1./4.
         aaa(15,76+14)    = -1./4.
         aaa(15,76+16)     =  0.
         aaa(15,76+15)    =  1./4.
c     
      endif
c     
c     New coil combination (SC, 03/09/04)
      if(iscramb.eq.15) then
         aaa(12,76+12)    =  1.*omal/6*ompsq2
         aaa(12,76+11)     = 1.*omal/6*ompsq2
         aaa(12,76+10)    =  1.*opal/6*ompsq2
         aaa(12,76+16)    =  1.*opal/6*ompsq2
         aaa(12,76+15)     = 1.*omal/6*ompsq2
         aaa(12,76+14)    =  1.*omal/6*ompsq2
c     
         aaa(11,76+12)     = -1./4.
         aaa(11,76+11)      =  1./4.
         aaa(11,76+10)     =  0.
         aaa(11,76+16)     =  0.
         aaa(11,76+15)      = -1./4.
         aaa(11,76+14)     =  1./4.
c     
         aaa(10,76+12)    =  0.
         aaa(10,76+11)     =  0.
         aaa(10,76+10)    = -1./2.
         aaa(10,76+16)    =  1./2.
         aaa(10,76+15)     =  0.
         aaa(10,76+14)    =  0.
c     
         aaa(16,76+12)    = -1./4.
         aaa(16,76+11)     = -1./4.
         aaa(16,76+10)    =  0.
         aaa(16,76+16)    =  0.
         aaa(16,76+15)     =  1./4.
         aaa(16,76+14)    =  1./4.
c     
         aaa(15,76+12)     =   1.*omal*omal/6.*ompsq3
         aaa(15,76+11)      = -1.*(omal*omal+opal*opal)/6.*ompsq3
         aaa(15,76+10)     =   1.*opal*opal/6.*ompsq3
         aaa(15,76+16)     =   1.*omal*opal/6.*ompsq3
         aaa(15,76+15)      = -1.*(omal*omal+opal*opal)/6.*ompsq3
         aaa(15,76+14)     =   1.*omal*omal/6.*ompsq3
c     
         aaa(14,76+12)    =  1.*opal/4.*ompsq
         aaa(14,76+11)     =  0.
         aaa(14,76+10)    = -1.*omal/4.*ompsq
         aaa(14,76+16)    = -1.*omal/4.*ompsq
         aaa(14,76+15)     =  0.
         aaa(14,76+14)    =  1.*opal/4.*ompsq
c     
      endif
c     
c     New coil combination (SC, 03/09/04)
      if(iscramb.eq.16) then
         aaa(12,76+12)    =  1.*omal/6*ompsq2
         aaa(12,76+11)     = 1.*omal/6*ompsq2
         aaa(12,76+10)    =  1.*opal/6*ompsq2
         aaa(12,76+15)    =  1.*opal/6*ompsq2
         aaa(12,76+14)     = 1.*omal/6*ompsq2
         aaa(12,76+13)    =  1.*omal/6*ompsq2
c     
         aaa(11,76+12)     = -1./4.
         aaa(11,76+11)      =  1./4.
         aaa(11,76+10)     =  0.
         aaa(11,76+15)     =  0.
         aaa(11,76+14)      = -1./4.
         aaa(11,76+13)     =  1./4.
c     
         aaa(10,76+12)    =  0.
         aaa(10,76+11)     =  0.
         aaa(10,76+10)    = -1./2.
         aaa(10,76+15)    =  1./2.
         aaa(10,76+14)     =  0.
         aaa(10,76+13)    =  0.
c     
         aaa(15,76+12)    = -1./4.
         aaa(15,76+11)     = -1./4.
         aaa(15,76+10)    =  0.
         aaa(15,76+15)    =  0.
         aaa(15,76+14)     =  1./4.
         aaa(15,76+13)    =  1./4.
c     
         aaa(14,76+12)     =   1.*omal*omal/6.*ompsq3
         aaa(14,76+11)      = -1.*(omal*omal+opal*opal)/6.*ompsq3
         aaa(14,76+10)     =   1.*opal*opal/6.*ompsq3
         aaa(14,76+15)     =   1.*omal*opal/6.*ompsq3
         aaa(14,76+14)      = -1.*(omal*omal+opal*opal)/6.*ompsq3
         aaa(14,76+13)     =   1.*omal*omal/6.*ompsq3
c     
         aaa(13,76+12)    =  1.*opal/4.*ompsq
         aaa(13,76+11)     =  0.
         aaa(13,76+10)    = -1.*omal/4.*ompsq
         aaa(13,76+15)    = -1.*omal/4.*ompsq
         aaa(13,76+14)     =  0.
         aaa(13,76+13)    =  1.*opal/4.*ompsq
c     
      endif
c     
c     New coil combination (SC, 03/09/04)
      if(iscramb.eq.25) then
         aaa(12,76+12)    =  1.*omal/6*ompsq2
         aaa(12,76+11)     = 1.*omal/6*ompsq2
         aaa(12,76+10)    =  1.*opal/6*ompsq2
         aaa(12,76+16)    =  1.*opal/6*ompsq2
         aaa(12,76+15)     = 1.*omal/6*ompsq2
         aaa(12,76+14)    =  1.*omal/6*ompsq2
c     
         aaa(11,76+12)     =  1./6.
         aaa(11,76+11)     = -1./6.
         aaa(11,76+10)     =  1./6.
         aaa(11,76+16)     = -1./6.
         aaa(11,76+15)     =  1./6.
         aaa(11,76+14)     = -1./6.
c     
         aaa(10,76+12)    = -1./6.
         aaa(10,76+11)    =  1./6.
         aaa(10,76+10)    =  1./3.
         aaa(10,76+16)    = -1./3.
         aaa(10,76+15)    = -1./6.
         aaa(10,76+14)    =  1./6.
c     
         aaa(16,76+12)    = -1./4.
         aaa(16,76+11)     = -1./4.
         aaa(16,76+10)    =  0.
         aaa(16,76+16)    =  0.
         aaa(16,76+15)     =  1./4.
         aaa(16,76+14)    =  1./4.
c     
         aaa(15,76+12)     =   1.*omal/6.*ompsq3
         aaa(15,76+11)      = -1.*(omal+opal)/6.*ompsq3
         aaa(15,76+10)     =   1.*omal/6.*ompsq3
         aaa(15,76+16)     =   1.*omal/6.*ompsq3
         aaa(15,76+15)      = -1.*(omal+opal)/6.*ompsq3
         aaa(15,76+14)     =   1.*omal/6.*ompsq3
c     
         aaa(14,76+12)    =  1./4.
         aaa(14,76+11)     =  0.
         aaa(14,76+10)    = -1./4.
         aaa(14,76+16)    = -1./4.
         aaa(14,76+15)     =  0.
         aaa(14,76+14)    =  1./4.
c     
      endif
c     
c     New coil combination (SC, 03/09/04)
      if(iscramb.eq.26) then
         aaa(12,76+12)    =  1.*omal/6*ompsq2
         aaa(12,76+11)     = 1.*omal/6*ompsq2
         aaa(12,76+10)    =  1.*opal/6*ompsq2
         aaa(12,76+15)    =  1.*opal/6*ompsq2
         aaa(12,76+14)     = 1.*omal/6*ompsq2
         aaa(12,76+13)    =  1.*omal/6*ompsq2
c     
         aaa(11,76+12)     =  1./6.
         aaa(11,76+11)     = -1./6.
         aaa(11,76+10)     =  1./6.
         aaa(11,76+15)     = -1./6.
         aaa(11,76+14)     =  1./6.
         aaa(11,76+13)     = -1./6.
c     
         aaa(10,76+12)    = -1./6.
         aaa(10,76+11)    =  1./6.
         aaa(10,76+10)    =  1./3.
         aaa(10,76+15)    = -1./3.
         aaa(10,76+14)    = -1./6.
         aaa(10,76+13)    =  1./6.
c     
         aaa(15,76+12)    = -1./4.
         aaa(15,76+11)     = -1./4.
         aaa(15,76+10)    =  0.
         aaa(15,76+15)    =  0.
         aaa(15,76+14)     =  1./4.
         aaa(15,76+13)    =  1./4.
c     
         aaa(14,76+12)     =   1.*omal/6.*ompsq3
         aaa(14,76+11)      = -1.*(omal+opal)/6.*ompsq3
         aaa(14,76+10)     =   1.*omal/6.*ompsq3
         aaa(14,76+15)     =   1.*omal/6.*ompsq3
         aaa(14,76+14)      = -1.*(omal+opal)/6.*ompsq3
         aaa(14,76+13)     =   1.*omal/6.*ompsq3
c     
         aaa(13,76+12)    =  1./4.
         aaa(13,76+11)     =  0.
         aaa(13,76+10)    = -1./4.
         aaa(13,76+15)    = -1./4.
         aaa(13,76+14)     =  0.
         aaa(13,76+13)    =  1./4.
c     
      endif
c     
      if((iscramb.eq.3).or.(iscramb.eq.13)) then
c     New coil combination for the case zax<0 (SC, 17/02/05)
         if(zax(nzaxre).gt.0..or.iscramb.eq.13) then
            aaa(11,76+11)   =  0.
            aaa(11,76+10)  =  0.25*omal*ompsq
            aaa(11,76+12)  = -0.25*opal*ompsq
            aaa(11,76+14)  = -0.25*opal*ompsq
            aaa(11,76+16)  =  0.25*omal*ompsq
            aaa(10,76+11)  = -0.25
            aaa(10,76+10) =  0.25
            aaa(10,76+15) =  0.25
            aaa(10,76+16) = -0.25
            aaa(12,76+10) =  0.25*opal*ompsq
            aaa(12,76+12) =  0.25*omal*ompsq
            aaa(12,76+14) =  0.25*omal*ompsq
            aaa(12,76+16) =  0.25*opal*ompsq
            aaa(14,76+12) = -0.5
            aaa(14,76+14) =  0.5
            aaa(15,76+11)  =  0.5
            aaa(15,76+15) =  0.5
            aaa(16,76+11)  = -0.25
            aaa(16,76+10) = -0.25
            aaa(16,76+15) =  0.25
            aaa(16,76+16) =  0.25
         else
            aaa(10,76+10)   =  0.
            aaa(10,76+9)  =  0.25*omal*ompsq
            aaa(10,76+11)  = -0.25*opal*ompsq
            aaa(10,76+13)  = -0.25*opal*ompsq
            aaa(10,76+15)  =  0.25*omal*ompsq
            aaa(9,76+10)  = -0.25
            aaa(9,76+9) =  0.25
            aaa(9,76+14) =  0.25
            aaa(9,76+15) = -0.25
            aaa(11,76+9) =  0.25*opal*ompsq
            aaa(11,76+11) =  0.25*omal*ompsq
            aaa(11,76+13) =  0.25*omal*ompsq
            aaa(11,76+15) =  0.25*opal*ompsq
            aaa(13,76+11) = -0.5
            aaa(13,76+13) =  0.5
            aaa(14,76+10)  =  0.5
            aaa(14,76+14) =  0.5
            aaa(15,76+10)  = -0.25
            aaa(15,76+9) = -0.25
            aaa(15,76+14) =  0.25
            aaa(15,76+15) =  0.25
         endif
      endif
      if(iscramb.eq.13) then
         aaa(2,76+2)   =  0.5
         aaa(2,76+8)   = -0.5
         aaa(4,76+4)   =  0.5
         aaa(4,76+6)   = -0.5
         aaa(6,76+2)   =  0.25
         aaa(6,76+4)   =  0.25
         aaa(6,76+6)   =  0.25
         aaa(6,76+8)   =  0.25
         aaa(8,76+2)   =  0.25
         aaa(8,76+4)   = -0.25
         aaa(8,76+6)   = -0.25
         aaa(8,76+8)   =  0.25
         aaa(8,76+10)  = -0.25*alpha
         aaa(8,76+12)  = -0.25*alpha
         aaa(8,76+14)  = -0.25*alpha
         aaa(8,76+16)  = -0.25*alpha
         aaa(12,76+2)  =  0.25*alpha
         aaa(12,76+4)  = -0.25*alpha
         aaa(12,76+6)  = -0.25*alpha
         aaa(12,76+8)  =  0.25*alpha
      endif
c     
      if((iscramb.eq.4).or.(iscramb.eq.14)) then
         aaa(9,76+9)    = 0.
         aaa(15,76+15)  = 0.
         aaa(9,76+10)   =  0.25
         aaa(9,76+11)   = -0.25
         aaa(9,76+14)   = -0.25
         aaa(9,76+15)   =  0.25
         aaa(10,76+9)   = -0.25
         aaa(10,76+10)  =  0.25
         aaa(10,76+15)  = -0.25
         aaa(10,76+16)  =  0.25
         aaa(11,76+10)  =  0.25
         aaa(11,76+11)  =  0.25
         aaa(11,76+14)  =  0.25
         aaa(11,76+15)  =  0.25
         aaa(14,76+11)  = -0.5
         aaa(14,76+14)  =  0.5
         aaa(15,76+9)   =  0.5
         aaa(15,76+16)  =  0.5
         aaa(16,76+9)   = -0.25
         aaa(16,76+10)  = -0.25
         aaa(16,76+15)  =  0.25
         aaa(16,76+16)  =  0.25
      endif
      if(iscramb.eq.14) then
         aaa(1,76+1)    =  0.5
         aaa(1,76+8)    = -0.5
         aaa(4,76+4)    =  0.5
         aaa(4,76+5)    = -0.5
         aaa(5,76+1)    =  0.25
         aaa(5,76+4)    =  0.25
         aaa(5,76+5)    =  0.25
         aaa(5,76+8)    =  0.25
         aaa(8,76+1)    =  0.25
         aaa(8,76+4)    = -0.25
         aaa(8,76+5)    = -0.25
         aaa(8,76+8)    =  0.25
         aaa(8,76+10)   = -alpha/4.
         aaa(8,76+11)   = -alpha/4.
         aaa(8,76+14)   = -alpha/4.
         aaa(8,76+15)   = -alpha/4.
         aaa(11,76+1)   =  alpha/4.
         aaa(11,76+4)   = -alpha/4.
         aaa(11,76+5)   = -alpha/4.
         aaa(11,76+8)   =  alpha/4.
      endif
      if(iscramb.eq.5) then
         aaa(11,76+11)   =  0.
         aaa(11,76+10)  = -0.25*omal*ompsq
         aaa(11,76+12)  =  0.25*opal*ompsq
         aaa(11,76+14)  =  0.25*opal*ompsq
         aaa(11,76+16)  = -0.25*omal*ompsq
         aaa(10,76+11)  = -0.25
         aaa(10,76+10) =  0.
         aaa(10,76+12) =  0.25
         aaa(10,76+15) =  0.25
         aaa(10,76+14) = -0.25
         aaa(12,76+10) =  0.25*opal*ompsq
         aaa(12,76+12) =  0.25*omal*ompsq
         aaa(12,76+14) =  0.25*omal*ompsq
         aaa(12,76+16) =  0.25*opal*ompsq
         aaa(14,76+14) =  0.
         aaa(14,76+10) = -0.5
         aaa(14,76+16) =  0.5
         aaa(15,76+11)  =  0.5
         aaa(15,76+15) =  0.5
         aaa(16,76+11)  = -0.25
         aaa(16,76+12) = -0.25
         aaa(16,76+15) =  0.25
         aaa(16,76+14) =  0.25
         aaa(16,76+16) =  0.
      endif
      if(iscramb.eq.6) then
         aaa(9,76+9)   = -0.25*omal*ompsq
         aaa(9,76+11)  =  0.25*opal*ompsq
         aaa(9,76+14)  =  0.25*opal*ompsq
         aaa(9,76+16)  = -0.25*omal*ompsq
         aaa(11,76+11) =  0.25
         aaa(11,76+12) = -0.25
         aaa(11,76+13) =  0.25
         aaa(11,76+14) = -0.25
         aaa(12,76+12) =  0.
         aaa(12,76+9)  =  0.25*opal*ompsq
         aaa(12,76+11) =  0.25*omal*ompsq
         aaa(12,76+14) =  0.25*omal*ompsq
         aaa(12,76+16) =  0.25*opal*ompsq
         aaa(13,76+13) =  0.
         aaa(13,76+9)  = -0.5
         aaa(13,76+16) =  0.5
         aaa(14,76+14) =  0.
         aaa(14,76+12) =  0.5
         aaa(14,76+13)  = 0.5
         aaa(16,76+11) = -0.25
         aaa(16,76+12) = -0.25
         aaa(16,76+13) =  0.25
         aaa(16,76+14) =  0.25
         aaa(16,76+16) =  0.
      endif
c     
c     New coil combination for small plasmas (SC, 03/09/04)
      if(iscramb.eq.9) then
         aaa(11,76+11)    = 0.
         aaa(15,76+15)  = 0.
         aaa(11,76+12)   =  0.25*omal*ompsq
         aaa(11,76+13)   = -0.25*opal*ompsq
         aaa(11,76+14)   = -0.25*opal*ompsq
         aaa(11,76+15)   =  0.25*omal*ompsq
         aaa(12,76+11)   = -0.25
         aaa(12,76+12)  =  0.25
         aaa(12,76+15)  = -0.25
         aaa(12,76+16)  =  0.25
         aaa(13,76+12)  =  0.25*opal*ompsq
         aaa(13,76+13)  =  0.25*omal*ompsq
         aaa(13,76+14)  =  0.25*omal*ompsq
         aaa(13,76+15)  =  0.25*opal*ompsq
         aaa(14,76+13)  = -0.5
         aaa(14,76+14)  =  0.5
         aaa(15,76+11)   =  0.5
         aaa(15,76+16)  =  0.5
         aaa(16,76+11)   = -0.25
         aaa(16,76+12)  = -0.25
         aaa(16,76+15)  =  0.25
         aaa(16,76+16)  =  0.25
      endif
      endif
c     
      if(midplan.eq.8) then
c     
         do i=1,8
            aaa(i,76+i) = 1.
         enddo
         aaa(9,76+9)   = 0.540
         aaa(9,76+12)  = -.580
         aaa(9,76+13)  = 0.264
         aaa(9,76+16)  = -.064
         aaa(10,76+10) = 1.
         aaa(11,76+11) = 1.
         aaa(12,76+9)  = 0.226
         aaa(12,76+12) = 0.908
         aaa(12,76+13) = -.765
         aaa(12,76+16) = 0.212
         aaa(13,76+9)  = 0.212
         aaa(13,76+12) = -.765
         aaa(13,76+13) = 0.908
         aaa(13,76+16) = 0.226
         aaa(14,76+14) = 1.
         aaa(15,76+15) = 1.
         aaa(16,76+9)  = 0.064
         aaa(16,76+12) = -.264
         aaa(16,76+13) = 0.580
         aaa(16,76+16) = -.540
c     
         aaa(23,midplab)    = -psifac
         aaa(23,midoutb)    =  psifac
         aaa(23,38+midplab) = -gapin*rbee(midplab)*tpi*psifac
         aaa(23,38+midoutb) =  gapout*rbee(midoutb)*tpi*psifac
c     
         aaa(18,midplat)    = -psifac
         aaa(18,midoutt)    =  psifac
         aaa(18,38+midplat) = -gapin*rbee(midplat)*tpi*psifac
         aaa(18,38+midoutt) =  gapout*rbee(midoutt)*tpi*psifac
c     
      endif
c-------------------------------------------oh1,oh2
      aaa(17,115)  = 2.
c     put Ohmic coil current on output 18
      if (iscramb.eq.0) then
         do i=1,94
            aaa(18,i)  = 0.
         enddo
         aaa(18,93)    = 1.
      endif
c-------------------------------------------gas
c     Distinguish FIR from 1mm feedback by sign of gain (SC, 05/03/11)
      if (gain.ge.0.) then
c     END UNTRANSLATED
         aaa(21,116)  = 1.
c     UNTRANSLATED
      else
c     Convert 1 mm fringes to FIR fringes
         aaa(21,118)  = 214.6e-6/(2.9979e8/280.0e9)
      endif
c     END UNTRANSLATED
c-------------------------------------------fast
c     if((nfast.ne.0).and.(iscramb.ne.12)) aaa(22,117) = 1.
c-------------------------------------------kappa
      if(midplan.ne.8.and.ierat.ne.-1) then
         do k=1,38
            aaa(22,k)    = -a2ipzs(k)
            aaa(22,k+38) =  a3ipzs(k)
         enddo
c     UNTRANSLATED
         if(iscramb.ne.0) then
c     END UNTRANSLATED
            if (mvloop(1).eq.6) then
               do k=1,38
                  aaa(1,k)    = -a2ipzs(k)
                  aaa(1,k+38) =  a3ipzs(k)
               enddo
            endif
c     UNTRANSLATED
         endif
c     END UNTRANSLATED
c     
c     Added the possibility of subtracting coil current corrections
c     (SC, 13/05/04)
c     
         if ((ifour.ge.10.and.ifour.lt.20).or.
     1        (ifour.ge.30.and.ifour.lt.40)) then
            if (ierat.ne.-1) then
               do k=1,18
                  aaa(22,k+76) = -a4ipzs(k)
               enddo
            endif
c     UNTRANSLATED
            if(iscramb.ne.0) then
c     END UNTRANSLATED
               if (mvloop(1).eq.6) then
                  do k=1,38
                     aaa(1,k+76)    = -a4ipzs(k)
                  enddo
               endif
c     UNTRANSLATED
            endif
c     END UNTRANSLATED
         else
            if (ierat.ne.-1) then
               do k=1,18
                  aaa(22,k+76) = 0.
               enddo
            endif
c     UNTRANSLATED
            if(iscramb.ne.0) then
c     END UNTRANSLATED
               if (mvloop(1).eq.6) then
                  do k=1,38
                     aaa(1,k+76)  = 0.
                  enddo
               endif
c     UNTRANSLATED
            endif
c     END UNTRANSLATED
         end if
      endif
c     
c------------conversion from relative to absolute flux input
      if (mvloop(1).ne.21) then
         do 762 i=1,24
            aaa(i,1) = 0.
            do 761 n=2,nloop
               aaa(i,1) = aaa(i,1)-aaa(i,n)
 761        continue
 762     continue
      else
         do i=2,24
            aaa(i,1) = 0.
            do n=2,nloop
               aaa(i,1) = aaa(i,1)-aaa(i,n)
            enddo
         enddo
      endif
c     
      do n=1,msw
         do i=1,nra
            do j=1,nca
               aaasw(i,j,n) = aaa(i,j)
            enddo
         enddo
      enddo
c     
      if(midplan.eq.8) then
         do j=1,nca
            aaasw(18,j,4) = aaa(24,j)
         enddo
         do n=1,msw
            do j=1,nca
               aaasw(24,j,n) = 0.
            enddo
         enddo
      endif
c     
      return
      end
c     
c     
c     
c     
c     
c     
c     
c     
      subroutine gmatrix
      include 'fbtmgams.inc'
      include 'mga.inc'
c     
c--------------------------------------G1,G2,G3-matrices
c     a phys_mat element of 1.0 gives a load_mat element of 0.5
      do 769 i=1,nrg
         do 768 j=1,ncg
            b3(i,j) = 0.
            b4(i,j) = 0.
            b5(i,j) = 0.
 768     continue
 769  continue
c     
      alpha1 = 1./(1.+alpha*alpha)
      strang = 0.006/(tpi*5.25)
c     
c----------------------------------gas------------------------------
      b4(21,21) = (0.1/6.0)*abs(gain)
      b3(21,21) = (0.1/6.0)*ggain
      b5(21,21) = (0.1/6.0)*hgain
c-------------------------------------------------------------------
      b4(17,17)   =  0.25*ohsame
      b4(18,17)   = -0.25*ohsame
      b3(17,17)   =  0.25*ohsami
      b3(18,17)   = -0.25*ohsami
      b4(17,19) = -aipgain(1)
      b4(18,19) = -aipgain(1)
      b3(17,19) = -aipgain(2)
      b3(18,19) = -aipgain(2)
c-------------------------------------------------------------------
      if(midplan.ne.8) then
c     
         do i=1,8
            b4(i,i)     = 0.25
            b4(i+8,i+8) = 1.0
c************************
            b3(i,i)     = 0.
            b3(i+8,i+8) = 0.
c************************
c     ADDED 16/03/16 (SC)
            if (iscramb.eq.0) then
               b4(i,i)     = 0.35
               b4(i+8,i+8) = 1.4
               b3(i,i)     = 0.1
               b3(i+8,i+8) = 0.4
            endif
c     
         enddo
c     mvloop(1)=11 or =21 (Vloop feedback) option added (SC, 23/9/03)
c     IERAT=4 case added (SC, 07/10/11)
         if((mvloop(1).eq.1).or.(mvloop(1).eq.11).or.(mvloop(1).eq.21).or.
     +        (mvloop(1).eq.2).or.(mvloop(1).eq.12).or.
     +        ierat.eq.4) b4(1,1) = 0.
c     mvloop(1)=2 (two-component IOH feedback) option added (SC, 06/04/05)
         if(mvloop(1).eq.2.or.mvloop(1).eq.12) b4(2,2) = 0.
c     mvloop(1)=5 (plasma current control by ECRH power) option added (SC, 01/11/06)
         if(mod(mvloop(1),10).eq.5) then
            b4(1,1) = 0.
            if(mod(mvloop(1),100).eq.25) b4(2,2) = 0.
            if(mvloop(1).gt.100) b4(4,4)=0.
         endif
c     mvloop(1)=6 (plasma elongation control by ECRH) option added (SC, 02/11/06)
         if(mvloop(1).eq.6) then
            do imv=1,2
               if (mvloop(imv+1).ne.0) b4(imv,imv) = 0.
            enddo
            do imv=3,7
               if (mvloop(imv+1).ne.0) b4(imv+1,imv+1) = 0.
            enddo
         endif
c     inova=4 option added (SC, 25/04/05)
         if(inova.eq.4) b4(3,3) = 0.
c     
         if((iscramb.eq.1).or.(iscramb.eq.2)) then
            b4(mu3,mu3) = 0.
            b4(mu4,mu4) = 0.
            b4(mu3,18)  = gainr
            b4(mu4,18)  = gainr
         endif
c     New coil combination for Snowflake plasmas top - 4 coils (FP, 05/02/09)
         if(iscramb.eq.61) then
            b4(14,14) = 0.
            b4(15,15) = 0.
            b4(14,18)  = gainr
            b4(15,18)  = gainr
         endif
c     New coil combination for Snowflake plasmas bot - 4 coils (FP, 05/02/09)
         if(iscramb.eq.62) then
            b4(12,12) = 0.
            b4(13,13) = 0.
            b4(12,18)  = gainr
            b4(13,18)  = gainr
         endif
c     New coil combination for lower snowflake BOT-4 coils (SC, 22/04/16)
         if(iscramb.eq.63) then
            b4(11,11) = 0.
            b4(13,13) = 0.
            b4(11,18)  = gainr
            b4(13,18)  = gainr
         endif
c     
         if(iscramb.eq.1) then
            if((nfast.eq.0).or.(nfast.eq.-2).or.(nfast.eq.-3)
     1           .or.(nfast.eq.-4).or.(nfast.eq.-5)) then
               b4(mu3,20) = -gainz*0.1
               b4(mu4,20) =  gainz*0.1
               b5(mu3,20) = -gainvz*0.1*strang
               b5(mu4,20) =  gainvz*0.1*strang
               b5(mu1-1,20) = -gainvze*0.1*strang
               b5(mu2+1,20) =  gainvze*0.1*strang
            endif
c     if(nfast.eq.1) then
c     b4(mu3,22) = -gainext(1)
c     b4(mu4,22) =  gainext(1)
c     endif
            if(nfast.eq.-1) then
               b4(mu3,20) = -gainz*0.1
               b4(mu4,20) =  gainz*0.1
            endif
         endif
c     
         if(iscramb.eq.2) then
            b4(mu3,moh1) = -1.
            b4(mu4,moh4) = -1.
         endif
c     New coil combination for Snowflake plasmas to -TOP 4 coils (FP, 05/02/09)
         if(iscramb.eq.61) then
            b4(14,13) = -1.
            b4(15,16) = -1.
         endif
c     New coil combination for Snowflake plasmas to -BOT 4 coils (FP, 05/02/09)
         if(iscramb.eq.62) then
            b4(12,11) = -1.
            b4(13,14) = -1.
         endif
c     New coil combination for lower snowflake BOT-4 coils (SC, 22/04/16)
         if(iscramb.eq.63) then
            b4(11,10) = -1.
            b4(13,14) = -1.
         endif
         if(iscramb.eq.7) then
            b4(12,12) = 0.
            b4(14,14) = 0.
            b4(12,18)  = gainr
            b4(14,18)  = gainr
            b4(12,11) = -1.
            b4(14,15) = -1.
            b4(11,18) = gainr
            b4(15,18) = gainr
            if((nfast.eq.0).or.(nfast.eq.-2).or.(nfast.eq.-3)
     1           .or.(nfast.eq.-4).or.(nfast.eq.-5)) then
               b4(12,20) = -gainz*0.05
               b4(14,20) =  gainz*0.05
               b4(11,20) = -gainz*0.05
               b4(15,20) =  gainz*0.05
c     UNTRANSLATED
c     if(((inova.ne.2).and.(inova.ne.3).and.
c     1               (inova.ne.4)).or.(nfast.eq.0)) then
               if(inova.ne.2.and.inova.ne.3.and.
     1              inova.ne.4) then
c     END UNTRANSLATED
                  b5(12,20) = -gainvz*0.05*strang
                  b5(14,20) =  gainvz*0.05*strang
                  b5(11,20) = -gainvz*0.05*strang
                  b5(15,20) =  gainvz*0.05*strang
c     UNTRANSLATED
c     endif
c     if(((inova.eq.2).or.(inova.eq.3).or.
c     1            (inova.eq.4)).and.(nfast.ne.0)) then
               else
c     END UNTRANSLATED
                  b5(12,23) = -gainvz*0.05*strang
                  b5(14,23) =  gainvz*0.05*strang
                  b5(11,23) = -gainvz*0.05*strang
                  b5(15,23) =  gainvz*0.05*strang
               endif
            endif
         endif
c     
c     New coil combination for small plasmas (SC, 06/09/04)
         if(iscramb.eq.36) then
            b4(11,13) = -1.
            b4(12,13) = +1.
            b4(13,13) = +1.
            b4(14,13) = -1.
            b4(11,11) = +1.
            b4(12,11) = -1.
            b4(13,11) = +1.
            b4(14,11) = -1.
            b4(12,18)  = gainr
            b4(13,18)  = gainr
            b4(11,18) = gainr
            b4(14,18) = gainr
            if((nfast.eq.0).or.(nfast.eq.-2).or.(nfast.eq.-3)
     1           .or.(nfast.eq.-4).or.(nfast.eq.-5)) then
               b4(12,20) = -gainz*0.05
               b4(13,20) =  gainz*0.05
               b4(11,20) = -gainz*0.05
               b4(14,20) =  gainz*0.05
c     UNTRANSLATED
c     if(((inova.ne.2).and.(inova.ne.3).and.
c     1               (inova.ne.4)).or.(nfast.eq.0)) then
               if(inova.ne.2.and.inova.ne.3.and.
     1              inova.ne.4) then
c     END UNTRANSLATED
                  b5(12,20) = -gainvz*0.05*strang
                  b5(13,20) =  gainvz*0.05*strang
                  b5(11,20) = -gainvz*0.05*strang
                  b5(14,20) =  gainvz*0.05*strang
c     UNTRANSLATED
c     endif
c     if(((inova.eq.2).or.(inova.eq.3).or.
c     1            (inova.eq.4)).and.(nfast.ne.0)) then
               else
c     END UNTRANSLATED
                  b5(12,23) = -gainvz*0.05*strang
                  b5(13,23) =  gainvz*0.05*strang
                  b5(11,23) = -gainvz*0.05*strang
                  b5(14,23) =  gainvz*0.05*strang
               endif
            endif
         endif
c     
c     New coil combination for small plasmas (SC, 03/09/04)
         if(iscramb.eq.8) then
            b4(13,13) = 0.
            b4(14,14) = 0.
            b4(12,12) =  1.
            b4(13,12) = -1.
            b4(14,12) =  1.
            b4(15,12) = -1.
            b4(12,15) =  1.*omal
            b4(13,15) = -1.*opal
            b4(14,15) = -1.*opal
            b4(15,15) =  1.*omal
            b4(12,18) = gainr*opal
            b4(13,18) = gainr*omal
            b4(14,18) = gainr*omal
            b4(15,18) = gainr*opal
            if((nfast.eq.0).or.(nfast.eq.-2).or.(nfast.eq.-3)
     1           .or.(nfast.eq.-4).or.(nfast.eq.-5)) then
               b4(13,20) = -gainz*0.05
               b4(14,20) =  gainz*0.05
               b4(12,20) = -gainz*0.05
               b4(15,20) =  gainz*0.05
c     UNTRANSLATED
c     if(((inova.ne.2).and.(inova.ne.3).and.
c     1               (inova.ne.4)).or.(nfast.eq.0)) then
               if(inova.ne.2.and.inova.ne.3.and.
     1              inova.ne.4) then
c     END UNTRANSLATED
                  b5(13,20) = -gainvz*0.05*strang
                  b5(14,20) =  gainvz*0.05*strang
                  b5(12,20) = -gainvz*0.05*strang
                  b5(15,20) =  gainvz*0.05*strang
c     UNTRANSLATED
c     endif
c     if(((inova.eq.2).or.(inova.eq.3).or.
c     1            (inova.eq.4)).and.(nfast.ne.0)) then
               else
c     END UNTRANSLATED
                  b5(13,23) = -gainvz*0.05*strang
                  b5(14,23) =  gainvz*0.05*strang
                  b5(12,23) = -gainvz*0.05*strang
                  b5(15,23) =  gainvz*0.05*strang
               endif
            endif
         endif
c     
c     New coil combination for small plasmas at the top (SC, 18/01/05)
         if(iscramb.eq.10) then
            b4(14,14) = 0.
            b4(15,15) = 0.
            b4(13,13) =  1.
            b4(14,13) = -1.
            b4(15,13) =  1.
            b4(16,13) = -1.
            b4(13,16) =  1.*omal
            b4(14,16) = -1.*opal
            b4(15,16) = -1.*opal
            b4(16,16) =  1.*omal
            b4(13,18) = gainr*opal
            b4(14,18) = gainr*omal
            b4(15,18) = gainr*omal
            b4(16,18) = gainr*opal
            if((nfast.eq.0).or.(nfast.eq.-2).or.(nfast.eq.-3)
     1           .or.(nfast.eq.-4).or.(nfast.eq.-5)) then
               b4(14,20) = -gainz*0.05
               b4(15,20) =  gainz*0.05
               b4(13,20) = -gainz*0.05
               b4(16,20) =  gainz*0.05
c     UNTRANSLATED
c     if(((inova.ne.2).and.(inova.ne.3).and.
c     1               (inova.ne.4)).or.(nfast.eq.0)) then
               if(inova.ne.2.and.inova.ne.3.and.
     1              inova.ne.4) then
c     END UNTRANSLATED
                  b5(14,20) = -gainvz*0.05*strang
                  b5(15,20) =  gainvz*0.05*strang
                  b5(13,20) = -gainvz*0.05*strang
                  b5(16,20) =  gainvz*0.05*strang
c     UNTRANSLATED
c     endif
c     if(((inova.eq.2).or.(inova.eq.3).or.
c     1            (inova.eq.4)).and.(nfast.ne.0)) then
               else
c     END UNTRANSLATED
                  b5(14,23) = -gainvz*0.05*strang
                  b5(15,23) =  gainvz*0.05*strang
                  b5(13,23) = -gainvz*0.05*strang
                  b5(16,23) =  gainvz*0.05*strang
               endif
            endif
         endif
c     New coil combination for smallish plasmas at the top (SC, 19/03/13)
         if(iscramb.eq.11) then
            b4(13,13) = 0.
            b4(15,15) = 0.
            b4(12,12) =  1.
            b4(13,12) = -1.
            b4(15,12) =  1.
            b4(16,12) = -1.
            b4(12,16) =  1.*omal
            b4(13,16) = -1.*opal
            b4(15,16) = -1.*opal
            b4(16,16) =  1.*omal
            b4(12,18) = gainr*opal
            b4(13,18) = gainr*omal
            b4(15,18) = gainr*omal
            b4(16,18) = gainr*opal
            if((nfast.eq.0).or.(nfast.eq.-2).or.(nfast.eq.-3)
     1           .or.(nfast.eq.-4).or.(nfast.eq.-5)) then
               b4(13,20) = -gainz*0.05
               b4(15,20) =  gainz*0.05
               b4(12,20) = -gainz*0.05
               b4(16,20) =  gainz*0.05
c     UNTRANSLATED
c     if(((inova.ne.2).and.(inova.ne.3).and.
c     1               (inova.ne.4)).or.(nfast.eq.0)) then
               if(inova.ne.2.and.inova.ne.3.and.
     1              inova.ne.4) then
c     END UNTRANSLATED
                  b5(13,20) = -gainvz*0.05*strang
                  b5(15,20) =  gainvz*0.05*strang
                  b5(12,20) = -gainvz*0.05*strang
                  b5(16,20) =  gainvz*0.05*strang
c     UNTRANSLATED
c     endif
c     if(((inova.eq.2).or.(inova.eq.3).or.
c     1            (inova.eq.4)).and.(nfast.ne.0)) then
               else
c     END UNTRANSLATED
                  b5(13,23) = -gainvz*0.05*strang
                  b5(15,23) =  gainvz*0.05*strang
                  b5(12,23) = -gainvz*0.05*strang
                  b5(16,23) =  gainvz*0.05*strang
               endif
            endif
         endif
c     
         if((iscramb.eq.2).or.(iscramb.eq.12).or.(iscramb.eq.22)) then
            b4(moh1,18) = gainr
            b4(moh4,18) = gainr
            if((nfast.eq.0).or.(nfast.eq.-2).or.(nfast.eq.-3)
     1           .or.(nfast.eq.-4).or.(nfast.eq.-5)) then
               b4(mu3,20) = -gainz*0.05
               b4(mu4,20) =  gainz*0.05
               b4(moh1,20) = -gainz*0.05
               b4(moh4,20) =  gainz*0.05
c     UNTRANSLATED
c     if(((inova.ne.2).and.(inova.ne.3).and.
c     1            (inova.ne.4)).or.(nfast.eq.0)) then
               if(inova.ne.2.and.inova.ne.3.and.
     1              inova.ne.4) then
c     END UNTRANSLATED
                  b5(mu3,20) = -gainvz*0.05*strang
                  b5(mu4,20) =  gainvz*0.05*strang
                  b5(moh1,20) = -gainvz*0.05*strang
                  b5(moh4,20) =  gainvz*0.05*strang
c     UNTRANSLATED
c     endif
c     if(((inova.eq.2).or.(inova.eq.3).or.
c     1         (inova.eq.4)).and.(nfast.ne.0)) then
               else
c     END UNTRANSLATED
                  b5(mu3,23) = -gainvz*0.05*strang
                  b5(mu4,23) =  gainvz*0.05*strang
                  b5(moh1,23) = -gainvz*0.05*strang
                  b5(moh4,23) =  gainvz*0.05*strang
               endif
               b5(mu1-1,20) = -gainvze*0.1*strang
               b5(mu2+1,20) =  gainvze*0.1*strang
            endif
c     if(nfast.eq.1) then
c     b4(mu3,22)  = -gainext(1)*0.5
c     b4(mu4,22)  =  gainext(1)*0.5
c     b4(moh1,22) = -gainext(1)*0.5
c     b4(moh4,22) =  gainext(1)*0.5
c     endif
            if(nfast.eq.-1) then
               b4(mu3,20) = -gainz*0.05
               b4(mu4,20) =  gainz*0.05
               b4(moh1,20) = -gainz*0.05
               b4(moh4,20) =  gainz*0.05
            endif
         endif
c     New coil combination for snowflake plasma top -4 coils (FP,05/02/09)
         if(iscramb.eq.61) then
            b4(13,18) = gainr
            b4(16,18) = gainr
            b4(14,20) = -gainz*0.05
            b4(15,20) =  gainz*0.05
            b4(13,20) = -gainz*0.05
            b4(16,20) =  gainz*0.05
c     UNTRANSLATED
c     if(((inova.ne.2).and.(inova.ne.3).and.
c     1         (inova.ne.4)).or.(nfast.eq.0)) then
            if(inova.ne.2.and.inova.ne.3.and.
     1           inova.ne.4) then
c     END UNTRANSLATED
               b5(14,20) = -gainvz*0.05*strang
               b5(15,20) =  gainvz*0.05*strang
               b5(13,20) = -gainvz*0.05*strang
               b5(16,20) =  gainvz*0.05*strang
c     UNTRANSLATED
c     endif
c     if(((inova.eq.2).or.(inova.eq.3).or.
c     1            (inova.eq.4)).and.(nfast.ne.0)) then
            else
c     END UNTRANSLATED
               b5(14,23) = -gainvz*0.05*strang
               b5(15,23) =  gainvz*0.05*strang
               b5(13,23) = -gainvz*0.05*strang
               b5(16,23) =  gainvz*0.05*strang
            endif
            b5(5,20) = -gainvze*0.1*strang
            b5(8,20) =  gainvze*0.1*strang
         endif
c     New coil combination for snowflake plasma bot -4 coils (FP,05/02/09)
         if(iscramb.eq.62) then
            b4(11,18) = gainr
            b4(14,18) = gainr
            b4(12,20) = -gainz*0.05
            b4(13,20) =  gainz*0.05
            b4(11,20) = -gainz*0.05
            b4(14,20) =  gainz*0.05
c     UNTRANSLATED
c     if(((inova.ne.2).and.(inova.ne.3).and.
c     1         (inova.ne.4)).or.(nfast.eq.0)) then
            if(inova.ne.2.and.inova.ne.3.and.
     1           inova.ne.4) then
c     END UNTRANSLATED
               b5(12,20) = -gainvz*0.05*strang
               b5(13,20) =  gainvz*0.05*strang
               b5(11,20) = -gainvz*0.05*strang
               b5(14,20) =  gainvz*0.05*strang
c     UNTRANSLATED
c     endif
c     if(((inova.eq.2).or.(inova.eq.3).or.
c     1            (inova.eq.4)).and.(nfast.ne.0)) then
            else
c     END UNTRANSLATED
               b5(12,23) = -gainvz*0.05*strang
               b5(13,23) =  gainvz*0.05*strang
               b5(11,23) = -gainvz*0.05*strang
               b5(14,23) =  gainvz*0.05*strang
            endif
            b5(3,20) = -gainvze*0.1*strang
            b5(6,20) =  gainvze*0.1*strang
         endif
c     New coil combination for lower snowflake BOT-4 coils (SC, 22/04/16)
         if(iscramb.eq.63) then
            b4(10,18) = gainr
            b4(14,18) = gainr
            b4(11,20) = -gainz*0.05
            b4(13,20) =  gainz*0.05
            b4(10,20) = -gainz*0.05
            b4(14,20) =  gainz*0.05
c     UNTRANSLATED
c     if(((inova.ne.2).and.(inova.ne.3).and.
c     1         (inova.ne.4)).or.(nfast.eq.0)) then
            if(inova.ne.2.and.inova.ne.3.and.
     1           inova.ne.4) then
c     END UNTRANSLATED
               b5(11,20) = -gainvz*0.05*strang
               b5(13,20) =  gainvz*0.05*strang
               b5(10,20) = -gainvz*0.05*strang
               b5(14,20) =  gainvz*0.05*strang
c     UNTRANSLATED
c     endif
c     if(((inova.eq.2).or.(inova.eq.3).or.
c     1            (inova.eq.4)).and.(nfast.ne.0)) then
            else
c     END UNTRANSLATED
               b5(11,23) = -gainvz*0.05*strang
               b5(13,23) =  gainvz*0.05*strang
               b5(10,23) = -gainvz*0.05*strang
               b5(14,23) =  gainvz*0.05*strang
            endif
            b5(3,20) = -gainvze*0.1*strang
            b5(6,20) =  gainvze*0.1*strang
         endif
c     
         if((iscramb.eq.12).or.(iscramb.eq.22)) then
            b4(moh1,18) = gainr
            b4(mu3,18)  = gainr
            b4(moh2,18) = gainr
            b4(moh3,18) = gainr
            b4(mu4,18)  = gainr
            b4(moh4,18) = gainr
c     
            b4(moh1,moh1)   =  0.
            b4(mu3,moh1)    =  0.
            b4(moh2,moh1)   =  0.
            b4(moh3,moh1)   =  0.
            b4(mu4,moh1)    =  0.
            b4(moh4,moh1)   =  0.
c     
            b4(moh1,mu3)    = -1.0
            b4(mu3,mu3)     =  1.0
            b4(moh2,mu3)    =  0.
            b4(moh3,mu3)    =  0.
            b4(mu4,mu3)     = -1.0
            b4(moh4,mu3)    =  1.0
c     
            b4(moh1,moh2)   =  0.
            b4(mu3,moh2)    =  0.
            b4(moh2,moh2)   = -1.0
            b4(moh3,moh2)   =  1.0
            b4(mu4,moh2)    =  0.
            b4(moh4,moh2)   =  0.
c     
            b4(moh1,moh3)   =  0.
            b4(mu3,moh3)    =  0.
            b4(moh2,moh3)   =  0.
            b4(moh3,moh3)   =  0.
            b4(mu4,moh3)    =  0.
            b4(moh4,moh3)   =  0.
c     
            b4(moh1,mu4)    =  0.5
            b4(mu3,mu4)     = -1.0
            b4(moh2,mu4)    =  0.5
            b4(moh3,mu4)    =  0.5
            b4(mu4,mu4)     = -1.0
            b4(moh4,mu4)    =  0.5
c     
            b4(moh1,moh4)   =  1.0
            b4(mu3,moh4)    =  0.
            b4(moh2,moh4)   = -1.0
            b4(moh3,moh4)   = -1.0
            b4(mu4,moh4)    =  0.
            b4(moh4,moh4)   =  1.0
         endif
c     
c     New coil combination for small plasmas (SC, 03/09/04)
         if(iscramb.eq.19) then
            if((nfast.eq.0).or.(nfast.eq.-2).or.(nfast.eq.-3)
     1           .or.(nfast.eq.-4).or.(nfast.eq.-5)) then
               b4(11,20) = -gainz*0.05
               b4(16,20) =  gainz*0.05
               b4(12,20) = -gainz*0.05
               b4(15,20) =  gainz*0.05
c     UNTRANSLATED
c     if(((inova.ne.2).and.(inova.ne.3).and.
c     1            (inova.ne.4)).or.(nfast.eq.0)) then
               if(inova.ne.2.and.inova.ne.3.and.
     1              inova.ne.4) then
c     END UNTRANSLATED
                  b5(11,20) = -gainvz*0.05*strang
                  b5(16,20) =  gainvz*0.05*strang
                  b5(12,20) = -gainvz*0.05*strang
                  b5(15,20) =  gainvz*0.05*strang
c     UNTRANSLATED
c     endif
c     if(((inova.eq.2).or.(inova.eq.3).or.
c     1               (inova.eq.4)).and.(nfast.ne.0)) then
               else
c     END UNTRANSLATED
                  b5(11,23) = -gainvz*0.05*strang
                  b5(16,23) =  gainvz*0.05*strang
                  b5(12,23) = -gainvz*0.05*strang
                  b5(15,23) =  gainvz*0.05*strang
               endif
               b5(mu1-1,20) = -gainvze*0.1*strang
               b5(mu2+1,20) =  gainvze*0.1*strang
            endif
c     if(nfast.eq.1) then
c     b4(11,22)  = -gainext(1)*0.5
c     b4(16,22)  =  gainext(1)*0.5
c     b4(12,22) = -gainext(1)*0.5
c     b4(moh4,22) =  gainext(1)*0.5
c     endif
            if(nfast.eq.-1) then
               b4(11,20) = -gainz*0.05
               b4(16,20) =  gainz*0.05
               b4(12,20) = -gainz*0.05
               b4(15,20) =  gainz*0.05
            endif
            b4(12,18) = gainr*omal
            b4(11,18)  = gainr*opal
            b4(13,18) = gainr*omal
            b4(14,18) = gainr*omal
            b4(16,18)  = gainr*opal
            b4(15,18) = gainr*omal
c     
            b4(12,12)   =  0.
            b4(11,12)    =  0.
            b4(13,12)   =  0.
            b4(14,12)   =  0.
            b4(16,12)    =  0.
            b4(15,12)   =  0.
c     
            b4(12,11)    = -1.0
            b4(11,11)     =  1.0
            b4(13,11)    =  0.
            b4(14,11)    =  0.
            b4(16,11)     = -1.0
            b4(15,11)    =  1.0
c     
            b4(12,13)   =  0.
            b4(11,13)    =  0.
            b4(13,13)   = -1.0
            b4(14,13)   =  1.0
            b4(16,13)    =  0.
            b4(15,13)   =  0.
c     
            b4(12,14)   =  0.
            b4(11,14)    =  0.
            b4(13,14)   =  0.
            b4(14,14)   =  0.
            b4(16,14)    =  0.
            b4(15,14)   =  0.
c     
            b4(12,16)    =  0.5*opal
            b4(11,16)     = -1.0*omal
            b4(13,16)    =  0.5*opal
            b4(14,16)    =  0.5*opal
            b4(16,16)     = -1.0*omal
            b4(15,16)    =  0.5*opal
c     
            b4(12,15)   =  1.0
            b4(11,15)    =  0.
            b4(13,15)   = -1.0
            b4(14,15)   = -1.0
            b4(16,15)    =  0.
            b4(15,15)   =  1.0
         endif
c     
c     New coil combination (SC, 03/09/04)
         if(iscramb.eq.15) then
            if((nfast.eq.0).or.(nfast.eq.-2).or.(nfast.eq.-3)
     1           .or.(nfast.eq.-4).or.(nfast.eq.-5)) then
               b4(11,20) = -gainz*0.05
               b4(15,20) =  gainz*0.05
               b4(12,20) = -gainz*0.05
               b4(14,20) =  gainz*0.05
c     UNTRANSLATED
c     if(((inova.ne.2).and.(inova.ne.3).and.
c     1            (inova.ne.4)).or.(nfast.eq.0)) then
               if(inova.ne.2.and.inova.ne.3.and.
     1              inova.ne.4) then
c     END UNTRANSLATED
                  b5(11,20) = -gainvz*0.05*strang
                  b5(15,20) =  gainvz*0.05*strang
                  b5(12,20) = -gainvz*0.05*strang
                  b5(14,20) =  gainvz*0.05*strang
c     UNTRANSLATED
c     endif
c     if(((inova.eq.2).or.(inova.eq.3).or.
c     1               (inova.eq.4)).and.(nfast.ne.0)) then
               else
c     END UNTRANSLATED
                  b5(11,23) = -gainvz*0.05*strang
                  b5(15,23) =  gainvz*0.05*strang
                  b5(12,23) = -gainvz*0.05*strang
                  b5(14,23) =  gainvz*0.05*strang
               endif
               b5(mu1-1,20) = -gainvze*0.1*strang
               b5(mu2+1,20) =  gainvze*0.1*strang
            endif
c     if(nfast.eq.1) then
c     b4(11,22)  = -gainext(1)*0.5
c     b4(15,22)  =  gainext(1)*0.5
c     b4(12,22) = -gainext(1)*0.5
c     b4(moh4,22) =  gainext(1)*0.5
c     endif
            if(nfast.eq.-1) then
               b4(11,20) = -gainz*0.05
               b4(15,20) =  gainz*0.05
               b4(12,20) = -gainz*0.05
               b4(14,20) =  gainz*0.05
            endif
            b4(12,18) = gainr*omal
            b4(11,18)  = gainr*omal
            b4(10,18) = gainr*opal
            b4(16,18) = gainr*opal
            b4(15,18)  = gainr*omal
            b4(14,18) = gainr*omal
c     
            b4(12,12)   =  0.
            b4(11,12)    =  0.
            b4(10,12)   =  0.
            b4(16,12)   =  0.
            b4(15,12)    =  0.
            b4(14,12)   =  0.
c     
            b4(12,11)    = -1.0
            b4(11,11)     =  1.0
            b4(10,11)    =  0.
            b4(16,11)    =  0.
            b4(15,11)     = -1.0
            b4(14,11)    =  1.0
c     
            b4(12,10)   =  0.
            b4(11,10)    =  0.
            b4(10,10)   = -1.0
            b4(16,10)   =  1.0
            b4(15,10)    =  0.
            b4(14,10)   =  0.
c     
            b4(12,16)   =  0.
            b4(11,16)    =  0.
            b4(10,16)   =  0.
            b4(16,16)   =  0.
            b4(15,16)    =  0.
            b4(14,16)   =  0.
c     
            b4(12,15)    =  0.5*omal*omal
            b4(11,15)    = -0.5*(omal*omal+opal*opal)
            b4(10,15)    =  0.5*omal*opal
            b4(16,15)    =  0.5*omal*opal
            b4(15,15)    = -0.5*(omal*omal+opal*opal)
            b4(14,15)    =  0.5*omal*omal
c     
            b4(12,14)   =  1.*opal
            b4(11,14)    =  0.
            b4(10,14)   = -1.*omal
            b4(16,14)   = -1.*omal
            b4(15,14)    =  0.
            b4(14,14)   =  1.*opal
         endif
c     
c     New coil combination (SC, 03/09/04)
         if(iscramb.eq.16) then
            if((nfast.eq.0).or.(nfast.eq.-2).or.(nfast.eq.-3)
     1           .or.(nfast.eq.-4).or.(nfast.eq.-5)) then
               b4(11,20) = -gainz*0.05
               b4(14,20) =  gainz*0.05
               b4(12,20) = -gainz*0.05
               b4(13,20) =  gainz*0.05
c     UNTRANSLATED
c     if(((inova.ne.2).and.(inova.ne.3).and.
c     1            (inova.ne.4)).or.(nfast.eq.0)) then
               if(inova.ne.2.and.inova.ne.3.and.
     1              inova.ne.4) then
c     END UNTRANSLATED
                  b5(11,20) = -gainvz*0.05*strang
                  b5(14,20) =  gainvz*0.05*strang
                  b5(12,20) = -gainvz*0.05*strang
                  b5(13,20) =  gainvz*0.05*strang
c     UNTRANSLATED
c     endif
c     if(((inova.eq.2).or.(inova.eq.3).or.
c     1               (inova.eq.4)).and.(nfast.ne.0)) then
               else
c     END UNTRANSLATED
                  b5(11,23) = -gainvz*0.05*strang
                  b5(14,23) =  gainvz*0.05*strang
                  b5(12,23) = -gainvz*0.05*strang
                  b5(13,23) =  gainvz*0.05*strang
               endif
               b5(mu1-1,20) = -gainvze*0.1*strang
               b5(mu2+1,20) =  gainvze*0.1*strang
            endif
c     if(nfast.eq.1) then
c     b4(11,22)  = -gainext(1)*0.5
c     b4(14,22)  =  gainext(1)*0.5
c     b4(12,22) = -gainext(1)*0.5
c     b4(moh4,22) =  gainext(1)*0.5
c     endif
            if(nfast.eq.-1) then
               b4(11,20) = -gainz*0.05
               b4(14,20) =  gainz*0.05
               b4(12,20) = -gainz*0.05
               b4(13,20) =  gainz*0.05
            endif
            b4(12,18) = gainr*omal
            b4(11,18)  = gainr*omal
            b4(10,18) = gainr*opal
            b4(15,18) = gainr*opal
            b4(14,18)  = gainr*omal
            b4(13,18) = gainr*omal
c     
            b4(12,12)   =  0.
            b4(11,12)    =  0.
            b4(10,12)   =  0.
            b4(15,12)   =  0.
            b4(14,12)    =  0.
            b4(13,12)   =  0.
c     
            b4(12,11)    = -1.0
            b4(11,11)     =  1.0
            b4(10,11)    =  0.
            b4(15,11)    =  0.
            b4(14,11)     = -1.0
            b4(13,11)    =  1.0
c     
            b4(12,10)   =  0.
            b4(11,10)    =  0.
            b4(10,10)   = -1.0
            b4(15,10)   =  1.0
            b4(14,10)    =  0.
            b4(13,10)   =  0.
c     
            b4(12,15)   =  0.
            b4(11,15)    =  0.
            b4(10,15)   =  0.
            b4(15,15)   =  0.
            b4(14,15)    =  0.
            b4(13,15)   =  0.
c     
            b4(12,14)    =  0.5*omal*omal
            b4(11,14)    = -0.5*(omal*omal+opal*opal)
            b4(10,14)    =  0.5*omal*opal
            b4(15,14)    =  0.5*omal*opal
            b4(14,14)    = -0.5*(omal*omal+opal*opal)
            b4(13,14)    =  0.5*omal*omal
c     
            b4(12,13)   =  1.*opal
            b4(11,13)    =  0.
            b4(10,13)   = -1.*omal
            b4(15,13)   = -1.*omal
            b4(14,13)    =  0.
            b4(13,13)   =  1.*opal
         endif
c     
c     New coil combination (SC, 03/09/04)
         if(iscramb.eq.25) then
            if((nfast.eq.0).or.(nfast.eq.-2).or.(nfast.eq.-3)
     1           .or.(nfast.eq.-4).or.(nfast.eq.-5)) then
               b4(11,20) = -gainz*0.05
               b4(15,20) =  gainz*0.05
               b4(12,20) = -gainz*0.05
               b4(14,20) =  gainz*0.05
c     UNTRANSLATED
c     if(((inova.ne.2).and.(inova.ne.3).and.
c     1            (inova.ne.4)).or.(nfast.eq.0)) then
               if(inova.ne.2.and.inova.ne.3.and.
     1              inova.ne.4) then
c     END UNTRANSLATED
                  b5(11,20) = -gainvz*0.05*strang
                  b5(15,20) =  gainvz*0.05*strang
                  b5(12,20) = -gainvz*0.05*strang
                  b5(14,20) =  gainvz*0.05*strang
c     UNTRANSLATED
c     endif
c     if(((inova.eq.2).or.(inova.eq.3).or.
c     1               (inova.eq.4)).and.(nfast.ne.0)) then
               else
c     END UNTRANSLATED
                  b5(11,23) = -gainvz*0.05*strang
                  b5(15,23) =  gainvz*0.05*strang
                  b5(12,23) = -gainvz*0.05*strang
                  b5(14,23) =  gainvz*0.05*strang
               endif
               b5(mu1-1,20) = -gainvze*0.1*strang
               b5(mu2+1,20) =  gainvze*0.1*strang
            endif
c     if(nfast.eq.1) then
c     b4(11,22)  = -gainext(1)*0.5
c     b4(15,22)  =  gainext(1)*0.5
c     b4(12,22) = -gainext(1)*0.5
c     b4(moh4,22) =  gainext(1)*0.5
c     endif
            if(nfast.eq.-1) then
               b4(11,20) = -gainz*0.05
               b4(15,20) =  gainz*0.05
               b4(12,20) = -gainz*0.05
               b4(14,20) =  gainz*0.05
            endif
            b4(12,18) = gainr*omal
            b4(11,18)  = gainr*omal
            b4(10,18) = gainr*opal
            b4(16,18) = gainr*opal
            b4(15,18)  = gainr*omal
            b4(14,18) = gainr*omal
c     
            b4(12,12)   =  0.
            b4(11,12)    =  0.
            b4(10,12)   =  0.
            b4(16,12)   =  0.
            b4(15,12)    =  0.
            b4(14,12)   =  0.
c     
            b4(12,11)    =  1.0
            b4(11,11)    = -1.0
            b4(10,11)    =  1.0
            b4(16,11)    = -1.0
            b4(15,11)     = 1.0
            b4(14,11)    = -1.0
c     
            b4(12,10)   = -0.5
            b4(11,10)   =  0.5
            b4(10,10)   =  1.0
            b4(16,10)   = -1.0
            b4(15,10)   = -0.5
            b4(14,10)   =  0.5
c     
            b4(12,16)   =  0.
            b4(11,16)    =  0.
            b4(10,16)   =  0.
            b4(16,16)   =  0.
            b4(15,16)    =  0.
            b4(14,16)   =  0.
c     
            b4(12,15)    =  0.5*omal
            b4(11,15)    = -0.5*(omal+opal)
            b4(10,15)    =  0.5*omal
            b4(16,15)    =  0.5*omal
            b4(15,15)    = -0.5*(omal+opal)
            b4(14,15)    =  0.5*omal
c     
            b4(12,14)   =  1.
            b4(11,14)    =  0.
            b4(10,14)   = -1.
            b4(16,14)   = -1.
            b4(15,14)    =  0.
            b4(14,14)   =  1.
         endif
c     
c     New coil combination (SC, 03/09/04)
         if(iscramb.eq.26) then
            if((nfast.eq.0).or.(nfast.eq.-2).or.(nfast.eq.-3)
     1           .or.(nfast.eq.-4).or.(nfast.eq.-5)) then
               b4(11,20) = -gainz*0.05
               b4(14,20) =  gainz*0.05
               b4(12,20) = -gainz*0.05
               b4(13,20) =  gainz*0.05
c     UNTRANSLATED
c     if(((inova.ne.2).and.(inova.ne.3).and.
c     1            (inova.ne.4)).or.(nfast.eq.0)) then
               if(inova.ne.2.and.inova.ne.3.and.
     1              inova.ne.4) then
c     END UNTRANSLATED
                  b5(11,20) = -gainvz*0.05*strang
                  b5(14,20) =  gainvz*0.05*strang
                  b5(12,20) = -gainvz*0.05*strang
                  b5(13,20) =  gainvz*0.05*strang
c     UNTRANSLATED
c     endif
c     if(((inova.eq.2).or.(inova.eq.3).or.
c     1               (inova.eq.4)).and.(nfast.ne.0)) then
               else
c     END UNTRANSLATED
                  b5(11,23) = -gainvz*0.05*strang
                  b5(14,23) =  gainvz*0.05*strang
                  b5(12,23) = -gainvz*0.05*strang
                  b5(13,23) =  gainvz*0.05*strang
               endif
               b5(mu1-1,20) = -gainvze*0.1*strang
               b5(mu2+1,20) =  gainvze*0.1*strang
            endif
c     if(nfast.eq.1) then
c     b4(11,22)  = -gainext(1)*0.5
c     b4(14,22)  =  gainext(1)*0.5
c     b4(12,22) = -gainext(1)*0.5
c     b4(moh4,22) =  gainext(1)*0.5
c     endif
            if(nfast.eq.-1) then
               b4(11,20) = -gainz*0.05
               b4(14,20) =  gainz*0.05
               b4(12,20) = -gainz*0.05
               b4(13,20) =  gainz*0.05
            endif
            b4(12,18) = gainr*omal
            b4(11,18)  = gainr*omal
            b4(10,18) = gainr*opal
            b4(15,18) = gainr*opal
            b4(14,18)  = gainr*omal
            b4(13,18) = gainr*omal
c     
            b4(12,12)   =  0.
            b4(11,12)    =  0.
            b4(10,12)   =  0.
            b4(15,12)   =  0.
            b4(14,12)    =  0.
            b4(13,12)   =  0.
c     
            b4(12,11)    =  1.0
            b4(11,11)    = -1.0
            b4(10,11)    =  1.0
            b4(15,11)    = -1.0
            b4(14,11)     = 1.0
            b4(13,11)    = -1.0
c     
            b4(12,10)   = -0.5
            b4(11,10)   =  0.5
            b4(10,10)   =  1.0
            b4(15,10)   = -1.0
            b4(14,10)   = -0.5
            b4(13,10)   =  0.5
c     
            b4(12,15)   =  0.
            b4(11,15)    =  0.
            b4(10,15)   =  0.
            b4(15,15)   =  0.
            b4(14,15)    =  0.
            b4(13,15)   =  0.
c     
            b4(12,14)    =  0.5*omal
            b4(11,14)    = -0.5*(omal+opal)
            b4(10,14)    =  0.5*omal
            b4(15,14)    =  0.5*omal
            b4(14,14)    = -0.5*(omal+opal)
            b4(13,14)    =  0.5*omal
c     
            b4(12,13)   =  1.
            b4(11,13)    =  0.
            b4(10,13)   = -1.
            b4(15,13)   = -1.
            b4(14,13)    =  0.
            b4(13,13)   =  1.
         endif
c     
         if((iscramb.eq.3).or.(iscramb.eq.13)) then
c     New coil combination for the case zax<0 (SC, 17/02/05)
            if(zax(nzaxre).gt.0..or.iscramb.eq.13) then
               b4(11,11)    = 0.
               b4(12,12)  = 0.
               b4(16,16)  = 0.
               b4(10,11)   =  1.0*omal
               b4(12,11)   = -1.0*opal
               b4(14,11)   = -1.0*opal
               b4(16,11)   =  1.0*omal
               b4(11,10)   = -1.0
               b4(10,10)  =  1.0
               b4(15,10)  =  1.0
               b4(16,10)  = -1.0
               b4(10,18)  = gainr*opal
               b4(12,18)  = gainr*omal
               b4(14,18)  = gainr*omal
               b4(16,18)  = gainr*opal
               b4(12,14)  = -1.0
               b4(14,14)  =  1.0
               b4(11,15)   =  1.0
               b4(15,15)  =  1.0
               if((nfast.eq.0).or.(nfast.eq.-2).or.(nfast.eq.-3)
     1              .or.(nfast.eq.-4).or.(nfast.eq.-5)) then
                  b4(11,20)   = -gainz*0.0448
                  b4(10,20)  = -gainz*0.0448
                  b4(15,20)  =  gainz*0.0556
                  b4(16,20)  =  gainz*0.0556
c     
c     UNTRANSLATED
c     if(((inova.ne.2).and.(inova.ne.3).and.
c     1         (inova.ne.4)).or.(nfast.eq.0)) then
                  if(inova.ne.2.and.inova.ne.3.and.
     1                 inova.ne.4) then
c     END UNTRANSLATED
                     b5(11,20)   = -gainvz*0.0448*strang
                     b5(10,20)  = -gainvz*0.0448*strang
                     b5(15,20)  =  gainvz*0.0556*strang
                     b5(16,20)  =  gainvz*0.0556*strang
c     UNTRANSLATED
c     endif
c     if(((inova.eq.2).or.(inova.eq.3).or.
c     1            (inova.eq.4)).and.(nfast.ne.0)) then
                  else
c     END UNTRANSLATED
                     b5(11,23)   = -gainvz*0.0448*strang
                     b5(10,23)  = -gainvz*0.0448*strang
                     b5(15,23)  =  gainvz*0.0556*strang
                     b5(16,23)  =  gainvz*0.0556*strang
                  endif
c     
                  b5(3,20)   = -gainvze*0.1*strang
                  b5(7,20)   =  gainvze*0.1*strang
               endif
c     if(nfast.eq.1) then
c     b4(11,22)   = -gainext(1)*0.448
c     b4(10,22)  = -gainext(1)*0.448
c     b4(15,22)  =  gainext(1)*0.556
c     b4(16,22)  =  gainext(1)*0.556
c     endif
               if(nfast.eq.-1) then
                  b4(11,20)   = -gainz*0.0448
                  b4(10,20)  = -gainz*0.0448
                  b4(15,20)  =  gainz*0.0556
                  b4(16,20)  =  gainz*0.0556
               endif
            else
               b4(10,10)    = 0.
               b4(11,11)  = 0.
               b4(15,15)  = 0.
               b4(9,10)   =  1.0*omal
               b4(11,10)   = -1.0*opal
               b4(13,10)   = -1.0*opal
               b4(15,10)   =  1.0*omal
               b4(10,9)   = -1.0
               b4(9,9)  =  1.0
               b4(14,9)  =  1.0
               b4(15,9)  = -1.0
               b4(9,18)  = gainr*opal
               b4(11,18)  = gainr*omal
               b4(13,18)  = gainr*omal
               b4(15,18)  = gainr*opal
               b4(11,13)  = -1.0
               b4(13,13)  =  1.0
               b4(10,14)   =  1.0
               b4(14,14)  =  1.0
               if((nfast.eq.0).or.(nfast.eq.-2).or.(nfast.eq.-3)
     1              .or.(nfast.eq.-4).or.(nfast.eq.-5)) then
                  b4(10,20)   = -gainz*0.0448
                  b4(9,20)  = -gainz*0.0448
                  b4(14,20)  =  gainz*0.0556
                  b4(15,20)  =  gainz*0.0556
c     
c     UNTRANSLATED
c     if(((inova.ne.2).and.(inova.ne.3).and.
c     1         (inova.ne.4)).or.(nfast.eq.0)) then
                  if(inova.ne.2.and.inova.ne.3.and.
     1                 inova.ne.4) then
c     END UNTRANSLATED
                     b5(10,20)   = -gainvz*0.0448*strang
                     b5(9,20)  = -gainvz*0.0448*strang
                     b5(14,20)  =  gainvz*0.0556*strang
                     b5(15,20)  =  gainvz*0.0556*strang
c     UNTRANSLATED
c     endif
c     if(((inova.eq.2).or.(inova.eq.3).or.
c     1            (inova.eq.4)).and.(nfast.ne.0)) then
                  else
c     END UNTRANSLATED
                     b5(10,23)   = -gainvz*0.0448*strang
                     b5(9,23)  = -gainvz*0.0448*strang
                     b5(14,23)  =  gainvz*0.0556*strang
                     b5(15,23)  =  gainvz*0.0556*strang
                  endif
c     
                  b5(3,20)   = -gainvze*0.1*strang
                  b5(7,20)   =  gainvze*0.1*strang
               endif
c     if(nfast.eq.1) then
c     b4(10,22)   = -gainext(1)*0.448
c     b4(9,22)  = -gainext(1)*0.448
c     b4(14,22)  =  gainext(1)*0.556
c     b4(15,22)  =  gainext(1)*0.556
c     endif
               if(nfast.eq.-1) then
                  b4(10,20)   = -gainz*0.0448
                  b4(9,20)  = -gainz*0.0448
                  b4(14,20)  =  gainz*0.0556
                  b4(15,20)  =  gainz*0.0556
               endif
            endif
         endif
         if(iscramb.eq.13) then
            b4(2,2)    =  0.25
            b4(8,2)    = -0.25
            b4(4,4)    =  0.25
            b4(6,4)    = -0.25
            b4(2,6)    =  0.25
            b4(4,6)    =  0.25
            b4(6,6)    =  0.25
            b4(8,6)    =  0.25
            b4(2,8)    =  0.25*alpha1
            b4(4,8)    = -0.25*alpha1
            b4(6,8)    = -0.25*alpha1
            b4(8,8)    =  0.25*alpha1
            b4(2,18)   =  alpha*gainr
            b4(4,18)   = -alpha*gainr
            b4(6,18)   = -alpha*gainr
            b4(8,18)   =  alpha*gainr
            b4(10,8)   = -0.25*alpha*alpha1
            b4(11,8)   = -0.25*alpha*alpha1
            b4(13,8)   = -0.25*alpha*alpha1
            b4(16,8)   = -0.25*alpha*alpha1
         endif
c     
         if((iscramb.eq.4).or.(iscramb.eq.14)) then
            b4(9,9)    = 0.
            b4(11,11)  = 0.
            b4(15,15)  = 0.
            b4(16,16)  = 0.
            b4(10,9)   =  1.0
            b4(11,9)   = -1.0
            b4(14,9)   = -1.0
            b4(15,9)   =  1.0
            b4(9,10)   = -1.0
            b4(10,10)  =  1.0
            b4(15,10)  = -1.0
            b4(16,10)  =  1.0
            b4(10,18)  = gainr
            b4(11,18)  = gainr
            b4(14,18)  = gainr
            b4(15,18)  = gainr
            b4(11,14)  = -1.0
            b4(14,14)  =  1.0
            b4(9,15)   =  1.0
            b4(16,15)  =  1.0
            if((nfast.eq.0).or.(nfast.eq.-2).or.(nfast.eq.-3)
     1           .or.(nfast.eq.-4).or.(nfast.eq.-5)) then
               b4(9,20)   = -gainz*0.05
               b4(10,20)  = -gainz*0.05
               b4(15,20)  =  gainz*0.05
               b4(16,20)  =  gainz*0.05
c     UNTRANSLATED
c     if(((inova.ne.2).and.(inova.ne.3).and.
c     1            (inova.ne.4)).or.(nfast.eq.0)) then
               if(inova.ne.2.and.inova.ne.3.and.
     1              inova.ne.4) then
c     END UNTRANSLATED
                  b5(9,20)   = -gainvz*0.05*strang
                  b5(10,20)  = -gainvz*0.05*strang
                  b5(15,20)  =  gainvz*0.05*strang
                  b5(16,20)  =  gainvz*0.05*strang
c     UNTRANSLATED
c     endif
c     if(((inova.eq.2).or.(inova.eq.3).or.
c     1               (inova.eq.4)).and.(nfast.ne.0)) then
               else
c     END UNTRANSLATED
                  b5(9,23)   = -gainvz*0.05*strang
                  b5(10,23)  = -gainvz*0.05*strang
                  b5(15,23)  =  gainvz*0.05*strang
                  b5(16,23)  =  gainvz*0.05*strang
               endif
               b5(3,20)   = -gainvze*0.1*strang
               b5(6,20)   =  gainvze*0.1*strang
            endif
c     if(nfast.eq.1) then
c     b4(9,22)   = -gainext(1)*0.5
c     b4(10,22)  = -gainext(1)*0.5
c     b4(15,22)  =  gainext(1)*0.5
c     b4(16,22)  =  gainext(1)*0.5
c     endif
            if(nfast.eq.-1) then
               b4(9,20)   = -gainz*0.05
               b4(10,20)  = -gainz*0.05
               b4(15,20)  =  gainz*0.05
               b4(16,20)  =  gainz*0.05
            endif
         endif
         if(iscramb.eq.14) then
            b4(1,1)    =  0.25
            b4(8,1)    = -0.25
            b4(4,4)    =  0.25
            b4(5,4)    = -0.25
            b4(1,5)    =  0.25
            b4(4,5)    =  0.25
            b4(5,5)    =  0.25
            b4(8,5)    =  0.25
            b4(1,8)    =  0.25*alpha1
            b4(4,8)    = -0.25*alpha1
            b4(5,8)    = -0.25*alpha1
            b4(8,8)    =  0.25*alpha1
            b4(10,8)   = -0.25*alpha*alpha1
            b4(11,8)   = -0.25*alpha*alpha1
            b4(14,8)   = -0.25*alpha*alpha1
            b4(15,8)   = -0.25*alpha*alpha1
            b4(1,18)   =  alpha*gainr
            b4(4,18)   = -alpha*gainr
            b4(5,18)   = -alpha*gainr
            b4(8,18)   =  alpha*gainr
         endif
         if(iscramb.eq.5) then
            b4(11,11)    = 0.
            b4(10,10)  = 0.
            b4(14,14)  = 0.
            b4(16,16)  = 0.
            b4(10,11)   = -1.0*omal
            b4(12,11)   =  1.0*opal
            b4(14,11)   =  1.0*opal
            b4(16,11)   = -1.0*omal
            b4(11,10)   = -1.0
            b4(12,10)  =  1.0
            b4(15,10)  =  1.0
            b4(14,10)  = -1.0
            b4(10,18)  = gainr*opal
            b4(12,18)  = gainr*omal
            b4(14,18)  = gainr*omal
            b4(16,18)  = gainr*opal
            b4(10,14)  = -1.0
            b4(16,14)  =  1.0
            b4(11,15)   =  1.0
            b4(15,15)  =  1.0
            if((nfast.eq.0).or.(nfast.eq.-2).or.(nfast.eq.-3)
     1           .or.(nfast.eq.-4).or.(nfast.eq.-5)) then
               b4(11,20)   = -gainz*0.05
               b4(12,20)  = -gainz*0.05
               b4(15,20)  =  gainz*0.05
               b4(14,20)  =  gainz*0.05
c     
c     UNTRANSLATED
c     if(((inova.ne.2).and.(inova.ne.3).and.
c     1         (inova.ne.4)).or.(nfast.eq.0)) then
               if(inova.ne.2.and.inova.ne.3.and.
     1              inova.ne.4) then
c     END UNTRANSLATED
                  b5(11,20)   = -gainvz*0.05*strang
                  b5(12,20)  = -gainvz*0.05*strang
                  b5(15,20)  =  gainvz*0.05*strang
                  b5(14,20)  =  gainvz*0.05*strang
c     UNTRANSLATED
c     endif
c     if(((inova.eq.2).or.(inova.eq.3).or.
c     1            (inova.eq.4)).and.(nfast.ne.0)) then
               else
c     END UNTRANSLATED
                  b5(11,23)   = -gainvz*0.05*strang
                  b5(12,23)  = -gainvz*0.05*strang
                  b5(15,23)  =  gainvz*0.05*strang
                  b5(14,23)  =  gainvz*0.05*strang
               endif
c     
               b5(3,20)   = -gainvze*0.1*strang
               b5(7,20)   =  gainvze*0.1*strang
            endif
            if(nfast.eq.-1) then
               b4(11,20)   = -gainz*0.05
               b4(12,20)  = -gainz*0.05
               b4(15,20)  =  gainz*0.05
               b4(14,20)  =  gainz*0.05
            endif
         endif
         if(iscramb.eq.6) then
            b4(12,12)  = 0.
            b4(13,13)  = 0.
            b4(14,14)  = 0.
            b4(16,16)  = 0.
            b4(9,9)    = -1.0*omal
            b4(11,9)   =  1.0*opal
            b4(14,9)   =  1.0*opal
            b4(16,9)   = -1.0*omal
            b4(11,11)  =  1.0
            b4(12,11)  = -1.0
            b4(13,11)  =  1.0
            b4(14,11)  = -1.0
            b4(9,18)   = gainr*opal
            b4(11,18)  = gainr*omal
            b4(14,18)  = gainr*omal
            b4(16,18)  = gainr*opal
            b4(9,13)   = -1.0
            b4(16,13)  =  1.0
            b4(12,14)  =  1.0
            b4(13,14)  =  1.0
            if((nfast.eq.0).or.(nfast.eq.-2).or.(nfast.eq.-3)
     1           .or.(nfast.eq.-4).or.(nfast.eq.-5)) then
               b4(11,20)   = -gainz*0.05
               b4(12,20)  = -gainz*0.05
               b4(13,20)  =  gainz*0.05
               b4(14,20)  =  gainz*0.05
c     
c     UNTRANSLATED
c     if(((inova.ne.2).and.(inova.ne.3).and.
c     1         (inova.ne.4)).or.(nfast.eq.0)) then
               if(inova.ne.2.and.inova.ne.3.and.
     1              inova.ne.4) then
c     END UNTRANSLATED
                  b5(11,20)   = -gainvz*0.05*strang
                  b5(12,20)  = -gainvz*0.05*strang
                  b5(13,20)  =  gainvz*0.05*strang
                  b5(14,20)  =  gainvz*0.05*strang
c     UNTRANSLATED
c     endif
c     if(((inova.eq.2).or.(inova.eq.3).or.
c     1            (inova.eq.4)).and.(nfast.ne.0)) then
               else
c     END UNTRANSLATED
                  b5(11,23)   = -gainvz*0.05*strang
                  b5(12,23)  = -gainvz*0.05*strang
                  b5(13,23)  =  gainvz*0.05*strang
                  b5(14,23)  =  gainvz*0.05*strang
               endif
c     
               b5(3,20)   = -gainvze*0.1*strang
               b5(7,20)   =  gainvze*0.1*strang
            endif
            if(nfast.eq.-1) then
               b4(11,20)   = -gainz*0.05
               b4(12,20)  = -gainz*0.05
               b4(13,20)  =  gainz*0.05
               b4(14,20)  =  gainz*0.05
            endif
         endif
c     
c     New coil combination for small plasmas (SC, 03/09/04)
         if(iscramb.eq.9) then
            b4(11,11)    = 0.
            b4(13,13)  = 0.
            b4(15,15)  = 0.
            b4(16,16)  = 0.
            b4(12,11)   =  1.0*omal
            b4(13,11)   = -1.0*opal
            b4(14,11)   = -1.0*opal
            b4(15,11)   =  1.0*omal
            b4(11,12)   = -1.0
            b4(12,12)  =  1.0
            b4(15,12)  = -1.0
            b4(16,12)  =  1.0
            b4(12,18)  = gainr*opal
            b4(13,18)  = gainr*omal
            b4(14,18)  = gainr*omal
            b4(15,18)  = gainr*opal
            b4(13,14)  = -1.0
            b4(14,14)  =  1.0
            b4(11,15)   =  1.0
            b4(16,15)  =  1.0
            if((nfast.eq.0).or.(nfast.eq.-2).or.(nfast.eq.-3)
     1           .or.(nfast.eq.-4).or.(nfast.eq.-5)) then
               b4(11,20)   = -gainz*0.05
               b4(12,20)  = -gainz*0.05
               b4(15,20)  =  gainz*0.05
               b4(16,20)  =  gainz*0.05
c     UNTRANSLATED
c     if(((inova.ne.2).and.(inova.ne.3).and.
c     1            (inova.ne.4)).or.(nfast.eq.0)) then
               if(inova.ne.2.and.inova.ne.3.and.
     1              inova.ne.4) then
c     END UNTRANSLATED
                  b5(11,20)   = -gainvz*0.05*strang
                  b5(12,20)  = -gainvz*0.05*strang
                  b5(15,20)  =  gainvz*0.05*strang
                  b5(16,20)  =  gainvz*0.05*strang
c     UNTRANSLATED
c     endif
c     if(((inova.eq.2).or.(inova.eq.3).or.
c     1               (inova.eq.4)).and.(nfast.ne.0)) then
               else
c     END UNTRANSLATED
                  b5(11,23)  = -gainvz*0.05*strang
                  b5(12,23)  = -gainvz*0.05*strang
                  b5(15,23)  =  gainvz*0.05*strang
                  b5(16,23)  =  gainvz*0.05*strang
               endif
               b5(3,20)   = -gainvze*0.1*strang
               b5(6,20)   =  gainvze*0.1*strang
            endif
c     if(nfast.eq.1) then
c     b4(11,22)   = -gainext(1)*0.5
c     b4(12,22)  = -gainext(1)*0.5
c     b4(15,22)  =  gainext(1)*0.5
c     b4(16,22)  =  gainext(1)*0.5
c     endif
            if(nfast.eq.-1) then
               b4(11,20)   = -gainz*0.05
               b4(12,20)  = -gainz*0.05
               b4(15,20)  =  gainz*0.05
               b4(16,20)  =  gainz*0.05
            endif
         endif
c     
c----------------------------------fast-----------------------------
         if(nfast.eq.1) then
            b4(22,20) = -gainz*0.1
            b5(22,20) = -gainvz*0.1*strang
         endif
         if((nfast.eq.-1).or.(nfast.eq.-2).or.(nfast.eq.-3)
     1        .or.(nfast.eq.-4).or.(nfast.eq.-5)) then
c     b4(22,20) = -gainz*0.1*gainext(1)
            if(ikriz.ne.2) b5(22,20) = -gainvz*0.1*strang
            if((ikriz.eq.2).and.(nfast.ne.-5)) then
               if(inova.ne.4) then
                  b5(22,23) = -gainvz*0.1*strang
               else
c     inova=4 option introduced (SC, 21/04/05)
                  b5(22,3) = -gainvz*0.1*strang
               endif
            endif
c     UNTRANSLATED
c     if((ikriz.eq.2).and.(nfast.eq.-5))
c     1              b4(22,24) = -gainvz*2.5*strang
            if((ikriz.eq.2).and.(nfast.eq.-5))
     1           b4(22,24) = -gainvz*0.1*strang
c     END UNTRANSLATED
c-----------------------------------------------------------
c     b4(22,22) = boost
c     b5(22,22) = uc1
         endif
c------------------------------------------------------------------
c     
         do 779 i=1,nrg
            do 778 j=1,ncg
               b3a(i,j) = b3(i,j)
               b4a(i,j) = b4(i,j)
               b5a(i,j) = b5(i,j)
 778        continue
 779     continue
c     
c-------------------------hgain feedback----------------------------
c     
c----------------hgain now used as differential feedback on density----------
c     
c     if((hgain.ne.0.).and.(iscramb.eq.2)) then
c     b4a(21,21)   = 0.
c     b4a(mu3,21)  = -hgain
c     b4a(mu4,21)  =  hgain
c     b4a(moh1,21) = -hgain
c     b4a(moh4,21) =  hgain
c     endif
c     
c-----prepare first matrix for current control without r,z feedback-------
c     
         do i=1,nrg
            b3(i,18) = 0.
            b4(i,18) = 0.
            b5(i,18) = 0.
            b3(i,20) = 0.
            b4(i,20) = 0.
            b5(i,20) = 0.
            b3(i,22) = 0.
            b4(i,22) = 0.
            b5(i,22) = 0.
            b3(i,23) = 0.
            b4(i,23) = 0.
            b5(i,23) = 0.
            b3(i,24) = 0.
            b4(i,24) = 0.
            b5(i,24) = 0.
         enddo
         if(inova.eq.4) then
            do i=1,nrg
               b3(i,3) = 0.
               b4(i,3) = 0.
               b5(i,3) = 0.
            enddo
         endif
c     
c---  differential and integral feedback on density = zero in first matrix
c     
         b3(21,21) = 0.
         b5(21,21) = 0.
c     
c     direct coil current control (SC, 06/10/09)
         if(iscramb.eq.0) then
            b4(mu3,mu3) =  1.4
            b4(mu4,mu3) =  0.
            b4(mu3,mu4) =  0.
            b4(mu4,mu4) =  1.4
            b4(17,18) = 0.39
            b4(18,18) = 0.39
            b4(17,19) = 0.
            b4(18,19) = 0.
            b3(17,19) = 0.
            b3(18,19) = 0.
c     ADDED 16/03/16 (SC)
            b3(mu3,mu3) =  0.4
            b3(mu4,mu4) =  0.4
c     
         endif
         if(iscramb.eq.1) then
            b4(mu3,mu3) =  1.
            b4(mu4,mu3) = -1.
            b4(mu3,mu4) =  1.
            b4(mu4,mu4) =  1.
         endif
         if(iscramb.eq.2) then
            b4(moh1,mu3) =  1.
            b4(mu3,mu3)  =  1.
            b4(mu4,mu4)  =  1.
            b4(moh4,mu4) =  1.
         endif
c     New coil combination for Snowflake plasmas - top 4 coils (FP, 05/02/09)
         if(iscramb.eq.61) then
            b4(13,14) =  1.
            b4(14,14) =  1.
            b4(15,15) =  1.
            b4(16,15) =  1.
         endif
c     New coil combination for Snowflake plasmas - bot 4 coils (FP, 05/02/09)
         if(iscramb.eq.62) then
            b4(11,12) =  1.
            b4(12,12) =  1.
            b4(13,13) =  1.
            b4(14,13) =  1.
         endif
c     New coil combination for lower snowflake BOT-4 coils (SC, 22/04/16)
         if(iscramb.eq.63) then
            b4(10,11) =  1.
            b4(11,11) =  1.
            b4(13,13) =  1.
            b4(14,13) =  1.
         endif
         if(iscramb.eq.7) then
            b4(11,12) =  1.
            b4(12,12)  =  1.
            b4(14,14)  =  1.
            b4(15,14) =  1.
         endif
c     New coil combination for small plasmas (SC, 06/09/04)
         if(iscramb.eq.36) then
            b4(11,12) =  -1.
            b4(12,12)  = -1.
            b4(13,12) =  +1.
            b4(14,12)  = +1.
            b4(11,14)  =  1.
            b4(12,14) =  1.
            b4(13,14)  =  1.
            b4(14,14) =  1.
         endif
c     New coil combination for small plasmas (SC, 03/09/04)
         if(iscramb.eq.8) then
            b4(12,13) =  -1.
            b4(13,13) =  -1.
            b4(14,13) =   1.
            b4(15,13) =   1.
            b4(12,14) =   1.*opal
            b4(13,14) =   1.*omal
            b4(14,14) =   1.*omal
            b4(15,14) =   1.*opal
         endif
c     New coil combination for small plasmas at the top (SC, 18/01/05)
         if(iscramb.eq.10) then
            b4(13,14) =  -1.
            b4(14,14) =  -1.
            b4(15,14) =   1.
            b4(16,14) =   1.
            b4(13,15) =   1.*opal
            b4(14,15) =   1.*omal
            b4(15,15) =   1.*omal
            b4(16,15) =   1.*opal
         endif
c     New coil combination for smallish plasmas at the top (SC, 19/03/13)
         if(iscramb.eq.11) then
            b4(12,13) =  -1.
            b4(13,13) =  -1.
            b4(15,13) =   1.
            b4(16,13) =   1.
            b4(12,15) =   1.*opal
            b4(13,15) =   1.*omal
            b4(15,15) =   1.*omal
            b4(16,15) =   1.*opal
         endif
         if((iscramb.eq.12).or.(iscramb.eq.22)) then
            b4(moh1,moh1)   =  1.
            b4(mu3,moh1)    =  1.
            b4(moh2,moh1)   =  1.
            b4(moh3,moh1)   =  1.
            b4(mu4,moh1)    =  1.
            b4(moh4,moh1)   =  1.
c     
            b4(moh1,moh3)   = -1.
            b4(mu3,moh3)    = -1.
            b4(moh2,moh3)   =  0.
            b4(moh3,moh3)   =  0.
            b4(mu4,moh3)    =  1.
            b4(moh4,moh3)   =  1.
         endif
c     New coil combination for small plasmas (SC, 03/09/04)
         if(iscramb.eq.19) then
            b4(12,12)   =  1.*omal
            b4(11,12)    =  1.*opal
            b4(13,12)   =  1.*omal
            b4(14,12)   =  1.*omal
            b4(16,12)    =  1.*opal
            b4(15,12)   =  1.*omal
c     
            b4(12,14)   = -1.
            b4(11,14)    = -1.
            b4(13,14)   =  0.
            b4(14,14)   =  0.
            b4(16,14)    =  1.
            b4(15,14)   =  1.
         endif
c     
c     New coil combination (SC, 03/09/04)
         if(iscramb.eq.15) then
            b4(12,12)   =  1.*omal
            b4(11,12)    = 1.*omal
            b4(10,12)   =  1.*opal
            b4(16,12)   =  1.*opal
            b4(15,12)    = 1.*omal
            b4(14,12)   =  1.*omal
c     
            b4(12,16)   = -1.
            b4(11,16)    = -1.
            b4(10,16)   =  0.
            b4(16,16)   =  0.
            b4(15,16)    =  1.
            b4(14,16)   =  1.
         endif
c     
c     New coil combination (SC, 03/09/04)
         if(iscramb.eq.16) then
            b4(12,12)   =  1.*omal
            b4(11,12)    = 1.*omal
            b4(10,12)   =  1.*opal
            b4(15,12)   =  1.*opal
            b4(14,12)    = 1.*omal
            b4(13,12)   =  1.*omal
c     
            b4(12,15)   = -1.
            b4(11,15)    = -1.
            b4(10,15)   =  0.
            b4(15,15)   =  0.
            b4(14,15)    =  1.
            b4(13,15)   =  1.
         endif
c     
c     New coil combination (SC, 03/09/04)
         if(iscramb.eq.25) then
            b4(12,12)   =  1.*omal
            b4(11,12)    = 1.*omal
            b4(10,12)   =  1.*opal
            b4(16,12)   =  1.*opal
            b4(15,12)    = 1.*omal
            b4(14,12)   =  1.*omal
c     
            b4(12,16)   = -1.
            b4(11,16)    = -1.
            b4(10,16)   =  0.
            b4(16,16)   =  0.
            b4(15,16)    =  1.
            b4(14,16)   =  1.
         endif
c     
c     New coil combination (SC, 03/09/04)
         if(iscramb.eq.26) then
            b4(12,12)   =  1.*omal
            b4(11,12)    = 1.*omal
            b4(10,12)   =  1.*opal
            b4(15,12)   =  1.*opal
            b4(14,12)    = 1.*omal
            b4(13,12)   =  1.*omal
c     
            b4(12,15)   = -1.
            b4(11,15)    = -1.
            b4(10,15)   =  0.
            b4(15,15)   =  0.
            b4(14,15)    =  1.
            b4(13,15)   =  1.
         endif
c     
         if(iscramb.eq.3) then
c     New coil combination for the case zax<0 (SC, 17/02/05)
            if(zax(nzaxre).gt.0.) then
               b4(10,12)     =  1.*opal
               b4(12,12)     =  1.*omal
               b4(14,12)     =  1.*omal
               b4(16,12)     =  1.*opal
               b4(11,16)      = -1.
               b4(10,16)     = -1.
               b4(15,16)     =  1.
               b4(16,16)     =  1.
            else
               b4(9,11)     =  1.*opal
               b4(11,11)     =  1.*omal
               b4(13,11)     =  1.*omal
               b4(15,11)     =  1.*opal
               b4(10,15)      = -1.
               b4(9,15)     = -1.
               b4(14,15)     =  1.
               b4(15,15)     =  1.
            endif
         endif
         if(iscramb.eq.13) then
            b4(2,12)   =  alpha*alpha1
            b4(4,12)   = -alpha*alpha1
            b4(6,12)   = -alpha*alpha1
            b4(8,12)   =  alpha*alpha1
            b4(10,12)  =  alpha1
            b4(12,12)  =  alpha1
            b4(14,12)  =  alpha1
            b4(16,12)  =  alpha1
            b4(9,16)   = -1.
            b4(10,16)  = -1.
            b4(15,16)  =  1.
            b4(16,16)  =  1.
         endif
         if(iscramb.eq.4) then
            b4(10,11)     =  1.
            b4(11,11)     =  1.
            b4(14,11)     =  1.
            b4(15,11)     =  1.
            b4(9,16)      = -1.
            b4(10,16)     = -1.
            b4(15,16)     =  1.
            b4(16,16)     =  1.
         endif
         if(iscramb.eq.14) then
            b4(1,11)   =  alpha*alpha1
            b4(4,11)   = -alpha*alpha1
            b4(5,11)   = -alpha*alpha1
            b4(8,11)   =  alpha*alpha1
            b4(10,11)  =  alpha1
            b4(11,11)  =  alpha1
            b4(14,11)  =  alpha1
            b4(15,11)  =  alpha1
            b4(9,16)   = -1.
            b4(10,16)  = -1.
            b4(15,16)  =  1.
            b4(16,16)  =  1.
         endif
         if(iscramb.eq.5) then
            b4(10,12)     =  1.*opal
            b4(12,12)     =  1.*omal
            b4(14,12)     =  1.*omal
            b4(16,12)     =  1.*opal
            b4(11,16)      = -1.
            b4(12,16)     = -1.
            b4(15,16)     =  1.
            b4(14,16)     =  1.
            b4(16,16)     =  0.
         endif
         if(iscramb.eq.6) then
            b4(9,12)      =  1.*opal
            b4(11,12)     =  1.*omal
            b4(14,12)     =  1.*omal
            b4(16,12)     =  1.*opal
            b4(12,12)     =  0.
            b4(11,16)     = -1.
            b4(12,16)     = -1.
            b4(13,16)     =  1.
            b4(14,16)     =  1.
            b4(16,16)     =  0.
         endif
c     New coil combination for small plasmas (SC, 03/09/04)
         if(iscramb.eq.9) then
            b4(12,13)     =  1.*opal
            b4(13,13)     =  1.*omal
            b4(14,13)     =  1.*omal
            b4(15,13)     =  1.*opal
            b4(11,16)      = -1.
            b4(12,16)     = -1.
            b4(15,16)     =  1.
            b4(16,16)     =  1.
         endif
c     
c------------------------------------------------------------------------
c     
         do n=1,msw
            do i=1,nrg
               do j=1,ncg
c     UNTRANSLATED
                  if((n.eq.1).or.(n.gt.6)) then
c     END UNTRANSLATED
                     g1sw(i,j,n) = b3(i,j)
                     g2sw(i,j,n) = b4(i,j)
                     g3sw(i,j,n) = b5(i,j)
                  endif
c     UNTRANSLATED
                  if((n.eq.2).or.(n.eq.3).or.(n.eq.4).or.(n.eq.5).or.(n.eq.6)) then
c     END UNTRANSLATED
                  g1sw(i,j,n) = b3a(i,j)
                  g2sw(i,j,n) = b4a(i,j)
                  g3sw(i,j,n) = b5a(i,j)
               endif
            enddo
         enddo
      enddo
      if((mvloop(1).eq.1).or.(mvloop(1).eq.2).or.(mvloop(1).eq.12)) then
         if(aipgain(3).eq.0.) aipgain(3)=0.39
c     reduced from 0.25 to 0.1 (SC, 10/10/03)
c     increased to 0.39 (SC, 03/03/05)
c     pegged to aipgain (SC, 26/04/05)
         g2sw(17,1,4) =  aipgain(3)
         g2sw(18,1,4) =  aipgain(3)
         g2sw(17,1,5) =  aipgain(3)
         g2sw(18,1,5) =  aipgain(3)
      endif
c     mvloop(1)=11 or =21 (Vloop feedback) option added (SC, 23/9/03)
c     pegged to aipgain (SC, 26/04/05)
      if(mvloop(1).eq.11.or.mvloop(1).eq.21) then
         if(aipgain(3).eq.0.) aipgain(2)=100.
         g2sw(17,1,4) =  aipgain(3)
         g2sw(18,1,4) =  aipgain(3)
         g2sw(17,1,5) =  aipgain(3)
         g2sw(18,1,5) =  aipgain(3)
      endif
      if(mvloop(1).eq.11) then
         g1sw(17,1,4) =  aipgain(4)
         g1sw(18,1,4) =  aipgain(4)
         g1sw(17,1,5) =  aipgain(4)
         g1sw(18,1,5) =  aipgain(4)
      endif
c     mvloop(1)=2 (two-component IOH feedback) option added (SC, 06/04/05)
      if(mvloop(1).eq.2.or.mvloop(1).eq.12) then
         g2sw(17,2,4) =  g2sw(17,1,4)
         g2sw(18,2,4) =  g2sw(18,1,4)
         g2sw(17,2,5) =  g2sw(17,1,5)
         g2sw(18,2,5) =  g2sw(18,1,5)
      endif
c     mvloop(1)=5 (plasma current control by ECRH power) option added (SC, 01/11/06)
      if(mod(mvloop(1),10).eq.5) then
         ipch=19
         if (mvloop(1).gt.100) ipch=4
         if(aipgain(3).eq.0.) aipgain(3)=0.39
         g2sw(17,1,4) =  aipgain(3)
         g2sw(18,1,4) =  aipgain(3)
         g2sw(17,1,5) =  aipgain(3)
         g2sw(18,1,5) =  aipgain(3)
         if(aipgain(5).eq.0.) aipgain(5)=21.0
         if(iohfb.eq.-1) aipgain(5)=-aipgain(5)
         g2sw(1,ipch,4) =  aipgain(5)
         g2sw(1,ipch,5) =  aipgain(5)
         if(aipgain(6).eq.0.) aipgain(6)=200.0
         if(iohfb.eq.-1) aipgain(6)=-aipgain(6)
         g1sw(1,ipch,4) =  aipgain(6)
         g1sw(1,ipch,5) =  aipgain(6)
         if (mod(mvloop(1),100).eq.25) then
            if(iohfb.eq.-1) aipgain(7)=-aipgain(7)
            if(aipgain(7).eq.0.) aipgain(7)=aipgain(5)
            g2sw(2,ipch,4) =  aipgain(7)
            g2sw(2,ipch,5) =  aipgain(7)
            if(iohfb.eq.-1) aipgain(8)=-aipgain(8)
            if(aipgain(8).eq.0.) aipgain(8)=aipgain(6)
            g1sw(2,ipch,4) =  aipgain(8)
            g1sw(2,ipch,5) =  aipgain(8)
         endif
      endif
c     mvloop(1)=6 (plasma elongation control by ECRH) option added (SC, 02/11/06)
      if(mvloop(1).eq.6) then
         do imv=1,7
            if (mvloop(imv+1).ne.0) then
c     first digit of mvloop(imv+1) defines observer channel
               if (mvloop(imv+1)/10.eq.0) then
                  iinch=22
               else
                  iinch=1
               endif
               if (imv.lt.3) then
                  ioutch=imv
               else
                  ioutch=imv+1
               endif
c     second digit of mvloop(imv+1) defines RHVPS (1-2) or mirror (3-8)
               if (mod(mvloop(imv+1),10).lt.3) then
                  gainka2=25.
                  gainka1=825.
               else
c     these signs are based on the assumption that larger mirror angles mean
c     lower rhos; if reversed (e.g. for EQ launcher pointing downwards),
c     change all the following signs
                  if (iinch.eq.22) then
                     gainka2=-0.0071
                     gainka1=-0.2343
                  else
                     gainka2=-0.0112
                     gainka1=0.
                  endif
               endif
               if(gainext(2+2*imv).eq.0.) gainext(2+2*imv)=gainka2
               if(iohfb.eq.-1) gainext(2+2*imv)=-gainext(2+2*imv)
               if(iinch.eq.1) gainext(2+2*imv)=-gainext(2+2*imv)
               g2sw(ioutch,iinch,5) =  gainext(2+2*imv)
               if(gainext(3+2*imv).eq.0.) gainext(3+2*imv)=gainka1
               if(iohfb.eq.-1) gainext(3+2*imv)=-gainext(3+2*imv)
               if(iinch.eq.1) gainext(3+2*imv)=-gainext(3+2*imv)
               g1sw(ioutch,iinch,5) =  gainext(3+2*imv)
            endif
         enddo
      endif
c     
      if(iscramb.ne.0) then
c     Clamp OH feedback gain during breakdown and ramp-up (SC, 08/11/06-27/10/09)
c     IERAT=4 case added (SC, 07/10/11)
         if (ierat.ne.4) then
c     IERAT=-1 (SC, 16/06/20)
            if (ierat.eq.-1) then
               if(aipgain(3).eq.0.) aipgain(3)=0.39
               g2sw(17,22,1) =  aipgain(3)
               g2sw(18,22,1) =  aipgain(3)
               g2sw(17,19,1) = 0.
               g2sw(18,19,1) = 0.
               g1sw(17,22,1) = aipgain(3)*5.
               g1sw(18,22,1) = aipgain(3)*5.
            else
               if (abs(aipgain(1)).gt.0.01) then
                  g2sw(17,19,1) = -0.01
                  g2sw(18,19,1) = -0.01
                  g2sw(17,19,2) = -0.01
                  g2sw(18,19,2) = -0.01
               endif
            endif
         else
            if(aipgain(3).eq.0.) aipgain(3)=0.39
            g2sw(17,1,1) =  aipgain(3)
            g2sw(18,1,1) =  aipgain(3)
            g2sw(17,19,1) = 0.
            g2sw(18,19,1) = 0.
c     Add integral term to IERAT=4 (SC, 15/11/12)
            g1sw(17,1,1) = aipgain(3)*5.
            g1sw(18,1,1) = aipgain(3)*5.
            if (abs(aipgain(1)).gt.0.01) then
               g2sw(17,19,2) = -0.01
               g2sw(18,19,2) = -0.01
               g2sw(17,19,8) = -0.01
               g2sw(18,19,8) = -0.01
            endif
         endif
      endif
c     do this for 100% bootstrap
c     g2sw(17,19,1) = 0.0
c     g2sw(18,19,1) = 0.0
c--------------------------switch off OH feedback--------------------
      g2sw(17,19,4) = 0.
      g2sw(18,19,4) = 0.
      g1sw(17,19,4) = 0.
      g1sw(18,19,4) = 0.
      if((mvloop(1).eq.1).or.(mvloop(1).eq.11).or.(mvloop(1).eq.21).or.
     +     (mvloop(1).eq.2).or.(mvloop(1).eq.12)) then
         g2sw(17,19,5) = 0.
         g2sw(18,19,5) = 0.
         g1sw(17,19,5) = 0.
         g1sw(18,19,5) = 0.
      endif
c     mvloop(1)=5 (plasma current control by ECRH power) option added (SC, 01/11/06)
      if(mod(mvloop(1),10).eq.5) then
         g2sw(17,19,5) = 0.
         g2sw(18,19,5) = 0.
         g1sw(17,19,5) = 0.
         g1sw(18,19,5) = 0.
      endif
c--------------------------------------------------------------------
c----------------------------fps retarded----------------------------
      g3sw(22,20,2) = 0.
      g3sw(22,23,2) = 0.
      if(inova.eq.4) g3sw(22,3,2) = 0.
c     UNTRANSLATED 2013 (12/7/13)
      g3sw(22,20,7) = g3sw(22,20,3)
      g3sw(22,23,7) = g3sw(22,23,3)
      g3sw(22,3,7) = g3sw(22,3,3)
c     END UNTRANSLATED
c----------------------------gas gain reduced -----------------------
c     UNTRANSLATED
      g2sw(21,21,1) = 0.0
      g2sw(21,21,8) = 0.0
c     END UNTRANSLATED
      g2sw(21,21,2) = 0.1
c     No integral gain on current in first two matrices
      g1sw(17,19,1) = 0.0
      g1sw(18,19,1) = 0.0
      g1sw(17,19,2) = 0.0
      g1sw(18,19,2) = 0.0
      g1sw(17,19,8) = 0.0
      g1sw(18,19,8) = 0.0
c--------------------------------------------------------------------
      if((iscramb.eq.12).or.(iscramb.eq.22)) then
         g2sw(moh1,moh4,5)   =  0.
         g2sw(mu3,moh4,5)    =  0.
         g2sw(moh2,moh4,5)   =  0.
         g2sw(moh3,moh4,5)   =  0.
         g2sw(mu4,moh4,5)    =  0.
         g2sw(moh4,moh4,5)   =  0.
c     
c     UNTRANSLATED
         g2sw(moh1,moh4,6)   =  0.
         g2sw(mu3,moh4,6)    =  0.
         g2sw(moh2,moh4,6)   =  0.
         g2sw(moh3,moh4,6)   =  0.
         g2sw(mu4,moh4,6)    =  0.
         g2sw(moh4,moh4,6)   =  0.
c     END UNTRANSLATED
c     
         g2sw(moh1,22,5)     = gainext(1)
         g2sw(mu3,22,5)      = 0.
         g2sw(moh2,22,5)     = -gainext(1)
         g2sw(moh3,22,5)     = -gainext(1)
         g2sw(mu4,22,5)      = 0.
         g2sw(moh4,22,5)     = gainext(1)
c     
c     UNTRANSLATED
         g2sw(moh1,22,6)     = gainext(1)
         g2sw(mu3,22,6)      = 0.
         g2sw(moh2,22,6)     = -gainext(1)
         g2sw(moh3,22,6)     = -gainext(1)
         g2sw(mu4,22,6)      = 0.
         g2sw(moh4,22,6)     = gainext(1)
c     END UNTRANSLATED
      endif
c     
c     New coil combination for small plasmas (SC, 03/09/04)
      if(iscramb.eq.19) then
         g2sw(12,15,5)   =  0.
         g2sw(11,15,5)    =  0.
         g2sw(13,15,5)   =  0.
         g2sw(14,15,5)   =  0.
         g2sw(16,15,5)    =  0.
         g2sw(15,15,5)   =  0.
c     
c     UNTRANSLATED
         g2sw(12,15,6)   =  0.
         g2sw(11,15,6)    =  0.
         g2sw(13,15,6)   =  0.
         g2sw(14,15,6)   =  0.
         g2sw(16,15,6)    =  0.
         g2sw(15,15,6)   =  0.
c     END UNTRANSLATED
c     
         g2sw(12,22,5)     = gainext(1)
         g2sw(11,22,5)      = 0.
         g2sw(13,22,5)     = -gainext(1)
         g2sw(14,22,5)     = -gainext(1)
         g2sw(16,22,5)      = 0.
         g2sw(15,22,5)     = gainext(1)
c     
c     UNTRANSLATED
         g2sw(12,22,6)     = gainext(1)
         g2sw(11,22,6)      = 0.
         g2sw(13,22,6)     = -gainext(1)
         g2sw(14,22,6)     = -gainext(1)
         g2sw(16,22,6)      = 0.
         g2sw(15,22,6)     = gainext(1)
c     END UNTRANSLATED
      endif
c     
c     New coil combination (SC, 03/09/04)
      if(iscramb.eq.15) then
         g2sw(12,14,5)   =  0.
         g2sw(11,14,5)    =  0.
         g2sw(10,14,5)   =  0.
         g2sw(16,14,5)   =  0.
         g2sw(15,14,5)    =  0.
         g2sw(14,14,5)   =  0.
c     
c     UNTRANSLATED
         g2sw(12,14,6)   =  0.
         g2sw(11,14,6)    =  0.
         g2sw(10,14,6)   =  0.
         g2sw(16,14,6)   =  0.
         g2sw(15,14,6)    =  0.
         g2sw(14,14,6)   =  0.
c     END UNTRANSLATED
c     
         g2sw(12,22,5)     = -gainext(1)*opal
         g2sw(11,22,5)      = 0.
         g2sw(10,22,5)     = gainext(1)*omal
         g2sw(16,22,5)     = gainext(1)*omal
         g2sw(15,22,5)      = 0.
         g2sw(14,22,5)     = -gainext(1)*opal
c     
c     UNTRANSLATED
         g2sw(12,22,6)     = -gainext(1)*opal
         g2sw(11,22,6)      = 0.
         g2sw(10,22,6)     = gainext(1)*omal
         g2sw(16,22,6)     = gainext(1)*omal
         g2sw(15,22,6)      = 0.
         g2sw(14,22,6)     = -gainext(1)*opal
c     END UNTRANSLATED
      endif
c     
c     New coil combination (SC, 03/09/04)
      if(iscramb.eq.16) then
         g2sw(12,13,5)   =  0.
         g2sw(11,13,5)    =  0.
         g2sw(10,13,5)   =  0.
         g2sw(15,13,5)   =  0.
         g2sw(14,13,5)    =  0.
         g2sw(13,13,5)   =  0.
c     
c     UNTRANSLATED
         g2sw(12,13,6)   =  0.
         g2sw(11,13,6)    =  0.
         g2sw(10,13,6)   =  0.
         g2sw(15,13,6)   =  0.
         g2sw(14,13,6)    =  0.
         g2sw(13,13,6)   =  0.
c     END UNTRANSLATED
c     
         g2sw(12,22,5)     = -gainext(1)*opal
         g2sw(11,22,5)      = 0.
         g2sw(10,22,5)     = gainext(1)*omal
         g2sw(15,22,5)     = gainext(1)*omal
         g2sw(14,22,5)      = 0.
         g2sw(13,22,5)     = -gainext(1)*opal
c     
c     UNTRANSLATED
         g2sw(12,22,6)     = -gainext(1)*opal
         g2sw(11,22,6)      = 0.
         g2sw(10,22,6)     = gainext(1)*omal
         g2sw(15,22,6)     = gainext(1)*omal
         g2sw(14,22,6)      = 0.
         g2sw(13,22,6)     = -gainext(1)*opal
c     END UNTRANSLATED
      endif
c     
c     New coil combination (SC, 03/09/04)
      if(iscramb.eq.25) then
         g2sw(12,14,5)   =  0.
         g2sw(11,14,5)    =  0.
         g2sw(10,14,5)   =  0.
         g2sw(16,14,5)   =  0.
         g2sw(15,14,5)    =  0.
         g2sw(14,14,5)   =  0.
c     
c     UNTRANSLATED
         g2sw(12,14,6)   =  0.
         g2sw(11,14,6)    =  0.
         g2sw(10,14,6)   =  0.
         g2sw(16,14,6)   =  0.
         g2sw(15,14,6)    =  0.
         g2sw(14,14,6)   =  0.
c     END UNTRANSLATED
c     
         g2sw(12,22,5)     = -gainext(1)
         g2sw(11,22,5)      = 0.
         g2sw(10,22,5)     = gainext(1)
         g2sw(16,22,5)     = gainext(1)
         g2sw(15,22,5)      = 0.
         g2sw(14,22,5)     = -gainext(1)
c     
c     UNTRANSLATED
         g2sw(12,22,6)     = -gainext(1)
         g2sw(11,22,6)      = 0.
         g2sw(10,22,6)     = gainext(1)
         g2sw(16,22,6)     = gainext(1)
         g2sw(15,22,6)      = 0.
         g2sw(14,22,6)     = -gainext(1)
c     END UNTRANSLATED
      endif
c     
c     New coil combination (SC, 03/09/04)
      if(iscramb.eq.26) then
         g2sw(12,13,5)   =  0.
         g2sw(11,13,5)    =  0.
         g2sw(10,13,5)   =  0.
         g2sw(15,13,5)   =  0.
         g2sw(14,13,5)    =  0.
         g2sw(13,13,5)   =  0.
c     
c     UNTRANSLATED
         g2sw(12,13,6)   =  0.
         g2sw(11,13,6)    =  0.
         g2sw(10,13,6)   =  0.
         g2sw(15,13,6)   =  0.
         g2sw(14,13,6)    =  0.
         g2sw(13,13,6)   =  0.
c     END UNTRANSLATED
c     
         g2sw(12,22,5)     = -gainext(1)
         g2sw(11,22,5)      = 0.
         g2sw(10,22,5)     = gainext(1)
         g2sw(15,22,5)     = gainext(1)
         g2sw(14,22,5)      = 0.
         g2sw(13,22,5)     = -gainext(1)
c     
c     UNTRANSLATED
         g2sw(12,22,6)     = -gainext(1)
         g2sw(11,22,6)      = 0.
         g2sw(10,22,6)     = gainext(1)
         g2sw(15,22,6)     = gainext(1)
         g2sw(14,22,6)      = 0.
         g2sw(13,22,6)     = -gainext(1)
c     END UNTRANSLATED
      endif
c     
c     New coil combination (SC, 06/09/04)
      if(iscramb.eq.36) then
         g2sw(11,13,5)   =  0.
         g2sw(12,13,5)    =  0.
         g2sw(13,13,5)   =  0.
         g2sw(14,13,5)   =  0.
c     
c     UNTRANSLATED
         g2sw(11,13,6)   =  0.
         g2sw(12,13,6)    =  0.
         g2sw(13,13,6)   =  0.
         g2sw(14,13,6)   =  0.
c     END UNTRANSLATED
c     
         g2sw(11,22,5)     = gainext(1)
         g2sw(12,22,5)     = -gainext(1)
         g2sw(13,22,5)     = -gainext(1)
         g2sw(14,22,5)     = gainext(1)
c     
c     UNTRANSLATED
         g2sw(11,22,6)     = gainext(1)
         g2sw(12,22,6)     = -gainext(1)
         g2sw(13,22,6)     = -gainext(1)
         g2sw(14,22,6)     = gainext(1)
c     END UNTRANSLATED
      endif
c----------------switch off radial (iscramb = 1, 2, 7, 8) and vertical
c     (iscramb = 1, 2, 4, 7, 8, 9) feedback---------------
      if(iprmax.eq.1)  then
         if(iscramb.eq.1) then
            g2sw(mu3,20,3)   = 0.
            g2sw(mu4,20,3)   = 0.
            g3sw(mu3,20,3)   = 0.
            g3sw(mu4,20,3)   = 0.
            g3sw(mu1-1,20,3) = 0.
            g3sw(mu2+1,20,3) = 0.
            g2sw(mu3,18,3)   = 0.
            g2sw(mu4,18,3)   = 0.
         endif
         if(iscramb.eq.2) then
            g2sw(mu3,20,3)   = 0.
            g2sw(mu4,20,3)   = 0.
            g3sw(mu3,20,3)   = 0.
            g3sw(mu4,20,3)   = 0.
            g2sw(moh1,20,3)  = 0.
            g2sw(moh4,20,3)  = 0.
            g3sw(moh1,20,3)  = 0.
            g3sw(moh4,20,3)  = 0.
            g3sw(mu1-1,20,3) = 0.
            g3sw(mu2+1,20,3) = 0.
            g2sw(mu3,18,3)   = 0.
            g2sw(mu4,18,3)   = 0.
            g2sw(moh1,18,3)  = 0.
            g2sw(moh4,18,3)  = 0.
         endif
c     New coil combination for snowflake plasmas - top 4 coils (FP, 05/02/09)
         if(iscramb.eq.61) then
            g2sw(14,20,3)   = 0.
            g2sw(15,20,3)   = 0.
            g3sw(14,20,3)   = 0.
            g3sw(15,20,3)   = 0.
            g2sw(13,20,3)   = 0.
            g2sw(16,20,3)   = 0.
            g3sw(13,20,3)   = 0.
            g3sw(16,20,3)   = 0.
            g3sw(5,20,3)    = 0.
            g3sw(8,20,3)    = 0.
            g2sw(14,18,3)   = 0.
            g2sw(15,18,3)   = 0.
            g2sw(13,18,3)   = 0.
            g2sw(16,18,3)   = 0.
         endif
c     New coil combination for snowflake plasmas - bot 4 coils (FP, 05/02/09)
         if(iscramb.eq.62) then
            g2sw(12,20,3)   = 0.
            g2sw(13,20,3)   = 0.
            g3sw(12,20,3)   = 0.
            g3sw(13,20,3)   = 0.
            g2sw(12,20,3)   = 0.
            g2sw(14,20,3)   = 0.
            g3sw(11,20,3)   = 0.
            g3sw(14,20,3)   = 0.
            g3sw(3,20,3)    = 0.
            g3sw(6,20,3)    = 0.
            g2sw(12,18,3)   = 0.
            g2sw(13,18,3)   = 0.
            g2sw(11,18,3)   = 0.
            g2sw(14,18,3)   = 0.
         endif
c     New coil combination for lower snowflake BOT-4 coils (SC, 22/04/16)
         if(iscramb.eq.63) then
            g2sw(11,20,3)   = 0.
            g2sw(13,20,3)   = 0.
            g3sw(11,20,3)   = 0.
            g3sw(13,20,3)   = 0.
            g2sw(11,20,3)   = 0.
            g2sw(14,20,3)   = 0.
            g3sw(10,20,3)   = 0.
            g3sw(14,20,3)   = 0.
            g3sw(3,20,3)    = 0.
            g3sw(6,20,3)    = 0.
            g2sw(11,18,3)   = 0.
            g2sw(13,18,3)   = 0.
            g2sw(10,18,3)   = 0.
            g2sw(14,18,3)   = 0.
         endif
         if(iscramb.eq.7) then
            g2sw(12,20,3)   = 0.
            g2sw(14,20,3)   = 0.
            g3sw(12,20,3)   = 0.
            g3sw(14,20,3)   = 0.
            g2sw(11,20,3)  = 0.
            g2sw(15,20,3)  = 0.
            g3sw(11,20,3)  = 0.
            g3sw(15,20,3)  = 0.
            g2sw(12,18,3)   = 0.
            g2sw(14,18,3)   = 0.
            g2sw(11,18,3)  = 0.
            g2sw(15,18,3)  = 0.
         endif
c     New coil combination for small plasmas (SC, 03/09/04)
         if(iscramb.eq.8) then
            g2sw(13,20,3)   = 0.
            g2sw(14,20,3)   = 0.
            g3sw(13,20,3)   = 0.
            g3sw(14,20,3)   = 0.
            g2sw(12,20,3)  = 0.
            g2sw(15,20,3)  = 0.
            g3sw(12,20,3)  = 0.
            g3sw(15,20,3)  = 0.
            g2sw(13,18,3)   = 0.
            g2sw(14,18,3)   = 0.
            g2sw(12,18,3)  = 0.
            g2sw(15,18,3)  = 0.
         endif
c     New coil combination for small plasmas at the top (SC, 18/01/05)
         if(iscramb.eq.10) then
            g2sw(14,20,3)   = 0.
            g2sw(15,20,3)   = 0.
            g3sw(14,20,3)   = 0.
            g3sw(15,20,3)   = 0.
            g2sw(13,20,3)  = 0.
            g2sw(16,20,3)  = 0.
            g3sw(13,20,3)  = 0.
            g3sw(16,20,3)  = 0.
            g2sw(14,18,3)   = 0.
            g2sw(15,18,3)   = 0.
            g2sw(13,18,3)  = 0.
            g2sw(16,18,3)  = 0.
         endif
c     New coil combination for smallish plasmas at the top (SC, 19/03/13)
         if(iscramb.eq.11) then
            g2sw(13,20,3)   = 0.
            g2sw(15,20,3)   = 0.
            g3sw(13,20,3)   = 0.
            g3sw(15,20,3)   = 0.
            g2sw(12,20,3)  = 0.
            g2sw(16,20,3)  = 0.
            g3sw(12,20,3)  = 0.
            g3sw(16,20,3)  = 0.
            g2sw(13,18,3)   = 0.
            g2sw(15,18,3)   = 0.
            g2sw(12,18,3)  = 0.
            g2sw(16,18,3)  = 0.
         endif
         if(iscramb.eq.4) then
            g2sw(11,11,3)  = 0.
            g2sw(14,11,3)  = 0.
            g2sw(9,20,3)   = 0.
            g2sw(10,20,3)  = 0.
            g2sw(15,20,3)  = 0.
            g2sw(16,20,3)  = 0.
            g3sw(9,20,3)   = 0.
            g3sw(10,20,3)  = 0.
            g3sw(15,20,3)  = 0.
            g3sw(16,20,3)  = 0.
            g3sw(3,20,3)   = 0.
            g3sw(6,20,3)   = 0.
         endif
c     New coil combination for small plasmas (SC, 03/09/04)
         if(iscramb.eq.9) then
            g2sw(13,13,3)  = 0.
            g2sw(14,13,3)  = 0.
            g2sw(11,20,3)   = 0.
            g2sw(12,20,3)  = 0.
            g2sw(15,20,3)  = 0.
            g2sw(16,20,3)  = 0.
            g3sw(11,20,3)   = 0.
            g3sw(12,20,3)  = 0.
            g3sw(15,20,3)  = 0.
            g3sw(16,20,3)  = 0.
            g3sw(3,20,3)   = 0.
            g3sw(6,20,3)   = 0.
         endif
         if(nfast.ne.0) then
            g2sw(22,20,3) = 0.
            g3sw(22,20,3) = 0.
            g2sw(22,23,3) = 0.
            g3sw(22,23,3) = 0.
         endif
      endif
c     if(((nfast.eq.-2).or.(nfast.eq.-3).or.(nfast.eq.-5)).and.
c     1 (iprmax.eq.2)) then
c     g2sw(22,22,1)   = boost
c     g3sw(22,22,1)   = uc1
c     g3sw(22,22,2)   = uc1
c     endif
c     
      endif
c     
c     
c     
c     
c     Temporary increase in gains (SC, 09/11/05)
c     do n=3,6
c     g2sw(17,17,n)   =  g2sw(17,17,n)*4.
c     g2sw(18,17,n)   =  g2sw(18,17,n)*4.
c     g2sw(17,19,n) =    g2sw(17,19,n)*4.
c     g2sw(18,19,n) =    g2sw(18,19,n)*4.
c     enddo
c     
c     
c     
      if(midplan.eq.8) then
c     
         do n=1,msw
            do i=1,nrg
               do j=1,ncg
                  g1sw(i,j,n) = 0.
                  g2sw(i,j,n) = 0.
                  g3sw(i,j,n) = 0.
               enddo
            enddo
         enddo
c     
         do n=1,4
            g2sw(21,21,n) = (0.1/6.0)*abs(gain)
            g1sw(21,21,n) = (0.1/6.0)*ggain
            g3sw(21,21,n) = (0.1/6.0)*hgain
c-------------------------------------------------------------------
            g2sw(17,17,n)   =  0.25*ohsame
            g2sw(18,17,n)   = -0.25*ohsame
            g1sw(17,17,n)   =  0.25*ohsami
            g1sw(18,17,n)   = -0.25*ohsami
            g2sw(17,19,n) = -aipgain(1)
            g2sw(18,19,n) = -aipgain(1)
            g1sw(17,19,n) = -aipgain(2)
            g1sw(18,19,n) = -aipgain(2)
         enddo
c     
         do n=1,4
            do i=1,8
               g2sw(i,i,n) = 0.25
            enddo
            g2sw(10,10,n) = 1.
            g2sw(11,11,n) = 1.
            g2sw(14,14,n) = 1.
            g2sw(15,15,n) = 1.
c     
         enddo
c     
         g2sw(9,9,1)   =  1.167
         g2sw(12,9,1)  = -1.069
         g2sw(13,9,1)  = -1.056
         g2sw(16,9,1)  = -0.472
         g2sw(9,12,1)  =  1.177
         g2sw(12,12,1) =  1.448
         g2sw(13,12,1) =  0.856
         g2sw(16,12,1) =  0.350
         g2sw(9,13,1)  =  0.350
         g2sw(12,13,1) =  0.856
         g2sw(13,13,1) =  1.448
         g2sw(16,13,1) =  1.177
         g2sw(9,16,1)  =  0.472
         g2sw(12,16,1) =  1.056
         g2sw(13,16,1) =  1.069
         g2sw(16,16,1) = -1.167
c---------------------------------iplatop=1-----------------------------
         if(iplatop.eq.1) then
c     g2sw(9,23,2)  =  0.141*gainr
c     g2sw(12,23,2) = -0.508*gainr
c     g2sw(13,23,2) =  0.603*gainr
c     g2sw(16,23,2) =  0.150*gainr
            g2sw(9,18,2)  =  0.141*gainr
            g2sw(12,18,2) = -0.508*gainr
            g2sw(13,18,2) =  0.603*gainr
            g2sw(16,18,2) =  0.150*gainr
            g2sw(9,9,2)   =  0.770
            g2sw(12,9,2)  = -0.827
            g2sw(13,9,2)  =  0.377
            g2sw(16,9,2)  = -0.091
            g2sw(9,12,2)  =  0.150
            g2sw(12,12,2) =  0.603
            g2sw(13,12,2) = -0.508
            g2sw(16,12,2) =  0.141
            g2sw(9,16,2)  =  0.091
            g2sw(12,16,2) = -0.377
            g2sw(13,16,2) =  0.827
            g2sw(16,16,2) = -0.770
         endif
c---------------------------------iplatop=-1-----------------------------
         if(iplatop.eq.-1) then
            g2sw(9,23,2)  =  0.150*gainr
            g2sw(12,23,2) =  0.603*gainr
            g2sw(13,23,2) = -0.508*gainr
            g2sw(16,23,2) =  0.141*gainr
c     g2sw(9,18,2)  =  0.150*gainr
c     g2sw(12,18,2) =  0.603*gainr
c     g2sw(13,18,2) = -0.508*gainr
c     g2sw(16,18,2) =  0.141*gainr
            g2sw(9,9,2)   =  0.770
            g2sw(12,9,2)  = -0.827
            g2sw(13,9,2)  =  0.377
            g2sw(16,9,2)  = -0.091
            g2sw(9,13,2)  =  0.141
            g2sw(12,13,2) = -0.508
            g2sw(13,13,2) =  0.603
            g2sw(16,13,2) =  0.150
            g2sw(9,16,2)  =  0.091
            g2sw(12,16,2) = -0.377
            g2sw(13,16,2) =  0.827
            g2sw(16,16,2) = -0.770
         endif
c---------------------------------iplatop=0-----------------------------
         if(iplatop.eq.0) then
            g2sw(9,23,2)  =  0.150*gainr
            g2sw(12,23,2) =  0.603*gainr
            g2sw(13,23,2) = -0.508*gainr
            g2sw(16,23,2) =  0.141*gainr
            g2sw(9,18,2)  =  0.141*gainr
            g2sw(12,18,2) = -0.508*gainr
            g2sw(13,18,2) =  0.603*gainr
            g2sw(16,18,2) =  0.150*gainr
            g2sw(9,9,2)   =  0.770
            g2sw(12,9,2)  = -0.827
            g2sw(13,9,2)  =  0.377
            g2sw(16,9,2)  = -0.091
            g2sw(9,16,2)  =  0.091
            g2sw(12,16,2) = -0.377
            g2sw(13,16,2) =  0.827
            g2sw(16,16,2) = -0.770
         endif
c---------------------------------iplatop=1-----------------------------
         if(iplatop.eq.1) then
            do m=3,4
               g2sw(9,9,m)   =  0.770
               g2sw(12,9,m)  = -0.827
               g2sw(13,9,m)  =  0.377
               g2sw(16,9,m)  = -0.091
               g2sw(9,12,m)  =  0.150
               g2sw(12,12,m) =  0.603
               g2sw(13,12,m) = -0.508
               g2sw(16,12,m) =  0.141
c     g2sw(9,23,m)  =  0.141*gainr
c     g2sw(12,23,m) = -0.508*gainr
c     g2sw(13,23,m) =  0.603*gainr
c     g2sw(16,23,m) =  0.150*gainr
               g2sw(9,18,m)  =  0.141*gainr
               g2sw(12,18,m) = -0.508*gainr
               g2sw(13,18,m) =  0.603*gainr
               g2sw(16,18,m) =  0.150*gainr
               g2sw(9,20,m)  = -0.091*0.1*gainz
               g2sw(12,20,m) =  0.377*0.1*gainz
               g2sw(13,20,m) = -0.827*0.1*gainz
               g2sw(16,20,m) =  0.770*0.1*gainz
               g3sw(9,20,m)  = -0.091*0.1*gainvz*strang
               g3sw(12,20,m) =  0.377*0.1*gainvz*strang
               g3sw(13,20,m) = -0.827*0.1*gainvz*strang
               g3sw(16,20,m) =  0.770*0.1*gainvz*strang
            enddo
         endif
c---------------------------------iplatop=-1----------------------------
         if(iplatop.eq.-1) then
            do m=3,4
               g2sw(9,13,m)  =  0.141
               g2sw(12,13,m) = -0.508
               g2sw(13,13,m) =  0.603
               g2sw(16,13,m) =  0.150
               g2sw(9,16,m)  =  0.091
               g2sw(12,16,m) = -0.377
               g2sw(13,16,m) =  0.827
               g2sw(16,16,m) = -0.770
               g2sw(9,23,m)  =  0.150*gainr
               g2sw(12,23,m) =  0.603*gainr
               g2sw(13,23,m) = -0.508*gainr
               g2sw(16,23,m) =  0.141*gainr
c     g2sw(9,18,m)  =  0.150*gainr
c     g2sw(12,18,m) =  0.603*gainr
c     g2sw(13,18,m) = -0.508*gainr
c     g2sw(16,18,m) =  0.141*gainr
               g2sw(9,22,m)  =  0.770*0.1*gainz
               g2sw(12,22,m) = -0.827*0.1*gainz
               g2sw(13,22,m) =  0.377*0.1*gainz
               g2sw(16,22,m) = -0.091*0.1*gainz
               g3sw(9,22,m)  =  0.770*0.1*gainvz*strang
               g3sw(12,22,m) = -0.827*0.1*gainvz*strang
               g3sw(13,22,m) =  0.377*0.1*gainvz*strang
               g3sw(16,22,m) = -0.091*0.1*gainvz*strang
            enddo
         endif
c---------------------------------iplatop=0------------------------------
         if(iplatop.eq.0) then
            do m=3,4
               g2sw(9,18,m)  =  0.141*gainr
               g2sw(12,18,m) = -0.508*gainr
               g2sw(13,18,m) =  0.603*gainr
               g2sw(16,18,m) =  0.150*gainr
               g2sw(9,20,m)  = -0.091*0.1*gainz
               g2sw(12,20,m) =  0.377*0.1*gainz
               g2sw(13,20,m) = -0.827*0.1*gainz
               g2sw(16,20,m) =  0.770*0.1*gainz
               g3sw(9,20,m)  = -0.091*0.1*gainvz*strang
               g3sw(12,20,m) =  0.377*0.1*gainvz*strang
               g3sw(13,20,m) = -0.827*0.1*gainvz*strang
               g3sw(16,20,m) =  0.770*0.1*gainvz*strang
               g2sw(9,22,m)  =  0.770*0.1*gainz
               g2sw(12,22,m) = -0.827*0.1*gainz
               g2sw(13,22,m) =  0.377*0.1*gainz
               g2sw(16,22,m) = -0.091*0.1*gainz
               g3sw(9,22,m)  =  0.770*0.1*gainvz*strang
               g3sw(12,22,m) = -0.827*0.1*gainvz*strang
               g3sw(13,22,m) =  0.377*0.1*gainvz*strang
               g3sw(16,22,m) = -0.091*0.1*gainvz*strang
               g2sw(9,23,m)  =  0.150*gainr
               g2sw(12,23,m) =  0.603*gainr
               g2sw(13,23,m) = -0.508*gainr
               g2sw(16,23,m) =  0.141*gainr
            enddo
         endif
c     
c     if(iplatop.eq.1) then
c     do n=1,4
c     do j=1,ncg
c     if(n.gt.1) g2sw(9,j,n)  = g2sw(9,j,1)
c     if(n.gt.1) g2sw(12,j,n) = g2sw(12,j,1)
c     g3sw(9,j,n)  = 0.
c     g3sw(12,j,n) = 0.
c     enddo
c     enddo
c     endif
c     
c     if(iplatop.eq.-1) then
c     do n=1,4
c     do j=1,ncg
c     if(n.gt.1) g2sw(13,j,n) = g2sw(13,j,1)
c     if(n.gt.1) g2sw(16,j,n) = g2sw(16,j,1)
c     g3sw(13,j,n) = 0.
c     g3sw(16,j,n) = 0.
c     enddo
c     enddo
c     endif
c     
      endif
c     
      g2sw(21,21,7) = g2sw(21,21,3)
      g1sw(21,21,7) = g1sw(21,21,3)
      g3sw(21,21,7) = g3sw(21,21,3)
c     g2sw(17,19,8) = 2.*g2sw(17,19,3)
c     g2sw(18,19,8) = 2.*g2sw(18,19,3)
c     do i=1,ncg
      do j=1,nrg
         g3sw(j,3,7) = g3sw(j,3,3)*.45
         g3sw(j,20,7) = g3sw(j,20,3)*.45
         g3sw(j,23,7) = g3sw(j,23,3)*.45
         g3sw(j,24,7) = g3sw(j,24,3)*.45
      enddo
c     enddo
      do i=1,ncg
         do j=1,nrg
            g1sw(j,i,9) = g1sw(j,i,3)
            g2sw(j,i,9) = g2sw(j,i,3)
            g3sw(j,i,9) = g3sw(j,i,3)
         enddo
      enddo
      g1sw(21,21,9) = 0.
      g2sw(21,21,9) = 0.
      g3sw(21,21,9) = 0.
      if (inova.eq.5) then
         do i=1,ncg
            do j=1,nrg
               g1sw(j,i,2) = g1sw(j,i,1)
               g2sw(j,i,2) = g2sw(j,i,1)
               g3sw(j,i,2) = g3sw(j,i,1)
            enddo
         enddo
         g2sw(21,21,2) = g2sw(21,21,3)
      endif
! Copy matrix 3 and remove FPS for matrix 10 [AM 18/10/2017]
      do i=1,ncg
         do j=1,nrg
            g1sw(j,i,10) = g1sw(j,i,3)
            g2sw(j,i,10) = g2sw(j,i,3)
            g3sw(j,i,10) = g3sw(j,i,3)
         enddo
         g1sw(22,i,10) = 0.
         g2sw(22,i,10) = 0.
         g3sw(22,i,10) = 0.
      enddo
      return
      end
c     
c     
c     
c     
c     
c     
c     
c     
      subroutine fluxerr
      include 'fbtmgams.inc'
      include 'mga.inc'
c     
c     
c     start time loop
c     
c     do 2000 nma=1,nmatrx
c     print 280,nma
c     280 format(7h nma = ,i4)
c     write(50,3001) nma
c     
c     
c     interpolate measurements
c     
c     element number            value
c     
c     n=1,nloop                 flxd(n) = flxa(n)-flxa(1)
c     n=1,nprob                 beem(n)   (magnetic field)
c     n=1,nshap                 currm(n)  (shaping currents)
c     n=nshap+1,nshaoh          currm(n)  (oh currents)
c     n=nshafa                  currm(n)  (fast coil current)
c     n=nshafa+1,ngroup         currm(n)  (vessel voltages)
c     n=ngroup+1                currm(n)  (Rogovski signal, i.e.
c     plasma current + vessel current)
c     
c     
c     time = rampt*(float(nma-1)/float(nmatrx-1))
c     do 300 m=1,nruns
c     tim(m) = rampt*(float(m-1)/float(nruns-1))
c     if(tim(m).ge.time) go to 301
c     300 continue
c     ierr = 1
c     go to 4000
c     301 if(m.gt.1) m = m-1
c     tfr = (time-tim(m))/dt
c     placum =(placur(m)+tfr*(placur(m+1)-placur(m)))
c     zaxm = zax(m) + tfr*(zax(m+1)-zax(m))
c     do 302 i=1,ngroup
c     currm(i) = (gcurr(m,i)+tfr*(gcurr(m+1,i)-gcurr(m,i)))
c     if(i.gt.nshafa) currm(i)=-currm(i)
c     302 continue
c     currm(ngroup1) = placum
c     do 303 n=1,nprob
c     delbee = bee(m+1,n)-bee(m,n)
c     beem(n) =(bee(m,n) + tfr*delbee)
c     303 continue
c     
c     note that flux in MGAMS has opposite sign of flux in FBT ???
c     
c     do 304 n=1,nloop
c     delflu = flux(m+1,n)-flux(m,n)
c     flxa(n) =-(flux(m,n) + tfr*delflu)
c-------------------------this + sign should be - !-----------------
c     dfludt(n) =-delflu/dt
c     304 continue
c     do 305 n=1,nvvel
c     if(nvvel.eq.nloop) currm(nshafa+n)=dfludt(n)
c     if(nvvel.lt.nloop) currm(nshafa+n)=dfludt(2*n-1)
c     305 continue
c     
c     
c     
c     do 306 n=1,nvvel
c     currm(nshafa+n) = 0.
c     306 continue
c     
c     
c     
c     if(istop.eq.305) print 3000,(currm(n),n=1,ngroup1)
c     if(istop.eq.306) print 3000,(flxa(n),n=1,nloop)
c     do 307 n=2,nloop
c     flxd(n) = flxa(n) - flxa(1)
c     307 continue
c     
      m = numeq
      if(ilie.gt.0) then
         do 308 i=1,ilie
            xfob(i) = rlim(m,i)
            zfob(i) = zlim(m,i)
 308     continue
      endif
      if(ilia.gt.0) then
         do 309 i=1,ilia
            xfob(i+ilie) = rlia(m,i)
            zfob(i+ilie) = zlia(m,i)
 309     continue
      endif
      if(ibro.gt.0) then
         do 310 i=1,ibro
            xbxob(i) = rbroe(m,i)
            zbxob(i) = zbroe(m,i)
 310     continue
      endif
      if(ibzo.gt.0) then
         do 311 i=1,ibzo
            xbzob(i) = rbzoe(m,i)
            zbzob(i) = zbzoe(m,i)
 311     continue
      endif
c     
c     if(istop.eq.311) print 3000,(xfob(l),l=1,nfob)
c     if(istop.eq.311) print 3000,(zfob(l),l=1,nfob)
c     
c     if(iprx.eq.1) then
c     call mulmv(b1,mmax,nloop,flxd,nloop,v4)
c     call mulmv(b2,mmax,nprob,beem,nprob,v5)
c     call mulmv(b6,mmax,ngroup1,currm,ngroup1,v6)
c     do 320 m=1,mmax
c     v7(m) = v4(m)+v5(m)-v6(m)
c     320    continue
c     if(istop.eq.320) print 3000,(v7(m),m=1,mmax)
c     call mulmv(axi,mmax,mmax,v7,mmax,xxx)
c     write(50,322)
c     322    format(38h current element amplitudes (X-vector))
c     write(50,3000) (xxx(m),m=1,mmax)
c     aipee = 0.
c     do 323 m=1,mmax
c     aipee = aipee + xxx(m)*aph
c     323    continue
c     print 325,aipee
c     call mulvm(xxx,mmax,dep,mmax,nprob,v7)
c     aipee = 0.
c     do 324 n=1,nprob
c     aipee = aipee + v7(n)*prlen(n)
c     324    continue
c     print 325,aipee
c     325    format(6h aipee,e12.5)
c     endif
c     
c     
c     
c     
c     compute A matrix
c     
c     
      do 382 l=1,nfob
         do 375 m=1,mmax
            a1(l,m) = 0.
 375     continue
         do 378 j=1,jmax
            do 377 k=1,kmax
               if((r(j).lt.xip).or.(r(j).gt.xop)) go to 377
               if((z(k).lt.zlp).or.(z(k).gt.zup)) go to 377
               call gf(ineg,0,xfob(l),zfob(l),r(j),z(k),ans)
               do 376 m=1,mmax
                  if(coe(j,k,m).le.0.) go to 376
                  a1(l,m) = a1(l,m) + (ans*coe(j,k,m))
 376           continue
 377        continue
 378     continue
 382  continue
      do 386 l=1,nfoo
         do 384 m=1,mmax
            a1(l,m) = a1(l,m) - a1(nfob,m)
 384     continue
 386  continue
c     
      if(nbxob.gt.0) then
         do 410 l=1,nbxob
            lp = l+nfoo
            do 400 m=1,mmax
               a1(lp,m) = 0.
 400        continue
            do 406 j=1,jmax
               do 404 k=1,kmax
                  if((r(j).lt.xip).or.(r(j).gt.xop)) go to 404
                  if((z(k).lt.zlp).or.(z(k).gt.zup)) go to 404
                  call gradgf(ineg,0,xbxob(l),zbxob(l),r(j),z(k),gradx,gradz)
                  do 402 m=1,mmax
                     if(coe(j,k,m).le.0.) go to 402
                     a1(lp,m) = a1(lp,m) + gradz*coe(j,k,m)
 402              continue
 404           continue
 406        continue
            do 408 m=1,mmax
               a1(lp,m) = a1(lp,m)/(xbxob(l)*tpi)
 408        continue
 410     continue
      endif
c     
c     
      if(nbzob.gt.0) then
         do 430 l=1,nbzob
            lp = l+nfoo+nbxob
            do 420 m=1,mmax
               a1(lp,m) = 0.
 420        continue
            do 426 j=1,jmax
               do 424 k=1,kmax
                  if((r(j).lt.xip).or.(r(j).gt.xop)) go to 424
                  if((z(k).lt.zlp).or.(z(k).gt.zup)) go to 424
                  call gradgf(ineg,0,xbzob(l),zbzob(l),r(j),z(k),gradx,gradz)
                  do 422 m=1,mmax
                     if(coe(j,k,m).le.0.) go to 422
                     a1(lp,m) = a1(lp,m) - gradx*coe(j,k,m)
 422              continue
 424           continue
 426        continue
            do 428 m=1,mmax
               a1(lp,m) = a1(lp,m)/(xbzob(l)*tpi)
 428        continue
 430     continue
      endif
c     
c     
c     
c     
c     if(istop.eq.386) call primat('A1        ',a1,1000.,nob,mmax)
c     
c     
      do 444 l=1,nfob
         do 442 k=1,ngroup
            a78 = 0.
            ifi = isvf(k)
            ila = isvl(k)
            do 440 i=ifi,ila
               call gf(ineg,0,xfob(l),zfob(l),rvf(i),zvf(i),ans)
               if(k.le.nshafa) a78 = a78 + ans*tvf(i)*usdi
               if(k.gt.nshafa) a78 = a78 + (ans*tvf(i)*usdi)/resis(k)
 440        continue
            a7(l,k) = a78
 442     continue
         a7(l,ngroup1) = 0.
 444  continue
      do 448 l=1,nfoo
         do 446 k=1,ngroup
            a7(l,k)=a7(l,k)-a7(nfob,k)
 446     continue
 448  continue
c     
c     
      if(nbxob.gt.0) then
         do 454 l=1,nbxob
            lp = l+nfoo
            do 452 k=1,ngroup
               a78 = 0.
               ifi = isvf(k)
               ila = isvl(k)
               do 450 i=ifi,ila
                  call gradgf(ineg,0,xbxob(l),zbxob(l),rvf(i),zvf(i),
     1                 gradx,gradz)
                  if(k.le.nshafa) a78 = a78 + gradz*tvf(i)*usdi
                  if(k.gt.nshafa) a78 = a78 + (gradz*tvf(i)*usdi)/resis(k)
 450           continue
               a7(lp,k) = a78/(xbxob(l)*tpi)
 452        continue
            a7(lp,ngroup1) = 0.
 454     continue
      endif
c     
c     
      if(nbzob.gt.0) then
         do 464 l=1,nbzob
            lp = l+nfoo+nbxob
            do 462 k=1,ngroup
               a78 = 0.
               ifi = isvf(k)
               ila = isvl(k)
               do 460 i=ifi,ila
                  call gradgf(ineg,0,xbzob(l),zbzob(l),rvf(i),zvf(i),
     1                 gradx,gradz)
                  if(k.le.nshafa) a78 = a78 - gradx*tvf(i)*usdi
                  if(k.gt.nshafa) a78 = a78 - (gradx*tvf(i)*usdi)/resis(k)
 460           continue
               a7(lp,k) = a78/(xbzob(l)*tpi)
 462        continue
            a7(lp,ngroup1) = 0.
 464     continue
      endif
c     
c     
c     if(iprx.eq.1) then
c     call mulmv(a1,nob,mmax,xxx,mmax,v4)
c     call mulmv(a7,nob,ngroup,currm,ngroup,v5)
c     do 500 n=1,nob
c     v6(n) = v4(n)+v5(n)
c     500    continue
c     write(50,501)
c     501    format(5h A1*X)
c     write(50,3000) (v4(n),n=1,nob)
c     write(50,502)
c     502    format(5h A7*I)
c     write(50,3000) (v5(n),n=1,nob)
c     write(50,503)
c     503    format(12h epsilon-psi)
c     write(50,3000) (v6(n),n=1,nob)
c     endif
c     
      call mulmm(a1,nob,mmax,axi,mmax,mmax,b3)
      call mulmm(b3,nob,mmax,b1,mmax,nloop,a2)
      call mulmm(b3,nob,mmax,b2,mmax,nprob,a3)
      call mulmm(b3,nob,mmax,b6,mmax,ngroup1,b7)
c     
c     
      do 511 n=1,nob
         do 510 i=1,ngroup1
            a4(n,i) = a7(n,i)-b7(n,i)
 510     continue
 511  continue
c     
c     
c     if(istop.eq.511) call primat('A4        ',a4,1.,nob,ngroup)
c     
c     
c     compute ML-matrix
c     
c     
c     
c     
c     do 590 l=1,nob
c     do 589 k=1,nshap
c     a7t(k,l) = a7(l,k)
c     589 continue
c     590 continue
c     
c     
c     
c     call mdmt(a7t,nshap,nob,eee,nob,b4)
c     
c     
c     
c     do 600 i=1,nshap
c     b4(i,i) = -b4(i,i) - dddd(i)
c     600 continue
c     if(istop.eq.600) call primat('B4        ',b4,1.,nshap,nshap)
c     
c     
c     call inver(b4,nshap,b5)
c     if(istop.eq.601) call primat('B5        ',b5,1.,nshap,nshap)
c     call mulmd(a7t,nshap,nob,eee,nob,b7)
c     if(istop.eq.602) call primat('B7        ',b7,1.,nshap,nob)
c     call mulmm(b5,nshap,nshap,b7,nshap,nob,ame)
c     if(istop.eq.603) call primat('AME       ',ame,1.,nshap,nob)
c     call mulmd(b5,nshap,nshap,dddd,nshap,ami)
c     
c     do 603 k=nshap1,nshaoh
c     do 601 n=1,nob2
c     ame(k,n) = 0.
c     601 continue
c     do 602 n=1,nshaoh
c     ami(k,n) = 0.
c     602 continue
c     603 continue
c     do 608 k=1,nshaoh
c     do 604 n=nob1,nob2
c     ame(k,n) = 0.
c     604 continue
c     do 605 n=nshap1,nshaoh
c     ami(k,n) = 0.
c     605 continue
c     608 continue
c     
c     
c     set M-matrix to 0.0
c     
c     do 622 k=1,nshaoh
c     do 621 n=1,nob2
c     ame(k,n) = 0.
c     621 continue
c     do 620 n=1,nshaoh
c     ami(k,n) = 0.
c     620 continue
c     622 continue
c     
c     
c     write matrices amle and amli
c     
c     
c     
c     if(iprml.eq.1) then
c     write(50,790)
c     790 format(5h amle)
c     do 795 i=1,nshaoh
c     write(50,3000) (amle(i,n),n=1,nob2)
c     795 continue
c     write(50,796)
c     796 format(5h amli)
c     do 800 i=1,nshaoh
c     write(50,3000) (amli(i,n),n=1,nshaoh)
c     800 continue
c     endif
c     
c     
c     
c     multiply A-matrix with measurement vector
c     to get error vector
c     
c     
c     
c     call mulmv(a2,nob2,nloop,flxd,nloop,v4)
c     call mulmv(a3,nob2,nprob,beem,nprob,v5)
c     call mulmv(a4,nob2,ngroup1,currm,ngroup1,v6)
c     
c     
c     do 820 n=1,nob2
c     v7(n) = v4(n)+v5(n)+v6(n)
c     820 continue
c     if(istop.eq.820) print 3000,(v7(n),n=1,nob2)
c     
c     
c     subtract preprogrammed values
c     
c     
c     v7(nob1) = v7(nob1) - placum
c     v7(nob2) = v7(nob2) - placum*zaxm
c     
c     
c     if(ipreps.eq.1) then
c     placzam = placum*zaxm
c     write(50,822) placum
c     822    format(9h placum =,e12.5)
c     write(50,823) zaxm
c     823    format(9h zaxm   =,e12.5)
c     write(50,824) placzam
c     824    format(9h Ip*z   =,e12.5)
c     write(50,825)
c     825    format(39h output = A-matrix * measurement vector)
c     write(50,3000) (v7(n),n=1,nob2)
c     endif
c     
c     
c     
c     coil current increments
c     
c     
c     if(iprcinc.eq.1) then
c     call mulmv(ame,nshaoh,nob2,v7,nob2,v4)
c     call mulmv(ami,nshaoh,nshaoh,currm,nshaoh,v5)
c     do 826 i=1,nshaoh
c     v6(i) = (v4(i)+v5(i))/gain
c     826 continue
c     write(50,827)
c     827 format(24h coil current increments)
c     write(50,3000) (v6(i),i=1,nshaoh)
c     endif
c     
c     
c     coil voltages
c     
c     
c     if(iprvol.eq.1) then
c     call mulmv(elss,nshaoh,nshaoh,v6,nshaoh,v4)
c     do 828 i=1,nshaoh
c     v4(i) = v4(i)*gain + resis(i)*currm(i)
c     828 continue
c     write(50,829)
c     829 format(14h coil voltages)
c     write(50,3000) (v4(i),i=1,nshaoh)
c     
c     second way to compute voltages
c     
c     call mulmv(amle,nshaoh,nob2,v7,nob2,v4)
c     call mulmv(amli,nshaoh,nshaoh,currm,nshaoh,v5)
c     do 830 i=1,nshaoh
c     v6(i) = v4(i)+v5(i)
c     830 continue
c     write(50,3000) (v6(i),i=1,nshaoh)
c     endif
c     
c     write the matrices a2, a3, a4
c     
c     
c     
c     if(ipra.eq.1) then
c     write(50,926)
c     926 format(9h a2,a3,a4)
c     do 930 i=1,nob2
c     write(50,3000) (a2(i,n),n=1,nloop)
c     write(50,3000) (a3(i,n),n=1,nprob)
c     write(50,3000) (a4(i,n),n=1,ngroup1)
c     930 continue
c     endif
c     
c     
c     
c     
c     if(iprmea.eq.1) then
c     write(50,952)
c     952 format(37h measurement vector (flxd,beem,currm))
c     write(50,3000) (flxd(n),n=1,nloop)
c     write(50,3000) (beem(n),n=1,nprob)
c     write(50,3000) (currm(i),i=1,ngroup1)
c     endif
c     
c     
c     
c     no scrambling
c     
c     
      nmeas = nloop+nprob+ngroup1
      do 1004 i=1,nob2
         do 1001 n=1,nloop
            aaa(i,n) = a2(i,n)
 1001    continue
         do 1002 n=1,nprob
            aaa(i,n+nloop) = a3(i,n)
 1002    continue
         do 1003 n=1,ngroup1
            aaa(i,n+nloop+nprob) = a4(i,n)
 1003    continue
 1004 continue
c     
c     
      do i=1,mm1
         do n=1,mm3
            aaasw(i,n,10) = 0.
         enddo
      enddo
      do i=1,nob2
         do n=1,nmeas
            aaasw(i,n,10) = aaa(i,n)
         enddo
      enddo
c     
      aaasw(mm1,1,10)        = float(nfob)
      do i=1,nfob
         aaasw(mm1,i+1,10)      = xfob(i)
         aaasw(mm1,i+nfob+1,10) = zfob(i)
      enddo
c     
c     do 1005 n=1,nloop
c     sss(n) = flxd(n)
c     1005 continue
c     do 1006 n=1,nprob
c     sss(n+nloop) = beem(n)
c     1006 continue
c     do 1007 n=1,ngroup1
c     sss(n+nloop+nprob) = currm(n)
c     1007 continue
c     
c     
c     
c     do 1022 i=1,nob2
c     v10(i) = 0.
c     do 1020 n=1,nmeas
c     v10(i) = v10(i) + aaa(i,n)*sss(n)
c     1020 continue
c     1022 continue
c     
c     
c     2000 continue
c     
c     
 3000 format(1x,6e12.5)
 3001 format(1x,12i6)
c     
c     
      return
      end
c     
c     
c     
c     
c     
c     
c     
      subroutine gauss(mat,ax,cx)
      parameter (mh=120)
      dimension ax(mh,mh),cx(mh)
      ni=mat
      na=ni+1
      do 234 mm = 2,ni
         do 232 n = mm,na
 232        ax(mm-1,n) = ax(mm-1,n)/ax(mm-1,mm-1)
            do 233 m = mm,ni
               do 233 n = mm,na
 233              ax(m,n) = ax(m,n)-ax(mm-1,n)*ax(m,mm-1)
 234           continue
               ax(ni,na) = ax(ni,na)/ax(ni,ni)
               do 236 m = 1,ni
                  mm = ni-m+1
                  ml = mm-1
                  cx(mm) = ax(mm,na)
                  if(mm.eq.1)  go to 236
                  do 235 mb = 1,ml
 235                 ax(mb,na) = ax(mb,na) - cx(mm)*ax(mb,mm)
 236              continue
                  return
                  end
c     
c     
      subroutine primat(name,a,factor,nra,nca)
      character*10 name
      parameter(mh=120)
      dimension a(mh,mh),b(mh)
      print *,'% primat ',name,nra,nca
      print *,name,' = ',1./factor,' * reshape(['
      do 10 i=1,nra
         do 9  j=1,nca
            b(j)  = a(i,j)*factor
 9       continue
         print 100,(b(j),j=1,nca)
 10   continue
      print *,'],',nca,',',nra,')'';'
 100  format(8(e11.4,1h;))
      return
      end
c     
c     
c     
c     
      subroutine inver(a,la,b)
      parameter(mh=120)
      dimension a(mh,mh),b(mh,mh),c(mh,mh),cx(mh)
c     
c     computes b, the inverse of a
c     
      lx = la+1
      do 274 l=1,la
         do 172 m=1,la
            do 170 n=1,la
               c(m,n) = a(m,n)
 170        continue
            c(m,lx) = 0.
            if(m.eq.l) c(m,lx) = 1.
 172     continue
         ni = la
         na = ni+1
         do 234 mm = 2,ni
            do 232 n = mm,na
 232           c(mm-1,n) = c(mm-1,n)/c(mm-1,mm-1)
               do 233 m = mm,ni
                  do 233 n = mm,na
 233                 c(m,n) = c(m,n)-c(mm-1,n)*c(m,mm-1)
 234              continue
                  c(ni,na) = c(ni,na)/c(ni,ni)
                  do 236 m = 1,ni
                     mm = ni-m+1
                     ml = mm-1
                     cx(mm) = c(mm,na)
                     if(mm.eq.1)  go to 236
                     do 235 mb = 1,ml
 235                    c(mb,na) = c(mb,na) - cx(mm)*c(mb,mm)
 236                 continue
                     do 273 n=1,la
                        b(l,n) = cx(n)
 273                 continue
 274              continue
                  return
                  end
c     
c     
c     
c     
      subroutine mulvm(v,nv,a,nra,nca,pv)
      parameter(mh=120)
      dimension v(mh),a(mh,mh),pv(mh)
c     
c     computes the product of a row vector (v) times a matrix (a)
c     
      if(nv.ne.nra) ierr=1
c     
      do 2 j=1,nca
         pv(j) = 0.
         do 1 i=1,nra
            pv(j) = pv(j) + a(i,j)*v(i)
 1       continue
    2 continue
c     
      return
      end
c     
c     
c     
c     
      subroutine mulmv(a,nra,nca,v,nv,pv)
      parameter(mh=120)
      dimension a(mh,mh),v(mh),pv(mh)
c     
c     computes the product of a matrix (a) times a column vector (v)
c     
      if(nca.ne.nv) ierr = 1
c     
      do 2 i=1,nra
         pv(i) = 0.
         do 1 j=1,nca
            pv(i) = pv(i) + a(i,j)*v(j)
 1       continue
    2 continue
      return
      end
c     
c     
c     
c     
      subroutine mulmm(a,nra,nca,b,nrb,ncb,p)
      parameter(mh=120)
      dimension a(mh,mh),b(mh,mh),p(mh,mh)
c     
c     computes the product of two matrices
c     
      if(nca.ne.nrb) ierr=1
c     
      do 3 i=1,nra
         do 2 j=1,ncb
            p(i,j) = 0.
            do 1 k=1,nca
               p(i,j) = p(i,j) + a(i,k)*b(k,j)
 1          continue
 2       continue
    3 continue
c     
      return
      end
c     
c     
c     
c     
      subroutine mulmd(a,nra,nca,d,nd,p)
      parameter(mh=120)
      dimension a(mh,mh),d(mh),p(mh,mh)
c     
c     multiplies a matrix by a diagonal matrix
c     
      if(nd.ne.nca) ierr=1
c     
      do 3 i=1,nra
         do 2 j=1,nca
            p(i,j) = a(i,j)*d(j)
 2       continue
    3 continue
c     
      return
      end
c     
c     
c     
c     
      subroutine mdmt(a,nra,nca,d,nd,p)
      parameter(mh=120)
      dimension a(mh,mh),d(mh),p(mh,mh)
c     t
c     computes the triple product a * d * a
c     
      if(nd.ne.nca) ierr=1
      do 9 m1=1,nra
         do 8 m2=1,nra
            p(m1,m2) = 0.
            do 7 l=1,nca
               p(m1,m2) = p(m1,m2) + a(m1,l)*d(l)*a(m2,l)
 7          continue
 8       continue
    9 continue
      return
      end
c     
c     
c     
c     
      subroutine gf(ineg,nmult,xt,zt,xs,zs,ans)
c     
c......calculates poloidal flux at point (xt,zt) due to current
c......at location (xs,zs)  . . . returns value in ans
c     
c     
c     
c     
c     
      data q0,q1,q2,q3,q4,q5/-.30685281944e0, .29822748722e0,
     1     .00367617100e0, -.01091055499e0, .00860373511e0,
     2     .00725598106e0/
      data r0,r1,r2,r3,r4,r5/ .25e0, .06250928488e0,
     1     .00489241049e0, .01034604435e0, .01358621540e0,
     2     .00220893506e0/
      data pi,tpi/3.1415926535,6.283185308/
c     
c     
      ans = 0.
      zr = zs - zt
      qk2 = 4.*xs*xt/((xs+xt)**2 + zr**2)
      qn = 1.0 - qk2
      if(qn.le.0) go to 100
      qlg = -alog(qn)
      bk = q0 + qn*(q1+qn*(q2+qn*(q3+qn*(q4+qn*q5))))
     1     + (r0+qn*(r1+qn*(r2+qn*(r3+qn*(r4+qn*r5)))))*qlg
      ans = -sqrt(xt*xs/qk2)*bk*2.
 100  continue
c     
      return
      end
c     
c     
c     
      subroutine gradgf(ineg,nmult,xt,zt,xs,zs,gradx,gradz)
c     
c.....calculates gradient of the poloidal flux at
c.....point (xt,zt) due to current at location (xs,zs)
c.....if current is 1.0 amp, magnetic field is given by
c.....Bx = (gradz/xt)*(usdi/tpi)
c.....Bz = -(gradx/xt)*(usdi/tpi)
c.................................usdi=4*pi*1.0e-7 and tpi=2*pi
c     
c     
      data pi/3.1415926535897/,
     .     ak0 /1.38629436112/,
     .     ak1 /0.09666344259/,
     .     ak2 /0.03590092383/,
     .     ak3 /0.03742563713/,
     .     ak4 /0.01451196212/,
     .     bk0 /0.5/,
     .     bk1 /0.12498593597/,
     .     bk2 /0.06880248576/,
     .     bk3 /0.03328355346/,
     .     bk4 /0.00441787012/,
     .     ae1 /0.44325141463/,
     .     ae2 /0.0626060122/,
     .     ae3 /0.04757383546/,
     .     ae4 /0.01736506451/,
     .     be1 /0.2499836831/,
     .     be2 /0.09200180037/,
     .     be3 /0.04069697526/,
     .     be4 /0.00526449639/
c     
c     
      tpi = 2.*pi
      zd = zs - zt
      ck2 = 4.*xs*xt/((xs+xt)**2 + zd**2)
      x1 = 1. - ck2
      x2 = x1*x1
      x3 = x2*x1
      x4 = x3*x1
      ck = sqrt(ck2)
c     
      elipk = ak0+ak1*x1+ak2*x2+ak3*x3+ak4*x4
     .     - (bk0+bk1*x1+bk2*x2+bk3*x3+bk4*x4)*alog(x1)
c     
      elipe=1.0
      if(abs(x1) .gt. 1.0e-6)
     .     elipe=1.0+ae1*x1+ae2*x2+ae3*x3+ae4*x4
     .     - (be1*x1+be2*x2+be3*x3+be4*x4)*alog(x1)
c     
      term1 = -2.*elipk
      term2 = (2.-ck2)/(1.-ck2)*elipe
      fac = 1./(4.*sqrt(xs*xt))/ck*(term1+term2)
      call gf(ineg,nmult,xt,zt,xs,zs,ans)
      gradx = ans/2./xt - fac*(2.*xs - ck2*(xt+xs))
      gradz = -fac*ck2*(zs-zt)
      return
c     
      end
c     
c     
c     
      function amutlrc (a1,zc1,zd1,rd1,t1,a2,zc2,zd2,rd2,t2,n)
c     mutual of tw0 c0-axial coils
c     summing flux from filaments
c     dl is the size of the subunit for discretizing
c     
c===  real mutlrc
c     
      dl=sqrt((a1-a2)**2+(zc1-zc2)**2)/n
      nr1=rd1/dl+0.5
      if(nr1.lt.1) nr1=1
      nz1=zd1/dl+0.5
      if(nz1.lt.1) nz1=1
      dr1=rd1/nr1
      dz1=zd1/nz1
c     
      nr2=rd2/dl+0.5
      if(nr2.lt.1) nr2=1
      nz2=zd2/dl+0.5
      if(nz2.lt.1) nz2=1
      dr2=rd2/nr2
      dz2=zd2/nz2
c     
      sflx=0.0
c     
      do 13 ir=1,nr2
         r2=(ir-0.5)*dr2-0.5*rd2+a2
         r2=r2*(1.+(dr2/r2)**2/24.)
         do 12 iz=1,nz2
            z2=(iz-0.5)*dz2-0.5*zd2+zc2
            do 11 jr=1,nr1
               r1=(jr-0.5)*dr1-0.5*rd1+a1
               r1=r1*(1.+(dr1/r1)**2/24.)
               do 10 jz=1,nz1
                  z1=(jz-0.5)*dz1-0.5*zd1+zc1
                  call sfilfx(r1,z1,1.0,r2,z2,flx)
                  sflx=sflx+flx
 10            continue
 11         continue
 12      continue
 13   continue
c     
      amutlrc=t1*t2*sflx/(nr1*nz1*nr2*nz2)
c     
      return
      end
      function selfrc (a,zd,rd,t,n)
c     self-inductance of coil
c     summing flux from filaments
c     a/n is the subunit for discretizing
      real mu0
      data mu0 / 12.56637e-7 /
c     
      nr=rd/(a/n)+0.5
      if(nr.lt.1) nr=1
      nz2=0.5*zd/(a/n)+0.5
      nz=2*nz2
      if(nz.lt.2) nz=2
      dr=rd/nr
      dz=zd/nz
      sr=sqrt(dr*dz/3.14159)
      zp=0.5*(dz-zd)
c     
      sflx=0.0
      do 12 jp=1,nr
         rp=(jp-0.5)*dr-0.5*rd+a
         do 11 ja=jp,nr
            ra=(ja-0.5)*dr-0.5*rd+a

            do 10 ia=1,nz
               za=(ia-0.5)*dz-0.5*zd
               if(ja.eq.jp.and.ia.eq.1) then
                  flx=mu0*rp*(alog(8.0*rp/sr)-1.75)
               else
                  call sfilfx(ra,za,1.0,rp,zp,flx)
               end if
               if(ia.eq.1) flx=0.5*flx
               if(ja.ne.jp) flx=2.0*flx
               sflx=sflx+2*(nz+1-ia)*flx
               flxp=2*(nz+1-ia)*flx
c     type 2, jp,ja,ia,flxp,ra,za,rp,zp
 10         continue
 11      continue
 12   continue
      selfrc=t**2*sflx/(nr*nz)**2
c     
      return
      end
c     
c     
c     
      subroutine sfilfx(rf,zf,at,rp,zp,fx)
 733  c1=12.56637 e-7
 742  if(rp) 746,744,746
 744  fx=0.0
      return
c     
 746  continue
      if(at.eq.0.0) go to 775
      c2=c1*at
 750  z=(zp-zf)/rf
 752  r=rp/rf
 754  p2=(1.0+r)*(1.0+r)+z*z
 756  p=sqrt (p2)
 758  a2=p2-4.0*r
      if(a2.le.0.0) go to 773
c     
 760  h=4.0*r/p2
 761  v=a2/p2
c     
 1552 eka=(((0.0145119621*v+0.0374256371)*v+0.0359009238)*v+0.0966634426
     1     )*v+1.38629436
 1554 ekb=(((0.00441787012*v+0.0332835535)*v+0.0688024858)*v+0.124985936
     1     0)*v+0.5
 1556 eea=(((0.0173650645*v+0.0475738355)*v+0.0626060122)*v+0.443251415)
     1     *v+1.0
 1558 eeb=(((0.00526449639*v+0.0406969753)*v+0.0920018004)*v+0.249983683
     1     )*v
c     
 765  y=alog(v)
 766  ce=eea-y*eeb
 768  ck=eka-y*ekb
 772  fx=p*((1.0-0.5*h)*ck-ce)*c2*rf
      go to 775
 773  fx=sign(1.0e20,at)
 775  continue
      return
      end
c     
c     
c     
c     
c     
      subroutine wrimxdr
c--------------------------------------------------------------
c     FORTRAN routine to save control matrices in XDR format
c     Version for the VAX.
c     [ all matrices are stored as 1D vectors ]
c     [ and must be reformatted after reading ]
c     Michael Dutch, September 1992
c
c
c     Conditionally disable all XDR functionality
c     Antoine Merle, March 2022
c--------------------------------------------------------------
c     
      include 'fbtmgams.inc'
      include 'mga.inc'
c     
      parameter(mdum=mm1*mm3*msw)
      real dummy(mdum)
      character*30 nullterm

      nsw = msw
      do n=1,ntoft
         aipoft(n) = aipcor(n)
      enddo
c
#ifdef XDR 
      call xdropen('conmat18.xdr'//char(0))
c     
c     ======now save the data========
      call xdrsave(20,'nra'//char(0),1,1,0,nra,nra)
      call xdrsave(20,'nca'//char(0),1,1,0,nca,nca)
      call xdrsave(20,'nrg'//char(0),1,1,0,nrg,nrg)
      call xdrsave(20,'ncg'//char(0),1,1,0,ncg,ncg)
      call xdrsave(20,'nrm'//char(0),1,1,0,nrm,nrm)
      call xdrsave(20,'ncm'//char(0),1,1,0,ncm,ncm)
      call xdrsave(20,'ntoft'//char(0),1,1,0,ntoft,ntoft)
      call xdrsave(20,'noht'//char(0),1,1,0,noht,noht)
      call xdrsave(20,'midplan'//char(0),1,1,0,midplan,midplan)
      call xdrsave(20,'iscramb'//char(0),1,1,0,iscramb,iscramb)
      call xdrsave(20,'nsw'//char(0),1,1,0,nsw,nsw)
      call xdrsave(20,'nfast'//char(0),1,1,0,nfast,nfast)
      call xdrsave(20,'mvloop'//char(0),8,1,0,mvloop,mvloop)
      call xdrsave(10,'relovo'//char(0),1,1,0,relovo,relovo)
      call xdrsave(10,'aipgain'//char(0),6,1,0,aipgain,aipgain)
      call xdrsave(20,'inova'//char(0),1,1,0,inova,inova)
c     
c     
c     
c     ====(matrices stored as 1D vectors)====
c     
      naaa = nra*nca
      do 103 n=1,nsw
         do 102 j=1,nca
            do 100 i=1,nra
               dummy(i+(j-1)*nra+(n-1)*naaa)=aaasw(i,j,n)
 100        continue
 102     continue
 103  continue
      ntotal=naaa*nsw
      call xdrsave(10,'aaasw'//char(0),ntotal,1,0,dummy,dummy)
c     
      nggg = nrg*ncg
      do 203 n=1,nsw
         do 202 j=1,ncg
            do 200 i=1,nrg
               dummy(i+(j-1)*nrg+(n-1)*nggg)=g1sw(i,j,n)
 200        continue
 202     continue
 203  continue
      ntotal=nggg*nsw
      call xdrsave(10,'g1sw'//char(0),ntotal,1,0,dummy,dummy)
c     
      do 303 n=1,nsw
         do 302 j=1,ncg
            do 300 i=1,nrg
               dummy(i+(j-1)*nrg+(n-1)*nggg)=g2sw(i,j,n)
 300        continue
 302     continue
 303  continue
      call xdrsave(10,'g2sw'//char(0),ntotal,1,0,dummy,dummy)
c     
      do 403 n=1,nsw
         do 402 j=1,ncg
            do 400 i=1,nrg
               dummy(i+(j-1)*nrg+(n-1)*nggg)=g3sw(i,j,n)
 400        continue
 402     continue
 403  continue
      call xdrsave(10,'g3sw'//char(0),ntotal,1,0,dummy,dummy)
c     
      naml = nrm*ncm
      do 503 n=1,nsw
         do 502 j=1,ncm
            do 500 i=1,nrm
               dummy(i+(j-1)*nrm+(n-1)*naml)=amlsw(i,j,n)
 500        continue
 502     continue
 503  continue
      ntotal=naml*nsw
      call xdrsave(10,'amlsw'//char(0),ntotal,1,0,dummy,dummy)
c     
      nefw = noht*24
      do 602 j=1,24
         do 600 i=1,noht
            dummy(i+(j-1)*noht)=efwave(i,j)
 600     continue
 602  continue
      call xdrsave(10,'efwave'//char(0),nefw,1,0,dummy,dummy)
c     
      nefw = noht*17
      do 702 j=1,17
         do 700 i=1,noht
            dummy(i+(j-1)*noht)=efcur(i,j)
 700     continue
 702  continue
      call xdrsave(10,'efcur'//char(0),nefw,1,0,dummy,dummy)
c     
      nefw = noht*18
      do 802 j=1,18
         do 800 i=1,noht
            dummy(i+(j-1)*noht)=efvolt(i,j)
 800     continue
 802  continue
      call xdrsave(10,'efvolt'//char(0),nefw,1,0,dummy,dummy)
c     
      call xdrsave(10,'toft'//char(0),ntoft,1,0,toft,toft)
      call xdrsave(10,'aipoft'//char(0),ntoft,1,0,aipoft,aipoft)
      call xdrsave(10,'bzeroft'//char(0),ntoft,1,0,bzeroft,bzeroft)
      call xdrsave(10,'ohcur'//char(0),ntoft,1,0,ohcur,ohcur)
      call xdrsave(10,'toh'//char(0),noht,1,0,toh,toh)
      call xdrsave(10,'zeref'//char(0),noht,1,0,zeref,zeref)
      call xdrsave(10,'cayref'//char(0),noht,1,0,cayref,cayref)
c     
      call xdrclose()
#endif
c     
c     Test of position corrector (SC, 12/05/04)
c     
c     if (istop.eq.1963) then
      do 745 n=1,16
         write (51,7420) a4ipz(n)
 745  continue
      do 746 n=17,18
         write (51,7420) a4ipz(n)
 746  continue
      write (51,'(I5)') noht
      do i=1,noht
         write (51,7420) toh(i)
      end do
      do 747 n=1,17
         do 748 i=1,noht
            write (51,7420) efcur(i,n)
 748     continue
 747  continue
      write (51,'(I5)') ntoft
      do i=1,ntoft
         write (51,7420) toft(i)
      end do
      do i=1,ntoft
         write (51,7420) aipoft(i)
      end do
      write (51,'(I5)') nra
      write (51,'(I5)') nca
      write (51,'(I5)') nsw
      do n=1,nsw
         do j=1,nca
            do i=1,nra
               write (51,7420) aaasw(i,j,n)
            end do
         end do
      end do
      write (51,'(I5)') nrg
      write (51,'(I5)') ncg
      write (51,'(I5)') nsw
      do n=1,nsw
         do j=1,ncg
            do i=1,nrg
               write (51,7420) g1sw(i,j,n)
            end do
         end do
      end do
      do n=1,nsw
         do j=1,ncg
            do i=1,nrg
               write (51,7420) g2sw(i,j,n)
            end do
         end do
      end do
      do n=1,nsw
         do j=1,ncg
            do i=1,nrg
               write (51,7420) g3sw(i,j,n)
            end do
         end do
      end do
      write (51,'(I5)') nrm
      write (51,'(I5)') ncm
      write (51,'(I5)') nsw
      do n=1,nsw
         do j=1,ncm
            do i=1,nrm
               write (51,7420) amlsw(i,j,n)
            end do
         end do
      end do
      do j=1,24
         do i=1,noht
            write (51,7420) efwave(i,j)
         end do
      end do
      do j=1,18
         do i=1,noht
            write (51,7420) efvolt(i,j)
         end do
      end do
      do i=1,ntoft
         write (51,7420) bzeroft(i)
      end do
      do i=1,ntoft
         write (51,7420) ohcur(i)
      end do
      do i=1,noht
         write (51,7420) zeref(i)
      end do
      do i=1,noht
         write (51,7420) cayref(i)
      end do
c     end if
 7420 format (1x,e12.5)
c     
      return
      end

      SUBROUTINE MGAMDSPUT
C     mga outputs (was conmat18 file); mgams variables are not repeated:
C     iscramb shape_sel(1)
C     nfast   zip_sel(3)
C     mvloop  ip_sel(1)
C     relovo  vloop
C     aipgain ip_gain
C     inova   zip_sel(1)
C     toft    diohdt_time

      INCLUDE 'fbtmgams.inc'
      INCLUDE 'mga.inc'
      INCLUDE 'mdslib.inc'
      INTEGER MDSSTATUS MDSLENGTH
      REAL DUMMY(MM1*MM3*MSW)

      MDSSTATUS = MDSSETDEFAULT('\MGAMS.MGA'//CHAR(0))
      IF (MOD(MDSSTATUS,2).EQ.0) THEN
         PRINT *,'MGAMDSPUT - error selecting MGA branch'
         STOP
      ENDIF

      MDSSTATUS = MDSPUT('NRA'//CHAR(0),'$1'//CHAR(0),DESCR(IDTYPE_LONG,NRA,0),0)
      IF (MOD(MDSSTATUS,2).EQ.0) PRINT *,'MGAMDSPUT - error writting NRA'
      MDSSTATUS = MDSPUT('NCA'//CHAR(0),'$1'//CHAR(0),DESCR(IDTYPE_LONG,NCA,0),0)
      IF (MOD(MDSSTATUS,2).EQ.0) PRINT *,'MGAMDSPUT - error writting NCA'
      MDSSTATUS = MDSPUT('NRG'//CHAR(0),'$1'//CHAR(0),DESCR(IDTYPE_LONG,NRG,0),0)
      IF (MOD(MDSSTATUS,2).EQ.0) PRINT *,'MGAMDSPUT - error writting NRG'
      MDSSTATUS = MDSPUT('NCG'//CHAR(0),'$1'//CHAR(0),DESCR(IDTYPE_LONG,NCG,0),0)
      IF (MOD(MDSSTATUS,2).EQ.0) PRINT *,'MGAMDSPUT - error writting NCG'
      MDSSTATUS = MDSPUT('NRM'//CHAR(0),'$1'//CHAR(0),DESCR(IDTYPE_LONG,NRM,0),0)
      IF (MOD(MDSSTATUS,2).EQ.0) PRINT *,'MGAMDSPUT - error writting NRM'
      MDSSTATUS = MDSPUT('NCM'//CHAR(0),'$1'//CHAR(0),DESCR(IDTYPE_LONG,NCM,0),0)
      IF (MOD(MDSSTATUS,2).EQ.0) PRINT *,'MGAMDSPUT - error writting NCM'
      MDSSTATUS = MDSPUT('NTOFT'//CHAR(0),'$1'//CHAR(0),DESCR(IDTYPE_LONG,NTOFT,0),0)
      IF (MOD(MDSSTATUS,2).EQ.0) PRINT *,'MGAMDSPUT - error writting NTOFT'
      MDSSTATUS = MDSPUT('NOHT'//CHAR(0),'$1'//CHAR(0),DESCR(IDTYPE_LONG,NOHT,0),0)
      IF (MOD(MDSSTATUS,2).EQ.0) PRINT *,'MGAMDSPUT - error writting NOHT'
      MDSSTATUS = MDSPUT('MIDPLAN'//CHAR(0),'$1'//CHAR(0),DESCR(IDTYPE_LONG,MIDPLAN,0),0)
      IF (MOD(MDSSTATUS,2).EQ.0) PRINT *,'MGAMDSPUT - error writting MIDPLAN'
      MDSSTATUS = MDSPUT('NSW'//CHAR(0),'$1'//CHAR(0),DESCR(IDTYPE_LONG,MSW,0),0)
      IF (MOD(MDSSTATUS,2).EQ.0) PRINT *,'MGAMDSPUT - error writting NSW'

      DO K=1,NSW
         DO J=1,NCA
            DO I=1,NRA
               DUMMY(I+(J-1)*NRA+(K-1)*NRA*NCA)=AAASW(I,J,K)
            ENDDO
         ENDDO
      ENDDO
      MDSSTATUS = MDSPUT('AAASW'//CHAR(0),'$1'//CHAR(0),DESCR(IDTYPE_FLOAT,DUMMY,NRA,NCA,NSW,0),0)
      IF (MOD(MDSSTATUS,2).EQ.0) PRINT *,'FBTMDSPUT - error writting AAASW'
      DO K=1,NSW
         DO J=1,NCG
            DO I=1,NRG
               DUMMY(I+(J-1)*NRG+(K-1)*NRG*NCG)=G1SW(I,J,K)
            ENDDO
         ENDDO
      ENDDO
      MDSSTATUS = MDSPUT('G1SW'//CHAR(0),'$1'//CHAR(0),DESCR(IDTYPE_FLOAT,DUMMY,NRG,NCG,NSW,0),0)
      IF (MOD(MDSSTATUS,2).EQ.0) PRINT *,'FBTMDSPUT - error writting G1SW'
      DO K=1,NSW
         DO J=1,NCG
            DO I=1,NRG
               DUMMY(I+(J-1)*NRG+(K-1)*NRG*NCG)=G2SW(I,J,K)
            ENDDO
         ENDDO
      ENDDO
      MDSSTATUS = MDSPUT('G2SW'//CHAR(0),'$1'//CHAR(0),DESCR(IDTYPE_FLOAT,DUMMY,NRG,NCG,NSW,0),0)
      IF (MOD(MDSSTATUS,2).EQ.0) PRINT *,'FBTMDSPUT - error writting G2SW'
      DO K=1,NSW
         DO J=1,NCG
            DO I=1,NRG
               DUMMY(I+(J-1)*NRG+(K-1)*NRG*NCG)=G3SW(I,J,K)
            ENDDO
         ENDDO
      ENDDO
      MDSSTATUS = MDSPUT('G3SW'//CHAR(0),'$1'//CHAR(0),DESCR(IDTYPE_FLOAT,DUMMY,NRG,NCG,NSW,0),0)
      IF (MOD(MDSSTATUS,2).EQ.0) PRINT *,'FBTMDSPUT - error writting G3SW'
      DO K=1,NSW
         DO J=1,NCM
            DO I=1,NRM
               DUMMY(I+(J-1)*NRM+(K-1)*NRM*NCM)=AMLSW(I,J,K)
            ENDDO
         ENDDO
      ENDDO
      MDSSTATUS = MDSPUT('AMLSW'//CHAR(0),'$1'//CHAR(0),DESCR(IDTYPE_FLOAT,DUMMY,NRM,NCM,NSW,0),0)
      IF (MOD(MDSSTATUS,2).EQ.0) PRINT *,'FBTMDSPUT - error writting AMLSW'

      DO J=1,24
         DO I=1,NOHT
            DUMMY(I+(J-1)*NOHT)=EFWAVE(I,J)
         ENDDO
      ENDDO
      MDSSTATUS = MDSPUT('EFWAVE'//CHAR(0),'$1'//CHAR(0),DESCR(IDTYPE_FLOAT,DUMMY,NOHT,24,0),0)
      IF (MOD(MDSSTATUS,2).EQ.0) PRINT *,'FBTMDSPUT - error writting EFWAVE'
      DO J=1,17
         DO I=1,NOHT
            DUMMY(I+(J-1)*NOHT)=EFCUR(I,J)
         ENDDO
      ENDDO
      MDSSTATUS = MDSPUT('EFCUR'//CHAR(0),'$1'//CHAR(0),DESCR(IDTYPE_FLOAT,DUMMY,NOHT,17,0),0)
      IF (MOD(MDSSTATUS,2).EQ.0) PRINT *,'FBTMDSPUT - error writting EFCUR'
      DO J=1,18
         DO I=1,NOHT
            DUMMY(I+(J-1)*NOHT)=EFVOLT(I,J)
         ENDDO
      ENDDO
      MDSSTATUS = MDSPUT('EFVOLT'//CHAR(0),'$1'//CHAR(0),DESCR(IDTYPE_FLOAT,DUMMY,NOHT,18,0),0)
      IF (MOD(MDSSTATUS,2).EQ.0) PRINT *,'FBTMDSPUT - error writting EFVOLT'

      MDSSTATUS = MDSPUT('TOFT'//CHAR(0),'$1'//CHAR(0),DESCR(IDTYPE_FLOAT,TOFT,NTOFT,0),0)
      IF (MOD(MDSSTATUS,2).EQ.0) PRINT *,'FBTMDSPUT - error writting TOFT'
      MDSSTATUS = MDSPUT('AIPOFT'//CHAR(0),'$1'//CHAR(0),DESCR(IDTYPE_FLOAT,AIPCOR,NTOFT,0),0)
      IF (MOD(MDSSTATUS,2).EQ.0) PRINT *,'FBTMDSPUT - error writting AIPOFT'
      MDSSTATUS = MDSPUT('BZEROFT'//CHAR(0),'$1'//CHAR(0),DESCR(IDTYPE_FLOAT,BZEROFT,NTOFT,0),0)
      IF (MOD(MDSSTATUS,2).EQ.0) PRINT *,'FBTMDSPUT - error writting BZEROFT'
      MDSSTATUS = MDSPUT('OHCUR'//CHAR(0),'$1'//CHAR(0),DESCR(IDTYPE_FLOAT,OHCUR,NTOFT,0),0)
      IF (MOD(MDSSTATUS,2).EQ.0) PRINT *,'FBTMDSPUT - error writting OHCUR'
      MDSSTATUS = MDSPUT('TOH'//CHAR(0),'$1'//CHAR(0),DESCR(IDTYPE_FLOAT,TOH,NOHT,0),0)
      IF (MOD(MDSSTATUS,2).EQ.0) PRINT *,'FBTMDSPUT - error writting TOH'
      MDSSTATUS = MDSPUT('ZEREF'//CHAR(0),'$1'//CHAR(0),DESCR(IDTYPE_FLOAT,ZEREF,NOHT,0),0)
      IF (MOD(MDSSTATUS,2).EQ.0) PRINT *,'FBTMDSPUT - error writting ZEREF'
      MDSSTATUS = MDSPUT('CAYREF'//CHAR(0),'$1'//CHAR(0),DESCR(IDTYPE_FLOAT,CAYREF,NOHT,0),0)
      IF (MOD(MDSSTATUS,2).EQ.0) PRINT *,'FBTMDSPUT - error writting CAYREF'

      RETURN
      END
