Télécharger calp2.eso

Retour à la liste

Numérotation des lignes :

  1. C CALP2 SOURCE BP208322 16/11/18 21:15:22 9177
  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. NBROBL=2
  252. NBRFAC=0
  253. SEGINI NOMID
  254. LESOBL(1)='DY '
  255. LESOBL(2)='DZ '
  256. *
  257. NBTYPE=1
  258. SEGINI NOTYPE
  259. TYPE(1)='REAL*8'
  260. *
  261. * CARACTERISTIQUES POUR LES TUYAUX
  262. *
  263. ELSE IF (MFR.EQ.13) THEN
  264. NBROBL=2
  265. NBRFAC=2
  266. SEGINI NOMID
  267. LESOBL(1)='EPAI'
  268. LESOBL(2)='RAYO'
  269. LESFAC(1)='RACO'
  270. LESFAC(2)='PRES'
  271. *
  272. NBTYPE=1
  273. SEGINI NOTYPE
  274. TYPE(1)='REAL*8'
  275. ENDIF
  276. *
  277. MOCARA=NOMID
  278. NCARA=NBROBL
  279. NCARF=NBRFAC
  280. NCARR=NCARA+NCARF
  281. IF (MOCARA.NE.0) THEN
  282. MOTYPE=NOTYPE
  283. CALL KOMCHA(IPTR2,IPMAIL,CONM,MOCARA,MOTYPE,1,INFOS,3,
  284. $ IVACAR)
  285. SEGSUP NOTYPE
  286. IF (IERR.NE.0) GOTO 9990
  287. *
  288. IF (ISUP2.EQ.1) THEN
  289. CALL VALCHE(IVACAR,NCARR,IPMING,IPPORE,MOCARA,MELE)
  290. ENDIF
  291. ENDIF
  292.  
  293. N2=6
  294. SEGINI MCHAML
  295. ICHAML(NS)=MCHAML
  296. NOMCHE(1)='EPXX'
  297. TYPCHE(1)='REAL*8'
  298. NOMCHE(2)='EPYY'
  299. TYPCHE(2)='REAL*8'
  300. NOMCHE(3)='EPZZ'
  301. TYPCHE(3)='REAL*8'
  302. NOMCHE(4)='RTXY'
  303. TYPCHE(4)='REAL*8'
  304. NOMCHE(5)='RTYZ'
  305. TYPCHE(5)='REAL*8'
  306. NOMCHE(6)='RTXZ'
  307. TYPCHE(6)='REAL*8'
  308. N2PTEL=0
  309. N2EL=0
  310.  
  311. *-----------------------------------------------------------
  312. * CHAQUE MELVAL = COMPOSANTE SELON SIGMA
  313. *
  314. SEGINI MELVA1,MELVA2,MELVA3,MELVA4,MELVA5,MELVA6
  315. IELVAL(1)=MELVA1
  316. IELVAL(2)=MELVA2
  317. IELVAL(3)=MELVA3
  318. IELVAL(4)=MELVA4
  319. IELVAL(5)=MELVA5
  320. IELVAL(6)=MELVA6
  321. *
  322. *--
  323. * BRANCHEMENT SELON ELEMENT FINI
  324. *--
  325. * COQ3,COQ2,DKT
  326. IF ((MELE.EQ.27).OR.(MELE.EQ.28).OR.(MELE.EQ.44)) GOTO 3000
  327. * POUTRE
  328. IF (MELE.EQ.29) GOTO 2000
  329. * COQ4 ,DST
  330. IF (MELE.EQ.49.OR.MELE.EQ.93) GOTO 5000
  331. *--
  332. * AUCUNE CREATION CAR NE SAIT PAS FAIRE POUR L'ELEMENT
  333. *--
  334. MOTERR(1:4) =NOMTP(MELE)
  335. MOTERR(5:12)='CALP '
  336. CALL ERREUR(86)
  337. SEGSUP MELVA1,MELVA2,MELVA2,MELVA3,MELVA4,MELVA5,MELVA6,MCHAML
  338. GOTO 9990
  339. *
  340. *-----------------------------------------------------------
  341. * POUTRE+DEFORMATION
  342. *-----------------------------------------------------------
  343. 2000 CONTINUE
  344. DO 2010 N2=1,NEL
  345. DO 2011 N1=1,NBPTEL
  346. *
  347. MPTVAL=IVADEF
  348. *
  349. MELVAL=IVAL(1)
  350. EPS=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  351. *
  352. MELVAL=IVAL(2)
  353. GXY=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  354. *
  355. MELVAL=IVAL(3)
  356. GXZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  357. *
  358. MELVAL=IVAL(4)
  359. CX=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  360. *
  361. MELVAL=IVAL(5)
  362. CY=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  363. *
  364. MELVAL=IVAL(6)
  365. CZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  366. *
  367. MPTVAL=IVACAR
  368. *
  369. MELVAL=IVAL(1)
  370. PY=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  371. MELVAL=IVAL(2)
  372. PZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  373. *
  374. * CALCUL DES CONTRAINTES REELLES
  375. MELVA1.VELCHE(N1,N2)=EPS-(PY*CZ)+(PZ*CY)
  376. MELVA2.VELCHE(N1,N2)=0.
  377. MELVA3.VELCHE(N1,N2)=0.
  378. MELVA4.VELCHE(N1,N2)=GXY
  379. MELVA5.VELCHE(N1,N2)=0.
  380. MELVA6.VELCHE(N1,N2)=GXZ
  381. 2011 CONTINUE
  382. 2010 CONTINUE
  383. *
  384. SEGDES MELVA1,MELVA2,MELVA2,MELVA3,MELVA4,MELVA5,MELVA6,MCHAML
  385. *
  386. GOTO 510
  387. *
  388. *-----------------------------------------------------------
  389. * COQ2,COQ3,DKT + DEFORMATIONS
  390. *-----------------------------------------------------------
  391. 3000 CONTINUE
  392. IF (IFOUR.EQ.2.OR.IFOUR.EQ.1) THEN
  393. DO 3010 N2=1,NEL
  394. DO 3011 N1=1,NBPTEL
  395. *
  396. MPTVAL=IVADEF
  397. *
  398. MELVAL=IVAL(1)
  399. EPSS=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  400. *
  401. MELVAL=IVAL(2)
  402. EPTT=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  403. *
  404. MELVAL=IVAL(3)
  405. GAST=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  406. *
  407. MELVAL=IVAL(4)
  408. RTSS=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  409. *
  410. MELVAL=IVAL(5)
  411. RTTT=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  412. *
  413. MELVAL=IVAL(6)
  414. RTST=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  415. *
  416. MPTVAL=IVACAR
  417. *
  418. MELVAL=IVAL(1)
  419. EPAI=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  420. *
  421. IF (I_LOC.EQ.3) THEN
  422. r_z = 0.5 * EPAI
  423. MELVA1.VELCHE(N1,N2)=EPSS-r_z*RTSS
  424. MELVA2.VELCHE(N1,N2)=EPTT-r_z*RTTT
  425. MELVA3.VELCHE(N1,N2)=0.
  426. MELVA4.VELCHE(N1,N2)=GAST-r_z*RTST
  427. MELVA5.VELCHE(N1,N2)=0.
  428. MELVA6.VELCHE(N1,N2)=0.
  429. ELSE IF (I_LOC.EQ.1) THEN
  430. r_z = 0.5 * EPAI
  431. MELVA1.VELCHE(N1,N2)=EPSS+r_z*RTSS
  432. MELVA2.VELCHE(N1,N2)=EPTT+r_z*RTTT
  433. MELVA3.VELCHE(N1,N2)=0.
  434. MELVA4.VELCHE(N1,N2)=GAST+r_z*RTST
  435. MELVA5.VELCHE(N1,N2)=0.
  436. MELVA6.VELCHE(N1,N2)=0.
  437. ELSE IF (I_LOC.EQ.2) THEN
  438. MELVA1.VELCHE(N1,N2)=EPSS
  439. MELVA2.VELCHE(N1,N2)=EPTT
  440. MELVA3.VELCHE(N1,N2)=0.
  441. MELVA4.VELCHE(N1,N2)=GAST
  442. MELVA5.VELCHE(N1,N2)=0.
  443. MELVA6.VELCHE(N1,N2)=0.
  444. ENDIF
  445. 3011 CONTINUE
  446. 3010 CONTINUE
  447. ENDIF
  448. *
  449. IF (IFOUR.EQ.0) THEN
  450. DO 3012 N2=1,NEL
  451. DO 3013 N1=1,NBPTEL
  452. *
  453. MPTVAL=IVADEF
  454. *
  455. MELVAL=IVAL(1)
  456. EPSS=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  457. *
  458. MELVAL=IVAL(2)
  459. EPTT=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  460. *
  461. MELVAL=IVAL(3)
  462. RTSS=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  463. *
  464. MELVAL=IVAL(4)
  465. RTTT=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  466. *
  467. MPTVAL=IVACAR
  468. *
  469. MELVAL=IVAL(1)
  470. EPAI=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  471. *
  472. IF (I_LOC.EQ.3) 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)=0.
  478. MELVA5.VELCHE(N1,N2)=0.
  479. MELVA6.VELCHE(N1,N2)=0.
  480. ELSE IF (I_LOC.EQ.1) THEN
  481. r_z = 0.5 * EPAI
  482. MELVA1.VELCHE(N1,N2)=EPSS+r_z*RTSS
  483. MELVA2.VELCHE(N1,N2)=EPTT+r_z*RTTT
  484. MELVA3.VELCHE(N1,N2)=0.
  485. MELVA4.VELCHE(N1,N2)=0.
  486. MELVA5.VELCHE(N1,N2)=0.
  487. MELVA6.VELCHE(N1,N2)=0.
  488. ELSE IF (I_LOC.EQ.2) THEN
  489. MELVA1.VELCHE(N1,N2)=EPSS
  490. MELVA2.VELCHE(N1,N2)=EPTT
  491. MELVA3.VELCHE(N1,N2)=0.
  492. MELVA4.VELCHE(N1,N2)=0.
  493. MELVA5.VELCHE(N1,N2)=0.
  494. MELVA6.VELCHE(N1,N2)=0.
  495. ENDIF
  496. 3013 CONTINUE
  497. 3012 CONTINUE
  498. ENDIF
  499. *
  500. IF (IFOUR.EQ.-1.OR.IFOUR.EQ.-2) THEN
  501. DO 3014 N2=1,NEL
  502. DO 3015 N1=1,NBPTEL
  503. *
  504. MPTVAL=IVADEF
  505. *
  506. MELVAL=IVAL(1)
  507. EPSS=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  508. *
  509. MELVAL=IVAL(2)
  510. EPZZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  511. *
  512. MELVAL=IVAL(3)
  513. RTSS=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  514. *
  515. MELVAL=IVAL(4)
  516. RTZZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  517. *
  518. MPTVAL=IVACAR
  519. *
  520. MELVAL=IVAL(1)
  521. EPAI=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  522. *
  523. IF (I_LOC.EQ.3) THEN
  524. r_z = 0.5 * EPAI
  525. MELVA1.VELCHE(N1,N2)=EPSS-r_z*RTSS
  526. MELVA2.VELCHE(N1,N2)=EPZZ-r_z*RTZZ
  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.1) THEN
  532. r_z = 0.5 * EPAI
  533. MELVA1.VELCHE(N1,N2)=EPSS+r_z*RTSS
  534. MELVA2.VELCHE(N1,N2)=EPZZ+r_z*RTZZ
  535. MELVA3.VELCHE(N1,N2)=0.
  536. MELVA4.VELCHE(N1,N2)=0.
  537. MELVA5.VELCHE(N1,N2)=0.
  538. MELVA6.VELCHE(N1,N2)=0.
  539. ELSE IF (I_LOC.EQ.2) THEN
  540. MELVA1.VELCHE(N1,N2)=EPSS
  541. MELVA2.VELCHE(N1,N2)=EPZZ
  542. MELVA3.VELCHE(N1,N2)=0.
  543. MELVA4.VELCHE(N1,N2)=0.
  544. MELVA5.VELCHE(N1,N2)=0.
  545. MELVA6.VELCHE(N1,N2)=0.
  546. ENDIF
  547. 3015 CONTINUE
  548. 3014 CONTINUE
  549. ENDIF
  550. IF (IFOUR.EQ.-3) THEN
  551. DO 3016 N2=1,NEL
  552. DO 3017 N1=1,NBPTEL
  553. *
  554. MPTVAL=IVADEF
  555. *
  556. MELVAL=IVAL(1)
  557. EPSS=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  558. *
  559. MELVAL=IVAL(2)
  560. EPZZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  561. *
  562. MELVAL=IVAL(3)
  563. RTSS=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  564. *
  565. MELVAL=IVAL(4)
  566. RTZZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  567. *
  568. MPTVAL=IVACAR
  569. *
  570. MELVAL=IVAL(1)
  571. EPAI=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  572. *
  573. IF (I_LOC.EQ.3) THEN
  574. r_z = 0.5 * EPAI
  575. MELVA1.VELCHE(N1,N2)=EPSS-r_z*RTSS
  576. MELVA2.VELCHE(N1,N2)=0.
  577. MELVA3.VELCHE(N1,N2)=EPZZ-r_z*RTZZ
  578. MELVA4.VELCHE(N1,N2)=0.
  579. MELVA5.VELCHE(N1,N2)=0.
  580. MELVA6.VELCHE(N1,N2)=0.
  581. ELSE IF (I_LOC.EQ.1) THEN
  582. r_z = 0.5 * EPAI
  583. MELVA1.VELCHE(N1,N2)=EPSS+r_z*RTSS
  584. MELVA2.VELCHE(N1,N2)=0.
  585. MELVA3.VELCHE(N1,N2)=EPZZ+r_z*RTZZ
  586. MELVA4.VELCHE(N1,N2)=0.
  587. MELVA5.VELCHE(N1,N2)=0.
  588. MELVA6.VELCHE(N1,N2)=0.
  589. ELSE IF (I_LOC.EQ.2) THEN
  590. MELVA1.VELCHE(N1,N2)=EPSS
  591. MELVA2.VELCHE(N1,N2)=0.
  592. MELVA3.VELCHE(N1,N2)=EPZZ
  593. MELVA4.VELCHE(N1,N2)=0.
  594. MELVA5.VELCHE(N1,N2)=0.
  595. MELVA6.VELCHE(N1,N2)=0.
  596. ENDIF
  597. 3017 CONTINUE
  598. 3016 CONTINUE
  599. ENDIF
  600. SEGDES MELVA1,MELVA2,MELVA2,MELVA3,MELVA4,MELVA5,MELVA6,MCHAML
  601. GOTO 510
  602. *-----------------------------------------------------------
  603. * COQ4,DST + DEFORMATIONS
  604. *-----------------------------------------------------------
  605. 5000 CONTINUE
  606. DO 5010 N2=1,NEL
  607. DO 5011 N1=1,NBPTEL
  608. *
  609. MPTVAL=IVADEF
  610.  
  611. MELVAL=IVAL(1)
  612. EPSS=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  613. *
  614. MELVAL=IVAL(2)
  615. EPTT=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  616. *
  617. MELVAL=IVAL(3)
  618. GAST=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  619. *
  620. MELVAL=IVAL(4)
  621. RTSS=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  622.  
  623. MELVAL=IVAL(5)
  624. RTTT=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  625. *
  626. MELVAL=IVAL(6)
  627. RTST=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  628. *
  629. MELVAL=IVAL(7)
  630. GASN=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  631. *
  632. MELVAL=IVAL(8)
  633. GATN=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  634. *
  635. MPTVAL=IVACAR
  636. *
  637. MELVAL=IVAL(1)
  638. EPAI=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
  639. *
  640. IF (I_LOC.EQ.3) THEN
  641. r_z = 0.5 * EPAI
  642. MELVA1.VELCHE(N1,N2)=EPSS-r_z*RTSS
  643. MELVA2.VELCHE(N1,N2)=EPTT-r_z*RTTT
  644. MELVA3.VELCHE(N1,N2)=0.
  645. MELVA4.VELCHE(N1,N2)=GAST-r_z*RTST
  646. MELVA5.VELCHE(N1,N2)=GATN
  647. MELVA6.VELCHE(N1,N2)=GASN
  648. ELSE IF (I_LOC.EQ.1) THEN
  649. r_z = 0.5 * EPAI
  650. MELVA1.VELCHE(N1,N2)=EPSS+r_z*RTSS
  651. MELVA2.VELCHE(N1,N2)=EPTT+r_z*RTTT
  652. MELVA3.VELCHE(N1,N2)=0.
  653. MELVA4.VELCHE(N1,N2)=GAST+r_z*RTST
  654. MELVA5.VELCHE(N1,N2)=GATN
  655. MELVA6.VELCHE(N1,N2)=GASN
  656. ELSE IF (I_LOC.EQ.2) THEN
  657. MELVA1.VELCHE(N1,N2)=EPSS
  658. MELVA2.VELCHE(N1,N2)=EPTT
  659. MELVA3.VELCHE(N1,N2)=0.
  660. MELVA4.VELCHE(N1,N2)=GAST
  661. MELVA5.VELCHE(N1,N2)=GATN
  662. MELVA6.VELCHE(N1,N2)=GASN
  663. ENDIF
  664.  
  665. 5011 CONTINUE
  666. 5010 CONTINUE
  667. *
  668. SEGDES MELVA1,MELVA2,MELVA2,MELVA3,MELVA4,MELVA5,MELVA6,MCHAML
  669. C_______________________________________________________________________
  670. C
  671. C DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE NS
  672. C_______________________________________________________________________
  673. C
  674. 510 CONTINUE
  675. C
  676. 9990 CONTINUE
  677. SEGDES IMODEL
  678. SEGDES,MINTE
  679. *
  680. IF (ISUP1.EQ.1) THEN
  681. CALL DTMVAL(IVADEF,3)
  682. ELSE
  683. CALL DTMVAL(IVADEF,1)
  684. ENDIF
  685. *
  686. IF (ISUP2.EQ.1) THEN
  687. CALL DTMVAL(IVACAR,3)
  688. ELSE
  689. CALL DTMVAL(IVACAR,1)
  690. ENDIF
  691. NOMID=MODEFO
  692. IF (lsupno.and.MODEFO.NE.0)SEGSUP NOMID
  693. NOMID=MOCARA
  694. IF (MOCARA.NE.0) SEGSUP NOMID
  695.  
  696. * EN CAS D'ERREUR
  697. IF (IERR.NE.0) THEN
  698. SEGSUP,MCHELM
  699. IPTR4 = 0
  700. GOTO 999
  701. ENDIF
  702.  
  703. 1 CONTINUE
  704. *
  705. SEGDES,MCHELM
  706. IPTR4 = MCHELM
  707.  
  708. 999 CONTINUE
  709. SEGDES,MMODEL
  710. *
  711. RETURN
  712. END
  713.  
  714.  
  715.  
  716.  
  717.  
  718.  
  719.  
  720.  
  721.  

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