Télécharger pouvlo.eso

Retour à la liste

Numérotation des lignes :

  1. C POUVLO SOURCE BP208322 15/06/22 21:21:21 8543
  2. SUBROUTINE POUVLO(IPMODL,MLMOTS,ISUP,ICARA)
  3. *-----------------------------------------------------------------------
  4. * ADDITION DU VECTEUR LOCAL POUR LES POUTRES
  5. * ET LES TUYAUX S'IL EST ABSENT EN 3D
  6. *-----------------------------------------------------------------------
  7. *
  8. * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN)
  9. * -----------
  10. *
  11. * IPMODL (E) POINTEUR D'OBJET MODELE
  12. * MLMOTS (E) POINTEUR SUR LE LISTMOTS DE CARACTERISTIQUES
  13. * ISUP (E) NUMERO DE SUPPORT DEMANDE
  14. * ICARA (E+S) POINTEUR SUR LE CHAMELEM
  15. *
  16. * LANGAGE:
  17. * --------
  18. *
  19. * ESOPE + FORTRAN77
  20. *
  21. *-----------------------------------------------------------------------
  22. *
  23. IMPLICIT INTEGER(I-N)
  24. IMPLICIT REAL*8(A-H,O-Z)
  25. REAL*8 XEPOU(3,2),VECT(3)
  26. -INC CCOPTIO
  27. -INC CCHAMP
  28. -INC SMCHAML
  29. -INC SMMODEL
  30. -INC SMCOORD
  31. -INC SMLMOTS
  32. -INC SMELEME
  33. *
  34. * SEGMENT INFO
  35. * INTEGER INFELE(JG)
  36. * ENDSEGMENT
  37. CHARACTER*(NCONCH) CONM
  38. *
  39. SEGACT,MLMOTS
  40. *
  41. * LE VECTEUR EXISTE T-IL DEJA ?
  42. *
  43. DO 1 I=1,MOTS(/2)
  44. IF(MOTS(I).EQ.'VECT') THEN
  45. SEGDES MLMOTS
  46. RETURN
  47. ENDIF
  48. 1 CONTINUE
  49. *
  50. * ACTIVATIONS
  51. *
  52. MMODEL=IPMODL
  53. NSOUS=KMODEL(/1)
  54. MCHELM=ICARA
  55. SEGACT MCHELM
  56. *
  57. * BOUCLE SUR LES SOUS ZONES DU MODELE
  58. *
  59. DO 200 ISOUS=1,NSOUS
  60. *
  61. * TRAITEMENT DU MODELE
  62. *
  63. IMODEL=KMODEL(ISOUS)
  64. MELE =NEFMOD
  65. IPMAIL=IMAMOD
  66. CONM =CONMOD
  67. *
  68. *
  69. * INFORMATIONS SUR L'{L{MENT FINI
  70. *
  71. * CALL ELQUOI(MELE,0,ISUP,INFO,IMODEL)
  72. IF (IERR.NE.0) THEN
  73. SEGDES MCHELM
  74. RETURN
  75. ENDIF
  76. MFR =INFELE(13)
  77. IF(MFR.NE.7.AND.MFR.NE.13) THEN
  78. * SEGSUP INFO
  79. GO TO 200
  80. ENDIF
  81. *
  82. * RECHERCHE DE LA ZONE DU CHAMELEM
  83. *
  84. N1 = IMACHE(/1)
  85. N3 = INFCHE(/2)
  86. LAZON = 0
  87. DO 11 I=1,N1
  88. IF (IPMAIL.NE.IMACHE(I) .OR.
  89. . CONM.NE.CONCHE(I)) GO TO 11
  90. LAZON=I
  91. GO TO 12
  92. 11 CONTINUE
  93. *
  94. CALL ERREUR(472)
  95. SEGDES MCHELM
  96. * SEGSUP INFO
  97. RETURN
  98. *
  99. 12 CONTINUE
  100. MCHAML=ICHAML(LAZON)
  101. SEGACT MCHAML
  102. N2=NOMCHE(/2)
  103. N2=N2+1
  104. SEGADJ MCHAML
  105. NOMCHE(N2)='VECT'
  106. TYPCHE(N2)='POINTEURPOINT '
  107. MELEME=IPMAIL
  108. SEGACT MELEME
  109. NBNN=NUM(/1)
  110. *
  111. * CREATION DU MELVAL ET REMPLISSAGE
  112. *
  113. N1EL=0
  114. N1PTEL=0
  115. N2EL=NUM(/2)
  116. N2PTEL=1
  117. SEGINI MELVAL
  118. IELVAL(N2)=MELVAL
  119. *
  120. DO 305 ID=1,N2EL
  121. CALL DOXE(XCOOR,IDIM,NBNN,NUM,ID,XEPOU)
  122. CALL POULOC(XEPOU,VECT,KERRE)
  123. IF(KERRE.NE.0) THEN
  124. INTERR(1)=ISOUS
  125. INTERR(2)=ID
  126. CALL ERREUR(128)
  127. SEGDES MELEME
  128. SEGDES MELVAL,MCHAML,MCHELM,MLMOTS
  129. * SEGSUP INFO
  130. ENDIF
  131. *
  132. * CREATION DU VECTEUR
  133. *
  134. NBNOI=XCOOR(/1)/(IDIM+1)
  135. NBPTS=NBNOI+1
  136. SEGADJ MCOORD
  137. XCOOR(NBNOI*(IDIM+1)+1)=VECT(1)
  138. XCOOR(NBNOI*(IDIM+1)+2)=VECT(2)
  139. IF (IDIM.EQ.3) XCOOR(NBNOI*(IDIM+1)+3)=VECT(3)
  140. XCOOR(NBNOI*(IDIM+1)+(IDIM+1))=0.D0
  141. IELCHE(1,ID)=NBPTS
  142. 305 CONTINUE
  143. *
  144. * DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE ISOUS
  145. *
  146. SEGDES MELEME
  147. SEGDES MELVAL
  148. SEGDES MCHAML
  149. * SEGSUP INFO
  150. *
  151. 200 CONTINUE
  152. *
  153. SEGDES MCHELM
  154. SEGDES,MLMOTS
  155. RETURN
  156. END
  157.  
  158.  
  159.  
  160.  
  161.  
  162.  
  163.  
  164.  
  165.  
  166.  
  167.  

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