1 : C INQRTE SOURCE CHAT 07/10/29 21:21:05 5940 2 : SUBROUTINE INQRTE(MYQRFS,IMPR,IRET) 3 : IMPLICIT REAL*8 (A-H,O-Z) 4 : IMPLICIT INTEGER (I-N) 5 : C*********************************************************************** 6 : C NOM : INQRTE 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, 17/10/02, version initiale 22 : C HISTORIQUE : v1, 17/10/02, 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 (UNS4=1.D0/4.D0) 56 : * 57 : INTEGER NUMER 58 : * 59 : * Executable statements 60 : * 61 : IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans inqrte' 62 : * 63 : * Elément QUAF TE15 64 : * 65 : 66 : NDIMQR=3 67 : NBNOQR=15 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('TE15',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)=ZERO 80 : QRCOUR.XCONQR(2,1)=ZERO 81 : QRCOUR.XCONQR(3,1)=ZERO 82 : QRCOUR.XCONQR(1,2)=UNS2 83 : QRCOUR.XCONQR(2,2)=ZERO 84 : QRCOUR.XCONQR(3,2)=ZERO 85 : QRCOUR.XCONQR(1,3)=UN 86 : QRCOUR.XCONQR(2,3)=ZERO 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)=ZERO 92 : QRCOUR.XCONQR(2,5)=UN 93 : QRCOUR.XCONQR(3,5)=ZERO 94 : QRCOUR.XCONQR(1,6)=ZERO 95 : QRCOUR.XCONQR(2,6)=UNS2 96 : QRCOUR.XCONQR(3,6)=ZERO 97 : * 98 : QRCOUR.XCONQR(1,7)=ZERO 99 : QRCOUR.XCONQR(2,7)=ZERO 100 : QRCOUR.XCONQR(3,7)=UNS2 101 : QRCOUR.XCONQR(1,8)=UNS2 102 : QRCOUR.XCONQR(2,8)=ZERO 103 : QRCOUR.XCONQR(3,8)=UNS2 104 : QRCOUR.XCONQR(1,9)=ZERO 105 : QRCOUR.XCONQR(2,9)=UNS2 106 : QRCOUR.XCONQR(3,9)=UNS2 107 : QRCOUR.XCONQR(1,10)=ZERO 108 : QRCOUR.XCONQR(2,10)=ZERO 109 : QRCOUR.XCONQR(3,10)=UN 110 : * 111 : QRCOUR.XCONQR(1,11)=UNS3 112 : QRCOUR.XCONQR(2,11)=UNS3 113 : QRCOUR.XCONQR(3,11)=ZERO 114 : QRCOUR.XCONQR(1,12)=UNS3 115 : QRCOUR.XCONQR(2,12)=ZERO 116 : QRCOUR.XCONQR(3,12)=UNS3 117 : QRCOUR.XCONQR(1,13)=UNS3 118 : QRCOUR.XCONQR(2,13)=UNS3 119 : QRCOUR.XCONQR(3,13)=UNS3 120 : QRCOUR.XCONQR(1,14)=ZERO 121 : QRCOUR.XCONQR(2,14)=UNS3 122 : QRCOUR.XCONQR(3,14)=UNS3 123 : QRCOUR.XCONQR(1,15)=UNS4 124 : QRCOUR.XCONQR(2,15)=UNS4 125 : QRCOUR.XCONQR(3,15)=UNS4 126 : * 127 : * Numero du centre 128 : * 129 : QRCOUR.NUCENT=15 130 : * 131 : * Faces du TE15 : 4 TRI7 132 : * 133 : * Chapeau 134 : NBNN=0 135 : NBELEM=0 136 : NBSOUS=1 137 : NBREF=0 138 : SEGINI MYMEL 139 : * Faces TRI7 140 : NBNN=7 141 : NBELEM=4 142 : NBSOUS=0 143 : NBREF=0 144 : SEGINI SOUMEL 144 : CALL FICH4('TRI7',NOMS,NOMBR, 145 : $ NUMER, 146 : $ IMPR,IRET) 147 : IF (IRET.NE.0) GOTO 9999 148 : SOUMEL.ITYPEL=NUMER 149 : * Face 1 150 : SOUMEL.NUM(1,1)=1 151 : SOUMEL.NUM(2,1)=2 152 : SOUMEL.NUM(3,1)=3 153 : SOUMEL.NUM(4,1)=4 154 : SOUMEL.NUM(5,1)=5 155 : SOUMEL.NUM(6,1)=6 156 : SOUMEL.NUM(7,1)=11 157 : * Face 2 158 : SOUMEL.NUM(1,2)=1 159 : SOUMEL.NUM(2,2)=2 160 : SOUMEL.NUM(3,2)=3 161 : SOUMEL.NUM(4,2)=8 162 : SOUMEL.NUM(5,2)=10 163 : SOUMEL.NUM(6,2)=7 164 : SOUMEL.NUM(7,2)=12 165 : * Face 3 166 : SOUMEL.NUM(1,3)=3 167 : SOUMEL.NUM(2,3)=4 168 : SOUMEL.NUM(3,3)=5 169 : SOUMEL.NUM(4,3)=9 170 : SOUMEL.NUM(5,3)=10 171 : SOUMEL.NUM(6,3)=8 172 : SOUMEL.NUM(7,3)=13 173 : * Face 4 174 : SOUMEL.NUM(1,4)=1 175 : SOUMEL.NUM(2,4)=6 176 : SOUMEL.NUM(3,4)=5 177 : SOUMEL.NUM(4,4)=9 178 : SOUMEL.NUM(5,4)=10 179 : SOUMEL.NUM(6,4)=7 180 : SOUMEL.NUM(7,4)=14 181 : * 182 : SEGDES SOUMEL 183 : MYMEL.LISOUS(1)=SOUMEL 184 : SEGDES MYMEL 185 : QRCOUR.LFACE=MYMEL 186 : SEGDES QRCOUR 187 : MYQRFS.LISQRF(**)=QRCOUR 188 : * 189 : * Normal termination 190 : * 191 : IRET=0 192 : RETURN 193 : * 194 : * Format handling 195 : * 196 : * 197 : * Error handling 198 : * 199 : 9999 CONTINUE 200 : IRET=1 201 : WRITE(IOIMP,*) 'An error was detected in subroutine inqrte' 202 : RETURN 203 : * 204 : * End of subroutine INQRTE 205 : * 206 : END 207 : 208 : 209 : 210 :
© Cast3M 2003 - All rights reserved.
Disclaimer