Télécharger arpch2.eso

Retour à la liste

Numérotation des lignes :

  1. C ARPCH2 SOURCE BP208322 15/10/21 21:15:05 8690
  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. -INC CCOPTIO
  58. -INC SMRIGID
  59. -INC SMLCHPO
  60. -INC SMVECTD
  61. -INC TARWORK
  62.  
  63. INTEGER IPRIGI
  64. INTEGER IPRIG
  65. INTEGER IPMAUP
  66. INTEGER IPLCHP
  67. INTEGER APOINT
  68. INTEGER SENS
  69.  
  70.  
  71. INTEGER IPVEC
  72. INTEGER IPCHO
  73. INTEGER INSYM
  74. INTEGER START
  75. INTEGER ndim
  76. INTEGER N1
  77.  
  78.  
  79.  
  80. *On recupere le ichole
  81. MRIGID=IPRIGI
  82. SEGACT MRIGID
  83. IPCHO=ICHOLE
  84. SEGDES MRIGID
  85.  
  86.  
  87. *On récupère la position de la 1ere composante et la taille du vecteur
  88. MAUP=IPMAUP
  89. SEGACT MAUP
  90. START=ipntr(APOINT)-1
  91. ndim=resid(/1)
  92. SEGDES MAUP
  93.  
  94. INC=ndim/2
  95.  
  96. *Premier sens: on lit le vecteur arpack (en ayant repere sa position au
  97. *prealable) et on le transforme en un listchpo
  98. IF (SENS .EQ. 3 .OR. SENS .EQ. 4) THEN
  99.  
  100. *Recuperation la premiere partie du vecteur
  101. MAUP=IPMAUP
  102. SEGACT MAUP
  103.  
  104.  
  105. SEGINI MVECTD
  106. DO i=1,INC
  107. VECTBB(i)=workd(START+i)
  108. ENDDO
  109.  
  110. IPVEC=MVECTD
  111. SEGDES MVECTD
  112.  
  113. IF (SENS .EQ. 3) THEN
  114. *transofmation en chpoint primal
  115. CALL VCH1 (IPCHO,IPVEC,IPCHP1,IPRIG)
  116.  
  117. ELSEIF (SENS .EQ. 4) THEN
  118. * transformation en chpoint dual
  119. CALL VCH2 (IPCHO,IPVEC,IPCHP1,IPRIG)
  120.  
  121. ENDIF
  122.  
  123. *Recuperation de la seconde partie du vecteur
  124. MVECTD=IPVEC
  125. SEGACT MVECTD*MOD
  126. DO i=1,INC
  127. VECTBB(i)=workd(START+INC+i)
  128. ENDDO
  129.  
  130. IPVEC=MVECTD
  131. SEGDES MVECTD
  132.  
  133. SEGDES MAUP
  134.  
  135. IF (SENS .EQ. 3) THEN
  136. *transofmation en chpoint primal
  137. CALL VCH1 (IPCHO,IPVEC,IPCHP2,IPRIG)
  138.  
  139. ELSEIF (SENS .EQ. 4) THEN
  140. * transformation en chpoint dual
  141. CALL VCH2 (IPCHO,IPVEC,IPCHP2,IPRIG)
  142.  
  143. ENDIF
  144.  
  145. SEGSUP MVECTD
  146.  
  147. *On remplit le mlchpo
  148.  
  149. N1=2
  150. SEGINI MLCHPO
  151. ICHPOI(1)=IPCHP1
  152. ICHPOI(2)=IPCHP2
  153. IPLCHP=MLCHPO
  154. SEGDES MLCHPO
  155.  
  156. *Second sens: on ecrit dans le vecteur arpack (en ayant repéré sa
  157. *position au préalable)
  158. ELSEIF (SENS .EQ. 1 .OR. SENS .EQ. 2) THEN
  159.  
  160. *On recupere les chpoints
  161. MLCHPO=IPLCHP
  162. SEGACT MLCHPO
  163. IPCHP1=ICHPOI(1)
  164. IPCHP2=ICHPOI(2)
  165. SEGDES MLCHPO
  166.  
  167.  
  168. * transformation 1 en vecteur primal
  169. IF (SENS .EQ. 1) THEN
  170.  
  171. CALL CHV3 (IPCHO,IPCHP1,IPVEC,1)
  172.  
  173. ELSEIF (SENS .EQ. 2) THEN
  174. *transformation 1 en vecteur dual
  175. CALL CHV2 (IPCHO,IPCHP1,IPVEC,1)
  176.  
  177. ENDIF
  178.  
  179. MAUP=IPMAUP
  180. SEGACT MAUP*MOD
  181.  
  182. MVECTD=IPVEC
  183. SEGACT MVECTD
  184. DO i=1,INC
  185. workd(START+i)=VECTBB(i)
  186. ENDDO
  187.  
  188. IPVEC=MVECTD
  189. SEGDES MVECTD
  190.  
  191. * transformation 2 en vecteur primal
  192. IF (SENS .EQ. 1) THEN
  193.  
  194. CALL CHV3 (IPCHO,IPCHP2,IPVEC,1)
  195.  
  196. ELSEIF (SENS .EQ. 2) THEN
  197. *transformation 2 en vecteur dual
  198. CALL CHV2 (IPCHO,IPCHP2,IPVEC,1)
  199.  
  200. ENDIF
  201.  
  202. MVECTD=IPVEC
  203. SEGACT MVECTD
  204.  
  205. DO i=1,INC
  206. workd(START+INC+i)=VECTBB(i)
  207. ENDDO
  208.  
  209. SEGSUP MVECTD
  210.  
  211. IPMAUP=MAUP
  212. SEGDES MAUP
  213.  
  214. ENDIF
  215.  
  216.  
  217. END
  218.  
  219.  
  220.  
  221.  
  222.  

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