Numérotation des lignes :

C ITG0J2    SOURCE    CB215821  16/04/21    21:17:16     8920CCCC **********************************************************************CCC      SUBROUTINE INTEGRA0J2 (XTRI,X,NDIMX,LAM,DDEFPL,NDIMS,     .                       tolrel,nitmax,nescri,ues,kerre,iiter)      IMPLICIT INTEGER(I-N)      integer ndims,nitmax,nescri,ndimx,ues      real*8  xtri(ndimx),x(ndimx),ddefpl(ndims),lam,tolrel      integer i,j,iiter,kerre,ndimv      real*8  dl,lres,siginv(3),void(1),auxr1,vtLUiw,auxmax1,auxmax2      real*8  xres(6),dx(6),Amat(36),Gmat(36),vecn(6),vecm(6)      ndimv=1      kerre=0      void(1)=0.D0        do i=1,6         xres(i)=0.D0         dx(i)=0.D0         vecn(i)=0.D0         vecm(i)=0.D0        enddo        do i=1,36         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,void,ndimv,lres)      call vflsigJ2(x,ndims,void,ndimv,vecm)      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,'(I5,3X,E12.6)')iiter,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,void,ndimv,vecn)      call HessFlsigJ2(x,ndimx,void,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      go to 10      end

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