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

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