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(len=200) :: chain
integer, allocatable, dimension(:) :: lstelt
double precision, dimension(:), pointer :: cpro_dji, cpro_djr
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
if (ntcabs.lt.(ntpabs+2)) then
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)
iel = ifabor(ifac)
do id=1,ndimve
call field_get_val_s(iprpfl(idjr(id)), cpro_djr)
sir(i) = sir(i) &
+ cpro_djr(iel)*surfbo(id,ifac)
enddo
if ( ippmod(ieljou) .eq. 4 ) then
do id=1,ndimve
call field_get_val_s(iprpfl(idji(id)), cpro_dji)
sii(i) = sii(i) &
+ cpro_dji(iel)*surfbo(id,ifac)
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
if ( ippmod(ieljou) .eq. 4 ) then
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)
if ( ippmod(ieljou) .eq. 4 ) then
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
if ( ippmod(ieljou) .eq. 4 ) then
siit(ntf) = 0.d0
endif
enddo
do i=1,nbelec
if ( ielect(i).ne. 0 ) then
sirt(ielect(i)) = sirt(ielect(i)) + sir(i)
if ( ippmod(ieljou) .eq. 4 ) then
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
if ( ippmod(ieljou) .eq. 4 ) then
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)
if ( ippmod(ieljou) .eq. 4 ) then
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)
iel = ifabor(ifac)
itypfb(ifac) = iparoi
izone = i
izfppp(ifac) = izone
if ( ielect(i) .ne. 0 ) then
icodcl(ifac,isca(ipotr)) = 1
rcodcl(ifac,isca(ipotr),1) = ur(ielect(i),ielecb(i))
if ( ippmod(ieljou).eq.4 ) then
icodcl(ifac,isca(ipoti)) = 1
rcodcl(ifac,isca(ipoti),1) = ui(ielect(i),ielecb(i))
endif
else
ii = ipotr
icodcl(ifac,isca(ii)) = 3
rcodcl(ifac,isca(ii),3) = 0.d0
if ( ippmod(ieljou).eq. 4 ) then
ii = ipoti
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
do ifac = 1, nfabor
if ( itypfb(ifac) .eq. iparoi ) then
if (icodcl(ifac,isca(ipotr)) .eq. 1 ) then
if ( ippmod(ieljou).eq.3 ) then
if ( abs(rcodcl(ifac,isca(ipotr),1)).lt.1.e-20 ) then
itrouv = 1
endif
else if ( ippmod(ieljou).eq.4 ) then
if (icodcl(ifac,isca(ipoti)) .eq. 1 ) then
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
write(nfecra,1000)
endif
endif