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

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