Fortran77から95への変換 下記のコードをFortran77から95形式に変換しなければなりません。 自分でも調べながらやってみたのですが、Fortran77の知識不足で上手くいきません。 急ぎで95形式のコードに書き換える必要があるので、お力添えを頂ければ幸いです。 何卒よろしくお願いします。 C C SPLINE METHOD C PARAMETER (MP=100,NW=20) DIMENSION X(0:MP),Y(0:MP),G(0:MP),H(0:MP) C OPEN(UNIT=5,FILE='./sp.dat') OPEN(UNIT=7,FILE='./spout.dat') C READ(5,*) N2 N=N2-2 DO 20 I=0,N+1 20 READ(5,*) X(I),Y(I) CALL SPL21(X,Y,G,H,N,MP) C DO 40 I=0,N+1 C 40 WRITE(6,*) X(I),Y(I),G(I),H(I) HH=(X(N+1)-X(0))/FLOAT(NW) DO 30 I=0,NW XX=X(0)+HH*I YY=SPL22(G,H,X,Y,XX,N,MP) WRITE(6,2000) XX,YY KH=0 DO 50 K=0,N+1 IF(ABS(X(K)-XX).LE.0.01) THEN WRITE(7,2100) XX,YY,Y(K) KH=1 ENDIF 50 CONTINUE IF(KH.EQ.0) WRITE(7,2100) XX,YY 30 CONTINUE STOP 2000 FORMAT(T2,'X=',F6.2,3X,'Y=',F7.4) 2100 FORMAT(T2,4F10.4) END C C CALCULATION OF F(X) WITH CUBIC SPLINE METHOD C FUNCTION SPL22(G,H,X,Y,XX,N,MP) DIMENSION X(0:MP),Y(0:MP),G(0:MP),H(0:MP) DO 10 I=1,N+1 IF(X(I-1).LE.XX.AND.XX.LE.X(I)) GO TO 20 10 CONTINUE 20 XI=XX-X(I-1) XL=X(I)-X(I-1) SPL22=Y(I-1)+XI*(G(I-1) 1 +0.5*XI*(H(I-1)+XI*(H(I)-H(I-1))/(3.0*XL))) RETURN END C C CALCULATION OF THE COEFFICIENTS C SUBROUTINE SPL21(X,Y,G,H,N,MP) PARAMETER (NP=100) DIMENSION A(NP,NP+1),X(0:MP),Y(0:MP),G(0:MP),H(0:MP) N1=N+1 DO 10 I=1,N DO 10 J=1,N 10 A(J,I)=0.0 DO 11 I=1,N XL=X(I)-X(I-1) XR=X(I+1)-X(I) 11 A(I,N1)=6.0*(Y(I-1)/XL-(XL+XR)/XL/XR*Y(I)+Y(I+1)/XR) A(1,1)=2.0*(X(2)-X(0)) A(1,2)=X(2)-X(1) A(N,N)=2.0*(X(N1)-X(N-1)) A(N,N-1)=X(N)-X(N-1) DO 12 I=2,N-1 A(I,I-1)=X(I)-X(I-1) A(I,I)=2.0*(X(I+1)-X(I-1)) 12 A(I,I+1)=X(I+1)-X(I) CALL GASJO(A,DET,N,NP) DO 13 I=1,N 13 H(I)=A(I,N1) H(0)=0.0 H(N1)=0.0 XL=X(1)-X(0) G(0)=(Y(1)-Y(0))/XL-XL*H(1)/6.0 DO 14 I=1,N1 14 G(I)=G(I-1)+0.5*(H(I)+H(I-1))*(X(I)-X(I-1)) RETURN END C C GAUSS-JORDAN METHOD C SUBROUTINE GASJO(A,DET,N,NP) C PARAMETER (MP=100) DIMENSION A(NP,NP+1),IP(MP),IN(MP,2) C IF(MP.LT.NP) THEN WRITE(6,*) 'MP should be, MP.GE.NP' STOP ENDIF C N1=N+1 DET=1.0 DO 5 J=1,N 5 IP(J)=0 DO 200 I=1,N T=0.0 DO 60 J=1,N IF(IP(J).EQ.1) GO TO 60 DO 59 K=1,N IF(IP(K).EQ.1) GO TO 59 TTX=ABS(A(J,K)) IF(T.GT.TTX) GO TO 59 IR=J IC=K T=TTX 59 CONTINUE 60 CONTINUE IF(I.EQ.1) TMAX=T IP(IC)=1 IF(IR.EQ.IC) GO TO 7 DET=-DET DO 8 L=1,N1 T=A(IR,L) A(IR,L)=A(IC,L) 8 A(IC,L)=T 7 IN(I,1)=IR IN(I,2)=IC PI=A(IC,IC) DET=DET*PI IF(ABS(PI)/TMAX.LT.1.E-6) GO TO 111 A(IC,IC)=1.0 DO 9 L=1,N1 9 A(IC,L)=A(IC,L)/PI DO 100 LI=1,N IF(LI.EQ.IC) GO TO 100 T=A(LI,IC) A(LI,IC)=0.0 DO 11 L=1,N1 11 A(LI,L)=A(LI,L)-A(IC,L)*T 100 CONTINUE 200 CONTINUE DO 13 I=1,N L=N-I+1 IF(IN(L,1).EQ.IN(L,2)) GO TO 13 JR=IN(L,1) JC=IN(L,2) DO 12 K=1,N T=A(K,JR) A(K,JR)=A(K,JC) A(K,JC)=T 12 CONTINUE 13 CONTINUE GO TO 9999 111 WRITE(6,2000) 2000 FORMAT(1H '*** MATRIX A IS SINGULAR ***') 9999 RETURN END

リンク(外部サイト)



スポンサードリンク