Sources Esope | Cast3M

vraco1
C VRACO1    SOURCE    PV        09/03/12    21:36:59     6325
      SUBROUTINE VRACO1(IPGEOM,IPLIQU,IMELVA)
C=======================================================================
C
C      POUR LES ELEMENTS DE RACCORD FLUIDE STRUCTURE
C      CONSTRUIT UN SEGMENT DE TYPE MPTVAL CONTENANT ,
C      POUR CHAQUE ELEMENT DE RACCORD , LES VALEURS D UN
C      VECTEUR DIRIGE VERS L EXTERIEUR DU FLUIDE
C
C     JACQUELINE BROCHARD  DECEMBRE 85
C     P DOWLATYARI ADAPTATION AUX NOUVEAUX CHAMELEMS  FEV.92
C=======================================================================
C  ENTREES
C     IPGEOM = POINTEUR SUR LE MELEME DES ELTS DE RACCORD
C     IPLIQU = POINTEUR SUR LE MELEME DES ELTS LIQUIDE
C     IDIM   = IDIM DE CCOPTIO
C=======================================================================
C  SORTIES
C     IMELVA = POINTEUR SUR LE SEGMENT MPTVAL
C=======================================================================
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
-INC SMCOORD
-INC SMELEME
 
-INC PPARAM
-INC CCOPTIO
-INC SMCHAML
      SEGMENT MPTVAL
        INTEGER IPOS(NS),NSOF(NS)
        INTEGER IVAL(NCOSOU)
        CHARACTER*16 TYVAL(NCOSOU)
      ENDSEGMENT
      DIMENSION XE(3,2)
      MELEME=IPGEOM
      SEGACT MELEME
      NELRAC=NUM(/2)
      NOERAC=(NUM(/1))/2
      IPT1=IPLIQU
      SEGACT IPT1
      IPT2=IPT1
      SEGACT MCOORD
C
C   INITIALISATION DU SEGMENT MELVAL
C
      NS=1
      NCOSOU=IDIM
      SEGINI MPTVAL
      IMELVA=MPTVAL
      N1PTEL=1
      N1EL=NELRAC
      N2PTEL=0
      N2EL=0
      DO 10 IC=1,IDIM
        TYVAL(IC)='REAL*8'
        SEGINI MELVAL
        IVAL(IC)=MELVAL
 10   CONTINUE
C
C   BOUCLE SUR LES ELEMENTS DE RACCORD
C
      DO 1000 JA=1,NELRAC
      DO 1500 JSOUS=1,MAX(1,IPT1.LISOUS(/1))
      IF(IPT1.LISOUS(/1).NE.0) THEN
       IPT2=IPT1.LISOUS(JSOUS)
       SEGACT IPT2
      ENDIF
      NELLIQ=IPT2.NUM(/2)
      NOELIQ=IPT2.NUM(/1)
      DO 100 IC=1,NELLIQ
      JNE=0
      DO 110 ID=1,NOELIQ
      NOE=IPT2.NUM(ID,IC)
      DO 120 IB=1,NOERAC*2
      IF(NOE.EQ.NUM(IB,JA)) JNE=JNE+1
 120  CONTINUE
 110  CONTINUE
      IF(JNE.EQ.NOERAC) GOTO 200
 100  CONTINUE
      IF(IPT1.LISOUS(/1).NE.0) SEGDES IPT2
 1500 CONTINUE
C
C     ERREUR   ON NE TROUVE PAS D ELEMENT LIQUIDE
C     CONTENANT LES PREMIERS NOEUDS DE L ELT DE RACCORD
C
      CALL ERREUR(258)
      DO 20 IC=1,IDIM
       MELVAL=IVAL(IC)
       SEGSUP MELVAL
 20   CONTINUE
      SEGSUP MPTVAL
      GOTO 666
  200 CONTINUE
C
C     ON CONSTRUIT UN VECTEUR DIRIGE VERS L EXTERIEUR DU FLUIDE
C
      DO 210 ID=1,NOELIQ
      NOE=IPT2.NUM(ID,IC)
      DO 220 IB=1,NOERAC*2
      IF(NOE.EQ.NUM(IB,JA)) GOTO 210
  220 CONTINUE
      GOTO 230
  210 CONTINUE
 230  CONTINUE
      iru= mod((ib+4),8)
      DO 300 I=1,IDIM
      XE(I,1)=XCOOR((NUM(iru,JA)-1)*(IDIM+1)+I)
      XE(I,2)=XCOOR((NOE-1)*(IDIM+1)+I)
      MELVAL=IVAL(I)
      VELCHE(1,JA)=XE(I,1)-XE(I,2)
  300 CONTINUE
 1000 CONTINUE
      DO 30 IC=1,IDIM
       MELVAL=IVAL(IC)
       SEGDES MELVAL
 30   CONTINUE
      SEGDES MPTVAL
      IF(IPT1.LISOUS(/1).NE.0) SEGDES IPT2
 666  CONTINUE
      SEGDES IPT1
      SEGDES MELEME
  777 CONTINUE
      RETURN
      END