Esope source files

   1 : C ZKMTP     SOURCE    CHAT      05/01/13    04:23:17     5004           
   2 :       SUBROUTINE ZKMTP
   3 : C************************************************************************
   4 : C              T
   5 : C   CALCUL DE C P
   6 : C
   7 : C     MCHPOI = KMTP MATRAK IZB ;
   8 : C
   9 : C     POINTEURS :
  10 : C
  11 : C     MATRAK  MATRICES ELEMENTAIRES DE LA DIVERGENCE (ALIAS "C")
  12 : C     IZB     CHAMP DE PRESSION (SCAL ELEM SUR LA ZONE PRESSION)
  13 : C     MELEME  OBJET MAILLAGE SUR LEQUEL REPOSE LA PRESSION
  14 : C     IZIPAD  CORRESPONDANCE NUMER. GLOBALE --> NUMER. LOCALE
  15 : C             (DOMAINE SUR LEQUEL PORTE AP ET NON LA PRESSION)
  16 : C     MELEMG  OBJET MAILLAGE SUR LEQUEL REPOSE LE GRADIENT DE PRESSION
  17 : C             C'EST UN OBJET MAILLAGE COMPOSE DE POI1.
  18 : C
  19 : C !!!!!!!!!!! QUI DOIT ETRE LE CHANGER MELEME POI1 !!!!!!!!!!!!!!!!!!!!
  20 : C !!!!!!!!!!! ON NE VERIFIE MEME PAS (SCANDALEUX)  !!!!!!!!!!!!!!!!!!!!
  21 : C
  22 : C     EN SORTIE :
  23 : C                                                 T
  24 : C     MCHPOI  CONTIENT LE GRADIENT DE PRESSION C P
  25 : C
  26 : C ***********************************************************************
  27 :       IMPLICIT INTEGER(I-N)
  28 :       IMPLICIT REAL*8 (A-H,O-Z)
  29 :       CHARACTER*8 TYPE,TYPC
  30 : -INC CCOPTIO
  31 : -INC SMELEME
  32 :       POINTEUR MELEMG.MELEME
  33 : -INC SMLENTI
  34 :       POINTEUR IZIPAD.MLENTI
  35 : C-INC SMMATRAKANC
  36 : C*************************************************************************
  37 : C
  38 : C    REPERAGE ET STOKAGE DES MATRICES ELEMENTAIRES  puis assemblees
  39 : C
  40 : 
  41 : * LGEOC SPG de la pression et/ou des multiplicateurs de Lagrange
  42 : * (points CENTRE ) pour chaque operateur de contrainte
  43 : * KGEOC SPG pour la totalite des points CENTRE.
  44 : * KGEOS SPG pour la totalite des points SOMMET (Diagonale vitesse)
  45 : * KLEMC Connectivites de l'ensemble des contraintes
  46 : * LIZAFM(NBSOUS) contient les pointeurs IZAFM des sous-zones
  47 : 
  48 :       SEGMENT MATRAK
  49 :       INTEGER LGEOC(NBOP),IDEBS(NBOP),IFINS(NBOP)
  50 :       INTEGER LIZAFM(NBSOUS)
  51 :       INTEGER IKAM0 (NBSOUS)
  52 :       INTEGER IMEM  (NBELC)
  53 :       INTEGER KLEMC,KGEOS,KGEOC,KDIAG,KCAC,KIZCL,KIZGC
  54 :       ENDSEGMENT
  55 : 
  56 :       SEGMENT IZAFM
  57 :       REAL*8  AM(NNELP,NP,IESP),RPGI(NELAX)
  58 :       ENDSEGMENT
  59 : 
  60 :       POINTEUR IPMJ.IZAFM,IPMK.IZAFM
  61 : 
  62 : C*******************************************************************
  63 : -INC SMCHPOI
  64 :       POINTEUR IZB.MCHPOI,IZBB.MPOVAL
  65 : C***
  66 : 
  67 : C     write(6,*)' DEBUT KMTP '
  68 :       TYPE='MATRAK'
  68 :       CALL LIROBJ(TYPE,MATRAK,1,IRET)
  69 :       IF(IRET.EQ.0)RETURN
  70 : 
  71 :       TYPE='CHPOINT '
  71 :       CALL LIROBJ(TYPE,IZB,1,IRET)
  72 :       IF(IRET.EQ.0)RETURN
  72 :       CALL LICHT(IZB,IZBB,TYPC,IGEOMC)
  73 : 
  73 :       CALL LIROBJ(TYPE,IZV,0,IRET)
  74 :       IF(IRET.EQ.0)IZV=0
  75 : 
  76 :       SEGACT MATRAK
  77 :       MELEME=KLEMC
  78 : 
  79 :       MELEMG=KGEOS
  79 :       CALL KRIPAD(MELEMG,IZIPAD)
  80 :       NC=IDIM
  81 :       TYPE='SOMMET'
  82 :       IF(IZV.EQ.0)THEN
  82 :       CALL CRCHPT(TYPE,MELEMG,NC,MCHPOI)
  82 :       CALL LICHT(MCHPOI,MPOVAL,TYPC,IGEOMS)
  83 :       NPT=VPOCHA(/1)
  84 :       ELSE
  84 :       CALL LICHT(IZV,IZVV,TYPC,IGEOMS)
  85 :       IF(IGEOMS.NE.MELEMG)THEN
  86 :       WRITE(6,*)'Supports geometriques non compatibles'
  87 :       RETURN
  88 :       ENDIF
  89 :       MCHPOI=0
  90 :       MPOVAL=IZVV
  91 :       NPT=VPOCHA(/1)
  92 :       IF(VPOCHA(/2).NE.IDIM)THEN
  93 :       WRITE(6,*)' Champoint inacceptable '
  94 :       RETURN
  95 :       ENDIF
  96 : 
  97 :       ENDIF
  98 : 
  99 :       SEGACT MELEME
 100 : 
 101 : 
 102 : 
 103 :       NBSOUS=LISOUS(/1)
 104 :       IF(NBSOUS.EQ.0)NBSOUS=1
 105 :       KK=0
 106 : 
 107 :       DO 13 KS=1,NBSOUS
 108 :       IF(NBSOUS.EQ.1)IPT1=MELEME
 109 :       IF(NBSOUS.NE.1)IPT1=LISOUS(KS)
 110 :       IZAFM=LIZAFM(KS)
 111 :       SEGACT IPT1,IZAFM
 112 : C
 113 : C
 114 :       NP=IPT1.NUM(/1)
 115 :       NEL=IPT1.NUM(/2)
 116 : C
 117 :       IF(IDIM.EQ.3)GO TO 5
 118 : C
 119 : C*******************************************************************
 120 : C PARTIE NUMERIQUE 2D DANS CMP2
 121 : C*******************************************************************
 122 : C
 123 :       K0=KK
 123 :       CALL KMP2(AM,IZBB.VPOCHA(K0+1,1),VPOCHA,
 124 :      & IZIPAD.LECT,IPT1.NUM,NP,NEL,NPT)
 125 :       KK=K0+NEL
 126 : 
 127 : C     DO 6 K=1,NEL
 128 : C     KK=KK+1
 129 : C     DO 7 I=1,NP
 130 : C     IU=IPADL(IPT1.NUM(I,K))
 131 : C     VPOCHA(IU,1)=VPOCHA(IU,1)+AM(K,I,1)*B(KK)
 132 : C     VPOCHA(IU,2)=VPOCHA(IU,2)+AM(K,I,1)*B(KK)
 133 : C7    CONTINUE
 134 : C6    CONTINUE
 135 : 
 136 :       GO TO 10
 137 : 
 138 :  5    CONTINUE
 139 : 
 140 : C
 141 : C*******************************************************************
 142 : C PARTIE NUMERIQUE 3D DANS CMP3
 143 : C*******************************************************************
 144 : C
 145 :       K0=KK
 145 :       CALL KMP3(AM,IZBB.VPOCHA(K0+1,1),VPOCHA,
 146 :      & IZIPAD.LECT,IPT1.NUM,NP,NEL,NPT)
 147 :       KK=K0+NEL
 148 : 
 149 : C     DO 11 K=1,NEL
 150 : C     KK=KK+1
 151 : C     DO 12 I=1,NP
 152 : C     IU=IPADL(IPT1.NUM(I,K))
 153 : C     VPOCHA(IU,1)=VPOCHA(IU,1)+AM(K,I,1)*B(KK)
 154 : C     VPOCHA(IU,2)=VPOCHA(IU,2)+AM(K,I,1)*B(KK)
 155 : C     VPOCHA(IU,3)=VPOCHA(IU,3)+AM(K,I,1)*B(KK)
 156 : C12   CONTINUE
 157 : C11   CONTINUE
 158 : 
 159 :  10   CONTINUE
 160 :       SEGDES IPT1
 161 :       SEGDES IZAFM
 162 :  13   CONTINUE
 163 : 
 164 :       SEGSUP IZIPAD
 165 :       SEGDES MELEME
 166 :       SEGDES IZB,IZBB
 167 : 
 168 :       SEGDES MPOVAL
 169 :       SEGDES MATRAK
 170 : 
 170 :       IF(MCHPOI.NE.0)CALL ECROBJ('CHPOINT',MCHPOI)
 171 : C     write(6,*)' FIN KMTP '
 172 :       RETURN
 173 :       END
 174 : 
 175 :  
 176 :  
 177 :