1 : C INDCR SOURCE PV 09/03/12 21:25:16 6325 2 : SUBROUTINE INDCR(MOT,NMO,IER,IMAIL,ICHA) 3 : C======================================================================= 4 : C SUBROUTINE DE LA PROCEDURE INDIC DE QUALITE D'UN MAILLAGE 5 : C PHILIPPE BEAUMIER 90 6 : C CONTIENT LES ZONES RELATIVES AUX DIFFERENTS CHAMPS 7 : C CREATION DU CHAMELEM RESULTAT 8 : C 9 : C======================================================================= 10 : C 11 : C INPUT 12 : C 13 : C MOT : SUCCESSION DES MOTS CLES LUS 14 : C NMO : NOMBRE DE MOTS CLES LUS 15 : C IER : INDICATEUR D'ERREUR (0 SI ERREUR) 16 : C IMAIL : POINTEUR SUR LE MAILLAGE 17 : C ICHA : POINTEUR SUR LE CHAMELEM 18 : C 19 : C OUTPUT 20 : C 21 : C ICHA : POINTEUR SUR LE CHAMELEM 22 : C 23 : IMPLICIT INTEGER(I-N) 24 : IMPLICIT REAL*8(A-H,O-Z) 25 : -INC CCOPTIO 26 : -INC SMCHAML 27 : -INC SMELEME 28 : -INC SMCOORD 29 : C 30 : CHARACTER*(*) MOT(*) 31 : SEGMENT/WRK1/(XE(3,NBNO)) 32 : C 33 : IER = 1 34 : MELEME = IMAIL 35 : SEGACT MELEME 36 : IPT1 = MELEME 37 : IF(NMO.EQ.0) IER=0 38 : IF(IER.EQ.0) GOTO 666 39 : L1=7 40 : NSOUS = LISOUS(/1) 41 : N1=NSOUS 42 : IF(N1.EQ.0) N1=1 43 : N3=5 44 : SEGINI MCHELM 45 : ICHA = MCHELM 46 : IFOCHE = IFOUR 47 : C 48 : C BOUCLE SUR LES DIFFERENTS MOTS CLES 49 : C 50 : DO 1 IMOT=1,NMO 51 : IF (MOT(IMOT).EQ.'PLAN') THEN 52 : C 53 : C====================================================================== 54 : C 55 : C ZONE RELATIVE AU CALCUL DE LA PLANEARITE DU MAILLAGE 56 : C 57 : C====================================================================== 58 : C 59 : C ON CREE UN CHAMELEM INDIQUANT LA PLANEARITE D'UN MAILLAGE 60 : C 61 : TITCHE='QUALITE' 62 : DO 10 ISOUS=1,MAX(1,NSOUS) 63 : IF(NSOUS.NE.0) THEN 64 : IPT1=LISOUS(ISOUS) 65 : SEGACT IPT1 66 : ENDIF 67 : IMACHE(ISOUS)=IPT1 68 : CONCHE(ISOUS)=' ' 69 : INFCHE(ISOUS,1)=0 70 : INFCHE(ISOUS,2)=0 71 : INFCHE(ISOUS,3)=NIFOUR 72 : INFCHE(ISOUS,4)=0 73 : INFCHE(ISOUS,5)=0 74 : N2 = NMO 75 : SEGINI MCHAML 76 : NOMCHE(IMOT)='PLAN' 77 : TYPCHE(IMOT)='REAL*8' 78 : ICHAML(ISOUS)=MCHAML 79 : IF(((IPT1.ITYPEL).NE.8).AND.((IPT1.ITYPEL).NE.10).AND. 80 : 1 ((IPT1.ITYPEL).NE.4).AND.((IPT1.ITYPEL).NE.6)) THEN 81 : C 82 : C LES ELEMENTS NE SONT PAS DES QUA4,QUA8,TRI3,TRI6 83 : C 84 : N1PTEL=0 85 : N2PTEL=0 86 : N1EL=0 87 : N2EL=0 88 : SEGINI MELVAL 89 : IELVAL(IMOT)=MELVAL 90 : ELSE 91 : C 92 : C ELEMENT QUA4,QUA8,TRI3,TRI6 93 : C 94 : N1PTEL=1 95 : C NB DE NOEUDS PAR ELEMENT DANS LE MELEME 96 : N2PTEL=0 97 : N1EL=IPT1.NUM(/2) 98 : C NB D'ELEMENTS DANS LE MELEME 99 : N2EL=0 100 : SEGINI MELVAL 101 : IELVAL(IMOT)=MELVAL 102 : C 103 : C CALCUL DES VALEURS DU CHAMP 104 : C 105 : NBNO = IPT1.NUM(/1) 106 : SEGINI WRK1 106 : CALL NORCOS(VELCHE,IPT1.NUM(/1),N1EL,XCOOR,IDIM,IPT1.NUM, 107 : 1 XE,IPT1.ITYPEL) 108 : SEGDES WRK1 109 : ENDIF 110 : SEGDES MELVAL 111 : IF(NSOUS.NE.0) THEN 112 : SEGDES IPT1 113 : ENDIF 114 : SEGDES MCHAML 115 : 10 CONTINUE 116 : C 117 : ELSE 118 : C 119 : C AUTRES MOTS CLES 120 : C 121 : ENDIF 122 : C 123 : 1 CONTINUE 124 : MCHELM = ICHA 125 : SEGDES MCHELM 126 : MELEME=IMAIL 127 : SEGDES MELEME 128 : 666 RETURN 129 : END 130 : 131 : 132 : 133 : 134 :
© Cast3M 2003 - All rights reserved.
Disclaimer