Télécharger calp2.eso

Retour à la liste

Numérotation des lignes :

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

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