1 : C RLEXCO SOURCE PV 09/03/12 21:33:51 6325 2 : SUBROUTINE RLEXCO(MLEFC,MACOE2,MCHELM) 3 : C 4 : C**** Definition de MCHAML qui contient les coefficients 5 : C pour le calcul du gradient 6 : C 7 : C 8 : C**** Variables de COOPTIO 9 : C 10 : C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR 11 : C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ 12 : C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES 13 : C & ,IECHO, IIMPI, IOSPI 14 : C & ,IDIM 15 : C & ,MCOORD 16 : C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE 17 : C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU 18 : C & ,NORINC,NORVAL,NORIND,NORVAD 19 : C & ,NUCROU, IPSAUV 20 : C 21 : IMPLICIT INTEGER(I-N) 22 : -INC CCOPTIO 23 : INTEGER NBL, NBTPOI 24 : SEGMENT MLELEM 25 : INTEGER INDEX(NBL+1) 26 : INTEGER LESPOI(NBTPOI) 27 : ENDSEGMENT 28 : POINTEUR MLEFC.MLELEM 29 : C 30 : INTEGER N1,N2 31 : SEGMENT MATRIX 32 : REAL*8 MAT(N1,N2) 33 : ENDSEGMENT 34 : POINTEUR MACOE2.MATRIX 35 : C 36 : INTEGER N3,L1,N1PTEL,N1EL,N2PTEL,N2EL 37 : -INC SMCHAML 38 : INTEGER NBNN,NBELEM,NBSOUS,NBREF 39 : -INC SMELEME 40 : INTEGER JG 41 : -INC SMLENTI 42 : POINTEUR MLELAS.MLENTI, MLECON.MLENTI, MLEELT.MLENTI 43 : C 44 : INTEGER NMAX, IELEM, IPOS, IPOS1, ISOUS, NTSOUS, NG 45 : & , I1, I2, I3, IPOS2 46 : C 47 : SEGACT MLEFC 48 : SEGACT MACOE2 49 : NBL=MLEFC.INDEX(/1)-1 50 : C 51 : NMAX=0 52 : IPOS1=MLEFC.INDEX(1) 53 : DO IELEM = 1, NBL 54 : IPOS=IPOS1 55 : IPOS1=MLEFC.INDEX(1+IELEM) 56 : NMAX=MAX(NMAX,IPOS1-IPOS) 57 : ENDDO 58 : C 59 : C**** L'elt le plus grand a NMAX point 60 : C 61 : JG=NMAX 62 : SEGINI MLELAS 63 : SEGINI MLECON 64 : JG=NBL 65 : SEGINI MLEELT 66 : C 67 : C**** Les MLENTI ici initialisé 68 : C 69 : C MLELAS+MLEELT = structure pour definir les MAILLAGEs 70 : C du MCHELM 71 : C 72 : C NELT1=MLELAS.LECT(I) = 0 -> il n'y a pas d'elts avec I points 73 : C > 0 -> NELT1 a I points 74 : C Les autres elts avec I points sont 75 : C dedans MLEELT (liste chaînée qui 76 : C est lié à MLEELT) 77 : C 78 : C MLECON.LECT(I) = nombre de elts avec I points 79 : C 80 : C N.B: MLECON.LECT(I) est une information redondantemais pratique 81 : C 82 : C 83 : IPOS1=MLEFC.INDEX(1) 84 : DO IELEM = 1, NBL, 1 85 : IPOS=IPOS1 86 : IPOS1=MLEFC.INDEX(1+IELEM) 87 : NBNN=IPOS1-IPOS 88 : MLECON.LECT(NBNN)=MLECON.LECT(NBNN)+1 89 : MLEELT.LECT(IELEM)= MLELAS.LECT(NBNN) 90 : MLELAS.LECT(NBNN)=IELEM 91 : ENDDO 92 : C 93 : C**** Les supports 94 : C 95 : NTSOUS=0 96 : DO ISOUS=1,NMAX,1 97 : IF(MLECON.LECT(ISOUS).NE.0) NTSOUS=NTSOUS+1 98 : ENDDO 99 : C 100 : C**** Initialisation du MCHELM 101 : C 102 : N1=NTSOUS 103 : N2=IDIM 104 : N3=6 105 : L1=8 106 : SEGINI MCHELM 107 : MCHELM.TITCHE='Gradient' 108 : MCHELM.IFOCHE=IFOUR 109 : C 110 : ISOUS=0 111 : NBSOUS=0 112 : NBREF=0 113 : DO I1 = 1, NMAX, 1 114 : NBELEM=MLECON.LECT(I1) 115 : IF(NBELEM .GT. 0)THEN 116 : ISOUS=ISOUS+1 117 : NBNN=I1 118 : SEGINI MELEME 119 : C ITYPEL=32 -> 'POLY' 120 : ITYPEL=32 121 : MCHELM.IMACHE(ISOUS)=MELEME 122 : SEGINI MCHAML 123 : MCHELM.ICHAML(ISOUS)=MCHAML 124 : MCHAML.NOMCHE(1)='alphax ' 125 : MCHAML.NOMCHE(2)='alphay ' 126 : MCHAML.TYPCHE(1)='REAL*8 ' 127 : MCHAML.TYPCHE(2)='REAL*8 ' 128 : N1PTEL=NBNN 129 : N1EL=NBELEM 130 : N2PTEL=0 131 : N2EL=0 132 : SEGINI MELVA1 133 : SEGINI MELVA2 134 : MCHAML.IELVAL(1)=MELVA1 135 : MCHAML.IELVAL(2)=MELVA2 136 : IF(IDIM.EQ.3)THEN 137 : MCHAML.NOMCHE(3)='alphaz ' 138 : MCHAML.TYPCHE(3)='REAL*8 ' 139 : SEGINI MELVA3 140 : MCHAML.IELVAL(3)=MELVA3 141 : ENDIF 142 : IELEM=MLELAS.LECT(I1) 143 : IPOS=MLEFC.INDEX(IELEM) 144 : IPOS1=MLEFC.INDEX(IELEM+1) 145 : IF((IPOS1-IPOS).NE.NBNN)THEN 146 : WRITE(IOIMP,*) 'subroutine rlexco.eso' 146 : CALL ERREUR(5) 147 : GOTO 9999 148 : ENDIF 149 : C 150 : C********** MELEME.NUM(1,*) est le point face 151 : C 152 : DO I3=1,NBNN,1 153 : IPOS2=IPOS+I3-1 154 : NG=MLEFC.LESPOI(IPOS2) 155 : MELEME.NUM(I3,1)=NG 156 : MELVA1.VELCHE(I3,1)=MACOE2.MAT(1,IPOS2) 157 : MELVA2.VELCHE(I3,1)=MACOE2.MAT(2,IPOS2) 158 : IF(IDIM.EQ.3) MELVA3.VELCHE(I3,1)=MACOE2.MAT(3,IPOS2) 159 : ENDDO 160 : C 161 : DO I2=2,NBELEM,1 162 : IELEM=MLEELT.LECT(IELEM) 163 : IPOS=MLEFC.INDEX(IELEM) 164 : IPOS1=MLEFC.INDEX(IELEM+1) 165 : IF((IPOS1-IPOS).NE.NBNN)THEN 166 : WRITE(IOIMP,*) 'subroutine rlexco.eso' 166 : CALL ERREUR(5) 167 : GOTO 9999 168 : ENDIF 169 : C 170 : DO I3=1,NBNN,1 171 : IPOS2=IPOS+I3-1 172 : NG=MLEFC.LESPOI(IPOS2) 173 : MELEME.NUM(I3,I2)=NG 174 : MELVA1.VELCHE(I3,I2)=MACOE2.MAT(1,IPOS2) 175 : MELVA2.VELCHE(I3,I2)=MACOE2.MAT(2,IPOS2) 176 : IF(IDIM.EQ.3) MELVA3.VELCHE(I3,I2)=MACOE2.MAT(3,IPOS2) 177 : ENDDO 178 : ENDDO 179 : C 180 : IELEM=MLEELT.LECT(IELEM) 181 : IF(IELEM.NE.0)THEN 182 : WRITE(IOIMP,*) 'subroutine rlexco.eso' 182 : CALL ERREUR(5) 183 : GOTO 9999 184 : ENDIF 185 : SEGDES MCHAML 186 : SEGDES MELEME 187 : SEGDES MELVA1 188 : SEGDES MELVA2 189 : IF(IDIM.EQ.3) SEGDES MELVA3 190 : ENDIF 191 : ENDDO 192 : C 193 : SEGDES MCHELM 194 : C 195 : SEGSUP MLEFC 196 : SEGSUP MACOE2 197 : SEGSUP MLEELT 198 : SEGSUP MLECON 199 : SEGSUP MLELAS 200 : C 201 : 9999 RETURN 202 : END 203 : 204 : 205 : 206 : 207 : C 208 : 209 : 210 : 211 :
© Cast3M 2003 - All rights reserved.
Disclaimer