1 : C RELR20 SOURCE GOUNAND 11/05/24 21:16:04 6976 2 : SUBROUTINE RELR20(MATASS, 3 : $ MCON, 4 : $ IMPR,IRET) 5 : IMPLICIT REAL*8 (A-H,O-Z) 6 : IMPLICIT INTEGER (I-N) 7 : C*********************************************************************** 8 : C NOM : RELR20 9 : C DESCRIPTION : 10 : * 11 : * Création d'une matrice de contraintes 12 : * 13 : C 14 : C 15 : C 16 : C LANGAGE : ESOPE 17 : C AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF) 18 : C mél : gounand@semt2.smts.cea.fr 19 : C*********************************************************************** 20 : C APPELES : 21 : C APPELES (E/S) : 22 : C APPELES (BLAS) : 23 : C APPELES (CALCUL) : 24 : C APPELE PAR : 25 : C*********************************************************************** 26 : C SYNTAXE GIBIANE : 27 : C ENTREES : 28 : C ENTREES/SORTIES : 29 : C SORTIES : 30 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé 31 : C*********************************************************************** 32 : C VERSION : v1, 02/07/2003, version initiale 33 : C HISTORIQUE : v1, 02/07/2003, création 34 : C HISTORIQUE : 35 : C HISTORIQUE : 36 : C*********************************************************************** 37 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 38 : C en cas de modification de ce sous-programme afin de faciliter 39 : C la maintenance ! 40 : C*********************************************************************** 41 : -INC CCOPTIO 42 : -INC SMCOORD 43 : -INC CCHAMP 44 : -INC SMRIGID 45 : POINTEUR MCON.MRIGID 46 : POINTEUR DESCON.DESCR 47 : * POINTEUR ICON.IMATRI 48 : POINTEUR XCON.XMATRI 49 : -INC SMELEME 50 : POINTEUR MEL.MELEME 51 : * Includes persos 52 : CBEGININCLUDE SMMINC 53 : SEGMENT MINC 54 : INTEGER NPOS(NPT+1) 55 : INTEGER MPOS(NPT,NBI+1) 56 : ENDSEGMENT 57 : SEGMENT IMINC 58 : INTEGER LNUPO (NDDL) 59 : INTEGER LNUINC(NDDL) 60 : ENDSEGMENT 61 : CENDINCLUDE SMMINC 62 : POINTEUR MINCP.MINC 63 : POINTEUR MINCD.MINC 64 : POINTEUR IMINCP.IMINC 65 : POINTEUR IMINCD.IMINC 66 : CBEGININCLUDE SMPMORS 67 : SEGMENT PMORS 68 : INTEGER IA (NTT+1) 69 : INTEGER JA (NJA) 70 : ENDSEGMENT 71 : CENDINCLUDE SMPMORS 72 : POINTEUR PROFM.PMORS 73 : CBEGININCLUDE SMIZA 74 : SEGMENT IZA 75 : REAL*8 A(NBVA) 76 : ENDSEGMENT 77 : CENDINCLUDE SMIZA 78 : POINTEUR VALM.IZA 79 : CBEGININCLUDE SMMATASS 80 : SEGMENT MATASS 81 : POINTEUR KJPOPA.MLENTI 82 : POINTEUR LINCPA.MLMOTS 83 : POINTEUR MINCPA.MINC 84 : POINTEUR KJPODA.MLENTI 85 : POINTEUR LINCDA.MLMOTS 86 : POINTEUR MINCDA.MINC 87 : POINTEUR PROFMA.PMORS 88 : POINTEUR VALMA.IZA 89 : ENDSEGMENT 90 : CENDINCLUDE SMMATASS 91 : * 92 : -INC SMLENTI 93 : POINTEUR KJSPGP.MLENTI 94 : POINTEUR KJSPGD.MLENTI 95 : POINTEUR KLSPGP.MLENTI 96 : POINTEUR KKSPGP.MLENTI 97 : -INC SMLMOTS 98 : POINTEUR LINCP.MLMOTS 99 : POINTEUR LINCD.MLMOTS 100 : * 101 : INTEGER IMPR,IRET 102 : CHARACTER*4 MYMOP,MYMOD 103 : * 104 : * Executable statements 105 : * 106 : IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans relr20.eso' 107 : * 108 : * Lecture de MATASS 109 : * 110 : SEGACT MATASS 111 : KJSPGP=MATASS.KJPOPA 112 : LINCP =MATASS.LINCPA 113 : MINCP =MATASS.MINCPA 114 : KJSPGD=MATASS.KJPODA 115 : LINCD =MATASS.LINCDA 116 : MINCD =MATASS.MINCDA 117 : PROFM =MATASS.PROFMA 118 : VALM =MATASS.VALMA 119 : * 120 : * Création de l'inverse des segments MINC 121 : * et suppression de ces derniers 122 : * 123 : * In relr21 : SEGINI IMINCP 123 : CALL RELR21(MINCP,IMINCP,IMPR,IRET) 124 : IF (IRET.NE.0) GOTO 9999 125 : * In relr21 : SEGINI IMINCD 125 : CALL RELR21(MINCD,IMINCD,IMPR,IRET) 126 : IF (IRET.NE.0) GOTO 9999 127 : * SEGPRT,IMINCP 128 : * SEGPRT,IMINCD 129 : SEGSUP MINCP 130 : SEGSUP MINCD 131 : * SEGDES MCOORD 132 : SEGACT MCOORD*MOD 133 : SEGACT KJSPGP 134 : SEGACT LINCP 135 : SEGACT IMINCP 136 : SEGACT KJSPGD 137 : SEGACT LINCD 138 : SEGACT IMINCD 139 : SEGACT PROFM 140 : SEGACT VALM 141 : NDDLDU=IMINCD.LNUPO(/1) 142 : NPOPRI=KJSPGP.LECT(/1) 143 : * Il y a autant de rigidités à créer que de degrés de liberté duaux 144 : NRIGE=7 145 : NRIGEL=NDDLDU 146 : SEGINI MCON 147 : MCON.MTYMAT='CON.DIV.' 148 : JG=NPOPRI 149 : SEGINI KLSPGP 150 : * Ensemble des numéros de points primaux 151 : DO IDDLDU=1,NDDLDU 152 : MCON.COERIG(IDDLDU)=1.D0 153 : INZ=PROFM.IA(IDDLDU) 154 : LNZ=PROFM.IA(IDDLDU+1)-INZ 155 : * 156 : * Création de la géométrie pour la iddldueme matrice 157 : * 158 : * Quels points de KJSPGP sont concernés par les 159 : * ddls INZ à INZ+LNZ-1. 160 : * degré et fin de la liste chaînée 161 : LDG=0 162 : LAST=-1 163 : DO JNZ=1,LNZ 164 : NUMPP=IMINCP.LNUPO(PROFM.JA(INZ+JNZ-1)) 165 : IF (KLSPGP.LECT(NUMPP).EQ.0) THEN 166 : LDG=LDG+1 167 : KLSPGP.LECT(NUMPP)=LAST 168 : LAST=NUMPP 169 : ENDIF 170 : ENDDO 171 : * remplissage de KKSPGP 172 : * KLSPGP sert maintenant de repérage dans KKSPGP 173 : * (ouh la la quelle prise de risque !) 174 : JG=LDG 175 : SEGINI KKSPGP 176 : DO ILDG=1,LDG 177 : IPREC=KLSPGP.LECT(LAST) 178 : KKSPGP.LECT(ILDG)=LAST 179 : KLSPGP.LECT(LAST)=ILDG 180 : * KLSPGP.LECT(LAST)=0 181 : LAST=IPREC 182 : ENDDO 183 : * géométrie 184 : NBNN=LDG+2 185 : NBELEM=1 186 : NBSOUS=0 187 : NBREF=0 188 : SEGINI MEL 189 : MEL.ITYPEL=22 190 : * le premier point correspond à celui de IDDLDU 191 : NUPODU=KJSPGD.LECT(IMINCD.LNUPO(IDDLDU)) 192 : *! MEL.NUM(1,1)=NUPODU 193 : *! on crée deux ! nouveaux points 194 : * on crée un nouveau point de mêmes coordonnées 195 : * support du multiplicateur de Lagrange 196 : * NBPTOT=XCOOR(/1)/(IDIM+1) 197 : * NBPTS=NBPTOT+1 198 : * SEGADJ MCOORD 199 : * DO IIDIM=1,IDIM 200 : * XCOOR((NBPTS-1)*(IDIM+1) + IIDIM)= 201 : * $ XCOOR((NUPODU-1)*(IDIM+1) + IIDIM) 202 : * ENDDO 203 : * MEL.NUM(2,1)=NBPTS 204 : NBPTOT=XCOOR(/1)/(IDIM+1) 205 : NBPTS=NBPTOT+2 206 : SEGADJ MCOORD 207 : DO IIDIM=1,IDIM 208 : XCOOR((NBPTS-1)*(IDIM+1) + IIDIM)= 209 : $ XCOOR((NUPODU-1)*(IDIM+1) + IIDIM) 210 : XCOOR((NBPTS-2)*(IDIM+1) + IIDIM)= 211 : $ XCOOR((NUPODU-1)*(IDIM+1) + IIDIM) 212 : ENDDO 213 : MEL.NUM(1,1)=NBPTS-1 214 : MEL.NUM(2,1)=NBPTS 215 : * les points suivants correspondent à ceux de KKSPGP 216 : DO ILDG=1,LDG 217 : MEL.NUM(2+ILDG,1)=KJSPGP.LECT(KKSPGP.LECT(ILDG)) 218 : ENDDO 219 : SEGDES MEL 220 : MCON.IRIGEL(1,IDDLDU)=MEL 221 : * 222 : * Création du segment descripteur pour la iddldueme matrice 223 : * 224 : NLIGRP=2+LNZ 225 : NLIGRD=2+LNZ 226 : SEGINI DESCON 227 : * Les deux premiers indices 228 : DESCON.NOELEP(1)=1 229 : DESCON.NOELED(1)=1 230 : MYMOD=LINCD.MOTS(IMINCD.LNUINC(IDDLDU)) 230 : CALL FICH4(MYMOD,NOMDU,LNOMDU, 231 : $ INOMDU, 232 : $ IMPR,IRET) 233 : IF (IRET.NE.0) GOTO 9999 234 : DESCON.LISINC(1)=NOMDD(INOMDU) 235 : DESCON.LISDUA(1)=MYMOD 236 : DESCON.NOELEP(2)=2 237 : DESCON.NOELED(2)=2 238 : DESCON.LISINC(2)=NOMDD(INOMDU) 239 : DESCON.LISDUA(2)=MYMOD 240 : * Les indices suivants 241 : DO JNZ=1,LNZ 242 : NUIPP=IMINCP.LNUINC(PROFM.JA(INZ+JNZ-1)) 243 : MYMOP=LINCP.MOTS(NUIPP) 243 : CALL FICH4(MYMOP,NOMDD,LNOMDD, 244 : $ INOMDD, 245 : $ IMPR,IRET) 246 : IF (IRET.NE.0) GOTO 9999 247 : DESCON.LISINC(2+JNZ)=MYMOP 248 : DESCON.LISDUA(2+JNZ)=NOMDU(INOMDD) 249 : NUMPP=IMINCP.LNUPO(PROFM.JA(INZ+JNZ-1)) 250 : NUMP2=KLSPGP.LECT(NUMPP) 251 : IF (NUMP2.EQ.0) THEN 252 : WRITE(IOIMP,*) 'Erreur grave no1' 253 : GOTO 9999 254 : ENDIF 255 : DESCON.NOELEP(2+JNZ)=2+NUMP2 256 : DESCON.NOELED(2+JNZ)=2+NUMP2 257 : ENDDO 258 : SEGDES DESCON 259 : MCON.IRIGEL(3,IDDLDU)=DESCON 260 : * remise à zéro de KLSPGP et suppression de KKSPGP 261 : DO ILDG=1,LDG 262 : KLSPGP.LECT(KKSPGP.LECT(ILDG))=0 263 : ENDDO 264 : SEGSUP KKSPGP 265 : * 266 : * Création de la matrice élémentaire 267 : * 268 : NELRIG=1 269 : * SEGINI ICON 270 : NLIGRP=2+LNZ 271 : NLIGRD=2+LNZ 272 : SEGINI XCON 273 : * Les deux premiers indices 274 : XCON.RE(1,1,1)=-1.D0 275 : XCON.RE(1,2,1)= 1.D0 276 : XCON.RE(2,1,1)= 1.D0 277 : XCON.RE(2,2,1)=-1.D0 278 : * Les indices suivants 279 : DO JNZ=1,LNZ 280 : VAL=VALM.A(INZ+JNZ-1) 281 : XCON.RE(1,2+JNZ)=VAL 282 : XCON.RE(2,2+JNZ)=VAL 283 : XCON.RE(2+JNZ,1)=VAL 284 : XCON.RE(2+JNZ,2)=VAL 285 : ENDDO 286 : SEGDES XCON 287 : * ICON.IMATTT(1)=XCON 288 : * SEGDES ICON 289 : * MCON.IRIGEL(4,IDDLDU)=ICON 290 : MCON.IRIGEL(4,IDDLDU)=XCON 291 : MCON.IRIGEL(5,IDDLDU)=0 292 : MCON.IRIGEL(6,IDDLDU)=0 293 : MCON.IRIGEL(7,IDDLDU)=0 294 : ENDDO 295 : SEGSUP KLSPGP 296 : SEGDES MCON 297 : * Suppression de tous les objets de MATASS 298 : SEGSUP VALM 299 : SEGSUP PROFM 300 : SEGSUP IMINCD 301 : SEGSUP LINCD 302 : SEGSUP KJSPGD 303 : SEGSUP IMINCP 304 : SEGSUP LINCP 305 : SEGSUP KJSPGP 306 : * SEGDES MCOORD 307 : SEGACT MCOORD 308 : SEGSUP MATASS 309 : * 310 : * Normal termination 311 : * 312 : IRET=0 313 : RETURN 314 : * 315 : * Format handling 316 : * 317 : * 318 : * Error handling 319 : * 320 : 9999 CONTINUE 321 : IRET=1 322 : WRITE(IOIMP,*) 'An error was detected in subroutine relr20' 323 : RETURN 324 : * 325 : * End of subroutine RELR20 326 : * 327 : END 328 : 329 :
© Cast3M 2003 - All rights reserved.
Disclaimer