1 : C LIGMAI SOURCE CHAT 05/01/13 01:17:40 5004 2 : SUBROUTINE LIGMAI(MELEME,TTRAV,ICAS) 3 : C_______________________________________________________________________ 4 : C ROUTINE LIGMAI 5 : C ENTREE : MELEME ----> OBJET MAILLAGE 6 : C ICAS 1 si on admet une boucle ferméé 0 sinon 7 : C SORTIE : TTRAV -----> UN SEGMENT CONTENANT 8 : C - LA LIGNE DES NOEUDS 9 : C 10 : C ______________________________________________________________________ 11 : IMPLICIT INTEGER(I-N) 12 : -INC CCOPTIO 13 : -INC SMELEME 14 : -INC SMCOORD 15 : SEGMENT ICPR(XCOOR(/1)/(IDIM+1)) 16 : SEGMENT IELE(MAXEL,NNOE) 17 : SEGMENT TTRAV 18 : INTEGER ILIS(NNOE) 19 : ENDSEGMENT 20 : * 21 : * on separe les noeuds concernes en noeuds coins et noeuds 22 : * milieux apres avoir verifie que les seuls elements presents 23 : * sont des seg2 ou des seg3. 24 : * 25 : SEGACT MELEME 26 : IPT1=MELEME 27 : DO 1 I=1,MAX(1,LISOUS(/1)) 28 : IF(LISOUS(/1).NE.0) THEN 29 : IPT1=LISOUS(I) 30 : SEGACT IPT1 31 : ENDIF 32 : IF(IPT1.ITYPEL.NE.2.AND.IPT1.ITYPEL.NE.3) THEN 33 : * write( 6,FMT='('' pas bon itypel'')') 34 : GO TO 1000 35 : ENDIF 36 : 1 CONTINUE 37 : SEGINI ICPR 38 : NNOE=0 39 : MAXEL=0 40 : IELMAX=0 41 : DO 2 IO=1,MAX(1,LISOUS(/1)) 42 : IF(LISOUS(/1).NE.0) THEN 43 : IPT1=LISOUS(IO) 44 : ENDIF 45 : DO 3 I=1,IPT1.NUM(/2) 46 : DO 3 J=1,IPT1.NUM(/1) 47 : IA=IPT1.NUM(J,I) 48 : IF(ICPR(IA).EQ.0) THEN 49 : NNOE=NNOE+1 50 : ENDIF 51 : ICPR(IA)=ICPR(IA)+1 52 : MAXEL=MAX(MAXEL,ICPR(IA)) 53 : 3 CONTINUE 54 : IELMAX=MAX(IELMAX,IPT1.NUM(/2)) 55 : 2 CONTINUE 56 : IELMAX=IELMAX+1 57 : * write(6,fmt='('' nnoe maxel '',2i6)')nnoe,maxel 58 : IF(NNOE.EQ.0) GO TO 1000 59 : IF(MAXEL.GT.2) GO TO 1000 60 : MAXEL=2 61 : SEGINI IELE 62 : IB=0 63 : DO 4 I=1,ICPR(/1) 64 : ICPR(I)=0 65 : 4 CONTINUE 66 : DO 5 IO=1,MAX(1,LISOUS(/1)) 67 : IF(LISOUS(/1).NE.0) THEN 68 : IPT1=LISOUS(IO) 69 : ENDIF 70 : DO 6 I=1,IPT1.NUM(/2) 71 : DO 6 J=1,IPT1.NUM(/1) 72 : IA=IPT1.NUM(J,I) 73 : IF(ICPR(IA).EQ.0) THEN 74 : IB=IB+1 75 : ICPR(IA)=IB 76 : ENDIF 77 : IBA=ICPR(IA) 78 : IF(IELE(1,IBA).EQ.0) THEN 79 : IELE(1,IBA)=I+IO*IELMAX 80 : ELSE 81 : IELE(2,IBA)=I+IO*IELMAX 82 : ENDIF 83 : 6 CONTINUE 84 : 5 CONTINUE 85 : * 86 : * pour trouver une extremite il faut un point extremeite d'un 87 : * element qui n'appartient qu'a un seul element. 88 : * A tout hasard on regarde si le premier element contient 89 : * un point de depart. 90 : * 91 : IF(LISOUS(/1).NE.0) IPT1=LISOUS(1) 92 : IDEP=0 93 : IA=IPT1.NUM(1,1) 94 : IB=ICPR(IA) 95 : IF(IELE(2,IB).EQ.0) THEN 96 : IDEP=IA 97 : ELSE 98 : IA=IPT1.NUM(IPT1.NUM(/1),1) 99 : IB=ICPR(IA) 100 : IF(IELE(2,IB).EQ.0) THEN 101 : IDEP=IA 102 : ENDIF 103 : ENDIF 104 : IF(IDEP.EQ.0) THEN 105 : * recherche d'un point de depart 106 : DO 10 IO=1,MAX(1,LISOUS(/1)) 107 : IF(LISOUS(/1) .NE.0) IPT1=LISOUS(IO) 108 : IDE=IPT1.NUM(/1) 109 : DO 11 I=1,IPT1.NUM(/2) 110 : IDEP=IPT1.NUM(1,I) 111 : IB=ICPR(IDEP) 112 : IF(IELE(2,IB).EQ.0) GO TO 12 113 : IDEP=IPT1.NUM(IDE,I) 114 : IB=ICPR(IDEP) 115 : IF(IELE(2,IB).EQ.0) GO TO 12 116 : 11 CONTINUE 117 : 10 CONTINUE 118 : IF( ICAS.EQ.1) THEN 119 : * ON prend le premier point du premier element 120 : IF(LISOUS(/1) .NE.0) IPT1=LISOUS(1) 121 : IDEP=IPT1.NUM(1,1) 122 : NNOE=NNOE+1 123 : * write(6,fmt='('' nb de point à enregistrer '')') nnoe 124 : ELSE 125 : * write(6,fmt='('' pas de point de depart!'')') 126 : * write(6,fmt='('' iele'',(3i6))') 127 : * $(ko,iele(1,ko),iele(2,ko),ko=1,nnoe) 128 : SEGSUP ICPR,IELE 129 : GO TO 1000 130 : ENDIF 131 : ENDIF 132 : 12 CONTINUE 133 : * 134 : * on connait le poiunt de depart IDEP il suffit de remplir 135 : * le tableau ilis de ttrav 136 : * 137 : SEGINI TTRAV 138 : ILIS(1)=IDEP 139 : IA=ICPR(IDEP) 140 : INLI=1 141 : IDEINI=IDEP 142 : * write(6,fmt='('' inli,idep'',3i6)') inli,idep 143 : IELPRE=IELE(1,IA) 144 : IF(LISOUS(/1).NE.0) THEN 145 : IO=IELPRE/IELMAX 146 : IPT1=LISOUS(IO) 147 : IEL=IELPRE-IO*IELMAX 148 : ELSE 149 : IEL=IELPRE-IELMAX 150 : ENDIF 151 : IF(IPT1.NUM(1,IEL).EQ.IDEP) THEN 152 : DO 17 IK=2,IPT1.NUM(/1) 153 : IDEP=IPT1.NUM(IK,IEL) 154 : INLI=INLI+1 155 : ILIS(INLI)=IDEP 156 : * write(6,fmt='('' 17 inli,idep iel'',3i6)') inli,idep,iel 157 : 17 CONTINUE 158 : ELSE 159 : DO 18 IK=IPT1.NUM(/1)-1,1,-1 160 : IDEP=IPT1.NUM(IK,IEL) 161 : INLI=INLI+1 162 : ILIS(INLI)=IDEP 163 : * write(6,fmt='('' 18 inli,idep iel'',3i6)') inli,idep,iel 164 : 18 CONTINUE 165 : ENDIF 166 : 20 CONTINUE 167 : ILOC=ICPR(IDEP) 168 : IA=IELE(1,ILOC) 169 : * write(6,fmt='('' idep,iloc,ia,ielpre'',4i6)')idep,iloc 170 : * $,ia,ielpre 171 : IF(IA.EQ.IELPRE) THEN 172 : IA=IELE(2,ILOC) 173 : * write(6,fmt='('' idep,iloc,ia,ielpre'',4i6)')idep,iloc 174 : * $,ia,ielpre 175 : IF(IA.EQ.0) GO TO 30 176 : ENDIF 177 : IELPRE=IA 178 : IF(LISOUS(/1).NE.0) THEN 179 : IO=IA/IELMAX 180 : IPT1=LISOUS(IO) 181 : IA=IA-IO*IELMAX 182 : ELSE 183 : IA=IA-IELMAX 184 : ENDIF 185 : IF(IPT1.NUM(1,IA).EQ.IDEP) THEN 186 : DO 21 IK=2,IPT1.NUM(/1) 187 : IDEP=IPT1.NUM(IK,IA) 188 : INLI=INLI+1 189 : ILIS(INLI)=IDEP 190 : * write(6,fmt='('' 21 inli,idep iel'',3i6)') inli,idep,iel 191 : 21 CONTINUE 192 : ELSE 193 : DO 22 IK=IPT1.NUM(/1)-1,1,-1 194 : IDEP=IPT1.NUM(IK,IA) 195 : INLI=INLI+1 196 : ILIS(INLI)=IDEP 197 : * write(6,fmt='('' 22 inli,idep iel'',3i6)') inli,idep,iel 198 : 22 CONTINUE 199 : ENDIF 200 : IF(IDEP.NE.IDEINI)GO TO 20 201 : 30 CONTINUE 202 : SEGSUP ICPR,IELE 203 : IF(INLI.NE.NNOE) THEN 204 : * write(6,fmt='('' icas0 inli nnoe '',2i6)') inli,nnoe 205 : SEGSUP TTRAV 206 : GO TO 1000 207 : ENDIF 208 : SEGDES TTRAV 209 : GO TO 1002 209 : 1000 CALL ERREUR(426) 210 : 1002 CONTINUE 211 : IF(LISOUS(/1).NE.0) THEN 212 : DO 1001 I=1,LISOUS(/1) 213 : IPT1=LISOUS(I) 214 : SEGDES IPT1 215 : 1001 CONTINUE 216 : ENDIF 217 : SEGDES MELEME 218 : RETURN 219 : END 220 : 221 : 222 :
© Cast3M 2003 - All rights reserved.
Disclaimer