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