23 INTEGER,
INTENT(IN) :: status
24 CHARACTER(*),
INTENT(IN) :: line
25 REAL(KIND=JPRB) :: ZHOOK_HANDLE
28 IF (
lhook)
CALL dr_hook(
'MODE_READ_CDF:HANDLE_ERR_CDF',0,zhook_handle)
29 IF (status /= nf90_noerr)
THEN 30 CALL abor1_sfx(
'MODE_READ_NETCDF: HANDLE_ERR_CDF:'//
trim(line))
32 IF (
lhook)
CALL dr_hook(
'MODE_READ_CDF:HANDLE_ERR_CDF',1,zhook_handle)
37 SUBROUTINE get1dcdf(KCDF_ID,IDVAR,PMISSVALUE,PVALU1D)
44 INTEGER,
INTENT(IN) :: KCDF_ID
45 INTEGER,
INTENT(IN) :: IDVAR
46 REAL,
INTENT(OUT) :: PMISSVALUE
47 REAL,
DIMENSION(:),
INTENT(OUT) :: PVALU1D
50 character(len=80) :: HACTION
51 integer,
save :: NDIMS=1
53 integer,
DIMENSION(:),
ALLOCATABLE :: NVARDIMID,NVARDIMLEN
54 character(len=80),
DIMENSION(:),
ALLOCATABLE :: NVARDIMNAM
57 character(len=80),
DIMENSION(:),
ALLOCATABLE :: HNAME
58 REAL,
DIMENSION(:),
ALLOCATABLE :: ZVALU1D
59 REAL(KIND=JPRB) :: ZHOOK_HANDLE
62 IF (
lhook)
CALL dr_hook(
'MODE_READ_CDF:GET1DCDF',0,zhook_handle)
64 ALLOCATE(nvardimid(ndims))
65 ALLOCATE(nvardimlen(ndims))
66 ALLOCATE(nvardimnam(ndims))
71 haction=
'get variable type' 72 status=nf90_inquire_variable(kcdf_id,idvar,xtype=kvartype)
76 haction=
'get variable dimensions identifiant' 77 status=nf90_inquire_variable(kcdf_id,idvar,dimids=nvardimid)
81 haction=
'get variable dimensions name' 82 status=nf90_inquire_dimension(kcdf_id,nvardimid(ndims),
name=nvardimnam(ndims))
85 haction=
'get variable dimensions length' 86 status=nf90_inquire_dimension(kcdf_id,nvardimid(ndims),len=nvardimlen(ndims))
91 haction=
'get attributs' 93 status=nf90_inquire_variable(kcdf_id,idvar,natts=ngatts)
96 allocate(hname(1:ngatts))
99 status=nf90_inq_attname(kcdf_id,idvar,jloop,hname(jloop))
102 if (
trim(hname(jloop))==
'missing_value')
then 104 haction=
'get missing value' 105 status=nf90_get_att(kcdf_id,idvar,
"missing_value",pmissvalue)
111 ALLOCATE(zvalu1d(1:nvardimlen(ndims)))
114 IF (kvartype>=5)
then 115 haction=
'get variable values (1D)' 116 status=nf90_get_var(kcdf_id,idvar,zvalu1d(:))
119 pvalu1d(:)=zvalu1d(:)
120 IF (
ALLOCATED(zvalu1d ))
DEALLOCATE(zvalu1d)
121 IF (
lhook)
CALL dr_hook(
'MODE_READ_CDF:GET1DCDF',1,zhook_handle)
127 SUBROUTINE get2dcdf(KCDF_ID,IDVAR,PDIM1,HDIM1NAME,PDIM2,HDIM2NAME,&
135 INTEGER,
INTENT(IN) :: KCDF_ID
136 INTEGER,
INTENT(IN) :: IDVAR
137 REAL,
DIMENSION(:),
INTENT(OUT) :: PDIM1,PDIM2
138 CHARACTER(len=80),
INTENT(OUT) :: HDIM1NAME,HDIM2NAME
139 REAL,
INTENT(OUT) :: PMISSVALUE
140 REAL,
DIMENSION(:,:),
INTENT(OUT) :: PVALU2D
143 character(len=80) :: HACTION
144 integer,
save :: NDIMS=2
146 integer,
DIMENSION(:),
ALLOCATABLE :: NVARDIMID,NVARDIMLEN
147 character(len=80),
DIMENSION(:),
ALLOCATABLE :: NVARDIMNAM
150 character(len=80),
DIMENSION(:),
ALLOCATABLE :: HNAME
151 real :: ZMISS1,ZMISS2
152 REAL,
DIMENSION(:,:),
ALLOCATABLE :: ZVALU2D
153 REAL(KIND=JPRB) :: ZHOOK_HANDLE
156 IF (
lhook)
CALL dr_hook(
'MODE_READ_CDF:GET2DCDF',0,zhook_handle)
158 ALLOCATE(nvardimid(ndims))
159 ALLOCATE(nvardimlen(ndims))
160 ALLOCATE(nvardimnam(ndims))
165 haction=
'get variable type' 166 status=nf90_inquire_variable(kcdf_id,idvar,xtype=kvartype)
170 haction=
'get variable dimensions identifiant' 171 status=nf90_inquire_variable(kcdf_id,idvar,dimids=nvardimid)
174 haction=
'get attributs' 176 status=nf90_inquire_variable(kcdf_id,idvar,natts=ngatts)
179 allocate(hname(1:ngatts))
182 status=nf90_inq_attname(kcdf_id,idvar,jloop,hname(jloop))
185 if (
trim(hname(jloop))==
'missing_value')
then 187 haction=
'get missing value' 188 status=nf90_get_att(kcdf_id,idvar,
"missing_value",pmissvalue)
196 haction=
'get variable dimensions name' 197 status=nf90_inquire_dimension(kcdf_id,nvardimid(jloop),
name=nvardimnam(jloop))
199 haction=
'get variable dimensions length' 200 status=nf90_inquire_dimension(kcdf_id,nvardimid(jloop),len=nvardimlen(jloop))
206 ALLOCATE(zvalu2d(1:nvardimlen(1),1:nvardimlen(2)))
208 IF (kvartype>=5)
then 209 haction=
'get variable values (2D)' 210 status=nf90_get_var(kcdf_id,idvar,zvalu2d(:,:))
213 pvalu2d(:,:)=zvalu2d(:,:)
215 CALL get1dcdf(kcdf_id,nvardimid(1),zmiss1,pdim1)
216 CALL get1dcdf(kcdf_id,nvardimid(2),zmiss2,pdim2)
217 hdim1name=nvardimnam(1)
218 hdim2name=nvardimnam(2)
219 IF (
ALLOCATED(zvalu2d ))
DEALLOCATE(zvalu2d)
220 IF (
lhook)
CALL dr_hook(
'MODE_READ_CDF:GET2DCDF',1,zhook_handle)
233 CHARACTER(LEN=28),
INTENT(IN) :: HFILENAME
234 CHARACTER(LEN=28),
INTENT(IN) :: HNCVARNAME
235 REAL,
DIMENSION(:),
INTENT(OUT) :: PLON,PLAT
236 REAL,
DIMENSION(:),
INTENT(OUT) :: PVAL
241 character(len=80) :: HACTION
242 character(len=80),
DIMENSION(:),
ALLOCATABLE :: VARNAME
243 integer ::JLOOP1,JDIM1,JDIM2,JLOOP
244 integer ::ID_VARTOGET,ID_VARTOGET1,ID_VARTOGET2
247 integer,
dimension(1) :: IDIMID
248 integer,
DIMENSION(1:2) :: NLEN2D,IDIMID2D
249 integer,
DIMENSION(:),
ALLOCATABLE :: NVARDIMID,NVARDIMLEN
250 character(len=80),
DIMENSION(:),
ALLOCATABLE :: NVARDIMNAM
251 real,
DIMENSION(:),
ALLOCATABLE :: ZVALU
252 real,
DIMENSION(:,:),
ALLOCATABLE :: ZVALU2D
254 real,
DIMENSION(:),
ALLOCATABLE :: ZDIM1
255 real,
DIMENSION(:),
ALLOCATABLE :: ZDIM2
256 character(len=80) :: YDIM1NAME,YDIM2NAME
257 integer :: ILONFOUND,ILATFOUND, IARG
258 REAL(KIND=JPRB) :: ZHOOK_HANDLE
263 IF (
lhook)
CALL dr_hook(
'MODE_READ_CDF:READ_LATLONVAL_CDF',0,zhook_handle)
266 haction=
'open netcdf' 267 status=nf90_open(hfilename,nf90_nowrite,kcdf_id)
270 if (status/=nf90_noerr)
then 280 haction=
'get number of variables' 281 status=nf90_inquire(kcdf_id,nvariables=nbvars)
284 ALLOCATE(varname(nbvars))
293 haction=
'get variables names' 294 status=nf90_inquire_variable(kcdf_id,jloop1,
name=varname(jloop1))
297 if (varname(jloop1)==hncvarname)
then 301 if (varname(jloop1)/=hncvarname)
then 302 if((lgt(
trim(varname(jloop1)),
trim(hncvarname))).AND.&
303 (scan(
trim(varname(jloop1)),
trim(hncvarname))==1))
then 310 if (id_vartoget1/=0)
then 311 id_vartoget=id_vartoget1
313 id_vartoget=id_vartoget2
315 if (id_vartoget==0)
then 316 haction=
'close netcdf' 317 status=nf90_close(kcdf_id)
319 CALL abor1_sfx(
'MODE_READ_NETCDF: READ_LATLONVAL_CDF')
329 haction=
'get variable dimensions number' 330 status=nf90_inquire_variable(kcdf_id,id_vartoget,ndims=nvardims)
335 SELECT CASE (nvardims)
339 haction=
'get variable dimensions length' 340 status=nf90_inquire_variable(kcdf_id,id_vartoget,dimids=idimid)
341 status=nf90_inquire_dimension(kcdf_id,idimid(1),len=nlen)
343 ALLOCATE(zvalu(nlen))
345 CALL get1dcdf(kcdf_id,id_vartoget,zmiss,zvalu)
350 status=nf90_inquire_variable(kcdf_id,id_vartoget,dimids=idimid2d)
352 haction=
'get variable dimensions length' 353 status=nf90_inquire_dimension(kcdf_id,idimid2d(jloop),len=nlen2d(jloop))
356 ALLOCATE(zvalu2d(nlen2d(1),nlen2d(2)))
357 ALLOCATE(zdim1(nlen2d(1)))
358 ALLOCATE(zdim2(nlen2d(2)))
360 CALL get2dcdf(kcdf_id,id_vartoget,zdim1,ydim1name,zdim2,ydim2name,&
364 if ((ydim1name==
'lon').OR.(ydim1name==
'longitude')) ilonfound=1
365 if ((ydim2name==
'lon').OR.(ydim2name==
'longitude')) ilonfound=2
366 if ((ydim1name==
'lat').OR.(ydim1name==
'latitude')) ilatfound=1
367 if ((ydim2name==
'lat').OR.(ydim2name==
'latitude')) ilatfound=2
372 IF ((ilonfound==1).AND.(ilatfound==2))
then 374 DO jdim1=1,
SIZE(zdim1)
375 DO jdim2=1,
SIZE(zdim2)
377 pval(iarg)=zvalu2d(jdim1,jdim2)
378 plon(iarg)=zdim1(jdim1)
379 plat(iarg)=zdim2(jdim2)
382 ELSEIF ((ilonfound==2).AND.(ilatfound==1))
then 384 DO jdim1=1,
SIZE(zdim1)
385 DO jdim2=1,
SIZE(zdim2)
387 pval(iarg)=zvalu2d(jdim1,jdim2)
388 plat(iarg)=zdim1(jdim1)
389 plon(iarg)=zdim2(jdim2)
393 write(0,*)
'*****WARNING*****: incompatible dimensions to lat/lon/value arrays' 402 haction=
'close netcdf' 403 status=nf90_close(kcdf_id)
410 IF (
ALLOCATED(varname ))
DEALLOCATE(varname)
411 IF (
ALLOCATED(zvalu ))
DEALLOCATE(zvalu )
412 IF (
ALLOCATED(zvalu2d ))
DEALLOCATE(zvalu2d)
413 IF (
ALLOCATED(zdim1 ))
DEALLOCATE(zdim1 )
414 IF (
ALLOCATED(zdim2 ))
DEALLOCATE(zdim2 )
416 IF (
ALLOCATED(nvardimid ))
DEALLOCATE(nvardimid )
417 IF (
ALLOCATED(nvardimnam ))
DEALLOCATE(nvardimnam)
418 IF (
ALLOCATED(nvardimlen ))
DEALLOCATE(nvardimlen)
419 IF (
lhook)
CALL dr_hook(
'MODE_READ_CDF:READ_LATLONVAL_CDF',1,zhook_handle)
431 CHARACTER(LEN=28),
INTENT(IN) :: HFILENAME
432 CHARACTER(LEN=28),
INTENT(IN) :: HNCVARNAME
433 INTEGER,
INTENT(OUT):: KDIM
438 character(len=80) :: HACTION
439 character(len=80),
DIMENSION(:),
ALLOCATABLE :: VARNAME
440 integer ::JLOOP1,JLOOP
441 integer ::ID_VARTOGET,ID_VARTOGET1,ID_VARTOGET2
443 integer,
dimension(1) :: NDIMID
444 integer,
DIMENSION(2) ::NLEN2D, NDIMID2D
445 REAL(KIND=JPRB) :: ZHOOK_HANDLE
450 IF (
lhook)
CALL dr_hook(
'MODE_READ_CDF:READ_DIM_CDF',0,zhook_handle)
451 haction=
'open netcdf' 452 status=nf90_open(hfilename,nf90_nowrite,kcdf_id)
453 if (status/=nf90_noerr)
then 462 haction=
'get number of variables' 463 status=nf90_inquire(kcdf_id,nvariables=nbvars)
466 ALLOCATE(varname(nbvars))
475 haction=
'get variables names' 476 status=nf90_inquire_variable(kcdf_id,jloop1,
name=varname(jloop1))
479 if (varname(jloop1)==hncvarname)
then 483 if (varname(jloop1)/=hncvarname)
then 484 if((lgt(
trim(varname(jloop1)),
trim(hncvarname))).AND.&
485 (scan(
trim(varname(jloop1)),
trim(hncvarname))==1))
then 492 if (id_vartoget1/=0)
then 493 id_vartoget=id_vartoget1
495 id_vartoget=id_vartoget2
497 if (id_vartoget==0)
then 498 haction=
'close netcdf' 499 status=nf90_close(kcdf_id)
501 CALL abor1_sfx(
'MODE_READ_CDF: READ_DIM_CDF')
511 haction=
'get variable dimensions number' 512 status=nf90_inquire_variable(kcdf_id,id_vartoget,ndims=nvardims)
518 SELECT CASE (nvardims)
521 haction=
'get variable dimensions length' 522 status=nf90_inquire_variable(kcdf_id,id_vartoget,dimids=ndimid)
523 status=nf90_inquire_dimension(kcdf_id,ndimid(1),len=kdim)
529 status=nf90_inquire_variable(kcdf_id,id_vartoget,dimids=ndimid2d)
531 haction=
'get variable dimensions length' 532 status=nf90_inquire_dimension(kcdf_id,ndimid2d(jloop),len=nlen2d(jloop))
534 kdim=kdim*nlen2d(jloop)
540 haction=
'close netcdf' 541 status=nf90_close(kcdf_id)
548 IF (
ALLOCATED(varname ))
DEALLOCATE(varname)
549 IF (
lhook)
CALL dr_hook(
'MODE_READ_CDF:READ_DIM_CDF',1,zhook_handle)
static const char * trim(const char *name, int *n)
subroutine handle_err_cdf(status, line)
quick &counting sorts only inumt inumt name
subroutine read_latlonval_cdf(HFILENAME, HNCVARNAME, PLON, PLAT, PVAL)
subroutine abor1_sfx(YTEXT)
subroutine get2dcdf(KCDF_ID, IDVAR, PDIM1, HDIM1NAME, PDIM2, HDIM2NAME, PMISSVALUE, PVALU2D)
subroutine get1dcdf(KCDF_ID, IDVAR, PMISSVALUE, PVALU1D)
subroutine read_dim_cdf(HFILENAME, HNCVARNAME, KDIM)