Télécharger evtemp.eso

Retour à la liste

Numérotation des lignes :

  1. C EVTEMP SOURCE JC220346 16/04/25 21:15:07 8915
  2. SUBROUTINE EVTEMP(LCOUL)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. ************************************************************************
  6. * NOM : EVRESU
  7. * DESCRIPTION : Evolution temporelle d'un resultat de calcul pour un
  8. * ensemble de noeuds et un ensemble d'instants donnes
  9. ************************************************************************
  10. * APPELE PAR : evol.eso
  11. ************************************************************************
  12. * SYNTAXE (GIBIANE) :
  13. *
  14. * EVOL1 = EVOL (|COUL1 |) 'TEMP' |LCHP1 LREE1| (LIPDT1) --------+
  15. * |LCOUL1| |TAB1 (MOT1)| |
  16. * |
  17. * +--------------------------+
  18. * |
  19. * +---> |COMP1 | |POIN1 | ;
  20. * |LCOMP1 | |MAIL1 |
  21. * |N1 N2 N3|
  22.  
  23. ************************************************************************
  24. -INC CCOPTIO
  25. -INC SMELEME
  26. -INC SMTABLE
  27. -INC SMLENTI
  28. -INC SMLMOTS
  29. *
  30. POINTEUR LCOMP.MLMOTS
  31. POINTEUR LCOUL.MLENTI
  32. CHARACTER*4 CHA4
  33. CHARACTER*8 CHA8,CHB8
  34. CHARACTER*32 CH32
  35. CHARACTER*72 CH72
  36. LOGICAL ZLOGI
  37. *
  38. *
  39. * SI ON EST DANS LE CAS D'UNE VARIABLE DE TYPE MCHAML DANS UNE TABLE
  40. * PASAPAS => BRANCHEMENT VERS EVTEM1 (ANCIENNE SUBROUTINE EVTEMP
  41. * REBAPTISEE DEPUIS)
  42. LCH32=0
  43. CALL LIROBJ('TABLE',ITAB1,0,IRETOU)
  44. IF (IRETOU.EQ.0) GOTO 1
  45. CHA8=' '
  46. CALL ACCTAB(ITAB1,'MOT',0,0.D0,'SOUSTYPE',.TRUE.,0,
  47. & CHA8,IVAL,XVAL,CHB8,ZLOGI,ITAB2)
  48. IF (CHA8.NE.'MOT') THEN
  49. MOTERR(1:8)='TABLE'
  50. CALL ERREUR(302)
  51. RETURN
  52. ENDIF
  53. IF (CHB8.NE.'PASAPAS') GOTO 1
  54. CALL LIRCHA(CH32,0,LCH32)
  55. IF (LCH32.EQ.0) GOTO 1
  56. CHA8=' '
  57. CALL ACCTAB(ITAB1,'MOT',0,0.D0,CH32(1:LCH32),.TRUE.,0,
  58. & 'TABLE',IVAL,XVAL,CHB8,ZLOGI,ITAB2)
  59. IF (IERR.NE.0) RETURN
  60. MTABLE=ITAB2
  61. SEGACT,MTABLE
  62. IF (MTABTV(1).NE.'MCHAML') GOTO 1
  63. * => APPEL A EVTEM1
  64. SEGACT,LCOUL
  65. ICOUL=LCOUL.LECT(1)
  66. SEGDES,LCOUL
  67. CALL ECRCHA(CH32)
  68. CALL ECROBJ('TABLE',ITAB1)
  69. CALL EVTEM1(ICOUL)
  70. RETURN
  71. *
  72. *
  73. 1 CONTINUE
  74. IF (LCH32.GT.0) CALL ECRCHA(CH32)
  75. IF (IRETOU.NE.0) CALL ECROBJ('TABLE',ITAB1)
  76. *
  77. *
  78. *
  79. *
  80. * +---------------------------------------------------------------+
  81. * | |
  82. * | L E C T U R E D E S A R G U M E N T S |
  83. * | |
  84. * +---------------------------------------------------------------+
  85. *
  86. *
  87. * ===============
  88. * SIGNAL D'ENTREE
  89. * ===============
  90. *
  91. ITYP=0
  92. CALL LIRRES(ILCHP1,1,ITYP,CH32,NCH,1,ILREE1)
  93. IF (IERR.NE.0) RETURN
  94. *
  95. *
  96. * =====================
  97. * LISTE DES COMPOSANTES
  98. * =====================
  99. *
  100. LCOMP=0
  101. CALL LIROBJ('LISTMOTS',LCOMP,0,ILCOMP)
  102. IF (ILCOMP.EQ.0) THEN
  103. CALL LIRCHA(CHA4,0,LCH4)
  104. IF (LCH4.GT.0) THEN
  105. JGN=4
  106. JGM=1
  107. SEGINI,LCOMP
  108. LCOMP.MOTS(1)=CHA4
  109. SEGDES,LCOMP
  110. ENDIF
  111. ENDIF
  112. *
  113. *
  114. * =========
  115. * GEOMETRIE
  116. * =========
  117. *
  118. * OBJET DE TYPE POINT
  119. CALL LIROBJ('POINT',IPO1,0,IRET)
  120. IF (IRET.NE.0) THEN
  121. NBNN=1
  122. NBELEM=1
  123. NBSOUS=0
  124. NBREF=0
  125. SEGINI,MELEME
  126. ITYPEL=1
  127. NUM(1,1)=IPO1
  128. IMA1=MELEME
  129. ELSE
  130. *
  131. * OBJET DE TYPE MAILLAGE
  132. CALL LIROBJ('MAILLAGE',IMA1,0,IRET)
  133.  
  134. * OBJET DE TYPE INCOMPATIBLE
  135. IF (IRET.EQ.0) THEN
  136. MOTERR(1:40)='POINT MAILLAGE'
  137. CALL ERREUR(471)
  138. RETURN
  139. ENDIF
  140. *
  141. ENDIF
  142. *
  143. *
  144. * +---------------------------------------------------------------+
  145. * | |
  146. * | C O N S T R U C T I O N D E L ' E V O L U T I O N |
  147. * | |
  148. * +---------------------------------------------------------------+
  149. *
  150. *
  151. CH72=' '
  152. CALL CREVLC(ILREE1,ILCHP1,IMA1,LCOMP,LCOUL,CH72,IEVOL1)
  153. IF (IERR.NE.0) RETURN
  154. *
  155. IF (ILCOMP.EQ.0.AND.LCOMP.GT.0) SEGSUP,LCOMP
  156. *
  157. CALL ECROBJ('EVOLUTIO',IEVOL1)
  158. *
  159. RETURN
  160. *
  161. END
  162. *
  163. *
  164.  

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