1 : C RLEXC1 SOURCE PV 09/03/12 21:33:50 6325 2 : SUBROUTINE RLEXC1(MLEPOI,MLECOE,MCHELM) 3 : C************************************************************************ 4 : C 5 : C PROJET : CASTEM 2000 6 : C 7 : C NOM : RLEXC1 8 : C 9 : C DESCRIPTION : Appelle par GRADI2 10 : C 11 : C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI) 12 : C 13 : C AUTEUR : A. BECCANTINI 14 : C 15 : C************************************************************************ 16 : C 17 : C Inputs: 18 : C 19 : C MLEPOI : pointers of list of points (FACE + neighbors) 20 : C 21 : C MLECOE : pointers of the list of coeff 22 : C 23 : C Output 24 : C 25 : C MCHELM : MCHAML which contains the coeff. to compute gradients 26 : C 27 : C 28 : C 29 : C**** Variables de COOPTIO 30 : C 31 : C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR 32 : C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ 33 : C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES 34 : C & ,IECHO, IIMPI, IOSPI 35 : C & ,IDIM 36 : C & ,MCOORD 37 : C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE 38 : C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU 39 : C & ,NORINC,NORVAL,NORIND,NORVAD 40 : C & ,NUCROU, IPSAUV, IPREFI, IFICLE 41 : CC 42 : IMPLICIT INTEGER(I-N) 43 : 44 : INTEGER N1,N2 45 : SEGMENT MATRIX 46 : REAL*8 MAT(N1,N2) 47 : ENDSEGMENT 48 : C 49 : -INC CCOPTIO 50 : INTEGER N3,L1,N1PTEL,N1EL,N2PTEL,N2EL 51 : INTEGER NBNN,NBELEM,NBSOUS,NBREF 52 : INTEGER JG 53 : -INC SMCHAML 54 : -INC SMLREEL 55 : -INC SMLENTI 56 : -INC SMELEME 57 : POINTEUR MLELAS.MLENTI, MLECON.MLENTI, MLEELT.MLENTI 58 : & ,MLEPOI.MLENTI,MLECOE.MLENTI 59 : C 60 : INTEGER NFAC,NMAX,IFAC, NTSOUS, I1, NBNN0, I3, I2, NG, ISOUS 61 : C 62 : SEGACT MLEPOI 63 : SEGACT MLECOE 64 : NFAC=MLEPOI.LECT(/1) 65 : C 66 : C**** NMAX = maximum number of points in the element 67 : C 'FACE'-neighbors 68 : NMAX=0 69 : DO IFAC = 1, NFAC, 1 70 : MLENTI=MLEPOI.LECT(IFAC) 71 : SEGACT MLENTI 72 : NBNN=MLENTI.LECT(/1) 73 : NMAX=MAX(NMAX,NBNN) 74 : ENDDO 75 : C 76 : C**** We create the following MLENTI 77 : C 78 : C MLECON : dimension = NMAX 79 : C MLECON.LECT(I) = number of elements with I points 80 : C 81 : C MLELAS : dimension = NMAX 82 : 83 : C MLELAS.LECT(I) = 0 -> there are no elements with I 84 : C points 85 : C 86 : C J -> the J-th element has I points 87 : C 88 : C 89 : C The other elements with I points are into the chaining list 90 : C MLEELT. 91 : C 92 : C MLEELT : dimension = NFAC 93 : C MLEELT+MLELAS allows to rapidly recover the elements 94 : C with the same number of points 95 : C For example, the elements with I points are: 96 : C IELEM = MLELAS.LECT(I) 97 : C IELEM2 = MLEELT.LECT(IELEM) 98 : C ... 99 : C IELEM_K+1 = MLEELT.LECT(IELEM_K) 100 : C ... 101 : C until IELEM_K+1 = 0 102 : C 103 : JG=NMAX 104 : SEGINI MLELAS 105 : SEGINI MLECON 106 : JG=NFAC 107 : SEGINI MLEELT 108 : DO IFAC = 1, NFAC, 1 109 : MLENTI=MLEPOI.LECT(IFAC) 110 : NBNN=MLENTI.LECT(/1) 111 : MLECON.LECT(NBNN)=MLECON.LECT(NBNN)+1 112 : MLEELT.LECT(IFAC)= MLELAS.LECT(NBNN) 113 : MLELAS.LECT(NBNN)=IFAC 114 : ENDDO 115 : C 116 : C**** Les supports 117 : C 118 : NTSOUS=0 119 : DO ISOUS=1,NMAX,1 120 : IF(MLECON.LECT(ISOUS).NE.0) NTSOUS=NTSOUS+1 121 : ENDDO 122 : C 123 : C**** Initialisation du MCHELM 124 : C 125 : N1=NTSOUS 126 : N2=IDIM 127 : N3=6 128 : L1=8 129 : SEGINI MCHELM 130 : MCHELM.TITCHE='Gradient' 131 : MCHELM.IFOCHE=IFOUR 132 : C 133 : ISOUS=0 134 : NBSOUS=0 135 : NBREF=0 136 : DO I1 = 1, NMAX, 1 137 : NBELEM=MLECON.LECT(I1) 138 : IF(NBELEM .GT. 0)THEN 139 : ISOUS=ISOUS+1 140 : NBNN=I1 141 : SEGINI MELEME 142 : C ITYPEL=32 -> 'POLY' 143 : ITYPEL=32 144 : MCHELM.IMACHE(ISOUS)=MELEME 145 : SEGINI MCHAML 146 : MCHELM.ICHAML(ISOUS)=MCHAML 147 : MCHAML.NOMCHE(1)='alphax ' 148 : MCHAML.NOMCHE(2)='alphay ' 149 : MCHAML.TYPCHE(1)='REAL*8 ' 150 : MCHAML.TYPCHE(2)='REAL*8 ' 151 : N1PTEL=NBNN 152 : N1EL=NBELEM 153 : N2PTEL=0 154 : N2EL=0 155 : SEGINI MELVA1 156 : SEGINI MELVA2 157 : MCHAML.IELVAL(1)=MELVA1 158 : MCHAML.IELVAL(2)=MELVA2 159 : IF(IDIM.EQ.3)THEN 160 : MCHAML.NOMCHE(3)='alphaz ' 161 : MCHAML.TYPCHE(3)='REAL*8 ' 162 : SEGINI MELVA3 163 : MCHAML.IELVAL(3)=MELVA3 164 : ENDIF 165 : IFAC=MLELAS.LECT(I1) 166 : MLENTI=MLEPOI.LECT(IFAC) 167 : MATRIX=MLECOE.LECT(IFAC) 168 : SEGACT MATRIX 169 : NBNN0=MLENTI.LECT(/1) 170 : IF(NBNN0.NE.NBNN)THEN 171 : WRITE(IOIMP,*) 'subroutine rlexc1.eso' 171 : CALL ERREUR(5) 172 : GOTO 9999 173 : ENDIF 174 : C 175 : C********** The first point of MLENTI is a FACE point 176 : C In the same way, MELEME.NUM(1,*) is the FACE point 177 : C 178 : C N.B. the first element is stored into MLELAS 179 : C the others are stored into MLEELT 180 : C 181 : DO I3=1,NBNN,1 182 : NG=MLENTI.LECT(I3) 183 : MELEME.NUM(I3,1)=NG 184 : MELVA1.VELCHE(I3,1)=MATRIX.MAT(2,I3) 185 : MELVA2.VELCHE(I3,1)=MATRIX.MAT(3,I3) 186 : IF(IDIM.EQ.3) MELVA3.VELCHE(I3,1)=MATRIX.MAT(4,I3) 187 : ENDDO 188 : SEGSUP MLENTI 189 : SEGSUP MATRIX 190 : C 191 : DO I2=2,NBELEM,1 192 : IFAC=MLEELT.LECT(IFAC) 193 : MLENTI=MLEPOI.LECT(IFAC) 194 : MATRIX=MLECOE.LECT(IFAC) 195 : SEGACT MATRIX 196 : NBNN0=MLENTI.LECT(/1) 197 : IF(NBNN0.NE.NBNN)THEN 198 : WRITE(IOIMP,*) 'subroutine rlexc1.eso' 198 : CALL ERREUR(5) 199 : GOTO 9999 200 : ENDIF 201 : C 202 : DO I3=1,NBNN,1 203 : NG=MLENTI.LECT(I3) 204 : MELEME.NUM(I3,I2)=NG 205 : MELVA1.VELCHE(I3,I2)=MATRIX.MAT(2,I3) 206 : MELVA2.VELCHE(I3,I2)=MATRIX.MAT(3,I3) 207 : IF(IDIM.EQ.3) MELVA3.VELCHE(I3,I2)=MATRIX.MAT(4,I3) 208 : ENDDO 209 : SEGSUP MLENTI 210 : SEGSUP MATRIX 211 : ENDDO 212 : C 213 : IFAC=MLEELT.LECT(IFAC) 214 : IF(IFAC.NE.0)THEN 215 : WRITE(IOIMP,*) 'subroutine rlexc1.eso' 215 : CALL ERREUR(5) 216 : GOTO 9999 217 : ENDIF 218 : SEGDES MCHAML 219 : SEGDES MELEME 220 : SEGDES MELVA1 221 : SEGDES MELVA2 222 : IF(IDIM.EQ.3) SEGDES MELVA3 223 : ENDIF 224 : ENDDO 225 : C 226 : SEGDES MCHELM 227 : C 228 : SEGSUP MLEPOI 229 : SEGSUP MLECOE 230 : SEGSUP MLEELT 231 : SEGSUP MLECON 232 : SEGSUP MLELAS 233 : C 234 : 9999 RETURN 235 : END 236 : 237 : 238 : 239 : 240 : C 241 : 242 : 243 : 244 : 245 : 246 :
© Cast3M 2003 - All rights reserved.
Disclaimer