1 : C ERRE SOURCE JC220346 14/01/31 21:15:05 7939 2 : SUBROUTINE ERRE 3 : *_______________________________________________________________________ 4 : * 5 : * OPERATEUR ERRE 6 : * -------------- 7 : * 8 : * PASSAGE AUX NOUVEAUX MCHAMLS PAR JM CAMPENON LE 02/91 9 : * 10 : *_______________________________________________________________________ 11 : * 12 : IMPLICIT INTEGER(I-N) 13 : IMPLICIT REAL*8(A-H,O-Z) 14 : * 15 : -INC CCOPTIO 16 : -INC SMTEXTE 17 : -INC SMLCHPO 18 : -INC SMLREEL 19 : -INC SMLENTI 20 : -INC SMLMOTS 21 : * 22 : CHARACTER AUX*73 23 : LOGICAL ZAVEC 24 : * 25 : AUX=' ' 26 : * 26 : CALL LIRCHA(AUX,0,IRETOU) 27 : IF (IRETOU.EQ.0) GOTO 250 27 : CALL LENCHA(AUX,LAUX) 28 : ZAVEC=(AUX(1:LAUX).EQ.'AVEC') 29 : IF (ZAVEC) GOTO 250 30 : WRITE(IOIMP,11) AUX 31 : 11 FORMAT(/,(1X,A73)) 31 : CALL ERREUR(308) 32 : RETURN 33 : * 33 : 250 CALL LIRENT (KENT,0,IRETOU) 34 : IF (IRETOU.EQ.0) GOTO 255 35 : * MOT-CLE "AVEC" 36 : IF (ZAVEC) THEN 37 : * MOTERR = 40 PREMIERS CARACTERES D'UNE CHAINE 37 : CALL LIRCHA(MOTERR,0,IRET) 38 : * INTERR = ENTIER OU LISTE D'ENTIERS 38 : CALL LIRENT(INTERR(1),0,IRET) 39 : IF (IRET.EQ.0) THEN 39 : CALL LIROBJ('LISTENTI',MLENTI,0,IRET) 40 : IF (IRET.NE.0) THEN 41 : SEGACT,MLENTI 42 : NN=MIN(LECT(/1),SIZE(INTERR)) 43 : DO I=1,NN 44 : INTERR(I)=LECT(I) 45 : ENDDO 46 : SEGDES,MLENTI 47 : ENDIF 48 : ENDIF 49 : * REAERR = ENTIER OU LISTE D'ENTIERS 49 : CALL LIRREE(REAERR(1),0,IRET) 50 : IF (IRET.EQ.0) THEN 50 : CALL LIROBJ('LISTREEL',MLREEL,0,IRET) 51 : IF (IRET.NE.0) THEN 52 : SEGACT,MLREEL 53 : NN=MIN(PROG(/1),SIZE(REAERR)) 54 : DO I=1,NN 55 : REAERR(I)=PROG(I) 56 : ENDDO 57 : SEGDES,MLREEL 58 : ENDIF 59 : ENDIF 60 : * BOOERR = LOGIQUE OU LISTE DE MOTS 60 : CALL LIRLOG(BOOERR(1),0,IRET) 61 : IF (IRET.EQ.0) THEN 61 : CALL LIROBJ('LISTMOTS',MLMOTS,0,IRET) 62 : IF (IRET.NE.0) THEN 63 : SEGACT,MLMOTS 64 : NN=MIN(MOTS(/2),SIZE(BOOERR)) 65 : DO I=1,NN 66 : IF ((MOTS(I).EQ.'VRAI') .OR. 67 : & (MOTS(I).EQ.'V' ) .OR. 68 : & (MOTS(I).EQ.'TRUE') .OR. 69 : & (MOTS(I).EQ.'T' )) THEN 70 : BOOERR(I)=.TRUE. 71 : ELSE 72 : BOOERR(I)=.FALSE. 73 : ENDIF 74 : ENDDO 75 : SEGDES,MLMOTS 76 : ENDIF 77 : ENDIF 78 : ENDIF 78 : CALL ERREUR(KENT) 79 : RETURN 80 : 80 : 255 CALL LIROBJ('CHPOINT ',IPO1,0,IRETOU) 81 : IF (IRETOU.EQ.0) GOTO 256 81 : CALL LIROBJ('CHPOINT ',IPO2,1,IRETOU) 82 : IF (IERR.NE.0) RETURN 83 : IRET = -2 83 : CALL ADCHPO(IPO1,IPO2,IRET,1D0,-1D0) 84 : IF (IRET.EQ.0) RETURN 84 : CALL ECROBJ('CHPOINT ',IRET) 84 : CALL MAXIMU(1) 85 : RETURN 86 : 86 : 256 CALL LIROBJ('LISTCHPO',IPO1,0,IRETOU) 87 : IF (IRETOU.EQ.0) GOTO 260 87 : CALL LIROBJ('LISTCHPO',IPO2,1,IRETOU) 88 : IF (IERR.NE.0) RETURN 89 : 90 : mlchp1 = ipo1 91 : mlchp2 = ipo2 92 : segact mlchp1, mlchp2 92 : if (mlchp1.ichpoi(/1).ne.mlchp2.ichpoi(/1)) call erreur(3) 93 : if (ierr.ne.0) return 94 : JG = mlchp1.ichpoi(/1) 95 : segini mlreel 96 : do ii = 1 ,jg 97 : IRET = -2 98 : ipo1 = mlchp1.ichpoi(ii) 99 : ipo2 = mlchp2.ichpoi(ii) 99 : CALL ADCHPO(IPO1,IPO2,IRET,1D0,-1D0) 100 : IF (IRET.EQ.0) RETURN 100 : CALL ECROBJ('CHPOINT ',IRET) 100 : CALL MAXIMU(1) 100 : call lirree(xx,1,iretou) 101 : if (ierr.ne.0) return 102 : prog(ii) = xx 103 : enddo 103 : call ECROBJ('LISTREEL',mlreel) 104 : RETURN 105 : 106 : *_______________________________________________________________________ 107 : * 108 : * CALCUL D'ERREUR ( VERSION BARZIC ET RICHARD ) 109 : *_______________________________________________________________________ 110 : * 111 : 260 CONTINUE 111 : CALL LIROBJ('MMODEL',IPMODL,1,IRETM) 112 : IF (IERR.NE.0) RETURN 113 : * 113 : CALL LIROBJ('MCHAML',IPCHE1,1,IRETOU) 114 : IF (IERR.NE.0)RETURN 114 : CALL LIROBJ('MCHAML',IPCHE2,1,IRETOU) 115 : IF (IERR.NE.0) RETURN 116 : * 116 : CALL RNGCHA (IPCHE1,IPCHE2,'CONTRAINTES','CARACTERISTIQUES' 117 : 1 ,IPCH1,IPCH2) 118 : IF(IPCH1.EQ.0.OR.IPCH2.EQ.0)THEN 119 : IF(IPCH1.EQ.0)THEN 120 : MOTERR(1:16)='CONTRAINTES ' 121 : ELSE 122 : MOTERR(1:16)='CARACTERISTIQUES' 123 : ENDIF 123 : CALL ERREUR(565) 124 : RETURN 125 : ENDIF 126 : * 126 : CALL ERRARE(IPMODL,IPCH1,IPCH2,XERR,IPCHRR) 127 : * 128 : IF (IPCHRR.NE.0) THEN 128 : CALL ECROBJ('MCHAML',IPCHRR) 128 : CALL ECRREE(XERR) 129 : ENDIF 130 : 131 : RETURN 132 : END 133 : 134 : 135 :
© Cast3M 2003 - All rights reserved.
Disclaimer