string 2 number [fortran] by 바죠

http://fortranwiki.org/fortran/show/strnum

! Convert numeric values to strings and vice-versa using internal file IO
program strnum
  implicit none
  character(len=25) :: str
  real :: num

  ! Convert a numeric value to a string using an internal write
  num = 3.14
  write (str, '(g12.5)') num
  print *, 'str: ', str                           ! str:   3.1400

  ! Convert a string to a numeric value using an internal read
  str = '17.2'
  read (str, '(g12.5)') num
  print *, 'num: ', num                           ! num:   17.20000
end program strnum



http://incredible.egloos.com/4836430


-----------------------------------------------------------------
       character(len=20) function str(k)
!      "Convert an integer to string."
       integer, intent(in) :: k
       write (str, *) k
       str = adjustl(str)
       end function str
!     And here is a test code:
       program x
       integer :: i
       character(len=20) :: str

       do i=1,100
           open(11, file='Output'//trim(str(i))//'.txt')
           write (11, *) i
           close (11)
       end do
       end program x

-----------------------------------------------------------------
!234567890
!      character(len=10) :: str = '1.23e1'
!      character(len=10) :: str = ' 1.23e1'
       character(len=10) :: str = ' 1.23e1 '
       real    :: a

!      str=adjustl(str)
       read(str,*) a
       print*, a
       stop
       end

-----------------------------------------------------------------

INTEGER FUNCTION fiCount_Fields(iUNITNUMBER)
!count the number of fields by counting the delimiters

INTEGER, INTENT(IN) :: iUNITNUMBER
CHARACTER (LEN = 20000):: miFIRSTLINE

READ(UNIT=iUNITNUMBER, FMT='(A)') miFIRSTLINE
REWIND(UNIT=iUNITNUMBER)
fiCount_Fields= fiCountF(',',TRIM(miFIRSTLINE)) + 1

END FUNCTION fiCount_Fields



INTEGER FUNCTION fiCountF(cLETTER, cSTRING)
! Count the number of occurrences of LETTER in STRING

CHARACTER (1), INTENT(IN) :: cLETTER
CHARACTER (*), INTENT(IN) :: cSTRING
INTEGER :: I

fiCountF = 0
DO I = 1, LEN(cSTRING)
IF (cSTRING(I:I) == cLETTER) fiCountF = fiCountF + 1
END DO

END FUNCTION fiCountF

-----------------------------------------------------------------

INTEGER FUNCTION fiCount_Fields(iUNITNUMBER)
IMPLICIT NONE
!count the number of fields by counting the delimiters

        INTEGER, INTENT(IN)  :: iUNITNUMBER
        CHARACTER (LEN = 20000):: miFIRSTLINE

        READ(UNIT=iUNITNUMBER, FMT='(A)') miFIRSTLINE
        REWIND(UNIT=iUNITNUMBER)
        fiCount_Fields= fiCountF(',',TRIM(miFIRSTLINE)) + 1

END FUNCTION fiCount_Fields


INTEGER FUNCTION fiCountF(cLETTER, cSTRING)
IMPLICIT NONE
! Count the number of occurrences of LETTER in STRING

        CHARACTER (1), INTENT(IN) :: cLETTER
        CHARACTER (*), INTENT(IN) :: cSTRING
        INTEGER :: I

        fiCountF = 0
        DO I = 1, LEN(cSTRING)
                IF (cSTRING(I:I) == cLETTER) fiCountF = fiCountF + 1
        END DO

END FUNCTION fiCountF


INTEGER FUNCTION fiCount_Rows(iUNITNUMBER)
IMPLICIT NONE
!count the number of rows in the file

        INTEGER, INTENT(IN)  :: iUNITNUMBER
        CHARACTER (LEN = 3)  :: cALINE

        REWIND(UNIT=iUNITNUMBER)

        fiCount_Rows= 0

        DO
          READ(UNIT=iUNITNUMBER, FMT='(A)',END=100) cALINE

          IF (TRIM(cALINE) .NE. '') THEN
                fiCount_Rows= fiCount_Rows + 1
          ELSE
                EXIT
          ENDIF

        END DO

        100 CONTINUE
          REWIND(UNIT=iUNITNUMBER)

END FUNCTION fiCount_Rows

-----------------------------------------------------------------

SUBROUTINE sOpen_DataFile(iUNITNUMBER)
IMPLICIT NONE
! prompt user to enter data file name

        INTEGER, INTENT(IN) :: iUNITNUMBER
        CHARACTER*20000 cFILENAME

        CLOSE(iUNITNUMBER)

        PRINT *, 'Enter the datafile name'
        PRINT *, 'it must be comma delimited'
        PRINT *, 'with the the prediction variable in the last column.'
        PRINT *, 'If it is in the same folder as this executable just type the name'
        PRINT *, '?'

        DO
                READ *, cFILENAME
                IF (cFILENAME == 'q' .or. cFILENAME == 'Q') STOP

                ! open data file
                OPEN(UNIT=iUNITNUMBER, ERR=100, FILE=cFILENAME, STATUS='OLD')

                ! File Opened OK so Exit
                EXIT

                ! File not found
                100 PRINT *, 'Cannot find file ' // TRIM(cFILENAME) // &
                ', re-enter or "Q" to quit'

        END DO

END SUBROUTINE sOpen_DataFile


-----------------------------------------------------------------

! Convert numeric values to strings and vice-versa using internal file IO
program strnum
  implicit none
  character(len=25) :: str
  real :: num

  ! Convert a numeric value to a string using an internal write
  num = 3.14
  write (str, '(g12.5)') num
  print *, 'str: ', str                           ! str: 3.1400

  ! Convert a string to a numeric value using an internal read
  str = '17.2'
  read (str, '(g12.5)') num
  print *, 'num: ', num                           ! num: 17.20000
end program strnum
http://fortranwiki.org/fortran/show/strnum

-----------------------------------------------------------------

http://www.sdsc.edu/~tkaiser/f90.html

 


     character (len=12)tmpstr
 
     write(tmpstr,"(a12)")(c_date(5:8)//c_time(1:4)//".dat") ! // does string concatination
     write(*,*)"name of file= ",tmpstr
     open(14,file=tmpstr)

     name of file= 03271114.dat


Creating a format statement at run time (array of integers and a real)
     ! test_vect is an array that we do not know its length until run time
     nstate=9 ! the size of the array
     write(fstr,'("(",i4,"i1,1x,f10.5)")')nstates
     write(*,*)"format= ",fstr
     write(*,fstr)test_vect,result

     format= (   9i1,1x,f10.5)


Reading from a string
    integer ht,minut,sec
    read(c_time,"(3i2)")hr,minut,sec

-----------------------------------------------------------------


!234567890
       subroutine readnext_r8(string, ipos, r8value)
       implicit none
       character(len=*), intent(in)    :: string
       integer,          intent(inout) :: ipos
       real*8,           intent(out)   :: r8value
       integer                         :: i1, i2

       i2 = len_trim(string)
!      initial r8value:
       if (ipos > i2) then
         ipos   = 0
         r8value = 0.0d0
         return
       end if
!      skip blanks:
       i1 = ipos
       do
        if (string(i1:i1) /= ' ') exit
        i1 = i1 + 1
       end do
!      read real r8value and set ipos:
       read(string(i1:i2), *) r8value
       ipos = scan(string(i1:i2), ' ')
       if (ipos == 0) then
          ipos = i2 + 1
       else
          ipos = ipos + i1 - 1
       end if
       end subroutine readnext_r8
!234567890
       subroutine readnext_i4(string, ipos, i4value)
       implicit none
       character(len=*), intent(in)    :: string
       integer,          intent(inout) :: ipos
       integer,          intent(out)   :: i4value
       integer                         :: i1, i2

       i2 = len_trim(string)
!      initial i4value:
       if (ipos > i2) then
         ipos   = 0
         i4value = 0
         return
       end if
!      skip blanks:
       i1 = ipos
       do
        if (string(i1:i1) /= ' ') exit
        i1 = i1 + 1
       end do
!      read real i4value and set ipos:
       read(string(i1:i2), *) i4value
       ipos = scan(string(i1:i2), ' ')
       if (ipos == 0) then
          ipos = i2 + 1
       else
          ipos = ipos + i1 - 1
       end if
       end subroutine readnext_i4
!234567890
       subroutine readnext_c(string, ipos, char1)
       implicit none
       character(len=*), intent(in)    :: string
       integer,          intent(inout) :: ipos
       character(len=*), intent(out)   :: char1
       integer                         :: i1, i2

       i2 = len_trim(string)
!      initial char1:
       if (ipos > i2) then
         ipos   = 0
         char1 =' '
         return
       end if
!      skip blanks:
       i1 = ipos
       do
        if (string(i1:i1) /= ' ') exit
        i1 = i1 + 1
       end do
!      read real char1 and set ipos:
       read(string(i1:i2), *) char1
       char1=adjustl(char1)
       char1=trim(char1)
       ipos = scan(string(i1:i2), ' ')
       if (ipos == 0) then
          ipos = i2 + 1
       else
          ipos = ipos + i1 - 1
       end if
       end subroutine readnext_c
!234567890
       program aaa
       implicit none
       integer i,ipos
       real*8 tmv(30)
       integer itmv(30)
       character*280 char1(30)
       character*280 string

       string=' 10   20   30  '
       ipos=1
       do i=1,4
       call readnext_i4(string, ipos, itmv(i))
       write(6,*) itmv(i),kind(itmv(i))
       enddo


       string=' 10.   2.0   .30  '
       ipos=1
       do i=1,4
       call readnext_r8(string, ipos, tmv(i))
       write(6,*) tmv(i),kind(tmv(i))
       enddo

       string=' a  bc  def   20   30  '
       ipos=1
       do i=1,4
       call readnext_c(string, ipos, char1(i))
       write(6,*) trim(char1(i)),kind(char1(i))
       enddo

       end program aaa
ifort -warn unused z.f90
[ihlee@KRISS-TUCANA a7]$ ./a.out
          10           4
          20           4
          30           4
           0           4
   10.0000000000000                8
   2.00000000000000                8
  0.300000000000000                8
  0.000000000000000E+000           8
 a           1
 bc           1
 def           1
 20           1
-----------------------------------------------------------------


-----------------------------------------------------------------


-----------------------------------------------------------------


-----------------------------------------------------------------



핑백

덧글

댓글 입력 영역

최근 포토로그



MathJax