Télécharger la plaquette Cast3M


fr en

Télécharger itga21.eso

Retour à la liste

Numérotation des lignes : 

itga21

  1. C ITGA21    SOURCE    CB215821  16/04/21    21:17:18     8920
  2. CCC
  3. C **********************************************************************
  4. CCC
  5.       SUBROUTINE INTEGRA21 (XTRI,X,NDIMX,LAM,DDEFPL,NDIMS,
  6.      .                    nmodel,tolrel,nitmax,nescri,ues,nnumer,
  7.      .                    deltax,kerre,iiter)
  8.       IMPLICIT INTEGER(I-N)
  9.  
  10.       integer ndims,nmodel,nitmax,nescri,nnumer,ndimx,ues,kdummy
  11.       real*8    xtri(ndimx),x(ndimx),ddefpl(ndims),lam,tolrel
  12.       integer i,j,iiter,kerre,npcon,npcap,kdu,ndimv
  13.       real*8    dl,lres,siginv(3)
  14.       real*8    auxr1,vtLUiw,auxmax1,auxmax2,deltax
  15.       real*8    xres(8),dx(8),Amat(64),Gmat(64),vecn(8),vecm(8)
  16.  
  17.       kerre=0
  18.       ndimv=2
  19.       npcon=ndims+1
  20.       npcap=ndims+2
  21.       kdummy=nmodel
  22.       if (nmodel.eq.22) kdummy=23
  23.       do i=1,8
  24.           xres(i)=0.D0
  25.           dx(i)=0.D0
  26.           vecn(i)=0.D0
  27.           vecm(i)=0.D0
  28.         enddo
  29.       do i=1,64
  30.           Amat(i)=0.D0
  31.           Gmat(i)=0.D0
  32.         enddo
  33.       dl=1.D0
  34.       iiter=-1
  35.       call MatGenHookinv(Gmat,ndimx,ndims)
  36. 10    continue
  37.       iiter=iiter+1
  38.       kdu=0
  39.       call yielddMAC(x,ndims,x(npcon),ndimv,lres,kdummy)
  40.       call VecFlMAC(x,ndimx,vecm,nmodel)
  41.       do i=1,ndimx
  42.          xres(i)=lam*vecm(i)
  43.          do j=1,ndimx
  44.             xres(i)=xres(i)+Gmat((i-1)*ndimx+j)*(x(j)-xtri(j))
  45.          enddo
  46.       enddo
  47.       auxmax1=ABS(dx(1))
  48.       do i=2,ndims+1
  49.          if (ABS(dx(i)).gt.auxmax1) auxmax1=ABS(dx(i))
  50.       enddo
  51.       auxmax2=ABS(x(1))
  52.       do i=2,ndimx
  53.          if (ABS(x(i)).gt.auxmax2) auxmax2=ABS(x(i))
  54.       enddo
  55.         auxr1=max(auxmax1,ABS(dl))/max(auxmax2,ABS(lam))
  56.       if (iiter.eq.0) auxr1=1.D0
  57.       if (nescri.eq.1) then
  58.          call InvariantesPQT(x,ndims,siginv)
  59.          write(ues,998)iiter,(siginv(i),i=1,3),x(ndimx-1),
  60.      .                 x(ndimx),auxr1
  61. 998      format(I3,'Sig ',3(E10.4,1x),'V ',E10.4,1x,E10.4,' L ',E10.4)
  62.       endif
  63.       if ((auxr1.lt.tolrel).or.
  64.      .   ((iiter.eq.nitmax).and.(auxr1.lt.sqrt(tolrel)))) then
  65. c CONVERGIDO
  66.          do i=1,ndims
  67.             ddefpl(i)=0.D0
  68.             do j=1,ndims
  69.                ddefpl(i)=ddefpl(i)+Gmat((i-1)*ndimx+j)*(xtri(j)-x(j))
  70.             enddo
  71.          enddo
  72.          return
  73.       endif
  74. c NO CONVERGIDO
  75.       if (iiter.eq.nitmax) then
  76.          kerre=1
  77.          return
  78.       endif
  79.       call VecYiMAC(x,ndimx,vecn,nmodel)
  80.       call HessMAC(x,ndimx,Amat,ndimx,nnumer,deltax,nmodel)
  81.       do i=1,ndimx*ndimx
  82.          Amat(i)=Gmat(i)+lam*Amat(i)
  83.       enddo
  84.       call DescLU(Amat,ndimx)
  85.       dl=(lres-vtLUiw(vecn,Amat,xres,ndimx))
  86.      .         /vtLUiw(vecn,Amat,vecm,ndimx)
  87.       do i=1,ndimx
  88.          xres(i)=-xres(i)-dl*vecm(i)
  89.       enddo
  90.       call LUiw(Amat,xres,dx,ndimx)
  91.       lam=lam+dl
  92.       do i=1,ndimx
  93.          x(i)=x(i)+dx(i)
  94.       enddo
  95.       if (x(npcon).lt.0.D0) x(npcon)=0.D0
  96.       if (x(npcap).lt.0.D0) x(npcap)=0.D0
  97.       go to 10
  98.       end
  99.  
  100.  
  101.  
  102.  
  103.  
  104.  

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