Télécharger menag2.eso

Retour à la liste

Numérotation des lignes :

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

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