Télécharger la plaquette Cast3M


fr en

Télécharger calnu5.eso

Retour à la liste

Numérotation des lignes : 

calnu5

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

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