Télécharger la plaquette Cast3M


fr en

Télécharger idlia1.eso

Retour à la liste

Numérotation des lignes : 

idlia1

  1. C IDLIA1    SOURCE    BP208322  14/09/15    21:16:39     8150
  2.       SUBROUTINE IDLIA1(ipm,ipr,ipt)
  3.  
  4. c identifie les liaisons : point + ddl d'un objet rigidite
  5. c vis-à-vis d'un maillage
  6. c range dans une table
  7.  
  8.       IMPLICIT REAL*8 (A-H,O-Z)
  9.       IMPLICIT INTEGER(I-N)
  10.  
  11.  
  12. -INC PPARAM
  13. -INC CCOPTIO
  14. -INC SMRIGID
  15. -INC SMTABLE
  16. -INC SMELEME
  17.  
  18. c     on autorise les ddl mecanique + thermique + liquide
  19. c     rem : on pourrait utiliser lnomdd de bdata sans les alfa, beta
  20.       PARAMETER (NPRIN=15)
  21.       CHARACTER*4 MOPRIN(NPRIN)
  22.       DATA MOPRIN / 'UX  ','UY  ','UZ  ','UR  ','UT  ',
  23.      &              'RX  ','RY  ','RZ  ','RT  ','P   ','PI  ',
  24.      &              'T   ','RR  ','TINF','TSUP'/
  25.       CHARACTER*4 MOTINC
  26.  
  27.       INTEGER lpilmo(NPRIN)
  28.       segment pilmpoi(0)
  29.  
  30. c     Recup des donnees d'entree + passage en POI1 du maillage entre
  31.       meleme = ipm
  32.       segact meleme
  33.       if (itypel.ne.1) call change(ipm,1)
  34.       meleme = ipm
  35.       mrigid = ipr
  36.       segact meleme,mrigid
  37.  
  38. c     creation de la table de sortie d'indice IM
  39.       CALL CRTABL(ipt)
  40.       CALL ECCTAB(ipt,'MOT',0,0.0D0,'SOUSTYPE',.TRUE.,0,
  41.      & 'MOT',0,0.0D0,'LIAISONS_STATIQUES',.TRUE.,0)
  42.       IM = 0
  43.  
  44. c     creation segment local des noeuds par inconnue
  45.       do l= 1,NPRIN
  46.         segini pilmpoi
  47.         lpilmo(l) = pilmpoi
  48.       enddo
  49.  
  50. c---- boucle sur les rigidites elementaires ----------------------------
  51.       nrigel = coerig(/1)
  52.       DO 1 ire = 1,nrigel
  53.         IPT1 = irigel(1,ire)
  54.         segact ipt1
  55. c       on va demarrer a leun=2 si multiplicateur LX en 1ere position
  56.         leun = 1
  57.         if (ipt1.itypel.eq.22) leun = 2
  58.         nbelem = ipt1.num(/2)
  59.         descr = irigel(3,ire)
  60.         segact descr
  61.         NLIGRP = noelep(/1)
  62.         IF(IIMPI.GE.333) WRITE(IOIMP,*) 'IDLI: zone ',ire,leun
  63.  
  64. c  ---- boucle sur les inconnues (primales) ---------------------
  65.         DO 10 igrp = leun,NLIGRP
  66.           MOTINC = lisinc(igrp)
  67.           ino = noelep(igrp)
  68.  
  69.         IF(IIMPI.GE.333) WRITE(IOIMP,*) 'IDLI: inconnue',igrp,MOTINC,ino
  70.  
  71. c         recherche dans la liste l inconnue MOTINC
  72.           do 11 l = 1,NPRIN
  73.              if (MOTINC.eq.MOPRIN(l)) goto 12
  74.  11       continue
  75. c         ici, on n'a pas trouve  MOTINC
  76. c bp : soit on fait une erreur, soit on continue avec un avertissement
  77. c      mais il ne faut pas s'arreter au milieu ...
  78. c           MOTERR(1:4) = 'IDLI'
  79. c           MOTERR(5:8) = MOTINC
  80. c           CALL ERREUR(335)
  81.           WRITE(IOIMP,*) 'IDLI: DDL NON TRAITE ', MOTINC
  82.           goto 10
  83. c         ici, on a trouve  MOTINC --> l
  84.         IF(IIMPI.GE.333) WRITE(IOIMP,*) 'IDLI: retrouvee en position',l
  85.  12       continue
  86.           pilmpoi = lpilmo(l)
  87.  
  88. c    ---- boucle sur les elements ----------------
  89.           DO 20 iele = 1,nbelem
  90.             IPOI = ipt1.num(ino,iele)
  91.  
  92. c           recherche dans le maillage POI1 du noeud IPOI
  93.             do 21 jn = 1,num(/2)
  94.               if (IPOI.eq.num(1,jn)) goto 22
  95.  21         continue
  96. c           ici, on n'a pas trouve  IPOI :
  97. c           on passe au noeud suivant sans mot dire
  98.             goto 20
  99. c           ici, on a trouve  IPOI -> jn  et  MOTINC -> l
  100.  22         continue
  101.         IF(IIMPI.GE.333) WRITE(IOIMP,*) 'IDLI: et noeud',IPOI,' en',jn
  102.  
  103. c           IPOI a t'il deja ete vu pour l inconnue MOTINC(=l) ?
  104.             do ip = 1,pilmpoi(/1)
  105. c             si le couple IPOI + MOTINC deja vu => on ne retraite pas
  106.               if (pilmpoi(ip).eq.IPOI) goto 10
  107.             enddo
  108.             pilmpoi(**) = IPOI
  109.  
  110. c           on ecrit la table IPT . IM . POINT_LIAISON  = IPOI
  111. c                             IPT . IM . DDL_LIAISON    = MOTINC
  112.             IM = IM + 1
  113.             CALL CRTABL(iptab2)
  114.             CALL ECCTAB(iptab2,'MOT',0,0.0D0,'POINT_LIAISON',.TRUE.,0,
  115.      &                  'POINT',0,0.0D0,' ',.TRUE.,IPOI)
  116.             CALL ECCTAB(iptab2,'MOT',0,0.0D0,'DDL_LIAISON',.TRUE.,0,
  117.      &                 'MOT',0,0.0D0,MOTINC,.TRUE.,0)
  118.             CALL ECCTAB(IPT,'ENTIER',IM,0.0D0,' ',.TRUE.,0,
  119.      &                 'TABLE',0,0.0D0,' ',.TRUE.,iptab2)
  120.  
  121.  
  122.  20       continue
  123. c    ---- fin de boucle sur les elements ----------------
  124.  
  125.  10     continue
  126. c  ---- fin de boucle sur les inconnues (primales) ---------------------
  127.  
  128.         segdes ipt1,descr
  129.  
  130.  1    CONTINUE
  131. c---- fin de boucle sur les rigidites elementaires ---------------------
  132.  
  133. c     suppression segment local avant de partir
  134.       do io = 1,NPRIN
  135.        pilmpoi = lpilmo(io)
  136.        segsup pilmpoi
  137.       enddo
  138.  
  139.       RETURN
  140.       END
  141.  
  142.  
  143.  
  144.  
  145.  

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