Télécharger manur3.eso

Retour à la liste

Numérotation des lignes :

  1. C MANUR3 SOURCE BP208322 15/06/22 21:20:28 8543
  2. SUBROUTINE MANUR3 (IPELEM,IINCO,IDUAL,IPDESC)
  3. ************************************************************************
  4. *
  5. * M A N U R 3
  6. * -----------
  7. *
  8. * FONCTION:
  9. * ---------
  10. *
  11. * CONSTRUCTION DU DESCRIPTEUR D'UN OBJET 'RIGIDITE' CREE
  12. * MANUELLEMENT.
  13. * L'UTILISATION DE CE SOUS-PROGRAMME N'EST PAS UNIVERSELLE.
  14. *
  15. * MODE D'APPEL:
  16. * -------------
  17. *
  18. * CALL MANUR3 (IPELEM,IINCO,IDUAL,IPDESC)
  19. *
  20. * PARAMETRES: (E)=ENTREE (S)=SORTIE
  21. * -----------
  22. *
  23. * IPELEM ENTIER (E) POINTEUR DE L'OBJET 'MAILLAGE' SUR LEQUEL
  24. * VA S'APPUYER LA 'RIGIDITE'.
  25. * IINCO SEGMENT (E) REGROUPEMENT DE POINTEURS SUR DES
  26. * 'LISTMOTS'.
  27. * SOIT IL N'Y A QU'1 'LISTMOTS', QUI CONTIENT
  28. * LES NOMS DES COMPOSANTES POUR UN NOEUD D'UN
  29. * ELEMENT DE L'OBJET DE POINTEUR "IPELEM",
  30. * SOIT IL Y A AUTANT DE 'LISTMOTS' QUE DE
  31. * NOEUDS PAR ELEMENT ET LE N-IEME 'LISTMOTS'
  32. * CONTIENT LES NOMS DES COMPOSANTES POUR LE
  33. * N-IEME NOEUD D'UN ELEMENT.
  34. * IDUAL SEGMENT (E) IDEM POUR LES DUALES
  35. * IPDESC ENTIER (S) POINTEUR SUR LE SEGMENT DESCRIPTEUR DE
  36. * L'OBJET 'RIGIDITE'.
  37. *
  38. * LEXIQUE: (ORDRE ALPHABETIQUE)
  39. * --------
  40. *
  41. * MTEM3 SEGMENT REGROUPEMENT DE POINTEURS SUR DES 'LISTMOTS'.
  42. * MEME ORGANISATION QUE "MTEMP3", MAIS LES
  43. * 'LISTMOTS' CONTIENNENT LES NOMS DES INCONNUES
  44. * DUALES.
  45. * NBCOMP ENTIER NOMBRE DE COMPOSANTES POUR UN NOEUD D'ELEMENT.
  46. * NBLMOT ENTIER NOMBRE DE 'LISTMOTS' REFERENCES PAR "MTEMP3".
  47. * NBMOTT ENTIER NOMBRE TOTAL DE NOMS DE COMPOSANTES DONNES.
  48. *
  49. * LES AUTRES VARIABLES IMPORTANTES SONT EXPLIQUEES DANS LES MODULES
  50. * INCLUS.
  51. *
  52. * SOUS-PROGRAMMES APPELES:
  53. * ------------------------
  54. *
  55. * ERREUR.
  56. *
  57. * AUTEUR, DATE DE CREATION:
  58. * -------------------------
  59. *
  60. * PASCAL MANIGOT 19 FEVRIER 1985
  61. *
  62. * LANGAGE:
  63. * --------
  64. *
  65. * ESOPE + FORTRAN77 + EXTENSION: CARACTERES MIS DANS DES ENTIERS.
  66. *
  67. ************************************************************************
  68. *
  69. IMPLICIT INTEGER(I-N)
  70. -INC CCOPTIO
  71. -INC CCHAMP
  72. -INC SMELEME
  73. -INC SMLMOTS
  74. -INC SMRIGID
  75. *
  76. SEGMENT /MTEMP3/ (ILMOTS(0)),MTEM3.MTEMP3
  77. *
  78. LOGICAL BADNAM
  79. *
  80. *
  81. *
  82. * -- VERIFICATION DES NOMS DE COMPOSANTES DONNES ET ENREGISTREMENT
  83. * DES COMPOSANTES DUALES --
  84. *
  85. MTEMP3=IINCO
  86. SEGACT,MTEMP3
  87. NBLMOT = ILMOTS(/1)
  88. *
  89. * ON N'A PAS DONNE LES NOMS DES DUALES
  90. * ON CHERCHE DANS NOMDD
  91. *
  92. IF (IDUAL.EQ.0) THEN
  93. SEGINI,MTEM3=MTEMP3
  94. *
  95. NBMOTT = 0
  96. DO 100 IB100=1,NBLMOT
  97. *
  98. MLMOTS = ILMOTS(IB100)
  99. SEGACT,MLMOTS
  100. NBMOTS = MOTS(/2)
  101. NBMOTT = NBMOTT + NBMOTS
  102. SEGINI,MLMOT1=MLMOTS
  103. MTEM3.ILMOTS(IB100) = MLMOT1
  104. *
  105. DO 110 IB110=1,NBMOTS
  106. *
  107. BADNAM = .TRUE.
  108. DO 120 IB120=1,LNOMDD
  109. IF (MOTS(IB110) .EQ. NOMDD(IB120) ) THEN
  110. MLMOT1.MOTS(IB110) = NOMDU(IB120)
  111. BADNAM = .FALSE.
  112. * --> SORTIE DE BOUCLE N.120
  113. GOTO 122
  114. END IF
  115. 120 CONTINUE
  116. * END DO
  117. 122 CONTINUE
  118. *
  119. IF (BADNAM) THEN
  120. MOTERR(1:4) = MOTS(IB110)
  121. NUMERR = 197
  122. CALL ERREUR (NUMERR)
  123. RETURN
  124. END IF
  125. *
  126. 110 CONTINUE
  127. * END DO
  128. *
  129. SEGDES,MLMOTS
  130. SEGDES,MLMOT1
  131. *
  132. 100 CONTINUE
  133. * END DO
  134. *
  135. * ON A DONNE LES NOMS DES DUALES
  136. * ON NE FAIT AUCUNE VERIF SUR LES NOMS
  137. *
  138. ELSE
  139.  
  140. MTEM3=IDUAL
  141. SEGACT MTEM3
  142. *
  143. NBMOTT=0
  144. DO 200 IB200=1,NBLMOT
  145. MLMOTS = ILMOTS(IB200)
  146. SEGACT,MLMOTS
  147. MLMOT1 = MTEM3.ILMOTS(IB200)
  148. SEGACT MLMOT1
  149. NBMOTS = MOTS(/2)
  150. IF (NBMOTS.NE.MLMOT1.MOTS(/2)) THEN
  151. CALL ERREUR(217)
  152. RETURN
  153. ENDIF
  154. NBMOTT = NBMOTT + NBMOTS
  155. SEGDES MLMOTS
  156. SEGDES MLMOT1
  157. 200 CONTINUE
  158.  
  159. ENDIF
  160. *
  161. * -- REMPLISSAGE DU DESCRIPTEUR DE L'OBJET "RIGIDITE" --
  162. *
  163. MELEME = IPELEM
  164. SEGACT,MELEME
  165. NBNN = NUM(/1)
  166. SEGDES,MELEME
  167. *
  168. IF (NBLMOT .EQ. 1) THEN
  169. *
  170. NLIGRP= NBMOTT * NBNN
  171. NLIGRD=NBMOTT * NBNN
  172. SEGINI,DESCR
  173. MLMOTS = ILMOTS(1)
  174. SEGACT,MLMOTS
  175. MLMOT1 = MTEM3.ILMOTS(1)
  176. SEGACT,MLMOT1
  177. NBCOMP = NBMOTT
  178. *
  179. DO 500 IB500=1,NBNN
  180. ICONST = (IB500 - 1) * NBCOMP
  181. DO 510 IB510=1,NBCOMP
  182. III = IB510 + ICONST
  183. NOELEP(III) = IB500
  184. NOELED(III) = IB500
  185. LISINC(III) = MOTS(IB510)
  186. LISDUA(III) = MLMOT1.MOTS(IB510)
  187. 510 CONTINUE
  188. * END DO
  189. 500 CONTINUE
  190. * END DO
  191. *
  192. SEGDES,MLMOTS
  193. *
  194. ELSE IF (NBLMOT .GT. 1) THEN
  195. *
  196. IF (NBLMOT .NE. NBNN) THEN
  197. NUMERR = 198
  198. CALL ERREUR (NUMERR)
  199. RETURN
  200. END IF
  201. *
  202. NLIGRP = NBMOTT
  203. NLIGRD=NBMOTT
  204. SEGINI,DESCR
  205. *
  206. ICONST = 0
  207. DO 550 IB550=1,NBNN
  208. *
  209. MLMOTS = ILMOTS(IB550)
  210. SEGACT,MLMOTS
  211. MLMOT1 = MTEM3.ILMOTS(IB550)
  212. SEGACT,MLMOT1
  213. NBCOMP = MOTS(/2)
  214. *
  215. DO 570 IB570=1,NBCOMP
  216. III = IB570 + ICONST
  217. NOELEP(III) = IB550
  218. NOELED(III) = IB550
  219. LISINC(III) = MOTS(IB570)
  220. LISDUA(III) = MLMOT1.MOTS(IB570)
  221. 570 CONTINUE
  222. * END DO
  223. *
  224. ICONST = ICONST + NBCOMP
  225. *
  226. SEGDES,MLMOTS
  227. *
  228. 550 CONTINUE
  229. * END DO
  230. *
  231. ELSE
  232. *
  233. * IL N'A PAS ETE FOURNI DE 'LISTMOTS':
  234. MOTERR(1:8) = 'LISTMOTS'
  235. NUMERR = 37
  236. CALL ERREUR (NUMERR)
  237. RETURN
  238. *
  239. END IF
  240. *
  241. IPDESC = DESCR
  242. SEGDES,DESCR
  243. SEGDES,MTEMP3
  244. IF (IDUAL.EQ.0) THEN
  245. SEGSUP MTEM3
  246. ELSE
  247. SEGDES MTEM3
  248. ENDIF
  249. *
  250. END
  251.  
  252.  
  253.  
  254.  
  255.  
  256.  
  257.  
  258.  
  259.  
  260.  
  261.  

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