1 : C KCHA1 SOURCE PV 09/03/12 21:25:58 6325 2 : SUBROUTINE KCHA1(MTRAV,IPGEOM,IPRESU) 3 : C----------------------------------------------------------------------- 4 : C Transforme un CHPO de support CENTRE en un MCHAML constant par élément 5 : C Le maillage IPGEOM est le maillage à partir duquel les points CENTRE 6 : C sont créés (verification faite dans kcha.eso). 7 : C----------------------------------------------------------------------- 8 : C 9 : C--------------------------- 10 : C Paramètres Entrée/Sortie : 11 : C--------------------------- 12 : C 13 : C E/ MTRAV : Segment de travail du CHPO de support centre. 14 : C Les valeurs du ième point de MTRAV sont 15 : C à affecter au ième élément de IPGEOM. 16 : C E/ IPGEOM : Support du MCHAML 17 : C /S IPRESU : Contient le MCHAML résultat de support IPGEOM 18 : C 19 : C---------------------- 20 : C Variables en COMMON : 21 : C---------------------- 22 : C 23 : C E/ IFOUR : cf CCOPTIO 24 : C E/ NIFOUR : cf CCOPTIO 25 : C 26 : C----------------------------------------------------------------------- 27 : C 28 : C Langage : ESOPE + FORTRAN77 29 : C 30 : C Auteurs : F.DABBENE 31 : C 32 : C----------------------------------------------------------------------- 33 : IMPLICIT INTEGER(I-N) 34 : IMPLICIT REAL*8 (A-H,O-Z) 35 : C 36 : -INC CCOPTIO 37 : -INC SMCHAML 38 : -INC SMCHPOI 39 : -INC SMELEME 40 : -INC TMTRAV 41 : C 42 : C- Initialisations 43 : C 44 : IELEM = 0 45 : ISTOP = 0 46 : MELEME = IPGEOM 47 : SEGACT MELEME 48 : NBSOUS = LISOUS(/1) 49 : IF (NBSOUS.EQ.0) NBSOUS=1 50 : C 51 : C - Création du MCHELM 52 : C 53 : C - Récupération du nombre total de composantes dans MTRAV 54 : C - Approximation d'une seule harmonique. 55 : C 56 : SEGACT MTRAV 57 : NNIN = IBIN(/1) 58 : C 59 : C - Création par zone élémentaire 60 : C 61 : L1 = 8 62 : N1 = NBSOUS 63 : N3 = 6 64 : SEGINI MCHELM 65 : IPRESU = MCHELM 66 : TITCHE = 'SCALAIRE' 67 : IFOCHE = IFOUR 68 : IF (NBSOUS.EQ.1) THEN 69 : NBNN = NUM(/1) 70 : MELE = ITYPEL 71 : IELE = NUMGEO(MELE) 72 : IMACHE(1) = MELEME 73 : N2 = NNIN 74 : SEGINI MCHAML 75 : DO 5 ICOMP=1,NNIN 76 : NOMCHE(ICOMP) = INCO(ICOMP) 77 : 5 CONTINUE 78 : ICHAML(1) = MCHAML 79 : CONCHE(1) = ' ' 80 : INFCHE(1,1) = 0 81 : INFCHE(1,2) = 0 82 : INFCHE(1,3) = NIFOUR 83 : ISTOP = ISTOP + 1 83 : CALL RESHPT(1,NBNN,IELE,MELE,0,MINTE,IRT1) 84 : IF (IRT1.EQ.0) GOTO 100 85 : INFCHE(1,4) = MINTE 86 : INFCHE(1,5) = 0 87 : INFCHE(1,6) = 2 88 : SEGDES MCHAML 89 : ELSE 90 : IPOS = 0 91 : DO 10 I=1,NBSOUS 92 : IPT1 = LISOUS(I) 93 : SEGACT IPT1 94 : NBNN = IPT1.NUM(/1) 95 : NBELEM = IPT1.NUM(/2) 96 : MELE = IPT1.ITYPEL 97 : IELE = NUMGEO(MELE) 98 : IMACHE(I) = IPT1 99 : SEGDES IPT1 100 : CONCHE(I) = ' ' 101 : N2 = NNIN 102 : SEGINI MCHAML 103 : C - Recherche du nombre de composantes réellement dans la zone : 104 : C On ne conserve que les composantes ayant une valeur pour au moins un 105 : C point du sous-maillage 106 : IN2 = 0 107 : DO 20 ICOMP=1,NNIN 108 : DO 30 NEL=1,NBELEM 109 : IF (IBIN(ICOMP,IPOS+NEL).EQ.1) THEN 110 : IN2 = IN2 + 1 111 : NOMCHE(IN2) = INCO(ICOMP) 112 : GOTO 20 113 : ENDIF 114 : 30 CONTINUE 115 : 20 CONTINUE 116 : C On ajuste la taille du MCHAML au nouveau nombre de composantes 117 : N2 = IN2 118 : SEGADJ MCHAML 119 : ICHAML(I) = MCHAML 120 : INFCHE(I,1) = 0 121 : INFCHE(I,2) = 0 122 : INFCHE(I,3) = NIFOUR 123 : ISTOP = ISTOP + 1 123 : CALL RESHPT(1,NBNN,IELE,MELE,0,MINTE,IRT1) 124 : IF (IRT1.EQ.0) GOTO 100 125 : INFCHE(I,4) = MINTE 126 : INFCHE(I,5) = 0 127 : INFCHE(I,6) = 2 128 : SEGDES MCHAML 129 : IPOS = IPOS + NBELEM 130 : 10 CONTINUE 131 : ENDIF 132 : SEGDES MELEME 133 : C 134 : C- Remplissage du MCHAML et du MELVAL de chaque sous zone 135 : C 136 : DO 40 I=1,NBSOUS 137 : MELEME = IMACHE(I) 138 : MCHAML = ICHAML(I) 139 : SEGACT MELEME 140 : SEGACT MCHAML*MOD 141 : N2 = NOMCHE(/2) 142 : N1PTEL = 1 143 : N1EL = MELEME.NUM(/2) 144 : N2PTEL = 0 145 : N2EL = 0 146 : 147 : DO 50 ICOMP=1,N2 148 : SEGINI MELVAL 149 : TYPCHE(ICOMP) = 'REAL*8' 150 : IELVAL(ICOMP) = MELVAL 151 : IF (NBSOUS.EQ.1) THEN 152 : IPOS = ICOMP 153 : ELSE 153 : CALL PLACE(INCO,NNIN,IPOS,NOMCHE(ICOMP)) 154 : ENDIF 155 : IPOS1 = IELEM 156 : DO 60 NEL=1,N1EL 157 : IPOS1 = IPOS1 + 1 158 : VELCHE(1,NEL) = BB(IPOS,IPOS1) 159 : 60 CONTINUE 160 : SEGDES MELVAL 161 : 50 CONTINUE 162 : SEGDES MCHAML 163 : SEGDES MELEME 164 : IELEM = IELEM + N1EL 165 : 40 CONTINUE 166 : SEGDES MCHELM 167 : SEGSUP MTRAV 168 : RETURN 169 : C 170 : C- Ménage en cas d'erreur 171 : C 172 : 100 CONTINUE 173 : SEGDES MCHAML 174 : SEGDES MCHELM 175 : SEGDES MELEME 176 : IPRESU = 0 177 : C 178 : RETURN 179 : END 180 : 181 :
© Cast3M 2003 - All rights reserved.
Disclaimer