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

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