1 : C VRACOR SOURCE CHAT 11/03/16 21:33:34 6902 2 : SUBROUTINE VRACOR(IPMODE,IPLIQU,IFLAG,ICARA) 3 : ************************************************************** 4 : * CALUL DES VECTEURS DIRIGES VERS L'EXTERIEUR DU FLUIDE POUR 5 : * LES ELEMENTS RACCORDS FLUIDE-MECANIQUE ,ET LES AJOUTER DANS 6 : * LE CHAMP/ELEMENT DE CARACTERISTIQUES 7 : * 8 : * ENTREES : 9 : * 10 : * IPMODE = POINTEUR SUR UN OBJET MMODEL 11 : * IPLIQU =POINTUER SUR LE MAILLAGE LIQUIDE 12 : * ICARA = POINTEUR SUR LE CHAMP/ELEMENT DE CARACTERISTIQUES 13 : * IFLAG = 1 LE CHAMELEM DE CARACTERISTIQUES EXITE =2 IL N'EXISTE PAS 14 : * SORTIES : 15 : * 16 : * ICARA =POINTEUR SUR LE CHAMP/ELEMENT DE CARACTERISTIQUES 17 : * COMPLETE 18 : **************************************************************** 19 : IMPLICIT INTEGER(I-N) 20 : IMPLICIT REAL*8(A-H,O-Z) 21 : * 22 : -INC CCOPTIO 23 : -INC SMCHAML 24 : -INC SMMODEL 25 : * 26 : SEGMENT MPTVAL 27 : INTEGER IPOS(NS),NSOF(NS) 28 : INTEGER IVAL(NCOSOU) 29 : CHARACTER*16 TYVAL(NCOSOU) 30 : ENDSEGMENT 31 : * 32 : SEGMENT INFO 33 : INTEGER INFELL(JG) 34 : ENDSEGMENT 35 : * 36 : CHARACTER*4 V(3) 37 : DATA V/'VX ','VY ','VZ '/ 38 : * 39 : MMODEL=IPMODE 40 : * 41 : * ACTIVATION DU MCHAML 42 : * 43 : NSOUS=KMODEL(/1) 44 : IF(IFLAG.NE.2)THEN 45 : MCHELM=ICARA 46 : SEGACT MCHELM 47 : ELSE 48 : N1=NSOUS 49 : L1=16 50 : N3=6 51 : SEGINI MCHELM 52 : ICARA=MCHELM 53 : TITCHE='CARACTERISTIQUES' 54 : IFOCHE=IFOUR 55 : ENDIF 56 : * 57 : * BOUCLE SUR LES SOUS-ZONES 58 : * 59 : DO 500 ISOUS=1,NSOUS 60 : NCOMP=0 61 : IMODEL=KMODEL(ISOUS) 62 : IPMAIL=IMAMOD 62 : CALL VRACO1(IPMAIL,IPLIQU,IMELVA) 63 : IF(IERR.NE.0)THEN 64 : IF(IFLAG.NE.2)THEN 65 : SEGSUP MCHELM 66 : ELSE 67 : SEGDES MCHELM 68 : ENDIF 69 : RETURN 70 : ENDIF 71 : IF(IFLAG.NE.2)THEN 72 : MCHAML=ICHAML(ISOUS) 73 : SEGACT MCHAML 74 : NCOMP=IELVAL(/1) 75 : N2=NCOMP+IDIM 76 : SEGADJ MCHAML 77 : ELSE 78 : N2=IDIM 79 : MELE=NEFMOD 80 : if(infmod(/1).lt.5) then 80 : CALL ELQUOI(MELE,0,3,IPINF,IMODEL) 81 : IF (IERR.NE.0)THEN 82 : IF(IFLAG.NE.2)THEN 83 : SEGSUP MCHELM 84 : ELSE 85 : SEGDES MCHELM 86 : ENDIF 87 : RETURN 88 : ENDIF 89 : INFO=IPINF 90 : IPMIN=INFELL(11) 91 : segsup info 92 : else 93 : IPMIN=INFMOD(5) 94 : endif 95 : IMACHE(ISOUS)=IPMAIL 96 : CONCHE(ISOUS)=CONMOD 97 : INFCHE(ISOUS,1) = 0 98 : INFCHE(ISOUS,2) = 0 99 : INFCHE(ISOUS,3) = NIFOUR 100 : INFCHE(ISOUS,4) = IPMIN 101 : INFCHE(ISOUS,5) = 0 102 : INFCHE(ISOUS,6) = 3 103 : SEGINI MCHAML 104 : ICHAML(ISOUS)=MCHAML 105 : ENDIF 106 : MPTVAL=IMELVA 107 : SEGACT MPTVAL 108 : DO 10 IC=1,IDIM 109 : IELVAL(NCOMP+IC)=IVAL(IC) 110 : NOMCHE(NCOMP+IC)=V(IC) 111 : TYPCHE(NCOMP+IC)=TYVAL(IC) 112 : 10 CONTINUE 113 : SEGSUP MPTVAL 114 : SEGDES MCHAML 115 : 500 CONTINUE 116 : SEGDES,MCHELM 117 : RETURN 118 : END 119 : 120 : 121 : 122 : 123 : 124 : 125 : 126 : 127 : 128 : 129 :
© Cast3M 2003 - All rights reserved.
Disclaimer