Télécharger xpost1.eso

Retour à la liste

Numérotation des lignes :

  1. C XPOST1 SOURCE PV 20/03/25 21:15:26 10554
  2. c
  3. SUBROUTINE XPOST1(IPCHP1,IPMOD1,IPCHP2)
  4. c
  5. c Construit un Chpoint avec des ddl "physiques" (UX UY) en
  6. c RECOmbinant les ddl Xfem (UX AX B1X C1X ...)
  7. c -> Utile pour le tracé de déformées
  8. c
  9. C SYNTAXE :
  10. c chpo2 = XFEM 'RECO' chpo1 MODEL_XFEM
  11. C
  12. c
  13. IMPLICIT INTEGER(I-N)
  14. IMPLICIT REAL*8 (A-H,O-Z)
  15. C
  16. PARAMETER (XTOL1=1.d-7)
  17. PARAMETER (NBRMAX=5)
  18.  
  19. C
  20. C SEGMENTS INCLUDE
  21. -INC CCREEL
  22.  
  23. -INC PPARAM
  24. -INC CCOPTIO
  25. -INC SMCOORD
  26. -INC SMELEME
  27. -INC SMCHPOI
  28. -INC SMCHAML
  29. -INC SMMODEL
  30. -INC SMLREEL
  31. c
  32. POINTEUR MCHEX1.MCHELM,MPHI1.MPOVAL,MPSI1.MPOVAL
  33. C
  34.  
  35. c SEGMENT MRACC
  36. c INTEGER TLENR(NBENR1,NBPT)
  37. c ENDSEGMENT
  38. SEGMENT MRACC
  39. INTEGER TLENR(NBENR1,NBPT)
  40. INTEGER IPOCHA(NBPT,NCOMP1)
  41. ENDSEGMENT
  42. c SEGMENT MRACC
  43. c INTEGER NOD2PT(NBPT)
  44. c INTEGER TLENR(NBENR1,NBPT1)
  45. c INTEGER IPOCHA(NCOMP1,NBPT1)
  46. c ENDSEGMENT
  47. C
  48. C
  49. C_____________________________________________________________
  50. C INITIALISATION DES INCONNUES obligatoires et facultatives
  51. PARAMETER (NOBL=4,NFAC=27)
  52. CHARACTER*4 DDLOBL(NOBL),DDLFAC(NFAC),MODDL,MODDL2
  53. DATA DDLOBL/'UX ','UY ','UZ ','LX '/
  54. DATA DDLFAC/'AX ','AY ','AZ ',
  55. >'B1X ','B1Y ','B1Z ',
  56. >'C1X ','C1Y ','C1Z ',
  57. >'D1X ','D1Y ','D1Z ',
  58. >'E1X ','E1Y ','E1Z ',
  59. >'B2X ','B2Y ','B2Z ',
  60. >'C2X ','C2Y ','C2Z ',
  61. >'D2X ','D2Y ','D2Z ',
  62. >'E2X ','E2Y ','E2Z '/
  63. INTEGER TENR(NFAC),TNI(NFAC),TF2O(NFAC)
  64. c ddlfac correspond a quel enrichissement?
  65. DATA TENR/1,1,1,2,2,2,2,2,2,2,2,2,2,2,2,3,3,3,3,3,3,3,3,3,3,3,3/
  66. c ddlfac correspond a quel fonction d'enrichissement?
  67. DATA TNI/1,1,1,1,1,1,2,2,2,3,3,3,4,4,4,1,1,1,2,2,2,3,3,3,4,4,4/
  68. c ddlfac correspond a quel ddlobl?
  69. DATA TF2O/1,2,3,1,2,3,1,2,3,1,2,3,1,2,3,1,2,3,1,2,3,1,2,3,1,2,3/
  70. c tables pour mise en concordance des ddl
  71. INTEGER TOBL(NOBL),TFAC(NOBL,4,NBRMAX)
  72. INTEGER TIFAC(NOBL,4,NBRMAX)
  73. c fonctions de forme
  74. REAL*8 SHPWRK(4)
  75.  
  76. nbpt = nbpts
  77.  
  78. C_____________________________________________________________
  79. C ACTIVATION ...
  80.  
  81. C ...DU MODELE
  82. MMODEL=IPMOD1
  83. NSOUS = KMODEL(/1)
  84.  
  85. C ...DU CHPOINT avec ddl xfem
  86. MCHPOI=IPCHP1
  87. NSOUP0 = IPCHP(/1)
  88.  
  89. C_____________________________________________________________
  90. C TRAVAIL PRELIMINAIRE SUR L ENRICHISSEMENT'
  91. C on les transforme en 2 chpoints psi et phi
  92. c avec le type d enrichissement pour composante
  93.  
  94. NBENR1= NBRMAX
  95. NCOMP1=NFAC
  96. SEGINI,MRACC
  97. N=NBPT
  98. NC=NBRMAX
  99. segini,MPHI1,MPSI1
  100. NBPT = 0
  101. NBENR2= 0
  102.  
  103. c ----boucle sur les zones du modele
  104. DO 0001 ISOUS=1,NSOUS
  105. c write(6,*) 'zone du modele sISOUS=',ISOUS,'/',NSOUS
  106. IMODEL = KMODEL(ISOUS)
  107. NOBMOD=IVAMOD(/1)
  108. IF(NOBMOD.NE.0) THEN
  109.  
  110. c -------boucle sur les objet ivamod jusqu'a trouver un mchelm d'enrichissement
  111. DO 0002 iobmo1=1,NOBMOD
  112. if((TYMODE(iobmo1)).ne.'MCHAML ') goto 0002
  113. MCHEX1 = IVAMOD(iobmo1)
  114. if((MCHEX1.TITCHE).ne.'ENRICHIS') goto 0003
  115.  
  116. * on a trouvé une zone enrichie => on crée une table d'enrichissment nodal
  117. N1 = MCHEX1.ICHAML(/1)
  118. c ---------boucle sur les maillages elementaire du chaml d'enrichissement
  119. do 0010 i1=1,N1
  120. if((MCHEX1.INFCHE(i1,4)).ne.0) goto 0010
  121.  
  122. MELEME = MCHEX1.IMACHE(i1)
  123. MCHAM1 = MCHEX1.ICHAML(i1)
  124. NBNN = NUM(/1)
  125. NBELEM = NUM(/2)
  126. N2=MCHAM1.IELVAL(/1)
  127. ITYP1 = ITYPEL
  128. c-------- On exclu les sous zone de relation
  129. if (ITYP1.EQ.48) goto 0010
  130. c ------------boucle sur les enrichissements possibles
  131. do i2=1,N2
  132. MELVAL=MCHAM1.IELVAL(i2)
  133. do j=1,NBELEM
  134. do i=1,NBNN
  135. inoeu = NUM(i,j)
  136. NBPT = max(NBPT,inoeu)
  137. MLREEL = IELCHE(i,j)
  138. c write(6,*) 'i,j,inoeu,mlreel',i,j,inoeu,MLREEL,NBPT
  139. if (MLREEL.ne.0) then
  140. TLENR(i2,inoeu) = MLREEL
  141. NBENR2 = max(NBENR2,i2)
  142. if (i2.eq.1) then
  143. MPHI1.VPOCHA(inoeu,i2) = PROG(i)
  144. else
  145. MPSI1.VPOCHA(inoeu,i2) = PROG(i)
  146. MPHI1.VPOCHA(inoeu,i2) = PROG(NBNN+i)
  147. endif
  148. c avec MPSI1 et MPHI1, on peut fermer MLREEL
  149. endif
  150. enddo
  151. enddo
  152. enddo
  153. c ------------fin de boucle sur les enrichissements possibles
  154. 0010 continue
  155. c ---------fin de boucle sur les maillages elementaire du chaml d'enrichissement
  156.  
  157. 0003 CONTINUE
  158. 0002 CONTINUE
  159. c -------fin de boucle sur les objet ivamod
  160.  
  161. ENDIF
  162. 0001 CONTINUE
  163. c ----fin de boucle sur les zones du modele
  164.  
  165. N=NBPT
  166. * NC=NBENR1
  167. NC=NBENR2
  168. segadj,MPHI1,MPSI1
  169.  
  170. C_____________________________________________________________
  171. C INITIALISATION
  172. c
  173. c ...du mchpo2
  174. NAT=JATTRI(/1)
  175. NSOUPO=NSOUP0
  176. SEGINI,MCHPO2=MCHPOI
  177. C NPOCHA=0
  178.  
  179.  
  180. C_____________________________________________________________
  181. C>>>>>>>>>>>>>>>>>>>>>>> BOUCLE SUR LES ZONES DU CHPOINT
  182. DO 1000 ISOUP=1,NSOUP0
  183. c write(*,*) 'xpost1: ZONE ',ISOUP,' / ',NSOUP0
  184.  
  185. C_____________________________________
  186. C ACTIVATION DU SOUS CHPOINT
  187. MSOUPO = IPCHP(ISOUP)
  188. MELEME = IGEOC
  189. MPOVAL = IPOVAL
  190.  
  191. c nbre de composante, de points
  192. NCOMP = NOCOMP(/2)
  193. NBPT0 = NUM(/2)
  194. NC = NCOMP
  195.  
  196. C INITIALISATION du MSOUP2 (avec NC =celui de départ)
  197. SEGINI,MSOUP2=MSOUPO
  198. MCHPO2.IPCHP(ISOUP)=MSOUP2
  199.  
  200. c quelles sont les composantes obligatoires (=physiques) et ou sont elles?
  201. c on en deduit NC
  202. NC=0
  203. DO 1001 IOBL=1,NOBL
  204. MODDL2 = DDLOBL(IOBL)
  205. DO ICOMP=1,NCOMP
  206. MODDL = NOCOMP(ICOMP)
  207. * on a trouvé cette comp obl dans le chpoint d entree
  208. IF(MODDL.eq.MODDL2) THEN
  209. NC=NC+1
  210. MSOUP2.NOCOMP(NC) = MODDL2
  211. MSOUP2.NOCONS(NC) = NOCONS(ICOMP)
  212. TOBL(NC) = ICOMP
  213. GOTO 1001
  214. ENDIF
  215. ENDDO
  216. 1001 CONTINUE
  217. IF(NC.lt.NOBL) THEN
  218. DO IOBL=(NC+1),NOBL
  219. TOBL(IOBL) = 0
  220. ENDDO
  221. ENDIF
  222.  
  223. c ...et les facultatives(enrichissement)?
  224. do i1=1,NOBL
  225. do i2=1,4
  226. do i3=1,NBRMAX
  227. TFAC(i1,i2,i3) = 0
  228. enddo
  229. enddo
  230. enddo
  231. NF=0
  232. IFAC = 0
  233. DO 1002 IFAC=1,NFAC
  234. MODDL2 = DDLFAC(IFAC)
  235. DO ICOMP=1,NCOMP
  236. MODDL = NOCOMP(ICOMP)
  237. * on a trouvé une comp fac qui va etre ajouté a la comp obl dans le chpoint de sortie
  238. IF(MODDL.eq.MODDL2) THEN
  239. NF=NF+1
  240. IOBL=TF2O(IFAC)
  241. INI =TNI (IFAC)
  242. IENR=TENR(IFAC)
  243. TFAC(IOBL,INI,IENR) = ICOMP
  244. TIFAC(IOBL,INI,IENR) = IFAC
  245. GOTO 1002
  246. ENDIF
  247. ENDDO
  248. * on n a pas trouvé la composante facultative
  249. IOBL=TF2O(IFAC)
  250. INI =TNI (IFAC)
  251. IENR=TENR(IFAC)
  252. TIFAC(IOBL,INI,IENR) = IFAC
  253. 1002 CONTINUE
  254.  
  255.  
  256. C INITIALISATION du MSOUP2 (avec NC ajusté) et du MPOVA2
  257. segadj,MSOUP2
  258. N = VPOCHA(/1)
  259. SEGINI,MPOVA2
  260. MSOUP2.IPOVAL = MPOVA2
  261.  
  262. c actifs a ce stade : MCHPO2,MCHPOI,MELEME,MPOVAL,MPOVA2
  263.  
  264. C_____________________________________
  265. C>>>>>>>>>>>>> BOUCLE SUR LES POINTS
  266. DO 2000 J=1,NBPT0
  267. c write(*,*) 'point ',J,' / ',NBPT0,NC
  268.  
  269. C______________________
  270. C On commence par recopier les valeurs obligatoires (UX,UY)
  271. DO IC2=1,NC
  272. ICOMP = TOBL(IC2)
  273. MPOVA2.VPOCHA(J,IC2) = VPOCHA(J,ICOMP)
  274. ENDDO
  275.  
  276. C______________________
  277. C ce noeud est il IENR2-enrichi?
  278. inoeu = NUM(1,J)
  279.  
  280. DO 3000 IENR2=1,NBENR2
  281.  
  282. MLREEL = TLENR(IENR2,inoeu)
  283.  
  284. C si ce noeud n est pas enrichi on ne fait rien
  285. IF(MLREEL.eq.0) GOTO 3000
  286.  
  287. C si ce noeud est enrichi,
  288. c on recupere les infos relatives a l enrichissement
  289.  
  290. c on calcule les fonctions d enrichissement
  291.  
  292. c------------pour IENR=1, fonction H, ddl AX et AY
  293. IF (IENR2.eq.1) THEN
  294. PHIX = MPHI1.VPOCHA(inoeu,IENR2)
  295. NBNI = 1
  296. SHPWRK(1) = SIGN(1.D0,PHIX)
  297. if (abs(phix).lt.xtol1) then
  298. SHPWRK(1) = 0.d0
  299. else
  300. SHPWRK(1) = SIGN(1.D0,PHIX)
  301. endif
  302. ENDIF
  303. c------------fin du cas IENR=1, fonction H
  304.  
  305. c------------pour IENR>1, 4 fonctions F
  306. IF (IENR2.ge.2) THEN
  307. PHIX = MPHI1.VPOCHA(inoeu,IENR2)
  308. PSIX = MPSI1.VPOCHA(inoeu,IENR2)
  309. if (ABS(phix).lt.xtol1) then
  310. HX = 0.d0
  311. else
  312. HX = SIGN(1.D0,PHIX)
  313. endif
  314. RX = ( (PSIX**2.) + (PHIX**2.) )**0.5
  315. IF (RX.LT.XTOL1) THEN
  316. THETAX = 0.d0
  317. ELSE
  318. THETAX = HX * ((XPI/2.) - (ATAN2(PSIX,ABS(PHIX))))
  319. ENDIF
  320. SIN1T = SIN(THETAX)
  321. C COS1T = COS(THETAX)
  322. SIN05T = SIN(THETAX/2.)
  323. COS05T = COS(THETAX/2.)
  324. NBNI = 4
  325. SHPWRK(1) = (RX**0.5) * SIN05T
  326. SHPWRK(2) = (RX**0.5) * COS05T
  327. SHPWRK(3) = (RX**0.5) * SIN05T * SIN1T
  328. SHPWRK(4) = (RX**0.5) * COS05T * SIN1T
  329. ENDIF
  330. c------------fin du cas IENR>1, fonction F
  331.  
  332. c on ajoute les fonctions d enrichissement
  333. DO 3900 IC2=1,NC
  334. DO 3900 INI=1,NBNI
  335. ICOMP = TFAC(IC2,INI,IENR2)
  336. IFAC = TIFAC(IC2,INI,IENR2)
  337. c 1ere fois qu on voit le besoin de (composante + noeud)
  338. if(IPOCHA(inoeu,IFAC).eq.0) IPOCHA(inoeu,IFAC)=1
  339. c cas ou on a pas trouvé cette composante dans cette zone du
  340. c chpoint solution => on saute simplement
  341. if(ICOMP.eq.0) goto 3900
  342. MPOVA2.VPOCHA(J,IC2) = MPOVA2.VPOCHA(J,IC2)
  343. $ + ( SHPWRK(INI) * VPOCHA(J,ICOMP) )
  344. IPOCHA(inoeu,IFAC) = IPOCHA(inoeu,IFAC)+1
  345. 3900 CONTINUE
  346.  
  347. 3000 CONTINUE
  348. C<<<<<<<<< FIN DE BOUCLE SUR LES enrichissements
  349.  
  350.  
  351.  
  352. 2000 CONTINUE
  353. C<<<<<<<<<<<<<<< FIN DE BOUCLE SUR LES POINTS
  354.  
  355.  
  356. 1000 CONTINUE
  357. C<<<<<<<<<<<<<<<<<<<<<<<<< FIN DE BOUCLE SUR LES ZONES
  358.  
  359. segsup,MPHI1,MPSI1
  360.  
  361.  
  362. C_____________________________________________________________
  363. C PETIT AVERTISSEMENT S'IL MANQUE DES ENRICHISSEMENTS
  364. C
  365. C --initialisation du nombre d erreur sur le noms de composantes
  366. NBERR1=0
  367.  
  368. c --recherche des erreurs
  369. DO inoeu=1,NBPT
  370. DO icomp1=1,NCOMP1
  371. c -cas ou on a pas besoin de cette composante en ce noeud :
  372. c (IPOCHA(inoeu,icomp1).EQ.0)
  373. c -Cas ou on a trouvé un noeud enrichi sans la composante associée
  374. c dans le chpoint => avertissement :
  375. IF (IPOCHA(inoeu,icomp1).EQ.1) THEN
  376. NBERR1=NBERR1+1
  377. if (IIMPI.ge.1) then
  378. write(IOIMP,991) DDLFAC(icomp1),inoeu
  379. 991 format(2X,'ABSENCE DE LA COMPOSANTE ',A4,' AU NOEUD ',I6,
  380. $ ' DANS LE CHPOINT FOURNI a XFEM RECO')
  381. endif
  382. ENDIF
  383. ENDDO
  384. ENDDO
  385. c --cas ou on a une ou des erreurs--
  386. IF (NBERR1.gt.0) THEN
  387. write(IOIMP,*) 'OPERATEUR XFEM RECO : ABSENCE DANS LE CHPOINT ',
  388. & 'DEPLACEMENT DE CERTAINES INCONNUES ATTENDUES PAR LE MODELE'
  389. ENDIF
  390.  
  391. segsup,MRACC
  392.  
  393.  
  394. C_____________________________________________________________
  395. C ON RETOURNE LE CHPOINT
  396.  
  397. IPCHP2=MCHPO2
  398.  
  399. END
  400.  
  401.  
  402.  
  403.  
  404.  
  405.  

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