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