Télécharger manur3.eso

Retour à la liste

Numérotation des lignes :

manur3
  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.  
  71. -INC PPARAM
  72. -INC CCOPTIO
  73. -INC CCHAMP
  74. -INC SMELEME
  75. -INC SMLMOTS
  76. -INC SMRIGID
  77. *
  78. SEGMENT /MTEMP3/ (ILMOTS(0)),MTEM3.MTEMP3
  79. *
  80. LOGICAL BADNAM
  81. *
  82. *
  83. *
  84. * -- VERIFICATION DES NOMS DE COMPOSANTES DONNES ET ENREGISTREMENT
  85. * DES COMPOSANTES DUALES --
  86. *
  87. MTEMP3=IINCO
  88. SEGACT,MTEMP3
  89. NBLMOT = ILMOTS(/1)
  90. *
  91. * ON N'A PAS DONNE LES NOMS DES DUALES
  92. * ON CHERCHE DANS NOMDD
  93. *
  94. IF (IDUAL.EQ.0) THEN
  95. SEGINI,MTEM3=MTEMP3
  96. *
  97. NBMOTT = 0
  98. DO 100 IB100=1,NBLMOT
  99. *
  100. MLMOTS = ILMOTS(IB100)
  101. SEGACT,MLMOTS
  102. NBMOTS = MOTS(/2)
  103. NBMOTT = NBMOTT + NBMOTS
  104. SEGINI,MLMOT1=MLMOTS
  105. MTEM3.ILMOTS(IB100) = MLMOT1
  106. *
  107. DO 110 IB110=1,NBMOTS
  108. *
  109. BADNAM = .TRUE.
  110. DO 120 IB120=1,LNOMDD
  111. IF (MOTS(IB110) .EQ. NOMDD(IB120) ) THEN
  112. MLMOT1.MOTS(IB110) = NOMDU(IB120)
  113. BADNAM = .FALSE.
  114. * --> SORTIE DE BOUCLE N.120
  115. GOTO 122
  116. END IF
  117. 120 CONTINUE
  118. * END DO
  119. 122 CONTINUE
  120. *
  121. IF (BADNAM) THEN
  122. MOTERR(1:4) = MOTS(IB110)
  123. NUMERR = 197
  124. CALL ERREUR (NUMERR)
  125. RETURN
  126. END IF
  127. *
  128. 110 CONTINUE
  129. * END DO
  130. *
  131. SEGDES,MLMOTS
  132. SEGDES,MLMOT1
  133. *
  134. 100 CONTINUE
  135. * END DO
  136. *
  137. * ON A DONNE LES NOMS DES DUALES
  138. * ON NE FAIT AUCUNE VERIF SUR LES NOMS
  139. *
  140. ELSE
  141.  
  142. MTEM3=IDUAL
  143. SEGACT MTEM3
  144. *
  145. NBMOTT=0
  146. DO 200 IB200=1,NBLMOT
  147. MLMOTS = ILMOTS(IB200)
  148. SEGACT,MLMOTS
  149. MLMOT1 = MTEM3.ILMOTS(IB200)
  150. SEGACT MLMOT1
  151. NBMOTS = MOTS(/2)
  152. IF (NBMOTS.NE.MLMOT1.MOTS(/2)) THEN
  153. CALL ERREUR(217)
  154. RETURN
  155. ENDIF
  156. NBMOTT = NBMOTT + NBMOTS
  157. SEGDES MLMOTS
  158. SEGDES MLMOT1
  159. 200 CONTINUE
  160.  
  161. ENDIF
  162. *
  163. * -- REMPLISSAGE DU DESCRIPTEUR DE L'OBJET "RIGIDITE" --
  164. *
  165. MELEME = IPELEM
  166. SEGACT,MELEME
  167. NBNN = NUM(/1)
  168. SEGDES,MELEME
  169. *
  170. IF (NBLMOT .EQ. 1) THEN
  171. *
  172. NLIGRP= NBMOTT * NBNN
  173. NLIGRD=NBMOTT * NBNN
  174. SEGINI,DESCR
  175. MLMOTS = ILMOTS(1)
  176. SEGACT,MLMOTS
  177. MLMOT1 = MTEM3.ILMOTS(1)
  178. SEGACT,MLMOT1
  179. NBCOMP = NBMOTT
  180. *
  181. DO 500 IB500=1,NBNN
  182. ICONST = (IB500 - 1) * NBCOMP
  183. DO 510 IB510=1,NBCOMP
  184. III = IB510 + ICONST
  185. NOELEP(III) = IB500
  186. NOELED(III) = IB500
  187. LISINC(III) = MOTS(IB510)
  188. LISDUA(III) = MLMOT1.MOTS(IB510)
  189. 510 CONTINUE
  190. * END DO
  191. 500 CONTINUE
  192. * END DO
  193. *
  194. SEGDES,MLMOTS
  195. *
  196. ELSE IF (NBLMOT .GT. 1) THEN
  197. *
  198. IF (NBLMOT .NE. NBNN) THEN
  199. NUMERR = 198
  200. CALL ERREUR (NUMERR)
  201. RETURN
  202. END IF
  203. *
  204. NLIGRP = NBMOTT
  205. NLIGRD=NBMOTT
  206. SEGINI,DESCR
  207. *
  208. ICONST = 0
  209. DO 550 IB550=1,NBNN
  210. *
  211. MLMOTS = ILMOTS(IB550)
  212. SEGACT,MLMOTS
  213. MLMOT1 = MTEM3.ILMOTS(IB550)
  214. SEGACT,MLMOT1
  215. NBCOMP = MOTS(/2)
  216. *
  217. DO 570 IB570=1,NBCOMP
  218. III = IB570 + ICONST
  219. NOELEP(III) = IB550
  220. NOELED(III) = IB550
  221. LISINC(III) = MOTS(IB570)
  222. LISDUA(III) = MLMOT1.MOTS(IB570)
  223. 570 CONTINUE
  224. * END DO
  225. *
  226. ICONST = ICONST + NBCOMP
  227. *
  228. SEGDES,MLMOTS
  229. *
  230. 550 CONTINUE
  231. * END DO
  232. *
  233. ELSE
  234. *
  235. * IL N'A PAS ETE FOURNI DE 'LISTMOTS':
  236. MOTERR(1:8) = 'LISTMOTS'
  237. NUMERR = 37
  238. CALL ERREUR (NUMERR)
  239. RETURN
  240. *
  241. END IF
  242. *
  243. IPDESC = DESCR
  244. SEGDES,DESCR
  245. SEGDES,MTEMP3
  246. IF (IDUAL.EQ.0) THEN
  247. SEGSUP MTEM3
  248. ELSE
  249. SEGDES MTEM3
  250. ENDIF
  251. *
  252. END
  253.  
  254.  
  255.  
  256.  
  257.  
  258.  
  259.  
  260.  
  261.  
  262.  
  263.  

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