C DEPCHP SOURCE CB215821 20/11/25 13:24:36 10792 C======================================================================= C= ROUTINE APPELEE PAR DEPLAC POUR 'PLUS' OU 'MOIN' D'UN CHPOINT = C======================================================================= SUBROUTINE DEPCHP(ICPR,IPCH,XSENS) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) -INC PPARAM -INC CCOPTIO -INC SMELEME -INC SMCOORD -INC SMCHPOI SEGMENT ICPR(nbpts) DIMENSION IPASS(3) CHARACTER*(LOCOMP) NOMIN(3) idimp1=IDIM+1 C Fabrication de la liste des inconnues possibles C 3 cas : 1) MODE AXIS/FOUR , 2) MODE UNID , 3) autres IF (IFOMOD.EQ.0.OR.IFOMOD.EQ.1) THEN NOMIN(1)='UR ' NOMIN(2)='UZ ' ELSE IF (IFOMOD.EQ.3) THEN NOMIN(1)='UX ' ELSE IF (IFOMOD.EQ.4.OR.IFOMOD.EQ.5) THEN NOMIN(1)='UR ' ELSE NOMIN(1)='UX ' NOMIN(2)='UY ' IF (IDIM.EQ.3) NOMIN(3)='UZ ' ENDIF C On recupere le CHPOint SEGACT,MCOORD*MOD MCHPOI=IPCH SEGACT,MCHPOI DO i=1,IPCHP(/1) MSOUPO=IPCHP(i) SEGACT,MSOUPO JCOMP=0 DO j=1,IDIM IPASS(j)=0 DO k=1,NOCOMP(/2) IF (NOMIN(j).EQ.NOCOMP(k)) THEN IPASS(j)=k JCOMP=JCOMP+1 ENDIF ENDDO ENDDO IF (JCOMP.NE.0) THEN MELEME=IGEOC SEGACT,MELEME MPOVAL=IPOVAL SEGACT,MPOVAL DO j=1,NUM(/2) K2=ICPR(NUM(1,j)) IF (K2.NE.0) THEN IREF=(NUM(1,j)-1)*idimp1 DO k=1,IDIM K1=IPASS(k) IF (K1.NE.0) . XCOOR(IREF+k)=XCOOR(IREF+k)+VPOCHA(j,K1)*XSENS ENDDO ENDIF ENDDO SEGDES,MPOVAL,MELEME ENDIF SEGDES,MSOUPO ENDDO SEGDES,MCHPOI RETURN END