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