Télécharger la plaquette Cast3M


fr en

Télécharger prracc.eso

Retour à la liste

Numérotation des lignes : 

prracc

  1. C PRRACC    SOURCE    BP208322  16/11/18    21:20:21     9177           
  2. C
  3. C   CE SOUS PROGRAMME PREPARE LES DONNEES POUR LES ELEMENTS
  4. C   RACCORD NORMAUX OU LES ELEMENTS RACCORD POREUX (BALD)
  5. C
  6.       SUBROUTINE PRRACC
  7.       IMPLICIT INTEGER(I-N)
  8.       IMPLICIT REAL*8(A-H,O-Z)
  9.  
  10.  
  11. -INC PPARAM
  12. -INC CCOPTIO
  13. -INC CCGEOME
  14. -INC SMELEME
  15.  
  16.       XXX=DENSIT/10.
  17.       CALL LIRREE(XXX,0,IRETOU)
  18.       IF (IERR.NE.0) RETURN
  19.       CRIT=ABS(XXX)
  20.       IF (CRIT.EQ.0.) THEN
  21.         CALL ERREUR(21)
  22.         RETURN
  23.       ENDIF
  24.  
  25.       IPT3=0
  26.       CALL LIROBJ('MAILLAGE',IPT1,1,IRETOU)
  27.       IF (IERR.NE.0) RETURN
  28.       CALL LIROBJ('MAILLAGE',IPT2,1,IRETOU)
  29.       IF (IERR.NE.0) RETURN
  30.       CALL LIROBJ('MAILLAGE',IPT3,0,IRETOU)
  31.       IF (IERR.NE.0) RETURN
  32. C
  33.       SEGACT IPT1
  34.       IF (IPT1.LISOUS(/1).NE.0) GOTO 102
  35.       IF (KSURF(IPT1.ITYPEL).EQ.0) GOTO 101
  36.  102  CONTINUE
  37.       CALL ECROBJ('MAILLAGE',IPT1)
  38.       CALL PRCONT
  39.       CALL LIROBJ('MAILLAGE',IPT1,1,IRETOU)
  40.       IF (IERR.NE.0) RETURN
  41.       SEGACT IPT1
  42.  101  CONTINUE
  43. C
  44.       SEGACT IPT2
  45.       IF (IPT2.LISOUS(/1).NE.0) GOTO 202
  46.       IF (KSURF(IPT2.ITYPEL).EQ.0) GOTO 201
  47.  202  CONTINUE
  48.       CALL ECROBJ('MAILLAGE',IPT2)
  49.       CALL PRCONT
  50.       CALL LIROBJ('MAILLAGE',IPT2,1,IRETOU)
  51.       IF (IERR.NE.0) RETURN
  52.       SEGACT IPT2
  53.  201  CONTINUE
  54. C
  55.       IF(IPT3.NE.0)THEN
  56. C
  57. C  CAS DES ELELMENTS JOINTS POREUX
  58. C
  59.         SEGACT IPT3
  60.         IF (IPT3.LISOUS(/1).NE.0) GOTO 302
  61.         IF (KSURF(IPT3.ITYPEL).EQ.0) GOTO 301
  62.  302    CONTINUE
  63.         SEGDES IPT1,IPT2,IPT3
  64.         CALL ERREUR(26)
  65.         RETURN
  66.  301    CONTINUE
  67.         CALL RACPOR(IPT1,IPT2,IPT3,IPT4,CRIT)
  68.         SEGDES IPT1,IPT2,IPT3
  69. C
  70.       ELSE
  71. C
  72. C  CAS DES ELELMENTS JOINTS NORMAUX
  73. C
  74.         CALL RACCOR(IPT1,IPT2,IPT4,CRIT)
  75.         SEGDES IPT1,IPT2
  76. C
  77.       END IF
  78. C
  79.       IF (IERR.NE.0) RETURN
  80.       SEGDES IPT4
  81.       CALL ECROBJ('MAILLAGE',IPT4)
  82.  
  83.       RETURN
  84.       END
  85.  
  86.  
  87.  
  88.  
  89.  

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