main Program

Uses

  • program~~main~14~~UsesGraph program~main~14 main FLAP FLAP program~main~14->FLAP module~pfio pFIO program~main~14->module~pfio mpi mpi program~main~14->mpi

Calls

program~~main~14~~CallsGraph program~main~14 main init init program~main~14->init mpi_finalize mpi_finalize program~main~14->mpi_finalize mpi_init mpi_init program~main~14->mpi_init proc~add_cli_options~2 add_cli_options program~main~14->proc~add_cli_options~2 proc~parse_cli_arguments parse_cli_arguments program~main~14->proc~parse_cli_arguments proc~run~14 run program~main~14->proc~run~14 add add proc~add_cli_options~2->add get get proc~parse_cli_arguments->get mpi_comm_rank mpi_comm_rank proc~run~14->mpi_comm_rank mpi_comm_size mpi_comm_size proc~run~14->mpi_comm_size none~add_dimension FileMetadata%add_dimension proc~run~14->none~add_dimension none~add_variable~2 FileMetadata%add_variable proc~run~14->none~add_variable~2 none~create_par NetCDF4_FileFormatter%create_par proc~run~14->none~create_par none~put_var~21 NetCDF4_FileFormatter%put_var proc~run~14->none~put_var~21 insert insert none~add_dimension->insert proc~mapl_return MAPL_Return none~add_dimension->proc~mapl_return none~add_variable~2->get at at none~add_variable~2->at begin begin none~add_variable~2->begin interface~mapl_assert MAPL_Assert none~add_variable~2->interface~mapl_assert next next none~add_variable~2->next none~get_const_value Variable%get_const_value none~add_variable~2->none~get_const_value none~get_dimensions Variable%get_dimensions none~add_variable~2->none~get_dimensions none~get_shape UnlimitedEntity%get_shape none~add_variable~2->none~get_shape none~insert~7 StringVariableMap%insert none~add_variable~2->none~insert~7 none~is_empty UnlimitedEntity%is_empty none~add_variable~2->none~is_empty none~add_variable~2->proc~mapl_return push_back push_back none~add_variable~2->push_back nf90_create nf90_create none~create_par->nf90_create none~create_par->proc~mapl_return proc~mapl_verify MAPL_Verify none~create_par->proc~mapl_verify none~put_var_real64_4 NetCDF4_FileFormatter%put_var_real64_4 none~put_var~21->none~put_var_real64_4

Variables

Type Attributes Name Initial
character(len=:), allocatable :: output_filename
integer :: ierror
integer :: im
integer :: lm
integer :: n_fields
type(command_line_interface) :: cli

Subroutines

subroutine add_cli_options(cli)

Arguments

Type IntentOptional Attributes Name
type(command_line_interface), intent(inout) :: cli

subroutine parse_cli_arguments(cli, im, lm, n_fields, output_filename)

Arguments

Type IntentOptional Attributes Name
type(command_line_interface), intent(inout) :: cli
integer, intent(out) :: im
integer, intent(out) :: lm
integer, intent(out) :: n_fields
character(len=:), intent(out), allocatable :: output_filename

subroutine run(im, lm, n_fields, output_filename)

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: im
integer, intent(in) :: lm
integer, intent(in) :: n_fields
character(len=*), intent(in) :: output_filename

Source Code

program main
   use MPI
   use FLAP
   use pFIO
   implicit none

   integer :: ierror
   type (command_line_interface) :: cli
   integer :: im
   integer :: lm
   integer :: n_fields
   character(:), allocatable :: output_filename

   call MPI_Init(ierror)

   call cli%init(description='potential reproducer of parallel netcdf problem on SCU12')
   call add_cli_options(cli)
   call parse_cli_arguments(cli, im, lm, n_fields, output_filename)

   call run(im, lm, n_fields, output_filename)
   
   call MPI_Finalize(ierror)

contains


   subroutine add_cli_options(cli)
      type (command_line_interface), intent(inout) :: cli

      call cli%add(switch='--im',  &
                  help='IM World', &
                  required=.true., &
                  act='store')

      call cli%add(switch='--lm',  &
                  help='# levels per field', &
                  required=.true., &
                  act='store')

      call cli%add(switch='--n_fields',  &
                  help='# of fields', &
                  required=.true., &
                  act='store')
      
      call cli%add(switch='-o',  &
                  help='output file name', &
                  required=.true., &
                  act='store')
   end subroutine add_cli_options

   subroutine parse_cli_arguments(cli, im, lm, n_fields, output_filename)
      type (command_line_interface), intent(inout) :: cli
      integer, intent(out) :: im
      integer, intent(out) :: lm
      integer, intent(out) :: n_fields
      character(:), allocatable, intent(out) :: output_filename


      character(1000) :: buffer
      call cli%get(switch='--im', val=im)
      call cli%get(switch='--lm', val=lm)
      call cli%get(switch='--n_fields', val=n_fields)
      call cli%get(switch='-o', val=buffer)
      output_filename = trim(buffer)

   end subroutine parse_cli_arguments


   subroutine run(im, lm, n_fields, output_filename)
      integer, intent(in) :: im
      integer, intent(in) :: lm
      integer, intent(in) :: n_fields
      character(*), intent(in) :: output_filename

      type (Netcdf4_Fileformatter) :: formatter
      type (FileMetadata) :: metadata
      real, allocatable :: field(:,:,:)

      integer :: jm
      integer :: j0, j1
      integer :: nj_local
      integer :: rank, npes, ierror
      integer :: j, n
      character(:), allocatable :: field_name
      character(3) :: field_idx_str

      call mpi_comm_size(MPI_COMM_WORLD, npes, ierror)
      call mpi_comm_rank(MPI_COMM_WORLD, rank, ierror)

      jm = im*6 ! pseudo cubed sphere
      call metadata%add_dimension('IM_WORLD', im)
      call metadata%add_dimension('JM_WORLD', jm)
      call metadata%add_dimension('LM', lm)

      do n = 1, n_fields
         write(field_idx_str,'(i3.3)') n
         field_name = 'field_' // field_idx_str
         call metadata%add_variable(field_name, Variable(pFIO_REAL32, dimensions='IM_WORLD,JM_WORLD,LM'))
      end do

      call formatter%create_par(output_filename, comm=MPI_COMM_WORLD)
      call formatter%write(metadata)

      j0 = 1 + rank*jm/npes
      j1 = (rank+1)*jm/npes
      nj_local = (j1 - j0) + 1
      allocate(field(im, nj_local, lm))

      do j = j0, j1
         field(:,j-j0+1,:) = j
      end do

      do n = 1, n_fields
         write(field_idx_str,'(i3.3)') n
         field_name = 'field_' // field_idx_str
         call formatter%put_var(field_name, field, start=[1,j0,1], count=[im,nj_local,lm])
      end do

      call formatter%close()
   end subroutine run

end program main