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

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