Télécharger menag2.eso

Retour à la liste

Numérotation des lignes :

  1. C MENAG2 SOURCE PV 16/11/26 21:16:09 9205
  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. xmatri=irigel(4,j)
  127. islis((xmatri-1)/npgcd)=1
  128. segdes xmatri
  129. 32 CONTINUE
  130. SEGDES MRIGID
  131. 31 CONTINUE
  132. 40 CONTINUE
  133. *
  134. * CAS DES BLOQ STRUC
  135. *
  136. ITLACC=KCOLA(6)
  137. IF (ITLAC(/1).EQ.0) GOTO 70
  138. DO 61 I=1,ITLAC(/1)
  139. * MCLSTR=ITLAC(I)
  140. * ISLIS((MCLSTR-1)/npgcd)=1
  141. * SEGDES MCLSTR
  142. ISEG=ITLAC(I)
  143. ISLIS((ISEG-1)/npgcd)=1
  144. SEGDES ISEG
  145. 61 CONTINUE
  146. 70 CONTINUE
  147. *
  148. * CAS DES ELEM STRUC
  149. *
  150. ITLACC=KCOLA(7)
  151. IF (ITLAC(/1).EQ.0) GOTO 80
  152. DO 71 I=1,ITLAC(/1)
  153. * MELSTR=ITLAC(I)
  154. * ISLIS((MELSTR-1)/npgcd)=1
  155. * SEGDES MELSTR
  156. ISEG=ITLAC(I)
  157. ISLIS((ISEG-1)/npgcd)=1
  158. SEGDES ISEG
  159. 71 CONTINUE
  160. 80 CONTINUE
  161. *
  162. * CAS DES MSOLUT
  163. *
  164. ITLACC=KCOLA(8)
  165. SEGACT ITLACC
  166. IF (ITLAC(/1).EQ.0) GOTO 90
  167. DO 81 I=1,ITLAC(/1)
  168. MSOLUT=ITLAC(I)
  169. ISLIS((MSOLUT-1)/npgcd)=1
  170. SEGACT MSOLUT
  171. C
  172. C ZONE COMMUNE PAS SI COMMUNE QUE CA |
  173. C
  174. IF(ITYSOL.EQ.MODYN) THEN
  175. MSOLRE=MSOLIS(1)
  176. ISLIS((MSOLRE-1)/npgcd)=1
  177. SEGDES MSOLRE
  178. MSOLEN=MSOLIS(2)
  179. IF(MSOLEN.NE.0) THEN
  180. ISLIS((MSOLEN-1)/npgcd)=1
  181. SEGDES MSOLEN
  182. ENDIF
  183. ENDIF
  184. ISEG=MSOLIS(3)
  185. IF(ISEG.NE.0) THEN
  186. ISLIS((ISEG-1)/npgcd)=1
  187. SEGDES ISEG
  188. ENDIF
  189. MSOLEN=MSOLIS(4)
  190. IF(MSOLEN.NE.0) THEN
  191. ISLIS((MSOLEN-1)/npgcd)=1
  192. SEGACT MSOLEN
  193. DO 82 NS=1,ISOLEN(/1)
  194. MMODE=ISOLEN(NS)
  195. ISLIS((MMODE-1)/npgcd)=1
  196. SEGDES MMODE
  197. 82 CONTINUE
  198. SEGDES MSOLEN
  199. ENDIF
  200. C
  201. NIPO=MSOLIS(/1)
  202. DO 83 J=5,NIPO
  203. MSOLEN=MSOLIS(J)
  204. IF(MSOLEN.NE.0) THEN
  205. ISLIS((MSOLEN-1)/npgcd)=1
  206. SEGDES MSOLEN
  207. ENDIF
  208. 83 CONTINUE
  209. SEGDES MSOLUT
  210. 81 CONTINUE
  211. 90 CONTINUE
  212. *
  213. * CAS DES MSTRUC
  214. *
  215. ITLACC=KCOLA(9)
  216. IF (ITLAC(/1).EQ.0) GOTO 100
  217. DO 91 I=1,ITLAC(/1)
  218. MSTRUC=ITLAC(I)
  219. ISLIS((MSTRUC-1)/npgcd)=1
  220. SEGDES MSTRUC
  221. 91 CONTINUE
  222. 100 CONTINUE
  223. *
  224. * CAS DES MTABLE
  225. *
  226. ITLACC=KCOLA(10)
  227. IF (ITLAC(/1).EQ.0) GOTO 110
  228. DO 101 I=1,ITLAC(/1)
  229. * MTABLE=ITLAC(I)
  230. * ISLIS((**-1)/npgcd)=MTABLE
  231. * SEGDES MTABLE
  232. ISEG=ITLAC(I)
  233. ISLIS((ISEG-1)/npgcd)=1
  234. SEGDES ISEG
  235. 101 CONTINUE
  236. 110 CONTINUE
  237. *
  238. * CAS DES MSOSTU
  239. *
  240. ITLACC=KCOLA(12)
  241. IF (ITLAC(/1).EQ.0) GOTO 130
  242. DO 121 I=1,ITLAC(/1)
  243. MSOSTU=ITLAC(I)
  244. ISLIS((MSOSTU-1)/npgcd)=1
  245. SEGDES MSOSTU
  246. 121 CONTINUE
  247. 130 CONTINUE
  248. *
  249. * CAS DES IMATRI ( n'existe plus)
  250. *
  251. * ITLACC=KCOLA(13)
  252. * IF (ITLAC(/1).EQ.0) GOTO 140
  253. * DO 131 I=1,ITLAC(/1)
  254. * IMATRI=ITLAC(I)
  255. * ISLIS((IMATRI-1)/npgcd)=1
  256. * SEGACT IMATRI
  257. * DO 132 K=1,IMATTT(/1)
  258. * XMATRI=IMATTT(K)
  259. * ISLIS((XMATRI-1)/npgcd)=1
  260. * SEGDES XMATRI
  261. * 132 CONTINUE
  262. * SEGDES IMATRI
  263. * 131 CONTINUE
  264. * 140 CONTINUE
  265. *
  266. * CAS DES MJONCT
  267. *
  268. ITLACC=KCOLA(14)
  269. IF (ITLAC(/1).EQ.0) GOTO 150
  270. DO 141 I=1,ITLAC(/1)
  271. MJONCT=ITLAC(I)
  272. ISLIS((MJONCT-1)/npgcd)=1
  273. SEGDES MJONCT
  274. 141 CONTINUE
  275. 150 CONTINUE
  276. *
  277. * CAS DES MATTAC
  278. *
  279. ITLACC=KCOLA(15)
  280. SEGACT ITLACC
  281. IF (ITLAC(/1).EQ.0) GOTO 160
  282. DO 151 I=1,ITLAC(/1)
  283. MATTAC=ITLAC(I)
  284. SEGACT MATTAC
  285. ISLIS((MATTAC-1)/npgcd)=1
  286. DO 152 NM=1,LISATT(/1)
  287. MSOUMA=LISATT(NM)
  288. if (MSOUMA.gt.0) then
  289. ISLIS((MSOUMA-1)/npgcd)=1
  290. SEGACT MSOUMA
  291. MPHYCH=IPHYCH
  292. if (MPHYCH.gt.0) then
  293. ISLIS((MPHYCH-1)/npgcd)=1
  294. SEGDES MPHYCH
  295. endif
  296. MGEOCH=IGEOCH
  297. ISLIS((MGEOCH-1)/npgcd)=1
  298. SEGDES MGEOCH
  299. DO 153 NATR=1,IATREL(/1)
  300. MJONCT=IATREL(NATR)
  301. ISLIS((MJONCT-1)/npgcd)=1
  302. C
  303. SEGDES MJONCT
  304. 153 CONTINUE
  305. SEGDES MSOUMA
  306. endif
  307. 152 CONTINUE
  308. SEGDES MATTAC
  309. 151 CONTINUE
  310. 160 CONTINUE
  311. *
  312. * CAS DES MMATRI : LES MMATRI N'ETANT PAS REMPLI DANS LE PROCESSUS
  313. * NORMAL : FILLPO ON LES REMPLI AU NIVEAU DE MRIGID
  314. * ON EST EGALEMENT CONTRAINT DE SAUVER IGEOMA (MELEME) CAR CE N'EST
  315. * PAS FAIT AUTOMATIQUEMENT
  316. *
  317. ITLACC=KCOLA(16)
  318. IF (ITLAC(/1).EQ.0) GOTO 170
  319. DO 161 I=1,ITLAC(/1)
  320. MMATRI=ITLAC(I)
  321. ISLIS((MMATRI-1)/npgcd)=1
  322. SEGACT MMATRI
  323. ISEG=IGEOMA
  324. ISLIS((ISEG-1)/npgcd)=1
  325. SEGDES ISEG
  326. MDIAG=IDIAG
  327. ISLIS((MDIAG-1)/npgcd)=1
  328. SEGDES MDIAG
  329. MINCPO=IINCPO
  330. ISLIS((MINCPO-1)/npgcd)=1
  331. SEGDES MINCPO
  332. IF(IDUAPO.GT.0) THEN
  333. MINCPO=IDUAPO
  334. ISLIS((MINCPO-1)/npgcd)=1
  335. SEGDES MINCPO
  336. ENDIF
  337. MIDUA=IIDUA
  338. ISLIS((MIDUA-1)/npgcd)=1
  339. SEGDES MIDUA
  340. MIMIK=IIMIK
  341. ISLIS((MIMIK-1)/npgcd)=1
  342. SEGDES MIMIK
  343. MDNOR=IDNORM
  344. ISLIS((MDNOR-1)/npgcd)=1
  345. SEGDES MDNOR
  346. MHARK=IHARK
  347. ISLIS((MHARK-1)/npgcd)=1
  348. SEGDES MHARK
  349. IF(IHARDU.GT.0) THEN
  350. MHARK=IHARDU
  351. ISLIS((MHARK-1)/npgcd)=1
  352. SEGDES MHARK
  353. ENDIF
  354. IF(IDNORD.GT.0) THEN
  355. MDNO1=IDNORD
  356. ISLIS((MDNO1-1)/npgcd)=1
  357. SEGDES MDNO1
  358. ENDIF
  359.  
  360. MILIGN=IILIGN
  361. ISLIS((MILIGN-1)/npgcd)=1
  362. SEGACT MILIGN
  363. DO 162 J=1,ILIGN(/1)
  364. LIGN=ILIGN(J)
  365. ISLIS((LIGN-1)/npgcd)=1
  366. SEGDES LIGN
  367. 162 CONTINUE
  368. SEGDES MILIGN
  369.  
  370. IF(IILIGS.NE.0) THEN
  371. MILIGN=IILIGS
  372. ISLIS((MILIGN-1)/npgcd)=1
  373. SEGACT MILIGN
  374. DO 163 J=1,ILIGN(/1)
  375. LIGN=ILIGN(J)
  376. ISLIS((LIGN-1)/npgcd)=1
  377. SEGDES LIGN
  378. 163 CONTINUE
  379. SEGDES MILIGN
  380. ENDIF
  381. IF(IASLIG.NE.0) THEN
  382. ISLIS((IASLIG-1)/npgcd)=1
  383. MILIGN=IASLIG
  384. SEGACT MILIGN
  385. DO 164 J=1,ILIGN(/1)
  386. LIGN=ILIGN(J)
  387. ISLIS((LIGN-1)/npgcd)=1
  388. SEGDES LIGN
  389. 164 CONTINUE
  390. SEGDES MILIGN
  391. MDIAG=IASDIA
  392. ISLIS((MDIAG-1)/npgcd)=1
  393. SEGDES MDIAG
  394. ENDIF
  395. SEGDES MMATRI
  396. 161 CONTINUE
  397. 170 CONTINUE
  398. *
  399. * CAS DES MDEFOR
  400. *
  401. ITLACC=KCOLA(17)
  402. IF (ITLAC(/1).EQ.0) GOTO 180
  403. DO 171 I=1,ITLAC(/1)
  404. * MDEFOR=ITLAC(I)
  405. * ISLIS((MDEFOR-1)/npgcd)=1
  406. * SEGDES MDEFOR
  407. ISEG=ITLAC(I)
  408. ISLIS((ISEG-1)/npgcd)=1
  409. SEGDES ISEG
  410. 171 CONTINUE
  411. 180 CONTINUE
  412. *
  413. * LA SUITE EST DANS MENAG6
  414. *
  415. CALL MENAG6(ILISSE,ISLIS,ICOLAC)
  416. *
  417. * ORDONNER LES SEGMENTS
  418. *
  419. NP=0
  420. DO 11 I=1,ISLIS(/1)
  421. IF( ISLIS(I).NE.0) THEN
  422. NP=NP+1
  423. ISLIS(NP)=I*npgcd+1
  424. ENDIF
  425. 11 CONTINUE
  426. SEGADJ ISLIS
  427. * SEGINI IBLIS
  428. * CALL TRIENT(ISLIS(1),IBLIS(1),ISLIS(/1))
  429. * SEGSUP IBLIS
  430.  
  431. RETURN
  432. END
  433.  
  434.  
  435.  
  436.  
  437.  
  438.  
  439.  
  440.  
  441.  

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