Télécharger calhrh.eso

Retour à la liste

Numérotation des lignes :

  1. C CALHRH SOURCE CHAT 05/01/12 21:46:15 5004
  2. SUBROUTINE CALHRH(AH,Q1,Q2,Q3,IES)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C*****************************************************************************
  6. C CE SP CALCUL LES CORRECTIONS D'HOURGLASS EN 2D POUR UN QUA4
  7. C EN 3D POUR UN CUB8
  8. C
  9. C*****************************************************************************
  10. -INC CCOPTIO
  11. REAL*8 AH(8,8),V(4)
  12. REAL*8 A1(8,8),A2(8,8),A3(8,8),A4(8,8)
  13. REAL*8 Q1(8,8),Q2(8,8),Q3(8,8)
  14. REAL*8 V1(8),V2(8),V3(8),V4(8)
  15.  
  16. DATA V4/-1.D0,1.D0,-1.D0,1.D0,1.D0,-1.D0,1.D0,-1.D0/
  17. DATA V1/1.D0,1.D0,-1.D0,-1.D0,-1.D0,-1.D0,1.D0,1.D0/
  18. DATA V2/1.D0,-1.D0,-1.D0,1.D0,-1.D0,1.D0,1.D0,-1.D0/
  19. DATA V3/1.D0,-1.D0,1.D0,-1.D0,1.D0,-1.D0,1.D0,-1.D0/
  20. DATA V/1.D0,-1.D0,1.D0,-1.D0/
  21. C
  22. C
  23. C WRITE(IOIMP,*)'CALHRH ies=',ies
  24. IF(IES.EQ.2)THEN
  25. NP=4
  26. DO 1 I=1,NP
  27. DO 11 J=1,NP
  28. AH(J,I)=V(I)*V(J)
  29. 11 CONTINUE
  30. 1 CONTINUE
  31. RETURN
  32. C
  33. ELSEIF(IES.EQ.3)THEN
  34. NP=8
  35. DO 2 I=1,NP
  36. DO 21 J=1,NP
  37. A1(J,I)=V1(I)*V1(J)
  38. 21 CONTINUE
  39. 2 CONTINUE
  40. C WRITE(IOIMP,1008)A1
  41. DO 3 I=1,NP
  42. DO 31 J=1,NP
  43. A2(J,I)=V2(I)*V2(J)
  44. 31 CONTINUE
  45. 3 CONTINUE
  46. C WRITE(IOIMP,1008)A2
  47. DO 4 I=1,NP
  48. DO 41 J=1,NP
  49. A3(J,I)=V3(I)*V3(J)
  50. 41 CONTINUE
  51. 4 CONTINUE
  52. C WRITE(IOIMP,1008)A3
  53. DO 5 I=1,NP
  54. DO 51 J=1,NP
  55. A4(J,I)=V4(I)*V4(J)
  56. 51 CONTINUE
  57. 5 CONTINUE
  58. C WRITE(IOIMP,1008)A4
  59. 1004 FORMAT(4(10X,1PE11.4,2X,1PE11.4,2X,1PE11.4,2X,1PE11.4/))
  60. DO 10 I=1,NP
  61. DO 101 J=1,NP
  62. Q1(J,I)=(A1(J,I)+A2(J,I)+A4(J,I)/3.D0)/48.D0
  63. Q2(J,I)=(A1(J,I)+A3(J,I)+A4(J,I)/3.D0)/48.D0
  64. Q3(J,I)=(A2(J,I)+A3(J,I)+A4(J,I)/3.D0)/48.D0
  65. AH(J,I)=Q1(J,I)+Q2(J,I)+Q3(J,I)
  66. 101 CONTINUE
  67. 10 CONTINUE
  68. C WRITE(IOIMP,1008)AH
  69. RETURN
  70. ELSE
  71. WRITE(IOIMP,*)' DIMENSION ESPACE ERRONEE '
  72. CALL ARRET(0)
  73. ENDIF
  74. 1008 FORMAT(/8(1X,1PE11.4))
  75. END
  76.  
  77.  
  78.  
  79.  
  80.  
  81.  
  82.  

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