Télécharger matran.eso

Retour à la liste

Numérotation des lignes :

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

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