Télécharger la plaquette Cast3M


fr en

Télécharger arpch1.eso

Retour à la liste

Numérotation des lignes : 

arpch1

  1. C ARPCH1    SOURCE    BP208322  20/02/06    21:15:03     10512          
  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.  
  57. -INC PPARAM
  58. -INC CCOPTIO
  59. -INC SMVECTD
  60. -INC SMRIGID
  61. -INC TARWORK
  62.  
  63.       INTEGER IPRIGI
  64.       INTEGER IPRIG
  65.       INTEGER IPMAUP
  66.       INTEGER IPCHP
  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 IPCHB
  77.  
  78. *On recupere le ichole
  79.       MRIGID=IPRIGI
  80.       SEGACT MRIGID
  81.       IPCHO=ICHOLE
  82.       SEGDES MRIGID
  83.  
  84. *On récupère la position de la 1ere composante et la taille du vecteur
  85.       MAUP=IPMAUP
  86.       SEGACT MAUP
  87.       START=ipntr(APOINT)-1
  88.       ndim=resid(/1)
  89.       SEGDES MAUP
  90.  
  91.       INC=ndim
  92.  
  93.  
  94. *Premier sens: on lit le vecteur arpack (en ayant repere sa position au
  95. *prealable) et on le transforme en chpoint dual ou primal
  96.       IF (SENS .EQ. 3 .OR. SENS .EQ. 4) THEN
  97.  
  98.         MAUP=IPMAUP
  99.         SEGACT MAUP
  100.  
  101.  
  102.         SEGINI MVECTD
  103.         DO  i=1,INC
  104.           VECTBB(i)=workd(START+i)
  105.         ENDDO
  106.  
  107.         IPVEC=MVECTD
  108.         SEGDES MVECTD
  109.  
  110. c         SEGDES MAUP
  111.  
  112.         IF (SENS .EQ. 3) THEN
  113. *transofmation en chpoint primal
  114.           CALL VCH1 (IPCHO,IPVEC,IPCHP,IPRIG)
  115.  
  116.         ELSEIF (SENS .EQ. 4) THEN
  117. * transformation en chpoint dual
  118.           CALL VCH2 (IPCHO,IPVEC,IPCHP,IPRIG)
  119.  
  120.         ENDIF
  121.  
  122.  
  123.  
  124. *Second sens: on ecrit dans le vecteur arpack (en ayant repéré sa
  125. *position au préalable)
  126.       ELSEIF (SENS .EQ. 1 .OR. SENS .EQ. 2) THEN
  127. * transformation en vecteur primal
  128.         IF (SENS .EQ. 1) THEN
  129.  
  130.           CALL CHV3 (IPCHO,IPCHP,IPVEC,1)
  131.  
  132.  
  133.         ELSEIF (SENS .EQ. 2) THEN
  134. *transformation en vecteur dual
  135.           CALL CHV2 (IPCHO,IPCHP,IPVEC,1)
  136.  
  137.         ENDIF
  138.  
  139.         MAUP=IPMAUP
  140.         SEGACT MAUP*MOD
  141.  
  142.         MVECTD=IPVEC
  143.         SEGACT MVECTD
  144.  
  145.         DO i=1,INC
  146.           workd(START+i)=VECTBB(i)
  147.         ENDDO
  148.  
  149.         SEGSUP MVECTD
  150.  
  151.         IPMAUP=MAUP
  152. c         SEGDES MAUP
  153.  
  154.       ENDIF
  155.  
  156.  
  157.       END
  158.  
  159.  
  160.  
  161.  
  162.  
  163.  

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