Télécharger la plaquette Cast3M


fr en

Télécharger prliai.eso

Retour à la liste

Numérotation des lignes : 

prliai

  1. C PRLIAI    SOURCE    PV090527  23/06/22    21:15:04     11692          
  2. C
  3. C   CE SOUS PROGRAMME PREPARE LES DONNEES POUR LES ELEMENTS
  4. C   LIAISON NORMAUX OU LES ELEMENTS LIAISON POREUX (BALD)
  5. C
  6.       SUBROUTINE PRLIAI
  7.       IMPLICIT INTEGER(I-N)
  8.       implicit real*8 (a-h,o-z)
  9.  
  10. -INC PPARAM
  11. -INC CCOPTIO
  12. -INC SMELEME
  13. -INC CCGEOME
  14.       SEGMENT LISOBJ(0)
  15.       REAL*8 XXX
  16.       IPT3=0
  17.       XXX=DENSIT/10.
  18.       CALL LIRREE(XXX,0,IRETOU)
  19.       CRIT=ABS(REAL(XXX))
  20.   20  CONTINUE
  21.       IF (CRIT.EQ.0.) CALL ERREUR(21)
  22.       IF (IERR.NE.0) RETURN
  23.       CALL LIROBJ('MAILLAGE',IPT1,1,IRETOU)
  24.       CALL LIROBJ('MAILLAGE',IPT2,1,IRETOU)
  25.       CALL LIROBJ('MAILLAGE',IPT3,0,IRETOU)
  26.       IF (IERR.NE.0) RETURN
  27.       SEGACT IPT1
  28.       SEGACT IPT2
  29.       IF (IPT3.NE.0) SEGACT IPT3
  30.       SEGINI LISOBJ
  31. C
  32. C  ON RECHERCHE LES PARTIES DE MEME TYPE
  33. C
  34.       IPT4=IPT1
  35.       DO 1001 IOBI=1,MAX(1,IPT1.LISOUS(/1))
  36.       IF (IPT1.LISOUS(/1).NE.0) THEN
  37.        IPT4=IPT1.LISOUS(IOBI)
  38.        SEGACT IPT4
  39.       ENDIF
  40.       IF (KSURF(IPT4.ITYPEL).NE.IPT4.ITYPEL) GOTO 1002
  41.       IPT5=IPT2
  42.       DO 1006 IOBJ=1,MAX(1,IPT2.LISOUS(/1))
  43.       IF (IPT2.LISOUS(/1).NE.0) THEN
  44.        IPT5=IPT2.LISOUS(IOBJ)
  45.        SEGACT IPT5
  46.       ENDIF
  47.       IF (KSURF(IPT5.ITYPEL).NE.IPT5.ITYPEL) GOTO 1007
  48.       IF (IPT4.ITYPEL.NE.IPT5.ITYPEL) GOTO 1007
  49.        IF (IPT3.NE.0) THEN
  50. C
  51. C  CAS DES ELELMENTS JOINTS POREUX
  52. C
  53.         IPT6=IPT3
  54.         DO 1008 IOBK=1,MAX(1,IPT3.LISOUS(/1))
  55.         IF (IPT3.LISOUS(/1).NE.0) THEN
  56.          IPT6=IPT3.LISOUS(IOBK)
  57.          SEGACT IPT6
  58.         ENDIF
  59.         IF (KSURF(IPT6.ITYPEL).NE.IPT6.ITYPEL) GOTO 1009
  60.         IF (IPT4.ITYPEL.EQ.IPT6.ITYPEL) GOTO 1009
  61.         IF (NBSOM(IPT4.ITYPEL).NE.NBSOM(IPT6.ITYPEL)) GOTO 1009
  62.         IPT7=0
  63.         CALL LIAPOR(IPT4,IPT5,IPT6,IPT7,CRIT)
  64.         IF (IERR.NE.0) GOTO 1003
  65.         IF (IPT7.NE.0) LISOBJ(**)=IPT7
  66.  1009   CONTINUE
  67.         IF (IPT3.LISOUS(/1).NE.0) SEGDES IPT6
  68.  1008   CONTINUE
  69.        ELSE
  70. C
  71. C  CAS DES ELELMENTS JOINTS NORMAUX
  72. C
  73.         IPT7=0
  74.         CALL LIAISO(IPT4,IPT5,IPT7,CRIT)
  75.         IF (IERR.NE.0) GOTO 1003
  76.         IF (IPT7.NE.0) LISOBJ(**)=IPT7
  77.        END IF
  78.  1007 CONTINUE
  79.       IF (IPT2.LISOUS(/1).NE.0) SEGDES IPT5
  80.  1006 CONTINUE
  81.  1002 CONTINUE
  82.       IF (IPT1.LISOUS(/1).NE.0) SEGDES IPT4
  83.  1001 CONTINUE
  84.  1003 CONTINUE
  85.       SEGDES IPT1,IPT2
  86.       IF (IPT3.NE.0) SEGDES IPT3
  87.       IF (LISOBJ(/1).NE.0.AND.IERR.EQ.0) GOTO 2000
  88.       CALL ERREUR(26)
  89.       SEGSUP LISOBJ
  90.       RETURN
  91.  2000 IF (LISOBJ(/1).GT.1) GOTO 2001
  92.       IPT4=LISOBJ(1)
  93.       SEGDES IPT4
  94.       GOTO 2002
  95.  2001 NBNN=0
  96.       NBELEM=0
  97.       NBREF=0
  98.       NBSOUS=LISOBJ(/1)
  99.       SEGINI IPT4
  100.       DO 2010 IOB=1,LISOBJ(/1)
  101.       IPT7=LISOBJ(IOB)
  102.       SEGDES IPT7
  103.       IPT4.LISOUS(IOB)=IPT7
  104.  2010 CONTINUE
  105.       SEGDES IPT4
  106.  2002 SEGSUP LISOBJ
  107.       CALL ECROBJ('MAILLAGE',IPT4)
  108.       RETURN
  109.       END
  110.  
  111.  
  112.  
  113.  
  114.  
  115.  
  116.  
  117.  
  118.  
  119.  
  120.  
  121.  
  122.  

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