1 : C KRCHP1 SOURCE CHAT 05/01/13 01:05:51 5004 2 : SUBROUTINE KRCHP1(TYPE,IGEOM,MCHPOI,MLMOTS) 3 : C************************************************************************* 4 : C 5 : C Ce SP cree un champoint 6 : C 7 : C************************************************************************* 8 : IMPLICIT INTEGER(I-N) 9 : -INC CCOPTIO 10 : -INC SMCHPOI 11 : -INC SMELEME 12 : -INC SMLMOTS 13 : C 14 : INTEGER IGEOM,NC, NAT, NSOUPO,N,I,NBSOUS 15 : CHARACTER*8 TYPE 16 : C 17 : SEGACT MLMOTS 18 : NC = MLMOTS.MOTS(/2) 19 : IPT1 = IGEOM 20 : IF((IPT1 .LE. 0) .OR. (NC .EQ. 0))THEN 21 : C 22 : C******* Creation d'un CHPOINT vide 23 : C 24 : NAT=2 25 : NSOUPO=0 26 : SEGINI MCHPOI 27 : JATTRI(1)=2 28 : IFOPOI = IFOUR 29 : SEGDES MCHPOI 30 : ELSE 31 : C 32 : C******* Creation d'un CHPOINT 33 : C de type TYPE, 34 : C tytre blanc 35 : C defini sur le maillage des POI1 de IGEOM 36 : C de composantes MLMOTS 37 : C avec MPOVAL zero 38 : C 39 : C 40 : SEGACT IPT1 41 : NBSOUS = IPT1.LISOUS(/1) 42 : IF ( (NBSOUS .NE. 0) .OR. (IPT1.ITYPEL .NE. 1)) THEN 42 : CALL CHANGE(IPT1,1) 43 : IF (IERR.NE.0) GOTO 9999 44 : ENDIF 45 : N=IPT1.NUM(/2) 46 : SEGDES IPT1 47 : NSOUPO=1 48 : NAT=2 49 : SEGINI MCHPOI,MSOUPO,MPOVAL 50 : MCHPOI.JATTRI(1)=2 51 : * Nature discret 52 : MCHPOI.IFOPOI=IFOMOD 53 : MCHPOI.MTYPOI=TYPE 54 : MCHPOI.MOCHDE= 55 : $' ' 56 : MCHPOI.IPCHP(1)=MSOUPO 57 : MSOUPO.IGEOC=IPT1 58 : MSOUPO.IPOVAL=MPOVAL 59 : DO 1 I=1,NC,1 60 : MSOUPO.NOCOMP(I)= MLMOTS.MOTS(I) 61 : 1 CONTINUE 62 : SEGDES MCHPOI,MSOUPO,MPOVAL 63 : ENDIF 64 : SEGDES MLMOTS 65 : 9999 RETURN 66 : END 67 : 68 : 69 : 70 : 71 : 72 :
© Cast3M 2003 - All rights reserved.
Disclaimer