1 : C DMTD SOURCE CHAT 11/03/16 21:19:19 6902 2 : SUBROUTINE DMTD 3 : C----------------------------------------------------------------------- 4 : C -1 t 5 : C Calcul du CHPOIN scalaire D M D 6 : C Somme des termes de chaque matrice elementaire pour former 7 : C un chpoin dont le support géométrique est le maillage TADOM.CENTRE 8 : C----------------------------------------------------------------------- 9 : C 10 : C--------------------------- 11 : C Phrase d'appel (GIBIANE) : 12 : C--------------------------- 13 : C 14 : C CHP1 = 'DMTD' MMODEL RIG1 ; 15 : C 16 : C------------------------ 17 : C Operandes et resultat : 18 : C------------------------ 19 : C 20 : C MMODEL : MODELE DARCY. 21 : C RIG1 : Matrices hybrides elementaires de DARCY crees par MHYB. 22 : C CHP1 : CHPO centre de composante SCAL coef par élément. 23 : C 24 : C----------------------------------------------------------------------- 25 : C 26 : C Langage : ESOPE + FORTRAN77 27 : C 28 : C 29 : C----------------------------------------------------------------------- 30 : IMPLICIT INTEGER(I-N) 31 : IMPLICIT REAL*8 (A-H,O-Z) 32 : * 33 : -INC CCOPTIO 34 : -INC SMCHPOI 35 : -INC SMELEME 36 : -INC SMRIGID 37 : -INC SMTABLE 38 : -INC SMMODEL 39 : * 40 : LOGICAL LOGRE,LOGIN 41 : CHARACTER*8 TAPIND,TYPOBJ,CHARRE,LETYPE 42 : * 43 : * Initialisations 44 : * 45 : IVALIN = 0 46 : XVALIN = 0.D0 47 : LOGIN = .TRUE. 48 : IOBIN = 0 49 : TAPIND = 'MOT ' 50 : * 51 : * 52 : * Lecture du MMODEL 53 : * 53 : CALL LIROBJ('MMODEL',IPMODE,1,IRET) 54 : IF(IERR.NE.0)RETURN 55 : MMODEL=IPMODE 56 : SEGACT MMODEL 57 : N1=KMODEL(/1) 58 : DO 7 I=1,N1 59 : IMODEL=KMODEL(I) 60 : SEGACT IMODEL 61 : IF(FORMOD(1).NE.'DARCY')THEN 62 : MOTERR(1:16) = 'DARCY ' 62 : CALL ERREUR(719) 63 : RETURN 64 : ENDIF 65 : 7 CONTINUE 66 : C 67 : C on récupère la table DOMAINE à partir du modèle 68 : C 69 : IPTABL = 0 69 : CALL LEKMOD(MMODEL,IPTABL,IRET) 70 : IF (IERR.NE.0) RETURN 71 : TYPOBJ = 'MAILLAGE' 71 : CALL LEKTAB(IPTABL,'ELTFA',IOBRE) 72 : IF (IERR.NE.0) RETURN 73 : IELTFA = IOBRE 73 : CALL LEKTAB(IPTABL,'CENTRE',IOBRE) 74 : IF (IERR.NE.0) RETURN 75 : ICENTR = IOBRE 76 : * 77 : * Lecture de RIGIDITE 78 : * 78 : CALL LIROBJ('RIGIDITE',IPRIGI,1,IRET) 79 : IF (IERR.NE.0) RETURN 80 : MRIGID = IPRIGI 81 : * 82 : * 83 : * 84 : * Test du sous-type de la matrice de rigiditée récupérée 85 : * 86 : SEGACT MRIGID 87 : LETYPE = MTYMAT 88 : IF (LETYPE.NE.'DARCY') THEN 89 : MOTERR(1:8) = 'RIGIDITE' 90 : MOTERR(9:16) = 'DARCY ' 90 : CALL ERREUR(79) 91 : SEGDES MRIGID 92 : GOTO 100 93 : ENDIF 94 : * 95 : * Controle des pointeurs de MELEME de la rigidité 96 : * 97 : NRIGEL=IRIGEL(/2) 98 : MELEME=IELTFA 99 : SEGACT MELEME 100 : NBSOUS=LISOUS(/1) 101 : IF(NBSOUS.EQ.0)THEN 102 : IF((NRIGEL.NE.1).OR.(IRIGEL(1,1).NE.MELEME))THEN 103 : MOTERR(1:8) = 'DARCY ' 104 : MOTERR(9:16) = 'ELTFA ' 105 : INTERR(1) = 1 105 : CALL ERREUR(698) 106 : SEGDES MRIGID 107 : GOTO 100 108 : ENDIF 109 : ELSE 110 : IF(NRIGEL.NE.NBSOUS)THEN 111 : MOTERR(1:8) = 'DARCY ' 112 : MOTERR(9:16) = 'ELTFA ' 113 : INTERR(1) = 1 113 : CALL ERREUR(698) 114 : SEGDES MRIGID 115 : GOTO 100 116 : ENDIF 117 : DO 10 ISOUS=1,NBSOUS 118 : IF (LISOUS(ISOUS).NE.IRIGEL(1,ISOUS)) THEN 119 : MOTERR(1:8) = 'DARCY ' 120 : MOTERR(9:16) = 'ELTFA ' 121 : INTERR(1) = ISOUS 121 : CALL ERREUR(698) 122 : SEGDES MRIGID 123 : GOTO 100 124 : ENDIF 125 : 10 CONTINUE 126 : ENDIF 127 : * 128 : * Construction de MCHPOI 129 : * 130 : * 131 : IPT1=ICENTR 132 : SEGACT IPT1 133 : NPN=IPT1.NUM(/2) 134 : NSOUPO=1 135 : NAT=1 136 : SEGINI MCHPOI 137 : MTYPOI=' ' 138 : MOCHDE=' CHPOIN CREE PAR DMTD ' 139 : IFOPOI=IFOUR 140 : JATTRI(1)=2 141 : NC=1 142 : SEGINI MSOUPO 143 : IPCHP(1)=MSOUPO 144 : NOCOMP(1)='SCAL' 145 : NOHARM(1)=0 146 : IGEOC=ICENTR 147 : N=NPN 148 : SEGINI MPOVAL 149 : IPOVAL=MPOVAL 150 : NB=N 150 : CALL INITD(VPOCHA,NB,0.D0) 151 : C 152 : C Calcul de la somme par element 153 : C 154 : ITELEM=0 155 : DO 50 ISOUS=1,NRIGEL 156 : xMATRI=IRIGEL(4,ISOUS) 157 : SEGACT xMATRI 158 : NELRIG=re(/3) 159 : DO 60 IEL=1,NELRIG 160 : ITELEM=ITELEM+1 161 : * XMATRI=IMATTT(IEL) 162 : * SEGACT XMATRI 163 : NLIGRD=RE(/1) 164 : NLIGRP=RE(/2) 165 : CONSD=0.D0 166 : DO 40 J=1,NLIGRP 167 : DO 30 I=1,NLIGRD 168 : CONSD=CONSD+RE(I,J,iel) 169 : 30 CONTINUE 170 : 40 CONTINUE 171 : VPOCHA(ITELEM,1)=CONSD 172 : * SEGDES XMATRI 173 : 60 CONTINUE 174 : SEGDES xMATRI 175 : 50 CONTINUE 176 : SEGDES MRIGID 176 : CALL ECROBJ('CHPOINT',MCHPOI) 177 : * 178 : * Ménage 179 : * 180 : SEGDES MPOVAL,MSOUPO,MCHPOI 181 : 100 CONTINUE 182 : RETURN 183 : END 184 : 185 : 186 : 187 : 188 : 189 : 190 : 191 : 192 : 193 : 194 : 195 : 196 : 197 : 198 : 199 : 200 : 201 :
© Cast3M 2003 - All rights reserved.
Disclaimer