Télécharger sort5.eso

Retour à la liste

Numérotation des lignes :

sort5
  1. C SORT5 SOURCE CB215821 20/11/25 13:40:13 10792
  2. SUBROUTINE SORT5(ICOLAC)
  3. C=======================================================================
  4. C RESTAURATION DE LA NUMEROTATION DANS LES PILES
  5. C
  6. C PROGRAMME PAR FARVACQUE
  7. C APPELE PAR REST RESTFO
  8. C N'APPELLE RIEN
  9. C=======================================================================
  10. C TABLEAU KCOLA :
  11. C 1 MELEME 2 CHPOIN 3 MRIGID 4 5 6 MCLSTR
  12. C 7 MELSTR 8 MSOLUT 9 MSTRUC 10 11 12 MSOSTU
  13. C 13 IMATRI 14 MJONCT 15 MATTAC 16 MMATRI 17 MDEFOR 18 MLREEL
  14. C 19 MLENTI 20 MCHARG 21 22 MEVOLL
  15. C=======================================================================
  16. IMPLICIT INTEGER(I-N)
  17. IMPLICIT REAL*8(A-H,O-Z)
  18.  
  19. -INC PPARAM
  20. -INC CCOPTIO
  21. -INC SMELEME
  22. -INC SMCHPOI
  23. -INC SMRIGID
  24. -INC SMMATRI
  25. -INC SMSOLUT
  26. -INC SMLENTI
  27. -INC SMLREEL
  28. -INC SMDEFOR
  29. -INC SMCHARG
  30. -INC SMEVOLL
  31. -INC TMCOLAC
  32. C
  33. SEGMENT ILIST(ILL)
  34. SEGMENT ISORTA(0)
  35.  
  36. CHARACTER*(8) ITYPE
  37. C
  38. SEGACT ICOLAC
  39. NITLAC=ICOLA(/1)
  40. C
  41. C **** BOUCLE SUR LES FILES DE SORTIE IFILE=1,NITLAC
  42. C
  43. DO 1099 IFILE=1,NITLAC
  44. ITLACC=KCOLA(IFILE)
  45. IMAX1=ITLAC(/1)
  46. IF(IMAX1.EQ.0) GO TO 1099
  47. IP1=ICOLA(IFILE)
  48. GO TO (6001,6002,6003,1099,1099,1099,1099,6008,1099,1099,
  49. & 1099,1099,6013,1099,1099,6016,6017,6018,6019,6020,
  50. & 1099,6022),IFILE
  51. C Au cas où un ICOLAC plus grand serait passé en argument ...
  52. GOTO 1099
  53. C ****************************** MELEME ****************************
  54. 6001 CONTINUE
  55. DO 20 I=1,IMAX1
  56. MELEME=ITLAC(I)
  57. SEGACT MELEME
  58. IF (LISOUS(/1).EQ.0) GOTO 21
  59. DO 1003 J=1,LISOUS(/1)
  60. LISOUS(J)=ITLAC(LISOUS(J))
  61. 1003 CONTINUE
  62. 21 CONTINUE
  63. IF (LISREF(/1).EQ.0) GOTO 25
  64. DO 1004 J=1,LISREF(/1)
  65. LISREF(J)=ITLAC(LISREF(J))
  66. 1004 CONTINUE
  67. 25 CONTINUE
  68. SEGDES MELEME
  69. 20 CONTINUE
  70. GOTO 1098
  71. C **************************CHPOINT*********************************
  72. 6002 CONTINUE
  73. ITLAC1=KCOLA(1)
  74. DO 1101 IEL=1,IMAX1
  75. MCHPOI=ITLAC(IEL)
  76. SEGACT MCHPOI
  77. NSOUPO=IPCHP(/1)
  78. DO 1103 ISOU=1,NSOUPO
  79. MSOUPO=IPCHP(ISOU)
  80. SEGACT MSOUPO
  81. IVA=IGEOC
  82. IGEOC=ITLAC1.ITLAC(IVA)
  83. SEGDES MSOUPO
  84. 1103 CONTINUE
  85. SEGDES MCHPOI
  86. 1101 CONTINUE
  87. GOTO 1098
  88. C ***********************MRIGID*************************************
  89. 6003 CONTINUE
  90. ITLAC1=KCOLA(1)
  91. ITLAC2=KCOLA(13)
  92. ITLAC3=KCOLA(16)
  93. * ITLAC4=KCOLA(11) ON REMPLACE PAR UN MELEME AM 12/2/90
  94. DO 1202 IEL=1,IMAX1
  95. MRIGID=ITLAC(IEL)
  96. SEGACT MRIGID
  97. NRIGEL=IRIGEL(/2)
  98. IF(IMGEO1.EQ.0) GOTO 1204
  99. IMGEOD=IMGEO1
  100. SEGACT IMGEOD
  101. DO 1205 I=1,IMGEOR(/1)
  102. IVA=IMGEOR(I)
  103. IMGEOR(I)=ITLAC1.ITLAC(IVA)
  104. 1205 CONTINUE
  105. SEGDES IMGEOD
  106. 1204 CONTINUE
  107. IF(IMGEO1.EQ.0) GOTO 1208
  108. MVECRI=IVECRI
  109. SEGACT MVECRI*mod
  110. DO 1209 I=1,MELZON(/1)
  111. IVA=MELZON(I)
  112. MELZON(I)=ITLAC1.ITLAC(IVA)
  113. 1209 CONTINUE
  114. SEGDES MVECRI
  115. 1208 CONTINUE
  116. IVA=ICHOLE
  117. IF(IVA .NE.0) ICHOLE=ITLAC3.ITLAC(IVA)
  118. DO 1203 IR=1,NRIGEL
  119. IVA=IRIGEL(1,IR)
  120. IRIGEL(1,IR)=ITLAC1.ITLAC(IVA)
  121. IVA=IRIGEL(2,IR)
  122. IF(IVA.NE.0) IRIGEL(2,IR)=ITLAC1.ITLAC(IVA)
  123. * IVA=IRIGEL(4,IR)
  124. * IRIGEL(4,IR)=ITLAC2.ITLAC(IVA)
  125. 1203 CONTINUE
  126. SEGDES MRIGID
  127. 1202 CONTINUE
  128. GOTO 1098
  129. C *************************** *******************************
  130. 6004 CONTINUE
  131. GOTO 1098
  132. C *************************** *******************************
  133. 6005 CONTINUE
  134. GOTO 1098
  135. C ****************************MSOLUT********************************
  136. 6008 CONTINUE
  137. DO 1800 IEL=1,IMAX1
  138. MSOLUT=ITLAC(IEL)
  139. SEGACT MSOLUT
  140. IF(MSOLIS(3).LE.0) GOTO 1802
  141. ITLAC1=KCOLA(1)
  142. IVA=MSOLIS(3)
  143. MSOLIS(3)=ITLAC1.ITLAC(IVA)
  144. GOTO 1803
  145. 1802 CONTINUE
  146. MSOLIS(3)=-MSOLIS(3)
  147. 1803 CONTINUE
  148. SEGDES MSOLUT
  149. 1800 CONTINUE
  150. GOTO 1098
  151. C ***************************** *****************************
  152. 6011 CONTINUE
  153. GOTO 1098
  154. C ***************************** IMATRI *****************************
  155. 6013 CONTINUE
  156. GOTO 1098
  157. C ***************************** MMATRI *****************************
  158. 6016 CONTINUE
  159. ITLAC1=KCOLA(1)
  160. DO 2600 IEL=1,IMAX1
  161. MMATRI=ITLAC(IEL)
  162. SEGACT MMATRI
  163. IVA=IGEOMA
  164. IGEOMA=ITLAC1.ITLAC(IVA)
  165. SEGDES MMATRI
  166. 2600 CONTINUE
  167. GOTO 1098
  168. C ************************* MDEFOR*******************************
  169. 6017 CONTINUE
  170. ITLAC1=KCOLA(1)
  171. ITLAC2=KCOLA(2)
  172. ITLAC3=KCOLA(30)
  173. ITLAC4=KCOLA(38)
  174. ITLAC5=KCOLA(39)
  175. DO 2700 IEL=1,IMAX1
  176. MDEFOR=ITLAC(IEL)
  177. SEGACT MDEFOR
  178. NDEF=IELDEF(/1)
  179. DO 2701 I=1,NDEF
  180. IVA=IELDEF(I)
  181. IELDEF(I)=ITLAC1.ITLAC(IVA)
  182. IVA=ICHDEF(I)
  183. ICHDEF(I)=ITLAC2.ITLAC(IVA)
  184. IVA=MTVECT(I)
  185. MTVECT(I)=ITLAC3.ITLAC(IVA)
  186. IVA=MDCHP(I)
  187. MDCHP(I)=ITLAC2.ITLAC(IVA)
  188. IVA=MDCHEL(I)
  189. MDCHEL(I)=ITLAC5.ITLAC(IVA)
  190. IVA=MDMODE(I)
  191. MDMODE(I)=ITLAC4.ITLAC(IVA)
  192. 2701 CONTINUE
  193. SEGDES MDEFOR
  194. 2700 CONTINUE
  195. GOTO 1098
  196. C ***************************MLREEL******************************
  197. 6018 CONTINUE
  198. GOTO 1098
  199. C *****************************MLENTI***************************
  200. 6019 CONTINUE
  201. GOTO 1098
  202. C ****************************MCHARG*****************************
  203. 6020 CONTINUE
  204. ITLAC1=KCOLA(2)
  205. ITLAC2=KCOLA(18)
  206. ITLAC3=KCOLA(39)
  207. ITLAC4=KCOLA(10)
  208. ITLAC5=KCOLA(32)
  209. ITLAC6=KCOLA(1)
  210. DO 3000 IEL=1,IMAX1
  211. MCHARG=ITLAC(IEL)
  212. SEGACT MCHARG
  213. N=KCHARG(/1)
  214. DO 3001 I=1,N
  215. ICHARG=KCHARG(I)
  216. SEGACT ICHARG
  217. IF(CHATYP.EQ.'CHPOINT ') THEN
  218. IVA=ICHPO1
  219. ICHPO1=ITLAC1.ITLAC(IVA)
  220. IVA=ICHPO2
  221. ICHPO2=ITLAC2.ITLAC(IVA)
  222. IVA=ICHPO3
  223. ICHPO3=ITLAC2.ITLAC(IVA)
  224. ELSE IF (CHATYP.EQ.'MCHAML ') THEN
  225. IVA=ICHPO1
  226. IICHPO1=ITLAC3.ITLAC(IVA)
  227. IVA=ICHPO2
  228. ICHPO2=ITLAC2.ITLAC(IVA)
  229. IVA=ICHPO3
  230. ICHPO3=ITLAC2.ITLAC(IVA)
  231. ELSE IF (CHATYP.EQ.'TABLE ') THEN
  232. IVA=ICHPO1
  233. ICHPO1=ITLAC4.ITLAC(IVA)
  234. IVA=ICHPO2
  235. ICHPO2=ITLAC4.ITLAC(IVA)
  236. ENDIF
  237. IF(CHAMOB(I).EQ.'TRAN') THEN
  238. IVA=ICHPO4
  239. ICHPO4=ITLAC5.ITLAC(IVA)
  240. IVA=ICHPO6
  241. ICHPO6=ITLAC2.ITLAC(IVA)
  242. IVA=ICHPO7
  243. ICHPO7=ITLAC2.ITLAC(IVA)
  244. ELSEIF(CHAMOB(I).EQ.'ROTA') THEN
  245. IVA=ICHPO4
  246. ICHPO4=ITLAC5.ITLAC(IVA)
  247. IVA=ICHPO5
  248. IF(IDIM.GT.2) ICHPO5=ITLAC5.ITLAC(IVA)
  249. IVA=ICHPO6
  250. ICHPO6=ITLAC2.ITLAC(IVA)
  251. IVA=ICHPO7
  252. ICHPO7=ITLAC2.ITLAC(IVA)
  253. ELSEIF(CHAMOB(I).EQ.'TRAJ') THEN
  254. IVA=ICHPO4
  255. ICHPO4=ITLAC1.ITLAC(IVA)
  256. IVA=ICHPO5
  257. ICHPO5=ITLAC6.ITLAC(IVA)
  258. IVA=ICHPO6
  259. ICHPO6=ITLAC2.ITLAC(IVA)
  260. ENDIF
  261. SEGDES ICHARG
  262. 3001 CONTINUE
  263. SEGDES MCHARG
  264. 3000 CONTINUE
  265. GOTO 1098
  266. C ************************ *****************************
  267. 6021 CONTINUE
  268. GOTO 1098
  269. C *********************MEVOLL************************************
  270. 6022 CONTINUE
  271. ITLAC1=KCOLA(1)
  272. ITLAC2=KCOLA(18)
  273. DO 3200 IEL=1,IMAX1
  274. MEVOLL=ITLAC(IEL)
  275. SEGACT MEVOLL
  276. N=IEVOLL(/1)
  277. DO 3201 I=1,N
  278. KEVOLL=IEVOLL(I)
  279. SEGACT KEVOLL
  280. IVA=IPROGX
  281. IPROGX=ITLAC2.ITLAC(IVA)
  282. IVA=IPROGY
  283. IPROGY=ITLAC2.ITLAC(IVA)
  284. SEGDES KEVOLL
  285. 3201 CONTINUE
  286. SEGDES MEVOLL
  287. 3200 CONTINUE
  288. GOTO 1098
  289. C ******************************************************************
  290. 1098 CONTINUE
  291. C
  292. 1099 CONTINUE
  293. SEGDES ICOLAC
  294. C
  295. RETURN
  296. END
  297.  
  298.  
  299.  
  300.  
  301.  
  302.  
  303.  
  304.  
  305.  
  306.  

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