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