1 : C MASQ SOURCE FANDEUR 10/12/14 21:18:08 6812 2 : SUBROUTINE MASQ 3 : ************************************************************************ 4 : * * 5 : * OPERATEUR MASQUE * 6 : * * 7 : ************************************************************************ 8 : * 9 : IMPLICIT INTEGER(I-N) 10 : IMPLICIT REAL*8(A-H,O-Z) 11 : * 12 : -INC CCOPTIO 13 : * 14 : PARAMETER (LMOT = 6, LSOM = 1) 15 : CHARACTER*4 MMOT(LMOT), MSOM(LSOM) 16 : * 17 : DATA MMOT/'SUPE','EGSU','EGAL','EGIN','INFE','DIFF'/ 18 : DATA MSOM/'SOMM'/ 19 : * 20 : ISOM=0 21 : * 21 : CALL LIRMOT(MMOT,LMOT,ICLE,1) 22 : IF (IERR.NE.0) RETURN 23 : * 23 : CALL LIRMOT (MSOM,LSOM,ISOM,0) 24 : IF (IERR.NE.0) RETURN 25 : * 25 : CALL LIROBJ ('MCHAML',MCH,0,IRETOU) 26 : IF (IERR.NE.0) RETURN 27 : * 28 : IF(IRETOU.NE.0) THEN 29 : I1=0 29 : CALL LIRENT(I1,0,IRETEN) 30 : IF (IERR.NE.0) RETURN 31 : X1=I1 31 : CALL LIRREE(X1,0,IRETOU) 32 : IF (IERR.NE.0) RETURN 33 : IF(IRETEN.NE.0.OR.IRETOU.NE.0) THEN 33 : CALL MASCHE( X1,MCH,ICLE,IRET,ISOM,IRETER) 34 : ELSE 35 : MCH1=0 35 : CALL LIROBJ ('MCHAML',MCH1,1,IRETOU) 36 : IF (IERR.NE.0) RETURN 36 : CALL MSCHE1(MCH1,MCH,ICLE,IRET,ISOM,IRETER) 37 : ENDIF 38 : IF (IRETER.EQ.0) RETURN 39 : II=2 40 : ELSE 40 : CALL LIROBJ('CHPOINT ',ICHP,0,IRETOU) 41 : IF (IERR.NE.0) RETURN 42 : IF(IRETOU.NE.0) THEN 43 : I1=0 43 : CALL LIRENT (I1,0,IRETEN) 44 : IF (IERR.NE.0) RETURN 45 : X1=I1 45 : CALL LIRREE(X1,0,IRETOU) 46 : IF (IERR.NE.0) RETURN 47 : IF(IRETEN.NE.0.OR.IRETOU.NE.0) THEN 47 : CALL MASCHP( X1,ICHP,ICLE,IRET,ISOM) 48 : ELSE 49 : ICHP1=0 49 : CALL LIROBJ('CHPOINT ',ICHP1,1,IRETOU) 50 : IF(IERR.NE.0) RETURN 50 : CALL MSCHP1(ICHP1,ICHP,ICLE,IRET,ISOM) 51 : ENDIF 52 : IF(IERR.NE.0) RETURN 53 : II=3 54 : ELSE 54 : CALL LIROBJ('LISTREEL',IPLI,0,IRETOU) 55 : IF (IERR.NE.0) RETURN 56 : IF(IRETOU.NE.0) THEN 57 : I1=0 57 : CALL LIRENT (I1,0,IRETEN) 58 : IF (IERR.NE.0) RETURN 59 : X1=I1 59 : CALL LIRREE(X1,0,IRETOU) 60 : IF (IERR.NE.0) RETURN 61 : IF(IRETEN.NE.0.OR.IRETOU.NE.0) THEN 61 : CALL MASLIS('LISTREEL',IPLI,ICLE,X1,I1,IRET,ISOM) 62 : ELSE 62 : CALL LIROBJ('LISTREEL',IPLI1,1,IRETOU) 63 : IF(IERR.NE.0) RETURN 63 : CALL MSLIS1('LISTREEL',IPLI,ICLE,IPLI1,IRET,ISOM) 64 : ENDIF 65 : IF(IERR.NE.0) RETURN 66 : II=5 67 : ELSE 67 : CALL LIROBJ('LISTENTI',IPLI,0,IRETOU) 68 : IF(IRETOU.EQ.0) THEN 69 : C 70 : C PAS D OPERANDE CORRECTE TROUVE 71 : C 71 : CALL QUETYP(MOTERR(1:8),0,IRETOU) 72 : IF(IRETOU.NE.0) THEN 72 : CALL ERREUR (39) 73 : ELSE 73 : CALL ERREUR(533) 74 : ENDIF 75 : RETURN 76 : ENDIF 77 : I1=0 77 : CALL LIRENT (I1,0,IRETEN) 78 : IF (IERR.NE.0) RETURN 79 : X1=I1 80 : IF(IRETEN.NE.0) THEN 80 : CALL MASLIS('LISTENTI',IPLI,ICLE,X1,I1,IRET,ISOM) 81 : ELSE 81 : CALL LIROBJ('LISTENTI',IPLI1,1,IRETOU) 81 : CALL MSLIS1('LISTENTI',IPLI,ICLE,IPLI1,IRET,ISOM) 82 : ENDIF 83 : IF(IERR.NE.0) RETURN 84 : II=6 85 : ENDIF 86 : ENDIF 87 : ENDIF 88 : C 89 : IF(ISOM.NE.0) II=4 90 : C 90 : IF (II.EQ.2) CALL ECROBJ('MCHAML ',IRET) 90 : IF (II.EQ.3) CALL ECROBJ('CHPOINT ',IRET) 90 : IF (II.EQ.5) CALL ECROBJ('LISTREEL',IRET) 90 : IF (II.EQ.6) CALL ECROBJ('LISTENTI',IRET) 90 : IF (II.EQ.4) CALL ECRENT(IRET) 91 : 92 : RETURN 93 : END 94 : 95 :
© Cast3M 2003 - All rights reserved.
Disclaimer