Télécharger prrigi.eso

Retour à la liste

Numérotation des lignes :

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

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