#undef I_AM_MAIN #include "MAPL_ErrLog.h" program main use MPI use FLAP use pFIO use MAPL_ErrorHandlingMod implicit none integer :: ierror, rc type (command_line_interface) :: cli integer :: im integer :: lm integer :: n_fields character(:), allocatable :: output_filename call MPI_Init(ierror) _VERIFY(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) _VERIFY(ierror) call mpi_comm_rank(MPI_COMM_WORLD, rank, ierror) _VERIFY(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