program test_do

  !关于do循环

  !  循环次数计算公式：MAX((表达式2-表达式1+表达式3)/表达式3,0)

  !  表达式1代表循环变量的初值

  !  表达式2代表循环变量的终值

  !  表达式3代表循环变量的步长

  implicit none

  integer ::i,j,N

  integer ::trips

  real(8) ::dt,dt1,s,t,TStart,TEnd

  !fortran90中可以省略data关键字

  integer ::a(5)=(/1,2,3,4,5/)

  !integer ::(a(i),i=1,5)

  !整型变量循环测试

  N=max((6-1+1)/1,0)

  print *,\'循环次数=\',n

  do i=1,6

    write(*,\'(i3)\',ADVANCE=\'NO\') i

  enddo

  forall(i=1:4)

    j=i

    write(*,\'(i3)\',ADVANCE=\'NO\') j

  end forall

  print *, \'   \'

  N=MAX((6-1-2)/(-2),0)

  PRINT *,\'循环次数=\',n  

  do i=1,6,-2

    write(*,\'(i3)\',ADVANCE=\'NO\') i

  enddo

  !实型变量循环测试

  TStart=0.0d0

  TEnd=5.0d0

  dt=0.3d0

  do dt1=TStart,TEnd,dt

    write(*,*) \'   \'

    write(*,\'(f15.8)\',ADVANCE=\'NO\') dt1

  enddo

  print *, \'   \'

  trips=int((TEnd-TStart)/dt+spacing(DT))+1

  T=TStart

  do i=1,trips

    s=60.0d0*T-0.5d0*9.8d0*T*T

    print *, I,T,s

t=t+dt

  enddo

  print *, \'   \'

  !非确定性循环

  !do-enddo

  T=TStart

  do

if( t > TEnd) exit

    s=60.0d0*T-0.5d0*9.8d0*T*T

    print *, T,s

t=t+dt

  enddo

  print *, \'   \'

  !do while-enddo

  T=TStart

  do while(t <= TEnd)

    s=60.0d0*T-0.5d0*9.8d0*T*T

    PRINT *, T,s

t=t+dt

  enddo

  stop \'test_do ok!\'

end

  IMPLICIT NONE

  real(8),dimension(10000000) ::hh

  real(8),allocatable,dimension(:) ::xx

end module arr_test

program test

  IMPLICIT NONE

  integer n,i

  real(8),dimension(10000000) ::aa,ee

  real(8),allocatable,dimension(:) ::bb

  !read(*,*) n

  n=10000000

  allocate(bb(n))

  bb=1.0D0

  PRINT *,bb(5)

  deallocate(bb)

  aa=0.0d0

  PRINT *,aa(5)

  call TEST_ARR1(n,aa,ee)

  !PRINT *,CC(5)

  !PRINT *,DD(5)

  PRINT *,ee(5)

  STOP

  END

  subroutine test_ARR1(n,CC,FF)

    use arr_test

    IMPLICIT NONE

integer n

    !REAL(8),dimension(:) ::CC,FF

    !REAL(8),dimension(n) ::CC,FF

    REAL(8),dimension(10000000) ::CC,FF

    REAL(8),DIMENSION(10000000) ::DD

    real(8),allocatable,dimension(:) ::yy

FF=CC

hh=6.0d0

    PRINT *,CC(5)

    DD=2.0D0

    PRINT *,DD(5)

    PRINT *,FF(5)

    PRINT *,hh(5)

    allocate(xx(n))

      xx=7.0D0

      PRINT *,xx(5)

    deallocate(xx)

    allocate(yy(n))

      yy=8.0D0

      PRINT *,yy(5)

    deallocate(yy)

return

end

  implicit none

  integer ::i

  contains

  subroutine sub4(ARR2)

    implicit none

real(8),dimension(:) ::ARR2

    call sub5(ARR2)

contains

    subroutine sub5(ARR3)

      implicit none

   real(8),dimension(:) ::ARR3

      ARR3=19.0d0

    end subroutine sub5

  end subroutine sub4

end module test_contais

program test_contains

  !主程序(program)、子程序(subroutine)、函数(function)和模块(module)例程

  !     都可以含有内部子程序

  !

  !除模块例程可以含两层contains外，主程序、子程序和函数只能一层contains。

  use test_contais

  implicit none

  integer ::N,M

  real(8) ::real0

  real(8),dimension(10) ::ARROR0             !固定数组

  real(8),allocatable,dimension(:) ::ARROR1  !声明动态数组

  write(*,*) \'输入整形变量n和m=?\'

  read(*,*) N,M

  allocate (ARROR1(N))                        !给动态数组分配内存

  ARROR1=0.9D0

  print *, ARROR1

  deallocate (ARROR1)                         !将分配的内存释放掉

  call sub1(ARROR0)

  print *, ARROR0

  allocate (ARROR1(M))

  !如果动态数组不分配内存，是不对的

  call sub1(ARROR1)

  print *, ARROR1

  deallocate (ARROR1)

  call  sub2(real0)

  print *, real0

  call  sub4(ARROR0)

  print *, ARROR0

  stop \'test_contais ok!\'

  contains

  subroutine sub1(ARR2)

    implicit none

real(8),dimension(:) ::ARR2

    ARR2=9.0d0

  end subroutine sub1  

end program test_contains

subroutine sub2(real2)

  implicit none

  real(8) ::real2

  call sub3(real2)

  print *,real2

  return

  contains

  subroutine sub3(ARR2)

    implicit none

real(8) ::ARR2

    ARR2=9.0d0

return

  end subroutine sub3

end subroutine sub2  

program test_logical_type

  !implicit none

  integer,parameter :: MaxInt = 30

  !logical,dimension(MaxInt) ::wherr

  call sub1(MaxInt,wherr)

  print *,wherr

  stop

end program test_logical_type

  SUBROUTINE sub1(KL,wherr)

    implicit none

    integer ::KL

logical,dimension(KL) ::wherr

    integer ::i

    call sub2(KL,wherr)

return

  end SUBROUTINE sub1

  SUBROUTINE sub2(KL,wherr)

    implicit none

    integer ::KL

logical,dimension(KL) ::wherr

    integer ::i

do i=1,KL

   PRINT *, KL

   wherr(i)= .false.

enddo

return

  end SUBROUTINE sub2

    character(8)  :: Name

    integer  :: Num, NR, NB, NL, NSN, EN, NC, NN, NBN

  end type T_ModTopo

  CHARACTER*10 TITLE

  REAL(KIND=8) START, eSTOP

  LOGICAL(KIND=4) RESET

  INTEGER(KIND=4) INTERVAL

  type(T_ModTopo) :: Topo

  !program test_namelist_type

  NAMELIST /CONTROL/ TITLE, RESET, START, eSTOP, INTERVAL,Topo

  open(UNIT=1,file=\'read1.dat\')

  READ (UNIT=1, NML=CONTROL)

  !print *, TITLE, RESET, START, eSTOP, INTERVAL

  print *, Topo%Name

  print *, Topo%nr

  print *, Topo%nb

  print *, Topo%nl

  stop

  end  

  !end program test_namelist_type