Télécharger manur4.eso

Retour à la liste

Numérotation des lignes :

  1. C MANUR4 SOURCE BP208322 17/02/10 21:15:01 9305
  2. SUBROUTINE MANUR4 (IPELEM,IPDESC,MTEMP4,IPMATR,IANTI)
  3. ************************************************************************
  4. *
  5. * M A N U R 4
  6. * -----------
  7. *
  8. * FONCTION:
  9. * ---------
  10. *
  11. * CONSTRUCTION DES MATRICES ELEMENTAIRES DE RIGIDITE POUR UN OBJET
  12. * 'RIGIDITE' CREE MANUELLEMENT.
  13. * L'UTILISATION DE CE SOUS-PROGRAMME N'EST PAS UNIVERSELLE.
  14. *
  15. * MODE D'APPEL:
  16. * -------------
  17. *
  18. * CALL MANUR4 (IPELEM,IPDESC,MTEMP4,IPMATR,IANTI)
  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. * IPDESC ENTIER (E) POINTEUR SUR LE SEGMENT DESCRIPTEUR DE
  26. * L'OBJET 'RIGIDITE'.
  27. * MTEMP4 SEGMENT (E) REGROUPEMENT DE POINTEURS SUR DES
  28. * 'LISTREEL'.
  29. * SOIT IL N'Y A QU'1 'LISTREEL', QUI CONTIENT
  30. * TOUS LES TERMES DE LA
  31. * MATRICE ELEMENTAIRE DE RIGIDITE, ECRITS
  32. * LIGNE PAR LIGNE,
  33. * SOIT IL Y A AUTANT DE 'LISTREEL' QUE DE
  34. * LIGNES DANS LA MATRICE ELEMENTAIRE DE
  35. * RIGIDITE, LE N-IEME 'LISTREEL' DECRIVANT LA
  36. * N-IEME LIGNE DE LA MATRICE .
  37. * IPMATR ENTIER (S) POINTEUR SUR LE SEGMENT CONTENANT LA LISTE
  38. * DES POINTEURS DES MATRICES ELEMENTAIRES DE
  39. * RIGIDITE.
  40. *
  41. * EXEMPLE DE PRESENTATION DE LA MATRICE ELEMENTAIRE:
  42. *
  43. * | A B C |
  44. * | B D E | PEUT ETRE REPRESENTEE:
  45. * | C E F |
  46. *
  47. * PAR 1 SEUL 'LISTREEL' CONTENANT: A, B,C,B, D,E, C, E, F.
  48. * PAR 3 'LISTREEL' CONTENANT: A. B C
  49. * B, D. E
  50. * C, E, F.
  51. *
  52. * LEXIQUE: (ORDRE ALPHABETIQUE)
  53. * --------
  54. *
  55. * LONG ENTIER LONGUEUR DU 'LISTREEL' TRAITE.
  56. * NBLREE ENTIER NOMBRE DE 'LISTREEL' REFERENCES PAR "MTEMP4".
  57. *
  58. * LES AUTRES VARIABLES IMPORTANTES SONT EXPLIQUEES DANS LES MODULES
  59. * INCLUS.
  60. *
  61. * SOUS-PROGRAMMES APPELES:
  62. * ------------------------
  63. *
  64. * ERREUR.
  65. *
  66. * AUTEUR, DATE DE CREATION:
  67. * -------------------------
  68. *
  69. * PASCAL MANIGOT 19 FEVRIER 1985
  70. *
  71. * LANGAGE:
  72. * --------
  73. *
  74. * ESOPE + FORTRAN77
  75. *
  76. ************************************************************************
  77. *
  78. IMPLICIT INTEGER(I-N)
  79. -INC CCOPTIO
  80. -INC SMELEME
  81. -INC SMLREEL
  82. -INC SMRIGID
  83. *
  84. SEGMENT /MTEMP4/ (ILREEL(0))
  85. *
  86. cdebug LOGICAL TEST
  87. *
  88. MELEME = IPELEM
  89. SEGACT,MELEME
  90. NELRIG = NUM(/2)
  91. SEGDES,MELEME
  92. *
  93. DESCR = IPDESC
  94. SEGACT,DESCR
  95. C ... La distinction entre les deux nombre est un peu artificielle,
  96. C car manur3 vérifie si les listmots sont de longueurs égales,
  97. C on en a juste besoin pour initialiser XMATRI ...
  98. NLIGRP = NOELEP(/1)
  99. NLIGRD = NOELED(/1)
  100. C ... LVAL = nombre de termes d'une matrice pleine ...
  101. LVAL = NLIGRP * NLIGRD
  102. SEGDES,DESCR
  103. *
  104. SEGINI,xMATRI
  105. IPMATR = xMATRI
  106. * SEGINI,XMATRI
  107. * DO 100 IB100=1,NELRIG
  108. * IMATTT(IB100) = XMATRI
  109. * 100 CONTINUE
  110. * END DO
  111. * SEGDES,IMATRI
  112. *
  113. * RQ: "XMATRI" EST GARDE ACTIF.
  114. *
  115. SEGACT,MTEMP4
  116. NBLREE = ILREEL(/1)
  117. *
  118. IF (NBLREE .EQ. 1) THEN
  119. *
  120. MLREEL = ILREEL(1)
  121. SEGACT,MLREEL
  122. C ... LVA1 = nombre de termes d'une matrice carrée défini par
  123. C sa moitié ...
  124. LVA1=NLIGRP*(NLIGRP+1)/2
  125. IF (LVAL .NE. PROG(/1).AND.PROG(/1).NE.LVA1 ) THEN
  126. NUMERR = 199
  127. CALL ERREUR (NUMERR)
  128. RETURN
  129. END IF
  130. *
  131. C ... ILA = N° de ligne de la matrice élémentaire ...
  132. ILA=1
  133. C ... ILC = N° de colonne de la matrice élémentaire ...
  134. ILC=1
  135.  
  136. C ... ITRI dit si toutes les composantes ont été données ou
  137. C juste le triangle inférieur ...
  138. ITRI=0
  139. cbp IF(PROG(/1).EQ.LVA1) ITRI=1
  140. IF(PROG(/1).EQ.LVA1.AND.PROG(/1).NE.LVAL) ITRI=1
  141. IF(ITRI.EQ.1.AND.IANTI.EQ.2) THEN
  142. CALL ERREUR(731)
  143. C ... On laisse les cochonneries dans XMATRI ...
  144. * SEGDES,XMATRI
  145. C ... puis on s'en va ...
  146. RETURN
  147. ENDIF
  148.  
  149. DO 200 IB200=1,PROG(/1)
  150.  
  151. RE(ILA,ILC,1) = PROG(IB200)
  152.  
  153. IF(ITRI.EQ.1) THEN
  154. IF(IANTI.EQ.1) THEN
  155. RE(ILC,ILA,1)=-PROG(IB200)
  156. ELSE
  157. RE(ILC,ILA,1)=PROG(IB200)
  158. ENDIF
  159. ENDIF
  160.  
  161. cdebugC ... Vérif si les lignes pleines respectent la symétrie spécifiée ...
  162. cdebug IF((ITRI.EQ.0) .AND.
  163. cdebug & (IANTI.EQ.0.OR.IANTI.EQ.1) .AND.
  164. cdebug & (ILC.LE.ILA)) THEN
  165. cdebug IF(IANTI.EQ.0) TEST=RE(ILA,ILC,1).EQ.RE(ILC,ILA,1)
  166. cdebug IF(IANTI.EQ.1) TEST=RE(ILA,ILC,1).EQ.-RE(ILC,ILA,1)
  167. cdebug IF(.NOT.TEST) THEN
  168. cdebug write(*,*) 'Erreur : les lignes pleines ne ',
  169. cdebug & 'respectent pas la symétrie spécifiée !'
  170. cdebugC-à-faire boulot avec les segments
  171. cdebug return
  172. cdebug ENDIF
  173. cdebug ENDIF
  174.  
  175. ILC=ILC+1
  176. C ... On passe à la ligne si on a traversé la diagonale (cas triangulaire) ...
  177. IF(ILC.GT.ILA.AND.ITRI.EQ.1) THEN
  178. ILC=1
  179. ILA=ILA+1
  180. ENDIF
  181.  
  182. C ... On passe à la ligne si on est au bout (cas plein) ...
  183. IF(ILC.GT.NLIGRP) THEN
  184. ILC=1
  185. ILA=ILA+1
  186. ENDIF
  187.  
  188. 200 CONTINUE
  189. do ib=2,nelrig
  190. do io=1,nligrp
  191. do iu=1,nligrd
  192. re(iu,io,ib)=re(iu,io,1)
  193. enddo
  194. enddo
  195. enddo
  196. * END DO
  197. *
  198. SEGDES,MLREEL
  199. *
  200. ELSE IF (NBLREE .GT. 1) THEN
  201. *
  202. IF (NBLREE .EQ. NLIGRD) THEN
  203. *
  204. MLREEL=ILREEL(1)
  205. SEGACT MLREEL
  206.  
  207. C ... Cas triangulaire ? ...
  208. ITRI=0
  209. IF(PROG(/1).EQ.1) ITRI=1
  210. IF(ITRI.EQ.1.AND.IANTI.EQ.2) THEN
  211. CALL ERREUR(731)
  212. C ... On laisse les cochonneries dans XMATRI ...
  213. * SEGDES,XMATRI
  214. C ... puis on s'en va ...
  215. RETURN
  216. ENDIF
  217.  
  218. C ... Boucle sur les lignes (IB300 = N° de la ligne) ...
  219. DO 300 IB300=1,NBLREE
  220. *
  221. MLREEL = ILREEL(IB300)
  222. SEGACT,MLREEL
  223. LONG = PROG(/1)
  224. C ... Cas lignes pleines : longueur doit être NLIGRP ...
  225. IF (ITRI.EQ.0.AND.LONG .NE. NLIGRP) THEN
  226. NUMERR = 200
  227. CALL ERREUR (NUMERR)
  228. RETURN
  229. END IF
  230. C ... Cas triangulaire : longueur doit être N° de la ligne ...
  231. IF (ITRI.EQ.1.AND.LONG.NE.IB300) THEN
  232. NUMERR = 200
  233. CALL ERREUR (NUMERR)
  234. RETURN
  235. END IF
  236.  
  237. C ... Boucle sur les colonnes (IB310 = N° de la colonne) ...
  238. DO 310 IB310=1,LONG
  239.  
  240. RE(IB300,IB310,1) = PROG(IB310)
  241. IF(IANTI.EQ.1.AND.ITRI.EQ.1)RE(IB310,IB300,1)=-RE(IB300,IB310,1)
  242. IF(IANTI.EQ.0.AND.ITRI.EQ.1)RE(IB310,IB300,1)=RE(IB300,IB310,1)
  243.  
  244. cdebugC ... Vérif si les lignes pleines respectent la symétrie spécifiée ...
  245. cdebug IF((ITRI.EQ.0) .AND.
  246. cdebug & (IANTI.EQ.0.OR.IANTI.EQ.1) .AND.
  247. cdebug & (IB310.LE.IB300)) THEN
  248. cdebug IF(IANTI.EQ.0) TEST=RE(IB300,IB310,1).EQ.RE(IB310,IB300,1)
  249. cdebug IF(IANTI.EQ.1) TEST=RE(IB300,IB310,1).EQ.-RE(IB310,IB300,1)
  250. cdebug IF(.NOT.TEST) THEN
  251. cdebug write(*,*) 'Erreur : les lignes pleines ne ',
  252. cdebug & 'respectent pas la symétrie spécifiée !'
  253. cdebugC-à-faire boulot avec les segments
  254. cdebug return
  255. cdebug ENDIF
  256. cdebug ENDIF
  257.  
  258. 310 CONTINUE
  259. * END DO
  260. *
  261. SEGDES,MLREEL
  262. *
  263. 300 CONTINUE
  264. do ib=2,nelrig
  265. do io=1,nligrp
  266. do iu=1,nligrd
  267. re(iu,io,ib)=re(iu,io,1)
  268. enddo
  269. enddo
  270. enddo
  271. * END DO
  272.  
  273. C ... c.à.d. le nombre de LISTREEL est différent du nombre de variables duales ...
  274. ELSE
  275. *
  276. NUMERR = 201
  277. CALL ERREUR (NUMERR)
  278. RETURN
  279. *
  280. END IF
  281. *
  282. ELSE
  283. *
  284. * AUCUN 'LISTREEL' N'A ETE FOURNI EN DONNEE.
  285. MOTERR(1:8) = 'LISTREEL'
  286. NUMERR = 37
  287. CALL ERREUR (NUMERR)
  288. RETURN
  289. *
  290. END IF
  291. *
  292. SEGDES,XMATRI
  293. SEGDES,MTEMP4
  294. *
  295. END
  296.  
  297.  
  298.  
  299.  
  300.  
  301.  
  302.  
  303.  
  304.  

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