1 : C CV2CP9 SOURCE GOUNAND 07/10/10 21:15:01 5886 2 : SUBROUTINE CV2CP9(MYDISC,MYLMOT,MYMCHA, 3 : $ MYFALS, 4 : $ MYCHPO, 5 : $ IMPR,IRET) 6 : IMPLICIT REAL*8 (A-H,O-Z) 7 : IMPLICIT INTEGER (I-N) 8 : C*********************************************************************** 9 : C NOM : CV2CP9 10 : C DESCRIPTION : Transforme un MCHAEL en MCHPOI 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 : PRLS92 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, 07/10/02, version initiale 36 : C HISTORIQUE : v1, 07/10/02, 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 SOUMAI.MELEME 53 : POINTEUR MELTOT.MELEME 54 : POINTEUR SMLTOT.MELEME 55 : POINTEUR ML1TOT.MELEME 56 : INTEGER NBNN,NBELEM,NBSOUS,NBREF 57 : -INC SMLMOTS 58 : POINTEUR MYLMOT.MLMOTS 59 : -INC SMLENTI 60 : POINTEUR KRIGEO.MLENTI 61 : INTEGER JG 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 MYMCHA.MCHAEL 78 : POINTEUR MZMCHA.MCHEVA 79 : CBEGININCLUDE SFALRF 80 : SEGMENT FALRF 81 : CHARACTER*(LNNFA) NOMFA 82 : INTEGER NUQUAF(NBLRF) 83 : POINTEUR ELEMF(NBLRF).ELREF 84 : ENDSEGMENT 85 : SEGMENT FALRFS 86 : POINTEUR LISFA(0).FALRF 87 : ENDSEGMENT 88 : CENDINCLUDE SFALRF 89 : POINTEUR MYFALS.FALRFS 90 : CBEGININCLUDE SELREF 91 : SEGMENT ELREF 92 : CHARACTER*(LNNOM) NOMLRF 93 : CHARACTER*(LNFORM) FORME 94 : CHARACTER*(LNTYPL) TYPEL 95 : CHARACTER*(LNESP) ESPACE 96 : INTEGER DEGRE 97 : REAL*8 XCONOD(NDIMEL,NBNOD) 98 : INTEGER NPQUAF(NBDDL) 99 : INTEGER NUMCMP(NBDDL) 100 : INTEGER QUENOD(NBDDL) 101 : INTEGER ORDDER(NDIMEL,NBDDL) 102 : POINTEUR MBPOLY.POLYNS 103 : ENDSEGMENT 104 : SEGMENT ELREFS 105 : POINTEUR LISEL(0).ELREF 106 : ENDSEGMENT 107 : CENDINCLUDE SELREF 108 : POINTEUR MYLRF.ELREF 109 : * 110 : * Includes persos 111 : * 112 : * Liste de MELEME 113 : INTEGER NBMEL 114 : SEGMENT MELS 115 : POINTEUR LISMEL(NBMEL).MELEME 116 : ENDSEGMENT 117 : POINTEUR GPMELS.MELS 118 : * 119 : CHARACTER*(4) MYDISC 120 : INTEGER IMPR,IRET 121 : * 122 : INTEGER NDLIG,NDCOL,N2DLIG,N2DCOL,NDNOEU,NDELM 123 : INTEGER IDELM 124 : INTEGER IBEL,IDDL,ISOUS,ITQUAF 125 : INTEGER NBEL,NDDL,NSOUS 126 : INTEGER NNGLO,NNLOC,NNQUA 127 : INTEGER ININ,INNOE 128 : INTEGER NTOGPO 129 : * 130 : * Executable statements 131 : * 132 : IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans cv2cp9' 133 : 134 : 135 : * 136 : * Création de MELTOT maillage des points sur lesquels reposent les ddl 137 : * (il y a des doublons) 138 : * 139 : SEGACT MYMCHA 140 : * SEGPRT,MYMCHA 141 : NSOUS=MYMCHA.IMACHE(/1) 142 : * 143 : NBNN=0 144 : NBELEM=0 145 : NBSOUS=NSOUS 146 : NBREF=0 147 : SEGINI,MELTOT 148 : DO 1 ISOUS=1,NSOUS 149 : SOUMAI=MYMCHA.IMACHE(ISOUS) 150 : SEGACT SOUMAI 151 : * On cherche l'élément fini correspondant au QUAF 152 : ITQUAF=SOUMAI.ITYPEL 152 : CALL KEEF(ITQUAF,MYDISC, 153 : $ MYFALS, 154 : $ MYLRF, 155 : $ IMPR,IRET) 156 : IF (IRET.NE.0) GOTO 9999 157 : SEGACT MYLRF 158 : NDDL=MYLRF.NPQUAF(/1) 159 : NBEL=SOUMAI.NUM(/2) 160 : * 161 : NBNN=NDDL 162 : NBELEM=NBEL 163 : NBSOUS=0 164 : NBREF=0 165 : SEGINI,SMLTOT 166 : DO IBEL=1,NBEL 167 : DO IDDL=1,NDDL 168 : NNQUA=MYLRF.NPQUAF(IDDL) 169 : NNGLO=SOUMAI.NUM(NNQUA,IBEL) 170 : SMLTOT.NUM(IDDL,IBEL)=NNGLO 171 : ENDDO 172 : ENDDO 173 : SEGDES,SMLTOT 174 : MELTOT.LISOUS(ISOUS)=SMLTOT 175 : SEGDES,MYLRF 176 : SEGDES,SOUMAI 177 : 1 CONTINUE 178 : SEGDES,MELTOT 179 : SEGDES,MYMCHA 180 : * 181 : * On construit ML1TOT, ensemble des points de MELTOT 182 : * 183 : NBMEL=1 184 : SEGINI,GPMELS 185 : GPMELS.LISMEL(1)=MELTOT 185 : CALL MLUNIQ(GPMELS,ML1TOT, 186 : $ IMPR,IRET) 187 : IF (IRET.NE.0) GOTO 9999 188 : SEGSUP,GPMELS 189 : * 190 : * Destruction de MELTOT 191 : * 192 : SEGACT,MELTOT*MOD 193 : DO 3 ISOUS=1,NSOUS 194 : SMLTOT=MELTOT.LISOUS(ISOUS) 195 : * SEGACT,SMLTOT 196 : SEGSUP,SMLTOT 197 : 3 CONTINUE 198 : SEGSUP,MELTOT 199 : * 200 : * Initialisation de MYMTRA 201 : * 202 : SEGACT MYLMOT 203 : NNIN=MYLMOT.MOTS(/2) 204 : SEGACT ML1TOT 205 : NNNOE=ML1TOT.NUM(/2) 206 : SEGINI,MYMTRA 207 : * Remplissage de MYMTRA.INCO et MYMTRA.IGEO 208 : DO ININ=1,NNIN 209 : MYMTRA.INCO(ININ)=MYLMOT.MOTS(ININ) 210 : ENDDO 211 : DO INNOE=1,NNNOE 212 : MYMTRA.IGEO(INNOE)=ML1TOT.NUM(1,INNOE) 213 : ENDDO 214 : SEGSUP,ML1TOT 215 : SEGDES,MYLMOT 216 : * Création du segment de repérage dans MYMTRA.IGEO 217 : NTOGPO=XCOOR(/1)/(IDIM+1) 218 : JG=NTOGPO 219 : SEGINI,KRIGEO 219 : CALL RSETEE(MYMTRA.IGEO,NNNOE, 220 : $ KRIGEO.LECT,NTOGPO, 221 : $ IMPR,IRET) 222 : IF (IRET.NE.0) GOTO 9999 223 : * Remplissage de MYMTRA.BB et MYMTRA.IBIN 224 : SEGACT,MYMCHA 225 : DO 5 ISOUS=1,NSOUS 226 : SOUMAI=MYMCHA.IMACHE(ISOUS) 227 : SEGACT,SOUMAI 228 : MZMCHA=MYMCHA.ICHEVA(ISOUS) 229 : IF (MZMCHA.NE.0) THEN 230 : SEGACT,MZMCHA 231 : * On cherche l'élément fini correspondant au QUAF 232 : ITQUAF=SOUMAI.ITYPEL 232 : CALL KEEF(ITQUAF,MYDISC, 233 : $ MYFALS, 234 : $ MYLRF, 235 : $ IMPR,IRET) 236 : IF (IRET.NE.0) GOTO 9999 237 : SEGACT MYLRF 238 : NDDL=MYLRF.NPQUAF(/1) 239 : NBEL=SOUMAI.NUM(/2) 240 : * Petits tests 241 : NDLIG=MZMCHA.VELCHE(/1) 242 : NDCOL=MZMCHA.VELCHE(/2) 243 : N2DLIG=MZMCHA.VELCHE(/3) 244 : N2DCOL=MZMCHA.VELCHE(/4) 245 : NDNOEU=MZMCHA.VELCHE(/5) 246 : NDELM=MZMCHA.VELCHE(/6) 247 : IF (.NOT.( (NDLIG.EQ.1.AND.NDCOL.EQ.NDDL) 248 : $ .OR. (NDLIG.EQ.NDDL.AND.NDCOL.EQ.1)) 249 : $ .OR.N2DLIG.NE.1 250 : $ .OR.N2DCOL.NE.1.OR.NDNOEU.NE.1 251 : $ .OR.(NDELM.NE.1.AND.NDELM.NE.NBEL)) THEN 252 : WRITE(IOIMP,*) 'Erreur dims MZMCHA' 253 : GOTO 9999 254 : ENDIF 255 : 256 : DO IBEL=1,NBEL 257 : IF (NDELM.EQ.1) THEN 258 : IDELM=1 259 : ELSE 260 : IDELM=IBEL 261 : ENDIF 262 : DO IDDL=1,NDDL 263 : IF (NDLIG.EQ.1) THEN 264 : ILIG=1 265 : ICOL=IDDL 266 : ELSE 267 : ILIG=IDDL 268 : ICOL=1 269 : ENDIF 270 : NNQUA=MYLRF.NPQUAF(IDDL) 271 : NNGLO=SOUMAI.NUM(NNQUA,IBEL) 272 : NNLOC=KRIGEO.LECT(NNGLO) 273 : IF (NNLOC.EQ.0) THEN 274 : WRITE(IOIMP,*) 'Erreur de programmation 1' 275 : GOTO 9999 276 : ENDIF 277 : ININ=MYLRF.NUMCMP(IDDL) 278 : MYMTRA.IBIN(ININ,NNLOC)=1 279 : MYMTRA.BB(ININ,NNLOC)=MYMTRA.BB(ININ,NNLOC) 280 : $ +MZMCHA.VELCHE(ILIG,ICOL,1,1,1,IDELM) 281 : ENDDO 282 : ENDDO 283 : SEGDES,MYLRF 284 : SEGDES,MZMCHA 285 : ENDIF 286 : SEGDES,SOUMAI 287 : 5 CONTINUE 288 : SEGDES,MYMCHA 289 : SEGSUP,KRIGEO 290 : * 291 : * Transformation l'objet MTRAV en chpoint 292 : * 292 : CALL CRECHP(MYMTRA,MYCHPO) 293 : SEGSUP MYMTRA 294 : SEGACT MYCHPO*MOD 295 : MYCHPO.JATTRI(1)=2 296 : SEGDES MYCHPO 297 : * IMPR=6 298 : IF (IMPR.GT.3) THEN 299 : WRITE(IOIMP,*) 'On a créé MYCHPO=',MYCHPO 299 : CALL ECROBJ('CHPOINT ',MYCHPO) 299 : CALL PRLIST 300 : ENDIF 301 : * IMPR=0 302 : * 303 : * Normal termination 304 : * 305 : IRET=0 306 : RETURN 307 : * 308 : * Format handling 309 : * 310 : * 311 : * Error handling 312 : * 313 : 9999 CONTINUE 314 : IRET=1 315 : WRITE(IOIMP,*) 'An error was detected in subroutine cv2cp9' 316 : RETURN 317 : * 318 : * End of subroutine CV2CP9 319 : * 320 : END 321 : 322 : 323 :
© Cast3M 2003 - All rights reserved.
Disclaimer