1 : C EVSOLU SOURCE CHAT 05/01/12 23:47:45 5004 2 : SUBROUTINE EVSOLU(ICOUL) 3 : C======================================================================= 4 : C OPTION SOLU DE L'OPERATEUR EVOL (CONSTRUCTION DE COURBES) 5 : C 6 : C.1.EVOLUTION D'UN DDL DANS L'OBJET SOLUTION: 7 : C MEVOL = EVOL COUL SOLU MSOLUT TYPE PT1 COMP (INSTANTS) ; 8 : C ---- ---- ---- ---- 9 : C 10 : C.2.EVOLUTION DE PLUSIEURS DDL DANS L'OBJET SOLUTION: 11 : C MEVOL = EVOL COUL SOLU MSOLUT TYPE CHP1 (INSTANTS) ; 12 : C ---- ---- ---- 13 : C 14 : C.3.EVOLUTION DE LA CONTRIBUTION MODALE RELATIVE AU MODE MOD1: 15 : C MEVOL = EVOL COUL SOLU MSOLUT TYPE MOD1 ALFA (INSTANTS); 16 : C ---- ---- ---- ---- 17 : C 18 : C.4.EVOLUTION D'UNE VARIABLE DE LIAISON RELATIVE A LA LIAISON MAT1: 19 : C MEVOL = EVOL COUL SOLU MSOLUT LIAI MAT1 COMP (INSTANTS) ; 20 : C ---- ---- ---- ---- 21 : C 22 : C.5.EVOLUTION D'UNE INCONNUE DE LIAISON RELATIVE A LA LIAISON MAT1: 23 : C MEVOL = EVOL COUL SOLU MSOLUT TYPE MAT1 COMP (INSTANTS); 24 : C ---- ---- ---- ---- 25 : C 26 : C COUL : COULEUR (FACULTATIVE) 27 : C MEVOL : OBJET DE TYPE EVOLUTION 28 : C MSOLUT : OBJET SOLUTION 29 : C TYPE : MOT CLE:TYPE DE LA VARIABLE (DEPL,VITE,ACCE,LIAI..) 30 : C COMP : NOM DE LA COMPOSANTE CHOISIE 31 : C INSTANTS: PROCEDURE FACULTATIVE POUR CHOISIR LES CAS DE SORTIE 32 : C PROGX :OBJET LISTREEL, LISTE DES TEMPS A SORTIR 33 : C LECTC :OBJET LISTENTI, LISTE DES CAS A SORTIR 34 : C RIEN :L'OBJET EVOLUTION PORTE SUR TOUS LES CAS PRESENTS 35 : C DANS LE MSOLUT 36 : C 37 : C PT1 : POINT OU MELEME A EXTRAIRE 38 : C CHP1 : CHPOINT CONTENANT LES POINTS ET DDL (FABRIQUE PAR 39 : C EXEMPLE PAR MANU CHPO ) 40 : C MOD1 : OBJET MSOLUT (MODE OU SOLUSTAT...) 41 : C MAT1 : OBJET ATTACHE. 42 : C 43 : C LES OBJETS PT1,MOD1,MAT1 SERVENT A REPERER DANS LES CHAMPS 44 : C CHOISIS, LE(S) POINT(S) QUI INTERESSENT L'EVOLUTION. 45 : C 46 : C CREATION : 16/10/85 47 : C PROGRAMMEUR : FARVACQUE 48 : C======================================================================= 49 : IMPLICIT INTEGER(I-N) 50 : LOGICAL L0,L1 51 : REAL*8 X0,X1 52 : CHARACTER*4 CHAR0,CHAR1 53 : CHARACTER*8 CTYP 54 : -INC CCOPTIO 55 : -INC SMSOLUT 56 : -INC SMTABLE 57 : -INC SMEVOLL 58 : -INC SMATTAC 59 : -INC SMELEME 60 : -INC SMCHPOI 61 : SEGMENT NUMOO 62 : INTEGER NUMO(N),KLIST(N) 63 : CHARACTER*4 NUDDL(N) 64 : ENDSEGMENT 65 : CHARACTER*72 TI 66 : * CHARACTER*4 MCHA,NOMCO 67 : CHARACTER*72 MCHA,NOMCO 68 : CHARACTER*8 ITYPE 69 : CHARACTER*8 ITYP1 70 : C------TYPE DU PROCHAIN OBJET A LIRE----(TABLE OU SOLUTION) 70 : CALL QUETYP (CTYP,1,IRETOU) 71 : IF (IERR.NE.0) RETURN 72 : C --- ON LIT LE NOM DU CHAMP A TRAITER ET LE NOM DE LA COMPOSANTE 72 : CALL LIRCHA(MCHA,1,IRETOU) 73 : IF(IERR.NE.0) GOTO 5000 74 : LCHALU=IRETOU 74 : CALL LIRCHA(NOMCO,0,IRETOU) 75 : IF(IRETOU.EQ.0) NOMCO=' ' 76 : LCOLU=IRETOU 77 : C 78 : IF (CTYP(1:5).EQ.'TABLE') THEN 79 : ISTA=0 79 : CALL LIRTAB ('RESULTAT_DYNE',ISTA,1,IRETOU) 80 : IF (IERR.NE.0) GOTO 5000 81 : ENDIF 82 : C-------------- 83 : C 84 : IF (CTYP(1:8).EQ.'SOLUTION') THEN 84 : CALL LIROBJ('SOLUTION',KSOLU,1,IRETOU) 85 : IF(IERR.NE.0) GOTO 5000 86 : MSOLUT=KSOLU 87 : ENDIF 88 : C-----ON LIT EVENTUELLEMENT LA LISTE DES PAS DE TEMPS OU DE CAS --- 89 : IPX=0 90 : ITOUS=0 91 : ILX=0 91 : CALL LIROBJ('LISTREEL',IPX,0,IRETOU) 91 : IF(IRETOU.EQ.0) CALL LIROBJ('LISTENTI',ILX,0,IRETOU) 92 : IF(IRETOU.EQ.0) ITOUS=1 93 : C---------------------------------------------------------- 94 : C *** ON VA CHERCHER LE CHAMP MCHA DANS LE MSOLUT 95 : C 96 : IF (CTYP(1:8).EQ.'SOLUTION') THEN 97 : SEGACT MSOLUT 98 : MOTERR(1:8)= ITYSOL 98 : CALL CHRCHA(MCHA,MOTERR(1:8),ICHA,ISOLIT) 99 : IF(ICHA.EQ.0) THEN 100 : MOTERR(1:8)= ITYSOL 101 : MOTERR(9:12)=MCHA 101 : CALL ERREUR(235) 102 : C ERREUR DANS LE TYPE DE CHAMP 103 : GOTO 5000 104 : ENDIF 105 : MSOLEN=MSOLIS(ICHA) 106 : IF(MSOLEN.EQ.0) THEN 107 : MOTERR(1:8)= ITYSOL 108 : MOTERR(9:12)=MCHA 108 : CALL ERREUR(235) 109 : C CE TYPE DE CHAMP EST VIDE DANS LE MSOLUT 110 : GOTO 5000 111 : ENDIF 112 : C 113 : C **** VERIFS DE COMPATIBILITE IPX,ILX, MSOLUT... EN RETOUR : 114 : C **** DANS IPX LE LISTREEL A METTRE DANS IPROGX 115 : C **** DANS ILEX LE LISTENTI QUI CONTIENT LES NUMERO DES CHAMPS 116 : C 117 : IF(MSOLIS(1).EQ.0)GOTO 600 118 : IBOS=MSOLUT 118 : CALL VERIDY(IBOS,IPX,ICHA,ITOUS,ILEX,ITYP1) 119 : MSOLUT=IBOS 120 : SEGACT MSOLUT 121 : IF(IERR.NE.0) GOTO 5000 122 : GOTO 700 123 : 600 CONTINUE 124 : IF(MSOLIS(3).EQ.0) GOTO601 125 : IBOS=MSOLUT 125 : CALL VERIMO(IBOS,ILX,ICHA,ITOUS,ILEX,IPX,ITYP1) 126 : IF(IERR.NE.0) GOTO 5000 127 : MSOLUT=IBOS 128 : SEGACT MSOLUT 129 : GOTO 700 130 : 601 CONTINUE 131 : MOTERR(1:8)='SOLUTION' 132 : MOTERR(9:16)=ITYSOL 132 : CALL ERREUR(131) 133 : C NON DISPONIBLE 134 : GOTO 5000 135 : C 136 : 700 IF( MSOLIT(ICHA).NE.2) GOTO 1002 137 : SEGDES MSOLUT 138 : ENDIF 139 : C-------------------------------------------- 140 : C---CAS D UN OBJET DE TYPE TABLE ------------ 141 : IF (CTYP(1:5).EQ.'TABLE') THEN 142 : ICHA =0 143 : MTAB1=ISTA 144 : LBO=0 145 : I0=1 146 : IRET1=0 147 : C --- ON PREND LA PREMIERE TABLE (PAS DE TEMPS 1) 147 : CALL ACCTAB (ISTA ,'ENTIER',I0,X0,CHAR0,L0,IRET0, 148 : 1 'TABLE',I1,X1,CHAR1,L1,IRET1) 149 : IBOBO=IRET1 149 : CALL CHTCHA (MCHA,LCHALU,IBOBO,ICHA ) 150 : IF(ICHA.EQ.0) THEN 151 : MOTERR(1:8)= MCHA(1:8) 152 : MOTERR(9:12)=MCHA 152 : CALL ERREUR(235) 153 : C ERREUR DANS LE TYPE DE CHAMP 154 : GOTO 5000 155 : ENDIF 156 : C **** VERIFS DE COMPATIBILITE IPX,ILX, MTABLE... EN RETOUR : 157 : C **** DANS IPX LE LISTREEL A METTRE DANS IPROGX 158 : C **** DANS ILEX LE LISTENTI QUI CONTIENT LES NUMERO DES CHAMPS 158 : CALL VERITA(ISTA,IPX,ICHA,ITOUS,ILEX,ITYP1) 159 : IF(IERR.NE.0) GOTO 5000 160 : ENDIF 161 : C **** LA SORTIE PORTE SUR DES CHPOINTS. ON FABRIQUE NUMOO LE TABLEAU 162 : C *** DE SORTIE: LECTURE D'UN POINT OU D'UN MATTAC OU D'UN MODE OU 163 : C **** D'UN CHPOINT OU D'UN MELEME 164 : C 164 : CALL LIROBJ('POINT ',IRET,0,IRETOU) 165 : IF(IRETOU.NE.0) THEN 166 : ITYPE='POINT' 167 : GOTO 10 168 : ENDIF 168 : CALL LIROBJ('MAILLAGE',IRET,0,IRETOU) 169 : IF(IRETOU.NE.0) THEN 170 : ITYPE='MAILLAGE' 171 : GOTO 10 172 : ENDIF 172 : CALL LIROBJ('CHPOINT ',IRET,0,IRETOU) 173 : IF(IRETOU.NE.0) THEN 174 : ITYPE='CHPOINT' 175 : GOTO 10 176 : ENDIF 176 : CALL LIROBJ('ATTACHE ',IRET,0,IRETOU) 177 : IF(IRETOU.NE.0) THEN 178 : ITYPE='ATTACHE' 179 : GOTO 10 180 : ENDIF 180 : CALL LIROBJ('SOLUTION',IRET,0,IRETOU) 181 : IF(IRETOU.NE.0) THEN 182 : ITYPE='SOLUTION' 183 : GOTO 10 184 : ENDIF 184 : CALL LIRTAB('BASE_MODALE',IRET,0,IRETOU) 185 : IF(IRETOU.NE.0) THEN 186 : ITYPE='TABLE ' 187 : GOTO 10 188 : ENDIF 189 : C 189 : CALL ERREUR(248) 190 : C ON NE TROUVE PAS LE SUPPORT QUI CONTIENT LES POINTS 191 : GOTO 5000 192 : C 193 : 10 CONTINUE 193 : CALL EVNUMO(ITYPE,IRET,NOMCO,IBOO) 194 : IF(IERR.NE.0) GOTO 5000 195 : C 196 : C *** FABRICATION DU( OU DES) PROG CORRESPONDANT AU TABLEAU NUMOO 197 : C *** ET AUX INSTANTS ILEX (ILEX EST TUE DANS EVOL1) 198 : C 198 : CALL EVOL1(IBOO,ILEX) 199 : NUMOO=IBOO 200 : IF(IERR.NE.0) GOTO 5000 201 : GOTO 3000 202 : C 203 : C *** LA SORTIE PORTE SUR DES CHAMELEM 204 : C 205 : 1002 CONTINUE 206 : C OPTION NON DISPONIBLE 206 : CALL ERREUR(19) 207 : GOTO 5000 208 : C 209 : 3000 CONTINUE 210 : C 211 : C *** INITIALISATION DE MEVOLL 212 : C 213 : N=NUMO(/1) 214 : SEGINI MEVOLL 215 : ITYEVO='REEL' 216 : TI(1:72)=TITREE 217 : IEVTEX=TI 218 : DO 2080 I=1,NUMO(/1) 219 : SEGINI KEVOLL 220 : TYPX='LISTREEL' 221 : TYPY='LISTREEL' 222 : IPROGX=IPX 223 : IPROGY=KLIST(I) 224 : NOMEVX=ITYP1 225 : NOMEVY(1:4)=MCHA 226 : WRITE(NOMEVY(5:8),FMT='(I4)') NUMO(I) 227 : NOMEVY(9:12)=NUDDL(I) 228 : KEVTEX=TI 229 : NUMEVX=ICOUL 230 : NUMEVY='REEL' 231 : SEGDES KEVOLL 232 : IEVOLL(I)=KEVOLL 233 : 2080 CONTINUE 234 : SEGDES MEVOLL 235 : SEGSUP NUMOO 235 : CALL ECROBJ('EVOLUTIO',MEVOLL) 236 : 5000 CONTINUE 237 : RETURN 238 : END 239 :
© Cast3M 2003 - All rights reserved.
Disclaimer