1 : C MANUC5 SOURCE CHAT 11/03/16 21:27:11 6902 2 : SUBROUTINE MANUC5 3 : *--------------------------------------------------------------------* 4 : * * 5 : * CREATION D'UN NOUVEAU CHAMELEM PAR MANU * 6 : * * 7 : *--------------------------------------------------------------------* 8 : IMPLICIT INTEGER(I-N) 9 : IMPLICIT REAL*8(A-H,O-Z) 10 : -INC CCOPTIO 11 : -INC SMLMOTS 12 : -INC SMLREEL 13 : -INC SMLENTI 14 : -INC SMELEME 15 : -INC SMMODEL 16 : * 17 : CHARACTER*4 MOCHOI,MOTYPE(3) 18 : CHARACTER*8 MOCHOY 19 : CHARACTER*8 CAR 20 : CHARACTER*16 JECONS 21 : CHARACTER*72 JEROME 22 : CHARACTER*8 LISMOT(5),REPA(1) 23 : DATA MOTYPE/'TYPE','CONS','EVOL'/ 24 : DATA REPA/'REPA'/ 25 : DATA LISMOT/'NOEUD','GRAVITE','RIGIDITE','MASSE','STRESSES'/ 26 : * 27 : * Initialisation des segments 28 : * 29 : IPLAC=0 30 : IPMAIL=0 31 : IPMODL=0 32 : * 33 : * LECTURE D'UN MODELE 34 : * 34 : CALL LIROBJ('MMODEL',IPMODL,0,IRET) 35 : IF(IERR.NE.0)RETURN 36 : IF(IRET.EQ.0)THEN 37 : * 38 : * SINON D'UN MAILLAGE 39 : * 40 : MOTERR(1:8)='MAILLAGE' 40 : CALL MESLIR(-137) 40 : CALL LIROBJ('MAILLAGE',IPMAIL,0,IRET) 41 : * 42 : * SINON lecture du mot EVOL 43 : * 44 : IF( IRET.EQ.0) THEN 44 : CALL LIRMOT ( MOTYPE(3),1,IPLAC,0) 44 : IF (IPLAC.EQ.0) CALL ERREUR(907) 45 : IF (IERR.NE.0) RETURN 46 : IF (IPLAC.EQ.1) THEN 46 : CALL MANUC8 47 : RETURN 48 : ENDIF 49 : ENDIF 50 : ENDIF 51 : * 52 : JG=0 53 : JGN=4 54 : JGM=0 55 : SEGINI,MLMOTS 56 : SEGINI,MLMOT1 57 : SEGINI,MLMOT2 58 : SEGINI,MLMOT3 59 : SEGINI,MLREE1 60 : SEGINI,MLENT2 61 : 62 : L1 = 0 63 : LL1 = 0 64 : IPLAC=0 65 : * 66 : itart=0 66 : call LIRMOT(REPA,1,itart,0) 67 : * 68 : 10 CONTINUE 69 : * 70 : * ON DESIRE LIRE UNE COMPOSANTE 71 : * 72 : IRCHOI = 0 72 : CALL LIRCHA(MOCHOY,0,IRCHOI) 73 : IF(IRCHOI.EQ.0) GO TO 20 74 : MOCHOI=MOCHOY(1:4) 75 : * 76 : * SI ON A LU LE MOT TYPE 77 : * 78 : IF(MOCHOI.EQ.MOTYPE(1)) THEN 78 : CALL LIRCHA(JEROME,1,L1) 79 : GO TO 10 80 : ENDIF 81 : * 82 : * SI ON A LU LE MOT CONS 83 : * 84 : IF(IPMAIL.NE.0)THEN 85 : IF(MOCHOI.EQ.MOTYPE(2)) THEN 85 : CALL LIRCHA(JECONS,1,LL1) 86 : GO TO 10 87 : ENDIF 88 : ENDIF 89 : IF(IPMODL.NE.0.AND.IPLAC.EQ.0)THEN 89 : CALL PLACE(LISMOT,5,IPLAC,MOCHOY) 90 : IF(IPLAC.NE.0)GOTO 10 91 : ENDIF 92 : * 93 : * SINON ON TESTE LE NOMBRE DE CARACTERES LUS 94 : * 95 : IF(IRCHOI.GT.4) THEN 95 : CALL ERREUR(536) 96 : GOTO 99 97 : ENDIF 98 : * 98 : CALL LIRREE(RECOM,0,IRET2) 99 : IF (IRET2.EQ.1) THEN 100 : MLMOT1.MOTS(**) = MOCHOI 101 : JG=MLREE1.PROG(/1)+1 102 : SEGADJ MLREE1 103 : MLREE1.PROG(JG)=RECOM 104 : ELSE 104 : CALL QUETYP(CAR,0,IRET1) 105 : IF (IERR.NE.0) GO TO 99 105 : CALL LIROBJ(CAR,IPTRUC,0,IRET1) 106 : IF (IERR.NE.0) GO TO 99 107 : * 108 : * ON A LU UN OBJET DE TYPE AUTRE QU'UN FLOTTANT 109 : * 110 : MLMOT2.MOTS(**) = MOCHOI 111 : MLMOT3.MOTS(**)=CAR(1:4) 112 : MOTS(**) =CAR(5:8) 113 : JG=MLENT2.LECT(/1)+1 114 : SEGADJ MLENT2 115 : MLENT2.LECT(JG)=IPTRUC 116 : ENDIF 117 : GOTO 10 118 : * 119 : 20 CONTINUE 120 : IF ( L1.EQ.0) THEN 121 : JEROME=' ' 122 : L1 = 1 123 : ENDIF 124 : * 125 : * RECUPERATION DES ZONES ELEMENTAIRES DU MAILLAGE 126 : * 127 : IF(IPMAIL.NE.0)THEN 128 : MELEME=IPMAIL 129 : SEGACT MELEME 130 : JG=LISOUS(/1) 131 : IF (JG.EQ.0) THEN 132 : JG=1 133 : SEGINI MLENT1 134 : MLENT1.LECT(1)=IPMAIL 135 : ELSE 136 : SEGINI MLENT1 137 : DO 22 IT=1,JG 138 : MLENT1.LECT(IT)=LISOUS(IT) 139 : 22 CONTINUE 140 : ENDIF 141 : * 142 : SEGDES MELEME 143 : IF ( LL1.EQ.0) THEN 144 : JECONS=' ' 145 : ENDIF 146 : * 147 : * ON STOCKE LE NOM DU COMPOSANT 148 : * 149 : JGN=16 150 : JGM=JG 151 : SEGINI MLMOT4 152 : DO 23 IT=1,JG 153 : MLMOT4.MOTS(IT)=JECONS 154 : 23 CONTINUE 155 : * 155 : CALL MANUC4(MLENT1,MLMOT1,MLMOT2,MLMOT3,MLMOTS,MLREE1, 156 : & MLENT2,JEROME,L1,MLMOT4,IPOI1) 157 : * 158 : * Suppression des segments 159 : * 160 : SEGSUP,MLENT1 161 : SEGSUP,MLMOT4 161 : IF(IERR.EQ.0)CALL ECROBJ('MCHAML ',IPOI1) 162 : ELSE 163 : IF(IPLAC.EQ.0)IPLAC=1 164 : MMODEL=IPMODL 165 : SEGACT,MMODEL 166 : N1=KMODEL(/1) 167 : DO 69 I=1,N1 168 : IMODEL=KMODEL(I) 169 : SEGACT,IMODEL 170 : 69 CONTINUE 170 : CALL MANUC6(IPMODL,MLMOT1,MLMOT2,MLMOT3,MLMOTS,MLREE1, 171 : & MLENT2,JEROME,L1,IPLAC,IPOI1,itart) 172 : DO 68 I=1,N1 173 : IMODEL=KMODEL(I) 174 : SEGDES,IMODEL 175 : * END DO 176 : 68 CONTINUE 177 : SEGDES,MMODEL 177 : IF(IERR.EQ.0)CALL ECROBJ('MCHAML ',IPOI1) 178 : ENDIF 179 : * 180 : * Suppression des segments 181 : * 182 : 99 CONTINUE 183 : SEGSUP,MLMOTS 184 : SEGSUP,MLMOT1 185 : SEGSUP,MLMOT2 186 : SEGSUP,MLMOT3 187 : SEGSUP,MLREE1 188 : SEGSUP,MLENT2 189 : RETURN 190 : END 191 : 192 : 193 : 194 :
© Cast3M 2003 - All rights reserved.
Disclaimer