Télécharger etg.eso

Retour à la liste

Numérotation des lignes :

  1. C ETG SOURCE CB215821 17/12/07 21:15:08 9656
  2. SUBROUTINE ETG
  3.  
  4. implicit integer (i-n)
  5. implicit real*8(a-h,o-z)
  6.  
  7. -INC CCOPTIO
  8. -INC SMTABLE
  9. -INC CCNOYAU
  10. -INC CCASSIS
  11. -INC CCPRECO
  12.  
  13. LOGICAL LOGR1,LOGR2,BMAX
  14. REAL*8 XVALRE,XVALR2
  15. CHARACTER*(8) TYPOBJ,CHA8,CHARRE,CHACRE
  16.  
  17. C SID : SEGMENT CONTENANT LES INFORMATIONS POUR LA FUSION DES OBJETS
  18. SEGMENT SID
  19. C NBFUS : NOMBRE D'OBJETS A FUSIONNER
  20. C IPOINT : POINTEURS SUR LES NBFUS OBJETS A FUSIONNER
  21. C BVAL : LOGIQUES SUR LESQUELS ON FAIT UN ET LOGIQUE
  22. C XVAL : VALEURS MAXI / MINI LOCALES A FUSIONNER
  23. C CHATYP : MOT DONNANT LE TYPE D'OBJETS A FUSIONNER
  24. INTEGER IPOINT(NBFUS)
  25. LOGICAL BVAL (NBFUS)
  26. REAL*8 XVAL (NBFUS)
  27. CHARACTER*8 CHATYP
  28. ENDSEGMENT
  29.  
  30. BMAX = .FALSE.
  31. LOGR1 = .FALSE.
  32. LOGR2 = .FALSE.
  33. XVALRE= 0.
  34. XVALR2= 0.
  35.  
  36.  
  37. CC Lecture du premier objet
  38. CC ------------------------
  39. CALL MESLIR(-225)
  40. CALL QUETYP(TYPOBJ,0,IRETOU)
  41. IF(IRETOU.EQ.0) THEN
  42. CC Cet opérateur a encore besoin d'un opérande.
  43. CALL ERREUR (533)
  44. RETURN
  45. ENDIF
  46. CALL LIROBJ(TYPOBJ,IP1,1,IRETOU)
  47.  
  48. IF(TYPOBJ.EQ.'TABLE') THEN
  49. MTABLE = IP1
  50. CALL ACCTAB(MTABLE,'MOT',0,0.D0 ,'SOUSTYPE',.TRUE.,0,
  51. > 'MOT',IENT1,XVALRE, TYPOBJ ,LOGR1 ,ID1)
  52. IF (TYPOBJ.NE.'ESCLAVE') THEN
  53. CC Donnez une TABLE de sous-type %m1:8
  54. MOTERR(1:8)='ESCLAVE'
  55. CALL ERREUR(-173)
  56. CC Le sous-type de la table est incorrect
  57. CALL ERREUR(648)
  58. RETURN
  59. ENDIF
  60.  
  61. SEGACT,MTABLE
  62. ML=MLOTAB
  63.  
  64. C RECHERCHE DU CREATEUR
  65. CALL ACCTAB(MTABLE,'MOT ',IND ,0.D0 ,'CREATEUR',.TRUE.,0 ,
  66. & 'MOT ',IENT1,XVALR2,CHACRE ,LOGR2 ,ID2)
  67. IF (IERR.NE.0) RETURN
  68.  
  69. C DIMENSIONNEMENT DU SEGMENT SID A (ML - 2) a cause des indices 'SOUSTYPE' et 'CREATEUR'
  70. NBFUS = ML - 2
  71. SEGINI,SID
  72. NBENT = 0
  73.  
  74. IND = 1
  75. TYPOBJ=' '
  76. CALL ACCTAB(MTABLE,'ENTIER',IND ,0.D0 ,' ',.TRUE.,0 ,
  77. & TYPOBJ ,IENT1,XVALRE ,CHARRE,LOGR1 ,ID1 )
  78. IF (IERR.NE.0) RETURN
  79.  
  80. if (TYPOBJ .eq. 'FLOTTANT') then
  81. if (CHACRE .eq. 'MAXI') then
  82. BMAX = .TRUE.
  83. elseif (CHACRE .eq. 'MINI') then
  84. BMAX = .FALSE.
  85. else
  86. CALL ERREUR(21)
  87. RETURN
  88. endif
  89.  
  90. ELSEIF(TYPOBJ .EQ. 'MMODEL')THEN
  91. C Verification que le MMODEL n'est pas deja dans le CCPRECO
  92. DO IIMOD = 1, NMOPAR
  93. IF (PESCLA(IIMOD) .EQ. 0) THEN
  94. C On sort
  95. GOTO 1
  96. ELSEIF (MTABLE .EQ. PESCLA(IIMOD)) THEN
  97. imodel = PARMOD(IIMOD)
  98. CALL ECROBJ(TYPOBJ,imodel)
  99. SEGSUP,SID
  100. SEGDES,MTABLE
  101. RETURN
  102. ENDIF
  103. ENDDO
  104. ENDIF
  105.  
  106. 1 CONTINUE
  107.  
  108. IF (TYPOBJ.EQ.'CHPOINT'.OR. TYPOBJ.EQ.'RIGIDITE' .OR.
  109. & TYPOBJ.EQ.'LOGIQUE'.OR. TYPOBJ.EQ.'MCHAML' .OR.
  110. & TYPOBJ.EQ.'MMODEL' .OR. TYPOBJ.EQ.'MAILLAGE' .OR.
  111. & TYPOBJ.EQ.'MATRIK' .OR. TYPOBJ.EQ.'FLOTTANT' ) THEN
  112.  
  113. C REMPLISSAGE DU SEGMENT SID POUR LA FUSION PAR TOURNOI
  114. NBENT = NBENT + 1
  115. SID.IPOINT(NBENT)= ID1
  116. SID.BVAL (NBENT)= LOGR1
  117. SID.XVAL (NBENT)= XVALRE
  118. SID.CHATYP = TYPOBJ
  119. CHA8 = TYPOBJ
  120.  
  121. IF (ML .GE. 4) THEN
  122. DO I=4,ML
  123. C La TABLE n'est plus SEGDES par acctab pour les ESCLAVES
  124. C* SEGACT,MTABLE
  125.  
  126. IND = i-2
  127. CALL ACCTAB(MTABLE,'ENTIER ',IND,0.D0,' ',.TRUE.,0,
  128. & TYPOBJ,IVALRE,XVALRE,CHARRE,LOGR2,ID2)
  129. IF (IERR.NE.0) RETURN
  130.  
  131. IF (TYPOBJ .NE. CHA8) THEN
  132. C ERREUR SI LES TYPES SONT DIFFERENTS ENTRE 2 INDICES DE LA TABLE ESCLAVE
  133. MOTERR(1:8 ) = CHA8
  134. MOTERR(9:16) = TYPOBJ
  135. CALL ERREUR(1045)
  136. SEGSUP,SID
  137. RETURN
  138. ENDIF
  139.  
  140. C REMPLISSAGE DU SEGMENT SID POUR LA FUSION PAR TOURNOI
  141. NBENT=NBENT + 1
  142. SID.IPOINT(NBENT)= ID2
  143. SID.BVAL(NBENT) = LOGR2
  144. SID.XVAL(NBENT) = XVALRE
  145. ENDDO
  146.  
  147. C LANCEMENT DE LA FUSION DES OBJETS
  148. C WRITE(IOIMP,*)'FUSION ENCLENCHEE DANS ETG : ',CHA8
  149. ID = SID
  150. CALL FUNOBJ(ID,ID1,XVALRE,LOGR1,BMAX)
  151. ENDIF
  152.  
  153. ELSE
  154. CC Donnez une TABLE de sous-type %m1:8
  155. MOTERR(1:8)='ESCLAVE '
  156. CALL ERREUR(-173)
  157. CC Le sous-type de la table est incorrect
  158. CALL ERREUR(648)
  159. RETURN
  160. ENDIF
  161.  
  162.  
  163. IF (TYPOBJ .EQ. 'LOGIQUE' ) THEN
  164. CALL ECRLOG(LOGR1)
  165.  
  166. ELSEIF (TYPOBJ .EQ. 'FLOTTANT') THEN
  167. CALL ECRREE(XVALRE)
  168.  
  169. ELSE
  170. CALL ECROBJ(TYPOBJ,ID1)
  171.  
  172. ENDIF
  173.  
  174. SEGSUP,SID
  175. SEGDES,MTABLE
  176. RETURN
  177.  
  178. ELSE
  179. call refus
  180.  
  181. ENDIF
  182.  
  183. RETURN
  184. END
  185.  
  186.  
  187.  
  188.  
  189.  

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