1 : C CP2CV7 SOURCE GOUNAND 07/07/30 21:15:08 5819 2 : SUBROUTINE CP2CV7(CGEOME,MYLMOT,MYDISC,MYCHPO,MYREAL, 3 : $ MYFALS, 4 : $ MYMCHA, 5 : $ IMPR,IRET) 6 : IMPLICIT REAL*8 (A-H,O-Z) 7 : IMPLICIT INTEGER (I-N) 8 : C*********************************************************************** 9 : C NOM : CP2CV7 10 : C DESCRIPTION : Transforme un chpoint en MCHAEL 11 : C 12 : C LANGAGE : ESOPE 13 : C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) 14 : C mél : gounand@semt2.smts.cea.fr 15 : C*********************************************************************** 16 : C APPELES : 17 : C APPELE PAR : PRLS63 18 : C*********************************************************************** 19 : C ENTREES : * CGEOME (type MELEME) : maillage de QUAFs 20 : C partitionné. 21 : C * MYDISC (type CH*(4)) : nom d'espace de 22 : C discrétisation (cf. NOMFA dans l'include 23 : C SFALRF) 24 : C * MYFALS (type FALRFS) : segment de description 25 : C des familles d'éléments de références. 26 : C SORTIES : * MYMCHA (type MCHAEL) : champ par éléments de 27 : C la grandeur tensorielle (degrés de liberté de 28 : C la grandeur). 29 : C ENTREES/SORTIES : - 30 : C TRAVAIL : 31 : C (1, nb. ddl, NCOMPD, NCOMPP, 1, nb. élément) 32 : C 33 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé 34 : C*********************************************************************** 35 : C VERSION : v1, 24/09/03, version initiale 36 : C HISTORIQUE : v1, 24/09/03, création 37 : C HISTORIQUE : 38 : C HISTORIQUE : 39 : C*********************************************************************** 40 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 41 : C en cas de modification de ce sous-programme afin de faciliter 42 : C la maintenance ! 43 : C*********************************************************************** 44 : -INC CCOPTIO 45 : -INC SMCOORD 46 : -INC SMCHPOI 47 : POINTEUR MYCHPO.MCHPOI 48 : -INC TMTRAV 49 : POINTEUR MYMTRA.MTRAV 50 : INTEGER NNIN,NNNOE 51 : -INC SMELEME 52 : POINTEUR CGEOME.MELEME 53 : POINTEUR SOUMAI.MELEME 54 : -INC SMLMOTS 55 : POINTEUR MYLMOT.MLMOTS 56 : INTEGER JGN 57 : -INC SMLENTI 58 : POINTEUR KRIGEO.MLENTI 59 : POINTEUR KRINCO.MLENTI 60 : INTEGER JG 61 : * 62 : * Includes persos 63 : * 64 : CBEGININCLUDE SMCHAEL 65 : SEGMENT MCHAEL 66 : POINTEUR IMACHE(N1).MELEME 67 : POINTEUR ICHEVA(N1).MCHEVA 68 : ENDSEGMENT 69 : SEGMENT MCHEVA 70 : REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM) 71 : ENDSEGMENT 72 : SEGMENT LCHEVA 73 : POINTEUR LISCHE(NBCHE).MCHEVA 74 : ENDSEGMENT 75 : CENDINCLUDE SMCHAEL 76 : INTEGER N1 77 : POINTEUR MYMCHA.MCHAEL 78 : INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM 79 : POINTEUR MZMCHA.MCHEVA 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 MYLRF.ELREF 110 : * 111 : CHARACTER*(4) MYDISC 112 : INTEGER IMPR,IRET 113 : * 114 : INTEGER IBEL,IDDL,ISOUS,ITQUAF 115 : INTEGER NBEL,NDDL,NSOUS 116 : INTEGER NMLOC,NMQUA,NNGLO,NNLOC,NNMDDL,NNQUA 117 : INTEGER NTOGPO 118 : LOGICAL LDDLEX 119 : REAL*8 MYREAL 120 : REAL*8 CONTRI 121 : LOGICAL LWARN,LVIDE 122 : * 123 : * Executable statements 124 : * 125 : IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans cp2cv7' 126 : 127 : * Transformation du chpoint en un objet MTRAV plus commode 128 : * 129 : IF (MYCHPO.EQ.0) THEN 130 : MYMCHA=0 131 : ELSEIF (MYCHPO.LT.0) THEN 132 : SEGACT CGEOME 133 : NSOUS=CGEOME.LISOUS(/1) 134 : N1=NSOUS 135 : SEGINI MYMCHA 136 : DO 2 ISOUS=1,NSOUS 137 : SOUMAI=CGEOME.LISOUS(ISOUS) 138 : SEGACT SOUMAI 139 : * On cherche l'élément fini correspondant au QUAF 140 : ITQUAF=SOUMAI.ITYPEL 140 : CALL KEEF(ITQUAF,MYDISC, 141 : $ MYFALS, 142 : $ MYLRF, 143 : $ IMPR,IRET) 144 : IF (IRET.NE.0) GOTO 9999 145 : SEGACT MYLRF 146 : NDDL=MYLRF.NPQUAF(/1) 147 : * NBEL=SOUMAI.NUM(/2) 148 : * On initialise le MCHEVA a remplir 149 : NBLIG=1 150 : NBCOL=NDDL 151 : N2LIG=1 152 : N2COL=1 153 : NBPOI=1 154 : * Astuce ! 155 : NBELM=1 156 : SEGINI MZMCHA 157 : DO IDDL=1,NDDL 158 : MZMCHA.VELCHE(1,IDDL,1,1,1,1)= 159 : $ MYREAL 160 : ENDDO 161 : SEGDES MZMCHA 162 : MYMCHA.ICHEVA(ISOUS)=MZMCHA 163 : SEGDES MYLRF 164 : SEGDES SOUMAI 165 : MYMCHA.IMACHE(ISOUS)=SOUMAI 166 : 2 CONTINUE 167 : SEGDES MYMCHA 168 : SEGDES CGEOME 169 : ELSE 169 : CALL CP2TRA(MYCHPO, 170 : $ MYMTRA,LVIDE, 171 : $ IMPR,IRET) 172 : IF (IRET.NE.0) GOTO 9999 173 : * 174 : * Warning, si aucune valeur du chpoint n'a servi 175 : * 176 : *Pour débugger 177 : * LWARN=.TRUE. 178 : LWARN=.FALSE. 179 : * 180 : * Segments de repérage dans MTRAV 181 : * 182 : SEGACT MYMTRA 183 : JGN=MYMTRA.INCO(/1) 184 : NNIN=MYMTRA.INCO(/2) 185 : NNNOE=MYMTRA.IGEO(/1) 186 : * Création du segment de répérage dans IGEO 187 : NTOGPO=XCOOR(/1)/(IDIM+1) 188 : JG=NTOGPO 189 : SEGINI,KRIGEO 189 : CALL RSETEE(MYMTRA.IGEO,NNNOE, 190 : $ KRIGEO.LECT,NTOGPO, 191 : $ IMPR,IRET) 192 : IF (IRET.NE.0) GOTO 9999 193 : * Création du segment de repérage dans INCO 194 : SEGACT MYLMOT 195 : NNMDDL=MYLMOT.MOTS(/2) 196 : JG=NNMDDL 197 : SEGINI KRINCO 197 : CALL CREPE2(JGN,NNMDDL,NNIN, 198 : $ MYLMOT.MOTS,MYMTRA.INCO, 199 : $ KRINCO.LECT, 200 : $ IMPR,IRET) 201 : IF (IRET.NE.0) GOTO 9999 202 : * 203 : * Création et remplissage du champ par éléments 204 : * 205 : SEGACT CGEOME 206 : NSOUS=CGEOME.LISOUS(/1) 207 : N1=NSOUS 208 : SEGINI MYMCHA 209 : DO 1 ISOUS=1,NSOUS 210 : SOUMAI=CGEOME.LISOUS(ISOUS) 211 : SEGACT SOUMAI 212 : * SEGPRT,SOUMAI 213 : * On cherche l'élément fini correspondant au QUAF 214 : ITQUAF=SOUMAI.ITYPEL 214 : CALL KEEF(ITQUAF,MYDISC, 215 : $ MYFALS, 216 : $ MYLRF, 217 : $ IMPR,IRET) 218 : IF (IRET.NE.0) GOTO 9999 219 : SEGACT MYLRF 220 : NDDL=MYLRF.NPQUAF(/1) 221 : NBEL=SOUMAI.NUM(/2) 222 : * On initialise le MCHEVA a remplir 223 : NBLIG=1 224 : NBCOL=NDDL 225 : N2LIG=1 226 : N2COL=1 227 : NBPOI=1 228 : NBELM=NBEL 229 : SEGINI MZMCHA 230 : DO IBEL=1,NBEL 231 : DO IDDL=1,NDDL 232 : NNQUA=MYLRF.NPQUAF(IDDL) 233 : NNGLO=SOUMAI.NUM(NNQUA,IBEL) 234 : NNLOC=KRIGEO.LECT(NNGLO) 235 : NMQUA=MYLRF.NUMCMP(IDDL) 236 : NMLOC=KRINCO.LECT(NMQUA) 237 : IF (NNLOC.EQ.0.OR.NMLOC.EQ.0) THEN 238 : CONTRI=0.D0 239 : ELSE 240 : LDDLEX=MYMTRA.IBIN(NMLOC,NNLOC).EQ.1 241 : IF (.NOT.LDDLEX) THEN 242 : CONTRI=0.D0 243 : ELSE 244 : LWARN=.FALSE. 245 : CONTRI=MYMTRA.BB(NMLOC,NNLOC) 246 : ENDIF 247 : ENDIF 248 : MZMCHA.VELCHE(1,IDDL,1,1,1,IBEL)=CONTRI 249 : ENDDO 250 : ENDDO 251 : SEGDES MZMCHA 252 : * SEGPRT,MZMCHA 253 : MYMCHA.ICHEVA(ISOUS)=MZMCHA 254 : SEGDES MYLRF 255 : SEGDES SOUMAI 256 : MYMCHA.IMACHE(ISOUS)=SOUMAI 257 : 1 CONTINUE 258 : SEGDES MYMCHA 259 : SEGDES CGEOME 260 : SEGSUP KRINCO 261 : SEGDES MYLMOT 262 : SEGSUP KRIGEO 263 : SEGSUP MYMTRA 264 : * IMPR=6 265 : IF (IMPR.GT.3) THEN 266 : WRITE(IOIMP,*) 'On a créé', 267 : $ ' MYMCHA(élément ,1, 1 , 1 ,1, ddl)' 267 : CALL PRCAEL(MYMCHA,IMPR,IRET) 268 : IF (IRET.NE.0) GOTO 9999 269 : ENDIF 270 : * 271 : * Warning 272 : * 273 : IF (LWARN.AND.(.NOT.LVIDE)) THEN 274 : WRITE(IOIMP,*) 'Error : no values of the given CHPOINT', 275 : $ ' were used' 276 : GOTO 9999 277 : ENDIF 278 : ENDIF 279 : * 280 : * Normal termination 281 : * 282 : IRET=0 283 : RETURN 284 : * 285 : * Format handling 286 : * 287 : * 288 : * Error handling 289 : * 290 : 9999 CONTINUE 291 : IRET=1 292 : WRITE(IOIMP,*) 'An error was detected in subroutine cp2cv7' 293 : RETURN 294 : * 295 : * End of subroutine CP2CV7 296 : * 297 : END 298 : 299 : 300 : 301 :
© Cast3M 2003 - All rights reserved.
Disclaimer