Télécharger licoma.eso

Retour à la liste

Numérotation des lignes :

  1. C LICOMA SOURCE CHAT 05/01/13 01:17:24 5004
  2. SUBROUTINE LICOMA(NBPGAU,IDIM,NBNN,NDDL,XE,CFPI,WORK,POIGAU,
  3. 1 QSIGAU,ETAGAU,SHPTOT,REL,LRE,IER246)
  4. C=======================================================================
  5. C
  6. C CALCULE LA MATRICE MASSE DE L ELEMENT DE RACCORD
  7. C LIQUIDE COQUE CAS TRIDIMENSIONNEL
  8. C (INTEGRE LE PRODUIT PI*U AVEC U DEPLACEMENT NORMAL A LA PAROI
  9. C DU SOLIDE)
  10. C
  11. C ROUTINE FORTRAN PUR
  12. C
  13. C JACQUELINE BROCHARD JUILLET 86
  14. C=======================================================================
  15. C ENTREES
  16. C NBPGAU = NB DE PTS DE GAUSS
  17. C NBNN = NB DE NOEUDS DE L ELEMENT DE RACCORD
  18. C XE(3,NBNN) = COORDONNEES LOCALES DE L ELEMENT
  19. C CFPI = COEFFICIENT DE NORMALISATION SUR PI
  20. C WORK(IDIM) = COMPOSANTES DE LA NORMALE SORTANTE AU FLUIDE
  21. C POIGAU(NBPGAU) = POIDS DE GAUSS
  22. C QSIGAU(NBPGAU),ETAGAU(NBPGAU) = COORDONNEES DES PTS DE GAUSS
  23. C SHPTOT(6,NBNN,NBPGAU) = FONCTIONS DE FORME ET DERIVEES DE
  24. C L ELEMENT DE RACCORD
  25. C SORTIES
  26. C REL(LRE,LRE) = MATRICE DE MASSE
  27. C=======================================================================
  28. IMPLICIT INTEGER(I-N)
  29. IMPLICIT REAL*8 (A-H,O-Z)
  30. DIMENSION XE(3,1),WORK(IDIM),POIGAU(NBPGAU),QSIGAU(NBPGAU)
  31. DIMENSION ETAGAU(NBPGAU),SHPTOT(6,NBNN,1)
  32. DIMENSION XEL(3,3),BPSS(3,3),BB(9),VME(24,24)
  33. DIMENSION REL(LRE,1)
  34. DATA EPSI/1.D-12/
  35. DATA XZER/0.D0/
  36. IER246=0
  37. C
  38. C MATRICE DE PASSAGE
  39. C
  40. CALL VPAST(XE,BPSS)
  41. C
  42. C COORDONNEES LOCALES
  43. C
  44. CALL VCORLC(XE,XEL,BPSS)
  45. C
  46. C MISE A 0 DE LA MATRICE DE MASSE
  47. C
  48. CALL ZERO(VME,LRE,LRE)
  49. C
  50. C CALCUL DE LA SURFACE
  51. C
  52. X21=XEL(1,2)-XEL(1,1)
  53. Y31=XEL(2,3)-XEL(2,1)
  54. SURF=X21*Y31
  55. C
  56. C ON COMPARE L ORIENTATION DE LA NORMALE SORTANTE AU FLUIDE
  57. C A CELLE DE LA PAROI
  58. C
  59. NBNNL=NBNN/2
  60. ID=NBNNL+1
  61. VNQSI1=XZER
  62. VNQSI2=XZER
  63. VNQSI3=XZER
  64. VNETA1=XZER
  65. VNETA2=XZER
  66. VNETA3=XZER
  67. ALFA=XZER
  68. BETA=XZER
  69. GAMMA=XZER
  70. DO 20 J=ID,NBNN
  71. VNQSI1=VNQSI1+SHPTOT(2,J,1)*XE(1,J)
  72. VNQSI2=VNQSI2+SHPTOT(2,J,1)*XE(2,J)
  73. VNQSI3=VNQSI3+SHPTOT(2,J,1)*XE(3,J)
  74. VNETA1=VNETA1+SHPTOT(3,J,1)*XE(1,J)
  75. VNETA2=VNETA2+SHPTOT(3,J,1)*XE(2,J)
  76. VNETA3=VNETA3+SHPTOT(3,J,1)*XE(3,J)
  77. 20 CONTINUE
  78. ALFA=VNQSI2*VNETA3-VNQSI3*VNETA2
  79. BETA=VNQSI3*VNETA1-VNQSI1*VNETA3
  80. GAMMA=VNQSI1*VNETA2-VNQSI2*VNETA1
  81. PSCAL=ALFA*WORK(1)+BETA*WORK(2)+GAMMA*WORK(3)
  82. IF (ABS(PSCAL).LT.EPSI) GOTO 777
  83. SENS=PSCAL/ABS(PSCAL)
  84. C
  85. C CALCUL DES TERMES DE LA MATRICE : INTEGRATION NUMERIQUE
  86. C NL : NUMERO D UN NOEUD LIQUIDE
  87. C IGAU : NUMERO DU POINT DE GAUSS
  88. C J : NUMERO D UN NOEUD DE COQUE
  89. C K INDICE SUR LA COMPOSANTE W , RX , OU RY
  90. C
  91. DO 100 NL=1,NBNNL
  92. IL=2*NL
  93. DO 80 IGAU=1,NBPGAU
  94. C VALEURS DES FONCTIONS DE FORME POUR L ELT DE COQUE
  95. CALL MFDKT(QSIGAU(IGAU),ETAGAU(IGAU),XEL,BB)
  96. DO 30 J=ID,NBNN
  97. INDM=2*NBNNL+(J-ID)*NDDL
  98. DO 35 K=1,3
  99. IC=INDM+2+K
  100. IP=(J-ID)*3+K
  101. VME(IL,IC)=VME(IL,IC)-SENS*CFPI*SURF*SHPTOT(1,NL,IGAU)
  102. 1 *POIGAU(IGAU)*BB(IP)
  103. 35 CONTINUE
  104. 30 CONTINUE
  105. 80 CONTINUE
  106. C
  107. C CHANGEMENT DE REPERE ET SYMETRISATION
  108. C
  109. DO 50 J=ID,NBNN
  110. INDM=2*NBNNL+(J-ID)*NDDL
  111. INDF=INDM+3
  112. DO 55 I=1,3
  113. DO 56 IP=1,3
  114. REL(IL,INDM+I)=REL(IL,INDM+I)+BPSS(IP,I)*VME(IL,INDM+IP)
  115. REL(IL,INDF+I)=REL(IL,INDF+I)+BPSS(IP,I)*VME(IL,INDF+IP)
  116. 56 CONTINUE
  117. 55 CONTINUE
  118. DO 40 K=1,6
  119. IC=INDM+K
  120. REL(IC,IL)=REL(IL,IC)
  121. 40 CONTINUE
  122. 50 CONTINUE
  123. 100 CONTINUE
  124. GOTO 666
  125. C
  126. C ERREUR LE VECTEUR PERMETTANT D ORIENTER L ELEMENT DE RACCORD
  127. C EST NUL OU PARALLELE A LA FRONTIERE DU FLUIDE
  128. C
  129. 777 IER246=246
  130. 666 CONTINUE
  131. RETURN
  132. END
  133.  
  134.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales