Sources Esope | Cast3M

crchpt
C CRCHPT    SOURCE    CB215821  25/04/23    21:15:07     12247          
      SUBROUTINE CRCHPT(TYPI,IGEOM,NC,MCHPOI)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C*************************************************************************
C
C Ce SP cree un champoint type TRIO-EF
C
C*************************************************************************
 
-INC PPARAM
-INC CCOPTIO
-INC SMCHPOI
-INC SMCOORD
-INC SMELEME
      POINTEUR IGEOM.MELEME
      CHARACTER*(*) TYPI
      CHARACTER*8 TYPE
      CHARACTER*(LOCOMP) MOT(3),MOCOMP
      DATA MOT/'UX  ','UY  ','UZ  '/
 
      TYPE='        '
      TYPE=TYPI
      MCHPOI=0
      IF(IGEOM .LE. 0)THEN
         NAT=1
         NSOUPO=0
         SEGINI MCHPOI
         IFOPOI = IFOUR
         JATTRI(1)=2
         RETURN
      ENDIF
      SEGACT IGEOM
      IF(IGEOM.ITYPEL.NE.1)THEN
         WRITE(6,*)' Support geometrique incorrect '
         RETURN
      ENDIF
** il ne faut pas appeler crech1 car le maillage n'est pas nouveau
**    call crech1(igeom,0)
      N=IGEOM.NUM(/2)
      NSOUPO=1
      NAT=1
      SEGINI MCHPOI,MSOUPO,MPOVAL
      JATTRI(1)=2
      IFOPOI=IFOUR
      MTYPOI=TYPE
      MOCHDE='                                                  '
      IPCHP(1)=MSOUPO
      IGEOC=IGEOM
      IPOVAL=MPOVAL
      IF(NC.EQ.1)THEN
         NOCOMP(1)='SCAL'
      ELSEIF(NC.GT.3)THEN
         DO 1 I=1,NC
            WRITE(MOCOMP,FMT='(A2,I2)')'CP',I
            NOCOMP(I)=MOCOMP
 1       CONTINUE
      ELSE
         DO 2 I=1,NC
            NOCOMP(I)=MOT(I)
 2       CONTINUE
      ENDIF
      END