Esope source files

   1 : C CRCHPT    SOURCE    PV        13/04/16    21:15:13     7765           
   2 :       SUBROUTINE CRCHPT(TYPI,IGEOM,NC,MCHPOI)
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)
   5 : C*************************************************************************
   6 : C     
   7 : C Ce SP cree un champoint type TRIO-EF
   8 : C     
   9 : C*************************************************************************
  10 : -INC CCOPTIO
  11 : -INC SMCHPOI
  12 : -INC SMELEME
  13 :       POINTEUR IGEOM.MELEME
  14 :       CHARACTER*(*) TYPI
  15 :       CHARACTER*8 TYPE
  16 :       CHARACTER*4 MOT(3),NOM4
  17 :       DATA MOT/'UX  ','UY  ','UZ  '/
  18 : 
  19 :       TYPE='        '
  20 :       TYPE=TYPI
  21 :       MCHPOI=0
  22 :       IF(IGEOM .LE. 0)THEN
  23 :          NAT=1
  24 :          NSOUPO=0
  25 :          SEGINI MCHPOI
  26 :          IFOPOI = IFOUR
  27 :          JATTRI(1)=2
  28 :          SEGDES MCHPOI
  29 :          RETURN
  30 :       ENDIF
  31 :       SEGACT IGEOM
  32 :       IF(IGEOM.ITYPEL.NE.1)THEN
  33 :          WRITE(6,*)' Support geometrique incorrect '
  34 :          RETURN
  35 :       ENDIF
  35 :       call crech1(igeom,0)
  36 :       N=IGEOM.NUM(/2)
  37 :       SEGDES IGEOM
  38 :       NSOUPO=1
  39 :       NAT=1
  40 :       SEGINI MCHPOI,MSOUPO,MPOVAL
  41 :       JATTRI(1)=2
  42 :       IFOPOI=IFOMOD
  43 :       MTYPOI=TYPE
  44 :       MOCHDE='                                                  '
  45 :       IPCHP(1)=MSOUPO
  46 :       IGEOC=IGEOM
  47 :       IPOVAL=MPOVAL
  48 :       IF(NC.EQ.1)THEN
  49 :          NOCOMP(1)='SCAL'
  50 :       ELSEIF(NC.GT.3)THEN
  51 :          DO 1 I=1,NC
  52 :             WRITE(NOM4,FMT='(A2,I2)')'CP',I
  53 :             NOCOMP(I)=NOM4
  54 :  1       CONTINUE
  55 :       ELSE
  56 :          DO 2 I=1,NC
  57 :             NOCOMP(I)=MOT(I)
  58 :  2       CONTINUE
  59 :       ENDIF
  60 :       SEGDES MCHPOI,MSOUPO,MPOVAL
  61 :       RETURN
  62 :       END
  63 : 
  64 :  
  65 :  
  66 :  
  67 :  
  68 :