1 : C EVCHPO SOURCE GOUNAND 12/08/30 21:15:06 7490 2 : SUBROUTINE EVCHPO(ICOUL) 3 : C====================================================================== 4 : C OPTION CHPO DE L'OPERATEUR EVOL C 5 : C C 6 : C LA SYNTHAXE DE CETTE OPTION D'EVOL EST LA SUIVANTE : C 7 : C C 8 : C C 9 : C EV1 = EVOL (COUL) CHPO CHPT COMP LIGN; C 10 : C C 11 : C C 12 : C + COUL : COULEUR DE LA COURBE (FACULTATIVE) C 13 : C C 14 : C + CHPT : CHAMP-POINT C 15 : C C 16 : C + COMP : COMPOSANTE DU CHAMP POINT C 17 : C C 18 : C + LIGN : LIGNE DE NOEUDS. C 19 : C C 20 : C C 21 : C====================================================================== 22 : IMPLICIT INTEGER(I-N) 23 : IMPLICIT REAL*8 (A-H,O-Z) 24 : -INC CCOPTIO 25 : -INC SMEVOLL 26 : -INC SMCHPOI 27 : -INC SMLREEL 28 : -INC SMELEME 29 : -INC SMCOORD 30 : -INC SMLMOTS 31 : -INC TMTRAV 32 : SEGMENT MVOL 33 : REAL*8 MMABS(JG) 34 : REAL*8 MMORD(JG) 35 : CHARACTER*4 NOMAB(JG) 36 : REAL*8 POSNO(JG) 37 : ENDSEGMENT 38 : SEGMENT TTRAV 39 : INTEGER ILIS(IDIMM) 40 : ENDSEGMENT 41 : CHARACTER*8 NOMQUA,NOM 42 : CHARACTER*4 CMOT 43 : CHARACTER*8 NCHPT,NMAIL 44 : CHARACTER*23 UMOT1 45 : CHARACTER*16 UMOT2 46 : CHARACTER*12 UMOT3 47 : CHARACTER*72 TITRE 48 : REAL*8 DEPA(400),PREC(3),TREPA(400),MYPOS(3),HEPOS(3) 49 : LOGICAL FIRST,SECOND,THIRD,NOMME 50 : DIMENSION ITABCH(3) 51 : CMOT=' ' 52 : C LECTURE DES DIFFERENTES ENTREES 53 : C LECTURE DU CHAMP-POINT 53 : CALL LIROBJ ('CHPOINT',IBOPOI,1,IRETOC) 54 : IF (IRETOC.EQ.0) GOTO 111 55 : MCHPOI=IBOPOI 56 : C LECTURE DE LA COMPOSANTE 56 : CALL LIRCHA(CMOT,0,IRETOU) 57 : C LECTURE DE L'OBJET MAILLAGE 57 : CALL LIROBJ('MAILLAGE',IPOI,1,IRETOM) 58 : IF (IRETOM.EQ.0) GOTO 111 59 : MELEME = IPOI 59 : CALL LIGMAI(MELEME,TTRAV,1) 60 : IF(IERR.NE.0) RETURN 61 : SEGACT TTRAV 62 : NBNN=ILIS(/1) 63 : JG=NBNN 64 : SEGINI MVOL 65 : C APPEL A UNE ROUTINE DE PRESENTATION D'UN CHPOINT SOUS FORME RESUME 65 : CALL TRACHP(MCHPOI,MTRAV) 66 : SEGACT MTRAV 67 : SEGACT MCOORD 68 : ICC=0 69 : NCO=INCO(/2) 70 : * 71 : IF(IRETOU.EQ.0.AND.NCO.GT.1) THEN 72 : MOTERR(1:8)='MOT ' 72 : CALL ERREUR(37) 73 : GO TO 111 74 : ENDIF 75 : * 76 : * SI LE CHAMP A UNE SEULE COMPOSANTE ET QU'ON N'A PAS LU 77 : * DE NOM DE COMPOSANTE , ON LA PREND 78 : * 79 : IF(NCO.EQ.1.AND.IRETOU.EQ.0) THEN 80 : CMOT=INCO(1) 81 : ICC=1 82 : ELSE 83 : DO 1 INC=1,NCO 84 : IF (INCO(INC).EQ.CMOT) THEN 85 : ICC=INC 86 : ENDIF 87 : 1 CONTINUE 88 : ENDIF 89 : * Pas besoin d'erreur, il suffit de mettre 0 90 : * IF (ICC.EQ.0) THEN 91 : * MOTERR(1:4)=CMOT 91 : * CALL ERREUR(181) 92 : * GOTO 111 93 : * ENDIF 94 : C BOUCLE SUR TOUS LES NOEUDS DU MAILLAGE 95 : IBAC=0 96 : IBOC=0 97 : ZMABS=0.D0 98 : DO 2 IY=1,3 99 : PREC(IY)=0.D0 100 : 2 CONTINUE 101 : DO 7 IBO=1,ILIS(/1) 102 : NN= ILIS(IBO) 103 : NCOO=0 104 : DO 3 J=1,IDIM 105 : NCOO=NCOO+1 106 : MYPOS(NCOO)=XCOOR((NN-1)*(IDIM+1)+NCOO) 107 : 3 CONTINUE 108 : TOTAL = 0.D0 109 : DO 4 IT=1,IDIM 110 : TOTAL = TOTAL + (MYPOS(IT)-PREC(IT))**2 111 : PREC(IT)=MYPOS(IT) 112 : 4 CONTINUE 113 : TOTAL = TOTAL**0.5D0 114 : ZMABS = ZMABS + TOTAL 115 : IF (IBAC.EQ.0) THEN 116 : ZMABS=0.D0 117 : ENDIF 118 : NOMME=.FALSE. 118 : CALL SKNAME(NN,NOMQUA,IRETOL,1) 119 : IF (IRETOL.EQ.1) THEN 120 : NOMME=.TRUE. 121 : NOM = NOMQUA 122 : ENDIF 123 : IF (ICC.EQ.0) THEN 124 : INDI0=1 125 : ELSE 126 : INDI0=1 127 : DO 6 KJ=1,IGEO(/1) 128 : NH=IGEO(KJ) 129 : IF(NH.EQ.NN) THEN 130 : IF (IBIN(ICC,KJ).EQ.0) THEN 131 : INDI0 = 1 132 : GOTO 6 133 : ENDIF 134 : IBAC=IBAC+1 135 : MMORD(IBAC)=BB(ICC,KJ) 136 : MMABS(IBAC)=ZMABS 137 : INDI0=0 138 : IF (NOMME) THEN 139 : IBOC=IBOC+1 140 : POSNO (IBOC)=ZMABS 141 : NOMAB (IBOC)=NOM 142 : ENDIF 143 : GOTO 7 144 : ENDIF 145 : 6 CONTINUE 146 : ENDIF 147 : IF (INDI0.EQ.1) THEN 148 : IBAC=IBAC+1 149 : MMORD(IBAC)=0.D0 150 : MMABS(IBAC)=ZMABS 151 : IF (NOMME) THEN 152 : IBOC=IBOC+1 153 : POSNO (IBOC)=ZMABS 154 : NOMAB (IBOC)=NOM 155 : ENDIF 156 : ENDIF 157 : 7 CONTINUE 158 : JG=IBAC 159 : SEGINI MLREEL,MLREE1 160 : DO 8 IT=1,IBAC 161 : PROG(IT)=MMABS(IT) 162 : MLREE1.PROG(IT)=MMORD(IT) 163 : 8 CONTINUE 164 : N=1 165 : M=IBOC 166 : IF(M.NE.0) N = 2 167 : SEGINI MEVOLL 168 : C 169 : C CREATION DU EVOL CONTENANT LES NOMS 170 : C 171 : IF(M.NE.0) THEN 172 : SEGINI KEVOLL 173 : *MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM IIIIIII 174 : * DANS NOMABS ON A LES POINTS QUALIFIES IIIIIII 175 : * IBOC LE NOMBRE DE POINTS QUALIFIES IIII 176 : * DANS POSNO LA POSITION DES POINTS QUALIFIES IIII 177 : * MLREEL : ABSCISSE DES POINTS IIII 178 : * MLREE1 : ORDONNEE DES POINTS IIIIII 179 : JGN=8 180 : JGM=IBOC 181 : SEGINI MLMOTS 182 : JG=IBOC 183 : SEGINI MLREE2 184 : IPROGX=MLREE2 185 : IPROGY=MLMOTS 186 : TYPX='LISTREEL' 187 : TYPY='LISTMOTS' 188 : IEVOLL(2)=KEVOLL 189 : NUMEVY='MARQ' 190 : NUMEVX=ICOUL 191 : NOMEVX='ABS' 192 : NOMEVY=CMOT 193 : DO 9 I=1,IBOC 194 : MOTS(I)=NOMAB(I) 195 : MLREE2.PROG(I)=POSNO(I) 196 : 9 CONTINUE 197 : KEVTEX='POINTS NOMMES APPARTENANT A LA LIGNE' 198 : SEGDES MLREE2,MLMOTS,KEVOLL 199 : ENDIF 200 : SEGINI KEVOLL 201 : IEVOLL(1)= KEVOLL 202 : ITYEVO='REEL' 203 : TYPX='LISTREEL' 204 : TYPY='LISTREEL' 205 : IPROGX= MLREEL 206 : IPROGY= MLREE1 207 : IEVTEX=TITREE 208 : NOMEVX= 'ABS' 209 : NOMEVY= CMOT 210 : NUMEVX= ICOUL 211 : NUMEVY= 'REEL' 211 : CALL SKNAME(IBOPOI,NCHPT,IRETO,0) 212 : IF (IRETO.NE.0) THEN 212 : CALL SKNAME(IPOI,NMAIL,IRETO,0) 213 : IF (IRETO.NE.0) THEN 214 : UMOT1= 'TRACE DE LA COMPOSANTE ' 215 : UMOT2= ' DU CHAMP-POINT ' 216 : UMOT3= ' LE LONG DE ' 217 : TITRE=UMOT1//CMOT//UMOT2//NCHPT//UMOT3//NMAIL 218 : KEVTEX=TITRE 219 : ENDIF 220 : ENDIF 221 : SEGDES MEVOLL,KEVOLL 222 : SEGDES MLREEL,MLREE1 222 : CALL ECROBJ('EVOLUTIO',MEVOLL) 223 : SEGSUP MTRAV,TTRAV 224 : SEGSUP MVOL 225 : 111 RETURN 226 : END 227 : 228 : 229 : 230 : 231 : 232 :
© Cast3M 2003 - All rights reserved.
Disclaimer