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.  
  53. -INC PPARAM
  54. -INC CCOPTIO
  55. -INC SMMATRI
  56. -INC SMRIGID
  57. -INC SMVECTD
  58. *
  59. * PARAMETER (LFIRST = 9)
  60. *
  61. * SAVE JFIRST
  62. *
  63. * DATA JFIRST/1/
  64. REAL*8 V
  65. integer insym
  66. insym = 0
  67. *
  68. * -- DETERMINATION DU NOMBRE D'INCONNUES DU PROBLEME TRAITE --
  69. *
  70. MRIGID = IPRIGI
  71. SEGACT,MRIGID
  72. NRG = IRIGEL(/1)
  73. NBR = IRIGEL(/2)
  74. IPMATR = ICHOLE
  75. IF(NORINC.GT.0 .AND. NORIND.GT.0) THEN
  76. INSYM = 1
  77. ENDIF
  78. IF (NRG.GE.7) THEN
  79. DO 9 IN = 1,NBR
  80. IANTI=IRIGEL(7,IN)
  81. IF(IANTI.GT.0) THEN
  82. INSYM = 1
  83. ENDIF
  84. 9 CONTINUE
  85. ENDIF
  86. SEGDES,MRIGID
  87. *
  88. IF (IPMATR .EQ. 0) THEN
  89. IF (INSYM .EQ. 0) THEN
  90. CALL TRIANG (IPRIGI,1D-18,0)
  91. ELSE
  92. CALL ldmt1(IPRIGI,1.D-18)
  93. ENDIF
  94. IF (IERR .NE. 0) RETURN
  95. MRIGID = IPRIGI
  96. SEGACT,MRIGID
  97. IPMATR = ICHOLE
  98. SEGDES,MRIGID
  99. END IF
  100. *
  101. MMATRI = IPMATR
  102. SEGACT,MMATRI
  103. MILIGN=IILIGN
  104. SEGDES,MMATRI
  105. SEGACT,MILIGN
  106. INC=IPNO(/1)
  107. SEGDES,MILIGN
  108. *
  109. * -- DETERMINATION D'UN VECTEUR QUELCONQUE, DE DIMENSION EGALE A
  110. * CELLE DU PROBLEME TRAITE --
  111. *
  112. SEGINI,MVECTD
  113. IPVECT = MVECTD
  114. DO 100 IB=1,INC
  115. CALL TDRAND(V)
  116. VECTBB(IB) = V
  117. 100 CONTINUE
  118. * write(6,*) ' vectbb sortie de trandd'
  119. * write(6,*) (vectbb (ib),ib=1,inc)
  120.  
  121. * END DO
  122. SEGDES,MVECTD
  123. *
  124. * IF (JFIRST .EQ. LFIRST) THEN
  125. * JFIRST = 1
  126. * ELSE
  127. * JFIRST = JFIRST + 1
  128. * END IF
  129. *
  130. * -- TRANSFORMATION DU VECTEUR EN CHPOINT ALEATOIRE --
  131. *
  132. CALL VCH1 (IPMATR,IPVECT, IPCHPO,IPRIGI)
  133. IF (IERR .NE. 0) RETURN
  134. *
  135. MVECTD = IPVECT
  136. SEGSUP,MVECTD
  137. *
  138. END
  139.  
  140.  
  141.  
  142.  
  143.  
  144.  
  145.  
  146.  
  147.  
  148.  
  149.  
  150.  
  151.  
  152.  
  153.  
  154.  
  155.  
  156.  

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