C KPSOML SOURCE PV 22/04/21 21:15:06 11344 SUBROUTINE KPSOML C************************************************************************ C C OBJET : C C CALCUL DE LA MATRICE MASSE ---> Creation d'un CHAML C C C SYNTAXE : C C RES = KPSO OBJ1 <'AXI' i> <'IMPR'> ; C C OBJ1 : Table DOMAINE C C AXI : Calcule en coordonee cylindrique 2D C i=2 axe de symetrie oy C C C************************************************************************ IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) -INC CCGEOME -INC PPARAM -INC CCOPTIO -INC SMELEME -INC SMTABLE -INC SMCOORD -INC SMCHAML -INC SMCHPOI -INC SIZFFB dimension mtabd(1) CHARACTER*8 NOM0,CHAI,LISMO(1),TYPE,TYPC DATA LISMO/'IMPR '/ C *************************************************************** IMPR=0 IAXI=0 IF(IFOMOD.EQ.0)IAXI=2 CALL LITABS('DOMAINE ',MTABD,1,1,IRET) IF(IRET.EQ.0)THEN WRITE(6,*)' On attend une table de soustype DOMAINE' RETURN ENDIF TYPE=' ' CALL ACMO(MTABD(1),'MAILLAGE',TYPE,MELEME) IF(TYPE.NE.'MAILLAGE')RETURN 19 CONTINUE CALL LIRCHA(CHAI,0,IRET) IF(IRET.EQ.0)GO TO 20 CALL OPTLI(IP,LISMO,CHAI,1) IF(IP.EQ.0)THEN WRITE(6,*)' On attend le mot cle IMPR ' RETURN ENDIF IMPR=1 GO TO 19 20 CONTINUE C CREATION DE LA DIAGONALE CALL CRCHPE(MELEME,1,MCHELM) SEGACT MCHELM NBSOUS=IMACHE(/1) C C BOUCLE SUR LES TYPES D'ELEMENTS ET CALCUL C DO 1 KSOUS=1,NBSOUS MCHAML=ICHAML(KSOUS) SEGACT MCHAML MELVAL=IELVAL(1) SEGACT MELVAL*MOD IPT1=IMACHE(KSOUS) SEGACT IPT1 NP=IPT1.NUM(/1) NEL=IPT1.NUM(/2) C NOM0=NOMS(IPT1.ITYPEL)//' ' CALL KALPBG(NOM0,'FONFORM ',IZFFM) SEGACT IZFFM*MOD IZHR=KZHR(1) SEGACT IZHR*MOD C NPG=FN(/2) NES=GR(/1) IF(IMPR.NE.0)THEN WRITE(6,*)' SUB CADGSI : NES,NP,NPG,IDIM,NEL=' & ,NES,NP,NPG,IDIM,NEL ENDIF C DO 10 K=1,NEL C NPGR=0 IF(IAXI.NE.0)NPGR=NPG C DO 12 I=1,NP J=IPT1.NUM(I,K) DO 12 N=1,IDIM XYZ(N,I)=XCOOR((J-1)*(IDIM+1) +N) 12 CONTINUE CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NP,NPG,IAXI,AIRE) IF(IMPR.NE.0)THEN WRITE(6,*)' SUB kpsoml : AIRE=',AIRE WRITE(6,*)' SUB kpsoml : LER ' WRITE(6,1001)(IPT1.NUM(I,K),I=1,NP) WRITE(6,*)' SUB kpsoml : XYZ ' WRITE(6,1002)((XYZ(N,I),N=1,2),I=1,NP) ENDIF C DO 3 J=1,NP SJ=0.D0 DO 4 L=1,NPG 4 SJ=SJ+FN(J,L)*PGSQ(L) 3 VELCHE(J,K)=SJ IF(IMPR.NE.0)THEN WRITE(6,*)' SUB CADGSI : CALCUL DE LA DIAGONALE' WRITE(6,1003)(K,VELCHE(I,K),I=1,NP) WRITE(6,*)' FIN DE CADGSI' ENDIF C 10 CONTINUE SEGDES MELVAL,MCHAML SEGDES IPT1 SEGSUP IZFFM,IZHR 1 CONTINUE SEGDES MCHELM CALL ECROBJ('MCHAML ',MCHELM) RETURN 1001 FORMAT(20(1X,I5)) 1002 FORMAT(10(1X,1PE11.4)) 1003 FORMAT(6(1X,I7,1X,1PE11.4)) END