1 : C EVNUMO SOURCE CHAT 05/01/12 23:46:57 5004 2 : SUBROUTINE EVNUMO(ITYPE,IRET,NOMCO,IBOO) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : C======================================================================= 6 : C CHERCHE DANS L'OBJET IRET DE TYPE ITYPE LA LISTE DES POINTS ET 7 : C REMPLIT LE TABLEAU NUMOO 8 : C APPELE PAR EVSOLU 9 : C APPELLE CHANGE,LIRE,REFUS,ERREUR(66) 10 : C ECRIT PAR FARVACQUE LE 24/10/85 11 : C======================================================================= 12 : -INC CCOPTIO 13 : -INC SMSOLUT 14 : -INC SMATTAC 15 : -INC SMELEME 16 : -INC SMCHPOI 17 : SEGMENT ITRAV1(0) 18 : SEGMENT STRAV2 19 : CHARACTER*4 ITRAV2(0) 20 : ENDSEGMENT 21 : SEGMENT NUMOO 22 : INTEGER NUMO(N),KLIST(N) 23 : CHARACTER*4 NUDDL(N) 24 : ENDSEGMENT 25 : LOGICAL L0,L1 26 : CHARACTER*8 ITYPE,TYPRET,CHARRE 27 : CHARACTER*4 NOMCO 28 : * 29 : IF (ITYPE.EQ.'POINT ') THEN 30 : N=1 31 : SEGINI NUMOO 32 : NUMO(1)=IRET 33 : NUDDL(1)=NOMCO 34 : * 35 : ELSE IF (ITYPE.EQ.'MAILLAGE') THEN 36 : MELEME= IRET 37 : SEGACT MELEME 37 : IF(ITYPEL.NE.1) CALL CHANGE (IRET,1) 38 : MELEME=IRET 39 : SEGACT MELEME 40 : N=NUM(/2) 41 : SEGINI NUMOO 42 : DO 10 I=1,N 43 : NUMO(I)=NUM(1,I) 44 : NUDDL(I)=NOMCO 45 : 10 CONTINUE 46 : SEGDES MELEME 47 : * 48 : ELSE IF (ITYPE.EQ.'CHPOINT ') THEN 49 : MCHPOI=IRET 50 : SEGACT MCHPOI 51 : NSOUPO=IPCHP(/1) 52 : SEGINI ITRAV1 53 : SEGINI STRAV2 54 : DO 20 I=1,NSOUPO 55 : MSOUPO=IPCHP(I) 56 : SEGACT MSOUPO 57 : MELEME=IGEOC 58 : SEGACT MELEME 59 : NP=NUM(/2) 60 : NC=NOCOMP(/2) 61 : MPOVAL=IPOVAL 62 : SEGACT MPOVAL 63 : DO 22 J1=1,NP 64 : DO 22 J2=1,NC 65 : * IF(VPOCHA(J1,J2).EQ.0.) GOTO 22 66 : ITRAV1(**)=NUM(1,J1) 67 : ITRAV2(**)=NOCOMP(J2) 68 : 22 CONTINUE 69 : SEGDES MELEME,MPOVAL,MSOUPO 70 : 20 CONTINUE 71 : SEGDES MCHPOI 72 : N=ITRAV1(/1) 73 : SEGINI NUMOO 74 : DO 24 I=1,N 75 : NUMO(I)=ITRAV1(I) 76 : NUDDL(I)=ITRAV2(I) 77 : 24 CONTINUE 78 : SEGSUP ITRAV1,STRAV2 79 : * 80 : ELSE IF (ITYPE.EQ.'ATTACHE ') THEN 81 : MATTAC=IRET 82 : SEGACT MATTAC 83 : NSOU=LISATT(/1) 84 : N=0 85 : NI=0 86 : SEGINI NUMOO 87 : DO 30 I=1,NSOU 88 : MSOUMA=LISATT(I) 89 : SEGACT MSOUMA 90 : MJONCT=IATREL(1) 91 : SEGDES MSOUMA 92 : SEGACT MJONCT 93 : MCHPOI=MJOPOI 94 : SEGDES MJONCT 95 : SEGACT MCHPOI 96 : MSOUPO=IPCHP(1) 97 : SEGDES MCHPOI 98 : SEGACT MSOUPO 99 : MELEME=IGEOC 100 : SEGDES MSOUPO 101 : SEGACT MELEME 102 : NM=NUM(/2) 103 : N=N+NM 104 : SEGADJ NUMOO 105 : DO 32 J=1,NM 106 : NUMO(NI+J)=NUM(1,J) 107 : NUDDL(NI+J)=NOMCO 108 : 32 CONTINUE 109 : NI=N 110 : SEGDES MELEME 111 : 30 CONTINUE 112 : SEGDES MATTAC 113 : * 114 : ELSE IF (ITYPE.EQ.'SOLUTION') THEN 115 : MSOLUT=IRET 116 : SEGACT MSOLUT 117 : IF (MSOLIS(3).EQ.0) THEN 118 : MOTERR(1:8)='SOLUTION' 119 : MOTERR(9:16)='MODE' 119 : CALL ERREUR(66) 120 : * ON ATTEND UN MODE 121 : SEGDES MSOLUT 122 : GOTO 5000 123 : ELSE 124 : MELEME=MSOLIS(3) 125 : SEGDES MSOLUT 126 : SEGACT MELEME 127 : N=NUM(/2) 128 : SEGINI NUMOO 129 : DO 40 I=1,N 130 : NUMO(I)=NUM(1,I) 131 : NUDDL(I)=NOMCO 132 : 40 CONTINUE 133 : SEGDES MELEME 134 : ENDIF 135 : * 136 : ELSE IF (ITYPE.EQ.'TABLE ') THEN 136 : CALL ACCTAB(IRET,'MOT',I0,X0,'MODES',L0,IP0, 137 : & 'TABLE',I1,X1,' ',L1,IBAS) 138 : IB = 0 139 : NBMODE = 0 140 : 50 CONTINUE 141 : IB = IB + 1 142 : TYPRET = ' ' 142 : CALL ACCTAB(IBAS,'ENTIER',IB,X0,' ',L0,IP0, 143 : & TYPRET,I1,X1,CHARRE,L1,IBBB) 144 : IF (IBBB.NE.0 .AND. TYPRET.EQ.'TABLE ') THEN 145 : NBMODE = NBMODE + 1 146 : GOTO 50 147 : ENDIF 148 : N = NBMODE 149 : SEGINI NUMOO 150 : DO 52 IB = 1,NBMODE 150 : CALL ACCTAB(IBAS,'ENTIER',IB,X0,' ',L0,IP0, 151 : & TYPRET,I1,X1,TYPRET,L1,IBBB) 151 : CALL ACCTAB(IBBB,'MOT',I0,X0,'POINT_REPERE',L0,IP0, 152 : & 'POINT',I1,X1,' ',L1,IPTR) 153 : NUMO(IB)=IPTR 154 : NUDDL(IB)=NOMCO 155 : 52 CONTINUE 156 : ENDIF 157 : IBOO=NUMOO 158 : IF(IIMPI.NE.0)WRITE(6,1700)(NUMO(I),NUDDL(I),I=1,NUMO(/1)) 159 : 1700 FORMAT(' COUPLES NUMO-NUDDL ',10(I5,A4,1X)) 160 : 5000 CONTINUE 161 : RETURN 162 : END 163 : 164 :
© Cast3M 2003 - All rights reserved.
Disclaimer