1 : C EXCEPT SOURCE PV 09/03/12 21:21:42 6325 2 : SUBROUTINE EXCEPT(EPSILO,NDIM,JREBO,XNREB,MELEME,IZCENT 3 : $ ,IELTFA,IZVIT,IVPT,IEL1,TDEP,DTREEL,XDEP2,IZSH,IZUN,IEL2,NVOISI) 4 : 5 : ************************************************************************ 6 : *** SP 'EXCEPT' : permet de traiter les cas particuliers ou trajectoire 7 : *** passe par un noeud ou une arete. Apres tests sur noeuds et aretes, 8 : *** renvoie n° global de l'elemt ou trajectoire a effectivement lieu. 9 : *** 10 : *** APPELES 1 = aucun 11 : *** APPELES 2 = 'TRJLOC', 'REEREF', 'TESTNO', 'TESTAR', 'VOISIN', 12 : *** 'JCBIEN', 'SAUCO1', 'REFREE', 'SAUCO2', 'LIEUPT' 13 : *** 14 : *** E = 'EPSILO' erreur de précision de calcul (calibrage) acceptable 15 : *** 'NDIM' dimension de l'espace 16 : *** 'JREBO' n° local face impermeable ou se trouve particule, -1 sinon 17 : *** 'XNREB' vecteur normal à la face impermeable 18 : *** 'MELEME' pteur sur maillage du domaine étudié 19 : *** 'IZCENT' pteur sur la table "DOMAINE.CENTRE" 20 : *** 'IELTFA' pteur sur la table "DOMAINE.ELTFA" 21 : *** 'IZVIT' pteur sur le segment des vitesses 22 : *** 'IVPT' entier valant 1 dans le cas du régime permanent 23 : *** 'IEL1' n° global elemt courant à partir duquel on cherche voisins 24 : *** 'TDEP' tps réel courant écoulé 25 : *** 'DTREEL' pas de temps considéré pour saut particule 26 : *** 'XDEP2' position reelle courante particule dans maillage 27 : *** 'IZSH' segmt content fcts forme,base et coord réelles noeuds 28 : *** 'IZUN' segmt content les flux aux faces % sous-maillage 29 : *** 30 : *** S = 'IEL2' n° global elemt ou trajectoire a lieu, 0 sinon 31 : *** 'NVOISI' nbre d'elements voisins lorsque noeud ou arete en commun 32 : *** 33 :
Warning: preg_replace(): Compilation failed: unmatched parentheses at offset 6 in C:\xampp\htdocs\cast3m_kit_local_fr_en_2014\sources.php on line 158
34 : *** 35 : *** Auteur Cyril Nou 36 : ************************************************************************ 37 : 38 : IMPLICIT INTEGER(I-N) 39 : IMPLICIT REAL*8 (A-H,O-Z) 40 : -INC SMELEME 41 : -INC CCREEL 42 : -INC SMCHAML 43 : POINTEUR IZCENT.MELEME,IELTFA.MELEME 44 : SEGMENT IZSH 45 : REAL*8 SHP(6,MNO9),SHY(12,MNO9),XYZL(3,MNO9) 46 : ENDSEGMENT 47 : SEGMENT IZVIT 48 : REAL*8 TEMTRA(NVIPT) 49 : INTEGER IPUN(NBS),IDUN(NBS),IPVPT(NVIPT),IFORML 50 : ENDSEGMENT 51 : SEGMENT IZVPT 52 : INTEGER IPUN1(NBS),IPUMAX 53 : ENDSEGMENT 54 : SEGMENT IZUN 55 : REAL*8 UN(I1,I2,I3) 56 : ENDSEGMENT 57 : SEGMENT IZUMAX 58 : REAL*8 UMAX(NBREL) 59 : ENDSEGMENT 60 : DIMENSION XDEP2(3),XREF(3),XTEST2(3),XTEST(3),IVOISI(200) 61 : DIMENSION UTEST(3),XNREB(3) 62 : DO 10 I=1,200 63 : IVOISI(I)=0 64 : 10 CONTINUE 65 : DTTEST=DTREEL/100 66 : NVOISI=0 67 : IEL2=0 68 : IEL3=0 69 : 70 : ************************************** 71 : *** RECHERCHE DES ELEMENTS VOISINS *** 72 : ************************************** 73 : 73 : CALL TRJLOC(NDIM,MELEME,IZCENT,IELTFA,IZVIT,IVPT,IEL1 74 : $ ,TDEP,NOEL1,ITY1,ITYG,IZSH,IZUN,NOUN1,IELL,DIAM,IPT1) 74 : CALL REEREF(NDIM,ITY1,NOEL1,IZSH,XDEP2,XREF) 74 : CALL TESTNO(EPSILO,ITYG,XREF,INOEUD) 75 : *** cas ou trajectoire passe par un noeud 76 : IF (INOEUD.GT.0) THEN 76 : CALL VOISIN(NDIM,MELEME,IPT1,IELL,INOEUD,IVOISI,NVOISI) 77 : ELSEIF (NDIM.EQ.3) THEN 77 : CALL TESTAR(EPSILO,ITYG,XREF,IARETE,JNOEU1,JNOEU2) 78 : *** cas ou la trajectoire passe par une arete 79 : IF (IARETE.GT.0) THEN 79 : CALL VOISIN(NDIM,MELEME,IPT1,IELL,JNOEU1,IVOISI,NVOISI) 80 : ENDIF 81 : ENDIF 82 : 83 : **************************************** 84 : *** RECHERCHE ELEMENT OU TRAJ A LIEU *** 85 : **************************************** 86 : 87 : IF (NVOISI.GT.0) THEN 88 : IREBCO=0 89 : NTEST=0 90 : 40 CONTINUE 91 : IF( NVOISI.GT.200)THEN 92 : C write(6,*)' except un noeud a plus de 200 voisins ' 92 : CALL ERREUR (21) 93 : RETURN 94 : ENDIF 95 : DO 20 I=1,NVOISI 96 : *** recuperation caractéristiques du ieme element voisin 96 : CALL TRJLOC(NDIM,MELEME,IZCENT,IELTFA,IZVIT,IVPT,IVOISI(I) 97 : $ ,TDEP,NOEL2,ITY2,JTYG,IZSH,IZUN,NOUN2,IELL2,DIAM2,IPT2) 98 : *** test du saut convectif dans le ieme element voisin 98 : CALL SAUCON(NDIM,ITY2,JTYG,NOEL2,NOUN2,DIAM2 99 : $ ,UN(1,1,IELL2),XREF,XDEP2,DTTEST,XTEST2,IZSH,UTEST,LTEST) 100 : *** cas ou Jacobien lors approximation vitesse efmh 101 : IF (LTEST.EQ.0) THEN 102 : IEL1=-1 103 : RETURN 104 : ENDIF 104 : CALL NORMVI(NDIM,UTEST,XNORM,UXY) 105 : COEFC=SCVECT(UTEST,XNREB,NDIM) 106 : COEFC=COEFC*DTTEST 107 : DO 30 J=1,NDIM 108 : XTEST2(J)=XTEST2(J)-IREBCO*COEFC*XNREB(J) 109 : 30 CONTINUE 110 : *** test sur la position arrivee % ieme element voisin 110 : CALL LIEUPT(XZPREC,NDIM,JTYG,XTEST2,IZSH,JTEST) 111 : *** recuperation du n° global element ou a lieu trajectoire 112 : IF (JTEST.EQ.1) THEN 113 : IEL3=IVOISI(I) 114 : IF(IEL3.NE.IEL1) THEN 115 : IEL2=IEL3 116 : RETURN 117 : ENDIF 118 : ENDIF 119 : IF ((I.EQ.NVOISI).AND.(IEL3.NE.0)) THEN 120 : IEL2=IEL3 121 : RETURN 122 : ENDIF 123 : 20 CONTINUE 124 : *** si test sans rebond echoue, tentative avec rebond 125 : IF ((IEL2.EQ.0).AND.(JREBO.GT.0)) THEN 126 : IF (NTEST.EQ.1) THEN 127 : RETURN 128 : ELSE 129 : IREBCO=1 130 : NTEST=1 131 : GOTO 40 132 : ENDIF 133 : ENDIF 134 : ENDIF 135 : 136 : RETURN 137 : END 138 : 139 : 140 : 141 : 142 : 143 : 144 : 145 :
© Cast3M 2003 - All rights reserved.
Disclaimer