Télécharger rot3r.eso

Retour à la liste

Numérotation des lignes :

  1. C ROT3R SOURCE BP208322 15/06/22 21:22:35 8543
  2. SUBROUTINE ROT3R(NEF,IMAIL,IPMODE,IPCHEM,IPRIGI)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. ************************************************************************
  6. *
  7. * R O T 3 R
  8. * ---------
  9. *
  10. * FONCTION:
  11. * ---------
  12. * CALCUL DE LA MATRICE DE RESISTANCE POUR L'ELEMENT ROT3
  13. *
  14. * MODULES UTILISES:
  15. * -----------------
  16. *
  17. -INC CCOPTIO
  18. -INC CCREEL
  19. *-
  20. -INC SMCOORD
  21. -INC SMINTE
  22. -INC CCHAMP
  23. -INC SMMODEL
  24. -INC SMRIGID
  25. -INC SMELEME
  26. -INC SMCHAML
  27. *
  28. * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN)
  29. * -----------
  30. *
  31. * NEF (E) NUMERO DE L'ELEMENT-FINI DANS NOMTP (VOIR CCHAMP)
  32. * IMAIL (E) NUMERO DU MAILLAGE ELEMENTAIRE CONSIDERE,DANS
  33. * L'OBJET MODELE
  34. * IPMODE (E) POINTEUR SUR UN SEGMENT IMODEL
  35. * IPCHEM (E) POINTEUR SUR LE CHAMELEM DE CARACTERISTIQUE
  36. * +XCOOR (E) VOIR SMCOORD
  37. * +IDIM (E) VOIR CCOPTIO
  38. * +IFOMOD (E) VOIR CCOPTIO
  39. * +XZERO (E) VOIR CCREEL
  40. * IPRIGI (E/S) POINTEUR SUR L'OBJET RESULTAT,DE TYPE RIGIDITE
  41. *
  42. * VARIABLES:
  43. * ----------
  44. *
  45. * NBNN NOMBRE DE NOEUDS DANS L'ELEMENT CONSIDERE
  46. * NEF NUMERO DE L'ELEMENT FINI DANS NOMTP (VOIR CCHAMP)
  47. * NBELEM NOMBRE D'ELEMENTS DANS LE MAILLAGE ELEMENTAIRE
  48. * NBPGAU NOMBRE DE POINTS DE GAUSS DANS L'ELEMENT-FINI
  49. * NDIM NOMBRE DE LIGNES DE LA MATRICE GRADIENT
  50. * CEL(2*NBNN,2*NBNN) MATRICE DE CONDUCTIVITE ELEMENTAIRE
  51. * XE(3,NBNN) COORDONNEES DE L'ELEMENT DANS LE REPERE GLOBAL
  52. * SHP(6,NBNN) TABLEAU DE TRAVAIL
  53. * GRAD(NDIM,NBNN) MATRICE GRADIENT DES FONCTIONS DE FORME BIDIM.
  54. * VALMAT(NMATR) TABLEAU DE TRAVAIL
  55. *
  56. SEGMENT,MMAT1
  57. REAL*8 VALMAT(NMATR)
  58. REAL*8 XE(3,NBNN),CEL1(NBNN,NBNN),XE1(3,NBNN)
  59. REAL*8 SHP(6,NBNN),GRAD(NDIM,NBNN)
  60. ENDSEGMENT
  61. *
  62. SEGMENT NOTYPE
  63. CHARACTER*16 TYPE(NBTYPE)
  64. ENDSEGMENT
  65. *
  66. SEGMENT MPTVAL
  67. INTEGER IPOS(NS) ,NSOF(NS)
  68. INTEGER IVAL(NCOSOU)
  69. CHARACTER*16 TYVAL(NCOSOU)
  70. ENDSEGMENT
  71. *
  72. SEGMENT INFO
  73. INTEGER INFELL(JG)
  74. ENDSEGMENT
  75. *
  76. REAL*8 COSD1(3),COSD2(3),COSD3(3),YK(2,2)
  77. CHARACTER*8 CNM
  78. CHARACTER*(NCONCH) CONM
  79. PARAMETER (NINF=3)
  80. INTEGER INFOS(NINF)
  81. *
  82. *
  83. *
  84. * AUTEUR, DATE DE CREATION:
  85. * -------------------------
  86. *
  87. * YANN STEPHAN , JANVIER 1997 (COPIE DE TCOQ3C)
  88. *
  89. * LANGAGE:
  90. * --------
  91. *
  92. * ESOPE + FORTRAN77
  93. *
  94. ************************************************************************
  95. *
  96. * RECUPERATION DES CARACTERISTIQUES GEOMETRIQUES DU MAILLAGE
  97. * ELEMENTAIRE
  98. *
  99. IMODEL=IPMODE
  100. CONM =CONMOD
  101. IPMAIL=IMAMOD
  102. MELEME=IMAMOD
  103. SEGACT,MELEME
  104. NBNN=NUM(/1)
  105. NBELEM=NUM(/2)
  106. MRIGID=IPRIGI
  107. SEGACT,MRIGID
  108. *
  109. * RECUPERATION DES CARACTERISTIQUES D'INTEGRATION DE L'ELEMENT
  110. * FINI LIE A NOTRE MAILLAGE
  111. *
  112. if(infmod(/1).lt.4) then
  113. CALL ELQUOI(NEF,0,2,IPINF,IMODEL)
  114. IF(IERR.NE.0) THEN
  115. SEGDES IMODEL,MELEME
  116. SEGSUP MRIGID
  117. RETURN
  118. ENDIF
  119. INFO=IPINF
  120. IPINTE=INFELL(11)
  121. else
  122. ipinte=infmod(4)
  123. endif
  124. *
  125. * INFORMATION SUR L'ELEMENT
  126. *
  127. MINTE=IPINTE
  128. SEGACT,MINTE
  129. NBPGAU=POIGAU(/1)
  130. *
  131. xMATRI=IRIGEL(4,IMAIL)
  132. SEGACT,xMATRI*MOD
  133. NLIGRP=NBNN
  134. NLIGRD=NBNN
  135. *
  136. * RECHERCHE LES POINTEURS DES SEGMENTS MELVAL QUI CORRESPONDENT
  137. * AUX COMPOSANTES DE LA CONDUCTIVITE ET L'EPAISSEUR DES ELEMENT
  138. *
  139. NFOR=FORMOD(/2)
  140. NMAT=MATMOD(/2)
  141. CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CNM,INM,INT)
  142. IF (IERR.NE.0) THEN
  143. SEGDES,MELEME
  144. SEGDES,MINTE
  145. SEGSUP,MRIGID,xMATRI
  146. RETURN
  147. ENDIF
  148. *
  149. * REMLIR LE TABLEAU INFOS (INFORMATIONS SUR ELEMENT)
  150. INFOS(1)=0
  151. INFOS(2)=0
  152. INFOS(3)=NIFOUR
  153. *
  154. NBROBL=0
  155. NBRFAC=0
  156. IF(CNM.EQ.'ISOTROPE')THEN
  157. NBROBL=2
  158. SEGINI NOMID
  159. MOMATR=NOMID
  160. LESOBL(1)='ETA '
  161. LESOBL(2)='EPAI'
  162. NMATR=2
  163. NMATF=0
  164. ELSE IF(CNM.EQ.'ORTHOTRO') THEN
  165. NBROBL=5
  166. SEGINI NOMID
  167. MOMATR=NOMID
  168. LESOBL(1)='ETA1'
  169. LESOBL(2)='ETA2'
  170. LESOBL(3)='EPAI'
  171. LESOBL(4)='V1X '
  172. LESOBL(5)='V1Y '
  173. NMATR=5
  174. NMATF=0
  175. ELSE
  176. CALL ERREUR(251)
  177. SEGSUP,xMATRI,MRIGID
  178. SEGDES, MELEME
  179. SEGDES, MINTE
  180. RETURN
  181. ENDIF
  182. SEGDES NOMID
  183. *
  184. NBTYPE=1
  185. SEGINI NOTYPE
  186. MOTYPE=NOTYPE
  187. TYPE(1)='REAL*8'
  188. *
  189. CALL KOMCHA(IPCHEM,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAMAT)
  190. SEGSUP NOTYPE
  191. IF(IERR.NE.0)THEN
  192. SEGSUP,xMATRI,MRIGID
  193. SEGDES,MELEME
  194. SEGDES,MINTE
  195. RETURN
  196. ENDIF
  197. *
  198. MPTVAL=IVAMAT
  199. IF(CNM.EQ.'ISOTROPE')THEN
  200. IPMELV=IVAL(2)
  201. ELSE IF(CNM.EQ.'ORTHOTRO') THEN
  202. IPMELV=IVAL(3)
  203. ENDIF
  204. CALL QUELCH(IPMELV,ICONS)
  205. IF(ICONS.NE.0)THEN
  206. CALL ERREUR(566)
  207. SEGSUP,MRIGID,xMATRI
  208. SEGDES,MELEME
  209. SEGDES,MINTE
  210. CALL DTMVAL(IVAMAT,1)
  211. RETURN
  212. ENDIF
  213. *
  214. *
  215. NDIM=IDIM-1
  216. SEGINI,MMAT1
  217. *
  218. * BOUCLE SUR LES ELEMENTS DU MAILLAGE ELEMENTAIRE IMAIL
  219. *
  220. DO 10 IEL=1,NBELEM
  221. *
  222. * MISE A ZERO DES TABLEAUX CEL1 ET XE1
  223. *
  224. CALL ZERO(CEL1,NBNN,NBNN)
  225. CALL ZERO (XE1,3,NBNN)
  226. *
  227. * ON CHERCHE LES COORDONNEES DES NOEUDS DE L'ELEMENT IEL,
  228. * DANS LE REPERE GLOBAL
  229. *
  230. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IEL,XE)
  231. *
  232. * CALCUL DES COORDONNEES DES NOEUDS DANS LE REPERE LOCAL DE L'
  233. * ELEMENT COQUE
  234. *
  235. DO 60 I=1,3
  236. COSD1(I)=XE(I,2)-XE(I,1)
  237. COSD2(I)=XE(I,3)-XE(I,1)
  238. 60 CONTINUE
  239. *
  240. COSD3(1)=COSD1(2)*COSD2(3)-COSD1(3)*COSD2(2)
  241. COSD3(2)=COSD1(3)*COSD2(1)-COSD1(1)*COSD2(3)
  242. COSD3(3)=COSD1(1)*COSD2(2)-COSD1(2)*COSD2(1)
  243. *
  244. COSD1L=SQRT(COSD1(1)*COSD1(1)+COSD1(2)*COSD1(2)+
  245. . COSD1(3)*COSD1(3))
  246. COSD3L=SQRT(COSD3(1)*COSD3(1)+COSD3(2)*COSD3(2)+
  247. . COSD3(3)*COSD3(3))
  248. *
  249. DO 70 I=1,3
  250. COSD1(I)=COSD1(I)/COSD1L
  251. COSD3(I)=COSD3(I)/COSD3L
  252. 70 CONTINUE
  253. *
  254. COSD2(1)=COSD3(2)*COSD1(3)-COSD3(3)*COSD1(2)
  255. COSD2(2)=COSD3(3)*COSD1(1)-COSD3(1)*COSD1(3)
  256. COSD2(3)=COSD3(1)*COSD1(2)-COSD3(2)*COSD1(1)
  257. *
  258. DO 80 NOE=1,NBNN
  259. DO 80 I=1,3
  260. XE1(1,NOE)=XE1(1,NOE)+XE(I,NOE)*COSD1(I)
  261. XE1(2,NOE)=XE1(2,NOE)+XE(I,NOE)*COSD2(I)
  262. 80 CONTINUE
  263. *
  264. *
  265. * BOUCLE SUR LES POINTS DE GAUSS
  266. *
  267. IFOIS=0
  268. IFOI2=0
  269. DO 20 IGAU=1,NBPGAU
  270. *
  271. * CALCUL DE LA MATRCIE GRADIENT DES FONCTIONS DE FORME ET
  272. * DU JACOBIEN(DANS LE PLAN), EN UN POINT DE GAUSS
  273. *
  274. NFIN=NDIM+1
  275. DO 90 NP=1,NBNN
  276. DO 90 I=1,NFIN
  277. SHP(I,NP)=SHPTOT(I,NP,IGAU)
  278. 90 CONTINUE
  279. *
  280. * DERIVES DES FONCTIONS DE FORME DANS LA GEOMETRIE REELLE
  281. * ET LE JACOBIEN
  282. CALL JACOBI(XE1,SHP,NDIM,NBNN,DJAC)
  283. *
  284. DO 100 NP=1,NBNN
  285. DO 100 I= 1,NDIM
  286. GRAD(I,NP)=SHP(I+1,NP)
  287. 100 CONTINUE
  288. IF(DJAC.LT.XZERO)IFOIS=IFOIS+1
  289. IF(ABS(DJAC).LT.XPETIT)IFOI2=IFOI2 +1
  290. *
  291. * ON MULTIPLIE LE JACOBIEN PAR LE POIDS D'INTEGRATION,POUR LE
  292. * POINT DE GAUSS CONSIDERE
  293. *
  294. DJAC=ABS(DJAC)*POIGAU(IGAU)
  295. *
  296. * ON CHERCHE LES VALEURS DE COMPOSANTES DE LA RESISTIVITE
  297. * ET L'EPAISSEUR DE LA COQUE
  298. *
  299. MPTVAL=IVAMAT
  300. DO 30 IM=1,NMATR
  301. IF(IVAL(IM).NE.0)THEN
  302. MELVAL=IVAL(IM)
  303. IBMN=MIN(IEL,VELCHE(/2))
  304. IGMN=MIN(IGAU,VELCHE(/1))
  305. VALMAT(IM)=VELCHE(IGMN,IBMN)
  306. ELSE
  307. VALMAT(IM)=0
  308. ENDIF
  309. 30 CONTINUE
  310. *
  311. * MATERIAU ISOTROPE
  312. *
  313. IF(CNM.NE.'ORTHOTRO')THEN
  314. *
  315. EP=VALMAT(2)
  316. IF(EP.LE.XPETIT)THEN
  317. * L'ELEMENT (IEL) AU POINT DE GAUSS (IGAU)DE TYPE (NOMTP(NEF)) A
  318. * UNE EPAISSEUR NULLE
  319. INTERR(1)=IEL
  320. INTERR(2)=IGAU
  321. MOTERR(1:4)=NOMTP(NEF)
  322. CALL ERREUR(355)
  323. SEGSUP,MRIGID,xMATRI
  324. GO TO 999
  325. ENDIF
  326. XK=VALMAT(1)*DJAC/EP
  327. *
  328. * ON AJOUTE LE PRODUIT K*DJAC*TRANSPOSEE(GRAD)*GRAD
  329. * POUR LE POINT DE GAUSS CONSIDERE,A LA MATRICE CEL1
  330. *
  331. CALL NTNST (GRAD,XK,NBNN,NDIM,CEL1)
  332. *
  333. *
  334. ELSE
  335. *
  336. * CAS ORTHOTROPE
  337. *
  338. EP=VALMAT(3)
  339. IF(EP.LE.XPETIT)THEN
  340. * L'ELEMENT (IEL) AU POINT DE GAUSS (IGAU)DE TYPE (NOMTP(NEF)) A
  341. * UNE EPAISSEUR NULLE
  342. INTERR(1)=IEL
  343. INTERR(2)=IGAU
  344. MOTERR(1:4)=NOMTP(NEF)
  345. CALL ERREUR(355)
  346. SEGSUP,MRIGID,xMATRI
  347. GO TO 999
  348. ENDIF
  349. XK1=VALMAT(1)/EP
  350. XK2=VALMAT(2)/EP
  351. *
  352. COSA=VALMAT(4)
  353. SINA=-VALMAT(5)
  354. * CALCUL DE LA MATRICE DES COEFFICIENTS DE RESISTIVITE DANS LE
  355. * PLAN,PAR RAPPORT AU REPERE LOCAL DE L'ELEMENT
  356. *
  357. COS2=COSA*COSA
  358. SIN2=SINA*SINA
  359. SINCOS=SINA*COSA
  360. YK(1,1)=COS2*XK1+SIN2*XK2
  361. YK(1,2)=SINCOS*(XK1-XK2)
  362. YK(2,1)=YK(1,2)
  363. YK(2,2)=SIN2*XK1+COS2*XK2
  364.  
  365. *
  366. * ON AJOUTE LE PRODUIT DJAC*TRANSPOSEE(GRAD)*YK*GRAD
  367. * POUR LE POINT DE GAUSS CONSIDERE,A LA MATRICE CEL1
  368. *
  369. CALL BDBST (GRAD,DJAC,YK,NBNN,NDIM,CEL1)
  370. *
  371. ENDIF
  372. *
  373. 20 CONTINUE
  374. *
  375. *
  376. IF(IFOIS.NE.0.AND.IFOIS.NE.NBPGAU)THEN
  377. *
  378. * LE JACOBIEN EST NEGATIF ,MAILLAGE INCORRECT
  379. INTERR(1)=IEL
  380. CALL ERREUR(195)
  381. SEGSUP,xMATRI,MRIGID
  382. GO TO 999
  383. ELSEIF(IFOI2.EQ.NBPGAU)THEN
  384. *
  385. * CAS OU LE JACOBIEN EST TRES PETIT
  386. *
  387. INTERR(1)=IEL
  388. CALL ERREUR (259)
  389. SEGSUP,xMATRI,MRIGID
  390. GO TO 999
  391. ENDIF
  392. *
  393. * SEGINI,XMATRI
  394. * IMATTT(IEL)=XMATRI
  395. *
  396. * REMPLISSAGE DE XMATRI
  397. *
  398. CALL REMPMT(CEL1,NBNN,RE(1,1,iel))
  399. * SEGDES,XMATRI
  400. 10 CONTINUE
  401. * END DO
  402. *
  403. * DESACTIVATION DES SEGMENTS
  404. *
  405. SEGDES,xMATRI,MRIGID
  406. 999 CONTINUE
  407. SEGSUP,MMAT1
  408. 99 CONTINUE
  409. SEGDES,MELEME
  410. SEGDES,MINTE
  411. * SEGDES,INFO
  412. *
  413. MPTVAL=IVAMAT
  414. DO 50 I=1,NMATR
  415. MELVAL=IVAL(I)
  416. SEGDES,MELVAL
  417. 50 CONTINUE
  418. SEGSUP MPTVAL
  419. NOMID=MOMATR
  420. SEGSUP NOMID
  421. *
  422. RETURN
  423. END
  424.  
  425.  
  426.  
  427.  
  428.  

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