1 : C COPBA4 SOURCE CHAT 05/01/12 22:19:35 5004
2 : SUBROUTINE COPBA4(ITMOD,ITPSM)
3 : IMPLICIT INTEGER(I-N)
4 : IMPLICIT REAL*8(A-H,O-Z)
5 : ************************************************************************
6 : * *
7 : * Projecte le champ base B des pseudo-modes sur la base modale. *
8 : * *
9 : * Param}tres: *
10 : * *
11 : * e ITMOD Table des modes de sous-type BASE_DE_MODES *
12 : * es ITPSM Table des pseudo-modes *
13 : * *
14 : * *
15 : * Auteur, date de cr{ation: *
16 : * *
17 : * Lionel VIVAN Aout 1990 *
18 : * *
19 : ************************************************************************
20 : *
21 : LOGICAL L0,L1
22 : CHARACTER*8 TYPRET,CHARRE
23 : CHARACTER*40 MONTYP
24 : *
25 : IPSM = 0
26 : 10 CONTINUE
27 : IPSM = IPSM + 1
28 : TYPRET = ' '
28 : CALL ACCTAB(ITPSM,'ENTIER',IPSM,X0,' ',L0,IP0,
29 : & TYPRET,I1,X1,CHARRE,L1,ITTP)
30 : IF (TYPRET.EQ.'TABLE ' .AND. ITTP.NE.0) THEN
30 : CALL ACCTAB(ITTP,'MOT',I0,X0,'SOUSTYPE',L0,IP0,
31 : & 'MOT',I1,X1,MONTYP,L1,IP1)
32 : *
33 : * cas des forces concentr{es
34 : *
35 : IF (MONTYP(1:9).EQ.'PSMO_FORC') THEN
35 : CALL ACCTAB(ITTP,'MOT',I0,X0,'CHAMP_BASE_B',L0,IP0,
36 : & 'CHPOINT',I1,X1,' ',L1,ICHPT)
36 : CALL PROJTA(ICHPT,ITMOD,ICHPR)
36 : CALL ECCTAB(ITTP,'MOT',I0,X0,'CHAMP_BASE_A',L0,IP0,
37 : & 'CHPOINT',I1,X1,' ',L1,ICHPR)
38 : *
39 : * cas des structures multisupport{es
40 : *
41 : ELSE IF (MONTYP(1:9).EQ.'PSMO_DEPL') THEN
41 : CALL ACCTAB(ITTP,'MOT',I0,X0,'CHAMP_BASE_B',L0,IP0,
42 : & 'CHPOINT',I1,X1,' ',L1,ICHPT)
42 : CALL PROJTA(ICHPT,ITMOD,ICHPR)
42 : CALL ECCTAB(ITTP,'MOT',I0,X0,'CHAMP_BASE_A',L0,IP0,
43 : & 'CHPOINT',I1,X1,' ',L1,ICHPR)
44 : ENDIF
45 : GOTO 10
46 : ENDIF
47 : *
48 : END
49 :
50 :
© Cast3M 2003 - All rights reserved.
Disclaimer