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.  
  62. -INC PPARAM
  63. -INC CCOPTIO
  64. INTEGER IESREF,IESREL,NDPOGO,NDELEM
  65. REAL*8 JMAJAC(IESREL,IESREF,NDPOGO,NDELEM)
  66. REAL*8 JDTJAC(NDPOGO,NDELEM)
  67. *
  68. INTEGER IMPR,IRET
  69. *
  70. REAL*8 ZERO
  71. PARAMETER (ZERO=0.D0)
  72. *
  73. INTEGER IELEM,IPOGO,IREEL,JREEL
  74. REAL*8 DETCAR,DET
  75. *
  76. * Executable statements
  77. *
  78. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans geoli3'
  79. IF (IESREF.EQ.1) THEN
  80. DO 1 IELEM=1,NDELEM
  81. DO 12 IPOGO=1,NDPOGO
  82. DETCAR=ZERO
  83. DO 122 IREEL=1,IESREL
  84. DETCAR=DETCAR+
  85. $ (JMAJAC(IREEL,1,IPOGO,IELEM)
  86. $ *JMAJAC(IREEL,1,IPOGO,IELEM))
  87. 122 CONTINUE
  88. IF (DETCAR.GT.ZERO) THEN
  89. JDTJAC(IPOGO,IELEM)=SQRT(DETCAR)
  90. ELSE
  91. GOTO 9998
  92. ENDIF
  93. 12 CONTINUE
  94. 1 CONTINUE
  95. ELSEIF (IESREF.EQ.2) THEN
  96. DO 3 IELEM=1,NDELEM
  97. DO 32 IPOGO=1,NDPOGO
  98. DETCAR=ZERO
  99. DO 322 IREEL=1,IESREL-1
  100. DO 3222 JREEL=IREEL+1,IESREL
  101. DET=(JMAJAC(IREEL,1,IPOGO,IELEM)
  102. $ *JMAJAC(JREEL,2,IPOGO,IELEM))
  103. $ -(JMAJAC(JREEL,1,IPOGO,IELEM)
  104. $ *JMAJAC(IREEL,2,IPOGO,IELEM))
  105. DETCAR=DETCAR+(DET*DET)
  106. 3222 CONTINUE
  107. 322 CONTINUE
  108. IF (DETCAR.GT.ZERO) THEN
  109. JDTJAC(IPOGO,IELEM)=SQRT(DETCAR)
  110. ELSE
  111. GOTO 9998
  112. ENDIF
  113. 32 CONTINUE
  114. 3 CONTINUE
  115. ELSE
  116. WRITE(IOIMP,*) 'Je ne sais pas calculer la racine'
  117. WRITE(IOIMP,*) 'du det. de la matrice tAA de dimension '
  118. WRITE(IOIMP,*) 'IESREF=',IESREF
  119. ENDIF
  120. *
  121. * Normal termination
  122. *
  123. IRET=0
  124. RETURN
  125. *
  126. * Format handling
  127. *
  128. *
  129. * Error handling
  130. *
  131. 9998 CONTINUE
  132. WRITE(IOIMP,*) 'Déterminant de la matrice tAA nul ou négatif'
  133. WRITE(IOIMP,*) 'IELEM=',IELEM,' IPOGO=',IPOGO
  134. GOTO 9999
  135. 9999 CONTINUE
  136. IRET=1
  137. WRITE(IOIMP,*) 'An error was detected in subroutine geoli3'
  138. RETURN
  139. *
  140. * End of subroutine GEOLI3
  141. *
  142. END
  143.  
  144.  
  145.  

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