Télécharger itg0rh.eso

Retour à la liste

Numérotation des lignes :

  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