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