Télécharger kdxdy.eso

Retour à la liste

Numérotation des lignes :

  1. C KDXDY SOURCE MAGN 17/02/24 21:15:11 9323
  2. SUBROUTINE KDXDY
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C*************************************************************************
  6. C
  7. C OBJET : Cree un CHAMPOINT CENTRE contenant les informations
  8. C décrites ci dessous, sur les éléments du domaine.
  9. C
  10. C SYNTAXE : CHPC = KDXDY OBJDOM ;
  11. C
  12. C OBJDOM : TABLE de SOUSTYPE DOMAINE
  13. C
  14. C AVIS IMPORTANT ;
  15. C
  16. C Ces informations sont destinées aux opérateurs de discrétisation
  17. C et sont rangées dans un ordre particulier.
  18. C
  19. C Les dimensions du tableau sont : (DIME NBEL) DIME=11 en 2D
  20. C DIME=13 en 3D
  21. C et il contient :
  22. C
  23. C pour un SEG2 la longueur de l'element (XML) et la matrice P(2,2) en 2D
  24. C P(3,3) en 3D
  25. C pour un TRI3 XML,XMH,AJ1/XML,AJ2/XML, et la matrice P(2,2) en 2D
  26. C P(3,3) en 3D
  27. C pour un QUA4 IDEM
  28. C pour un CUB8 XML XMH XME et la matrice P
  29. C pour un PRI6 IDEM
  30. C
  31. C***********************************************************************
  32. C MATRICE P
  33. C LA MATRICE DE ROTATION DU REPERE GLOBALE VERS LE REPERE LOCAL
  34. C DEFINI PAR DEUX OU TROIS POINTS PRIS DANS XYZ SUIVANT QU'ON EST
  35. C EN 2D OU EN 3D
  36. C ON PREND P1 P2 ET PNP
  37. C
  38. C U TEL QUE T SOIT DIRIGE SUIVANT P1P2 V TOURNE VERS
  39. C . .V P1PNP ET U = T VECTORIEL V
  40. C . .
  41. C . . __ __
  42. C (P1). . . . .T (P2) | tx ty tz |
  43. C | |
  44. C ON A ALORS WL= P WG P = | vx vy vz |
  45. C | |
  46. C | ux uy uz |
  47. C |__ __|
  48. C*************************************************************************
  49. -INC CCOPTIO
  50. -INC CCREEL
  51. *-
  52. -INC CCGEOME
  53. -INC SMTABLE
  54. -INC SMELEME
  55. POINTEUR MELEMC.MELEME
  56. -INC SMCOORD
  57. -INC SMCHPOI
  58. -INC SIZFFB
  59. PARAMETER (NLTS=10)
  60. CHARACTER*8 LISTS(NLTS)
  61. C***
  62. DIMENSION AAJ(3,3,9),XC(3),T(13),DELTAX(3)
  63. PARAMETER (NTB=1)
  64. CHARACTER*8 LTAB(NTB),TYPE,NOM0,TYPC
  65. DIMENSION KTAB(NTB)
  66. DATA LTAB/'DOMAINE '/
  67. DATA LISTS/'QUA4 ','CUB8 ','TRI3 ','PRI6 ',
  68. &'SEG2 ','TET4 ','PYR5 ','TRI7 ','QUA9 ',
  69. &'SEG3 '/
  70. C***
  71. NTO=NTB
  72. CALL LITABS(LTAB,KTAB,NTB,NTO,IRET)
  73. IF(IRET.EQ.0)RETURN
  74. MTABD=KTAB(1)
  75.  
  76. TYPE=' '
  77. CALL ACMO(MTABD,'CENTRE',TYPE,MELEMC)
  78.  
  79. NC=IDIM
  80.  
  81. TYPE='CENTRE'
  82. CALL CRCHPT(TYPE,MELEMC,NC,MCHPOI)
  83. CALL LICHTM(MCHPOI,MPOVAL,TYPC,IGEOM)
  84.  
  85. TYPE=' '
  86. CALL ACMO(MTABD,'MAILLAGE',TYPE,MELEME)
  87. IF(TYPE.NE.'MAILLAGE')GO TO 90
  88. SEGACT MELEME
  89.  
  90. IAXI=0
  91. IF(IFOMOD.EQ.0)IAXI=2
  92. NPGI=1
  93.  
  94. NBSOUS=LISOUS(/1)
  95. IF(NBSOUS.EQ.0)NBSOUS=1
  96.  
  97. K0=0
  98. DO 1 L=1,NBSOUS
  99. IPT1=MELEME
  100. IF(NBSOUS.NE.1)IPT1=LISOUS(L)
  101. SEGACT IPT1
  102. NP=IPT1.NUM(/1)
  103. NEL=IPT1.NUM(/2)
  104. NOM0=NOMS(IPT1.ITYPEL)//' '
  105. C write(6,*)' KDXDY : NOM0=',nom0,' NEL=',nel
  106. CALL OPTLI(IP,LISTS,NOM0,NLTS)
  107. IF(IP.EQ.0)THEN
  108. WRITE(6,*)' Sub KDXDY :'
  109. WRITE(6,*)' Il y a des types d''éléments pour lesquels on ne sait'
  110. &,'pas faire'
  111. GO TO 1
  112. ENDIF
  113. CALL KALPBG(NOM0,'FONFORM ',IZFFM)
  114. SEGACT IZFFM*MOD
  115. IZHR=KZHR(1)
  116. SEGACT IZHR*MOD
  117. NES=GR(/1)
  118. NPG=GR(/3)
  119.  
  120. DO 10 K=1,NEL
  121. KK=K0+K
  122. NPGR=0
  123. IF(IAXI.NE.0)NPGR=NPG
  124. C
  125. C REMPLISSAGE DE XYZ
  126. C ------------------
  127. C
  128. DO 12 I=1,NP
  129. J=IPT1.NUM(I,K)
  130. DO 12 N=1,IDIM
  131. XYZ(N,I)=XCOOR((J-1)*(IDIM+1)+N)
  132. 12 CONTINUE
  133.  
  134. CALL CALJAJ(GR,XYZ,NES,IDIM,NP,NPGI,AAJ)
  135. C
  136. CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NP,NPG,IAXI,AIRE)
  137.  
  138. IF(AIRE.LE.0.D0)AIRE=ABS(AIRE)
  139.  
  140.  
  141. C CALCUL DES LONGUEURS DES COTES DE L'ELEMENT
  142. C UNIQUEMENT POUR LES SEG2 QUA4 ET CUB8
  143.  
  144. XML=0.
  145. DO 231 N=1,IDIM
  146. XML=XML+(XYZ(N,1)-XYZ(N,2))*(XYZ(N,1)-XYZ(N,2))
  147. 231 CONTINUE
  148. XML=SQRT(XML)
  149.  
  150. DO 234 N=1,IDIM
  151. DELTAX(N)=ABS(XYZ(N,NP)-XYZ(N,1))
  152. DO 233 I=2,NP
  153. DELTAX(N)=DELTAX(N)+ABS(XYZ(N,I)-XYZ(N,I-1))
  154. 233 CONTINUE
  155. VPOCHA(KK,N)=(DELTAX(N)/FLOAT(NP))+XPETIT
  156. IF(NOM0.EQ.'QUA4 ')THEN
  157. VPOCHA(KK,N)=VPOCHA(KK,N)*FLOAT(IDIM)
  158. ENDIF
  159. 234 CONTINUE
  160.  
  161. C
  162. C
  163. IF(XML.EQ.0.)
  164. &WRITE(6,*)' ELEMENT DEGENERE ( AYANT UN COTE DE LONGUEUR NULLE) '
  165. C
  166. C
  167. 10 CONTINUE
  168. K0=K0+NEL
  169. SEGDES IPT1
  170. 1 CONTINUE
  171. SEGDES MELEME,MPOVAL,MCHPOI
  172. C
  173. CALL ECROBJ('CHPOINT ',MCHPOI)
  174.  
  175. RETURN
  176.  
  177. 90 CONTINUE
  178. WRITE(6,*)' Interruption anormale de KDXDY'
  179. RETURN
  180. 1001 FORMAT(20(1X,I5))
  181. 1002 FORMAT(10(1X,1PE11.4))
  182. END
  183.  
  184.  
  185.  
  186.  
  187.  
  188.  
  189.  
  190.  
  191.  
  192.  
  193.  
  194.  
  195.  
  196.  
  197.  
  198.  
  199.  
  200.  
  201.  
  202.  
  203.  
  204.  

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