Fortran程式設計 n!

2020-10-12 16:00:24
program main
    implicit none
    character(len=10)::str      !the longest string in the reading file-ten chars
    integer(4)::i,a,loc,err=0,
    real(16)::num=1q0
    
    print*,'Please write a number<1754 in the file FORTRAN_File-n!.in'
    print*,'negetive number and the decimal are both available,but you will receive an awarning.'
    
    open(300,file='FORTRAN_File-n!.in.txt',status='old',action='read',form='formatted')
    open(400,file='FORTRAN_File-n!.out.txt'.status='new',action='write',form='formatted')
    read(300,*)str
    str=adjustl(str)
    str=trim(str)                             !delete the blank
    a=len(str)
    
     do i=1,a
        if(str(i)<'0'.and.str(i)>9.and.str(i)/='+'.and.str(i)/='-'.and.str(i)/='.') err=1       !error type 1
     enddo
    
    loc=index(str,'+')
    if(loc>1)  err=1                                                !error type 1
    
    loc=index(str,'-')
    if(loc>1) err=1                                                 !error type 1
    
    if(str=='.')   err=1                                            !error type 1
    
    if(err/=1) then
        loc=index(str,'.')
        if(loc/=0) err=3                                            !error type 3
        str(loc)=' '
        loc=index(str,'.')
        if(loc>1)    err=1                                          !error type 1
    endif
    
    if(str(1)=='+'.and.(str(2)>='1'.and.str(2)<='9')) then       !transfer +xx to xx
        str(1)=' '
        str=adjustl(str)
        str=trim(str)
    endif
    a=len(str)
    
    if(str=='-') err=2                                              !error type 2
    
    if(num==0)  err=5                                               !not wrong,error type 5
    
    if(err==0)  then
        write(str,*)num              !start compute n!
        if(num>1754) err=4                                              !error type 4
        n=int(num)
        do i=n,1,-1
            num=num*i
        enddo
    endif
    
    select case(err)
    case(1)
        write(400,*)'error:the input is not a number,please modify your input'
    case(2)
        write(400,*)'warning:the input is a negetive number,please modify your input'
    case(3)
        write(400,*)'warning:the input is a decimal,please modify your input'
    case(4)
        write(400,*)'warning:the input is too large,please enter a number lower than 1754'
    case(5)
        write(400,*)'str=0  0!=1'
    case(0)
        write(400,'(A,2x,A,2x,I4,2x,A,2x,f43.0)')'str=',str,n,'!=',num
end program main