1 : C NORV3 SOURCE PV 09/03/12 21:29:42 6325 2 : SUBROUTINE NORV3(NSOMM,NBMAX,IPO2,SCMB,INDLI, 3 : & VAL1,VAL2,IND22,IND2,IND,IPO3,VAUX,TAB) 4 : C 5 : C************************************************************************ 6 : C 7 : C PROJET : CASTEM 2000 8 : C 9 : C NOM : NORV1 10 : C 11 : C DESCRIPTION : Appelle par NORV 12 : C 13 : C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI) 14 : C 15 : C AUTEUR : C. LE POTIER, DM2S/SFME/MTMS 16 : C 17 : C************************************************************************ 18 : C 19 : IMPLICIT INTEGER(I-N) 20 : IMPLICIT REAL*8 (a-h,o-z) 21 : -INC SMLENTI 22 : -INC SMELEME 23 : -INC SMCHPOI 24 : -INC CCOPTIO 25 : -INC SMCOORD 26 : -INC SMLREEL 27 : POINTEUR MELEFL.MELEME, MELEFP.MELEME, MELEFA.MELEME, 28 : & MELTFA.MELEME 29 : POINTEUR MPOSUR.MPOVAL, MPONOR.MPOVAL, 30 : & MPOCHP.MPOVAL, MPOVCL.MPOVAL, MPGSOM.MPOVAL, MPVOSO.MPOVAL, 31 : & MPOGRA.MPOVAL,MPOTEN.MPOVAL 32 : POINTEUR MLENCL.MLENTI, MLECEN.MLENTI, MLESOM.MLENTI, 33 : & MLEFA.MLENTI 34 : -INC SMCHAML 35 : INTEGER NBNN,NBREF 36 : 37 : 38 : 39 : C 40 : C**** Variables de COOPTIO 41 : C 42 : C 43 : C**** Variables de COOPTIO 44 : C 45 : C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR 46 : C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ 47 : C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES 48 : C & ,IECHO, IIMPI, IOSPI 49 : C & ,IDIM 50 : C & ,MCOORD 51 : C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE 52 : C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU 53 : C & ,NORINC,NORVAL,NORIND,NORVAD 54 : C & ,NUCROU, IPSAUV 55 : 56 : C**** Variable de SMLENTI, SMCHPOI 57 : C 58 : INTEGER JG, N, NC, NSOUPO, NAT, NBSOUS, NBNO,NBELEM 59 : C 60 : C**** Les includes 61 : C 62 : INTEGER I1,ICOMP,ICOMGR,IGEOM 63 : & ,IOP1,ICEN,ISOMM,IFAC,IFACEL,IFACEP,INORM 64 : & ,ISURF,IMAIL,ICHPO,ICHCL,ICHGRA,ICOEFF 65 : & ,NTOT,NSOMM,NCOMP,NFAC,NCEN 66 : & ,NLCF,NGCF,NGCF1,NGCF2,NGCG,NGCD,NLCG,NLCD,NGS1,NGS2 67 : & ,NLS1,NLS2,NLFCL 68 : & ,ISOUS,IELEM,INOEUD,ICELL 69 : INTEGER ICEN2 70 : REAL*8 SCNX,SCNY,SURF,VOL,VAL,VALX,VALY,XG,XD,XF,XS1,XS2 71 : & ,YG,YD,YF,YS1,YS2,PSCA,XNORM,VECX,VECY,PSCAGX,PSCAGY, 72 : & PSCADX,PSCADY,K11G,K22G,K21G,K11D,K22D,K21D,VXG1,VXG2, 73 : & VXAU,VYAU,VXD1,VXD2,VYG1,VYG2,TRG1,TRG2, 74 : & TRD1,TRD2,TRG,TRD,VALAUX 75 : REAL*8 XLONG,AG1,AG2,AD1,AD2,PSCAG1,PSCAG2,PSCAD1,PSCAD2, 76 : & COEF1,COEF2,COEF3,COEF4,SCN1X,SCN1Y,VX,VY,COEF1X,COEF2X, 77 : & COEF1Y,COEF2Y,CX,CY,ANCX,ANCY,DIFFX,DIFFY,XLONGG,XLONGD 78 : & VALD,VALG,COEF,GX,GY,XMINK11,XMAXK11,XMINK22,XMAXK22 79 : 80 : REAL*8 VECXG1(2),VECYG1(2) 81 : REAL*8 VECXG2(2),VECYG2(2) 82 : REAL*8 VECXD1(2),VECYD1(2) 83 : REAL*8 VECXD2(2),VECYD2(2) 84 : REAL*8 EPS 85 : INTEGER ICRIT 86 : CHARACTER*(4) NOMCOM(18) 87 : CHARACTER*8 TYPE 88 : C 89 : DATA NOMCOM /'P1DX','P1DY', 90 : & 'P2DX','P2DY', 91 : & 'P3DX','P3DY', 92 : & 'P4DX','P4DY', 93 : & 'P5DX','P5DY', 94 : & 'P6DX','P6DY', 95 : & 'P7DX','P7DY', 96 : & 'P8DX','P8DY', 97 : & 'P9DX','P9DY'/ 98 : 99 : INTEGER NDIM 100 : SEGMENT MMAT1 101 : REAL*8 PM(NDIM,NDIM),PM1(NDIM,NDIM),XSOL(NDIM) 102 : INTEGER IC(NDIM) 103 : ENDSEGMENT 104 : 105 : INTEGER K1,K2 106 : SEGMENT INDICE 107 : INTEGER NUME(K1,K2) 108 : ENDSEGMENT 109 : POINTEUR IND.INDICE,IND2.INDICE,IND22.INDICE 110 : 111 : SEGMENT MATRICE 112 : REAL*8 MAT(K1,K2) 113 : ENDSEGMENT 114 : POINTEUR VAL1.MATRICE,VAL2.MATRICE,SCMB.MATRICE 115 : 116 : INTEGER K3 117 : SEGMENT POINT2 118 : INTEGER POINT(K3) 119 : ENDSEGMENT 120 : POINTEUR IPO2.POINT2 121 : 122 : SEGMENT MATRICE2 123 : REAL*8 MAT2(K1,K2) 124 : ENDSEGMENT 125 : POINTEUR MATR1.MATRICE2,MATR2.MATRICE2 126 : 127 : 128 : SEGMENT POINT3 129 : INTEGER POINT33(K3) 130 : ENDSEGMENT 131 : POINTEUR IPO3.POINT3 132 : 133 : SEGMENT INDICE3 134 : INTEGER NU(K1,K2) 135 : ENDSEGMENT 136 : POINTEUR INDIC.INDICE3 137 : 138 : 139 : 140 : 141 : SEGMENT REP 142 : INTEGER ID(K3) 143 : ENDSEGMENT 144 : POINTEUR TAB.REP,INDLI.REP 145 : 146 : 147 : K3 = NSOMM 148 : SEGINI IPO3 149 : c SEGINI VAUX 150 : 151 : 152 : 153 : 154 : 155 : c WRITE(6,*) 'DANS NORV3' 156 : c WRITE(6,*) 'NBMAX= ',NBMAX 157 : 158 : * ON EST ICI 159 : c INVERSION DE CHAQUE PETITE MATRICE 160 : EPS = 1.e-30 161 : XINF = 1.e+30 162 : NMOY = 0 163 : DO NLS1=1,NSOMM,1 164 : NMOY = NMOY + (INDLI.ID(NLS1)*INDLI.ID(NLS1)) 165 : NDIM = INDLI.ID(NLS1) 166 : c WRITE(6,*) 'NLS1= ',NLS1,'NDIM = ', NDIM 167 : K1 = NBMAX 168 : K2 = (NBMAX+1) 169 : SEGINI MMAT1 170 : 171 : K1 = NBMAX 172 : K2 = NBMAX + 1 173 : SEGINI INDIC 174 : IPO3.POINT33(NLS1) = INDIC 175 : 176 : C ON EST ICI 177 : MATR1 = IPO2.POINT(NLS1) 178 : SEGACT MATR1 *MOD 179 : 180 : DO I=1,INDLI.ID(NLS1) 181 : DO J = 1,INDLI.ID(NLS1) 182 : PM(I,J) = MATR1.MAT2(I,J) 183 : c WRITE(6,*) 'NLS1= ',NLS1,'I=',I,'J=',J,PM(I,J) 184 : ENDDO 185 : c WRITE(6,*) 'NLS1= ',NLS1,'I=',I,'SCMB', SCMB.MAT(I,NLS1) 186 : ENDDO 187 : c WRITE(6,*) 'NLS1= ',NLS1,'EPS= ',EPS 187 : CALL INVER(PM,NDIM,ICRIT,PM1,IC,EPS) 188 : c WRITE(6,*) 'NLS1= ',NLS1,'EPS= ',EPS 189 : c WRITE(6,*) 'NLS1= ',NLS1,'ICRIT= ',ICRIT 190 : IF (ICRIT.EQ.1) THEN 191 : WRITE(6,*) 'MATRICE PEUT ETRE NON INVERSIBLE' 192 : WRITE(6,*) 'NLS1= ',NLS1 193 : c DO I=1,INDLI.ID(NLS1) 194 : c DO J = 1,INDLI.ID(NLS1) 195 : c PM(I,J) = 0.0 196 : c WRITE(6,*) 'NLS1= ',NLS1,'I=',I,'J=',J,'NOEUD2= ', 197 : c & MATR1.MAT2(I,J) 198 : c WRITE(6,*) 'NLS1= ',NLS1,'I=',I,'J=',J,'PM= ',PM(I,J) 199 : c ENDDO 200 : c ENDDO 201 : ENDIF 202 : 203 : ITROUVE = 0 204 : DO I=1,INDLI.ID(NLS1) 205 : DO J = 1,INDLI.ID(NLS1) 206 : IF (PM(I,J).GT.XINF) THEN 207 : ITROUVE = 1 208 : GOTO 444 209 : ENDIF 210 : ENDDO 211 : ENDDO 212 : 444 CONTINUE 213 : 214 : IF (ITROUVE.EQ.1) THEN 215 : WRITE(6,*) 'PM EST TRES GRAND : LE CONDITIONNEMNENT EST PEUT 216 : & ETRE MAUVAIS' 217 : c DO I=1,INDLI.ID(NLS1) 218 : c DO J = 1,INDLI.ID(NLS1) 219 : c PM(I,J) = 0.0D0 220 : c ENDDO 221 : c ENDDO 222 : ENDIF 223 : 224 : 225 : c WRITE(6,*) 'NLS1= ',NLS1,'INDLI(NLS1)=',INDLI.ID(NLS1) 226 : DO I = 1,INDLI.ID(NLS1) 227 : XSOL(I) = 0.0D0 228 : DO J = 1,INDLI.ID(NLS1) 229 : c WRITE(6,*) 'NLS1= ',NLS1,'J=',J,'SCMB', SCMB.MAT(J,NLS1) 230 : c WRITE(6,*) 'NLS1= ',NLS1,'J=',J,'SCMB', SCMB.MAT(J,NLS1) 231 : c WRITE(6,*) 'NLS1= ',NLS1,'I=',I,'J=',J,'PM= ',PM(I,J) 232 : XSOL(I) = XSOL(I) + (SCMB.MAT(J,NLS1)*PM(I,J)) 233 : ENDDO 234 : ENDDO 235 : 236 : DO J = 1,INDLI.ID(NLS1) 237 : SCMB.MAT(J,NLS1) = XSOL(J) 238 : c WRITE(6,*) 'NLS1= ',NLS1,'J=',J,'XSOL',XSOL(J) 239 : ENDDO 240 : 241 : DO IAUX = 1,INDLI.ID(NLS1) 242 : 243 : ICON = 0 244 : DO JAUX = 1,INDLI.ID(NLS1) 245 : MATR1.MAT2(IAUX,JAUX) = 0.0D0 246 : VALAUX = PM(IAUX,JAUX) * 247 : & (VAL1.MAT(JAUX,NLS1)) 248 : NTEST = IND.NUME(JAUX,NLS1) 249 : IF (NTEST.NE.0) THEN 250 : c WRITE(6,*) 'NLS1= ',NLS1, 'IND=',IND.NUME(JAUX,NLS1) 251 : c WRITE(6,*) 'NLS1= ',NLS1, 'VAL1=',VAL1.MAT(JAUX,NLS1) 252 : c WRITE(6,*) 'NLS1= ',NLS1, 'IND=',IND22.NUME(JAUX,NLS1) 253 : c WRITE(6,*) 'NLS1= ',NLS1, 'VAL2=',VAL2.MAT(JAUX,NLS1) 254 : 255 : c RECHERCHE DE NTEST 256 : 257 : DO IAUX2=1,INDLI.ID(NLS1) 258 : J1 = INDIC.NU(IAUX,IAUX2) 259 : J2 = NTEST 260 : IF (J1.EQ.J2) THEN 261 : ITEST = IAUX2 262 : GOTO 533 263 : ENDIF 264 : ENDDO 265 : ICON = ICON +1 266 : ITEST = ICON 267 : IF (ITEST.GT.K2) THEN 268 : WRITE(6,*) 'K2 TROP PETIT' 268 : CALL ERREUR(5) 269 : ENDIF 270 : 271 : 533 CONTINUE 272 : INDIC.NU(IAUX,ITEST) = NTEST 273 : MATR1.MAT2(IAUX,ITEST) = MATR1.MAT2(IAUX,ITEST) 274 : & + VALAUX 275 : ENDIF 276 : 277 : ENDDO 278 : c ENDDO 279 : 280 : C MEME CHOSE POUR VAL2 281 : c DO IAUX = 1,INDLI.ID(NLS1) 282 : 283 : DO JAUX = 1,INDLI.ID(NLS1) 284 : VALAUX = PM(IAUX,JAUX) * 285 : & (VAL2.MAT(JAUX,NLS1)) 286 : NTEST = IND22.NUME(JAUX,NLS1) 287 : 288 : c RECHERCHE DE NTEST 289 : 290 : IF (NTEST.NE.0) THEN 291 : DO IAUX2 = 1,ICON 292 : J1 = INDIC.NU(IAUX,IAUX2) 293 : J2 = NTEST 294 : IF (J1.EQ.J2) THEN 295 : ITEST = IAUX2 296 : GOTO 633 297 : ENDIF 298 : ENDDO 299 : ICON = ICON +1 300 : ITEST = ICON 301 : IF (ITEST.GT.K2) THEN 302 : WRITE(6,*) 'K2 TROP PETIT' 302 : CALL ERREUR(5) 303 : ENDIF 304 : 305 : 633 CONTINUE 306 : INDIC.NU(IAUX,ITEST) = NTEST 307 : MATR1.MAT2(IAUX,ITEST) = MATR1.MAT2(IAUX,ITEST) 308 : & + VALAUX 309 : ENDIF 310 : 311 : ENDDO 312 : ENDDO 313 : TAB.ID(NLS1) = ICON 314 : c DO IAUX = 1,INDLI.ID(NLS1) 315 : cc DO IAUX2 = 1,TAB.ID(NLS1) 316 : c WRITE(6,*) 'NLS1= ',NLS1,'IAUX= ',IAUX ,'IAUX2= ', 317 : c & IAUX2,'VAUX',MATR1.MAT2(IAUX,IAUX2) 318 : c & ,'IND3= ',INDIC.NU(IAUX,IAUX2) 319 : c ENDDO 320 : c ENDDO 321 : c WRITE(6,*) 'ICON= ',ICON 322 : 323 : SEGDES INDIC 324 : SEGDES MATR1 325 : SEGSUP MMAT1 326 : ENDDO 327 : NMOY = NMOY/(1.D0*NSOMM) 328 : c WRITE(6,*) 'NMOY1= ',(NMOY) 329 : c SEGSUP NOEUD2 330 : SEGSUP VAL1 331 : SEGSUP VAL2 332 : SEGSUP IND 333 : SEGSUP IND22 334 : 335 : 336 : 337 : 9999 CONTINUE 338 : RETURN 339 : END 340 : 341 : 342 : 343 : 344 : 345 : 346 : 347 : 348 : 349 : 350 : 351 : 352 :
© Cast3M 2003 - All rights reserved.
Disclaimer