Numérotation des lignes :

C KPRISS    SOURCE    PV        16/11/17    22:00:18     9180                 SUBROUTINE KPRISS(MELEME,IPM1,IPM2,IPM3,IAXI,IKAS,MACRO,KPRE)      IMPLICIT INTEGER(I-N)      IMPLICIT REAL*8 (A-H,O-Z)C*****************************************************************************CC     Ce SP calcule les matrices elementaires de divergence alias CCC*****************************************************************************      CHARACTER*8 NOM0 -INC CCOPTIO-INC CCGEOME-INC SMCOORD-INC SIZFFB      POINTEUR IZF1.IZFFM-INC SMMATRIK-INC SMELEME-INC CCREEL      DIMENSION KIPM(3),XYZ1(24)  C OPERATEUR PRESSIONC      DEUPI=1.D0      IF(IAXI.NE.0)DEUPI=2.D0*XPI C     write(6,*)' DEUPI=',deupi      IF(IDIM.EQ.2)IPM3=IPM1      KIPM(1)=IPM1      KIPM(2)=IPM2      KIPM(3)=IPM3      SEGACT MELEME,IPM1*MOD,IPM2*MOD,IPM3*MOD       NP=NUM(/1)      NEL=NUM(/2)       IF(KPRE.NE.2)THEN       IF(MACRO.EQ.0)THEN       IF(KPRE.EQ.3)NOM0=NOMS(ITYPEL)//'PRP0'       IF(KPRE.EQ.4)NOM0=NOMS(ITYPEL)//'PRP1'       ELSE       IF(KPRE.EQ.3)NOM0=NOMS(ITYPEL)//'MCP0'       IF(KPRE.EQ.4)NOM0=NOMS(ITYPEL)//'MCP1'       ENDIF       CALL KALPBG(NOM0,'FONFORM ',IZFFM)C      write(6,*)' NOM0=',nom0,' ikas=',ikas,' nel=',nel       SEGACT IZFFM*MOD      IZHR=KZHR(1)      SEGACT IZHR*MOD      NES=GR(/1)      NPG=GR(/3)      IZF1=KTP(1)      SEGACT IZF1*MOD      MP1=IZF1.FN(/1)       DO 30 KE=1,NEL      DO 12 I=1,NP      J=NUM(I,KE)      DO 12 N=1,IDIM      XYZ(N,I)=XCOOR((J-1)*(IDIM+1)    +N) 12   CONTINUE       CALL CALJBR     &(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NP,NPG,IAXI,AIRE,AJ,SGN)C     write(6,*)' Retour caljbr ',mp1,np,npg       DO 324 K=1,IDIM      IPM4=KIPM(K)       DO 323 M=1,MP1       DO 323 I=1,NP      U=0.D0      DO 333 L=1,NPG      U=U+IZF1.FN(M,L)*HR(K,I,L)*PGSQ(L)*DEUPI*RPG(L) 333  CONTINUE       IF(IAXI.NE.0.AND.K.EQ.1)THEN      DO 334 L=1,NPG      U=U+IZF1.FN(M,L)*FN(I,L)*PGSQ(L)*DEUPI 334  CONTINUE      ENDIF       if(ikas.ne.2)then      IPM4.AM(KE,I,M)=IPM4.AM(KE,I,M)+U      else      IPM4.AM(KE,M,I)=IPM4.AM(KE,M,I)+U      endif  323  CONTINUE 324  CONTINUE  37   CONTINUE 30   CONTINUE       SEGSUP IZHR,IZFFM  C CAS MACRO CENTRE       ELSEIF(KPRE.EQ.2)THEN        NOM0=NOMS(ITYPEL)//'    '        CALL KALPBG(NOM0,'FONFORM ',IZFFM)         SEGACT IZFFM*MOD        IZHR=KZHR(1)        SEGACT IZHR*MOD        NES=GR(/1)        NPG=GR(/3)        IZF1=KTP(1)        SEGACT IZF1*MOD        MPG=IZF1.FN(/2)        NP=GR(/2)         DO 40 KE=1,NEL         IX=0        DO 42 I=1,NP        J=NUM(I,KE)        DO 42 N=1,IDIM        IX=IX+1        XYZ1(IX)=XCOOR((J-1)*(IDIM+1)    +N) 42     CONTINUE       CALL CALJBR(FN,GR,PG,XYZ1,HR,PGSQ,RPG,NES,     & IDIM,NP,NPG,IAXI,AIRE,AJ,SGN)       DO 424 K=1,IDIM      IPM4=KIPM(K)       DO 423 I=1,NP      U=0.D0      DO 433 L=1,NPG      U=U+HR(K,I,L)*PGSQ(L)*DEUPI*RPG(L) 433  CONTINUE       IF(IAXI.NE.0.AND.K.EQ.1)THEN      DO 434 L=1,NPG      U=U+FN(I,L)*PGSQ(L)*DEUPI 434  CONTINUE      ENDIF       if(ikas.ne.2)then      IPM4.AM(KE,I,1)=IPM4.AM(KE,I,1)+U      else      IPM4.AM(KE,1,I)=IPM4.AM(KE,1,I)+U      endif  423  CONTINUE 424  CONTINUE  40   CONTINUE       SEGSUP IZHR,IZFFM       ENDIF       RETURN 1002 FORMAT(10(1X,1PE11.4)) 1040 FORMAT(1X,'CALCUL MATRICE AM ',I4/10(1X,1PE11.4))      END

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