Télécharger calp2.eso

Retour à la liste

Numérotation des lignes :

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

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