Télécharger geoli3.eso

Retour à la liste

Numérotation des lignes :

  1. C GEOLI3 SOURCE GOUNAND 05/12/21 21:27:17 5281
  2. SUBROUTINE GEOLI3(IESREL,IESREF,NDPOGO,NDELEM,JMAJAC,
  3. $ JDTJAC,
  4. $ IMPR,IRET)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6. IMPLICIT INTEGER (I-N)
  7. C***********************************************************************
  8. C NOM : GEOLI3
  9. C PROJET : Noyau linéaire NLIN
  10. C DESCRIPTION : Calcul du jacobien dans le cas où la matrice
  11. C jacobienne A n'est pas carrée. A(n,m)
  12. C On calcule sqrt (det (transpose(A) * A))
  13. C Ceci est effectué pour chaque point de Gauss d'un
  14. C élément.
  15. C
  16. C Pour calculer det (tA A), on utilise la formule suivante
  17. C déduite de celle de Binet-Cauchy :
  18. C
  19. C det(tAA) = SUM (det(A_I))^2
  20. C I
  21. C
  22. C où I parcourt tous les sous-ensembles {i_1<...<i_m} dans
  23. C {1,...,N} et A_I est la matrice (m,m) obtenue de A en
  24. C retenant seulement ses lignes de numéro i_1,...,i_k.
  25. C
  26. C LANGAGE : Fortran 77 (sauf E/S)
  27. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  28. C mél : gounand@semt2.smts.cea.fr
  29. C***********************************************************************
  30. C APPELES : -
  31. C APPELE PAR : GEOLIN
  32. C***********************************************************************
  33. C ENTREES : * IESREL (type entier) : dimension de l'espace
  34. C réel (i.e. géométrique).
  35. C * IESREF (type entier) : dimension de l'espace de
  36. C référence.
  37. C * NDNOEU (type entier) : nombre de ddl (par
  38. C élément) de la transformation géométrique.
  39. C * NDPOGO (type entier) : nombre de points
  40. C d'intégration.
  41. C * NDELEM (type entier) : nombre d'éléments du
  42. C maillage élémentaire courant.
  43. C * JMAJAC (type MCHEVA) : valeurs de la matrice
  44. C jacobienne aux points de Gauss sur le maillage
  45. C élémentaire courant.
  46. C ENTREES/SORTIES : * JDTJAC (type MCHEVA) : valeurs de
  47. C sqrt(det(trans(J).J)) aux points de Gauss sur
  48. C le maillage élémentaire courant.
  49. C SORTIES : -
  50. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  51. C***********************************************************************
  52. C VERSION : v1, 12/08/99, version initiale
  53. C HISTORIQUE : v1, 12/08/99, création
  54. C HISTORIQUE :
  55. C HISTORIQUE :
  56. C***********************************************************************
  57. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  58. C en cas de modification de ce sous-programme afin de faciliter
  59. C la maintenance !
  60. C***********************************************************************
  61. -INC CCOPTIO
  62. INTEGER IESREF,IESREL,NDPOGO,NDELEM
  63. REAL*8 JMAJAC(IESREL,IESREF,NDPOGO,NDELEM)
  64. REAL*8 JDTJAC(NDPOGO,NDELEM)
  65. *
  66. INTEGER IMPR,IRET
  67. *
  68. REAL*8 ZERO
  69. PARAMETER (ZERO=0.D0)
  70. *
  71. INTEGER IELEM,IPOGO,IREEL,JREEL
  72. REAL*8 DETCAR,DET
  73. *
  74. * Executable statements
  75. *
  76. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans geoli3'
  77. IF (IESREF.EQ.1) THEN
  78. DO 1 IELEM=1,NDELEM
  79. DO 12 IPOGO=1,NDPOGO
  80. DETCAR=ZERO
  81. DO 122 IREEL=1,IESREL
  82. DETCAR=DETCAR+
  83. $ (JMAJAC(IREEL,1,IPOGO,IELEM)
  84. $ *JMAJAC(IREEL,1,IPOGO,IELEM))
  85. 122 CONTINUE
  86. IF (DETCAR.GT.ZERO) THEN
  87. JDTJAC(IPOGO,IELEM)=SQRT(DETCAR)
  88. ELSE
  89. GOTO 9998
  90. ENDIF
  91. 12 CONTINUE
  92. 1 CONTINUE
  93. ELSEIF (IESREF.EQ.2) THEN
  94. DO 3 IELEM=1,NDELEM
  95. DO 32 IPOGO=1,NDPOGO
  96. DETCAR=ZERO
  97. DO 322 IREEL=1,IESREL-1
  98. DO 3222 JREEL=IREEL+1,IESREL
  99. DET=(JMAJAC(IREEL,1,IPOGO,IELEM)
  100. $ *JMAJAC(JREEL,2,IPOGO,IELEM))
  101. $ -(JMAJAC(JREEL,1,IPOGO,IELEM)
  102. $ *JMAJAC(IREEL,2,IPOGO,IELEM))
  103. DETCAR=DETCAR+(DET*DET)
  104. 3222 CONTINUE
  105. 322 CONTINUE
  106. IF (DETCAR.GT.ZERO) THEN
  107. JDTJAC(IPOGO,IELEM)=SQRT(DETCAR)
  108. ELSE
  109. GOTO 9998
  110. ENDIF
  111. 32 CONTINUE
  112. 3 CONTINUE
  113. ELSE
  114. WRITE(IOIMP,*) 'Je ne sais pas calculer la racine'
  115. WRITE(IOIMP,*) 'du det. de la matrice tAA de dimension '
  116. WRITE(IOIMP,*) 'IESREF=',IESREF
  117. ENDIF
  118. *
  119. * Normal termination
  120. *
  121. IRET=0
  122. RETURN
  123. *
  124. * Format handling
  125. *
  126. *
  127. * Error handling
  128. *
  129. 9998 CONTINUE
  130. WRITE(IOIMP,*) 'Déterminant de la matrice tAA nul ou négatif'
  131. WRITE(IOIMP,*) 'IELEM=',IELEM,' IPOGO=',IPOGO
  132. GOTO 9999
  133. 9999 CONTINUE
  134. IRET=1
  135. WRITE(IOIMP,*) 'An error was detected in subroutine geoli3'
  136. RETURN
  137. *
  138. * End of subroutine GEOLI3
  139. *
  140. END
  141.  
  142.  
  143.  

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