Télécharger grad2.eso

Retour à la liste

Numérotation des lignes :

  1. C GRAD2 SOURCE GG250959 17/09/20 21:15:33 9554
  2. SUBROUTINE GRAD2(IPMODL,IPCHA1,IPCHE1,IPGRAD,IRET)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. *____________________________________________________________________*
  6. * *
  7. * Sous-programme de l'operateur GRADIENT *
  8. * *
  9. * Entree: *
  10. * *
  11. * IPMODL Pointeur sur un objet MMODEL *
  12. * IPCHA1 Pointeur sur un MCHAML de DEPLACEMENT *
  13. * IPCHE1 Pointeur sur un MCHAML de CARACTERISTIQUES *
  14. * *
  15. * Sortie: *
  16. * *
  17. * IPGRAD Pointeur sur un MCHAML de gradients *
  18. * IRET 1 si succes , 0 sinon *
  19. * *
  20. *____________________________________________________________________*
  21. *
  22. -INC CCOPTIO
  23. -INC CCHAMP
  24. -INC CCGEOME
  25. -INC SMCHAML
  26. -INC SMMODEL
  27. -INC SMELEME
  28. -INC SMINTE
  29. -INC SMCOORD
  30. *
  31. SEGMENT INFO
  32. INTEGER INFELL(JG)
  33. ENDSEGMENT
  34. *
  35. SEGMENT NOTYPE
  36. CHARACTER*16 TYPE(NBTYPE)
  37. ENDSEGMENT
  38. *
  39. SEGMENT MPTVAL
  40. INTEGER IPOS(NS) ,NSOF(NS)
  41. INTEGER IVAL(NCOSOU)
  42. CHARACTER*16 TYVAL(NCOSOU)
  43. ENDSEGMENT
  44. *
  45. SEGMENT WRK1
  46. REAL*8 XDDL(LRN),GRAD(NSTB),AUX(NSTB),XE(3,NBBB)
  47. ENDSEGMENT
  48. *
  49. SEGMENT WRK2
  50. REAL*8 SHPWRK(6,NBNO),BGENE(NSTB,LRE)
  51. ENDSEGMENT
  52. *
  53. SEGMENT WRK3
  54. REAL*8 XGENE(NSTN,LRN)
  55. ENDSEGMENT
  56. *
  57. SEGMENT WRK4
  58. REAL*8 XLOC(3,3),XGLOB(3,3),TXR(IDIM,IDIM)
  59. REAL*8 VALMAT(NMATT)
  60. REAL*8 PMAT(NSTB,NSTB),PMAT1(IDIM,IDIM),PMAT2(IDIM,IDIM)
  61. ENDSEGMENT
  62. *
  63. SEGMENT WRK5
  64. REAL*8 BPSS(3,3),XEL(3,NBBB)
  65. REAL*8 XNTH(LRN,LRN),XNTB(LRN,LRN),XNTT(LRN)
  66. ENDSEGMENT
  67. *
  68. SEGMENT WRK6
  69. REAL*8 PKK(NSTB,NSTB)
  70. ENDSEGMENT
  71. *
  72. CHARACTER*8 CMATE
  73. CHARACTER*(NCONCH) CONM
  74. PARAMETER ( NINF=3 )
  75. INTEGER INFOS(NINF)
  76. *
  77. IRET = 0
  78. IPGRAD = 0
  79.  
  80. NHRM=NIFOUR
  81. MCHAML=0
  82. C
  83. C VERIFICATION DU LIEU SUPPORT DU MCHAML DE MATERIAU
  84. C
  85. ISUP=0
  86. CALL QUESUP(IPMODL,IPCHE1,3,0,ISUP,IRETMA)
  87. IF (ISUP.GT.1) RETURN
  88. C
  89. C ACTIVATION DU MODELE
  90. C
  91. MMODEL=IPMODL
  92. SEGACT MMODEL
  93. NSOUS=KMODEL(/1)
  94. C
  95. KEL22 = 0
  96. DO ISOUS = 1,NSOUS
  97. IMODEL=KMODEL(ISOUS)
  98. SEGACT IMODEL
  99. IF (FORMOD(1).NE.'POREUX') THEN
  100. CALL ERREUR(19)
  101. GOTO 888
  102. ENDIF
  103. IF ((NEFMOD.EQ.22).OR.(NEFMOD.EQ.259)) KEL22 = KEL22 + 1
  104. IF (FORMOD(1).EQ.'CHARGEMENT') KEL22 = KEL22 + 1
  105. ENDDO
  106. C
  107. C INITIALISATION DU MCHAML RESULTAT
  108. C
  109. N1=NSOUS-KEL22
  110. N3=6
  111. L1=11
  112. SEGINI MCHELM
  113. TITCHE='GRADIENT'
  114. IFOCHE=IFOUR
  115. IPGRAD=MCHELM
  116. C____________________________________________________________________
  117. C
  118. C DEBUT DE LA BOUCLE SUR LES DIFFERENTES ZONES
  119. C____________________________________________________________________
  120. C
  121. isouss=0
  122. DO 500 ISOUS=1,NSOUS
  123. *
  124. * INITIALISATION
  125. *
  126. IVAMAT=0
  127. IVAGRA=0
  128. IVADEP=0
  129. IVACAR=0
  130. NMATR=0
  131. NMATF=0
  132. NGRAD=0
  133. NDEP=0
  134. MOMATR=0
  135. MOGRAD=0
  136. MODEPL=0
  137. C
  138. C ON RECUPERE L INFORMATION GENERALE
  139. C
  140. IMODEL=KMODEL(ISOUS)
  141. SEGACT IMODEL
  142. C
  143. C TRAITEMENT DU MODELE
  144. C
  145. MELE=NEFMOD
  146. if ((MELE.EQ.22).OR.(MELE.EQ.259)) go to 500
  147. IF (FORMOD(1).EQ.'CHARGEMENT') GO TO 500
  148. C
  149. isouss=isouss+1
  150. MELEME=IMAMOD
  151. IPMAIL=IMAMOD
  152. CONM =CONMOD
  153. IMACHE(ISOUSs)=IPMAIL
  154. CONCHE(ISOUSs)=CONMOD
  155. C
  156. C NATURE DU MATERIAU
  157. C
  158. * NFOR=FORMOD(/2)
  159. * NMAT=MATMOD(/2)
  160. * CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,MATE,INAT)
  161. CMATE = CMATEE
  162. MATE = IMATEE
  163. MAPL = INATUU
  164. IF (CMATE.EQ.' ')THEN
  165. CALL ERREUR(251)
  166. SEGSUP MCHELM
  167. GOTO 888
  168. ENDIF
  169. C____________________________________________________________________
  170. C
  171. C INFORMATION SUR L'ELEMENT FINI
  172. C____________________________________________________________________
  173. C
  174. if(infmod(/1).lt.5) then
  175. CALL ELQUOI(MELE,0,3,IPINF,IMODEL)
  176. IF (IERR.NE.0) THEN
  177. SEGSUP MCHELM
  178. GOTO 888
  179. ENDIF
  180. INFO=IPINF
  181. MFR =INFELL(13)
  182. IELE =INFELL(14)
  183. IPORE=INFELL(8)
  184. MINTE=INFELL(11)
  185. segsup info
  186. else
  187. MFR =INFELE(13)
  188. IELE =INFELE(14)
  189. IPORE=INFELE(8)
  190. MINTE=INFMOD(5)
  191. endif
  192. IPMINT=MINTE
  193. C
  194. C CREATION DU TABLEAU INFOS
  195. C
  196. CALL IDENT(IPMAIL,CONM,IPCHA1,IPCHE1,INFOS,IRTD)
  197. IF (IRTD.EQ.0) GOTO 9990
  198. C
  199. INFCHE(ISOUSs,1)=0
  200. INFCHE(ISOUSs,2)=0
  201. INFCHE(ISOUSs,3)=NHRM
  202. INFCHE(ISOUSs,4)=MINTE
  203. INFCHE(ISOUSs,5)=0
  204. INFCHE(ISOUSs,6)=3
  205. C
  206. C ACTIVATIONS
  207. C
  208. SEGACT MINTE
  209. NBPGAU=POIGAU(/1)
  210.  
  211. SEGACT MELEME
  212. NBNN =NUM(/1)
  213. NBELEM=NUM(/2)
  214.  
  215. C____________________________________________________________________
  216. C
  217. C RECHERCHE DES COMPOSANTES DE DEPLACEMENTS
  218. C____________________________________________________________________
  219. C
  220. NBROBL=0
  221. NBRFAC=0
  222. IPPORE=0
  223. *
  224. IF(MFR.EQ.33) THEN
  225. IPPORE=NBNN
  226. NBROBL=1
  227. SEGINI NOMID
  228. LESOBL(1)='P '
  229. ELSE IF(MFR.EQ.57) THEN
  230. IPPORE=NBNN
  231. NBROBL=2
  232. SEGINI NOMID
  233. LESOBL(1)='P '
  234. LESOBL(2)='PQ '
  235. ELSE IF(MFR.EQ.59) THEN
  236. IPPORE=NBNN
  237. NBROBL=3
  238. SEGINI NOMID
  239. LESOBL(1)='P '
  240. LESOBL(2)='PQ '
  241. LESOBL(3)='TP '
  242. ENDIF
  243. IDECAP=NBROBL
  244.  
  245. NDEP=NBROBL
  246. MODEPL = NOMID
  247. C
  248. NBTYPE=1
  249. SEGINI NOTYPE
  250. MOTYPE=NOTYPE
  251. TYPE(1)='REAL*8'
  252. CALL KOMCHA(IPCHA1,IPMAIL,CONM,MODEPL,MOTYPE,1,INFOS,3,IVADEP)
  253. SEGSUP NOTYPE
  254. IF (IERR.NE.0) GOTO 9990
  255.  
  256. C____________________________________________________________________
  257. C
  258. C RECHERCHE DES COMPOSANTES DE MATERIAU
  259. C____________________________________________________________________
  260. C
  261. NBROBL=0
  262. NBRFAC=0
  263. * cas isotrope
  264. IF (MATE.EQ.1) THEN
  265. *
  266. IF (MELE.GE.79.AND.MELE.LE.83) THEN
  267. NBROBL=2
  268. SEGINI NOMID
  269. LESOBL(1)='PERM'
  270. LESOBL(2)='VISC'
  271. ELSE IF (MELE.GE.108.AND.MELE.LE.110) THEN
  272. NBROBL=4
  273. SEGINI NOMID
  274. LESOBL(1)='PERH'
  275. LESOBL(2)='PERB'
  276. LESOBL(3)='PERT'
  277. LESOBL(4)='VISC'
  278. ELSE IF (MELE.GE.173.AND.MELE.LE.177) THEN
  279. NBROBL=4
  280. SEGINI NOMID
  281. LESOBL(1)='PK11'
  282. LESOBL(2)='PK12'
  283. LESOBL(3)='PK21'
  284. LESOBL(4)='PK22'
  285. ELSE IF (MELE.GE.178.AND.MELE.LE.182) THEN
  286. NBROBL=9
  287. SEGINI NOMID
  288. LESOBL(1)='PK11'
  289. LESOBL(2)='PK12'
  290. LESOBL(3)='PK13'
  291. LESOBL(4)='PK21'
  292. LESOBL(5)='PK22'
  293. LESOBL(6)='PK23'
  294. LESOBL(7)='PK31'
  295. LESOBL(8)='PK32'
  296. LESOBL(9)='PK33'
  297. ELSE IF (MELE.GE.185.AND.MELE.LE.187) THEN
  298. NBROBL=12
  299. SEGINI NOMID
  300. LESOBL(1)='PH11'
  301. LESOBL(2)='PB11'
  302. LESOBL(3)='PT11'
  303. LESOBL(4)='PH12'
  304. LESOBL(5)='PB12'
  305. LESOBL(6)='PT12'
  306. LESOBL(7)='PH21'
  307. LESOBL(8)='PB21'
  308. LESOBL(9)='PT21'
  309. LESOBL(10)='PH22'
  310. LESOBL(11)='PB22'
  311. LESOBL(12)='PT22'
  312. ELSE IF (MELE.GE.188.AND.MELE.LE.190) THEN
  313. NBROBL=27
  314. SEGINI NOMID
  315. LESOBL(1)='PH11'
  316. LESOBL(2)='PB11'
  317. LESOBL(3)='PT11'
  318. LESOBL(4)='PH12'
  319. LESOBL(5)='PB12'
  320. LESOBL(6)='PT12'
  321. LESOBL(7)='PH13'
  322. LESOBL(8)='PB13'
  323. LESOBL(9)='PT13'
  324. LESOBL(10)='PH21'
  325. LESOBL(11)='PB21'
  326. LESOBL(12)='PT21'
  327. LESOBL(13)='PH22'
  328. LESOBL(14)='PB22'
  329. LESOBL(15)='PT22'
  330. LESOBL(16)='PH23'
  331. LESOBL(17)='PB23'
  332. LESOBL(18)='PT23'
  333. LESOBL(19)='PH31'
  334. LESOBL(20)='PB31'
  335. LESOBL(21)='PT31'
  336. LESOBL(22)='PH32'
  337. LESOBL(23)='PB32'
  338. LESOBL(24)='PT32'
  339. LESOBL(25)='PH33'
  340. LESOBL(26)='PB33'
  341. LESOBL(27)='PT33'
  342. ENDIF
  343. * cas orthotrope
  344. ELSE IF (MATE.EQ.2) THEN
  345. IF (IDIM.EQ.3) THEN
  346. NBROBL=10
  347. SEGINI NOMID
  348. LESOBL(1)='PER1'
  349. LESOBL(2)='PER2'
  350. LESOBL(3)='PER3'
  351. LESOBL(4)='VISC'
  352. LESOBL(5)='V1X '
  353. LESOBL(6)='V1Y '
  354. LESOBL(7)='V1Z '
  355. LESOBL(8)='V2X '
  356. LESOBL(9)='V2Y '
  357. LESOBL(10)='V2Z '
  358. ELSE IF(IDIM.EQ.2) THEN
  359. IF (IFOUR.LE.0) THEN
  360. NBROBL=5
  361. SEGINI NOMID
  362. LESOBL(1)='PER1'
  363. LESOBL(2)='PER2'
  364. LESOBL(3)='VISC'
  365. LESOBL(4)='V1X '
  366. LESOBL(5)='V1Y '
  367. ELSE IF (IFOUR.EQ.1) THEN
  368. NBROBL=6
  369. SEGINI NOMID
  370. LESOBL(1)='PER1'
  371. LESOBL(2)='PER2'
  372. LESOBL(3)='PER3'
  373. LESOBL(4)='VISC'
  374. LESOBL(5)='V1X '
  375. LESOBL(6)='V1Y '
  376. ENDIF
  377. ENDIF
  378. * cas anisotrope
  379. ELSE IF (MATE.EQ.3)THEN
  380. IF(IDIM.EQ.3)THEN
  381. NBROBL=13
  382. SEGINI NOMID
  383. LESOBL(1)='PER1'
  384. LESOBL(2)='PER2'
  385. LESOBL(3)='PER3'
  386. LESOBL(4)='PE12'
  387. LESOBL(5)='PE13'
  388. LESOBL(6)='PE23'
  389. LESOBL(7)='VISC'
  390. LESOBL(8)='V1X '
  391. LESOBL(9)='V1Y '
  392. LESOBL(10)='V1Z '
  393. LESOBL(11)='V2X '
  394. LESOBL(12)='V2Y '
  395. LESOBL(13)='V2Z '
  396. ELSE IF (IDIM.EQ.2) THEN
  397. IF (IFOUR.LE.0) THEN
  398. NBROBL=6
  399. SEGINI NOMID
  400. LESOBL(1)='PER1'
  401. LESOBL(2)='PER2'
  402. LESOBL(3)='PE12'
  403. LESOBL(4)='VISC'
  404. LESOBL(5)='V1X '
  405. LESOBL(6)='V1Y '
  406. ELSE IF (IFOUR.EQ.1) THEN
  407. NBROBL=7
  408. SEGINI NOMID
  409. LESOBL(1)='PER1'
  410. LESOBL(2)='PER2'
  411. LESOBL(3)='PE12'
  412. LESOBL(4)='PER3'
  413. LESOBL(5)='VISC'
  414. LESOBL(6)='V1X '
  415. LESOBL(7)='V1Y '
  416. ENDIF
  417. ENDIF
  418. * cas unidirectionnel
  419. ELSE IF (MATE.EQ.4) THEN
  420. IF (IDIM.EQ.3) THEN
  421. NBROBL=8
  422. SEGINI NOMID
  423. LESOBL(1)='PERM'
  424. LESOBL(2)='VISC'
  425. LESOBL(3)='V1X '
  426. LESOBL(4)='V1Y '
  427. LESOBL(5)='V1Z '
  428. LESOBL(6)='V2X '
  429. LESOBL(7)='V2Y '
  430. LESOBL(8)='V2Z '
  431. ELSE
  432. NBROBL=4
  433. SEGINI NOMID
  434. LESOBL(1)='PERM'
  435. LESOBL(2)='VISC'
  436. LESOBL(3)='V1X '
  437. LESOBL(4)='V1Y '
  438. ENDIF
  439. ENDIF
  440. *
  441. NMATR=NBROBL
  442. NMATF=NBRFAC
  443. NMATT = NMATR+NMATF
  444. MOMATR=NOMID
  445. *
  446. NBTYPE=1
  447. SEGINI NOTYPE
  448. MOTYPE=NOTYPE
  449. TYPE(1)='REAL*8'
  450. CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAMAT)
  451. SEGSUP NOTYPE
  452. IF (IERR.NE.0) GOTO 9990
  453. IF (ISUP.EQ.1) THEN
  454. CALL VALCHE(IVAMAT,NMATR,IPMINT,IPPORE,MOMATR,MELE)
  455. ENDIF
  456. *
  457. *_______________________________________________________________________
  458. *
  459. * COMPOSANTES EN SORTIE
  460. *_______________________________________________________________________
  461. *
  462. * CAS JOINTS
  463. *
  464. IF((MELE.GE.108.AND.MELE.LE.110).OR.
  465. . (MELE.GE.185.AND.MELE.LE.190)) THEN
  466.  
  467. IF(IFOUR.LE.0) THEN
  468. * CAS PLAN
  469. NCOVEC=3
  470. ELSE IF (IFOUR.EQ.2) THEN
  471. * 3D
  472. NCOVEC=4
  473. ENDIF
  474. ELSE
  475.  
  476. IF(IFOUR.LE.0) THEN
  477. * CONTRAINTES PLANES - DEFORMATIONS PLANES
  478. * DEFO PLAN GENE
  479. * AXISYMETRIQUE
  480. NCOVEC=2
  481.  
  482. ELSE IF (IFOUR.GT.0) THEN
  483. * FOURIER
  484. * 3D
  485. NCOVEC=3
  486. ENDIF
  487.  
  488. ENDIF
  489. *
  490. NBROBL=NCOVEC*IDECAP
  491. NBRFAC=0
  492. NGRAD=NBROBL
  493. SEGINI NOMID
  494. MOGRAD=NOMID
  495.  
  496. IF((MELE.GE.108.AND.MELE.LE.110).OR.
  497. . (MELE.GE.185.AND.MELE.LE.190)) THEN
  498.  
  499. DO 121 IPR=1,IDECAP
  500. IPRDEC = (IPR-1)*NCOVEC
  501. IF(IPR.EQ.1) THEN
  502. LESOBL(IPRDEC+1)='VCPH'
  503. LESOBL(IPRDEC+2)='VCPB'
  504. LESOBL(IPRDEC+3)='VCP1'
  505. IF(NCOVEC.EQ.4) LESOBL(IPRDEC+4)='VCP2'
  506. ELSE IF(IPR.EQ.2) THEN
  507. LESOBL(IPRDEC+1)='VCQH'
  508. LESOBL(IPRDEC+2)='VCQB'
  509. LESOBL(IPRDEC+3)='VCQ1'
  510. IF(NCOVEC.EQ.4) LESOBL(IPRDEC+4)='VCQ2'
  511. ELSE IF(IPR.EQ.3) THEN
  512. LESOBL(IPRDEC+1)='VCTH'
  513. LESOBL(IPRDEC+2)='VCTB'
  514. LESOBL(IPRDEC+3)='VCT1'
  515. IF(NCOVEC.EQ.4) LESOBL(IPRDEC+4)='VCT2'
  516. ENDIF
  517. 121 CONTINUE
  518.  
  519. ELSE
  520. DO 120 IPR=1,IDECAP
  521. IPRDEC = (IPR-1)*NCOVEC
  522. IF(IPR.EQ.1) THEN
  523. LESOBL(IPRDEC+1)='VCP1'
  524. LESOBL(IPRDEC+2)='VCP2'
  525. IF(NCOVEC.EQ.3) LESOBL(IPRDEC+3)='VCP3'
  526. ELSE IF(IPR.EQ.2) THEN
  527. LESOBL(IPRDEC+1)='VCQ1'
  528. LESOBL(IPRDEC+2)='VCQ2'
  529. IF(NCOVEC.EQ.3) LESOBL(IPRDEC+3)='VCQ3'
  530. ELSE IF(IPR.EQ.3) THEN
  531. LESOBL(IPRDEC+1)='VCT1'
  532. LESOBL(IPRDEC+2)='VCT2'
  533. IF(NCOVEC.EQ.3) LESOBL(IPRDEC+3)='VCT3'
  534. ENDIF
  535. 120 CONTINUE
  536.  
  537. ENDIF
  538. *
  539. * SEGDES NOMID
  540. *_______________________________________________________________________
  541. *
  542. * CREATION DU MCHAML DE LA SOUS ZONE
  543. *_______________________________________________________________________
  544. *
  545. N1PTEL=NBPGAU
  546. N1EL=NBELEM
  547. NBPTEL=N1PTEL
  548. NEL=N1EL
  549. N2=NGRAD
  550. *
  551. SEGINI MCHAML
  552. ICHAML(ISOUSs)=MCHAML
  553. NS=1
  554. NCOSOU=NGRAD
  555. SEGINI MPTVAL
  556. IVAGRA=MPTVAL
  557. NOMID=MOGRAD
  558. SEGACT NOMID
  559. DO 100 ICOMP=1,NGRAD
  560. NOMCHE(ICOMP)=LESOBL(ICOMP)
  561. TYPCHE(ICOMP)='REAL*8'
  562. N2PTEL=0
  563. N2EL=0
  564. SEGINI MELVAL
  565. IELVAL(ICOMP)=MELVAL
  566. IVAL(ICOMP)=MELVAL
  567. 100 CONTINUE
  568. *
  569. IF(MELE.GE.79.AND.MELE.LE.83) GO TO 79
  570. IF(MELE.GE.173.AND.MELE.LE.182) GO TO 79
  571. IF(MELE.GE.108.AND.MELE.LE.110) GO TO 80
  572. IF(MELE.GE.185.AND.MELE.LE.190) GO TO 80
  573. *
  574. GOTO 99
  575. *
  576. C_______________________________________________________________________
  577. C
  578. C MILIEUX POREUX
  579. C_______________________________________________________________________
  580. C
  581. 79 CONTINUE
  582. C
  583. C POUR CES ELEMENTS NBBB = NOMBRE DE NOEUDS
  584. C NBNO = NOMBRE DE FONCTIONS DE FORME
  585. C
  586. DIM3=1.D0
  587. NBNO=IPORE
  588. NBBB=NBNN
  589.  
  590. LPP=NBNO-NBBB
  591. LRN =IDECAP*LPP
  592. LRE=NBNN*IDECAP
  593. NSTBE=2
  594. IF(IFOUR.GT.0) NSTBE=3
  595. NSTB=NSTBE*IDECAP
  596. NSTN=1
  597.  
  598. * CAS NON ISOTROPES
  599. * RECUPERATION DES FONCTIONS DE FORME ET LEURS DERIVEES
  600. * AU CENTRE DE L'ELEMENT POUR LE CALCUL DES AXES LOCAUX
  601. *
  602. IF(MATE.EQ.2.OR.MATE.EQ.3.OR.MATE.EQ.4) THEN
  603. CALL RESHPT(1,NBNO,IELE,MELE,0,IPMIN2,IRT1)
  604. MINTE2=IPMIN2
  605. SEGACT MINTE2
  606. SEGINI WRK4
  607. ENDIF
  608. *
  609. SEGINI WRK1,WRK2,WRK3,WRK6
  610. I195=0
  611. I259=0
  612. I367=0
  613. C
  614. DO 3079 IB=1,NBELEM
  615. C
  616. C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  617. C
  618. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  619. C
  620. C ON RECUPERE LES DEPLACEMENTS
  621. C
  622. MPTVAL=IVADEP
  623. NCOSOU=IVAL(/1)
  624. IE=1
  625. DO 8079 I=1,NCOSOU
  626. MELVAL=IVAL(I)
  627. DO 8079 IGAU=1,LPP
  628. IGAUSO=IBSOM(NSPOS(IELE)+IGAU-1)
  629. IGMN=MIN(IGAUSO,VELCHE(/1))
  630. IBMN=MIN(IB ,VELCHE(/2))
  631. XDDL(IE)=VELCHE(IGMN,IBMN)
  632. IE=IE+1
  633. 8079 CONTINUE
  634.  
  635. * WRITE(6,44551) (XDDL(I),I=1,LRN)
  636. *44551 FORMAT(2X,'XDDL'/(4(1X,1PE12.5)/))
  637. *
  638. * CALCUL DES AXES LOCAUX DANS LES CAS NON ISOTROPES
  639. *
  640. IF(MATE.EQ.2.OR.MATE.EQ.3.OR.MATE.EQ.4) THEN
  641. NBSH=MINTE2.SHPTOT(/2)
  642. CALL RLOCAL (XE,MINTE2.SHPTOT,NBSH,NBNN,TXR)
  643. IF (NBSH.EQ.-1) THEN
  644. CALL ERREUR(525)
  645. RETURN
  646. ENDIF
  647. ENDIF
  648.  
  649. C
  650. C BOUCLE SUR LES POINTS DE GAUSS
  651. C
  652. ISDJC=0
  653.  
  654. DO 5079 IGAU=1,NBPGAU
  655. C
  656. C RECUPERATION DE L'EPAISSEUR
  657. C
  658. IF (IFOUR.EQ.-2)THEN
  659. MPTVAL=IVACAR
  660. IF (IVACAR.NE.0) THEN
  661. MELVAL=IVAL(1)
  662. IF (MELVAL.NE.0) THEN
  663. IGMN=MIN(IGAU,VELCHE(/1))
  664. IBMN=MIN(IB,VELCHE(/2))
  665. DIM3=VELCHE(IGMN,IBMN)
  666. ELSE
  667. DIM3=1.D0
  668. ENDIF
  669. ENDIF
  670. ENDIF
  671. C
  672. LHOO=NSTB
  673. CALL BNQORE(IGAU,NBNO,NBNN,LRE,IFOUR,NSTB,NSTN,NHRM,DIM3,
  674. . XE,SHPTOT,SHPWRK,BGENE,XGENE,DJAC,IDECAP,LHOO,2)
  675.  
  676. * IF(IGAU.EQ.1) THEN
  677. * PRINT *,' MATRICE B LIGNE PAR LIGNE '
  678. * DO 3367 IPZ = 1,NSTB
  679. * PRINT *,' LIGNE ',IPZ
  680. * WRITE(6,3368) (BGENE(IPZ,JPZ), JPZ=1,LRE)
  681. *3368 FORMAT(8(1X,1PE10.3)/)
  682. *3367 CONTINUE
  683. * ENDIF
  684.  
  685. IF(DJAC.LT.0.D0) ISDJC=ISDJC+1
  686. IF(DJAC.EQ.0.D0) I259=IB
  687. C
  688. C ON RECUPERE LE MATERIAU
  689. C
  690. EREF=1.D0
  691. MPTVAL=IVAMAT
  692. CALL ZERO (PKK,NSTB,NSTB)
  693. *
  694. * le cas isotrope
  695. *
  696. IF (MATE.EQ.1) THEN
  697.  
  698. IF(MFR.EQ.33) THEN
  699.  
  700. MELVAL=IVAL(1)
  701. IGMN=MIN(IGAU,VELCHE(/1))
  702. IBMN=MIN(IB ,VELCHE(/2))
  703. XK =VELCHE(IGMN,IBMN)
  704. *
  705. MELVAL=IVAL(2)
  706. IGMN=MIN(IGAU,VELCHE(/1))
  707. IBMN=MIN(IB ,VELCHE(/2))
  708. XMU =VELCHE(IGMN,IBMN)
  709. IF(XMU.EQ.0.D0) THEN
  710. I367=IB
  711. GO TO 5079
  712. ENDIF
  713. COMJAC=EREF*EREF*XK/XMU
  714. DO 1729 I=1,NSTB
  715. PKK(I,I)=COMJAC
  716. 1729 CONTINUE
  717.  
  718. ELSE IF (MFR.EQ.57.OR.MFR.EQ.59) THEN
  719.  
  720. ICO=1
  721. IDECA2=IDECAP*IDECAP
  722. DO 1731 ICD = 1,IDECAP
  723. ICDA =(ICD -1) * NSTBE
  724. DO 1732 JCD = 1,IDECAP
  725. JCDA =(JCD -1) * NSTBE
  726. MELVAL=IVAL(ICO)
  727. IGMN=MIN(IGAU,VELCHE(/1))
  728. IBMN=MIN(IB ,VELCHE(/2))
  729. DO 1733 KCD = 1,NSTBE
  730. PKK(ICDA+KCD,JCDA+KCD) =VELCHE(IGMN,IBMN)
  731. 1733 CONTINUE
  732. ICO=ICO+1
  733. 1732 CONTINUE
  734. 1731 CONTINUE
  735. ENDIF
  736. *
  737. * IF(IGAU . EQ . 1 ) THEN
  738. * PRINT *,' MATRICE PKK'
  739. *
  740. * IF (IDECAP.EQ.1) THEN
  741. * WRITE (6,1341) ((PKK(I,J),J=1,NSTB),I=1,NSTB)
  742. *1341 FORMAT(2(1X,1PE12.5)/)
  743. *
  744. * ELSE IF (IDECAP.EQ.2) THEN
  745. * WRITE (6,1342) ((PKK(I,J),J=1,NSTB),I=1,NSTB)
  746. *1342 FORMAT(4(1X,1PE12.5)/)
  747. *
  748. * ELSE IF (IDECAP.EQ.3) THEN
  749. * WRITE (6,1343) ((PKK(I,J),J=1,NSTB),I=1,NSTB)
  750. *1343 FORMAT(6(1X,1PE12.5)/)
  751. * ENDIF
  752. * ENDIF
  753. *
  754. * les cas non isotropes
  755. *
  756. ELSE IF(MATE.EQ.2.OR.MATE.EQ.3.OR.MATE.EQ.4) THEN
  757. *
  758. IF(MFR.EQ.33) THEN
  759.  
  760. DO 4379 IM=1,NMATT
  761. IF (IVAL(IM).NE.0) THEN
  762. MELVAL=IVAL(IM)
  763. IBMN=MIN(IB ,VELCHE(/2))
  764. IGMN=MIN(IGAU,VELCHE(/1))
  765. VALMAT(IM)=VELCHE(IGMN,IBMN)
  766. ELSE
  767. VALMAT(IM)=0.D0
  768. ENDIF
  769. 4379 CONTINUE
  770. *
  771. CALL PERMAO(WRK4,IFOUR,MATE,EREF,KERRE)
  772. IF(KERRE.EQ.1) GO TO 99
  773. IF(KERRE.EQ.2) THEN
  774. I367=IB
  775. GO TO 5079
  776. ENDIF
  777. *
  778. * REMPLISSAGE POUR CAS MFR=33 UNIQUEMENT
  779. *
  780. DO 4479 I=1,NSTBE
  781. DO 4479 J=1,NSTBE
  782. PKK(I,J)=PMAT(I,J)
  783. 4479 CONTINUE
  784.  
  785. * IF(IGAU . EQ . 1 ) THEN
  786. *
  787. * PRINT *,' MATRICE PKK'
  788. * IF(NSTBE.EQ.3) THEN
  789. * WRITE (6,1441) ((PKK(I,J),J=1,NSTB),I=1,NSTB)
  790. *1441 FORMAT(3(1X,1PE12.5)/)
  791. * ELSE
  792. * WRITE (6,1341) ((PKK(I,J),J=1,NSTB),I=1,NSTB)
  793. * ENDIF
  794. * ENDIF
  795. *
  796. ELSE IF (MFR.EQ.57.OR.MFR.EQ.59) THEN
  797. *
  798. * CAS NON PREVU
  799. GO TO 99
  800. ENDIF
  801. *
  802. * les cas non pr\E9vus
  803. *
  804. ELSE
  805. GO TO 99
  806. ENDIF
  807. *
  808. * CALCUL DES GRADIENTS
  809. *
  810. DO 9179 IPR=1,IDECAP
  811. LPPDEC=(IPR-1)*LPP
  812. NSTDEC=(IPR-1)*NSTBE
  813. NBBDEC=(IPR-1)*NBBB
  814. DO 9079 I=1,NSTBE
  815. AUX(I+NSTDEC)=0.D0
  816. DO 9079 J=1,LPP
  817. AUX(I+NSTDEC)= AUX(I+NSTDEC) +
  818. . BGENE(I+NSTDEC,J+NBBDEC)*XDDL(J+LPPDEC)
  819. 9079 CONTINUE
  820. 9179 CONTINUE
  821.  
  822. * IF(IGAU.EQ.1) THEN
  823. * WRITE(6,44552) (AUX (I),I=1,NSTB)
  824. *44552 FORMAT(2X,'AUX '/(4(1X,1PE12.5)/))
  825. * ENDIF
  826. *
  827. DO 9279 I=1,NSTB
  828. GRAD(I)=0.D0
  829. DO 9279 J=1,NSTB
  830. GRAD(I)=GRAD(I)+PKK(I,J)*AUX(J)
  831. 9279 CONTINUE
  832.  
  833. * IF(IGAU.EQ.1) THEN
  834. * WRITE(6,44553) (GRAD (I),I=1,NSTB)
  835. *44553 FORMAT(2X,'GRAD '/(4(1X,1PE12.5)/))
  836. * ENDIF
  837. C
  838. C REMPLISSAGE DU SEGMENT CONTENANT LES GRADIENTS
  839. C
  840. MPTVAL=IVAGRA
  841. DO 4179 I=1,NSTB
  842. MELVAL=IVAL(I)
  843. VELCHE(IGAU,IB)=GRAD(I)
  844. 4179 CONTINUE
  845.  
  846. 5079 CONTINUE
  847. *
  848. IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) I195=IB
  849. C
  850. 3079 CONTINUE
  851.  
  852. SEGSUP WRK1,WRK2,WRK3
  853. IF(MATE.EQ.2.OR.MATE.EQ.3.OR.MATE.EQ.4) THEN
  854. SEGDES MINTE2
  855. SEGSUP WRK4
  856. ENDIF
  857. *
  858. IF(I195.NE.0) THEN
  859. INTERR(1)=I195
  860. CALL ERREUR(195)
  861. GOTO 9990
  862. ELSE IF(I259.NE.0) THEN
  863. INTERR(1)=I259
  864. CALL ERREUR(259)
  865. GOTO 9990
  866. ELSE IF(I367.NE.0) THEN
  867. INTERR(1)=I367
  868. CALL ERREUR(367)
  869. GOTO 9990
  870. ENDIF
  871. *
  872. GOTO 9990
  873. C
  874. C_______________________________________________________________________
  875. C
  876. C JOINTS POREUX
  877. C_______________________________________________________________________
  878. C
  879. 80 CONTINUE
  880. C
  881. C POUR CES ELEMENTS NBBB = NOMBRE DE NOEUDS
  882. C NBNO = NOMBRE DE FONCTIONS DE FORME
  883. C
  884. DIM3=1.D0
  885. NBNO=IPORE
  886. NBBB=NBNN
  887. LPP=(NBNO-NBBB)*3/2
  888. LRN =LPP*IDECAP
  889. LRE=LRN
  890. NSTBE=3
  891. IF(IFOUR.EQ.2) NSTBE=4
  892. NSTB=NSTBE*IDECAP
  893. NSTN=1
  894. NMIL=LPP-NBSOM(IELE)
  895.  
  896. * PRINT *,'NSTBE=',NSTBE
  897. * PRINT *,'NSTB=',NSTB
  898. * PRINT *,'IDECAP=',IDECAP
  899. * PRINT *,'LPP =',LPP
  900. * PRINT *,'LRN =',LRN
  901. * PRINT *,'LRE =',LRE
  902. * PRINT *,'NBNO =',NBNO
  903. * PRINT *,'NBBB =',NBBB
  904. * PRINT *,'NSTN =',NSTN
  905. * PRINT *,'IFOUR =',IFOUR
  906. * PRINT *,'NMIL =',NMIL
  907.  
  908. SEGINI WRK1,WRK2,WRK3,WRK5,WRK6
  909. I195=0
  910. I259=0
  911. I367=0
  912. C
  913. DO 3080 IB=1,NBELEM
  914. C
  915. C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  916. C
  917. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  918. C
  919. C ON RECUPERE LES DEPLACEMENTS
  920. C
  921. MPTVAL=IVADEP
  922. NCOSOU=IVAL(/1)
  923. IE=1
  924.  
  925. * PRINT *,' NBSOM(IELE) =', NBSOM(IELE)
  926. * PRINT *,' LPP = ', LPP
  927. * PRINT *,' NCOSOU = ', NCOSOU
  928.  
  929. IE=0
  930. DO 8080 I=1,NCOSOU
  931. MELVAL=IVAL(I)
  932. DO 8180 IGAU=1,NBSOM(IELE)
  933. IGAUSO=IBSOM(NSPOS(IELE)+IGAU-1)
  934. IGMN=MIN(IGAUSO,VELCHE(/1))
  935. IBMN=MIN(IB ,VELCHE(/2))
  936. IE=IE+1
  937. XDDL(IE)=VELCHE(IGMN,IBMN)
  938. 8180 CONTINUE
  939. *
  940. DO 8280 IGAU=1,NMIL
  941. IE=IE+1
  942. IGAUSO=NBBB - NMIL + IGAU
  943. IGMN=MIN(IGAUSO,VELCHE(/1))
  944. IBMN=MIN(IB ,VELCHE(/2))
  945. XDDL(IE)=VELCHE(IGMN,IBMN)
  946. 8280 CONTINUE
  947. 8080 CONTINUE
  948.  
  949. * WRITE(6,48551) (XDDL(I),I=1,LRN)
  950. *48551 FORMAT(2X,'XDDL'/(4(1X,1PE12.5)/))
  951.  
  952. C
  953. C CALCUL DES AXES LOCAUX ET DES COORDONNEES LOCALES
  954. C
  955. CALL JOPLOC(XE,SHPTOT,NBBB,NBNO,IFOUR,XEL,BPSS)
  956.  
  957. * PRINT *, 'MATRICE BPSS '
  958. * WRITE(6,67564) ((BPSS(I,J),J=1,3),I=1,3)
  959. *67564 FORMAT(2X,3(1X,1PE12.5)/)
  960.  
  961. C
  962. C BOUCLE SUR LES POINTS DE GAUSS
  963. C
  964. ISDJC=0
  965. DO 5080 IGAU=1,NBPGAU
  966. C
  967. C RECUPERATION DE L'EPAISSEUR
  968. C
  969. * IF (IFOUR.EQ.-2)THEN
  970. * MPTVAL=IVACAR
  971. * IF (IVACAR.NE.0) THEN
  972. * MELVAL=IVAL(1)
  973. * IF (MELVAL.NE.0) THEN
  974. * IGMN=MIN(IGAU,VELCHE(/1))
  975. * IBMN=MIN(IB,VELCHE(/2))
  976. * DIM3=VELCHE(IGMN,IBMN)
  977. * ELSE
  978. * DIM3=1.D0
  979. * ENDIF
  980. * ENDIF
  981. * ENDIF
  982. C
  983. CALL BNQORJ(IGAU,NBNO,NBBB,LRE,IFOUR,NSTB,NSTN,XE,XEL,
  984. . SHPTOT,SHPWRK,BPSS,BGENE,XGENE,DJAC,IDECAP,1)
  985.  
  986. * IF(IGAU.EQ.1) THEN
  987. * PRINT *,' MATRICE B LIGNE PAR LIGNE '
  988. * DO 3867 IPZ = 1,NSTB
  989. * PRINT *,' LIGNE ',IPZ
  990. * WRITE(6,3868) (BGENE(IPZ,JPZ), JPZ=1,LRE)
  991. *3868 FORMAT(8(1X,1PE10.3)/)
  992. *3867 CONTINUE
  993. * WRITE(6,77442) ((BGENE(I,J),J=1,LRE),I=1,NSTB)
  994. *77442 FORMAT(//6(1X,1PE12.5))
  995. * WRITE(6,77443) (XDDL(I),I=1,LRN)
  996. *77443 FORMAT(//6(1X,1PE12.5))
  997. * ENDIF
  998.  
  999. IF(DJAC.LT.0.D0) ISDJC=ISDJC+1
  1000. IF(DJAC.EQ.0.D0) I259=IB
  1001.  
  1002. *
  1003. * CALCUL DES GRADIENTS
  1004. *
  1005. DO 9180 IPR=1,IDECAP
  1006. LPPDEC=(IPR-1)*LPP
  1007. NSTDEC=(IPR-1)*NSTBE
  1008. DO 9080 I=1,NSTBE
  1009. II=I+NSTDEC
  1010. r_z = 0.D0
  1011. DO 9081 J=1,LPP
  1012. JJ=J+LPPDEC
  1013. r_z = r_z + BGENE(II,JJ)*XDDL(JJ)
  1014. 9081 CONTINUE
  1015. AUX(II)=r_z
  1016. 9080 CONTINUE
  1017. 9180 CONTINUE
  1018.  
  1019. C
  1020. C ON RECUPERE LE MATERIAU
  1021. C
  1022. EREF=1.D0
  1023. MPTVAL=IVAMAT
  1024. *
  1025. * le cas isotrope (le seul)
  1026. *
  1027.  
  1028. IF(MELE.GE.108.AND.MELE.LE.110) THEN
  1029.  
  1030. MELVAL=IVAL(4)
  1031. IGMN=MIN(IGAU,VELCHE(/1))
  1032. IBMN=MIN(IB ,VELCHE(/2))
  1033. XMU =VELCHE(IGMN,IBMN)
  1034. IF(XMU.EQ.0.D0) THEN
  1035. I367=IB
  1036. GO TO 5080
  1037. ENDIF
  1038. *
  1039. FAC = EREF*EREF/XMU
  1040. * H
  1041. MELVAL=IVAL(1)
  1042. IGMN=MIN(IGAU,VELCHE(/1))
  1043. IBMN=MIN(IB ,VELCHE(/2))
  1044. PKK(1,1)=VELCHE(IGMN,IBMN)*FAC
  1045. * B
  1046. MELVAL=IVAL(2)
  1047. IGMN=MIN(IGAU,VELCHE(/1))
  1048. IBMN=MIN(IB ,VELCHE(/2))
  1049. PKK(2,2)=VELCHE(IGMN,IBMN)*FAC
  1050. * T
  1051. MELVAL=IVAL(3)
  1052. IGMN=MIN(IGAU,VELCHE(/1))
  1053. IBMN=MIN(IB ,VELCHE(/2))
  1054. PKK(3,3)=VELCHE(IGMN,IBMN)*FAC
  1055. IF(NSTBE.EQ.4) THEN
  1056. PKK(4,4) = PKK(3,3)
  1057. ENDIF
  1058.  
  1059. DO 9280 I=1,NSTB
  1060. GRAD(I)=PKK(I,I)*AUX(I)
  1061. 9280 CONTINUE
  1062.  
  1063. *
  1064. ELSE IF(MELE.GE.185.AND.MELE.LE.190) THEN
  1065.  
  1066. FAC = EREF*EREF
  1067. IE=0
  1068. DO 2185 IPR=1,IDECAP
  1069. IPR1 = (IPR-1) * NSTBE
  1070. DO 2185 JPR=1,IDECAP
  1071. JPR1 = (JPR-1) * NSTBE
  1072. DO 2186 I=1,NSTBE
  1073. II = I + IPR1
  1074. JJ = I + JPR1
  1075. IF(I.NE.4) THEN
  1076. IE=IE+1
  1077. MELVAL=IVAL(IE)
  1078. IGMN=MIN(IGAU,VELCHE(/1))
  1079. IBMN=MIN(IB ,VELCHE(/2))
  1080. PKK(II,JJ)=VELCHE(IGMN,IBMN)*FAC
  1081. ELSE
  1082. PKK(II,JJ)=PKK(II-1,JJ-1)
  1083. ENDIF
  1084. 2186 CONTINUE
  1085. 2185 CONTINUE
  1086.  
  1087. CALL ZERO(GRAD,NSTB,1)
  1088. DO 2480 IPR=1,IDECAP
  1089. IPR1 = (IPR-1) * NSTBE
  1090. DO 2480 JPR=1,IDECAP
  1091. JPR1 = (JPR-1) * NSTBE
  1092. DO 2485 I=1,NSTBE
  1093. II = I + IPR1
  1094. JJ = I + JPR1
  1095. GRAD(II)=GRAD(II)+PKK(II,JJ)*AUX(JJ)
  1096. 2485 CONTINUE
  1097. 2480 CONTINUE
  1098.  
  1099. ENDIF
  1100.  
  1101. *
  1102. * IF(IGAU.EQ.1) THEN
  1103. * PRINT *, ' MATRICE PKK '
  1104. * WRITE(6,77444) ((PKK(I,J),J=1,NSTB),I=1,NSTB)
  1105. *77444 FORMAT(//6(1X,1PE12.5))
  1106. * WRITE(6,48553) (GRAD (I),I=1,NSTB)
  1107. *48553 FORMAT(2X,'GRAD '/(4(1X,1PE12.5)/))
  1108. * ENDIF
  1109.  
  1110. C
  1111. C REMPLISSAGE DU SEGMENT CONTENANT LES GRADIENTS
  1112. C
  1113. MPTVAL=IVAGRA
  1114. DO 4180 I=1,NSTB
  1115. MELVAL=IVAL(I)
  1116. VELCHE(IGAU,IB)=GRAD(I)
  1117. 4180 CONTINUE
  1118. *
  1119. 5080 CONTINUE
  1120. *
  1121. IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) I195=IB
  1122. *
  1123. 3080 CONTINUE
  1124.  
  1125. SEGSUP WRK1,WRK2,WRK3,WRK5,WRK6
  1126. *
  1127. IF(I195.NE.0) THEN
  1128. INTERR(1)=I195
  1129. CALL ERREUR(195)
  1130. GOTO 9990
  1131. ELSE IF(I259.NE.0) THEN
  1132. INTERR(1)=I259
  1133. CALL ERREUR(259)
  1134. GOTO 9990
  1135. ELSE IF(I367.NE.0) THEN
  1136. INTERR(1)=I367
  1137. CALL ERREUR(367)
  1138. GOTO 9990
  1139. ENDIF
  1140. *
  1141. GOTO 9990
  1142. *
  1143. 99 CONTINUE
  1144. MOTERR(1:4)=NOMTP(MELE)
  1145. MOTERR(9:12)='GRAD'
  1146. CALL ERREUR(86)
  1147. C
  1148. C____________________________________________________________________
  1149. C
  1150. C DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE ISOUS
  1151. C____________________________________________________________________
  1152. C
  1153. 9990 CONTINUE
  1154. SEGDES MELEME
  1155. *
  1156. CALL DTMVAL(IVADEP,1)
  1157. CALL DTMVAL(IVAMAT,1)
  1158. CALL DTMVAL(IVAGRA,1)
  1159. *
  1160. IF(IERR.NE.0)THEN
  1161. IF (MCHAML.NE.0) SEGSUP MCHAML
  1162. ELSE
  1163. SEGDES MCHAML
  1164. ENDIF
  1165. *
  1166. IF(MOMATR.NE.0)THEN
  1167. NOMID=MOMATR
  1168. SEGSUP NOMID
  1169. ENDIF
  1170. *
  1171. IF(MOGRAD.NE.0)THEN
  1172. NOMID=MOGRAD
  1173. SEGSUP NOMID
  1174. ENDIF
  1175. *
  1176. IF(MODEPL.NE.0)THEN
  1177. NOMID=MODEPL
  1178. SEGSUP NOMID
  1179. ENDIF
  1180. *
  1181. SEGDES MINTE
  1182. C
  1183. C DANS LE CAS D'ERREUR
  1184. C
  1185. IF(IERR.NE.0) GOTO 888
  1186. *
  1187. 500 CONTINUE
  1188. * Fin normale
  1189. IRET = 1
  1190. *
  1191. if(n1.ne.isouss) then
  1192. n1=isouss
  1193. segadj mchelm
  1194. endif
  1195. SEGDES,MCHELM
  1196.  
  1197. 888 CONTINUE
  1198. DO ISOUS = 1,NSOUS
  1199. IMODEL=KMODEL(ISOUS)
  1200. SEGDES,IMODEL
  1201. ENDDO
  1202. SEGDES,MMODEL
  1203. *
  1204. RETURN
  1205. END
  1206.  
  1207.  
  1208.  
  1209.  
  1210.  
  1211.  
  1212.  
  1213.  
  1214.  
  1215.  
  1216.  
  1217.  

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