1 : C VRACO1 SOURCE PV 09/03/12 21:36:59 6325 2 : SUBROUTINE VRACO1(IPGEOM,IPLIQU,IMELVA) 3 : C======================================================================= 4 : C 5 : C POUR LES ELEMENTS DE RACCORD FLUIDE STRUCTURE 6 : C CONSTRUIT UN SEGMENT DE TYPE MPTVAL CONTENANT , 7 : C POUR CHAQUE ELEMENT DE RACCORD , LES VALEURS D UN 8 : C VECTEUR DIRIGE VERS L EXTERIEUR DU FLUIDE 9 : C 10 : C JACQUELINE BROCHARD DECEMBRE 85 11 : C P DOWLATYARI ADAPTATION AUX NOUVEAUX CHAMELEMS FEV.92 12 : C======================================================================= 13 : C ENTREES 14 : C IPGEOM = POINTEUR SUR LE MELEME DES ELTS DE RACCORD 15 : C IPLIQU = POINTEUR SUR LE MELEME DES ELTS LIQUIDE 16 : C IDIM = IDIM DE CCOPTIO 17 : C======================================================================= 18 : C SORTIES 19 : C IMELVA = POINTEUR SUR LE SEGMENT MPTVAL 20 : C======================================================================= 21 : IMPLICIT INTEGER(I-N) 22 : IMPLICIT REAL*8 (A-H,O-Z) 23 : -INC SMCOORD 24 : -INC SMELEME 25 : -INC CCOPTIO 26 : -INC SMCHAML 27 : SEGMENT MPTVAL 28 : INTEGER IPOS(NS),NSOF(NS) 29 : INTEGER IVAL(NCOSOU) 30 : CHARACTER*16 TYVAL(NCOSOU) 31 : ENDSEGMENT 32 : DIMENSION XE(3,2) 33 : MELEME=IPGEOM 34 : SEGACT MELEME 35 : NELRAC=NUM(/2) 36 : NOERAC=(NUM(/1))/2 37 : IPT1=IPLIQU 38 : SEGACT IPT1 39 : IPT2=IPT1 40 : SEGACT MCOORD 41 : C 42 : C INITIALISATION DU SEGMENT MELVAL 43 : C 44 : NS=1 45 : NCOSOU=IDIM 46 : SEGINI MPTVAL 47 : IMELVA=MPTVAL 48 : N1PTEL=1 49 : N1EL=NELRAC 50 : N2PTEL=0 51 : N2EL=0 52 : DO 10 IC=1,IDIM 53 : TYVAL(IC)='REAL*8' 54 : SEGINI MELVAL 55 : IVAL(IC)=MELVAL 56 : 10 CONTINUE 57 : C 58 : C BOUCLE SUR LES ELEMENTS DE RACCORD 59 : C 60 : DO 1000 JA=1,NELRAC 61 : DO 1500 JSOUS=1,MAX(1,IPT1.LISOUS(/1)) 62 : IF(IPT1.LISOUS(/1).NE.0) THEN 63 : IPT2=IPT1.LISOUS(JSOUS) 64 : SEGACT IPT2 65 : ENDIF 66 : NELLIQ=IPT2.NUM(/2) 67 : NOELIQ=IPT2.NUM(/1) 68 : DO 100 IC=1,NELLIQ 69 : JNE=0 70 : DO 110 ID=1,NOELIQ 71 : NOE=IPT2.NUM(ID,IC) 72 : DO 120 IB=1,NOERAC*2 73 : IF(NOE.EQ.NUM(IB,JA)) JNE=JNE+1 74 : 120 CONTINUE 75 : 110 CONTINUE 76 : IF(JNE.EQ.NOERAC) GOTO 200 77 : 100 CONTINUE 78 : IF(IPT1.LISOUS(/1).NE.0) SEGDES IPT2 79 : 1500 CONTINUE 80 : C 81 : C ERREUR ON NE TROUVE PAS D ELEMENT LIQUIDE 82 : C CONTENANT LES PREMIERS NOEUDS DE L ELT DE RACCORD 83 : C 83 : CALL ERREUR(258) 84 : DO 20 IC=1,IDIM 85 : MELVAL=IVAL(IC) 86 : SEGSUP MELVAL 87 : 20 CONTINUE 88 : SEGSUP MPTVAL 89 : GOTO 666 90 : 200 CONTINUE 91 : C 92 : C ON CONSTRUIT UN VECTEUR DIRIGE VERS L EXTERIEUR DU FLUIDE 93 : C 94 : DO 210 ID=1,NOELIQ 95 : NOE=IPT2.NUM(ID,IC) 96 : DO 220 IB=1,NOERAC*2 97 : IF(NOE.EQ.NUM(IB,JA)) GOTO 210 98 : 220 CONTINUE 99 : GOTO 230 100 : 210 CONTINUE 101 : 230 CONTINUE 102 : iru= mod((ib+4),8) 103 : DO 300 I=1,IDIM 104 : XE(I,1)=XCOOR((NUM(iru,JA)-1)*(IDIM+1)+I) 105 : XE(I,2)=XCOOR((NOE-1)*(IDIM+1)+I) 106 : MELVAL=IVAL(I) 107 : VELCHE(1,JA)=XE(I,1)-XE(I,2) 108 : 300 CONTINUE 109 : 1000 CONTINUE 110 : DO 30 IC=1,IDIM 111 : MELVAL=IVAL(IC) 112 : SEGDES MELVAL 113 : 30 CONTINUE 114 : SEGDES MPTVAL 115 : IF(IPT1.LISOUS(/1).NE.0) SEGDES IPT2 116 : 666 CONTINUE 117 : SEGDES IPT1 118 : SEGDES MELEME 119 : 777 CONTINUE 120 : RETURN 121 : END 122 : 123 : 124 : 125 :
© Cast3M 2003 - All rights reserved.
Disclaimer