Télécharger menag2.eso

Retour à la liste

Numérotation des lignes :

  1. C MENAG2 SOURCE PV 17/12/05 21:16:45 9646
  2. C SUPPRIMER LES SEGMENTS INDESIRABLES
  3. C DESACTIVER LES AUTRES
  4. C
  5. SUBROUTINE MENAG2(ISLIS,ICOLAC)
  6.  
  7. IMPLICIT INTEGER(I-N)
  8. IMPLICIT REAL*8(A-H,O-Z)
  9.  
  10. C=======================================================================
  11. C TABLEAU KCOLA: VOIR SIGNIFICATION DANS SOUS-PROGRAMME TYPFIL
  12. C=======================================================================
  13.  
  14. CHARACTER*8 MODYN
  15.  
  16. SEGMENT ISLIS(NP)
  17. SEGMENT IBLIS(ISLIS(/1))
  18. * SEGMENT BIDON POUR REMPLACER LES TROP NOMBREUSES
  19. * DECLARATION
  20. SEGMENT ISEG(0)
  21. *
  22. -INC CCOPTIO
  23. -INC TMCOLAC
  24. *-INC SMCOORD
  25. *-INC SMELEME
  26. -INC SMCHPOI
  27. -INC SMRIGID
  28. *-INC SMCLSTR
  29. *-INC SMELSTR
  30. -INC SMSTRUC
  31. *-INC SMTABLE
  32. -INC SMINTE
  33. -INC SMATTAC
  34. -INC SMMATRI
  35. -INC SMSOLUT
  36. *-INC SMSUPER
  37. -INC SMTEXTE
  38. *-INC SMDEFOR
  39. -INC CCASSIS
  40.  
  41. MODYN='DYNAMIQU'
  42.  
  43. ILISSE=ILISSG
  44. NP=ILISEG(/1)
  45. SEGINI ISLIS
  46. * A TOUT HASARD SAUVER LA CONFIGURATION COURANTE
  47. ISLIS((MCOORD-1)/npgcd)=1
  48.  
  49. SEGACT ICOLAC
  50. *
  51. * CAS DES MELEME
  52. *
  53. ITLACC=KCOLA(1)
  54. IF (ITLAC(/1).EQ.0) GOTO 20
  55. DO 12 I=1,ITLAC(/1)
  56. ISEG=ITLAC(I)
  57. IF (ISEG.NE.0) THEN
  58. ISLIS((ISEG-1)/npgcd)=1
  59. SEGDES ISEG
  60. ENDIF
  61. 12 CONTINUE
  62. 20 CONTINUE
  63. *
  64. * CAS DES CHPOINT
  65. *
  66. ITLACC=KCOLA(2)
  67. IF (ITLAC(/1).EQ.0) GOTO 30
  68. DO 21 I=1,ITLAC(/1)
  69. MCHPOI=ITLAC(I)
  70. IF (MCHPOI.EQ.0) GOTO 21
  71. ISLIS((MCHPOI-1)/npgcd)=1
  72. SEGACT MCHPOI
  73. if (ipchp(/1).gt.1000.or.ipchp(/1).lt.0) then
  74. write (6,*) ' menag2 chpo incorrect ',
  75. > mchpoi,j,ipchp(/1),msoupo
  76. goto 21
  77. endif
  78. DO 22 J=1,IPCHP(/1)
  79. MSOUPO=IPCHP(J)
  80. if (msoupo.eq.0) goto 22
  81. if (msoupo.le.100) then
  82. write (6,*) ' menag2 chpo incorrect ',
  83. > mchpoi,j,ipchp(/1),msoupo
  84. goto 21
  85. endif
  86. ISLIS((MSOUPO-1)/npgcd)=1
  87. SEGACT MSOUPO
  88. MPOVAL=IPOVAL
  89. C
  90. C BIZARRE : DANS UN ATTACH, ON TROUVE UN CHPOI SANS MPOVAL ?
  91. IF(MPOVAL.NE.0) THEN
  92. ISLIS((MPOVAL-1)/npgcd)=1
  93. SEGDES MPOVAL
  94. ENDIF
  95. SEGDES MSOUPO
  96. 22 CONTINUE
  97. SEGDES MCHPOI
  98. 21 CONTINUE
  99. 30 CONTINUE
  100. *
  101. * CAS DES MRIGID (ON REMPLIT MMATRI CAR CA N'A PAS L'AIR FAIT DANS
  102. * FILLPO
  103. *
  104. ITLACC=KCOLA(3)
  105. ITLAC1=KCOLA(16)
  106. IF (ITLAC(/1).EQ.0) GOTO 40
  107. DO 31 I=1,ITLAC(/1)
  108. MRIGID=ITLAC(I)
  109. ISLIS((MRIGID-1)/npgcd)=1
  110. SEGACT MRIGID
  111. * IF (ICHOLE.NE.0) ITLAC1.ITLAC(**)=ICHOLE
  112. IMGEOD=IMGEO1
  113. IF (IMGEOD.NE.0) THEN
  114. ISLIS((IMGEOD-1)/npgcd)=1
  115. SEGDES IMGEOD
  116. ENDIF
  117. IF(IVECRI.NE.0) then
  118. ISLIS((IVECRI-1)/npgcd)=1
  119. MVECRI=IVECRI
  120. SEGDES MVECRI
  121. ENDIF
  122. DO 32 J=1,IRIGEL(/2)
  123. DESCR=IRIGEL(3,J)
  124. ISLIS((DESCR-1)/npgcd)=1
  125. SEGDES DESCR
  126. * maintenant fait dans la pile imatri
  127. *** xmatri=irigel(4,j)
  128. *** islis((xmatri-1)/npgcd)=1
  129. *** segdes xmatri
  130. 32 CONTINUE
  131. SEGDES MRIGID
  132. 31 CONTINUE
  133. 40 CONTINUE
  134. *
  135. * CAS DES BLOQ STRUC
  136. *
  137. ITLACC=KCOLA(6)
  138. IF (ITLAC(/1).EQ.0) GOTO 70
  139. DO 61 I=1,ITLAC(/1)
  140. * MCLSTR=ITLAC(I)
  141. * ISLIS((MCLSTR-1)/npgcd)=1
  142. * SEGDES MCLSTR
  143. ISEG=ITLAC(I)
  144. ISLIS((ISEG-1)/npgcd)=1
  145. SEGDES ISEG
  146. 61 CONTINUE
  147. 70 CONTINUE
  148. *
  149. * CAS DES ELEM STRUC
  150. *
  151. ITLACC=KCOLA(7)
  152. IF (ITLAC(/1).EQ.0) GOTO 80
  153. DO 71 I=1,ITLAC(/1)
  154. * MELSTR=ITLAC(I)
  155. * ISLIS((MELSTR-1)/npgcd)=1
  156. * SEGDES MELSTR
  157. ISEG=ITLAC(I)
  158. ISLIS((ISEG-1)/npgcd)=1
  159. SEGDES ISEG
  160. 71 CONTINUE
  161. 80 CONTINUE
  162. *
  163. * CAS DES MSOLUT
  164. *
  165. ITLACC=KCOLA(8)
  166. SEGACT ITLACC
  167. IF (ITLAC(/1).EQ.0) GOTO 90
  168. DO 81 I=1,ITLAC(/1)
  169. MSOLUT=ITLAC(I)
  170. ISLIS((MSOLUT-1)/npgcd)=1
  171. SEGACT MSOLUT
  172. C
  173. C ZONE COMMUNE PAS SI COMMUNE QUE CA |
  174. C
  175. IF(ITYSOL.EQ.MODYN) THEN
  176. MSOLRE=MSOLIS(1)
  177. ISLIS((MSOLRE-1)/npgcd)=1
  178. SEGDES MSOLRE
  179. MSOLEN=MSOLIS(2)
  180. IF(MSOLEN.NE.0) THEN
  181. ISLIS((MSOLEN-1)/npgcd)=1
  182. SEGDES MSOLEN
  183. ENDIF
  184. ENDIF
  185. ISEG=MSOLIS(3)
  186. IF(ISEG.NE.0) THEN
  187. ISLIS((ISEG-1)/npgcd)=1
  188. SEGDES ISEG
  189. ENDIF
  190. MSOLEN=MSOLIS(4)
  191. IF(MSOLEN.NE.0) THEN
  192. ISLIS((MSOLEN-1)/npgcd)=1
  193. SEGACT MSOLEN
  194. DO 82 NS=1,ISOLEN(/1)
  195. MMODE=ISOLEN(NS)
  196. ISLIS((MMODE-1)/npgcd)=1
  197. SEGDES MMODE
  198. 82 CONTINUE
  199. SEGDES MSOLEN
  200. ENDIF
  201. C
  202. NIPO=MSOLIS(/1)
  203. DO 83 J=5,NIPO
  204. MSOLEN=MSOLIS(J)
  205. IF(MSOLEN.NE.0) THEN
  206. ISLIS((MSOLEN-1)/npgcd)=1
  207. SEGDES MSOLEN
  208. ENDIF
  209. 83 CONTINUE
  210. SEGDES MSOLUT
  211. 81 CONTINUE
  212. 90 CONTINUE
  213. *
  214. * CAS DES MSTRUC
  215. *
  216. ITLACC=KCOLA(9)
  217. IF (ITLAC(/1).EQ.0) GOTO 100
  218. DO 91 I=1,ITLAC(/1)
  219. MSTRUC=ITLAC(I)
  220. ISLIS((MSTRUC-1)/npgcd)=1
  221. SEGDES MSTRUC
  222. 91 CONTINUE
  223. 100 CONTINUE
  224. *
  225. * CAS DES MTABLE
  226. *
  227. ITLACC=KCOLA(10)
  228. IF (ITLAC(/1).EQ.0) GOTO 110
  229. DO 101 I=1,ITLAC(/1)
  230. * MTABLE=ITLAC(I)
  231. * ISLIS((**-1)/npgcd)=MTABLE
  232. * SEGDES MTABLE
  233. ISEG=ITLAC(I)
  234. ISLIS((ISEG-1)/npgcd)=1
  235. SEGDES ISEG
  236. 101 CONTINUE
  237. 110 CONTINUE
  238. *
  239. * CAS DES MSOSTU
  240. *
  241. ITLACC=KCOLA(12)
  242. IF (ITLAC(/1).EQ.0) GOTO 130
  243. DO 121 I=1,ITLAC(/1)
  244. MSOSTU=ITLAC(I)
  245. ISLIS((MSOSTU-1)/npgcd)=1
  246. SEGDES MSOSTU
  247. 121 CONTINUE
  248. 130 CONTINUE
  249. *
  250. * CAS DES IMATRI
  251. *
  252. ITLACC=KCOLA(13)
  253. IF (ITLAC(/1).EQ.0) GOTO 140
  254. DO 131 I=1,ITLAC(/1)
  255. IMATRI=ITLAC(I)
  256. ISLIS((IMATRI-1)/npgcd)=1
  257. 131 CONTINUE
  258. 140 CONTINUE
  259. *
  260. * CAS DES MJONCT
  261. *
  262. ITLACC=KCOLA(14)
  263. IF (ITLAC(/1).EQ.0) GOTO 150
  264. DO 141 I=1,ITLAC(/1)
  265. MJONCT=ITLAC(I)
  266. ISLIS((MJONCT-1)/npgcd)=1
  267. SEGDES MJONCT
  268. 141 CONTINUE
  269. 150 CONTINUE
  270. *
  271. * CAS DES MATTAC
  272. *
  273. ITLACC=KCOLA(15)
  274. SEGACT ITLACC
  275. IF (ITLAC(/1).EQ.0) GOTO 160
  276. DO 151 I=1,ITLAC(/1)
  277. MATTAC=ITLAC(I)
  278. SEGACT MATTAC
  279. ISLIS((MATTAC-1)/npgcd)=1
  280. DO 152 NM=1,LISATT(/1)
  281. MSOUMA=LISATT(NM)
  282. if (MSOUMA.gt.0) then
  283. ISLIS((MSOUMA-1)/npgcd)=1
  284. SEGACT MSOUMA
  285. MPHYCH=IPHYCH
  286. if (MPHYCH.gt.0) then
  287. ISLIS((MPHYCH-1)/npgcd)=1
  288. SEGDES MPHYCH
  289. endif
  290. MGEOCH=IGEOCH
  291. ISLIS((MGEOCH-1)/npgcd)=1
  292. SEGDES MGEOCH
  293. DO 153 NATR=1,IATREL(/1)
  294. MJONCT=IATREL(NATR)
  295. ISLIS((MJONCT-1)/npgcd)=1
  296. C
  297. SEGDES MJONCT
  298. 153 CONTINUE
  299. SEGDES MSOUMA
  300. endif
  301. 152 CONTINUE
  302. SEGDES MATTAC
  303. 151 CONTINUE
  304. 160 CONTINUE
  305. *
  306. * CAS DES MMATRI : LES MMATRI N'ETANT PAS REMPLI DANS LE PROCESSUS
  307. * NORMAL : FILLPO ON LES REMPLI AU NIVEAU DE MRIGID
  308. * ON EST EGALEMENT CONTRAINT DE SAUVER IGEOMA (MELEME) CAR CE N'EST
  309. * PAS FAIT AUTOMATIQUEMENT
  310. *
  311. ITLACC=KCOLA(16)
  312. IF (ITLAC(/1).EQ.0) GOTO 170
  313. DO 161 I=1,ITLAC(/1)
  314. MMATRI=ITLAC(I)
  315. ISLIS((MMATRI-1)/npgcd)=1
  316. SEGACT MMATRI
  317. ISEG=IGEOMA
  318. ISLIS((ISEG-1)/npgcd)=1
  319. SEGDES ISEG
  320. MDIAG=IDIAG
  321. ISLIS((MDIAG-1)/npgcd)=1
  322. SEGDES MDIAG
  323. MINCPO=IINCPO
  324. ISLIS((MINCPO-1)/npgcd)=1
  325. SEGDES MINCPO
  326. IF(IDUAPO.GT.0) THEN
  327. MINCPO=IDUAPO
  328. ISLIS((MINCPO-1)/npgcd)=1
  329. SEGDES MINCPO
  330. ENDIF
  331. MIDUA=IIDUA
  332. ISLIS((MIDUA-1)/npgcd)=1
  333. SEGDES MIDUA
  334. MIMIK=IIMIK
  335. ISLIS((MIMIK-1)/npgcd)=1
  336. SEGDES MIMIK
  337. MDNOR=IDNORM
  338. ISLIS((MDNOR-1)/npgcd)=1
  339. SEGDES MDNOR
  340. MHARK=IHARK
  341. ISLIS((MHARK-1)/npgcd)=1
  342. SEGDES MHARK
  343. IF(IHARDU.GT.0) THEN
  344. MHARK=IHARDU
  345. ISLIS((MHARK-1)/npgcd)=1
  346. SEGDES MHARK
  347. ENDIF
  348. IF(IDNORD.GT.0) THEN
  349. MDNO1=IDNORD
  350. ISLIS((MDNO1-1)/npgcd)=1
  351. SEGDES MDNO1
  352. ENDIF
  353.  
  354. MILIGN=IILIGN
  355. ISLIS((MILIGN-1)/npgcd)=1
  356. SEGACT MILIGN
  357. DO 162 J=1,ILIGN(/1)
  358. LIGN=ILIGN(J)
  359. ISLIS((LIGN-1)/npgcd)=1
  360. SEGDES LIGN
  361. 162 CONTINUE
  362. SEGDES MILIGN
  363.  
  364. IF(IILIGS.NE.0) THEN
  365. MILIGN=IILIGS
  366. ISLIS((MILIGN-1)/npgcd)=1
  367. SEGACT MILIGN
  368. DO 163 J=1,ILIGN(/1)
  369. LIGN=ILIGN(J)
  370. ISLIS((LIGN-1)/npgcd)=1
  371. SEGDES LIGN
  372. 163 CONTINUE
  373. SEGDES MILIGN
  374. ENDIF
  375. IF(IASLIG.NE.0) THEN
  376. ISLIS((IASLIG-1)/npgcd)=1
  377. MILIGN=IASLIG
  378. SEGACT MILIGN
  379. DO 164 J=1,ILIGN(/1)
  380. LIGN=ILIGN(J)
  381. ISLIS((LIGN-1)/npgcd)=1
  382. SEGDES LIGN
  383. 164 CONTINUE
  384. SEGDES MILIGN
  385. MDIAG=IASDIA
  386. ISLIS((MDIAG-1)/npgcd)=1
  387. SEGDES MDIAG
  388. ENDIF
  389. SEGDES MMATRI
  390. 161 CONTINUE
  391. 170 CONTINUE
  392. *
  393. * CAS DES MDEFOR
  394. *
  395. ITLACC=KCOLA(17)
  396. IF (ITLAC(/1).EQ.0) GOTO 180
  397. DO 171 I=1,ITLAC(/1)
  398. * MDEFOR=ITLAC(I)
  399. * ISLIS((MDEFOR-1)/npgcd)=1
  400. * SEGDES MDEFOR
  401. ISEG=ITLAC(I)
  402. ISLIS((ISEG-1)/npgcd)=1
  403. SEGDES ISEG
  404. 171 CONTINUE
  405. 180 CONTINUE
  406. *
  407. * LA SUITE EST DANS MENAG6
  408. *
  409. CALL MENAG6(ILISSE,ISLIS,ICOLAC)
  410. *
  411. * ORDONNER LES SEGMENTS
  412. *
  413. NP=0
  414. DO 11 I=1,ISLIS(/1)
  415. IF( ISLIS(I).NE.0) THEN
  416. NP=NP+1
  417. ISLIS(NP)=I*npgcd+1
  418. ENDIF
  419. 11 CONTINUE
  420. SEGADJ ISLIS
  421. * SEGINI IBLIS
  422. * CALL TRIENT(ISLIS(1),IBLIS(1),ISLIS(/1))
  423. * SEGSUP IBLIS
  424.  
  425. RETURN
  426. END
  427.  
  428.  
  429.  
  430.  
  431.  
  432.  
  433.  
  434.  
  435.  
  436.  
  437.  

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