Sources Esope | Cast3M

licoma
C LICOMA    SOURCE    CHAT      05/01/13    01:17:24     5004
      SUBROUTINE LICOMA(NBPGAU,IDIM,NBNN,NDDL,XE,CFPI,WORK,POIGAU,
     1         QSIGAU,ETAGAU,SHPTOT,REL,LRE,IER246)
C=======================================================================
C
C      CALCULE LA MATRICE MASSE DE L ELEMENT DE RACCORD
C       LIQUIDE COQUE             CAS TRIDIMENSIONNEL
C      (INTEGRE LE PRODUIT PI*U AVEC U DEPLACEMENT NORMAL A LA PAROI
C         DU SOLIDE)
C
C      ROUTINE FORTRAN PUR
C
C     JACQUELINE BROCHARD JUILLET 86
C=======================================================================
C      ENTREES
C         NBPGAU = NB DE PTS DE GAUSS
C         NBNN   = NB DE NOEUDS DE L ELEMENT DE RACCORD
C         XE(3,NBNN) = COORDONNEES LOCALES DE L ELEMENT
C         CFPI   = COEFFICIENT DE NORMALISATION SUR PI
C         WORK(IDIM) = COMPOSANTES DE LA NORMALE SORTANTE AU FLUIDE
C         POIGAU(NBPGAU) = POIDS DE GAUSS
C         QSIGAU(NBPGAU),ETAGAU(NBPGAU) = COORDONNEES DES PTS DE GAUSS
C         SHPTOT(6,NBNN,NBPGAU) = FONCTIONS DE FORME ET DERIVEES DE
C            L ELEMENT DE RACCORD
C      SORTIES
C         REL(LRE,LRE) = MATRICE DE MASSE
C=======================================================================
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
      DIMENSION XE(3,1),WORK(IDIM),POIGAU(NBPGAU),QSIGAU(NBPGAU)
      DIMENSION ETAGAU(NBPGAU),SHPTOT(6,NBNN,1)
      DIMENSION XEL(3,3),BPSS(3,3),BB(9),VME(24,24)
      DIMENSION REL(LRE,1)
      DATA EPSI/1.D-12/
      DATA XZER/0.D0/
      IER246=0
C
C     MATRICE DE PASSAGE
C
      CALL VPAST(XE,BPSS)
C
C     COORDONNEES LOCALES
C
      CALL VCORLC(XE,XEL,BPSS)
C
C     MISE A 0 DE LA MATRICE DE MASSE
C
      CALL ZERO(VME,LRE,LRE)
C
C     CALCUL DE LA SURFACE
C
      X21=XEL(1,2)-XEL(1,1)
      Y31=XEL(2,3)-XEL(2,1)
      SURF=X21*Y31
C
C     ON COMPARE L ORIENTATION DE LA NORMALE SORTANTE AU FLUIDE
C       A CELLE DE LA PAROI
C
      NBNNL=NBNN/2
      ID=NBNNL+1
      VNQSI1=XZER
      VNQSI2=XZER
      VNQSI3=XZER
      VNETA1=XZER
      VNETA2=XZER
      VNETA3=XZER
      ALFA=XZER
      BETA=XZER
      GAMMA=XZER
      DO 20 J=ID,NBNN
      VNQSI1=VNQSI1+SHPTOT(2,J,1)*XE(1,J)
      VNQSI2=VNQSI2+SHPTOT(2,J,1)*XE(2,J)
      VNQSI3=VNQSI3+SHPTOT(2,J,1)*XE(3,J)
      VNETA1=VNETA1+SHPTOT(3,J,1)*XE(1,J)
      VNETA2=VNETA2+SHPTOT(3,J,1)*XE(2,J)
      VNETA3=VNETA3+SHPTOT(3,J,1)*XE(3,J)
 20   CONTINUE
      ALFA=VNQSI2*VNETA3-VNQSI3*VNETA2
      BETA=VNQSI3*VNETA1-VNQSI1*VNETA3
      GAMMA=VNQSI1*VNETA2-VNQSI2*VNETA1
      PSCAL=ALFA*WORK(1)+BETA*WORK(2)+GAMMA*WORK(3)
      IF (ABS(PSCAL).LT.EPSI) GOTO 777
      SENS=PSCAL/ABS(PSCAL)
C
C     CALCUL DES TERMES DE LA MATRICE : INTEGRATION NUMERIQUE
C       NL : NUMERO D UN NOEUD LIQUIDE
C       IGAU : NUMERO DU POINT DE GAUSS
C       J : NUMERO D UN NOEUD DE COQUE
C       K INDICE SUR LA COMPOSANTE W , RX , OU RY
C
      DO 100 NL=1,NBNNL
      IL=2*NL
      DO 80 IGAU=1,NBPGAU
C  VALEURS DES FONCTIONS DE FORME POUR L ELT DE COQUE
      CALL MFDKT(QSIGAU(IGAU),ETAGAU(IGAU),XEL,BB)
      DO 30 J=ID,NBNN
      INDM=2*NBNNL+(J-ID)*NDDL
      DO 35 K=1,3
      IC=INDM+2+K
      IP=(J-ID)*3+K
      VME(IL,IC)=VME(IL,IC)-SENS*CFPI*SURF*SHPTOT(1,NL,IGAU)
     1                      *POIGAU(IGAU)*BB(IP)
 35   CONTINUE
 30   CONTINUE
 80   CONTINUE
C
C     CHANGEMENT DE REPERE ET SYMETRISATION
C
      DO 50 J=ID,NBNN
      INDM=2*NBNNL+(J-ID)*NDDL
      INDF=INDM+3
      DO 55 I=1,3
      DO 56 IP=1,3
      REL(IL,INDM+I)=REL(IL,INDM+I)+BPSS(IP,I)*VME(IL,INDM+IP)
      REL(IL,INDF+I)=REL(IL,INDF+I)+BPSS(IP,I)*VME(IL,INDF+IP)
  56  CONTINUE
  55  CONTINUE
      DO 40 K=1,6
      IC=INDM+K
      REL(IC,IL)=REL(IL,IC)
 40   CONTINUE
 50   CONTINUE
100   CONTINUE
      GOTO 666
C
C     ERREUR  LE VECTEUR PERMETTANT D ORIENTER L ELEMENT DE RACCORD
C     EST NUL OU PARALLELE A LA FRONTIERE DU FLUIDE
C
777   IER246=246
666   CONTINUE
      RETURN
      END