Ignore:
Timestamp:
Oct 16, 2012, 2:41:50 PM (12 years ago)
Author:
Laurent Fairhead
Message:

Version testing basée sur la r1668

http://lmdz.lmd.jussieu.fr/utilisateurs/distribution-du-modele/versions-intermediaires

Testing release based on r1668

Location:
LMDZ5/branches/testing
Files:
6 edited
1 copied

Legend:

Unmodified
Added
Removed

  • LMDZ5/branches/testing

  • LMDZ5/branches/testing/libf/bibio/netcdf95.F90

    r1279 r1669  
    33
    44  ! Author: Lionel GUEZ
    5 
    6   ! Three criticisms may be made about the Fortran 90 NetCDF interface:
    7 
    8   ! -- NetCDF procedures are usually functions with side effects.
    9   ! First, they have "intent(out)" arguments.
    10   ! Furthermore, there is obviously data transfer inside the procedures.
    11   ! Any data transfer inside a function is considered as a side effect.
    12 
    13   ! -- The caller of a NetCDF procedure usually has to handle the error
    14   ! status. NetCDF procedures would be much friendlier if they behaved
    15   ! like the Fortran input/output statements. That is, the error status
    16   ! should be an optional output argument.
    17   ! If the caller does not request the error status and there is an
    18   ! error then the NetCDF procedure should produce an error message
    19   ! and stop the program.
    20 
    21   ! -- Some procedures use array arguments with assumed size.
    22   ! It would be better to use the pointer attribute.
    23 
    24   ! This module produces a NetCDF interface that answers those three
    25   ! criticisms for some (not all) procedures.
    26 
    27   ! "nf95_get_att" is more secure than "nf90_get_att" because it
    28   ! checks that the "values" argument is long enough and removes the
    29   ! null terminator, if any.
    30 
    31   ! This module replaces some of the official NetCDF procedures.
    32   ! This module also provides the procedures "handle_err" and "nf95_gw_var".
    33 
    34   ! This module provides only a partial replacement for some generic
    35   ! procedures such as "nf90_def_var".
     5  ! See:
     6  ! http://www.lmd.jussieu.fr/~lglmd/NetCDF95
    367
    378  use nf95_def_var_m
    389  use nf95_put_var_m
     10  use nf95_get_var_m
    3911  use nf95_gw_var_m
    4012  use nf95_put_att_m

  • LMDZ5/branches/testing/libf/bibio/nf95_get_att_m.F90

    r1279 r1669  
    11! $Id$
    22module nf95_get_att_m
     3
     4  use handle_err_m, only: handle_err
     5  use netcdf, only: nf90_get_att, nf90_noerr
     6  use simple, only: nf95_inquire_attribute
    37
    48  implicit none
    59
    610  interface nf95_get_att
    7      module procedure nf95_get_att_text
     11     module procedure nf95_get_att_text, nf95_get_att_one_FourByteInt
     12
     13     ! The difference between the specific procedures is the type of
     14     ! argument "values".
    815  end interface
    916
    … …  
    1522  subroutine nf95_get_att_text(ncid, varid, name, values, ncerr)
    1623
    17     use netcdf, only: nf90_get_att, nf90_inquire_attribute, nf90_noerr
    18     use handle_err_m, only: handle_err
    19 
    2024    integer,                          intent( in) :: ncid, varid
    2125    character(len = *),               intent( in) :: name
    … …  
    2327    integer, intent(out), optional:: ncerr
    2428
    25     ! Variable local to the procedure:
     29    ! Variables local to the procedure:
    2630    integer ncerr_not_opt
    2731    integer att_len
    … …  
    3034
    3135    ! Check that the length of "values" is large enough:
    32     ncerr_not_opt = nf90_inquire_attribute(ncid, varid, name, len=att_len)
    33     call handle_err("nf95_get_att_text nf90_inquire_attribute " &
    34          // trim(name), ncerr_not_opt, ncid, varid)
    35     if (len(values) < att_len) then
    36        print *, "nf95_get_att_text"
    37        print *, "varid = ", varid
    38        print *, "attribute name: ", name
    39        print *, 'length of "values" is not large enough'
    40        print *, "len(values) = ", len(values)
    41        print *, "number of characters in attribute: ", att_len
    42        stop 1
     36    call nf95_inquire_attribute(ncid, varid, name, nclen=att_len, &
     37         ncerr=ncerr_not_opt)
     38    if (ncerr_not_opt == nf90_noerr) then
     39       if (len(values) < att_len) then
     40          print *, "nf95_get_att_text"
     41          print *, "varid = ", varid
     42          print *, "attribute name: ", name
     43          print *, 'length of "values" is not large enough'
     44          print *, "len(values) = ", len(values)
     45          print *, "number of characters in attribute: ", att_len
     46          stop 1
     47       end if
    4348    end if
    4449
    … …  
    4853       ncerr = ncerr_not_opt
    4954    else
    50        call handle_err("nf95_get_att_text", ncerr_not_opt, ncid, varid)
     55       call handle_err("nf95_get_att_text " // trim(name), ncerr_not_opt, &
     56            ncid, varid)
    5157    end if
    5258
    … …  
    5864  end subroutine nf95_get_att_text
    5965
     66  !***********************
     67
     68  subroutine nf95_get_att_one_FourByteInt(ncid, varid, name, values, ncerr)
     69
     70    integer,                                    intent( in) :: ncid, varid
     71    character(len = *),                         intent( in) :: name
     72    integer ,               intent(out) :: values
     73    integer, intent(out), optional:: ncerr
     74
     75    ! Variables local to the procedure:
     76    integer ncerr_not_opt
     77    integer att_len
     78
     79    !-------------------
     80
     81    ! Check that the attribute contains a single value:
     82    call nf95_inquire_attribute(ncid, varid, name, nclen=att_len, &
     83         ncerr=ncerr_not_opt)
     84    if (ncerr_not_opt == nf90_noerr) then
     85       if (att_len /= 1) then
     86          print *, "nf95_get_att_one_FourByteInt"
     87          print *, "varid = ", varid
     88          print *, "attribute name: ", name
     89          print *, 'the attribute does not contain a single value'
     90          print *, "number of values in attribute: ", att_len
     91          stop 1
     92       end if
     93    end if
     94
     95    ncerr_not_opt = nf90_get_att(ncid, varid, name, values)
     96    if (present(ncerr)) then
     97       ncerr = ncerr_not_opt
     98    else
     99       call handle_err("nf95_get_att_one_FourByteInt " // trim(name), &
     100            ncerr_not_opt, ncid, varid)
     101    end if
     102
     103  end subroutine nf95_get_att_one_FourByteInt
     104
    60105end module nf95_get_att_m

  • LMDZ5/branches/testing/libf/bibio/nf95_gw_var_m.F90

    r1279 r1669  
    11! $Id$
    22module nf95_gw_var_m
     3
     4  use nf95_get_var_m, only: NF95_GET_VAR
     5  use simple, only: nf95_inquire_variable, nf95_inquire_dimension
    36
    47  implicit none
    … …  
    811     ! These procedures read a whole NetCDF variable (coordinate or
    912     ! primary) into an array.
    10      ! The difference between the procedures is the rank of the array
    11      ! and the type of Fortran values.
     13     ! The difference between the procedures is the rank and type of
     14     ! argument "values".
    1215     ! The procedures do not check the type of the NetCDF variable.
    1316
    14 !!$     module procedure nf95_gw_var_real_1d, nf95_gw_var_real_2d, &
    15 !!$          nf95_gw_var_real_3d, nf95_gw_var_real_4d, nf95_gw_var_dble_1d, &
    16 !!$          nf95_gw_var_dble_3d, nf95_gw_var_int_1d, nf95_gw_var_int_3d
     17     ! Not including double precision procedures in the generic
     18     ! interface because we use a compilation option that changes default
     19     ! real precision.
    1720     module procedure nf95_gw_var_real_1d, nf95_gw_var_real_2d, &
    18           nf95_gw_var_real_3d, nf95_gw_var_real_4d, nf95_gw_var_int_1d, &
    19           nf95_gw_var_int_3d
     21          nf95_gw_var_real_3d, nf95_gw_var_real_4d, nf95_gw_var_real_5d, &
     22          nf95_gw_var_int_1d, nf95_gw_var_int_3d
    2023  end interface
    2124
    … …  
    2932    ! Real type, the array has rank 1.
    3033
    31     use netcdf, only: NF90_GET_VAR
    32     use simple, only: nf95_inquire_variable, nf95_inquire_dimension
    33     use handle_err_m, only: handle_err
    34 
    3534    integer, intent(in):: ncid
    3635    integer, intent(in):: varid
    … …  
    3837
    3938    ! Variables local to the procedure:
    40     integer ierr, len
    41     integer, pointer :: dimids(:)
     39    integer nclen
     40    integer, pointer:: dimids(:)
    4241
    4342    !---------------------
    … …  
    4645
    4746    if (size(dimids) /= 1) then
    48        print *, "nf95_gw_var_real_1d: NetCDF variable is not of rank 1"
    49        stop 1
    50     end if
    51 
    52     call nf95_inquire_dimension(ncid, dimids(1), len=len)
    53     deallocate(dimids) ! pointer
    54 
    55     allocate(values(len))
    56     if (len /= 0) then
    57        ierr = NF90_GET_VAR(ncid, varid, values)
    58        call handle_err("NF90_GET_VAR", ierr, ncid, varid)
    59     end if
     47       print *, "nf95_gw_var_real_1d:"
     48       print *, "varid = ", varid
     49       print *, "rank of NetCDF variable is ", size(dimids), ", not 1"
     50       stop 1
     51    end if
     52
     53    call nf95_inquire_dimension(ncid, dimids(1), nclen=nclen)
     54    deallocate(dimids) ! pointer
     55
     56    allocate(values(nclen))
     57    if (nclen /= 0) call NF95_GET_VAR(ncid, varid, values)
    6058
    6159  end subroutine nf95_gw_var_real_1d
    … …  
    6765    ! Real type, the array has rank 2.
    6866
    69     use netcdf, only: NF90_GET_VAR
    70     use simple, only: nf95_inquire_variable, nf95_inquire_dimension
    71     use handle_err_m, only: handle_err
    72 
    7367    integer, intent(in):: ncid
    7468    integer, intent(in):: varid
    … …  
    7670
    7771    ! Variables local to the procedure:
    78     integer ierr, len1, len2
    79     integer, pointer :: dimids(:)
     72    integer nclen1, nclen2
     73    integer, pointer:: dimids(:)
    8074
    8175    !---------------------
    … …  
    8478
    8579    if (size(dimids) /= 2) then
    86        print *, "nf95_gw_var_real_2d: NetCDF variable is not of rank 2"
    87        stop 1
    88     end if
    89 
    90     call nf95_inquire_dimension(ncid, dimids(1), len=len1)
    91     call nf95_inquire_dimension(ncid, dimids(2), len=len2)
    92     deallocate(dimids) ! pointer
    93 
    94     allocate(values(len1, len2))
    95     if (len1 /= 0 .and. len2 /= 0) then
    96        ierr = NF90_GET_VAR(ncid, varid, values)
    97        call handle_err("NF90_GET_VAR", ierr, ncid, varid)
    98     end if
     80       print *, "nf95_gw_var_real_2d:"
     81       print *, "varid = ", varid
     82       print *, "rank of NetCDF variable is ", size(dimids), ", not 2"
     83       stop 1
     84    end if
     85
     86    call nf95_inquire_dimension(ncid, dimids(1), nclen=nclen1)
     87    call nf95_inquire_dimension(ncid, dimids(2), nclen=nclen2)
     88    deallocate(dimids) ! pointer
     89
     90    allocate(values(nclen1, nclen2))
     91    if (nclen1 /= 0 .and. nclen2 /= 0) call NF95_GET_VAR(ncid, varid, values)
    9992
    10093  end subroutine nf95_gw_var_real_2d
    … …  
    10699    ! Real type, the array has rank 3.
    107100
    108     use netcdf, only: NF90_GET_VAR
    109     use simple, only: nf95_inquire_variable, nf95_inquire_dimension
    110     use handle_err_m, only: handle_err
    111 
    112101    integer, intent(in):: ncid
    113102    integer, intent(in):: varid
    … …  
    115104
    116105    ! Variables local to the procedure:
    117     integer ierr, len1, len2, len3
    118     integer, pointer :: dimids(:)
     106    integer nclen1, nclen2, nclen3
     107    integer, pointer:: dimids(:)
    119108
    120109    !---------------------
    … …  
    123112
    124113    if (size(dimids) /= 3) then
    125        print *, "nf95_gw_var_real_3d: NetCDF variable is not of rank 3"
    126        stop 1
    127     end if
    128 
    129     call nf95_inquire_dimension(ncid, dimids(1), len=len1)
    130     call nf95_inquire_dimension(ncid, dimids(2), len=len2)
    131     call nf95_inquire_dimension(ncid, dimids(3), len=len3)
    132     deallocate(dimids) ! pointer
    133 
    134     allocate(values(len1, len2, len3))
    135     if (len1 * len2 * len3 /= 0) then
    136        ierr = NF90_GET_VAR(ncid, varid, values)
    137        call handle_err("NF90_GET_VAR", ierr, ncid, varid)
    138     end if
     114       print *, "nf95_gw_var_real_3d:"
     115       print *, "varid = ", varid
     116       print *, "rank of NetCDF variable is ", size(dimids), ", not 3"
     117       stop 1
     118    end if
     119
     120    call nf95_inquire_dimension(ncid, dimids(1), nclen=nclen1)
     121    call nf95_inquire_dimension(ncid, dimids(2), nclen=nclen2)
     122    call nf95_inquire_dimension(ncid, dimids(3), nclen=nclen3)
     123    deallocate(dimids) ! pointer
     124
     125    allocate(values(nclen1, nclen2, nclen3))
     126    if (nclen1 * nclen2 * nclen3 /= 0) call NF95_GET_VAR(ncid, varid, values)
    139127
    140128  end subroutine nf95_gw_var_real_3d
    … …  
    146134    ! Real type, the array has rank 4.
    147135
    148     use netcdf, only: NF90_GET_VAR
    149     use simple, only: nf95_inquire_variable, nf95_inquire_dimension
    150     use handle_err_m, only: handle_err
    151 
    152136    integer, intent(in):: ncid
    153137    integer, intent(in):: varid
    … …  
    155139
    156140    ! Variables local to the procedure:
    157     integer ierr, len_dim(4), i
    158     integer, pointer :: dimids(:)
     141    integer len_dim(4), i
     142    integer, pointer:: dimids(:)
    159143
    160144    !---------------------
    … …  
    163147
    164148    if (size(dimids) /= 4) then
    165        print *, "nf95_gw_var_real_4d: NetCDF variable is not of rank 4"
     149       print *, "nf95_gw_var_real_4d:"
     150       print *, "varid = ", varid
     151       print *, "rank of NetCDF variable is ", size(dimids), ", not 4"
    166152       stop 1
    167153    end if
    168154
    169155    do i = 1, 4
    170        call nf95_inquire_dimension(ncid, dimids(i), len=len_dim(i))
     156       call nf95_inquire_dimension(ncid, dimids(i), nclen=len_dim(i))
    171157    end do
    172158    deallocate(dimids) ! pointer
    173159
    174160    allocate(values(len_dim(1), len_dim(2), len_dim(3), len_dim(4)))
    175     if (all(len_dim /= 0)) then
    176        ierr = NF90_GET_VAR(ncid, varid, values)
    177        call handle_err("NF90_GET_VAR", ierr, ncid, varid)
    178     end if
     161    if (all(len_dim /= 0)) call NF95_GET_VAR(ncid, varid, values)
    179162
    180163  end subroutine nf95_gw_var_real_4d
    … …  
    182165  !************************************
    183166
     167  subroutine nf95_gw_var_real_5d(ncid, varid, values)
     168
     169    ! Real type, the array has rank 5.
     170
     171    integer, intent(in):: ncid
     172    integer, intent(in):: varid
     173    real, pointer:: values(:, :, :, :, :)
     174
     175    ! Variables local to the procedure:
     176    integer len_dim(5), i
     177    integer, pointer:: dimids(:)
     178
     179    !---------------------
     180
     181    call nf95_inquire_variable(ncid, varid, dimids=dimids)
     182
     183    if (size(dimids) /= 5) then
     184       print *, "nf95_gw_var_real_5d:"
     185       print *, "varid = ", varid
     186       print *, "rank of NetCDF variable is ", size(dimids), ", not 5"
     187       stop 1
     188    end if
     189
     190    do i = 1, 5
     191       call nf95_inquire_dimension(ncid, dimids(i), nclen=len_dim(i))
     192    end do
     193    deallocate(dimids) ! pointer
     194
     195    allocate(values(len_dim(1), len_dim(2), len_dim(3), len_dim(4), len_dim(5)))
     196    if (all(len_dim /= 0)) call NF95_GET_VAR(ncid, varid, values)
     197
     198  end subroutine nf95_gw_var_real_5d
     199
     200  !************************************
     201
    184202!!$  subroutine nf95_gw_var_dble_1d(ncid, varid, values)
    185203!!$
    186204!!$    ! Double precision, the array has rank 1.
    187 !!$
    188 !!$    use netcdf, only: NF90_GET_VAR
    189 !!$    use simple, only: nf95_inquire_variable, nf95_inquire_dimension
    190 !!$    use handle_err_m, only: handle_err
    191205!!$
    192206!!$    integer, intent(in):: ncid
    … …  
    195209!!$
    196210!!$    ! Variables local to the procedure:
    197 !!$    integer ierr, len
    198 !!$    integer, pointer :: dimids(:)
     211!!$    integer nclen
     212!!$    integer, pointer:: dimids(:)
    199213!!$
    200214!!$    !---------------------
    … …  
    203217!!$
    204218!!$    if (size(dimids) /= 1) then
    205 !!$       print *, "nf95_gw_var_dble_1d: NetCDF variable is not of rank 1"
    206 !!$       stop 1
     219!!$       print *, "nf95_gw_var_dble_1d:"
     220!!$       print *, "varid = ", varid
     221!!$       print *, "rank of NetCDF variable is ", size(dimids), ", not 1"
     222!!$        stop 1
    207223!!$    end if
    208224!!$
    209 !!$    call nf95_inquire_dimension(ncid, dimids(1), len=len)
     225!!$    call nf95_inquire_dimension(ncid, dimids(1), nclen=nclen)
    210226!!$    deallocate(dimids) ! pointer
    211227!!$
    212 !!$    allocate(values(len))
    213 !!$    if (len /= 0) then
    214 !!$       ierr = NF90_GET_VAR(ncid, varid, values)
    215 !!$       call handle_err("NF90_GET_VAR", ierr, ncid, varid)
    216 !!$    end if
     228!!$    allocate(values(nclen))
     229!!$    if (nclen /= 0) call NF95_GET_VAR(ncid, varid, values)
    217230!!$
    218231!!$  end subroutine nf95_gw_var_dble_1d
    … …  
    223236!!$
    224237!!$    ! Double precision, the array has rank 3.
    225 !!$
    226 !!$    use netcdf, only: NF90_GET_VAR
    227 !!$    use simple, only: nf95_inquire_variable, nf95_inquire_dimension
    228 !!$    use handle_err_m, only: handle_err
    229238!!$
    230239!!$    integer, intent(in):: ncid
    … …  
    233242!!$
    234243!!$    ! Variables local to the procedure:
    235 !!$    integer ierr, len1, len2, len3
    236 !!$    integer, pointer :: dimids(:)
     244!!$    integer nclen1, nclen2, nclen3
     245!!$    integer, pointer:: dimids(:)
    237246!!$
    238247!!$    !---------------------
    … …  
    241250!!$
    242251!!$    if (size(dimids) /= 3) then
    243 !!$       print *, "nf95_gw_var_dble_3d: NetCDF variable is not of rank 3"
     252!!$       print *, "nf95_gw_var_dble_3d:"
     253!!$       print *, "varid = ", varid
     254!!$       print *, "rank of NetCDF variable is ", size(dimids), ", not 3"
    244255!!$       stop 1
    245256!!$    end if
    246257!!$
    247 !!$    call nf95_inquire_dimension(ncid, dimids(1), len=len1)
    248 !!$    call nf95_inquire_dimension(ncid, dimids(2), len=len2)
    249 !!$    call nf95_inquire_dimension(ncid, dimids(3), len=len3)
     258!!$    call nf95_inquire_dimension(ncid, dimids(1), nclen=nclen1)
     259!!$    call nf95_inquire_dimension(ncid, dimids(2), nclen=nclen2)
     260!!$    call nf95_inquire_dimension(ncid, dimids(3), nclen=nclen3)
    250261!!$    deallocate(dimids) ! pointer
    251262!!$
    252 !!$    allocate(values(len1, len2, len3))
    253 !!$    if (len1 * len2 * len3 /= 0) then
    254 !!$       ierr = NF90_GET_VAR(ncid, varid, values)
    255 !!$       call handle_err("NF90_GET_VAR", ierr, ncid, varid)
    256 !!$    end if
     263!!$    allocate(values(nclen1, nclen2, nclen3))
     264!!$    if (nclen1 * nclen2 * nclen3 /= 0) call NF95_GET_VAR(ncid, varid, values)
    257265!!$
    258266!!$  end subroutine nf95_gw_var_dble_3d
    259 
     267!!$
    260268  !************************************
    261269
    … …  
    264272    ! Integer type, the array has rank 1.
    265273
    266     use netcdf, only: NF90_GET_VAR
    267     use simple, only: nf95_inquire_variable, nf95_inquire_dimension
    268     use handle_err_m, only: handle_err
    269 
    270274    integer, intent(in):: ncid
    271275    integer, intent(in):: varid
    … …  
    273277
    274278    ! Variables local to the procedure:
    275     integer ierr, len
    276     integer, pointer :: dimids(:)
     279    integer nclen
     280    integer, pointer:: dimids(:)
    277281
    278282    !---------------------
    … …  
    281285
    282286    if (size(dimids) /= 1) then
    283        print *, "nf95_gw_var_int_1d: NetCDF variable is not of rank 1"
    284        stop 1
    285     end if
    286 
    287     call nf95_inquire_dimension(ncid, dimids(1), len=len)
    288     deallocate(dimids) ! pointer
    289 
    290     allocate(values(len))
    291     if (len /= 0) then
    292        ierr = NF90_GET_VAR(ncid, varid, values)
    293        call handle_err("NF90_GET_VAR", ierr, ncid, varid)
    294     end if
     287       print *, "nf95_gw_var_int_1d:"
     288       print *, "varid = ", varid
     289       print *, "rank of NetCDF variable is ", size(dimids), ", not 1"
     290       stop 1
     291    end if
     292
     293    call nf95_inquire_dimension(ncid, dimids(1), nclen=nclen)
     294    deallocate(dimids) ! pointer
     295
     296    allocate(values(nclen))
     297    if (nclen /= 0) call NF95_GET_VAR(ncid, varid, values)
    295298
    296299  end subroutine nf95_gw_var_int_1d
    … …  
    302305    ! Integer type, the array has rank 3.
    303306
    304     use netcdf, only: NF90_GET_VAR
    305     use simple, only: nf95_inquire_variable, nf95_inquire_dimension
    306     use handle_err_m, only: handle_err
    307 
    308307    integer, intent(in):: ncid
    309308    integer, intent(in):: varid
    … …  
    311310
    312311    ! Variables local to the procedure:
    313     integer ierr, len1, len2, len3
    314     integer, pointer :: dimids(:)
     312    integer nclen1, nclen2, nclen3
     313    integer, pointer:: dimids(:)
    315314
    316315    !---------------------
    … …  
    319318
    320319    if (size(dimids) /= 3) then
    321        print *, "nf95_gw_var_int_3d: NetCDF variable is not of rank 3"
    322        stop 1
    323     end if
    324 
    325     call nf95_inquire_dimension(ncid, dimids(1), len=len1)
    326     call nf95_inquire_dimension(ncid, dimids(2), len=len2)
    327     call nf95_inquire_dimension(ncid, dimids(3), len=len3)
    328     deallocate(dimids) ! pointer
    329 
    330     allocate(values(len1, len2, len3))
    331     if (len1 * len2 * len3 /= 0) then
    332        ierr = NF90_GET_VAR(ncid, varid, values)
    333        call handle_err("NF90_GET_VAR", ierr, ncid, varid)
    334     end if
     320       print *, "nf95_gw_var_int_3d:"
     321       print *, "varid = ", varid
     322       print *, "rank of NetCDF variable is ", size(dimids), ", not 3"
     323       stop 1
     324    end if
     325
     326    call nf95_inquire_dimension(ncid, dimids(1), nclen=nclen1)
     327    call nf95_inquire_dimension(ncid, dimids(2), nclen=nclen2)
     328    call nf95_inquire_dimension(ncid, dimids(3), nclen=nclen3)
     329    deallocate(dimids) ! pointer
     330
     331    allocate(values(nclen1, nclen2, nclen3))
     332    if (nclen1 * nclen2 * nclen3 /= 0) call NF95_GET_VAR(ncid, varid, values)
    335333
    336334  end subroutine nf95_gw_var_int_3d

  • LMDZ5/branches/testing/libf/bibio/nf95_put_var_m.F90

    r1279 r1669  
    99          nf95_put_var_2D_FourByteReal, nf95_put_var_3D_FourByteReal, &
    1010          nf95_put_var_4D_FourByteReal
    11 !!$     module procedure nf95_put_var_1D_FourByteReal, &
    12 !!$          nf95_put_var_2D_FourByteReal, nf95_put_var_3D_FourByteReal, &
    13 !!$          nf95_put_var_4D_FourByteReal, nf90_put_var_1D_EightByteReal, &
    14 !!$          nf90_put_var_3D_EightByteReal
    1511  end interface
    1612
    … …  
    2521    use handle_err_m, only: handle_err
    2622
    27     integer, intent( in) :: ncid, varid
    28     real, intent( in) :: values
    29     integer, dimension(:), optional, intent( in) :: start
     23    integer, intent(in) :: ncid, varid
     24    real, intent(in) :: values
     25    integer, dimension(:), optional, intent(in) :: start
    3026    integer, intent(out), optional:: ncerr
    3127
    … …  
    5248    use handle_err_m, only: handle_err
    5349
    54     integer, intent( in) :: ncid, varid
    55     integer, intent( in) :: values
    56     integer, dimension(:), optional, intent( in) :: start
     50    integer, intent(in) :: ncid, varid
     51    integer, intent(in) :: values
     52    integer, dimension(:), optional, intent(in) :: start
    5753    integer, intent(out), optional:: ncerr
    5854
    … …  
    7470  !***********************
    7571
    76   subroutine nf95_put_var_1D_FourByteReal(ncid, varid, values, start, count, &
    77        stride, map, ncerr)
     72  subroutine nf95_put_var_1D_FourByteReal(ncid, varid, values, start, &
     73       count_nc, stride, map, ncerr)
    7874
    7975    use netcdf, only: nf90_put_var
    … …  
    8278    integer,                         intent(in) :: ncid, varid
    8379    real, intent(in) :: values(:)
    84     integer, dimension(:), optional, intent(in) :: start, count, stride, map
    85     integer, intent(out), optional:: ncerr
    86 
    87     ! Variable local to the procedure:
    88     integer ncerr_not_opt
    89 
    90     !-------------------
    91 
    92     ncerr_not_opt = nf90_put_var(ncid, varid, values, start, count, stride, &
    93          map)
     80    integer, dimension(:), optional, intent(in) :: start, count_nc, stride, map
     81    integer, intent(out), optional:: ncerr
     82
     83    ! Variable local to the procedure:
     84    integer ncerr_not_opt
     85
     86    !-------------------
     87
     88    ncerr_not_opt = nf90_put_var(ncid, varid, values, start, count_nc, &
     89         stride, map)
    9490    if (present(ncerr)) then
    9591       ncerr = ncerr_not_opt
    … …  
    10399  !***********************
    104100
    105   subroutine nf95_put_var_1D_FourByteInt(ncid, varid, values, start, count, &
    106        stride, map, ncerr)
     101  subroutine nf95_put_var_1D_FourByteInt(ncid, varid, values, start, &
     102       count_nc, stride, map, ncerr)
    107103
    108104    use netcdf, only: nf90_put_var
    … …  
    111107    integer,                         intent(in) :: ncid, varid
    112108    integer, intent(in) :: values(:)
    113     integer, dimension(:), optional, intent(in) :: start, count, stride, map
    114     integer, intent(out), optional:: ncerr
    115 
    116     ! Variable local to the procedure:
    117     integer ncerr_not_opt
    118 
    119     !-------------------
    120 
    121     ncerr_not_opt = nf90_put_var(ncid, varid, values, start, count, stride, &
    122          map)
     109    integer, dimension(:), optional, intent(in) :: start, count_nc, stride, map
     110    integer, intent(out), optional:: ncerr
     111
     112    ! Variable local to the procedure:
     113    integer ncerr_not_opt
     114
     115    !-------------------
     116
     117    ncerr_not_opt = nf90_put_var(ncid, varid, values, start, count_nc, &
     118         stride, map)
    123119    if (present(ncerr)) then
    124120       ncerr = ncerr_not_opt
    … …  
    132128  !***********************
    133129
    134   subroutine nf95_put_var_2D_FourByteReal(ncid, varid, values, start, count, &
    135        stride, map, ncerr)
    136 
    137     use netcdf, only: nf90_put_var
    138     use handle_err_m, only: handle_err
    139 
    140     integer,                         intent( in) :: ncid, varid
    141     real, intent( in) :: values(:, :)
    142     integer, dimension(:), optional, intent( in) :: start, count, stride, map
    143     integer, intent(out), optional:: ncerr
    144 
    145     ! Variable local to the procedure:
    146     integer ncerr_not_opt
    147 
    148     !-------------------
    149 
    150     ncerr_not_opt = nf90_put_var(ncid, varid, values, start, count, stride, &
    151          map)
     130  subroutine nf95_put_var_1D_EightByteReal(ncid, varid, values, start, &
     131       count_nc, stride, map, ncerr)
     132
     133    use typesizes, only: eightByteReal
     134    use netcdf, only: nf90_put_var
     135    use handle_err_m, only: handle_err
     136
     137    integer,                         intent(in) :: ncid, varid
     138    real (kind = EightByteReal),     intent(in) :: values(:)
     139    integer, dimension(:), optional, intent(in):: start, count_nc, stride, map
     140    integer, intent(out), optional:: ncerr
     141
     142    ! Variable local to the procedure:
     143    integer ncerr_not_opt
     144
     145    !-------------------
     146
     147    ncerr_not_opt = nf90_put_var(ncid, varid, values, start, count_nc, &
     148         stride, map)
     149    if (present(ncerr)) then
     150       ncerr = ncerr_not_opt
     151    else
     152       call handle_err("nf95_put_var_1D_eightByteReal", ncerr_not_opt, ncid, &
     153            varid)
     154    end if
     155
     156  end subroutine nf95_put_var_1D_EightByteReal
     157
     158  !***********************
     159
     160  subroutine nf95_put_var_2D_FourByteReal(ncid, varid, values, start, &
     161       count_nc, stride, map, ncerr)
     162
     163    use netcdf, only: nf90_put_var
     164    use handle_err_m, only: handle_err
     165
     166    integer,                         intent(in) :: ncid, varid
     167    real, intent(in) :: values(:, :)
     168    integer, dimension(:), optional, intent(in) :: start, count_nc, stride, map
     169    integer, intent(out), optional:: ncerr
     170
     171    ! Variable local to the procedure:
     172    integer ncerr_not_opt
     173
     174    !-------------------
     175
     176    ncerr_not_opt = nf90_put_var(ncid, varid, values, start, count_nc, &
     177         stride, map)
    152178    if (present(ncerr)) then
    153179       ncerr = ncerr_not_opt
    … …  
    161187  !***********************
    162188
    163   subroutine nf95_put_var_3D_FourByteReal(ncid, varid, values, start, count, &
    164        stride, map, ncerr)
    165 
    166     use netcdf, only: nf90_put_var
    167     use handle_err_m, only: handle_err
    168 
    169     integer,                         intent( in) :: ncid, varid
    170     real, intent( in) :: values(:, :, :)
    171     integer, dimension(:), optional, intent( in) :: start, count, stride, map
    172     integer, intent(out), optional:: ncerr
    173 
    174     ! Variable local to the procedure:
    175     integer ncerr_not_opt
    176 
    177     !-------------------
    178 
    179     ncerr_not_opt = nf90_put_var(ncid, varid, values, start, count, stride, &
    180          map)
     189  subroutine nf95_put_var_2D_EightByteReal(ncid, varid, values, start, &
     190       count_nc, stride, map, ncerr)
     191
     192    use typesizes, only: EightByteReal
     193    use netcdf, only: nf90_put_var
     194    use handle_err_m, only: handle_err
     195
     196    integer,                         intent(in) :: ncid, varid
     197    real (kind = EightByteReal), intent(in) :: values(:, :)
     198    integer, dimension(:), optional, intent(in) :: start, count_nc, stride, map
     199    integer, intent(out), optional:: ncerr
     200
     201    ! Variable local to the procedure:
     202    integer ncerr_not_opt
     203
     204    !-------------------
     205
     206    ncerr_not_opt = nf90_put_var(ncid, varid, values, start, count_nc, &
     207         stride, map)
     208    if (present(ncerr)) then
     209       ncerr = ncerr_not_opt
     210    else
     211       call handle_err("nf95_put_var_2D_EightByteReal", ncerr_not_opt, ncid, &
     212            varid)
     213    end if
     214
     215  end subroutine nf95_put_var_2D_EightByteReal
     216
     217  !***********************
     218
     219  subroutine nf95_put_var_3D_FourByteReal(ncid, varid, values, start, &
     220       count_nc, stride, map, ncerr)
     221
     222    use netcdf, only: nf90_put_var
     223    use handle_err_m, only: handle_err
     224
     225    integer,                         intent(in) :: ncid, varid
     226    real, intent(in) :: values(:, :, :)
     227    integer, dimension(:), optional, intent(in) :: start, count_nc, stride, map
     228    integer, intent(out), optional:: ncerr
     229
     230    ! Variable local to the procedure:
     231    integer ncerr_not_opt
     232
     233    !-------------------
     234
     235    ncerr_not_opt = nf90_put_var(ncid, varid, values, start, count_nc, &
     236         stride, map)
    181237    if (present(ncerr)) then
    182238       ncerr = ncerr_not_opt
    … …  
    190246  !***********************
    191247
    192   subroutine nf95_put_var_4D_FourByteReal(ncid, varid, values, start, count, &
    193        stride, map, ncerr)
    194 
    195     use netcdf, only: nf90_put_var
    196     use handle_err_m, only: handle_err
    197 
    198     integer,                         intent( in) :: ncid, varid
    199     real, intent( in) :: values(:, :, :, :)
    200     integer, dimension(:), optional, intent( in) :: start, count, stride, map
    201     integer, intent(out), optional:: ncerr
    202 
    203     ! Variable local to the procedure:
    204     integer ncerr_not_opt
    205 
    206     !-------------------
    207 
    208     ncerr_not_opt = nf90_put_var(ncid, varid, values, start, count, stride, &
    209          map)
     248  subroutine nf95_put_var_3D_EightByteReal(ncid, varid, values, start, &
     249       count_nc, stride, map, ncerr)
     250
     251    use typesizes, only: eightByteReal
     252    use netcdf, only: nf90_put_var
     253    use handle_err_m, only: handle_err
     254
     255    integer,                         intent(in) :: ncid, varid
     256    real (kind = EightByteReal),     intent(in) :: values(:, :, :)
     257    integer, dimension(:), optional, intent(in) :: start, count_nc, stride, map
     258    integer, intent(out), optional:: ncerr
     259
     260    ! Variable local to the procedure:
     261    integer ncerr_not_opt
     262
     263    !-------------------
     264
     265    ncerr_not_opt = nf90_put_var(ncid, varid, values, start, count_nc, &
     266         stride, map)
     267    if (present(ncerr)) then
     268       ncerr = ncerr_not_opt
     269    else
     270       call handle_err("nf95_put_var_3D_eightByteReal", ncerr_not_opt, ncid, &
     271            varid)
     272    end if
     273
     274  end subroutine nf95_put_var_3D_EightByteReal
     275
     276  !***********************
     277
     278  subroutine nf95_put_var_4D_FourByteReal(ncid, varid, values, start, &
     279       count_nc, stride, map, ncerr)
     280
     281    use netcdf, only: nf90_put_var
     282    use handle_err_m, only: handle_err
     283
     284    integer,                         intent(in) :: ncid, varid
     285    real, intent(in) :: values(:, :, :, :)
     286    integer, dimension(:), optional, intent(in) :: start, count_nc, stride, map
     287    integer, intent(out), optional:: ncerr
     288
     289    ! Variable local to the procedure:
     290    integer ncerr_not_opt
     291
     292    !-------------------
     293
     294    ncerr_not_opt = nf90_put_var(ncid, varid, values, start, count_nc, &
     295         stride, map)
    210296    if (present(ncerr)) then
    211297       ncerr = ncerr_not_opt
    … …  
    219305  !***********************
    220306
    221 !!$  subroutine nf90_put_var_1D_EightByteReal(ncid, varid, values, start, count, &
    222 !!$       stride, map, ncerr)
    223 !!$
    224 !!$    use typesizes, only: eightByteReal
    225 !!$    use netcdf, only: nf90_put_var
    226 !!$    use handle_err_m, only: handle_err
    227 !!$
    228 !!$    integer,                         intent( in) :: ncid, varid
    229 !!$    real (kind = EightByteReal),     intent( in) :: values(:)
    230 !!$    integer, dimension(:), optional, intent( in) :: start, count, stride, map
    231 !!$    integer, intent(out), optional:: ncerr
    232 !!$
    233 !!$    ! Variable local to the procedure:
    234 !!$    integer ncerr_not_opt
    235 !!$
    236 !!$    !-------------------
    237 !!$
    238 !!$    ncerr_not_opt = nf90_put_var(ncid, varid, values, start, count, stride, &
    239 !!$         map)
    240 !!$    if (present(ncerr)) then
    241 !!$       ncerr = ncerr_not_opt
    242 !!$    else
    243 !!$       call handle_err("nf95_put_var_1D_eightByteReal", ncerr_not_opt, ncid, &
    244 !!$            varid)
    245 !!$    end if
    246 !!$
    247 !!$  end subroutine nf90_put_var_1D_EightByteReal
    248 !!$
    249 !!$  !***********************
    250 !!$
    251 !!$  subroutine nf90_put_var_3D_EightByteReal(ncid, varid, values, start, count, &
    252 !!$       stride, map, ncerr)
    253 !!$
    254 !!$    use typesizes, only: eightByteReal
    255 !!$    use netcdf, only: nf90_put_var
    256 !!$    use handle_err_m, only: handle_err
    257 !!$
    258 !!$    integer,                         intent( in) :: ncid, varid
    259 !!$    real (kind = EightByteReal),     intent( in) :: values(:, :, :)
    260 !!$    integer, dimension(:), optional, intent( in) :: start, count, stride, map
    261 !!$    integer, intent(out), optional:: ncerr
    262 !!$
    263 !!$    ! Variable local to the procedure:
    264 !!$    integer ncerr_not_opt
    265 !!$
    266 !!$    !-------------------
    267 !!$
    268 !!$    ncerr_not_opt = nf90_put_var(ncid, varid, values, start, count, stride, &
    269 !!$         map)
    270 !!$    if (present(ncerr)) then
    271 !!$       ncerr = ncerr_not_opt
    272 !!$    else
    273 !!$       call handle_err("nf95_put_var_3D_eightByteReal", ncerr_not_opt, ncid, &
    274 !!$            varid)
    275 !!$    end if
    276 !!$
    277 !!$  end subroutine nf90_put_var_3D_EightByteReal
     307  subroutine nf95_put_var_4D_EightByteReal(ncid, varid, values, start, &
     308       count_nc, stride, map, ncerr)
     309
     310    use typesizes, only: EightByteReal
     311    use netcdf, only: nf90_put_var
     312    use handle_err_m, only: handle_err
     313
     314    integer, intent(in):: ncid, varid
     315    real(kind = EightByteReal), intent(in):: values(:, :, :, :)
     316    integer, dimension(:), optional, intent(in):: start, count_nc, stride, map
     317    integer, intent(out), optional:: ncerr
     318
     319    ! Variable local to the procedure:
     320    integer ncerr_not_opt
     321
     322    !-------------------
     323
     324    ncerr_not_opt = nf90_put_var(ncid, varid, values, start, count_nc, &
     325         stride, map)
     326    if (present(ncerr)) then
     327       ncerr = ncerr_not_opt
     328    else
     329       call handle_err("nf95_put_var_4D_EightByteReal", ncerr_not_opt, ncid, &
     330            varid)
     331    end if
     332
     333  end subroutine nf95_put_var_4D_EightByteReal
    278334
    279335end module nf95_put_var_m

  • LMDZ5/branches/testing/libf/bibio/simple.F90

    r1279 r1669  
    22module simple
    33
     4  use handle_err_m, only: handle_err
     5 
    46  implicit none
    57
     8  private handle_err
     9
    610contains
    711
    … …  
    913
    1014    use netcdf, only: nf90_open
    11     use handle_err_m, only: handle_err
    1215
    1316    character(len=*), intent(in):: path
    … …  
    3639
    3740    use netcdf, only: nf90_inq_dimid
    38     use handle_err_m, only: handle_err
    39 
    40     integer,             intent( in) :: ncid
    41     character (len = *), intent( in) :: name
     41
     42    integer,             intent(in) :: ncid
     43    character (len = *), intent(in) :: name
    4244    integer,             intent(out) :: dimid
    4345    integer, intent(out), optional:: ncerr
    … …  
    5254       ncerr = ncerr_not_opt
    5355    else
    54        call handle_err("nf95_inq_dimid", ncerr_not_opt, ncid)
     56       call handle_err("nf95_inq_dimid " // name, ncerr_not_opt, ncid)
    5557    end if
    5658
    … …  
    5961  !************************
    6062
    61   subroutine nf95_inquire_dimension(ncid, dimid, name, len, ncerr)
     63  subroutine nf95_inquire_dimension(ncid, dimid, name, nclen, ncerr)
    6264
    6365    use netcdf, only: nf90_inquire_dimension
    64     use handle_err_m, only: handle_err
    6566
    6667    integer,                       intent( in) :: ncid, dimid
    6768    character (len = *), optional, intent(out) :: name
    68     integer,             optional, intent(out) :: len
    69     integer, intent(out), optional:: ncerr
    70 
    71     ! Variable local to the procedure:
    72     integer ncerr_not_opt
    73 
    74     !-------------------
    75 
    76     ncerr_not_opt = nf90_inquire_dimension(ncid, dimid, name, len)
     69    integer,             optional, intent(out) :: nclen
     70    integer, intent(out), optional:: ncerr
     71
     72    ! Variable local to the procedure:
     73    integer ncerr_not_opt
     74
     75    !-------------------
     76
     77    ncerr_not_opt = nf90_inquire_dimension(ncid, dimid, name, nclen)
    7778    if (present(ncerr)) then
    7879       ncerr = ncerr_not_opt
    … …  
    8889
    8990    use netcdf, only: nf90_inq_varid
    90     use handle_err_m, only: handle_err
    9191
    9292    integer,             intent(in) :: ncid
    93     character (len = *), intent(in) :: name
     93    character(len=*), intent(in):: name
    9494    integer,             intent(out) :: varid
    9595    integer, intent(out), optional:: ncerr
    … …  
    115115
    116116    ! In "nf90_inquire_variable", "dimids" is an assumed-size array.
    117     ! This is the classical case of an array the size of which is
     117    ! This is not optimal.
     118    ! We are in the classical case of an array the size of which is
    118119    ! unknown in the calling procedure, before the call.
    119120    ! Here we use a better solution: a pointer argument array.
    … …  
    121122
    122123    use netcdf, only: nf90_inquire_variable, nf90_max_var_dims
    123     use handle_err_m, only: handle_err
    124124
    125125    integer, intent(in):: ncid, varid
    … …  
    151151       ncerr = ncerr_not_opt
    152152    else
    153        call handle_err("nf95_inquire_variable", ncerr_not_opt, ncid)
     153       call handle_err("nf95_inquire_variable", ncerr_not_opt, ncid, varid)
    154154    end if
    155155
    … …  
    161161   
    162162    use netcdf, only: nf90_create
    163     use handle_err_m, only: handle_err
    164163
    165164    character (len = *), intent(in   ) :: path
    … …  
    186185  !************************
    187186
    188   subroutine nf95_def_dim(ncid, name, len, dimid, ncerr)
     187  subroutine nf95_def_dim(ncid, name, nclen, dimid, ncerr)
    189188
    190189    use netcdf, only: nf90_def_dim
    191     use handle_err_m, only: handle_err
    192190
    193191    integer,             intent( in) :: ncid
    194192    character (len = *), intent( in) :: name
    195     integer,             intent( in) :: len
     193    integer,             intent( in) :: nclen
    196194    integer,             intent(out) :: dimid
    197195    integer, intent(out), optional :: ncerr
    … …  
    202200    !-------------------
    203201
    204     ncerr_not_opt = nf90_def_dim(ncid, name, len, dimid)
    205     if (present(ncerr)) then
    206        ncerr = ncerr_not_opt
    207     else
    208        call handle_err("nf95_def_dim", ncerr_not_opt, ncid)
     202    ncerr_not_opt = nf90_def_dim(ncid, name, nclen, dimid)
     203    if (present(ncerr)) then
     204       ncerr = ncerr_not_opt
     205    else
     206       call handle_err("nf95_def_dim " // name, ncerr_not_opt, ncid)
    209207    end if
    210208
    … …  
    216214
    217215    use netcdf, only: nf90_redef
    218     use handle_err_m, only: handle_err
    219216
    220217    integer, intent( in) :: ncid
    … …  
    240237
    241238    use netcdf, only: nf90_enddef
    242     use handle_err_m, only: handle_err
    243239
    244240    integer,           intent( in) :: ncid
    … …  
    265261
    266262    use netcdf, only: nf90_close
    267     use handle_err_m, only: handle_err
    268263
    269264    integer, intent( in) :: ncid
    … …  
    289284
    290285    use netcdf, only: nf90_copy_att
    291     use handle_err_m, only: handle_err
    292286
    293287    integer, intent( in):: ncid_in,  varid_in
    … …  
    305299       ncerr = ncerr_not_opt
    306300    else
    307        call handle_err("nf95_copy_att", ncerr_not_opt, ncid_out)
     301       call handle_err("nf95_copy_att " // name, ncerr_not_opt, ncid_out)
    308302    end if
    309303
    310304  end subroutine nf95_copy_att
    311305
     306  !***********************
     307
     308  subroutine nf95_inquire_attribute(ncid, varid, name, xtype, nclen, attnum, &
     309       ncerr)
     310
     311    use netcdf, only: nf90_inquire_attribute
     312
     313    integer,             intent( in)           :: ncid, varid
     314    character (len = *), intent( in)           :: name
     315    integer,             intent(out), optional :: xtype, nclen, attnum
     316    integer, intent(out), optional:: ncerr
     317
     318    ! Variable local to the procedure:
     319    integer ncerr_not_opt
     320
     321    !-------------------
     322
     323    ncerr_not_opt = nf90_inquire_attribute(ncid, varid, name, xtype, nclen, &
     324         attnum)
     325    if (present(ncerr)) then
     326       ncerr = ncerr_not_opt
     327    else
     328       call handle_err("nf95_inquire_attribute " // name, ncerr_not_opt, &
     329            ncid, varid)
     330    end if
     331
     332  end subroutine nf95_inquire_attribute
     333
     334  !***********************
     335
     336  subroutine nf95_inquire(ncid, nDimensions, nVariables, nAttributes, &
     337       unlimitedDimId, formatNum, ncerr)
     338
     339    use netcdf, only: nf90_inquire
     340
     341    integer,           intent( in) :: ncid
     342    integer, optional, intent(out) :: nDimensions, nVariables, nAttributes
     343    integer, optional, intent(out) :: unlimitedDimId, formatNum
     344    integer, intent(out), optional:: ncerr
     345
     346    ! Variable local to the procedure:
     347    integer ncerr_not_opt
     348
     349    !-------------------
     350
     351    ncerr_not_opt = nf90_inquire(ncid, nDimensions, nVariables, nAttributes, &
     352         unlimitedDimId, formatNum)
     353    if (present(ncerr)) then
     354       ncerr = ncerr_not_opt
     355    else
     356       call handle_err("nf95_inquire", ncerr_not_opt, ncid)
     357    end if
     358
     359  end subroutine nf95_inquire
     360
    312361end module simple
Note: See TracChangeset for help on using the changeset viewer.