1 : C COML SOURCE FANDEUR 12/07/18 21:15:27 7435 2 : 3 : SUBROUTINE COML 4 : 5 : *----------------------------------------------------------------------- 6 : * CALCUL COMPORTEMENTS LOCAUX 7 : *----------------------------------------------------------------------- 8 : * SYNTAXE 9 : * CHES1 = 'COMP' MODL CHET1 CHET2 ; 10 : * 11 : * MMODEL | MODL OBJET MODELE 12 : * | 13 : * MCHAML | CHET1 par exemple : contraintes, phases, 14 : * | caracteristiques, variables internes, temperatures 15 : * | rassemblees dans le champ pour un etat 16 : * | initial 17 : * MCHAML | CHET2 : idem etat final 18 : * on entre ce dont on a besoin 19 : * on sort ce qui doit 20 : *----------------------------------------------------------------------- 21 : 22 : IMPLICIT INTEGER (I-N) 23 : IMPLICIT REAL*8(A-H,O-Z) 24 : 25 : -INC CCOPTIO 26 : 27 : -INC SMCHAML 28 : -INC SMMODEL 29 : -INC DECHE 30 : * pointeur des mcheml en entree 31 : SEGMENT llchee(0) 32 : * 33 : * LECTURE D'UN MODEL 34 : * 34 : CALL LIROBJ('MMODEL',IPMODL,1,irt) 35 : IF (IERR.NE.0) RETURN 36 : * 37 : * Lecture des mchaml (au moins un) 38 : * 39 : SEGINI,llchee 40 : LACOND = 1 41 : 50 CONTINUE 41 : CALL LIROBJ('MCHAML',ipche1,LACOND,irt) 42 : IF (IERR.NE.0) GOTO 9010 43 : IF (irt.ne.0) THEN 44 : * appel a redu pour rendre compatible le mchaml et le mmodel 44 : CALL REDUAF(ipche1,ipmodl,ipch,0,iret,kerr) 44 : IF (iret.NE.1) CALL ERREUR(kerr) 45 : IF (IERR.NE.0) GOTO 9010 46 : llchee(**) = ipch 47 : LACOND = 0 48 : GOTO 50 49 : ENDIF 50 : 51 : c Pile des melval sous forme de deche 52 : c mise en place du tableau des pointeurs sur les melval : deche 53 : iimel = 500 54 : segini,lilmel 55 : ijmel=0 56 : do iem = 1, llchee(/1) 57 : mchelm = llchee(iem) 58 : segact mchelm 59 : n1 = conche(/2) 60 : n3 = infche(/2) 61 : do in1 = 1, n1 62 : mchaml = ichaml(in1) 63 : segact mchaml 64 : n2 = nomche(/2) 65 : do in2 = 1, n2 66 : segini deche 67 : indec = iem 68 : ieldec = ielval(in2) 69 : typdec = typche(in2) 70 : nomdec = nomche(in2) 71 : imadec = imache(in1) 72 : condec = conche(in1) 73 : ifodec = ifoche 74 : do in3 = 1, n3 75 : infdec(in3) = infche(in1,in3) 76 : enddo 77 : * write (ioimp,*) ' coml in1 in2 condec ',in1,in2,condec 78 : * segdes deche 79 : ijmel=ijmel+1 80 : if (ijmel.gt.iimel)then 81 : iimel=iimel+500 82 : segadj lilmel 83 : endif 84 : lilmel(ijmel) = deche 85 : enddo 86 : segdes mchaml 87 : enddo 88 : segdes mchelm 89 : enddo 90 : iimel=ijmel 91 : segadj lilmel 92 : ipmel = lilmel 93 : c Indice des deche pour le champ de sortie 94 : INDESO = llchee(/1) + 1 95 : c Indicateur(s) d'erreur si non nul(s) 96 : IRETOU = 0 97 : 97 : CALL COML2(IPMODL,ipmel,INDESO,IRETOU) 98 : 99 : c Sortie sur une erreur bloquante 100 : IF (IERR.GT.0 .OR. IRETOU.NE.0) GOTO 9000 101 : 102 : c Construction du MCHAML resultat : sortie normale 103 : lilmel = ipmel 104 : iga = 0 105 : n3 = 0 106 : DO 107 iol = 1, lilmel(/1) 107 : deche = lilmel(iol) 108 : IF (indec.EQ.INDESO) THEN 109 : iga = iga + 1 110 : n3 = max(n3,infdec(/1)) 111 : ENDIF 112 : 107 CONTINUE 113 : n1 = iga 114 : n2 = 1 115 : L1 = 13 116 : SEGINI,mchelm 117 : TITCHE = 'CREE PAR COMP' 118 : iga = 0 119 : DO 108 iol = 1, lilmel(/1) 120 : deche = lilmel(iol) 121 : melval= ieldec 122 : IF (indec.EQ.INDESO) THEN 123 : iga = iga + 1 124 : IFOCHE = ifodec 125 : CONCHE(iga) = condec 126 : IMACHE(iga) = imadec 127 : DO in3 = 1, infdec(/1) 128 : INFCHE(iga,in3) = infdec(in3) 129 : ENDDO 130 : SEGINI,mchaml 131 : ICHAML(iga)=mchaml 132 : NOMCHE(1) = nomdec 133 : TYPCHE(1) = typdec 134 : IELVAL(1) = melval 135 : c... compresse eventuellement le melval s il est constant 135 : CALL comred(melval) 136 : SEGDES,mchaml 137 : ENDIF 138 : SEGDES,melval 139 : SEGSUP,deche 140 : 108 continue 141 : SEGDES,mchelm 141 : CALL ECROBJ('MCHAML ',mchelm) 142 : c write(ioimp,*) 'sortie normale de coml', mchelm 143 : 144 : 9000 CONTINUE 145 : SEGSUP,lilmel 146 : 9010 CONTINUE 147 : SEGSUP,llchee 148 : * 149 : RETURN 150 : END 151 : 152 :
© Cast3M 2003 - All rights reserved.
Disclaimer