1 : C INQRPY SOURCE CHAT 07/10/29 21:20:58 5940 2 : SUBROUTINE INQRPY(MYQRFS,IMPR,IRET) 3 : IMPLICIT REAL*8 (A-H,O-Z) 4 : IMPLICIT INTEGER (I-N) 5 : C*********************************************************************** 6 : C NOM : INQRPY 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, 01/08/06, version initiale 22 : C HISTORIQUE : v1, 01/08/06, 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 : * 51 : INTEGER IMPR,IRET 52 : REAL*8 ZERO,UN,UNS3,UNS2,UNS4 53 : * 54 : PARAMETER (ZERO=0.D0,UN=1.D0,UNS3=1.D0/3.D0,UNS2=1.D0/2.D0) 55 : PARAMETER (UNS5=1.D0/5.D0) 56 : * 57 : INTEGER NUMER 58 : * 59 : * Executable statements 60 : * 61 : IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans inqrpy' 62 : * 63 : * Elément QUAF PY19 64 : * 65 : 66 : NDIMQR=3 67 : NBNOQR=19 68 : SEGINI QRCOUR 69 : * Numéro de l'élément géométrique dans NOMS 70 : * NOMS(1:NOMBR) sont les noms des types d'éléments géométriques, 71 : * cf. include CCGEOME 71 : CALL FICH4('PY19',NOMS,NOMBR, 72 : $ NUMER, 73 : $ IMPR,IRET) 74 : IF (IRET.NE.0) GOTO 9999 75 : QRCOUR.NUMQUF=NUMER 76 : * 77 : * Coordonnées des noeuds du QUAF de référence 78 : * 79 : QRCOUR.XCONQR(1,1)=UN 80 : QRCOUR.XCONQR(2,1)=ZERO 81 : QRCOUR.XCONQR(3,1)=ZERO 82 : QRCOUR.XCONQR(1,2)=UNS2 83 : QRCOUR.XCONQR(2,2)=UNS2 84 : QRCOUR.XCONQR(3,2)=ZERO 85 : QRCOUR.XCONQR(1,3)=ZERO 86 : QRCOUR.XCONQR(2,3)=UN 87 : QRCOUR.XCONQR(3,3)=ZERO 88 : QRCOUR.XCONQR(1,4)=-UNS2 89 : QRCOUR.XCONQR(2,4)=UNS2 90 : QRCOUR.XCONQR(3,4)=ZERO 91 : QRCOUR.XCONQR(1,5)=-UN 92 : QRCOUR.XCONQR(2,5)=ZERO 93 : QRCOUR.XCONQR(3,5)=ZERO 94 : QRCOUR.XCONQR(1,6)=-UNS2 95 : QRCOUR.XCONQR(2,6)=-UNS2 96 : QRCOUR.XCONQR(3,6)=ZERO 97 : QRCOUR.XCONQR(1,7)=ZERO 98 : QRCOUR.XCONQR(2,7)=-UN 99 : QRCOUR.XCONQR(3,7)=ZERO 100 : QRCOUR.XCONQR(1,8)=UNS2 101 : QRCOUR.XCONQR(2,8)=-UNS2 102 : QRCOUR.XCONQR(3,8)=ZERO 103 : * 104 : QRCOUR.XCONQR(1,9)=UNS2 105 : QRCOUR.XCONQR(2,9)=ZERO 106 : QRCOUR.XCONQR(3,9)=UNS2 107 : QRCOUR.XCONQR(1,10)=ZERO 108 : QRCOUR.XCONQR(2,10)=UNS2 109 : QRCOUR.XCONQR(3,10)=UNS2 110 : QRCOUR.XCONQR(1,11)=-UNS2 111 : QRCOUR.XCONQR(2,11)=ZERO 112 : QRCOUR.XCONQR(3,11)=UNS2 113 : QRCOUR.XCONQR(1,12)=ZERO 114 : QRCOUR.XCONQR(2,12)=-UNS2 115 : QRCOUR.XCONQR(3,12)=ZERO 116 : * 117 : QRCOUR.XCONQR(1,13)=ZERO 118 : QRCOUR.XCONQR(2,13)=ZERO 119 : QRCOUR.XCONQR(3,13)=UN 120 : QRCOUR.XCONQR(1,14)=ZERO 121 : QRCOUR.XCONQR(2,14)=ZERO 122 : QRCOUR.XCONQR(3,14)=ZERO 123 : * 124 : QRCOUR.XCONQR(1,15)=UNS3 125 : QRCOUR.XCONQR(2,15)=UNS3 126 : QRCOUR.XCONQR(3,15)=UNS3 127 : QRCOUR.XCONQR(1,16)=-UNS3 128 : QRCOUR.XCONQR(2,16)=UNS3 129 : QRCOUR.XCONQR(3,16)=UNS3 130 : QRCOUR.XCONQR(1,17)=-UNS3 131 : QRCOUR.XCONQR(2,17)=-UNS3 132 : QRCOUR.XCONQR(3,17)=UNS3 133 : QRCOUR.XCONQR(1,18)=UNS3 134 : QRCOUR.XCONQR(2,18)=-UNS3 135 : QRCOUR.XCONQR(3,18)=UNS3 136 : * 137 : QRCOUR.XCONQR(1,19)=ZERO 138 : QRCOUR.XCONQR(2,19)=ZERO 139 : QRCOUR.XCONQR(3,19)=UNS5 140 : 141 : * 142 : * Numero du centre 143 : * 144 : QRCOUR.NUCENT=19 145 : * 146 : * Faces du PY19 : 1 QUA9 + 4 TRI7 147 : * 148 : * Chapeau 149 : NBNN=0 150 : NBELEM=0 151 : NBSOUS=2 152 : NBREF=0 153 : SEGINI MYMEL 154 : * Face QUA9 155 : NBNN=9 156 : NBELEM=1 157 : NBSOUS=0 158 : NBREF=0 159 : SEGINI SOUMEL 159 : CALL FICH4('QUA9',NOMS,NOMBR, 160 : $ NUMER, 161 : $ IMPR,IRET) 162 : IF (IRET.NE.0) GOTO 9999 163 : SOUMEL.ITYPEL=NUMER 164 : * Face 1 165 : SOUMEL.NUM(1,1)=1 166 : SOUMEL.NUM(2,1)=2 167 : SOUMEL.NUM(3,1)=3 168 : SOUMEL.NUM(4,1)=4 169 : SOUMEL.NUM(5,1)=5 170 : SOUMEL.NUM(6,1)=6 171 : SOUMEL.NUM(7,1)=7 172 : SOUMEL.NUM(8,1)=8 173 : SOUMEL.NUM(9,1)=14 174 : * 175 : SEGDES SOUMEL 176 : MYMEL.LISOUS(1)=SOUMEL 177 : * 4 Faces TRI7 178 : NBNN=7 179 : NBELEM=4 180 : NBSOUS=0 181 : NBREF=0 182 : SEGINI SOUMEL 182 : CALL FICH4('TRI7',NOMS,NOMBR, 183 : $ NUMER, 184 : $ IMPR,IRET) 185 : IF (IRET.NE.0) GOTO 9999 186 : SOUMEL.ITYPEL=NUMER 187 : * Face 1 188 : SOUMEL.NUM(1,1)=1 189 : SOUMEL.NUM(2,1)=2 190 : SOUMEL.NUM(3,1)=3 191 : SOUMEL.NUM(4,1)=10 192 : SOUMEL.NUM(5,1)=13 193 : SOUMEL.NUM(6,1)=9 194 : SOUMEL.NUM(7,1)=15 195 : * Face 2 196 : SOUMEL.NUM(1,2)=3 197 : SOUMEL.NUM(2,2)=4 198 : SOUMEL.NUM(3,2)=5 199 : SOUMEL.NUM(4,2)=11 200 : SOUMEL.NUM(5,2)=13 201 : SOUMEL.NUM(6,2)=10 202 : SOUMEL.NUM(7,2)=16 203 : * Face 3 204 : SOUMEL.NUM(1,3)=5 205 : SOUMEL.NUM(2,3)=6 206 : SOUMEL.NUM(3,3)=7 207 : SOUMEL.NUM(4,3)=12 208 : SOUMEL.NUM(5,3)=13 209 : SOUMEL.NUM(6,3)=11 210 : SOUMEL.NUM(7,3)=17 211 : * Face 4 212 : SOUMEL.NUM(1,4)=7 213 : SOUMEL.NUM(2,4)=8 214 : SOUMEL.NUM(3,4)=1 215 : SOUMEL.NUM(4,4)=9 216 : SOUMEL.NUM(5,4)=13 217 : SOUMEL.NUM(6,4)=12 218 : SOUMEL.NUM(7,4)=18 219 : * 220 : SEGDES SOUMEL 221 : MYMEL.LISOUS(2)=SOUMEL 222 : SEGDES MYMEL 223 : QRCOUR.LFACE=MYMEL 224 : SEGDES QRCOUR 225 : MYQRFS.LISQRF(**)=QRCOUR 226 : * 227 : * Normal termination 228 : * 229 : IRET=0 230 : RETURN 231 : * 232 : * Format handling 233 : * 234 : * 235 : * Error handling 236 : * 237 : 9999 CONTINUE 238 : IRET=1 239 : WRITE(IOIMP,*) 'An error was detected in subroutine inqrpy' 240 : RETURN 241 : * 242 : * End of subroutine INQRPY 243 : * 244 : END 245 : 246 : 247 : 248 :
© Cast3M 2003 - All rights reserved.
Disclaimer