Gaelle + Didier 26/04/2016 : bug dimensions 2D cases in netcdf
[MNH-git_open_source-lfs.git] / src / LIB / SURCOUCHE / src / fmread_ll.f90
1 !MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
2 !MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
3 !MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
4 !MNH_LIC for details. version 1.
5 !-----------------------------------------------------------------
6 !--------------- special set of characters for CVS information
7 !-----------------------------------------------------------------
8 ! $Source$
9 ! $Name$ 
10 ! $Revision$ 
11 ! $Date$
12 !-----------------------------------------------------------------
13 !-----------------------------------------------------------------
14
15 #ifdef MNH_MPI_DOUBLE_PRECISION
16 #define MPI_FLOAT MPI_DOUBLE_PRECISION
17 #else
18 #define MPI_FLOAT MPI_REAL
19 #endif
20
21 MODULE MODE_FMREAD
22 !
23 !Correction :
24 !  J.Escobar : 22/08/2005 : BUG : manque un "GOTO 1000" si champs
25 !              lue non trouvĂ© !!!
26 !  J.Escobar : 13/01/2015 : remove comment on BCAST(IRESP in FMREADX2_ll
27 !  J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1 
28 !  D.Gazen   : avril 2016 bug dimensions 2D cases in netcdf
29 !
30 USE MODD_MPIF
31 #if defined(MNH_IOCDF4)
32 USE MODE_NETCDF
33 #endif
34 IMPLICIT NONE 
35
36 PRIVATE
37
38 INTERFACE FMREAD
39   MODULE PROCEDURE FMREADX0_ll,FMREADX1_ll,FMREADX2_ll,FMREADX3_ll,&
40        & FMREADX4_ll,FMREADX5_ll,FMREADX6_ll,&
41        & FMREADN0_ll,FMREADN1_ll,FMREADN2_ll,&
42        & FMREADL0_ll,FMREADL1_ll,FMREADC0_ll,FMREADT0_ll
43 END INTERFACE
44 !
45
46 PUBLIC FMREAD_LB,FMREAD,FMREADX0_ll,FMREADX1_ll,FMREADX2_ll,FMREADX3_ll,&
47        & FMREADX4_ll,FMREADX5_ll,FMREADX6_ll,&
48        & FMREADN0_ll,FMREADN1_ll,FMREADN2_ll,&
49        & FMREADL0_ll,FMREADL1_ll,FMREADC0_ll,FMREADT0_ll
50
51 !INCLUDE 'mpif.h'
52
53 CONTAINS 
54 SUBROUTINE FM_READ_ERR(HFUNC,HFILEM,HFIPRI,HRECFM,HDIR,KRESP)
55 USE MODE_FM, ONLY : FMLOOK_ll
56
57 CHARACTER(LEN=*) :: HFUNC 
58 CHARACTER(LEN=*) :: HFILEM
59 CHARACTER(LEN=*) :: HFIPRI
60 CHARACTER(LEN=*) :: HRECFM
61 CHARACTER(LEN=*) :: HDIR
62 INTEGER          :: KRESP
63
64 INTEGER          :: ILUPRI
65 INTEGER          :: IRESP
66
67 CALL FMLOOK_ll(HFIPRI,HFIPRI,ILUPRI,IRESP)
68 WRITE (ILUPRI,*) ' exit from ',HFUNC, ' with RESP:',KRESP
69 !STOP "fmread_ll.f90:: FM_READ_ERR"
70
71 WRITE (ILUPRI,*) '   | HFILEM = ',HFILEM
72 WRITE (ILUPRI,*) '   | HRECFM = ',HRECFM
73 WRITE (ILUPRI,*) '   | HDIR  = ',HDIR
74
75 END SUBROUTINE FM_READ_ERR
76
77
78 SUBROUTINE BCAST_HEADER(TPFD,TPFMH)
79 USE MODE_FD_ll, ONLY : FD_ll
80 USE MODD_FM
81 TYPE(FD_ll),     POINTER    :: TPFD
82 TYPE(FMHEADER), INTENT(IN) :: TPFMH
83
84 INTEGER :: ierr 
85
86 CALL MPI_BCAST(TPFMH%GRID,1,MPI_INTEGER,TPFD%OWNER-1,TPFD%COMM,IERR)
87 CALL MPI_BCAST(TPFMH%COMLEN,1,MPI_INTEGER,TPFD%OWNER-1,TPFD%COMM,IERR)
88 CALL MPI_BCAST(TPFMH%COMMENT,TPFMH%COMLEN,MPI_CHARACTER,TPFD%OWNER-1,TPFD%COMM,IERR)
89
90 END SUBROUTINE BCAST_HEADER
91
92 SUBROUTINE FMREADX0_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
93      KLENCH,HCOMMENT,KRESP)
94 USE MODD_IO_ll, ONLY : ISP,GSMONOPROC 
95 USE MODD_FM
96 USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
97 !
98 !*      0.    DECLARATIONS
99 !             ------------
100 !
101 !
102 !*      0.1   Declarations of arguments
103 !
104 CHARACTER(LEN=*),             INTENT(IN) ::HFILEM ! FM-file name
105 CHARACTER(LEN=*),             INTENT(IN) ::HRECFM ! name of the article to read
106 CHARACTER(LEN=*),             INTENT(IN) ::HFIPRI ! output file for error messages
107 CHARACTER(LEN=*),             INTENT(IN) ::HDIR   ! field form
108 REAL,                         INTENT(INOUT)::PFIELD ! array containing the data field 
109 INTEGER,                      INTENT(INOUT)::KGRID  ! C-grid indicator (u,v,w,T)
110 INTEGER,                      INTENT(INOUT)::KLENCH ! length of comment string
111 CHARACTER(LEN=*),             INTENT(INOUT)::HCOMMENT ! comment string
112 INTEGER,                      INTENT(INOUT)::KRESP    ! return-code
113 !
114 !*      0.2   Declarations of local variables
115 !
116 !----------------------------------------------------------------
117 CHARACTER(LEN=JPFINL)        :: YFNLFI
118 INTEGER                      :: IERR
119 TYPE(FD_ll), POINTER         :: TZFD
120 INTEGER                      :: IRESP
121 TYPE(FMHEADER)               :: TZFMH
122 !
123 !*      1.1   THE NAME OF LFIFM
124 !
125 IRESP = 0
126 YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
127 !------------------------------------------------------------------
128 TZFD=>GETFD(YFNLFI)
129 IF (ASSOCIATED(TZFD)) THEN
130   IF (GSMONOPROC) THEN ! sequential execution
131     IF (ASSOCIATED(TZFD%CDF)) THEN
132        CALL NCREAD(TZFD%CDF%NCID,HRECFM,PFIELD,TZFMH,IRESP)
133     ELSE
134        CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,1,PFIELD,TZFMH,IRESP)
135     END IF
136     IF (IRESP /= 0) GOTO 1000
137   ELSE ! multiprocessor execution
138     IF (ISP == TZFD%OWNER)  THEN
139       IF (ASSOCIATED(TZFD%CDF)) THEN
140          CALL NCREAD(TZFD%CDF%NCID,HRECFM,PFIELD,TZFMH,IRESP)
141       ELSE
142          CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,1,PFIELD,TZFMH,IRESP)
143       END IF
144     END IF
145     !
146     CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
147     IF (IRESP /= 0) GOTO 1000
148     !
149     CALL BCAST_HEADER(TZFD,TZFMH)
150     !
151     CALL MPI_BCAST(PFIELD,1,MPI_FLOAT,TZFD%OWNER-1,TZFD%COMM,IERR)
152   END IF
153   KGRID  = TZFMH%GRID
154   KLENCH = TZFMH%COMLEN
155   HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
156 ELSE 
157   IRESP = -61
158 END IF
159 !----------------------------------------------------------------
160 1000 CONTINUE
161 !! Error handler
162 IF (IRESP.NE.0) THEN
163   CALL FM_READ_ERR("FMREADX0_ll",HFILEM,HFIPRI,HRECFM,HDIR,IRESP)
164 ENDIF
165 KRESP = IRESP
166 RETURN
167     
168 END SUBROUTINE FMREADX0_ll
169
170 SUBROUTINE FMREADX1_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
171      KLENCH,HCOMMENT,KRESP, KIMAX_ll, KJMAX_ll, TPSPLITTING)
172 USE MODD_IO_ll, ONLY : ISP,GSMONOPROC, ISNPROC
173 USE MODD_FM
174 USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
175 USE MODE_SCATTER_ll
176 USE MODE_ALLOCBUFFER_ll
177 USE MODD_STRUCTURE_ll, ONLY : ZONE_ll
178 !
179 !*      0.    DECLARATIONS
180 !             ------------
181 !
182 !
183 !*      0.1   Declarations of arguments
184 !
185 CHARACTER(LEN=*),        INTENT(IN) ::HFILEM   ! FM-file name
186 CHARACTER(LEN=*),        INTENT(IN) ::HRECFM   ! name of the article to read
187 CHARACTER(LEN=*),        INTENT(IN) ::HFIPRI   ! output file for error messages
188 CHARACTER(LEN=*),        INTENT(IN) ::HDIR     ! Field form
189 REAL,DIMENSION(:),TARGET,INTENT(INOUT)::PFIELD   ! array containing the data field 
190 INTEGER,                 INTENT(INOUT)::KGRID    ! C-grid indicator (u,v,w,T)
191 INTEGER,                 INTENT(INOUT)::KLENCH   ! length of comment string
192 CHARACTER(LEN=*),        INTENT(INOUT)::HCOMMENT ! comment string
193 INTEGER,                 INTENT(INOUT)::KRESP    ! return-code
194 INTEGER, OPTIONAL, INTENT(IN) ::KIMAX_ll
195 INTEGER, OPTIONAL, INTENT(IN) ::KJMAX_ll
196 TYPE(ZONE_ll), DIMENSION(ISNPROC), OPTIONAL :: TPSPLITTING  ! splitting of the domain
197 !
198 !*      0.2   Declarations of local variables
199 !
200 !----------------------------------------------------------------
201 CHARACTER(LEN=JPFINL)     :: YFNLFI
202 INTEGER                   :: IERR
203 TYPE(FD_ll), POINTER      :: TZFD
204 INTEGER                   :: IRESP
205 REAL,DIMENSION(:),POINTER :: ZFIELDP
206 LOGICAL                   :: GALLOC
207 TYPE(FMHEADER)            :: TZFMH
208 !
209 !*      1.1   THE NAME OF LFIFM
210 !
211 GALLOC = .FALSE.
212 IRESP = 0
213 YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
214 !------------------------------------------------------------------
215 TZFD=>GETFD(YFNLFI)
216 IF (ASSOCIATED(TZFD)) THEN
217   IF (GSMONOPROC) THEN ! sequential execution
218     IF (ASSOCIATED(TZFD%CDF)) THEN
219        CALL NCREAD(TZFD%CDF%NCID,HRECFM,PFIELD,TZFMH,IRESP)
220     ELSE
221        CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
222     END IF
223     IF (IRESP /= 0) GOTO 1000
224   ELSE ! multiprocessor execution
225     IF (ISP == TZFD%OWNER)  THEN
226       IF( PRESENT(KIMAX_ll) .AND. PRESENT(KJMAX_ll) ) THEN
227         CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC, KIMAX_ll, KJMAX_ll)
228       ELSE
229         CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC)
230       ENDIF
231       IF (ASSOCIATED(TZFD%CDF)) THEN
232          CALL NCREAD(TZFD%CDF%NCID,HRECFM,ZFIELDP,TZFMH,IRESP)
233       ELSE
234          CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
235               & ,IRESP)
236       END IF
237     ELSE
238       ALLOCATE(ZFIELDP(0))
239       GALLOC = .TRUE.
240     END IF
241       
242     !  
243     CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
244     IF (IRESP /= 0) GOTO 1000
245     !
246     CALL BCAST_HEADER(TZFD,TZFMH)
247     !
248     IF (HDIR /= 'XX' .AND. HDIR /='YY') THEN
249       ! Broadcast Field
250       CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MPI_FLOAT,TZFD%OWNER-1,TZFD%COMM,IERR)
251     ELSE 
252       !Scatter Field
253       IF( PRESENT(TPSPLITTING) ) THEN
254         CALL SCATTER_XXFIELD(HDIR,ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM,TPSPLITTING)
255       ELSE
256         CALL SCATTER_XXFIELD(HDIR,ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM)
257       ENDIF
258     END IF
259   END IF !(GSMONOPROC)
260   
261   KGRID  = TZFMH%GRID
262   KLENCH = TZFMH%COMLEN
263   HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
264 ELSE 
265   IRESP = -61
266 END IF
267 !----------------------------------------------------------------
268 1000 CONTINUE
269 !! Error handler
270 IF (IRESP.NE.0) THEN
271   CALL FM_READ_ERR("FMREADX1_ll",HFILEM,HFIPRI,HRECFM,HDIR,IRESP)
272 ENDIF
273
274 IF (GALLOC) DEALLOCATE (ZFIELDP)
275 KRESP = IRESP
276 RETURN
277 !------------------------------------------------------------------
278 END SUBROUTINE FMREADX1_ll
279
280 SUBROUTINE FMREADX2_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
281      KLENCH,HCOMMENT,KRESP, KIMAX_ll, KJMAX_ll, TPSPLITTING)
282 USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LPACK,L1D,L2D , ISNPROC
283 USE MODD_PARAMETERS_ll,ONLY : JPHEXT
284 USE MODD_FM
285 USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
286 USE MODE_SCATTER_ll
287 USE MODE_ALLOCBUFFER_ll
288 !JUANZ
289 USE MODD_TIMEZ, ONLY : TIMEZ
290 USE MODE_MNH_TIMING, ONLY : SECOND_MNH2
291 !JUANZ 
292 USE MODD_STRUCTURE_ll, ONLY : ZONE_ll
293 #ifdef MNH_GA
294     USE MODE_GA
295 #endif
296
297 IMPLICIT NONE
298
299 CHARACTER(LEN=*),           INTENT(IN) ::HFILEM   ! FM-file name
300 CHARACTER(LEN=*),           INTENT(IN) ::HRECFM   ! name of the article to read
301 CHARACTER(LEN=*),           INTENT(IN) ::HFIPRI   ! output file for error messages
302 CHARACTER(LEN=*),           INTENT(IN) ::HDIR     ! field form
303 REAL,DIMENSION(:,:),TARGET, INTENT(INOUT)::PFIELD   ! array containing the data field
304 INTEGER,                    INTENT(INOUT)::KGRID    ! C-grid indicator (u,v,w,T)
305 INTEGER,                    INTENT(INOUT)::KLENCH   ! length of comment string
306 CHARACTER(LEN=*),           INTENT(INOUT)::HCOMMENT ! comment string
307 INTEGER,                   INTENT(INOUT)::KRESP     ! return-code
308 INTEGER, OPTIONAL, INTENT(IN) ::KIMAX_ll
309 INTEGER, OPTIONAL, INTENT(IN) ::KJMAX_ll
310 TYPE(ZONE_ll), DIMENSION(ISNPROC), OPTIONAL :: TPSPLITTING  ! splitting of the domain
311 !
312 !
313 !*      0.2   Declarations of local variables
314 !
315 CHARACTER(LEN=JPFINL)        :: YFNLFI
316 INTEGER                      :: IERR
317 TYPE(FD_ll), POINTER         :: TZFD
318 INTEGER                      :: IRESP
319 REAL,DIMENSION(:,:), POINTER :: ZFIELDP
320 LOGICAL                      :: GALLOC
321 TYPE(FMHEADER)               :: TZFMH
322 !JUANZ
323 REAL*8,DIMENSION(2) :: T0,T1,T2
324 REAL*8,DIMENSION(2) :: T11,T22
325 !JUANZ
326 #ifdef MNH_GA
327 REAL,DIMENSION(:,:),POINTER    :: ZFIELD_GA
328 #endif
329 !
330 !*      1.1   THE NAME OF LFIFM
331 !
332 CALL SECOND_MNH2(T11)
333 GALLOC = .FALSE.
334 IRESP = 0
335 YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
336
337 !------------------------------------------------------------------
338
339 TZFD=>GETFD(YFNLFI)
340 IF (ASSOCIATED(TZFD)) THEN
341   IF (GSMONOPROC) THEN ! sequential execution
342 !    IF (LPACK .AND. L1D .AND. HDIR=='XY') THEN 
343     IF (LPACK .AND. L1D .AND. SIZE(PFIELD,1)==2*JPHEXT+1 .AND. SIZE(PFIELD,2)==2*JPHEXT+1) THEN
344       ZFIELDP=>PFIELD(2:2,2:2)
345       IF (ASSOCIATED(TZFD%CDF)) THEN
346          CALL NCREAD(TZFD%CDF%NCID,HRECFM,ZFIELDP,TZFMH,IRESP)
347       ELSE
348          CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
349       END IF
350       PFIELD(:,:)=SPREAD(SPREAD(PFIELD(2,2),DIM=1,NCOPIES=3),DIM=2,NCOPIES=3)
351 !    ELSE IF (LPACK .AND. L2D .AND. HDIR=='XY') THEN
352     ELSE IF (LPACK .AND. L2D .AND. SIZE(PFIELD,2)==2*JPHEXT+1) THEN
353       ZFIELDP=>PFIELD(:,2:2)
354       IF (ASSOCIATED(TZFD%CDF)) THEN
355          CALL NCREAD(TZFD%CDF%NCID,HRECFM,ZFIELDP,TZFMH,IRESP)
356       ELSE
357          CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
358       END IF
359       PFIELD(:,:)=SPREAD(PFIELD(:,2),DIM=2,NCOPIES=3)
360     ELSE
361       IF (ASSOCIATED(TZFD%CDF)) THEN
362          CALL NCREAD(TZFD%CDF%NCID,HRECFM,PFIELD,TZFMH,IRESP)
363       ELSE
364          CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
365       END IF
366     END IF
367     IF (IRESP /= 0) GOTO 1000
368   ELSE ! multiprocessor execution
369      CALL SECOND_MNH2(T0)
370     IF (ISP == TZFD%OWNER)  THEN
371       ! I/O processor case
372       IF( PRESENT(KIMAX_ll) .AND. PRESENT(KJMAX_ll) ) THEN
373         CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC, KIMAX_ll, KJMAX_ll)
374       ELSE
375         CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC)
376       ENDIF
377       IF (ASSOCIATED(TZFD%CDF)) THEN
378          CALL NCREAD(TZFD%CDF%NCID,HRECFM,ZFIELDP,TZFMH,IRESP)
379       ELSE
380          CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
381            & ,IRESP)
382       END IF
383     ELSE
384       ALLOCATE(ZFIELDP(0,0))
385       GALLOC = .TRUE.
386     END IF
387     CALL SECOND_MNH2(T1)
388     TIMEZ%T_READ2D_READ=TIMEZ%T_READ2D_READ + T1 - T0
389     !
390     CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
391     IF (IRESP /= 0) GOTO 1000
392     !
393     CALL BCAST_HEADER(TZFD,TZFMH)
394     !
395     IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
396       ! XX or YY Scatter Field
397       IF( PRESENT(TPSPLITTING) ) THEN
398         CALL SCATTER_XXFIELD(HDIR,ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM,TPSPLITTING)
399       ELSE
400         CALL SCATTER_XXFIELD(HDIR,ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM)
401       ENDIF
402     ELSE IF (HDIR == 'XY') THEN
403       IF (LPACK .AND. L2D) THEN
404         ! 2D compact case
405       IF( PRESENT(TPSPLITTING) ) THEN
406         CALL SCATTER_XXFIELD('XX',ZFIELDP(:,1),PFIELD(:,2),TZFD%OWNER,TZFD%COMM,TPSPLITTING)
407       ELSE
408         CALL SCATTER_XXFIELD('XX',ZFIELDP(:,1),PFIELD(:,2),TZFD%OWNER,TZFD%COMM)
409       ENDIF
410         PFIELD(:,:) = SPREAD(PFIELD(:,2),DIM=2,NCOPIES=3)
411       ELSE
412 #ifdef MNH_GA
413          !
414          ! init/create the ga , dim3 = 1
415          !
416          CALL MNH_INIT_GA(SIZE(PFIELD,1),SIZE(PFIELD,2),1,HRECFM,"READ")
417          IF (ISP == TZFD%OWNER)  THEN
418             !
419             ! put the data in the g_a , this proc get this 1 slide
420             !
421             lo_zplan(JPIZ) = 1
422             hi_zplan(JPIZ) = 1
423             call nga_put(g_a, lo_zplan, hi_zplan,ZFIELDP, ld_zplan)
424          END IF
425          call ga_sync
426          !
427          ! get the columun data in this proc
428          !
429          ! temp buf to avoid problem with none stride PFIELDS buffer  with HALO 
430          ALLOCATE (ZFIELD_GA (SIZE(PFIELD,1),SIZE(PFIELD,2)))
431          call nga_get(g_a, lo_col, hi_col,ZFIELD_GA(1,1) , ld_col)
432          PFIELD = ZFIELD_GA
433          DEALLOCATE(ZFIELD_GA)
434 #else
435         ! XY Scatter Field
436         CALL SCATTER_XYFIELD(ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM)
437 #endif
438       END IF
439     ELSE
440       CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MPI_FLOAT,TZFD%OWNER-1,TZFD%COMM,IERR)
441     END IF
442     CALL SECOND_MNH2(T2)
443     TIMEZ%T_READ2D_SCAT=TIMEZ%T_READ2D_SCAT + T2 - T1    
444   END IF !(GSMONOPROC)
445   
446   KGRID  = TZFMH%GRID
447   KLENCH = TZFMH%COMLEN
448   HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
449 ELSE 
450   IRESP = -61
451 END IF
452 !----------------------------------------------------------------
453 1000 CONTINUE
454 !! Error handler
455 IF (IRESP.NE.0) THEN
456   CALL FM_READ_ERR("FMREADX2_ll",HFILEM,HFIPRI,HRECFM,HDIR,IRESP)
457 ENDIF
458 IF (GALLOC) DEALLOCATE (ZFIELDP)
459 KRESP = IRESP
460 !------------------------------------------------------------------
461
462 CALL SECOND_MNH2(T22)
463 TIMEZ%T_READ2D_ALL=TIMEZ%T_READ2D_ALL + T22 - T11
464
465 END SUBROUTINE FMREADX2_ll
466
467 SUBROUTINE FMREADX3_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
468      KLENCH,HCOMMENT,KRESP)
469 USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LPACK,L1D,L2D 
470 USE MODD_PARAMETERS_ll,ONLY : JPHEXT
471 USE MODD_FM
472 USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
473 USE MODE_SCATTER_ll
474 USE MODE_ALLOCBUFFER_ll
475 !JUANZ
476 USE MODD_IO_ll, ONLY : ISNPROC
477 USE MODE_IO_ll, ONLY : io_file,io_rank
478 USE MODD_TIMEZ, ONLY : TIMEZ
479 USE MODE_MNH_TIMING, ONLY : SECOND_MNH2
480 !JUANZ
481 #ifdef MNH_GA
482     USE MODE_GA
483 #endif
484 USE MODD_VAR_ll, ONLY : MNH_STATUSES_IGNORE
485
486 IMPLICIT NONE
487
488 CHARACTER(LEN=*),             INTENT(IN) ::HFILEM ! FM-file name
489 CHARACTER(LEN=*),             INTENT(IN) ::HRECFM ! name of the article to read
490 CHARACTER(LEN=*),             INTENT(IN) ::HFIPRI ! output file for error messages
491 CHARACTER(LEN=*),             INTENT(IN) ::HDIR   ! field form
492 REAL, DIMENSION(:,:,:),TARGET,INTENT(INOUT)::PFIELD ! array containing the data field
493 INTEGER,                      INTENT(INOUT)::KGRID  ! C-grid indicator (u,v,w,T)
494 INTEGER,                      INTENT(INOUT)::KLENCH ! length of comment string
495 CHARACTER(LEN=*),             INTENT(INOUT)::HCOMMENT ! comment string
496 INTEGER,                      INTENT(INOUT)::KRESP    ! return-code
497 !
498 #ifdef MNH_GA
499 REAL,DIMENSION(:,:,:),POINTER              :: ZFIELD_GA
500 #endif
501 !
502 !
503 !*      0.2   Declarations of local variables
504 !
505 CHARACTER(LEN=JPFINL)                    :: YFNLFI
506 INTEGER                                  :: IERR
507 TYPE(FD_ll), POINTER                     :: TZFD
508 INTEGER                                  :: IRESP
509 REAL,DIMENSION(:,:,:),POINTER            :: ZFIELDP
510 LOGICAL                                  :: GALLOC
511 TYPE(FMHEADER)                           :: TZFMH
512 !JUAN
513 INTEGER                                  :: JK,JKK
514 CHARACTER(LEN=LEN(HRECFM))               :: YK,YRECZSLIDE
515 REAL,DIMENSION(:,:),POINTER              :: ZSLIDE_ll,ZSLIDE
516 INTEGER                                  :: IK_FILE,IK_rank,inb_proc_real,JK_MAX
517 CHARACTER(len=5)                         :: YK_FILE  
518 CHARACTER(len=128)                       :: YFILE_IOZ  
519 TYPE(FD_ll), POINTER                     :: TZFD_IOZ 
520 INTEGER                                  :: JI,IXO,IXE,IYO,IYE
521 REAL,DIMENSION(:,:),POINTER              :: TX2DP
522 INTEGER, DIMENSION(MPI_STATUS_SIZE)      :: STATUS
523 LOGICAL                                  :: GALLOC_ll
524
525 INTEGER,ALLOCATABLE,DIMENSION(:)    :: REQ_TAB
526 INTEGER                           :: NB_REQ
527 TYPE TX_2DP
528    REAL,DIMENSION(:,:), POINTER    :: X
529 END TYPE TX_2DP
530 TYPE(TX_2DP),ALLOCATABLE,DIMENSION(:) :: T_TX2DP
531 REAL*8,DIMENSION(2) :: T0,T1,T2
532 REAL*8,DIMENSION(2) :: T11,T22
533 !JUAN
534 !
535 !*      1.1   THE NAME OF LFIFM
536 !
537 CALL SECOND_MNH2(T11)
538 GALLOC    = .FALSE.
539 GALLOC_ll = .FALSE.
540 IRESP  = 0
541 YFNLFI = TRIM(ADJUSTL(HFILEM))//'.lfi'
542 !------------------------------------------------------------------
543 TZFD=>GETFD(YFNLFI)
544 IF (ASSOCIATED(TZFD)) THEN
545   IF (GSMONOPROC  .AND.  (TZFD%nb_procio.eq.1) ) THEN ! sequential execution
546 !    IF (LPACK .AND. L1D .AND. HDIR=='XY') THEN 
547     IF (LPACK .AND. L1D  .AND. SIZE(PFIELD,1)==2*JPHEXT+1 .AND. SIZE(PFIELD,2)==2*JPHEXT+1) THEN
548       ZFIELDP=>PFIELD(2:2,2:2,:)
549       IF (ASSOCIATED(TZFD%CDF)) THEN
550          CALL NCREAD(TZFD%CDF%NCID,HRECFM,ZFIELDP,TZFMH,IRESP)
551       ELSE
552          CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
553       END IF
554       PFIELD(:,:,:)=SPREAD(SPREAD(PFIELD(2,2,:),DIM=1,NCOPIES=3),DIM=2,NCOPIES=3)
555 !    ELSE IF (LPACK .AND. L2D .AND. HDIR=='XY') THEN
556     ELSE IF (LPACK .AND. L2D .AND. SIZE(PFIELD,2)==2*JPHEXT+1) THEN
557       ALLOCATE (ZFIELDP(SIZE(PFIELD,1),1,SIZE(PFIELD,3)))
558       GALLOC = .TRUE.
559       IF (ASSOCIATED(TZFD%CDF)) THEN
560          CALL NCREAD(TZFD%CDF%NCID,HRECFM,ZFIELDP,TZFMH,IRESP)
561       ELSE
562          CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
563       END IF
564       PFIELD(:,:,:)=SPREAD(ZFIELDP(:,1,:),DIM=2,NCOPIES=3)
565     ELSE
566       IF (ASSOCIATED(TZFD%CDF)) THEN
567          CALL NCREAD(TZFD%CDF%NCID,HRECFM,PFIELD,TZFMH,IRESP)
568       ELSE
569          CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
570       END IF
571     END IF
572     IF (IRESP /= 0) GOTO 1000
573   ELSEIF ( (TZFD%nb_procio .eq. 1 ) .OR.  ( HDIR == '--' )  ) THEN ! multiprocessor execution & 1 IO proc 
574   ! read 3D field for graphique
575     IF (ISP == TZFD%OWNER)  THEN
576       CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC)
577       IF (ASSOCIATED(TZFD%CDF)) THEN
578          CALL NCREAD(TZFD%CDF%NCID,HRECFM,ZFIELDP,TZFMH,IRESP)
579       ELSE
580          CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
581            & ,IRESP)
582       END IF
583     ELSE 
584       ALLOCATE(ZFIELDP(0,0,0))
585       GALLOC = .TRUE. 
586     END IF
587     !
588     CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
589     IF (IRESP /= 0) GOTO 1000
590     !
591     CALL BCAST_HEADER(TZFD,TZFMH)
592     !
593     IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
594       ! XX or YY Scatter Field
595       CALL SCATTER_XXFIELD(HDIR,ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM) 
596     ELSE IF (HDIR == 'XY') THEN
597       IF (LPACK .AND. L2D) THEN
598         ! 2D compact case
599         CALL SCATTER_XXFIELD('XX',ZFIELDP(:,1,:),PFIELD(:,2,:),TZFD%OWNER,TZFD%COMM)
600         PFIELD(:,:,:) = SPREAD(PFIELD(:,2,:),DIM=2,NCOPIES=3)
601       ELSE
602         ! XY Scatter Field
603         CALL SCATTER_XYFIELD(ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM)
604       END IF
605     ELSE
606       ! Broadcast Field
607       CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MPI_FLOAT,TZFD%OWNER-1,TZFD%COMM,IERR)
608     END IF
609   ELSE  ! multiprocessor execution & // IO  
610 !
611 !JUAN BG Z SLIDE 
612 !
613 #ifdef MNH_GA
614           !
615           ! init/create the ga
616           !
617           CALL SECOND_MNH2(T0)
618           CALL MNH_INIT_GA(SIZE(PFIELD,1),SIZE(PFIELD,2),SIZE(PFIELD,3),HRECFM,"READ")
619          !
620          ! read the data
621          !
622          ALLOCATE(ZSLIDE_ll(0,0)) ! to avoid bug on test of size
623          GALLOC_ll = .TRUE.
624          DO JKK=1,IKU_ll
625             IK_FILE   =  io_file(JKK,TZFD%nb_procio)
626             write(YK_FILE ,'(".Z",i3.3)') IK_FILE+1
627             YFILE_IOZ =  TRIM(HFILEM)//YK_FILE//".lfi"
628             TZFD_IOZ => GETFD(YFILE_IOZ)
629             !
630             IK_RANK   =  TZFD_IOZ%OWNER
631             !
632             IF (ISP == IK_RANK )  THEN
633                IF ( SIZE(ZSLIDE_ll) .EQ. 0 ) THEN
634                   DEALLOCATE(ZSLIDE_ll)
635                   CALL ALLOCBUFFER_ll(ZSLIDE_ll,ZSLIDE,HDIR,GALLOC_ll)
636                END IF
637                !    
638                CALL SECOND_MNH2(T0)
639                WRITE(YK,'(I4.4)')  JKK
640                YRECZSLIDE = TRIM(HRECFM)//YK
641                IF (ASSOCIATED(TZFD_IOZ%CDF)) THEN
642                   CALL NCREAD(TZFD_IOZ%CDF%NCID,YRECZSLIDE,ZSLIDE_ll,TZFMH,IRESP)
643                ELSE
644                   CALL FM_READ_ll(TZFD_IOZ%FLU,YRECZSLIDE,.TRUE.,SIZE(ZSLIDE_ll),ZSLIDE_ll,TZFMH&
645                        & ,IRESP)
646                END IF
647                CALL SECOND_MNH2(T1)
648                TIMEZ%T_READ3D_READ=TIMEZ%T_READ3D_READ + T1 - T0
649                !
650                ! put the data in the g_a , this proc get this JKK slide
651                !
652                lo_zplan(JPIZ) = JKK
653                hi_zplan(JPIZ) = JKK
654                call nga_put(g_a, lo_zplan, hi_zplan,ZSLIDE_ll, ld_zplan)
655             END IF
656          END DO
657          call ga_sync
658          !
659          ! get the columun data in this proc
660          !
661          ! temp buf to avoid problem with none stride PFIELDS buffer  with HALO 
662          ALLOCATE (ZFIELD_GA (SIZE(PFIELD,1),SIZE(PFIELD,2),SIZE(PFIELD,3)))
663          call nga_get(g_a, lo_col, hi_col,ZFIELD_GA(1,1,1) , ld_col)
664          PFIELD = ZFIELD_GA
665          DEALLOCATE(ZFIELD_GA)
666 #else
667      ALLOCATE(ZSLIDE_ll(0,0))
668      GALLOC_ll = .TRUE.
669      inb_proc_real = min(TZFD%nb_procio,ISNPROC)
670      Z_SLIDE: DO JK=1,SIZE(PFIELD,3),inb_proc_real
671         !
672         ! read the data
673         !
674         JK_MAX=min(SIZE(PFIELD,3),JK+inb_proc_real-1)
675         !
676          NB_REQ=0
677          ALLOCATE(REQ_TAB(ISNPROC-1))
678          ALLOCATE(T_TX2DP(ISNPROC-1))        
679         DO JKK=JK,JK_MAX
680            IF (TZFD%NB_PROCIO .GT. 1 ) THEN
681               IK_FILE   =  io_file(JKK,TZFD%nb_procio)
682               write(YK_FILE ,'(".Z",i3.3)') IK_FILE+1
683               YFILE_IOZ =  TRIM(HFILEM)//YK_FILE//".lfi"
684               TZFD_IOZ => GETFD(YFILE_IOZ)
685            ELSE
686               TZFD_IOZ => TZFD
687            ENDIF
688            IK_RANK   =  TZFD_IOZ%OWNER
689            IF (ISP == IK_RANK )  THEN
690               IF ( SIZE(ZSLIDE_ll) .EQ. 0 ) THEN
691                  DEALLOCATE(ZSLIDE_ll)
692                  CALL ALLOCBUFFER_ll(ZSLIDE_ll,ZSLIDE,HDIR,GALLOC_ll)
693               END IF
694               !JUAN
695                CALL SECOND_MNH2(T0)
696               WRITE(YK,'(I4.4)')  JKK
697               YRECZSLIDE = TRIM(HRECFM)//YK
698               IF (ASSOCIATED(TZFD_IOZ%CDF)) THEN
699                  CALL NCREAD(TZFD_IOZ%CDF%NCID,YRECZSLIDE,ZSLIDE_ll,TZFMH,IRESP)
700               ELSE
701                  CALL FM_READ_ll(TZFD_IOZ%FLU,YRECZSLIDE,.TRUE.,SIZE(ZSLIDE_ll),ZSLIDE_ll,TZFMH&
702                    & ,IRESP)
703               END IF
704               !JUANIOZ
705                CALL SECOND_MNH2(T1)
706                TIMEZ%T_READ3D_READ=TIMEZ%T_READ3D_READ + T1 - T0
707               DO JI = 1,ISNPROC
708                  CALL GET_DOMREAD_ll(JI,IXO,IXE,IYO,IYE)
709                  TX2DP=>ZSLIDE_ll(IXO:IXE,IYO:IYE)
710                  IF (ISP /= JI) THEN 
711                      NB_REQ = NB_REQ + 1
712                      ALLOCATE(T_TX2DP(NB_REQ)%X(IXO:IXE,IYO:IYE))
713                      T_TX2DP(NB_REQ)%X=TX2DP
714                      CALL MPI_ISEND(T_TX2DP(NB_REQ)%X,SIZE(TX2DP),MPI_FLOAT,JI-1,199+IK_RANK &
715                           & ,TZFD_IOZ%COMM,REQ_TAB(NB_REQ),IERR)
716                      !CALL MPI_BSEND(TX2DP,SIZE(TX2DP),MPI_FLOAT,JI-1,199+IK_RANK,TZFD_IOZ%COMM,IERR)
717                  ELSE 
718                     PFIELD(:,:,JKK) = TX2DP(:,:)
719                  END IF
720               END DO
721                CALL SECOND_MNH2(T2)
722                TIMEZ%T_READ3D_SEND=TIMEZ%T_READ3D_SEND + T2 - T1
723               !JUANIOZ
724            END IF
725         END DO
726         !
727         ! brodcast the data
728         !
729     IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
730       ! XX or YY Scatter Field
731        STOP " XX ou YY NON PREVU SUR BG POUR LE MOMENT "
732       CALL SCATTER_XXFIELD(HDIR,ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM) 
733     ELSE IF (HDIR == 'XY') THEN
734        IF (LPACK .AND. L2D) THEN
735           ! 2D compact case
736           STOP " L2D NON PREVU SUR BG POUR LE MOMENT "
737           CALL SCATTER_XXFIELD('XX',ZFIELDP(:,1,:),PFIELD(:,2,:),TZFD%OWNER,TZFD%COMM)
738           PFIELD(:,:,:) = SPREAD(PFIELD(:,2,:),DIM=2,NCOPIES=3)
739        ELSE
740           !
741           ! XY Scatter Field
742           !
743                CALL SECOND_MNH2(T0)
744           DO JKK=JK,JK_MAX
745              !
746              ! get the file & rank 
747              !
748              IF (TZFD%NB_PROCIO .GT. 1 ) THEN
749                IK_FILE   =  io_file(JKK,TZFD%nb_procio)
750                write(YK_FILE ,'(".Z",i3.3)') IK_FILE+1
751                YFILE_IOZ =  TRIM(HFILEM)//YK_FILE//".lfi"
752                TZFD_IOZ => GETFD(YFILE_IOZ)
753             ELSE
754                TZFD_IOZ => TZFD
755             END IF
756             !
757             !IK_RANK   =  1 + io_rank(IK_FILE,ISNPROC,TZFD%nb_procio)
758             IK_RANK    =  TZFD_IOZ%OWNER
759             !
760             ZSLIDE => PFIELD(:,:,JKK)
761 !JUANIOZ
762             !CALL SCATTER_XYFIELD(ZSLIDE_ll,ZSLIDE,TZFD_IOZ%OWNER,TZFD_IOZ%COMM)
763             IF (ISP .NE. IK_RANK) THEN
764                CALL MPI_RECV(ZSLIDE,SIZE(ZSLIDE),MPI_FLOAT,IK_RANK-1,199+IK_RANK,TZFD_IOZ%COMM&
765                     & ,STATUS,IERR)
766             END IF
767 !JUAN IOZ
768          END DO
769                CALL SECOND_MNH2(T1)
770                TIMEZ%T_READ3D_RECV=TIMEZ%T_READ3D_RECV + T1 - T0               
771       END IF
772     ELSE
773       ! Broadcast Field
774        STOP "  Broadcast Field NON PREVU SUR BG POUR LE MOMENT "
775       CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MPI_FLOAT,TZFD%OWNER-1,TZFD%COMM,IERR)
776     END IF
777          CALL SECOND_MNH2(T0) 
778          IF (NB_REQ .GT.0 ) THEN
779             CALL MPI_WAITALL(NB_REQ,REQ_TAB,MNH_STATUSES_IGNORE,IERR)
780             DO JI=1,NB_REQ ;  DEALLOCATE(T_TX2DP(JI)%X) ; ENDDO
781          END IF
782          DEALLOCATE(T_TX2DP)
783          DEALLOCATE(REQ_TAB)
784          CALL SECOND_MNH2(T1) 
785          TIMEZ%T_READ3D_WAIT=TIMEZ%T_READ3D_WAIT + T1 - T0
786  END DO Z_SLIDE
787  !
788  CALL BCAST_HEADER(TZFD,TZFMH)
789  !
790 #endif
791 !JUAN BG Z SLIDE  
792   END IF !(GSMONOPROC) 
793   
794   KGRID    = TZFMH%GRID
795   KLENCH   = TZFMH%COMLEN
796   HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
797 ELSE 
798   IRESP = -61          
799 END IF
800 !----------------------------------------------------------------
801 1000 CONTINUE
802 !! Error handler
803 IF (IRESP.NE.0) THEN
804   CALL FM_READ_ERR("FMREADX3_ll",HFILEM,HFIPRI,HRECFM,HDIR,IRESP)
805 ENDIF
806 IF (GALLOC) DEALLOCATE (ZFIELDP)
807 IF (GALLOC_ll) DEALLOCATE (ZSLIDE_ll)
808 !IF (ASSOCIATED(ZSLIDE_ll)) DEALLOCATE (ZSLIDE_ll)
809 KRESP = IRESP
810 CALL MPI_BARRIER(TZFD%COMM,IERR)
811 CALL SECOND_MNH2(T22)
812 TIMEZ%T_READ3D_ALL=TIMEZ%T_READ3D_ALL + T22 - T11
813
814 !------------------------------------------------------------------
815 END SUBROUTINE FMREADX3_ll
816
817 SUBROUTINE FMREADX4_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
818      KLENCH,HCOMMENT,KRESP)
819 USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LPACK,L1D,L2D 
820 USE MODD_PARAMETERS_ll,ONLY : JPHEXT
821 USE MODD_FM
822 USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
823 USE MODE_SCATTER_ll
824 USE MODE_ALLOCBUFFER_ll
825
826 CHARACTER(LEN=*),              INTENT(IN) ::HFILEM   ! FM-file name
827 CHARACTER(LEN=*),              INTENT(IN) ::HRECFM   ! name of the article to read
828 CHARACTER(LEN=*),              INTENT(IN) ::HFIPRI   ! output file for error messages
829 CHARACTER(LEN=*),              INTENT(IN) ::HDIR     ! field form
830 REAL,DIMENSION(:,:,:,:),TARGET,INTENT(INOUT)::PFIELD   ! array containing the data field
831 INTEGER,                       INTENT(INOUT)::KGRID    ! C-grid indicator (u,v,w,T)
832 INTEGER,                       INTENT(INOUT)::KLENCH   ! length of comment string
833 CHARACTER(LEN=*),              INTENT(INOUT)::HCOMMENT ! comment string
834 INTEGER,                       INTENT(INOUT)::KRESP  ! return-code if
835 !
836 !
837 !*      0.2   Declarations of local variables
838 !
839 CHARACTER(LEN=JPFINL)           :: YFNLFI
840 INTEGER                         :: IERR
841 TYPE(FD_ll), POINTER            :: TZFD
842 INTEGER                         :: IRESP
843 REAL,DIMENSION(:,:,:,:),POINTER :: ZFIELDP
844 LOGICAL                         :: GALLOC
845 TYPE(FMHEADER)                  :: TZFMH
846 !
847 !*      1.1   THE NAME OF LFIFM
848 !
849 GALLOC = .FALSE.
850 IRESP = 0
851 YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
852 !------------------------------------------------------------------
853 TZFD=>GETFD(YFNLFI)
854 IF (ASSOCIATED(TZFD)) THEN
855   IF (GSMONOPROC) THEN ! sequential execution
856 !    IF (LPACK .AND. L1D .AND. HDIR=='XY') THEN 
857     IF (LPACK .AND. L1D .AND. SIZE(PFIELD,1)==2*JPHEXT+1 .AND. SIZE(PFIELD,2)==2*JPHEXT+1) THEN
858       ZFIELDP=>PFIELD(2:2,2:2,:,:)
859       IF (ASSOCIATED(TZFD%CDF)) THEN
860          CALL NCREAD(TZFD%CDF%NCID,HRECFM,ZFIELDP,TZFMH,IRESP)
861       ELSE
862          CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
863       END IF
864       PFIELD(:,:,:,:)=SPREAD(SPREAD(PFIELD(2,2,:,:),DIM=1,NCOPIES=3),DIM=2,NCOPIES=3)
865 !    ELSE IF (LPACK .AND. L2D .AND. HDIR=='XY') THEN
866     ELSE IF (LPACK .AND. L2D .AND. SIZE(PFIELD,2)==2*JPHEXT+1) THEN
867       ZFIELDP=>PFIELD(:,2:2,:,:)
868       IF (ASSOCIATED(TZFD%CDF)) THEN
869          CALL NCREAD(TZFD%CDF%NCID,HRECFM,ZFIELDP,TZFMH,IRESP)
870       ELSE
871          CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
872       END IF
873       PFIELD(:,:,:,:)=SPREAD(PFIELD(:,2,:,:),DIM=2,NCOPIES=3)
874     ELSE
875       IF (ASSOCIATED(TZFD%CDF)) THEN
876          CALL NCREAD(TZFD%CDF%NCID,HRECFM,PFIELD,TZFMH,IRESP)
877       ELSE
878          CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
879       END IF
880     END IF
881     IF (IRESP /= 0) GOTO 1000
882   ELSE
883     IF (ISP == TZFD%OWNER)  THEN
884       CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC)
885       IF (ASSOCIATED(TZFD%CDF)) THEN
886          CALL NCREAD(TZFD%CDF%NCID,HRECFM,ZFIELDP,TZFMH,IRESP)
887       ELSE
888          CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
889            & ,IRESP)
890       END IF
891     ELSE
892       ALLOCATE(ZFIELDP(0,0,0,0))
893       GALLOC = .TRUE.
894     END IF
895     !
896     CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
897     IF (IRESP /= 0) GOTO 1000
898     !
899     CALL BCAST_HEADER(TZFD,TZFMH)
900     !
901     IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
902       ! XX or YY Scatter Field
903       CALL SCATTER_XXFIELD(HDIR,ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM) 
904     ELSE IF (HDIR == 'XY') THEN
905       IF (LPACK .AND. L2D) THEN
906         ! 2D compact case
907         CALL SCATTER_XXFIELD('XX',ZFIELDP(:,1,:,:),PFIELD(:,2,:,:),TZFD%OWNER,TZFD%COMM)
908         PFIELD(:,:,:,:) = SPREAD(PFIELD(:,2,:,:),DIM=2,NCOPIES=3)
909       ELSE
910         ! XY Scatter Field
911         CALL SCATTER_XYFIELD(ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM)
912       END IF
913     ELSE
914       ! Broadcast Field
915       CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MPI_FLOAT,TZFD%OWNER-1,TZFD%COMM,IERR)
916     END IF
917   END IF
918   KGRID  = TZFMH%GRID
919   KLENCH = TZFMH%COMLEN
920   HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
921 ELSE 
922   IRESP = -61
923 END IF
924 !----------------------------------------------------------------
925 1000 CONTINUE
926 !! Error handler
927 IF (IRESP.NE.0) THEN
928   CALL FM_READ_ERR("FMREADX4_ll",HFILEM,HFIPRI,HRECFM,HDIR,IRESP)
929 ENDIF
930
931 IF (GALLOC) DEALLOCATE (ZFIELDP)
932 KRESP = IRESP
933 RETURN
934 !------------------------------------------------------------------
935 END SUBROUTINE FMREADX4_ll
936
937 SUBROUTINE FMREADX5_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
938      KLENCH,HCOMMENT,KRESP)
939 USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LPACK,L1D,L2D 
940 USE MODD_PARAMETERS_ll,ONLY : JPHEXT
941 USE MODD_FM
942 USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
943 USE MODE_SCATTER_ll
944 USE MODE_ALLOCBUFFER_ll
945
946 CHARACTER(LEN=*),                INTENT(IN) ::HFILEM ! FM-file name
947 CHARACTER(LEN=*),                INTENT(IN) ::HRECFM ! name of the article to read
948 CHARACTER(LEN=*),                INTENT(IN) ::HFIPRI ! output file for error messages
949 CHARACTER(LEN=*),                INTENT(IN) ::HDIR   ! field form
950 REAL,DIMENSION(:,:,:,:,:),TARGET,INTENT(INOUT)::PFIELD ! array containing the data field
951 INTEGER,                         INTENT(INOUT)::KGRID  ! C-grid indicator (u,v,w,T)
952 INTEGER,                         INTENT(INOUT)::KLENCH ! length of comment string
953 CHARACTER(LEN=*),                INTENT(INOUT)::HCOMMENT ! comment string
954 INTEGER,                         INTENT(INOUT)::KRESP  ! return-code
955 !
956 !
957 !*      0.2   Declarations of local variables
958 !
959 CHARACTER(LEN=JPFINL)             :: YFNLFI
960 INTEGER                           :: IERR
961 TYPE(FD_ll), POINTER              :: TZFD
962 INTEGER                           :: IRESP
963 REAL,DIMENSION(:,:,:,:,:),POINTER :: ZFIELDP
964 LOGICAL                           :: GALLOC
965 TYPE(FMHEADER)                    :: TZFMH
966 !
967 !*      1.1   THE NAME OF LFIFM
968 !
969 GALLOC = .FALSE.
970 IRESP = 0
971 YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
972 !------------------------------------------------------------------
973 TZFD=>GETFD(YFNLFI)
974 IF (ASSOCIATED(TZFD)) THEN
975   IF (GSMONOPROC) THEN ! sequential execution
976 !    IF (LPACK .AND. L1D .AND. HDIR=='XY') THEN 
977     IF (LPACK .AND. L1D .AND. SIZE(PFIELD,1)==2*JPHEXT+1 .AND. SIZE(PFIELD,2)==2*JPHEXT+1) THEN
978       ZFIELDP=>PFIELD(2:2,2:2,:,:,:)
979       IF (ASSOCIATED(TZFD%CDF)) THEN
980          CALL NCREAD(TZFD%CDF%NCID,HRECFM,ZFIELDP,TZFMH,IRESP)
981       ELSE
982          CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
983       END IF
984       PFIELD(:,:,:,:,:)=SPREAD(SPREAD(PFIELD(2,2,:,:,:),DIM=1,NCOPIES=3),DIM=2,NCOPIES=3)
985 !    ELSE IF (LPACK .AND. L2D .AND. HDIR=='XY') THEN
986     ELSE IF (LPACK .AND. L2D .AND. SIZE(PFIELD,2)==2*JPHEXT+1) THEN
987       ZFIELDP=>PFIELD(:,2:2,:,:,:)
988       IF (ASSOCIATED(TZFD%CDF)) THEN
989          CALL NCREAD(TZFD%CDF%NCID,HRECFM,ZFIELDP,TZFMH,IRESP)
990       ELSE
991          CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
992       END IF
993       PFIELD(:,:,:,:,:)=SPREAD(PFIELD(:,2,:,:,:),DIM=2,NCOPIES=3)
994     ELSE
995       IF (ASSOCIATED(TZFD%CDF)) THEN
996          CALL NCREAD(TZFD%CDF%NCID,HRECFM,PFIELD,TZFMH,IRESP)
997       ELSE
998          CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
999       END IF
1000     END IF  
1001     IF (IRESP /= 0) GOTO 1000
1002   ELSE ! multiprocessor execution
1003     IF (ISP == TZFD%OWNER)  THEN
1004       CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC)
1005       IF (ASSOCIATED(TZFD%CDF)) THEN
1006          CALL NCREAD(TZFD%CDF%NCID,HRECFM,ZFIELDP,TZFMH,IRESP)
1007       ELSE
1008          CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
1009            & ,IRESP)
1010       END IF
1011     ELSE
1012       ALLOCATE(ZFIELDP(0,0,0,0,0))
1013       GALLOC = .TRUE.
1014     END IF
1015     !
1016     CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
1017     IF (IRESP /= 0) GOTO 1000
1018     !
1019     CALL BCAST_HEADER(TZFD,TZFMH)
1020     !
1021     IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
1022       ! XX or YY Scatter Field
1023       CALL SCATTER_XXFIELD(HDIR,ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM) 
1024     ELSE IF (HDIR == 'XY') THEN
1025       IF (LPACK .AND. L2D) THEN
1026         ! 2D compact case
1027         CALL SCATTER_XXFIELD('XX',ZFIELDP(:,1,:,:,:),PFIELD(:,2,:,:,:),&
1028              & TZFD%OWNER,TZFD%COMM)
1029         PFIELD(:,:,:,:,:) = SPREAD(PFIELD(:,2,:,:,:),DIM=2,NCOPIES=3)
1030       ELSE
1031         ! XY Scatter Field
1032         CALL SCATTER_XYFIELD(ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM)
1033       END IF
1034     ELSE
1035       ! Broadcast Field
1036       CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MPI_FLOAT,TZFD%OWNER-1,TZFD%COMM,IERR)
1037     END IF
1038   END IF
1039   KGRID  = TZFMH%GRID
1040   KLENCH = TZFMH%COMLEN
1041   HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
1042 ELSE 
1043   IRESP = -61
1044 END IF
1045 !----------------------------------------------------------------
1046 1000 CONTINUE
1047 !! Error handler
1048 IF (IRESP.NE.0) THEN
1049   CALL FM_READ_ERR("FMREADX5_ll",HFILEM,HFIPRI,HRECFM,HDIR,IRESP)
1050 ENDIF
1051 IF (GALLOC) DEALLOCATE (ZFIELDP)
1052 KRESP = IRESP
1053 RETURN
1054 !------------------------------------------------------------------
1055 END SUBROUTINE FMREADX5_ll
1056
1057 SUBROUTINE FMREADX6_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
1058      KLENCH,HCOMMENT,KRESP)
1059 USE MODD_IO_ll, ONLY : ISP,GSMONOPROC 
1060 USE MODD_FM
1061 USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
1062 USE MODE_SCATTER_ll
1063 USE MODE_ALLOCBUFFER_ll
1064
1065 CHARACTER(LEN=*),                  INTENT(IN) ::HFILEM ! FM-file name
1066 CHARACTER(LEN=*),                  INTENT(IN) ::HRECFM ! name of the article to read
1067 CHARACTER(LEN=*),                  INTENT(IN) ::HFIPRI ! output file for error messages
1068 CHARACTER(LEN=*),                  INTENT(IN) ::HDIR   ! field form
1069 REAL,DIMENSION(:,:,:,:,:,:),TARGET,INTENT(INOUT)::PFIELD ! array containing the data field
1070 INTEGER,                           INTENT(INOUT)::KGRID  ! C-grid indicator (u,v,w,T)
1071 INTEGER,                           INTENT(INOUT)::KLENCH ! length of comment string
1072 CHARACTER(LEN=*),                  INTENT(INOUT)::HCOMMENT ! comment string
1073 INTEGER,                           INTENT(INOUT)::KRESP  ! return-code
1074 !
1075 !
1076 !*      0.2   Declarations of local variables
1077 !
1078 CHARACTER(LEN=JPFINL)               :: YFNLFI
1079 INTEGER                             :: IERR
1080 TYPE(FD_ll), POINTER                :: TZFD
1081 INTEGER                             :: IRESP
1082 REAL,DIMENSION(:,:,:,:,:,:),POINTER :: ZFIELDP
1083 LOGICAL                             :: GALLOC
1084 TYPE(FMHEADER)                      :: TZFMH
1085 !
1086 !*      1.1   THE NAME OF LFIFM
1087 !
1088 GALLOC = .FALSE.
1089 IRESP = 0
1090 YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
1091 !------------------------------------------------------------------
1092 TZFD=>GETFD(YFNLFI)
1093 IF (ASSOCIATED(TZFD)) THEN
1094   IF (GSMONOPROC) THEN ! sequential execution
1095       IF (ASSOCIATED(TZFD%CDF)) THEN
1096          CALL NCREAD(TZFD%CDF%NCID,HRECFM,PFIELD,TZFMH,IRESP)
1097       ELSE
1098          CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
1099       END IF
1100     IF (IRESP /= 0) GOTO 1000
1101   ELSE ! multiprocessor execution
1102     IF (ISP == TZFD%OWNER)  THEN
1103       CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC)
1104       IF (ASSOCIATED(TZFD%CDF)) THEN
1105          CALL NCREAD(TZFD%CDF%NCID,HRECFM,ZFIELDP,TZFMH,IRESP)
1106       ELSE
1107          CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
1108            & ,IRESP)
1109       END IF
1110     ELSE
1111       ALLOCATE(ZFIELDP(0,0,0,0,0,0))
1112       GALLOC = .TRUE.
1113     END IF
1114     !
1115     CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
1116     IF (IRESP /= 0) GOTO 1000
1117     !
1118     CALL BCAST_HEADER(TZFD,TZFMH)
1119     !
1120     IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
1121       ! XX or YY Scatter Field
1122       CALL SCATTER_XXFIELD(HDIR,ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM) 
1123     ELSE IF (HDIR == 'XY') THEN
1124       ! XY Scatter Field
1125       CALL SCATTER_XYFIELD(ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM)
1126     ELSE
1127       ! Broadcast Field
1128       CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MPI_FLOAT,TZFD%OWNER-1,TZFD%COMM,IERR)
1129     END IF
1130   END IF
1131   KGRID  = TZFMH%GRID
1132   KLENCH = TZFMH%COMLEN
1133   HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
1134 ELSE 
1135   IRESP = -61
1136 END IF
1137 !----------------------------------------------------------------
1138 1000 CONTINUE
1139 !! Error handler
1140 IF (IRESP.NE.0) THEN
1141   CALL FM_READ_ERR("FMREADX6_ll",HFILEM,HFIPRI,HRECFM,HDIR,IRESP)
1142 ENDIF
1143 IF (GALLOC) DEALLOCATE (ZFIELDP)
1144 KRESP = IRESP
1145 RETURN
1146 !------------------------------------------------------------------
1147 END SUBROUTINE FMREADX6_ll
1148
1149 SUBROUTINE FMREADN0_ll(HFILEM,HRECFM,HFIPRI,HDIR,KFIELD,KGRID,&
1150      KLENCH,HCOMMENT,KRESP)
1151 USE MODD_IO_ll, ONLY : ISP,GSMONOPROC 
1152 USE MODD_FM
1153 USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
1154
1155 !
1156 !*      0.    DECLARATIONS
1157 !             ------------
1158 !
1159 !
1160 !*      0.1   Declarations of arguments
1161 !
1162 CHARACTER(LEN=*),          INTENT(IN) ::HFILEM   ! FM-file name
1163 CHARACTER(LEN=*),          INTENT(IN) ::HRECFM   ! name of the article to read
1164 CHARACTER(LEN=*),          INTENT(IN) ::HFIPRI   ! output file for error messages
1165 CHARACTER(LEN=*),          INTENT(IN) ::HDIR     ! Field form
1166 INTEGER,                   INTENT(INOUT)::KFIELD ! array containing the data field     
1167 INTEGER,                   INTENT(INOUT)::KGRID    ! C-grid indicator (u,v,w,T)
1168 INTEGER,                   INTENT(INOUT)::KLENCH   ! length of comment string
1169 CHARACTER(LEN=*),          INTENT(INOUT)::HCOMMENT ! comment string
1170 INTEGER,                   INTENT(INOUT)::KRESP    ! return-code
1171 !
1172 !*      0.2   Declarations of local variables
1173 !
1174 CHARACTER(LEN=JPFINL)        :: YFNLFI
1175 INTEGER                      :: IERR
1176 TYPE(FD_ll), POINTER         :: TZFD
1177 INTEGER                      :: IRESP
1178 TYPE(FMHEADER)               :: TZFMH
1179
1180 !
1181 !*      1.1   THE NAME OF LFIFM
1182 !
1183 IRESP = 0
1184 YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
1185 !  
1186 TZFD=>GETFD(YFNLFI)
1187 IF (ASSOCIATED(TZFD)) THEN
1188   IF (GSMONOPROC) THEN ! sequential execution
1189       IF (ASSOCIATED(TZFD%CDF)) THEN
1190          CALL NCREAD(TZFD%CDF%NCID,HRECFM,KFIELD,TZFMH,IRESP)
1191       ELSE
1192          CALL FM_READ_ll(TZFD%FLU,HRECFM,.FALSE.,1,KFIELD,TZFMH,IRESP)
1193       END IF
1194     IF (IRESP /= 0) GOTO 1000
1195   ELSE
1196     IF (ISP == TZFD%OWNER)  THEN
1197       IF (ASSOCIATED(TZFD%CDF)) THEN
1198          CALL NCREAD(TZFD%CDF%NCID,HRECFM,KFIELD,TZFMH,IRESP)
1199       ELSE
1200          CALL FM_READ_ll(TZFD%FLU,HRECFM,.FALSE.,1,KFIELD,TZFMH,IRESP)
1201       END IF
1202     END IF
1203     !
1204     CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
1205     IF (IRESP /= 0) GOTO 1000
1206     !
1207     CALL BCAST_HEADER(TZFD,TZFMH)       
1208     !
1209     CALL MPI_BCAST(KFIELD,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
1210   END IF
1211   KGRID  = TZFMH%GRID
1212   KLENCH = TZFMH%COMLEN
1213   HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
1214 ELSE 
1215   IRESP = -61
1216 END IF
1217 !----------------------------------------------------------------
1218 1000 CONTINUE
1219 !! Error handler
1220 IF (IRESP.NE.0) THEN
1221   CALL FM_READ_ERR("FMREADN0_ll",HFILEM,HFIPRI,HRECFM,HDIR,IRESP)
1222 ENDIF
1223 KRESP = IRESP
1224 RETURN
1225
1226 END SUBROUTINE FMREADN0_ll
1227
1228 SUBROUTINE FMREADN1_ll(HFILEM,HRECFM,HFIPRI,HDIR,KFIELD,KGRID,&
1229      KLENCH,HCOMMENT,KRESP)
1230 USE MODD_IO_ll, ONLY : ISP,GSMONOPROC
1231 USE MODD_FM
1232 USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
1233 USE MODE_SCATTER_ll
1234 USE MODE_ALLOCBUFFER_ll
1235
1236 !*      0.    DECLARATIONS
1237 !             ------------
1238 !
1239 !
1240 !*      0.1   Declarations of arguments
1241 !
1242 CHARACTER(LEN=*),           INTENT(IN) ::HFILEM   ! FM-file name
1243 CHARACTER(LEN=*),           INTENT(IN) ::HRECFM   ! name of the article to read
1244 CHARACTER(LEN=*),           INTENT(IN) ::HFIPRI   ! output file for error messages
1245 CHARACTER(LEN=*),           INTENT(IN) ::HDIR     ! Field form
1246 INTEGER,DIMENSION(:),TARGET,INTENT(INOUT)::KFIELD ! array containing the data field     
1247 INTEGER,                    INTENT(INOUT)::KGRID    ! C-grid indicator (u,v,w,T)
1248 INTEGER,                    INTENT(INOUT)::KLENCH   ! length of comment string
1249 CHARACTER(LEN=*),           INTENT(INOUT)::HCOMMENT ! comment string
1250 INTEGER,                    INTENT(INOUT)::KRESP    ! return-code
1251 !
1252 !*      0.2   Declarations of local variables
1253 !
1254 CHARACTER(LEN=JPFINL)            :: YFNLFI
1255 INTEGER                          :: IERR
1256 TYPE(FD_ll), POINTER             :: TZFD
1257 INTEGER                          :: IRESP
1258 INTEGER,DIMENSION(:),POINTER     :: IFIELDP
1259 LOGICAL                          :: GALLOC
1260 TYPE(FMHEADER)                   :: TZFMH
1261 !
1262 !*      1.1   THE NAME OF LFIFM
1263 !
1264 GALLOC = .FALSE.
1265 IRESP = 0
1266 YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
1267 !------------------------------------------------------------------
1268 TZFD=>GETFD(YFNLFI)
1269 IF (ASSOCIATED(TZFD)) THEN
1270   IF (GSMONOPROC) THEN ! sequential execution
1271     IF (ASSOCIATED(TZFD%CDF)) THEN
1272        CALL NCREAD(TZFD%CDF%NCID,HRECFM,KFIELD,TZFMH,IRESP)
1273     ELSE
1274        CALL FM_READ_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(KFIELD),KFIELD,TZFMH,IRESP)
1275     END IF
1276     IF (IRESP /= 0) GOTO 1000
1277   ELSE
1278     IF (ISP == TZFD%OWNER)  THEN
1279       CALL ALLOCBUFFER_ll(IFIELDP,KFIELD,HDIR,GALLOC)
1280       IF (ASSOCIATED(TZFD%CDF)) THEN
1281          CALL NCREAD(TZFD%CDF%NCID,HRECFM,IFIELDP,TZFMH,IRESP)
1282       ELSE
1283          CALL FM_READ_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELDP),IFIELDP,TZFMH&
1284            & ,IRESP)
1285       END IF
1286     ELSE
1287       ALLOCATE(IFIELDP(0))
1288       GALLOC = .TRUE.
1289     END IF
1290     !
1291     CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
1292     IF (IRESP /= 0) GOTO 1000
1293     !
1294     CALL BCAST_HEADER(TZFD,TZFMH)
1295     !
1296     IF (HDIR /= 'XX' .AND. HDIR /='YY') THEN
1297       ! Broadcast Field
1298       CALL MPI_BCAST(KFIELD,SIZE(KFIELD),MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
1299     ELSE 
1300       !Scatter Field
1301       CALL SCATTER_XXFIELD(HDIR,IFIELDP,KFIELD,TZFD%OWNER,TZFD%COMM) 
1302     END IF
1303   END IF
1304   KGRID  = TZFMH%GRID
1305   KLENCH = TZFMH%COMLEN
1306   HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
1307 ELSE 
1308   IRESP = -61
1309 END IF
1310 !----------------------------------------------------------------
1311 1000 CONTINUE
1312 !! Error handler
1313 IF (IRESP.NE.0) THEN
1314   CALL FM_READ_ERR("FMREADN1_ll",HFILEM,HFIPRI,HRECFM,HDIR,IRESP)
1315 ENDIF
1316 IF (GALLOC) DEALLOCATE (IFIELDP)
1317 KRESP = IRESP
1318 RETURN
1319   
1320 END SUBROUTINE FMREADN1_ll
1321
1322 SUBROUTINE FMREADN2_ll(HFILEM,HRECFM,HFIPRI,HDIR,KFIELD,KGRID,&
1323      KLENCH,HCOMMENT,KRESP)
1324 USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LPACK,L1D,L2D 
1325 USE MODD_PARAMETERS_ll,ONLY : JPHEXT
1326 USE MODD_FM
1327 USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
1328 USE MODE_SCATTER_ll
1329 USE MODE_ALLOCBUFFER_ll
1330
1331 CHARACTER(LEN=*),              INTENT(IN) ::HFILEM ! FM-file name
1332 CHARACTER(LEN=*),              INTENT(IN) ::HRECFM ! name of the article to read
1333 CHARACTER(LEN=*),              INTENT(IN) ::HFIPRI ! output file for error messages
1334 CHARACTER(LEN=*),              INTENT(IN) ::HDIR   ! field form
1335 INTEGER, DIMENSION(:,:),TARGET,INTENT(INOUT)::KFIELD ! array containing the data field
1336 INTEGER,                       INTENT(INOUT)::KGRID  ! C-grid indicator (u,v,w,T)
1337 INTEGER,                       INTENT(INOUT)::KLENCH ! length of comment string
1338 CHARACTER(LEN=*),              INTENT(INOUT)::HCOMMENT ! comment string
1339 INTEGER,                       INTENT(INOUT)::KRESP  ! return-code
1340 !
1341 !
1342 !*      0.2   Declarations of local variables
1343 !
1344 CHARACTER(LEN=JPFINL)          :: YFNLFI
1345 INTEGER                        :: IERR
1346 TYPE(FD_ll), POINTER           :: TZFD
1347 INTEGER                        :: IRESP
1348 INTEGER,DIMENSION(:,:),POINTER :: IFIELDP
1349 LOGICAL                        :: GALLOC
1350 TYPE(FMHEADER)                 :: TZFMH
1351 !
1352 !*      1.1   THE NAME OF LFIFM
1353 !
1354 GALLOC = .FALSE.
1355 IRESP = 0
1356 YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
1357 !------------------------------------------------------------------
1358 TZFD=>GETFD(YFNLFI)
1359 IF (ASSOCIATED(TZFD)) THEN
1360   IF (GSMONOPROC) THEN ! sequential execution
1361 !    IF (LPACK .AND. L1D .AND. HDIR=='XY') THEN 
1362     IF (LPACK .AND. L1D .AND. SIZE(KFIELD,1)==2*JPHEXT+1 .AND. SIZE(KFIELD,2)==2*JPHEXT+1) THEN
1363       IFIELDP=>KFIELD(2:2,2:2)
1364       IF (ASSOCIATED(TZFD%CDF)) THEN
1365          CALL NCREAD(TZFD%CDF%NCID,HRECFM,IFIELDP,TZFMH,IRESP)
1366       ELSE
1367          CALL FM_READ_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELDP),IFIELDP,TZFMH,IRESP)
1368       END IF
1369       KFIELD(:,:)=SPREAD(SPREAD(KFIELD(2,2),DIM=1,NCOPIES=3),DIM=2,NCOPIES=3)
1370 !    ELSE IF (LPACK .AND. L2D .AND. HDIR=='XY') THEN
1371     ELSE IF (LPACK .AND. L2D .AND. SIZE(KFIELD,2)==2*JPHEXT+1) THEN
1372       IFIELDP=>KFIELD(:,2:2)
1373       IF (ASSOCIATED(TZFD%CDF)) THEN
1374          CALL NCREAD(TZFD%CDF%NCID,HRECFM,IFIELDP,TZFMH,IRESP)
1375       ELSE
1376          CALL FM_READ_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELDP),IFIELDP,TZFMH,IRESP)
1377       END IF
1378       KFIELD(:,:)=SPREAD(KFIELD(:,2),DIM=2,NCOPIES=3)
1379     ELSE
1380       IF (ASSOCIATED(TZFD%CDF)) THEN
1381          CALL NCREAD(TZFD%CDF%NCID,HRECFM,KFIELD,TZFMH,IRESP)
1382       ELSE
1383          CALL FM_READ_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(KFIELD),KFIELD,TZFMH,IRESP)
1384       END IF
1385     END IF
1386     IF (IRESP /= 0) GOTO 1000
1387   ELSE
1388     IF (ISP == TZFD%OWNER)  THEN
1389       CALL ALLOCBUFFER_ll(IFIELDP,KFIELD,HDIR,GALLOC)
1390       IF (ASSOCIATED(TZFD%CDF)) THEN
1391          CALL NCREAD(TZFD%CDF%NCID,HRECFM,IFIELDP,TZFMH,IRESP)
1392       ELSE
1393          CALL FM_READ_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELDP),IFIELDP&
1394            & ,TZFMH,IRESP)
1395       END IF
1396     ELSE
1397       ALLOCATE(IFIELDP(0,0))
1398       GALLOC = .TRUE.
1399     END IF
1400     !
1401     CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
1402     IF (IRESP /= 0) GOTO 1000
1403     !
1404     CALL BCAST_HEADER(TZFD,TZFMH)
1405     !
1406     IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
1407       ! XX or YY Scatter Field
1408       CALL SCATTER_XXFIELD(HDIR,IFIELDP,KFIELD,TZFD%OWNER,TZFD&
1409            & %COMM) 
1410     ELSE IF (HDIR == 'XY') THEN
1411       IF (LPACK .AND. L2D) THEN
1412         ! 2D compact case
1413         CALL SCATTER_XXFIELD('XX',IFIELDP(:,1),KFIELD(:,2),TZFD%OWNER,TZFD%COMM)
1414         KFIELD(:,:) = SPREAD(KFIELD(:,2),DIM=2,NCOPIES=3)
1415       ELSE
1416         ! XY Scatter Field
1417         CALL SCATTER_XYFIELD(IFIELDP,KFIELD,TZFD%OWNER,TZFD%COMM)
1418       END IF
1419     ELSE
1420       ! Broadcast Field
1421       IF (ISP == TZFD%OWNER) KFIELD = IFIELDP
1422       CALL MPI_BCAST(KFIELD,SIZE(KFIELD),MPI_INTEGER,TZFD%OWNER-1&
1423            & ,TZFD%COMM,IERR)
1424     END IF
1425   END IF
1426   KGRID  = TZFMH%GRID
1427   KLENCH = TZFMH%COMLEN
1428   HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
1429 ELSE 
1430   IRESP = -61
1431 END IF
1432 !----------------------------------------------------------------
1433 1000 CONTINUE
1434 !! Error handler
1435 IF (IRESP.NE.0) THEN
1436   CALL FM_READ_ERR("FMREADN2_ll",HFILEM,HFIPRI,HRECFM,HDIR,IRESP)
1437 ENDIF
1438 !
1439 IF (GALLOC) DEALLOCATE (IFIELDP)
1440 KRESP = IRESP
1441 RETURN
1442 !------------------------------------------------------------------
1443 END SUBROUTINE FMREADN2_ll
1444
1445
1446 SUBROUTINE FMREADL0_ll(HFILEM,HRECFM,HFIPRI,HDIR,OFIELD,KGRID,&
1447      KLENCH,HCOMMENT,KRESP)
1448 USE MODD_IO_ll, ONLY : ISP,GSMONOPROC 
1449 USE MODD_FM
1450 USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
1451
1452 !*      0.    DECLARATIONS
1453 !             ------------
1454 !
1455 !
1456 !*      0.1   Declarations of arguments
1457 !
1458 CHARACTER(LEN=*),          INTENT(IN) ::HFILEM ! FM-file name
1459 CHARACTER(LEN=*),          INTENT(IN) ::HRECFM ! name of the article to read
1460 CHARACTER(LEN=*),          INTENT(IN) ::HFIPRI ! output file for error messages
1461 CHARACTER(LEN=*),          INTENT(IN) ::HDIR   ! field form
1462 LOGICAL,                   INTENT(INOUT)::OFIELD ! array containing the data field
1463 INTEGER,                   INTENT(INOUT)::KGRID  ! C-grid indicator (u,v,w,T)
1464 INTEGER,                   INTENT(INOUT)::KLENCH ! length of comment string
1465 CHARACTER(LEN=*),          INTENT(INOUT)::HCOMMENT ! comment string
1466 INTEGER,                   INTENT(INOUT)::KRESP    ! return-code
1467 !
1468 !*      0.2   Declarations of local variables
1469 !
1470 CHARACTER(LEN=JPFINL)        :: YFNLFI
1471 INTEGER                      :: IERR
1472 TYPE(FD_ll), POINTER         :: TZFD
1473 INTEGER                      :: IRESP
1474 INTEGER                      :: IFIELD
1475 TYPE(FMHEADER)               :: TZFMH
1476
1477 !
1478 !*      1.1   THE NAME OF LFIFM
1479 !
1480 IRESP = 0
1481 YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
1482 !------------------------------------------------------------------
1483 TZFD=>GETFD(YFNLFI)
1484 IF (ASSOCIATED(TZFD)) THEN
1485   IF (GSMONOPROC) THEN ! sequential execution
1486     IF (ASSOCIATED(TZFD%CDF)) THEN
1487        CALL NCREAD(TZFD%CDF%NCID,HRECFM,IFIELD,TZFMH,IRESP)
1488     ELSE
1489        CALL FM_READ_ll(TZFD%FLU,HRECFM,.FALSE.,1,IFIELD,TZFMH,IRESP)
1490     END IF
1491     IF (IRESP /= 0) GOTO 1000
1492   ELSE
1493     IF (ISP == TZFD%OWNER)  THEN
1494       IF (ASSOCIATED(TZFD%CDF)) THEN
1495          CALL NCREAD(TZFD%CDF%NCID,HRECFM,IFIELD,TZFMH,IRESP)
1496       ELSE
1497          CALL FM_READ_ll(TZFD%FLU,HRECFM,.FALSE.,1,IFIELD,TZFMH,IRESP)
1498       END IF
1499     END IF
1500     !
1501     CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
1502     IF (IRESP /= 0) GOTO 1000
1503     !
1504     CALL BCAST_HEADER(TZFD,TZFMH)
1505     !
1506     CALL MPI_BCAST(IFIELD,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,&
1507          & IERR)
1508   END IF
1509   IF (IFIELD==1) THEN
1510     OFIELD=.TRUE.
1511   ELSE
1512     OFIELD=.FALSE.
1513   END IF
1514   KGRID  = TZFMH%GRID
1515   KLENCH = TZFMH%COMLEN
1516   HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
1517 ELSE 
1518   IRESP = -61
1519 END IF
1520 !----------------------------------------------------------------
1521 1000 CONTINUE
1522 !! Error handler
1523 IF (IRESP.NE.0) THEN
1524   CALL FM_READ_ERR("FMREADL0_ll",HFILEM,HFIPRI,HRECFM,HDIR,IRESP)
1525 ENDIF
1526 KRESP = IRESP
1527 RETURN
1528
1529 END SUBROUTINE FMREADL0_ll
1530
1531 SUBROUTINE FMREADL1_ll(HFILEM,HRECFM,HFIPRI,HDIR,OFIELD,KGRID,&
1532      KLENCH,HCOMMENT,KRESP)
1533 USE MODD_IO_ll, ONLY : ISP,GSMONOPROC 
1534 USE MODD_FM
1535 USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
1536 !
1537 !*      0.    DECLARATIONS
1538 !             ------------
1539 !
1540 IMPLICIT NONE
1541 !
1542 !*      0.1   Declarations of arguments
1543 !
1544 CHARACTER(LEN=*),          INTENT(IN) ::HFILEM  ! FM-file name
1545 CHARACTER(LEN=*),          INTENT(IN) ::HRECFM  ! name of the article to read
1546 CHARACTER(LEN=*),          INTENT(IN) ::HFIPRI  ! output file for error messages
1547 CHARACTER(LEN=*),          INTENT(IN) ::HDIR    ! Field form
1548 LOGICAL, DIMENSION(:),     INTENT(INOUT)::OFIELD  ! array containing the data field
1549 INTEGER,                   INTENT(INOUT)::KGRID    ! C-grid indicator (u,v,w,T)
1550 INTEGER,                   INTENT(INOUT)::KLENCH   ! length of comment string
1551 CHARACTER(LEN=*),          INTENT(INOUT)::HCOMMENT ! comment string
1552 INTEGER,                   INTENT(INOUT)::KRESP    ! return-code
1553 !
1554 !*      0.2   Declarations of local variables
1555 !
1556
1557 CHARACTER(LEN=JPFINL)            :: YFNLFI
1558 INTEGER                          :: IERR
1559 TYPE(FD_ll), POINTER             :: TZFD
1560 INTEGER                          :: IRESP
1561 INTEGER, DIMENSION(SIZE(OFIELD)) :: IFIELD
1562 TYPE(FMHEADER)                   :: TZFMH
1563
1564 !
1565 !*      1.1   THE NAME OF LFIFM
1566 !
1567 IRESP = 0
1568 YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
1569 !
1570 TZFD=>GETFD(YFNLFI)
1571 IF (ASSOCIATED(TZFD)) THEN
1572   IF (GSMONOPROC) THEN ! sequential execution
1573       IF (ASSOCIATED(TZFD%CDF)) THEN
1574          CALL NCREAD(TZFD%CDF%NCID,HRECFM,IFIELD,TZFMH,IRESP)
1575       ELSE
1576          CALL FM_READ_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELD),IFIELD,TZFMH&
1577          & ,IRESP)
1578       END IF
1579     IF (IRESP /= 0) GOTO 1000
1580   ELSE
1581     IF (ISP == TZFD%OWNER)  THEN
1582       IF (ASSOCIATED(TZFD%CDF)) THEN
1583          CALL NCREAD(TZFD%CDF%NCID,HRECFM,IFIELD,TZFMH,IRESP)
1584       ELSE
1585          CALL FM_READ_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELD),IFIELD,TZFMH&
1586            & ,IRESP)
1587       END IF
1588     END IF
1589     !
1590     CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
1591     IF (IRESP /= 0) GOTO 1000
1592     !
1593     CALL BCAST_HEADER(TZFD,TZFMH)
1594     !
1595     CALL MPI_BCAST(IFIELD,SIZE(IFIELD),MPI_INTEGER,TZFD%OWNER-1,TZFD&
1596        & %COMM,IERR)
1597   END IF
1598   WHERE (IFIELD==1)
1599     OFIELD=.TRUE.
1600   ELSEWHERE
1601     OFIELD=.FALSE.
1602   END WHERE
1603   KGRID  = TZFMH%GRID
1604   KLENCH = TZFMH%COMLEN
1605   HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
1606 ELSE 
1607   IRESP = -61
1608 END IF
1609 !----------------------------------------------------------------
1610 1000 CONTINUE
1611 !! Error handler
1612 IF (IRESP.NE.0) THEN
1613   CALL FM_READ_ERR("FMREADL1_ll",HFILEM,HFIPRI,HRECFM,HDIR,IRESP)
1614 ENDIF
1615 KRESP = IRESP
1616 RETURN
1617
1618 END SUBROUTINE FMREADL1_ll
1619
1620 SUBROUTINE FMREADC0_ll(HFILEM,HRECFM,HFIPRI,HDIR,HFIELD,KGRID,&
1621      KLENCH,HCOMMENT,KRESP)
1622 USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIREAD
1623 USE MODD_FM
1624 USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
1625 !
1626 !*      0.    DECLARATIONS
1627 !             ------------
1628 !
1629 !
1630 !*      0.1   Declarations of arguments
1631 !
1632 CHARACTER(LEN=*),          INTENT(IN) ::HFILEM   ! FM-file name
1633 CHARACTER(LEN=*),          INTENT(IN) ::HRECFM   ! name of the article to read
1634 CHARACTER(LEN=*),          INTENT(IN) ::HFIPRI   ! output file for error messages
1635 CHARACTER(LEN=*),          INTENT(IN) ::HDIR     ! Field form
1636 CHARACTER(LEN=*),          INTENT(INOUT)::HFIELD   ! array containing the data field    
1637 INTEGER,                   INTENT(INOUT)::KGRID    ! C-grid indicator (u,v,w,T)
1638 INTEGER,                   INTENT(INOUT)::KLENCH   ! length of comment string
1639 CHARACTER(LEN=*),          INTENT(INOUT)::HCOMMENT ! comment string
1640 INTEGER,                   INTENT(INOUT)::KRESP    ! return-code
1641 !
1642 !*      0.2   Declarations of local variables
1643 !
1644 CHARACTER(LEN=JPFINL)             :: YFNLFI
1645 INTEGER                           :: IERR
1646 TYPE(FD_ll), POINTER              :: TZFD
1647 INTEGER                           :: IRESP
1648 INTEGER                           :: JLOOP
1649 INTEGER, DIMENSION(LEN(HFIELD))   :: IFIELD
1650 CHARACTER(LEN(HFIELD))            :: YFIELD
1651 INTEGER                           :: ILENG
1652 TYPE(FMHEADER)                    :: TZFMH
1653
1654 !
1655 !*      1.1   THE NAME OF LFIFM
1656 !
1657 IRESP = 0
1658 YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
1659 ILENG=LEN(HFIELD)
1660 !
1661 TZFD=>GETFD(YFNLFI)
1662 IF (ASSOCIATED(TZFD)) THEN
1663   IF (GSMONOPROC) THEN  ! sequential execution
1664       IF (ASSOCIATED(TZFD%CDF)) THEN
1665          CALL NCREAD(TZFD%CDF%NCID,HRECFM,YFIELD,TZFMH,IRESP)
1666       ELSE
1667          CALL FM_READ_ll(TZFD%FLU,HRECFM,.FALSE.,ILENG,IFIELD,TZFMH,IRESP)
1668       END IF
1669     IF (IRESP /= 0) GOTO 1000
1670   ELSE ! parallel execution
1671     IF (ISP == TZFD%OWNER)  THEN
1672       IF (ASSOCIATED(TZFD%CDF)) THEN
1673          CALL NCREAD(TZFD%CDF%NCID,HRECFM,YFIELD,TZFMH,IRESP)
1674       ELSE
1675          CALL FM_READ_ll(TZFD%FLU,HRECFM,.FALSE.,ILENG,IFIELD,TZFMH,IRESP)
1676       END IF
1677     END IF
1678     !
1679     CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
1680     IF (IRESP /= 0) GOTO 1000
1681     !
1682     CALL BCAST_HEADER(TZFD,TZFMH)
1683     !
1684     IF (LIOCDF4 .AND. .NOT. LLFIREAD) THEN
1685        ! NetCDF
1686        CALL MPI_BCAST(YFIELD,ILENG,MPI_CHARACTER,TZFD%OWNER-1,TZFD%COMM,&
1687             &IERR)
1688     ELSE 
1689        ! LFI
1690        CALL MPI_BCAST(IFIELD,ILENG,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,&
1691             & IERR)
1692     END IF
1693   END IF ! parallel execution
1694   !
1695   IF (LIOCDF4 .AND. .NOT. LLFIREAD) THEN
1696      ! NetCDF
1697      HFIELD = YFIELD
1698   ELSE
1699      ! LFI Case
1700      DO JLOOP=1,ILENG
1701         HFIELD(JLOOP:JLOOP)=ACHAR(IFIELD(JLOOP))
1702      END DO
1703   END IF
1704   KGRID  = TZFMH%GRID
1705   KLENCH = TZFMH%COMLEN
1706   HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
1707 ELSE 
1708   IRESP = -61
1709 END IF
1710 !----------------------------------------------------------------
1711 1000 CONTINUE
1712 !! Error handler
1713 IF (IRESP.NE.0) THEN
1714   CALL FM_READ_ERR("FMREADC0_ll",HFILEM,HFIPRI,HRECFM,HDIR,IRESP)
1715 ENDIF
1716 KRESP = IRESP
1717 RETURN
1718
1719 END SUBROUTINE FMREADC0_ll
1720
1721 SUBROUTINE FMREADT0_ll(HFILEM,HRECFM,HFIPRI,HDIR,TFIELD,KGRID,&
1722                            KLENCH,HCOMMENT,KRESP)
1723 !*      0.    DECLARATIONS
1724 !             ------------
1725 !
1726 USE MODD_IO_ll, ONLY : ISP,GSMONOPROC 
1727 USE MODD_TYPE_DATE
1728 USE MODD_FM
1729 USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
1730 !
1731 !*      0.1   Declarations of arguments
1732 !
1733 CHARACTER(LEN=*),          INTENT(IN) ::HFILEM   ! FM-file name
1734 CHARACTER(LEN=*),          INTENT(IN) ::HRECFM   ! name of the article to read
1735 CHARACTER(LEN=*),          INTENT(IN) ::HFIPRI   ! output file for error messages
1736 CHARACTER(LEN=*),          INTENT(IN) ::HDIR     ! Field form
1737 TYPE (DATE_TIME),          INTENT(INOUT)::TFIELD ! array containing the data field
1738 INTEGER,                   INTENT(INOUT)::KGRID    ! C-grid indicator (u,v,w,T)
1739 INTEGER,                   INTENT(INOUT)::KLENCH   ! length of comment string
1740 CHARACTER(LEN=*),          INTENT(INOUT)::HCOMMENT ! comment string
1741 INTEGER,                   INTENT(INOUT)::KRESP    ! return-code
1742 !
1743 !
1744 !*      0.2   Declarations of local variables
1745 !
1746 !-------------------------------------------------------------------------------
1747
1748
1749 CHARACTER(LEN=JPFINL)        :: YFNLFI
1750 INTEGER                      :: IERR
1751 TYPE(FD_ll), POINTER         :: TZFD
1752 INTEGER                      :: IRESP
1753 INTEGER,DIMENSION(3)         :: ITDATE
1754 REAL                         :: ZTIME
1755 TYPE(FMHEADER)               :: TZFMH
1756
1757 !
1758 !*      1.1   THE NAME OF LFIFM
1759 !
1760 IRESP = 0
1761
1762 YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
1763
1764 TZFD=>GETFD(YFNLFI)
1765 IF (ASSOCIATED(TZFD)) THEN
1766   IF (GSMONOPROC) THEN ! sequential execution
1767     IF (ASSOCIATED(TZFD%CDF)) THEN
1768        CALL NCREAD(TZFD%CDF%NCID,TRIM(HRECFM)//'%TDATE',ITDATE,TZFMH,IRESP)
1769        CALL NCREAD(TZFD%CDF%NCID,TRIM(HRECFM)//'%TIME',ZTIME,TZFMH,IRESP)
1770     ELSE
1771        CALL FM_READ_ll(TZFD%FLU,TRIM(HRECFM)//'%TDATE',.FALSE.,3,ITDATE&
1772        & ,TZFMH,IRESP)
1773        CALL FM_READ_ll(TZFD%FLU,TRIM(HRECFM)//'%TIME',.TRUE.,1,ZTIME&
1774        & ,TZFMH,IRESP)
1775     END IF
1776     IF (IRESP /= 0) GOTO 1000
1777   ELSE
1778     IF (ISP == TZFD%OWNER)  THEN
1779        IF (ASSOCIATED(TZFD%CDF)) THEN
1780           CALL NCREAD(TZFD%CDF%NCID,TRIM(HRECFM)//'%TDATE',ITDATE,TZFMH,IRESP)
1781           CALL NCREAD(TZFD%CDF%NCID,TRIM(HRECFM)//'%TIME',ZTIME,TZFMH,IRESP)
1782        ELSE
1783           CALL FM_READ_ll(TZFD%FLU,TRIM(HRECFM)//'%TDATE',.FALSE.,3,ITDATE&
1784                & ,TZFMH,IRESP)
1785           CALL FM_READ_ll(TZFD%FLU,TRIM(HRECFM)//'%TIME',.TRUE.,1,ZTIME&
1786                & ,TZFMH,IRESP)
1787
1788        END IF
1789     END IF
1790     !
1791     CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
1792     IF (IRESP /= 0) GOTO 1000
1793     ! Last header is significant
1794     CALL BCAST_HEADER(TZFD,TZFMH)      
1795     !
1796     CALL MPI_BCAST(ITDATE,3,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
1797     CALL MPI_BCAST(ZTIME,1,MPI_FLOAT,TZFD%OWNER-1,TZFD%COMM,IERR)
1798   END IF
1799   TFIELD%TDATE = DATE(ITDATE(1),ITDATE(2),ITDATE(3))
1800   TFIELD%TIME = ZTIME
1801   KGRID  = TZFMH%GRID
1802   KLENCH = TZFMH%COMLEN
1803   HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
1804 ELSE 
1805   IRESP = -61
1806 END IF
1807 !----------------------------------------------------------------
1808 1000 CONTINUE
1809 !! Error handler
1810 IF (IRESP.NE.0) THEN
1811   CALL FM_READ_ERR("FMREADT0_ll",HFILEM,HFIPRI,HRECFM,HDIR,IRESP)
1812 ENDIF
1813 KRESP = IRESP
1814 RETURN
1815
1816 END SUBROUTINE FMREADT0_ll
1817
1818 SUBROUTINE FMREAD_LB(HFILEM,HRECFM,HFIPRI,HLBTYPE,PLB,KRIM,KL3D,&
1819      & KGRID,KLENCH,HCOMMENT,KRESP)
1820 USE MODD_FM
1821 USE MODD_IO_ll,        ONLY : ISP,ISNPROC,GSMONOPROC,LPACK,L2D 
1822 USE MODD_PARAMETERS_ll,ONLY : JPHEXT
1823 USE MODE_DISTRIB_LB
1824 USE MODE_TOOLS_ll,     ONLY : GET_GLOBALDIMS_ll
1825 USE MODE_FD_ll,        ONLY : GETFD,JPFINL,FD_LL
1826 !JUANZ
1827 USE MODD_TIMEZ, ONLY : TIMEZ
1828 USE MODE_MNH_TIMING, ONLY : SECOND_MNH2
1829 !JUANZ
1830 USE MODD_VAR_ll, ONLY : MNH_STATUSES_IGNORE
1831
1832 CHARACTER(LEN=*),     INTENT(IN) ::HFILEM   ! file name
1833 CHARACTER(LEN=*),     INTENT(IN) ::HRECFM   ! name of the article to be written
1834 CHARACTER(LEN=*),     INTENT(IN) ::HFIPRI   ! file for prints
1835 CHARACTER(LEN=*),     INTENT(IN) ::HLBTYPE  ! 'LBX','LBXU','LBY' or 'LBYV'
1836 REAL, DIMENSION(:,:,:),TARGET, INTENT(INOUT)::PLB ! array containing the LB field
1837 INTEGER,              INTENT(IN) :: KRIM  ! size of the LB area
1838 INTEGER,              INTENT(IN) :: KL3D  ! size of the LB array in FM
1839 INTEGER,              INTENT(INOUT)::KGRID  ! C-grid indicator (u,v,w,T)
1840 INTEGER,              INTENT(INOUT)::KLENCH ! length of comment string
1841 CHARACTER(LEN=*),     INTENT(INOUT)::HCOMMENT ! comment string
1842 INTEGER,              INTENT(INOUT)::KRESP  ! return-code 
1843 !
1844 !*      0.2   Declarations of local variables
1845 !
1846 CHARACTER(LEN=JPFINL)        :: YFNLFI
1847 INTEGER                      :: IERR
1848 TYPE(FD_ll), POINTER         :: TZFD
1849 INTEGER                      :: IRESP
1850 REAL,DIMENSION(:,:,:),ALLOCATABLE,TARGET :: Z3D
1851 REAL,DIMENSION(:,:,:), POINTER           :: TX3DP
1852 TYPE(FMHEADER)               :: TZFMH
1853 INTEGER :: IIMAX_ll,IJMAX_ll
1854 INTEGER :: IIB,IIE,IJB,IJE
1855 INTEGER :: JI
1856 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: STATUS
1857 INTEGER, ALLOCATABLE,DIMENSION(:,:)   :: STATUSES
1858 !JUANZIO
1859 !JUAN INTEGER,SAVE,DIMENSION(100000)    :: REQ_TAB
1860 INTEGER,ALLOCATABLE,DIMENSION(:)    :: REQ_TAB
1861 INTEGER                           :: NB_REQ,IKU
1862 TYPE TX_3DP
1863 REAL,DIMENSION(:,:,:), POINTER    :: X
1864 END TYPE
1865 TYPE(TX_3DP),ALLOCATABLE,DIMENSION(:) :: T_TX3DP
1866 REAL*8,DIMENSION(2) :: T0,T1,T2,T3
1867 REAL*8,DIMENSION(2) :: T11,T22
1868 !JUANZIO
1869
1870 !
1871 !*      1.1   THE NAME OF LFIFM
1872 !
1873 CALL SECOND_MNH2(T11)
1874 IRESP = 0
1875 YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
1876 !------------------------------------------------------------------
1877 TZFD=>GETFD(YFNLFI)
1878 IF (ASSOCIATED(TZFD)) THEN
1879   IF (GSMONOPROC) THEN ! sequential execution
1880     IF (HLBTYPE == 'LBX' .OR. HLBTYPE == 'LBXU') THEN 
1881       ALLOCATE(Z3D(KL3D,SIZE(PLB,2),SIZE(PLB,3)))
1882       Z3D = 0.0
1883       IF (LPACK .AND. L2D) THEN
1884         TX3DP=>Z3D(:,JPHEXT+1:JPHEXT+1,:)
1885         IF (ASSOCIATED(TZFD%CDF)) THEN
1886            CALL NCREAD(TZFD%CDF%NCID,HRECFM,TX3DP,TZFMH,IRESP)
1887         ELSE
1888            CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(TX3DP),TX3DP,TZFMH,IRESP)
1889         END IF
1890         Z3D(:,:,:) = SPREAD(Z3D(:,JPHEXT+1,:),DIM=2,NCOPIES=2*JPHEXT+1)
1891       ELSE
1892          IF (ASSOCIATED(TZFD%CDF)) THEN
1893             CALL NCREAD(TZFD%CDF%NCID,HRECFM,Z3D,TZFMH,IRESP)
1894          ELSE
1895             CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(Z3D),Z3D,TZFMH,IRESP)
1896          END IF
1897       END IF
1898       PLB(1:KRIM+JPHEXT,:,:)          = Z3D(1:KRIM+JPHEXT,:,:)
1899       PLB(KRIM+JPHEXT+1:2*(KRIM+JPHEXT),:,:) = Z3D(KL3D-KRIM-JPHEXT+1:KL3D,:,:)
1900     ELSE !(HLBTYPE == 'LBY' .OR. HLBTYPE == 'LBYV') 
1901       ALLOCATE(Z3D(SIZE(PLB,1),KL3D,SIZE(PLB,3)))
1902       Z3D = 0.0
1903       IF (ASSOCIATED(TZFD%CDF)) THEN
1904          CALL NCREAD(TZFD%CDF%NCID,HRECFM,Z3D,TZFMH,IRESP)
1905       ELSE
1906          CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(Z3D),Z3D,TZFMH,IRESP)
1907       END IF
1908       PLB(:,1:KRIM+JPHEXT,:)          = Z3D(:,1:KRIM+JPHEXT,:)
1909       PLB(:,KRIM+JPHEXT+1:2*(KRIM+JPHEXT),:) = Z3D(:,KL3D-KRIM-JPHEXT+1:KL3D,:)
1910     END IF
1911     IF (IRESP /= 0) GOTO 1000
1912   ELSE                 ! multiprocessor execution
1913     IF (ISP == TZFD%OWNER)  THEN
1914       CALL SECOND_MNH2(T0)
1915       CALL GET_GLOBALDIMS_ll(IIMAX_ll,IJMAX_ll)
1916       IF (HLBTYPE == 'LBX' .OR. HLBTYPE == 'LBXU') THEN 
1917         ALLOCATE(Z3D(KL3D,IJMAX_ll+2*JPHEXT,SIZE(PLB,3)))
1918         Z3D = 0.0
1919         IF (LPACK .AND. L2D) THEN
1920           TX3DP=>Z3D(:,JPHEXT+1:JPHEXT+1,:)
1921           IF (ASSOCIATED(TZFD%CDF)) THEN
1922              CALL NCREAD(TZFD%CDF%NCID,HRECFM,TX3DP,TZFMH,IRESP)
1923           ELSE
1924              CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(TX3DP),TX3DP,TZFMH,IRESP)
1925           END IF
1926           Z3D(:,:,:) = SPREAD(Z3D(:,JPHEXT+1,:),DIM=2,NCOPIES=2*JPHEXT+1)
1927         ELSE
1928            IF (ASSOCIATED(TZFD%CDF)) THEN
1929               CALL NCREAD(TZFD%CDF%NCID,HRECFM,Z3D,TZFMH,IRESP)
1930            ELSE
1931               CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(Z3D),Z3D,TZFMH,IRESP)
1932            END IF
1933         END IF
1934         ! erase gap in LB field
1935         Z3D(KRIM+JPHEXT+1:2*(KRIM+JPHEXT),:,:) = Z3D(KL3D-KRIM-JPHEXT+1:KL3D,:,:)
1936       ELSE !(HLBTYPE == 'LBY' .OR. HLBTYPE == 'LBYV') 
1937         ALLOCATE(Z3D(IIMAX_ll+2*JPHEXT,KL3D,SIZE(PLB,3)))
1938         Z3D = 0.0
1939         IF (ASSOCIATED(TZFD%CDF)) THEN
1940            CALL NCREAD(TZFD%CDF%NCID,HRECFM,Z3D,TZFMH,IRESP)
1941         ELSE
1942            CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(Z3D),Z3D,TZFMH,IRESP)
1943         END IF
1944         ! erase gap in LB field
1945         Z3D(:,KRIM+JPHEXT+1:2*(KRIM+JPHEXT),:) = Z3D(:,KL3D-KRIM-JPHEXT+1:KL3D,:)
1946       END IF
1947       CALL SECOND_MNH2(T1)
1948       TIMEZ%T_READLB_READ=TIMEZ%T_READLB_READ + T1 - T0
1949     END IF
1950     !  
1951     CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
1952     IF (IRESP /= 0) GOTO 1000
1953     !  
1954     CALL BCAST_HEADER(TZFD,TZFMH)
1955     ! 
1956     NB_REQ=0
1957     ALLOCATE(REQ_TAB(ISNPROC-1))
1958     !REQ_TAB=MPI_REQUEST_NULL
1959     IF (ISP == TZFD%OWNER)  THEN
1960        CALL SECOND_MNH2(T1)
1961       !ALLOCATE(REQ_TAB(ISNPROC-1))
1962       !REQ_TAB=MPI_REQUEST_NULL
1963       ALLOCATE(T_TX3DP(ISNPROC-1))
1964       IKU = SIZE(Z3D,3)
1965       DO JI = 1,ISNPROC
1966         CALL GET_DISTRIB_LB(HLBTYPE,JI,'FM','READ',KRIM,IIB,IIE,IJB,IJE)
1967         IF (IIB /= 0) THEN
1968           TX3DP=>Z3D(IIB:IIE,IJB:IJE,:)
1969           IF (ISP /= JI) THEN 
1970             NB_REQ = NB_REQ + 1
1971             ALLOCATE(T_TX3DP(NB_REQ)%X(IIB:IIE,IJB:IJE,IKU))           
1972             T_TX3DP(NB_REQ)%X=Z3D(IIB:IIE,IJB:IJE,:)
1973             CALL MPI_ISEND(T_TX3DP(NB_REQ)%X,SIZE(TX3DP),MPI_FLOAT,JI-1,99,TZFD%COMM,REQ_TAB(NB_REQ),IERR)
1974             !CALL MPI_BSEND(T_TX3DP(NB_REQ)%X,SIZE(TX3DP),MPI_FLOAT,JI-1,99,TZFD%COMM,IERR)
1975           ELSE
1976             CALL GET_DISTRIB_LB(HLBTYPE,JI,'LOC','READ',KRIM,IIB,IIE,IJB,IJE)
1977             PLB(IIB:IIE,IJB:IJE,:) = TX3DP(:,:,:)
1978           END IF
1979         END IF
1980       END DO
1981       CALL SECOND_MNH2(T2)
1982       TIMEZ%T_READLB_SEND=TIMEZ%T_READLB_SEND + T2 - T1      
1983       IF (NB_REQ .GT.0 ) THEN
1984          !ALLOCATE(STATUSES(MPI_STATUS_SIZE,NB_REQ))
1985          !CALL MPI_WAITALL(NB_REQ,REQ_TAB,STATUSES,IERR)
1986          CALL MPI_WAITALL(NB_REQ,REQ_TAB,MNH_STATUSES_IGNORE,IERR)
1987          !DEALLOCATE(STATUSES)
1988          DO JI=1,NB_REQ ;  DEALLOCATE(T_TX3DP(JI)%X) ; ENDDO
1989       END IF
1990       DEALLOCATE(T_TX3DP)
1991       !DEALLOCATE(REQ_TAB)
1992       CALL SECOND_MNH2(T3)
1993       TIMEZ%T_READLB_WAIT=TIMEZ%T_READLB_WAIT + T3 - T2
1994     ELSE
1995        CALL SECOND_MNH2(T0)
1996       !ALLOCATE(REQ_TAB(1))
1997       !REQ_TAB=MPI_REQUEST_NULL
1998       CALL GET_DISTRIB_LB(HLBTYPE,ISP,'LOC','READ',KRIM,IIB,IIE,IJB,IJE)
1999       IF (IIB /= 0) THEN
2000         TX3DP=>PLB(IIB:IIE,IJB:IJE,:)
2001         CALL MPI_RECV(TX3DP,SIZE(TX3DP),MPI_FLOAT,TZFD%OWNER-1,99,TZFD%COMM,STATUS,IERR)
2002         !NB_REQ = NB_REQ + 1
2003         !CALL MPI_IRECV(TX3DP,SIZE(TX3DP),MPI_FLOAT,TZFD%OWNER-1,99,TZFD%COMM,REQ_TAB(NB_REQ),IERR)
2004         !IF (NB_REQ .GT.0 ) CALL MPI_WAITALL(NB_REQ,REQ_TAB,MNH_STATUSES_IGNORE,IERR)
2005       END IF
2006       CALL SECOND_MNH2(T1)
2007       TIMEZ%T_READLB_RECV=TIMEZ%T_READLB_RECV + T1 - T0 
2008     END IF
2009     DEALLOCATE(REQ_TAB)
2010   END IF !(GSMONOPROC)
2011   KGRID  = TZFMH%GRID
2012   KLENCH = TZFMH%COMLEN
2013   HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
2014 ELSE 
2015   IRESP = -61          
2016 END IF
2017 !----------------------------------------------------------------
2018 1000 CONTINUE
2019 !! Error handler
2020 IF (IRESP.NE.0) THEN
2021   CALL FM_READ_ERR("FMREAD_LB",HFILEM,HFIPRI,HRECFM,HLBTYPE,IRESP)
2022 ENDIF
2023 !
2024 IF (ALLOCATED(Z3D)) DEALLOCATE (Z3D)
2025 KRESP = IRESP
2026 !
2027 !CALL MPI_BARRIER(TZFD%COMM,IERR)
2028 CALL SECOND_MNH2(T22)
2029 TIMEZ%T_READLB_ALL=TIMEZ%T_READLB_ALL + T22 - T11
2030 END SUBROUTINE FMREAD_LB
2031
2032 END MODULE MODE_FMREAD
2033
2034
2035 !