1 : C KCHA SOURCE PV 09/03/12 21:26:02 6325
2 : SUBROUTINE KCHA
3 : C-----------------------------------------------------------------------
4 : C Transforme un CHPO de support CENTRE en un MCHAML constant par élément
5 : C Transforme un MCHAML constant par élément en un CHPO de support CENTRE
6 : C de nature DIFFUSE
7 : C-----------------------------------------------------------------------
8 : C
9 : C---------------------------
10 : C Phrase d'appel (GIBIANE) :
11 : C---------------------------
12 : C
13 : C RES1 = 'KCHA' MODL1 MOT1 DONN1 ('QUAF')
14 : C TABL1
15 : C
16 : C------------------------
17 : C Opérandes et résultat :
18 : C------------------------
19 : C
20 : C RES1 : Contient le CHPO ou le MCHAML résultat selon l'option MOT1
21 : C Le support de RES1 est soit table.centre, soit table.maillage
22 : C MOT1 : Mot de quatre lettre indiquant le type d'objet à créer
23 : C Si MOT1='CHPO' un MCHAML constant devient un CHPO centre
24 : C Si MOT1='CHAM' un CHPO centre devient un MCHAML constant
25 : C MODL1 : Objet MMODEL
26 : C TABL1 : TABLE Domaine
27 : C DONN1 : Objet à transformer (CHPO OU MCHAML)
28 : C 'QUAF' : mot de 4 lettres indiquant le travail avec maillage QUAF
29 : C plutôt que simple
30 : C
31 : C-----------------------------------------------------------------------
32 : C
33 : C Langage : ESOPE + FORTRAN77
34 : C
35 : C Auteurs : F.DABBENE 07/94
36 : C Révision : 01/99 P.Maugis
37 : C Révision : 11/06 PM : utilisation maillages QUAF
38 : C
39 : C-----------------------------------------------------------------------
40 : IMPLICIT INTEGER(I-N)
41 : IMPLICIT REAL*8 (A-H,O-Z)
42 : PARAMETER (NBOPT=2)
43 : C
44 : -INC CCOPTIO
45 : -INC SMCHAML
46 : -INC SMCHPOI
47 : -INC SMELEME
48 : -INC SMTABLE
49 : C
50 : CHARACTER*4 MOTOPT(NBOPT),NOMTOT(1),MOQUAF(1)
51 : DATA MOTOPT / 'CHAM' , 'CHPO' /
52 : DATA MOQUAF / 'QUAF' /
53 : LOGICAL LQUAF
54 : C
55 : C- Lecture de l'option et traitement
56 : C
57 : * on construit un CHAMELEM ou un CHPOINT ?
58 : ICOND = 1
58 : CALL LIRMOT(MOTOPT,NBOPT,IKCHA,ICOND)
59 : IF (IKCHA.EQ.0) RETURN
60 :
61 : * maillage simple ou QUAF ?
62 : ICOND = 0
62 : CALL LIRMOT(MOQUAF,1,IQUAF,ICOND)
63 : LQUAF = (IQUAF.EQ.1)
64 : C
65 : C Lecture du modèle
66 : C
66 : CALL LIROBJ('MMODEL',IPMODE,0,IRET)
67 : IF (IERR.NE.0) RETURN
68 : C
69 : C Récupération de la TABLE domaine et des maillages
70 : C
71 : IPTABL = 0
72 : IF(IRET.EQ.0)THEN
72 : CALL LIRTAB('DOMAINE',IPTABL,1,IRET)
73 : IF (IERR.NE.0) RETURN
74 : ELSE
74 : CALL LEKMOD(IPMODE,IPTABL,IRET)
75 : IF (IERR.NE.0) RETURN
76 : ENDIF
77 :
78 : C Maillage des points centres
78 : CALL LEKTAB(IPTABL,'CENTRE ',IPCENT)
79 : IF (IERR.NE.0) RETURN
80 :
81 : C- Maillage support voulu
82 : IF (LQUAF) THEN
82 : CALL LEKTAB(IPTABL,'QUAF ',IPGEOM)
83 : IF (IERR.NE.0) RETURN
84 : ELSE
84 : CALL LEKTAB(IPTABL,'MAILLAGE',IPGEOM)
85 : IF (IERR.NE.0) RETURN
86 : ENDIF
87 : C
88 : C- Transformation ...
89 : C
90 : IF (IKCHA.EQ.1) THEN
91 : C
92 : C- d'un CHPO CENTRE en MCHAML constant par élément
93 : C
94 : C Lecture objet à transformer
94 : CALL LIROBJ('CHPOINT',ICHP1,1,IRET1)
95 : IF (IRET1.EQ.0) RETURN
96 : C Construction du segment de travail
97 : NBCOMP = 0
98 : NOMTOT(1) = ' '
98 : CALL KCHA0(ICHP1,IPCENT,NBCOMP,NOMTOT,MTRAV,IREDIR)
99 : C Appel de la procédure de métamorphose :
99 : CALL KCHA1(MTRAV,IPGEOM,IPRESU)
100 : ELSE
101 : C
102 : C- d'un MCHAML constant par élément en CHPO CENTRE
103 : C
104 : C Lecture objet à transformer
104 : CALL LIROBJ('MCHAML',IPCHE1,1,IRET1)
105 : IF (IRET1.EQ.0) RETURN
106 : C Appel de la procédure de métamorphose :
106 : CALL KCHA2(IPCHE1,IPGEOM,IPCENT,IPRESU)
107 : ENDIF
108 : C
109 : C- Ecriture du résultat
110 : C
111 : IF (IPRESU.EQ.0) then
111 : CALL ERREUR (5)
112 : ELSE
113 : IF (IKCHA.EQ.1) THEN
113 : CALL ECROBJ('MCHAML',IPRESU)
114 : ELSE
114 : CALL ECROBJ('CHPOINT',IPRESU)
115 : ENDIF
116 : ENDIF
117 : C
118 : RETURN
119 : END
120 :
121 :
122 :
123 :
124 :
125 :
126 :
127 :
128 :
© Cast3M 2003 - All rights reserved.
Disclaimer