Télécharger ntap21.eso

Retour à la liste

Numérotation des lignes :

  1. C NTAP21 SOURCE CHAT 05/01/13 02:02:08 5004
  2. SUBROUTINE NTAP21(IVFP,IVFQ,IVLAMB,IVB,IBU,IBL,
  3. * NPDR,N,MCP,MCQ,M,MVDU,MVDL,ITI,ITK)
  4. *
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8(A-H,O-Z)
  7. REAL*8 NORMP,NORMPM
  8. LOGICAL ADMI,UNAD
  9. -INC CCOPTIO
  10. -INC CCREEL
  11. -INC SMLREEL
  12. -INC TMXMAT
  13. -INC SMLENTI
  14. POINTEUR MLREE4.MLREEL,MLREE5.MLREEL
  15. POINTEUR MLREE6.MLREEL,MLREE7.MLREEL,MLREE8.MLREEL
  16. *
  17. UNAD=.FALSE.
  18. VFPMIN=XGRAND
  19. NORMPM=XGRAND
  20. N11=N+1
  21. MLENT1=ITI
  22. MLENT2=ITK
  23. LDIM1=NPDR
  24. LDIM2=2
  25. SEGINI MXMAT,MXMA1
  26. MXMA2=MVDU
  27. MXMA3=MVDL
  28. SEGACT MXMA2,MXMA3
  29. DO 1 I=1,NPDR
  30. XMAT(I,1)=MXMA2.XMAT(MLENT1.LECT(I),MLENT2.LECT(I)-1)
  31. XMAT(I,2)=MXMA2.XMAT(MLENT1.LECT(I),MLENT2.LECT(I))
  32. MXMA1.XMAT(I,1)=MXMA3.XMAT(MLENT1.LECT(I),MLENT2.LECT(I)-1)
  33. MXMA1.XMAT(I,2)=MXMA3.XMAT(MLENT1.LECT(I),MLENT2.LECT(I))
  34. 1 CONTINUE
  35. MLREEL=IBU
  36. SEGACT MLREEL
  37. JG=PROG(/1)
  38. SEGINI MLREE6,MLREE7
  39. SEGINI MLREE4,MLREE5
  40. SEGINI MLREE2,MLREE3
  41. IBBU=MLREE2
  42. IBBL=MLREE3
  43. DO 2 I=0,(2**NPDR)-1
  44. ADMI=.TRUE.
  45. *
  46. * SAUVEGARDE DE IBU,IBL
  47. *
  48. MLREEL=IBU
  49. MLREE1=IBL
  50. SEGACT MLREEL,MLREE1
  51. DO 10 J=1,N11
  52. MLREE4.PROG(J)=PROG(J)
  53. MLREE5.PROG(J)=MLREE1.PROG(J)
  54. 10 CONTINUE
  55. *
  56. K=I
  57. JG=NPDR
  58. SEGINI MLENTI
  59. DO 3 J=NPDR-1,0,-1
  60. LECT(J+1)=INT(K/(2**J))
  61. K=K-(2**J)*LECT(J+1)
  62. 3 CONTINUE
  63. DO 4 J=1,NPDR
  64. MLREE4.PROG(MLENT1.LECT(J))=XMAT(J,LECT(J)+1)
  65. MLREE5.PROG(MLENT1.LECT(J))=MXMA1.XMAT(J,LECT(J)+1)
  66. 4 CONTINUE
  67. *
  68. * TEST SI IBU,IBL EST UN PT DUAL ADMISSIBLE
  69. *
  70. JG=MLREE4.PROG(/1)
  71. SEGINI MLREEL,MLREE1
  72. DO 41 J=1,N11
  73. PROG(J)=1.D0/MLREE4.PROG(J)
  74. MLREE1.PROG(J)=1.D0/MLREE5.PROG(J)
  75. 41 CONTINUE
  76. MXMA2=MCP
  77. MXMA3=MCQ
  78. CALL MATVE1(MXMA2.XMAT,PROG,M,N11,MLREE6.PROG,2)
  79. CALL MATVE1(MXMA3.XMAT,MLREE1.PROG,M,N11,MLREE7.PROG,2)
  80. MLREE8=IVB
  81. NORMP=0.D0
  82. DO 42 J=1,M
  83. DIF=MLREE6.PROG(J)+MLREE7.PROG(J)-MLREE8.PROG(J)
  84. IF(DIF.GT.0.D0)THEN
  85. IF(UNAD) GO TO 2
  86. ADMI=.FALSE.
  87. NORMP=NORMP+(DIF**2)
  88. ENDIF
  89. 42 CONTINUE
  90. *
  91. * CALCUL DE LA VALEUR DE LA FONCTION PRIMALE VFP DE X
  92. *
  93. IF(ADMI) THEN
  94. IF(IIMPI.EQ.1799)
  95. *WRITE(IOIMP,FMT='( '' POINT ADMISSIBLE '' )')
  96. MLREE6=IVFP
  97. MLREE7=IVFQ
  98. SEGACT MLREE6,MLREE7
  99. VFP=0.
  100. DO 5 J = 1,N11
  101. VFP=VFP+(PROG(J)*MLREE6.PROG(J))+
  102. * (MLREE1.PROG(J)*MLREE7.PROG(J))
  103. 5 CONTINUE
  104. UNAD=.TRUE.
  105. *
  106. * RECHERCHE DU MIN DE VFP POUR LES PTS ADMISSIBLES
  107. *
  108. IF(VFP.LT.VFPMIN) THEN
  109. VFPMIN=VFP
  110. DO 20 J=1,N11
  111. MLREE2.PROG(J)=MLREE4.PROG(J)
  112. MLREE3.PROG(J)=MLREE5.PROG(J)
  113. 20 CONTINUE
  114. ENDIF
  115. ENDIF
  116. *
  117. * RECHERCHE DU PT QUI RESPECTE AU MIEUX LES CONTRAINTES SI PAS DE SOL
  118. *
  119. IF(.NOT.UNAD)THEN
  120. IF(NORMP.LT.NORMPM) THEN
  121. NORMPM=NORMP
  122. DO 21 J=1,N11
  123. MLREE2.PROG(J)=MLREE4.PROG(J)
  124. MLREE3.PROG(J)=MLREE5.PROG(J)
  125. 21 CONTINUE
  126. ENDIF
  127. ENDIF
  128. 2 CONTINUE
  129. IF(.NOT.UNAD) THEN
  130. IF(IIMPI.EQ.1799)
  131. *WRITE(IOIMP,FMT='( '' PAS DE POINT ADMISSIBLE '' )')
  132. ENDIF
  133. MLREEL=IBBU
  134. MLREE1=IBBL
  135. MLREE2=IBU
  136. MLREE3=IBL
  137. SEGACT MLREEL,MLREE1,MLREE2,MLREE3
  138. DO 30 I=1,N11
  139. MLREE2.PROG(I)=PROG(I)
  140. MLREE3.PROG(I)=MLREE1.PROG(I)
  141. 30 CONTINUE
  142. IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='('' VALEURS DE X DANS ETAP21
  143. * = IBU :'',/,(1X,5E12.5))')(MLREE2.PROG(I),I=1,N11)
  144. IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='('' VALEURS DE X DANS ETAP21
  145. * = IBL :'',/,(1X,5E12.5))')(MLREE3.PROG(I),I=1,N11)
  146. RETURN
  147. END
  148.  
  149.  
  150.  
  151.  
  152.  

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