Sources Esope | Cast3M

kdom4c
C KDOM4C    SOURCE    CB215821  20/11/25    13:31:08     10792          
      SUBROUTINE KDOM4C(MELF,MELFL,MELFP,MCHPSU,MCHPNO,MCHPMR)
C
C************************************************************************
C
C PROJET            :  CASTEM 2000
C
C NOM               :  KDOM4C
C                      Subroutine called by KDOM4A
C                      Axial-symmetric case, TRI7 and QUA8
C                      We compute
C                      MTAB . 'XXSURFAC'
C                      MTAB . 'XXNORMAF'
C                      MTAB . 'MATROT'
C                      and we change the position for the central points
C                      of MELEMQ
C
C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
C
C AUTEUR            :  A. BECCANTINI, DRN/DMT/SEMT/LTMF
C
C
C************************************************************************
C
C INPUTS :
C
C MELF   : meleme 'FACE'
C MELFL  : meleme 'FACEL'
C MELFP  : meleme 'FACEP'
C
C OUTPUTS :
C
C MCHPSU : mchpoi 'XXSURFAC'
C MCHPNO : mchpoi 'XXNORMAF'
C MCHPMR : mchpoi 'MATROT'
C
C***********************************************************
C
C Created the 24/02/04
C
C**** Variables of CCOPTIO
C
C      INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
C     &        ,IOTER,   IOLEC,  IOIMP,     IOCAR,  IOACQ
C     &        ,IOPER,   IOSGB,  IOGRA,     IOSAU,  IORES
C     &        ,IECHO,   IIMPI,  IOSPI
C     &        ,IDIM
CC     &        ,MCOORD
C     &        ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
C     &        ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
C     &        ,NORINC,NORVAL,NORIND,NORVAD
C     &        ,NUCROU, IPSAUV, IFICLE, IPREFI, IREFOR, ISAFOR
C
      IMPLICIT INTEGER(I-N)
      INTEGER IGEOM, MCHPSU, MCHPNO,  MCHPMR
     &     ,JGN, JGM, NP, NEL, IEL, NLCF
     &     , NF, IP1, IP2
      REAL*8 X1,X2,Y1,Y2,SURF,XF,YF,DX,DY,DVAL,DNX,DNY,DTX,DTY,ORIENT
      CHARACTER*8 TYPE
 
 
-INC PPARAM
-INC CCOPTIO
-INC SMELEME
      POINTEUR MELFL.MELEME,MELFP.MELEME,MELF.MELEME
-INC SMCHPOI
      POINTEUR MPOVSU.MPOVAL, MPOVNO.MPOVAL, MPOVMR.MPOVAL
-INC SMLENTI
-INC SMLMOTS
-INC SMCOORD
C
C**** Corresp. FACE
C
      CALL KRIPAD(MELF,MLENTI)
C     SEGINI MLENTI
C
C**** Champoint surfaces
C
      JGN=4
      JGM=1
      SEGINI MLMOTS
      MLMOTS.MOTS(1)='SCAL'
      TYPE='FACE    '
      CALL KRCHP1(TYPE,MELF,MCHPSU,MLMOTS)
      IF(IERR.NE.0)GOTO 9999
      CALL LICHT(MCHPSU,MPOVSU,TYPE,IGEOM)
      IF(IERR.NE.0)GOTO 9999
C     SEGACT MPOVSU
      SEGSUP MLMOTS
C
C**** Champoint normales
C
      JGN=4
      JGM=IDIM
      SEGINI MLMOTS
      MLMOTS.MOTS(1)='UX'
      MLMOTS.MOTS(2)='UY'
      TYPE='FACE    '
      CALL KRCHP1(TYPE,MELF,MCHPNO,MLMOTS)
      IF(IERR.NE.0)GOTO 9999
      CALL LICHT(MCHPNO,MPOVNO,TYPE,IGEOM)
      IF(IERR.NE.0)GOTO 9999
C     SEGACT MPOVNO
      SEGSUP MLMOTS
C
C**** Champoint matrice de rotation
C
      JGN=4
      JGM=IDIM*IDIM
      SEGINI MLMOTS
C      IF(IDIM.EQ.2)THEN
         MLMOTS.MOTS(1)='RX'
         MLMOTS.MOTS(2)='RY'
         MLMOTS.MOTS(3)='MX'
         MLMOTS.MOTS(4)='MY'
*        Normale en M
*        vect(M,U) = z
C      ENDIF
      CALL KRCHP1(TYPE,MELF,MCHPMR,MLMOTS)
      IF(IERR.NE.0)GOTO 9999
      CALL LICHT(MCHPMR,MPOVMR,TYPE,IGEOM)
      IF(IERR.NE.0)GOTO 9999
C     SEGACT MPOVMR
C
      SEGACT MELFP
C     In the case 2D,  NBSOUS=1
      SEGACT MELFL
C
      NP=MELFP.NUM(/1)-1
      NEL=MELFP.NUM(/2)
      IF(NP .NE. 2)THEN
         WRITE(IOIMP,*) 'Subroutine kdom4c.eso'
         CALL ERREUR(5)
      ENDIF
C
      DO IEL=1,NEL,1
C       X1,Y1,X2,Y2,XF,YF
         NF=MELFP.NUM(NP+1,IEL)
         IP1=MELFP.NUM(1,IEL)
         IP2=MELFP.NUM(2,IEL)
         X1=XCOOR((IP1-1)*(IDIM+1)+1)
         Y1=XCOOR((IP1-1)*(IDIM+1)+2)
         X2=XCOOR((IP2-1)*(IDIM+1)+1)
         Y2=XCOOR((IP2-1)*(IDIM+1)+2)
         CALL KDOM3B(X1,Y1,X2,Y2,SURF,XF,YF)
         XCOOR((NF-1)*(IDIM+1)+1)=XF
         XCOOR((NF-1)*(IDIM+1)+2)=YF
         NLCF=MLENTI.LECT(NF)
         MPOVSU.VPOCHA(NLCF,1)=SURF
         DX=X1-XF
         DY=Y1-YF
         DVAL=((DX*DX)+(DY*DY))**0.5D0
         DNX=DY/DVAL
         DNY=-1.0D0*DX/DVAL
         DTX=DX/DVAL
         DTY=DY/DVAL
C
C******* Orientation selon FACEL
C
         IP1=MELFL.NUM(1,NLCF)
         X1=XCOOR((IP1-1)*(IDIM+1)+1)
         Y1=XCOOR((IP1-1)*(IDIM+1)+2)
         DX=XF-X1
         DY=YF-Y1
         ORIENT=SIGN(1.0D0,((DNX*DX)+(DNY*DY)))
C
         MPOVNO.VPOCHA(NLCF,1)=DNX*ORIENT
         MPOVNO.VPOCHA(NLCF,2)=DNY*ORIENT
C
         MPOVMR.VPOCHA(NLCF,3)=DNX*ORIENT
         MPOVMR.VPOCHA(NLCF,4)=DNY*ORIENT
         MPOVMR.VPOCHA(NLCF,1)=DTX*ORIENT
         MPOVMR.VPOCHA(NLCF,2)=DTY*ORIENT
C
      ENDDO
C
      SEGDES MPOVSU
      SEGDES MPOVNO
      SEGDES MPOVMR
      SEGDES MELFP
C
      SEGDES MELFL
      SEGSUP MLENTI
C
 9999 RETURN
      END