1 : C CV2MCA SOURCE CHAT 09/10/09 21:16:53 6519 2 : SUBROUTINE CV2MCA(CGEOME,TABVDC,TABMAT, 3 : $ MYFALS, 4 : $ MATLSA,CHPLSA, 5 : $ IMPR,IRET) 6 : IMPLICIT REAL*8 (A-H,O-Z) 7 : IMPLICIT INTEGER (I-N) 8 : C*********************************************************************** 9 : C NOM : CV2MCA 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 ou chpoint... 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 : prlin2 22 : C*********************************************************************** 23 : C ENTREES : 24 : C ENTREES/SORTIES : - 25 : C SORTIES : 26 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé 27 : C*********************************************************************** 28 : C VERSION : v1, 06/03/09, version initiale 29 : C HISTORIQUE : v1, 06/03/06, création 30 : C HISTORIQUE : 31 : C*********************************************************************** 32 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 33 : C en cas de modification de ce sous-programme afin de faciliter 34 : C la maintenance ! 35 : C*********************************************************************** 36 : -INC CCOPTIO 37 : -INC SMLMOTS 38 : POINTEUR MYLMOT.MLMOTS 39 : POINTEUR NCVARP.MLMOTS 40 : POINTEUR NCVARD.MLMOTS 41 : -INC SMRIGID 42 : POINTEUR MATLSA.MRIGID 43 : POINTEUR MATTMP.MRIGID 44 : POINTEUR MATTM2.MRIGID 45 : -INC SMCHPOI 46 : POINTEUR CHPLSA.MCHPOI 47 : POINTEUR CHPTMP.MCHPOI 48 : POINTEUR CHPTM2.MCHPOI 49 : -INC SMELEME 50 : POINTEUR CGEOME.MELEME 51 : * 52 : * Includes persos 53 : * 54 : CBEGININCLUDE SMCHAEL 55 : SEGMENT MCHAEL 56 : POINTEUR IMACHE(N1).MELEME 57 : POINTEUR ICHEVA(N1).MCHEVA 58 : ENDSEGMENT 59 : SEGMENT MCHEVA 60 : REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM) 61 : ENDSEGMENT 62 : SEGMENT LCHEVA 63 : POINTEUR LISCHE(NBCHE).MCHEVA 64 : ENDSEGMENT 65 : CENDINCLUDE SMCHAEL 66 : POINTEUR MYMCHA.MCHAEL 67 : CBEGININCLUDE SFALRF 68 : SEGMENT FALRF 69 : CHARACTER*(LNNFA) NOMFA 70 : INTEGER NUQUAF(NBLRF) 71 : POINTEUR ELEMF(NBLRF).ELREF 72 : ENDSEGMENT 73 : SEGMENT FALRFS 74 : POINTEUR LISFA(0).FALRF 75 : ENDSEGMENT 76 : CENDINCLUDE SFALRF 77 : POINTEUR MYFALS.FALRFS 78 : CBEGININCLUDE SMPOUET 79 : SEGMENT TABGEO 80 : CHARACTER*4 DISGEO 81 : POINTEUR IGEO.MCHAEL 82 : ENDSEGMENT 83 : SEGMENT TABVDC 84 : INTEGER VVARPR(NUMVPR) 85 : INTEGER VVARDU(NUMVDU) 86 : INTEGER VDATPR(NUMDPR) 87 : INTEGER VDATDU(NUMDDU) 88 : INTEGER VCOFPR(NUMCPR) 89 : INTEGER VCOFDU(NUMCDU) 90 : INTEGER ILCPR(NUMDER+1,NUMOP,NUMVPR) 91 : INTEGER ILCDU(NUMDER+1,NUMOP,NUMVDU) 92 : POINTEUR VLCOF(JLCOF).MLENTI 93 : POINTEUR VCOMP(JGCOF).COMP 94 : POINTEUR VLDAT(JGCOF).MLENTI 95 : INTEGER DJSVD(JGVD) 96 : POINTEUR NOMVD(JGVD).MLMOTS 97 : POINTEUR MVD(JGVD).MCHPOI 98 : REAL*8 XVD(JGVD) 99 : CHARACTER*4 DISVD(KGVD) 100 : ENDSEGMENT 101 : SEGMENT TATRAV 102 : POINTEUR VVCOF(JLCOF).MCHEVA 103 : POINTEUR VCOF(JGCOF).MCHEVA 104 : POINTEUR IVD(JGVD).MCHAEL 105 : POINTEUR VD(JGVD).MCHEVA 106 : POINTEUR DVD(JGVD).MCHEVA 107 : POINTEUR FFVD(KGVD).MCHEVA 108 : POINTEUR DFFVD(KGVD).MCHEVA 109 : LOGICAL LVCOF(JGCOF) 110 : LOGICAL LVD(JGVD) 111 : LOGICAL LDVD(JGVD) 112 : LOGICAL LFFVD(KGVD) 113 : LOGICAL LDFFVD(KGVD) 114 : ENDSEGMENT 115 : SEGMENT TABMAT 116 : POINTEUR VMAT(NUMVDU,NUMVPR).MCHAEL 117 : ENDSEGMENT 118 : CENDINCLUDE SMPOUET 119 : INTEGER NUMVPR,NUMVDU 120 : * 121 : CHARACTER*4 MDISCP,MDISCD,MYDISC 122 : INTEGER IMPR,IRET 123 : * 124 : LOGICAL MVVPR,MVVDU 125 : * 126 : * Executable statements 127 : * 128 : IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans cv2mca' 129 : * 129 : CALL CV2MAA(CGEOME,TABVDC,TABMAT, 130 : $ MYFALS, 131 : $ MATLSA, 132 : $ IMPR,IRET) 133 : IF (IRET.NE.0) GOTO 9999 134 : CHPLSA=0 135 : CHPTMP=0 136 : SEGACT TABVDC 137 : SEGACT TABMAT 138 : NUMVPR=TABMAT.VMAT(/2) 139 : NUMVDU=TABMAT.VMAT(/1) 140 : DO IVARPR=1,NUMVPR 141 : DO IVARDU=1,NUMVDU 142 : IJVARP=TABVDC.VVARPR(IVARPR) 143 : IJVARD=TABVDC.VVARDU(IVARDU) 144 : MVVPR=(TABVDC.MVD(IJVARP).NE.0) 145 : MVVDU=(TABVDC.MVD(IJVARD).NE.0) 146 : IKVARP=TABVDC.DJSVD(IJVARP) 147 : MDISCP=TABVDC.DISVD(IKVARP) 148 : NCVARP=TABVDC.NOMVD(IJVARP) 149 : IKVARD=TABVDC.DJSVD(IJVARD) 150 : MDISCD=TABVDC.DISVD(IKVARD) 151 : NCVARD=TABVDC.NOMVD(IJVARD) 152 : MYMCHA=TABMAT.VMAT(IVARDU,IVARPR) 153 : IF (MYMCHA.NE.0) THEN 154 : IF (MVVPR.OR.MVVDU) THEN 155 : IF ((.NOT.MVVPR).AND.MVVDU) THEN 156 : MYDISC=MDISCP 157 : MYLMOT=NCVARP 157 : CALL CV2CP9(MYDISC,MYLMOT,MYMCHA, 158 : $ MYFALS, 159 : $ CHPTMP, 160 : $ IMPR,IRET) 161 : IF (IRET.NE.0) GOTO 9999 162 : ELSEIF (MVVPR.AND.(.NOT.MVVDU)) THEN 163 : MYDISC=MDISCD 164 : MYLMOT=NCVARD 164 : CALL CV2CP9(MYDISC,MYLMOT,MYMCHA, 165 : $ MYFALS, 166 : $ CHPTMP, 167 : $ IMPR,IRET) 168 : IF (IRET.NE.0) GOTO 9999 169 : ELSEIF (MVVPR.AND.MVVDU) THEN 170 : MYDISC='CSTE' 171 : JGN=4 172 : JGM=1 173 : SEGINI,MYLMOT 174 : * MYLMOT.MOTS(1)='RES2' 175 : MYLMOT.MOTS(1)='SCAL' 176 : * In CV2CP9 : SEGINI CHPTMP 176 : CALL CV2CP9(MYDISC,MYLMOT,MYMCHA, 177 : $ MYFALS, 178 : $ CHPTMP, 179 : $ IMPR,IRET) 180 : IF (IRET.NE.0) GOTO 9999 181 : SEGSUP,MYLMOT 182 : ENDIF 183 : ENDIF 184 : IF (CHPTMP.NE.0) THEN 185 : IF (CHPLSA.EQ.0) THEN 186 : CHPLSA=CHPTMP 187 : CHPTMP=0 188 : ELSE 189 : * In ADCHPO : SEGINI CHPTM2 189 : CALL ADCHPO(CHPLSA,CHPTMP,CHPTM2,1.D0,1.D0) 190 : IF (CHPTM2.EQ.0) THEN 191 : WRITE(IOIMP,*) 192 : $ 'Pas pu faire le ET des chpoints...' 193 : GOTO 9999 194 : ENDIF 195 : * In DTCHPO : SEGSUP CHPLSA 195 : CALL DTCHPO(CHPLSA) 196 : * In DTCHPO : SEGSUP CHPTMP 196 : CALL DTCHPO(CHPTMP) 197 : CHPLSA=CHPTM2 198 : CHPTMP=0 199 : ENDIF 200 : ENDIF 201 : ENDIF 202 : ENDDO 203 : ENDDO 204 : SEGDES TABMAT 205 : SEGDES TABVDC 206 : * WRITE(IOIMP,*) '>' 207 : IF (IMPR.GT.3) THEN 208 : WRITE(IOIMP,*) 'On a créé MATLSA=',MATLSA 209 : IF (MATLSA.NE.0) THEN 209 : CALL ECROBJ('RIGIDITE',MATLSA) 209 : CALL PRLIST 210 : ENDIF 211 : WRITE(IOIMP,*) 'On a créé CHPLSA=',CHPLSA 212 : IF (CHPLSA.NE.0) THEN 212 : CALL ECROBJ('CHPOINT ',CHPLSA) 212 : CALL PRLIST 213 : ENDIF 214 : ENDIF 215 : * 216 : * Normal termination 217 : * 218 : IRET=0 219 : RETURN 220 : * 221 : * Format handling 222 : * 223 : * 224 : * Error handling 225 : * 226 : 9999 CONTINUE 227 : IRET=1 228 : WRITE(IOIMP,*) 'An error was detected in subroutine cv2mca' 229 : RETURN 230 : * 231 : * End of subroutine CV2MCA 232 : * 233 : END 234 : 235 : 236 : 237 :
© Cast3M 2003 - All rights reserved.
Disclaimer