Line data    Source code

       1              : module test_gyre_mod
       2              : 
       3              :    use const_def, only: dp, mesa_dir
       4              :    use gyre_mesa_m
       5              : 
       6              :    implicit none
       7              : 
       8              : contains
       9              : 
      10            1 :    subroutine do_test()
      11              : 
      12            1 :       real(dp), allocatable :: global_data(:)
      13            1 :       real(dp), allocatable :: point_data(:, :)
      14              :       integer               :: version
      15              : 
      16              :       integer  :: ipar(1)
      17            2 :       real(dp) :: rpar(1)
      18              : 
      19              :       ! Initialize
      20              : 
      21            1 :       call init('gyre.in')
      22              : 
      23            1 :       call set_constant('GYRE_DIR', TRIM(mesa_dir)//'/gyre/gyre')
      24              : 
      25              :       ! Read a model from file
      26              : 
      27            1 :       call read_model('model.dat')
      28              : 
      29              :       ! Find modes
      30              : 
      31            1 :       call get_modes(0, user_sub, ipar, rpar)
      32            1 :       call get_modes(1, user_sub, ipar, rpar)
      33              : 
      34            1 :       write (*, *) 'done file model'
      35              : 
      36              :       ! Load a model into memory
      37              : 
      38            1 :       call load_model('model.dat', global_data, point_data, version)
      39              : 
      40            1 :       call set_model(global_data, point_data, version)
      41              : 
      42              :       ! Find modes
      43              : 
      44            1 :       call get_modes(0, user_sub, ipar, rpar)
      45            1 :       call get_modes(1, user_sub, ipar, rpar)
      46              : 
      47            1 :       write (*, *) 'done memory model'
      48              : 
      49            1 :    end subroutine do_test
      50              : 
      51           68 :    subroutine user_sub(md, ipar, rpar, retcode)
      52              : 
      53              :       type(mode_t), intent(in) :: md
      54              :       integer, intent(inout)   :: ipar(:)
      55              :       real(dp), intent(inout)  :: rpar(:)
      56              :       integer, intent(out)     :: retcode
      57              : 
      58              :       ! Print out mode info
      59              : 
      60           68 :       write (*, *) md%md_p%l, md%n_p, md%n_g, md%n_pg, REAL(md%freq('UHZ')), md%E_norm()
      61              : 
      62           68 :       retcode = 0
      63              : 
      64           68 :    end subroutine user_sub
      65              : 
      66            1 :    subroutine load_model(file, global_data, point_data, version)
      67              : 
      68              :       character(LEN=*), intent(in)       :: file
      69              :       real(dp), allocatable, intent(out) :: global_data(:)
      70              :       real(dp), allocatable, intent(out) :: point_data(:, :)
      71              :       integer, intent(out)               :: version
      72              : 
      73              :       integer :: unit
      74              :       integer :: n
      75              :       integer :: k
      76              :       integer :: k_chk
      77              : 
      78              :       ! Read a model from the MESA-format file
      79              : 
      80            1 :       open (NEWUNIT=unit, FILE=file, STATUS='OLD')
      81              : 
      82              :       ! Read the header
      83              : 
      84            1 :       allocate (global_data(3))
      85              : 
      86            1 :       read (unit, *) n, global_data, version
      87              : 
      88            2 :       select case (version)
      89              :       case (1)
      90            1 :          backspace (unit)
      91              :       case (19)
      92              :       case (100)
      93              :       case default
      94            1 :          stop 'Unrecognized MESA file version'
      95              :       end select
      96              : 
      97              :       ! Read the data
      98              : 
      99            1 :       allocate (point_data(18, n))
     100              : 
     101         1007 :       read_loop: do k = 1, n
     102         1006 :          read (unit, *) k_chk, point_data(:, k)
     103         1007 :          if (k /= k_chk) stop 'Index mismatch'
     104              :       end do read_loop
     105              : 
     106            1 :       close (unit)
     107              : 
     108            1 :    end subroutine load_model
     109              : 
     110              : end module test_gyre_mod
     111              : 
     112            1 : program test_gyre
     113              : 
     114            1 :    use test_gyre_mod
     115              : 
     116              :    implicit none
     117              : 
     118            1 :    call do_test()
     119              : 
     120            1 : end program test_gyre