Esope source files

   1 : C KDXDY     SOURCE    MAGN      10/05/18    21:15:35     6675           
   2 :       SUBROUTINE KDXDY
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)
   5 : C*************************************************************************
   6 : C
   7 : C     OBJET   : Cree un CHAMPOINT CENTRE contenant les informations
   8 : C               décrites ci dessous, sur les éléments du domaine.
   9 : C
  10 : C     SYNTAXE : CHPC = KDXDY OBJDOM ;
  11 : C
  12 : C                      OBJDOM : TABLE de SOUSTYPE DOMAINE
  13 : C
  14 : C     AVIS IMPORTANT ;
  15 : C
  16 : C     Ces informations sont destinées aux opérateurs de discrétisation
  17 : C     et sont rangées dans un ordre particulier.
  18 : C
  19 : C Les dimensions du tableau sont : (DIME NBEL)  DIME=11 en 2D
  20 : C                                               DIME=13 en 3D
  21 : C et il contient :
  22 : C
  23 : C  pour un SEG2 la longueur de l'element (XML) et la matrice P(2,2) en 2D
  24 : C                                                            P(3,3) en 3D
  25 : C  pour un TRI3 XML,XMH,AJ1/XML,AJ2/XML, et la matrice P(2,2) en 2D
  26 : C                                                      P(3,3) en 3D
  27 : C  pour un QUA4 IDEM
  28 : C  pour un CUB8 XML XMH XME et la matrice P
  29 : C  pour un PRI6 IDEM
  30 : C
  31 : C***********************************************************************
  32 : C   MATRICE P
  33 : C       LA MATRICE DE ROTATION DU REPERE GLOBALE VERS LE REPERE LOCAL
  34 : C   DEFINI PAR DEUX OU TROIS POINTS PRIS DANS XYZ SUIVANT QU'ON EST
  35 : C   EN 2D OU EN 3D
  36 : C   ON PREND P1 P2 ET PNP
  37 : C
  38 : C     U                TEL QUE T SOIT DIRIGE SUIVANT P1P2 V TOURNE VERS
  39 : C     .     .V          P1PNP ET U = T VECTORIEL V
  40 : C     .   .
  41 : C     . .                             __       __
  42 : C (P1). . . . .T (P2)                | tx ty tz  |
  43 : C                                    |           |
  44 : C  ON A ALORS WL= P WG          P  = | vx vy vz  |
  45 : C                                    |           |
  46 : C                                    | ux uy uz  |
  47 : C                                    |__       __|
  48 : C*************************************************************************
  49 : -INC CCOPTIO
  50 : -INC CCREEL
  51 : *- 
  52 : -INC CCGEOME
  53 : -INC SMTABLE
  54 : -INC SMELEME
  55 :       POINTEUR MELEMC.MELEME
  56 : -INC SMCOORD
  57 : -INC SMCHPOI
  58 : -INC SIZFFB
  59 :       PARAMETER (NLTS=10)
  60 :       CHARACTER*8 LISTS(NLTS)
  61 : C***
  62 :       DIMENSION AAJ(3,3,9),XC(3),T(13),DELTAX(3)
  63 :       PARAMETER (NTB=1)
  64 :       CHARACTER*8 LTAB(NTB),TYPE,NOM0,TYPC
  65 :       DIMENSION KTAB(NTB)
  66 :       DATA LTAB/'DOMAINE '/
  67 :       DATA LISTS/'QUA4    ','CUB8    ','TRI3    ','PRI6    ',
  68 :      &'SEG2    ','TET4    ','PYR5    ','TRI7    ','QUA9    ',
  69 :      &'SEG3    '/
  70 : C***
  71 :       NTO=NTB
  71 :       CALL LITABS(LTAB,KTAB,NTB,NTO,IRET)
  72 :       IF(IRET.EQ.0)RETURN
  73 :       MTABD=KTAB(1)
  74 : 
  75 :       TYPE=' '
  75 :       CALL ACMO(MTABD,'CENTRE',TYPE,MELEMC)
  76 : 
  77 :       NC=IDIM
  78 : 
  79 :       TYPE='CENTRE'
  79 :       CALL CRCHPT(TYPE,MELEMC,NC,MCHPOI)
  79 :       CALL LICHT(MCHPOI,MPOVAL,TYPC,IGEOM)
  80 : 
  81 :       TYPE=' '
  81 :       CALL ACMO(MTABD,'MAILLAGE',TYPE,MELEME)
  82 :       IF(TYPE.NE.'MAILLAGE')GO TO 90
  83 :       SEGACT MELEME
  84 : 
  85 :       IAXI=0
  86 :       IF(IFOMOD.EQ.0)IAXI=2
  87 :       NPGI=1
  88 : 
  89 :       NBSOUS=LISOUS(/1)
  90 :       IF(NBSOUS.EQ.0)NBSOUS=1
  91 : 
  92 :       K0=0
  93 :       DO 1 L=1,NBSOUS
  94 :       IPT1=MELEME
  95 :       IF(NBSOUS.NE.1)IPT1=LISOUS(L)
  96 :       SEGACT IPT1
  97 :       NP=IPT1.NUM(/1)
  98 :       NEL=IPT1.NUM(/2)
  99 :       NOM0=NOMS(IPT1.ITYPEL)//'    '
 100 : C     write(6,*)' KDXDY : NOM0=',nom0,' NEL=',nel
 100 :       CALL OPTLI(IP,LISTS,NOM0,NLTS)
 101 :       IF(IP.EQ.0)THEN
 102 :       WRITE(6,*)' Sub KDXDY :'
 103 :       WRITE(6,*)' Il y a des types d''éléments pour lesquels on ne sait'
 104 :      &,'pas faire'
 105 :       GO TO 1
 106 :       ENDIF
 106 :       CALL KALPBG(NOM0,'FONFORM ',IZFFM)
 107 :       SEGACT IZFFM*MOD
 108 :       IZHR=KZHR(1)
 109 :       SEGACT IZHR*MOD
 110 :       NES=GR(/1)
 111 :       NPG=GR(/3)
 112 : 
 113 :       DO 10 K=1,NEL
 114 :       KK=K0+K
 115 :       NPGR=0
 116 :       IF(IAXI.NE.0)NPGR=NPG
 117 : C
 118 : C     REMPLISSAGE DE XYZ
 119 : C     ------------------
 120 : C
 121 :       DO 12 I=1,NP
 122 :       J=IPT1.NUM(I,K)
 123 :       DO 12 N=1,IDIM
 124 :       XYZ(N,I)=XCOOR((J-1)*(IDIM+1)+N)
 125 :  12   CONTINUE
 126 : 
 126 :       CALL CALJAJ(GR,XYZ,NES,IDIM,NP,NPGI,AAJ)
 127 : C
 127 :       CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NP,NPG,IAXI,AIRE)
 128 : 
 129 :       IF(AIRE.LE.0.D0)AIRE=ABS(AIRE)
 130 : 
 131 : 
 132 : C             CALCUL DES LONGUEURS DES COTES DE L'ELEMENT
 133 : C                    UNIQUEMENT POUR LES SEG2 QUA4 ET CUB8
 134 : 
 135 :       XML=0.
 136 :       DO 231 N=1,IDIM
 137 :       XML=XML+(XYZ(N,1)-XYZ(N,2))*(XYZ(N,1)-XYZ(N,2))
 138 :  231  CONTINUE
 139 :       XML=SQRT(XML)
 140 : 
 141 :       DO 234 N=1,IDIM
 142 :       DELTAX(N)=ABS(XYZ(N,NP)-XYZ(N,1))
 143 :       DO 233 I=2,NP
 144 :       DELTAX(N)=DELTAX(N)+ABS(XYZ(N,I)-XYZ(N,I-1))
 145 :  233  CONTINUE
 146 :       VPOCHA(KK,N)=(DELTAX(N)/FLOAT(NP))+XPETIT
 147 :       IF(NOM0.EQ.'QUA4    ')THEN
 148 :       VPOCHA(KK,N)=VPOCHA(KK,N)*FLOAT(IDIM)
 149 :       ENDIF
 150 :  234  CONTINUE
 151 : 
 152 : C
 153 : C
 154 :       IF(XML.EQ.0.)
 155 :      &WRITE(6,*)' ELEMENT DEGENERE ( AYANT UN COTE DE LONGUEUR NULLE) '
 156 : C
 157 : C
 158 :  10   CONTINUE
 159 :       K0=K0+NEL
 160 :       SEGDES IPT1
 161 :  1    CONTINUE
 162 :       SEGDES MELEME,MPOVAL,MCHPOI
 163 : C
 163 :       CALL ECROBJ('CHPOINT ',MCHPOI)
 164 : 
 165 :       RETURN
 166 : 
 167 :  90   CONTINUE
 168 :       WRITE(6,*)' Interruption anormale de KDXDY'
 169 :       RETURN
 170 :  1001 FORMAT(20(1X,I5))
 171 :  1002 FORMAT(10(1X,1PE11.4))
 172 :       END
 173 : 
 174 : 
 175 : 
 176 : 
 177 : 
 178 : 
 179 : 
 180 : 
 181 : 
 182 : 
 183 :  
 184 :  
 185 :  
 186 :  
 187 :  
 188 :  
 189 :