Télécharger la plaquette Cast3M


fr en

Télécharger calhrh.eso

Retour à la liste

Numérotation des lignes : 

calhrh

  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