Télécharger ntap17.eso

Retour à la liste

Numérotation des lignes :

ntap17
  1. C NTAP17 SOURCE CHAT 05/01/13 02:02:03 5004
  2. SUBROUTINE NTAP17(IVFP,IVFQ,IVXU,IVXL,IVLAMB,IVB,IBU,IBL,VF0,
  3. * NDR,N,MCP,MCQ,M,XL,XLL,ILOG1,NPDR,MVDU,MVDL,ITI,ITK,VFPMAX,
  4. * IVN,IVD)
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8(A-H,O-Z)
  7.  
  8. -INC PPARAM
  9. -INC CCOPTIO
  10. -INC SMLREEL
  11. -INC TMXMAT
  12. -INC SMLENTI
  13. POINTEUR MLREE4.MLREEL,MLREE5.MLREEL
  14. POINTEUR MLREE6.MLREEL,MLREE7.MLREEL
  15. LOGICAL ILOG1
  16. N11=N+1
  17. VFPMAX=-1.D-20
  18. MLENT1=ITI
  19. MLENT2=ITK
  20. LDIM1=NPDR
  21. LDIM2=2
  22. SEGINI MXMAT,MXMA3
  23. MXMA1=MVDU
  24. MXMA2=MVDL
  25. DO 1 I=1,NPDR
  26. XMAT(I,1)=MXMA1.XMAT(MLENT1.LECT(I),MLENT2.LECT(I)-1)
  27. XMAT(I,2)=MXMA1.XMAT(MLENT1.LECT(I),MLENT2.LECT(I))
  28. MXMA3.XMAT(I,1)=MXMA2.XMAT(MLENT1.LECT(I),MLENT2.LECT(I)-1)
  29. MXMA3.XMAT(I,2)=MXMA2.XMAT(MLENT1.LECT(I),MLENT2.LECT(I))
  30. 1 CONTINUE
  31. * SAUVEGARDE DE IVXU,IVXL
  32. MLREEL=IVXU
  33. MLREE1=IVXL
  34. MLREE6=IVFP
  35. MLREE7=IVFQ
  36. SEGACT MLREEL,MLREE1,MLREE6,MLREE7
  37. JG=PROG(/1)
  38. SEGINI MLREE4,MLREE5
  39. IBBU=MLREE4
  40. IBBL=MLREE5
  41. SEGINI MLREE2,MLREE3
  42. IBU=MLREE2
  43. IBL=MLREE3
  44. DO 2 I=0,(2**NPDR)-1
  45. DO 10 J=1,JG
  46. MLREE4.PROG(J)=PROG(J)
  47. MLREE5.PROG(J)=MLREE1.PROG(J)
  48. 10 CONTINUE
  49. *
  50. ******** CONVERSION DE I EN BINAIRE **************
  51. *
  52. K=I
  53. JG=NPDR
  54. SEGINI MLENTI
  55. DO 3 J=NPDR-1,0,-1
  56. LECT(J+1)=INT(K/(2**J))
  57. K=K-(2**J)*LECT(J+1)
  58. 3 CONTINUE
  59. *
  60. *** DANS MLENTI(I) ON A LE CODAGE: 0 POUR X(K-1) POUR LA VARIABLE I
  61. * : 1 POUR X(K)
  62. * QUI N'EST PAS FIXEE
  63. *
  64. DO 4 J=1,NPDR
  65. MLREE4.PROG(MLENT1.LECT(J))=XMAT(J,LECT(J)+1)
  66. MLREE5.PROG(MLENT1.LECT(J))=MXMA3.XMAT(J,LECT(J)+1)
  67. 4 CONTINUE
  68. *
  69. * CALCUL DE LA VALEUR DE LA FONCTION PRIMALE VFP DE X
  70. *
  71. VFP=0.
  72. DO 5 J = 1,N11
  73. X1=MLREE4.PROG(J)
  74. X2=MLREE5.PROG(J)
  75. IF(MLREE4.PROG(J).LT.1.D-15) X1=1.D-15
  76. IF(MLREE5.PROG(J).LT.1.D-15) X2=1.D-15
  77. VFP=VFP+(MLREE6.PROG(J)/X1)+(MLREE7.PROG(J)/X2)
  78. 5 CONTINUE
  79. *
  80. *RECHERCHE DU MAX DE VFP AUTOUR DU POINT COURANT
  81. *
  82. IF(VFP.GT.VFPMAX) THEN
  83. VFPMAX=VFP
  84. DO 20 J=1,N11
  85. MLREE2.PROG(J)=MLREE4.PROG(J)
  86. MLREE3.PROG(J)=MLREE5.PROG(J)
  87. 20 CONTINUE
  88. ENDIF
  89. 2 CONTINUE
  90. MLREE2=IBU
  91. MLREE3=IBL
  92. SEGACT MLREE2,MLREE3
  93. IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='('' VALEURS DE X APRES SELECT
  94. *ION = IBU :'',/,(1X,5E12.5))')(MLREE2.PROG(I),I=1,N11)
  95. IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='('' VALEURS DE X APRES SELECT
  96. *ION = IBL :'',/,(1X,5E12.5))')(MLREE3.PROG(I),I=1,N11)
  97. *
  98. ************************************************************************
  99. *
  100. XLL=XL
  101. XL=0.D0
  102. MLREEL=IVN
  103. MLREE1=IVD
  104. MLREE4=IVXU
  105. MLREE5=IVXL
  106. SEGACT MLREEL,MLREE1,MLREE4,MLREE5
  107. DO 6 I = 1,N11
  108. X1=MLREE4.PROG(J)
  109. X2=MLREE5.PROG(J)
  110. IF(MLREE4.PROG(J).LT.1.D-15) X1=1.D-15
  111. IF(MLREE5.PROG(J).LT.1.D-15) X2=1.D-15
  112. XL=XL +(PROG(I)/X1)+(MLREE1.PROG(I)/X2)
  113. 6 CONTINUE
  114. MLREEL=IVB
  115. MLREE1=IVLAMB
  116. DO 7 I=1,M
  117. XL=XL+PROG(I)*MLREE1.PROG(I)
  118. 7 CONTINUE
  119. *
  120. ILOG1=.FALSE.
  121. IF( XL.GT.VFPMAX) THEN
  122. ILOG1= .TRUE.
  123. ELSE
  124. IF( XLL.LT.XL)THEN
  125. ILOG1=.TRUE.
  126. ENDIF
  127. ENDIF
  128. IF( NDR.EQ.0) THEN
  129. ILOG1=.TRUE.
  130. ENDIF
  131. NDR=NDR + 1
  132. RETURN
  133. END
  134.  
  135.  

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