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 :
© Cast3M 2003 - All rights reserved.
Disclaimer