Télécharger dyne07.eso

Retour à la liste

Numérotation des lignes :

  1. C DYNE07 SOURCE PV 16/11/17 21:59:10 9180
  2. SUBROUTINE DYNE07(ICHT2,MMATRX,IPCREF,IPCHPO)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. ************************************************************************
  6. *
  7. * D Y N E 0 7
  8. * -----------
  9. *
  10. * FONCTION:
  11. * ---------
  12. * UTILITAIRE DE L'OPERATEUR "DYNE"
  13. * MET LES VALEURS D'UN VECTEUR ORDONNE SELON L'OBJET RIGIDITE M
  14. * DANS UN CHPOINT, ORDONNE SELON UN AUTRE CHPOINT DE REFERENCE.
  15. *
  16. * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN)
  17. * -----------
  18. *
  19. * VEC (E) VECTEUR
  20. * MMATRX (E) POINTEUR SUR LE SEGMENT MMATRI ( ACTIF )
  21. * IPCREF (E) POINTEUR SUR LE CHPOINT DE REFERENCE
  22. * IPCHPO (S) POINTEUR SUR LE CHPOINT RESULTAT
  23. *
  24. * AUTEUR, DATE DE CREATION:
  25. * -------------------------
  26. * DENIS ROBERT, LE 6 DECEMBRE 1988.
  27. * REVU ET CORRIGE DECEMBRE 89 MP
  28. *
  29. * LANGAGE:
  30. * --------
  31. * ESOPE + FORTRAN77
  32. *
  33. ************************************************************************
  34. *
  35. * MODULES UTILISES:
  36. *
  37. -INC SMCHPOI
  38. -INC SMMATRI
  39. -INC CCOPTIO
  40. -INC SMELEME
  41. -INC SMCOORD
  42. *
  43. SEGMENT,MCHT2
  44. REAL*8 VCC2(NDDL)
  45. ENDSEGMENT
  46. *
  47. * REAL*8 VEC(*)
  48. *
  49. SEGMENT,ICPR(XCOOR(/1)/(IDIM+1))
  50. SEGMENT,ICOR(NC1)
  51. *
  52. *--- ACTIVATION DES SEGMENTS
  53. *
  54. MCHT2=ICHT2
  55. MMATRI=MMATRX
  56. MCHPO1=IPCREF
  57. SEGACT,MCHPO1
  58. NSOUP1=MCHPO1.IPCHP(/1)
  59. MELEME=IGEOMA
  60. MIMIK=IIMIK
  61. IMI=IMIK(/2)
  62. MHARK=IHARK
  63. MINCPO=IINCPO
  64. N2=NUM(/2)
  65. *
  66. *--- RECENSEMENT DES POINTS SUPPORTS
  67. *
  68. SEGINI,ICPR
  69. DO 10 I=1,N2
  70. ICPR(NUM(1,I))=I
  71. 10 CONTINUE
  72. * END DO
  73. *
  74. *--- INITIALISATION DU CHPOINT RESULTAT
  75. *
  76. NSOUPO=NSOUP1
  77. NAT=1
  78. SEGINI,MCHPOI
  79. IPCHPO=MCHPOI
  80. MTYPOI='SCALAIRE'
  81. MOCHDE=' '
  82. JATTRI(1)=MCHPO1.JATTRI(1)
  83. IFOPOI=IFOUR
  84. *
  85. *--- BOUCLE SUR LES PARTITIONS DU CHPOINT DE REFERENCE
  86. *
  87. DO 100 I=1,NSOUP1
  88. MSOUP1=MCHPO1.IPCHP(I)
  89. SEGACT,MSOUP1
  90. IPT1=MSOUP1.IGEOC
  91. SEGACT,IPT1
  92. SEGINI,IPT2=IPT1
  93. NC=MSOUP1.NOCOMP(/2)
  94. SEGINI,MSOUPO
  95. IPCHP(I)=MSOUPO
  96. IGEOC=IPT2
  97. NC1=NC
  98. SEGINI,ICOR
  99. DO 110 KI=1,NC
  100. NOCOMP(KI)=MSOUP1.NOCOMP(KI)
  101. NOHARM(KI)=MSOUP1.NOHARM(KI)
  102. DO 120 J=1,IMI
  103. IF (MSOUP1.NOCOMP(KI).NE.IMIK(J)) GO TO 120
  104. IF (MSOUP1.NOHARM(KI).NE.IHAR(J)) GO TO 120
  105. ICOR(KI)=J
  106. GO TO 110
  107. 120 CONTINUE
  108. * END DO
  109. 110 CONTINUE
  110. * END DO
  111. MPOVA1=MSOUP1.IPOVAL
  112. SEGACT,MPOVA1
  113. N=MPOVA1.VPOCHA(/1)
  114. SEGINI,MPOVAL=MPOVA1
  115. IPOVAL=MPOVAL
  116. DO 200 J=1,N
  117. K=ICPR(IPT1.NUM(1,J))
  118. IF (K.NE.0) GO TO 300
  119. *
  120. *--- INCOMPATIBILITE D'UN POINT SUPPORT
  121. *
  122. CALL ERREUR(252)
  123. RETURN
  124. 300 CONTINUE
  125. DO 200 LI=1,NC
  126. KKIL=ICOR(LI)
  127. IF (KKIL.EQ.0) GO TO 200
  128. KI=INCPO(KKIL,K)
  129. IF (KI.NE.0) GO TO 400
  130. *
  131. *--- INCOMPATIBILITE DE TYPE D'INCONNUE
  132. *
  133. CALL ERREUR(288)
  134. * RETURN
  135. 400 CONTINUE
  136. VPOCHA(J,LI)=VCC2(KI)
  137. 200 CONTINUE
  138. * END DO
  139. SEGDES,MPOVA1,MSOUP1,IPT1
  140. SEGDES,MPOVAL,MSOUPO,IPT2
  141. SEGSUP,ICOR
  142. 100 CONTINUE
  143. * END DO
  144. SEGSUP,ICPR
  145. SEGDES,MCHPO1,MCHPOI
  146. *
  147. END
  148.  
  149.  
  150.  
  151.  
  152.  
  153.  
  154.  
  155.  

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