Sources Esope | Cast3M

ch2vec
C CH2VEC    SOURCE    CB215821  20/11/25    13:19:10     10792          
      SUBROUTINE CH2VEC(MCHPOI,MINC,KISPG,IDMAT,KVEC,IMPR,IRET)
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
C***********************************************************************
C NOM         : CH2VEC
C DESCRIPTION :
C
C     Ce sp effectue la surcharge :
C     chpoint (MCHPOI) -> vecteur (KVEC pointeur de type IZA).
C     L'ordonnancement des inconnues est
C     donné par MINC, les points concernés par KISPG et IDMAT
C     donne le passage num. ancienne -> num. nouvelle (NUAN)
C
C     Son alter ego est vec2ch.
C
C     Les valeurs non nulles de MCHPOI NE correspondant
C     PAS à des inconnues du vecteur KVEC donnent lieu à
C     l'émission d'un warning.
C
C
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 APPELES     : KRIPAD
C***********************************************************************
C ENTREES            : MCHPOI, MINC, KISPG, IDMAT, IMPR
C ENTREES/SORTIES    : KVEC
C SORTIES            : IRET
C CODE RETOUR (IRET) : inutilisé (=0 tout marche !)
C
C     MCHPOI : pointeur sur segment MCHPOI de l'include SMCHPOI
C              chpoint de surchargement pour le vecteur KVEC.
C     MINC   : pointeur sur segment MINC de l'include SMMATRIK
C              décrit l'ordonnancement des inconnues dans une
C              certaine numérotation (dite "nouvelle").
C     KISPG  : pointeur sur segment MELEME de l'include SMELEME
C              support géométrique des inconnues.
C     IDMAT  : pointeur sur segment IDMAT de l'include SMMATRIK
C              contient le tableau NUAN permettant de faire
C              le passage numérotation ancienne -> num. "nouvelle".
C     IMPR   : niveau d'impression
C     KVEC   : pointeur sur segment IZA de l'include SMMATRIK
C              contient le vecteur des inconnues à surcharger.
C              (Il est donc initialisé avant l'appel à ch2vec)
C
C***********************************************************************
C VERSION    : v2, 01/12/99
C HISTORIQUE : v1, 01/04/98, création
C HISTORIQUE : v2; 01/12/99, modifs (nouvelle signification de NUAN)
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 KVEC.IZA
-INC SMCHPOI
-INC SMELEME
      POINTEUR KISPG.MELEME
-INC SMLENTI
      CHARACTER*(LOCOMP) NOMINC
      LOGICAL FLINC
*
      INTEGER IMPR,IRET
*
      INTEGER I1,IN,INBI,INBVA
      INTEGER INC,L,N,NBI,NC,NSOUPO
*
      IRET=0
C
      IF (IMPR.GT.5) WRITE(IOIMP,*) 'Entrée dans ch2vec.eso'
C
      IF (IMPR.GT.6) THEN
         WRITE(IOIMP,*) ' ch2vec : entrées '
         WRITE(IOIMP,*) ' MCHPOI = ',MCHPOI
         WRITE(IOIMP,*) ' MINC   = ',MINC
         WRITE(IOIMP,*) ' KISPG  = ',KISPG
         WRITE(IOIMP,*) ' IDMAT  = ',IDMAT
      ENDIF
C
      SEGACT MINC
      NBI=LISINC(/2)
C In KRIPAD : SEGACT KISPG
C             SEGINI MLENTI
C      write(ioimp,*) 'kispg'
C      call ecmail(kispg,0)
C      write(ioimp,*) 'minc'
C      write(ioimp,*) 'minc lisinc',(lisinc(i),i=1,lisinc(/2))
C      write(ioimp,*) 'minc npos  ',(npos(i),i=1,npos(/1))
C      do i=1,mpos(/1)
C         write(ioimp,*) 'minc mpos  (',i,')=',(mpos(i,j),j=1,mpos(/2))
C      enddo
      CALL KRIPAD(KISPG,MLENTI)
C      write(ioimp,*) 'mlenti  ',(lect(i),i=1,lect(/1))
      SEGACT IDMAT
      SEGACT MCHPOI
      NSOUPO=IPCHP(/1)
      DO 1 L=1,NSOUPO
         MSOUPO=IPCHP(L)
         SEGACT MSOUPO
         NC=NOCOMP(/2)
         MELEME=IGEOC
         MPOVAL=IPOVAL
         SEGACT MELEME
         N=NUM(/2)
         IF (N.EQ.0) GOTO 15
         SEGACT MPOVAL
         DO 2 INC=1,NC
            NOMINC=NOCOMP(INC)
            FLINC=.FALSE.
C  Repeat..until
            INBI=1
 21         CONTINUE
            IF (NOMINC.EQ.LISINC(INBI)) THEN
               FLINC=.TRUE.
            ELSEIF (INBI.LT.NBI) THEN
               INBI=INBI+1
               GOTO 21
            ENDIF
            IF (.NOT.FLINC) THEN
*               WRITE(IOIMP,*) ' ch2vec : Composante ',NOMINC,' unknown '
            ELSE
               N=VPOCHA(/1)
               DO 3 IN=1,N
                  I1=LECT(NUM(1,IN))
                  IF(I1.EQ.0)THEN
*    Silence dans les rangs !
*                     WRITE(IOIMP,*) ' ch2vec : le point ',NUM(1,IN),
*     $                    ' inconnue : ', NOCOMP(INC)
*                     WRITE(IOIMP,*) ' n''appartient pas au vec.'
                  ELSE
                     IF (MPOS(I1,INBI).NE.0) THEN
                        INBVA=NUAN(NPOS(I1)+MPOS(I1,INBI)-1)
C                     INBVA=NPOS(NUAN(I1))+MPOS(NUAN(I1),INBI)-1
C                    KVEC.A(INBVA)=KVEC.A(INBVA)+VPOCHA(IN,INC)
C Je préfère surcharger
C
*                        WRITE(IOIMP,*) ' ch2vec : le point ',NUM(1,IN),
*     $                       ' inconnue : ', NOCOMP(INC) , 'valeur ',
*     $                       VPOCHA(IN,INC)
*                        WRITE(IOIMP,*) ' attribue au ddl ',INBVA
                        KVEC.A(INBVA)=VPOCHA(IN,INC)
                     ENDIF
                  ENDIF
 3             CONTINUE
            ENDIF
 2       CONTINUE
 15      CONTINUE
 1    CONTINUE
      SEGDES IDMAT,MINC
      SEGSUP MLENTI
*
*     Normal termination
*
      RETURN
*
* End of CH2VEC
*
      END