Sources Esope | Cast3M

calnu6
C CALNU6    SOURCE    GOUNAND   25/04/30    21:15:02     12258          
      SUBROUTINE CALNU6(KMINCT,PMTOT,IZATOT,
     $     IRENU,
     $     KTYPI,IORINC,MLAG1,MLAG2,
     $     IPBLOC,
     $     NEWNUM,
     $     IMPR,IRET)
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
C***********************************************************************
C NOM         : CALNU6
C PROJET      : Noyau linéaire NLIN
C DESCRIPTION : Calcul d'une renumérotation avec minimisation d'un
C               profil PUIS placement des inconnues suivant l'ordre
C               donné par LIORD
C               Dans calnum, on effectuait les choses suivantes :
C               - minimisation du profil sur les ddl sans les ML.
C               - insertion des ML dans la nouvelle numérotation
C               Maintenant, on essaie la chose suivante :
C               - minimisation du profil sur les ddl AVEC les ML.;
C               - retrait des ML de la numérotation ;
C               - réinsertion des ML pour les placer après les ddl non
C     ML auxquels ils sont liés.
C
C     On essaie de faire correctement le traitement des multiplicateurs
C     de Lagrange.
C
C
C
C  IRENU=1 'RIEN' : pas de renumérotation
C        2 'SLOA' : algorithme de chez Sloan
C        3 'GIPR' : Gibbs-King (profile reduction)
C        4 'GIBA' : Gibbs-Poole-Stockmeyer (bandwidth reduction)
C
C LANGAGE     : ESOPE
C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
C               mél : gounand@semt2.smts.cea.fr
C***********************************************************************
C APPELES          : RENUME
C APPELES (UTIL.)  : ISETI, ISHELI, RSETXI
C APPELE PAR       : PRASEM
C***********************************************************************
C ENTREES            : KMINCT, PMTOT, IRENU
C SORTIES            : NEWNUM
C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
C***********************************************************************
C VERSION    : v1, 22/04/2025, version initiale
C HISTORIQUE : v1, 22/04/2025, création
C HISTORIQUE :
C***********************************************************************
C
-INC PPARAM
-INC CCOPTIO
-INC SMMATRIK
      POINTEUR KMINCT.MINC
      POINTEUR PMTOT.PMORS
      POINTEUR IZATOT.IZA
-INC SMLENTI
      INTEGER JG
      POINTEUR LITYP.MLENTI
      POINTEUR LINIV.MLENTI
      POINTEUR DDLINC.MLENTI
*inu      POINTEUR DDLPT.MLENTI
      POINTEUR NEWNUM.MLENTI
      POINTEUR KRDDL.MLENTI
      POINTEUR NNUTOT.MLENTI
      POINTEUR PRMDDL.MLENTI
      SEGMENT LML
      POINTEUR ML(NINC).MLENTI
      ENDSEGMENT
      POINTEUR DDLDIM.MLENTI
      POINTEUR ITTDDL.MLENTI
      POINTEUR INUDDL.MLENTI
      POINTEUR LDD.LML
      POINTEUR LDDI.MLENTI
      POINTEUR NNU.LML
      POINTEUR NNUI.MLENTI
      POINTEUR NNUJ.MLENTI
      POINTEUR NNUK.MLENTI
      POINTEUR PRM.LML
      POINTEUR PRMI.MLENTI
*-INC SMLLOGI
      SEGMENT MLLOGI
      LOGICAL LOGI(JG)
      ENDSEGMENT
      POINTEUR DDLOK.MLLOGI
*      POINTEUR PTLAG.MLLOGI
      POINTEUR DDLLAG.MLLOGI
*
*STAT-INC SMSTAT
*
      INTEGER IMPR,IRET
      INTEGER IRENU
*
      INTEGER ITOTPO,JTTDDL
      INTEGER NTOTPO,NTTDDL
      LOGICAL LLAG,LRELA,LMG
*
* Executable statements
*
      IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans calnu6'
*
* Construction de DDLINC : c'est un tableau d'entiers tel que :
* DDLINC(jttddl) = ordre du ddl
*
*      SEGPRT,KMINCT
*      SEGPRT,PMTOT
*      SEGPRT,LITYP
*      SEGPRT,LINIV
* Obtention de la nouvelle numérotation des ddl
* In RENUME : SEGINI NNUTOT
      CALL RENUME(PMTOT,IRENU,NNUTOT,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      LMG=(KTYPI.EQ.7.OR.KTYPI.EQ.8.OR.KTYPI.EQ.10.OR.KTYPI.EQ.11)
*      write(ioimp,*) 'LMG=',LMG
      IF (LMG) THEN
         CALL KRES23(KMINCT,PMTOT,IZATOT,NNUTOT,IORINC,KTYPI,
     $        NEWNUM,IPBLOC)
         IF (IERR.NE.0) GOTO 9999
      ELSE
         CALL KRES24(KMINCT,PMTOT,NNUTOT,MLAG1,MLAG2,
     $        NEWNUM)
         IF (IERR.NE.0) GOTO 9999
         IPBLOC=0
      ENDIF
      IF (NEWNUM.NE.NNUTOT) SEGSUP NNUTOT
*
* Normal termination
*
      IRET=0
      RETURN
*
* Format handling
*
*
* Error handling
*
 9999 CONTINUE
      IRET=1
      WRITE(IOIMP,*) 'An error was detected in subroutine calnu6'
      RETURN
*
* End of subroutine CALNU6
*
      END