Esope source files

   1 : C DEPCHP    SOURCE    CHAT      05/01/12    22:42:04     5004           
   2 : 
   3 : C=======================================================================
   4 : C=   ROUTINE APPELEE PAR DEPLAC POUR 'PLUS' OU 'MOIN' D'UN CHPOINT     =
   5 : C=======================================================================
   6 : 
   7 :       SUBROUTINE DEPCHP(ICPR,IPCH,XSENS)
   8 : 
   9 :       IMPLICIT INTEGER(I-N)
  10 :       IMPLICIT REAL*8 (A-H,O-Z)
  11 : 
  12 : -INC CCOPTIO
  13 : -INC SMELEME
  14 : -INC SMCOORD
  15 : -INC SMCHPOI
  16 : 
  17 :       SEGMENT ICPR(XCOOR(/1)/(IDIM+1))
  18 : 
  19 :       DIMENSION IPASS(3)
  20 :       CHARACTER*4 NOMIN(3)
  21 : 
  22 :       idimp1=IDIM+1
  23 : 
  24 : C  Fabrication de la liste des inconnues possibles
  25 : C  3 cas : 1) MODE AXIS/FOUR , 2) MODE UNID , 3) autres
  26 :       IF (IFOMOD.EQ.0.OR.IFOMOD.EQ.1) THEN
  27 :         NOMIN(1)='UR  '
  28 :         NOMIN(2)='UZ  '
  29 :       ELSE IF (IFOMOD.EQ.3) THEN
  30 :         NOMIN(1)='UX  '
  31 :       ELSE IF (IFOMOD.EQ.4.OR.IFOMOD.EQ.5) THEN
  32 :         NOMIN(1)='UR  '
  33 :       ELSE
  34 :         NOMIN(1)='UX  '
  35 :         NOMIN(2)='UY  '
  36 :         IF (IDIM.EQ.3) NOMIN(3)='UZ  '
  37 :       ENDIF
  38 : 
  39 : C  On recupere le CHPOint
  40 :       SEGACT,MCOORD*MOD
  41 :       MCHPOI=IPCH
  42 :       SEGACT,MCHPOI
  43 :       DO i=1,IPCHP(/1)
  44 :         MSOUPO=IPCHP(i)
  45 :         SEGACT,MSOUPO
  46 :         JCOMP=0
  47 :         DO j=1,IDIM
  48 :           IPASS(j)=0
  49 :           DO k=1,NOCOMP(/2)
  50 :             IF (NOMIN(j).EQ.NOCOMP(k)) THEN
  51 :               IPASS(j)=k
  52 :               JCOMP=JCOMP+1
  53 :             ENDIF
  54 :           ENDDO
  55 :         ENDDO
  56 :         IF (JCOMP.NE.0) THEN
  57 :           MELEME=IGEOC
  58 :           SEGACT,MELEME
  59 :           MPOVAL=IPOVAL
  60 :           SEGACT,MPOVAL
  61 :           DO j=1,NUM(/2)
  62 :             K2=ICPR(NUM(1,j))
  63 :             IF (K2.NE.0) THEN
  64 :               IREF=(NUM(1,j)-1)*idimp1
  65 :               DO k=1,IDIM
  66 :                 K1=IPASS(k)
  67 :                 IF (K1.NE.0)
  68 :      .            XCOOR(IREF+k)=XCOOR(IREF+k)+VPOCHA(j,K1)*XSENS
  69 :               ENDDO
  70 :             ENDIF
  71 :           ENDDO
  72 :           SEGDES,MPOVAL,MELEME
  73 :         ENDIF
  74 :         SEGDES,MSOUPO
  75 :       ENDDO
  76 : 
  77 :       SEGDES,MCHPOI
  78 : 
  79 :       RETURN
  80 :       END
  81 : 
  82 :  
  83 :