C KPRISS SOURCE PV 20/09/28 21:15:19 10727 SUBROUTINE KPRISS(MELEME,IPM1,IPM2,IPM3,IAXI,IKAS,MACRO,KPRE) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) C***************************************************************************** C C Ce SP calcule les matrices elementaires de divergence alias C C C***************************************************************************** CHARACTER*8 NOM0 -INC PPARAM -INC CCOPTIO -INC CCGEOME -INC SMCOORD -INC SIZFFB POINTEUR IZF1.IZFFM -INC SMMATRIK -INC SMELEME -INC CCREEL DIMENSION KIPM(3),XYZ1(24) C OPERATEUR PRESSION C 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 I=1,NP J=NUM(I,KE) DO N=1,IDIM XYZ(N,I)=XCOOR((J-1)*(IDIM+1) +N) ENDDO ENDDO 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 M=1,MP1 DO 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 ENDDO ENDDO 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 I=1,NP J=NUM(I,KE) DO N=1,IDIM IX=IX+1 XYZ1(IX)=XCOOR((J-1)*(IDIM+1) +N) ENDDO ENDDO 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