Télécharger depchp.eso

Retour à la liste

Numérotation des lignes :

  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.  
  84.  

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