Télécharger ntap17.eso

Retour à la liste

Numérotation des lignes :

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

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