Télécharger calp1.eso

Retour à la liste

Numérotation des lignes :

  1. C CALP1 SOURCE PASCAL 18/11/09 21:15:04 9987
  2. SUBROUTINE CALP1(IPTR1,IPTR2,IPMODL,LOC,IPTR4)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C
  6. C APPELE PAR CALP
  7. C
  8. C AUTEUR : J.BRUN (AVRIL 90)
  9. C
  10. C PARTIE CALCUL EN PEAU DES CONTRAINTES
  11. C
  12. C-----------------------------------------------------------
  13. C PARAMETRES :
  14. C IPTR1 : POINTEUR SUR UN MCHAML DE TYPE CONTRAINTE
  15. C IPTR2 : POINTEUR SUR UN MCHAML DE TYPE CARACTERISTIQUE
  16. C IPMODL : POINTEUR SUR UN SEGMENT MMODEL
  17. C LOC : MOT CLE SUR 4 CARACTERES
  18. C SUPE PEAU SUP
  19. C MOYE PLAN MOYEN
  20. C INFE PEAU INF
  21. C IPTR4 : POINTEUR SUR UN MCHMAL DU MEME TYPE QUE CELUI D'IPTR1
  22. C (SORTIE)
  23. C
  24. -INC SMMODEL
  25. -INC SMCHAML
  26. -INC SMELEME
  27.  
  28. -INC PPARAM
  29. -INC CCOPTIO
  30. C -INC CCREEL
  31. -INC CCHAMP
  32. -INC CCGEOME
  33. -INC SMCOORD
  34. -INC SMINTE
  35. C
  36. SEGMENT MPTVAL
  37. INTEGER IPOS(NS) ,NSOF(NS)
  38. INTEGER IVAL(NCOSOU)
  39. CHARACTER*16 TYVAL(NCOSOU)
  40. ENDSEGMENT
  41. C
  42. SEGMENT NOTYPE
  43. CHARACTER*16 TYPE(NBTYPE)
  44. ENDSEGMENT
  45. C
  46. PARAMETER ( NINF=3 )
  47. INTEGER INFOS(NINF)
  48. CHARACTER*4 LOC
  49. CHARACTER*(NCONCH) CONM
  50. LOGICAL lsupco
  51.  
  52. IPTR4 = 0
  53. IF (LOC.EQ.'SUPE') THEN
  54. I_LOC = 1
  55. ELSE IF (LOC.EQ.'MOYE') THEN
  56. I_LOC = 2
  57. ELSE IF (LOC.EQ.'INFE') THEN
  58. I_LOC = 3
  59. ELSE
  60. CALL ERREUR(5)
  61. RETURN
  62. ENDIF
  63. C
  64. C VERIFICATION DU LIEU SUPPORT DU MCHAML DE CONTRAINTES
  65. C
  66. CALL QUESUP(IPMODL,IPTR1,5,0,ISUP1,IRET)
  67. IF (ISUP1.GT.1) RETURN
  68. C
  69. C VERIFICATION DU LIEU SUPPORT DU MCHAML DE CARACTERISTIQUES
  70. C
  71. CALL QUESUP(IPMODL,IPTR2,5,0,ISUP2,IRET1)
  72. IF (ISUP2.GT.1) RETURN
  73.  
  74. NHRM=NIFOUR
  75. C
  76. C ACTIVATION DU MODELE
  77. C
  78. MMODEL=IPMODL
  79. SEGACT MMODEL
  80. NSOUS=KMODEL(/1)
  81. N1=NSOUS
  82. C
  83. C ON NE TIENT PAS COMPTE D'UN EVENTUEL MODELE CHARGEMENT
  84. C
  85. DO III = 1,NSOUS
  86. IMODEL = KMODEL(III)
  87. SEGACT IMODEL
  88. IF (FORMOD(1).EQ.'CHARGEMENT') N1=N1-1
  89. SEGDES IMODEL
  90. END DO
  91. C
  92. C CREATION DU MCHELM
  93. C
  94. L1=11
  95. N3=6
  96. SEGINI MCHELM
  97. TITCHE='CONTRAINTES'
  98. IFOCHE=IFOUR
  99. IPTR4=MCHELM
  100. C----------------------------------------------------------
  101. C TRAITEMENT POUR CHAQUE SOUS ZONE DU MODELE ORIGINE
  102. C
  103. DO 1 NS=1,KMODEL(/1)
  104. C INITIALISATION
  105. IPMING=0
  106. IVASTR=0
  107. IVACAR=0
  108. NSTR=0
  109. NCARA=0
  110. NCARF=0
  111. MOSTRS=0
  112. MOCARA=0
  113. lsupco=.false.
  114.  
  115. IMODEL=KMODEL(NS)
  116. SEGACT IMODEL
  117. IF (FORMOD(1).EQ.'CHARGEMENT') GOTO 1
  118. MELE=NEFMOD
  119. C CALL ELQUOI(MELE,0,5,INFO,IMODEL)
  120. MFR=INFELE(13)
  121. NBPGAU=INFELE(4)
  122. C MINTE=INFELE(11)
  123. MINTE=infmod(7)
  124. NBNN= NBNNE( NUMGEO(MELE))
  125. IPPORE=0
  126. IF(MFR.EQ.33) IPPORE=NBNN
  127. C SEGSUP INFO
  128.  
  129. MELEME=IMAMOD
  130. SEGACT MELEME
  131. NBELEM=NUM(/2)
  132. SEGDES MELEME
  133. IPMAIL=IMAMOD
  134. CONM =CONMOD
  135. IMACHE(NS)=IPMAIL
  136. CONCHE(NS)=CONMOD
  137. C
  138. C COQUE INTEGREE OU PAS ?
  139. C
  140. IF(INFMOD(/1).NE.0)THEN
  141. NPINT=INFMOD(1)
  142. ELSE
  143. NPINT=0
  144. ENDIF
  145. IF (NPINT.NE.0)THEN
  146. MCHEL1=IPTR1
  147. IF (I_LOC.EQ.2) THEN
  148. INF=INFMOD(1)
  149. IF (MOD(INF,2).EQ.0) THEN
  150. CALL ERREUR(722)
  151. RETURN
  152. ENDIF
  153. IENT1=(INFMOD(1)+1)/2
  154. IERR1=0
  155. CALL EXTRSK(MCHEL1,IMODEL,NS,MCHELM,IENT1,IERR1)
  156. IF (IERR1.NE.0) GO TO 9990
  157. GO TO 1
  158. ELSE IF (I_LOC.EQ.1) THEN
  159. IENT1=INFMOD(1)
  160. IERR1=0
  161. CALL EXTRSK(MCHEL1,IMODEL,NS,MCHELM,IENT1,IERR1)
  162. IF (IERR1.NE.0) GO TO 9990
  163. GO TO 1
  164. ELSE IF (I_LOC.EQ.3) THEN
  165. IERR1=0
  166. CALL EXTRSK(MCHEL1,IMODEL,NS,MCHELM, 1,IERR1)
  167. IF (IERR1.NE.0) GO TO 9990
  168. GO TO 1
  169. ENDIF
  170. ENDIF
  171. C
  172. C CREATION DU TABLEAU INFOS
  173. C
  174. CALL IDENT(IPMAIL,CONM,IPTR1,IPTR2,INFOS,IRTD)
  175. IF (IRTD.EQ.0) GOTO 9990
  176. C
  177. INFCHE(NS,1)=1
  178. INFCHE(NS,2)=0
  179. INFCHE(NS,3)=NHRM
  180. INFCHE(NS,4)=MINTE
  181. INFCHE(NS,5)=1
  182. INFCHE(NS,6)=5
  183. C____________________________________________________________________
  184. C
  185. C RECHERCHE DES NOMS DE COMPOSANTES
  186. C____________________________________________________________________
  187. C
  188. if(lnomid(4).ne.0) then
  189. nomid=lnomid(4)
  190. segact nomid
  191. mostrs=nomid
  192. nstr=lesobl(/2)
  193. nfac=lesfac(/2)
  194. else
  195. lsupco=.true.
  196. CALL IDCONT(IMODEL,IFOUR,MOSTRS,NSTR,NFAC)
  197. endif
  198. C
  199. C VERIFICATION DE LEUR PRESENCE
  200. C____________________________________________________________________
  201. C
  202. NBTYPE=1
  203. SEGINI NOTYPE
  204. MOTYPE=NOTYPE
  205. TYPE(1)='REAL*8'
  206. CALL KOMCHA(IPTR1,IPMAIL,CONM,MOSTRS,MOTYPE,1,INFOS,3,IVASTR)
  207. SEGSUP NOTYPE
  208. IF (IERR.NE.0) GOTO 9990
  209.  
  210. IPMING=MINTE
  211. SEGACT,MINTE
  212. IF (ISUP1.EQ.1) THEN
  213. CALL VALCHE(IVASTR,NSTR,IPMING,IPPORE,MOSTRS,MELE)
  214. ENDIF
  215. C
  216. C RECHERCHE DE LA TAILLE DES MELVAL A ALLOUER
  217. C
  218. N1PTEL=0
  219. N1EL=0
  220. MPTVAL=IVASTR
  221. DO 110 IO=1,NSTR
  222. MELVAL=IVAL(IO)
  223. N1PTEL=MAX(N1PTEL,VELCHE(/1))
  224. N1EL =MAX(N1EL ,VELCHE(/2))
  225. 110 CONTINUE
  226. C NBGSTR=N1PTEL
  227. IF (N1PTEL.EQ.1.OR.NBPGAU.EQ.1) THEN
  228. N1PTEL=1
  229. ELSE
  230. N1PTEL=NBPGAU
  231. ENDIF
  232. NBPTEL=N1PTEL
  233. NEL=N1EL
  234. C____________________________________________________________________
  235. C
  236. C TRAITEMENT DES CHAMPS DE CARACTERISTIQUES *
  237. C____________________________________________________________________
  238. C
  239. NBROBL=0
  240. NBRFAC=0
  241. NOMID =0
  242. NOTYPE=0
  243. C IVECT=0
  244. C
  245. C EPAISSEUR ET EXCENTREMENT DANS LE CAS DES COQUES
  246. C
  247. IF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN
  248. NBROBL=1
  249. NBRFAC=1
  250. SEGINI NOMID
  251. LESOBL(1)='EPAI'
  252. LESFAC(1)='EXCE'
  253.  
  254. NBTYPE=1
  255. SEGINI NOTYPE
  256. TYPE(1)='REAL*8'
  257. C
  258. C CARACTERISTIQUES POUR LES POUTRES
  259. C
  260. ELSE IF (MFR.EQ.7 ) THEN
  261. C
  262. IF (IDIM.NE.3) THEN
  263. INTERR(1)=IDIM
  264. CALL ERREUR(709)
  265. RETURN
  266. ENDIF
  267. C
  268. NBROBL=5
  269. NBRFAC=1
  270. SEGINI NOMID
  271. LESOBL(1)='INRY'
  272. LESOBL(2)='INRZ'
  273. LESOBL(3)='SECT'
  274. LESOBL(4)='DY '
  275. LESOBL(5)='DZ '
  276. LESFAC(1)='TORS'
  277. C
  278. NBTYPE=1
  279. SEGINI NOTYPE
  280. TYPE(1)='REAL*8'
  281. C
  282. C CARACTERISTIQUES POUR LES TUYAUX
  283. C
  284. ELSE IF (MFR.EQ.13) THEN
  285. NBROBL=2
  286. NBRFAC=2
  287. SEGINI NOMID
  288. LESOBL(1)='EPAI'
  289. LESOBL(2)='RAYO'
  290. LESFAC(1)='RACO'
  291. LESFAC(2)='PRES'
  292.  
  293. NBTYPE=1
  294. SEGINI NOTYPE
  295. TYPE(1)='REAL*8'
  296. ENDIF
  297.  
  298. MOCARA=NOMID
  299. MOTYPE=NOTYPE
  300. NCARA=NBROBL
  301. NCARF=NBRFAC
  302. NCARR=NCARA+NCARF
  303.  
  304. CALL KOMCHA(IPTR2,IPMAIL,CONM,MOCARA,MOTYPE,1,INFOS,3,
  305. $ IVACAR)
  306. SEGSUP NOTYPE
  307. IF (IERR.NE.0) GOTO 9990
  308.  
  309. IF (ISUP2.EQ.1) THEN
  310. CALL VALCHE(IVACAR,NCARR,IPMING,IPPORE,MOCARA,MELE)
  311. ENDIF
  312. N2=6
  313. SEGINI MCHAML
  314. ICHAML(NS)=MCHAML
  315. NOMCHE(1)='SMXX'
  316. TYPCHE(1)='REAL*8'
  317. NOMCHE(2)='SMYY'
  318. TYPCHE(2)='REAL*8'
  319. NOMCHE(3)='SMZZ'
  320. TYPCHE(3)='REAL*8'
  321. NOMCHE(4)='SMXY'
  322. TYPCHE(4)='REAL*8'
  323. NOMCHE(5)='SMYZ'
  324. TYPCHE(5)='REAL*8'
  325. NOMCHE(6)='SMXZ'
  326. TYPCHE(6)='REAL*8'
  327. N2PTEL=0
  328. N2EL=0
  329.  
  330. C-----------------------------------------------------------
  331. C CHAQUE MELVAL = COMPOSANTE SELON SIGMA
  332. C
  333. SEGINI MELVA1,MELVA2,MELVA3,MELVA4,MELVA5,MELVA6
  334. IELVAL(1)=MELVA1
  335. IELVAL(2)=MELVA2
  336. IELVAL(3)=MELVA3
  337. IELVAL(4)=MELVA4
  338. IELVAL(5)=MELVA5
  339. IELVAL(6)=MELVA6
  340.  
  341. C-----------------------------------------------------------
  342. C BRANCHEMENT SELON ELEMENT FINI
  343. C-----------------------------------------------------------
  344. C COQ3,COQ2,DKT
  345. IF ((MELE.EQ.27).OR.(MELE.EQ.28).OR.(MELE.EQ.44)) GOTO 3000
  346. C POUTRE
  347. IF (MELE.EQ.29) GOTO 2000
  348. C TUYAU
  349. C IF (MELE.EQ.42) GOTO 4000
  350. C COQ4 ,DST
  351. IF (MELE.EQ.49.OR.MELE.EQ.93) GOTO 5000
  352. C-----------------------------------------------------------
  353. C AUCUNE CREATION CAR NE SAIT PAS FAIRE POUR L'ELEMENT
  354. C-----------------------------------------------------------
  355. MOTERR(1:4) =NOMTP(MELE)
  356. MOTERR(5:12)='CALP '
  357. CALL ERREUR(86)
  358. SEGSUP MELVA1,MELVA2,MELVA2,MELVA3,MELVA4,MELVA5,MELVA6,MCHAML
  359. GOTO 9990
  360. C-----------------------------------------------------------
  361. C POUTRES + CONTRAINTES
  362. C-----------------------------------------------------------
  363. 2000 CONTINUE
  364. DO 2010 N2=1,NEL
  365. DO 2011 N1=1,NBPTEL
  366. MPTVAL=IVASTR
  367. MELVAL=IVAL(1)
  368. EFFX=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  369.  
  370. MELVAL=IVAL(2)
  371. EFFY=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  372.  
  373. MELVAL=IVAL(3)
  374. EFFZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  375.  
  376. MELVAL=IVAL(5)
  377. FLEXY=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  378.  
  379. MELVAL=IVAL(6)
  380. FLEXZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  381.  
  382. MPTVAL=IVACAR
  383.  
  384. MELVAL=IVAL(3)
  385. SECT=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  386.  
  387. MELVAL=IVAL(1)
  388. FINRY=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  389.  
  390. MELVAL=IVAL(2)
  391. FINRZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  392.  
  393. MELVAL=IVAL(4)
  394. PY=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  395. MELVAL=IVAL(5)
  396. PZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  397. AIRY=SECT
  398.  
  399. AIRZ=SECT
  400.  
  401. C CALCUL DES CONTRAINTES REELLES
  402. MELVA1.VELCHE(N1,N2)=(EFFX/SECT)+(FLEXY*PZ/FINRY)
  403. . -(FLEXZ*PY/FINRZ)
  404. MELVA2.VELCHE(N1,N2)=0.
  405. MELVA3.VELCHE(N1,N2)=0.
  406. MELVA4.VELCHE(N1,N2)=(EFFY/AIRY)
  407. MELVA5.VELCHE(N1,N2)=0.
  408. MELVA6.VELCHE(N1,N2)=(EFFZ/AIRZ)
  409. 2011 CONTINUE
  410. 2010 CONTINUE
  411.  
  412. SEGDES MELVA1,MELVA2,MELVA2,MELVA3,MELVA4,MELVA5,MELVA6,MCHAML
  413.  
  414. GOTO 510
  415.  
  416. C-----------------------------------------------------------
  417. C COQ2,COQ3,DKT + CONTRAINTES
  418. C-----------------------------------------------------------
  419. 3000 CONTINUE
  420. IF (IFOUR.EQ.2.OR.IFOUR.EQ.1) THEN
  421. DO 3010 N2=1,NEL
  422. DO 3011 N1=1,NBPTEL
  423.  
  424. MPTVAL=IVASTR
  425.  
  426. MELVAL=IVAL(1)
  427. AN11=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  428.  
  429. MELVAL=IVAL(2)
  430. AN22=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  431.  
  432. MELVAL=IVAL(3)
  433. AN12=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  434.  
  435. MELVAL=IVAL(4)
  436. AM11=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  437.  
  438. MELVAL=IVAL(5)
  439. AM22=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  440.  
  441. MELVAL=IVAL(6)
  442. AM12=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  443.  
  444. MPTVAL=IVACAR
  445.  
  446. MELVAL=IVAL(1)
  447. EPAI=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  448.  
  449. IF (I_LOC.EQ.3) THEN
  450. r_z = EPAI*EPAI
  451. MELVA1.VELCHE(N1,N2)=AN11/EPAI-(6.*AM11/r_z)
  452. MELVA2.VELCHE(N1,N2)=AN22/EPAI-(6.*AM22/r_z)
  453. MELVA3.VELCHE(N1,N2)=0.
  454. MELVA4.VELCHE(N1,N2)=AN12/EPAI-(6.*AM12/r_z)
  455. MELVA5.VELCHE(N1,N2)=0.
  456. MELVA6.VELCHE(N1,N2)=0.
  457. ELSE IF (I_LOC.EQ.1) THEN
  458. r_z = EPAI*EPAI
  459. MELVA1.VELCHE(N1,N2)=AN11/EPAI+(6.*AM11/r_z)
  460. MELVA2.VELCHE(N1,N2)=AN22/EPAI+(6.*AM22/r_z)
  461. MELVA3.VELCHE(N1,N2)=0.
  462. MELVA4.VELCHE(N1,N2)=AN12/EPAI+(6.*AM12/r_z)
  463. MELVA5.VELCHE(N1,N2)=0.
  464. MELVA6.VELCHE(N1,N2)=0.
  465. ELSE IF (I_LOC.EQ.2) THEN
  466. MELVA1.VELCHE(N1,N2)=AN11/EPAI
  467. MELVA2.VELCHE(N1,N2)=AN22/EPAI
  468. MELVA3.VELCHE(N1,N2)=0.
  469. MELVA4.VELCHE(N1,N2)=AN12/EPAI
  470. MELVA5.VELCHE(N1,N2)=0.
  471. MELVA6.VELCHE(N1,N2)=0.
  472. ENDIF
  473. 3011 CONTINUE
  474. 3010 CONTINUE
  475. ENDIF
  476.  
  477. IF (IFOUR.EQ.0) THEN
  478. DO 3012 N2=1,NEL
  479. DO 3013 N1=1,NBPTEL
  480.  
  481. MPTVAL=IVASTR
  482.  
  483. MELVAL=IVAL(1)
  484. AN11=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  485.  
  486. MELVAL=IVAL(2)
  487. AN22=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  488.  
  489. MELVAL=IVAL(3)
  490. AM11=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  491.  
  492. MELVAL=IVAL(4)
  493. AM22=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  494.  
  495. MPTVAL=IVACAR
  496.  
  497. MELVAL=IVAL(1)
  498. EPAI=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  499.  
  500. IF (I_LOC.EQ.3) THEN
  501. r_z = EPAI*EPAI
  502. MELVA1.VELCHE(N1,N2)=AN11/EPAI-(6.*AM11/r_z)
  503. MELVA2.VELCHE(N1,N2)=AN22/EPAI-(6.*AM22/r_z)
  504. MELVA3.VELCHE(N1,N2)=0.
  505. MELVA4.VELCHE(N1,N2)=0.
  506. MELVA5.VELCHE(N1,N2)=0.
  507. MELVA6.VELCHE(N1,N2)=0.
  508. ELSE IF (I_LOC.EQ.1) THEN
  509. r_z = EPAI*EPAI
  510. MELVA1.VELCHE(N1,N2)=AN11/EPAI+(6.*AM11/r_z)
  511. MELVA2.VELCHE(N1,N2)=AN22/EPAI+(6.*AM22/r_z)
  512. MELVA3.VELCHE(N1,N2)=0.
  513. MELVA4.VELCHE(N1,N2)=0.
  514. MELVA5.VELCHE(N1,N2)=0.
  515. MELVA6.VELCHE(N1,N2)=0.
  516. ELSE IF (I_LOC.EQ.2) THEN
  517. MELVA1.VELCHE(N1,N2)=AN11/EPAI
  518. MELVA2.VELCHE(N1,N2)=AN22/EPAI
  519. MELVA3.VELCHE(N1,N2)=0.
  520. MELVA4.VELCHE(N1,N2)=0.
  521. MELVA5.VELCHE(N1,N2)=0.
  522. MELVA6.VELCHE(N1,N2)=0.
  523. ENDIF
  524. 3013 CONTINUE
  525. 3012 CONTINUE
  526. ENDIF
  527.  
  528. IF (IFOUR.EQ.-1.OR.IFOUR.EQ.-2) THEN
  529. DO 3014 N2=1,NEL
  530. DO 3015 N1=1,NBPTEL
  531.  
  532. MPTVAL=IVASTR
  533.  
  534. MELVAL=IVAL(1)
  535. AN11=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  536.  
  537. MELVAL=IVAL(2)
  538. ANZZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  539.  
  540. MELVAL=IVAL(3)
  541. AM11=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  542.  
  543. MELVAL=IVAL(4)
  544. AMZZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  545.  
  546. MPTVAL=IVACAR
  547.  
  548. MELVAL=IVAL(1)
  549. EPAI=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  550.  
  551. IF (I_LOC.EQ.3) THEN
  552. r_z = EPAI*EPAI
  553. MELVA1.VELCHE(N1,N2)=AN11/EPAI-(6.*AM11/r_z)
  554. MELVA2.VELCHE(N1,N2)=ANZZ/EPAI-(6.*AMZZ/r_z)
  555. MELVA3.VELCHE(N1,N2)=0.
  556. MELVA4.VELCHE(N1,N2)=0.
  557. MELVA5.VELCHE(N1,N2)=0.
  558. MELVA6.VELCHE(N1,N2)=0.
  559. ELSE IF (I_LOC.EQ.1) THEN
  560. r_z = EPAI*EPAI
  561. MELVA1.VELCHE(N1,N2)=AN11/EPAI+(6.*AM11/r_z)
  562. MELVA2.VELCHE(N1,N2)=ANZZ/EPAI+(6.*AMZZ/r_z)
  563. MELVA3.VELCHE(N1,N2)=0.
  564. MELVA4.VELCHE(N1,N2)=0.
  565. MELVA5.VELCHE(N1,N2)=0.
  566. MELVA6.VELCHE(N1,N2)=0.
  567. ELSE IF (I_LOC.EQ.2) THEN
  568. MELVA1.VELCHE(N1,N2)=AN11/EPAI
  569. MELVA2.VELCHE(N1,N2)=ANZZ/EPAI
  570. MELVA3.VELCHE(N1,N2)=0.
  571. MELVA4.VELCHE(N1,N2)=0.
  572. MELVA5.VELCHE(N1,N2)=0.
  573. MELVA6.VELCHE(N1,N2)=0.
  574. ENDIF
  575. 3015 CONTINUE
  576. 3014 CONTINUE
  577. ENDIF
  578. IF (IFOUR.EQ.-3) THEN
  579. DO 3016 N2=1,NEL
  580. DO 3017 N1=1,NBPTEL
  581.  
  582. MPTVAL=IVASTR
  583.  
  584. MELVAL=IVAL(1)
  585. AN11=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  586.  
  587. MELVAL=IVAL(2)
  588. ANZZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  589.  
  590. MELVAL=IVAL(3)
  591. AM11=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  592.  
  593. MELVAL=IVAL(4)
  594. AMZZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  595.  
  596. MPTVAL=IVACAR
  597.  
  598. MELVAL=IVAL(1)
  599. EPAI=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  600.  
  601. IF (I_LOC.EQ.3) THEN
  602. r_z = EPAI*EPAI
  603. MELVA1.VELCHE(N1,N2)=AN11/EPAI-(6.*AM11/r_z)
  604. MELVA2.VELCHE(N1,N2)=0.
  605. MELVA3.VELCHE(N1,N2)=ANZZ/EPAI-(6.*AMZZ/r_z)
  606. MELVA4.VELCHE(N1,N2)=0.
  607. MELVA5.VELCHE(N1,N2)=0.
  608. MELVA6.VELCHE(N1,N2)=0.
  609. ELSE IF (I_LOC.EQ.1) THEN
  610. r_z = EPAI*EPAI
  611. MELVA1.VELCHE(N1,N2)=AN11/EPAI+(6.*AM11/r_z)
  612. MELVA2.VELCHE(N1,N2)=0.
  613. MELVA3.VELCHE(N1,N2)=ANZZ/EPAI+(6.*AMZZ/r_z)
  614. MELVA4.VELCHE(N1,N2)=0.
  615. MELVA5.VELCHE(N1,N2)=0.
  616. MELVA6.VELCHE(N1,N2)=0.
  617. ELSE IF (I_LOC.EQ.2) THEN
  618. MELVA1.VELCHE(N1,N2)=AN11/EPAI
  619. MELVA2.VELCHE(N1,N2)=0.
  620. MELVA3.VELCHE(N1,N2)=ANZZ/EPAI
  621. MELVA4.VELCHE(N1,N2)=0.
  622. MELVA5.VELCHE(N1,N2)=0.
  623. MELVA6.VELCHE(N1,N2)=0.
  624. ENDIF
  625. 3017 CONTINUE
  626. 3016 CONTINUE
  627. ENDIF
  628. SEGDES MELVA1,MELVA2,MELVA2,MELVA3,MELVA4,MELVA5,MELVA6,MCHAML
  629.  
  630. GOTO 510
  631. C-----------------------------------------------------------
  632. C TUYAU+CONTRAINTE
  633. C-----------------------------------------------------------
  634. C 4000 CONTINUE
  635. C DO 4010 N2=1,NEL
  636. C DO 4011 N1=1,NBPTEL
  637. C
  638. C MPTVAL=IVASTR
  639. C
  640. C MELVAL=IVAL(1)
  641. C EFFX=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  642. C
  643. C MELVAL=IVAL(2)
  644. C EFFY=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  645. C
  646. C MELVAL=IVAL(3)
  647. C EFFZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  648. C
  649. C MELVAL=IVAL(4)
  650. C FLEXY=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  651. C
  652. C MELVAL=IVAL(5)
  653. C FLEXZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  654. C
  655. C MELVAL=IVAL(6)
  656. C
  657. C FLEXX=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  658. C
  659. C MPTVAL=IVACAR
  660. C
  661. C MELVAL=IVAL(1)
  662. C EPAI=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  663. C
  664. C MELVAL=IVAL(2)
  665. C RAYO=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  666. C
  667. C IF(IVECT.EQ.2)THEN
  668. C MELVAL=IVAL(6)
  669. C PY=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  670. C MELVAL=IVAL(7)
  671. C PZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  672. C ELSE
  673. C MELVAL=IVAL(5)
  674. C IPO=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  675. C CALL EXCOO1(IPO,PX,PY,PZ,D)
  676. C ENDIF
  677. C RINT=(RAYO-EPAI)
  678. C D1=SQRT((PY**2)+(PZ**2))
  679. C
  680. C CALCUL DES CONTRAINTES REELLES
  681. C
  682. C FINRY=((RAYO**4)-(RINT**4))*XPI/4
  683. C SECT=XPI*((RAYO**2)-(RINT**2))
  684. C IF ((D1.GE.RINT).AND.(D1.LE.RAYO)) THEN
  685. C MELVA1.VELCHE(N1,N2)=(EFFX/SECT)+(FLEXY*PZ
  686. C . /FINRY)-(FLEXZ*PY/FINRY)
  687. C MELVA2.VELCHE(N1,N2)=0.
  688. C MELVA3.VELCHE(N1,N2)=0.
  689. C MELVA4.VELCHE(N1,N2)=(EFFY/AIRY)
  690. C MELVA5.VELCHE(N1,N2)=(FLEXX/2*XPI*RAYO**2*EPAI)
  691. C MELVA6.VELCHE(N1,N2)=(EFFZ/AIRZ)
  692. C ELSE
  693. C CALL ERREUR(505)
  694. C SEGSUP MELVA1,MELVA2,MELVA2,MELVA3,MELVA4,MELVA5,MELVA6,MCHAML
  695. C GOTO 9990
  696. C ENDIF
  697. C 4011 CONTINUE
  698. C 4010 CONTINUE
  699. C
  700. C SEGDES MELVA1,MELVA2,MELVA2,MELVA3,MELVA4,MELVA5,MELVA6,MCHAML
  701. C GOTO 510
  702. C-----------------------------------------------------------
  703. C COQ4 +CONTRAINTE
  704. C-----------------------------------------------------------
  705. 5000 CONTINUE
  706. DO 5010 N2=1,NEL
  707. DO 5011 N1=1,NBPTEL
  708.  
  709. MPTVAL=IVASTR
  710.  
  711. MELVAL=IVAL(1)
  712. AN11=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  713.  
  714. MELVAL=IVAL(2)
  715. AN22=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  716.  
  717. MELVAL=IVAL(3)
  718. AN12=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  719.  
  720. MELVAL=IVAL(4)
  721. AM11=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  722.  
  723. MELVAL=IVAL(5)
  724. AM22=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  725.  
  726. MELVAL=IVAL(6)
  727. AM12=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  728.  
  729. MELVAL=IVAL(7)
  730. V1=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  731.  
  732. MELVAL=IVAL(8)
  733. V2=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  734.  
  735. MPTVAL=IVACAR
  736.  
  737. MELVAL=IVAL(1)
  738. EPAI=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  739.  
  740. IF (I_LOC.EQ.3) THEN
  741. r_z = EPAI*EPAI
  742. MELVA1.VELCHE(N1,N2)=AN11/EPAI-(6.*AM11/r_z)
  743. MELVA2.VELCHE(N1,N2)=AN22/EPAI-(6.*AM22/r_z)
  744. MELVA3.VELCHE(N1,N2)=0.
  745. MELVA4.VELCHE(N1,N2)=AN12/EPAI-(6.*AM12/r_z)
  746. MELVA5.VELCHE(N1,N2)=V1/EPAI
  747. MELVA6.VELCHE(N1,N2)=V2/EPAI
  748. ELSE IF (I_LOC.EQ.1) THEN
  749. r_z = EPAI*EPAI
  750. MELVA1.VELCHE(N1,N2)=AN11/EPAI+(6.*AM11/r_z)
  751. MELVA2.VELCHE(N1,N2)=AN22/EPAI+(6.*AM22/r_z)
  752. MELVA3.VELCHE(N1,N2)=0.
  753. MELVA4.VELCHE(N1,N2)=AN12/EPAI+(6.*AM12/r_z)
  754. MELVA5.VELCHE(N1,N2)=V1/EPAI
  755. MELVA6.VELCHE(N1,N2)=V2/EPAI
  756. ELSE IF (I_LOC.EQ.2) THEN
  757. r_z = EPAI*EPAI
  758. MELVA1.VELCHE(N1,N2)=AN11/EPAI
  759. MELVA2.VELCHE(N1,N2)=AN22/EPAI
  760. MELVA3.VELCHE(N1,N2)=0.
  761. MELVA4.VELCHE(N1,N2)=AN12/EPAI
  762. MELVA5.VELCHE(N1,N2)=V1/EPAI
  763. MELVA6.VELCHE(N1,N2)=V2/EPAI
  764. ENDIF
  765. 5011 CONTINUE
  766. 5010 CONTINUE
  767.  
  768. SEGDES MELVA1,MELVA2,MELVA2,MELVA3,MELVA4,MELVA5,MELVA6,MCHAML
  769.  
  770.  
  771. C-----------------------------------------------------------
  772. C DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE NS
  773. C-----------------------------------------------------------
  774. 510 CONTINUE
  775.  
  776. SEGDES IMODEL
  777. SEGDES,MINTE
  778.  
  779. IF (ISUP1.EQ.1) THEN
  780. CALL DTMVAL(IVASTR,3)
  781. ELSE
  782. CALL DTMVAL(IVASTR,1)
  783. ENDIF
  784.  
  785. IF (ISUP2.EQ.1) THEN
  786. CALL DTMVAL(IVACAR,3)
  787. ELSE
  788. CALL DTMVAL(IVACAR,1)
  789. ENDIF
  790.  
  791. NOMID=MOSTRS
  792. IF (MOSTRS.NE.0.and.lsupco)SEGSUP NOMID
  793. NOMID=MOCARA
  794. IF (MOCARA.NE.0) SEGSUP NOMID
  795. 1 CONTINUE
  796.  
  797. SEGDES MCHELM,MMODEL
  798. RETURN
  799. C-----------------------------------------------------------
  800. C DESACTIVATION ET RETOUR DANS LE CAS D'ERREUR
  801. C-----------------------------------------------------------
  802. 9990 CONTINUE
  803.  
  804. SEGDES,MINTE
  805. IF (ISUP1.EQ.1) THEN
  806. CALL DTMVAL(IVASTR,3)
  807. ELSE
  808. CALL DTMVAL(IVASTR,1)
  809. ENDIF
  810.  
  811. IF (ISUP2.EQ.1) THEN
  812. CALL DTMVAL(IVACAR,3)
  813. ELSE
  814. CALL DTMVAL(IVACAR,1)
  815. ENDIF
  816.  
  817. NOMID=MOCARA
  818. IF (MOCARA.NE.0) SEGSUP NOMID
  819. NOMID=MOSTRS
  820. IF (MOSTRS.NE.0.and.lsupco)SEGSUP NOMID
  821. SEGDES MMODEL,IMODEL
  822. SEGSUP MCHELM
  823.  
  824. RETURN
  825. END
  826.  
  827.  
  828.  
  829.  
  830.  
  831.  
  832.  
  833.  
  834.  
  835.  
  836.  

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