1 : C CV2MAB SOURCE GOUNAND 09/09/03 21:15:10 6481 2 : SUBROUTINE CV2MAB(MDISCP,NCVARP,MDISCD,NCVARD, 3 : $ IMTLSB, 4 : $ MYFALS, 5 : $ MATLSB, 6 : $ IMPR,IRET) 7 : IMPLICIT REAL*8 (A-H,O-Z) 8 : IMPLICIT INTEGER (I-N) 9 : C*********************************************************************** 10 : C NOM : CV2MAB 11 : C DESCRIPTION : Transforme un MCHAEL (mon champ par éléments) 12 : C représentant un ensemble de matrices élémentaires en 13 : C MATRIK... 14 : C 15 : C LANGAGE : ESOPE 16 : C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) 17 : C mél : gounand@semt2.smts.cea.fr 18 : C*********************************************************************** 19 : C APPELES : KEEF (recherche de l'élément fini) 20 : C APPELES (E/S) : ECROBJ, PRLIST (écriture entier, objet, 21 : C impression) 22 : C APPELE PAR : PRLSB2 23 : C*********************************************************************** 24 : C ENTREES : 25 : C ENTREES/SORTIES : - 26 : C SORTIES : 27 : C TRAVAIL : * MYMEL (type MELEME) : maillage élémentaire. 28 : C * JMTLSB (type MCHEVA) : valeurs du champ IMTLSB 29 : C sur le maillage élémentaire. 30 : C Structure (cf.include SMCHAEL) : 31 : C (nb. ddl dual, nb. ddl primal, 32 : C nb. comp. duales, nb. comp. primales, 33 : C 1, nb. éléments) 34 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé 35 : C*********************************************************************** 36 : C VERSION : v1, 22/07/09, version initiale 37 : C HISTORIQUE : v1, 22/07/09, création 38 : C HISTORIQUE : 39 : C HISTORIQUE : 40 : C*********************************************************************** 41 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 42 : C en cas de modification de ce sous-programme afin de faciliter 43 : C la maintenance ! 44 : C*********************************************************************** 45 : -INC CCOPTIO 46 : -INC SMLMOTS 47 : POINTEUR NCVARP.MLMOTS 48 : POINTEUR NCVARD.MLMOTS 49 : -INC SMELEME 50 : POINTEUR MELPRI.MELEME 51 : POINTEUR MELDUA.MELEME 52 : POINTEUR MYMEL.MELEME 53 : INTEGER NBNN,NBELEM,NBSOUS,NBREF 54 : -INC SMLENTI 55 : POINTEUR LPOQFP.MLENTI 56 : POINTEUR LPOQFD.MLENTI 57 : POINTEUR KPOQFP.MLENTI 58 : POINTEUR KPOQFD.MLENTI 59 : INTEGER JG 60 : -INC SMMATRIK 61 : POINTEUR MATLSB.MATRIK 62 : * 63 : * Includes persos 64 : * 65 : CBEGININCLUDE SMCHAEL 66 : SEGMENT MCHAEL 67 : POINTEUR IMACHE(N1).MELEME 68 : POINTEUR ICHEVA(N1).MCHEVA 69 : ENDSEGMENT 70 : SEGMENT MCHEVA 71 : REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM) 72 : ENDSEGMENT 73 : SEGMENT LCHEVA 74 : POINTEUR LISCHE(NBCHE).MCHEVA 75 : ENDSEGMENT 76 : CENDINCLUDE SMCHAEL 77 : POINTEUR IMTLSB.MCHAEL 78 : POINTEUR JMTLSB.MCHEVA 79 : INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM 80 : CBEGININCLUDE SFALRF 81 : SEGMENT FALRF 82 : CHARACTER*(LNNFA) NOMFA 83 : INTEGER NUQUAF(NBLRF) 84 : POINTEUR ELEMF(NBLRF).ELREF 85 : ENDSEGMENT 86 : SEGMENT FALRFS 87 : POINTEUR LISFA(0).FALRF 88 : ENDSEGMENT 89 : CENDINCLUDE SFALRF 90 : POINTEUR MYFALS.FALRFS 91 : CBEGININCLUDE SELREF 92 : SEGMENT ELREF 93 : CHARACTER*(LNNOM) NOMLRF 94 : CHARACTER*(LNFORM) FORME 95 : CHARACTER*(LNTYPL) TYPEL 96 : CHARACTER*(LNESP) ESPACE 97 : INTEGER DEGRE 98 : REAL*8 XCONOD(NDIMEL,NBNOD) 99 : INTEGER NPQUAF(NBDDL) 100 : INTEGER NUMCMP(NBDDL) 101 : INTEGER QUENOD(NBDDL) 102 : INTEGER ORDDER(NDIMEL,NBDDL) 103 : POINTEUR MBPOLY.POLYNS 104 : ENDSEGMENT 105 : SEGMENT ELREFS 106 : POINTEUR LISEL(0).ELREF 107 : ENDSEGMENT 108 : CENDINCLUDE SELREF 109 : POINTEUR LRFPRI.ELREF 110 : POINTEUR LRFDUA.ELREF 111 : * 112 : CHARACTER*4 MDISCP,MDISCD 113 : INTEGER IMPR,IRET 114 : * 115 : INTEGER IBNN,IBELEM 116 : INTEGER ITQUAF,NDDLPR,NDDLDU 117 : INTEGER IDDLPR,IDDLDU 118 : INTEGER NSOUS,NPOQUF 119 : INTEGER ISOUS 120 : INTEGER ILIGRP,ILIGRD,IELRIG,ICMPP,ICMPD 121 : 122 : * 123 : * Executable statements 124 : * 125 : IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans cv2mab' 126 : NRIGE=7 127 : NMATRI=0 128 : NKID=9 129 : NKMT=7 130 : SEGINI,MATLSB 131 : * 132 : * Remplissage de MRIGID 133 : * 134 : SEGACT NCVARP 135 : SEGACT NCVARD 136 : SEGACT IMTLSB 137 : NSOUS=IMTLSB.IMACHE(/1) 138 : C SEGPRT,NCVARP 139 : C SEGPRT,NCVARD 140 : C SEGPRT,IMTLSB 141 : DO ISOUS=1,NSOUS 142 : JMTLSB=IMTLSB.ICHEVA(ISOUS) 143 : IF (JMTLSB.NE.0) THEN 144 : C SEGPRT,NCVARP 145 : C SEGPRT,NCVARD 146 : C SEGPRT,JMTLSB 147 : SEGACT JMTLSB 148 : MYMEL =IMTLSB.IMACHE(ISOUS) 149 : SEGACT MYMEL 150 : ITQUAF=MYMEL.ITYPEL 150 : CALL KEEF(ITQUAF,MDISCP,MYFALS, 151 : $ LRFPRI,IMPR,IRET) 152 : IF (IRET.NE.0) GOTO 9999 153 : SEGACT LRFPRI 154 : NDDLPR=LRFPRI.NPQUAF(/1) 154 : CALL KEEF(ITQUAF,MDISCD,MYFALS, 155 : $ LRFDUA,IMPR,IRET) 156 : IF (IRET.NE.0) GOTO 9999 157 : SEGACT LRFDUA 158 : NDDLDU=LRFDUA.NPQUAF(/1) 159 : DO IVARP=1,NCVARP.MOTS(/2) 160 : * Construction de la liste des points du QUAF sur lesquels il y a des 161 : * ddl pour l'inconnue primale 162 : JG=0 163 : SEGINI LPOQFP 164 : DO IDDLPR=1,NDDLPR 165 : IF (LRFPRI.NUMCMP(IDDLPR).EQ.IVARP) THEN 166 : LPOQFP.LECT(**)=LRFPRI.NPQUAF(IDDLPR) 167 : ENDIF 168 : ENDDO 169 : IF (LPOQFP.LECT(/1).EQ.0) THEN 170 : GOTO 1 171 : ENDIF 172 : C* Suppression des doublons (pas besoin) 172 : C CALL IUNIQ(LPOQFP.LECT,LPOQFP.LECT(/1), 173 : C $ LPOQFP.LECT,NPOQFP, 174 : C $ IMPR,IRET) 175 : C IF (IRET.NE.0) GOTO 9999 176 : C JG=NPOQFP 177 : C SEGADJ,LPOQFP 178 : * Segment de repérage dans cette liste 179 : JG=MYMEL.NUM(/1) 180 : SEGINI,KPOQFP 180 : CALL RSETXI(KPOQFP.LECT,LPOQFP.LECT,LPOQFP.LECT(/1)) 181 : * Construction du maillage primal 182 : NBNN=LPOQFP.LECT(/1) 183 : NBELEM = MYMEL.NUM(/2) 184 : NBSOUS = 0 185 : NBREF=0 186 : SEGINI,MELPRI 187 : * Type 32 POLY 188 : MELPRI.ITYPEL=32 189 : DO IBELEM=1,NBELEM 190 : DO IBNN=1,NBNN 191 : MELPRI.NUM(IBNN,IBELEM)= 192 : $ MYMEL.NUM(LPOQFP.LECT(IBNN),IBELEM) 193 : ENDDO 194 : ENDDO 195 : SEGDES MELPRI 196 : * 197 : DO IVARD=1,NCVARD.MOTS(/2) 198 : * Construction de la liste des points du QUAF sur lesquels il y a des 199 : * ddl pour l'inconnue duale 200 : JG=0 201 : SEGINI LPOQFD 202 : DO IDDLDU=1,NDDLDU 203 : IF (LRFDUA.NUMCMP(IDDLDU).EQ.IVARD) THEN 204 : LPOQFD.LECT(**)=LRFDUA.NPQUAF(IDDLDU) 205 : ENDIF 206 : ENDDO 207 : IF (LPOQFD.LECT(/1).EQ.0) THEN 208 : GOTO 3 209 : ENDIF 210 : C* Suppression des doublons 210 : C CALL IUNIQ(LPOQFD.LECT,LPOQFD.LECT(/1), 211 : C $ LPOQFD.LECT,NPOQFD, 212 : C $ IMPR,IRET) 213 : C IF (IRET.NE.0) GOTO 9999 214 : C JG=NPOQFD 215 : C SEGADJ,LPOQFD 216 : * Segment de repérage dans cette liste 217 : JG=MYMEL.NUM(/1) 218 : SEGINI,KPOQFD 218 : CALL RSETXI(KPOQFD.LECT,LPOQFD.LECT,LPOQFD.LECT(/1)) 219 : * Construction du maillage dual 220 : NBNN=LPOQFD.LECT(/1) 221 : NBELEM = MYMEL.NUM(/2) 222 : NBSOUS = 0 223 : NBREF=0 224 : SEGINI,MELDUA 225 : * Type 32 POLY 226 : MELDUA.ITYPEL=32 227 : DO IBELEM=1,NBELEM 228 : DO IBNN=1,NBNN 229 : MELDUA.NUM(IBNN,IBELEM)= 230 : $ MYMEL.NUM(LPOQFD.LECT(IBNN),IBELEM) 231 : ENDDO 232 : ENDDO 233 : SEGDES MELDUA 234 : * Construction du IMATRI 235 : NBME=1 236 : NBSOUS=1 237 : SEGINI IMATRI 238 : LISPRI(1)=NCVARP.MOTS(IVARP) 239 : LISDUA(1)=NCVARD.MOTS(IVARD) 240 : * Construction du IZAFM 241 : NBEL=MYMEL.NUM(/2) 242 : NP=LPOQFP.LECT(/1) 243 : MP=LPOQFD.LECT(/1) 244 : SEGINI IZAFM 245 : * remplissage des matrices élémentaires 246 : NBLIG=JMTLSB.VELCHE(/1) 247 : NBCOL=JMTLSB.VELCHE(/2) 248 : N2LIG=JMTLSB.VELCHE(/3) 249 : N2COL=JMTLSB.VELCHE(/4) 250 : NBPOI=JMTLSB.VELCHE(/5) 251 : NBELM=JMTLSB.VELCHE(/6) 252 : IF (NBLIG.NE.NDDLDU.OR.NBCOL.NE.NDDLPR.OR.N2LIG.NE.1 253 : $ .OR.N2COL.NE.1.OR.NBPOI.NE.1.OR.NBELM.NE.NBEL) 254 : $ THEN 255 : WRITE(IOIMP,*) 'Erreur dims JMTLSB' 256 : GOTO 9999 257 : ENDIF 258 : DO IDDLDU=1,NDDLDU 259 : IF (LRFDUA.NUMCMP(IDDLDU).EQ.IVARD) THEN 260 : IMP=KPOQFD.LECT(LRFDUA.NPQUAF(IDDLDU)) 261 : DO IDDLPR=1,NDDLPR 262 : IF (LRFPRI.NUMCMP(IDDLPR).EQ.IVARP) THEN 263 : INP=KPOQFP.LECT(LRFPRI.NPQUAF(IDDLPR)) 264 : DO IBEL=1,NBEL 265 : AM(IBEL,INP,IMP)= 266 : $ JMTLSB.VELCHE(IDDLDU,IDDLPR, 267 : $ 1,1,1,IBEL) 268 : ENDDO 269 : ENDIF 270 : ENDDO 271 : ENDIF 272 : ENDDO 273 : SEGDES IZAFM 274 : LIZAFM(1,1)=IZAFM 275 : SEGDES IMATRI 276 : * 277 : * Remplissage du chapeau 278 : * 279 : NRIGE=MATLSB.IRIGEL(/1) 280 : NMATRI=MATLSB.IRIGEL(/2)+1 281 : NKID=MATLSB.KIDMAT(/1) 282 : NKMT=MATLSB.KKMMT(/1) 283 : SEGADJ,MATLSB 284 : MATLSB.IRIGEL(1,NMATRI)=MELPRI 285 : MATLSB.IRIGEL(2,NMATRI)=MELDUA 286 : MATLSB.IRIGEL(4,NMATRI)=IMATRI 287 : MATLSB.IRIGEL(7,NMATRI)=2 288 : SEGSUP KPOQFD 289 : 3 CONTINUE 290 : SEGSUP LPOQFD 291 : ENDDO 292 : SEGSUP KPOQFP 293 : 1 CONTINUE 294 : SEGSUP LPOQFP 295 : ENDDO 296 : SEGDES LRFDUA 297 : SEGDES LRFPRI 298 : SEGDES MYMEL 299 : SEGDES JMTLSB 300 : ENDIF 301 : ENDDO 302 : SEGDES IMTLSB 303 : SEGDES NCVARD 304 : SEGDES NCVARP 305 : SEGDES MATLSB 306 : IF (IMPR.GT.3) THEN 307 : WRITE(IOIMP,*) 'On a créé MATLSB=',MATLSB 307 : CALL ECROBJ('MATRIK ',MATLSB) 307 : CALL PRLIST 308 : ENDIF 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 cv2mab' 323 : RETURN 324 : * 325 : * End of subroutine CV2MAB 326 : * 327 : END 328 : 329 : 330 :
© Cast3M 2003 - All rights reserved.
Disclaimer