Télécharger aleat1.eso

Retour à la liste

Numérotation des lignes :

  1. C ALEAT1 SOURCE PV 16/11/17 21:58:06 9180
  2. * CREATION D'UN 'CHPOINT' A VALEURS QUELCONQUES.
  3. SUBROUTINE ALEAT1 (IPRIGI,IPCHPO)
  4. ************************************************************************
  5. *
  6. * A L E A T 1
  7. * -----------
  8. *
  9. * FONCTION:
  10. * ---------
  11. *
  12. * CREER UN 'CHPOINT' A VALEURS QUELCONQUES A PARTIR DE LA DONNEE
  13. * D'UNE 'RIGIDITE'.
  14. *
  15. * MODE D'APPEL:
  16. * -------------
  17. *
  18. * CALL ALEAT1 (IPRIGI,IPCHPO)
  19. *
  20. * PARAMETRES: (E)=ENTREE (S)=SORTIE
  21. * -----------
  22. *
  23. * IPRIGI ENTIER (E) POINTEUR D'UNE 'RIGIDITE'.
  24. * IPCHPO ENTIER (S) POINTEUR DU 'CHPOINT' DETERMINE.
  25. *
  26. * LEXIQUE: (ORDRE ALPHABETIQUE)
  27. * --------
  28. *
  29. * INC ENTIER NOMBRE D'INCONNUES DU PROBLEME.
  30. * IPMATR ENTIER POINTEUR SUR L'OBJET 'MATRICE' ASSOCIE A LA
  31. * 'RIGIDITE' DE POINTEUR "IPRIGI".
  32. * IPVECT ENTIER POINTEUR D'UN OBJET DE TRAVAIL 'VECTDOUB'.
  33. *
  34. * SOUS-PROGRAMMES APPELES:
  35. * ------------------------
  36. *
  37. * TRIANG, TDRAND, VCH1.
  38. *
  39. * AUTEUR, DATE DE CREATION:
  40. * -------------------------
  41. *
  42. * PASCAL MANIGOT 5 OCTOBRE 1984
  43. *
  44. * LANGAGE:
  45. * --------
  46. *
  47. * ESOPE + FORTRAN77
  48. *
  49. ************************************************************************
  50. *
  51. IMPLICIT INTEGER(I-N)
  52. -INC CCOPTIO
  53. -INC SMMATRI
  54. -INC SMRIGID
  55. -INC SMVECTD
  56. *
  57. * PARAMETER (LFIRST = 9)
  58. *
  59. * SAVE JFIRST
  60. *
  61. * DATA JFIRST/1/
  62. REAL*8 V
  63. integer insym
  64. insym = 0
  65. *
  66. * -- DETERMINATION DU NOMBRE D'INCONNUES DU PROBLEME TRAITE --
  67. *
  68. MRIGID = IPRIGI
  69. SEGACT,MRIGID
  70. NRG = IRIGEL(/1)
  71. NBR = IRIGEL(/2)
  72. IPMATR = ICHOLE
  73. IF(NORINC.GT.0 .AND. NORIND.GT.0) THEN
  74. INSYM = 1
  75. ENDIF
  76. IF (NRG.GE.7) THEN
  77. DO 9 IN = 1,NBR
  78. IANTI=IRIGEL(7,IN)
  79. IF(IANTI.GT.0) THEN
  80. INSYM = 1
  81. ENDIF
  82. 9 CONTINUE
  83. ENDIF
  84. SEGDES,MRIGID
  85. *
  86. IF (IPMATR .EQ. 0) THEN
  87. IF (INSYM .EQ. 0) THEN
  88. CALL TRIANG (IPRIGI,1D-18,0)
  89. ELSE
  90. CALL ldmt1(IPRIGI,1.D-18)
  91. ENDIF
  92. IF (IERR .NE. 0) RETURN
  93. MRIGID = IPRIGI
  94. SEGACT,MRIGID
  95. IPMATR = ICHOLE
  96. SEGDES,MRIGID
  97. END IF
  98. *
  99. MMATRI = IPMATR
  100. SEGACT,MMATRI
  101. MILIGN=IILIGN
  102. SEGDES,MMATRI
  103. SEGACT,MILIGN
  104. INC=IPNO(/1)
  105. SEGDES,MILIGN
  106. *
  107. * -- DETERMINATION D'UN VECTEUR QUELCONQUE, DE DIMENSION EGALE A
  108. * CELLE DU PROBLEME TRAITE --
  109. *
  110. SEGINI,MVECTD
  111. IPVECT = MVECTD
  112. DO 100 IB=1,INC
  113. CALL TDRAND(V)
  114. VECTBB(IB) = V
  115. 100 CONTINUE
  116. * write(6,*) ' vectbb sortie de trandd'
  117. * write(6,*) (vectbb (ib),ib=1,inc)
  118.  
  119. * END DO
  120. SEGDES,MVECTD
  121. *
  122. * IF (JFIRST .EQ. LFIRST) THEN
  123. * JFIRST = 1
  124. * ELSE
  125. * JFIRST = JFIRST + 1
  126. * END IF
  127. *
  128. * -- TRANSFORMATION DU VECTEUR EN CHPOINT ALEATOIRE --
  129. *
  130. CALL VCH1 (IPMATR,IPVECT, IPCHPO,IPRIGI)
  131. IF (IERR .NE. 0) RETURN
  132. *
  133. MVECTD = IPVECT
  134. SEGSUP,MVECTD
  135. *
  136. END
  137.  
  138.  
  139.  
  140.  
  141.  
  142.  
  143.  
  144.  
  145.  
  146.  
  147.  
  148.  
  149.  
  150.  
  151.  
  152.  
  153.  
  154.  

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