Télécharger prrigi.eso

Retour à la liste

Numérotation des lignes :

  1. C PRRIGI SOURCE BP208322 13/04/08 21:15:16 7749
  2. c imprime les matrices de rigidite pointeur de l objet=iret
  3. c
  4. SUBROUTINE PRRIGI(IRET,JENTET)
  5. IMPLICIT INTEGER(I-N)
  6. -INC SMRIGID
  7. -INC CCOPTIO
  8. -INC SMELEME
  9. CHARACTER*24 TITI,TOTO,TOTO2
  10. c nombre de matrices elementaires a afficher (anciennement =10 en dur)
  11. PARAMETER(NRESU=2)
  12. c
  13. C eventuellement, on lit le nombre de valeurs de REL a afficher avant de
  14. C revenir a la ligne
  15. NMAX=39
  16. CALL LIRENT(IMAX,0,IRETOU)
  17. if(IRETOU.NE.0) NMAX=IMAX
  18.  
  19. MRIGID=IRET
  20. if (mrigid.le.0) then
  21. call erreur(26)
  22. return
  23. endif
  24. SEGACT MRIGID
  25. NRI=IRIGEL(/1)
  26. NR=IRIGEL(/2)
  27. c ERREUR(-26): Matrice de %m1:8 formée de %i1 matrice(s) élémentaire(s)
  28. MOTERR(1:8)=MTYMAT
  29. INTERR(1)=NR
  30. CALL ERREUR(-26)
  31.  
  32. c --- boucle sur les sous-rigidites ------------------------------------
  33. DO 191 I=1,NR
  34. IGEO=IRIGEL(1,I)
  35. xMATRI=IRIGEL(4,I)
  36. SEGACT xMATRI
  37. NMA=re(/3)
  38. DESCR=IRIGEL(3,I)
  39. NNHA=IRIGEL(5,I)
  40. NEGALI=IRIGEL(6,I)
  41. SEGACT DESCR
  42. NINC=LISINC(/2)
  43. NINCD=LISDUA(/2)
  44.  
  45. c ERREUR(-27): Sous matrice %i1 : %i2 éléments : %i3 x %i4 inconnue(s) par matrice
  46. c Coefficient multiplicateur %r1 : Harmonique %i5
  47. INTERR(1)=I
  48. INTERR(2)=NMA
  49. INTERR(3)=NINC
  50. INTERR(4)=NINCD
  51. REAERR(1)=COERIG(I)
  52. INTERR(5)=NNHA
  53. CALL ERREUR(-27)
  54. IF (NRI.GE.7) THEN
  55. IANTI=IRIGEL(7,I)
  56. IF (IANTI.EQ.0) THEN
  57. CALL ERREUR(-274)
  58. ELSE IF (IANTI.EQ.1) THEN
  59. CALL ERREUR(-275)
  60. ELSE IF (IANTI.EQ.2) THEN
  61. CALL ERREUR(-307)
  62. ELSE IF (IANTI.EQ.3) THEN
  63. CALL ERREUR(-320)
  64. ENDIF
  65. ELSE
  66. CALL ERREUR(-274)
  67. ENDIF
  68.  
  69. c ... désormais inutile ... interr(1)=negali
  70. c ERREUR(-28): Nature des matrices : "%m1:1"
  71. c Noeuds Inconnue : (les %i2 premières sont primales)
  72. IF(NEGALI.EQ.0) THEN
  73. MOTERR(1:1)='='
  74. ELSE IF(NEGALI.EQ.-1) THEN
  75. MOTERR(1:1)='>'
  76. ELSE IF(NEGALI.EQ. 1) THEN
  77. MOTERR(1:1)='<'
  78. ELSE
  79. MOTERR(1:1)='?'
  80. ENDIF
  81. INTERR(2)=NINC
  82. CALL ERREUR(-28)
  83. c ecriture du DESCR
  84. WRITE(IOIMP,194)(NOELEP(J),LISINC(J),J=1,NINC)
  85. WRITE(IOIMP,194)(NOELED(J),LISDUA(J),J=1,NINCD)
  86. 194 FORMAT( I6,9X,A4)
  87. SEGDES DESCR
  88. MELEME=IGEO
  89. SEGACT MELEME
  90. C ERREUR (-29): Liste des points associés aux matrices
  91. CALL ERREUR (-29)
  92. NBNN=NUM(/1)
  93. NBELEM=NUM(/2)
  94. c option 'RESUM' : on n'affiche que les NRESU premiers elements
  95. nbi=nbelem
  96. if(jentet.eq.1) nbi=min (NRESU,nbi)
  97. NBNN2=min(NBNN,NMAX)
  98. WRITE(TITI,FMT='("( A,",I3,"( A,I3))")') NBNN2
  99. WRITE(IOIMP,TITI) ' element :',(' pt',IKK,IKK=1,NBNN)
  100. WRITE(TITI,FMT='("(I8,A,",I3,"(1X,I8))")') NBNN2
  101. DO 1000 INNN=1,NBi
  102. c WRITE(IOIMP,1001)(NUM(IKK,INNN),IKK=1,NBNN)
  103. WRITE(IOIMP,TITI) INNN,' :',(NUM(IKK,INNN),IKK=1,NBNN)
  104. 1000 CONTINUE
  105. c 1001 FORMAT(15I8)
  106.  
  107. IF(ITYPEL.NE.22) GOTO 199
  108. c - Cas des multiplicateurs de Lagrange -
  109. C ERREUR(-30): Maillage %i1 associé à la condition
  110. INTERR(1)=IGEO
  111. CALL ERREUR(-30)
  112. NBPOIN=NUM(/2)
  113. NBNN=NUM(/1)
  114. c option 'RESUM' : on n'affiche que les NRESU premiere elements
  115. nbi=nbpoin
  116. if( jentet.eq.1) nbi=min (NRESU,nbi)
  117. NBNN2=min(NBNN,NMAX)
  118. c WRITE(TITI,FMT='("(27X,",I3,"(1X,I8))")') NBNN2
  119. WRITE(TITI,FMT='("(1X,A,1X,",I3,"(1X,I8))")') NBNN2
  120. DO 198 J=1,nbi
  121. IF (IERR.NE.0) RETURN
  122. c C ERREUR(-31): Noeuds soumis à la condition :
  123. c CALL ERREUR(-31)
  124. c ecriture des noeuds hors LX (suppose etre en position 1)
  125. c WRITE (IOIMP,203) (NUM(K,J),K=2,NBNN)
  126. c WRITE (IOIMP,TITI) (NUM(K,J),K=2,NBNN)
  127. WRITE (IOIMP,TITI) 'Noeuds soumis à la condition :',
  128. & (NUM(K,J),K=2,NBNN)
  129. c 203 FORMAT(30X,10I8)
  130. c ecriture du noeud LX (suppose etre en position 1)
  131. c ERREUR(-32): Multiplicateurs de Lagrange : %i1
  132. INTERR(1)=NUM(1,J)
  133. CALL ERREUR(-32)
  134. 198 CONTINUE
  135. 199 CONTINUE
  136. c - Fin du Cas des multiplicateurs de Lagrange -
  137. SEGDES MELEME
  138.  
  139. c --- boucle sur le matrices elementaires ---
  140. if(jentet.eq.1) nma=min(nma,NRESU)
  141. DO 196 IA=1,NMA
  142. IF (IERR.NE.0) RETURN
  143. * XMATRI=IMATTT(IA)
  144. ** SEGACT XMATRI
  145. NVA=RE(/1)
  146. NVB=RE(/2)
  147. C ERREUR(-33): Matrice élémentaire numéro : %i1 ( ligne1,ligne2,ligne3...)
  148. INTERR(1)= IA
  149. CALL ERREUR(-33)
  150. C ecriture des matrices elementaires REL
  151. c WRITE(IOIMP,195) ((RE(L,K,ia),K=1,NVB),L=1,NVA)
  152. c 195 FORMAT(1X,6E12.5)
  153. c ecriture ligne par ligne
  154. c NMAX= nbre de valeurs max = (nbre caracteres max -1espace -3points)
  155. c = (512)/13 = 39 par exemple
  156. if(NVB.le.NMAX) then
  157. WRITE(TOTO,FMT='("(",I3,"(1X,E12.5),1X,A)")') NVB
  158. do L=1,NVA
  159. WRITE(IOIMP,FMT=TOTO) (RE(L,jou,IA),jou=1,NVB),';'
  160. enddo
  161. else
  162. nbloc=NVB/NMAX
  163. WRITE(TOTO,FMT='("(",I3,"(1X,E12.5),1X,A)")') NMAX
  164. nrest = NVB-(NMAX*nbloc)
  165. c on s assure que : NMAX >= nrest > 0
  166. if(nrest.eq.0) then
  167. nbloc=nbloc-1
  168. nrest=NMAX
  169. endif
  170. WRITE(TOTO2,FMT='("(",I3,"(1X,E12.5),1X,A)")') nrest
  171. do L=1,NVA
  172. jdeb=1
  173. if(nbloc.gt.0) then
  174. do jbloc=1,nbloc
  175. WRITE(IOIMP,FMT=TOTO) (RE(L,jou,IA),jou=jdeb,(jdeb+NMAX-1)),'...'
  176. jdeb=jdeb+NMAX
  177. enddo
  178. endif
  179. WRITE(IOIMP,FMT=TOTO2) (RE(L,jou,IA),jou=jdeb,NVB),';'
  180. enddo
  181. endif
  182. * SEGDES XMATRI
  183. 196 CONTINUE
  184. c --- fin de boucle sur le matrices elementaires ---
  185. SEGDES MELEME
  186. SEGDES xMATRI
  187.  
  188. 191 CONTINUE
  189. c --- fin de boucle sur les sous-rigidites -----------------------------
  190. SEGDES MRIGID
  191. RETURN
  192. END
  193. c
  194.  
  195.  
  196.  
  197.  
  198.  

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