1 : C RACOMA SOURCE CHAT 05/01/13 02:44:33 5004 2 : SUBROUTINE RACOMA(IFOUR,NIFOUR,IDIM,XE,CFPI,WORK,REL,LRE) 3 : C======================================================================= 4 : C 5 : C CALCULE LA MATRICE MASSE DE L ELEMENT DE RACCORD 6 : C LIQUIDE COQUE CAS BIDIMENSIONNEL 7 : C (INTEGRE LE PRODUIT XPI*U AVEC U DEPLACEMENT NORMAL A LA COQUE) 8 : C 9 : C ROUTINE FORTRAN PUR 10 : C 11 : C JACQUELINE BROCHARD DECEMBRE 85 12 : C======================================================================= 13 : C ENTREES 14 : C IFOUR = IFOUR DE CCOPTIO 15 : C NIFOUR = NIFOUR DE CCOPTIO 16 : C XE(3,NBNN) = COORDONNEES LOCALES DE L ELEMENT 17 : C CFPI = COEFFICIENT DE NORMALISATION SUR XPI 18 : C WORK(IDIM) = COMPOSANTES DE LA NORMALE SORTANTE AU FLUIDE 19 : C SORTIES 20 : C REL(LRE,LRE) = MATRICE DE MASSE 21 : C======================================================================= 22 : IMPLICIT INTEGER(I-N) 23 : IMPLICIT REAL*8 (A-H,O-Z) 24 : C Include contenant quelques constantes dont XPI : 25 : -INC CCREEL 26 : DIMENSION XE(3,*),WORK(IDIM),REL(LRE,*) 27 : DATA EPSI/1.D-12/ 28 : C 29 : C CALCUL DES COMPOSANTES DU VECTEUR NORMAL A LA COQUE 30 : C ET COMPARAISON DE L ORIENTATION DE LA NORMALE SORTANTE AU FLUIDE 31 : C A CELLE DE LA COQUE 32 : C 33 : ALFA=-(XE(2,4)-XE(2,3)) 34 : BETA=XE(1,4)-XE(1,3) 35 : PSCAL=ALFA*WORK(1)+BETA*WORK(2) 36 : IF (ABS(PSCAL).LT.EPSI) GOTO 777 37 : SENS=PSCAL/ABS(PSCAL) 38 : C ---------- NORME 39 : C ********** INCA SOMMME(COS**2)=1< AQUAMODE SOMME(COS**2)=.5D0 40 : COEF=-SENS*CFPI 41 : C ---------- PRELIMINAIRES 42 : A=XE(1,1)+XE(1,2) 43 : B=XE(1,2)-XE(1,1) 44 : CP=XE(2,2)-XE(2,1) 45 : AL=SQRT(B*B+CP*CP) 46 : SP=B/AL 47 : CP=CP/AL 48 : AD=COEF*AL/120.D0 49 : C **** PLAN ***** 50 : IF( IFOUR. GE.0) GO TO 20 51 : A=2.D0 52 : B=0.D0 53 : 20 CONTINUE 54 : IF(IFOUR.EQ.0.OR.(IFOUR.EQ.1.AND. 55 : + NIFOUR.EQ.0)) THEN 56 : COEF=2*XPI 57 : ELSEIF(IFOUR.EQ.1.AND.NIFOUR.NE.0) THEN 58 : COEF=XPI 59 : ELSE 60 : COEF=1.D0 61 : ENDIF 62 : A=A*AD*COEF 63 : B=B*AD*COEF 64 : ASP=A*SP 65 : BSP=B*SP 66 : ACP=A*CP 67 : BCP=B*CP 68 : AD=A*AL 69 : BD=B*AL 70 : C ---------- ON REMPLIT LA MATRICE 71 : C ---------- SEULS LES TERMES SUR XPI*UR XPI*UZ XPI*RT 72 : C ---------- NE SONT PAS NULS 73 : IF(IFOUR.LT.1) NCP=3 74 : IF(IFOUR.EQ.1) NCP=4 75 : IC1=4 76 : IC2=4+NCP 77 : REL(2,IC1+1)=21.D0*ACP-11.D0*BCP 78 : REL(2,IC1+2)=-21.D0*ASP+11.D0*BSP 79 : REL(2,IC1+NCP)=-3.D0*AD+BD 80 : REL(2,IC2+1)=9.D0*ACP+BCP 81 : REL(2,IC2+2)=-9.D0*ASP-BSP 82 : REL(2,IC2+NCP)=2.D0*AD 83 : REL(4,IC1+1)=9.D0*ACP-BCP 84 : REL(4,IC1+2)=-9.D0*ASP+BSP 85 : REL(4,IC1+NCP)=-REL(2,IC2+NCP) 86 : REL(4,IC2+1)=21.D0*ACP+11.D0*BCP 87 : REL(4,IC2+2)=-21.D0*ASP-11.D0*BSP 88 : REL(4,IC2+NCP)=3.D0*AD+BD 89 : C 90 : C LE COUPLAGE LIQUIDE-COQUE LIENT LES NOEUDS 1-4 ET 2-3 , 91 : C ON INVERSE DONC LES TERMES SUR LES NOEUDS 3 ET 4 92 : C 93 : DO 1 IA=1,2 94 : JA=2*IA 95 : DO 11 IB=5,IC2 96 : ELT=REL(JA,IB) 97 : JB=IB+NCP 98 : REL(JA,IB)=REL(JA,JB) 99 : REL(JA,JB)=ELT 100 : 11 CONTINUE 101 : 1 CONTINUE 102 : C ---------- SYMETRISATION 103 : JB1=5 104 : JB2=4+2*NCP 105 : DO 40 IA=1,2 106 : JA=2*IA 107 : DO 41 JB=JB1,JB2 108 : REL(JB,JA)=REL(JA,JB) 109 : 41 CONTINUE 110 : 40 CONTINUE 111 : GOTO 666 112 : C 113 : C ERREUR LE VECTEUR PERMETTANT D ORIENTER L ELEMENT DE RACCORD 114 : C EST NUL OU PARALLELE A LA FRONTIERE DU FLUIDE 115 : C 115 : 777 CALL ERREUR(246) 116 : 666 CONTINUE 117 : RETURN 118 : END 119 : 120 : 121 : 122 : 123 : 124 :
© Cast3M 2003 - All rights reserved.
Disclaimer