1 : C CHPTCO SOURCE PASCAL 12/12/12 21:15:05 7605 2 : SUBROUTINE CHPTCO(IVAL,IPOIN) 3 : IMPLICIT INTEGER(I-N) 4 : CHARACTER*12 CTEXT 5 : -INC CCOPTIO 6 : -INC SMCHPOI 7 : -INC SMELEME 8 : logical ltelq 9 : MCHPOI=IPOIN 10 : SEGACT MCHPOI 11 : NSOUPO=IPCHP(/1) 12 : C 13 : C CAS DU CHPOINT VIDE 14 : C 15 : IF(NSOUPO.EQ.0) THEN 16 : SEGDES,MCHPOI 17 : NAT=1 18 : SEGINI,MCHPO1 19 : MCHPO1.IFOPOI=IFOUR 20 : MCHPO1.JATTRI(1)=1 21 : SEGDES,MCHPO1 21 : CALL ECROBJ('CHPOINT',MCHPO1) 22 : IF (IVAL.EQ.0) THEN 23 : IF (IDIM.EQ.2) THEN 24 : SEGINI,MCHPO2 25 : MCHPO2.IFOPOI=IFOUR 26 : MCHPO2.JATTRI(1)=1 27 : SEGDES,MCHPO2 27 : CALL ECROBJ('CHPOINT',MCHPO2) 28 : ELSEIF (IDIM.EQ.3) THEN 29 : SEGINI,MCHPO2 30 : MCHPO2.IFOPOI=IFOUR 31 : MCHPO2.JATTRI(1)=1 32 : SEGDES,MCHPO2 32 : CALL ECROBJ('CHPOINT',MCHPO2) 33 : SEGINI,MCHPO3 34 : MCHPO3.IFOPOI=IFOUR 35 : MCHPO3.JATTRI(1)=1 36 : SEGDES,MCHPO3 36 : CALL ECROBJ('CHPOINT',MCHPO3) 37 : ENDIF 38 : ENDIF 39 : RETURN 40 : ENDIF 41 : C 42 : C CAS DU CHPOINT NON VIDE 43 : C 44 : DO 1 I=1,NSOUPO 45 : MSOUPO=IPCHP(I) 46 : SEGACT MSOUPO 47 : IF(I.EQ.1) THEN 48 : IPT1=IGEOC 49 : SEGINI,MELEME=IPT1 50 : SEGDES MELEME 51 : IPGEO=MELEME 52 : ELSE 53 : IPGE1=IPGEO 54 : IPGE2=IGEOC 55 : ltelq=.false. 55 : CALL FUSE(IPGE1,IPGE2,IPGEO,ltelq) 56 : MELEME=IPGE1 57 : SEGSUP MELEME 58 : ENDIF 59 : SEGDES MSOUPO 60 : 1 CONTINUE 61 : SEGDES MCHPOI 61 : CALL CHPCOO(IVAL,IPGEO) 62 : C 63 : RETURN 64 : END 65 : 66 : 67 :
© Cast3M 2003 - All rights reserved.
Disclaimer