Télécharger matran.eso

Retour à la liste

Numérotation des lignes :

  1. C MATRAN SOURCE CB215821 20/11/25 13:34:05 10792
  2. SUBROUTINE MATRAN(MTABD,MCHPOI)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C------------------------------------------------------------------
  6. C PROJET : CASTEM 2000
  7. C
  8. C NOM : MATRAN
  9. C
  10. C DESCRIPTION : Cette subroutine cree un chpoint 'FACE' sur MTABD
  11. C contenant la matrice de passage du repaire global
  12. C dans le repaire de chaque face (voir CALJQB)
  13. C
  14. C LANGAGE : FORTRAN 77 + ESOPE 2000
  15. C
  16. C AUTEUR : R. MOREL, DRN/DMT/SEMT/TTMF
  17. C
  18. C-----------------------------------------------------------------
  19. C
  20. C APPELES (E/S) : LEKTAB
  21. C
  22. C APPELES (Calcul): CALJBR
  23. C
  24. C-----------------------------------------------------------------
  25. C
  26. C ENTREES :
  27. C MTABD : Table de sous-type domaine
  28. C
  29. C SORTIES :
  30. C MCHPOI : Pointeur du CHPOIN contenant les
  31. C Matrices decrite ci-dessus.
  32. C
  33. C-----------------------------------------------------------------
  34. C
  35. C HISTORIQUE (Anomalies et modifications eventuelles)
  36. C
  37. C HISTORIQUE : 23.10.98, Creation
  38. C
  39. C-----------------------------------------------------------------
  40. C
  41.  
  42. -INC PPARAM
  43. -INC CCOPTIO
  44. -INC CCGEOME
  45. -INC SMTABLE
  46. POINTEUR MTABD.MTABLE
  47. -INC SMELEME
  48. POINTEUR MELEMC.MELEME,MELEMD.MELEME
  49. POINTEUR MELEMF.MELEME
  50. -INC SMCOORD
  51. -INC SMCHPOI
  52. -INC SMLENTI
  53. -INC SIZFFB
  54. PARAMETER (NBO=5)
  55. REAL*8 CFT,NORMX,NORMY,NORMZ,A2J(2,2,1),T,TX,TY,TZ,AIRE
  56. REAL*8 X1,X2,X3,Y1,Y2,Y3,Z1,Z2,Z3,SCAL,SGN,A3J(3,3,1)
  57. INTEGER NP,NPG,NES
  58. CHARACTER*8 TYPE,TYPC,NOM0,LIST1(NBO),LIST2(NBO)
  59. C Les elements complets ne sont pas tous implementes
  60. C On se ramene aux elements facep sans le centre de la face
  61. DATA LIST1/'SEG3 ','TRI4 ','TRI7 ','QUA5 ',
  62. & 'QUA9 '/
  63. DATA LIST2/'SEG2 ','TRI3 ','TRI6 ','QUA4 ',
  64. & 'QUA8 '/
  65. C
  66. CALL LEKTAB(MTABD,'FACEL',MELEMD)
  67. SEGACT MELEMD
  68. IPT2=MELEMD
  69. CALL LEKTAB(MTABD,'FACE',MELEMF)
  70. CALL KRIPAD(MELEMF,MLENTI)
  71. SEGACT MELEMF
  72. NC=IDIM*IDIM
  73. TYPE='FACE'
  74. CALL CRCHPT(TYPE,MELEMF,NC,MCHPOI)
  75. CALL LICHT(MCHPOI,MPOVAL,TYPC,IGEOM)
  76. CALL LEKTAB(MTABD,'FACEP',MELEME)
  77. SEGACT MELEME
  78. C
  79. SEGACT MCHPOI*MOD
  80. MSOUPO=MCHPOI.IPCHP(1)
  81. SEGACT MSOUPO*MOD
  82. NBSOUS=LISOUS(/1)
  83. IF(NBSOUS.EQ.0)NBSOUS=1
  84. IF (IDIM.EQ.2) THEN
  85. C
  86. NOCOMP(1)='UX '
  87. NOCOMP(2)='UY '
  88. NOCOMP(3)='RX '
  89. NOCOMP(4)='RY '
  90. DO 1 L=1,NBSOUS
  91. IPT1=MELEME
  92. IF(NBSOUS.NE.1)IPT1=LISOUS(L)
  93. SEGACT IPT1
  94. NP=IPT1.NUM(/1)-1
  95. NEL=IPT1.NUM(/2)
  96. C Toutes les faces sont des SEG3 donc NP=2
  97. IF(NP.NE.2)RETURN
  98. C
  99. C
  100. C On considere la face sans son centre comme un elt fini SEG2
  101. C
  102. TYPE = NOMS(IPT1.ITYPEL)//' '
  103. CALL OPTLI(IP,LIST1,TYPE,NBO)
  104. IF (IP .EQ. 0) CALL ERREUR(5)
  105. TYPE = LIST2(IP)
  106. CALL KALPBG(TYPE,'FONFORM0',IZFFM)
  107. SEGACT IZFFM*MOD
  108. IZHR=KZHR(1)
  109. SEGACT IZHR*MOD
  110. NES=1
  111. NPG=1
  112. C Boucle sur toutes les faces pour le paquet L
  113. DO 10 K=1,NEL
  114. NF=LECT(IPT1.NUM(NP+1,K))
  115. C REMPLISSAGE DE XYZ
  116. C ------------------
  117. C
  118. DO 12 I=1,NP
  119. J=IPT1.NUM(I,K)
  120. DO 12 N=1,IDIM
  121. XYZ(N,I)=XCOOR((J-1)*(IDIM+1)+N)
  122. 12 CONTINUE
  123. C
  124. C CALJBR calcul le jacobien du passage de l'elt de ref.
  125. C a l'elt. reel
  126. C A2J=Jacobien AIRE=detA2J
  127. CALL CALJBR(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NP,
  128. &NPG,IAXI,AIRE,A2J,SGEN)
  129. C
  130. NORMX=A2J(1,2,1)
  131. NORMY=A2J(2,2,1)
  132. C On verifie que n est dans le meme sens que vec(13) de FACEL
  133. C Calcul de vec(13)
  134. C FACEL est repere par IPT2
  135. J1=IPT2.NUM(1,NF)
  136. J2=IPT2.NUM(2,NF)
  137. JJ2=LECT(J2)
  138. J3=IPT2.NUM(3,NF)
  139. C
  140. IF (J1.eq.J3) THEN
  141. X1=XCOOR((J1-1)*(IDIM+1)+1)
  142. Y1=XCOOR((J1-1)*(IDIM+1)+2)
  143. X2=XCOOR((J2-1)*(IDIM+1)+1)
  144. Y2=XCOOR((J2-1)*(IDIM+1)+2)
  145. SCAL=(X2-X1)*NORMX+(Y2-Y1)*NORMY
  146. SGN=SIGN(1.D0,SCAL)
  147. C
  148. ELSE
  149. X1=XCOOR((J1-1)*(IDIM+1)+1)
  150. Y1=XCOOR((J1-1)*(IDIM+1)+2)
  151. X3=XCOOR((J3-1)*(IDIM+1)+1)
  152. Y3=XCOOR((J3-1)*(IDIM+1)+2)
  153. SCAL=(X3-X1)*NORMX+(Y3-Y1)*NORMY
  154. SGN=SIGN(1.D0,SCAL)
  155. ENDIF
  156. MPOVAL.VPOCHA(JJ2,1)=A2J(1,1,1)
  157. MPOVAL.VPOCHA(JJ2,2)=A2J(2,1,1)
  158. MPOVAL.VPOCHA(JJ2,3)=SGN*NORMX
  159. MPOVAL.VPOCHA(JJ2,4)=SGN*NORMY
  160. C
  161. C
  162. 10 CONTINUE
  163. C
  164. SEGDES IPT1
  165. 1 CONTINUE
  166. C
  167. C
  168. ELSE
  169. C
  170. NOCOMP(1)='UX '
  171. NOCOMP(2)='UY '
  172. NOCOMP(3)='UZ '
  173. NOCOMP(4)='RX '
  174. NOCOMP(5)='RY '
  175. NOCOMP(6)='RZ '
  176. NOCOMP(7)='MX '
  177. NOCOMP(8)='MY '
  178. NOCOMP(9)='MZ '
  179. DO 21 L=1,NBSOUS
  180. IPT1=MELEME
  181. IF(NBSOUS.NE.1)IPT1=LISOUS(L)
  182. SEGACT IPT1
  183. NP=IPT1.NUM(/1)-1
  184. NEL=IPT1.NUM(/2)
  185. C Les elts complets ne sont pas implementes, on utilise
  186. C l'elt. face sans le centre
  187. C
  188. TYPE = NOMS(IPT1.ITYPEL)//' '
  189. CALL OPTLI(IP,LIST1,TYPE,NBO)
  190. IF (IP .EQ. 0) CALL ERREUR(5)
  191. TYPE = LIST2(IP)
  192. C Calcul des fonctions de forme sur l'elt. de reference
  193. C
  194. CALL KALPBG(TYPE,'FONFORM0',IZFFM)
  195. SEGACT IZFFM*MOD
  196. IZHR=KZHR(1)
  197. SEGACT IZHR*MOD
  198. NES=2
  199. NPG=1
  200. C Boucle sur les faces du paquet L
  201. DO 210 K=1,NEL
  202. NF=LECT(IPT1.NUM(NP+1,K))
  203. C
  204. C REMPLISSAGE DE XYZ
  205. C ------------------
  206. C
  207. C write(6,*)'num',(ipt1.num(ii,k),ii=1,np+1),' NF=',nf
  208. DO 212 I=1,NP
  209. J=IPT1.NUM(I,K)
  210. DO 212 N=1,IDIM
  211. XYZ(N,I)=XCOOR((J-1)*(IDIM+1)+N)
  212. 212 CONTINUE
  213. C
  214. C
  215. C calcul du jacobien idem dim 2
  216. C
  217. CALL CALJBR(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NP,
  218. & NPG,IAXI,AIRE,A3J,SGEN)
  219. NORMX=A3J(1,3,1)
  220. NORMY=A3J(2,3,1)
  221. NORMZ=A3J(3,3,1)
  222. C
  223. C On verifie que n est dans le meme sens que vec(13) de FACEL
  224. C Calcul de vec(13)
  225. C FACEL est repere par IPT2
  226. J1=IPT2.NUM(1,NF)
  227. J2=IPT2.NUM(2,NF)
  228. JJ2=LECT(J2)
  229. J3=IPT2.NUM(3,NF)
  230. C
  231. IF (J1.eq.J3) THEN
  232. X1=XCOOR((J1-1)*(IDIM+1)+1)
  233. Y1=XCOOR((J1-1)*(IDIM+1)+2)
  234. Z1=XCOOR((J1-1)*(IDIM+1)+3)
  235. X2=XCOOR((J2-1)*(IDIM+1)+1)
  236. Y2=XCOOR((J2-1)*(IDIM+1)+2)
  237. Z2=XCOOR((J2-1)*(IDIM+1)+3)
  238. C
  239. SCAL=(X2-X1)*NORMX+(Y2-Y1)*NORMY+(Z2-Z1)*NORMZ
  240. SGN=SIGN(1.D0,SCAL)
  241. C
  242. ELSE
  243. X1=XCOOR((J1-1)*(IDIM+1)+1)
  244. Y1=XCOOR((J1-1)*(IDIM+1)+2)
  245. Z1=XCOOR((J1-1)*(IDIM+1)+3)
  246. X3=XCOOR((J3-1)*(IDIM+1)+1)
  247. Y3=XCOOR((J3-1)*(IDIM+1)+2)
  248. Z3=XCOOR((J3-1)*(IDIM+1)+3)
  249. SCAL=(X3-X1)*NORMX+(Y3-Y1)*NORMY+(Z3-Z1)*NORMZ
  250. SGN=SIGN(1.D0,SCAL)
  251. ENDIF
  252. C
  253. TX=A3J(1,1,1)
  254. TY=A3J(2,1,1)
  255. TZ=A3J(3,1,1)
  256. T=SQRT(TX*TX+TY*TY+TZ*TZ)
  257. TX=TX / T
  258. TY=TY / T
  259. TZ=TZ / T
  260. MPOVAL.VPOCHA(JJ2,1)=TX
  261. MPOVAL.VPOCHA(JJ2,2)=TY
  262. MPOVAL.VPOCHA(JJ2,3)=TZ
  263. MPOVAL.VPOCHA(JJ2,4)=NORMY*TZ-NORMZ*TY
  264. MPOVAL.VPOCHA(JJ2,5)=NORMZ*TX-NORMX*TZ
  265. MPOVAL.VPOCHA(JJ2,6)=NORMX*TY-NORMY*TX
  266. MPOVAL.VPOCHA(JJ2,7)=SGN*NORMX
  267. MPOVAL.VPOCHA(JJ2,8)=SGN*NORMY
  268. MPOVAL.VPOCHA(JJ2,9)=SGN*NORMZ
  269. C
  270. 210 CONTINUE
  271. C
  272. SEGDES IPT1
  273. 21 CONTINUE
  274. ENDIF
  275. CALL ECMO(MTABD,'MATROT','CHPOINT ',MCHPOI)
  276. SEGSUP MLENTI
  277. SEGDES MELEMD
  278. SEGDES MELEME
  279. SEGDES MELEMF
  280. SEGDES MCHPOI
  281. SEGDES MSOUPO
  282. SEGDES MPOVAL
  283. RETURN
  284. END
  285.  
  286.  
  287.  
  288.  
  289.  
  290.  
  291.  
  292.  
  293.  
  294.  
  295.  
  296.  

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