1 : C INQRPR SOURCE CHAT 07/10/29 21:20:56 5940 2 : SUBROUTINE INQRPR(MYQRFS,IMPR,IRET) 3 : IMPLICIT REAL*8 (A-H,O-Z) 4 : IMPLICIT INTEGER (I-N) 5 : C*********************************************************************** 6 : C NOM : INQRPR 7 : C PROJET : Noyau linéaire NLIN 8 : C DESCRIPTION : 9 : C LANGAGE : ESOPE 10 : C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) 11 : C mél : gounand@semt2.smts.cea.fr 12 : C*********************************************************************** 13 : C APPELES : 14 : C APPELE PAR : 15 : C*********************************************************************** 16 : C ENTREES : - 17 : C ENTREES/SORTIES : 18 : C SORTIES : - 19 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé 20 : C*********************************************************************** 21 : C VERSION : v1, 15/03/04, version initiale 22 : C HISTORIQUE : v1, 15/03/04, création 23 : C HISTORIQUE : 24 : C HISTORIQUE : 25 : C*********************************************************************** 26 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 27 : C en cas de modification de ce sous-programme afin de faciliter 28 : C la maintenance ! 29 : C*********************************************************************** 30 : -INC CCOPTIO 31 : -INC CCGEOME 32 : CBEGININCLUDE SIQUAF 33 : SEGMENT IQUAF 34 : INTEGER NUMQUF 35 : REAL*8 XCONQR(NDIMQR,NBNOQR) 36 : INTEGER NUCENT 37 : POINTEUR LFACE.MELEME 38 : ENDSEGMENT 39 : SEGMENT IQUAFS 40 : POINTEUR LISQRF(NBQRF).IQUAF 41 : ENDSEGMENT 42 : CENDINCLUDE SIQUAF 43 : POINTEUR MYQRFS.IQUAFS 44 : POINTEUR QRCOUR.IQUAF 45 : INTEGER NDIMQR,NBNOQR 46 : -INC SMELEME 47 : POINTEUR MYMEL.MELEME 48 : POINTEUR SOUMEL.MELEME 49 : INTEGER NBNN,NBELEM,NBSOUS,NBREF 50 : -INC SMLENTI 51 : POINTEUR INOD.MLENTI 52 : -INC SMLREEL 53 : POINTEUR ZVAL.MLREEL 54 : POINTEUR YVAL.MLREEL 55 : POINTEUR XVAL.MLREEL 56 : * 57 : INTEGER IMPR,IRET 58 : REAL*8 ZERO,UN 59 : REAL*8 UNS3 60 : REAL*8 UNS2 61 : PARAMETER (UNS3=1.D0/3.D0) 62 : PARAMETER (UNS2=1.D0/2.D0) 63 : PARAMETER (ZERO=0.D0,UN=1.D0) 64 : * 65 : INTEGER NUMER 66 : * 67 : * Executable statements 68 : * 69 : IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans inqrpr' 70 : * 71 : * Elément QUAF PR21 72 : * 73 : NDIMQR=3 74 : NBNOQR=21 75 : SEGINI QRCOUR 76 : * Numéro de l'élément géométrique dans NOMS 77 : * NOMS(1:NOMBR) sont les noms des types d'éléments géométriques, 78 : * cf. include CCGEOME 78 : CALL FICH4('PR21',NOMS,NOMBR, 79 : $ NUMER, 80 : $ IMPR,IRET) 81 : IF (IRET.NE.0) GOTO 9999 82 : QRCOUR.NUMQUF=NUMER 83 : * 84 : * Coordonnées des noeuds du QUAF de référence 85 : * 86 : JG=21 87 : SEGINI INOD 88 : DO IDDL=1,6 89 : INOD.LECT(IDDL)=IDDL 90 : ENDDO 91 : INOD.LECT( 7)=19 92 : INOD.LECT( 8)= 7 93 : INOD.LECT( 9)=16 94 : INOD.LECT(10)= 8 95 : INOD.LECT(11)=17 96 : INOD.LECT(12)= 9 97 : INOD.LECT(13)=18 98 : INOD.LECT(14)=21 99 : DO IDDL=15,20 100 : INOD.LECT(IDDL)=IDDL-5 101 : ENDDO 102 : INOD.LECT(21)=20 103 : * 104 : JG=3 105 : SEGINI ZVAL 106 : ZVAL.PROG(1)=-UN 107 : ZVAL.PROG(2)=ZERO 108 : ZVAL.PROG(3)=UN 109 : JG=7 110 : SEGINI XVAL 111 : SEGINI YVAL 112 : XVAL.PROG(1)=ZERO 113 : YVAL.PROG(1)=ZERO 114 : XVAL.PROG(2)=UNS2 115 : YVAL.PROG(2)=ZERO 116 : XVAL.PROG(3)=UN 117 : YVAL.PROG(3)=ZERO 118 : XVAL.PROG(4)=UNS2 119 : YVAL.PROG(4)=UNS2 120 : XVAL.PROG(5)=ZERO 121 : YVAL.PROG(5)=UN 122 : XVAL.PROG(6)=ZERO 123 : YVAL.PROG(6)=UNS2 124 : XVAL.PROG(7)=UNS3 125 : YVAL.PROG(7)=UNS3 126 : ICPT=0 127 : DO IZ=1,3 128 : DO IT=1,7 129 : ICPT=ICPT+1 130 : JNOD=INOD.LECT(ICPT) 131 : QRCOUR.XCONQR(1,JNOD)=XVAL.PROG(IT) 132 : QRCOUR.XCONQR(2,JNOD)=YVAL.PROG(IT) 133 : QRCOUR.XCONQR(3,JNOD)=ZVAL.PROG(IZ) 134 : ENDDO 135 : ENDDO 136 : SEGSUP ZVAL 137 : SEGSUP YVAL 138 : SEGSUP XVAL 139 : SEGSUP INOD 140 : * 141 : * Numero du centre 142 : * 143 : QRCOUR.NUCENT=21 144 : * 145 : * Faces du PR21 : 2 TRI7 + 3 QUA9 146 : * 147 : * Chapeau 148 : NBNN=0 149 : NBELEM=0 150 : NBSOUS=2 151 : NBREF=0 152 : SEGINI MYMEL 153 : * 2 Faces TRI7 154 : NBNN=7 155 : NBELEM=2 156 : NBSOUS=0 157 : NBREF=0 158 : SEGINI SOUMEL 158 : CALL FICH4('TRI7',NOMS,NOMBR, 159 : $ NUMER, 160 : $ IMPR,IRET) 161 : IF (IRET.NE.0) GOTO 9999 162 : SOUMEL.ITYPEL=NUMER 163 : * Face 1 164 : SOUMEL.NUM(1,1)=1 165 : SOUMEL.NUM(2,1)=2 166 : SOUMEL.NUM(3,1)=3 167 : SOUMEL.NUM(4,1)=4 168 : SOUMEL.NUM(5,1)=5 169 : SOUMEL.NUM(6,1)=6 170 : SOUMEL.NUM(7,1)=19 171 : * Face 2 172 : SOUMEL.NUM(1,2)=10 173 : SOUMEL.NUM(2,2)=11 174 : SOUMEL.NUM(3,2)=12 175 : SOUMEL.NUM(4,2)=13 176 : SOUMEL.NUM(5,2)=14 177 : SOUMEL.NUM(6,2)=15 178 : SOUMEL.NUM(7,2)=20 179 : SEGDES SOUMEL 180 : MYMEL.LISOUS(1)=SOUMEL 181 : * 3 Faces QUA9 182 : NBNN=9 183 : NBELEM=3 184 : NBSOUS=0 185 : NBREF=0 186 : SEGINI SOUMEL 186 : CALL FICH4('QUA9',NOMS,NOMBR, 187 : $ NUMER, 188 : $ IMPR,IRET) 189 : IF (IRET.NE.0) GOTO 9999 190 : SOUMEL.ITYPEL=NUMER 191 : * Face 1 192 : SOUMEL.NUM(1,1)=1 193 : SOUMEL.NUM(2,1)=2 194 : SOUMEL.NUM(3,1)=3 195 : SOUMEL.NUM(4,1)=8 196 : SOUMEL.NUM(5,1)=12 197 : SOUMEL.NUM(6,1)=11 198 : SOUMEL.NUM(7,1)=10 199 : SOUMEL.NUM(8,1)=7 200 : SOUMEL.NUM(9,1)=16 201 : * Face 2 202 : SOUMEL.NUM(1,2)=3 203 : SOUMEL.NUM(2,2)=4 204 : SOUMEL.NUM(3,2)=5 205 : SOUMEL.NUM(4,2)=9 206 : SOUMEL.NUM(5,2)=14 207 : SOUMEL.NUM(6,2)=13 208 : SOUMEL.NUM(7,2)=12 209 : SOUMEL.NUM(8,2)=8 210 : SOUMEL.NUM(9,2)=17 211 : * Face 3 212 : SOUMEL.NUM(1,3)=5 213 : SOUMEL.NUM(2,3)=6 214 : SOUMEL.NUM(3,3)=1 215 : SOUMEL.NUM(4,3)=7 216 : SOUMEL.NUM(5,3)=10 217 : SOUMEL.NUM(6,3)=15 218 : SOUMEL.NUM(7,3)=14 219 : SOUMEL.NUM(8,3)=9 220 : SOUMEL.NUM(9,3)=18 221 : SEGDES SOUMEL 222 : MYMEL.LISOUS(2)=SOUMEL 223 : SEGDES MYMEL 224 : QRCOUR.LFACE=MYMEL 225 : SEGDES QRCOUR 226 : MYQRFS.LISQRF(**)=QRCOUR 227 : * 228 : * Normal termination 229 : * 230 : IRET=0 231 : RETURN 232 : * 233 : * Format handling 234 : * 235 : * 236 : * Error handling 237 : * 238 : 9999 CONTINUE 239 : IRET=1 240 : WRITE(IOIMP,*) 'An error was detected in subroutine inqrpr' 241 : RETURN 242 : * 243 : * End of subroutine INQRPR 244 : * 245 : END 246 : 247 : 248 : 249 :
© Cast3M 2003 - All rights reserved.
Disclaimer