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:
2 edited

Legend:

Unmodified
Added
Removed

  • LMDZ5/branches/testing

  • 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
Note: See TracChangeset for help on using the changeset viewer.