Télécharger arpch2.eso

Retour à la liste

Numérotation des lignes :

arpch2
  1. C ARPCH2 SOURCE BP208322 20/02/06 21:15:04 10512
  2. SUBROUTINE ARPCH2 (IPRIGI,IPRIG,IPMAUP,IPLCHP,APOINT,SENS)
  3.  
  4.  
  5. ***********************************************************************
  6. *
  7. * A R P C H 2
  8. *
  9. * FONCTION:
  10. * ---------
  11. *
  12. * PASSAGE D'UN LISTCHPO DE 2 CHPOINTS (ORDONES) A UN VECTEUR
  13. * COMPATIBLE AVEC LA "REVERSE COMMUNICATION" D'ARPACK
  14. * ET VICE VERSA POUR UN PROBLEME QUADRATIQUE
  15. *
  16. *
  17. * PARAMETRES: (E)=ENTREE (S)=SORTIE
  18. * -----------
  19. *
  20. * IPRIGI ENTIER (E) POINTEUR D'UN MRIGID (IVECRI)
  21. *
  22. * IPRIG ENTIER (E) POINTEUR DE LA RIGIDITE
  23. *
  24. * IPMAUP ENTIER (E/S) POINTEUR DES ELEMENTS ARPACK
  25. *
  26. * IPLCHP ENTIER (E/S) POINTEUR DU DU LISTCHPO
  27. *
  28. * APOINT ENTIER (E) INDICE DU TABLEAU 'ipntr':
  29. * POSITION DE LA 1ERE COMPOSANTE
  30. * DANS LE TABLEAU DE TRAVAIL 'workd'
  31. *
  32. * SENS ENTIER (E) ENTIER POUR TYPE DE LA CONVERSION
  33. * -1 CHPOINTS -> VECTEUR PRIMAL
  34. * -2 CHPOINTS -> VECTEUR DUAL
  35. * -3 VECTEUR -> CHPOINTS PRIMAUX
  36. * -4 VECTEUR -> CHPOINTS DUALS
  37. *
  38. * SOUS-PROGRAMMES APPELES:
  39. * ------------------------
  40.  
  41. *
  42. * TRIANG,LDMT1,VCH1,VCH2,CHV3,CHV2
  43. *
  44. * AUTEUR, DATE DE CREATION:
  45. * -------------------------
  46. *
  47. * PASCAL BOUDA 17 JUILLET 2015
  48. *
  49. * LANGAGE:
  50. * --------
  51. *
  52. * FORTRAN 77 & 90
  53. *
  54. ***********************************************************************
  55.  
  56.  
  57.  
  58. -INC PPARAM
  59. -INC CCOPTIO
  60. -INC SMRIGID
  61. -INC SMLCHPO
  62. -INC SMVECTD
  63. -INC TARWORK
  64.  
  65. INTEGER IPRIGI
  66. INTEGER IPRIG
  67. INTEGER IPMAUP
  68. INTEGER IPLCHP
  69. INTEGER APOINT
  70. INTEGER SENS
  71.  
  72.  
  73. INTEGER IPVEC
  74. INTEGER IPCHO
  75. INTEGER INSYM
  76. INTEGER START
  77. INTEGER ndim
  78. INTEGER N1
  79.  
  80.  
  81.  
  82. *On recupere le ichole
  83. MRIGID=IPRIGI
  84. SEGACT MRIGID
  85. IPCHO=ICHOLE
  86. SEGDES MRIGID
  87.  
  88.  
  89. *On récupère la position de la 1ere composante et la taille du vecteur
  90. MAUP=IPMAUP
  91. SEGACT MAUP
  92. START=ipntr(APOINT)-1
  93. ndim=resid(/1)
  94. c SEGDES MAUP
  95.  
  96. INC=ndim/2
  97.  
  98. *Premier sens: on lit le vecteur arpack (en ayant repere sa position au
  99. *prealable) et on le transforme en un listchpo
  100. IF (SENS .EQ. 3 .OR. SENS .EQ. 4) THEN
  101.  
  102. *Recuperation la premiere partie du vecteur
  103. MAUP=IPMAUP
  104. SEGACT MAUP
  105.  
  106.  
  107. SEGINI MVECTD
  108. DO i=1,INC
  109. VECTBB(i)=workd(START+i)
  110. ENDDO
  111.  
  112. IPVEC=MVECTD
  113. SEGDES MVECTD
  114.  
  115. IF (SENS .EQ. 3) THEN
  116. *transofmation en chpoint primal
  117. CALL VCH1 (IPCHO,IPVEC,IPCHP1,IPRIG)
  118.  
  119. ELSEIF (SENS .EQ. 4) THEN
  120. * transformation en chpoint dual
  121. CALL VCH2 (IPCHO,IPVEC,IPCHP1,IPRIG)
  122.  
  123. ENDIF
  124.  
  125. *Recuperation de la seconde partie du vecteur
  126. MVECTD=IPVEC
  127. SEGACT MVECTD*MOD
  128. DO i=1,INC
  129. VECTBB(i)=workd(START+INC+i)
  130. ENDDO
  131.  
  132. IPVEC=MVECTD
  133. SEGDES MVECTD
  134.  
  135. SEGDES MAUP
  136.  
  137. IF (SENS .EQ. 3) THEN
  138. *transofmation en chpoint primal
  139. CALL VCH1 (IPCHO,IPVEC,IPCHP2,IPRIG)
  140.  
  141. ELSEIF (SENS .EQ. 4) THEN
  142. * transformation en chpoint dual
  143. CALL VCH2 (IPCHO,IPVEC,IPCHP2,IPRIG)
  144.  
  145. ENDIF
  146.  
  147. SEGSUP MVECTD
  148.  
  149. *On remplit le mlchpo
  150.  
  151. N1=2
  152. SEGINI MLCHPO
  153. ICHPOI(1)=IPCHP1
  154. ICHPOI(2)=IPCHP2
  155. IPLCHP=MLCHPO
  156. SEGDES MLCHPO
  157.  
  158. *Second sens: on ecrit dans le vecteur arpack (en ayant repéré sa
  159. *position au préalable)
  160. ELSEIF (SENS .EQ. 1 .OR. SENS .EQ. 2) THEN
  161.  
  162. *On recupere les chpoints
  163. MLCHPO=IPLCHP
  164. SEGACT MLCHPO
  165. IPCHP1=ICHPOI(1)
  166. IPCHP2=ICHPOI(2)
  167. SEGDES MLCHPO
  168.  
  169.  
  170. * transformation 1 en vecteur primal
  171. IF (SENS .EQ. 1) THEN
  172.  
  173. CALL CHV3 (IPCHO,IPCHP1,IPVEC,1)
  174.  
  175. ELSEIF (SENS .EQ. 2) THEN
  176. *transformation 1 en vecteur dual
  177. CALL CHV2 (IPCHO,IPCHP1,IPVEC,1)
  178.  
  179. ENDIF
  180.  
  181. MAUP=IPMAUP
  182. SEGACT MAUP*MOD
  183.  
  184. MVECTD=IPVEC
  185. SEGACT MVECTD
  186. DO i=1,INC
  187. workd(START+i)=VECTBB(i)
  188. ENDDO
  189.  
  190. IPVEC=MVECTD
  191. SEGDES MVECTD
  192.  
  193. * transformation 2 en vecteur primal
  194. IF (SENS .EQ. 1) THEN
  195.  
  196. CALL CHV3 (IPCHO,IPCHP2,IPVEC,1)
  197.  
  198. ELSEIF (SENS .EQ. 2) THEN
  199. *transformation 2 en vecteur dual
  200. CALL CHV2 (IPCHO,IPCHP2,IPVEC,1)
  201.  
  202. ENDIF
  203.  
  204. MVECTD=IPVEC
  205. SEGACT MVECTD
  206.  
  207. DO i=1,INC
  208. workd(START+INC+i)=VECTBB(i)
  209. ENDDO
  210.  
  211. SEGSUP MVECTD
  212.  
  213. IPMAUP=MAUP
  214. c SEGDES MAUP
  215.  
  216. ENDIF
  217.  
  218.  
  219. END
  220.  
  221.  
  222.  
  223.  
  224.  
  225.  

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