Télécharger resmmo.eso

Retour à la liste

Numérotation des lignes :

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

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