您所在位置：主题：各位帮忙看看我的问题！
llbbhq
[专家分：0] 发布于 2011-04-27 18:50:00
main.f90:
program main
USE VAR
IMPLICIT NONE
! DATA BETA /8*0/ DATA initializaion is not allowed
! When the variable is defined in a module,So:
INTEGER::I ! cycle index
REAL::GRA(DIM2)!GRADIENT
REAL::D(DIM2) !for use of d=-b
REAL::LD,PHO
REAL::K,ALPHA0,ALPHA
LOGICAL::ALIVE
LAMBDA=REAL(2)
BETA=(/(0.0,I=1,8)/)
OPEN(10,FILE="G:\lasso.txt") !write(t(matrix(temp,67,9)),"G:\\lasso.txt",ncolumns=9)
INQUIRE(FILE="G:\lasso.txt",EXIST=ALIVE)
IF(ALIVE) THEN
DO I=1,67
READ(10,*) X(I,:),Y(I)
END DO
ELSE
WRITE(*,*) "ERROR HAPPENS"
END IF
!REAL,EXTERNAL::GAM WHEN FUNCTION IS INCLUDED IN A MODULE,
!IT'S NOT NECESSARY TO DECLARE THIS FUNCTION IN EXTERNAL FORM
DO WHILE(.TRUE.)
GRA=-2*MATMUL(TRANSPOSE(X),Y-MATMUL(X,BETA))
D=-BETA
DO I=1,8
WRITE(*,*) D(I)
END DO
DO I=1,DIM2
WRITE(*,*) I
IF( ABS(BETA(I)-GRA(I))>LAMBDA) THEN
D(I)=-(GRA(I)-SIGN(LAMBDA,GRA(I)-BETA(I)))
END IF
END DO
LD=SQRT(SUM(D**2))
IF(LD.LT.0.01) EXIT
PHO=1/LD
K=0.0;ALPHA0=0.9
DO WHILE(.TRUE.)
ALPHA=PHO*ALPHA0**K
IF(GAM(BETA+ALPHA*D).LT.GAM(BETA)) EXIT
K=K+1
END DO
BETA=BETA+ALPHA*D
END DO
stop
end program main
VAR.F90 !模块
MODULE VAR
IMPLICIT NONE
INTEGER,PARAMETER::DIM1=67,DIM2=8
REAL::X(DIM1,DIM2),Y(DIM1),BETA(DIM2),LAMBDA
CONTAINS
REAL FUNCTION GAM(BETA2)
IMPLICIT NONE
REAL::BETA2(DIM2)
GAM=SUM((Y-MATMUL(X,BETA2))**2)+&
&LAMBDA*SUM(ABS(BETA2))
RETURN
END FUNCTION
END MODULE
这个程序是我自己写的一个算法的实现，具体含义不用去管它，我就是对程序中的几个问题不明白，这主要在中间的那个DO WHILE循环中：
1：BETA是个8维向量，已经初化到0。因此在第一次执行DO WHILE循环时，D中各元素应该全是0；其次，在接下来DO循环中的WRITE语句中，应该分别输出12345678（DIM2=8）。所以在执行程序时，结果应为：00000000（8个0）12345678……（忽略输出格式）。但在我的机子了跑的结果却是12345678……。
2：将3行D的输出程序简化为WRITE(*,*) D。理论上更改之后的输出应该与之前的输出一致，但跑出来的结果却是：345678……。
想了一天，不得其解，求高人指点。
program main
USE VAR
IMPLICIT NONE
! DATA BETA /8*0/ DATA initializaion is not allowed
! When the variable is defined in a module,So:
INTEGER::I ! cycle index
REAL::GRA(DIM2)!GRADIENT
REAL::D(DIM2) !for use of d=-b
REAL::LD,PHO
REAL::K,ALPHA0,ALPHA
LOGICAL::ALIVE
LAMBDA=REAL(2)
BETA=(/(0.0,I=1,8)/)
OPEN(10,FILE="G:\lasso.txt") !write(t(matrix(temp,67,9)),"G:\\lasso.txt",ncolumns=9)
INQUIRE(FILE="G:\lasso.txt",EXIST=ALIVE)
IF(ALIVE) THEN
DO I=1,67
READ(10,*) X(I,:),Y(I)
END DO
ELSE
WRITE(*,*) "ERROR HAPPENS"
END IF
!REAL,EXTERNAL::GAM WHEN FUNCTION IS INCLUDED IN A MODULE,
!IT'S NOT NECESSARY TO DECLARE THIS FUNCTION IN EXTERNAL FORM
DO WHILE(.TRUE.)
GRA=-2*MATMUL(TRANSPOSE(X),Y-MATMUL(X,BETA))
D=-BETA
DO I=1,8
WRITE(*,*) D(I)
END DO
DO I=1,DIM2
WRITE(*,*) I
IF( ABS(BETA(I)-GRA(I))>LAMBDA) THEN
D(I)=-(GRA(I)-SIGN(LAMBDA,GRA(I)-BETA(I)))
END IF
END DO
LD=SQRT(SUM(D**2))
IF(LD.LT.0.01) EXIT
PHO=1/LD
K=0.0;ALPHA0=0.9
DO WHILE(.TRUE.)
ALPHA=PHO*ALPHA0**K
IF(GAM(BETA+ALPHA*D).LT.GAM(BETA)) EXIT
K=K+1
END DO
BETA=BETA+ALPHA*D
END DO
stop
end program main
VAR.F90 !模块
MODULE VAR
IMPLICIT NONE
INTEGER,PARAMETER::DIM1=67,DIM2=8
REAL::X(DIM1,DIM2),Y(DIM1),BETA(DIM2),LAMBDA
CONTAINS
REAL FUNCTION GAM(BETA2)
IMPLICIT NONE
REAL::BETA2(DIM2)
GAM=SUM((Y-MATMUL(X,BETA2))**2)+&
&LAMBDA*SUM(ABS(BETA2))
RETURN
END FUNCTION
END MODULE
这个程序是我自己写的一个算法的实现，具体含义不用去管它，我就是对程序中的几个问题不明白，这主要在中间的那个DO WHILE循环中：
1：BETA是个8维向量，已经初化到0。因此在第一次执行DO WHILE循环时，D中各元素应该全是0；其次，在接下来DO循环中的WRITE语句中，应该分别输出12345678（DIM2=8）。所以在执行程序时，结果应为：00000000（8个0）12345678……（忽略输出格式）。但在我的机子了跑的结果却是12345678……。
2：将3行D的输出程序简化为WRITE(*,*) D。理论上更改之后的输出应该与之前的输出一致，但跑出来的结果却是：345678……。
想了一天，不得其解，求高人指点。