1 : C KMF SOURCE CHAT 05/01/13 00:57:24 5004 2 : SUBROUTINE KMF 3 : C *********************************************************************** 4 : C 5 : C Objet : Cet operateur calcule soit C*U 6 : C soit C*1/D * U 7 : C 8 : C Syntaxe : 9 : C CAS 1 / 10 : C 11 : C B = KMF MATRAK MCHPOI ; 12 : C 13 : C 14 : C CAS 2 / 15 : C 16 : C B = KMF MATRAK MCHPOI 'MDM1' CHPOIMDM1 ; 17 : C ou 18 : C KMF MATRAK MCHPOI 'MDM1' CHPOIMDM1 B ; 19 : C 20 : C Dans ce dernier cas KMF agit comme foncteur sur B 21 : C 22 : C 23 : C 24 : C 25 : C POINTEURS : 26 : C 27 : C MATRAK MATRICES ELEMENTAIRES DE LA DIVERGENCE (ALIAS "C") 28 : C IZTUN CHPOINT CONTENANT U 29 : C 30 : C EN SORTIE : 31 : C 32 : C IZB CONTIENT C*U 33 : C 34 : C *********************************************************************** 35 : IMPLICIT INTEGER(I-N) 36 : IMPLICIT REAL*8 (A-H,O-Z) 37 : CHARACTER*8 TYPE,TYPC 38 : -INC CCOPTIO 39 : -INC SMELEME 40 : -INC SMLENTI 41 : POINTEUR IZIPAD.MLENTI 42 : C-INC SMMATRAK 43 : C************************************************************************* 44 : C 45 : C REPERAGE ET STOKAGE DES MATRICES ELEMENTAIRES puis assemblees 46 : C 47 : 48 : * LGEOC SPG de la pression et/ou des multiplicateurs de Lagrange 49 : * (points CENTRE ) pour chaque operateur de contrainte 50 : * KGEOC SPG pour la totalite des points CENTRE. 51 : * KGEOS SPG pour la totalite des points SOMMET (Diagonale vitesse) 52 : * KLEMC Connectivites de l'ensemble des contraintes 53 : * LIZAFM(NBSOUS) contient les pointeurs IZAFM des sous-zones 54 : 55 : SEGMENT MATRAK 56 : INTEGER LGEOC(NBOP),IDEBS(NBOP),IFINS(NBOP) 57 : INTEGER LIZAFM(NBSOUS) 58 : INTEGER IKAM0 (NBSOUS) 59 : INTEGER IMEM (NBELC) 60 : INTEGER KLEMC,KGEOS,KGEOC,KDIAG,KCAC,KIZCL,KIZGC 61 : ENDSEGMENT 62 : 63 : SEGMENT IZAFM 64 : REAL*8 AM(NNELP,NP,IESP),RPGI(NELAX) 65 : ENDSEGMENT 66 : 67 : POINTEUR IPMJ.IZAFM,IPMK.IZAFM 68 : 69 : C******************************************************************* 70 : -INC SMCHPOI 71 : POINTEUR IZB.MCHPOI,IZBB.MPOVAL 72 : POINTEUR IZD.MCHPOI,IZDD.MPOVAL 73 : CHARACTER*4 LISMOT(1) 74 : DATA LISMOT/'MDM1'/ 75 : C**** 76 : 77 : C LECTURE DES ARGUMENTS 78 : 78 : CALL QUETYP(TYPE,1,IRET) 79 : IF(IRET.EQ.0) RETURN 80 : 81 : IF(TYPE.EQ.'MATRIK')THEN 81 : CALL KMFN 82 : RETURN 83 : ELSEIF(TYPE.EQ.'MATRAK')THEN 83 : CALL LIROBJ('MATRAK',MATRAK,1,IRET) 84 : 84 : CALL LIROBJ('CHPOINT',MCHPOI,1,IRET) 85 : IF(IRET.EQ.0) RETURN 86 : 86 : CALL LIRMOT(LISMOT,1,IMDM1,0) 87 : 88 : IF(IMDM1.NE.0)THEN 88 : CALL LIROBJ('CHPOINT',IZD,1,IRET) 89 : IF(IRET.EQ.0) RETURN 89 : CALL LICHT(IZD,IZDD,TYPC,IGEOM) 90 : ENDIF 91 : 92 : SEGACT MATRAK 93 : MELEME=KLEMC 94 : MELEM1=KGEOS 94 : CALL KRIPAD(MELEM1,IZIPAD) 95 : IGEOMC=KGEOC 96 : TYPE='CENTRE' 97 : 98 : 99 : IF(IMDM1.EQ.0)THEN 99 : CALL CRCHPT(TYPE,IGEOMC,1,IZB) 99 : CALL LICHT(IZB,IZBB,TYPC,IGEOM) 100 : 101 : ELSE 101 : CALL LIROBJ('CHPOINT',IZB,0,IRET) 102 : 103 : IEB=1 104 : IF(IRET.EQ.0) THEN 105 : IEB=0 105 : CALL CRCHPT(TYPE,IGEOMC,1,IZB) 106 : ENDIF 107 : 107 : CALL LICHT(IZB,IZBB,TYPC,IGEOM) 108 : IF(IGEOM.NE.IGEOMC)THEN 109 : WRITE(6,*)' Le champ de contraintes n a pas le meme support' 110 : &,' geometrique que les matrices de contrainte ' 111 : RETURN 112 : ENDIF 113 : ENDIF 114 : 115 : 115 : CALL LICHT(MCHPOI,MPOVAL,TYPC,IGEOU) 116 : N=VPOCHA(/1) 117 : 118 : SEGACT MELEME 119 : NBSOUS=LISOUS(/1) 120 : IF(NBSOUS.EQ.0)NBSOUS=1 121 : KK=0 122 : DO 15 KS=1,NBSOUS 123 : IF(NBSOUS.EQ.1)IPT1=MELEME 124 : IF(NBSOUS.NE.1)IPT1=LISOUS(KS) 125 : IZAFM=LIZAFM(KS) 126 : SEGACT IPT1,IZAFM 127 : 128 : NP=IPT1.NUM(/1) 129 : NEL=IPT1.NUM(/2) 130 : IF(IDIM.EQ.3)GO TO 5 131 : C 132 : C 2D 133 : C 134 : 135 : K0=KK 136 : IF(IMDM1.NE.0)THEN 136 : CALL KRA002(AM,VPOCHA,IZDD.VPOCHA,IZBB.VPOCHA(K0+1,1), 137 : & IPT1.NUM,IZIPAD.LECT,NP,NEL,N) 138 : ELSE 138 : CALL KMF2(AM,VPOCHA,IZBB.VPOCHA(K0+1,1), 139 : & IPT1.NUM,IZIPAD.LECT,NP,NEL,N) 140 : ENDIF 141 : KK=K0+NEL 142 : 143 : GO TO 10 144 : 145 : 5 CONTINUE 146 : C 147 : C 3D 148 : C 149 : K0=KK 150 : IF(IMDM1.NE.0)THEN 150 : CALL KRA003(AM,VPOCHA,IZDD.VPOCHA,IZBB.VPOCHA(K0+1,1), 151 : & IPT1.NUM,IZIPAD.LECT,NP,NEL,N) 152 : ELSE 152 : CALL KMF3(AM,VPOCHA,IZBB.VPOCHA(K0+1,1), 153 : & IPT1.NUM,IZIPAD.LECT,NP,NEL,N) 154 : ENDIF 155 : KK=K0+NEL 156 : 157 : 10 CONTINUE 158 : IF(MELEME.NE.IPT1)SEGDES IPT1 159 : SEGDES IZAFM 160 : 15 CONTINUE 161 : 162 : SEGSUP IZIPAD 163 : SEGDES MELEME 164 : SEGDES MATRAK 165 : SEGACT MCHPOI 166 : MSOUPO=IPCHP(1) 167 : SEGDES MPOVAL 168 : SEGDES MSOUPO 169 : SEGDES MCHPOI 170 : SEGDES IZB,IZBB 171 : IF(IMDM1.NE.0)THEN 172 : SEGDES IZD,IZDD 173 : ENDIF 174 : 174 : IF(IMDM1.EQ.0.OR.IEB.EQ.0)CALL ECROBJ('CHPOINT ',IZB) 175 : ELSE 176 : RETURN 177 : ENDIF 178 : 179 : RETURN 180 : END 181 : 182 : 183 :
© Cast3M 2003 - All rights reserved.
Disclaimer