1 : C KMTP SOURCE CHAT 05/01/13 00:58:07 5004 2 : SUBROUTINE KMTP 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 : CHARACTER*4 NOM4(3) 31 : -INC CCOPTIO 32 : -INC SMELEME 33 : POINTEUR MELEMG.MELEME 34 : -INC SMLENTI 35 : POINTEUR IZIPAD.MLENTI 36 : -INC SMLMOTS 37 : C-INC SMMATRAKANC 38 : C************************************************************************* 39 : C 40 : C REPERAGE ET STOKAGE DES MATRICES ELEMENTAIRES puis assemblees 41 : C 42 : 43 : * LGEOC SPG de la pression et/ou des multiplicateurs de Lagrange 44 : * (points CENTRE ) pour chaque operateur de contrainte 45 : * KGEOC SPG pour la totalite des points CENTRE. 46 : * KGEOS SPG pour la totalite des points SOMMET (Diagonale vitesse) 47 : * KLEMC Connectivites de l'ensemble des contraintes 48 : * LIZAFM(NBSOUS) contient les pointeurs IZAFM des sous-zones 49 : 50 : SEGMENT MATRAK 51 : INTEGER LGEOC(NBOP),IDEBS(NBOP),IFINS(NBOP) 52 : INTEGER LIZAFM(NBSOUS) 53 : INTEGER IKAM0 (NBSOUS) 54 : INTEGER IMEM (NBELC) 55 : INTEGER KLEMC,KGEOS,KGEOC,KDIAG,KCAC,KIZCL,KIZGC 56 : ENDSEGMENT 57 : 58 : SEGMENT IZAFM 59 : REAL*8 AM(NNELP,NP,IESP),RPGI(NELAX) 60 : ENDSEGMENT 61 : 62 : POINTEUR IPMJ.IZAFM,IPMK.IZAFM 63 : 64 : C******************************************************************* 65 : -INC SMCHPOI 66 : POINTEUR IZB.MCHPOI,IZBB.MPOVAL 67 : C*** 68 : C write(6,*)' DEBUT KMTP ' 68 : CALL QUETYP(TYPE,0,IRET) 69 : IF(TYPE.EQ.'ENTIER')THEN 69 : CALL LIRENT(NASTOK,0,IRET) 70 : ELSE 71 : NASTOK=0 72 : ENDIF 73 : IF(NASTOK.EQ.0)THEN 73 : CALL ZKMTP 74 : RETURN 75 : ENDIF 76 : 77 : TYPE='MATRAK' 77 : CALL LIROBJ(TYPE,MATRAK,1,IRET) 78 : IF(IRET.EQ.0)RETURN 79 : 80 : TYPE='CHPOINT ' 80 : CALL LIROBJ(TYPE,IZB,1,IRET) 81 : IF(IRET.EQ.0)RETURN 81 : CALL LICHT(IZB,IZBB,TYPC,IGEOMC) 82 : 82 : CALL LIROBJ(TYPE,IZV,0,IRET) 83 : IF(IRET.EQ.0)IZV=0 84 : 84 : CALL LIROBJ('LISTMOTS',MLMOTS,1,IRET) 85 : IF(IRET.EQ.0)RETURN 86 : SEGACT MLMOTS 87 : JGM=MOTS(/2) 88 : DO 178 I=1,JGM 89 : NOM4(I)=MOTS(I) 90 : 178 CONTINUE 91 : SEGDES MLMOTS 92 : 93 : SEGACT MATRAK 94 : MELEME=KLEMC 95 : 96 : MELEMG=KGEOS 96 : CALL KRIPAD(MELEMG,IZIPAD) 97 : NC=IDIM 98 : TYPE='SOMMET' 99 : IF(IZV.EQ.0)THEN 99 : CALL KRCHPT(TYPE,MELEMG,NC,MCHPOI,NOM4) 99 : CALL LICHT(MCHPOI,MPOVAL,TYPC,IGEOMS) 100 : NPT=VPOCHA(/1) 101 : ELSE 101 : CALL LICHT(IZV,IZVV,TYPC,IGEOMS) 102 : IF(IGEOMS.NE.MELEMG)THEN 103 : WRITE(6,*)'Supports geometriques non compatibles' 104 : RETURN 105 : ENDIF 106 : MCHPOI=0 107 : MPOVAL=IZVV 108 : NPT=VPOCHA(/1) 109 : IF(VPOCHA(/2).NE.IDIM)THEN 110 : WRITE(6,*)' Champoint inacceptable ' 111 : RETURN 112 : ENDIF 113 : 114 : ENDIF 115 : 116 : SEGACT MELEME 117 : 118 : 119 : 120 : NBSOUS=LISOUS(/1) 121 : IF(NBSOUS.EQ.0)NBSOUS=1 122 : KK=0 123 : 124 : DO 13 KS=1,NBSOUS 125 : IF(NBSOUS.EQ.1)IPT1=MELEME 126 : IF(NBSOUS.NE.1)IPT1=LISOUS(KS) 127 : IZAFM=LIZAFM(KS) 128 : SEGACT IPT1,IZAFM 129 : C 130 : C 131 : NP=IPT1.NUM(/1) 132 : NEL=IPT1.NUM(/2) 133 : C 134 : IF(IDIM.EQ.3)GO TO 5 135 : C 136 : C******************************************************************* 137 : C PARTIE NUMERIQUE 2D DANS CMP2 138 : C******************************************************************* 139 : C 140 : K0=KK 140 : CALL KMP2(AM,IZBB.VPOCHA(K0+1,1),VPOCHA, 141 : & IZIPAD.LECT,IPT1.NUM,NP,NEL,NPT) 142 : KK=K0+NEL 143 : 144 : C DO 6 K=1,NEL 145 : C KK=KK+1 146 : C DO 7 I=1,NP 147 : C IU=IPADL(IPT1.NUM(I,K)) 148 : C VPOCHA(IU,1)=VPOCHA(IU,1)+AM(K,I,1)*B(KK) 149 : C VPOCHA(IU,2)=VPOCHA(IU,2)+AM(K,I,1)*B(KK) 150 : C7 CONTINUE 151 : C6 CONTINUE 152 : 153 : GO TO 10 154 : 155 : 5 CONTINUE 156 : 157 : C 158 : C******************************************************************* 159 : C PARTIE NUMERIQUE 3D DANS CMP3 160 : C******************************************************************* 161 : C 162 : K0=KK 162 : CALL KMP3(AM,IZBB.VPOCHA(K0+1,1),VPOCHA, 163 : & IZIPAD.LECT,IPT1.NUM,NP,NEL,NPT) 164 : KK=K0+NEL 165 : 166 : C DO 11 K=1,NEL 167 : C KK=KK+1 168 : C DO 12 I=1,NP 169 : C IU=IPADL(IPT1.NUM(I,K)) 170 : C VPOCHA(IU,1)=VPOCHA(IU,1)+AM(K,I,1)*B(KK) 171 : C VPOCHA(IU,2)=VPOCHA(IU,2)+AM(K,I,1)*B(KK) 172 : C VPOCHA(IU,3)=VPOCHA(IU,3)+AM(K,I,1)*B(KK) 173 : C12 CONTINUE 174 : C11 CONTINUE 175 : 176 : 10 CONTINUE 177 : SEGDES IPT1 178 : SEGDES IZAFM 179 : 13 CONTINUE 180 : 181 : SEGSUP IZIPAD 182 : SEGDES MELEME 183 : SEGDES IZB,IZBB 184 : 185 : SEGDES MPOVAL 186 : SEGDES MATRAK 187 : 187 : IF(MCHPOI.NE.0)CALL ECROBJ('CHPOINT',MCHPOI) 188 : C write(6,*)' FIN KMTP ' 189 : RETURN 190 : END 191 : 192 : 193 : 194 :
© Cast3M 2003 - All rights reserved.
Disclaimer