Télécharger form.eso

Retour à la liste

Numérotation des lignes :

  1. C FORM SOURCE PV 18/10/17 11:49:11 9965
  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
  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 ACTOBJ('MMODEL ',IPMODL,1)
  99. CALL ACTOBJ('MCHAML ',IPIN ,1)
  100. CALL REDUAF(IPIN,IPMODL,IPCH1,0,IR,KER)
  101. IF(IR .NE. 1) CALL ERREUR(KER)
  102. IF(IERR .NE. 0) RETURN
  103.  
  104. C Mise a jour des caracteristiques materielles
  105. CALL FORMCH(IPMODL,IPCH1,IRET,IPTC,IPCH2)
  106. IF (IRET.EQ.0.OR.IERR.NE.0) RETURN
  107. CALL ECROBJ('MCHAML',IPCH2)
  108. ENDIF
  109.  
  110. idimp1=IDIM+1
  111. IF (IPTC.EQ.0) THEN
  112. IF (MCOO.EQ.0) THEN
  113. SEGINI,MXCA=MCOORD
  114. SEGDES,MXCA
  115. CALL ECROBJ('CONFIGUR',MXCA)
  116. go to 10
  117. ELSE
  118. MXCA=MCOO
  119. SEGACT,MXCA
  120. NBPTA=MXCA.XCOOR(/1)/idimp1
  121. NBPTS=XCOOR(/1)/idimp1
  122. SEGADJ,MXCA
  123. DO i=NBPTA*idimp1+1,NBPTS*idimp1
  124. MXCA.XCOOR(i)=XCOOR(i)
  125. ENDDO
  126. SEGDES,MCOORD
  127. MCOORD=MXCA
  128. go to 10
  129. ENDIF
  130. ELSE
  131.  
  132. C Mise a jour des coordonnes en ajoutant le champ de deplacement
  133. IF (MCOO.NE.0) THEN
  134. MXCA=MCOO
  135. SEGACT,MXCA
  136. NBPTA=MXCA.XCOOR(/1)/idimp1
  137. NBPTS=XCOOR(/1)/idimp1
  138. SEGADJ,MXCA
  139. DO i=NBPTA*idimp1+1,NBPTS*idimp1
  140. MXCA.XCOOR(i)=XCOOR(i)
  141. ENDDO
  142. SEGDES,MCOORD
  143. MCOORD=MXCA
  144. ENDIF
  145.  
  146. IF (IFOMOD.EQ.0.OR.IFOMOD.EQ.1) THEN
  147. BUR=.TRUE.
  148. NCMAX=2
  149. ELSE IF (IFOMOD.EQ.4.OR.IFOMOD.EQ.5) THEN
  150. BUR=.TRUE.
  151. NCMAX=1
  152. ELSE IF (IFOMOD.EQ.-1) THEN
  153. BUR=.FALSE.
  154. NCMAX=2
  155. ELSE IF (IFOMOD.EQ.3) THEN
  156. BUR=.FALSE.
  157. NCMAX=1
  158. ELSE
  159. BUR=.FALSE.
  160. NCMAX=3
  161. ENDIF
  162.  
  163. SEGINI,MXCA=MCOORD
  164. SEGDES,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. SEGDES,IPT2,MPOVAL,MSOUPO
  191. ENDDO
  192. SEGDES,MCHPOI
  193. MCOORD=MXCA
  194. CALL ECROBJ('CONFIGUR',MCOORD)
  195. ENDIF
  196. 10 CONTINUE
  197. C * attention aux assistants ....
  198. if (NBESC.NE.0) then
  199. C * il faut liberer le segment de dialogue
  200. mestra=imestr
  201. SEGDES MESTRA
  202. end if
  203. RETURN
  204. END
  205.  
  206.  
  207.  
  208.  
  209.  
  210.  
  211.  
  212.  
  213.  

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