Télécharger devso2.eso

Retour à la liste

Numérotation des lignes :

  1. C DEVSO2 SOURCE CHAT 05/01/12 22:47:25 5004
  2. SUBROUTINE DEVSO2(ITRES)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. *--------------------------------------------------------------------*
  6. * *
  7. * Op{rateur DYNE : algorithme de Fu - de Vogelaere *
  8. * ________________________________________________ *
  9. * *
  10. * Remplissage des CHPOINTs resultats. *
  11. * Sauvegarde des variables necessaires a une reprise de calcul *
  12. * *
  13. * Parametres: *
  14. * *
  15. * es ITRES Segment de sauvegarde des resultats *
  16. * *
  17. * Auteur, date de creation: *
  18. * *
  19. * Denis ROBERT-MOUGIN, le 1er juin 1989. *
  20. * *
  21. *--------------------------------------------------------------------*
  22. -INC CCOPTIO
  23. -INC SMCOORD
  24. -INC SMCHPOI
  25. *
  26. SEGMENT,MTRES
  27. REAL*8 XRES(NRES,NCRES,NPRES),XREP(NREP,NCRES)
  28. REAL*8 XRESLA(NLSA,NPRES,NVALA),XRESLB(NLSB,NPRES,NVALB)
  29. REAL*8 XMREP(NLIAB,4,IDIMB)
  30. INTEGER ICHRES(NVES),IPORES(NRES,NPRES),IPOREP(NREP)
  31. INTEGER IPOLA(NLSA),INULA(NLSA),IPLRLA(NLSA,NVALA)
  32. INTEGER IPOLB(NLSB),INULB(NLSB),IPLRLB(NLSB,NVALB)
  33. INTEGER ILIREA(NLSA,NTVAR),ILIREB(NLSB,NTVAR)
  34. INTEGER ILIRNA(NLSA,NTVAR),ILIRNB(NLSB,NTVAR)
  35. INTEGER IPOLR(1),IMREP(NLIAB,2),IPPREP(NLIAB,4)
  36. INTEGER ILPOLA(NLIAA,2)
  37. ENDSEGMENT
  38. *
  39. MTRES = ITRES
  40. NRES = XRES(/1)
  41. NREP = XREP(/1)
  42. NCRES = XRES(/2)
  43. NPRES = XRES(/3)
  44. NLIAB = XMREP(/1)
  45. IDIMB = XMREP(/3)
  46. *
  47. * Boucle sur les variables demandees, pour tous les pas
  48. * de sortie:
  49. *
  50. IRE2 = 0
  51. DO 10 IRES=1,8
  52. IF (ICHRES(IRES).NE.0) THEN
  53. IRE2 = IRE2 + 1
  54. DO 20 IPAS=1,NPRES
  55. MCHPOI = IPORES(IRE2,IPAS)
  56. NSOUPO = IPCHP(/1)
  57. DO 30 ISOUPO=1,NSOUPO
  58. MSOUPO = IPCHP(ISOUPO)
  59. MPOVAL = IPOVAL
  60. N1 = VPOCHA(/1)
  61. NC = VPOCHA(/2)
  62. INCO = 0
  63. DO 40 J=1,N1
  64. DO 50 I=1,NC
  65. INCO = INCO + 1
  66. VPOCHA(J,I) = XRES(IRE2,INCO,IPAS)
  67. 50 CONTINUE
  68. * end do
  69. 40 CONTINUE
  70. * end do
  71. SEGDES,MPOVAL,MSOUPO
  72. 30 CONTINUE
  73. * end do
  74. SEGDES,MCHPOI
  75. 20 CONTINUE
  76. * end do
  77. ENDIF
  78. 10 CONTINUE
  79. * end do
  80. *
  81. * Cas des CHPOINTs destines a la reprise de calcul:
  82. *
  83. DO 100 IREP=1,NREP
  84. MCHPOI = IPOREP(IREP)
  85. NSOUPO = IPCHP(/1)
  86. DO 110 ISOUPO=1,NSOUPO
  87. MSOUPO = IPCHP(ISOUPO)
  88. MPOVAL = IPOVAL
  89. N1 = VPOCHA(/1)
  90. NC = VPOCHA(/2)
  91. INCO = 0
  92. DO 120 J=1,N1
  93. DO 130 I=1,NC
  94. INCO = INCO + 1
  95. VPOCHA(J,I) = XREP(IREP,INCO)
  96. 130 CONTINUE
  97. * end do
  98. 120 CONTINUE
  99. * end do
  100. SEGDES,MPOVAL,MSOUPO
  101. 110 CONTINUE
  102. * end do
  103. SEGDES,MCHPOI
  104. 100 CONTINUE
  105. * end do
  106. *
  107. * Cas des variables de liaison necessaires a la reprise de calcul
  108. *
  109. IF (NLIAB.NE.0) THEN
  110. IDIM1 = IDIM + 1
  111. DO 200 I = 1,NLIAB
  112. ITYP = IMREP(I,1)
  113. IF (ITYP.EQ.3 .OR. ITYP.EQ.4 .OR. ITYP.EQ.5 .OR.
  114. & ITYP.EQ.6 .OR.
  115. & ITYP.EQ.13 .or. ityp.eq.-13 .or. ityp.eq.113
  116. & .OR. ITYP.EQ.14 .OR. ITYP.EQ.23 .OR.
  117. & ITYP.EQ.24 .OR. ITYP.EQ.33 .OR. ITYP.EQ.34) THEN
  118. DO 210 II = 1,3
  119. NUMPO = IPPREP(I,II)
  120. XCOOR(NUMPO * IDIM1) = 0.D0
  121. DO 210 ID = 1,IDIM
  122. XCOOR((NUMPO - 1) * IDIM1 + ID) = XMREP(I,II,ID)
  123. 210 CONTINUE
  124. * end do
  125. ELSE IF (ITYP.EQ.7) THEN
  126. DO 220 II = 1,3
  127. NUMPO = IPPREP(I,II)
  128. XCOOR(NUMPO * IDIM1) = 0.D0
  129. XCOOR((NUMPO - 1) * IDIM1 + 1) = XMREP(I,II,1)
  130. 220 CONTINUE
  131. * end do
  132. ELSE IF (ITYP.EQ.25 .OR. ITYP.EQ.26) THEN
  133. DO 230 II = 1,4
  134. NUMPO = IPPREP(I,II)
  135. XCOOR(NUMPO * IDIM1) = 0.D0
  136. DO 230 ID = 1,IDIM
  137. XCOOR((NUMPO - 1) * IDIM1 + ID) = XMREP(I,II,ID)
  138. 230 CONTINUE
  139. * end do
  140.  
  141. ENDIF
  142. 200 CONTINUE
  143. * end do
  144. ENDIF
  145. *
  146. END
  147.  
  148.  
  149.  
  150.  
  151.  
  152.  

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