Télécharger resmmo.eso

Retour à la liste

Numérotation des lignes :

  1. C RESMMO SOURCE PV 17/10/03 21:16:27 9581
  2.  
  3. SUBROUTINE RESMMO (ICOLAC,ITLACC,IMAX1,IDEB)
  4.  
  5. *--------------------------------------------------------------------*
  6. * *
  7. * Restauration des pointeurs issus de la pile des MODELEs. *
  8. * *
  9. *--------------------------------------------------------------------*
  10. C***********************************************************************
  11. C HISTORIQUE : 06/11/98 : rajout de la restitution de la table
  12. C pour le modele 'NAVIER_STOKES'
  13. C On ne fait pas comme MILL car on ne comprend pas
  14. C sa modification (en fait, on ne comprend pas
  15. C pourquoi elle n'est pas faite dans tous les
  16. C objets (cf. restch.eso pour les CHPOINTs))
  17. C
  18. C***********************************************************************
  19. IMPLICIT INTEGER(I-N)
  20. IMPLICIT REAL*8 (A-H,O-Z)
  21.  
  22. -INC CCOPTIO
  23. -INC SMMODEL
  24. -INC TMCOLAC
  25.  
  26. character*8 cmate
  27. character*8 ityp1
  28. *
  29. EXTERNAL LONG
  30. character*73 m_mode
  31. character*600 m_libe
  32. logical b_z
  33. *
  34. * Boucle sur les MODELEs contenus dans la pile:
  35. *
  36. ITLAC1 = KCOLA(1)
  37. ITLAC2 = KCOLA(10)
  38. ITLAC3 = KCOLA(40)
  39. ITLAC4 = KCOLA(29)
  40. DO 10 IEL=IDEB,IMAX1
  41. MMODEL = ITLAC(IEL)
  42. IF (MMODEL.EQ.0) GOTO 10
  43. SEGACT,MMODEL
  44. NSOUMO = KMODEL(/1)
  45. DO 20 ISOU=1,NSOUMO
  46. IMODEL=KMODEL(ISOU)
  47. IF (IMODEL.NE.0) THEN
  48. SEGACT,IMODEL*MOD
  49. IVA = IMAMOD
  50. IF (IVA.LT.0) IMAMOD = ITLAC1.ITLAC(ABS(IVA))
  51. C Point support DEFO.GENE.
  52. IVA = IPDPGE
  53. IF (IVA.LT.0) IPDPGE = ITLAC1.ITLAC(ABS(IVA))
  54. C cas 'NAVIER_STOKES' : INFMOD(2) contient une table
  55. NFOR=FORMOD(/2)
  56. MN3 =INFMOD(/1)
  57. do 715 iou=1,ivamod(/1)
  58. ityp1=tymode(iou)
  59. call typfil(ityp1,j)
  60. iva=abs(ivamod(iou))
  61. if(j.le.0) go to 715
  62. itlac5=KCOLA(J)
  63. if( ivamod(iou).le.0) ivamod(iou)=itlac5.itlac(iva)
  64. 715 continue
  65.  
  66. IF (NFOR.GT.0) THEN
  67. IF ((FORMOD(1).EQ.'NAVIER_STOKES') .OR.
  68. * (FORMOD(1).EQ.'DARCY').OR.
  69. * (FORMOD(1).EQ.'EULER')) THEN
  70. IF (MN3.GT.1) THEN
  71. IVA=ABS(INFMOD(2))
  72. IF(IVA.NE.0) INFMOD(2)=ITLAC2.ITLAC(IVA)
  73. ENDIF
  74. ENDIF
  75. do iou=3,mn3
  76. if(iou.ne.9.and.iou.ne.13) then
  77. if(infmod(iou).lt.0) then
  78. iva=abs(infmod(iou))
  79. if(iou.eq.14) then
  80. infmod(iou)=itlac4.itlac(iva)
  81. else
  82. infmod(iou)=itlac3.itlac(iva)
  83. endif
  84. endif
  85. endif
  86. enddo
  87. ENDIF
  88. if(mn3.lt.8.and.(formod(1).EQ.'MECANIQUE' .OR.
  89. & formod(1).EQ.'POREUX' .OR.
  90. & formod(1).EQ.'CHARGEMENT' ))then
  91. mn3=8
  92. nfor=formod(/2)
  93. nmat=matmod(/2)
  94. nobmod=ivamod(/1)
  95. segadj,imodel
  96. call prquoi(imodel)
  97.  
  98. * initialisation des nomid
  99. IF (FORMOD(1).NE.'NAVIER_STOKES'.AND.
  100. & FORMOD(1).NE.'EULER' .AND.
  101. & FORMOD(1).NE.'MELANGE' ) THEN
  102. if (CMATE.NE.'MODAL'.AND.CMATE.NE.'STATIQUE') then
  103. lucvar=0
  104. lucmat=0
  105. lucmaf=0
  106. luparx=0
  107. call inomid(imodel,' ',iret,lucvar,lucmat,
  108. & lucmaf,luparx)
  109. endif
  110. ENDIF
  111. endif
  112.  
  113. if (NFOR.eq.1) then
  114. nobmod = ivamod(/1)
  115. if (nobmod.eq.0) goto 200
  116. noblib = 0
  117. if (formod(1).NE.'MECANIQUE' .AND.
  118. & formod(1).NE.'POREUX') GOTO 210
  119. if (inatuu.ge.0) goto 200
  120. CALL PLACE(tymode,nobmod,noblib,'LMEEXT ')
  121. if (noblib.eq.0) goto 200
  122. goto 220
  123. 210 continue
  124. if (formod(1).NE.'DIFFUSION') goto 200
  125. CALL PLACE(tymode,nobmod,noblib,'LDIEXT ')
  126. if (noblib.eq.0) goto 200
  127. c* goto 220
  128. 220 continue
  129. m_ptre = ivamod(noblib+1)
  130. if (m_ptre.eq.0) then
  131. call erreur(21)
  132. return
  133. endif
  134. call queval(m_ptre,'MOT',ier,lgmot,r_z,m_libe,b_z,i_z)
  135. lglib = INDEX(m_libe,'=')-1
  136. m_mode = m_libe(lglib+2:lgmot)
  137. lglib = LONG(m_libe(1:lglib))
  138. m_libe = m_libe(1:lglib)//CHAR(0)
  139. lgmod = LONG(m_mode)
  140. m_mode = m_mode(1:lgmod)//CHAR(0)
  141. m_ptre = 0
  142. i_z = -1
  143. CALL PTRLOI(m_libe,lglib,m_mode,lgmod,i_z,m_ptre)
  144. if (m_ptre.le.0) thEN
  145. WRITE(ioimp,*) 'ERROR : Option LIB_LOI'
  146. call erreur(21)
  147. return
  148. endif
  149. ivamod(noblib) = m_ptre
  150. 200 continue
  151. endif
  152.  
  153. SEGDES,IMODEL
  154. ENDIF
  155. 20 CONTINUE
  156. SEGDES,MMODEL
  157. 10 CONTINUE
  158.  
  159. RETURN
  160. END
  161.  
  162.  
  163.  

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