Télécharger calnu5.eso

Retour à la liste

Numérotation des lignes :

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

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