Sources Esope | Cast3M

inctyp
C INCTYP    SOURCE    GOUNAND   25/03/24    21:15:03     12216          
      SUBROUTINE INCTYP(MATRIK,IORINC,
     $     ATYP,ANOD,
     $     IMPR,IRET)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C***********************************************************************
C NOM         : INCTYP
C DESCRIPTION :
C     Ce sp initialise le vecteur inconnue primale
C     (i.e. x de Ax=b) avec un chpoint d'inconnues primales.
C     On a en vue une méthode itérative de résolution.
C
C     Ce sp est quasiment identique à mesmbr.eso.
C     C'est une interface à ch2vec.
C
C
C LANGAGE     : ESOPE
C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF)
C               mél : gounand@semt2.smts.cea.fr
C***********************************************************************
C APPELE  : CH2VEC
C***********************************************************************
C ENTREES            : MATRIK, MCHINI, IMPR
C ENTREES/SORTIES    : -
C SORTIES            : INCX, IRET
C CODE RETOUR (IRET) : 0 si ok
C                     &lt;0 si problème
C     MATRIK : pointeur sur segment MATRIK de l'include SMMATRIK
C              on pioche dedans les informations nécessaires
C              (numérotations, inconnues, support géométriques)
C              pour effectuer la conversion MCHINI->INCX.
C     MCHINI : pointeur sur segment MCHPOI de l'include SMCHPOI
C              chpoint d'initialisation du vecteur INCX
C     IMPR   : niveau d'impression
C     INCX   : pointeur sur segment IZA de l'include SMMATRIK
C              vecteur x initial pour la résolution de Ax=b.
C              Il est initialisé à 0 si MCHINI est nul
C              sinon les valeurs non nulles de MCHINI
C              correspondant à des inconnues primales sont
C              chargées dans INCX.
C              Les valeurs non nulles de MCHINI NE correspondant
C              PAS à des inconnues primales donnent lieu à
C              l'émission d'un warning (cf. CH2VEC).
C***********************************************************************
C VERSION    : v1, 01/04/98, version initiale
C HISTORIQUE : v1, 01/04/98, création
C HISTORIQUE :
C HISTORIQUE :
C***********************************************************************
C Prière de PRENDRE LE TEMPS de compléter les commentaires
C en cas de modification de ce sous-programme afin de faciliter
C la maintenance !
C***********************************************************************
 
-INC PPARAM
-INC CCOPTIO
-INC SMMATRIK
      POINTEUR INCX.IZA
-INC SMLENTI
      POINTEUR ATYP.MLENTI
      POINTEUR ANOD.MLENTI
      POINTEUR KRINC.MLENTI
-INC SMLMOTS
      POINTEUR IORINC.MLMOTS
      POINTEUR IORINU.MLMOTS
C
      IRET=0
      SEGACT MATRIK
C Initialisation de l'inconnue à 0
      JG=KNTTP
      SEGINI ATYP
      SEGINI ANOD
      NBVA=KNTTP
      MINC=KMINCP
      SEGACT MINC
      NBI=LISINC(/2)
      JG=NBI
      SEGINI KRINC
*      WRITE(IOIMP,*) 'NBI,IORINC= ',NBI,IORINC
*
      IF (IORINC.NE.0) THEN
         SEGACT IORINC
         SEGINI,IORINU=IORINC
         JGN=IORINC.MOTS(/1)
         JGM=IORINC.MOTS(/2)
*         write(ioimp,*) 'JGN,JGM=',JGN,JGM
         CALL CUNIQ(IORINC.MOTS,JGN,JGM,IORINU.MOTS,JGMU,IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
         IF (JGM.NE.JGMU) THEN
            WRITE(IOIMP,*) 'IORINC ne doit pas avoir de doublons'
            GOTO 9999
         ENDIF
         SEGSUP IORINU
         IF (JGM.NE.NBI) THEN
            WRITE(IOIMP,*)
     $      'IORINC doit referencer toutes les inconnues de la matrice'
            GOTO 9999
         ENDIF
         CALL CREPER(JGN,NBI,JGM,MINC.LISINC,IORINC.MOTS,KRINC.LECT,IMPR
     $        ,IRET)
         IF (IRET.NE.0) GOTO 9999
      ELSE
         DO IBI=1,NBI
            KRINC.LECT(IBI)=IBI
         ENDDO
      ENDIF
      IF (IMPR.GT.2) THEN
         WRITE(IOIMP,*) 'NBI= ',NBI
         WRITE(IOIMP,*) 'MINC.LISINC(1..',NBI,')= '
         WRITE(IOIMP,*)(MINC.LISINC(II),II=1,NBI)
         IF (IORINC.NE.0) THEN
            WRITE(IOIMP,*) 'IORINC.MOTS(1..',NBI,')= '
            WRITE(IOIMP,*)(IORINC.MOTS(II),II=1,NBI)
         ENDIF
         WRITE(IOIMP,*) 'KRINC.LECT(1..',NBI,')= '
         WRITE(IOIMP,*)(KRINC.LECT(II),II=1,NBI)
      ENDIF
*
      NPT=NPOS(/1)-1
      IDMAT=KIDMAT(1)
      SEGACT IDMAT
      DO IBI=1,NBI
         JBI=KRINC.LECT(IBI)
         DO IPT=1,NPT
            IF (MPOS(IPT,IBI).NE.0) THEN
               ATYP.LECT(NUAN(NPOS(IPT)+
     $              MPOS(IPT,IBI)-1))=JBI
               ANOD.LECT(NUAN(NPOS(IPT)+
     $              MPOS(IPT,IBI)-1))=IPT
            ENDIF
         ENDDO
      ENDDO
      SEGDES IDMAT
      SEGDES MINC
      SEGSUP KRINC
C
      IF (IMPR.GT.5) THEN
         WRITE(IOIMP,*) 'inctyp.eso : création du pointeur ATYP=',ATYP
         IF (IMPR.GT.7) THEN
            WRITE(IOIMP,*) 'ATYP(1..',JG,')= '
            WRITE(IOIMP,1002)(ATYP.LECT(II),II=1,JG)
         ENDIF
      ENDIF
C
      SEGDES ATYP
      SEGDES MATRIK
*
*     Normal termination
*
      RETURN
*
* Format handling
*
 1002 FORMAT(10(1X,I7))
*
* Error handling
*
 9999 CONTINUE
      WRITE(IOIMP,*) 'An error was detected in inctyp.eso'
      RETURN
*
* End of INCTYP
*
      END