Sources Esope | Cast3M

incor2
C INCOR2    SOURCE    GOUNAND   25/04/30    21:15:06     12258          
      SUBROUTINE INCOR2(MATELE,LITOT,MLAG1,MLAG2)
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
C***********************************************************************
C NOM         : INCOR2
C DESCRIPTION :
C
C Construction de l'ensemble des noms d'inconnues possibles LITOT.
C     MLAG1 contient les multiplicateurs de Lagrange a placer apres les
C     inconnues auxquelles ils se rapportent
C     MLAG2 contient les multiplicateurs de Lagrange a placer avant les
C     inconnues auxquelles ils se rapportent
C
C
C LANGAGE     : ESOPE
C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
C               mél : gounand@semt2.smts.cea.fr
C***********************************************************************
C SYNTAXE GIBIANE    :
C ENTREES            :
C ENTREES/SORTIES    :
C SORTIES            :
C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
C***********************************************************************
C VERSION    : v1, 24/03/2004, version initiale
C HISTORIQUE : v1, 24/03/2004, création
C HISTORIQUE :     24/04/2025, simplification
C HISTORIQUE :
C***********************************************************************
 
-INC PPARAM
-INC CCOPTIO
-INC SMMATRIK
      POINTEUR MATELE.MATRIK
      POINTEUR IMATEL.IMATRI
-INC SMLMOTS
      POINTEUR GPINCS.MLMOTS
      POINTEUR LITOT.MLMOTS
      POINTEUR LITOT2.MLMOTS
      POINTEUR MLAG1.MLMOTS
      POINTEUR MLAG2.MLMOTS
-INC SMLENTI
      POINTEUR LINIV.MLENTI
      POINTEUR LINIV2.MLENTI
      POINTEUR LITYP.MLENTI
      POINTEUR LITYP2.MLENTI
      POINTEUR LORD.MLENTI
      POINTEUR LIORD.MLENTI
C!      POINTEUR LIORD2.MLENTI
      POINTEUR LIPERM.MLENTI
      LOGICAL LOK
*
      INTEGER LNMOTS
      PARAMETER (LNMOTS=8)
      CHARACTER*8 MONMOT,MONMOD,MONMOP
      LOGICAL LRELA
      LOGICAL LTYP1
*
* Executable statements
*
*      WRITE(IOIMP,*) 'Entrée dans incor2.eso'
*
      SEGACT MATELE
      NMATE = MATELE.IRIGEL(/2)
*
* Construction de la liste des inconnues
*
      NBMTOT=0
      DO 3 IMATE=1,NMATE
         IMATEL=MATELE.IRIGEL(4,IMATE)
         SEGACT IMATEL
         NBMTOT=NBMTOT+IMATEL.LISPRI(/2)
 3    CONTINUE
      JGN=LNMOTS
      JGM=2*NBMTOT
      SEGINI GPINCS
      SEGINI LITOT
      NBM2=0
      DO 4 IMATE=1,NMATE
         IMATEL=MATELE.IRIGEL(4,IMATE)
         DO 42 IBME=1,IMATEL.LISPRI(/2)
            NBM2=NBM2+1
            GPINCS.MOTS(NBM2)=IMATEL.LISPRI(IBME)
 42      CONTINUE
         DO 43 IBME=1,IMATEL.LISDUA(/2)
            NBM2=NBM2+1
            GPINCS.MOTS(NBM2)=IMATEL.LISDUA(IBME)
 43      CONTINUE
 4    CONTINUE
      CALL CUNIQ(GPINCS.MOTS,LNMOTS,NBM2,
     $     LITOT.MOTS,NBUNIQ,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      JGN=LNMOTS
      JGM=NBUNIQ
      SEGADJ LITOT
      SEGSUP GPINCS
*
*      SEGPRT,LITOT
*
* Construction de la liste des types
      JG=LITOT.MOTS(/2)
      SEGINI LITYP
      N1=0
      N2=0
*
* On parcourt la liste des noms pour donner un type trusted (1)
* ou multiplicateur de Lagrange premier (3) ou deuxième (4).
*      DO ITOT=1,LITOT.MOTS(/2)
**         IF (LITOT.MOTS(ITOT)(1:1).EQ.'$') THEN
**            LITYP.LECT(ITOT)=1
**         ELSEIF (LITOT.MOTS(ITOT)(1:2).EQ.'LX') THEN
*         IF (LITOT.MOTS(ITOT)(1:2).EQ.'LX') THEN
*            LITYP.LECT(ITOT)=3
*         ELSEIF (LITOT.MOTS(ITOT)(1:2).EQ.'MX') THEN
*            LITYP.LECT(ITOT)=4
*         ENDIF
*      ENDDO
      DO IMATE=1,NMATE
         IMATYP=MATELE.IRIGEL(7,IMATE)
         IF (IMATYP.EQ.4.OR.IMATYP.EQ.-3.OR.IMATYP.EQ.-4) THEN
            IMATEL=MATELE.IRIGEL(4,IMATE)
            SEGACT IMATEL
            DO IBME=1,IMATEL.LISDUA(/2)
               MONMOT=IMATEL.LISDUA(IBME)
               CALL FIMOTS(MONMOT,LITOT,IORD,IMPR,IRET)
               IF (IRET.NE.0) GOTO 9999
               IF (IMATYP.EQ.-4) THEN
                  IF (LITYP.LECT(IORD).NE.2) THEN
                     N2=N2+1
                     LITYP.LECT(IORD)=2
                  ENDIF
               ELSE
                  IF (LITYP.LECT(IORD).NE.1) THEN
                     N1=N1+1
                     LITYP.LECT(IORD)=1
                  ENDIF
               ENDIF
            ENDDO
         ENDIF
      ENDDO
*
* On ajoute les inconnues à MLAG1 ou MLAG2 si nécessaire
*
      IF (N1.GT.0) THEN
         IF (MLAG1.NE.0) THEN
            SEGACT MLAG1*MOD
            JGN=MLAG1.MOTS(/1)
            IDX1=MLAG1.MOTS(/2)
            JGM=IDX1+N1
            SEGADJ MLAG1
         ELSE
            JGN=LOCHPO
            JGM=N1
            SEGINI MLAG1
            IDX1=0
         ENDIF
         I1=0
      ENDIF
      IF (N2.GT.0) THEN
         IF (MLAG2.NE.0) THEN
            SEGACT MLAG2*MOD
            JGN=MLAG2.MOTS(/1)
            IDX2=MLAG2.MOTS(/2)
            JGM=IDX2+N2
            SEGADJ MLAG2
         ELSE
            JGN=LOCHPO
            JGM=N2
            SEGINI MLAG2
            IDX2=0
         ENDIF
         I2=0
      ENDIF
*
      DO IINC=1,LITOT.MOTS(/2)
         IF (LITYP.LECT(IINC).EQ.1) THEN
            I1=I1+1
            MLAG1.MOTS(IDX1+I1)=LITOT.MOTS(IINC)
         ELSEIF (LITYP.LECT(IINC).EQ.2) THEN
            I2=I2+1
            MLAG2.MOTS(IDX2+I2)=LITOT.MOTS(IINC)
         ENDIF
      ENDDO
 
*     SEGPRT,LITYP
 
 
      SEGSUP LITYP
*
* Normal termination
*
      IRET=0
      RETURN
*
* Format handling
*
*
* Error handling
*
 9999 CONTINUE
      IRET=1
      WRITE(IOIMP,*) 'An error was detected in subroutine incor2'
      RETURN
*
* End of subroutine INCOR2
*
      END