Numérotation des lignes :

C ITGA1J    SOURCE    CHAT      05/01/13    00:44:30     5004CCCC **********************************************************************CCC      subroutine Integra1J2 (xtri,x,ndimx,ndimv,lam,ddefpl,ndims,     .                       tolrel,nitmax,nescri,ues,kerre,iiter)      IMPLICIT INTEGER(I-N)      IMPLICIT REAL*8 (A-H,O-Z)      integer ndims,nitmax,nescri,ndimx,ues      real*8  xtri(*),x(*),ddefpl(ndims),lam,tolrel      integer i,j,iiter,kerre,ndimv      real*8  dl,lres,siginv(3),auxr1,vtLUiw      real*8  xres(7),dx(7),Amat(49),Gmat(49),vecn(7),vecm(7)      kerre=0        do i=1,7         xres(i)=0.D0         dx(i)=0.D0         vecn(i)=0.D0         vecm(i)=0.D0        enddo        do i=1,49         amat(i)=0.D0         gmat(i)=0.D0        enddo      iiter=-1      call MatGenHookinv(Gmat,ndimx,ndims)        dl=1.D010    continue      iiter=iiter+1      call yielddJ2(x,ndims,x(ndimx),ndimv,lres)      call vflsigJ2(x,ndims,x(ndimx),ndimv,vecm)      call vflvarJ2(x,ndims,x(ndimx),ndimv,vecm(ndimx))      do i=1,ndimx         xres(i)=lam*vecm(i)         do j=1,ndimx            xres(i)=xres(i)+Gmat((i-1)*ndimx+j)*(x(j)-xtri(j))         enddo      enddo      auxmax1=abs(dx(1))      auxmax2=abs(x(1))      do i=2,ndimx       if (abs(dx(i)).gt.auxmax1) auxmax1=abs(dx(i))       if (abs(x(i)).gt.auxmax2) auxmax2=abs(x(i))      enddo      auxr1=max(auxmax1,abs(dl))/max(auxmax2,1.D0)      if (nescri.eq.1) then         write(ues,'(I3,X,8(1pE8.2,1x))')     .        iiter,(abs(xres(i)),i=1,ndimx),abs(lres),auxr1      endif      if (auxr1.lt.tolrel) thenc CONVERGIDO         do i=1,ndims            ddefpl(i)=0.D0            do j=1,ndims               ddefpl(i)=ddefpl(i)+Gmat((i-1)*ndimx+j)*(xtri(j)-x(j))            enddo         enddo         return      endifc NO CONVERGIDO      if (iiter.eq.nitmax) then         kerre=1         return      endif      call vyisigJ2(x,ndims,x(ndimx),ndimv,vecn)      call vyivarJ2(x,ndims,x(ndimx),ndimv,vecn(ndimx))      call HessFlsigJ2(x,ndims,x(ndimx),ndimv,Amat,ndimx)      do i=1,ndimx*ndimx         Amat(i)=Gmat(i)+lam*Amat(i)      enddo      call DescLU(Amat,ndimx)      dl=(lres-vtLUiw(vecn,Amat,xres,ndimx))     .         /vtLUiw(vecn,Amat,vecm,ndimx)      do i=1,ndimx         xres(i)=-xres(i)-dl*vecm(i)      enddo      call LUiw(Amat,xres,dx,ndimx)      lam=lam+dl      do i=1,ndimx         x(i)=x(i)+dx(i)      enddo      if (x(ndimx).lt.0.D0) x(ndimx)=0.D0      go to 10      end

© Cast3M 2003 - Tous droits réservés.
Mentions légales