Esope source files

   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 '
  71 :          CALL ARRET(0)
  72 :       ENDIF
  73 :  1008 FORMAT(/8(1X,1PE11.4))
  74 :       END
  75 : 
  76 : 
  77 : 
  78 : 
  79 :  
  80 :