Local variables to be added
integer          ifac  , ii     , iel
integer          i     , ntf    , nb    , id , itrouv
integer          izone
integer          nborne(nbtrmx)
integer          ilelt , nlelt
double precision rnbs2,capaeq
double precision sir(nelemx)   ,sii(nelemx)
double precision sirb(nbtrmx,6),siib(nbtrmx,6)
double precision ur(nbtrmx,6)  ,ui(nbtrmx,6)
double precision sirt(nbtrmx)  ,siit(nbtrmx)
character*200    chain
integer, allocatable, dimension(:) :: lstelt
Initialization and finalization
Initialization and finalization is similar to that of the base examples
 
Computation of intensity (A/m2) for each electrode
Pre initialisation
do i= 1,nbelec
  sir(i) = 0.d0
  sii(i) = 0.d0
enddo
do ntf= 1,nbtrf
  sirt(ntf) = 0.d0
  siit(ntf) = 0.d0
enddo
  do ntf = 1,nbtrf
    uroff(ntf) = 0.d0
    uioff(ntf) = 0.d0
  enddo
endif
do i = 1,nbelec
  chain = ' '
  write(chain,3000) ielecc(i)
  if ( ielect(i).ne. 0 ) then
    call 
getfbr(chain,nlelt,lstelt)
    
    do ilelt = 1, nlelt
      ifac = lstelt(ilelt)
        sir(i) = sir(i)                                           &
      enddo
          sii(i) = sii(i)                                         &
        enddo
      endif
    enddo
  endif
enddo
Definition of Voltage on each termin of transformers
Computation of Intensity on each termin of transformers: 
do i=1,nbelec
  sirb(ielect(i),ielecb(i)) = 0.d0
    siib(ielect(i),ielecb(i)) = 0.d0
  endif
enddo
do i=1,nbelec
  if ( ielect(i).ne. 0 ) then
    sirb(ielect(i),ielecb(i)) = sirb(ielect(i),ielecb(i))         &
                               +sir(i)
       siib(ielect(i),ielecb(i)) = siib(ielect(i),ielecb(i))      &
                                  +sii(i)
    endif
  endif
enddo
 RVoltage on each termin: 
do ntf=1,nbtrf
  if (ibrpr(ntf) .eq. 0 .and. ibrsec(ntf) .eq. 0 ) then
    nborne(ntf) = 3
    rnbs2 = 3.d0*rnbs(ntf)*rnbs(ntf)
    ur(ntf,1)=  1.154675d0*tenspr(ntf)/rnbs(ntf)                  &
      + (zr(ntf)*sirb(ntf,1)-zi(ntf)*siib(ntf,1))/rnbs2
    ur(ntf,2)= -0.5773d0*tenspr(ntf)/rnbs(ntf)                    &
      + (zr(ntf)*sirb(ntf,2)-zi(ntf)*siib(ntf,2))/rnbs2
    ur(ntf,3)= -0.5773d0*tenspr(ntf)/rnbs(ntf)                    &
      + (zr(ntf)*sirb(ntf,3)-zi(ntf)*siib(ntf,3))/rnbs2
    ui(ntf,1)=  0.d0                                              &
      + (zi(ntf)*sirb(ntf,1)+zr(ntf)*siib(ntf,1))/rnbs2
    ui(ntf,2)= -1.d0*tenspr(ntf)/rnbs(ntf)                        &
      + (zi(ntf)*sirb(ntf,2)+zr(ntf)*siib(ntf,2))/rnbs2
    ui(ntf,3)=  1.d0*tenspr(ntf)/rnbs(ntf)                        &
      + (zi(ntf)*sirb(ntf,3)+zr(ntf)*siib(ntf,3))/rnbs2
  else
    write(
nfecra, *) 
'Matrice sur le Transfo a ecrire' 
  endif
enddo
 Total intensity for a transformer (zero valued WHEN Offset established): 
do ntf=1,nbtrf
  sirt(ntf) = 0.d0
    siit(ntf) = 0.d0
  endif
enddo
do i=1,nbelec
  if ( ielect(i).ne. 0 ) then
    sirt(ielect(i)) = sirt(ielect(i)) + sir(i)
      siit(ielect(i)) = siit(ielect(i)) + sii(i)
    endif
  endif
enddo
 Take in account of Offset: 
do ntf=1,nbtrf
  uroff(ntf) = uroff(ntf) + sirt(ntf)/capaeq
    uioff(ntf) = uioff(ntf) + siit(ntf)/capaeq
  endif
enddo
if ( ntfref .gt. 0 ) then
  uroff(ntfref) = 0.d0
  uioff(ntfref) = 0.d0
endif
do ntf=1,nbtrf
  do nb=1,nborne(ntf)
    ur(ntf,nb) = ur(ntf,nb) + uroff(ntf)
      ui(ntf,nb) = ui(ntf,nb) + uioff(ntf)
    endif
  enddo
enddo
  Take in account of Boundary Conditions 
do i=1,nbelec
  chain = ' '
  write(chain,3000) ielecc(i)
  call 
getfbr(chain,nlelt,lstelt)
  
  do ilelt = 1, nlelt
    ifac = lstelt(ilelt)
    izone = i
    if ( ielect(i) .ne. 0 ) then
      rcodcl(ifac,
isca(
ipotr),1) = ur(ielect(i),ielecb(i))
        rcodcl(ifac,
isca(
ipoti),1) = ui(ielect(i),ielecb(i))
      endif
    else
      icodcl(ifac,
isca(ii))   = 3
      rcodcl(ifac,
isca(ii),3) = 0.d0
        icodcl(ifac,
isca(ii))   = 3
        rcodcl(ifac,
isca(ii),3) = 0.d0
      endif
    endif
  enddo
enddo
Finalization step
Test, if not any reference transformer a piece of wall may be at ground: 
if ( ntfref .eq. 0 ) then
  itrouv = 0
          if ( abs(rcodcl(ifac,
isca(
ipotr),1)).lt.1.e-20 ) 
then 
            itrouv = 1
          endif
            if (abs(rcodcl(ifac,
isca(
ipotr),1)).lt.1.e-20         &
 
           .and.abs(rcodcl(ifac,
isca(
ipoti),1)).lt.1.e-20 ) 
then              itrouv = 1
            endif
          endif
        endif
      endif
    endif
  enddo
  if ( itrouv .eq. 0 ) then
  endif
endif