1 : C CADGFA SOURCE MAGN 10/05/18 21:15:00 6675 2 : SUBROUTINE CADGFA 3 : C************************************************************************ 4 : C 5 : C OBJET : 6 : C 7 : C CALCUL DE LA MATRICE MASSE DIAGONALE POUR LES FACES 8 : C ---> Creation d'un CHAMPOIN 9 : C D0=NI ( MASSE LUMPE ) 10 : C 11 : C SYNTAXE : 12 : C 13 : C RES = DGSI OBJ1 <'AXI' i> <'IMPR'> ; 14 : C 15 : C OBJ1 : Table DOMAINE 16 : C 17 : C AXI : Calcule en coordonee cylindrique 2D 18 : C i=2 axe de symetrie oy 19 : C 20 : C 21 : C************************************************************************ 22 : IMPLICIT INTEGER(I-N) 23 : IMPLICIT REAL*8 (A-H,O-Z) 24 : -INC CCOPTIO 25 : -INC SMELEME 26 : -INC SMTABLE 27 : POINTEUR MTABD.MTABLE 28 : -INC SMCOORD 29 : -INC SMLENTI 30 : POINTEUR IZIPAD.MLENTI 31 : -INC SMCHPOI 32 : -INC SIZFFB 33 : CHARACTER*8 NOM0,CHAI,LISMO(1),TYPE,TYPC 34 : DATA LISMO/'IMPR '/ 35 : C *************************************************************** 36 : 37 : IMPR=0 38 : IAXI=0 39 : IF(IFOMOD.EQ.0)IAXI=2 40 : 40 : CALL LITABS('DOMAINE ',MTABD,1,1,IRET) 41 : IF(IRET.EQ.0)THEN 42 : WRITE(6,*)' On attend une table de soustype DOMAINE' 43 : RETURN 44 : ENDIF 45 : SEGACT MTABD 46 : TYPE=' ' 46 : CALL ACMO(MTABD,'MAILLAGE',TYPE,MELEME) 47 : IF(TYPE.NE.'MAILLAGE')RETURN 48 : TYPE=' ' 48 : CALL ACMO(MTABD,'FACE',TYPE,MELEMF) 49 : IF(TYPE.NE.'MAILLAGE')RETURN 50 : TYPE=' ' 50 : CALL ACMO(MTABD,'CENTRE',TYPE,MELEMC) 51 : IF(TYPE.NE.'MAILLAGE')RETURN 51 : CALL LEKTAB(MTABD,'FACEL',MELEME) 52 : IF(MELEME.EQ.0)RETURN 52 : CALL LEKTAB(MTABD,'XXVOLUM',MCHPO1) 53 : IF(MCHPO1.EQ.0)RETURN 54 : 55 : 19 CONTINUE 55 : CALL LIRCHA(CHAI,0,IRET) 56 : IF(IRET.EQ.0)GO TO 20 56 : CALL OPTLI(IP,LISMO,CHAI,1) 57 : IF(IP.EQ.0)THEN 58 : WRITE(6,*)' On attend le mot cle IMPR ' 59 : RETURN 60 : ENDIF 61 : IMPR=1 62 : GO TO 19 63 : 64 : 20 CONTINUE 65 : 65 : CALL KRIPAD(MELEMC,MLENT1) 65 : CALL KRIPAD(MELEMF,MLENT2) 66 : 67 : C CREATION DE LA DIAGONALE 67 : CALL CRCHPT('FACE',MELEMF,1,MCHPOI) 67 : CALL LICHT(MCHPOI,MPOVAL,TYPC,IGEOM) 67 : CALL LICHT(MCHPO1,MPOVA1,TYPC,IGEOM) 68 : SEGACT MELEME 69 : C 70 : C BOUCLE SUR LES TYPES D'ELEMENTS ET CALCUL 71 : C 72 : NBEL=NUM(/2) 73 : DO 1 K=1,NBEL 74 : I1=NUM(1,K) 75 : I2=NUM(2,K) 76 : I3=NUM(3,K) 77 : I1=MLENT1.LECT(I1) 78 : I2=MLENT2.LECT(I2) 79 : I3=MLENT1.LECT(I3) 80 : V=(MPOVA1.VPOCHA(I1,1)+MPOVA1.VPOCHA(I3,1) )*0.5D0 81 : VPOCHA(I2,1)=V 82 : 1 CONTINUE 83 : 84 : IF(IMPR.NE.0)THEN 85 : WRITE(6,*)' SUB CADGFA : CALCUL DE LA DIAGONALE' 86 : WRITE(6,1003)(I,VPOCHA(I,1),I=1,VPOCHA(/1)) 87 : WRITE(6,*)' FIN DE CADGFA' 88 : ENDIF 89 : 90 : SEGDES MELEME 91 : SEGDES MTABD 92 : SEGSUP MLENT1,MLENT2 93 : SEGDES MCHPOI,MPOVAL 93 : CALL ECROBJ('CHPOINT',MCHPOI) 94 : RETURN 95 : 1001 FORMAT(20(1X,I5)) 96 : 1002 FORMAT(10(1X,1PE11.4)) 97 : 1003 FORMAT(6(1X,I7,1X,1PE11.4)) 98 : END 99 : 100 : 101 : 102 : 103 : 104 :
© Cast3M 2003 - All rights reserved.
Disclaimer