Télécharger form.eso

Retour à la liste

Numérotation des lignes :

  1. C FORM SOURCE CB215821 16/12/05 21:39:30 9237
  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. call ooonth( ith)
  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
  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. IF (IRET2.EQ.0) THEN
  91. MOTERR(1:8)='CHPOINT'
  92. CALL ERREUR(37)
  93. RETURN
  94. ENDIF
  95.  
  96. CALL LIROBJ('MMODEL',IPMODL,1,IRET)
  97. IF (IRET.EQ.0 .OR. IERR.NE.0) go to 10
  98. CALL REDUAF(IPIN,IPMODL,IPCH1,0,IR,KER)
  99. IF(IR .NE. 1) CALL ERREUR(KER)
  100. IF(IERR .NE. 0) RETURN
  101.  
  102. C Mise a jour des caracteristiques materielles
  103. CALL FORMCH(IPMODL,IPCH1,IRET,IPTC,IPCH2)
  104. IF (IRET.EQ.0.OR.IERR.NE.0) RETURN
  105. CALL ECROBJ('MCHAML',IPCH2)
  106. ENDIF
  107.  
  108. idimp1=IDIM+1
  109. IF (IPTC.EQ.0) THEN
  110. IF (MCOO.EQ.0) THEN
  111. SEGINI,MXCA=MCOORD
  112. SEGDES,MXCA
  113. CALL ECROBJ('CONFIGUR',MXCA)
  114. go to 10
  115. ELSE
  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. go to 10
  127. ENDIF
  128. ELSE
  129.  
  130. C Mise a jour des coordonnes en ajoutant le champ de deplacement
  131. IF (MCOO.NE.0) THEN
  132. MXCA=MCOO
  133. SEGACT,MXCA
  134. NBPTA=MXCA.XCOOR(/1)/idimp1
  135. NBPTS=XCOOR(/1)/idimp1
  136. SEGADJ,MXCA
  137. DO i=NBPTA*idimp1+1,NBPTS*idimp1
  138. MXCA.XCOOR(i)=XCOOR(i)
  139. ENDDO
  140. SEGDES,MCOORD
  141. MCOORD=MXCA
  142. ENDIF
  143.  
  144. IF (IFOMOD.EQ.0.OR.IFOMOD.EQ.1) THEN
  145. BUR=.TRUE.
  146. NCMAX=2
  147. ELSE IF (IFOMOD.EQ.4.OR.IFOMOD.EQ.5) THEN
  148. BUR=.TRUE.
  149. NCMAX=1
  150. ELSE IF (IFOMOD.EQ.-1) THEN
  151. BUR=.FALSE.
  152. NCMAX=2
  153. ELSE IF (IFOMOD.EQ.3) THEN
  154. BUR=.FALSE.
  155. NCMAX=1
  156. ELSE
  157. BUR=.FALSE.
  158. NCMAX=3
  159. ENDIF
  160.  
  161. SEGINI,MXCA=MCOORD
  162. SEGDES,MCOORD
  163. MCHPOI=IPTC
  164. SEGACT,MCHPOI
  165. DO iSoup=1,IPCHP(/1)
  166. MSOUPO=IPCHP(iSoup)
  167. SEGACT,MSOUPO
  168. MPOVAL=IPOVAL
  169. SEGACT,MPOVAL
  170. IPT2=IGEOC
  171. SEGACT,IPT2
  172. NbElt=IPT2.NUM(/2)
  173. DO 70 IC=1,NOCOMP(/2)
  174. MDDL=NOCOMP(IC)
  175. DO INUM=1,NCMAX
  176. IF (BUR) THEN
  177. IF (NODEG(INUM).EQ.MDDL) GOTO 81
  178. ELSE
  179. IF (NODEF(INUM).EQ.MDDL) GOTO 81
  180. ENDIF
  181. ENDDO
  182. GOTO 70
  183. 81 DO iElt=1,NbElt
  184. IP=(IPT2.NUM(1,iElt)-1)*idimp1+INUM
  185. MXCA.XCOOR(IP)=MXCA.XCOOR(IP)+VPOCHA(iElt,IC)
  186. ENDDO
  187. 70 CONTINUE
  188. SEGDES,IPT2,MPOVAL,MSOUPO
  189. ENDDO
  190. SEGDES,MCHPOI
  191. MCOORD=MXCA
  192. CALL ECROBJ('CONFIGUR',MCOORD)
  193. ENDIF
  194. 10 CONTINUE
  195. C * attention aux assistants ....
  196. if (NBESC.NE.0) then
  197. C * il faut liberer le segment de dialogue
  198. mestra=imestr
  199. SEGDES MESTRA
  200. end if
  201. RETURN
  202. END
  203.  
  204.  
  205.  

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