Télécharger itga21.eso

Retour à la liste

Numérotation des lignes :

  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