Télécharger calp1.eso

Retour à la liste

Numérotation des lignes :

  1. C CALP1 SOURCE BP208322 16/11/18 21:15:20 9177
  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. NBROBL=5
  260. NBRFAC=1
  261. SEGINI NOMID
  262. LESOBL(1)='INRY'
  263. LESOBL(2)='INRZ'
  264. LESOBL(3)='SECT'
  265. LESOBL(4)='DY '
  266. LESOBL(5)='DZ '
  267. LESFAC(1)='TORS'
  268. C
  269. NBTYPE=1
  270. SEGINI NOTYPE
  271. TYPE(1)='REAL*8'
  272. C
  273. C CARACTERISTIQUES POUR LES TUYAUX
  274. C
  275. ELSE IF (MFR.EQ.13) THEN
  276. NBROBL=2
  277. NBRFAC=2
  278. SEGINI NOMID
  279. LESOBL(1)='EPAI'
  280. LESOBL(2)='RAYO'
  281. LESFAC(1)='RACO'
  282. LESFAC(2)='PRES'
  283.  
  284. NBTYPE=1
  285. SEGINI NOTYPE
  286. TYPE(1)='REAL*8'
  287. ENDIF
  288.  
  289. MOCARA=NOMID
  290. MOTYPE=NOTYPE
  291. NCARA=NBROBL
  292. NCARF=NBRFAC
  293. NCARR=NCARA+NCARF
  294.  
  295. CALL KOMCHA(IPTR2,IPMAIL,CONM,MOCARA,MOTYPE,1,INFOS,3,
  296. $ IVACAR)
  297. SEGSUP NOTYPE
  298. IF (IERR.NE.0) GOTO 9990
  299.  
  300. IF (ISUP2.EQ.1) THEN
  301. CALL VALCHE(IVACAR,NCARR,IPMING,IPPORE,MOCARA,MELE)
  302. ENDIF
  303. N2=6
  304. SEGINI MCHAML
  305. ICHAML(NS)=MCHAML
  306. NOMCHE(1)='SMXX'
  307. TYPCHE(1)='REAL*8'
  308. NOMCHE(2)='SMYY'
  309. TYPCHE(2)='REAL*8'
  310. NOMCHE(3)='SMZZ'
  311. TYPCHE(3)='REAL*8'
  312. NOMCHE(4)='SMXY'
  313. TYPCHE(4)='REAL*8'
  314. NOMCHE(5)='SMYZ'
  315. TYPCHE(5)='REAL*8'
  316. NOMCHE(6)='SMXZ'
  317. TYPCHE(6)='REAL*8'
  318. N2PTEL=0
  319. N2EL=0
  320.  
  321. C-----------------------------------------------------------
  322. C CHAQUE MELVAL = COMPOSANTE SELON SIGMA
  323. C
  324. SEGINI MELVA1,MELVA2,MELVA3,MELVA4,MELVA5,MELVA6
  325. IELVAL(1)=MELVA1
  326. IELVAL(2)=MELVA2
  327. IELVAL(3)=MELVA3
  328. IELVAL(4)=MELVA4
  329. IELVAL(5)=MELVA5
  330. IELVAL(6)=MELVA6
  331.  
  332. C-----------------------------------------------------------
  333. C BRANCHEMENT SELON ELEMENT FINI
  334. C-----------------------------------------------------------
  335. C COQ3,COQ2,DKT
  336. IF ((MELE.EQ.27).OR.(MELE.EQ.28).OR.(MELE.EQ.44)) GOTO 3000
  337. C POUTRE
  338. IF (MELE.EQ.29) GOTO 2000
  339. C TUYAU
  340. C IF (MELE.EQ.42) GOTO 4000
  341. C COQ4 ,DST
  342. IF (MELE.EQ.49.OR.MELE.EQ.93) GOTO 5000
  343. C-----------------------------------------------------------
  344. C AUCUNE CREATION CAR NE SAIT PAS FAIRE POUR L'ELEMENT
  345. C-----------------------------------------------------------
  346. MOTERR(1:4) =NOMTP(MELE)
  347. MOTERR(5:12)='CALP '
  348. CALL ERREUR(86)
  349. SEGSUP MELVA1,MELVA2,MELVA2,MELVA3,MELVA4,MELVA5,MELVA6,MCHAML
  350. GOTO 9990
  351. C-----------------------------------------------------------
  352. C POUTRES + CONTRAINTES
  353. C-----------------------------------------------------------
  354. 2000 CONTINUE
  355. DO 2010 N2=1,NEL
  356. DO 2011 N1=1,NBPTEL
  357. MPTVAL=IVASTR
  358. MELVAL=IVAL(1)
  359. EFFX=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  360.  
  361. MELVAL=IVAL(2)
  362. EFFY=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  363.  
  364. MELVAL=IVAL(3)
  365. EFFZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  366.  
  367. MELVAL=IVAL(5)
  368. FLEXY=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  369.  
  370. MELVAL=IVAL(6)
  371. FLEXZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  372.  
  373. MPTVAL=IVACAR
  374.  
  375. MELVAL=IVAL(3)
  376. SECT=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  377.  
  378. MELVAL=IVAL(1)
  379. FINRY=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  380.  
  381. MELVAL=IVAL(2)
  382. FINRZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  383.  
  384. MELVAL=IVAL(4)
  385. PY=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  386. MELVAL=IVAL(5)
  387. PZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  388. AIRY=SECT
  389.  
  390. AIRZ=SECT
  391.  
  392. C CALCUL DES CONTRAINTES REELLES
  393. MELVA1.VELCHE(N1,N2)=(EFFX/SECT)+(FLEXY*PZ/FINRY)
  394. . -(FLEXZ*PY/FINRZ)
  395. MELVA2.VELCHE(N1,N2)=0.
  396. MELVA3.VELCHE(N1,N2)=0.
  397. MELVA4.VELCHE(N1,N2)=(EFFY/AIRY)
  398. MELVA5.VELCHE(N1,N2)=0.
  399. MELVA6.VELCHE(N1,N2)=(EFFZ/AIRZ)
  400. 2011 CONTINUE
  401. 2010 CONTINUE
  402.  
  403. SEGDES MELVA1,MELVA2,MELVA2,MELVA3,MELVA4,MELVA5,MELVA6,MCHAML
  404.  
  405. GOTO 510
  406.  
  407. C-----------------------------------------------------------
  408. C COQ2,COQ3,DKT + CONTRAINTES
  409. C-----------------------------------------------------------
  410. 3000 CONTINUE
  411. IF (IFOUR.EQ.2.OR.IFOUR.EQ.1) THEN
  412. DO 3010 N2=1,NEL
  413. DO 3011 N1=1,NBPTEL
  414.  
  415. MPTVAL=IVASTR
  416.  
  417. MELVAL=IVAL(1)
  418. AN11=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  419.  
  420. MELVAL=IVAL(2)
  421. AN22=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  422.  
  423. MELVAL=IVAL(3)
  424. AN12=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  425.  
  426. MELVAL=IVAL(4)
  427. AM11=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  428.  
  429. MELVAL=IVAL(5)
  430. AM22=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  431.  
  432. MELVAL=IVAL(6)
  433. AM12=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  434.  
  435. MPTVAL=IVACAR
  436.  
  437. MELVAL=IVAL(1)
  438. EPAI=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  439.  
  440. IF (I_LOC.EQ.3) THEN
  441. r_z = EPAI*EPAI
  442. MELVA1.VELCHE(N1,N2)=AN11/EPAI-(6.*AM11/r_z)
  443. MELVA2.VELCHE(N1,N2)=AN22/EPAI-(6.*AM22/r_z)
  444. MELVA3.VELCHE(N1,N2)=0.
  445. MELVA4.VELCHE(N1,N2)=AN12/EPAI-(6.*AM12/r_z)
  446. MELVA5.VELCHE(N1,N2)=0.
  447. MELVA6.VELCHE(N1,N2)=0.
  448. ELSE IF (I_LOC.EQ.1) THEN
  449. r_z = EPAI*EPAI
  450. MELVA1.VELCHE(N1,N2)=AN11/EPAI+(6.*AM11/r_z)
  451. MELVA2.VELCHE(N1,N2)=AN22/EPAI+(6.*AM22/r_z)
  452. MELVA3.VELCHE(N1,N2)=0.
  453. MELVA4.VELCHE(N1,N2)=AN12/EPAI+(6.*AM12/r_z)
  454. MELVA5.VELCHE(N1,N2)=0.
  455. MELVA6.VELCHE(N1,N2)=0.
  456. ELSE IF (I_LOC.EQ.2) THEN
  457. MELVA1.VELCHE(N1,N2)=AN11/EPAI
  458. MELVA2.VELCHE(N1,N2)=AN22/EPAI
  459. MELVA3.VELCHE(N1,N2)=0.
  460. MELVA4.VELCHE(N1,N2)=AN12/EPAI
  461. MELVA5.VELCHE(N1,N2)=0.
  462. MELVA6.VELCHE(N1,N2)=0.
  463. ENDIF
  464. 3011 CONTINUE
  465. 3010 CONTINUE
  466. ENDIF
  467.  
  468. IF (IFOUR.EQ.0) THEN
  469. DO 3012 N2=1,NEL
  470. DO 3013 N1=1,NBPTEL
  471.  
  472. MPTVAL=IVASTR
  473.  
  474. MELVAL=IVAL(1)
  475. AN11=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  476.  
  477. MELVAL=IVAL(2)
  478. AN22=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  479.  
  480. MELVAL=IVAL(3)
  481. AM11=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  482.  
  483. MELVAL=IVAL(4)
  484. AM22=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  485.  
  486. MPTVAL=IVACAR
  487.  
  488. MELVAL=IVAL(1)
  489. EPAI=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  490.  
  491. IF (I_LOC.EQ.3) THEN
  492. r_z = EPAI*EPAI
  493. MELVA1.VELCHE(N1,N2)=AN11/EPAI-(6.*AM11/r_z)
  494. MELVA2.VELCHE(N1,N2)=AN22/EPAI-(6.*AM22/r_z)
  495. MELVA3.VELCHE(N1,N2)=0.
  496. MELVA4.VELCHE(N1,N2)=0.
  497. MELVA5.VELCHE(N1,N2)=0.
  498. MELVA6.VELCHE(N1,N2)=0.
  499. ELSE IF (I_LOC.EQ.1) THEN
  500. r_z = EPAI*EPAI
  501. MELVA1.VELCHE(N1,N2)=AN11/EPAI+(6.*AM11/r_z)
  502. MELVA2.VELCHE(N1,N2)=AN22/EPAI+(6.*AM22/r_z)
  503. MELVA3.VELCHE(N1,N2)=0.
  504. MELVA4.VELCHE(N1,N2)=0.
  505. MELVA5.VELCHE(N1,N2)=0.
  506. MELVA6.VELCHE(N1,N2)=0.
  507. ELSE IF (I_LOC.EQ.2) THEN
  508. MELVA1.VELCHE(N1,N2)=AN11/EPAI
  509. MELVA2.VELCHE(N1,N2)=AN22/EPAI
  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. ENDIF
  515. 3013 CONTINUE
  516. 3012 CONTINUE
  517. ENDIF
  518.  
  519. IF (IFOUR.EQ.-1.OR.IFOUR.EQ.-2) THEN
  520. DO 3014 N2=1,NEL
  521. DO 3015 N1=1,NBPTEL
  522.  
  523. MPTVAL=IVASTR
  524.  
  525. MELVAL=IVAL(1)
  526. AN11=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  527.  
  528. MELVAL=IVAL(2)
  529. ANZZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  530.  
  531. MELVAL=IVAL(3)
  532. AM11=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  533.  
  534. MELVAL=IVAL(4)
  535. AMZZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  536.  
  537. MPTVAL=IVACAR
  538.  
  539. MELVAL=IVAL(1)
  540. EPAI=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  541.  
  542. IF (I_LOC.EQ.3) THEN
  543. r_z = EPAI*EPAI
  544. MELVA1.VELCHE(N1,N2)=AN11/EPAI-(6.*AM11/r_z)
  545. MELVA2.VELCHE(N1,N2)=ANZZ/EPAI-(6.*AMZZ/r_z)
  546. MELVA3.VELCHE(N1,N2)=0.
  547. MELVA4.VELCHE(N1,N2)=0.
  548. MELVA5.VELCHE(N1,N2)=0.
  549. MELVA6.VELCHE(N1,N2)=0.
  550. ELSE IF (I_LOC.EQ.1) THEN
  551. r_z = EPAI*EPAI
  552. MELVA1.VELCHE(N1,N2)=AN11/EPAI+(6.*AM11/r_z)
  553. MELVA2.VELCHE(N1,N2)=ANZZ/EPAI+(6.*AMZZ/r_z)
  554. MELVA3.VELCHE(N1,N2)=0.
  555. MELVA4.VELCHE(N1,N2)=0.
  556. MELVA5.VELCHE(N1,N2)=0.
  557. MELVA6.VELCHE(N1,N2)=0.
  558. ELSE IF (I_LOC.EQ.2) THEN
  559. MELVA1.VELCHE(N1,N2)=AN11/EPAI
  560. MELVA2.VELCHE(N1,N2)=ANZZ/EPAI
  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. ENDIF
  566. 3015 CONTINUE
  567. 3014 CONTINUE
  568. ENDIF
  569. IF (IFOUR.EQ.-3) THEN
  570. DO 3016 N2=1,NEL
  571. DO 3017 N1=1,NBPTEL
  572.  
  573. MPTVAL=IVASTR
  574.  
  575. MELVAL=IVAL(1)
  576. AN11=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  577.  
  578. MELVAL=IVAL(2)
  579. ANZZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  580.  
  581. MELVAL=IVAL(3)
  582. AM11=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  583.  
  584. MELVAL=IVAL(4)
  585. AMZZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  586.  
  587. MPTVAL=IVACAR
  588.  
  589. MELVAL=IVAL(1)
  590. EPAI=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  591.  
  592. IF (I_LOC.EQ.3) THEN
  593. r_z = EPAI*EPAI
  594. MELVA1.VELCHE(N1,N2)=AN11/EPAI-(6.*AM11/r_z)
  595. MELVA2.VELCHE(N1,N2)=0.
  596. MELVA3.VELCHE(N1,N2)=ANZZ/EPAI-(6.*AMZZ/r_z)
  597. MELVA4.VELCHE(N1,N2)=0.
  598. MELVA5.VELCHE(N1,N2)=0.
  599. MELVA6.VELCHE(N1,N2)=0.
  600. ELSE IF (I_LOC.EQ.1) THEN
  601. r_z = EPAI*EPAI
  602. MELVA1.VELCHE(N1,N2)=AN11/EPAI+(6.*AM11/r_z)
  603. MELVA2.VELCHE(N1,N2)=0.
  604. MELVA3.VELCHE(N1,N2)=ANZZ/EPAI+(6.*AMZZ/r_z)
  605. MELVA4.VELCHE(N1,N2)=0.
  606. MELVA5.VELCHE(N1,N2)=0.
  607. MELVA6.VELCHE(N1,N2)=0.
  608. ELSE IF (I_LOC.EQ.2) THEN
  609. MELVA1.VELCHE(N1,N2)=AN11/EPAI
  610. MELVA2.VELCHE(N1,N2)=0.
  611. MELVA3.VELCHE(N1,N2)=ANZZ/EPAI
  612. MELVA4.VELCHE(N1,N2)=0.
  613. MELVA5.VELCHE(N1,N2)=0.
  614. MELVA6.VELCHE(N1,N2)=0.
  615. ENDIF
  616. 3017 CONTINUE
  617. 3016 CONTINUE
  618. ENDIF
  619. SEGDES MELVA1,MELVA2,MELVA2,MELVA3,MELVA4,MELVA5,MELVA6,MCHAML
  620.  
  621. GOTO 510
  622. C-----------------------------------------------------------
  623. C TUYAU+CONTRAINTE
  624. C-----------------------------------------------------------
  625. C 4000 CONTINUE
  626. C DO 4010 N2=1,NEL
  627. C DO 4011 N1=1,NBPTEL
  628. C
  629. C MPTVAL=IVASTR
  630. C
  631. C MELVAL=IVAL(1)
  632. C EFFX=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  633. C
  634. C MELVAL=IVAL(2)
  635. C EFFY=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  636. C
  637. C MELVAL=IVAL(3)
  638. C EFFZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  639. C
  640. C MELVAL=IVAL(4)
  641. C FLEXY=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  642. C
  643. C MELVAL=IVAL(5)
  644. C FLEXZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  645. C
  646. C MELVAL=IVAL(6)
  647. C
  648. C FLEXX=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  649. C
  650. C MPTVAL=IVACAR
  651. C
  652. C MELVAL=IVAL(1)
  653. C EPAI=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  654. C
  655. C MELVAL=IVAL(2)
  656. C RAYO=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  657. C
  658. C IF(IVECT.EQ.2)THEN
  659. C MELVAL=IVAL(6)
  660. C PY=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  661. C MELVAL=IVAL(7)
  662. C PZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  663. C ELSE
  664. C MELVAL=IVAL(5)
  665. C IPO=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  666. C CALL EXCOO1(IPO,PX,PY,PZ,D)
  667. C ENDIF
  668. C RINT=(RAYO-EPAI)
  669. C D1=SQRT((PY**2)+(PZ**2))
  670. C
  671. C CALCUL DES CONTRAINTES REELLES
  672. C
  673. C FINRY=((RAYO**4)-(RINT**4))*XPI/4
  674. C SECT=XPI*((RAYO**2)-(RINT**2))
  675. C IF ((D1.GE.RINT).AND.(D1.LE.RAYO)) THEN
  676. C MELVA1.VELCHE(N1,N2)=(EFFX/SECT)+(FLEXY*PZ
  677. C . /FINRY)-(FLEXZ*PY/FINRY)
  678. C MELVA2.VELCHE(N1,N2)=0.
  679. C MELVA3.VELCHE(N1,N2)=0.
  680. C MELVA4.VELCHE(N1,N2)=(EFFY/AIRY)
  681. C MELVA5.VELCHE(N1,N2)=(FLEXX/2*XPI*RAYO**2*EPAI)
  682. C MELVA6.VELCHE(N1,N2)=(EFFZ/AIRZ)
  683. C ELSE
  684. C CALL ERREUR(505)
  685. C SEGSUP MELVA1,MELVA2,MELVA2,MELVA3,MELVA4,MELVA5,MELVA6,MCHAML
  686. C GOTO 9990
  687. C ENDIF
  688. C 4011 CONTINUE
  689. C 4010 CONTINUE
  690. C
  691. C SEGDES MELVA1,MELVA2,MELVA2,MELVA3,MELVA4,MELVA5,MELVA6,MCHAML
  692. C GOTO 510
  693. C-----------------------------------------------------------
  694. C COQ4 +CONTRAINTE
  695. C-----------------------------------------------------------
  696. 5000 CONTINUE
  697. DO 5010 N2=1,NEL
  698. DO 5011 N1=1,NBPTEL
  699.  
  700. MPTVAL=IVASTR
  701.  
  702. MELVAL=IVAL(1)
  703. AN11=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  704.  
  705. MELVAL=IVAL(2)
  706. AN22=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  707.  
  708. MELVAL=IVAL(3)
  709. AN12=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  710.  
  711. MELVAL=IVAL(4)
  712. AM11=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  713.  
  714. MELVAL=IVAL(5)
  715. AM22=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  716.  
  717. MELVAL=IVAL(6)
  718. AM12=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  719.  
  720. MELVAL=IVAL(7)
  721. V1=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  722.  
  723. MELVAL=IVAL(8)
  724. V2=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  725.  
  726. MPTVAL=IVACAR
  727.  
  728. MELVAL=IVAL(1)
  729. EPAI=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  730.  
  731. IF (I_LOC.EQ.3) THEN
  732. r_z = EPAI*EPAI
  733. MELVA1.VELCHE(N1,N2)=AN11/EPAI-(6.*AM11/r_z)
  734. MELVA2.VELCHE(N1,N2)=AN22/EPAI-(6.*AM22/r_z)
  735. MELVA3.VELCHE(N1,N2)=0.
  736. MELVA4.VELCHE(N1,N2)=AN12/EPAI-(6.*AM12/r_z)
  737. MELVA5.VELCHE(N1,N2)=V1/EPAI
  738. MELVA6.VELCHE(N1,N2)=V2/EPAI
  739. ELSE IF (I_LOC.EQ.1) THEN
  740. r_z = EPAI*EPAI
  741. MELVA1.VELCHE(N1,N2)=AN11/EPAI+(6.*AM11/r_z)
  742. MELVA2.VELCHE(N1,N2)=AN22/EPAI+(6.*AM22/r_z)
  743. MELVA3.VELCHE(N1,N2)=0.
  744. MELVA4.VELCHE(N1,N2)=AN12/EPAI+(6.*AM12/r_z)
  745. MELVA5.VELCHE(N1,N2)=V1/EPAI
  746. MELVA6.VELCHE(N1,N2)=V2/EPAI
  747. ELSE IF (I_LOC.EQ.2) THEN
  748. r_z = EPAI*EPAI
  749. MELVA1.VELCHE(N1,N2)=AN11/EPAI
  750. MELVA2.VELCHE(N1,N2)=AN22/EPAI
  751. MELVA3.VELCHE(N1,N2)=0.
  752. MELVA4.VELCHE(N1,N2)=AN12/EPAI
  753. MELVA5.VELCHE(N1,N2)=V1/EPAI
  754. MELVA6.VELCHE(N1,N2)=V2/EPAI
  755. ENDIF
  756. 5011 CONTINUE
  757. 5010 CONTINUE
  758.  
  759. SEGDES MELVA1,MELVA2,MELVA2,MELVA3,MELVA4,MELVA5,MELVA6,MCHAML
  760.  
  761.  
  762. C-----------------------------------------------------------
  763. C DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE NS
  764. C-----------------------------------------------------------
  765. 510 CONTINUE
  766.  
  767. SEGDES IMODEL
  768. SEGDES,MINTE
  769.  
  770. IF (ISUP1.EQ.1) THEN
  771. CALL DTMVAL(IVASTR,3)
  772. ELSE
  773. CALL DTMVAL(IVASTR,1)
  774. ENDIF
  775.  
  776. IF (ISUP2.EQ.1) THEN
  777. CALL DTMVAL(IVACAR,3)
  778. ELSE
  779. CALL DTMVAL(IVACAR,1)
  780. ENDIF
  781.  
  782. NOMID=MOSTRS
  783. IF (MOSTRS.NE.0.and.lsupco)SEGSUP NOMID
  784. NOMID=MOCARA
  785. IF (MOCARA.NE.0) SEGSUP NOMID
  786. 1 CONTINUE
  787.  
  788. SEGDES MCHELM,MMODEL
  789. RETURN
  790. C-----------------------------------------------------------
  791. C DESACTIVATION ET RETOUR DANS LE CAS D'ERREUR
  792. C-----------------------------------------------------------
  793. 9990 CONTINUE
  794.  
  795. SEGDES,MINTE
  796. IF (ISUP1.EQ.1) THEN
  797. CALL DTMVAL(IVASTR,3)
  798. ELSE
  799. CALL DTMVAL(IVASTR,1)
  800. ENDIF
  801.  
  802. IF (ISUP2.EQ.1) THEN
  803. CALL DTMVAL(IVACAR,3)
  804. ELSE
  805. CALL DTMVAL(IVACAR,1)
  806. ENDIF
  807.  
  808. NOMID=MOCARA
  809. IF (MOCARA.NE.0) SEGSUP NOMID
  810. NOMID=MOSTRS
  811. IF (MOSTRS.NE.0.and.lsupco)SEGSUP NOMID
  812. SEGDES MMODEL,IMODEL
  813. SEGSUP MCHELM
  814.  
  815. RETURN
  816. END
  817.  
  818.  
  819.  
  820.  
  821.  
  822.  
  823.  
  824.  
  825.  
  826.  

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