Télécharger kdom11.eso

Retour à la liste

Numérotation des lignes :

  1. C KDOM11 SOURCE KK2000 14/04/10 21:15:11 8032
  2. SUBROUTINE KDOM11(MELF,MELFL,MELFP,MCHPSU,MCHPNO,MCHPMR)
  3. C
  4. C************************************************************************
  5. C
  6. C PROJET : CASTEM 2000
  7. C
  8. C NOM : KDOM11
  9. C
  10. C DESCRIPTION : Subroutine called by KDOM10 in the case of EULER
  11. C model.
  12. C We create the CHPOINTS
  13. C MCHPSU = surfaces (faces dimension)
  14. C MCHPNO = normals (oriented from the first
  15. C to the second point of FACEL)
  16. C MCHPMR = rotation matrix
  17. C
  18. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
  19. C
  20. C AUTEUR : A. BECCANTINI, DRN/DMT/SEMT/LTMF
  21. C
  22. C************************************************************************
  23. C
  24. C INPUTS :
  25. C
  26. C MELF : meleme 'FACE'
  27. C MELFL : meleme 'FACEL'
  28. C MELFP : meleme 'FACEP'
  29. C
  30. C OUTPUTS :
  31. C
  32. C MCHPSU : mchpoi 'XXSURFAC'
  33. C MCHPNO : mchpoi 'XXNORMAF'
  34. C MCHPMR : mchpoi 'MATROT'
  35. C
  36. C
  37. IMPLICIT INTEGER(I-N)
  38. IMPLICIT REAL*8(A-H,O-Z)
  39. C
  40. INTEGER IGEOM, MCHPSU, MCHPNO, MCHPMR
  41. & ,JGN, JGM, NBSOUS, ISOUS, NP, NEL, IEL, IPO, NLCF
  42. & , NF, IFAC
  43. REAL*8 XF,YF,X1,Y1, DSURFX, DSURFY, XSURF, YSURF, SURF, A
  44. & ,ORIENT
  45. & ,ZF, DXP, DYP, DZP, DXPM1, DYPM1, DZPM1, DSURFZ, ZSURF
  46. & ,RMX, RMY, RMZ, RRX, RRY, RRZ
  47. CHARACTER*8 TYPE
  48.  
  49. -INC CCOPTIO
  50. -INC SMELEME
  51. POINTEUR MELFL.MELEME,MELFP.MELEME,MELF.MELEME
  52. -INC SMCHPOI
  53. POINTEUR MPOVSU.MPOVAL, MPOVNO.MPOVAL, MPOVMR.MPOVAL
  54. -INC SMLENTI
  55. -INC SMLMOTS
  56. -INC SMCOORD
  57. C
  58. C**** Corresp. FACE
  59. C
  60. CALL KRIPAD(MELF,MLENTI)
  61. C SEGINI MLENTI
  62. C
  63. C**** Champoint surfaces
  64. C
  65. JGN=4
  66. JGM=1
  67. SEGINI MLMOTS
  68. MLMOTS.MOTS(1)='SCAL'
  69. TYPE='FACE '
  70. CALL KRCHP1(TYPE,MELF,MCHPSU,MLMOTS)
  71. IF(IERR.NE.0)GOTO 9999
  72. CALL LICHT(MCHPSU,MPOVSU,TYPE,IGEOM)
  73. IF(IERR.NE.0)GOTO 9999
  74. C SEGACT MPOVSU
  75. SEGSUP MLMOTS
  76. C
  77. C**** Champoint normales
  78. C
  79. JGN=4
  80. JGM=IDIM
  81. SEGINI MLMOTS
  82. MLMOTS.MOTS(1)='UX'
  83. MLMOTS.MOTS(2)='UY'
  84. IF(IDIM .EQ. 3) MLMOTS.MOTS(3)='UZ'
  85. TYPE='FACE '
  86. CALL KRCHP1(TYPE,MELF,MCHPNO,MLMOTS)
  87. IF(IERR.NE.0)GOTO 9999
  88. CALL LICHT(MCHPNO,MPOVNO,TYPE,IGEOM)
  89. IF(IERR.NE.0)GOTO 9999
  90. C SEGACT MPOVNO
  91. SEGSUP MLMOTS
  92. C
  93. C**** Champoint matrice de rotation
  94. C
  95. JGN=4
  96. JGM=IDIM*IDIM
  97. SEGINI MLMOTS
  98. IF(IDIM.EQ.2)THEN
  99. MLMOTS.MOTS(1)='RX'
  100. MLMOTS.MOTS(2)='RY'
  101. MLMOTS.MOTS(3)='MX'
  102. MLMOTS.MOTS(4)='MY'
  103. * Normale en M
  104. * vect(M,U) = z
  105. ELSE
  106. MLMOTS.MOTS(1)='UX'
  107. MLMOTS.MOTS(2)='UY'
  108. MLMOTS.MOTS(3)='UZ'
  109. MLMOTS.MOTS(4)='RX'
  110. MLMOTS.MOTS(5)='RY'
  111. MLMOTS.MOTS(6)='RZ'
  112. MLMOTS.MOTS(7)='MX'
  113. MLMOTS.MOTS(8)='MY'
  114. MLMOTS.MOTS(9)='MZ'
  115. * Normale en M
  116. * vect(M,R) = U
  117. ENDIF
  118. CALL KRCHP1(TYPE,MELF,MCHPMR,MLMOTS)
  119. IF(IERR.NE.0)GOTO 9999
  120. CALL LICHT(MCHPMR,MPOVMR,TYPE,IGEOM)
  121. IF(IERR.NE.0)GOTO 9999
  122. C SEGACT MPOVMR
  123. C
  124. SEGACT MELFP
  125. NBSOUS=MELFP.LISOUS(/1)
  126. IF(NBSOUS.EQ.0)NBSOUS=1
  127. SEGACT MELFL
  128. C**********************
  129. C CAS DE LA DIMENSION 2
  130. C**********************
  131. IF (IDIM.EQ.2) THEN
  132. C
  133. DO ISOUS=1,NBSOUS,1
  134. IPT1 = MELFP
  135. IF(NBSOUS .NE. 1)THEN
  136. IPT1 = MELFP.LISOUS(ISOUS)
  137. SEGACT IPT1
  138. ENDIF
  139. C
  140. NP=IPT1.NUM(/1)-1
  141. NEL=IPT1.NUM(/2)
  142. IF(NP .NE. 2)THEN
  143. WRITE(IOIMP,*) 'Subroutine knrf.eso'
  144. CALL ERREUR(5)
  145. ENDIF
  146. C
  147. DO IEL=1,NEL,1
  148. NF=IPT1.NUM(NP+1,IEL)
  149. XF = XCOOR((NF-1)*(IDIM+1)+1)
  150. YF = XCOOR((NF-1)*(IDIM+1)+2)
  151. *
  152. IPO=IPT1.NUM(1,IEL)
  153. X1=XCOOR((IPO-1)*(IDIM+1)+1)
  154. Y1=XCOOR((IPO-1)*(IDIM+1)+2)
  155. DSURFX=Y1-YF
  156. DSURFY=XF-X1
  157. XSURF=DSURFX
  158. YSURF=DSURFY
  159. SURF=((DSURFX*DSURFX)+(DSURFY*DSURFY))**0.5D0
  160. *
  161. IPO=IPT1.NUM(2,IEL)
  162. X1=XCOOR((IPO-1)*(IDIM+1)+1)
  163. Y1=XCOOR((IPO-1)*(IDIM+1)+2)
  164. DSURFX=YF-Y1
  165. DSURFY=X1-XF
  166. XSURF=XSURF+DSURFX
  167. YSURF=YSURF+DSURFY
  168. SURF=SURF+(((DSURFX*DSURFX)+(DSURFY*DSURFY))**0.5D0)
  169. C
  170. NLCF=MLENTI.LECT(NF)
  171. MPOVSU.VPOCHA(NLCF,1)=SURF
  172. C
  173. C************* Orientation selon FACEL
  174. C
  175. IPO=MELFL.NUM(1,NLCF)
  176. X1=XCOOR((IPO-1)*(IDIM+1)+1)
  177. Y1=XCOOR((IPO-1)*(IDIM+1)+2)
  178. DSURFX=XF-X1
  179. DSURFY=YF-Y1
  180. ORIENT=SIGN(1.0D0,((DSURFX*XSURF)+(DSURFY*YSURF)))
  181. C
  182. MPOVNO.VPOCHA(NLCF,1)=XSURF/SURF*ORIENT
  183. MPOVNO.VPOCHA(NLCF,2)=YSURF/SURF*ORIENT
  184. C
  185. MPOVMR.VPOCHA(NLCF,3)=XSURF/SURF*ORIENT
  186. MPOVMR.VPOCHA(NLCF,4)=YSURF/SURF*ORIENT
  187. MPOVMR.VPOCHA(NLCF,1)=-1*YSURF/SURF*ORIENT
  188. MPOVMR.VPOCHA(NLCF,2)=XSURF/SURF*ORIENT
  189. C
  190. ENDDO
  191. IF(NBSOUS .NE. 1) SEGDES IPT1
  192. ENDDO
  193. C**********************
  194. C CAS DE LA DIMENSION 3
  195. C**********************
  196. ELSE
  197. C
  198. DO ISOUS=1,NBSOUS,1
  199. IPT1 = MELFP
  200. IF(NBSOUS .NE. 1)THEN
  201. IPT1 = MELFP.LISOUS(ISOUS)
  202. SEGACT IPT1
  203. ENDIF
  204. C
  205. NP=IPT1.NUM(/1)-1
  206. NEL=IPT1.NUM(/2)
  207. C
  208. DO IEL=1,NEL,1
  209. NF=IPT1.NUM(NP+1,IEL)
  210. XF = XCOOR((NF-1)*(IDIM+1)+1)
  211. YF = XCOOR((NF-1)*(IDIM+1)+2)
  212. ZF = XCOOR((NF-1)*(IDIM+1)+3)
  213. *
  214. IPO=IPT1.NUM(NP,IEL)
  215. DXP = XCOOR((IPO-1)*(IDIM+1)+1) - XF
  216. DYP = XCOOR((IPO-1)*(IDIM+1)+2) - YF
  217. DZP = XCOOR((IPO-1)*(IDIM+1)+3) - ZF
  218. SURF=0.0D0
  219. XSURF=0.0D0
  220. YSURF=0.0D0
  221. ZSURF=0.0D0
  222. DO IFAC=1,NP,1
  223. DXPM1 = DXP
  224. DYPM1 = DYP
  225. DZPM1 = DZP
  226. IPO=IPT1.NUM(IFAC,IEL)
  227. DXP = XCOOR((IPO-1)*(IDIM+1)+1) - XF
  228. DYP = XCOOR((IPO-1)*(IDIM+1)+2) - YF
  229. DZP = XCOOR((IPO-1)*(IDIM+1)+3) - ZF
  230. DSURFX = 0.5D0 * ((DYPM1 * DZP) - (DZPM1 * DYP))
  231. DSURFY = 0.5D0 * ((DZPM1 * DXP) - (DXPM1 * DZP))
  232. DSURFZ = 0.5D0 * ((DXPM1 * DYP) - (DYPM1 * DXP))
  233. XSURF=XSURF+DSURFX
  234. YSURF=YSURF+DSURFY
  235. ZSURF=ZSURF+DSURFZ
  236. ENDDO
  237. *
  238. SURF=(XSURF*XSURF)+(YSURF*YSURF)+(ZSURF*ZSURF)
  239. SURF=SURF**0.5D0
  240. NLCF=MLENTI.LECT(NF)
  241. MPOVSU.VPOCHA(NLCF,1)=SURF
  242. C
  243. C************* Orientation selon FACEL
  244. C
  245. IPO=MELFL.NUM(1,NLCF)
  246. DSURFX=XF-XCOOR((IPO-1)*(IDIM+1)+1)
  247. DSURFY=YF-XCOOR((IPO-1)*(IDIM+1)+2)
  248. DSURFZ=ZF-XCOOR((IPO-1)*(IDIM+1)+3)
  249. ORIENT=SIGN(1.0D0,((DSURFX*XSURF)+(DSURFY*YSURF)+(DSURFZ
  250. & *ZSURF)))
  251. C
  252. MPOVNO.VPOCHA(NLCF,1)=XSURF/SURF*ORIENT
  253. MPOVNO.VPOCHA(NLCF,2)=YSURF/SURF*ORIENT
  254. MPOVNO.VPOCHA(NLCF,3)=ZSURF/SURF*ORIENT
  255. C
  256. C************* MATROT
  257. C
  258. C Normal
  259. C
  260. MPOVMR.VPOCHA(NLCF,7)=XSURF/SURF*ORIENT
  261. MPOVMR.VPOCHA(NLCF,8)=YSURF/SURF*ORIENT
  262. MPOVMR.VPOCHA(NLCF,9)=ZSURF/SURF*ORIENT
  263.  
  264. C First direction (RX,RY,RZ) is normal to the
  265. C normal and FP (P = first point of FACEP)
  266. C
  267. IPO=IPT1.NUM(1,IEL)
  268. DXP = XCOOR((IPO-1)*(IDIM+1)+1) - XF
  269. DYP = XCOOR((IPO-1)*(IDIM+1)+2) - YF
  270. DZP = XCOOR((IPO-1)*(IDIM+1)+3) - ZF
  271. DSURFX = (ZSURF * DYP) - (YSURF * DZP)
  272. DSURFY = (XSURF * DZP) - (ZSURF * DXP)
  273. DSURFZ = (YSURF * DXP) - (XSURF * DYP)
  274. C
  275. C DZP=modulus of the RX,RY,RZ
  276. C
  277. DZP=(((DSURFX*DSURFX)+(DSURFY*DSURFY)+
  278. & (DSURFZ*DSURFZ))**0.5D0)
  279. C
  280. MPOVMR.VPOCHA(NLCF,4)=DSURFX/DZP
  281. MPOVMR.VPOCHA(NLCF,5)=DSURFY/DZP
  282. MPOVMR.VPOCHA(NLCF,6)=DSURFZ/DZP
  283. C
  284. C (UX,UY,UZ,RX,RY,RZ,MX,MY,MZ)=(1,2,3,4,5,6,7,8,9)
  285. C M,R,U is a right-hand normal frame
  286. C
  287. RMX=MPOVMR.VPOCHA(NLCF,7)
  288. RMY=MPOVMR.VPOCHA(NLCF,8)
  289. RMZ=MPOVMR.VPOCHA(NLCF,9)
  290. RRX=MPOVMR.VPOCHA(NLCF,4)
  291. RRY=MPOVMR.VPOCHA(NLCF,5)
  292. RRZ=MPOVMR.VPOCHA(NLCF,6)
  293. C
  294. MPOVMR.VPOCHA(NLCF,1)=(RMY*RRZ) - (RMZ*RRY)
  295. MPOVMR.VPOCHA(NLCF,2)=(RMZ*RRX) - (RMX*RRZ)
  296. MPOVMR.VPOCHA(NLCF,3)=(RMX*RRY) - (RMY*RRX)
  297. ENDDO
  298. IF(NBSOUS .NE. 1) SEGDES IPT1
  299. ENDDO
  300. ENDIF
  301. C
  302. SEGDES MPOVSU
  303. SEGDES MPOVNO
  304. SEGDES MPOVMR
  305. SEGDES MELFP
  306. C
  307. SEGDES MELFL
  308. SEGSUP MLENTI
  309. C
  310. 9999 RETURN
  311. END
  312.  
  313.  
  314.  
  315.  
  316.  
  317.  
  318.  
  319.  
  320.  
  321.  
  322.  
  323.  
  324.  
  325.  
  326.  
  327.  

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