Numérotation des lignes :

C CALHRH    SOURCE    CHAT      05/01/12    21:46:15     5004      SUBROUTINE CALHRH(AH,Q1,Q2,Q3,IES)      IMPLICIT INTEGER(I-N)      IMPLICIT REAL*8 (A-H,O-Z)C*****************************************************************************C     CE SP CALCUL LES CORRECTIONS D'HOURGLASS EN 2D POUR UN QUA4C                                              EN 3D POUR UN CUB8CC***************************************************************************** -INC PPARAM-INC CCOPTIO      REAL*8 AH(8,8),V(4)      REAL*8 A1(8,8),A2(8,8),A3(8,8),A4(8,8)      REAL*8 Q1(8,8),Q2(8,8),Q3(8,8)      REAL*8 V1(8),V2(8),V3(8),V4(8)       DATA V4/-1.D0,1.D0,-1.D0,1.D0,1.D0,-1.D0,1.D0,-1.D0/      DATA V1/1.D0,1.D0,-1.D0,-1.D0,-1.D0,-1.D0,1.D0,1.D0/      DATA V2/1.D0,-1.D0,-1.D0,1.D0,-1.D0,1.D0,1.D0,-1.D0/      DATA V3/1.D0,-1.D0,1.D0,-1.D0,1.D0,-1.D0,1.D0,-1.D0/      DATA V/1.D0,-1.D0,1.D0,-1.D0/CCC     WRITE(IOIMP,*)'CALHRH ies=',ies      IF(IES.EQ.2)THEN         NP=4         DO 1 I=1,NP            DO 11 J=1,NP               AH(J,I)=V(I)*V(J) 11         CONTINUE 1       CONTINUE         RETURNC      ELSEIF(IES.EQ.3)THEN         NP=8         DO 2 I=1,NP            DO 21 J=1,NP               A1(J,I)=V1(I)*V1(J) 21         CONTINUE 2       CONTINUEC     WRITE(IOIMP,1008)A1         DO 3 I=1,NP            DO 31 J=1,NP               A2(J,I)=V2(I)*V2(J) 31         CONTINUE 3       CONTINUEC     WRITE(IOIMP,1008)A2         DO 4 I=1,NP            DO 41 J=1,NP               A3(J,I)=V3(I)*V3(J) 41         CONTINUE 4       CONTINUEC     WRITE(IOIMP,1008)A3         DO 5 I=1,NP            DO 51 J=1,NP               A4(J,I)=V4(I)*V4(J) 51         CONTINUE 5       CONTINUEC     WRITE(IOIMP,1008)A4 1004    FORMAT(4(10X,1PE11.4,2X,1PE11.4,2X,1PE11.4,2X,1PE11.4/))         DO 10 I=1,NP            DO 101 J=1,NP               Q1(J,I)=(A1(J,I)+A2(J,I)+A4(J,I)/3.D0)/48.D0               Q2(J,I)=(A1(J,I)+A3(J,I)+A4(J,I)/3.D0)/48.D0               Q3(J,I)=(A2(J,I)+A3(J,I)+A4(J,I)/3.D0)/48.D0               AH(J,I)=Q1(J,I)+Q2(J,I)+Q3(J,I) 101        CONTINUE 10      CONTINUEC     WRITE(IOIMP,1008)AH         RETURN      ELSE         WRITE(IOIMP,*)' DIMENSION ESPACE ERRONEE '         CALL ARRET(0)      ENDIF 1008 FORMAT(/8(1X,1PE11.4))      END

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