Télécharger enpapf.eso

Retour à la liste

Numérotation des lignes :

  1. C ENPAPF SOURCE FANDEUR 13/01/29 21:15:30 7683
  2. SUBROUTINE ENPAPF(MSOLUT,ITAB,IBBE1,IBBE2,IBBE3,IMEL,IRETOU,IFORM)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. C=====================================================================
  6. C LECTURE PAS A PAS D'UN MSOLUT: LECTURE D'UN NOUVEAU PAS
  7. C SUR LA BANDE IORES
  8. C APPELE PAR : ENSOLF
  9. C APPELLE : LFCDIE LFCDI2 CREPO1
  10. C ECRIT PAR : FARVACQUE-LENA
  11. C======================================================================
  12. -INC CCOPTIO
  13. -INC SMSOLUT
  14. -INC SMCHPOI
  15. -INC SMCHAML
  16. SEGMENT/ITAB/(TAB(N1),ITABB(N2))
  17. SEGMENT/ITBBE2/(ITABE2(NN))
  18. SEGMENT/ITBBE1/(ITABE1(NN))
  19. SEGMENT/ITBBE3/(ITABE3(3,N3))
  20. DIMENSION ILENA(10)
  21. DATA ZERO/0.D0/
  22. C======================================================================
  23. C
  24. IRETOU=0
  25. SEGACT MSOLUT
  26. NIPO1=MSOLIS(/1)-4
  27. SEGACT ITAB
  28. N1=TAB(/1)
  29. N2=ITABB(/1)
  30. CALL LFCDI2(IORES,N1,TAB,IRETOU,IFORM)
  31. IF(IRETOU.NE.0) GOTO 1000
  32. CALL LFCDIE(IORES,N2,ITABB,IRETOU,IFORM)
  33. IF(IRETOU.NE.0) GOTO 1000
  34. IF(IIMPI.EQ.5) WRITE(IOIMP,800)(TAB(I),I=1,N1)
  35. IF(IIMPI.EQ.5)WRITE(IOIMP,801)(ITABB(I),I=1,N2)
  36. 800 FORMAT(/' *** TAB ',(5E12.5))
  37. 801 FORMAT(' ITABB=',3I4,' IPOS DES ENREGISTREMENTS:',12I5)
  38. C
  39. ITBBE1=IBBE1
  40. ITBBE2=IBBE2
  41. ITBBE3=IBBE3
  42. DO 25 III=1,NIPO1
  43. NENRE=ITABB(4+III)-ITABB(3+III)
  44. ITABE1(2*III-1)=0
  45. IF(NENRE.EQ.0) GOTO 26
  46. ISOLIT=MSOLIT(III+4)
  47. IF(ISOLIT.NE.2) GOTO 200
  48. C CHPOINT +++++++++++++++++++++++++
  49. NSOUPO=NENRE
  50. NAT=1
  51. SEGINI MCHPOI
  52. ITABE1(2*III-1)=MCHPOI
  53. C les chpo contenus dans les objets de type solution sont diffus
  54. JATTRI(1)=1
  55. DO 102 I=1,NSOUPO
  56. J=ITABE2(III)+I
  57. NC=ITABE3(2,J)
  58. SEGINI MSOUPO
  59. N=ITABE3(1,J)
  60. SEGINI MPOVAL
  61. IPOVAL=MPOVAL
  62. L=N*NC
  63. CALL LFCDI2(IORES,L,VPOCHA,IRETOU,IFORM)
  64. IF(IRETOU.NE.0) GOTO 1000
  65. SEGDES MPOVAL,MSOUPO
  66. IPCHP(I)=MSOUPO
  67. 102 CONTINUE
  68. SEGDES MCHPOI
  69. GOTO26
  70. C
  71. 200 IF(ISOLIT.NE.5) GOTO 300
  72. C MCHAML ++++++++++++++++++++++++++
  73. WRITE(IOIMP,*) 'ENPAPF : ISOLIT = 5 MCHAML ==> CONTACTER SUPPORT'
  74. N1=NENRE
  75. L1 = 0
  76. N3 = 6
  77. SEGINI MCHELM
  78. ITABE1(2*III-1)=MCHELM
  79. DO 202 ISOU=1,N1
  80. J=ITABE2(III)+ISOU
  81. N2 =ITABE3(2,J)
  82. SEGINI,MCHAML
  83. ICHAML(ISOU) = MCHAML
  84. N1PTEL=ITABE3(1,J)
  85. N1EL =ITABE3(3,J)
  86. N2PTEL = 0
  87. N2EL = 0
  88. L=N1PTEL*N1EL
  89. DO k = 1, N2
  90. SEGINI MELVAL
  91. CALL LFCDI2(IORES,L,VELCHE,IRETOU,IFORM)
  92. IF(IRETOU.NE.0) GOTO 1000
  93. SEGDES MELVAL
  94. IELVAL(k)=MELVAL
  95. ENDDO
  96. SEGDES MCHAML
  97. 202 CONTINUE
  98. SEGDES MCHELM
  99. GOTO 26
  100. 300 CONTINUE
  101. 26 CONTINUE
  102. 25 CONTINUE
  103. C
  104. C CAS D UN MODE
  105. C
  106. IF(ITYSOL.NE.'MODE ') GOTO 12
  107. MSOLEN=MSOLIS(4)
  108. SEGACT MSOLEN
  109. IPAS=ISOLEN(/1)+1
  110. N=IPAS
  111. SEGADJ MSOLEN
  112. LVALM=5
  113. NIMOD= 3
  114. SEGINI MMODE
  115. ISOLEN(IPAS)=MMODE
  116. FMMODD(1)=TAB(3)
  117. FMMODD(2)=TAB(4)
  118. FMMODD(3)=TAB(5)
  119. FMMODD(4)=TAB(6)
  120. FMMODD(5)=TAB(7)
  121. IMMODD(1)=ITABB(1)
  122. IMMODD(2)=ITABB(2)
  123. IMMODD(3)=ITABB(3)
  124. SEGDES MMODE,MSOLEN
  125. GOTO 20
  126. C
  127. C CAS D UN DYNAMIQUE
  128. C
  129. 12 IF(ITYSOL.NE.'DYNAMIQU') GOTO 13
  130. MSOLRE=MSOLIS(1)
  131. SEGACT MSOLRE
  132. IPAS=SOLRE(/1)+1
  133. N=IPAS
  134. SEGADJ MSOLRE
  135. SOLRE(IPAS)=TAB(2)
  136. SEGDES MSOLRE
  137. C MSOLEN=MSOLIS(2)
  138. C SEGADJ MSOLEN
  139. C ISOLEN(IPAS)=ITABB(1)
  140. C SEGDES MSOLEN
  141. GOTO 20
  142. 13 CONTINUE
  143. GOTO 20
  144. C
  145. C DANS TOUS LES CAS
  146. C
  147. 20 CONTINUE
  148. IF(IPAS.EQ.1) GOTO 21
  149. IF(IMEL.EQ.0) GOTO21
  150. ITBBE2=IMEL
  151. NN=IPAS
  152. SEGADJ ITBBE2
  153. CALL CREPO1(ZERO,ZERO,ZERO,IPOIN)
  154. ITABE2(IPAS)=IPOIN
  155. 21 CONTINUE
  156. C
  157. DO 30 III=1,NIPO1
  158. MSOLEN=MSOLIS(4+III)
  159. IF(MSOLEN.EQ.0) GOTO 30
  160. SEGACT MSOLEN
  161. N=IPAS
  162. SEGADJ MSOLEN
  163. ISOLEN(IPAS)=ITABE1(2*III-1)
  164. SEGDES MSOLEN
  165. 30 CONTINUE
  166. C
  167. 1000 CONTINUE
  168. SEGDES MSOLUT
  169. RETURN
  170. END
  171.  
  172.  
  173.  

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