1 : C VERIDY SOURCE CHAT 05/01/13 04:05:32 5004 2 : SUBROUTINE VERIDY(IBO,IPX,ICHA,ITOUS, ILEX,ITYPE) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : C======================================================================= 6 : C POUR OPERATEUR EVOL : POUR UN DYNAMIQUE, 7 : C VERIFIE LA COMPATIBILITE DU MSOLUT ET DU LISTREEL . 8 : C RETOUR :DANS ILEX UN SEGMENT MSOLEN QUI CONTIENT LA LISTE DES CHAMPS 9 : C A PRENDRE. 10 : C :ITYPE ='TEMPS ' 11 : C CREATION : 14/10/85 12 : C PROGRAMMEUR : FARVACQUE 13 : C======================================================================= 14 : -INC CCOPTIO 15 : -INC SMELEME 16 : -INC SMSOLUT 17 : -INC SMLREEL 18 : CHARACTER*8 ITYPE 19 : C 20 : IF(IPX.EQ.0.AND.ITOUS.EQ.0) THEN 21 : MOTERR(1:8)='LISTREEL' 21 : CALL ERREUR(37) 22 : C DYNAMIQUE ON ATTEND UN PROG 23 : GOTO 5000 24 : ENDIF 25 : C 26 : C **** ON VERIFIE D'ABORD QUE LA SUITE IPX EST CROISSANTE 27 : C 28 : IF(IPX.EQ.0) THEN 29 : JG=0 30 : SEGINI MLREEL 31 : IPX=MLREEL 32 : ELSE 33 : MLREEL=IPX 34 : SEGACT MLREEL 35 : LCAS=PROG(/1) 36 : DO 161 I=2,LCAS 37 : IF(PROG(I).GT.PROG(I-1)) GOTO 161 37 : CALL ERREUR(249) 38 : C LA SUITE DE REELS DOIT ETRE CROISSANTE 39 : GOTO 5000 40 : 161 CONTINUE 41 : ENDIF 42 : C 43 : MSOLUT=IBO 44 : SEGACT MSOLUT 45 : MSOLRE=MSOLIS(1) 46 : SEGACT MSOLRE 47 : LTE=SOLRE(/1) 48 : IF (ITOUS.EQ.0) THEN 49 : N=LCAS 50 : ELSE 51 : N=LTE 52 : ENDIF 53 : SEGINI MSOLEN 54 : MSOLE1=MSOLIS(ICHA) 55 : SEGACT MSOLE1 56 : IF(ITOUS.EQ.1) GOTO 10 57 : C 58 : IF(LTE.LT.LCAS.OR.SOLRE(LTE).LT.PROG(LCAS)) GOTO 140 59 : C 60 : JJ1=1 61 : DO 152 I=1,LCAS 62 : T1=PROG(I) 63 : IF(T1.EQ.0.) THEN 64 : IF(SOLRE(1).EQ.0.) THEN 65 : JJ1=2 66 : ISOLEN(1)=MSOLE1.ISOLEN(1) 67 : GOTO 152 68 : ENDIF 69 : GOTO 140 70 : ENDIF 71 : J1=JJ1 72 : DO 153 J=J1,LTE 73 : T2=SOLRE(J) 74 : TR=ABS((T2-T1)/T1) 75 : PRECI = (SOLRE(LTE) - SOLRE(1))/(LTE*1000.) 76 : IF(TR.LT.PRECI) THEN 77 : JJ1=J+1 78 : K=MSOLE1.ISOLEN(J) 79 : IF(K.EQ.0) THEN 80 : GOTO 140 81 : ELSE 82 : ISOLEN(I)=K 83 : ENDIF 84 : GOTO 152 85 : ENDIF 86 : IF(T2.GT.T1) GOTO 140 87 : 153 CONTINUE 88 : 152 CONTINUE 89 : GOTO 11 90 : C 91 : 140 CONTINUE 92 : MOTERR(1:8)='SOLUTION' 93 : MOTERR(9:16)='LISTREEL' 93 : CALL ERREUR(135) 94 : GOTO 5000 95 : C 96 : C ****** CAS ITOUS=1 ************************* 97 : C 98 : 10 CONTINUE 99 : II=0 100 : INN=0 101 : DO 1010 J=1,LTE 102 : K=MSOLE1.ISOLEN(J) 103 : IF(K.NE.0) INN=INN+1 104 : 1010 CONTINUE 105 : JG0=PROG(/1) 106 : JG=JG0+INN 107 : SEGADJ MLREEL 108 : INN=1 109 : DO 101 J=1,LTE 110 : K=MSOLE1.ISOLEN(J) 111 : IF(K.EQ.0) GOTO 101 112 : PROG(JG0+INN)=SOLRE(J) 113 : INN=INN+1 114 : II=II+1 115 : ISOLEN(II)=K 116 : 101 CONTINUE 117 : N=II 118 : SEGADJ MSOLEN 119 : C 120 : 11 CONTINUE 121 : ILEX=MSOLEN 122 : SEGDES MSOLRE,MSOLE1,MSOLUT 123 : SEGDES MLREEL,MSOLEN 124 : ITYPE='TEMPS' 125 : 5000 CONTINUE 126 : RETURN 127 : END 128 :
© Cast3M 2003 - All rights reserved.
Disclaimer