END DO
WRITE(*,*) ' MESH SP MESH SP ' JE=0
DO I=1,NM JS=JE+1 JE=ME(I) SP=0
DO J=JS,JE K=ABS(NA(J)) READ(1,*) NP(K)
WRITE(*,*) 'I=',I,'NP(',K,')=',NP(K) SP(I)=SP(I)+NP(K) END DO
WRITE(*,*) I,SP(I) END DO
500 CONTINUE
IF(NF==0) GOTO 560
WRITE(*,*) 'COEFFICIENTS OF FAN'
WRITE(*,*) 'FAN A B C' DO I=1,NF IB=NK+1
K=ABS(BR(IB)) DO J=1,3
READ(1,*) X(J),FX(J) END DO
T1=X(1)-X(2) T2=X(2)-X(3) T3=X(3)-X(1)
C(I,1)=-(T1*FX(3)+T2*FX(1)+T3*FX(2))/(T1*T2*T3) C(I,2)=(FX(1)-FX(2))/T1-(X(1)+X(2))*C(I,1) C(I,3)=FX(1)-(C(I,1)*X(1)+C(I,2))*X(1) DD(IB)=X(2)
WRITE(*,12344) I,C(I,1),C(I,2),C(I,3) 12344 FORMAT(I3,3(1X,F10.4)) END DO
WRITE(*,*) 'INITIAL VALUES' 560 CONTINUE DO I=1,NN Q(I)=0 END DO JE=0
DO I=1,NM I2=I-NK
I3=I-(NK+NF)
IF(I2>0) GOTO 580 READ(1,*) DD(I) Q(I)=DD(I)
37
GOTO 595
580 IF(I3>0) GOTO 590 Q(I)=DD(I) GOTO 595
590 K=ME(I-1) M=NA(K+1) Q(M)=30 GOTO 600 595 M=I
600 JS=JE+2 JE=ME(I) DO J=JS,JE K=ABS(NA(J))
IF(NA(J)<=0) THEN Q(K)=Q(K)-Q(M) GOTO 620 END IF
Q(K)=Q(K)+Q(M) 620 CONTINUE END DO END DO
IB=NK+1 DO IT=1,MI
IF(NK==0) GOTO 650 JE=ME(NK) GOTO 655 650 JE=0 655 L=0 SD=0.0 DO I=IB,NM JS=JE+1 JE=ME(I) SH=-SP(I) SU=0.0
IF(KF<1) GOTO 695 IW=I-NK
HH(I)=(C(IW,1)*Q(I)+C(IW,2))*Q(I)+C(IW,3) DH=2*C(IW,1)*Q(I)+C(IW,2) SH=SH-HH(I) SU=SU-DH
695 CONTINUE DO J=JS,JE K=ABS(NA(J))
DH=R(K)*ABS(Q(K)) HH(J)=DH*Q(K) SU=SU+2*DH
38
IF(NA(J)<0) GOTO 715 SH=SH+HH(J) GOTO 720
715 SH=SH-HH(J) 720 CONTINUE END DO D=-SH/SU DO J=JS,JE K=ABS(NA(J))
IF(NA(J)<0) GOTO 750 Q(K)=Q(K)+D GOTO 755
750 Q(K)=Q(K)-D 755 CONTINUE END DO SD=SD+ABS(D)
IF(ABS(D) 775 CONTINUE END DO IF(L==0) GOTO 790 END DO WRITE(*,*) 'IT=',IT STOP 790 WRITE(*,12345) IT,SD 12345 FORMAT('IT=',I4,1X,'SigamQ=',F8.4) WRITE(*,*) ' BR J1- J2 R Q DO I=1,NN HH(I)=R(I)*ABS(Q(I))*Q(I) WRITE(*,12346) I,J1(I),J2(I),R(I),Q(I),HH(I) 12346 FORMAT(I3,1X,I3,'-',I3,1X,F8.4,1X,F8.4,1X,F8.4) END DO IF(NK==0) GOTO 885 WRITE(*,*) 'BR R Q SUM H' JE=0 DO I=1,NK JS=JE+2 JE=ME(I) SH=-SP(I) DO J=JS,JE K=ABS(NA(J)) IF(NA(J)<0) GOTO 865 SH=SH+HH(K) GOTO 870 865 SH=SH-HH(K) 870 CONTINUE END DO 39 H' R(I)=ABS(SH/Q(I)/Q(I)) WRITE(*,*) I,R(I),Q(I),SH END DO 885 CONTINUE IF(NF==0) GOTO 935 WRITE(*,*) 'FAN J1 J2 Q FQ' DO K=1,NF J=K+NK FQ(K)=(C(K,1)*Q(J)+C(K,2))*Q(J)+C(K,3) WRITE(*,12347) K,J1(J),J2(J),Q(J),FQ(K) 12347 FORMAT(3(I3,1X),2(F8.4,1X)) END DO 935 SH=0.0 DO I=1,NJ RR(I)=0.0 DO K=1,NN IF(J1(K)<>1) GOTO 955 RR(I)=RR(I)+Q(K) GOTO 965 955 CONTINUE IF(J2(K)<>1) GOTO 965 RR(I)=RR(I)-Q(K) 965 CONTINUE END DO IF(SH WRITE(*,*) 'MOST ERROR Q=',SH SH=0.0 DO I=KF+1,NM JS=ME(I-1)+1 JE=ME(I) DH=0.0 DO J=JS,JE K=ABS(NA(J)) IF(NA(J)<0) GOTO 1020 DH=DH+HH(K)-NP(K) GOTO 1025 1020 DH=DH-HH(K)-NP(K) 1025 CONTINUE END DO