Télécharger la plaquette Cast3M


fr en

Télécharger depchp.eso

Retour à la liste

Numérotation des lignes : 

depchp

  1. C DEPCHP    SOURCE    CB215821  20/11/25    13:24:36     10792          
  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.  
  13. -INC PPARAM
  14. -INC CCOPTIO
  15. -INC SMELEME
  16. -INC SMCOORD
  17. -INC SMCHPOI
  18.  
  19.       SEGMENT ICPR(nbpts)
  20.  
  21.       DIMENSION IPASS(3)
  22.       CHARACTER*(LOCOMP) NOMIN(3)
  23.  
  24.       idimp1=IDIM+1
  25.  
  26. C  Fabrication de la liste des inconnues possibles
  27. C  3 cas : 1) MODE AXIS/FOUR , 2) MODE UNID , 3) autres
  28.       IF (IFOMOD.EQ.0.OR.IFOMOD.EQ.1) THEN
  29.         NOMIN(1)='UR  '
  30.         NOMIN(2)='UZ  '
  31.       ELSE IF (IFOMOD.EQ.3) THEN
  32.         NOMIN(1)='UX  '
  33.       ELSE IF (IFOMOD.EQ.4.OR.IFOMOD.EQ.5) THEN
  34.         NOMIN(1)='UR  '
  35.       ELSE
  36.         NOMIN(1)='UX  '
  37.         NOMIN(2)='UY  '
  38.         IF (IDIM.EQ.3) NOMIN(3)='UZ  '
  39.       ENDIF
  40.  
  41. C  On recupere le CHPOint
  42.       SEGACT,MCOORD*MOD
  43.       MCHPOI=IPCH
  44.       SEGACT,MCHPOI
  45.       DO i=1,IPCHP(/1)
  46.         MSOUPO=IPCHP(i)
  47.         SEGACT,MSOUPO
  48.         JCOMP=0
  49.         DO j=1,IDIM
  50.           IPASS(j)=0
  51.           DO k=1,NOCOMP(/2)
  52.             IF (NOMIN(j).EQ.NOCOMP(k)) THEN
  53.               IPASS(j)=k
  54.               JCOMP=JCOMP+1
  55.             ENDIF
  56.           ENDDO
  57.         ENDDO
  58.         IF (JCOMP.NE.0) THEN
  59.           MELEME=IGEOC
  60.           SEGACT,MELEME
  61.           MPOVAL=IPOVAL
  62.           SEGACT,MPOVAL
  63.           DO j=1,NUM(/2)
  64.             K2=ICPR(NUM(1,j))
  65.             IF (K2.NE.0) THEN
  66.               IREF=(NUM(1,j)-1)*idimp1
  67.               DO k=1,IDIM
  68.                 K1=IPASS(k)
  69.                 IF (K1.NE.0)
  70.      .            XCOOR(IREF+k)=XCOOR(IREF+k)+VPOCHA(j,K1)*XSENS
  71.               ENDDO
  72.             ENDIF
  73.           ENDDO
  74.           SEGDES,MPOVAL,MELEME
  75.         ENDIF
  76.         SEGDES,MSOUPO
  77.       ENDDO
  78.  
  79.       SEGDES,MCHPOI
  80.  
  81.       RETURN
  82.       END
  83.  
  84.  
  85.  
  86.  
  87.  
  88.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales