Télécharger form.eso

Retour à la liste

Numérotation des lignes :

  1. C FORM SOURCE PV 20/03/30 21:19:27 10567
  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
  59. ith=oothrd
  60. if(ith.ne.0) then
  61. call erreur (1010)
  62. return
  63. endif
  64. do ith=1,nbesc
  65. mesins= mescl(ith)
  66. segact mesins
  67. 20 if(nbins.ne.0) then
  68. * write(6,*)'on attend la fin des esclaves ith nbins',ith,nbins
  69. segdes mesins*record
  70. segact mesins*(mod,ecr=1)
  71. go to 20
  72. endif
  73. segdes mesins*record
  74. enddo
  75. mestra=imestr
  76. SEGACT MESTRA*MOD
  77. if (iimpi .eq. 1234)
  78. & write(ioimp,*) ' assistants en attente'
  79. end if
  80.  
  81.  
  82. SEGACT,MCOORD*mod
  83.  
  84. CALL LIROBJ('CONFIGUR',MCOO,0,IRET1)
  85. CALL LIROBJ('CHPOINT ',IPTC,0,IRET2)
  86. CALL LIROBJ('MCHAML ',IPIN,0,IRET3)
  87. IPCH1 = 0
  88.  
  89. IF (IRET3.NE.0) THEN
  90. CALL ACTOBJ('MCHAML ' ,IPIN,1)
  91. IF (IRET2.EQ.0) THEN
  92. MOTERR(1:8)='CHPOINT'
  93. CALL ERREUR(37)
  94. RETURN
  95. ENDIF
  96. CALL ACTOBJ('CHPOINT ',IPTC,1)
  97.  
  98. CALL LIROBJ('MMODEL',IPMODL,1,IRET)
  99. IF (IRET.EQ.0 .OR. IERR.NE.0) go to 10
  100. CALL ACTOBJ('MMODEL ',IPMODL,1)
  101. CALL ACTOBJ('MCHAML ',IPIN ,1)
  102. CALL REDUAF(IPIN,IPMODL,IPCH1,0,IR,KER)
  103. IF(IR .NE. 1) CALL ERREUR(KER)
  104. IF(IERR .NE. 0) RETURN
  105.  
  106. C Mise a jour des caracteristiques materielles
  107. CALL FORMCH(IPMODL,IPCH1,IRET,IPTC,IPCH2)
  108. IF (IRET.EQ.0.OR.IERR.NE.0) RETURN
  109. CALL ACTOBJ('MCHAML ',IPCH2,1)
  110. CALL ECROBJ('MCHAML ',IPCH2)
  111. ENDIF
  112.  
  113. idimp1=IDIM+1
  114. IF (IPTC.EQ.0) THEN
  115. IF (MCOO.EQ.0) THEN
  116. SEGINI,MXCA=MCOORD
  117. SEGDES,MXCA
  118. CALL ECROBJ('CONFIGUR',MXCA)
  119. go to 10
  120. ELSE
  121. MXCA=MCOO
  122. SEGACT,MXCA
  123. NBPTA=MXCA.XCOOR(/1)/idimp1
  124. NBPTS=XCOOR(/1)/idimp1
  125. SEGADJ,MXCA
  126. DO i=NBPTA*idimp1+1,NBPTS*idimp1
  127. MXCA.XCOOR(i)=XCOOR(i)
  128. ENDDO
  129. MCOORD=MXCA
  130. go to 10
  131. ENDIF
  132. ELSE
  133.  
  134. C Mise a jour des coordonnes en ajoutant le champ de deplacement
  135. IF (MCOO.NE.0) THEN
  136. MXCA=MCOO
  137. SEGACT,MXCA
  138. NBPTA=MXCA.XCOOR(/1)/idimp1
  139. NBPTS=XCOOR(/1)/idimp1
  140. SEGADJ,MXCA
  141. DO i=NBPTA*idimp1+1,NBPTS*idimp1
  142. MXCA.XCOOR(i)=XCOOR(i)
  143. ENDDO
  144. MCOORD=MXCA
  145. ENDIF
  146.  
  147. IF (IFOMOD.EQ.0.OR.IFOMOD.EQ.1) THEN
  148. BUR=.TRUE.
  149. NCMAX=2
  150. ELSE IF (IFOMOD.EQ.4.OR.IFOMOD.EQ.5) THEN
  151. BUR=.TRUE.
  152. NCMAX=1
  153. ELSE IF (IFOMOD.EQ.-1) THEN
  154. BUR=.FALSE.
  155. NCMAX=2
  156. ELSE IF (IFOMOD.EQ.3) THEN
  157. BUR=.FALSE.
  158. NCMAX=1
  159. ELSE
  160. BUR=.FALSE.
  161. NCMAX=3
  162. ENDIF
  163.  
  164. SEGINI,MXCA=MCOORD
  165. MCHPOI=IPTC
  166. SEGACT,MCHPOI
  167. DO iSoup=1,IPCHP(/1)
  168. MSOUPO=IPCHP(iSoup)
  169. SEGACT,MSOUPO
  170. MPOVAL=IPOVAL
  171. SEGACT,MPOVAL
  172. IPT2=IGEOC
  173. SEGACT,IPT2
  174. NbElt=IPT2.NUM(/2)
  175. DO 70 IC=1,NOCOMP(/2)
  176. MDDL=NOCOMP(IC)
  177. DO INUM=1,NCMAX
  178. IF (BUR) THEN
  179. IF (NODEG(INUM).EQ.MDDL) GOTO 81
  180. ELSE
  181. IF (NODEF(INUM).EQ.MDDL) GOTO 81
  182. ENDIF
  183. ENDDO
  184. GOTO 70
  185. 81 DO iElt=1,NbElt
  186. IP=(IPT2.NUM(1,iElt)-1)*idimp1+INUM
  187. MXCA.XCOOR(IP)=MXCA.XCOOR(IP)+VPOCHA(iElt,IC)
  188. ENDDO
  189. 70 CONTINUE
  190. ENDDO
  191. MCOORD=MXCA
  192. SEGDES,MCOORD
  193. CALL ECROBJ('CONFIGUR',MCOORD)
  194. ENDIF
  195. 10 CONTINUE
  196. C * attention aux assistants ....
  197. if (NBESC.NE.0) then
  198. C * il faut liberer le segment de dialogue
  199. mestra=imestr
  200. SEGDES MESTRA
  201. end if
  202.  
  203. END
  204.  
  205.  
  206.  
  207.  
  208.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales