Download krchpt.eso

Back to the list

   1 : C KRCHPT    SOURCE    CHAT      05/01/13    01:05:56     5004           
   2 :       SUBROUTINE KRCHPT(TYPI,IGEOM,NC,MCHPOI,MOT)
   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(NC)
  17 : 
  18 :       TYPE='        '
  19 :       TYPE=TYPI
  20 :       MCHPOI=0
  21 :       IF(IGEOM .LE. 0)THEN
  22 :          NAT=2
  23 :          NSOUPO=0
  24 :          SEGINI MCHPOI
  25 :          JATTRI(1)=2
  26 :          IFOPOI = IFOUR
  27 :          SEGDES MCHPOI
  28 :          RETURN
  29 :       ENDIF
  30 :       SEGACT IGEOM
  31 :       IF(IGEOM.ITYPEL.NE.1)THEN
  32 :          WRITE(6,*)' Support geometrique incorrect '
  33 :          RETURN
  34 :       ENDIF
  35 :       N=IGEOM.NUM(/2)
  36 :       SEGDES IGEOM
  37 :       NSOUPO=1
  38 :       NAT=1
  39 :       SEGINI MCHPOI,MSOUPO,MPOVAL
  40 :       JATTRI(1)=2
  41 :       IFOPOI=IFOMOD
  42 :       MTYPOI=TYPE
  43 :       MOCHDE='                                                  '
  44 :       IPCHP(1)=MSOUPO
  45 :       IGEOC=IGEOM
  46 :       IPOVAL=MPOVAL
  47 :          DO 1 I=1,NC
  48 :             NOCOMP(I)=MOT(I)
  49 :  1       CONTINUE
  50 :       SEGDES MCHPOI,MSOUPO,MPOVAL
  51 :       RETURN
  52 :       END
  53 : 
  54 :  
  55 :  
  56 :  
  57 :  

© Cast3M 2003 - All rights reserved.
Disclaimer