Télécharger aleat1.eso

Retour à la liste

Numérotation des lignes :

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

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