1 : C MELDIV SOURCE MAGN 10/05/18 21:16:22 6675 2 : SUBROUTINE MELDIV(MTABD,MCHPOI,MCHELM,KPOIND) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : C*********************************************************************** 6 : C 7 : C Ce Sp crée un MCHAML a partir d'un FLOTTANT ou d'un CHPOIN 8 : C Le MCHAML en retour est jetable et est calcule aux pts d'integrations 9 : C Le support géométrique du MCHELM est compatible avec le schema 10 : C d'intégration de l'opérateur 11 : C c'est le MELEME sauf pour les MACRO (INEFMD=2) avec CENTREP0 12 : C CENTREP1 et MSOMMET où MELEME=MACRO1 13 : C---------------------------------------------------------------------- 14 : C HISTORIQUE : 20/10/01 : Création 15 : C 16 : C HISTORIQUE : 17 : C 18 : C 19 : C--------------------------- 20 : C Paramètres Entrée/Sortie : 21 : C--------------------------- 22 : C 23 : C E/ MTABD : Objet model de la zone 24 : C E/ MCHPOI : CHPOINT valeur du coef si chpoint (chpoint vecteur) 25 : C /S MCHELM : Chamelem pts d'intégration pour le COEF 26 : C E/ KPOIND : ENTIER type du support GÉométrique DUAL du shéma 27 : C d'intégration différent de KPOINC celui du coef 28 : C cette info sert à la construction du Chamelem 29 : C---------------------------------------------------------------------- 30 : C KPOIN = 0->SOMMET 1-> FACE 2-> CENTRE 3-> CENTREP0 4-> CENTREP1 5-> MSOMMET 31 : C************************************************************************ 32 : 33 : -INC SIZFFB 34 : POINTEUR IZF1.IZFFM,IZH2.IZHR,IZFD.IZFFM 35 : SEGMENT SAJT 36 : REAL*8 AJT(IDIM,IDIM,NPG) 37 : ENDSEGMENT 38 : -INC SMCHAML 39 : -INC SMCHPOI 40 : -INC SMELEME 41 : POINTEUR IGEOM.MELEME 42 : POINTEUR MELEMD.MELEME,SPGD.MELEME 43 : -INC SMLENTI 44 : -INC SMCOORD 45 : -INC CCOPTIO 46 : -INC CCGEOME 47 : CHARACTER*4 NOMD4 48 : CHARACTER*8 TYPE,NOM0 49 : DIMENSION XPOI(3) 50 : C***************************************************************************** 51 : CMELDIV 52 : c write(6,*)' DEBUT MELDIV ' 53 : XPETI=1.D-30 54 : IAXI=0 55 : IF(IFOMOD.EQ.0)IAXI=2 56 : C 56 : CALL ACME(MTABD,'INEFMD',INEFMD) 57 : 57 : CALL LEKTAB(MTABD,'MAILLAGE',MELEME) 58 : IF(INEFMD.EQ.2.AND. 59 : & (KPOIND.EQ.3.OR.KPOIND.EQ.4.OR.KPOIND.EQ.5))THEN 59 : CALL LEKTAB(MTABD,'MACRO1',MELEME) 60 : ENDIF 61 : 62 : SEGACT MELEME 63 : 64 : L1=72 65 : N1=MAX(1,LISOUS(/1)) 66 : N2=1 67 : N3=6 68 : SEGINI MCHELM 69 : 70 : C------------------------------------------------------------------------- 71 : C__CHPOINT 72 : SEGACT MCHPOI 73 : NSOUPO=IPCHP(/1) 74 : 75 : IF(NSOUPO.EQ.1) THEN 76 : MSOUPO=IPCHP(1) 77 : SEGACT MSOUPO 78 : IGEOM=IGEOC 79 : MPOVAL=IPOVAL 80 : SEGDES MSOUPO 81 : SEGACT MPOVAL 82 : NC=VPOCHA(/2) 83 : IF(NC.NE.IDIM)THEN 83 : CALL ERREUR(788) 84 : RETURN 85 : ENDIF 86 : ELSE 86 : CALL ERREUR(788) 87 : RETURN 88 : ENDIF 89 : 90 : c write(6,*)' IGEOM=',IGEOM 90 : CALL KRIPAD(IGEOM,MLENTI) 91 : 92 : KPOINC=0 93 : NOMD4= ' ' 93 : CALL LEKTAB(MTABD,'MAILLAGE',MELEMD) 93 : CALL LEKTAB(MTABD,'SOMMET',SPGD) 93 : CALL VERPAD(MLENTI,SPGD,IRET) 94 : c write(6,*)' SOMMET (0 OK) ',SPGD,iret 95 : SEGDES SPGD 96 : IF(IRET.EQ.0)GO TO 180 97 : KPOINC=2 98 : NOMD4= ' ' 98 : CALL LEKTAB(MTABD,'CENTRE',MELEMD) 98 : CALL LEKTAB(MTABD,'CENTRE',SPGD) 98 : CALL VERPAD(MLENTI,SPGD,IRET) 99 : c write(6,*)' CENTRE (0 OK) ',SPGD,iret 100 : SEGDES SPGD 101 : IF(INEFMD.EQ.3)THEN 102 : KPOINC=3 103 : NOMD4= 'PRP0' 104 : ENDIF 105 : IF(IRET.EQ.0)GO TO 180 106 : KPOINC=5 107 : NOMD4= 'P1P1' 108 : IF(INEFMD.EQ.2)NOMD4= 'MCF1' 109 : IF(INEFMD.EQ.3)NOMD4= 'PFP1' 109 : CALL LEKTAB(MTABD,'MMAIL ',MELEMD) 109 : CALL LEKTAB(MTABD,'MSOMMET',SPGD) 109 : CALL VERPAD(MLENTI,SPGD,IRET) 110 : c write(6,*)'MSOMMET (0 OK) ',SPGD,iret 111 : SEGDES SPGD 112 : IF(IRET.EQ.0)GO TO 180 113 : IF(INEFMD.EQ.2.OR.INEFMD.EQ.3)THEN 114 : KPOINC=4 115 : NOMD4= ' ' 116 : IF(INEFMD.EQ.2)NOMD4= 'MCP1' 117 : IF(INEFMD.EQ.3)NOMD4= 'PRP1' 117 : CALL LEKTAB(MTABD,'ELTP1NC ',MELEMD) 117 : CALL LEKTAB(MTABD,'CENTREP1',SPGD) 117 : CALL VERPAD(MLENTI,SPGD,IRET) 118 : c write(6,*)'CENTREP1 (0 OK) ',SPGD,iret 119 : SEGDES SPGD 120 : IF(IRET.EQ.0)GO TO 180 121 : KPOINC=3 122 : NOMD4= ' ' 123 : IF(INEFMD.EQ.2)NOMD4= 'MCP0' 124 : IF(INEFMD.EQ.3)NOMD4= 'PRP0' 124 : CALL LEKTAB(MTABD,'CENTREP0',MELEMD) 124 : CALL LEKTAB(MTABD,'CENTREP0',SPGD) 124 : CALL VERPAD(MLENTI,SPGD,IRET) 125 : SEGDES SPGD 126 : IF(IRET.EQ.0)GO TO 180 127 : ENDIF 128 : 129 : C__CHPOINT_SUPPORT_INCONU 130 : C Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique 131 : MOTERR(1: 8) = 'CHPOINT ' 132 : MOTERR(9:16) = ' COEF ' 132 : CALL ERREUR(788) 133 : RETURN 134 : 180 CONTINUE 135 : SEGDES IGEOM 136 : C__CHPOINT 137 : c write(6,*)' CAs CHPOIN ' 138 : 139 : SEGACT MELEMD 140 : 141 : NKD=0 142 : DO 191 L=1,MAX(1,LISOUS(/1)) 143 : IPT1=MELEME 144 : IPT2=MELEMD 145 : IF(LISOUS(/1).NE.0)IPT1=LISOUS(L) 146 : SEGACT IPT1 147 : IF(MELEMD.LISOUS(/1).NE.0)IPT2=MELEMD.LISOUS(L) 148 : SEGACT IPT2 149 : IF(MELEMD.LISOUS(/1).NE.0)NKD=0 150 : MP=IPT2.NUM(/1) 151 : 152 : NOM0 = NOMS(IPT1.ITYPEL)//NOMD4 152 : CALL KALPBG(NOM0,'FONFORM ',IZFFM) 153 : SEGACT IZFFM 154 : IZHR=KZHR(1) 155 : IZF1=KTP(1) 156 : IZH2=KZHR(2) 157 : SEGACT IZHR*MOD 158 : 159 : IZFD=IZF1 160 : IF(KPOINC.EQ.0)IZFD=IZFFM 161 : SEGACT IZFD*MOD 162 : IF(MP.NE.IZFD.FN(/1))THEN 163 : write(6,*)' Gross problem ' 164 : write(6,*)' INEFMD=',INEFMD,' NOMD4=',NOMD4 165 : write(6,*)' MP=',MP,' KPOINC.=',KPOINC,' IZFD.FN(/1)=' 166 : & ,IZFD.FN(/1) 167 : ENDIF 168 : 169 : 170 : NES=GR(/1) 171 : NPG=GR(/3) 172 : 173 : NBNN =IPT1.NUM(/1) 174 : NBELEM=IPT1.NUM(/2) 175 : SEGINI MCHAML 176 : 177 : IDU=IDIM 178 : SEGINI SAJT 179 : N1PTEL=NPG*IDU 180 : N1EL =NBELEM 181 : N2PTEL=0 182 : N2EL=0 183 : IMACHE(L)=IPT1 184 : ICHAML(L)=MCHAML 185 : 186 : SEGINI MELVAL 187 : IELVAL(1)=MELVAL 188 : 189 : c write(6,*)' Avt BCL 192 ',N1EL,nbnn,N1PTEL 190 : DO 192 K=1,N1EL 191 : 192 : DO 109 J=1,NBNN 193 : J1=IPT1.NUM(J,K) 194 : DO 109 N=1,IDIM 195 : XYZ(N,J)=XCOOR((J1-1)*(IDIM+1)+N) 196 : 109 CONTINUE 197 : 197 : CALL CALJBR(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES, 198 : & IDIM,NBNN,NPG,IAXI,AIRE,AJ,SGN) 199 : 200 : NKD=NKD+1 201 : 202 : DO 194 LG=1,NPG 203 : U=0.D0 204 : DO 193 N=1,IDIM 205 : DO 193 I=1,MP 206 : I1=LECT(IPT2.NUM(I,NKD)) 207 : c U=U+IZFD.FN(I,LG)*VPOCHA(I1,N) 208 : U=U+HR(N,I,LG)*VPOCHA(I1,N) 209 : 193 CONTINUE 210 : VELCHE(LG,K)=U 211 : 194 CONTINUE 212 : 213 : IF(IAXI.NE.0)THEN 214 : DO 196 LG=1,NPG 215 : U=0.D0 216 : DO 195 I=1,MP 217 : I1=LECT(IPT2.NUM(I,NKD)) 218 : U=U+FN(I,LG)*VPOCHA(I1,1)/RPG(LG) 219 : 195 CONTINUE 220 : VELCHE(LG,K)=VELCHE(LG,K)+U 221 : 196 CONTINUE 222 : ENDIF 223 : 224 : 192 CONTINUE 225 : 226 : 227 : SEGDES MELVAL 228 : SEGDES IPT1,MCHAML 229 : SEGSUP IZFFM,IZHR,IZF1,IZH2,SAJT 230 : 191 CONTINUE 231 : SEGDES MCHPOI,MSOUPO,MPOVAL 232 : SEGDES MCHELM,MELEME 233 : 234 : SEGSUP MLENTI 235 : 236 : 237 : 238 : C************************************************************************* 239 : 240 : c write(6,*)' FIN MELDIV ' 241 : RETURN 242 : 1001 FORMAT(20(1X,I5)) 243 : 1002 FORMAT(10(1X,1PE11.4)) 244 : END 245 : 246 : 247 : 248 : 249 : 250 : 251 : 252 : 253 :
© Cast3M 2003 - All rights reserved.
Disclaimer