Télécharger arpch1.eso

Retour à la liste

Numérotation des lignes :

  1. C ARPCH1 SOURCE BP208322 15/10/21 21:15:05 8690
  2. SUBROUTINE ARPCH1 (IPRIGI,IPRIG,IPMAUP,IPCHP,APOINT,SENS)
  3.  
  4. ***********************************************************************
  5. *
  6. * A R P C H 1
  7. *
  8. * FONCTION:
  9. * ---------
  10. *
  11. * PASSAGE D'UN CHPOINT A UN VECTEUR COMPATIBLE AVEC LA
  12. * "REVERSE COMMUNICATION" D'ARPACK ET VICE VERSA POUR
  13. * UN PROBLEME LINAIRE
  14. *
  15. * PARAMETRES: (E)=ENTREE (S)=SORTIE
  16. * -----------
  17. *
  18. * IPRIGI ENTIER (E) POINTEUR D'UN MRIGID (IVECRI)
  19. *
  20. * IPRIG ENTIER (E) POINTEUR DE LA RIGIDITE
  21. *
  22. * IPMAUP ENTIER (E/S) POINTEUR DES ELEMENTS ARPACK
  23. *
  24. * IPCHP ENTIER (E/S) POINTEUR DU CHPOINT
  25. *
  26. * APOINT ENTIER (E) INDICE DU TABLEAU 'ipntr':
  27. * POSITION DE LA 1ERE COMPOSANTE
  28. * DANS LE TABLEAU DE TRAVAIL 'workd'
  29. *
  30. * SENS ENTIER (E) ENTIER POUR TYPE DE LA CONVERSION
  31. * -1 CHPOINT PRIMAL -> VECTEUR
  32. * -2 CHPOINT DUAL -> VECTEUR
  33. * -3 VECTEUR -> CHPOINT PRIMAL
  34. * -4 VECTEUR -> CHPOINT DUAL
  35. *
  36. * SOUS-PROGRAMMES APPELES:
  37. * ------------------------
  38. *
  39. * TRIANG,LDMT1,VCH1,VCH2,CHV3,CHV2
  40. *
  41. * AUTEUR, DATE DE CREATION:
  42. * -------------------------
  43. *
  44. *
  45. * PASCAL BOUDA 28 MAI 2015
  46. *
  47. * LANGAGE:
  48. * --------
  49.  
  50. *
  51. * FORTRAN 77 & 90
  52. *
  53. ***********************************************************************
  54.  
  55.  
  56. -INC CCOPTIO
  57. -INC SMVECTD
  58. -INC SMRIGID
  59. -INC TARWORK
  60.  
  61. INTEGER IPRIGI
  62. INTEGER IPRIG
  63. INTEGER IPMAUP
  64. INTEGER IPCHP
  65. INTEGER APOINT
  66. INTEGER SENS
  67.  
  68.  
  69. INTEGER IPVEC
  70. INTEGER IPCHO
  71. INTEGER INSYM
  72. INTEGER START
  73. INTEGER ndim
  74. INTEGER IPCHB
  75.  
  76. *On recupere le ichole
  77. MRIGID=IPRIGI
  78. SEGACT MRIGID
  79. IPCHO=ICHOLE
  80. SEGDES MRIGID
  81.  
  82. *On récupère la position de la 1ere composante et la taille du vecteur
  83. MAUP=IPMAUP
  84. SEGACT MAUP
  85. START=ipntr(APOINT)-1
  86. ndim=resid(/1)
  87. SEGDES MAUP
  88.  
  89. INC=ndim
  90.  
  91.  
  92. *Premier sens: on lit le vecteur arpack (en ayant repere sa position au
  93. *prealable) et on le transforme en chpoint dual ou primal
  94. IF (SENS .EQ. 3 .OR. SENS .EQ. 4) THEN
  95.  
  96. MAUP=IPMAUP
  97. SEGACT MAUP
  98.  
  99.  
  100. SEGINI MVECTD
  101. DO i=1,INC
  102. VECTBB(i)=workd(START+i)
  103. ENDDO
  104.  
  105. IPVEC=MVECTD
  106. SEGDES MVECTD
  107.  
  108. SEGDES MAUP
  109.  
  110. IF (SENS .EQ. 3) THEN
  111. *transofmation en chpoint primal
  112. CALL VCH1 (IPCHO,IPVEC,IPCHP,IPRIG)
  113.  
  114. ELSEIF (SENS .EQ. 4) THEN
  115. * transformation en chpoint dual
  116. CALL VCH2 (IPCHO,IPVEC,IPCHP,IPRIG)
  117.  
  118. ENDIF
  119.  
  120.  
  121.  
  122. *Second sens: on ecrit dans le vecteur arpack (en ayant repéré sa
  123. *position au préalable)
  124. ELSEIF (SENS .EQ. 1 .OR. SENS .EQ. 2) THEN
  125. * transformation en vecteur primal
  126. IF (SENS .EQ. 1) THEN
  127.  
  128. CALL CHV3 (IPCHO,IPCHP,IPVEC,1)
  129.  
  130.  
  131. ELSEIF (SENS .EQ. 2) THEN
  132. *transformation en vecteur dual
  133. CALL CHV2 (IPCHO,IPCHP,IPVEC,1)
  134.  
  135. ENDIF
  136.  
  137. MAUP=IPMAUP
  138. SEGACT MAUP*MOD
  139.  
  140. MVECTD=IPVEC
  141. SEGACT MVECTD
  142.  
  143. DO i=1,INC
  144. workd(START+i)=VECTBB(i)
  145. ENDDO
  146.  
  147. SEGSUP MVECTD
  148.  
  149. IPMAUP=MAUP
  150. SEGDES MAUP
  151.  
  152. ENDIF
  153.  
  154.  
  155. END
  156.  
  157.  
  158.  
  159.  
  160.  

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