Esope source files

   1 : C KDOM4C    SOURCE    CHAT      05/01/13    00:54:19     5004           
   2 :       SUBROUTINE KDOM4C(MELF,MELFL,MELFP,MCHPSU,MCHPNO,MCHPMR)
   3 : C
   4 : C************************************************************************
   5 : C
   6 : C PROJET            :  CASTEM 2000
   7 : C
   8 : C NOM               :  KDOM4C
   8 : C                      Subroutine called by KDOM4A
   9 : C                      Axial-symmetric case, TRI7 and QUA8
  10 : C                      We compute 
  11 : C                      MTAB . 'XXSURFAC'
  12 : C                      MTAB . 'XXNORMAF'
  13 : C                      MTAB . 'MATROT'
  14 : C                      and we change the position for the central points
  15 : C                      of MELEMQ
  16 : C                      
  17 : C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
  18 : C      
  19 : C AUTEUR            :  A. BECCANTINI, DRN/DMT/SEMT/LTMF
  20 : C
  21 : C
  22 : C************************************************************************
  23 : C
  24 : C INPUTS :
  25 : C
  26 : C MELF   : meleme 'FACE' 
  27 : C MELFL  : meleme 'FACEL'
  28 : C MELFP  : meleme 'FACEP'
  29 : C
  30 : C OUTPUTS :
  31 : C
  32 : C MCHPSU : mchpoi 'XXSURFAC'
  33 : C MCHPNO : mchpoi 'XXNORMAF'
  34 : C MCHPMR : mchpoi 'MATROT' 
  35 : C
  36 : C***********************************************************
  37 : C
  38 : C Created the 24/02/04
  39 : C
  40 : C**** Variables of CCOPTIO
  41 : C
  42 : C      INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  43 : C     &        ,IOTER,   IOLEC,  IOIMP,     IOCAR,  IOACQ
  44 : C     &        ,IOPER,   IOSGB,  IOGRA,     IOSAU,  IORES
  45 : C     &        ,IECHO,   IIMPI,  IOSPI
  46 : C     &        ,IDIM
  47 : CC     &        ,MCOORD      
  48 : C     &        ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  49 : C     &        ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  50 : C     &        ,NORINC,NORVAL,NORIND,NORVAD
  51 : C     &        ,NUCROU, IPSAUV, IFICLE, IPREFI, IREFOR, ISAFOR
  52 : C
  53 :       IMPLICIT INTEGER(I-N)
  54 :       INTEGER IGEOM, MCHPSU, MCHPNO,  MCHPMR
  55 :      &     ,JGN, JGM, NP, NEL, IEL, NLCF
  56 :      &     , NF, IP1, IP2
  57 :       REAL*8 X1,X2,Y1,Y2,SURF,XF,YF,DX,DY,DVAL,DNX,DNY,DTX,DTY,ORIENT
  58 :       CHARACTER*8 TYPE
  59 : 
  60 : -INC CCOPTIO
  61 : -INC SMELEME
  62 :       POINTEUR MELFL.MELEME,MELFP.MELEME,MELF.MELEME
  63 : -INC SMCHPOI
  64 :       POINTEUR MPOVSU.MPOVAL, MPOVNO.MPOVAL, MPOVMR.MPOVAL
  65 : -INC SMLENTI
  66 : -INC SMLMOTS
  67 : -INC SMCOORD
  68 : C
  69 : C**** Corresp. FACE
  70 : C
  70 :       CALL KRIPAD(MELF,MLENTI)
  71 : C     SEGINI MLENTI
  72 : C
  73 : C**** Champoint surfaces
  74 : C
  75 :       JGN=4
  76 :       JGM=1
  77 :       SEGINI MLMOTS
  78 :       MLMOTS.MOTS(1)='SCAL'
  79 :       TYPE='FACE    '
  79 :       CALL KRCHP1(TYPE,MELF,MCHPSU,MLMOTS)
  80 :       IF(IERR.NE.0)GOTO 9999
  80 :       CALL LICHT(MCHPSU,MPOVSU,TYPE,IGEOM)
  81 :       IF(IERR.NE.0)GOTO 9999
  82 : C     SEGACT MPOVSU
  83 :       SEGSUP MLMOTS
  84 : C
  85 : C**** Champoint normales
  86 : C
  87 :       JGN=4
  88 :       JGM=IDIM
  89 :       SEGINI MLMOTS
  90 :       MLMOTS.MOTS(1)='UX'
  91 :       MLMOTS.MOTS(2)='UY'
  92 :       TYPE='FACE    '
  92 :       CALL KRCHP1(TYPE,MELF,MCHPNO,MLMOTS)
  93 :       IF(IERR.NE.0)GOTO 9999
  93 :       CALL LICHT(MCHPNO,MPOVNO,TYPE,IGEOM)
  94 :       IF(IERR.NE.0)GOTO 9999
  95 : C     SEGACT MPOVNO
  96 :       SEGSUP MLMOTS
  97 : C
  98 : C**** Champoint matrice de rotation
  99 : C
 100 :       JGN=4
 101 :       JGM=IDIM*IDIM
 102 :       SEGINI MLMOTS
 103 : C      IF(IDIM.EQ.2)THEN
 104 :          MLMOTS.MOTS(1)='RX'
 105 :          MLMOTS.MOTS(2)='RY'
 106 :          MLMOTS.MOTS(3)='MX'
 107 :          MLMOTS.MOTS(4)='MY'
 108 : *        Normale en M
 109 : *        vect(M,U) = z
 110 : C      ENDIF
 110 :       CALL KRCHP1(TYPE,MELF,MCHPMR,MLMOTS)
 111 :       IF(IERR.NE.0)GOTO 9999
 111 :       CALL LICHT(MCHPMR,MPOVMR,TYPE,IGEOM)
 112 :       IF(IERR.NE.0)GOTO 9999
 113 : C     SEGACT MPOVMR
 114 : C
 115 :       SEGACT MELFP
 116 : C     In the case 2D,  NBSOUS=1
 117 :       SEGACT MELFL
 118 : C     
 119 :       NP=MELFP.NUM(/1)-1
 120 :       NEL=MELFP.NUM(/2)
 121 :       IF(NP .NE. 2)THEN
 122 :          WRITE(IOIMP,*) 'Subroutine kdom4c.eso'
 122 :          CALL ERREUR(5)
 123 :       ENDIF
 124 : C
 125 :       DO IEL=1,NEL,1
 126 : C       X1,Y1,X2,Y2,XF,YF
 127 :          NF=MELFP.NUM(NP+1,IEL)
 128 :          IP1=MELFP.NUM(1,IEL)
 129 :          IP2=MELFP.NUM(2,IEL)
 130 :          X1=XCOOR((IP1-1)*(IDIM+1)+1)
 131 :          Y1=XCOOR((IP1-1)*(IDIM+1)+2)
 132 :          X2=XCOOR((IP2-1)*(IDIM+1)+1)
 133 :          Y2=XCOOR((IP2-1)*(IDIM+1)+2)
 133 :          CALL KDOM3B(X1,Y1,X2,Y2,SURF,XF,YF)
 134 :          XCOOR((NF-1)*(IDIM+1)+1)=XF
 135 :          XCOOR((NF-1)*(IDIM+1)+2)=YF
 136 :          NLCF=MLENTI.LECT(NF)
 137 :          MPOVSU.VPOCHA(NLCF,1)=SURF
 138 :          DX=X1-XF
 139 :          DY=Y1-YF
 140 :          DVAL=((DX*DX)+(DY*DY))**0.5D0
 141 :          DNX=DY/DVAL
 142 :          DNY=-1.0D0*DX/DVAL
 143 :          DTX=DX/DVAL
 144 :          DTY=DY/DVAL
 145 : C
 146 : C******* Orientation selon FACEL
 147 : C
 148 :          IP1=MELFL.NUM(1,NLCF)
 149 :          X1=XCOOR((IP1-1)*(IDIM+1)+1)
 150 :          Y1=XCOOR((IP1-1)*(IDIM+1)+2)
 151 :          DX=XF-X1
 152 :          DY=YF-Y1
 153 :          ORIENT=SIGN(1.0D0,((DNX*DX)+(DNY*DY)))
 154 : C
 155 :          MPOVNO.VPOCHA(NLCF,1)=DNX*ORIENT
 156 :          MPOVNO.VPOCHA(NLCF,2)=DNY*ORIENT
 157 : C
 158 :          MPOVMR.VPOCHA(NLCF,3)=DNX*ORIENT
 159 :          MPOVMR.VPOCHA(NLCF,4)=DNY*ORIENT
 160 :          MPOVMR.VPOCHA(NLCF,1)=DTX*ORIENT
 161 :          MPOVMR.VPOCHA(NLCF,2)=DTY*ORIENT
 162 : C
 163 :       ENDDO
 164 : C
 165 :       SEGDES MPOVSU
 166 :       SEGDES MPOVNO
 167 :       SEGDES MPOVMR
 168 :       SEGDES MELFP
 169 : C
 170 :       SEGDES MELFL
 171 :       SEGSUP MLENTI
 172 : C
 173 :  9999 RETURN 
 174 :       END                                                            
 175 : 
 176 :  
 177 :  
 178 :  
 179 :  
 180 :  
 181 :  
 182 :  
 183 :  
 184 :  
 185 :  
 186 :  
 187 :  
 188 :  
 189 :