Télécharger la plaquette Cast3M


fr en

Télécharger itga1j.eso

Retour à la liste

Numérotation des lignes : 

itga1j

  1. C ITGA1J    SOURCE    CHAT      05/01/13    00:44:30     5004
  2. CCC
  3. C **********************************************************************
  4. CCC
  5.       subroutine Integra1J2 (xtri,x,ndimx,ndimv,lam,ddefpl,ndims,
  6.      .                       tolrel,nitmax,nescri,ues,kerre,iiter)
  7.       IMPLICIT INTEGER(I-N)
  8.       IMPLICIT REAL*8 (A-H,O-Z)
  9.       integer ndims,nitmax,nescri,ndimx,ues
  10.       real*8  xtri(*),x(*),ddefpl(ndims),lam,tolrel
  11.       integer i,j,iiter,kerre,ndimv
  12.       real*8  dl,lres,siginv(3),auxr1,vtLUiw
  13.       real*8  xres(7),dx(7),Amat(49),Gmat(49),vecn(7),vecm(7)
  14.       kerre=0
  15.         do i=1,7
  16.          xres(i)=0.D0
  17.          dx(i)=0.D0
  18.          vecn(i)=0.D0
  19.          vecm(i)=0.D0
  20.         enddo
  21.         do i=1,49
  22.          amat(i)=0.D0
  23.          gmat(i)=0.D0
  24.         enddo
  25.       iiter=-1
  26.       call MatGenHookinv(Gmat,ndimx,ndims)
  27.         dl=1.D0
  28. 10    continue
  29.       iiter=iiter+1
  30.       call yielddJ2(x,ndims,x(ndimx),ndimv,lres)
  31.       call vflsigJ2(x,ndims,x(ndimx),ndimv,vecm)
  32.       call vflvarJ2(x,ndims,x(ndimx),ndimv,vecm(ndimx))
  33.       do i=1,ndimx
  34.          xres(i)=lam*vecm(i)
  35.          do j=1,ndimx
  36.             xres(i)=xres(i)+Gmat((i-1)*ndimx+j)*(x(j)-xtri(j))
  37.          enddo
  38.       enddo
  39.       auxmax1=abs(dx(1))
  40.       auxmax2=abs(x(1))
  41.       do i=2,ndimx
  42.        if (abs(dx(i)).gt.auxmax1) auxmax1=abs(dx(i))
  43.        if (abs(x(i)).gt.auxmax2) auxmax2=abs(x(i))
  44.       enddo
  45.       auxr1=max(auxmax1,abs(dl))/max(auxmax2,1.D0)
  46.       if (nescri.eq.1) then
  47.          write(ues,'(I3,X,8(1pE8.2,1x))')
  48.      .        iiter,(abs(xres(i)),i=1,ndimx),abs(lres),auxr1
  49.       endif
  50.       if (auxr1.lt.tolrel) then
  51. c CONVERGIDO
  52.          do i=1,ndims
  53.             ddefpl(i)=0.D0
  54.             do j=1,ndims
  55.                ddefpl(i)=ddefpl(i)+Gmat((i-1)*ndimx+j)*(xtri(j)-x(j))
  56.             enddo
  57.          enddo
  58.          return
  59.       endif
  60. c NO CONVERGIDO
  61.       if (iiter.eq.nitmax) then
  62.          kerre=1
  63.          return
  64.       endif
  65.       call vyisigJ2(x,ndims,x(ndimx),ndimv,vecn)
  66.       call vyivarJ2(x,ndims,x(ndimx),ndimv,vecn(ndimx))
  67.       call HessFlsigJ2(x,ndims,x(ndimx),ndimv,Amat,ndimx)
  68.       do i=1,ndimx*ndimx
  69.          Amat(i)=Gmat(i)+lam*Amat(i)
  70.       enddo
  71.       call DescLU(Amat,ndimx)
  72.       dl=(lres-vtLUiw(vecn,Amat,xres,ndimx))
  73.      .         /vtLUiw(vecn,Amat,vecm,ndimx)
  74.       do i=1,ndimx
  75.          xres(i)=-xres(i)-dl*vecm(i)
  76.       enddo
  77.       call LUiw(Amat,xres,dx,ndimx)
  78.       lam=lam+dl
  79.       do i=1,ndimx
  80.          x(i)=x(i)+dx(i)
  81.       enddo
  82.       if (x(ndimx).lt.0.D0) x(ndimx)=0.D0
  83.       go to 10
  84.       end
  85.  
  86.  
  87.  
  88.  

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