Télécharger calnu5.eso

Retour à la liste

Numérotation des lignes :

  1. C CALNU5 SOURCE PV 16/11/17 21:58:20 9180
  2. SUBROUTINE CALNU5(LITYP,LINIV,KMINCT,PMTOT,
  3. $ IRENU,
  4. $ NEWNUM,
  5. $ IMPR,IRET)
  6. IMPLICIT REAL*8 (A-H,O-Z)
  7. IMPLICIT INTEGER (I-N)
  8. C***********************************************************************
  9. C NOM : CALNU5
  10. C PROJET : Noyau linéaire NLIN
  11. C DESCRIPTION : Calcul d'une renumérotation avec minimisation d'un
  12. C profil PUIS placement des inconnues suivant l'ordre
  13. C donné par LIORD
  14. C Dans calnum, on effectuait les choses suivantes :
  15. C - minimisation du profil sur les ddl sans les ML.
  16. C - insertion des ML dans la nouvelle numérotation
  17. C Maintenant, on essaie la chose suivante :
  18. C - minimisation du profil sur les ddl AVEC les ML.;
  19. C - retrait des ML de la numérotation ;
  20. C - réinsertion des ML pour les placer après les ddl non
  21. C ML auxquels ils sont liés.
  22. C
  23. C IRENU=1 'RIEN' : pas de renumérotation
  24. C 2 'SLOA' : algorithme de chez Sloan
  25. C 3 'GIPR' : Gibbs-King (profile reduction)
  26. C 4 'GIBA' : Gibbs-Poole-Stockmeyer (bandwidth reduction)
  27. C
  28. C LANGAGE : ESOPE
  29. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  30. C mél : gounand@semt2.smts.cea.fr
  31. C***********************************************************************
  32. C APPELES : RENUME
  33. C APPELES (UTIL.) : ISETI, ISHELI, RSETXI
  34. C APPELE PAR : PRASEM
  35. C***********************************************************************
  36. C ENTREES : KMINCT, PMTOT, IRENU
  37. C SORTIES : NEWNUM
  38. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  39. C***********************************************************************
  40. C VERSION : v1, 01/04/04, version initiale
  41. C HISTORIQUE : v1, 01/04/04, création
  42. C HISTORIQUE :
  43. C HISTORIQUE :
  44. C***********************************************************************
  45. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  46. C en cas de modification de ce sous-programme afin de faciliter
  47. C la maintenance !
  48. C***********************************************************************
  49. -INC CCOPTIO
  50. POINTEUR KMINCT.MINC
  51. POINTEUR PMTOT.PMORS
  52. -INC SMLENTI
  53. INTEGER JG
  54. POINTEUR LITYP.MLENTI
  55. POINTEUR LINIV.MLENTI
  56. POINTEUR DDLINC.MLENTI
  57. *inu POINTEUR DDLPT.MLENTI
  58. POINTEUR NEWNUM.MLENTI
  59. POINTEUR KRDDL.MLENTI
  60. POINTEUR NNUTOT.MLENTI
  61. POINTEUR PRMDDL.MLENTI
  62. SEGMENT LML
  63. POINTEUR ML(NINC).MLENTI
  64. ENDSEGMENT
  65. POINTEUR DDLDIM.MLENTI
  66. POINTEUR ITTDDL.MLENTI
  67. POINTEUR INUDDL.MLENTI
  68. POINTEUR LDD.LML
  69. POINTEUR LDDI.MLENTI
  70. POINTEUR NNU.LML
  71. POINTEUR NNUI.MLENTI
  72. POINTEUR NNUJ.MLENTI
  73. POINTEUR NNUK.MLENTI
  74. POINTEUR PRM.LML
  75. POINTEUR PRMI.MLENTI
  76. *-INC SMLLOGI
  77. SEGMENT MLLOGI
  78. LOGICAL LOGI(JG)
  79. ENDSEGMENT
  80. POINTEUR DDLOK.MLLOGI
  81. POINTEUR PTLAG.MLLOGI
  82. *
  83. *STAT-INC SMSTAT
  84. *
  85. INTEGER IMPR,IRET
  86. INTEGER IRENU
  87. *
  88. INTEGER ITOTPO,JTTDDL
  89. INTEGER NTOTPO,NTTDDL
  90. LOGICAL LLAG,LRELA
  91. *
  92. * Executable statements
  93. *
  94. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans calnu5'
  95. *
  96. * Construction de DDLINC : c'est un tableau d'entiers tel que :
  97. * DDLINC(jttddl) = ordre du ddl
  98. *
  99. C SEGPRT,KMINCT
  100. C SEGPRT,LITYP
  101. C SEGPRT,LINIV
  102. SEGACT KMINCT
  103. SEGACT LITYP
  104. SEGACT LINIV
  105. NINC=KMINCT.LISINC(/2)
  106. MAXNIV=0
  107. DO IINC=1,NINC
  108. MAXNIV=MAX(MAXNIV,LINIV.LECT(IINC))
  109. ENDDO
  110. *
  111. * Construction de DDLINC et DDLPT : sorte de segment réciproque
  112. * de KMINCT
  113. * En fait, DDLPT est inutile pour la suite.
  114. * Construction de PTLAG : liste des points sur lesquels
  115. * il n'y a que des inconnues de niveau > 1
  116. *!* Non ! il n'y a que des multiplicateurs de Lagrange
  117. *
  118. NTOTPO=KMINCT.NPOS(/1)-1
  119. NTTDDL=KMINCT.NPOS(NTOTPO+1)-1
  120. JG=NTTDDL
  121. SEGINI DDLINC
  122. *inu JG=NTTDDL
  123. *inu SEGINI DDLPT
  124. JG=NTOTPO
  125. SEGINI PTLAG
  126. LRELA=.FALSE.
  127. DO ITOTPO=1,NTOTPO
  128. LLAG=.TRUE.
  129. DO IINC=1,NINC
  130. IPOS=KMINCT.MPOS(ITOTPO,IINC)
  131. IF (IPOS.NE.0) THEN
  132. JPOS=KMINCT.NPOS(ITOTPO)+IPOS-1
  133. DDLINC.LECT(JPOS)=IINC
  134. *inu DDLPT.LECT(JPOS)=ITOTPO
  135. * Non ! IF (LITYP.LECT(IINC).LE.2) THEN
  136. IF (LINIV.LECT(IINC).LT.2) THEN
  137. LLAG=.FALSE.
  138. ENDIF
  139. ENDIF
  140. ENDDO
  141. PTLAG.LOGI(ITOTPO)=LLAG
  142. LRELA=LRELA.OR.LLAG
  143. ENDDO
  144. C SEGPRT,DDLINC
  145. C SEGPRT,DDLPT
  146. C SEGPRT,PTLAG
  147. *inu SEGSUP DDLPT
  148. *
  149. * Construction des tableaux d'entiers suivants :
  150. * LDD.IINC(1..NTTINC) liste des ddl de l'inconnue iinc
  151. * DDLINC(JTTDDL)=IINC : numéro de l'inconnue du ddl de numéro jttddl
  152. * KRDDL(JTTDDL)=ITTINC avec LDD.IINC(ITTINC)
  153. *
  154. SEGINI LDD
  155. JG=NINC
  156. SEGINI DDLDIM
  157. DO IINC=1,NINC
  158. JG=0
  159. SEGINI LDDI
  160. LDD.ML(IINC)=LDDI
  161. ENDDO
  162. JG=NTTDDL
  163. SEGINI KRDDL
  164. DO JTTDDL=1,NTTDDL
  165. IINC=DDLINC.LECT(JTTDDL)
  166. LDDI=LDD.ML(IINC)
  167. ITTINC=DDLDIM.LECT(IINC)+1
  168. LDDI.LECT(**)=JTTDDL
  169. KRDDL.LECT(JTTDDL)=ITTINC
  170. DDLDIM.LECT(IINC)=ITTINC
  171. ENDDO
  172. C SEGPRT,DDLDIM
  173. C SEGPRT,LDD
  174. C DO IINC=1,NINC
  175. C LDDI=LDD.ML(IINC)
  176. C SEGPRT,LDDI
  177. C ENDDO
  178. C SEGPRT,KRDDL
  179. *STAT CALL PRMSTA(' Préparation renume divers',MSTAT,IMPR)
  180. *
  181. * Obtention de la nouvelle numérotation des ddl
  182. * In RENUME : SEGINI NNUTOT
  183. * In RENUME : SEGDES NNUTOT
  184. CALL RENUME(PMTOT,IRENU,NNUTOT,IMPR,IRET)
  185. IF (IRET.NE.0) GOTO 9999
  186. C SEGPRT,NNUTOT
  187. *STAT CALL PRMSTA(' Après renume',MSTAT,IMPR)
  188. *
  189. * Construction des NNUs pour les points où il n'y a pas de
  190. * multiplicateurs de Lagrange
  191. *
  192. SEGACT,NNUTOT
  193. * NINC=NINC
  194. SEGINI NNU
  195. DO IINC=1,NINC
  196. JG=DDLDIM.LECT(IINC)
  197. SEGINI NNUI
  198. NNU.ML(IINC)=NNUI
  199. ENDDO
  200. DO ITOTPO=1,NTOTPO
  201. IF (.NOT.PTLAG.LOGI(ITOTPO)) THEN
  202. INNU=0
  203. DO IINC=1,NINC
  204. IPOS=KMINCT.MPOS(ITOTPO,IINC)
  205. IF (IPOS.NE.0) THEN
  206. JPOS=KMINCT.NPOS(ITOTPO)+IPOS-1
  207. IF (INNU.EQ.0) THEN
  208. INNU=NNUTOT.LECT(JPOS)
  209. ENDIF
  210. NNUI=NNU.ML(IINC)
  211. KRNNUI=KRDDL.LECT(JPOS)
  212. NNUI.LECT(KRNNUI)=INNU
  213. ENDIF
  214. ENDDO
  215. ENDIF
  216. ENDDO
  217. SEGSUP NNUTOT
  218. C SEGPRT,NNU
  219. C DO IINC=1,NINC
  220. C NNUI=NNU.ML(IINC)
  221. C SEGPRT,NNUI
  222. C ENDDO
  223. IF (LRELA) THEN
  224. C
  225. C Obtention des numéros des ddl portant sur des points
  226. C où il n'y a que des multiplicateurs de Lagrange
  227. C le max ou le min des ddl de niveau INIV-1 qui lui sont
  228. C reliés
  229. C
  230. SEGACT PMTOT
  231. DO INIV=2,MAXNIV
  232. DO IINC=1,NINC
  233. JNIV=LINIV.LECT(IINC)
  234. IF (JNIV.EQ.INIV) THEN
  235. JTYP=LITYP.LECT(IINC)
  236. DO ITOTPO=1,NTOTPO
  237. IF (PTLAG.LOGI(ITOTPO)) THEN
  238. IPOS=KMINCT.MPOS(ITOTPO,IINC)
  239. IF (IPOS.NE.0) THEN
  240. JTTDDL=KMINCT.NPOS(ITOTPO)+IPOS-1
  241. JNNU=0
  242. KSTRT=PMTOT.IA(JTTDDL)
  243. KSTOP=PMTOT.IA(JTTDDL+1)-1
  244. DO KIND=KSTRT,KSTOP
  245. KTTDDL=PMTOT.JA(KIND)
  246. KINC=DDLINC.LECT(KTTDDL)
  247. KNIV=LINIV.LECT(KINC)
  248. IF (KNIV.EQ.INIV-1) THEN
  249. NNUK=NNU.ML(KINC)
  250. KRNNUK=KRDDL.LECT(KTTDDL)
  251. KNNU=NNUK.LECT(KRNNUK)
  252. IF (KNNU.EQ.0) THEN
  253. WRITE(IOIMP,*) 'Erreur trop grave'
  254. GOTO 9999
  255. ENDIF
  256. IF (JNNU.EQ.0) THEN
  257. JNNU=KNNU
  258. ELSE
  259. IF (JTYP.EQ.4) THEN
  260. JNNU=MIN(JNNU,KNNU)
  261. *! ELSEIF (JTYP.EQ.3) THEN
  262. ELSEIF (JTYP.EQ.3.OR.JTYP.EQ.2) THEN
  263. JNNU=MAX(JNNU,KNNU)
  264. ELSE
  265. WRITE(IOIMP,*) 'Erreur grave 1.2'
  266. GOTO 9999
  267. ENDIF
  268. ENDIF
  269. ENDIF
  270. ENDDO
  271. ENDIF
  272. ENDIF
  273. ENDDO
  274. IF (JNNU.EQ.0) THEN
  275. WRITE(IOIMP,*) 'Erreur grave 1.5'
  276. GOTO 9999
  277. ENDIF
  278. NNUJ=NNU.ML(IINC)
  279. KRNNUJ=KRDDL.LECT(JTTDDL)
  280. NNUJ.LECT(KRNNUJ)=JNNU
  281. ENDIF
  282. ENDDO
  283. ENDDO
  284. SEGDES PMTOT
  285. ENDIF
  286. SEGSUP KRDDL
  287. SEGSUP PTLAG
  288. SEGSUP DDLINC
  289. SEGDES LINIV
  290. SEGDES LITYP
  291. SEGDES KMINCT
  292. C SEGPRT,NNU
  293. C DO IINC=1,NINC
  294. C NNUI=NNU.ML(IINC)
  295. C SEGPRT,NNUI
  296. C ENDDO
  297. *
  298. * 1 On calcule les permutations qui permettent de trier NNU
  299. * par ordre croissant de nouveau numéro.
  300. *
  301. SEGINI PRM
  302. DO IINC=1,NINC
  303. NTTINC=DDLDIM.LECT(IINC)
  304. JG=NTTINC
  305. SEGINI PRMI
  306. CALL ISETI(PRMI.LECT,NTTINC)
  307. PRM.ML(IINC)=PRMI
  308. NNUI=NNU.ML(IINC)
  309. CALL ISHELI(NTTINC,PRMI.LECT,NTTINC,NNUI.LECT,
  310. $ IMPR,IRET)
  311. IF (IRET.NE.0) GOTO 9999
  312. ENDDO
  313. C SEGPRT,PRM
  314. C DO IORD=1,NORD
  315. C PRMI=PRM.ML(IORD)
  316. C SEGPRT,PRMI
  317. C ENDDO
  318. *
  319. * 3 En "merge"ant les listes précédentes, on obtient
  320. * la permutation réciproque de la nouvelle numérotation
  321. * totale que l'on cherche (si, si !)
  322. *
  323. JG=NTTDDL
  324. SEGINI PRMDDL
  325. JG=NINC
  326. SEGINI ITTDDL
  327. DO IINC=1,NINC
  328. ITTDDL.LECT(IINC)=1
  329. ENDDO
  330. JG=NINC
  331. SEGINI DDLOK
  332. DO IINC=1,NINC
  333. DDLOK.LOGI(IINC)=(ITTDDL.LECT(IINC).LE.DDLDIM.LECT(IINC))
  334. ENDDO
  335. JG=NINC
  336. SEGINI INUDDL
  337. DO IINC=1,NINC
  338. IF (DDLOK.LOGI(IINC)) THEN
  339. NNUI=NNU.ML(IINC)
  340. PRMI=PRM.ML(IINC)
  341. * IITT=ITTDDL.LECT(IORD)
  342. * IPRM=PRM1.LECT(IITT)
  343. * INNU=NNU1.LECT(IPRM)
  344. INUDDL.LECT(IINC)=NNUI.LECT(PRMI.LECT(ITTDDL.LECT(IINC)))
  345. ENDIF
  346. ENDDO
  347. DO JTTDDL=1,NTTDDL
  348. JNUMIN=0
  349. JINC=0
  350. DO IINC=1,NINC
  351. IF (DDLOK.LOGI(IINC)) THEN
  352. IF (JNUMIN.EQ.0) THEN
  353. JNUMIN=INUDDL.LECT(IINC)
  354. JINC=IINC
  355. ELSE
  356. KNUMIN=INUDDL.LECT(IINC)
  357. IF (KNUMIN.LT.JNUMIN) THEN
  358. JNUMIN=KNUMIN
  359. JINC=IINC
  360. ENDIF
  361. ENDIF
  362. ENDIF
  363. ENDDO
  364. IF ((JNUMIN.EQ.0).OR.(JINC.EQ.0)) THEN
  365. WRITE(IOIMP,*) 'Erreur trop grave 2'
  366. GOTO 9999
  367. ENDIF
  368. LDDI=LDD.ML(JINC)
  369. NNUI=NNU.ML(JINC)
  370. PRMI=PRM.ML(JINC)
  371. KTTDDL=ITTDDL.LECT(JINC)
  372. PRMDDL.LECT(JTTDDL)=LDDI.LECT(PRMI.LECT(KTTDDL))
  373. ITTDDL.LECT(JINC)=KTTDDL+1
  374. DDLOK.LOGI(JINC)=(ITTDDL.LECT(JINC).LE.DDLDIM.LECT(JINC))
  375. IF (DDLOK.LOGI(JINC)) THEN
  376. NNUI=NNU.ML(JINC)
  377. PRMI=PRM.ML(JINC)
  378. INUDDL.LECT(JINC)=NNUI.LECT(PRMI.LECT(ITTDDL.LECT(JINC)))
  379. ENDIF
  380. ENDDO
  381. SEGSUP INUDDL
  382. SEGSUP DDLOK
  383. SEGSUP ITTDDL
  384. DO IINC=1,NINC
  385. PRMI=PRM.ML(IINC)
  386. SEGSUP PRMI
  387. ENDDO
  388. SEGSUP PRM
  389. DO IINC=1,NINC
  390. NNUI=NNU.ML(IINC)
  391. SEGSUP NNUI
  392. ENDDO
  393. SEGSUP NNU
  394. SEGSUP DDLDIM
  395. DO IINC=1,NINC
  396. LDDI=LDD.ML(IINC)
  397. SEGSUP LDDI
  398. ENDDO
  399. SEGSUP LDD
  400. * SEGPRT,PRMDDL
  401. *
  402. * D'où la nouvelle numérotation :
  403. *
  404. JG=NTTDDL
  405. SEGINI NEWNUM
  406. CALL RSETXI(NEWNUM.LECT,PRMDDL.LECT,NTTDDL)
  407. SEGDES NEWNUM
  408. SEGSUP PRMDDL
  409. *STAT CALL PRMSTA(' Merge et obtention NEWNUM',MSTAT,IMPR)
  410. * SEGPRT,NEWNUM
  411. * STOP 16
  412. *
  413. * Normal termination
  414. *
  415. IRET=0
  416. RETURN
  417. *
  418. * Format handling
  419. *
  420. *
  421. * Error handling
  422. *
  423. 9999 CONTINUE
  424. IRET=1
  425. WRITE(IOIMP,*) 'An error was detected in subroutine calnu5'
  426. RETURN
  427. *
  428. * End of subroutine CALNU5
  429. *
  430. END
  431.  
  432.  
  433.  
  434.  
  435.  
  436.  
  437.  
  438.  

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