1 : C VERIMO SOURCE CHAT 05/01/13 04:05:38 5004 2 : SUBROUTINE VERIMO(IBOS,IBONTI,ICHA,ITOUS,ILEX,IPX,ITYPE) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : C======================================================================= 6 : C POUR OPERATEUR EVOL : POUR UN MODE OU UN SOLSSTA,VERIFIE LA 7 : C COMPATIBILITE DU MSOLUT ET DU LISTENTI . 8 : C RETOUR :DANS ILEX UN SEGMENT MSOLEN QUI CONTIENT LA LISTE DES CHAMPS 9 : C A PRENDRE, DANS IPX UN LISTREEL A METTRE DANS LE MEVOLL 10 : C :ITYPE ='ITYSOL ' 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 : -INC SMLENTI 19 : CHARACTER*8 ITYPE 20 : C 21 : IF(IBONTI.EQ.0.AND.ITOUS.EQ.0) THEN 22 : MOTERR(1:8)='LISTENTI' 22 : CALL ERREUR(37 ) 23 : C MODE ON ATTEND UN LECT 24 : GOTO 5000 25 : ENDIF 26 : C 27 : C **** ON VERIFIE D'ABORD QUE LA SUITE MLENTI EST CROISSANTE 28 : C 29 : IF(IBONTI.NE.0) THEN 30 : MLENTI=IBONTI 31 : SEGACT MLENTI 32 : LCAS=LECT(/1) 33 : DO 161 I=2,LCAS 34 : IF(LECT(I).LE.LECT(I-1)) GOTO 140 35 : 161 CONTINUE 36 : ENDIF 37 : C 38 : MSOLUT=IBOS 39 : SEGACT MSOLUT 40 : MSOLE1=MSOLIS(ICHA) 41 : SEGACT MSOLE1 42 : LTE=MSOLE1.ISOLEN(/1) 43 : IF (ITOUS.EQ.0) THEN 44 : N=LCAS 45 : ELSE 46 : N=LTE 47 : ENDIF 48 : SEGINI MSOLEN 49 : ILEX=MSOLEN 50 : JG=0 51 : SEGINI MLREEL 52 : IPX=MLREEL 53 : IF(ITOUS.EQ.1) GOTO 10 54 : C 55 : IF(LTE.LT.LCAS.OR.LTE.LT.LECT(LCAS)) GOTO 140 56 : C 57 : INN=0 58 : DO 1520 I=1,LCAS 59 : K=MSOLE1.ISOLEN(LECT(I)) 60 : IF(K.NE.0) INN=INN+1 61 : 1520 CONTINUE 62 : JG0 = PROG(/1) 63 : JG=JG0 + INN 64 : SEGADJ MLREEL 65 : INN=1 66 : DO 152 I=1,LCAS 67 : K=MSOLE1.ISOLEN(LECT(I)) 68 : IF(K.EQ.0) GOTO 140 69 : ISOLEN(I)=K 70 : PROG(JG0+INN)=LECT(I) 71 : INN=INN+1 72 : 152 CONTINUE 73 : SEGDES MLENTI 74 : GOTO 11 75 : C 76 : 140 CONTINUE 77 : MOTERR(1:8)='SOLUTION' 78 : MOTERR(9:16)='LISTENTI' 78 : CALL ERREUR(135) 79 : GOTO 5000 80 : C 81 : C ****** CAS ITOUS=1 ************************* 82 : C 83 : 10 CONTINUE 84 : INN=0 85 : DO 1010 J=1,LTE 86 : K=MSOLE1.ISOLEN(J) 87 : IF(K.NE.0) INN=INN+1 88 : 1010 CONTINUE 89 : JG0= PROG(/1) 90 : JG=JG0+INN 91 : SEGADJ MLREEL 92 : II=0 93 : DO 101 J=1,LTE 94 : K=MSOLE1.ISOLEN(J) 95 : IF(K.EQ.0) GOTO 101 96 : II=II+1 97 : PROG(JG0+II)=J 98 : ISOLEN(II)=K 99 : 101 CONTINUE 100 : N=II 101 : SEGADJ MSOLEN 102 : C 103 : 11 CONTINUE 104 : SEGDES MSOLE1 105 : SEGDES MLREEL,MSOLEN 106 : ITYPE=ITYSOL 107 : SEGDES MSOLUT 108 : 5000 CONTINUE 109 : RETURN 110 : END 111 :
© Cast3M 2003 - All rights reserved.
Disclaimer