1 : C CV2MC9 SOURCE CHAT 09/10/09 21:16:52 6519 2 : SUBROUTINE CV2MC9(TABVDC,TABMAT, 3 : $ MYFALS, 4 : $ MATLS9,CHPLS9, 5 : $ IMPR,IRET) 6 : IMPLICIT REAL*8 (A-H,O-Z) 7 : IMPLICIT INTEGER (I-N) 8 : C*********************************************************************** 9 : C NOM : CV2MC9 10 : C DESCRIPTION : Transforme un MCHAEL (mon champ par éléments) 11 : C représentant un ensemble de matrices élémentaires en 12 : C RIGIDITE... 13 : C 14 : C LANGAGE : ESOPE 15 : C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) 16 : C mél : gounand@semt2.smts.cea.fr 17 : C*********************************************************************** 18 : C APPELES : KEEF (recherche de l'élément fini) 19 : C APPELES (E/S) : ECROBJ, PRLIST (écriture entier, objet, 20 : C impression) 21 : C APPELE PAR : PRLS92 22 : C*********************************************************************** 23 : C ENTREES : 24 : C ENTREES/SORTIES : - 25 : C SORTIES : 26 : C TRAVAIL : * MYMEL (type MELEME) : maillage élémentaire. 27 : C * JMTLS9 (type MCHEVA) : valeurs du champ IMTLS9 28 : C sur le maillage élémentaire. 29 : C Structure (cf.include SMCHAEL) : 30 : C (nb. ddl dual, nb. ddl primal, 31 : C nb. comp. duales, nb. comp. primales, 32 : C 1, nb. éléments) 33 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé 34 : C*********************************************************************** 35 : C VERSION : v1, 26/09/03, version initiale 36 : C HISTORIQUE : v1, 26/09/03, création 37 : C HISTORIQUE : 38 : C*********************************************************************** 39 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 40 : C en cas de modification de ce sous-programme afin de faciliter 41 : C la maintenance ! 42 : C*********************************************************************** 43 : -INC CCOPTIO 44 : -INC SMLMOTS 45 : POINTEUR MYLMOT.MLMOTS 46 : POINTEUR NCVARP.MLMOTS 47 : POINTEUR NCVARD.MLMOTS 48 : -INC SMRIGID 49 : POINTEUR MATLS9.MRIGID 50 : POINTEUR MATTMP.MRIGID 51 : POINTEUR MATTM2.MRIGID 52 : -INC SMCHPOI 53 : POINTEUR CHPLS9.MCHPOI 54 : POINTEUR CHPTMP.MCHPOI 55 : POINTEUR CHPTM2.MCHPOI 56 : * 57 : * Includes persos 58 : * 59 : CBEGININCLUDE SMCHAEL 60 : SEGMENT MCHAEL 61 : POINTEUR IMACHE(N1).MELEME 62 : POINTEUR ICHEVA(N1).MCHEVA 63 : ENDSEGMENT 64 : SEGMENT MCHEVA 65 : REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM) 66 : ENDSEGMENT 67 : SEGMENT LCHEVA 68 : POINTEUR LISCHE(NBCHE).MCHEVA 69 : ENDSEGMENT 70 : CENDINCLUDE SMCHAEL 71 : POINTEUR MYMCHA.MCHAEL 72 : CBEGININCLUDE SFALRF 73 : SEGMENT FALRF 74 : CHARACTER*(LNNFA) NOMFA 75 : INTEGER NUQUAF(NBLRF) 76 : POINTEUR ELEMF(NBLRF).ELREF 77 : ENDSEGMENT 78 : SEGMENT FALRFS 79 : POINTEUR LISFA(0).FALRF 80 : ENDSEGMENT 81 : CENDINCLUDE SFALRF 82 : POINTEUR MYFALS.FALRFS 83 : CBEGININCLUDE SMPOUET 84 : SEGMENT TABGEO 85 : CHARACTER*4 DISGEO 86 : POINTEUR IGEO.MCHAEL 87 : ENDSEGMENT 88 : SEGMENT TABVDC 89 : INTEGER VVARPR(NUMVPR) 90 : INTEGER VVARDU(NUMVDU) 91 : INTEGER VDATPR(NUMDPR) 92 : INTEGER VDATDU(NUMDDU) 93 : INTEGER VCOFPR(NUMCPR) 94 : INTEGER VCOFDU(NUMCDU) 95 : INTEGER ILCPR(NUMDER+1,NUMOP,NUMVPR) 96 : INTEGER ILCDU(NUMDER+1,NUMOP,NUMVDU) 97 : POINTEUR VLCOF(JLCOF).MLENTI 98 : POINTEUR VCOMP(JGCOF).COMP 99 : POINTEUR VLDAT(JGCOF).MLENTI 100 : INTEGER DJSVD(JGVD) 101 : POINTEUR NOMVD(JGVD).MLMOTS 102 : POINTEUR MVD(JGVD).MCHPOI 103 : REAL*8 XVD(JGVD) 104 : CHARACTER*4 DISVD(KGVD) 105 : ENDSEGMENT 106 : SEGMENT TATRAV 107 : POINTEUR VVCOF(JLCOF).MCHEVA 108 : POINTEUR VCOF(JGCOF).MCHEVA 109 : POINTEUR IVD(JGVD).MCHAEL 110 : POINTEUR VD(JGVD).MCHEVA 111 : POINTEUR DVD(JGVD).MCHEVA 112 : POINTEUR FFVD(KGVD).MCHEVA 113 : POINTEUR DFFVD(KGVD).MCHEVA 114 : LOGICAL LVCOF(JGCOF) 115 : LOGICAL LVD(JGVD) 116 : LOGICAL LDVD(JGVD) 117 : LOGICAL LFFVD(KGVD) 118 : LOGICAL LDFFVD(KGVD) 119 : ENDSEGMENT 120 : SEGMENT TABMAT 121 : POINTEUR VMAT(NUMVDU,NUMVPR).MCHAEL 122 : ENDSEGMENT 123 : CENDINCLUDE SMPOUET 124 : INTEGER NUMVPR,NUMVDU 125 : * 126 : CHARACTER*4 MDISCP,MDISCD,MYDISC 127 : INTEGER IMPR,IRET 128 : * 129 : LOGICAL MVVPR,MVVDU 130 : * 131 : * Executable statements 132 : * 133 : IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans cv2mc9' 134 : * WRITE(IOIMP,*) '<' 135 : MATLS9=0 136 : CHPLS9=0 137 : MATTMP=0 138 : CHPTMP=0 139 : SEGACT TABVDC 140 : SEGACT TABMAT 141 : * SEGPRT,TABMAT 142 : NUMVPR=TABMAT.VMAT(/2) 143 : NUMVDU=TABMAT.VMAT(/1) 144 : DO IVARPR=1,NUMVPR 145 : DO IVARDU=1,NUMVDU 146 : IJVARP=TABVDC.VVARPR(IVARPR) 147 : IJVARD=TABVDC.VVARDU(IVARDU) 148 : MVVPR=(TABVDC.MVD(IJVARP).NE.0) 149 : MVVDU=(TABVDC.MVD(IJVARD).NE.0) 150 : IKVARP=TABVDC.DJSVD(IJVARP) 151 : MDISCP=TABVDC.DISVD(IKVARP) 152 : NCVARP=TABVDC.NOMVD(IJVARP) 153 : IKVARD=TABVDC.DJSVD(IJVARD) 154 : MDISCD=TABVDC.DISVD(IKVARD) 155 : NCVARD=TABVDC.NOMVD(IJVARD) 156 : MYMCHA=TABMAT.VMAT(IVARDU,IVARPR) 157 : IF (MYMCHA.NE.0) THEN 158 : IF ((.NOT.MVVPR).AND.(.NOT.MVVDU)) THEN 159 : * In cv2ma9 : SEGINI MATTMP 159 : CALL CV2MA9(MDISCP,NCVARP,MDISCD,NCVARD, 160 : $ MYMCHA, 161 : $ MYFALS, 162 : $ MATTMP, 163 : $ IMPR,IRET) 164 : IF (IRET.NE.0) GOTO 9999 165 : ELSEIF ((.NOT.MVVPR).AND.MVVDU) THEN 166 : MYDISC=MDISCP 167 : MYLMOT=NCVARP 167 : CALL CV2CP9(MYDISC,MYLMOT,MYMCHA, 168 : $ MYFALS, 169 : $ CHPTMP, 170 : $ IMPR,IRET) 171 : IF (IRET.NE.0) GOTO 9999 172 : ELSEIF (MVVPR.AND.(.NOT.MVVDU)) THEN 173 : MYDISC=MDISCD 174 : MYLMOT=NCVARD 174 : CALL CV2CP9(MYDISC,MYLMOT,MYMCHA, 175 : $ MYFALS, 176 : $ CHPTMP, 177 : $ IMPR,IRET) 178 : IF (IRET.NE.0) GOTO 9999 179 : ELSEIF (MVVPR.AND.MVVDU) THEN 180 : MYDISC='CSTE' 181 : JGN=4 182 : JGM=1 183 : SEGINI,MYLMOT 184 : * MYLMOT.MOTS(1)='RES2' 185 : MYLMOT.MOTS(1)='SCAL' 186 : * In CV2CP9 : SEGINI CHPTMP 186 : CALL CV2CP9(MYDISC,MYLMOT,MYMCHA, 187 : $ MYFALS, 188 : $ CHPTMP, 189 : $ IMPR,IRET) 190 : IF (IRET.NE.0) GOTO 9999 191 : SEGSUP,MYLMOT 192 : ENDIF 193 : IF (CHPTMP.NE.0) THEN 194 : IF (CHPLS9.EQ.0) THEN 195 : CHPLS9=CHPTMP 196 : CHPTMP=0 197 : ELSE 198 : * In ADCHPO : SEGINI CHPTM2 198 : CALL ADCHPO(CHPLS9,CHPTMP,CHPTM2,1.D0,1.D0) 199 : IF (CHPTM2.EQ.0) THEN 200 : WRITE(IOIMP,*) 201 : $ 'Pas pu faire le ET des chpoints...' 202 : GOTO 9999 203 : ENDIF 204 : * In DTCHPO : SEGSUP CHPLS9 204 : CALL DTCHPO(CHPLS9) 205 : * In DTCHPO : SEGSUP CHPTMP 205 : CALL DTCHPO(CHPTMP) 206 : CHPLS9=CHPTM2 207 : CHPTMP=0 208 : ENDIF 209 : ENDIF 210 : IF (MATTMP.NE.0) THEN 211 : IF (MATLS9.EQ.0) THEN 212 : MATLS9=MATTMP 213 : MATTMP=0 214 : ELSE 215 : * In FUSRIG : SEGINI MATTM2 215 : CALL FUSRIG(MATLS9,MATTMP,MATTM2) 216 : IF (MATTM2.EQ.0) THEN 217 : WRITE(IOIMP,*) 218 : $ 'Pas pu faire le ET des chpoints...' 219 : GOTO 9999 220 : ENDIF 221 : SEGSUP MATLS9 222 : SEGSUP MATTMP 223 : MATLS9=MATTM2 224 : MATTMP=0 225 : ENDIF 226 : ENDIF 227 : ENDIF 228 : ENDDO 229 : ENDDO 230 : SEGDES TABMAT 231 : SEGDES TABVDC 232 : * WRITE(IOIMP,*) '>' 233 : IF (IMPR.GT.3) THEN 234 : WRITE(IOIMP,*) 'On a créé MATLS9=',MATLS9 235 : IF (MATLS9.NE.0) THEN 235 : CALL ECROBJ('RIGIDITE',MATLS9) 235 : CALL PRLIST 236 : ENDIF 237 : WRITE(IOIMP,*) 'On a créé CHPLS9=',CHPLS9 238 : IF (CHPLS9.NE.0) THEN 238 : CALL ECROBJ('CHPOINT ',CHPLS9) 238 : CALL PRLIST 239 : ENDIF 240 : ENDIF 241 : * 242 : * Normal termination 243 : * 244 : IRET=0 245 : RETURN 246 : * 247 : * Format handling 248 : * 249 : * 250 : * Error handling 251 : * 252 : 9999 CONTINUE 253 : IRET=1 254 : WRITE(IOIMP,*) 'An error was detected in subroutine cv2mc9' 255 : RETURN 256 : * 257 : * End of subroutine CV2MC9 258 : * 259 : END 260 : 261 : 262 : 263 :
© Cast3M 2003 - All rights reserved.
Disclaimer