D.Gazen & J.Escobar 24/03/2107:mode_netcdf.f90, Correction for compilation of netcdf4...
[MNH-git_open_source-lfs.git] / src / LIB / SURCOUCHE / src / mode_netcdf.f90
1 #if defined(MNH_IOCDF4)
2 MODULE MODE_NETCDF
3 !!
4 !!      Original  14/04/2015 D. Gazen
5 !!      D.Gazen & J.Escobar 24/03/2107 : Correction for compilation of netcdf4IO in REAL*4 <=> MNH_REAL=R4      
6 !!
7 USE MODD_NETCDF
8
9 IMPLICIT NONE 
10
11 PRIVATE
12
13 INTERFACE NCWRIT
14    MODULE PROCEDURE NCWRITX0, NCWRITX1, NCWRITX2, NCWRITX3, &
15         & NCWRITX4, NCWRITX5, NCWRITX6, &
16         & NCWRITN0, NCWRITN1, NCWRITN2, &
17         & NCWRITC0, NCWRITC1
18 END INTERFACE NCWRIT
19
20 INTERFACE NCREAD
21    MODULE PROCEDURE NCREADX0, NCREADX1, NCREADX2, NCREADX3, &
22         & NCREADX4, NCREADX5, NCREADX6, &
23         & NCREADN0, NCREADN1, NCREADN2, &
24         & NCREADC0
25 END INTERFACE NCREAD
26
27 ! Public from netcdf.inc :
28 !PUBLIC NF_OPEN,NF_CREATE,NF_NOWRITE,NF_CLOBBER,NF_NETCDF4,NF_NOERR,NF_STRERROR
29 ! Public from this module :
30 PUBLIC NEWIOCDF,CLEANIOCDF,NCWRIT,NCREAD
31
32 CONTAINS
33
34 FUNCTION NEWIOCDF()
35 TYPE(IOCDF), POINTER :: NEWIOCDF
36 TYPE(IOCDF), POINTER :: TZIOCDF
37 INTEGER              :: IRESP
38
39 ALLOCATE(TZIOCDF, STAT=IRESP)
40 IF (IRESP > 0) THEN 
41   PRINT *, 'NEWIOCDF : memory allocation error...'
42   STOP
43 END IF
44
45 TZIOCDF%NCID = -1
46 NULLIFY(TZIOCDF%DIMX)
47 NULLIFY(TZIOCDF%DIMY)
48 NULLIFY(TZIOCDF%DIMZ)
49 NULLIFY(TZIOCDF%DIMSTR)
50 NULLIFY(TZIOCDF%DIMLIST)
51
52 NEWIOCDF=>TZIOCDF
53
54 END FUNCTION NEWIOCDF
55
56 SUBROUTINE CLEANIOCDF(PIOCDF)
57 TYPE(IOCDF),  POINTER :: PIOCDF
58
59 INTEGER(KIND=IDCDF_KIND) :: IRESP
60
61 ! Close Netcdf File
62 IRESP = NF_CLOSE(PIOCDF%NCID)
63 IF (IRESP /= NF_NOERR) THEN
64    PRINT *, 'CLEANIOCDF, NF_CLOSE error : ', NF_STRERROR(IRESP)
65 END IF
66
67 ! Clean DIMLIST and DIMSTR
68 CALL CLEANLIST(PIOCDF%DIMLIST)
69 CALL CLEANLIST(PIOCDF%DIMSTR)
70 ! Then free iocdf
71 DEALLOCATE(PIOCDF)
72
73 PRINT *, 'CLEANIOCDF done.'
74
75 CONTAINS
76
77 SUBROUTINE CLEANLIST(PLIST)
78 TYPE(DIMCDF), POINTER :: PLIST,TZDIMCUR, TZDIMNEXT    
79
80 TZDIMCUR  => PLIST
81 DO WHILE(ASSOCIATED(TZDIMCUR))
82    TZDIMNEXT => TZDIMCUR%NEXT
83    DEALLOCATE(TZDIMCUR)
84    TZDIMCUR => TZDIMNEXT
85 END DO
86
87 END SUBROUTINE CLEANLIST
88   
89 END SUBROUTINE CLEANIOCDF
90
91 SUBROUTINE HANDLE_ERR(status,line,text,kresp)
92 INTEGER(KIND=IDCDF_KIND),INTENT(IN) :: status
93 INTEGER, INTENT(IN) :: line
94 CHARACTER(LEN=*), INTENT(IN) :: text
95 INTEGER, OPTIONAL, INTENT(OUT) :: kresp
96
97 ! Don't stop the code when kresp is present
98 ! and ensure kresp is a negative integer
99 IF (status /= NF_NOERR) THEN
100    PRINT *, 'NETCDF ERROR in '//TRIM(text), line, NF_STRERROR(status)
101    IF (PRESENT(kresp)) THEN
102       IF (status < 0) THEN
103          kresp = status
104       ELSE IF (status == 0) THEN
105          kresp = -1
106       ELSE
107          kresp = -status
108       END IF
109    ELSE
110       STOP
111    END IF
112 END IF
113 END SUBROUTINE HANDLE_ERR
114
115 FUNCTION str_replace(hstr, hold, hnew)
116 CHARACTER(LEN=*) :: hstr, hold, hnew
117 CHARACTER(LEN=LEN_TRIM(hstr)+MAX(0,LEN(hnew)-LEN(hold))) :: str_replace
118
119 INTEGER :: pos
120
121 pos = INDEX(hstr,hold)
122 IF (pos /= 0) THEN
123    str_replace = hstr(1:pos-1)//hnew//hstr(pos+LEN(hold):)
124 ELSE 
125    str_replace = hstr 
126 END IF
127
128 END FUNCTION str_replace
129
130 SUBROUTINE WRITATTR(KNCID, KVARID, TPFMH)
131 USE MODD_FM, ONLY : FMHEADER
132 INTEGER(KIND=IDCDF_KIND),INTENT(IN) :: KNCID
133 INTEGER(KIND=IDCDF_KIND),INTENT(IN) :: KVARID
134 TYPE(FMHEADER), INTENT(IN) :: TPFMH
135
136 INTEGER(KIND=IDCDF_KIND) :: STATUS
137 INTEGER(KIND=IDCDF_KIND),PARAMETER :: IONE = 1
138
139 ! GRID attribute definition
140 STATUS = NF_PUT_ATT_INT(KNCID, KVARID, 'GRID', &
141      &NF_INT, IONE, INT(TPFMH%GRID,KIND=IDCDF_KIND))
142 IF (STATUS /= NF_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITATTR [NF_PUT_ATT_INT]')
143
144 ! COMMENT attribute definition
145 STATUS = NF_PUT_ATT_TEXT(KNCID, KVARID,'COMMENT', &
146      &INT(LEN_TRIM(TPFMH%COMMENT),KIND=IDCDF_KIND), TPFMH%COMMENT)
147 IF (STATUS /= NF_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITATTR [NF_PUT_ATT_TEXT]')
148
149 END SUBROUTINE WRITATTR
150
151 FUNCTION GETDIMCDF(PIOCDF, KLEN, HDIMNAME)
152 TYPE(IOCDF), POINTER       :: PIOCDF
153 INTEGER(KIND=IDCDF_KIND),INTENT(IN) :: KLEN
154 CHARACTER(LEN=*), OPTIONAL :: HDIMNAME ! When provided don't search but
155                                        ! simply create with name HDIMNAME
156 TYPE(DIMCDF), POINTER   :: GETDIMCDF
157
158 TYPE(DIMCDF), POINTER :: TMP
159 INTEGER               :: COUNT
160 CHARACTER(LEN=7)      :: YSUFFIX
161 CHARACTER(LEN=8)      :: YDIMNAME
162 INTEGER(KIND=IDCDF_KIND) :: STATUS
163
164 IF (KLEN < 1) THEN
165    PRINT *, 'GETDIMCDF Error, KLEN=', KLEN
166    STOP
167 END IF
168
169 IF (PRESENT(HDIMNAME)) THEN
170    NULLIFY(TMP)
171    YDIMNAME = TRIM(HDIMNAME)
172 ELSE
173    ! Search dimension with KLEN length
174    COUNT = 1
175    TMP  => PIOCDF%DIMLIST
176    DO WHILE(ASSOCIATED(TMP))
177       IF (TMP%LEN == KLEN .AND. TMP%NAME /= 'STRLEN') EXIT
178       TMP=>TMP%NEXT
179       COUNT = COUNT+1
180    END DO
181    WRITE(YSUFFIX,'(i7)') KLEN
182    YDIMNAME = 'D'//ADJUSTL(YSUFFIX)
183 END IF
184
185 IF (.NOT. ASSOCIATED(TMP)) THEN
186    ! Not found then define new dimension
187    ALLOCATE(TMP)
188    TMP%NAME = YDIMNAME
189    TMP%LEN = KLEN
190    STATUS = NF_DEF_DIM(PIOCDF%NCID, TMP%NAME, KLEN, TMP%ID)
191    IF (STATUS /= NF_NOERR) CALL HANDLE_ERR(status,__LINE__,'GETDIMCDF[NF_DEF_DIM]')
192    NULLIFY(TMP%NEXT)
193    TMP%NEXT       => PIOCDF%DIMLIST
194    PIOCDF%DIMLIST => TMP
195 END IF
196
197 GETDIMCDF => TMP
198
199 END FUNCTION GETDIMCDF
200
201 FUNCTION GETSTRDIMID(PIOCDF, KLEN)
202 TYPE(IOCDF), POINTER    :: PIOCDF
203 INTEGER(KIND=IDCDF_KIND),INTENT(IN) :: KLEN
204 INTEGER(KIND=IDCDF_KIND)            :: GETSTRDIMID
205
206 TYPE(DIMCDF), POINTER :: TMP
207 CHARACTER(LEN=7)      :: YSUFFIX
208 CHARACTER(LEN=8)      :: YDIMNAME
209 INTEGER(KIND=IDCDF_KIND) :: STATUS
210
211 IF (KLEN < 1) THEN
212    PRINT *, 'GETSTRDIMID Error, KLEN=', KLEN
213    STOP
214 END IF
215
216 ! Search string dimension with KLEN length
217 TMP  => PIOCDF%DIMSTR
218 DO WHILE(ASSOCIATED(TMP))
219    IF (TMP%LEN == KLEN) EXIT
220    TMP=>TMP%NEXT
221 END DO
222 WRITE(YSUFFIX,'(i7)') KLEN
223 YDIMNAME = 'S'//ADJUSTL(YSUFFIX)
224
225 IF (.NOT. ASSOCIATED(TMP)) THEN
226    ! Not found then define new dimension
227    ALLOCATE(TMP)
228    TMP%NAME = YDIMNAME
229    TMP%LEN = KLEN
230    STATUS = NF_DEF_DIM(PIOCDF%NCID, TMP%NAME, KLEN, TMP%ID)
231    IF (STATUS /= NF_NOERR) CALL HANDLE_ERR(status,__LINE__,'GETSTRDIMID[NF_DEF_DIM]')
232    NULLIFY(TMP%NEXT)
233    TMP%NEXT      => PIOCDF%DIMSTR
234    PIOCDF%DIMSTR => TMP
235 END IF
236
237 GETSTRDIMID = TMP%ID
238
239 END FUNCTION GETSTRDIMID
240
241 SUBROUTINE FILLVDIMS(PIOCDF, KSHAPE, HDIR, KVDIMS)
242 TYPE(IOCDF),           POINTER        :: PIOCDF 
243 INTEGER(KIND=IDCDF_KIND), DIMENSION(:), INTENT(IN) :: KSHAPE
244 CHARACTER(LEN=*),      INTENT(IN)     :: HDIR
245 INTEGER(KIND=IDCDF_KIND),DIMENSION(:), INTENT(OUT) :: KVDIMS
246
247 INTEGER :: II
248 TYPE(DIMCDF), POINTER :: PTDIM
249
250 IF (SIZE(KSHAPE) < 1) THEN
251    PRINT *, 'FILLVDIMS Error, KSHAPE empty'
252    STOP
253 END IF
254
255 DO II=1, SIZE(KSHAPE)
256
257    IF (II == 1) THEN
258       IF (HDIR == 'XX' .OR. HDIR == 'XY') THEN
259          IF (.NOT. ASSOCIATED(PIOCDF%DIMX))  PIOCDF%DIMX => GETDIMCDF(PIOCDF, KSHAPE(II), 'X')
260          IF (KSHAPE(II) == PIOCDF%DIMX%LEN) THEN
261             PTDIM => PIOCDF%DIMX
262          ELSE
263             PTDIM => GETDIMCDF(PIOCDF, KSHAPE(II))
264          END IF
265       ELSE IF (HDIR == 'YY') THEN
266          IF (.NOT. ASSOCIATED(PIOCDF%DIMY))  PIOCDF%DIMY => GETDIMCDF(PIOCDF, KSHAPE(II), 'Y')
267          IF (KSHAPE(II) == PIOCDF%DIMY%LEN) THEN
268             PTDIM => PIOCDF%DIMY
269          ELSE
270             PTDIM => GETDIMCDF(PIOCDF, KSHAPE(II))
271          END IF
272       ELSE
273          PTDIM => GETDIMCDF(PIOCDF, KSHAPE(II))
274          KVDIMS(II) = PTDIM%ID
275       END IF
276    ELSE IF (II == 2) THEN
277       IF (HDIR == 'XY') THEN
278          IF (.NOT. ASSOCIATED(PIOCDF%DIMY))  PIOCDF%DIMY => GETDIMCDF(PIOCDF, KSHAPE(II), 'Y')
279          IF (KSHAPE(II) == PIOCDF%DIMY%LEN) THEN
280             PTDIM => PIOCDF%DIMY
281          ELSE
282             PTDIM => GETDIMCDF(PIOCDF, KSHAPE(II))
283          END IF
284       ELSE
285          PTDIM => GETDIMCDF(PIOCDF, KSHAPE(II))
286       END IF
287    ELSE IF (II == 3) THEN
288       IF (HDIR == 'XY') THEN
289          IF (.NOT. ASSOCIATED(PIOCDF%DIMZ))  PIOCDF%DIMZ => GETDIMCDF(PIOCDF, KSHAPE(II), 'Z')
290          IF (KSHAPE(II) == PIOCDF%DIMZ%LEN) THEN
291             PTDIM => PIOCDF%DIMZ
292          ELSE
293             PTDIM => GETDIMCDF(PIOCDF, KSHAPE(II))
294          END IF
295       ELSE
296          PTDIM => GETDIMCDF(PIOCDF, KSHAPE(II))
297       END IF
298    ELSE
299       PTDIM => GETDIMCDF(PIOCDF, KSHAPE(II))
300    END IF
301    
302    KVDIMS(II) = PTDIM%ID
303       
304 END DO
305
306 END SUBROUTINE FILLVDIMS
307
308
309 SUBROUTINE NCWRITX0(PZCDF, HVARNAME, HDIR, PFIELD, TPFMH, KRESP)
310 USE MODD_FM, ONLY : FMHEADER
311 TYPE(IOCDF), POINTER             :: PZCDF
312 CHARACTER(LEN=*),     INTENT(IN) :: HVARNAME
313 CHARACTER(LEN=*),     INTENT(IN) :: HDIR
314 REAL,                 INTENT(IN) :: PFIELD
315 TYPE(FMHEADER),       INTENT(IN) :: TPFMH
316 INTEGER,              INTENT(OUT):: KRESP
317
318 INTEGER(KIND=IDCDF_KIND) :: STATUS
319 INTEGER(KIND=IDCDF_KIND) :: INCID
320 CHARACTER(LEN=30) :: YVARNAME
321 INTEGER(KIND=IDCDF_KIND) :: IVARID
322 INTEGER(KIND=IDCDF_KIND),PARAMETER :: IZERO = 0
323 REAL(KIND=8)      :: ZFIELD8
324 INTEGER           :: IRESP
325
326 IRESP = 0
327 ! Get the Netcdf file ID
328 INCID = PZCDF%NCID
329
330 ! NetCDF var names can't contain '%' nor '.' 
331 YVARNAME = str_replace(HVARNAME, '%', '__')
332 YVARNAME = str_replace(YVARNAME, '.', '--')
333
334 ! The variable should not already exist but who knows ?
335 STATUS = NF_INQ_VARID(INCID, YVARNAME, IVARID)
336 IF (STATUS /= NF_NOERR) THEN
337    ! Define the scalar variable 
338    STATUS = NF_DEF_VAR(INCID, YVARNAME, NF_DOUBLE, IZERO, IZERO, IVARID)
339    IF (status /= NF_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCWRITX0[NF_DEF_VAR]')
340    CALL WRITATTR(INCID, IVARID, TPFMH)
341 ELSE
342    PRINT *,'NCWRITX0 : ', TRIM(YVARNAME), ' already defined !'
343 END IF
344
345 ! Write the data
346 #if defined(MNH_MPI_DOUBLE_PRECISION)
347 ! PFIELD REAL(KIND=8)
348 STATUS = NF_PUT_VAR_DOUBLE(INCID, IVARID, PFIELD)
349 #else
350 !! PFIELD REAL(KIND=4) saved as REAL(KIND=8)  
351 ZFIELD8 = PFIELD
352 STATUS = NF_PUT_VAR_DOUBLE(INCID, IVARID, ZFIELD8)
353 #endif
354 IF (status /= NF_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCWRITX0[NF_PUT_VAR_DOUBLE]',IRESP)
355
356 KRESP = IRESP
357 END SUBROUTINE NCWRITX0
358
359 SUBROUTINE NCWRITX1(PZCDF, HVARNAME, HDIR, PFIELD, TPFMH, KRESP)
360 USE MODD_FM, ONLY : FMHEADER
361 TYPE(IOCDF), POINTER             :: PZCDF
362 CHARACTER(LEN=*),     INTENT(IN) :: HVARNAME
363 CHARACTER(LEN=*),     INTENT(IN) :: HDIR
364 REAL, DIMENSION(:),   INTENT(IN) :: PFIELD
365 TYPE(FMHEADER),       INTENT(IN) :: TPFMH
366 INTEGER,              INTENT(OUT):: KRESP
367
368 INTEGER(KIND=IDCDF_KIND) :: STATUS
369 INTEGER(KIND=IDCDF_KIND) :: INCID
370 CHARACTER(LEN=30)     :: YVARNAME
371 INTEGER(KIND=IDCDF_KIND) :: IVARID
372 INTEGER(KIND=IDCDF_KIND), DIMENSION(SIZE(SHAPE(PFIELD))) :: IVDIMS
373 REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: ZFIELD8
374 INTEGER               :: IRESP
375
376 IRESP = 0
377 ! Get the Netcdf file ID
378 INCID = PZCDF%NCID
379
380 ! NetCDF var names can't contain '%' nor '.' 
381 YVARNAME = str_replace(HVARNAME, '%', '__')
382 YVARNAME = str_replace(YVARNAME, '.', '--')
383
384 ! The variable should not already exist but who knows ?
385 STATUS = NF_INQ_VARID(INCID, YVARNAME, IVARID)
386 IF (STATUS /= NF_NOERR) THEN
387    ! Get the netcdf dimensions
388    CALL FILLVDIMS(PZCDF, INT(SHAPE(PFIELD),KIND=IDCDF_KIND), HDIR, IVDIMS)
389
390    ! Define the variable 
391    STATUS = NF_DEF_VAR(INCID, YVARNAME, NF_DOUBLE, INT(SIZE(IVDIMS),KIND=IDCDF_KIND), IVDIMS, IVARID)
392    IF (status /= NF_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCWRITX1[NF_DEF_VAR]')
393    CALL WRITATTR(INCID, IVARID, TPFMH)
394 ELSE
395    PRINT *,'NCWRITX1 : ', TRIM(YVARNAME), ' already defined !'
396 END IF
397
398 ! Write the data
399 #if defined(MNH_MPI_DOUBLE_PRECISION)
400 ! PFIELD REAL(KIND=8)
401 STATUS = NF_PUT_VAR_DOUBLE(INCID, IVARID, PFIELD)
402 #else
403 !! PFIELD REAL(KIND=4) saved as REAL(KIND=8)  
404 ALLOCATE(ZFIELD8(SIZE(PFIELD)))
405 ZFIELD8 = PFIELD
406 STATUS = NF_PUT_VAR_DOUBLE(INCID, IVARID, ZFIELD8)
407 DEALLOCATE(ZFIELD8)
408 #endif
409 IF (status /= NF_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCWRITX1[NF_PUT_VAR_DOUBLE]',IRESP)
410  
411 KRESP = IRESP
412 END SUBROUTINE NCWRITX1
413
414 SUBROUTINE NCWRITX2(PZCDF, HVARNAME, HDIR, PFIELD, TPFMH, KRESP)
415 USE MODD_IO_ll, ONLY : LDEFLATEX2
416 USE MODD_FM, ONLY : FMHEADER
417 TYPE(IOCDF), POINTER             :: PZCDF
418 CHARACTER(LEN=*),     INTENT(IN) :: HVARNAME
419 CHARACTER(LEN=*),     INTENT(IN) :: HDIR
420 REAL, DIMENSION(:,:), INTENT(IN) :: PFIELD
421 TYPE(FMHEADER),       INTENT(IN) :: TPFMH
422 INTEGER,              INTENT(OUT):: KRESP
423
424 INTEGER(KIND=IDCDF_KIND),PARAMETER :: SHUFFLE = 0
425 INTEGER(KIND=IDCDF_KIND),PARAMETER :: DEFLATE = 1
426 INTEGER(KIND=IDCDF_KIND),PARAMETER :: DEFLATE_LEVEL = 2
427
428 INTEGER(KIND=IDCDF_KIND) :: STATUS
429 INTEGER(KIND=IDCDF_KIND) :: INCID
430 CHARACTER(LEN=30)     :: YVARNAME
431 INTEGER(KIND=IDCDF_KIND) :: IVARID
432 INTEGER(KIND=IDCDF_KIND), DIMENSION(SIZE(SHAPE(PFIELD))) :: IVDIMS
433 REAL(KIND=8),DIMENSION(:,:),ALLOCATABLE :: ZFIELD8
434 INTEGER               :: IRESP
435
436 IRESP = 0
437 ! Get the Netcdf file ID
438 INCID = PZCDF%NCID
439
440 ! NetCDF var names can't contain '%' nor '.' 
441 YVARNAME = str_replace(HVARNAME, '%', '__')
442 YVARNAME = str_replace(YVARNAME, '.', '--')
443
444 ! The variable should not already exist but who knows ?
445 STATUS = NF_INQ_VARID(INCID, YVARNAME, IVARID)
446 IF (STATUS /= NF_NOERR) THEN
447    ! Get the netcdf dimensions
448    CALL FILLVDIMS(PZCDF, INT(SHAPE(PFIELD),KIND=IDCDF_KIND), HDIR, IVDIMS)
449    
450    ! Define the variable 
451    STATUS = NF_DEF_VAR(INCID, YVARNAME, NF_DOUBLE, INT(SIZE(IVDIMS),KIND=IDCDF_KIND), IVDIMS, IVARID)
452    IF (status /= NF_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCWRITX2[NF_DEF_VAR]')
453    IF (LDEFLATEX2) THEN
454       ! Compress the variable with deflate level 2
455       STATUS = NF_DEF_VAR_DEFLATE(INCID, IVARID, SHUFFLE, DEFLATE, DEFLATE_LEVEL)
456       IF (status /= NF_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCWRITX2[NF_DEF_VAR_DEFLATE]')
457    END IF
458    CALL WRITATTR(INCID, IVARID, TPFMH)
459 ELSE
460    PRINT *,'NCWRITX2 : ', TRIM(YVARNAME), ' already defined !'
461 END IF
462
463 ! Write the data
464 #if defined(MNH_MPI_DOUBLE_PRECISION)
465 ! PFIELD REAL(KIND=8)
466 STATUS = NF_PUT_VAR_DOUBLE(INCID, IVARID, PFIELD)
467 #else
468 !! PFIELD REAL(KIND=4) saved as REAL(KIND=8)  
469 ALLOCATE(ZFIELD8(SIZE(PFIELD,1),SIZE(PFIELD,2)))
470 ZFIELD8 = PFIELD
471 STATUS = NF_PUT_VAR_DOUBLE(INCID, IVARID, ZFIELD8)
472 DEALLOCATE(ZFIELD8)
473 #endif
474 IF (status /= NF_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCWRITX2[NF_PUT_VAR_DOUBLE]',IRESP)
475  
476 KRESP = IRESP
477 END SUBROUTINE NCWRITX2
478
479 SUBROUTINE NCWRITX3(PZCDF, HVARNAME, HDIR, PFIELD, TPFMH, KRESP)
480 USE MODD_FM, ONLY : FMHEADER
481 TYPE(IOCDF), POINTER              :: PZCDF
482 CHARACTER(LEN=*),      INTENT(IN) :: HVARNAME
483 CHARACTER(LEN=*),      INTENT(IN) :: HDIR
484 REAL, DIMENSION(:,:,:),INTENT(IN) :: PFIELD
485 TYPE(FMHEADER),        INTENT(IN) :: TPFMH
486 INTEGER,               INTENT(OUT):: KRESP
487
488 INTEGER(KIND=IDCDF_KIND) :: STATUS
489 INTEGER(KIND=IDCDF_KIND) :: INCID
490 CHARACTER(LEN=30)     :: YVARNAME
491 INTEGER(KIND=IDCDF_KIND) :: IVARID
492 INTEGER(KIND=IDCDF_KIND), DIMENSION(SIZE(SHAPE(PFIELD))) :: IVDIMS
493 REAL(KIND=8),DIMENSION(:,:,:),ALLOCATABLE :: ZFIELD8
494 INTEGER               :: IRESP
495
496 IRESP = 0
497 ! Get the Netcdf file ID
498 INCID = PZCDF%NCID
499
500 ! NetCDF var names can't contain '%' nor '.' 
501 YVARNAME = str_replace(HVARNAME, '%', '__')
502 YVARNAME = str_replace(YVARNAME, '.', '--')
503
504 ! The variable should not already exist but who knows ?
505 STATUS = NF_INQ_VARID(INCID, YVARNAME, IVARID)
506 IF (STATUS /= NF_NOERR) THEN
507    ! Get the netcdf dimensions
508    CALL FILLVDIMS(PZCDF, INT(SHAPE(PFIELD),KIND=IDCDF_KIND), HDIR, IVDIMS)
509
510    ! Define the variable 
511    STATUS = NF_DEF_VAR(INCID, YVARNAME, NF_DOUBLE, INT(SIZE(IVDIMS),KIND=IDCDF_KIND), IVDIMS, IVARID)
512    IF (status /= NF_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCWRITX3[NF_DEF_VAR]')
513    CALL WRITATTR(INCID, IVARID, TPFMH)
514 ELSE
515    PRINT *,'NCWRITX3 : ', TRIM(YVARNAME), ' already defined !'
516 END IF
517
518 ! Write the data
519 #if defined(MNH_MPI_DOUBLE_PRECISION)
520 ! PFIELD REAL(KIND=8)
521 STATUS = NF_PUT_VAR_DOUBLE(INCID, IVARID, PFIELD)
522 #else
523 !! PFIELD REAL(KIND=4) saved as REAL(KIND=8)  
524 ALLOCATE(ZFIELD8(SIZE(PFIELD,1),SIZE(PFIELD,2),SIZE(PFIELD,3)))
525 ZFIELD8 = PFIELD
526 STATUS = NF_PUT_VAR_DOUBLE(INCID, IVARID, ZFIELD8)
527 DEALLOCATE(ZFIELD8)
528 #endif
529 IF (status /= NF_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCWRITX3[NF_PUT_VAR_DOUBLE] '//TRIM(HVARNAME),IRESP)
530  
531 KRESP = IRESP
532 END SUBROUTINE NCWRITX3
533
534 SUBROUTINE NCWRITX4(PZCDF, HVARNAME, HDIR, PFIELD, TPFMH, KRESP)
535 USE MODD_FM, ONLY : FMHEADER
536 TYPE(IOCDF), POINTER                 :: PZCDF
537 CHARACTER(LEN=*),         INTENT(IN) :: HVARNAME
538 CHARACTER(LEN=*),         INTENT(IN) :: HDIR
539 REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PFIELD
540 TYPE(FMHEADER),           INTENT(IN) :: TPFMH
541 INTEGER,                  INTENT(OUT):: KRESP
542
543 INTEGER(KIND=IDCDF_KIND) :: STATUS
544 INTEGER(KIND=IDCDF_KIND) :: INCID
545 CHARACTER(LEN=30)     :: YVARNAME
546 INTEGER(KIND=IDCDF_KIND) :: IVARID
547 INTEGER(KIND=IDCDF_KIND), DIMENSION(SIZE(SHAPE(PFIELD))) :: IVDIMS
548 REAL(KIND=8),DIMENSION(:,:,:,:),ALLOCATABLE :: ZFIELD8
549 INTEGER               :: IRESP
550
551 IRESP = 0
552 ! Get the Netcdf file ID
553 INCID = PZCDF%NCID
554
555 ! NetCDF var names can't contain '%' nor '.' 
556 YVARNAME = str_replace(HVARNAME, '%', '__')
557 YVARNAME = str_replace(YVARNAME, '.', '--')
558
559 ! The variable should not already exist but who knows ?
560 STATUS = NF_INQ_VARID(INCID, YVARNAME, IVARID)
561 IF (STATUS /= NF_NOERR) THEN
562    ! Get the netcdf dimensions
563    CALL FILLVDIMS(PZCDF, INT(SHAPE(PFIELD),KIND=IDCDF_KIND), HDIR, IVDIMS)
564
565    ! Define the variable 
566    STATUS = NF_DEF_VAR(INCID, YVARNAME, NF_DOUBLE, INT(SIZE(IVDIMS),KIND=IDCDF_KIND), IVDIMS, IVARID)
567    IF (status /= NF_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCWRITX4[NF_DEF_VAR]')
568    CALL WRITATTR(INCID, IVARID, TPFMH)
569 ELSE
570    PRINT *,'NCWRITX4 : ', TRIM(YVARNAME), ' already defined !'
571 END IF
572
573 ! Write the data
574 #if defined(MNH_MPI_DOUBLE_PRECISION)
575 ! PFIELD REAL(KIND=8)
576 STATUS = NF_PUT_VAR_DOUBLE(INCID, IVARID, PFIELD)
577 #else
578 !! PFIELD REAL(KIND=4) saved as REAL(KIND=8)  
579 ALLOCATE(ZFIELD8(SIZE(PFIELD,1),SIZE(PFIELD,2),SIZE(PFIELD,3),&
580      &SIZE(PFIELD,4)))
581 ZFIELD8 = PFIELD
582 STATUS = NF_PUT_VAR_DOUBLE(INCID, IVARID, ZFIELD8)
583 DEALLOCATE(ZFIELD8)
584 #endif
585 IF (status /= NF_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCWRITX4[NF_PUT_VAR_DOUBLE]',IRESP)
586  
587 KRESP = IRESP
588 END SUBROUTINE NCWRITX4
589
590 SUBROUTINE NCWRITX5(PZCDF, HVARNAME, HDIR, PFIELD, TPFMH, KRESP)
591 USE MODD_FM, ONLY : FMHEADER
592 TYPE(IOCDF), POINTER                   :: PZCDF
593 CHARACTER(LEN=*),           INTENT(IN) :: HVARNAME
594 CHARACTER(LEN=*),           INTENT(IN) :: HDIR
595 REAL, DIMENSION(:,:,:,:,:), INTENT(IN) :: PFIELD
596 TYPE(FMHEADER),             INTENT(IN) :: TPFMH
597 INTEGER,                    INTENT(OUT):: KRESP
598
599 INTEGER(KIND=IDCDF_KIND) :: STATUS
600 INTEGER(KIND=IDCDF_KIND) :: INCID
601 CHARACTER(LEN=30)     :: YVARNAME
602 INTEGER(KIND=IDCDF_KIND) :: IVARID
603 INTEGER(KIND=IDCDF_KIND), DIMENSION(SIZE(SHAPE(PFIELD))) :: IVDIMS
604 REAL(KIND=8),DIMENSION(:,:,:,:,:),ALLOCATABLE :: ZFIELD8
605 INTEGER               :: IRESP
606
607 IRESP = 0
608 ! Get the Netcdf file ID
609 INCID = PZCDF%NCID
610
611 ! NetCDF var names can't contain '%' nor '.' 
612 YVARNAME = str_replace(HVARNAME, '%', '__')
613 YVARNAME = str_replace(YVARNAME, '.', '--')
614
615 ! The variable should not already exist but who knows ?
616 STATUS = NF_INQ_VARID(INCID, YVARNAME, IVARID)
617 IF (STATUS /= NF_NOERR) THEN
618    ! Get the netcdf dimensions
619    CALL FILLVDIMS(PZCDF, INT(SHAPE(PFIELD),KIND=IDCDF_KIND), HDIR, IVDIMS)
620
621    ! Define the variable 
622    STATUS = NF_DEF_VAR(INCID, YVARNAME, NF_DOUBLE, INT(SIZE(IVDIMS),KIND=IDCDF_KIND), IVDIMS, IVARID)
623    IF (status /= NF_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCWRITX5[NF_DEF_VAR]')
624    CALL WRITATTR(INCID, IVARID, TPFMH)
625 ELSE
626    PRINT *,'NCWRITX5 : ', TRIM(YVARNAME), ' already defined !'
627 END IF
628
629 ! Write the data
630 #if defined(MNH_MPI_DOUBLE_PRECISION)
631 ! PFIELD REAL(KIND=8)
632 STATUS = NF_PUT_VAR_DOUBLE(INCID, IVARID, PFIELD)
633 #else
634 !! PFIELD REAL(KIND=4) saved as REAL(KIND=8)
635 ALLOCATE(ZFIELD8(SIZE(PFIELD,1),SIZE(PFIELD,2),SIZE(PFIELD,3),&
636      &SIZE(PFIELD,4),SIZE(PFIELD,5)))
637 ZFIELD8 = PFIELD
638 STATUS = NF_PUT_VAR_DOUBLE(INCID, IVARID, ZFIELD8)
639 DEALLOCATE(ZFIELD8) 
640 #endif
641 IF (status /= NF_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCWRITX5[NF_PUT_VAR_DOUBLE]',IRESP)
642  
643 KRESP = IRESP
644 END SUBROUTINE NCWRITX5
645
646 SUBROUTINE NCWRITX6(PZCDF, HVARNAME, HDIR, PFIELD, TPFMH, KRESP)
647 USE MODD_FM, ONLY : FMHEADER
648 TYPE(IOCDF), POINTER                     :: PZCDF
649 CHARACTER(LEN=*),             INTENT(IN) :: HVARNAME
650 CHARACTER(LEN=*),             INTENT(IN) :: HDIR
651 REAL, DIMENSION(:,:,:,:,:,:), INTENT(IN) :: PFIELD
652 TYPE(FMHEADER),               INTENT(IN) :: TPFMH
653 INTEGER,                      INTENT(OUT):: KRESP
654
655 INTEGER(KIND=IDCDF_KIND) :: STATUS
656 INTEGER(KIND=IDCDF_KIND) :: INCID
657 CHARACTER(LEN=30)     :: YVARNAME
658 INTEGER(KIND=IDCDF_KIND) :: IVARID
659 INTEGER(KIND=IDCDF_KIND), DIMENSION(SIZE(SHAPE(PFIELD))) :: IVDIMS
660 REAL(KIND=8),DIMENSION(:,:,:,:,:,:),ALLOCATABLE :: ZFIELD8
661 INTEGER               :: IRESP
662
663 IRESP = 0
664 ! Get the Netcdf file ID
665 INCID = PZCDF%NCID
666
667 ! NetCDF var names can't contain '%' nor '.' 
668 YVARNAME = str_replace(HVARNAME, '%', '__')
669 YVARNAME = str_replace(YVARNAME, '.', '--')
670
671 ! The variable should not already exist but who knows ?
672 STATUS = NF_INQ_VARID(INCID, YVARNAME, IVARID)
673 IF (STATUS /= NF_NOERR) THEN
674    ! Get the netcdf dimensions
675    CALL FILLVDIMS(PZCDF, INT(SHAPE(PFIELD),KIND=IDCDF_KIND), HDIR, IVDIMS)
676    
677    ! Define the variable 
678    STATUS = NF_DEF_VAR(INCID, YVARNAME, NF_DOUBLE, INT(SIZE(IVDIMS),KIND=IDCDF_KIND), IVDIMS, IVARID)
679    IF (status /= NF_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCWRITX6[NF_DEF_VAR]')
680    CALL WRITATTR(INCID, IVARID, TPFMH)
681 ELSE
682    PRINT *,'NCWRITX6 : ', TRIM(YVARNAME), ' already defined !'
683 END IF
684
685 ! Write the data
686 #if defined(MNH_MPI_DOUBLE_PRECISION)
687 ! PFIELD REAL(KIND=8)
688 STATUS = NF_PUT_VAR_DOUBLE(INCID, IVARID, PFIELD)
689 #else
690 !! PFIELD REAL(KIND=4) saved as REAL(KIND=8)
691 ALLOCATE(ZFIELD8(SIZE(PFIELD,1),SIZE(PFIELD,2),SIZE(PFIELD,3),&
692      &SIZE(PFIELD,4),SIZE(PFIELD,5),SIZE(PFIELD,6)))
693 ZFIELD8 = PFIELD
694 STATUS = NF_PUT_VAR_DOUBLE(INCID, IVARID, ZFIELD8)
695 DEALLOCATE(ZFIELD8) 
696 #endif
697 IF (status /= NF_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCWRITX6[NF_PUT_VAR_DOUBLE]',IRESP)
698  
699 KRESP = IRESP
700 END SUBROUTINE NCWRITX6
701
702 SUBROUTINE NCWRITN0(PZCDF, HVARNAME, HDIR, KFIELD, TPFMH, KRESP)
703 USE MODD_FM, ONLY : FMHEADER
704 USE MODD_PARAMETERS_ll,  ONLY : JPHEXT, JPVEXT
705 USE MODD_IO_ll, ONLY : LPACK,L1D,L2D
706 TYPE(IOCDF), POINTER             :: PZCDF
707 CHARACTER(LEN=*),     INTENT(IN) :: HVARNAME
708 CHARACTER(LEN=*),     INTENT(IN) :: HDIR
709 INTEGER,              INTENT(IN) :: KFIELD
710 TYPE(FMHEADER),       INTENT(IN) :: TPFMH
711 INTEGER,              INTENT(OUT):: KRESP
712
713 INTEGER(KIND=IDCDF_KIND) :: STATUS
714 INTEGER(KIND=IDCDF_KIND) :: INCID
715 CHARACTER(LEN=30) :: YVARNAME
716 INTEGER(KIND=IDCDF_KIND) :: IVARID
717 INTEGER(KIND=IDCDF_KIND),PARAMETER :: IZERO = 0
718 INTEGER           :: IRESP
719
720 IRESP = 0
721 ! Get the Netcdf file ID
722 INCID = PZCDF%NCID
723
724 ! NetCDF var names can't contain '%' nor '.' 
725 YVARNAME = str_replace(HVARNAME, '%', '__')
726 YVARNAME = str_replace(YVARNAME, '.', '--')
727
728 ! The variable should not already exist but who knows ?
729 STATUS = NF_INQ_VARID(INCID, YVARNAME, IVARID)
730 IF (STATUS /= NF_NOERR) THEN
731    ! Define the scalar variable 
732 #ifndef MNH_INT8
733    STATUS = NF_DEF_VAR(INCID, YVARNAME, NF_INT, IZERO, IZERO, IVARID)
734 #else
735    STATUS = NF_DEF_VAR(INCID, YVARNAME, NF_INT64, IZERO, IZERO, IVARID)
736 #endif
737    IF (status /= NF_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCWRITN0[NF_DEF_VAR]')
738    CALL WRITATTR(INCID, IVARID, TPFMH)
739 ELSE
740    PRINT *,'NCWRITN0 : ', TRIM(YVARNAME), ' already defined !'
741 END IF
742
743 ! Write the data
744 #ifndef MNH_INT8
745 STATUS = NF_PUT_VAR_INT(INCID, IVARID, INT(KFIELD,KIND=IDCDF_KIND))
746 IF (status /= NF_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCWRITN0[NF_PUT_VAR_INT]',IRESP)
747 #else
748 STATUS = NF_PUT_VAR_INT64(INCID, IVARID, KFIELD)
749 IF (status /= NF_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCWRITN0[NF_PUT_VAR_INT64]',IRESP)
750 #endif
751 !
752 ! Use IMAX, JMAX, KMAX to define DIMX, DIMY, DIMZ
753 ! /!\ Can only work if IMAX, JMAX or KMAX are written before any array
754 !
755 #if 0
756 IF (YVARNAME == 'IMAX' .AND. .NOT. ASSOCIATED(PZCDF%DIMX)) PZCDF%DIMX=>GETDIMCDF(PZCDF,KFIELD+2*JPHEXT,'X')
757 IF (YVARNAME == 'JMAX' .AND. .NOT. ASSOCIATED(PZCDF%DIMY)) THEN
758    IF (LPACK .AND. L2D) THEN
759       PZCDF%DIMY=>GETDIMCDF(PZCDF, 1,'Y')
760    ELSE
761       PZCDF%DIMY=>GETDIMCDF(PZCDF, KFIELD+2*JPHEXT, 'Y')
762    END IF
763 END IF
764 #endif
765 IF (YVARNAME == 'KMAX' .AND. .NOT. ASSOCIATED(PZCDF%DIMZ)) PZCDF%DIMZ=>GETDIMCDF(PZCDF,INT(KFIELD+2*JPVEXT,KIND=IDCDF_KIND),'Z')
766  
767 KRESP = IRESP
768 END SUBROUTINE NCWRITN0
769
770 SUBROUTINE NCWRITN1(PZCDF, HVARNAME, HDIR, KFIELD, TPFMH, KRESP)
771 USE MODD_FM, ONLY : FMHEADER
772 TYPE(IOCDF), POINTER              :: PZCDF
773 CHARACTER(LEN=*),      INTENT(IN) :: HVARNAME
774 CHARACTER(LEN=*),      INTENT(IN) :: HDIR
775 INTEGER, DIMENSION(:), INTENT(IN) :: KFIELD
776 TYPE(FMHEADER),        INTENT(IN) :: TPFMH
777 INTEGER,               INTENT(OUT):: KRESP
778
779 INTEGER(KIND=IDCDF_KIND) :: STATUS
780 INTEGER(KIND=IDCDF_KIND) :: INCID
781 CHARACTER(LEN=30)     :: YVARNAME
782 INTEGER(KIND=IDCDF_KIND) :: IVARID
783 INTEGER(KIND=IDCDF_KIND), DIMENSION(SIZE(SHAPE(KFIELD))) :: IVDIMS
784 INTEGER               :: IRESP
785
786 IRESP = 0
787 ! Get the Netcdf file ID
788 INCID = PZCDF%NCID
789
790 ! NetCDF var names can't contain '%' nor '.' 
791 YVARNAME = str_replace(HVARNAME, '%', '__')
792 YVARNAME = str_replace(YVARNAME, '.', '--')
793
794 ! The variable should not already exist but who knows ?
795 STATUS = NF_INQ_VARID(INCID, YVARNAME, IVARID)
796 IF (STATUS /= NF_NOERR) THEN
797    ! Get the netcdf dimensions
798    CALL FILLVDIMS(PZCDF, INT(SHAPE(KFIELD),KIND=IDCDF_KIND), HDIR, IVDIMS)
799 ! Define the variable 
800 #ifndef MNH_INT8
801    STATUS = NF_DEF_VAR(INCID, YVARNAME, NF_INT, INT(SIZE(IVDIMS),KIND=IDCDF_KIND), IVDIMS, IVARID)
802 #else
803    STATUS = NF_DEF_VAR(INCID, YVARNAME, NF_INT64, INT(SIZE(IVDIMS),KIND=IDCDF_KIND), IVDIMS, IVARID)
804 #endif
805    IF (status /= NF_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCWRITN1[NF_DEF_VAR] '//TRIM(YVARNAME))
806    CALL WRITATTR(INCID, IVARID, TPFMH)
807 ELSE
808    PRINT *,'NCWRITN1 : ', TRIM(YVARNAME), ' already defined !'
809 END IF
810
811 ! Write the data
812 #ifndef MNH_INT8
813 STATUS = NF_PUT_VAR_INT(INCID, IVARID, INT(KFIELD,KIND=IDCDF_KIND))
814 IF (status /= NF_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCWRITN1[NF_PUT_VAR_INT]',IRESP)
815 #else
816 STATUS = NF_PUT_VAR_INT64(INCID, IVARID, KFIELD)
817 IF (status /= NF_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCWRITN1[NF_PUT_VAR_INT64]',IRESP)
818 #endif
819
820 KRESP = IRESP 
821 END SUBROUTINE NCWRITN1
822
823 SUBROUTINE NCWRITN2(PZCDF, HVARNAME, HDIR, KFIELD, TPFMH, KRESP)
824 USE MODD_FM, ONLY : FMHEADER
825 TYPE(IOCDF), POINTER               :: PZCDF
826 CHARACTER(LEN=*),       INTENT(IN) :: HVARNAME
827 CHARACTER(LEN=*),       INTENT(IN) :: HDIR
828 INTEGER, DIMENSION(:,:),INTENT(IN) :: KFIELD
829 TYPE(FMHEADER),         INTENT(IN) :: TPFMH
830 INTEGER,                INTENT(OUT):: KRESP
831
832 INTEGER(KIND=IDCDF_KIND) :: STATUS
833 INTEGER(KIND=IDCDF_KIND) :: INCID
834 CHARACTER(LEN=30)     :: YVARNAME
835 INTEGER(KIND=IDCDF_KIND) :: IVARID
836 INTEGER(KIND=IDCDF_KIND), DIMENSION(SIZE(SHAPE(KFIELD))) :: IVDIMS
837 INTEGER               :: IRESP
838
839 IRESP = 0
840 ! Get the Netcdf file ID
841 INCID = PZCDF%NCID
842
843 ! NetCDF var names can't contain '%' nor '.' 
844 YVARNAME = str_replace(HVARNAME, '%', '__')
845 YVARNAME = str_replace(YVARNAME, '.', '--')
846
847 ! The variable should not already exist but who knows ?
848 STATUS = NF_INQ_VARID(INCID, YVARNAME, IVARID)
849 IF (STATUS /= NF_NOERR) THEN
850    ! Get the netcdf dimensions
851    CALL FILLVDIMS(PZCDF, INT(SHAPE(KFIELD),KIND=IDCDF_KIND), HDIR, IVDIMS)
852
853    ! Define the variable 
854 #ifndef MNH_INT8
855    STATUS = NF_DEF_VAR(INCID, YVARNAME, NF_INT, INT(SIZE(IVDIMS),KIND=IDCDF_KIND), IVDIMS, IVARID)
856 #else
857    STATUS = NF_DEF_VAR(INCID, YVARNAME, NF_INT64, INT(SIZE(IVDIMS),KIND=IDCDF_KIND), IVDIMS, IVARID)
858 #endif
859    IF (status /= NF_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCWRITN2[NF_DEF_VAR]')
860    CALL WRITATTR(INCID, IVARID, TPFMH)
861 ELSE
862    PRINT *,'NCWRITN2 : ', TRIM(YVARNAME), ' already defined !'
863 END IF
864
865 ! Write the data
866 #ifndef MNH_INT8
867 STATUS = NF_PUT_VAR_INT(INCID, IVARID, INT(KFIELD,KIND=IDCDF_KIND))
868 IF (status /= NF_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCWRITN2[NF_PUT_VAR_INT]',IRESP)
869 #else
870 STATUS = NF_PUT_VAR_INT64(INCID, IVARID, KFIELD)
871 IF (status /= NF_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCWRITN2[NF_PUT_VAR_INT64]',IRESP)
872 #endif
873
874 KRESP = IRESP
875 END SUBROUTINE NCWRITN2
876
877 SUBROUTINE NCWRITC0(PZCDF, HVARNAME, HDIR, HFIELD, TPFMH, KRESP)
878 USE MODD_FM, ONLY : FMHEADER
879 TYPE(IOCDF), POINTER              :: PZCDF
880 CHARACTER(LEN=*),      INTENT(IN) :: HVARNAME
881 CHARACTER(LEN=*),      INTENT(IN) :: HDIR
882 CHARACTER(LEN=*),      INTENT(IN) :: HFIELD
883 TYPE(FMHEADER),        INTENT(IN) :: TPFMH
884 INTEGER,               INTENT(OUT):: KRESP
885
886 INTEGER(KIND=IDCDF_KIND) :: STATUS
887 INTEGER(KIND=IDCDF_KIND) :: INCID
888 CHARACTER(LEN=30)     :: YVARNAME
889 INTEGER(KIND=IDCDF_KIND) :: IVARID
890 INTEGER(KIND=IDCDF_KIND), DIMENSION(1) :: IVDIMS
891 CHARACTER(LEN=32)     :: YSTR
892 !CHARACTER(LEN=LEN(HFIELD)) :: YSTR
893 INTEGER               :: IRESP
894
895 IRESP = 0
896 YSTR = HFIELD
897 IF (LEN_TRIM(HFIELD) > LEN(YSTR)) THEN
898    PRINT *,'NCWRIT0 : ',TRIM(YVARNAME), ' string variable TRUNCATED.'
899 END IF
900
901 ! Get the Netcdf file ID
902 INCID = PZCDF%NCID
903
904 ! NetCDF var names can't contain '%' nor '.' 
905 YVARNAME = str_replace(HVARNAME, '%', '__')
906 YVARNAME = str_replace(YVARNAME, '.', '--')
907
908 ! The variable should not already exist but who knows ?
909 STATUS = NF_INQ_VARID(INCID, YVARNAME, IVARID)
910 IF (STATUS /= NF_NOERR) THEN
911    ! Get the netcdf string dimensions id 
912    IVDIMS(1) = GETSTRDIMID(PZCDF, INT(LEN(YSTR),KIND=IDCDF_KIND))
913    ! Define the variable 
914    STATUS = NF_DEF_VAR(INCID, YVARNAME, NF_CHAR, INT(SIZE(IVDIMS),KIND=IDCDF_KIND), IVDIMS, IVARID)
915    IF (status /= NF_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCWRITC0[NF_DEF_VAR]')
916    CALL WRITATTR(INCID, IVARID, TPFMH)
917 ELSE
918    PRINT *,'NCWRITC0 : ', TRIM(YVARNAME), ' already defined !'
919 END IF
920
921 ! Write the data
922 STATUS = NF_PUT_VAR_TEXT(INCID, IVARID, YSTR)
923 IF (status /= NF_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCWRITC0[NF_PUT_VAR_TEXT]',IRESP)
924  
925 KRESP = IRESP
926 END SUBROUTINE NCWRITC0
927
928 SUBROUTINE NCWRITC1(PZCDF, HVARNAME, HDIR, HFIELD, TPFMH, KRESP)
929 USE MODD_FM, ONLY : FMHEADER
930 TYPE(IOCDF),        POINTER              :: PZCDF
931 CHARACTER(LEN=*),             INTENT(IN) :: HVARNAME
932 CHARACTER(LEN=*),             INTENT(IN) :: HDIR
933 CHARACTER(LEN=*),DIMENSION(:),INTENT(IN) :: HFIELD
934 TYPE(FMHEADER),               INTENT(IN) :: TPFMH
935 INTEGER,                      INTENT(OUT):: KRESP
936
937 INTEGER(KIND=IDCDF_KIND) :: STATUS
938 INTEGER(KIND=IDCDF_KIND) :: INCID
939 CHARACTER(LEN=30)     :: YVARNAME
940 INTEGER(KIND=IDCDF_KIND) :: IVARID
941 INTEGER(KIND=IDCDF_KIND), DIMENSION(2) :: IVDIMS
942 INTEGER(KIND=IDCDF_KIND), DIMENSION(1) :: ITMP
943 INTEGER               :: IRESP
944 INTEGER(KIND=IDCDF_KIND) :: ILEN
945 INTEGER(KIND=IDCDF_KIND) :: ISIZE
946 INTEGER(KIND=IDCDF_KIND),PARAMETER :: IONE=1
947
948 IRESP = 0
949 ILEN  = LEN(HFIELD)
950 ISIZE = SIZE(HFIELD)
951
952 ! Get the Netcdf file ID
953 INCID = PZCDF%NCID
954
955 ! NetCDF var names can't contain '%' nor '.' 
956 YVARNAME = str_replace(HVARNAME, '%', '__')
957 YVARNAME = str_replace(YVARNAME, '.', '--')
958
959 ! The variable should not already exist but who knows ?
960 STATUS = NF_INQ_VARID(INCID, YVARNAME, IVARID)
961 IF (STATUS /= NF_NOERR) THEN
962    ! Get the netcdf dimensions ID 
963    IVDIMS(1) = GETSTRDIMID(PZCDF,ILEN)
964    CALL FILLVDIMS(PZCDF, (/ISIZE/), HDIR, ITMP)
965    IVDIMS(2) = ITMP(1)
966    ! Define the variable 
967    STATUS = NF_DEF_VAR(INCID, YVARNAME, NF_CHAR, INT(SIZE(IVDIMS),KIND=IDCDF_KIND), IVDIMS, IVARID)
968    IF (status /= NF_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCWRITC1[NF_DEF_VAR]')
969    CALL WRITATTR(INCID, IVARID, TPFMH)
970 ELSE
971    PRINT *,'NCWRITC1 : ', TRIM(YVARNAME), ' already defined !'
972 END IF
973
974 ! Write the data
975 STATUS = NF_PUT_VARA_TEXT(INCID, IVARID, (/IONE,IONE/),(/ILEN,ISIZE/), HFIELD)
976 IF (status /= NF_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCWRITC1[NF_PUT_VARA_TEXT]',IRESP)
977  
978 KRESP = IRESP
979 END SUBROUTINE NCWRITC1
980
981 !
982 !
983 ! Here come the NetCDF READ routines
984 !
985 !
986 SUBROUTINE READATTR(KNCID, KVARID, HVAR, TPFMH)
987 USE MODD_FM, ONLY : FMHEADER, JPXKRK
988 INTEGER(KIND=IDCDF_KIND),INTENT(IN) :: KNCID
989 INTEGER(KIND=IDCDF_KIND),INTENT(IN) :: KVARID
990 CHARACTER(LEN=*),INTENT(IN) :: HVAR
991 TYPE(FMHEADER),  INTENT(OUT):: TPFMH
992
993 INTEGER(KIND=IDCDF_KIND) :: STATUS
994 INTEGER(KIND=IDCDF_KIND) :: ICOMLEN
995       
996 ! Read variables attributes (GRID and COMMENT)
997 STATUS = NF_GET_ATT_INT(KNCID, KVARID, 'GRID', TPFMH%GRID)
998 IF (STATUS /= NF_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'READATTR[NF_GET_ATT_INT] '//TRIM(HVAR))
999 STATUS = NF_INQ_ATTLEN(KNCID, KVARID, 'COMMENT', ICOMLEN)
1000 IF (STATUS /= NF_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'READATTR[NF_INQ_ATTLEN] '//TRIM(HVAR))
1001 IF (ICOMLEN <= JPXKRK) THEN
1002    TPFMH%COMLEN = ICOMLEN
1003    STATUS = NF_GET_ATT_TEXT(KNCID, KVARID, 'COMMENT', TPFMH%COMMENT)
1004    IF (STATUS /= NF_NOERR) CALL HANDLE_ERR(status,__LINE__,'READATTR[NF_GET_ATT_TEXT] '//TRIM(HVAR))
1005 ELSE
1006    PRINT *, 'READATTR : '//TRIM(HVAR)//' COMMENT attribute ignored because too long.'
1007    TPFMH%COMLEN = 0
1008 END IF
1009 END SUBROUTINE READATTR
1010
1011 SUBROUTINE NCREADX0(KNCID, HVARNAME, PFIELD, TPFMH, KRESP)
1012 USE MODD_FM, ONLY : FMHEADER, JPXKRK
1013 INTEGER(KIND=IDCDF_KIND),INTENT(IN) :: KNCID
1014 CHARACTER(LEN=*), INTENT(IN) :: HVARNAME
1015 REAL,             INTENT(OUT):: PFIELD
1016 TYPE(FMHEADER),   INTENT(OUT):: TPFMH
1017 INTEGER,          INTENT(OUT):: KRESP  ! return-code
1018
1019 INTEGER(KIND=IDCDF_KIND) :: STATUS
1020 CHARACTER(LEN=30) :: YVARNAME
1021 INTEGER(KIND=IDCDF_KIND) :: IVARID
1022 INTEGER(KIND=IDCDF_KIND) :: ITYPE   ! variable type
1023 INTEGER(KIND=IDCDF_KIND) :: IDIMS   ! number of dimensions
1024 INTEGER(KIND=IDCDF_KIND) :: ICOMLEN ! comment length
1025 REAL(KIND=8)      :: ZFIELD8
1026 INTEGER           :: IRESP
1027
1028 IRESP = 0
1029
1030 ! NetCDF var names can't contain '%' nor '.' 
1031 YVARNAME = str_replace(HVARNAME, '%', '__')
1032 YVARNAME = str_replace(YVARNAME, '.', '--')
1033
1034 ! Get variable ID, NDIMS and TYPE
1035 STATUS = NF_INQ_VARID(KNCID, YVARNAME, IVARID)
1036 IF (STATUS /= NF_NOERR) THEN
1037    CALL HANDLE_ERR(status,__LINE__,'NCREADX0[NF_INQ_VARID] '//TRIM(YVARNAME),IRESP)
1038    GOTO 1000
1039 END IF
1040 STATUS = NF_INQ_VARNDIMS(KNCID, IVARID, IDIMS)
1041 IF (STATUS /= NF_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'NCREADX0[NF_INQ_VARNDIMS] '//TRIM(YVARNAME))
1042 STATUS = NF_INQ_VARTYPE(KNCID, IVARID, ITYPE)
1043 IF (STATUS /= NF_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'NCREADX0[NF_INQ_VARTYPE] '//TRIM(YVARNAME))
1044
1045 IF (IDIMS == 0 .AND. ITYPE == NF_DOUBLE) THEN
1046    ! Read variable
1047 #if defined(MNH_MPI_DOUBLE_PRECISION)
1048    STATUS = NF_GET_VAR_DOUBLE(KNCID, IVARID, PFIELD)
1049 #else
1050    STATUS = NF_GET_VAR_DOUBLE(KNCID, IVARID, ZFIELD8)
1051    PFIELD = ZFIELD8
1052 #endif
1053    IF (STATUS /= NF_NOERR) THEN
1054       CALL HANDLE_ERR(status,__LINE__,'NCREADX0[NF_GET_VAR_DOUBLE] '//TRIM(YVARNAME),IRESP)
1055       GOTO 1000
1056    END IF
1057    ! Read variables attributes (GRID and COMMENT)
1058    CALL READATTR(KNCID, IVARID, YVARNAME, TPFMH)
1059 ELSE
1060    PRINT *, 'NCREADNCREADX0 : '//TRIM(YVARNAME)//' not READ (wrong size or type).'
1061    IRESP = -3
1062 END IF
1063
1064 1000 CONTINUE
1065 KRESP = IRESP
1066
1067 END SUBROUTINE NCREADX0
1068
1069 SUBROUTINE NCREADX1(KNCID, HVARNAME, PFIELD, TPFMH, KRESP)
1070 USE MODD_FM, ONLY : FMHEADER, JPXKRK
1071 INTEGER(KIND=IDCDF_KIND),INTENT(IN) :: KNCID
1072 CHARACTER(LEN=*),   INTENT(IN) :: HVARNAME
1073 REAL, DIMENSION(:), INTENT(OUT):: PFIELD
1074 TYPE(FMHEADER),     INTENT(OUT):: TPFMH
1075 INTEGER,            INTENT(OUT):: KRESP  ! return-code
1076
1077 INTEGER(KIND=IDCDF_KIND) :: STATUS
1078 CHARACTER(LEN=30)     :: YVARNAME
1079 INTEGER(KIND=IDCDF_KIND) :: IVARID
1080 INTEGER(KIND=IDCDF_KIND) :: ITYPE   ! variable type
1081 INTEGER(KIND=IDCDF_KIND) :: IDIMS   ! number of dimensions
1082 INTEGER(KIND=IDCDF_KIND), DIMENSION(SIZE(SHAPE(PFIELD))) :: IVDIMS
1083 REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: ZFIELD8
1084 INTEGER(KIND=IDCDF_KIND) :: ICOMLEN ! comment length
1085 INTEGER               :: IVARSIZE
1086 INTEGER(KIND=IDCDF_KIND) :: IDIMLEN
1087 INTEGER               :: II
1088 INTEGER               :: IRESP
1089
1090 IRESP = 0
1091
1092 ! NetCDF var names can't contain '%' nor '.' 
1093 YVARNAME = str_replace(HVARNAME, '%', '__')
1094 YVARNAME = str_replace(YVARNAME, '.', '--')
1095
1096 ! Get variable ID, NDIMS and TYPE
1097 STATUS = NF_INQ_VARID(KNCID, YVARNAME, IVARID)
1098 IF (STATUS /= NF_NOERR) THEN
1099    CALL HANDLE_ERR(status,__LINE__,'NCREADX1[NF_INQ_VARID] '//TRIM(YVARNAME),IRESP)
1100    GOTO 1000
1101 END IF
1102 STATUS = NF_INQ_VARNDIMS(KNCID, IVARID, IDIMS)
1103 IF (STATUS /= NF_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'NCREADX1[NF_INQ_VARNDIMS] '//TRIM(YVARNAME))
1104 STATUS = NF_INQ_VARTYPE(KNCID, IVARID, ITYPE)
1105 IF (STATUS /= NF_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'NCREADX1[NF_INQ_VARTYPE] '//TRIM(YVARNAME))
1106
1107 IF (IDIMS == SIZE(SHAPE(PFIELD)) .AND. ITYPE == NF_DOUBLE) THEN
1108    ! Check size of variable before reading
1109    STATUS = NF_INQ_VARDIMID(KNCID, IVARID, IVDIMS)
1110    IF (status /= NF_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCREADX1[NF_INQ_VARDIMID] '//TRIM(YVARNAME))
1111    IVARSIZE = 1
1112    DO II=1,IDIMS
1113       STATUS = NF_INQ_DIMLEN(KNCID,IVDIMS(II),IDIMLEN)
1114       IF (STATUS /= NF_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCREADX1[NF_INQ_DIMLEN] '//TRIM(YVARNAME))
1115       IVARSIZE = IVARSIZE*IDIMLEN
1116    END DO
1117    
1118    IF (IVARSIZE == SIZE(PFIELD)) THEN
1119       ! Read variable
1120 #if defined(MNH_MPI_DOUBLE_PRECISION)
1121       STATUS = NF_GET_VAR_DOUBLE(KNCID, IVARID, PFIELD)
1122 #else
1123       ALLOCATE(ZFIELD8(SIZE(PFIELD)))
1124       STATUS = NF_GET_VAR_DOUBLE(KNCID, IVARID, ZFIELD8)
1125       PFIELD = ZFIELD8
1126       DEALLOCATE(ZFIELD8)
1127 #endif
1128       IF (STATUS /= NF_NOERR) THEN
1129          CALL HANDLE_ERR(status,__LINE__,'NCREADX1[NF_GET_VAR_DOUBLE] '//TRIM(YVARNAME),IRESP)
1130          GOTO 1000
1131       END IF
1132       ! Read variables attributes (GRID and COMMENT)
1133       CALL READATTR(KNCID, IVARID, YVARNAME, TPFMH)
1134    ELSE
1135       PRINT *, 'NCREADX1 : '//TRIM(YVARNAME)//' not READ wrong size (file, mem) : ', IVARSIZE, SIZE(PFIELD)
1136       IRESP = -3
1137    END IF
1138 ELSE
1139    PRINT *, 'NCREADX1 : '//TRIM(YVARNAME)//' not READ (wrong shape or type).'
1140    IRESP = -3
1141 END IF
1142
1143 1000 CONTINUE
1144 KRESP = IRESP
1145
1146 END SUBROUTINE NCREADX1
1147
1148 SUBROUTINE NCREADX2(KNCID, HVARNAME, PFIELD, TPFMH, KRESP)
1149 USE MODD_FM, ONLY : FMHEADER, JPXKRK
1150 INTEGER(KIND=IDCDF_KIND),INTENT(IN) :: KNCID
1151 CHARACTER(LEN=*),     INTENT(IN) :: HVARNAME
1152 REAL, DIMENSION(:,:), INTENT(OUT):: PFIELD
1153 TYPE(FMHEADER),       INTENT(OUT):: TPFMH
1154 INTEGER,              INTENT(OUT):: KRESP  ! return-code
1155
1156 INTEGER(KIND=IDCDF_KIND) :: STATUS
1157 CHARACTER(LEN=30)     :: YVARNAME
1158 INTEGER(KIND=IDCDF_KIND) :: IVARID
1159 INTEGER(KIND=IDCDF_KIND) :: ITYPE   ! variable type
1160 INTEGER(KIND=IDCDF_KIND) :: IDIMS   ! number of dimensions
1161 INTEGER(KIND=IDCDF_KIND), DIMENSION(SIZE(SHAPE(PFIELD))) :: IVDIMS
1162 REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: ZFIELD8
1163 INTEGER(KIND=IDCDF_KIND) :: ICOMLEN ! comment length
1164 INTEGER               :: IVARSIZE
1165 INTEGER(KIND=IDCDF_KIND) :: IDIMLEN
1166 INTEGER               :: II
1167 INTEGER               :: IRESP
1168
1169 IRESP = 0
1170
1171 ! NetCDF var names can't contain '%' nor '.' 
1172 YVARNAME = str_replace(HVARNAME, '%', '__')
1173 YVARNAME = str_replace(YVARNAME, '.', '--')
1174
1175 ! Get variable ID, NDIMS and TYPE
1176 STATUS = NF_INQ_VARID(KNCID, YVARNAME, IVARID)
1177 IF (STATUS /= NF_NOERR) THEN
1178    CALL HANDLE_ERR(status,__LINE__,'NCREADX2[NF_INQ_VARID] '//TRIM(YVARNAME),IRESP)
1179    GOTO 1000
1180 END IF
1181 STATUS = NF_INQ_VARNDIMS(KNCID, IVARID, IDIMS)
1182 IF (STATUS /= NF_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'NCREADX2[NF_INQ_VARNDIMS] '//TRIM(YVARNAME))
1183 STATUS = NF_INQ_VARTYPE(KNCID, IVARID, ITYPE)
1184 IF (STATUS /= NF_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'NCREADX2[NF_INQ_VARTYPE] '//TRIM(YVARNAME))
1185
1186 IF (IDIMS == SIZE(SHAPE(PFIELD)) .AND. ITYPE == NF_DOUBLE) THEN
1187    ! Check size of variable before reading
1188    STATUS = NF_INQ_VARDIMID(KNCID, IVARID, IVDIMS)
1189    IF (status /= NF_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCREADX2[NF_INQ_VARDIMID] '//TRIM(YVARNAME))
1190    IVARSIZE = 1
1191    DO II=1,IDIMS
1192       STATUS = NF_INQ_DIMLEN(KNCID,IVDIMS(II),IDIMLEN)
1193       IF (STATUS /= NF_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCREADX2[NF_INQ_DIMLEN] '//TRIM(YVARNAME))
1194       IVARSIZE = IVARSIZE*IDIMLEN
1195    END DO
1196    
1197    IF (IVARSIZE == SIZE(PFIELD)) THEN
1198       ! Read variable
1199 #if defined(MNH_MPI_DOUBLE_PRECISION)
1200       STATUS = NF_GET_VAR_DOUBLE(KNCID, IVARID, PFIELD)
1201 #else
1202       ! REAL(KIND=4) was stored as REAL(KIND=8)
1203       ALLOCATE(ZFIELD8(SIZE(PFIELD,1),SIZE(PFIELD,2)))
1204       STATUS = NF_GET_VAR_DOUBLE(KNCID, IVARID, ZFIELD8)
1205       PFIELD = ZFIELD8
1206       DEALLOCATE(ZFIELD8)
1207 #endif
1208       IF (STATUS /= NF_NOERR) THEN
1209          CALL HANDLE_ERR(status,__LINE__,'NCREADX2[NF_GET_VAR_DOUBLE] '//TRIM(YVARNAME),IRESP)
1210          GOTO 1000
1211       END IF
1212       ! Read variables attributes (GRID and COMMENT)
1213       CALL READATTR(KNCID, IVARID, YVARNAME, TPFMH)
1214    ELSE
1215       PRINT *, 'NCREADX2 : '//TRIM(YVARNAME)//' not READ (wrong size).'
1216       IRESP = -3
1217    END IF
1218 ELSE
1219    PRINT *, 'NCREADX2 : '//TRIM(YVARNAME)//' not READ (wrong shape or type).'
1220    IRESP = -3
1221 END IF
1222
1223 1000 CONTINUE
1224 KRESP = IRESP
1225
1226 END SUBROUTINE NCREADX2
1227
1228 SUBROUTINE NCREADX3(KNCID, HVARNAME, PFIELD, TPFMH, KRESP)
1229 USE MODD_FM, ONLY : FMHEADER, JPXKRK
1230 INTEGER(KIND=IDCDF_KIND),INTENT(IN) :: KNCID
1231 CHARACTER(LEN=*),       INTENT(IN) :: HVARNAME
1232 REAL, DIMENSION(:,:,:), INTENT(OUT):: PFIELD
1233 TYPE(FMHEADER),         INTENT(OUT):: TPFMH
1234 INTEGER,                INTENT(OUT):: KRESP  ! return-code
1235
1236 INTEGER(KIND=IDCDF_KIND) :: STATUS
1237 CHARACTER(LEN=30)     :: YVARNAME
1238 INTEGER(KIND=IDCDF_KIND) :: IVARID
1239 INTEGER(KIND=IDCDF_KIND) :: ITYPE   ! variable type
1240 INTEGER(KIND=IDCDF_KIND) :: IDIMS   ! number of dimensions
1241 INTEGER(KIND=IDCDF_KIND), DIMENSION(SIZE(SHAPE(PFIELD))) :: IVDIMS
1242 REAL(KIND=8), DIMENSION(:,:,:), ALLOCATABLE :: ZFIELD8
1243 INTEGER(KIND=IDCDF_KIND) :: ICOMLEN ! comment length
1244 INTEGER               :: IVARSIZE
1245 INTEGER(KIND=IDCDF_KIND) :: IDIMLEN
1246 INTEGER               :: II
1247 INTEGER               :: IRESP
1248
1249 IRESP = 0
1250
1251 ! NetCDF var names can't contain '%' nor '.' 
1252 YVARNAME = str_replace(HVARNAME, '%', '__')
1253 YVARNAME = str_replace(YVARNAME, '.', '--')
1254
1255 ! Get variable ID, NDIMS and TYPE
1256 STATUS = NF_INQ_VARID(KNCID, YVARNAME, IVARID)
1257 IF (STATUS /= NF_NOERR) THEN
1258    CALL HANDLE_ERR(status,__LINE__,'NCREADX3[NF_INQ_VARID] '//TRIM(YVARNAME),IRESP)
1259    GOTO 1000
1260 END IF
1261 STATUS = NF_INQ_VARNDIMS(KNCID, IVARID, IDIMS)
1262 IF (STATUS /= NF_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'NCREADX3[NF_INQ_VARNDIMS] '//TRIM(YVARNAME))
1263 STATUS = NF_INQ_VARTYPE(KNCID, IVARID, ITYPE)
1264 IF (STATUS /= NF_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'NCREADX3[NF_INQ_VARTYPE] '//TRIM(YVARNAME))
1265
1266 IF (IDIMS == SIZE(SHAPE(PFIELD)) .AND. ITYPE == NF_DOUBLE) THEN
1267    ! Check size of variable before reading
1268    STATUS = NF_INQ_VARDIMID(KNCID, IVARID, IVDIMS)
1269    IF (status /= NF_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCREADX3[NF_INQ_VARDIMID] '//TRIM(YVARNAME))
1270    IVARSIZE = 1
1271    DO II=1,IDIMS
1272       STATUS = NF_INQ_DIMLEN(KNCID,IVDIMS(II),IDIMLEN)
1273       IF (STATUS /= NF_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCREADX3[NF_INQ_DIMLEN] '//TRIM(YVARNAME))
1274       IVARSIZE = IVARSIZE*IDIMLEN
1275    END DO
1276    
1277    IF (IVARSIZE == SIZE(PFIELD)) THEN
1278       ! Read variable
1279 #if defined(MNH_MPI_DOUBLE_PRECISION)
1280       STATUS = NF_GET_VAR_DOUBLE(KNCID, IVARID, PFIELD)
1281 #else
1282       ! REAL(KIND=4) was stored as REAL(KIND=8)
1283       ALLOCATE(ZFIELD8(SIZE(PFIELD,1),SIZE(PFIELD,2),SIZE(PFIELD,3)))
1284       STATUS = NF_GET_VAR_DOUBLE(KNCID, IVARID, ZFIELD8)
1285       PFIELD = ZFIELD8
1286       DEALLOCATE(ZFIELD8)
1287 #endif
1288       IF (STATUS /= NF_NOERR) THEN
1289          CALL HANDLE_ERR(status,__LINE__,'NCREADX3[NF_GET_VAR_DOUBLE] '//TRIM(YVARNAME),IRESP)
1290          GOTO 1000
1291       END IF
1292       ! Read variables attributes (GRID and COMMENT)
1293       CALL READATTR(KNCID, IVARID, YVARNAME, TPFMH)
1294    ELSE
1295       PRINT *, 'NCREADX3 : '//TRIM(YVARNAME)//' not READ (wrong size).'
1296       IRESP = -3
1297    END IF
1298 ELSE
1299    PRINT *, 'NCREADX3 : '//TRIM(YVARNAME)//' not READ (wrong shape or type).'
1300    IRESP = -3
1301 END IF
1302
1303 1000 CONTINUE
1304 KRESP = IRESP
1305
1306 END SUBROUTINE NCREADX3
1307
1308 SUBROUTINE NCREADX4(KNCID, HVARNAME, PFIELD, TPFMH, KRESP)
1309 USE MODD_FM, ONLY : FMHEADER, JPXKRK
1310 INTEGER(KIND=IDCDF_KIND), INTENT(IN) :: KNCID
1311 CHARACTER(LEN=*),         INTENT(IN) :: HVARNAME
1312 REAL, DIMENSION(:,:,:,:), INTENT(OUT):: PFIELD
1313 TYPE(FMHEADER),           INTENT(OUT):: TPFMH
1314 INTEGER,                  INTENT(OUT):: KRESP  ! return-code
1315
1316 INTEGER(KIND=IDCDF_KIND) :: STATUS
1317 CHARACTER(LEN=30)     :: YVARNAME
1318 INTEGER(KIND=IDCDF_KIND) :: IVARID
1319 INTEGER(KIND=IDCDF_KIND) :: ITYPE   ! variable type
1320 INTEGER(KIND=IDCDF_KIND) :: IDIMS   ! number of dimensions
1321 INTEGER(KIND=IDCDF_KIND), DIMENSION(SIZE(SHAPE(PFIELD))) :: IVDIMS
1322 REAL(KIND=8), DIMENSION(:,:,:,:), ALLOCATABLE :: ZFIELD8
1323 INTEGER(KIND=IDCDF_KIND) :: ICOMLEN ! comment length
1324 INTEGER               :: IVARSIZE
1325 INTEGER(KIND=IDCDF_KIND) :: IDIMLEN
1326 INTEGER               :: II
1327 INTEGER               :: IRESP
1328
1329 IRESP = 0
1330
1331 ! NetCDF var names can't contain '%' nor '.' 
1332 YVARNAME = str_replace(HVARNAME, '%', '__')
1333 YVARNAME = str_replace(YVARNAME, '.', '--')
1334
1335 ! Get variable ID, NDIMS and TYPE
1336 STATUS = NF_INQ_VARID(KNCID, YVARNAME, IVARID)
1337 IF (STATUS /= NF_NOERR) THEN
1338    CALL HANDLE_ERR(status,__LINE__,'NCREADX4[NF_INQ_VARID] '//TRIM(YVARNAME),IRESP)
1339    GOTO 1000
1340 END IF
1341 STATUS = NF_INQ_VARNDIMS(KNCID, IVARID, IDIMS)
1342 IF (STATUS /= NF_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'NCREADX4[NF_INQ_VARNDIMS] '//TRIM(YVARNAME))
1343 STATUS = NF_INQ_VARTYPE(KNCID, IVARID, ITYPE)
1344 IF (STATUS /= NF_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'NCREADX4[NF_INQ_VARTYPE] '//TRIM(YVARNAME))
1345
1346 IF (IDIMS == SIZE(SHAPE(PFIELD)) .AND. ITYPE == NF_DOUBLE) THEN
1347    ! Check size of variable before reading
1348    STATUS = NF_INQ_VARDIMID(KNCID, IVARID, IVDIMS)
1349    IF (status /= NF_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCREADX4[NF_INQ_VARDIMID] '//TRIM(YVARNAME))
1350    IVARSIZE = 1
1351    DO II=1,IDIMS
1352       STATUS = NF_INQ_DIMLEN(KNCID,IVDIMS(II),IDIMLEN)
1353       IF (STATUS /= NF_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCREADX4[NF_INQ_DIMLEN] '//TRIM(YVARNAME))
1354       IVARSIZE = IVARSIZE*IDIMLEN
1355    END DO
1356    
1357    IF (IVARSIZE == SIZE(PFIELD)) THEN
1358       ! Read variable
1359 #if defined(MNH_MPI_DOUBLE_PRECISION)
1360       STATUS = NF_GET_VAR_DOUBLE(KNCID, IVARID, PFIELD)
1361 #else
1362       ! REAL(KIND=4) was stored as REAL(KIND=8)
1363       ALLOCATE(ZFIELD8(SIZE(PFIELD,1),SIZE(PFIELD,2),SIZE(PFIELD,3),&
1364            &SIZE(PFIELD,4)))
1365       STATUS = NF_GET_VAR_DOUBLE(KNCID, IVARID, ZFIELD8)
1366       PFIELD = ZFIELD8
1367       DEALLOCATE(ZFIELD8)
1368 #endif
1369       IF (STATUS /= NF_NOERR) THEN
1370          CALL HANDLE_ERR(status,__LINE__,'NCREADX4[NF_GET_VAR_DOUBLE] '//TRIM(YVARNAME),IRESP)
1371          GOTO 1000
1372       END IF
1373       ! Read variables attributes (GRID and COMMENT)
1374       CALL READATTR(KNCID, IVARID, YVARNAME, TPFMH)
1375    ELSE
1376       PRINT *, 'NCREADX4 : '//TRIM(YVARNAME)//' not READ (wrong size).'
1377       IRESP = -3
1378    END IF
1379 ELSE
1380    PRINT *, 'NCREADX4 : '//TRIM(YVARNAME)//' not READ (wrong shape or type).'
1381    IRESP = -3
1382 END IF
1383
1384 1000 CONTINUE
1385 KRESP = IRESP
1386
1387 END SUBROUTINE NCREADX4
1388
1389 SUBROUTINE NCREADX5(KNCID, HVARNAME, PFIELD, TPFMH, KRESP)
1390 USE MODD_FM, ONLY : FMHEADER, JPXKRK
1391 INTEGER(KIND=IDCDF_KIND),   INTENT(IN) :: KNCID
1392 CHARACTER(LEN=*),           INTENT(IN) :: HVARNAME
1393 REAL, DIMENSION(:,:,:,:,:), INTENT(OUT):: PFIELD
1394 TYPE(FMHEADER),             INTENT(OUT):: TPFMH
1395 INTEGER,                    INTENT(OUT):: KRESP  ! return-code
1396
1397 INTEGER(KIND=IDCDF_KIND) :: STATUS
1398 CHARACTER(LEN=30)     :: YVARNAME
1399 INTEGER(KIND=IDCDF_KIND) :: IVARID
1400 INTEGER(KIND=IDCDF_KIND) :: ITYPE   ! variable type
1401 INTEGER(KIND=IDCDF_KIND) :: IDIMS   ! number of dimensions
1402 INTEGER(KIND=IDCDF_KIND), DIMENSION(SIZE(SHAPE(PFIELD))) :: IVDIMS
1403 REAL(KIND=8), DIMENSION(:,:,:,:,:), ALLOCATABLE :: ZFIELD8
1404 INTEGER(KIND=IDCDF_KIND) :: ICOMLEN ! comment length
1405 INTEGER               :: IVARSIZE
1406 INTEGER(KIND=IDCDF_KIND) :: IDIMLEN
1407 INTEGER               :: II
1408 INTEGER               :: IRESP
1409
1410 IRESP = 0
1411
1412 ! NetCDF var names can't contain '%' nor '.' 
1413 YVARNAME = str_replace(HVARNAME, '%', '__')
1414 YVARNAME = str_replace(YVARNAME, '.', '--')
1415
1416 ! Get variable ID, NDIMS and TYPE
1417 STATUS = NF_INQ_VARID(KNCID, YVARNAME, IVARID)
1418 IF (STATUS /= NF_NOERR) THEN
1419    CALL HANDLE_ERR(status,__LINE__,'NCREADX5[NF_INQ_VARID] '//TRIM(YVARNAME),IRESP)
1420    GOTO 1000
1421 END IF
1422 STATUS = NF_INQ_VARNDIMS(KNCID, IVARID, IDIMS)
1423 IF (STATUS /= NF_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'NCREADX5[NF_INQ_VARNDIMS] '//TRIM(YVARNAME))
1424 STATUS = NF_INQ_VARTYPE(KNCID, IVARID, ITYPE)
1425 IF (STATUS /= NF_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'NCREADX5[NF_INQ_VARTYPE] '//TRIM(YVARNAME))
1426
1427 IF (IDIMS == SIZE(SHAPE(PFIELD)) .AND. ITYPE == NF_DOUBLE) THEN
1428    ! Check size of variable before reading
1429    STATUS = NF_INQ_VARDIMID(KNCID, IVARID, IVDIMS)
1430    IF (status /= NF_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCREADX5[NF_INQ_VARDIMID] '//TRIM(YVARNAME))
1431    IVARSIZE = 1
1432    DO II=1,IDIMS
1433       STATUS = NF_INQ_DIMLEN(KNCID,IVDIMS(II),IDIMLEN)
1434       IF (STATUS /= NF_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCREADX5[NF_INQ_DIMLEN] '//TRIM(YVARNAME))
1435       IVARSIZE = IVARSIZE*IDIMLEN
1436    END DO
1437    
1438    IF (IVARSIZE == SIZE(PFIELD)) THEN
1439       ! Read variable
1440 #if defined(MNH_MPI_DOUBLE_PRECISION)
1441       STATUS = NF_GET_VAR_DOUBLE(KNCID, IVARID, PFIELD)
1442 #else
1443       ! REAL(KIND=4) was stored as REAL(KIND=8)
1444       ALLOCATE(ZFIELD8(SIZE(PFIELD,1),SIZE(PFIELD,2),SIZE(PFIELD,3),&
1445            &SIZE(PFIELD,4),SIZE(PFIELD,5)))
1446       STATUS = NF_GET_VAR_DOUBLE(KNCID, IVARID, ZFIELD8)
1447       PFIELD = ZFIELD8
1448       DEALLOCATE(ZFIELD8)
1449 #endif
1450       IF (STATUS /= NF_NOERR) THEN
1451          CALL HANDLE_ERR(status,__LINE__,'NCREADX5[NF_GET_VAR_DOUBLE] '//TRIM(YVARNAME),IRESP)
1452          GOTO 1000
1453       END IF
1454       ! Read variables attributes (GRID and COMMENT)
1455       CALL READATTR(KNCID, IVARID, YVARNAME, TPFMH)
1456    ELSE
1457       PRINT *, 'NCREADX5 : '//TRIM(YVARNAME)//' not READ (wrong size).'
1458       IRESP = -3
1459    END IF
1460 ELSE
1461    PRINT *, 'NCREADX5 : '//TRIM(YVARNAME)//' not READ (wrong shape or type).'
1462    IRESP = -3
1463 END IF
1464
1465 1000 CONTINUE
1466 KRESP = IRESP
1467
1468 END SUBROUTINE NCREADX5
1469
1470 SUBROUTINE NCREADX6(KNCID, HVARNAME, PFIELD, TPFMH, KRESP)
1471 USE MODD_FM, ONLY : FMHEADER, JPXKRK
1472 INTEGER(KIND=IDCDF_KIND),     INTENT(IN) :: KNCID
1473 CHARACTER(LEN=*),             INTENT(IN) :: HVARNAME
1474 REAL, DIMENSION(:,:,:,:,:,:), INTENT(OUT):: PFIELD
1475 TYPE(FMHEADER),               INTENT(OUT):: TPFMH
1476 INTEGER,                      INTENT(OUT):: KRESP  ! return-code
1477
1478 INTEGER(KIND=IDCDF_KIND) :: STATUS
1479 CHARACTER(LEN=30)     :: YVARNAME
1480 INTEGER(KIND=IDCDF_KIND) :: IVARID
1481 INTEGER(KIND=IDCDF_KIND) :: ITYPE   ! variable type
1482 INTEGER(KIND=IDCDF_KIND) :: IDIMS   ! number of dimensions
1483 INTEGER(KIND=IDCDF_KIND), DIMENSION(SIZE(SHAPE(PFIELD))) :: IVDIMS
1484 REAL(KIND=8), DIMENSION(:,:,:,:,:,:), ALLOCATABLE :: ZFIELD8
1485 INTEGER(KIND=IDCDF_KIND) :: ICOMLEN ! comment length
1486 INTEGER               :: IVARSIZE
1487 INTEGER(KIND=IDCDF_KIND) :: IDIMLEN
1488 INTEGER               :: II
1489 INTEGER               :: IRESP
1490
1491 IRESP = 0
1492
1493 ! NetCDF var names can't contain '%' nor '.' 
1494 YVARNAME = str_replace(HVARNAME, '%', '__')
1495 YVARNAME = str_replace(YVARNAME, '.', '--')
1496
1497 ! Get variable ID, NDIMS and TYPE
1498 STATUS = NF_INQ_VARID(KNCID, YVARNAME, IVARID)
1499 IF (STATUS /= NF_NOERR) THEN
1500    CALL HANDLE_ERR(status,__LINE__,'NCREADX6[NF_INQ_VARID] '//TRIM(YVARNAME),IRESP)
1501    GOTO 1000
1502 END IF
1503 STATUS = NF_INQ_VARNDIMS(KNCID, IVARID, IDIMS)
1504 IF (STATUS /= NF_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'NCREADX6[NF_INQ_VARNDIMS] '//TRIM(YVARNAME))
1505 STATUS = NF_INQ_VARTYPE(KNCID, IVARID, ITYPE)
1506 IF (STATUS /= NF_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'NCREADX6[NF_INQ_VARTYPE] '//TRIM(YVARNAME))
1507
1508 IF (IDIMS == SIZE(SHAPE(PFIELD)) .AND. ITYPE == NF_DOUBLE) THEN
1509    ! Check size of variable before reading
1510    STATUS = NF_INQ_VARDIMID(KNCID, IVARID, IVDIMS)
1511    IF (status /= NF_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCREADX6[NF_INQ_VARDIMID] '//TRIM(YVARNAME))
1512    IVARSIZE = 1
1513    DO II=1,IDIMS
1514       STATUS = NF_INQ_DIMLEN(KNCID,IVDIMS(II),IDIMLEN)
1515       IF (STATUS /= NF_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCREADX6[NF_INQ_DIMLEN] '//TRIM(YVARNAME))
1516       IVARSIZE = IVARSIZE*IDIMLEN
1517    END DO
1518    
1519    IF (IVARSIZE == SIZE(PFIELD)) THEN
1520       ! Read variable
1521 #if defined(MNH_MPI_DOUBLE_PRECISION)
1522       STATUS = NF_GET_VAR_DOUBLE(KNCID, IVARID, PFIELD)
1523 #else
1524       ! REAL(KIND=4) was stored as REAL(KIND=8)
1525       ALLOCATE(ZFIELD8(SIZE(PFIELD,1),SIZE(PFIELD,2),SIZE(PFIELD,3),&
1526            &SIZE(PFIELD,4),SIZE(PFIELD,5),SIZE(PFIELD,6)))
1527       STATUS = NF_GET_VAR_DOUBLE(KNCID, IVARID, ZFIELD8)
1528       PFIELD = ZFIELD8
1529       DEALLOCATE(ZFIELD8)
1530 #endif
1531       IF (STATUS /= NF_NOERR) THEN
1532          CALL HANDLE_ERR(status,__LINE__,'NCREADX6[NF_GET_VAR_DOUBLE] '//TRIM(YVARNAME),IRESP)
1533          GOTO 1000
1534       END IF
1535       ! Read variables attributes (GRID and COMMENT)
1536       CALL READATTR(KNCID, IVARID, YVARNAME, TPFMH)
1537    ELSE
1538       PRINT *, 'NCREADX6 : '//TRIM(YVARNAME)//' not READ (wrong size).'
1539       IRESP = -3
1540    END IF
1541 ELSE
1542    PRINT *, 'NCREADX6 : '//TRIM(YVARNAME)//' not READ (wrong shape or type).'
1543    IRESP = -3
1544 END IF
1545
1546 1000 CONTINUE
1547 KRESP = IRESP
1548
1549 END SUBROUTINE NCREADX6
1550
1551 SUBROUTINE NCREADN0(KNCID, HVARNAME, KFIELD, TPFMH, KRESP)
1552 USE MODD_FM, ONLY : FMHEADER, JPXKRK
1553 INTEGER(KIND=IDCDF_KIND),INTENT(IN) :: KNCID
1554 CHARACTER(LEN=*), INTENT(IN) :: HVARNAME
1555 INTEGER,          INTENT(OUT):: KFIELD
1556 TYPE(FMHEADER),   INTENT(OUT):: TPFMH
1557 INTEGER,          INTENT(OUT):: KRESP  ! return-code
1558
1559 INTEGER(KIND=IDCDF_KIND) :: STATUS
1560 CHARACTER(LEN=30) :: YVARNAME
1561 INTEGER(KIND=IDCDF_KIND) :: IVARID
1562 INTEGER(KIND=IDCDF_KIND) :: ITYPE   ! variable type
1563 INTEGER(KIND=IDCDF_KIND) :: IDIMS   ! number of dimensions
1564 INTEGER(KIND=IDCDF_KIND) :: ICOMLEN ! comment length
1565 INTEGER           :: IRESP
1566
1567 IRESP = 0
1568
1569 ! NetCDF var names can't contain '%' nor '.' 
1570 YVARNAME = str_replace(HVARNAME, '%', '__')
1571 YVARNAME = str_replace(YVARNAME, '.', '--')
1572
1573 ! Get variable ID, NDIMS and TYPE
1574 STATUS = NF_INQ_VARID(KNCID, YVARNAME, IVARID)
1575 IF (STATUS /= NF_NOERR) THEN
1576    CALL HANDLE_ERR(status,__LINE__,'NCREADN0[NF_INQ_VARID] '//TRIM(YVARNAME),IRESP)
1577    GOTO 1000
1578 END IF
1579 STATUS = NF_INQ_VARNDIMS(KNCID, IVARID, IDIMS)
1580 IF (STATUS /= NF_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'NCREADN0[NF_INQ_VARNDIMS] '//TRIM(YVARNAME))
1581 STATUS = NF_INQ_VARTYPE(KNCID, IVARID, ITYPE)
1582 IF (STATUS /= NF_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'NCREADN0[NF_INQ_VARTYPE] '//TRIM(YVARNAME))
1583
1584 #ifndef MNH_INT8
1585 IF (IDIMS == 0 .AND. ITYPE == NF_INT) THEN
1586 #else
1587 IF (IDIMS == 0 .AND. ITYPE == NF_INT64) THEN
1588 #endif
1589 ! Read variable
1590 #ifndef MNH_INT8
1591    STATUS = NF_GET_VAR_INT(KNCID, IVARID, KFIELD)
1592 #else
1593    STATUS = NF_GET_VAR_INT64(KNCID, IVARID, KFIELD)
1594 #endif
1595    IF (STATUS /= NF_NOERR) THEN
1596       CALL HANDLE_ERR(status,__LINE__,'NCREADN0[NF_GET_VAR_INT] '//TRIM(YVARNAME),IRESP)
1597       GOTO 1000
1598    END IF
1599    ! Read variables attributes (GRID and COMMENT)
1600    CALL READATTR(KNCID, IVARID, YVARNAME, TPFMH)
1601 ELSE
1602    PRINT *, 'NCREADN0 : '//TRIM(YVARNAME)//' not READ (wrong size or type).'
1603    IRESP = -3
1604 END IF
1605
1606 1000 CONTINUE
1607 KRESP = IRESP
1608
1609 END SUBROUTINE NCREADN0
1610
1611 SUBROUTINE NCREADN1(KNCID, HVARNAME, KFIELD, TPFMH, KRESP)
1612 USE MODD_FM, ONLY : FMHEADER, JPXKRK
1613 INTEGER(KIND=IDCDF_KIND),INTENT(IN) :: KNCID
1614 CHARACTER(LEN=*),      INTENT(IN) :: HVARNAME
1615 INTEGER, DIMENSION(:), INTENT(OUT):: KFIELD
1616 TYPE(FMHEADER),        INTENT(OUT):: TPFMH
1617 INTEGER,               INTENT(OUT):: KRESP  ! return-code
1618
1619 INTEGER(KIND=IDCDF_KIND) :: STATUS
1620 CHARACTER(LEN=30)     :: YVARNAME
1621 INTEGER(KIND=IDCDF_KIND) :: IVARID
1622 INTEGER(KIND=IDCDF_KIND) :: ITYPE   ! variable type
1623 INTEGER(KIND=IDCDF_KIND) :: IDIMS   ! number of dimensions
1624 INTEGER(KIND=IDCDF_KIND),DIMENSION(SIZE(SHAPE(KFIELD))) :: IVDIMS
1625 INTEGER(KIND=IDCDF_KIND) :: ICOMLEN ! comment length
1626 INTEGER               :: IVARSIZE
1627 INTEGER(KIND=IDCDF_KIND) :: IDIMLEN
1628 INTEGER               :: II
1629 INTEGER               :: IRESP
1630
1631 IRESP = 0
1632
1633 ! NetCDF var names can't contain '%' nor '.' 
1634 YVARNAME = str_replace(HVARNAME, '%', '__')
1635 YVARNAME = str_replace(YVARNAME, '.', '--')
1636
1637 ! Get variable ID, NDIMS and TYPE
1638 STATUS = NF_INQ_VARID(KNCID, YVARNAME, IVARID)
1639 IF (STATUS /= NF_NOERR) THEN
1640    CALL HANDLE_ERR(status,__LINE__,'NCREADN1[NF_INQ_VARID] '//TRIM(YVARNAME),IRESP)
1641    GOTO 1000
1642 END IF
1643 STATUS = NF_INQ_VARNDIMS(KNCID, IVARID, IDIMS)
1644 IF (STATUS /= NF_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'NCREADN1[NF_INQ_VARNDIMS] '//TRIM(YVARNAME))
1645 STATUS = NF_INQ_VARTYPE(KNCID, IVARID, ITYPE)
1646 IF (STATUS /= NF_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'NCREADN1[NF_INQ_VARTYPE] '//TRIM(YVARNAME))
1647
1648 #ifndef MNH_INT8
1649 IF (IDIMS == SIZE(SHAPE(KFIELD)) .AND. ITYPE == NF_INT) THEN
1650 #else
1651 IF (IDIMS == SIZE(SHAPE(KFIELD)) .AND. ITYPE == NF_INT64) THEN
1652 #endif
1653    ! Check size of variable before reading
1654    STATUS = NF_INQ_VARDIMID(KNCID, IVARID, IVDIMS)
1655    IF (status /= NF_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCREADN1[NF_INQ_VARDIMID] '//TRIM(YVARNAME))
1656    IVARSIZE = 1
1657    DO II=1,IDIMS
1658       STATUS = NF_INQ_DIMLEN(KNCID,IVDIMS(II),IDIMLEN)
1659       IF (STATUS /= NF_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCREADN1[NF_INQ_DIMLEN] '//TRIM(YVARNAME))
1660       IVARSIZE = IVARSIZE*IDIMLEN
1661    END DO
1662    
1663    IF (IVARSIZE == SIZE(KFIELD)) THEN
1664       ! Read variable
1665 #ifndef MNH_INT8
1666       STATUS = NF_GET_VAR_INT(KNCID, IVARID, KFIELD)
1667 #else
1668       STATUS = NF_GET_VAR_INT64(KNCID, IVARID, KFIELD)
1669 #endif
1670       IF (STATUS /= NF_NOERR) THEN
1671          CALL HANDLE_ERR(status,__LINE__,'NCREADN1[NF_GET_VAR_INT] '//TRIM(YVARNAME),IRESP)
1672          GOTO 1000
1673       END IF
1674       ! Read variables attributes (GRID and COMMENT)
1675       CALL READATTR(KNCID, IVARID, YVARNAME, TPFMH)
1676    ELSE
1677       PRINT *, 'NCREADN1 : '//TRIM(YVARNAME)//' not READ (wrong size).'
1678       IRESP = -3
1679    END IF
1680 ELSE
1681    PRINT *, 'NCREADN1 : '//TRIM(YVARNAME)//' not READ (wrong shape or type).'
1682    IRESP = -3
1683 END IF
1684
1685 1000 CONTINUE
1686 KRESP = IRESP
1687
1688 END SUBROUTINE NCREADN1
1689
1690 SUBROUTINE NCREADN2(KNCID, HVARNAME, KFIELD, TPFMH, KRESP)
1691 USE MODD_FM, ONLY : FMHEADER, JPXKRK
1692 INTEGER(KIND=IDCDF_KIND),INTENT(IN) :: KNCID
1693 CHARACTER(LEN=*),        INTENT(IN) :: HVARNAME
1694 INTEGER, DIMENSION(:,:), INTENT(OUT):: KFIELD
1695 TYPE(FMHEADER),          INTENT(OUT):: TPFMH
1696 INTEGER,                 INTENT(OUT):: KRESP  ! return-code
1697
1698 INTEGER(KIND=IDCDF_KIND)  :: STATUS
1699 CHARACTER(LEN=30)     :: YVARNAME
1700 INTEGER(KIND=IDCDF_KIND) :: IVARID
1701 INTEGER(KIND=IDCDF_KIND) :: ITYPE   ! variable type
1702 INTEGER(KIND=IDCDF_KIND) :: IDIMS   ! number of dimensions
1703 INTEGER(KIND=IDCDF_KIND),DIMENSION(SIZE(SHAPE(KFIELD))) :: IVDIMS
1704 INTEGER(KIND=IDCDF_KIND) :: ICOMLEN ! comment length
1705 INTEGER               :: IVARSIZE
1706 INTEGER(KIND=IDCDF_KIND) :: IDIMLEN
1707 INTEGER               :: II
1708 INTEGER               :: IRESP
1709
1710 IRESP = 0
1711
1712 ! NetCDF var names can't contain '%' nor '.' 
1713 YVARNAME = str_replace(HVARNAME, '%', '__')
1714 YVARNAME = str_replace(YVARNAME, '.', '--')
1715
1716 ! Get variable ID, NDIMS and TYPE
1717 STATUS = NF_INQ_VARID(KNCID, YVARNAME, IVARID)
1718 IF (STATUS /= NF_NOERR) THEN
1719    CALL HANDLE_ERR(status,__LINE__,'NCREADN2[NF_INQ_VARID] '//TRIM(YVARNAME),IRESP)
1720    GOTO 1000
1721 END IF
1722 STATUS = NF_INQ_VARNDIMS(KNCID, IVARID, IDIMS)
1723 IF (STATUS /= NF_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'NCREADN2[NF_INQ_VARNDIMS] '//TRIM(YVARNAME))
1724 STATUS = NF_INQ_VARTYPE(KNCID, IVARID, ITYPE)
1725 IF (STATUS /= NF_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'NCREADN2[NF_INQ_VARTYPE] '//TRIM(YVARNAME))
1726
1727 #ifndef MNH_INT8
1728 IF (IDIMS == SIZE(SHAPE(KFIELD)) .AND. ITYPE == NF_INT) THEN
1729 #else
1730 IF (IDIMS == SIZE(SHAPE(KFIELD)) .AND. ITYPE == NF_INT64) THEN
1731 #endif
1732 ! Check size of variable before reading
1733    STATUS = NF_INQ_VARDIMID(KNCID, IVARID, IVDIMS)
1734    IF (status /= NF_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCREADN2[NF_INQ_VARDIMID] '//TRIM(YVARNAME))
1735    IVARSIZE = 1
1736    DO II=1,IDIMS
1737       STATUS = NF_INQ_DIMLEN(KNCID,IVDIMS(II),IDIMLEN)
1738       IF (STATUS /= NF_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCREADN2[NF_INQ_DIMLEN] '//TRIM(YVARNAME))
1739       IVARSIZE = IVARSIZE*IDIMLEN
1740    END DO
1741    
1742    IF (IVARSIZE == SIZE(KFIELD)) THEN
1743       ! Read variable
1744 #ifndef MNH_INT8
1745       STATUS = NF_GET_VAR_INT(KNCID, IVARID, KFIELD)
1746 #else
1747       STATUS = NF_GET_VAR_INT64(KNCID, IVARID, KFIELD)
1748 #endif
1749       IF (STATUS /= NF_NOERR) THEN
1750          CALL HANDLE_ERR(status,__LINE__,'NCREADN2[NF_GET_VAR_INT] '//TRIM(YVARNAME),IRESP)
1751          GOTO 1000
1752       END IF
1753       ! Read variables attributes (GRID and COMMENT)
1754       CALL READATTR(KNCID, IVARID, YVARNAME, TPFMH)
1755    ELSE
1756       PRINT *, 'NCREADN2 : '//TRIM(YVARNAME)//' not READ (wrong size).'
1757       IRESP = -3
1758    END IF
1759 ELSE
1760    PRINT *, 'NCREADN2 : '//TRIM(YVARNAME)//' not READ (wrong shape or type).'
1761    IRESP = -3
1762 END IF
1763
1764 1000 CONTINUE
1765 KRESP = IRESP
1766
1767 END SUBROUTINE NCREADN2
1768
1769 SUBROUTINE NCREADC0(KNCID, HVARNAME, HFIELD, TPFMH, KRESP)
1770 USE MODD_FM, ONLY : FMHEADER, JPXKRK
1771 INTEGER(KIND=IDCDF_KIND),INTENT(IN) :: KNCID
1772 CHARACTER(LEN=*),      INTENT(IN) :: HVARNAME
1773 CHARACTER(LEN=*),      INTENT(OUT):: HFIELD
1774 TYPE(FMHEADER),        INTENT(OUT):: TPFMH
1775 INTEGER,               INTENT(OUT):: KRESP  ! return-code
1776
1777 INTEGER(KIND=IDCDF_KIND) :: STATUS
1778 CHARACTER(LEN=30)     :: YVARNAME
1779 INTEGER(KIND=IDCDF_KIND) :: IVARID
1780 INTEGER(KIND=IDCDF_KIND) :: ITYPE   ! variable type
1781 INTEGER(KIND=IDCDF_KIND) :: IDIMS   ! number of dimensions
1782 INTEGER(KIND=IDCDF_KIND),DIMENSION(1) :: IVDIMS
1783 CHARACTER(LEN=32)     :: YSTR
1784 !CHARACTER(LEN=LEN(HFIELD))     :: YSTR
1785 INTEGER(KIND=IDCDF_KIND) :: ICOMLEN ! comment length
1786 INTEGER(KIND=IDCDF_KIND) :: IDIMLEN
1787 INTEGER               :: II
1788 INTEGER               :: IRESP
1789
1790 IRESP = 0
1791
1792 ! NetCDF var names can't contain '%' nor '.' 
1793 YVARNAME = str_replace(HVARNAME, '%', '__')
1794 YVARNAME = str_replace(YVARNAME, '.', '--')
1795
1796 ! Get variable ID, NDIMS and TYPE
1797 STATUS = NF_INQ_VARID(KNCID, YVARNAME, IVARID)
1798 IF (STATUS /= NF_NOERR) THEN
1799    CALL HANDLE_ERR(status,__LINE__,'NCREADC0[NF_INQ_VARID] '//TRIM(YVARNAME),IRESP)
1800    GOTO 1000
1801 END IF
1802 STATUS = NF_INQ_VARNDIMS(KNCID, IVARID, IDIMS)
1803 IF (STATUS /= NF_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'NCREADC0[NF_INQ_VARNDIMS] '//TRIM(YVARNAME))
1804 STATUS = NF_INQ_VARTYPE(KNCID, IVARID, ITYPE)
1805 IF (STATUS /= NF_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'NCREADC0[NF_INQ_VARTYPE] '//TRIM(YVARNAME))
1806
1807 IF (IDIMS == 1 .AND. ITYPE == NF_CHAR) THEN
1808    ! Check size of variable before reading
1809    STATUS = NF_INQ_VARDIMID(KNCID, IVARID, IVDIMS)
1810    IF (status /= NF_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCREADC0[NF_INQ_VARDIMID] '//TRIM(YVARNAME))
1811    STATUS = NF_INQ_DIMLEN(KNCID,IVDIMS(1),IDIMLEN)
1812    IF (STATUS /= NF_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCREADC0[NF_INQ_DIMLEN] '//TRIM(YVARNAME))
1813    
1814    IF (IDIMLEN <= LEN(YSTR)) THEN
1815       ! Read variable
1816       STATUS = NF_GET_VAR_TEXT(KNCID, IVARID, YSTR)
1817       IF (STATUS /= NF_NOERR) THEN
1818          CALL HANDLE_ERR(status,__LINE__,'NCREADC0[NF_GET_VAR_TEXT] '//TRIM(YVARNAME),IRESP)
1819          GOTO 1000
1820       END IF
1821       IF (LEN_TRIM(YSTR) > LEN(HFIELD)) PRINT *, 'NCDREADC0 : '//TRIM(YVARNAME)//' truncated !!'
1822       HFIELD = TRIM(YSTR)
1823       ! Read variables attributes (GRID and COMMENT)
1824       CALL READATTR(KNCID, IVARID, YVARNAME, TPFMH)
1825    ELSE
1826       PRINT *, 'NCREADC0 : '//TRIM(YVARNAME)//' not READ (wrong size).'
1827       IRESP = -3
1828    END IF
1829 ELSE
1830    PRINT *, 'NCREADC0 : '//TRIM(YVARNAME)//' not READ (wrong shape or type).'
1831    IRESP = -3
1832 END IF
1833
1834 1000 CONTINUE
1835 KRESP = IRESP
1836
1837 END SUBROUTINE NCREADC0
1838
1839 END MODULE MODE_NETCDF
1840
1841 #else
1842 !
1843 ! External dummy subroutines
1844 !
1845 SUBROUTINE NCWRIT(A,B,C,D,E,F)
1846 INTEGER :: A,B,C,D,E,F
1847 PRINT *, 'NCWRIT empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF4 I/Os.'
1848 END SUBROUTINE NCWRIT
1849
1850 SUBROUTINE NCREAD(A,B,C,D,E)
1851 INTEGER :: A,B,C,D,E
1852 PRINT *, 'NCREAD empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF4 I/Os.'
1853 END SUBROUTINE NCREAD
1854
1855 SUBROUTINE CLEANIOCDF(A)
1856 INTEGER :: A
1857 PRINT *, 'CLEANIOCDF empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF4 I/Os.'
1858 END SUBROUTINE CLEANIOCDF
1859
1860 #endif