Télécharger la plaquette Cast3M


fr en

Télécharger qulx.eso

Retour à la liste

Numérotation des lignes : 

qulx

  1. C QULX      SOURCE    CB215821  25/04/23    21:15:35     12247          
  2.       SUBROUTINE QULX
  3. C
  4. C **  BUT : CHERCHER DANS UN CHPOINT TOUS LES MULTIPLICATEURS
  5. C **        QUI SONT REFERENCE PAR UNE MATRICE
  6. C **  UTILE POUR LES APPUIS UNILATERAUX
  7. C
  8.       IMPLICIT INTEGER(I-N)
  9.  
  10. -INC PPARAM
  11. -INC CCOPTIO
  12. -INC SMRIGID
  13. -INC SMCOORD
  14. -INC SMCHPOI
  15. -INC SMELEME
  16.       SEGMENT TRAV
  17.         INTEGER IP(NIP)
  18.         REAL*8 XP(NIP)
  19.       ENDSEGMENT
  20.       CALL LIROBJ ('RIGIDITE',MRIGID,1,IRETOU)
  21.       IF(IERR.NE.0) RETURN
  22.       CALL LIROBJ ('CHPOINT ',MCHPOI,1,IRETOU)
  23.       IF(IERR.NE.0) RETURN
  24. C
  25. C  **  RECHERCHE DU SOUS CHAMPOINT CONTENANT LES MULTIPLICATEURS
  26. C
  27.       SEGACT MCHPOI
  28.       DO 1 I = 1, IPCHP(/1)
  29.       MSOUPO=IPCHP(I)
  30.       II=I
  31.       SEGACT MSOUPO
  32.       IF(NOCOMP(1).EQ.'LX  ')  GO TO 2
  33.       SEGDES MSOUPO
  34.   1   CONTINUE
  35.       CALL ERREUR (21)
  36.       RETURN
  37.   2   CONTINUE
  38.       NOHA=NOHARM(1)
  39.       IPT1=IGEOC
  40.       MPOVAL=IPOVAL
  41.       SEGACT IPT1,MPOVAL
  42.       NIP=1000
  43.       LIP=0
  44.       SEGINI TRAV
  45.       NNO=IPT1.NUM(/2)
  46. C
  47. C  *** RECHERCHE DES BLOQUAGES, ON REMPLIT AU FUR ET A MESURE IP
  48. C  *** QUI CONTIENDRA LES NUMEROS DE NOEUDS ET XP LES VALEURS
  49. C
  50.       SEGACT MRIGID
  51.       DO 3 I=1,IRIGEL(/2)
  52.       MELEME=IRIGEL(1,I)
  53.       SEGACT MELEME
  54.       IF(ITYPEL.NE.22) GO TO 4
  55.       DO 5 J=1,NUM(/2)
  56.       DO 6 K=1,2
  57.       NN= NUM(K,J)
  58.       DO 7 L=1,NNO
  59.       IF(IPT1.NUM(1,L).EQ.NN) THEN
  60.           IF (NIP-LIP.LT.2) THEN
  61.             NIP=NIP+1000
  62.             SEGADJ TRAV
  63.           ENDIF
  64.           IP(LIP+1)=NN
  65.           XP(LIP+1)=VPOCHA(L,1)
  66.           LIP=LIP+1
  67.       ENDIF
  68.    7  CONTINUE
  69.    6  CONTINUE
  70.    5  CONTINUE
  71.    4  CONTINUE
  72.       SEGDES MELEME
  73.    3  CONTINUE
  74.       SEGDES MRIGID,MCHPOI,MSOUPO,IPT1,MPOVAL
  75. C
  76. C  *** CREATION DU CHPOINT
  77. C
  78.       IF(LIP.EQ.0) THEN
  79.           SEGSUP TRAV
  80.           NSOUPO=0
  81.           NAT=1
  82.           SEGINI MCHPOI
  83.           JATTRI(1)=2
  84.           CALL ECROBJ('CHPOINT ',MCHPOI)
  85.           RETURN
  86.       ENDIF
  87.       NSOUPO=1
  88.       NAT=1
  89.       SEGINI MCHPOI
  90.       JATTRI(1) = 2
  91.       NC=1
  92.       SEGINI MSOUPO
  93.       IPCHP(1)=MSOUPO
  94.       NOCOMP(1)='LX  '
  95.       NOHARM(1)=NOHA
  96.       NBELEM=LIP
  97.       NBNN=1
  98.       NBSOUS=0
  99.       NBREF=0
  100.       N=NBELEM
  101.       SEGINI MELEME
  102.       ITYPEL=1
  103.       SEGINI MPOVAL
  104.       IPOVAL=MPOVAL
  105.       IGEOC=MELEME
  106.       DO 8 I=1,NBELEM
  107.       NUM(1,I)=IP(I)
  108.       VPOCHA(I,1)=XP(I)
  109.    8  CONTINUE
  110.       SEGSUP TRAV
  111.       SEGDES MPOVAL,MELEME,MSOUPO,MCHPOI
  112.       CALL ECROBJ('CHPOINT ',MCHPOI)
  113.       RETURN
  114.       END
  115.  
  116.  
  117.  
  118.  
  119.  
  120.  
  121.  
  122.  
  123.  
  124.  
  125.  

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