1 : C ETALCH SOURCE CHAT 05/01/12 23:46:02 5004 2 : SUBROUTINE ETALCH(MCHPOI,IINC,ICPR,ICONTR,MVA,IPB,NPR2) 3 : C 4 : C======================================================================= 5 : C CE SUBROUTINE ETALE LE CHPOINT DANS LE TABLEAU MVA 6 : C ***** ENTREES ***** 7 : C IINC CONTIENT LA LISTE DES COMPOSANTES DU TABLEAU 8 : C ICPR(I)=K : LE POINT I EST LE KIEME DU TABLEAU MVA 9 : C ON VERIFIE QUE LES POINTS DE MCHPOI MUNIS DE LEUR COMPOSANTES SONT 10 : C CONTENUS DANS MVA, C.A.D. QUE MCONTR(I,J)=1 POUR CES POINTS 11 : C ***** SORTIES ***** 12 : C LES VALEURS DE MVA DANS LE CHPOINT 13 : C EVENTUELLEMENT IPB LE TABLEAU DE CORRESPONDANCE DES POINTS 14 : C IPB(I)=II LE IEME POINT DU CHPOINT EST A LA PLACE II DANS MVA 15 : C NPR2 = NOMBRE DE POINTS DU MCHPOI 16 : C 17 : C ATTENTION : SEGACT MVA,IPB ET MISE A ZERO DE CES 2 TABLEAUX AVANT 18 : C UTILISATION. 19 : C======================================================================= 20 : IMPLICIT INTEGER(I-N) 21 : -INC CCOPTIO 22 : -INC SMCHPOI 23 : -INC SMELEME 24 : SEGMENT ICPR(XCOOR(/1)/(IDIM+1)) 25 : SEGMENT IINC 26 : CHARACTER*4 CIINC(0) 27 : ENDSEGMENT 28 : SEGMENT/MVA/(VA(NNI1,IPR1)*D),MVA1.MVA 29 : SEGMENT/ICONTR/(MCONTR(NNI1,IPR1)) 30 : SEGMENT IPB(IPR1) 31 : C 32 : SEGACT ICPR 33 : SEGACT IINC 34 : SEGACT MVA*MOD 35 : SEGACT ICONTR 36 : IF(IPB.NE.0) SEGACT IPB*MOD 37 : NNI1=VA(/1) 38 : IPR1=VA(/2) 39 : NPR2=0 40 : C 41 : DO 1 J=1,IPR1 42 : DO 1 K=1,NNI1 43 : VA(K,J)=0. 44 : 1 CONTINUE 45 : C 46 : IF(IPB.EQ.0) GO TO 2 47 : DO 3 J=1,IPR1 48 : IPB(J)=0 49 : 3 CONTINUE 50 : 2 CONTINUE 51 : SEGACT MCHPOI 52 : NSOUP=IPCHP(/1) 53 : DO 60 ISOUP=1,NSOUP 54 : MSOUPO=IPCHP(ISOUP) 55 : SEGACT MSOUPO 56 : MELEME=IGEOC 57 : SEGACT MELEME 58 : N2=NUM(/2) 59 : MPOVAL=IPOVAL 60 : SEGACT MPOVAL 61 : DO 61 J=1,NOCOMP(/2) 62 : DO 62 K=1,NNI1 63 : IF(NOCOMP(J).EQ.CIINC(K)) GO TO 63 64 : 62 CONTINUE 65 : IJ=1 66 : GOTO 66 67 : 63 CONTINUE 68 : IF(IPB.NE.0) GO TO 65 69 : DO 64 IJ=1,N2 70 : KI=ICPR(NUM(1,IJ)) 71 : IF(MCONTR(K,KI).NE.1) GO TO 66 72 : VA(K,KI)=VPOCHA(IJ,J) 73 : 64 CONTINUE 74 : GO TO 61 75 : 65 CONTINUE 76 : DO 75 IJ=1,N2 77 : KI=ICPR(NUM(1,IJ)) 78 : IF(MCONTR(K,KI).NE.1) GO TO 66 79 : IF(J.EQ.1) IPB(NPR2+IJ)=KI 80 : VA(K,KI)=VPOCHA(IJ,J) 81 : 75 CONTINUE 82 : GO TO 61 83 : 66 CONTINUE 84 : MOTERR(1:4)=NOCOMP(J) 85 : INTERR(1)=NUM(1,IJ) 85 : CALL ERREUR(140) 86 : C INCOMPATIBILITE ENTRE LES POINTS ET COMPOSANTES DES 2 CHPOINTS 87 : GO TO 5000 88 : 61 CONTINUE 89 : NPR2=NPR2+N2 90 : SEGDES MELEME 91 : SEGDES MSOUPO 92 : SEGDES MPOVAL 93 : 60 CONTINUE 94 : SEGDES MCHPOI 95 : C 96 : SEGDES ICPR,IINC 97 : SEGDES ICONTR 98 : SEGDES MVA 99 : IF(IPB.NE.0) SEGDES IPB 100 : 5000 CONTINUE 101 : RETURN 102 : END 103 : 104 :
© Cast3M 2003 - All rights reserved.
Disclaimer