1 : C AVTRSF SOURCE CHAT 05/01/12 21:30:58 5004 2 : C CE SOUS PROGRAMME FABRIQUE LE SEGMENT FER OU SONT MISE EN FORME 3 : C LES DONNEES DE TRANSF 4 : C 5 : SUBROUTINE AVTRSF(MELEME,FER,IPT5) 6 : C 7 : C MELEME = OBJET A EXPLORER 8 : C FER = DONNEES MISES EN FORME 9 : C IPT5 = OBJET DANS LA NUMEROTATION DE FER 10 : IMPLICIT INTEGER(I-N) 11 : IMPLICIT REAL*8 (A-H,O-Z) 12 : -INC CCOPTIO 13 : -INC SMELEME 14 : -INC SMCOORD 15 : SEGMENT /FER/(NFI(ITT),MAI(IPP),ITOUR),AFER.FER 16 : SEGMENT ICPR(XCOOR(/1)/(IDIM+1)) 17 : SEGMENT IDCP(ITE) 18 : SEGMENT KON(NBCON,NMAX) 19 : SEGMENT IDCT(ITT) 20 : SEGINI ICPR 21 : DO 1 I=1,ICPR(/1) 22 : 1 ICPR(I)=0 23 : C REMPLISSAGE DE ICPR 24 : IT=0 25 : ITE=0 26 : SEGACT MELEME 27 : NBELEM=NUM(/2) 28 : NBNN=NUM(/1) 29 : NBSOUS=0 30 : NBREF=0 31 : ITT=(2+NBNN)*NBELEM 32 : IPP=NBELEM 33 : SEGINI FER 34 : IF (ITYPEL.EQ.2) IPT5=0 35 : IF (IPT5.EQ.0) GOTO 8 36 : SEGINI IPT5 37 : IPT5.ITYPEL=ITYPEL 38 : DO 7 J=1,NBELEM 39 : IT=IT+1 40 : ITE=ITE+1 41 : NFI(IT)=NUM(2,J) 42 : ICPR(NUM(2,J))=ITE 43 : 7 CONTINUE 44 : 8 CONTINUE 45 : DO 2 J=1,NBNN 46 : DO 2 K=1,NBELEM 47 : IPOIT=NUM(J,K) 48 : IF (ICPR(IPOIT).NE.0) GOTO 2 49 : ITE=ITE+1 50 : ICPR(IPOIT)=ITE 51 : 2 CONTINUE 52 : C TABLEAU INVERSE 53 : SEGINI IDCP 54 : ILO=XCOOR(/1)/(IDIM+1) 55 : DO 3 I=1,ILO 56 : II=ILO+1-I 57 : IF (ICPR(II).NE.0) IDCP(ICPR(II))=II 58 : 3 CONTINUE 59 : C ITE EST LE NOMBRE DE POINTS A TRACER ICPR LE TABLEAU 60 : C ON VA MAINTENANT INITIALISER ET REMPLIR LE TABLEAU DES CONNECTIONS 61 : NBCON=3 62 : NBCONR=NBCON-1 63 : NMAX=(5*ITE)/NBCON 64 : SEGINI KON 65 : C MISE A ZERO DU TABLEAU KON 66 : DO 10 I=1,NMAX 67 : DO 10 J=1,NBCON 68 : 10 KON(J,I)=0 69 : C FABRICATION DU TABLEAU DES CONNECTIONS 70 : ICHAIN=ITE 71 : DO 20 I=1,NUM(/2) 72 : N1=ICPR(NUM(1,I)) 73 : N2=ICPR(NUM(NBNN,I)) 74 : IF (N1.EQ.N2) GOTO 31 75 : ISENS=1 76 : NI=N1 77 : NJ=N2 78 : 21 CONTINUE 79 : 22 DO 23 K=1,NBCONR 80 : IF (ABS(KON(K,NI)).EQ.NJ) GOTO 31 81 : IF (KON(K,NI).EQ.0) GOTO 25 82 : 23 CONTINUE 83 : IF (KON(NBCON,NI).EQ.0) GOTO 24 84 : NI=KON(NBCON,NI) 85 : GOTO 22 86 : 24 ICHAIN=ICHAIN+1 87 : IF (ICHAIN.EQ.NMAX) GOTO 30 88 : KON(NBCON,NI)=ICHAIN 89 : K=1 90 : NI=ICHAIN 91 : 25 KON(K,NI)=NJ*ISENS 92 : IF (ISENS.LE.0) GOTO 20 93 : NI=N2 94 : NJ=N1 95 : ISENS=-1 96 : GOTO 21 97 : 20 CONTINUE 98 : C FABRICATION DES CONTOURS 99 : IP=0 100 : MAI(1)=IT 101 : KAUX=1 102 : 40 KAUXR=KAUX 103 : K=KAUX 104 : KPRESS=KAUXR 105 : 41 DO 42 KL=1,NBCONR 106 : ITRA=KON(KL,K) 107 : IF (ITRA.LE.0) GOTO 42 108 : GOTO 44 109 : 42 CONTINUE 110 : K=KON(NBCON,K) 111 : IF (K.NE.0) GOTO 41 112 : 43 KAUX=KAUX+1 113 : IF (KAUX.EQ.ITE+1) GOTO 60 114 : GOTO 40 115 : 44 IT=IT+1 116 : NFI(IT)=IDCP(KAUXR) 117 : GOTO 46 118 : 45 KL=1 119 : 46 DO 47 L=KL,NBCONR 120 : M=ABS(KON(L,K)) 121 : IF (M.EQ.0) GOTO 47 122 : GOTO 48 123 : 47 CONTINUE 124 : K=KON(NBCON,K) 125 : IF (K.EQ.0) GOTO 31 126 : GOTO 45 127 : 48 IT=IT+1 128 : NFI(IT)=IDCP(M) 129 : KON(L,K)=0 130 : M1=M 131 : 49 DO 50 L=1,NBCONR 132 : IF (KON(L,M1).EQ.0) GOTO 50 133 : IF (ABS(KON(L,M1)).EQ.KPRESS) GOTO 51 134 : 50 CONTINUE 135 : M1=KON(NBCON,M1) 136 : GOTO 49 137 : 51 KON(L,M1)=0 138 : IF (M.EQ.KAUXR) GOTO 52 139 : KPRESS=M 140 : K=KPRESS 141 : GOTO 45 142 : 52 IT=IT-1 143 : IP=IP+1 144 : MAI(IP+1)=IT 145 : GOTO 40 146 : 60 CONTINUE 147 : ITOUR=IP 148 : IF (IPT5.EQ.0) GOTO 70 149 : SEGINI IDCT 150 : DO 71 I=1,IT 151 : IDCT(ICPR(NFI(I)))=I 152 : 71 CONTINUE 153 : DO 72 I=1,NBNN 154 : DO 72 J=1,NBELEM 155 : IPT5.NUM(I,J)=IDCT(ICPR(NUM(I,J))) 156 : 72 CONTINUE 157 : SEGSUP IDCT 158 : 70 CONTINUE 159 : SEGSUP KON,ICPR,IDCP 160 : RETURN 160 : 30 CALL ERREUR(23) 161 : RETURN 161 : 31 CALL ERREUR(28) 162 : RETURN 163 : END 164 : 165 : 166 : 167 : 168 :
© Cast3M 2003 - All rights reserved.
Disclaimer