source: LMDZ6/trunk/tools/netcdf95/Variables/check_start_count.f90 @ 5087

Last change on this file since 5087 was 5084, checked in by Laurent Fairhead, 4 months ago

Reverting to r4065. Updating fortran standard broke too much stuff. Will do it by smaller chunks
AB, LF

File size: 2.6 KB
RevLine 
[4918]1module check_start_count_m
2
3  implicit none
4
5  private check_one_arg
6
7contains
8
9  subroutine check_start_count(name_calling, ncid, varid, start, count_nc, &
10       rank_values)
11
12    ! This procedure checks that:
13
14    ! - the size of start and count_nc equals the rank of the NetCDF variable;
15
16    ! - if count_nc is absent, the rank of values is lower than or
17    ! equal to the rank of the NetCDF variable.
18
19    use nf95_close_m, only: nf95_close
20    use nf95_inquire_variable_m, only: nf95_inquire_variable
[5084]21    use netcdf, only: nf90_noerr
[4918]22
23    character(len=*), intent(in):: name_calling ! name of calling procedure
24    integer, intent(in):: ncid, varid
25    integer, optional, intent(in):: start(:), count_nc(:)
26    integer, intent(in):: rank_values ! rank of argument "values"
27
28    ! Variables local to the procedure:
29    integer ncerr_not_opt, ndims
30
31    !-------------------
32
33    call nf95_inquire_variable(ncid, varid, ndims=ndims, ncerr=ncerr_not_opt)
34    if (ncerr_not_opt == nf90_noerr) then
35       call check_one_arg(name_calling, "start", ncid, varid, ndims, start)
36       call check_one_arg(name_calling, "count_nc", ncid, varid, ndims, &
37            count_nc)
38       if (.not. present(count_nc) .and. rank_values > ndims) then
39          print *, name_calling, ":"
40          print *, "varid = ", varid
41          print *, "Argument count_nc is absent and rank of argument values " &
42               // "is greater than rank of NetCDF variable"
43          print *, "rank of argument values: ", rank_values
44          print *, "rank of NetCDF variable: ", ndims
45          call nf95_close(ncid)
46          stop 1
47       end if
48    end if
49
50  end subroutine check_start_count
51
52  !**************************************************************
53
54  subroutine check_one_arg(name_calling, arg_name, ncid, varid, ndims, &
55       checked_arg)
56
57    use nf95_close_m, only: nf95_close
58
59    character(len=*), intent(in):: name_calling ! name of calling procedure
60    character(len=*), intent(in):: arg_name ! name of checked argument
61    integer, intent(in):: ncid, varid, ndims
62    integer, optional, intent(in):: checked_arg(:) ! start or count_nc
63
64    !-------------------
65
66    if (present(checked_arg)) then
67       if (size(checked_arg) /= ndims) then
68          print *, name_calling, ":"
69          print *, "varid = ", varid
70          print *, 'size of ' // arg_name // ' does not match rank of ' &
71               // 'NetCDF variable'
72          print *, 'size of ' // arg_name // " = ", size(checked_arg)
73          print *, "rank of NetCDF variable: ", ndims
74          call nf95_close(ncid)
75          stop 1
76       end if
77    end if
78
79  end subroutine check_one_arg
80
81end module check_start_count_m
Note: See TracBrowser for help on using the repository browser.