1 : C MANUC3 SOURCE CHAT 11/03/16 21:27:10 6902 2 : SUBROUTINE MANUC3(MLENT1,MLMOTS,IPOI,MONMOT,MLMOT3,MLMOT2, 3 : . LETYP,JER1,MLMOT4,ICHA) 4 : *------------------------------------------------------------------ 5 : * 6 : * CREATION D'UN MCHAML 7 : * 8 : *------------------------------------------------------------------ 9 : IMPLICIT INTEGER(I-N) 10 : -INC SMCHAML 11 : -INC SMLMOTS 12 : -INC SMLREEL 13 : -INC SMLENTI 14 : -INC SMMODEL 15 : -INC CCOPTIO 16 : * 17 : * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN) 18 : * ----------- 19 : * 20 : * MLENT1 (E) POINTEURS SUR ZONES ELEMENTAIRES DE MAILLAGE 21 : * MLMOTS (E) POINTEUR SUR UN LISTMOTS CONTENANT LES NOMS 22 : * MLMOT3 (E) POINTEUR SUR UN LISTMOTS CONTENANT LES TYPES 23 : * MLMOT2 (E) POINTEUR SUR UN LISTMOTS CONTENANT LES TYPES 24 : * MLMOT4 (E) POINTEUR SUR UN LISTMOTS CONTENANT LES NOMS 25 : * DES CONSTITUANTS 26 : * IPOI (E) POINTEUR SUR UN LISTENTI OU UN LISTREEL 27 : * MONMOT (E) MOT DE 8 CARACTERES 28 : * LETYP (E) TYPE DU MCHAML A CREER 29 : * JER1 (E) LONGUEUR DE LA CHAINE DE CARACTERES 30 : * ICHA (S) POINTEUR SUR LE MCHAML RESULTAT 31 : * 32 : * LANGAGE: 33 : * -------- 34 : * 35 : * ESOPE + FORTRAN77 36 : * 37 : ************************************************************************ 38 : * 39 : SEGMENT MPTVAL 40 : INTEGER IPOS(NS) ,NSOF(NS) 41 : INTEGER IVAL(NCOSOU) 42 : CHARACTER*16 TYVAL(NCOSOU) 43 : ENDSEGMENT 44 : * 45 : SEGMENT NOTYPE 46 : CHARACTER*16 TYPE(NBTYPE) 47 : ENDSEGMENT 48 : * 49 : * 50 : PARAMETER ( N3=6 ) 51 : PARAMETER (NINF=3) 52 : CHARACTER*8 MONMOT 53 : CHARACTER*(NCONCH) CONM 54 : CHARACTER*4 CAR,CAR2 55 : CHARACTER*(*) LETYP 56 : DIMENSION INFOS(NINF) 57 : NCOUCH=0 58 : * 59 : * RECHERCHE DES ZONES DE MAILLAGE ELEMENTAIRES 60 : * 61 : SEGACT,MLENT1 62 : N1=MLENT1.LECT(/1) 63 : INFOS(1) = 0 64 : INFOS(2) = 0 65 : INFOS(3) = NIFOUR 66 : * 67 : * INITIALISATION DU SEGMENT MCHELM 68 : * 69 : L1=JER1 70 : SEGINI,MCHELM 71 : ICHA=MCHELM 72 : TITCHE=LETYP 73 : IFOCHE=IFOUR 74 : * 75 : SEGACT,MLMOTS 76 : SEGACT,MLMOT3 77 : SEGACT,MLMOT2 78 : SEGACT,MLMOT4 79 : N2=MOTS(/2) 80 : IF(MONMOT.EQ.'REAL*8 ') THEN 81 : MLREEL=IPOI 82 : SEGACT,MLREEL 83 : ELSE 84 : MLENTI=IPOI 85 : SEGACT,MLENTI 86 : ENDIF 87 : * 88 : * BOUCLE SUR LES ZONES ELEMENTAIRES DU MAILLAGE 89 : * 90 : DO 20 I=1,N1 91 : IPMAIL = MLENT1.LECT(I) 92 : CONCHE(I)= MLMOT4.MOTS(I) 93 : IMACHE(I)= IPMAIL 94 : INFCHE(I,1) = 0 95 : INFCHE(I,2) = NCOUCH 96 : INFCHE(I,3) = NIFOUR 97 : INFCHE(I,4) = 0 98 : INFCHE(I,5) = 0 99 : INFCHE(I,6) = 1 100 : SEGINI,MCHAML 101 : ICHAML(I)=MCHAML 102 : * 103 : DO 10 IN=1,N2 104 : NOMCHE(IN)=MOTS(IN) 105 : IF (MONMOT.EQ.'REAL*8 ') THEN 106 : TYPCHE(IN)=MONMOT(1:6) 107 : N1PTEL=1 108 : N1EL=1 109 : N2PTEL=0 110 : N2EL=0 111 : ELSE 112 : CAR =MLMOT3.MOTS(IN) 113 : CAR2=MLMOT2.MOTS(IN) 114 : * 115 : * TRAITEMENT PARTICULIER POUR LE TYPE 'MCHAML' 116 : * 117 : IF (CAR.EQ.'MCHA') THEN 118 : IPT = LECT(IN) 118 : CALL QUESUP(0,IPT,0,0,ISUP,IRET) 119 : IF(IERR.NE.0)THEN 120 : SEGSUP MCHAML 121 : GOTO 99 122 : ENDIF 123 : IF (ISUP.NE.1)THEN 124 : MCHEL1=IPT 125 : SEGACT MCHEL1 126 : MOTERR(1:8)=MCHEL1.TITCHE 127 : SEGDES MCHEL1 127 : CALL ERREUR(124) 128 : SEGSUP MCHAML 129 : GOTO 99 130 : ENDIF 131 : NBROBL=1 132 : NBRFAC=0 133 : SEGINI NOMID 134 : MOTAUX=NOMID 135 : LESOBL(1)=NOMCHE(IN) 136 : NBTYPE=1 137 : SEGINI NOTYPE 138 : MOTYPE=NOTYPE 139 : TYPE(1)=' ' 140 : CONM=CONCHE(I) 140 : CALL KOMCHA(IPT,IPMAIL,CONM,MOTAUX,MOTYPE,1,INFOS,3,IVAAUX) 141 : SEGSUP NOTYPE 142 : IF (IERR.NE.0)THEN 143 : SEGSUP MCHAML 144 : GOTO 99 145 : ENDIF 146 : MPTVAL=IVAAUX 147 : TYPCHE(IN)=TYVAL(1) 148 : MELVA1 = IVAL(1) 149 : SEGINI,MELVAL=MELVA1 150 : IELVAL(IN) = MELVAL 151 : SEGDES,MELVAL 152 : GO TO 10 153 : ENDIF 154 : * 155 : TYPCHE(IN)='POINTEUR'//CAR(1:4)//CAR2(1:4) 156 : N1PTEL=0 157 : N1EL=0 158 : N2PTEL=1 159 : N2EL=1 160 : ENDIF 161 : * 162 : * INITIALISATION DU SEGMENT MELVAL 163 : * 164 : SEGINI,MELVAL 165 : IELVAL(IN)=MELVAL 166 : IF (MONMOT.EQ.'REAL*8 ') THEN 167 : VELCHE(N1PTEL,N1EL)=PROG(IN) 168 : ELSE 169 : IELCHE(N2PTEL,N2EL)=LECT(IN) 170 : ENDIF 171 : SEGDES,MELVAL 172 : 10 CONTINUE 173 : * END DO 174 : SEGDES,MCHAML 175 : 20 CONTINUE 176 : * END DO 177 : * 178 : 99 CONTINUE 179 : IF (MONMOT.EQ.'REAL*8 ') THEN 180 : SEGDES,MLREEL 181 : ELSE 182 : SEGDES,MLENTI 183 : ENDIF 184 : SEGDES,MLMOTS 185 : SEGDES,MLMOT4 186 : SEGDES,MLMOT3 187 : SEGDES,MLMOT2 188 : * 189 : IF(IERR.NE.0)THEN 190 : SEGSUP,MCHELM 191 : ELSE 192 : SEGDES,MCHELM 193 : ENDIF 194 : SEGDES,MLENT1 195 : * 196 : END 197 : 198 : 199 : 200 : 201 : 202 : 203 : 204 : 205 :
© Cast3M 2003 - All rights reserved.
Disclaimer