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.  
  11. -INC PPARAM
  12. -INC CCOPTIO
  13. REAL*8 AH(8,8),V(4)
  14. REAL*8 A1(8,8),A2(8,8),A3(8,8),A4(8,8)
  15. REAL*8 Q1(8,8),Q2(8,8),Q3(8,8)
  16. REAL*8 V1(8),V2(8),V3(8),V4(8)
  17.  
  18. DATA V4/-1.D0,1.D0,-1.D0,1.D0,1.D0,-1.D0,1.D0,-1.D0/
  19. DATA V1/1.D0,1.D0,-1.D0,-1.D0,-1.D0,-1.D0,1.D0,1.D0/
  20. DATA V2/1.D0,-1.D0,-1.D0,1.D0,-1.D0,1.D0,1.D0,-1.D0/
  21. DATA V3/1.D0,-1.D0,1.D0,-1.D0,1.D0,-1.D0,1.D0,-1.D0/
  22. DATA V/1.D0,-1.D0,1.D0,-1.D0/
  23. C
  24. C
  25. C WRITE(IOIMP,*)'CALHRH ies=',ies
  26. IF(IES.EQ.2)THEN
  27. NP=4
  28. DO 1 I=1,NP
  29. DO 11 J=1,NP
  30. AH(J,I)=V(I)*V(J)
  31. 11 CONTINUE
  32. 1 CONTINUE
  33. RETURN
  34. C
  35. ELSEIF(IES.EQ.3)THEN
  36. NP=8
  37. DO 2 I=1,NP
  38. DO 21 J=1,NP
  39. A1(J,I)=V1(I)*V1(J)
  40. 21 CONTINUE
  41. 2 CONTINUE
  42. C WRITE(IOIMP,1008)A1
  43. DO 3 I=1,NP
  44. DO 31 J=1,NP
  45. A2(J,I)=V2(I)*V2(J)
  46. 31 CONTINUE
  47. 3 CONTINUE
  48. C WRITE(IOIMP,1008)A2
  49. DO 4 I=1,NP
  50. DO 41 J=1,NP
  51. A3(J,I)=V3(I)*V3(J)
  52. 41 CONTINUE
  53. 4 CONTINUE
  54. C WRITE(IOIMP,1008)A3
  55. DO 5 I=1,NP
  56. DO 51 J=1,NP
  57. A4(J,I)=V4(I)*V4(J)
  58. 51 CONTINUE
  59. 5 CONTINUE
  60. C WRITE(IOIMP,1008)A4
  61. 1004 FORMAT(4(10X,1PE11.4,2X,1PE11.4,2X,1PE11.4,2X,1PE11.4/))
  62. DO 10 I=1,NP
  63. DO 101 J=1,NP
  64. Q1(J,I)=(A1(J,I)+A2(J,I)+A4(J,I)/3.D0)/48.D0
  65. Q2(J,I)=(A1(J,I)+A3(J,I)+A4(J,I)/3.D0)/48.D0
  66. Q3(J,I)=(A2(J,I)+A3(J,I)+A4(J,I)/3.D0)/48.D0
  67. AH(J,I)=Q1(J,I)+Q2(J,I)+Q3(J,I)
  68. 101 CONTINUE
  69. 10 CONTINUE
  70. C WRITE(IOIMP,1008)AH
  71. RETURN
  72. ELSE
  73. WRITE(IOIMP,*)' DIMENSION ESPACE ERRONEE '
  74. CALL ARRET(0)
  75. ENDIF
  76. 1008 FORMAT(/8(1X,1PE11.4))
  77. END
  78.  
  79.  
  80.  
  81.  
  82.  
  83.  
  84.  

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