Télécharger sols.eso

Retour à la liste

Numérotation des lignes :

sols
  1. C SOLS SOURCE CHAT 05/01/13 03:21:44 5004
  2. SUBROUTINE SOLS
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. C
  6. C=======================================================================
  7. C OPERATEUR SOLS : FABRIQUE LES SOLUTIONS STATIQUES POUR LES LIAISON L
  8. C DE LA STRUCTURE S
  9. C
  10. C SYNTAXE : SS = SOLS L S ;
  11. C SS : OBJET SOLUTION (SOUS TYPE SOLU-STAT)
  12. C S : OBJET STRUCTURE ELEMENTAIRE
  13. C L : OBJET ATTACHE
  14. C
  15. C ECRIT PAR FARVACQUE
  16. C APPELLE LIROBJ SOLS1 ERREUR(132,139) ECROBJ
  17. C=======================================================================
  18. C
  19.  
  20. -INC PPARAM
  21. -INC CCOPTIO
  22. -INC SMSTRUC
  23. -INC SMATTAC
  24. -INC SMSOLUT
  25. C
  26. C
  27. CALL LIROBJ('ATTACHE ',IMAT,1,IRETOU)
  28. IF(IERR.NE.0) GO TO 5000
  29. CALL LIROBJ('STRUCTUR',ISTR,1,IRETOU)
  30. IF(IERR.NE.0) GO TO 5000
  31. C
  32. MSTRUC=ISTR
  33. SEGACT MSTRUC
  34. IF(LISTRU(/1).EQ.1) GOTO 1
  35. SEGDES MSTRUC
  36. MOTERR(1:8)='STRUCTUR'
  37. CALL ERREUR(132)
  38. GO TO 5000
  39. 1 CONTINUE
  40. MSOSTU=LISTRU(1)
  41. SEGDES MSTRUC
  42. SEGACT MSOSTU
  43. KRIGI=ISRAID
  44. SEGDES MSOSTU
  45. C
  46. C **** ON COMPTE LES MJONCT QUI AGISSENT SUR MSOSTU ET QUI INTERVIENNEN
  47. C **** AU PREMIER MEMBRE. ON LES MET DANS MSOLE1
  48. C
  49. MATTAC=IMAT
  50. SEGACT MATTAC
  51. N=0
  52. SEGINI MSOLE1
  53. DO 170 IA=1,LISATT(/1)
  54. MSOUMA=LISATT(IA)
  55. SEGACT MSOUMA
  56. IF(ITYATT.EQ.'MECA') GO TO 169
  57. IF(ITYATT.EQ.'FLUI') GO TO 169
  58. IF(ITYATT.EQ.'DEPI') GO TO 169
  59. GOTO 171
  60. 169 CONTINUE
  61. NL=IATREL(/1)
  62. DO 172 IB=1,NL
  63. MJONCT=IATREL(IB)
  64. SEGACT MJONCT
  65. NCCC=ISTRJO(/1)
  66. DO 173 IC=1,NCCC
  67. IF(ISTRJO(IC).NE.MSOSTU) GO TO 173
  68. N=N+1
  69. SEGADJ MSOLE1
  70. MSOLE1.ISOLEN(N)=MJONCT
  71. GO TO 174
  72. 173 CONTINUE
  73. 174 CONTINUE
  74. SEGDES MJONCT
  75. 172 CONTINUE
  76. 171 CONTINUE
  77. SEGDES MSOUMA
  78. 170 CONTINUE
  79. SEGDES MATTAC
  80. IF(N.NE.0) GO TO 2
  81. INTERR(1)=MSOSTU
  82. CALL ERREUR(139)
  83. C ON NE TROUVE PAS DE LIAISON CORRESPONDANT A LA STRUCTURE
  84. SEGSUP MSOLE1
  85. GO TO 5000
  86. 2 CONTINUE
  87. C
  88. KSOSTU=MSOSTU
  89. KSOLE1=MSOLE1
  90. CALL SOLS1(KSOSTU,KSOLE1,KSOLUT)
  91. IF(IERR.NE.0) GOTO 5000
  92. CALL ECROBJ('SOLUTION',KSOLUT)
  93. 5000 CONTINUE
  94. RETURN
  95. END
  96.  
  97.  

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