Sources Esope | Cast3M

krchp1
C KRCHP1    SOURCE    FANDEUR   22/01/03    21:15:26     11136          
      SUBROUTINE KRCHP1(TYPE,IGEOM,MCHPOI,MLMOTS)
C*************************************************************************
C
C Ce SP cree un champoint
C
C*************************************************************************
      IMPLICIT INTEGER(I-N)
 
-INC PPARAM
-INC CCOPTIO
-INC SMCHPOI
-INC SMELEME
-INC SMLMOTS
C
      INTEGER IGEOM,NC, NAT, NSOUPO,N,I,NBSOUS
      CHARACTER*8 TYPE
C
      SEGACT MLMOTS
      NC = MLMOTS.MOTS(/2)
      IPT1 = IGEOM
      IF((IPT1 .LE. 0) .OR. (NC .EQ. 0))THEN
C
C******* Creation d'un CHPOINT vide
C
         NAT=2
         NSOUPO=0
         SEGINI MCHPOI
         JATTRI(1)=2
         IFOPOI = IFOUR
      ELSE
C
C******* Creation d'un CHPOINT
C        de type TYPE,
C           tytre blanc
C        defini sur le maillage des POI1 de IGEOM
C        de composantes MLMOTS
C        avec MPOVAL zero
C
C
         SEGACT IPT1
         NBSOUS = IPT1.LISOUS(/1)
         IF ( (NBSOUS .NE. 0) .OR. (IPT1.ITYPEL .NE. 1)) THEN
            CALL CHANGE(IPT1,1)
            IF (IERR.NE.0) RETURN
         ENDIF
         N=IPT1.NUM(/2)
         NSOUPO=1
         NAT=2
         SEGINI MCHPOI,MSOUPO,MPOVAL
         MCHPOI.JATTRI(1)=2
*        Nature discret
         MCHPOI.IFOPOI=IFOUR
         MCHPOI.MTYPOI=TYPE
         MCHPOI.MOCHDE=
     $'                                                                '
         MCHPOI.IPCHP(1)=MSOUPO
         MSOUPO.IGEOC=IPT1
         MSOUPO.IPOVAL=MPOVAL
         DO 1 I=1,NC,1
            MSOUPO.NOCOMP(I)= MLMOTS.MOTS(I)
 1       CONTINUE
      ENDIF
      END