Télécharger dyne04.eso

Retour à la liste

Numérotation des lignes :

  1. C DYNE04 SOURCE PV 16/11/17 21:59:09 9180
  2. SUBROUTINE DYNE04(MMATRX,ISECO,ICHT2,NDDL,MOOPT)
  3. ************************************************************************
  4. *
  5. * D Y N E 0 4
  6. * -----------
  7. *
  8. * FONCTION:
  9. * ---------
  10. * UTILITAIRE DE L'OPERATEUR "DYNE"
  11. * MET LES VALEURS D'UN CHPOINT DANS UN VECTEUR, SELON LES
  12. * PARTITIONS GEOMETRIQUES DE L'OBJET RIGIDITE M
  13. *
  14. * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN)
  15. * -----------
  16. *
  17. * MMATRX (E) POINTEUR SUR UN SEGMENT MMATRI ( ACTIF )
  18. * ISECO (E) POINTEUR SUR LE CHPOINT
  19. * VEC (E/S) VECTEUR CONTENANT LES VALEURS DU CHPOINT
  20. * NDDL (E) NOMBRE DE DEGRES DE LIBERTE
  21. * MOOPT (E) 'INCO' SI ON TRAVAILLE SUR LES INCONNUES PRIMALES
  22. * 'DUAL' SI ON TRAVAILLE SUR LES INCONNUES DUALES
  23. *
  24. * AUTEUR, DATE DE CREATION:
  25. * -------------------------
  26. * DENIS ROBERT, LE 25 NOVEMBRE 1988.
  27. * REVU ET CORRIGE DECEMBRE 89 MP
  28. *
  29. * LANGAGE:
  30. * --------
  31. * ESOPE + FORTRAN77
  32. *
  33. ************************************************************************
  34. *
  35. * MODULES UTILISES:
  36. *
  37. IMPLICIT INTEGER(I-N)
  38. -INC SMMATRI
  39. -INC SMCHPOI
  40. -INC SMELEME
  41. -INC CCOPTIO
  42. -INC SMCOORD
  43. *
  44. SEGMENT,ICPR(XCOOR(/1)/(IDIM+1))
  45. SEGMENT,ICOR(NC1)
  46. *
  47. SEGMENT,MCHT2
  48. REAL*8 VCC2(NDDL)
  49. ENDSEGMENT
  50. *
  51. * REAL*8 VEC(*)
  52. CHARACTER*4 MOOPT
  53. *
  54. *--- ACTIVATION DES SEGMENTS
  55. *
  56. MCHT2=ICHT2
  57. MMATRI=MMATRX
  58. MCHPOI=ISECO
  59. SEGACT,MCHPOI
  60. NSOUPO=IPCHP(/1)
  61. MELEME=IGEOMA
  62. MIMIK=IIMIK
  63. MIDUA=IIDUA
  64. IDU=IMIK(/2)
  65. MHARK=IHARK
  66. MINCPO=IINCPO
  67. N2=NUM(/2)
  68. *
  69. DO 33 I33=1,NDDL
  70. VCC2(I33)=0.D0
  71. 33 CONTINUE
  72. * END DO
  73. *
  74. *--- DANS ICPR ON COMPTE LES POINTS DE MELEME
  75. *
  76. SEGINI,ICPR
  77. DO 25 I=1,N2
  78. ICPR(NUM(1,I))=I
  79. 25 CONTINUE
  80. * END DO
  81. *
  82. *--- FABRICATION D'UN VECTEUR, ON VERIFIE QUE TOUTES LES COMPOSANTES
  83. *--- DU CHPOINT EXISTENT DANS L'OBJET MMATRI
  84. *
  85. DO 1 I=1,NSOUPO
  86. MSOUPO=IPCHP(I)
  87. SEGACT,MSOUPO
  88. IPT1=IGEOC
  89. SEGACT,IPT1
  90. NC=NOCOMP(/2)
  91. NC1=NC
  92. SEGINI,ICOR
  93. IF (MOOPT.EQ.'DUAL') THEN
  94. DO 11 KI=1,NC
  95. DO 10 J=1,IDU
  96. IF(NOCOMP(KI).NE.IDUA(J)) GO TO 10
  97. IF(NOHARM(KI).NE.IHAR(J)) GO TO 10
  98. ICOR(KI)=J
  99. GO TO 11
  100. 10 CONTINUE
  101. * END DO
  102. 11 CONTINUE
  103. * END DO
  104. ELSE IF (MOOPT.EQ.'INCO') THEN
  105. DO 21 KI=1,NC
  106. DO 20 J=1,IDU
  107. IF(NOCOMP(KI).NE.IMIK(J)) GO TO 20
  108. IF(NOHARM(KI).NE.IHAR(J)) GO TO 20
  109. ICOR(KI)=J
  110. GO TO 21
  111. 20 CONTINUE
  112. * END DO
  113. 21 CONTINUE
  114. * END DO
  115. ELSE
  116. CALL ERREUR(510)
  117. RETURN
  118. ENDIF
  119. MPOVAL=IPOVAL
  120. SEGACT,MPOVAL
  121. N=VPOCHA(/1)
  122. DO 2 J=1,N
  123. K=ICPR(IPT1.NUM(1,J))
  124. IF (K.NE.0) GO TO 4
  125. *
  126. *--- LE NUMERO DU NOEUD DU VECTEUR N'EXISTAIT PAS DANS LA MATRICE
  127. *
  128. CALL ERREUR (53)
  129. RETURN
  130. 4 CONTINUE
  131. DO 2 LI=1,NC
  132. KKIL=ICOR(LI)
  133. IF (KKIL.EQ.0) GOTO 2
  134. KI=INCPO(KKIL,K)
  135. IF (KI.NE.0) GO TO 6
  136. *
  137. *--- LE TYPE D'INCONNUE N'EXISTAIT PAS DANS LA MATRICE
  138. *
  139. CALL ERREUR(54)
  140. RETURN
  141. 6 CONTINUE
  142. VCC2(KI)=VPOCHA(J,LI)
  143. 2 CONTINUE
  144. * END DO
  145. * END DO
  146. SEGDES,MPOVAL,MSOUPO,IPT1
  147. SEGSUP,ICOR
  148. 1 CONTINUE
  149. * END DO
  150. SEGSUP,ICPR
  151. *
  152. END
  153.  
  154.  
  155.  
  156.  
  157.  
  158.  
  159.  
  160.  

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