1 : C FORM SOURCE CHAT 12/04/06 21:15:14 7345 2 : 3 : C======================================================================= 4 : C= F O R M = 5 : C= ------- = 6 : C= = 7 : C= FONCTEUR CAST3M 'FORME' DE MISE A JOUR DE CONFIGURATIONS : = 8 : C= ---------------------------------------------------------- = 9 : C= (CONF2) (CAR2) = 'FORME' (CONF1) (CHPO1) (MODL1 CAR1) ; = 10 : C= = 11 : C= UTILISATION : SANS OPERANDE METS DANS LA PILE LE SEGMENT CCOORD 12 : C= : AVEC UN OBJET CONFIGURA, ACTIVE CETTE CONFIGURATION 13 : C= : AVEC UN CHAMPOINT, CREE LES COORDO = COURANTES+DEFORMEE 14 : C= PUIS ACTIVE CETTE CONFIG 15 : C= : AVEC CHPOINT ET CONFIGUR CREE ET ACTIVE LA CONFIGU = 16 : C= CONFIGUR + DEFORMEE ISSU DE CHPOINT. 17 : C= SERT A NOMMER, ACTIVER OU CREER UNE CONFIGURATION C'EST-A-DIRE UN 18 : C= CHAMP DE COORDONNEES SUPPORT. 19 : C= = 20 : C= ARGUMENTS : = 21 : C= ----------- = 22 : C= CONF1 (CONFIGU) Champ de coordonnees support (configuration) = 23 : C= CHPO1 (CHPOINT) Champ de deplacements sur la structure = 24 : C= MODL1 (MMODEL) Modele de la structure etudiee (facultatif) = 25 : C= CAR1 (MCHAML) Caracteristiques geometriques (facultatif) = 26 : C= Sous-type 'CARACTERISTIQUES' = 27 : C= = 28 : C= RESULTATS : = 29 : C= ----------- = 30 : C= CONF2 (CONFIGU) Champ de coordonnees support actualise = 31 : C= CAR2 (MCHAML) Caracteristiques geometriques actualisees = 32 : C======================================================================= 33 : 34 : SUBROUTINE FORM 35 : 36 : IMPLICIT INTEGER(I-N) 37 : IMPLICIT REAL*8 (A-H,O-Z) 38 : 39 : -INC CCOPTIO 40 : -INC SMCOORD 41 : POINTEUR MXCA.MCOORD 42 : -INC SMELEME 43 : -INC SMCHPOI 44 : -INC CCASSIS 45 : 46 : LOGICAL BUR 47 : CHARACTER*4 MDDL 48 : CHARACTER*4 NODEF(3),NODEG(3) 49 : 50 : DATA NODEF / 'UX ','UY ','UZ ' / 51 : DATA NODEG / 'UR ','UZ ','UT ' / 52 : 53 : C * attention aux assistants .... 54 : if (NBESC.NE.0) then 55 : if (iimpi .eq. 1234) 56 : 57 : & write(ioimp,*) ' il faut bloquer les assistants' 58 : ith=0 58 : call ooonth( ith) 59 : if(ith.ne.0) then 59 : call erreur (1010) 60 : return 61 : endif 62 : do ith=1,nbesc 63 : mesins= mescl(ith) 64 : segact mesins 65 : 20 if(nbins.ne.0) then 66 : * write(6,*)'on attend la fin des esclaves ith nbins',ith,nbins 67 : segdes mesins*record 68 : segact mesins*(mod,ecr=1) 69 : go to 20 70 : endif 71 : segdes mesins*record 72 : enddo 73 : mestra=imestr 74 : SEGACT MESTRA*MOD 75 : if (iimpi .eq. 1234) 76 : & write(ioimp,*) ' assistants en attente' 77 : end if 78 : 79 : 80 : SEGACT,MCOORD 81 : 81 : CALL LIROBJ('CONFIGUR',MCOO,0,IRET1) 81 : CALL LIROBJ('CHPOINT ',IPTC,0,IRET2) 81 : CALL LIROBJ('MCHAML',IPCH1,0,IRET3) 82 : 83 : IF (IRET3.NE.0) THEN 84 : IF (IRET2.EQ.0) THEN 85 : MOTERR(1:8)='CHPOINT' 85 : CALL ERREUR(37) 86 : RETURN 87 : ENDIF 87 : CALL LIROBJ('MMODEL',IPMODL,1,IRET) 88 : IF (IRET.EQ.0.OR.IERR.NE.0) go to 10 89 : C Mise a jour des caracteristiques materielles 89 : CALL FORMCH(IPMODL,IPCH1,IRET,IPTC,IPCH2) 90 : IF (IRET.EQ.0.OR.IERR.NE.0) RETURN 90 : CALL ECROBJ('MCHAML',IPCH2) 91 : ENDIF 92 : 93 : idimp1=IDIM+1 94 : IF (IPTC.EQ.0) THEN 95 : IF (MCOO.EQ.0) THEN 96 : SEGINI,MXCA=MCOORD 97 : SEGDES,MXCA 97 : CALL ECROBJ('CONFIGUR',MXCA) 98 : go to 10 99 : ELSE 100 : MXCA=MCOO 101 : SEGACT,MXCA 102 : NBPTA=MXCA.XCOOR(/1)/idimp1 103 : NBPTS=XCOOR(/1)/idimp1 104 : SEGADJ,MXCA 105 : DO i=NBPTA*idimp1+1,NBPTS*idimp1 106 : MXCA.XCOOR(i)=XCOOR(i) 107 : ENDDO 108 : SEGDES,MCOORD 109 : MCOORD=MXCA 110 : go to 10 111 : ENDIF 112 : ELSE 113 : 114 : C Mise a jour des coordonnes en ajoutant le champ de deplacement 115 : IF (MCOO.NE.0) THEN 116 : MXCA=MCOO 117 : SEGACT,MXCA 118 : NBPTA=MXCA.XCOOR(/1)/idimp1 119 : NBPTS=XCOOR(/1)/idimp1 120 : SEGADJ,MXCA 121 : DO i=NBPTA*idimp1+1,NBPTS*idimp1 122 : MXCA.XCOOR(i)=XCOOR(i) 123 : ENDDO 124 : SEGDES,MCOORD 125 : MCOORD=MXCA 126 : ENDIF 127 : 128 : IF (IFOMOD.EQ.0.OR.IFOMOD.EQ.1) THEN 129 : BUR=.TRUE. 130 : NCMAX=2 131 : ELSE IF (IFOMOD.EQ.4.OR.IFOMOD.EQ.5) THEN 132 : BUR=.TRUE. 133 : NCMAX=1 134 : ELSE IF (IFOMOD.EQ.-1) THEN 135 : BUR=.FALSE. 136 : NCMAX=2 137 : ELSE IF (IFOMOD.EQ.3) THEN 138 : BUR=.FALSE. 139 : NCMAX=1 140 : ELSE 141 : BUR=.FALSE. 142 : NCMAX=3 143 : ENDIF 144 : 145 : SEGINI,MXCA=MCOORD 146 : SEGDES,MCOORD 147 : MCHPOI=IPTC 148 : SEGACT,MCHPOI 149 : DO iSoup=1,IPCHP(/1) 150 : MSOUPO=IPCHP(iSoup) 151 : SEGACT,MSOUPO 152 : MPOVAL=IPOVAL 153 : SEGACT,MPOVAL 154 : IPT2=IGEOC 155 : SEGACT,IPT2 156 : NbElt=IPT2.NUM(/2) 157 : DO 70 IC=1,NOCOMP(/2) 158 : MDDL=NOCOMP(IC) 159 : DO INUM=1,NCMAX 160 : IF (BUR) THEN 161 : IF (NODEG(INUM).EQ.MDDL) GOTO 81 162 : ELSE 163 : IF (NODEF(INUM).EQ.MDDL) GOTO 81 164 : ENDIF 165 : ENDDO 166 : GOTO 70 167 : 81 DO iElt=1,NbElt 168 : IP=(IPT2.NUM(1,iElt)-1)*idimp1+INUM 169 : MXCA.XCOOR(IP)=MXCA.XCOOR(IP)+VPOCHA(iElt,IC) 170 : ENDDO 171 : 70 CONTINUE 172 : SEGDES,IPT2,MPOVAL,MSOUPO 173 : ENDDO 174 : SEGDES,MCHPOI 175 : MCOORD=MXCA 175 : CALL ECROBJ('CONFIGUR',MCOORD) 176 : ENDIF 177 : 10 CONTINUE 178 : C * attention aux assistants .... 179 : if (NBESC.NE.0) then 180 : C * il faut liberer le segment de dialogue 181 : mestra=imestr 182 : SEGDES MESTRA 183 : end if 184 : RETURN 185 : END 186 : 187 : 188 : 189 : 190 : 191 : 192 : 193 : 194 : 195 :
© Cast3M 2003 - All rights reserved.
Disclaimer