1 : C MAMANU SOURCE CHAT 11/03/16 21:27:08 6902 2 : SUBROUTINE MAMANU 3 : *--------------------------------------------------------------------* 4 : * * 5 : * CREATION D'UN NOUVEAU CHAMELEM PAR MANU * 6 : * (OPTION 'CHAM' PP 24/11/92) * 7 : * * 8 : *--------------------------------------------------------------------* 9 : IMPLICIT INTEGER(I-N) 10 : IMPLICIT REAL*8(A-H,O-Z) 11 : -INC CCOPTIO 12 : -INC SMELEME 13 : -INC SMMODEL 14 : -INC SMCHAML 15 : * 16 : SEGMENT INFO 17 : INTEGER INFELL(JG) 18 : ENDSEGMENT 19 : * 20 : CHARACTER*4 MOCHOI,MOTYPE(2) 21 : CHARACTER*8 MOCHOY 22 : CHARACTER*8 TYPOBJ 23 : CHARACTER*72 CHATYPE 24 : CHARACTER*8 LISMOT(5) 25 : DATA MOTYPE/'TYPE','POSI'/ 26 : DATA LISMOT/'NOEUD','GRAVITE','RIGIDITE','MASSE','STRESSES'/ 27 : * 28 : * LECTURE (IMPERATIVE) D'UN MODELE 29 : * 29 : CALL LIROBJ('MMODEL',MMODEL,1,IRET) 30 : IF (IERR.NE.0) RETURN 31 : * 32 : * OPTION PAR DEFAUT 33 : * 34 : LTYPE=1 35 : CHATYPE=' ' 36 : IPOSI=1 37 : * 38 : * ON DESIRE LIRE SOIT UN MOT CLE, SOIT UN NOM DE COMPOSANTE 39 : * 40 : 1 IRCHOI = 0 40 : CALL LIRCHA(MOCHOY,1,IRCHOI) 41 : IF (IERR.NE.0) RETURN 42 : MOCHOI=MOCHOY(1:4) 43 : * 44 : * TRAITEMENT DES MOTS CLE 45 : * 45 : CALL PLACE(MOTYPE,2,IPLACE,MOCHOI) 46 : IF(IPLACE.EQ.0) GOTO 30 47 : GOTO(10,20),IPLACE 48 : * 49 : * SOUS-TYPE 50 : * 51 : 10 CONTINUE 51 : CALL LIRCHA(CHATYPE,1,LTYPE) 52 : IF (IERR.NE.0) RETURN 53 : GOTO 1 54 : * 55 : * PLACE 56 : * 57 : 20 CONTINUE 57 : CALL LIRMOT(LISMOT,5,IPOSI,1) 58 : IF (IERR.NE.0) RETURN 59 : GOTO 1 60 : * 61 : * MOCHOI EST LA COMPOSANTE, ON LIT MAINTENANT LES ENTIERS 62 : * 63 : 30 CONTINUE 63 : CALL LIRENT(IENT1,1,IRET) 64 : IF (IERR.NE.0) RETURN 64 : CALL LIRENT(IENT2,1,IRET) 65 : IF (IERR.NE.0) RETURN 65 : CALL LIRENT(IENT3,0,IRET) 66 : IF(IRET.EQ.0)THEN 67 : IENT3=1 68 : ENDIF 69 : * 70 : * LECTURE DE L'OBJET QUELCONQUE 71 : * MODIF AM 30/1/95 ON AUTORISE SEULEMENT LES REELS 72 : * 72 : * CALL LIRREE(XFLOT,0,IRETF) 73 : * 73 : CALL LIRREE(XFLOT,1,IRETF) 74 : IF(IERR.NE.0) RETURN 75 : * 76 : IF (IRETF.EQ.0) THEN 76 : CALL QUETYP(TYPOBJ,1,IRET) 77 : IF (IERR.NE.0) RETURN 77 : CALL LIROBJ(TYPOBJ,IPOBJ,1,IRET) 78 : IF (IERR.NE.0) RETURN 79 : ENDIF 80 : * 81 : * ON VERIFIE IENT1,IENT2 ET IENT3 82 : * 83 : SEGACT,MMODEL 84 : NZONE=KMODEL(/1) 85 : IF(IENT3.GT.NZONE)THEN 86 : INTERR(1)=IENT3 87 : INTERR(2)=NZONE 87 : CALL ERREUR(8001) 88 : SEGDES,MMODEL 89 : RETURN 90 : ENDIF 91 : * 92 : IMODEL=KMODEL(IENT3) 93 : SEGDES,MMODEL 94 : SEGACT,IMODEL 95 : MELEME=IMAMOD 96 : SEGACT,MELEME 97 : NBELEM=NUM(/2) 98 : IF(IENT1.GT.NBELEM)THEN 99 : INTERR(1)=IENT1 100 : INTERR(2)=NBELEM 101 : INTERR(3)=IENT3 101 : CALL ERREUR(8002) 102 : SEGDES,MELEME,IMODEL 103 : RETURN 104 : ENDIF 105 : * 106 : MELE=NEFMOD 107 : NFOR=FORMOD(/2) 107 : CALL PLACE(FORMOD,NFOR,IMECA,'MECANIQUE ') 108 : IF(IMECA.EQ.0)THEN 109 : INTERR(1)=IENT3 109 : CALL ERREUR(8003) 110 : RETURN 111 : ENDIF 112 : MINTE=0 113 : IF(IPOSI.EQ.1)THEN 114 : NBPGAU=NUM(/1) 115 : ELSE 116 : if(infmod(/1).lt. 2+iposi) then 116 : CALL ELQUOI(MELE,0,IPOSI,INFO,IMODEL) 117 : MINTE=INFELL(11) 118 : IF(IPOSI.EQ.2)NBPGAU=1 119 : IF(IPOSI.EQ.3)NBPGAU=INFELL(6) 120 : IF(IPOSI.EQ.4)NBPGAU=INFELL(3) 121 : IF(IPOSI.EQ.5)NBPGAU=INFELL(4) 122 : SEGSUP,INFO 123 : else 124 : minte=infmod(iposi+2) 125 : IF(IPOSI.EQ.2)NBPGAU=1 126 : IF(IPOSI.EQ.3)NBPGAU=INFELE(6) 127 : IF(IPOSI.EQ.4)NBPGAU=INFELE(3) 128 : IF(IPOSI.EQ.5)NBPGAU=INFELE(4) 129 : endif 130 : ENDIF 131 : 132 : 133 : SEGDES,MELEME 134 : IF(IENT2.GT.NBPGAU)THEN 135 : INTERR(1)=IENT2 136 : INTERR(2)=NBPGAU 137 : INTERR(3)=IENT3 137 : CALL ERREUR(8004) 138 : SEGDES,IMODEL 139 : RETURN 140 : ENDIF 141 : * 142 : * ON CONSTRUIT LE MCHAML 143 : * 144 : L1=LTYPE 145 : N1=1 146 : N3=6 147 : SEGINI,MCHELM 148 : TITCHE=CHATYPE(1:LTYPE) 149 : CONCHE(1)=CONMOD 150 : SEGDES,IMODEL 151 : IMACHE(1)=MELEME 152 : IFOCHE=IFOUR 153 : INFCHE(1,1) = 0 154 : INFCHE(1,2) = 0 155 : INFCHE(1,3) = NIFOUR 156 : INFCHE(1,4) = MINTE 157 : INFCHE(1,5) = 0 158 : INFCHE(1,6) = IPOSI 159 : * 160 : N2=1 161 : SEGINI,MCHAML 162 : ICHAML(1)=MCHAML 163 : NOMCHE(1)=MOCHOI 164 : IF (IRETF.EQ.0) THEN 165 : TYPCHE(1)='POINTEUR'//TYPOBJ 166 : N1PTEL=0 167 : N1EL=0 168 : N2PTEL=NBPGAU 169 : N2EL=NBELEM 170 : SEGINI,MELVAL 171 : DO IB=1,NBELEM 172 : DO IGAU=1,NBPGAU 173 : IELCHE(IGAU,IB)=0 174 : END DO 175 : END DO 176 : IELCHE(IENT2,IENT1)=IPOBJ 177 : ELSE 178 : TYPCHE(1)='REAL*8 ' 179 : N2PTEL=0 180 : N2EL=0 181 : N1PTEL=NBPGAU 182 : N1EL=NBELEM 183 : SEGINI,MELVAL 184 : DO IB=1,NBELEM 185 : DO IGAU=1,NBPGAU 186 : VELCHE(IGAU,IB)=0.D0 187 : END DO 188 : END DO 189 : VELCHE(IENT2,IENT1)=XFLOT 190 : ENDIF 191 : IELVAL(1)=MELVAL 192 : SEGDES,MELVAL,MCHAML,MCHELM 193 : * 194 : * ON SORT 195 : * 195 : CALL ECROBJ('MCHAML ',MCHELM) 196 : RETURN 197 : END 198 : 199 : 200 : 201 : 202 : 203 : 204 : 205 :
© Cast3M 2003 - All rights reserved.
Disclaimer