Télécharger manur4.eso

Retour à la liste

Numérotation des lignes :

  1. C MANUR4 SOURCE BP208322 20/05/04 21:15:08 10599
  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. * | A B C |
  43. * | D E F |
  44. * | G H I |
  45. * Elle peut etre donnee par: (PROG A B C D E F G H I )
  46. * ou bien par : (PROG A B C ) (PROG D E F) (PROG G H I )
  47. * si la matrice est symetrique ou antisymetrique on peut aussi
  48. * la decrire par 1 LISTREEEL : (PROG A D E G H I )
  49. * ou bien par plusieurs LISTREEL : (PROG A ) (PROG D E) (PROG G H I)
  50. *
  51. * LEXIQUE: (ORDRE ALPHABETIQUE)
  52. * --------
  53. *
  54. * LONG ENTIER LONGUEUR DU 'LISTREEL' TRAITE.
  55. * NBLREE ENTIER NOMBRE DE 'LISTREEL' REFERENCES PAR "MTEMP4".
  56. *
  57. * LES AUTRES VARIABLES IMPORTANTES SONT EXPLIQUEES DANS LES MODULES
  58. * INCLUS.
  59. *
  60. ************************************************************************
  61. *
  62. IMPLICIT INTEGER(I-N)
  63. LOGICAL ZTRI
  64. -INC PPARAM
  65. -INC CCOPTIO
  66. -INC SMELEME
  67. -INC SMLREEL
  68. -INC SMRIGID
  69. -INC CCREEL
  70. *
  71. SEGMENT /MTEMP4/ (ILREEL(0))
  72.  
  73. ************************************************************************
  74. * INITIALISATIONS ET OUVERTURE
  75. ************************************************************************
  76.  
  77. *
  78. MELEME = IPELEM
  79. SEGACT,MELEME
  80. NELRIG = NUM(/2)
  81. SEGDES,MELEME
  82. *
  83. DESCR = IPDESC
  84. SEGACT,DESCR
  85. C ... La distinction entre les deux nombres est un peu artificielle,
  86. C car manur3 vérifie si les listmots sont de longueurs égales,
  87. C on en a juste besoin pour initialiser XMATRI ...
  88. NLIGRP = NOELEP(/1)
  89. NLIGRD = NOELED(/1)
  90. C ... LVAL = nombre de termes d'une matrice pleine ...
  91. LVAL = NLIGRP * NLIGRD
  92. SEGDES,DESCR
  93. *
  94. SEGINI,xMATRI
  95. IPMATR = xMATRI
  96. * SEGINI,XMATRI
  97. * DO 100 IB100=1,NELRIG
  98. * IMATTT(IB100) = XMATRI
  99. * 100 CONTINUE
  100. * END DO
  101. * SEGDES,IMATRI
  102. *
  103. * RQ: "XMATRI" EST GARDE ACTIF.
  104. *
  105. SEGACT,MTEMP4
  106. NBLREE = ILREEL(/1)
  107. *
  108. ************************************************************************
  109. * Cas 1 seul LISTREEL
  110. ************************************************************************
  111. IF (NBLREE .EQ. 1) THEN
  112. *
  113. MLREEL = ILREEL(1)
  114. SEGACT,MLREEL
  115. C ... LVA1 = nombre de termes d'une matrice carrée défini par
  116. C sa moitié ...
  117. LVA1=NLIGRP*(NLIGRP+1)/2
  118. IF (LVAL .NE. PROG(/1).AND.PROG(/1).NE.LVA1 ) THEN
  119. NUMERR = 199
  120. CALL ERREUR (NUMERR)
  121. RETURN
  122. END IF
  123. *
  124. C ... ILA = N° de ligne de la matrice élémentaire ...
  125. ILA=1
  126. C ... ILC = N° de colonne de la matrice élémentaire ...
  127. ILC=1
  128.  
  129. C ... ZTRI dit si toutes les composantes ont été données ou
  130. C juste le triangle inférieur ...
  131. ZTRI=.FALSE.
  132. cbp IF(PROG(/1).EQ.LVA1) ZTRI=.TRUE.
  133. IF(PROG(/1).EQ.LVA1.AND.PROG(/1).NE.LVAL) ZTRI=.TRUE.
  134. IF(ZTRI .AND. IANTI.EQ.2) THEN
  135. CALL ERREUR(731)
  136. C ... On laisse les cochonneries dans XMATRI ...
  137. * SEGDES,XMATRI
  138. C ... puis on s'en va ...
  139. RETURN
  140. ENDIF
  141.  
  142. DO 200 IB200=1,PROG(/1)
  143.  
  144. RE(ILA,ILC,1) = PROG(IB200)
  145.  
  146. IF(ZTRI) THEN
  147. IF(IANTI.EQ.1) THEN
  148. RE(ILC,ILA,1)=-PROG(IB200)
  149. ELSE
  150. RE(ILC,ILA,1)=PROG(IB200)
  151. ENDIF
  152. ENDIF
  153.  
  154. ILC=ILC+1
  155. C ... On passe à la ligne si on a traversé la diagonale (cas triangulaire) ...
  156. IF(ILC.GT.ILA.AND. ZTRI) THEN
  157. ILC=1
  158. ILA=ILA+1
  159. ENDIF
  160.  
  161. C ... On passe à la ligne si on est au bout (cas plein) ...
  162. IF(ILC.GT.NLIGRP) THEN
  163. ILC=1
  164. ILA=ILA+1
  165. ENDIF
  166.  
  167. 200 CONTINUE
  168. do ib=2,nelrig
  169. do io=1,nligrp
  170. do iu=1,nligrd
  171. re(iu,io,ib)=re(iu,io,1)
  172. enddo
  173. enddo
  174. enddo
  175. * END DO
  176. *
  177. SEGDES,MLREEL
  178.  
  179.  
  180. ************************************************************************
  181. * Cas plusieurs LISTREEL
  182. ************************************************************************
  183. ELSE IF (NBLREE .GT. 1) THEN
  184. *
  185. IF (NBLREE .EQ. NLIGRD) THEN
  186. *
  187. MLREEL=ILREEL(1)
  188. SEGACT MLREEL
  189.  
  190. C ... Cas triangulaire ? ...
  191. ZTRI=.FALSE.
  192. IF(PROG(/1).EQ.1) ZTRI=.TRUE.
  193. IF(ZTRI .AND. IANTI.EQ.2) THEN
  194. CALL ERREUR(731)
  195. C ... On laisse les cochonneries dans XMATRI ...
  196. * SEGDES,XMATRI
  197. C ... puis on s'en va ...
  198. RETURN
  199. ENDIF
  200.  
  201. C ... Boucle sur les lignes (IB300 = N° de la ligne) ...
  202. DO 300 IB300=1,NBLREE
  203. *
  204. MLREEL = ILREEL(IB300)
  205. SEGACT,MLREEL
  206. LONG = PROG(/1)
  207. C ... Cas lignes pleines : longueur doit être NLIGRP ...
  208. IF (.not.ZTRI .AND. LONG.NE.NLIGRP) THEN
  209. NUMERR = 200
  210. CALL ERREUR (NUMERR)
  211. RETURN
  212. END IF
  213. C ... Cas triangulaire : longueur doit être N° de la ligne ...
  214. IF (ZTRI .AND. LONG.NE.IB300) THEN
  215. NUMERR = 200
  216. CALL ERREUR (NUMERR)
  217. RETURN
  218. END IF
  219.  
  220. C ... Boucle sur les colonnes (IB310 = N° de la colonne) ...
  221. DO 310 IB310=1,LONG
  222.  
  223. RE(IB300,IB310,1) = PROG(IB310)
  224. IF(IANTI.EQ.1.AND.ZTRI) RE(IB310,IB300,1)=-RE(IB300,IB310,1)
  225. IF(IANTI.EQ.0.AND.ZTRI) RE(IB310,IB300,1)=RE(IB300,IB310,1)
  226.  
  227. 310 CONTINUE
  228. * END DO
  229. *
  230. SEGDES,MLREEL
  231. *
  232. 300 CONTINUE
  233. do ib=2,nelrig
  234. do io=1,nligrp
  235. do iu=1,nligrd
  236. re(iu,io,ib)=re(iu,io,1)
  237. enddo
  238. enddo
  239. enddo
  240. * END DO
  241.  
  242. C ... c.à.d. le nombre de LISTREEL est différent du nombre de variables duales ...
  243. ELSE
  244. *
  245. NUMERR = 201
  246. CALL ERREUR (NUMERR)
  247. RETURN
  248. *
  249. END IF
  250.  
  251.  
  252. ************************************************************************
  253. * Cas aucun LISTREEL !
  254. ************************************************************************
  255. ELSE
  256. *
  257. * AUCUN 'LISTREEL' N'A ETE FOURNI EN DONNEE.
  258. MOTERR(1:8) = 'LISTREEL'
  259. NUMERR = 37
  260. CALL ERREUR (NUMERR)
  261. RETURN
  262. *
  263. END IF
  264.  
  265.  
  266. ************************************************************************
  267. * VERIFICATION EN FONCTION DES CAS (ajout, bp 2020)
  268. ************************************************************************
  269.  
  270. * SI SYM ET TRIANGULAIRE : PAS DE VERIF
  271. * SI SYM ET COMPLET : VERIF DES TERMES EXTRA-DIAGONAUX Aij=Aji
  272. IF(IANTI.EQ.0) THEN
  273. IF(.NOT.ZTRI) THEN
  274. call versym(re,re(/1),re(/2),re(/3),IANTI)
  275. if (ierr.ne.0) return
  276. ENDIF
  277.  
  278. ELSEIF(IANTI.EQ.1) THEN
  279. * SI ANTI-SYM ET TRIANGULAIRE : VERIF DE LA DIAGONALE
  280. IF(ZTRI) THEN
  281. xzref=(xpetit/xzprec)
  282. do iel=1,re(/3)
  283. do ir=1,re(/1)
  284. re1=re(ir,ir,iel)
  285. if (abs(re1).gt.xzref) then
  286. MOTERR(1:15)='ANTI-SYMETRIQUE'
  287. reaerr(1)=re1
  288. reaerr(2)=0.D0
  289. reaerr(3)=abs(re1)
  290. call erreur(1044)
  291. return
  292. endif
  293. enddo
  294. enddo
  295.  
  296. * SI ANTI-SYM ET COMPLET : VERIF DE TOUS LES TERMES Aij=-Aji
  297. ELSE
  298. call versym(re,re(/1),re(/2),re(/3),IANTI)
  299. if (ierr.ne.0) return
  300. ENDIF
  301.  
  302. * SI QUELCONQUE : PAS DE VERIF
  303. ENDIF
  304.  
  305.  
  306.  
  307. SEGDES,XMATRI
  308. SEGDES,MTEMP4
  309. *
  310. END
  311.  
  312.  
  313.  
  314.  
  315.  
  316.  
  317.  
  318.  
  319.  
  320.  

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