Télécharger itga1j.eso

Retour à la liste

Numérotation des lignes :

  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