Télécharger la plaquette Cast3M


fr en

Télécharger itg0rh.eso

Retour à la liste

Numérotation des lignes : 

itg0rh

  1. C ITG0RH    SOURCE    CB215821  16/04/21    21:17:17     8920
  2. CCC
  3. C **********************************************************************
  4. CCC
  5.       SUBROUTINE INTEGRA0RHMC (XTRI,X,NDIMX,LAM,DDEFPL,NDIMS,
  6.      .                         tolrel,nitmax,nescri,ues,kerre,iiter)
  7.       IMPLICIT INTEGER(I-N)
  8.       integer ndims,nitmax,nescri,ndimx,ues
  9.       real*8  xtri(ndimx),x(ndimx),ddefpl(ndims),lam,tolrel
  10.       integer i,j,iiter,kerre,ndimv
  11.       real*8  dl,lres,siginv(3),void(1),auxr1,vtLUiw,auxmax1,auxmax2
  12.       real*8  xres(6),dx(6),Amat(36),Gmat(36),vecn(6),vecm(6)
  13.       ndimv=1
  14.       kerre=0
  15.       void(1)=0.D0
  16.         do i=1,6
  17.          xres(i)=0.D0
  18.          dx(i)=0.D0
  19.          vecn(i)=0.D0
  20.          vecm(i)=0.D0
  21.         enddo
  22.         do i=1,36
  23.          amat(i)=0.D0
  24.          gmat(i)=0.D0
  25.         enddo
  26.       iiter=-1
  27.       call MatGenHookinv(Gmat,ndimx,ndims)
  28.         dl=1.D0
  29. 10    continue
  30.       iiter=iiter+1
  31.       call yielddRHMC(x,ndims,void,ndimv,lres)
  32.       call vflsigRHMC(x,ndims,void,ndimv,vecm)
  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,'(I5,3X,E12.6)')iiter,auxr1
  48.       endif
  49.       if (auxr1.lt.tolrel) then
  50. c CONVERGIDO
  51.          do i=1,ndims
  52.             ddefpl(i)=0.D0
  53.             do j=1,ndims
  54.                ddefpl(i)=ddefpl(i)+Gmat((i-1)*ndimx+j)*(xtri(j)-x(j))
  55.             enddo
  56.          enddo
  57.          return
  58.       endif
  59. c NO CONVERGIDO
  60.       if (iiter.eq.nitmax) then
  61.          kerre=1
  62.          return
  63.       endif
  64.       call vyisigRHMC(x,ndims,void,ndimv,vecn)
  65.       call HessFlsigRHMC(x,ndimx,void,ndimv,Amat,ndimx)
  66.       do i=1,ndimx*ndimx
  67.          Amat(i)=Gmat(i)+lam*Amat(i)
  68.       enddo
  69.       call DescLU(Amat,ndimx)
  70.       dl=(lres-vtLUiw(vecn,Amat,xres,ndimx))
  71.      .         /vtLUiw(vecn,Amat,vecm,ndimx)
  72.       do i=1,ndimx
  73.          xres(i)=-xres(i)-dl*vecm(i)
  74.       enddo
  75.       call LUiw(Amat,xres,dx,ndimx)
  76.       lam=lam+dl
  77.       do i=1,ndimx
  78.          x(i)=x(i)+dx(i)
  79.       enddo
  80.       go to 10
  81.       end
  82.  
  83.  
  84.  
  85.  
  86.  
  87.  

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