Télécharger la plaquette Cast3M


fr en

Télécharger unifo1.eso

Retour à la liste

Numérotation des lignes : 

unifo1

  1. C UNIFO1    SOURCE    MB234859  26/08/26    21:15:19     12626          
  2. * CREATION D'UN 'CHPOINT' UNIFORME.
  3.       SUBROUTINE UNIFO1 (IPRIGI,XX,IPCHPO)
  4. ************************************************************************
  5. *
  6. *                             U N I F O 1
  7. *                             -----------
  8. *
  9. * FONCTION:
  10. * ---------
  11. *
  12. *     CREER UN 'CHPOINT' DE MEME VALEUR EN TOUT POINT DU SUPPORT
  13. *     GEOMETRIQUE D'UNE 'RIGIDITE' DONNEE.
  14. *
  15. * MODE D'APPEL:
  16. * -------------
  17. *
  18. *     CALL UNIFO1 (IPRIGI,XX,IPCHPO)
  19. *
  20. * PARAMETRES:  (E)=ENTREE   (S)=SORTIE
  21. * -----------
  22. *
  23. *     IPRIGI  ENTIER    (E)  POINTEUR D'UNE 'RIGIDITE'.
  24. *     XX      REEL SP   (E)  VALEUR DU 'CHPOINT' EN TOUT POINT.
  25. *     IPCHPO  ENTIER    (S)  POINTEUR DU 'CHPOINT' DETERMINE.
  26. *
  27. * LEXIQUE: (ORDRE ALPHABETIQUE)
  28. * --------
  29. *
  30. *     INC     ENTIER    NOMBRE D'INCONNUES DU PROBLEME.
  31. *     IPMATR  ENTIER    POINTEUR SUR L'OBJET 'MATRICE' ASSOCIE A LA
  32. *                       'RIGIDITE' DE POINTEUR "IPRIGI".
  33. *     IPVECT  ENTIER    POINTEUR D'UN OBJET DE TRAVAIL 'VECTDOUB'.
  34. *
  35. * SOUS-PROGRAMMES APPELES:
  36. * ------------------------
  37. *
  38. *     TRIANG, VCH1.
  39. *
  40. * AUTEUR, DATE DE CREATION:
  41. * -------------------------
  42. *
  43. *     PASCAL MANIGOT     1ER AVRIL 1985
  44. *
  45. * LANGAGE:
  46. * --------
  47. *
  48. *     ESOPE + FORTRAN77
  49. *
  50. ************************************************************************
  51. *
  52.       IMPLICIT INTEGER(I-N)
  53.       IMPLICIT REAL*8(A-H,O-Z)
  54.  
  55. -INC PPARAM
  56. -INC CCOPTIO
  57. -INC SMMATRI
  58. -INC SMRIGID
  59. -INC SMVECTD
  60. -INC CCREEL
  61. *
  62. *     -- DETERMINATION DU NOMBRE D'INCONNUES DU PROBLEME TRAITE --
  63. *
  64.       integer insym
  65.       insym = 0
  66.       xspetl = xspeti
  67.       MRIGID = IPRIGI
  68.       SEGACT,MRIGID
  69.       NRG = IRIGEL(/1)
  70.       NBR = IRIGEL(/2)
  71.       IPMATR = ICHOLE
  72.       IF(NORINC.GT.0  .AND. NORIND.GT.0) THEN
  73.          INSYM = 1
  74.       ENDIF
  75.       IF (NRG.GE.7) THEN
  76.          DO  9 IN = 1,NBR
  77.             IANTI=IRIGEL(7,IN)
  78.             IF(IANTI.GT.0) THEN
  79.                INSYM = 1
  80.             ENDIF
  81.   9      CONTINUE
  82.       ENDIF
  83.       SEGDES,MRIGID
  84. *
  85.       IF (IPMATR .EQ. 0) THEN
  86.         CALL TRIANG(IPRIGI,xspetl,0,0,INSYM)
  87.         IF (IERR .NE. 0) RETURN
  88.         MRIGID = IPRIGI
  89.         SEGACT,MRIGID
  90.         IPMATR = ICHOLE
  91.         SEGDES,MRIGID
  92.       ENDIF
  93. *
  94.       MMATRI = IPMATR
  95.       SEGACT,MMATRI
  96.       MILIGN=IILIGN
  97.       SEGDES,MMATRI
  98.       SEGACT,MILIGN
  99.       INC=IPNO(/1)
  100.       SEGDES,MILIGN
  101. *
  102. *     -- DETERMINATION D'UN VECTEUR UNIFORME, DE DIMENSION EGALE A
  103. *     CELLE DU PROBLEME TRAITE --
  104. *
  105.       SEGINI,MVECTD
  106.       IPVECT = MVECTD
  107.       DO 100 IB=1,INC
  108.          VECTBB(IB) = XX
  109.   100    CONTINUE
  110. *     END DO
  111.       SEGDES,MVECTD
  112. *
  113. *     -- TRANSFORMATION DU VECTEUR EN CHPOINT --
  114. *
  115.       CALL VCH1 (IPMATR,IPVECT,  IPCHPO,IPRIGI)
  116.       IF (IERR .NE. 0) RETURN
  117. *
  118.       MVECTD = IPVECT
  119.       SEGSUP,MVECTD
  120. *
  121.       END
  122.  
  123.  

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