Télécharger kalpr2.eso

Retour à la liste

Numérotation des lignes :

  1. C KALPR2 SOURCE CB215821 16/04/21 21:17:22 8920
  2. SUBROUTINE KALPR2 (MYMOD,INFOEL,SKFAC2,SHC2D,XDEC,NELD,SKRESO)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C----------------------------------------------------------------------
  6. * Facteurs de forme en 2D-PLAN. Cas general
  7. * Calcul du decoupage des faces et initialisations
  8. * SP APPELE PAR facge2
  9. * entrée
  10. * MYMOD : pointeur de l'objet modèle
  11. * INFOEL : informations concernant le type des éléments des maillages
  12. * XDEC : parametre pour le decoupage des faces
  13. * NELD : nombre total d'elements
  14. * sortie
  15. * SKRESO : pointeur infos. globales
  16. * SKFAC2 : pointeur sur l objet 'faces' pour le calcul des FF
  17. * SHC2D : pointeur sur la surface de projection
  18. C----------------------------------------------------------------------
  19. C traitement des coques par dedoublement des elements
  20. C traitement des quadratiques en se ramenant a des elements
  21. C lineaires
  22. C----------------------------------------------------------------------
  23. LOGICAL ICOQ
  24. -INC CCOPTIO
  25. -INC SMCOORD
  26. -INC SMMODEL
  27. POINTEUR MYMOD.MMODEL
  28. -INC SMELEME
  29.  
  30. C ---------------------------------------------------------------
  31. C Stockage d'informations concernant le type des éléments des maillages
  32. SEGMENT ,INFOEL
  33. LOGICAL KCOQ(N1),KQUAD(N1)
  34. ENDSEGMENT
  35. C ---------------------------------------------------------------
  36. SEGMENT SKRESO
  37. INTEGER KFC,NRES,KES,KIMP
  38. ENDSEGMENT
  39. C KFC : NOMBRE DE FACES H.C
  40. C NRES: RESOLUTION
  41. C KES : DIM ESPACE
  42. C KIMP: IMPRESSION
  43. C-----------------------------------------------------------------------
  44. SEGMENT SKFAC2
  45. INTEGER NUK(MS,MFACE),KPATCH(MFACE)
  46. INTEGER NCELL(MFACE)
  47. REAL*8 U(3,MFACE),S(MFACE)
  48. REAL*8 FF1(MFACE)
  49. ENDSEGMENT
  50. SEGMENT IPATCH
  51. REAL*8 GP(MSP,NPATCH),SP(NPATCH)
  52. ENDSEGMENT
  53. C
  54. C DESCRIPTION DES ELEMENTS
  55. C ------------------------
  56. C MFACE : NOMBRE DE FACES
  57. C NUK : CONNECTIVITES
  58. C U : NORMALE UNITAIRE ET EQUATION DU PLAN DE L'ELEMENT
  59. C S : SURFACE
  60. C KVU : VISIBILITE A PRIORI
  61. C FF : FACTEURS DE FORME
  62. C FF1 : TRAVAIL
  63. C NCELL : NOMBRE TOTAL DE CELLULES VUES PAR UN POINT
  64. C KPATCH: POINTEUR SUR IPATCH
  65. C NPATCH: NOMBRE DE POINTS SUR L'ELEMENT (REDECOUPAGE)
  66. C GP : COORDONNEES DES POINTS
  67. C SP : ET SURFACES
  68. C-----------------------------------------------------------------------
  69. SEGMENT SHC2D
  70. INTEGER IR(NR),KA(NFC),IM(NFC,NFC)
  71. INTEGER KRO(NFC,NES),KSI(NFC,NES)
  72. REAL*8 V(NES,NR),G(NR)
  73. ENDSEGMENT
  74.  
  75. C DESCRIPTION DU H.C DE PROJECTION
  76. C --------------------------------
  77. C V : DIRECTION UNITAIRE DES CELLULES
  78. C G : FACTEUR DE FORME ASSOCIE
  79. C IR: CORRESPONDANCE
  80. C KRO , KSI : POUR LE CHANGEMENT DE REPERE
  81. C IM : REFERENCE
  82. C NR : RESOLUTION
  83. C NFC : NOMBRE DE FACES
  84. C-----------------------------------------------------------------------
  85. SEGMENT SDECOU
  86. INTEGER KDECOU(MFACE)
  87. ENDSEGMENT
  88. C--------------------------------------------------------------------
  89. C
  90. SEGMENT STRAV
  91. REAL*8 A1(2,2),A2(2,2),U1(3),U2(3)
  92. ENDSEGMENT
  93. C--------------------------------------------------------------------
  94. C
  95. DMIN=1.E-5
  96. DMAX=1./DMIN
  97. NPM=20
  98. C pour les elements lineaires (sinon pas=2)
  99. NSPA=1
  100. C on se ramene toujours a des SEG2
  101. NS=2
  102.  
  103. SEGINI STRAV
  104. C
  105. C>>> CREATION DE L'OBJET FACE
  106. C
  107. IF (INFOEL.EQ.0) THEN
  108. ICOQ = .FALSE.
  109. ELSE
  110. ICOQ = .TRUE.
  111. SEGACT INFOEL
  112. ENDIF
  113.  
  114. SEGACT MYMOD
  115. NTYP = MYMOD.KMODEL(/1)
  116. NFACE = 0
  117. NELD = 0
  118. DO 10 ITYP=1,NTYP
  119. IMODE1 = MYMOD.KMODEL(ITYP)
  120. SEGACT IMODE1
  121. IPT1 = IMODE1.IMAMOD
  122. SEGDES IMODE1
  123. SEGACT IPT1
  124. NEL = IPT1.NUM(/2)
  125. NSGEO = IPT1.NUM(/1)
  126. SEGDES IPT1
  127. C
  128. C un élément COQ -> 2 facteurs de formes
  129. IF (ICOQ.AND.KCOQ(ITYP)) NEL=2*NEL
  130. C
  131. NELD = NELD + NEL
  132. IF (NS.NE.2) WRITE(6,*) ' ON ATTEND DES SEG2 '
  133. NFACE = NFACE + NEL
  134. 10 CONTINUE
  135.  
  136. IF (IIMPI.GE.1) THEN
  137. *///////
  138. WRITE( 6,*) ' NOMBRE TOTAL D ELEMENTS',NELD,', DE FACES ',NFACE
  139. C NBSEG = 1+3*NTYP+(1+2*NTYP)*NELD
  140. C WRITE (6,*) 'Le CHAMELEM facteur de forme tient sur',
  141. C # NBSEG,' segments .'
  142. *///////
  143. ENDIF
  144. C
  145. MFACE = NFACE
  146. MS = NS
  147. SEGINI SKFAC2
  148. SEGINI SDECOU
  149. C
  150. C UN SEUL TYPE D'ELEMENTS : SEG2
  151. C
  152. C Remplissage de NUK(*,*) et de U(*,4)
  153. NELT= 0
  154. DO 100 ITYP = 1,NTYP
  155.  
  156.  
  157. IMODE1 = MYMOD.KMODEL(ITYP)
  158. SEGACT IMODE1
  159. IPT1 = IMODE1.IMAMOD
  160. SEGDES IMODE1
  161. SEGACT IPT1
  162. NSGEO = IPT1.NUM(/1)
  163. NSPA=1
  164. IF (ICOQ.AND.KQUAD(ITYP)) NSPA = 2
  165. NEL = IPT1.NUM(/2)
  166. DO 110 I = 1,NEL
  167. IF (ICOQ.AND.KCOQ(ITYP)) THEN
  168. WRITE (6,*) 'IL y a des COQ2'
  169. KEL = (2*I-1) + NELT
  170. ELSE
  171. KEL = I + NELT
  172. ENDIF
  173.  
  174. DO 111 IS = 1, NSGEO, NSPA
  175. LS=IS
  176. IF (ICOQ.AND.KQUAD(ITYP)) LS=(IS+1)/2
  177.  
  178. C** NUK(IS,KEL) = IPT1.NUM(IS,I)
  179. NUK(LS,KEL) = IPT1.NUM(IS,I)
  180. IF (IIMPI.GE.4) WRITE(6,*)
  181. # 'NUK(',LS,',',KEL,')=',NUK(LS,KEL)
  182. IREF = (IDIM+1)*(NUK(LS,KEL)-1)
  183. DO 112 K = 1,IDIM
  184. C** A1(K,IS) = XCOOR(IREF+K)
  185. A1(K,LS) = XCOOR(IREF+K)
  186. 112 CONTINUE
  187. 111 CONTINUE
  188. CALL KNORM2(IDIM,A1,NS,U1,S(KEL))
  189. *////////////
  190. * WRITE (6,*) 'Normale :',(U1(K),K=1,IDIM)
  191. *////////////
  192. DO 113 L = 1,IDIM+1
  193. U(L,KEL) = U1(L)
  194. 113 CONTINUE
  195. C
  196. IF (ICOQ.AND.KCOQ(ITYP)) THEN
  197. C On remplit NUK , U et S pour l'élément inverse
  198. NUK(1,KEL+1) = NUK(2,KEL)
  199. NUK(2,KEL+1) = NUK(1,KEL)
  200. S(KEL+1) = S(KEL)
  201. DO 114 L = 1,IDIM+1
  202. U(L,KEL+1) = -U(L,KEL)
  203. 114 CONTINUE
  204. ENDIF
  205.  
  206. 110 CONTINUE
  207. IF (ICOQ.AND.KCOQ(ITYP)) THEN
  208. NELT=NELT+NEL*2
  209. ELSE
  210. NELT=NELT+NEL
  211. ENDIF
  212. C
  213. SEGDES IPT1
  214. 100 CONTINUE
  215. C
  216. SEGDES MYMOD
  217. IF (ICOQ) SEGDES INFOEL
  218. C
  219. SEGACT SDECOU*MOD
  220.  
  221. DO 200 K1= 1,NFACE
  222. DO 213 LS= 1, NS
  223. IREF = (IDIM+1)*(NUK(LS,K1)-1)
  224. DO 212 K = 1,IDIM
  225. C** A1(K,IS) = XCOOR(IREF+K)
  226. A1(K,LS) = XCOOR(IREF+K)
  227. 212 CONTINUE
  228. 213 CONTINUE
  229. DO 214 K=1,IDIM+1
  230. U1(K) = U(K,K1)
  231. 214 CONTINUE
  232.  
  233. IF (XDEC.GE.0.01) THEN
  234. DK1 = DMAX
  235. DO 400 K2 = 1,MFACE
  236. C WRITE(6,*) ' K2 ',K2
  237. C
  238. DO 413 LS= 1, NS
  239. IREF = (IDIM+1)*(NUK(LS,K2)-1)
  240. DO 412 K = 1,IDIM
  241. C** A2(K,IS) = XCOOR(IREF+K)
  242. A2(K,LS) = XCOOR(IREF+K)
  243. 412 CONTINUE
  244. 413 CONTINUE
  245. DO 414 K=1,IDIM+1
  246. U2(K) = U(K,K2)
  247. 414 CONTINUE
  248. C
  249. CALL KPRIOR(IDIM,NS,NS,A1,A2,U1,U2,KVU)
  250.  
  251. IF (KVU.NE.0) THEN
  252. C WRITE(6,*) ' KVU',KVU
  253. D1 = (A1(1,1)+A1(1,2)-A2(1,1)-A2(1,2))/2.
  254. D2 = (A1(2,2)+A1(2,2)-A2(2,1)-A2(2,2))/2.
  255. DKK1 = SQRT(D1*D1+D2*D2)
  256. IF ((DKK1/S(K1)).GT.DMIN) THEN
  257. C tri angulaire
  258. CK1 = ABS(U1(1)*D1+U1(2)*D2)/DKK1
  259. C WRITE(6,*) ' K2 KVU DKK1 CK1 ',K1,KVU,DKK1,CK1
  260. IF(CK1.GE.0.01) THEN
  261. DK1= DMIN1(DKK1,DK1)
  262. ENDIF
  263. ENDIF
  264. ENDIF
  265. 400 CONTINUE
  266. DR=DK1/XDEC
  267. C WRITE(6,*) ' DR ',DR
  268.  
  269. ELSE
  270. DR = DMAX
  271. ENDIF
  272.  
  273. NPAT=INT(S(K1)/DR)+1
  274. NPAT=MIN0(NPAT,NPM)
  275. NPATCH = NPAT
  276. MSP = MS
  277. SEGINI IPATCH
  278. CALL KCREP2(A1,S(K1),IDIM,NPATCH,GP,SP)
  279. KDECOU(K1)= NPAT
  280. KPATCH(K1) = IPATCH
  281. SEGDES IPATCH
  282. 200 CONTINUE
  283. C
  284. IF(IIMPI.GE.2) THEN
  285. WRITE(6,*)
  286. WRITE(6,*) 'NOMBRE DE SUBDIVISIONS PAR FACE'
  287. WRITE(6,1000) (KDECOU(I),I=1,MFACE)
  288. 1000 FORMAT(1X,10(I4))
  289. ENDIF
  290. C
  291. C>>> CARACTERISTIQUES GLOBALES
  292. C
  293. NFC = 4
  294. NR = NRES
  295. NES = IDIM
  296. SEGINI SHC2D
  297. CALL KCACU2(IDIM,NRES,G,V,NFC,KRO,KSI,IR,KA,IM)
  298. C
  299. C** KFC = NFC
  300.  
  301. SEGDES SKFAC2,SHC2D
  302. SEGSUP SDECOU
  303. SEGSUP STRAV
  304. C
  305. RETURN
  306. END
  307.  
  308.  
  309.  
  310.  
  311.  
  312.  
  313.  
  314.  
  315.  
  316.  
  317.  
  318.  

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