Gaelle + Didier 26/04/2016 : bug dimensions 2D cases in netcdf
[MNH-git_open_source-lfs.git] / src / LIB / SURCOUCHE / src / fmwrit_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 !Correction :
14 !  J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1 
15 !  D.Gazen   : avril 2016 bug dimensions 2D cases
16 !-----------------------------------------------------------------
17
18 #ifdef MNH_MPI_DOUBLE_PRECISION
19 #define MPI_FLOAT MPI_DOUBLE_PRECISION
20 #else
21 #define MPI_FLOAT MPI_REAL
22 #endif
23
24 #ifdef MNH_GA
25 MODULE MODE_GA 
26 #include "mafdecls.fh"
27 #include "global.fh"
28     !
29     !  Global Array Variables
30     !
31     INTEGER, PARAMETER                              :: jpix=1 , jpiy = 2 , jpiz = 3
32     !
33     INTEGER                                         :: NIMAX_ll,NJMAX_ll, IIU_ll,IJU_ll,IKU_ll
34     integer                                         :: heap=5*10**6, stack
35     logical                                         :: gstatus_ga
36     INTEGER, PARAMETER                              :: ndim_GA = 3
37     INTEGER, DIMENSION(ndim_GA)                     :: dims_GA , chunk_GA 
38     INTEGER,PARAMETER                               :: CI=1 ,CJ=-1 ,CK=-1
39     INTEGER                                         :: g_a
40     integer, DIMENSION(ndim_GA)                     :: lo_col, hi_col , ld_col
41     integer, DIMENSION(ndim_GA)                     :: lo_zplan , hi_zplan , ld_zplan   
42     INTEGER                                         :: NIXO_L,NIXE_L,NIYO_L,NIYE_L
43     INTEGER                                         :: NIXO_G,NIXE_G,NIYO_G,NIYE_G
44  
45     LOGICAL,SAVE                                    :: GFIRST_GA  = .TRUE.
46     INTEGER                                         :: IIU_ll_MAX = -1, IJU_ll_MAX = -1, IKU_ll_MAX = -1
47
48   CONTAINS 
49     
50     SUBROUTINE MNH_INIT_GA(MY_NI,MY_NJ,MY_NK,HRECFM,HRW_MODE)
51
52 !
53 !  Modification 
54 !  J.Escobar 5/02/2015 : use JPHEXT from MODD_PARAMETERS_ll
55
56       USE MODE_TOOLS_ll,       ONLY : GET_GLOBALDIMS_ll
57       USE MODD_PARAMETERS_ll,  ONLY : JPHEXT
58       USE MODD_IO_ll,          ONLY : ISP
59       USE MODE_GATHER_ll,      ONLY : GET_DOMWRITE_ll
60       USE MODE_SCATTER_ll,     ONLY : GET_DOMREAD_ll
61
62       IMPLICIT NONE
63
64       INTEGER,          INTENT(IN) :: MY_NI,MY_NJ,MY_NK
65       CHARACTER(LEN=*), INTENT(IN) :: HRECFM   ! name of the article to write
66       CHARACTER(LEN=*), INTENT(IN) :: HRW_MODE 
67       
68       IF ( GFIRST_GA ) THEN
69          GFIRST_GA = .FALSE.
70          !
71          !   Allocate memory for GA library
72          !
73          stack = heap
74          !gstatus_ga = ma_init(MT_F_DBL, stack/ISNPROC, heap/ISNPROC)
75          gstatus_ga = ma_init(MT_F_DBL, stack, heap)
76          if ( .not. gstatus_ga ) STOP " MA_INIT FAILED "
77          !
78          !   Initialize GA library
79          !
80          !call ga_initialize_ltd(100000000)
81          call ga_initialize()
82       END IF
83       
84       CALL GET_GLOBALDIMS_ll (NIMAX_ll,NJMAX_ll)
85       IIU_ll = NIMAX_ll + 2*JPHEXT
86       IJU_ll = NJMAX_ll + 2*JPHEXT
87       IKU_ll = MY_NK   
88       !
89       !   configure Global array dimensions
90       !
91       dims_GA(JPIX) = IIU_ll
92       dims_GA(JPIY) = IJU_ll
93       dims_GA(JPIZ) = IKU_ll
94       chunk_GA(JPIX)   = CI
95       chunk_GA(JPIY)   = CJ
96       chunk_GA(JPIZ)   = CK 
97       IF ( CI .EQ. 1 ) chunk_GA(JPIX)   = dims_GA(JPIX) ! 1 block in X direction
98       IF ( CJ .EQ. 1 ) chunk_GA(JPIY)   = dims_GA(JPIY) ! 1 block in Y direction
99       IF ( CK .EQ. 1 ) chunk_GA(JPIZ)   = dims_GA(JPIZ) ! 1 block in Z direction
100       !
101       !   (re)create global array g_a ( if to small create it ... )
102       !
103       IF ( ( IIU_ll .GT. IIU_ll_MAX ) .OR. ( IJU_ll .GT. IJU_ll_MAX ) .OR. ( IKU_ll .GT. IKU_ll_MAX ) ) THEN
104          !
105          ! reallocate the g_a , if need with bigger Z size 
106          !
107          IF ( IKU_ll_MAX .NE. -1 ) gstatus_ga =  ga_destroy(g_a)
108          IIU_ll_MAX = IIU_ll
109          IJU_ll_MAX = IJU_ll
110          IKU_ll_MAX = IKU_ll
111          gstatus_ga = nga_create(MT_F_DBL, ndim_GA, dims_GA, HRECFM ,chunk_GA, g_a)
112          call ga_sync()
113       END IF
114       !----------------------------------------------------------------------!
115       !                                                                      !
116       ! Define/describe local column data owned by this processor to write   !
117       !                                                                      !
118       !----------------------------------------------------------------------!
119       IF ( HRW_MODE .EQ. "WRITE" ) THEN
120       CALL GET_DOMWRITE_ll(ISP,'local',NIXO_L,NIXE_L,NIYO_L,NIYE_L)
121       CALL GET_DOMWRITE_ll(ISP,'global',NIXO_G,NIXE_G,NIYO_G,NIYE_G)
122       ELSE
123       CALL GET_DOMREAD_ll(ISP,NIXO_L,NIXE_L,NIYO_L,NIYE_L)
124       CALL GET_DOMREAD_ll(ISP,NIXO_G,NIXE_G,NIYO_G,NIYE_G)
125       END IF
126       !
127       ! portion of data to write/put | read/get by this proc
128       !
129       lo_col(JPIX) = NIXO_G
130       hi_col(JPIX) = NIXE_G
131       
132       lo_col(JPIY) = NIYO_G
133       hi_col(JPIY) = NIYE_G
134       
135       lo_col(JPIZ) = 1
136       hi_col(JPIZ) = IKU_ll
137       !
138       ! declaration size of this local input column array
139       !
140       ld_col(JPIX) = MY_NI
141       ld_col(JPIY) = MY_NJ
142       ld_col(JPIZ) = MY_NK
143       !
144       !-----------------------------------------------------!
145       !                                                     !
146       !  Size of local ZSLIDE_ll Write buffer on I/O proc   !
147       !                                                     !
148       !-----------------------------------------------------!
149       !
150       ! declared dimension 
151       !
152       ld_zplan(JPIX) = IIU_ll
153       ld_zplan(JPIY) = IJU_ll
154       ld_zplan(JPIZ) = 1
155       !
156       ! write data by Z slide by I/O proc
157       !
158       lo_zplan(JPIX:JPIY) = 1
159       hi_zplan(JPIX) = IIU_ll 
160       hi_zplan(JPIY) = IJU_ll   
161       !call ga_sync()
162       !
163     END SUBROUTINE MNH_INIT_GA
164     
165 END MODULE MODE_GA
166
167 #endif
168
169 MODULE MODE_FMWRIT
170
171   USE MODD_MPIF
172 #if defined(MNH_IOCDF4)
173   USE MODE_NETCDF
174 #endif
175
176   IMPLICIT NONE 
177
178   PRIVATE
179
180   INTERFACE FMWRIT
181      MODULE PROCEDURE FMWRITX0_ll,FMWRITX1_ll,FMWRITX2_ll,FMWRITX3_ll,&
182           & FMWRITX4_ll,FMWRITX5_ll,FMWRITX6_ll,&
183           & FMWRITN0_ll,FMWRITN1_ll,FMWRITN2_ll,&
184           & FMWRITL0_ll,FMWRITL1_ll,FMWRITC0_ll,&
185           & FMWRITC1_ll,FMWRITT0_ll
186   END INTERFACE
187
188   INTERFACE FMWRITBOX
189      MODULE PROCEDURE FMWRITBOXX2_ll,FMWRITBOXX3_ll,FMWRITBOXX4_ll,&
190           & FMWRITBOXX5_ll,FMWRITBOXX6_ll
191   END INTERFACE
192
193   PUBLIC FMWRIT_LB,FMWRITBOX,FMWRIT,FMWRITX0_ll,FMWRITX1_ll,FMWRITX2_ll,FMWRITX3_ll,&
194        & FMWRITX4_ll,FMWRITX5_ll,FMWRITX6_ll,FMWRITN0_ll,FMWRITN1_ll,FMWRITN2_ll,&
195        & FMWRITL0_ll,FMWRITL1_ll,FMWRITC0_ll,FMWRITC1_ll,FMWRITT0_ll,FMWRITBOXX2_ll,&
196        & FMWRITBOXX3_ll,FMWRITBOXX4_ll,FMWRITBOXX5_ll,FMWRITBOXX6_ll
197
198   !INCLUDE 'mpif.h'
199
200 CONTAINS 
201
202   SUBROUTINE FM_WRIT_ERR(HFUNC,HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH&
203        & ,KRESP)
204     USE MODE_FM, ONLY : FMLOOK_ll
205
206     CHARACTER(LEN=*) :: HFUNC 
207     CHARACTER(LEN=*) :: HFILEM
208     CHARACTER(LEN=*) :: HFIPRI
209     CHARACTER(LEN=*) :: HRECFM
210     CHARACTER(LEN=*) :: HDIR
211     INTEGER          :: KGRID
212     INTEGER          :: KLENCH
213     INTEGER          :: KRESP
214
215     INTEGER          :: ILUPRI
216     INTEGER          :: IRESP
217
218     CALL FMLOOK_ll(HFIPRI,HFIPRI,ILUPRI,IRESP)
219     WRITE (ILUPRI,*) ' exit from ',HFUNC,' with RESP:',KRESP
220     WRITE (ILUPRI,*) '   | HFILEM = ',HFILEM
221     WRITE (ILUPRI,*) '   | HRECFM = ',HRECFM
222     WRITE (ILUPRI,*) '   | HDIR  = ',HDIR
223     WRITE (ILUPRI,*) '   | KGRID  = ',KGRID
224     WRITE (ILUPRI,*) '   | KLENCH = ',KLENCH
225
226   END SUBROUTINE FM_WRIT_ERR
227
228
229
230   SUBROUTINE FMWRITX0_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
231        KLENCH,HCOMMENT,KRESP)
232 !
233 !  Modification 
234 !  J.Escobar 15/04/2014 : add write to all Z files for all FMWRITX0_ll variables
235 !  J.Escobar 23/06/2014 : bug , replace .FALSE. to .TRUE. = OREAL type transmetted to FM_WRIT_ll
236 !
237     USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
238     USE MODD_FM
239     USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
240 #ifdef MNH_NCWRIT
241     USE MODD_GRID
242     USE MODD_DIM_n, ONLY: NIMAX
243     USE MODD_NCOUT
244     USE MODE_UTIL
245 #endif
246     !
247     !*      0.    DECLARATIONS
248     !             ------------
249     !
250     !*      0.1   Declarations of arguments
251     !
252     CHARACTER(LEN=*),        INTENT(IN) ::HFILEM  ! FM-file name
253     CHARACTER(LEN=*),        INTENT(IN) ::HRECFM  ! name of the article to write
254     CHARACTER(LEN=*),        INTENT(IN) ::HFIPRI  ! output file for error messages
255     CHARACTER(LEN=*),        INTENT(IN) ::HDIR    ! field form
256     REAL,                    INTENT(IN) ::PFIELD  ! array containing the data field
257     INTEGER,                 INTENT(IN) ::KGRID   ! C-grid indicator (u,v,w,T)
258     INTEGER,                 INTENT(IN) ::KLENCH  ! length of comment string
259     CHARACTER(LEN=*),        INTENT(IN) ::HCOMMENT! comment string
260     INTEGER,                 INTENT(OUT)::KRESP   ! return-code 
261     !
262     !*      0.2   Declarations of local variables
263     !
264     !----------------------------------------------------------------
265     CHARACTER(LEN=JPFINL)        :: YFNLFI
266     INTEGER                      :: IERR
267     TYPE(FD_ll), POINTER         :: TZFD
268     INTEGER                      :: IRESP
269     TYPE(FMHEADER)               :: TZFMH
270     !JUANZIO
271     INTEGER                                  :: IK_FILE,IK_rank
272     CHARACTER(len=5)                         :: YK_FILE  
273     CHARACTER(len=128)                       :: YFILE_IOZ  
274     TYPE(FD_ll), POINTER                     :: TZFD_IOZ 
275     !JUANZIO
276     !
277     !*      1.1   THE NAME OF LFIFM
278     !
279     IRESP = 0
280     YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
281     !print * , ' Writing Article 0 ' , HRECFM
282     !
283     TZFD=>GETFD(YFNLFI)
284     IF (ASSOCIATED(TZFD)) THEN
285        IF (GSMONOPROC) THEN ! sequential execution
286           TZFMH%GRID=KGRID
287           TZFMH%COMLEN=KLENCH
288           TZFMH%COMMENT=HCOMMENT
289 #ifdef MNH_NCWRIT
290           IF ( DEF_NC .AND. LLFIFM ) THEN
291           CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,1,PFIELD,TZFMH,IRESP)    
292           END IF
293           IF ( LNETCDF .AND. NIMAX == 0 ) THEN
294 !    PRINT * , ' SAVE MAP PARAMETER IF PGD '
295           IF ( trim(hrecfm) == "RPK" ) THEN
296             XRPK=PFIELD
297           ELSEIF ( trim(hrecfm) == "BETA" ) THEN
298             XBETA=PFIELD
299           ELSEIF (trim(hrecfm) == "LATORI" ) THEN
300             XLATORI=PFIELD
301           ELSEIF (trim(hrecfm) == "LONORI" ) THEN
302             XLONORI=PFIELD
303           ELSEIF (trim(hrecfm) == "LAT0" ) THEN
304             XLAT0=PFIELD
305           ELSEIF (trim(hrecfm) == "LON0" ) THEN
306             XLON0=PFIELD
307           END IF
308           END IF
309 #else
310           IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,1,PFIELD,TZFMH,IRESP)
311           IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,PFIELD,TZFMH,IRESP)
312 #endif
313        ELSE
314           IF (ISP == TZFD%OWNER)  THEN
315              TZFMH%GRID=KGRID
316              TZFMH%COMLEN=KLENCH
317              TZFMH%COMMENT=HCOMMENT
318 #ifdef MNH_NCWRIT
319                IF ( DEF_NC .AND. LLFIFM ) THEN
320              CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,1,PFIELD,TZFMH,IRESP)
321                END IF
322              IF ( LNETCDF .AND. NIMAX == 0 ) THEN
323 !                  print * , ' SAVE MAP PARAMETER IF PGD '
324                IF ( trim(hrecfm) == "RPK" ) THEN
325                  XRPK=PFIELD
326                ELSEIF ( trim(hrecfm) == "BETA" ) THEN
327                  XBETA=PFIELD
328                ELSEIF (trim(hrecfm) == "LATORI" ) THEN
329                  XLATORI=PFIELD
330                ELSEIF (trim(hrecfm) == "LONORI" ) THEN
331                  XLONORI=PFIELD
332                ELSEIF (trim(hrecfm) == "LAT0" ) THEN
333                  XLAT0=PFIELD
334                ELSEIF (trim(hrecfm) == "LON0" ) THEN
335                  XLON0=PFIELD
336                END IF
337              END IF
338 #else
339              IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,1,PFIELD,TZFMH,IRESP)
340              IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,PFIELD,TZFMH,IRESP)
341 #endif
342           END IF
343           !
344           CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
345        END IF ! multiprocessor execution
346        IF (TZFD%nb_procio.gt.1) THEN
347           ! write the data in all Z files
348           DO IK_FILE=1,TZFD%nb_procio
349              write(YK_FILE ,'(".Z",i3.3)')  IK_FILE
350              YFILE_IOZ =  TRIM(HFILEM)//YK_FILE//".lfi"
351              TZFD_IOZ => GETFD(YFILE_IOZ)   
352              IK_RANK = TZFD_IOZ%OWNER
353              IF ( ISP == IK_RANK )  THEN
354                 TZFMH%GRID=KGRID
355                 TZFMH%COMLEN=KLENCH
356                 TZFMH%COMMENT=HCOMMENT
357 #ifdef MNH_NCWRIT
358                IF ( DEF_NC .AND. LLFIFM ) THEN
359                 CALL FM_WRIT_ll(TZFD_IOZ%FLU,HRECFM,.TRUE.,1,PFIELD,TZFMH,IRESP)
360                END IF
361 #else
362                IF (LLFIOUT) CALL FM_WRIT_ll(TZFD_IOZ%FLU,HRECFM,.TRUE.,1,PFIELD,TZFMH,IRESP)
363                IF (LIOCDF4) CALL NCWRIT(TZFD_IOZ%CDF,HRECFM,HDIR,PFIELD,TZFMH,IRESP)
364 #endif
365              END IF
366           END DO
367        ENDIF
368     ELSE
369        IRESP = -61
370     END IF
371     !----------------------------------------------------------------
372     IF (IRESP.NE.0) THEN
373        CALL FM_WRIT_ERR("FMWRITX0_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH,IRESP)
374     END IF
375     KRESP = IRESP
376   END SUBROUTINE FMWRITX0_ll
377
378   SUBROUTINE FMWRITX1_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
379        KLENCH,HCOMMENT,KRESP)
380     USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
381     USE MODD_FM
382     USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
383     USE MODE_ALLOCBUFFER_ll
384     USE MODE_GATHER_ll
385 #ifdef MNH_NCWRIT
386     USE MODE_UTIL
387     USE MODE_DIMLIST
388     USE MODD_DIM_n, ONLY: NIMAX
389     USE MODD_NCOUT
390 #endif
391     !
392     !*      0.    DECLARATIONS
393     !             ------------
394     !
395     !*      0.1   Declarations of arguments
396     !
397     CHARACTER(LEN=*),        INTENT(IN) ::HFILEM   ! FM-file name
398     CHARACTER(LEN=*),        INTENT(IN) ::HRECFM   ! name of the article to write
399     CHARACTER(LEN=*),        INTENT(IN) ::HFIPRI   ! output file for error messages
400     CHARACTER(LEN=*),        INTENT(IN) ::HDIR     ! field form
401     REAL,DIMENSION(:),TARGET,INTENT(IN) ::PFIELD   ! array containing the data field
402     INTEGER,                 INTENT(IN) ::KGRID    ! C-grid indicator (u,v,w,T)
403     INTEGER,                 INTENT(IN) ::KLENCH   ! length of comment string
404     CHARACTER(LEN=*),        INTENT(IN) ::HCOMMENT ! comment string
405     INTEGER,                 INTENT(OUT)::KRESP    ! return-code 
406     !
407     !*      0.2   Declarations of local variables
408     !
409     !----------------------------------------------------------------
410     CHARACTER(LEN=JPFINL)        :: YFNLFI
411     INTEGER                      :: IERR
412     TYPE(FD_ll), POINTER         :: TZFD
413     INTEGER                      :: IRESP
414     TYPE(FMHEADER)               :: TZFMH
415     REAL,DIMENSION(:),POINTER    :: ZFIELDP
416     LOGICAL                      :: GALLOC
417 #ifdef MNH_NCWRIT
418     TYPE(workfield), DIMENSION(:), POINTER   :: TZRECLIST
419     INTEGER,DIMENSION(6)         :: TABDIM
420 #endif
421     !
422     !*      1.1   THE NAME OF LFIFM
423     !
424     IRESP = 0
425     GALLOC = .FALSE.
426     YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
427 #ifdef MNH_NCWRIT
428     TABDIM(:)=1
429     TABDIM(1)=SIZE(PFIELD,1)
430     !print * , ' Writing Article 1 ' , HRECFM
431 #endif
432     !------------------------------------------------------------------    
433     TZFD=>GETFD(YFNLFI)
434     IF (ASSOCIATED(TZFD)) THEN
435        IF (GSMONOPROC) THEN ! sequential execution
436           TZFMH%GRID=KGRID
437           TZFMH%COMLEN=KLENCH
438           TZFMH%COMMENT=HCOMMENT
439 #ifdef MNH_NCWRIT
440          IF ( DEF_NC .AND. LLFIFM ) THEN
441           CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
442          END IF
443          ! ------- WRITE NETCDF
444          IF ( LNETCDF .AND. NC_WRITE ) THEN
445           CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,PFIELD,.TRUE.,TZRECLIST, &
446 !          CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,PFIELD, &
447                   & KLENCH,HCOMMENT)
448             IF ( NC_FILE == 'phy' ) THEN
449 !!!!! CAS WRITE_PHYS_PARAM ... l'ecriture lfi ne peut pas se faire en meme temps
450               CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE., &
451                  SIZE(PFIELD),PFIELD,TZFMH,IRESP)
452             END IF
453          END IF
454 #else
455           IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
456           IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,PFIELD,TZFMH,IRESP)
457 #endif
458        ELSE
459           IF (ISP == TZFD%OWNER)  THEN
460              CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC)
461           ELSE
462              ALLOCATE(ZFIELDP(0))
463              GALLOC = .TRUE.
464           END IF
465           !
466           IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
467              CALL GATHER_XXFIELD(HDIR,PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
468           END IF
469           !
470           IF (ISP == TZFD%OWNER)  THEN
471              TZFMH%GRID=KGRID
472              TZFMH%COMLEN=KLENCH
473              TZFMH%COMMENT=HCOMMENT
474 #ifdef MNH_NCWRIT
475            IF ( DEF_NC .AND. LLFIFM ) THEN
476              CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
477                   & ,IRESP)
478            END IF
479            IF ( LNETCDF .AND. NC_WRITE ) THEN
480             TABDIM(1)=SIZE(ZFIELDP,1)
481             CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,ZFIELDP,.TRUE.,TZRECLIST, &
482               & KLENCH,HCOMMENT)
483              IF ( NC_FILE == 'phy' ) THEN
484                CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
485                   & ,IRESP)
486              END IF
487            END IF
488 #else
489              IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
490                   & ,IRESP)
491              IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,ZFIELDP,TZFMH,IRESP)
492 #endif
493           END IF
494           !
495           CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
496        END IF
497     ELSE
498        IRESP = -61
499     END IF
500     !----------------------------------------------------------------
501     IF (IRESP.NE.0) THEN
502        CALL FM_WRIT_ERR("FMWRITX1_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH,IRESP)
503     END IF
504     IF (GALLOC) DEALLOCATE(ZFIELDP)
505     KRESP = IRESP
506   END SUBROUTINE FMWRITX1_ll
507
508   SUBROUTINE FMWRITX2_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
509        KLENCH,HCOMMENT,KRESP)
510     USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT,LPACK,L1D,L2D
511     USE MODD_PARAMETERS_ll,ONLY : JPHEXT
512     USE MODD_FM
513     USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
514     USE MODE_ALLOCBUFFER_ll
515     USE MODE_GATHER_ll
516     !JUANZ
517     USE MODD_TIMEZ, ONLY : TIMEZ
518     USE MODE_MNH_TIMING, ONLY : SECOND_MNH2
519     !JUANZ 
520 #ifdef MNH_NCWRIT
521     USE MODE_UTIL
522     USE MODE_DIMLIST
523     USE MODD_DIM_n, ONLY: NIMAX
524     USE MODD_NCOUT
525 #endif
526 #ifdef MNH_GA
527     !JUAN_IOGA
528     USE MODE_GA
529 #endif 
530     !
531     IMPLICIT NONE
532     !
533     !*      0.1   Declarations of arguments
534     !
535     CHARACTER(LEN=*),          INTENT(IN) ::HFILEM   ! FM-file name
536     CHARACTER(LEN=*),          INTENT(IN) ::HRECFM   ! name of the article to write
537     CHARACTER(LEN=*),          INTENT(IN) ::HFIPRI   ! output file for error messages
538     CHARACTER(LEN=*),          INTENT(IN) ::HDIR     ! field form
539     REAL,DIMENSION(:,:),TARGET,INTENT(IN) ::PFIELD   ! array containing the data field
540     INTEGER,                   INTENT(IN) ::KGRID    ! C-grid indicator (u,v,w,T)
541     INTEGER,                   INTENT(IN) ::KLENCH   ! length of comment string
542     CHARACTER(LEN=*),          INTENT(IN) ::HCOMMENT ! comment string
543     INTEGER,                   INTENT(OUT)::KRESP    ! return-code 
544     !
545     !*      0.2   Declarations of local variables
546     !
547     CHARACTER(LEN=JPFINL)                  :: YFNLFI
548     INTEGER                                :: IERR
549     TYPE(FD_ll), POINTER                   :: TZFD
550     INTEGER                                :: IRESP
551     REAL,DIMENSION(:,:),POINTER            :: ZFIELDP
552     TYPE(FMHEADER)                         :: TZFMH
553     LOGICAL                                :: GALLOC
554 #ifdef MNH_NCWRIT
555     TYPE(workfield), DIMENSION(:), POINTER   :: TZRECLIST
556     INTEGER,DIMENSION(6)         :: TABDIM
557     LOGICAL                      :: NCWR
558     INTEGER                      :: LHREC_BEG,LHRECFM 
559 #endif
560     !
561     !JUANZ
562     REAL*8,DIMENSION(2) :: T0,T1,T2
563     REAL*8,DIMENSION(2) :: T11,T22
564     !JUANZ
565 #ifdef MNH_GA
566     REAL,DIMENSION(:,:),POINTER            :: ZFIELDP_GA , ZFIELD_GA
567     REAL                                   :: ERROR
568     INTEGER                                :: JI
569 #endif
570     !
571     !*      1.1   THE NAME OF LFIFM
572     !
573     CALL SECOND_MNH2(T11)
574     IRESP = 0
575     GALLOC = .FALSE.
576     YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
577 #ifdef MNH_NCWRIT
578     NCWR=.TRUE.
579     TABDIM(:)=1
580     TABDIM(1)=SIZE(PFIELD,1)
581     TABDIM(2)=SIZE(PFIELD,2)
582     !print * , ' Writing Article 2 ' , HRECFM
583 #endif
584     !------------------------------------------------------------------
585     TZFD=>GETFD(YFNLFI)
586     IF (ASSOCIATED(TZFD)) THEN
587        IF (GSMONOPROC) THEN ! sequential execution
588           TZFMH%GRID=KGRID
589           TZFMH%COMLEN=KLENCH
590           TZFMH%COMMENT=HCOMMENT
591           !    IF (LPACK .AND. L1D .AND. HDIR=='XY') THEN 
592           IF (LPACK .AND. L1D .AND. SIZE(PFIELD,1)==2*JPHEXT+1 .AND. SIZE(PFIELD,2)==2*JPHEXT+1) THEN 
593              ZFIELDP=>PFIELD(2:2,2:2)
594 #ifdef MNH_NCWRIT
595       IF ( DEF_NC .AND. LLFIFM ) THEN
596        CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
597       END IF
598       IF ( LNETCDF .AND. NC_WRITE ) THEN
599          TABDIM(1)=1
600          TABDIM(2)=1
601         CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,ZFIELDP,.TRUE.,TZRECLIST,&
602                   & KLENCH,HCOMMENT)
603       END IF
604 #else
605              IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
606              IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,ZFIELDP,TZFMH,IRESP)
607 #endif
608              !    ELSE IF (LPACK .AND. L2D .AND. HDIR=='XY') THEN
609           ELSEIF (LPACK .AND. L2D .AND. SIZE(PFIELD,2)==2*JPHEXT+1) THEN
610              ZFIELDP=>PFIELD(:,2:2)
611 #ifdef MNH_NCWRIT
612                IF ( DEF_NC .AND. LLFIFM ) THEN
613              CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
614                END IF
615              LHRECFM = LEN_TRIM(ADJUSTL(HRECFM))
616              IF ( LHRECFM > 5 ) THEN
617                LHREC_BEG =LHRECFM-4
618                IF ( ADJUSTL(HRECFM(LHREC_BEG:LHRECFM)) == 'DATIM') THEN
619                   NCWR = .FALSE.
620                END IF
621              END IF
622              IF ( LNETCDF .AND. NC_WRITE .AND. NCWR ) THEN
623                  TABDIM(2)=1
624               IF ( NC_FILE == 'phy' ) THEN
625                   CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE., &
626                      SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
627               END IF
628                   CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,ZFIELDP,.TRUE.,TZRECLIST,&
629                   & KLENCH,HCOMMENT)
630              END IF
631                NCWR = .TRUE.
632 #else
633              IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
634              IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,ZFIELDP,TZFMH,IRESP)
635 #endif
636           ELSE
637 #ifdef MNH_NCWRIT
638              IF ( DEF_NC .AND. LLFIFM ) THEN
639              CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
640              END IF
641              LHRECFM = LEN_TRIM(ADJUSTL(HRECFM))
642              IF ( LHRECFM > 5 ) THEN
643                LHREC_BEG =LHRECFM-4
644                IF ( ADJUSTL(HRECFM(LHREC_BEG:LHRECFM)) == 'DATIM') THEN
645                    NCWR = .FALSE.
646                END IF
647              END IF
648 !             IF ( NIMAX /= 0 ) THEN
649                IF ( LNETCDF .AND. NC_WRITE .AND. NCWR ) THEN
650               IF ( NC_FILE == 'phy' ) THEN
651                CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE., &
652                SIZE(PFIELD),PFIELD,TZFMH,IRESP)
653               END IF
654                  CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,PFIELD,.TRUE.,TZRECLIST, &
655                  & KLENCH,HCOMMENT)
656                END IF
657                NCWR = .TRUE.
658 !             END IF
659 #else
660              IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
661              IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,PFIELD,TZFMH,IRESP)
662 #endif
663           END IF
664        ELSE ! multiprocessor execution
665           CALL SECOND_MNH2(T0)
666           IF (ISP == TZFD%OWNER)  THEN
667              ! I/O processor case
668              CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC)
669           ELSE
670              ALLOCATE(ZFIELDP(0,0))
671              GALLOC = .TRUE.
672           END IF
673           !   
674           IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
675              CALL GATHER_XXFIELD(HDIR,PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
676           ELSEIF (HDIR == 'XY') THEN
677              IF (LPACK .AND. L2D) THEN
678                 CALL GATHER_XXFIELD('XX',PFIELD(:,2),ZFIELDP(:,1),TZFD%OWNER,TZFD%COMM)
679              ELSE
680 #ifdef MNH_GA
681           !
682           ! init/create the ga , dim3 = 1
683           !
684           CALL MNH_INIT_GA(SIZE(PFIELD,1),SIZE(PFIELD,2),1,HRECFM,"WRITE")
685          !
686          !   copy columun data to global arrays g_a 
687          !
688          ALLOCATE (ZFIELD_GA (SIZE(PFIELD,1),SIZE(PFIELD,2)))
689          ZFIELD_GA = PFIELD
690          call nga_put(g_a, lo_col, hi_col,ZFIELD_GA(NIXO_L,NIYO_L) , ld_col)  
691 !!$         print*," nga_put =",HRECFM,g_a," lo_col=",lo_col," hi_col=",hi_col,ZFIELD_GA(NIXO_L,NIYO_L), &
692 !!$          " NIXO_L=",NIXO_L,"NIYO_L=",NIYO_L," ld_col=",ld_col," ISP=",ISP
693          call ga_sync
694          DEALLOCATE (ZFIELD_GA)
695          IF (ISP == TZFD%OWNER)  THEN      
696             !
697             ! this proc get the  Z slide to write
698             !
699             lo_zplan(JPIZ) = 1
700             hi_zplan(JPIZ) = 1
701 !!$            ALLOCATE (ZFIELDP_GA(IIU_ll,IJU_ll))
702             call nga_get(g_a, lo_zplan, hi_zplan,ZFIELDP, ld_zplan)
703 !!$            print*,"nga_get=",HRECFM,g_a," lo_zplan=",lo_zplan," hi_zplan=",hi_zplan &
704 !!$                 ,ZFIELDP(1,1)," ld_zplan=",ld_zplan
705          END IF
706 !!$         call ga_sync
707 #else
708          CALL GATHER_XYFIELD(PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
709 !!$         IF (ISP == TZFD%OWNER)  THEN   
710 !!$            print*,HRECFM, "ERR=", MAXVAL (ZFIELDP_GA - ZFIELDP)
711 !!$            DO JI=1,IJU_ll
712 !!$            !print*,HRECFM, "ERR=", ZFIELDP_GA(:,JI) - ZFIELDP(:,JI)
713 !!$            print*,HRECFM, "WX2::GA =", ZFIELDP_GA(:,JI) 
714 !!$            print*,HRECFM, "WX2::MNH=", ZFIELDP(:,JI)
715 !!$         END DO
716 !!$         END IF
717 #endif
718              END IF
719           END IF
720           CALL SECOND_MNH2(T1)
721           TIMEZ%T_WRIT2D_GATH=TIMEZ%T_WRIT2D_GATH + T1 - T0
722           !
723           IF (ISP == TZFD%OWNER)  THEN             
724              TZFMH%GRID=KGRID
725              TZFMH%COMLEN=KLENCH
726              TZFMH%COMMENT=HCOMMENT
727 #ifdef MNH_NCWRIT
728              IF ( DEF_NC .AND. LLFIFM ) THEN
729              CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
730                   & ,IRESP)
731              END IF
732              LHRECFM = LEN_TRIM(ADJUSTL(HRECFM))
733              IF ( LHRECFM > 5 ) THEN
734                LHREC_BEG =LHRECFM-4
735                IF ( ADJUSTL(HRECFM(LHREC_BEG:LHRECFM)) == 'DATIM') THEN
736                    NCWR = .FALSE.
737                END IF
738              END IF
739                IF ( LNETCDF .AND. NC_WRITE .AND. NCWR ) THEN
740               TABDIM(1)=SIZE(ZFIELDP,1)
741               TABDIM(2)=SIZE(ZFIELDP,2)
742                  CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,ZFIELDP,.TRUE.,TZRECLIST, &
743 !                 CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,ZFIELDP, &
744                  & KLENCH,HCOMMENT)
745               END IF
746                 NCWR=.TRUE.
747 #else
748              IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
749                   & ,IRESP)
750              IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,ZFIELDP,TZFMH,IRESP)
751 #endif
752           END IF
753 #ifdef MNH_GA
754 !!$         IF (ISP .EQ. 1 ) THEN
755 !!$         call ga_print_stats()
756 !!$         call ga_summarize(1) 
757 !!$         ENDIF
758          call ga_sync
759 !!$         gstatus_ga =  ga_destroy(g_a)
760 #endif     
761           CALL SECOND_MNH2(T2)
762           TIMEZ%T_WRIT2D_WRIT=TIMEZ%T_WRIT2D_WRIT + T2 - T1
763           !
764           CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD&
765                & %COMM,IERR)
766        END IF
767     ELSE
768        IRESP = -61
769     END IF
770     !----------------------------------------------------------------
771     IF (IRESP.NE.0) THEN
772        CALL FM_WRIT_ERR("FMWRITX2_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH,IRESP)
773     END IF
774     IF (GALLOC) DEALLOCATE(ZFIELDP)
775     KRESP = IRESP
776     IF (ASSOCIATED(TZFD)) CALL MPI_BARRIER(TZFD%COMM,IERR)
777     CALL SECOND_MNH2(T22)
778     TIMEZ%T_WRIT2D_ALL=TIMEZ%T_WRIT2D_ALL + T22 - T11
779   END SUBROUTINE FMWRITX2_ll
780
781   SUBROUTINE FMWRITX3_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
782        KLENCH,HCOMMENT,KRESP)
783     USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT,LPACK,L1D,L2D
784     USE MODD_PARAMETERS_ll,ONLY : JPHEXT
785     USE MODD_FM
786     USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
787     USE MODE_ALLOCBUFFER_ll
788     USE MODE_GATHER_ll
789     !JUANZ    
790     USE MODD_IO_ll, ONLY : ISNPROC
791     USE MODE_IO_ll, ONLY : io_file,io_rank
792     USE MODD_TIMEZ, ONLY : TIMEZ
793     USE MODE_MNH_TIMING, ONLY : SECOND_MNH2
794     !JUANZ 
795 #ifdef MNH_NCWRIT
796     USE MODE_UTIL
797     USE MODD_DIM_n, ONLY: NIMAX
798     USE MODD_NCOUT
799 #endif
800 #ifdef MNH_GA
801     USE MODE_GA
802 #endif
803     USE MODD_VAR_ll, ONLY : MNH_STATUSES_IGNORE
804     !
805     !
806     !*      0.1   Declarations of arguments
807     !
808     CHARACTER(LEN=*),            INTENT(IN) ::HFILEM   ! FM-file name
809     CHARACTER(LEN=*),            INTENT(IN) ::HRECFM   ! name of the article to write
810     CHARACTER(LEN=*),            INTENT(IN) ::HFIPRI   ! output file for error messages
811     CHARACTER(LEN=*),            INTENT(IN) ::HDIR     ! field form
812     REAL,DIMENSION(:,:,:),TARGET,INTENT(IN) ::PFIELD   ! array containing the data field
813     INTEGER,                     INTENT(IN) ::KGRID    ! C-grid indicator (u,v,w,T)
814     INTEGER,                     INTENT(IN) ::KLENCH   ! length of comment string
815     CHARACTER(LEN=*),            INTENT(IN) ::HCOMMENT ! comment string
816     INTEGER,                     INTENT(OUT)::KRESP    ! return-code 
817     !
818     !*      0.2   Declarations of local variables
819     !
820     CHARACTER(LEN=JPFINL)                    :: YFNLFI
821     INTEGER                                  :: IERR
822     TYPE(FD_ll), POINTER                     :: TZFD
823     INTEGER                                  :: IRESP
824     REAL,DIMENSION(:,:,:),POINTER            :: ZFIELDP
825     TYPE(FMHEADER)                           :: TZFMH
826     LOGICAL                                  :: GALLOC
827     !JUAN
828     INTEGER                                  :: JK,JKK
829     CHARACTER(LEN=LEN(HRECFM))               :: YK,YRECZSLIDE
830     REAL,DIMENSION(:,:),POINTER              :: ZSLIDE_ll,ZSLIDE
831     INTEGER                                  :: IK_FILE,IK_rank,inb_proc_real,JK_MAX
832     CHARACTER(len=5)                         :: YK_FILE  
833     CHARACTER(len=128)                       :: YFILE_IOZ  
834     TYPE(FD_ll), POINTER                     :: TZFD_IOZ 
835     INTEGER                                  :: JI,IXO,IXE,IYO,IYE
836     REAL,DIMENSION(:,:),POINTER              :: TX2DP
837     INTEGER, DIMENSION(MPI_STATUS_SIZE)      :: STATUS
838     INTEGER, ALLOCATABLE,DIMENSION(:,:)      :: STATUSES
839     LOGICAL                                  :: GALLOC_ll
840     !JUANZIO
841     !INTEGER,SAVE,DIMENSION(100000)    :: REQ_TAB
842     INTEGER,ALLOCATABLE,DIMENSION(:)         :: REQ_TAB
843     INTEGER                                  :: NB_REQ
844     TYPE TX_2DP
845        REAL,DIMENSION(:,:), POINTER    :: X
846     END TYPE TX_2DP
847     TYPE(TX_2DP),ALLOCATABLE,DIMENSION(:) :: T_TX2DP
848     REAL*8,DIMENSION(2) :: T0,T1,T2
849     REAL*8,DIMENSION(2) :: T11,T22
850     !JUANZIO
851     !JUAN
852 #ifdef MNH_NCWRIT
853     TYPE(workfield), DIMENSION(:), POINTER   :: TZRECLIST
854     INTEGER,DIMENSION(6)                     :: TABDIM
855     CHARACTER(LEN=LEN(HRECFM))               :: HRECT
856     INTEGER                                  :: LHRECT
857 #endif
858 #ifdef MNH_GA
859     REAL,DIMENSION(:,:,:),POINTER          :: ZFIELD_GA
860 #endif
861     !
862     !*      1.1   THE NAME OF LFIFM
863     !
864     CALL SECOND_MNH2(T11)
865     IRESP = 0
866     GALLOC    = .FALSE.
867     GALLOC_ll = .FALSE.
868     YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
869     !print * , ' Writing Article 3 ' , HRECFM
870 !
871 #ifdef MNH_NCWRIT
872     HRECT=TRIM(HRECFM)
873     LHRECT=LEN(TRIM(HRECT))
874     TABDIM(:)=1
875     TABDIM(1)=SIZE(PFIELD,1)
876     TABDIM(2)=SIZE(PFIELD,2)
877     TABDIM(3)=SIZE(PFIELD,3)
878    IF ( LHRECT .gt. 4 ) THEN
879       IF ( HRECT(LHRECT-4:LHRECT) == 'TRAJZ' ) THEN
880            TABDIM(3)=SIZE(PFIELD,1)
881            TABDIM(1)=1
882       END IF
883    END IF
884     IF ( TRIM(HRECFM)  == 'AVION.TRAJX' ) THEN
885          TABDIM(1)=SIZE(PFIELD,2)
886          TABDIM(2)=1
887     ELSEIF ( TRIM(HRECFM)  == 'AVION.TRAJY' ) THEN
888          TABDIM(1)=SIZE(PFIELD,2)
889          TABDIM(2)=1
890     ELSEIF ( TRIM(HRECFM)  == 'AVION.TRAJZ' ) THEN
891          TABDIM(1)=SIZE(PFIELD,2)
892          TABDIM(2)=1
893   END IF 
894 #endif
895     !------------------------------------------------------------------
896     TZFD=>GETFD(YFNLFI)
897     IF (ASSOCIATED(TZFD)) THEN
898        IF (GSMONOPROC .AND.  (TZFD%nb_procio.eq.1) ) THEN ! sequential execution
899           TZFMH%GRID=KGRID
900           TZFMH%COMLEN=KLENCH
901           TZFMH%COMMENT=HCOMMENT
902           !    IF (LPACK .AND. L1D .AND. HDIR=='XY') THEN 
903           IF (LPACK .AND. L1D .AND. SIZE(PFIELD,1)==2*JPHEXT+1 .AND. SIZE(PFIELD,2)==2*JPHEXT+1) THEN 
904              ZFIELDP=>PFIELD(2:2,2:2,:)
905 #ifdef MNH_NCWRIT
906         IF ( DEF_NC .AND. LLFIFM ) THEN
907           CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
908         END IF
909         IF ( LNETCDF .AND. NC_WRITE ) THEN
910           TABDIM(1)=1
911           TABDIM(2)=1
912           CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,ZFIELDP,.TRUE.,TZRECLIST, &
913              & KLENCH,HCOMMENT)
914         END IF
915 #else
916              IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
917              IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,ZFIELDP,TZFMH,IRESP)
918 #endif
919              !    ELSE IF (LPACK .AND. L2D .AND. HDIR=='XY') THEN
920           ELSEIF (LPACK .AND. L2D .AND. SIZE(PFIELD,2)==2*JPHEXT+1) THEN
921              ZFIELDP=>PFIELD(:,2:2,:)
922 #ifdef MNH_NCWRIT
923         IF ( DEF_NC .AND. LLFIFM ) THEN
924           CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
925         END IF
926         IF ( LNETCDF .AND. NC_WRITE ) THEN
927            TABDIM(2)=1
928           IF ( NC_FILE == 'phy' ) THEN
929             CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
930           END IF
931            CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,ZFIELDP,.TRUE.,TZRECLIST, &
932 !            CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,ZFIELDP, &
933                & KLENCH,HCOMMENT)
934         END IF
935 #else
936              IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
937              IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,ZFIELDP,TZFMH,IRESP)
938 #endif
939           ELSE
940 #ifdef MNH_NCWRIT
941         IF ( DEF_NC .AND. LLFIFM ) THEN
942           CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
943         END IF
944         IF ( LNETCDF .AND. NC_WRITE ) THEN
945           IF ( NC_FILE == 'phy' ) THEN
946             CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
947           END IF
948             CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,PFIELD,.TRUE.,TZRECLIST, &
949 !             CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,PFIELD, &
950                 & KLENCH,HCOMMENT)
951         END IF
952 #else
953              IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
954              IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,PFIELD,TZFMH,IRESP)
955 #endif
956           END IF
957        ELSEIF ( (TZFD%nb_procio .eq. 1 ) .OR. ( HDIR == '--' ) ) THEN  ! multiprocessor execution & 1 proc IO
958           ! write 3D field in 1 time = output for graphique
959           IF (ISP == TZFD%OWNER)  THEN
960              CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC)
961           ELSE
962              ALLOCATE(ZFIELDP(0,0,0))
963              GALLOC = .TRUE.
964           END IF
965           !
966           IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
967              CALL GATHER_XXFIELD(HDIR,PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
968           ELSEIF (HDIR == 'XY') THEN
969              IF (LPACK .AND. L2D) THEN
970                 CALL GATHER_XXFIELD('XX',PFIELD(:,2,:),ZFIELDP(:,1,:),TZFD%OWNER,TZFD%COMM)
971              ELSE
972                 CALL GATHER_XYFIELD(PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
973              END IF
974           END IF
975           !
976           IF (ISP == TZFD%OWNER)  THEN
977              TZFMH%GRID=KGRID
978              TZFMH%COMLEN=KLENCH
979              TZFMH%COMMENT=HCOMMENT
980 #ifdef MNH_NCWRIT
981         IF ( DEF_NC .AND. LLFIFM ) THEN
982           CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
983                & ,IRESP)
984         END IF
985         IF ( LNETCDF .AND. NC_WRITE ) THEN
986            TABDIM(1)=SIZE(ZFIELDP,1)
987            TABDIM(2)=SIZE(ZFIELDP,2)
988            TABDIM(3)=SIZE(ZFIELDP,3)
989            IF ( NC_FILE == ' phy' ) THEN
990              CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
991                   & ,IRESP)
992           END IF
993              CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,ZFIELDP,.TRUE.,TZRECLIST, &
994 !                CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,ZFIELDP, &
995                & KLENCH,HCOMMENT)
996         END IF
997 #else
998              IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
999                   & ,IRESP)
1000              IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,ZFIELDP,TZFMH,IRESP)
1001 #endif
1002        END IF
1003           !
1004           CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD&
1005                & %COMM,IERR)
1006           !
1007        ELSE ! multiprocessor execution & // IO
1008           !
1009           !JUAN BG Z SLIDE 
1010           !
1011           !
1012 #ifdef MNH_GA
1013           !
1014           ! init/create the ga
1015           !
1016           CALL SECOND_MNH2(T0)
1017           CALL MNH_INIT_GA(SIZE(PFIELD,1),SIZE(PFIELD,2),SIZE(PFIELD,3),HRECFM,"WRITE")
1018          !
1019          !   copy columun data to global arrays g_a 
1020          !
1021          ALLOCATE (ZFIELD_GA (SIZE(PFIELD,1),SIZE(PFIELD,2),SIZE(PFIELD,3)))
1022          ZFIELD_GA = PFIELD
1023          call nga_put(g_a, lo_col, hi_col,ZFIELD_GA(NIXO_L,NIYO_L,1) , ld_col)  
1024          DEALLOCATE(ZFIELD_GA)
1025 !!$         print*," nga_put =",HRECFM,g_a," lo_col=",lo_col," hi_col=",hi_col,PFIELD(NIXO_L,NIYO_L,1) &
1026 !!$          ," ld_col=",ld_col
1027          call ga_sync
1028          CALL SECOND_MNH2(T1)
1029          TIMEZ%T_WRIT3D_SEND=TIMEZ%T_WRIT3D_SEND + T1 - T0
1030          !
1031          ! write the data
1032          !
1033          ALLOCATE(ZSLIDE_ll(0,0)) ! to avoid bug on test of size
1034          GALLOC_ll = .TRUE.
1035          !
1036          DO JKK=1,IKU_ll
1037             !
1038             IK_FILE   =  io_file(JKK,TZFD%nb_procio)
1039             write(YK_FILE ,'(".Z",i3.3)') IK_FILE+1
1040             YFILE_IOZ =  TRIM(HFILEM)//YK_FILE//".lfi"
1041             TZFD_IOZ => GETFD(YFILE_IOZ)
1042             !
1043             IK_RANK   =  TZFD_IOZ%OWNER
1044             !IK_RANK   =  1 + io_rank(IK_FILE,ISNPROC,TZFD%nb_procio)
1045             !
1046             IF (ISP == IK_RANK )  THEN 
1047                CALL SECOND_MNH2(T0)
1048                TZFMH%GRID=KGRID
1049                TZFMH%COMLEN=KLENCH
1050                TZFMH%COMMENT=HCOMMENT
1051                WRITE(YK,'(I4.4)')  JKK
1052                YRECZSLIDE = TRIM(HRECFM)//YK
1053                !
1054                IF ( SIZE(ZSLIDE_ll) .EQ. 0 ) THEN
1055                   DEALLOCATE(ZSLIDE_ll)
1056                   CALL ALLOCBUFFER_ll(ZSLIDE_ll,ZSLIDE,HDIR,GALLOC_ll)
1057                END IF
1058                !
1059                ! this proc get this JKK slide
1060                !
1061                lo_zplan(JPIZ) = JKK
1062                hi_zplan(JPIZ) = JKK
1063                call nga_get(g_a, lo_zplan, hi_zplan,ZSLIDE_ll, ld_zplan)
1064                CALL SECOND_MNH2(T1)
1065                TIMEZ%T_WRIT3D_RECV=TIMEZ%T_WRIT3D_RECV + T1 - T0
1066                !
1067                IF (LLFIOUT) CALL FM_WRIT_ll(TZFD_IOZ%FLU,YRECZSLIDE,.TRUE.,SIZE(ZSLIDE_ll),&
1068                     &ZSLIDE_ll,TZFMH,IRESP)
1069                IF (LIOCDF4) CALL NCWRIT(TZFD_IOZ%CDF,YRECZSLIDE,HDIR,ZSLIDE_ll,TZFMH,IRESP)
1070                CALL SECOND_MNH2(T2)
1071                TIMEZ%T_WRIT3D_WRIT=TIMEZ%T_WRIT3D_WRIT + T2 - T1
1072             END IF
1073          END DO
1074          !call ga_sync
1075          !
1076          ! destroy the global array 
1077          !
1078 !!$         IF (ISP .EQ. 1 ) THEN
1079 !!$         call ga_print_stats()
1080 !!$         call ga_summarize(1) 
1081 !!$         ENDIF
1082          CALL SECOND_MNH2(T0) 
1083          call ga_sync
1084 !!$         gstatus_ga =  ga_destroy(g_a)
1085          CALL SECOND_MNH2(T1) 
1086          TIMEZ%T_WRIT3D_WAIT=TIMEZ%T_WRIT3D_WAIT + T1 - T0     
1087 #else
1088           !
1089           ALLOCATE(ZSLIDE_ll(0,0))
1090           GALLOC_ll = .TRUE.
1091           inb_proc_real = min(TZFD%nb_procio,ISNPROC)
1092           Z_SLIDE: DO JK=1,SIZE(PFIELD,3),inb_proc_real
1093              !
1094              ! collecte the data
1095              !
1096              JK_MAX=min(SIZE(PFIELD,3),JK+inb_proc_real-1)
1097              !
1098              NB_REQ=0
1099              ALLOCATE(REQ_TAB(inb_proc_real))
1100              ALLOCATE(T_TX2DP(inb_proc_real))
1101              DO JKK=JK,JK_MAX
1102                 !
1103                 ! get the file & rank to write this level
1104                 !
1105                 IF (TZFD%NB_PROCIO .GT. 1 ) THEN
1106                    IK_FILE   =  io_file(JKK,TZFD%nb_procio)
1107                    write(YK_FILE ,'(".Z",i3.3)') IK_FILE+1
1108                    YFILE_IOZ =  TRIM(HFILEM)//YK_FILE//".lfi"
1109                    TZFD_IOZ => GETFD(YFILE_IOZ)
1110                 ELSE
1111                    TZFD_IOZ => TZFD
1112                 END IF
1113                 !
1114                 !IK_RANK   =  1 + io_rank(IK_FILE,ISNPROC,TZFD%nb_procio)
1115                 IK_RANK   =  TZFD_IOZ%OWNER
1116                 !
1117                 IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
1118                    STOP " XX NON PREVU SUR BG POUR LE MOMENT "
1119                    CALL GATHER_XXFIELD(HDIR,PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
1120                 ELSEIF (HDIR == 'XY') THEN
1121                    IF (LPACK .AND. L2D) THEN
1122                       STOP " L2D NON PREVU SUR BG POUR LE MOMENT "
1123                       CALL GATHER_XXFIELD('XX',PFIELD(:,2,:),ZFIELDP(:,1,:),TZFD%OWNER,TZFD%COMM)
1124                    ELSE
1125                       !CALL GATHER_XYFIELD(ZSLIDE,ZSLIDE_ll,TZFD_IOZ%OWNER,TZFD_IOZ%COMM)
1126                       !JUANIOZ
1127                       CALL SECOND_MNH2(T0)
1128                       IF ( ISP /= IK_RANK )  THEN
1129                          ! Other processors
1130                          CALL GET_DOMWRITE_ll(ISP,'local',IXO,IXE,IYO,IYE)
1131                          IF (IXO /= 0) THEN ! intersection is not empty
1132                             NB_REQ = NB_REQ + 1
1133                             ALLOCATE(T_TX2DP(NB_REQ)%X(IXO:IXE,IYO:IYE))
1134                             ZSLIDE => PFIELD(:,:,JKK)
1135                             TX2DP=>ZSLIDE(IXO:IXE,IYO:IYE)
1136                             T_TX2DP(NB_REQ)%X=ZSLIDE(IXO:IXE,IYO:IYE)
1137                             CALL MPI_ISEND(T_TX2DP(NB_REQ)%X,SIZE(TX2DP),MPI_FLOAT,IK_RANK-1,99+IK_RANK &
1138                                           & ,TZFD_IOZ%COMM,REQ_TAB(NB_REQ),IERR)
1139                             !CALL MPI_BSEND(TX2DP,SIZE(TX2DP),MPI_FLOAT,IK_RANK-1,99+IK_RANK,TZFD_IOZ%COMM,IERR)                       
1140                          END IF
1141                       END IF
1142                       CALL SECOND_MNH2(T1)
1143                       TIMEZ%T_WRIT3D_SEND=TIMEZ%T_WRIT3D_SEND + T1 - T0
1144                       !JUANIOZ
1145                    END IF
1146                 END IF
1147              END DO
1148              !
1149              ! write the data
1150              !
1151              DO JKK=JK,JK_MAX
1152                 IF (TZFD%NB_PROCIO .GT. 1 ) THEN
1153                    IK_FILE   =  io_file(JKK,TZFD%nb_procio)
1154                    write(YK_FILE ,'(".Z",i3.3)') IK_FILE+1
1155                    YFILE_IOZ =  TRIM(HFILEM)//YK_FILE//".lfi"
1156                    TZFD_IOZ => GETFD(YFILE_IOZ)
1157                 ELSE
1158                    TZFD_IOZ => TZFD
1159                 ENDIF
1160                 IK_RANK   =  TZFD_IOZ%OWNER
1161                 !IK_RANK   =  1 + io_rank(IK_FILE,ISNPROC,TZFD%nb_procio)
1162                 !
1163                 IF (ISP == IK_RANK )  THEN
1164                    !JUANIOZ
1165                    CALL SECOND_MNH2(T0)
1166                    ! I/O proc case
1167                    IF ( SIZE(ZSLIDE_ll) .EQ. 0 ) THEN
1168                       DEALLOCATE(ZSLIDE_ll)
1169                       CALL ALLOCBUFFER_ll(ZSLIDE_ll,ZSLIDE,HDIR,GALLOC_ll)
1170                    END IF
1171                    DO JI=1,ISNPROC
1172                       CALL GET_DOMWRITE_ll(JI,'global',IXO,IXE,IYO,IYE)
1173                       IF (IXO /= 0) THEN ! intersection is not empty
1174                          TX2DP=>ZSLIDE_ll(IXO:IXE,IYO:IYE)
1175                          IF (ISP == JI) THEN 
1176                             CALL GET_DOMWRITE_ll(JI,'local',IXO,IXE,IYO,IYE)
1177                             ZSLIDE => PFIELD(:,:,JKK)
1178                             TX2DP = ZSLIDE(IXO:IXE,IYO:IYE)
1179                          ELSE 
1180                             CALL MPI_RECV(TX2DP,SIZE(TX2DP),MPI_FLOAT,JI-1,99+IK_RANK,TZFD_IOZ%COMM,STATUS,IERR)
1181                          END IF
1182                       END IF
1183                    END DO
1184                    CALL SECOND_MNH2(T1)
1185                    TIMEZ%T_WRIT3D_RECV=TIMEZ%T_WRIT3D_RECV + T1 - T0
1186                    !JUANIOZ 
1187                    TZFMH%GRID=KGRID
1188                    TZFMH%COMLEN=KLENCH
1189                    TZFMH%COMMENT=HCOMMENT
1190                    WRITE(YK,'(I4.4)')  JKK
1191                    YRECZSLIDE = TRIM(HRECFM)//YK
1192                    IF (LLFIOUT) CALL FM_WRIT_ll(TZFD_IOZ%FLU,YRECZSLIDE,.TRUE.,SIZE(ZSLIDE_ll),ZSLIDE_ll,TZFMH&
1193                         & ,IRESP)
1194                    IF (LIOCDF4) CALL NCWRIT(TZFD_IOZ%CDF,YRECZSLIDE,HDIR,ZSLIDE_ll,TZFMH,IRESP)
1195                    CALL SECOND_MNH2(T2)
1196                    TIMEZ%T_WRIT3D_WRIT=TIMEZ%T_WRIT3D_WRIT + T2 - T1
1197                 END IF
1198 !!$           CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD_IOZ%OWNER-1,TZFD_IOZ%COMM,IERR)
1199              END DO
1200              !CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD_IOZ%OWNER-1,TZFD_IOZ%COMM,IERR)
1201              !CALL MPI_BARRIER(TZFD_IOZ%COMM,IERR)
1202              !
1203              CALL SECOND_MNH2(T0) 
1204              IF (NB_REQ .GT.0 ) THEN
1205                 !ALLOCATE(STATUSES(MPI_STATUS_SIZE,NB_REQ))
1206                 CALL MPI_WAITALL(NB_REQ,REQ_TAB,MNH_STATUSES_IGNORE,IERR)
1207                 !CALL MPI_WAITALL(NB_REQ,REQ_TAB,STATUSES,IERR)
1208                 !DEALLOCATE(STATUSES)
1209                 DO JI=1,NB_REQ ;  DEALLOCATE(T_TX2DP(JI)%X) ; ENDDO
1210              END IF
1211              DEALLOCATE(T_TX2DP)
1212              DEALLOCATE(REQ_TAB)
1213              CALL SECOND_MNH2(T1) 
1214              TIMEZ%T_WRIT3D_WAIT=TIMEZ%T_WRIT3D_WAIT + T1 - T0
1215           END DO Z_SLIDE
1216           !JUAN BG Z SLIDE  
1217 ! end of MNH_GA
1218 #endif
1219        END IF ! multiprocessor execution
1220     ELSE
1221        IRESP = -61
1222     END IF
1223     !----------------------------------------------------------------
1224     IF (IRESP.NE.0) THEN
1225        CALL FM_WRIT_ERR("FMWRITX3_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH,IRESP)
1226     END IF
1227     IF (GALLOC) DEALLOCATE(ZFIELDP)
1228     IF (GALLOC_ll) DEALLOCATE(ZSLIDE_ll)
1229     !IF (Associated(ZSLIDE_ll)) DEALLOCATE(ZSLIDE_ll)
1230     KRESP = IRESP
1231     IF (ASSOCIATED(TZFD)) CALL MPI_BARRIER(TZFD%COMM,IERR)
1232     CALL SECOND_MNH2(T22)
1233     TIMEZ%T_WRIT3D_ALL=TIMEZ%T_WRIT3D_ALL + T22 - T11
1234   END SUBROUTINE FMWRITX3_ll
1235
1236   SUBROUTINE FMWRITX4_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
1237        KLENCH,HCOMMENT,KRESP)
1238     USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT,LPACK,L1D,L2D
1239     USE MODD_PARAMETERS_ll,ONLY : JPHEXT
1240     USE MODD_FM
1241     USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
1242     USE MODE_ALLOCBUFFER_ll
1243     USE MODE_GATHER_ll
1244 !!!!! MOD SB
1245 #ifdef MNH_NCWRIT
1246     USE MODD_NCOUT
1247     USE MODE_UTIL
1248 #endif
1249 !!!!! MOD SB
1250     !
1251     !
1252     !*      0.1   Declarations of arguments
1253     !
1254     CHARACTER(LEN=*),              INTENT(IN) ::HFILEM   ! FM-file name
1255     CHARACTER(LEN=*),              INTENT(IN) ::HRECFM   ! name of the article to write
1256     CHARACTER(LEN=*),              INTENT(IN) ::HFIPRI   ! output file for error messages
1257     CHARACTER(LEN=*),              INTENT(IN) ::HDIR     ! field form
1258     REAL,DIMENSION(:,:,:,:),TARGET,INTENT(IN) ::PFIELD   ! array containing the data field
1259     INTEGER,                       INTENT(IN) ::KGRID    ! C-grid indicator (u,v,w,T)
1260     INTEGER,                       INTENT(IN) ::KLENCH   ! length of comment string
1261     CHARACTER(LEN=*),              INTENT(IN) ::HCOMMENT ! comment string
1262     INTEGER,                       INTENT(OUT)::KRESP    ! return-code 
1263     !
1264     !*      0.2   Declarations of local variables
1265     !
1266     CHARACTER(LEN=JPFINL)                    :: YFNLFI
1267     INTEGER                                  :: IERR
1268     TYPE(FD_ll), POINTER                     :: TZFD
1269     INTEGER                                  :: IRESP
1270     REAL,DIMENSION(:,:,:,:),POINTER          :: ZFIELDP
1271     TYPE(FMHEADER)                           :: TZFMH
1272     LOGICAL                                  :: GALLOC
1273     !
1274     !*      1.1   THE NAME OF LFIFM
1275     !
1276     IRESP = 0
1277     GALLOC = .FALSE.
1278     YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
1279     !print * , ' Writing Article 4 ' , HRECFM
1280     !------------------------------------------------------------------
1281     TZFD=>GETFD(YFNLFI)
1282     IF (ASSOCIATED(TZFD)) THEN
1283        IF (GSMONOPROC) THEN ! sequential execution
1284           TZFMH%GRID=KGRID
1285           TZFMH%COMLEN=KLENCH
1286           TZFMH%COMMENT=HCOMMENT
1287           !    IF (LPACK .AND. L1D .AND. HDIR=='XY') THEN 
1288           IF (LPACK .AND. L1D .AND. SIZE(PFIELD,1)==2*JPHEXT+1 .AND. SIZE(PFIELD,2)==2*JPHEXT+1) THEN 
1289              ZFIELDP=>PFIELD(2:2,2:2,:,:)
1290 #ifdef MNH_NCWRIT
1291            IF ( DEF_NC .AND. LLFIFM ) THEN
1292              CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
1293            END IF
1294 #else
1295              IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
1296              IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,ZFIELDP,TZFMH,IRESP)
1297 #endif
1298              !    ELSE IF (LPACK .AND. L2D .AND. HDIR=='XY') THEN
1299           ELSEIF (LPACK .AND. L2D  .AND. SIZE(PFIELD,2)==2*JPHEXT+1) THEN
1300              ZFIELDP=>PFIELD(:,2:2,:,:)
1301 #ifdef MNH_NCWRIT
1302           IF ( DEF_NC .AND. LLFIFM ) THEN
1303             CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
1304           END IF
1305 #else
1306              IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
1307              IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,ZFIELDP,TZFMH,IRESP)
1308 #endif
1309           ELSE
1310 #ifdef MNH_NCWRIT
1311           IF ( DEF_NC .AND. LLFIFM ) THEN
1312             CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
1313           END IF
1314 #else
1315              IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
1316              IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,PFIELD,TZFMH,IRESP)
1317 #endif
1318           END IF
1319        ELSE
1320           IF (ISP == TZFD%OWNER)  THEN
1321              CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC)
1322           ELSE
1323              ALLOCATE(ZFIELDP(0,0,0,0))
1324              GALLOC = .TRUE.
1325           END IF
1326           !
1327           IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
1328              CALL GATHER_XXFIELD(HDIR,PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
1329           ELSEIF (HDIR == 'XY') THEN
1330              IF (LPACK .AND. L2D) THEN
1331                 CALL GATHER_XXFIELD('XX',PFIELD(:,2,:,:),ZFIELDP(:,1,:,:),TZFD%OWNER,TZFD%COMM)
1332              ELSE
1333                 CALL GATHER_XYFIELD(PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
1334              END IF
1335           END IF
1336           !
1337           IF (ISP == TZFD%OWNER)  THEN
1338              TZFMH%GRID=KGRID
1339              TZFMH%COMLEN=KLENCH
1340              TZFMH%COMMENT=HCOMMENT
1341 #ifdef MNH_NCWRIT
1342            IF ( DEF_NC .AND. LLFIFM ) THEN
1343              CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
1344            END IF
1345 #else
1346              IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
1347              IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,ZFIELDP,TZFMH,IRESP)
1348 #endif
1349           END IF
1350           !
1351           CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
1352        END IF ! multiprocessor execution
1353     ELSE 
1354        IRESP = -61
1355     END IF
1356     !----------------------------------------------------------------
1357     IF (IRESP.NE.0) THEN
1358        CALL FM_WRIT_ERR("FMWRITX4_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH,IRESP)
1359     END IF
1360     IF (GALLOC) DEALLOCATE(ZFIELDP)
1361     KRESP = IRESP
1362   END SUBROUTINE FMWRITX4_ll
1363
1364   SUBROUTINE FMWRITX5_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
1365        KLENCH,HCOMMENT,KRESP)
1366     USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT,LPACK,L1D,L2D
1367     USE MODD_PARAMETERS_ll,ONLY : JPHEXT
1368     USE MODD_FM
1369     USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
1370     USE MODE_ALLOCBUFFER_ll
1371     USE MODE_GATHER_ll
1372 #ifdef MNH_NCWRIT
1373     USE MODE_UTIL
1374     USE MODD_DIM_n
1375     USE MODD_NCOUT
1376 #endif
1377     !
1378     !
1379     !*      0.1   Declarations of arguments
1380     !
1381     CHARACTER(LEN=*),                INTENT(IN) ::HFILEM   ! FM-file name
1382     CHARACTER(LEN=*),                INTENT(IN) ::HRECFM   ! name of the article to write
1383     CHARACTER(LEN=*),                INTENT(IN) ::HFIPRI   ! output file for error messages
1384     CHARACTER(LEN=*),                INTENT(IN) ::HDIR     ! field form
1385     REAL,DIMENSION(:,:,:,:,:),TARGET,INTENT(IN) ::PFIELD ! array containing the data field
1386     INTEGER,                         INTENT(IN) ::KGRID    ! C-grid indicator (u,v,w,T)
1387     INTEGER,                         INTENT(IN) ::KLENCH   ! length of comment string
1388     CHARACTER(LEN=*),                INTENT(IN) ::HCOMMENT ! comment string
1389     INTEGER,                         INTENT(OUT)::KRESP    ! return-code 
1390     !
1391     !*      0.2   Declarations of local variables
1392     !
1393     CHARACTER(LEN=JPFINL)                    :: YFNLFI
1394     INTEGER                                  :: IERR
1395     TYPE(FD_ll), POINTER                     :: TZFD
1396     INTEGER                                  :: IRESP
1397     REAL,DIMENSION(:,:,:,:,:),POINTER        :: ZFIELDP
1398     TYPE(FMHEADER)                           :: TZFMH
1399     LOGICAL                                  :: GALLOC
1400 #ifdef MNH_NCWRIT
1401     TYPE(workfield), DIMENSION(:), POINTER   :: TZRECLIST
1402     INTEGER,DIMENSION(6)         :: TABDIM
1403 #endif
1404     !
1405     !*      1.1   THE NAME OF LFIFM
1406     !
1407     IRESP = 0
1408     GALLOC = .FALSE.
1409     YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
1410 #ifdef MNH_NCWRIT
1411     TABDIM(:)=1
1412     TABDIM(1)=SIZE(PFIELD,1)
1413     TABDIM(2)=SIZE(PFIELD,2)
1414     TABDIM(3)=SIZE(PFIELD,3)
1415     TABDIM(4)=SIZE(PFIELD,4)
1416     TABDIM(5)=SIZE(PFIELD,5)
1417     !print * , ' Writing Article 5 ' , HRECFM
1418 #endif
1419     !------------------------------------------------------------------
1420     TZFD=>GETFD(YFNLFI)
1421     IF (ASSOCIATED(TZFD)) THEN
1422        IF (GSMONOPROC) THEN ! sequential execution
1423           TZFMH%GRID=KGRID
1424           TZFMH%COMLEN=KLENCH
1425           TZFMH%COMMENT=HCOMMENT
1426           !    IF (LPACK .AND. L1D .AND. HDIR=='XY') THEN 
1427           IF (LPACK .AND. L1D .AND. SIZE(PFIELD,1)==2*JPHEXT+1 .AND. SIZE(PFIELD,2)==2*JPHEXT+1) THEN 
1428              ZFIELDP=>PFIELD(2:2,2:2,:,:,:)
1429 #ifdef MNH_NCWRIT
1430             IF ( DEF_NC .AND. LLFIFM ) THEN
1431              CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
1432             END IF
1433 #else
1434              IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
1435              IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,ZFIELDP,TZFMH,IRESP)
1436 #endif
1437              !    ELSE IF (LPACK .AND. L2D .AND. HDIR=='XY') THEN
1438      ELSEIF (LPACK .AND. L2D .AND. SIZE(PFIELD,2)==2*JPHEXT+1) THEN
1439              ZFIELDP=>PFIELD(:,2:2,:,:,:)
1440 #ifdef MNH_NCWRIT
1441             IF ( DEF_NC .AND. LLFIFM ) THEN
1442              CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
1443             END IF
1444             IF ( LNETCDF .AND. NC_WRITE ) THEN
1445              TABDIM(2)=1
1446               IF ( NC_FILE == 'phy' ) THEN
1447                  CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP), &
1448                  ZFIELDP,TZFMH,IRESP)
1449               END IF
1450                CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,ZFIELDP,.TRUE.,TZRECLIST, &
1451 !               CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,ZFIELDP, &
1452                & KLENCH,HCOMMENT)
1453              END IF
1454 #else
1455              IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
1456              IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,ZFIELDP,TZFMH,IRESP)
1457 #endif
1458           ELSE
1459 #ifdef MNH_NCWRIT
1460                IF ( DEF_NC .AND. LLFIFM ) THEN
1461              CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
1462                END IF
1463              IF ( LNETCDF .AND. NC_WRITE ) THEN
1464               IF ( NC_FILE == 'phy' ) THEN
1465                  CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD), &
1466                      PFIELD,TZFMH,IRESP)
1467               END IF
1468                CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,PFIELD,.TRUE.,TZRECLIST, &
1469 !               CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,PFIELD, &
1470                & KLENCH,HCOMMENT)
1471              END IF
1472 #else
1473              IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
1474              IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,PFIELD,TZFMH,IRESP)
1475 #endif
1476           END IF
1477        ELSE
1478           IF (ISP == TZFD%OWNER)  THEN
1479              CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC)
1480           ELSE
1481              ALLOCATE(ZFIELDP(0,0,0,0,0))
1482              GALLOC = .TRUE.
1483           END IF
1484           !
1485           IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
1486              CALL GATHER_XXFIELD(HDIR,PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
1487           ELSEIF (HDIR == 'XY') THEN
1488              IF (LPACK .AND. L2D) THEN
1489                 CALL GATHER_XXFIELD('XX',PFIELD(:,2,:,:,:),ZFIELDP(:,1,:,:,:),&
1490                      & TZFD%OWNER,TZFD%COMM)
1491              ELSE
1492                 CALL GATHER_XYFIELD(PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
1493              END IF
1494           END IF
1495           !
1496           IF (ISP == TZFD%OWNER)  THEN
1497              TZFMH%GRID=KGRID
1498              TZFMH%COMLEN=KLENCH
1499              TZFMH%COMMENT=HCOMMENT
1500 #ifdef MNH_NCWRIT
1501                IF ( DEF_NC .AND. LLFIFM ) THEN
1502              CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
1503                   & ,IRESP)
1504                 END IF
1505              IF ( LNETCDF .AND. NC_WRITE ) THEN
1506               IF ( NC_FILE == 'phy' ) THEN
1507              CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
1508                   & ,IRESP)
1509               END IF
1510          CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,ZFIELDP,.TRUE.,TZRECLIST, &
1511 !               CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,ZFIELDP, &
1512                & KLENCH,HCOMMENT)
1513              END IF
1514 #else
1515              IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
1516                   & ,IRESP)
1517              IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,ZFIELDP,TZFMH,IRESP)
1518 #endif
1519           END IF
1520           !
1521           CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
1522        END IF ! multiprocessor execution
1523     ELSE 
1524        IRESP = -61
1525     END IF
1526     !----------------------------------------------------------------
1527     IF (IRESP.NE.0) THEN
1528        CALL FM_WRIT_ERR("FMWRITX5_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH,IRESP)
1529     END IF
1530     IF (GALLOC) DEALLOCATE(ZFIELDP)
1531     KRESP = IRESP
1532   END SUBROUTINE FMWRITX5_ll
1533
1534   SUBROUTINE FMWRITX6_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
1535        KLENCH,HCOMMENT,KRESP)
1536     USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
1537     USE MODD_FM
1538     USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
1539     USE MODE_ALLOCBUFFER_ll
1540     USE MODE_GATHER_ll
1541     !
1542 !!!! MOD SB
1543 #ifdef MNH_NCWRIT
1544     USE MODD_NCOUT
1545     USE MODE_UTIL
1546 #endif
1547 !!!! MOD SB
1548     !
1549     !*      0.1   Declarations of arguments
1550     !
1551     CHARACTER(LEN=*),                INTENT(IN) ::HFILEM   ! FM-file name
1552     CHARACTER(LEN=*),                INTENT(IN) ::HRECFM   ! name of the article to write
1553     CHARACTER(LEN=*),                INTENT(IN) ::HFIPRI   ! output file for error messages
1554     CHARACTER(LEN=*),                INTENT(IN) ::HDIR     ! field form
1555     REAL,DIMENSION(:,:,:,:,:,:),TARGET,INTENT(IN) ::PFIELD ! array containing the data field
1556     INTEGER,                         INTENT(IN) ::KGRID    ! C-grid indicator (u,v,w,T)
1557     INTEGER,                         INTENT(IN) ::KLENCH   ! length of comment string
1558     CHARACTER(LEN=*),                INTENT(IN) ::HCOMMENT ! comment string
1559     INTEGER,                         INTENT(OUT)::KRESP    ! return-code 
1560     !
1561     !*      0.2   Declarations of local variables
1562     !
1563     CHARACTER(LEN=JPFINL)                    :: YFNLFI
1564     INTEGER                                  :: IERR
1565     TYPE(FD_ll), POINTER                     :: TZFD
1566     INTEGER                                  :: IRESP
1567     REAL,DIMENSION(:,:,:,:,:,:),POINTER        :: ZFIELDP
1568     TYPE(FMHEADER)                           :: TZFMH
1569     LOGICAL                                  :: GALLOC
1570     !
1571     !*      1.1   THE NAME OF LFIFM
1572     !
1573     IRESP = 0
1574     GALLOC = .FALSE.
1575     YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
1576     !print * , ' Writing Article 6 ' , HRECFM
1577     !------------------------------------------------------------------
1578     TZFD=>GETFD(YFNLFI)
1579     IF (ASSOCIATED(TZFD)) THEN
1580        IF (GSMONOPROC) THEN ! sequential execution
1581           TZFMH%GRID=KGRID
1582           TZFMH%COMLEN=KLENCH
1583           TZFMH%COMMENT=HCOMMENT
1584 #ifdef MNH_NCWRIT
1585                IF ( DEF_NC .AND. LLFIFM ) THEN
1586           CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
1587                END IF
1588 #else
1589           IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
1590           IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,PFIELD,TZFMH,IRESP)
1591 #endif
1592        ELSE ! multiprocessor execution
1593           IF (ISP == TZFD%OWNER)  THEN
1594              CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC)
1595           ELSE
1596              ALLOCATE(ZFIELDP(0,0,0,0,0,0))
1597              GALLOC = .TRUE.
1598           END IF
1599           !
1600           IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
1601              CALL GATHER_XXFIELD(HDIR,PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
1602           ELSEIF (HDIR == 'XY') THEN
1603              CALL GATHER_XYFIELD(PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
1604           END IF
1605           !
1606           IF (ISP == TZFD%OWNER)  THEN
1607              TZFMH%GRID=KGRID
1608              TZFMH%COMLEN=KLENCH
1609              TZFMH%COMMENT=HCOMMENT
1610 #ifdef MNH_NCWRIT
1611                IF ( DEF_NC .AND. LLFIFM ) THEN
1612              CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
1613                   & ,IRESP)
1614                END IF
1615 #else
1616              IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
1617                   & ,IRESP)
1618              IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,ZFIELDP,TZFMH,IRESP)
1619 #endif
1620           END IF
1621           !
1622           CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
1623        END IF ! multiprocessor execution
1624     ELSE 
1625        IRESP = -61
1626     END IF
1627     !----------------------------------------------------------------
1628     IF (IRESP.NE.0) THEN
1629        CALL FM_WRIT_ERR("FMWRITX6_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH,IRESP)
1630     END IF
1631     IF (GALLOC) DEALLOCATE(ZFIELDP)
1632     KRESP = IRESP
1633   END SUBROUTINE FMWRITX6_ll
1634
1635   SUBROUTINE FMWRITN0_ll(HFILEM,HRECFM,HFIPRI,HDIR,KFIELD,KGRID,&
1636        KLENCH,HCOMMENT,KRESP)
1637     USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
1638     USE MODD_FM
1639     USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
1640     !*      0.    DECLARATIONS
1641     !             ------------
1642 !!!! MOD SB
1643 #ifdef MNH_NCWRIT
1644     USE MODD_NCOUT
1645     USE MODE_UTIL 
1646 #endif
1647 !!!! MOD SB
1648     !
1649     !
1650     !*      0.1   Declarations of arguments
1651     !
1652     CHARACTER(LEN=*),   INTENT(IN) ::HFILEM  ! FM-file name
1653     CHARACTER(LEN=*),   INTENT(IN) ::HRECFM  ! name of the article to read
1654     CHARACTER(LEN=*),   INTENT(IN) ::HFIPRI  ! output file for error messages
1655     CHARACTER(LEN=*),   INTENT(IN) ::HDIR    ! field form
1656     INTEGER,            INTENT(IN) ::KFIELD  ! array containing the data field
1657     INTEGER,            INTENT(IN) ::KGRID   ! C-grid indicator (u,v,w,T)
1658     INTEGER,            INTENT(IN) ::KLENCH  ! length of comment string
1659     CHARACTER(LEN=*),   INTENT(IN) ::HCOMMENT! comment string
1660     INTEGER,            INTENT(OUT)::KRESP   ! return-code
1661     !
1662     !*      0.2   Declarations of local variables
1663     !
1664     CHARACTER(LEN=JPFINL)        :: YFNLFI
1665     INTEGER                      :: IERR
1666     TYPE(FD_ll), POINTER         :: TZFD
1667     INTEGER                      :: IRESP
1668     TYPE(FMHEADER)               :: TZFMH
1669
1670     !JUANZIO
1671     INTEGER                                  :: IK_FILE,IK_rank
1672     CHARACTER(len=5)                         :: YK_FILE  
1673     CHARACTER(len=128)                       :: YFILE_IOZ  
1674     TYPE(FD_ll), POINTER                     :: TZFD_IOZ 
1675     !JUANZIO
1676     !----------------------------------------------------------------
1677     !
1678     !*      1.1   THE NAME OF LFIFM
1679     !
1680     IRESP = 0
1681     YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
1682     !print * , ' Writing Article N0 ' , HRECFM
1683     !------------------------------------------------------------------
1684     TZFD=>GETFD(YFNLFI)
1685     IF (ASSOCIATED(TZFD)) THEN
1686        IF (GSMONOPROC) THEN ! sequential execution
1687           TZFMH%GRID=KGRID
1688           TZFMH%COMLEN=KLENCH
1689           TZFMH%COMMENT=HCOMMENT
1690 #ifdef MNH_NCWRIT
1691                IF ( DEF_NC .AND. LLFIFM ) THEN
1692           CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,1,KFIELD,TZFMH,IRESP)
1693                END IF
1694 #else
1695           IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,1,KFIELD,TZFMH,IRESP)
1696           IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,KFIELD,TZFMH,IRESP)
1697 #endif
1698        ELSE 
1699           IF (ISP == TZFD%OWNER)  THEN
1700              TZFMH%GRID=KGRID
1701              TZFMH%COMLEN=KLENCH
1702              TZFMH%COMMENT=HCOMMENT
1703 #ifdef MNH_NCWRIT
1704                IF ( DEF_NC .AND. LLFIFM ) THEN
1705              CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,1,KFIELD,TZFMH,IRESP)
1706                END IF
1707 #else
1708              IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,1,KFIELD,TZFMH,IRESP)
1709              IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,KFIELD,TZFMH,IRESP)
1710 #endif
1711           END IF
1712           !
1713           CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
1714
1715        END IF ! multiprocessor execution
1716        IF (TZFD%nb_procio.gt.1) THEN
1717           ! write the data in all Z files
1718           DO IK_FILE=1,TZFD%nb_procio
1719              write(YK_FILE ,'(".Z",i3.3)')  IK_FILE
1720              YFILE_IOZ =  TRIM(HFILEM)//YK_FILE//".lfi"
1721              TZFD_IOZ => GETFD(YFILE_IOZ)   
1722              IK_RANK = TZFD_IOZ%OWNER
1723              IF ( ISP == IK_RANK )  THEN
1724                 TZFMH%GRID=KGRID
1725                 TZFMH%COMLEN=KLENCH
1726                 TZFMH%COMMENT=HCOMMENT
1727 #ifdef MNH_NCWRIT
1728                IF ( DEF_NC .AND. LLFIFM ) THEN
1729                 CALL FM_WRIT_ll(TZFD_IOZ%FLU,HRECFM,.FALSE.,1,KFIELD,TZFMH,IRESP)
1730                END IF
1731 #else
1732                 IF (LLFIOUT) CALL FM_WRIT_ll(TZFD_IOZ%FLU,HRECFM,.FALSE.,1,KFIELD,TZFMH,IRESP)
1733                 IF (LIOCDF4) CALL NCWRIT(TZFD_IOZ%CDF,HRECFM,HDIR,KFIELD,TZFMH,IRESP)
1734 #endif
1735              END IF
1736           END DO
1737        ENDIF
1738     ELSE 
1739        IRESP = -61
1740     END IF
1741     !----------------------------------------------------------------
1742     IF (IRESP.NE.0) THEN
1743        CALL FM_WRIT_ERR("FMWRITN0_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH&
1744             & ,IRESP)
1745     END IF
1746     KRESP = IRESP
1747   END SUBROUTINE FMWRITN0_ll
1748
1749   SUBROUTINE FMWRITN1_ll(HFILEM,HRECFM,HFIPRI,HDIR,KFIELD,KGRID,&
1750        KLENCH,HCOMMENT,KRESP)
1751     USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
1752     USE MODD_FM
1753     USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
1754     USE MODE_ALLOCBUFFER_ll
1755     USE MODE_GATHER_ll
1756     !*      0.    DECLARATIONS
1757     !             ------------
1758 !!!! MOD SB
1759 #ifdef MNH_NCWRIT
1760     USE MODD_NCOUT
1761     USE MODE_UTIL
1762 #endif
1763 !!!! MOD SB
1764     !
1765     !
1766     !*      0.1   Declarations of arguments
1767     !
1768     CHARACTER(LEN=*),           INTENT(IN) ::HFILEM   ! FM-file name
1769     CHARACTER(LEN=*),           INTENT(IN) ::HRECFM   ! name of the article to write
1770     CHARACTER(LEN=*),           INTENT(IN) ::HFIPRI   ! output file for error messages
1771     CHARACTER(LEN=*),           INTENT(IN) ::HDIR     ! field form
1772     INTEGER,DIMENSION(:),TARGET,INTENT(IN) ::KFIELD   ! array containing the data field
1773     INTEGER,                    INTENT(IN) ::KGRID    ! C-grid indicator (u,v,w,T)
1774     INTEGER,                    INTENT(IN) ::KLENCH   ! length of comment string
1775     CHARACTER(LEN=*),           INTENT(IN) ::HCOMMENT ! comment string
1776     INTEGER,                    INTENT(OUT)::KRESP    ! return-code 
1777     !
1778     !*      0.2   Declarations of local variables
1779     !
1780     CHARACTER(LEN=JPFINL)        :: YFNLFI
1781     INTEGER                      :: IERR
1782     TYPE(FD_ll), POINTER         :: TZFD
1783     INTEGER                      :: IRESP
1784     TYPE(FMHEADER)               :: TZFMH
1785     INTEGER,DIMENSION(:),POINTER :: IFIELDP
1786     LOGICAL                      :: GALLOC
1787 #ifdef MNH_NCWRIT
1788     REAL,DIMENSION(SIZE(KFIELD)) ::WFIELD
1789     TYPE(workfield), DIMENSION(:), POINTER   :: TZRECLIST
1790     INTEGER,DIMENSION(6)         :: TABDIM
1791 #endif
1792     !----------------------------------------------------------------
1793     !
1794     !*      1.1   THE NAME OF LFIFM
1795     !
1796     IRESP = 0
1797     GALLOC = .FALSE.
1798     YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
1799     !print * , ' Writing Article N1 ' , HRECFM
1800 #ifdef MNH_NCWRIT
1801     WFIELD = KFIELD
1802     TABDIM(:)=1
1803 #endif
1804     !------------------------------------------------------------------
1805     TZFD=>GETFD(YFNLFI)
1806     IF (ASSOCIATED(TZFD)) THEN
1807        IF (GSMONOPROC) THEN ! sequential execution
1808           TZFMH%GRID=KGRID
1809           TZFMH%COMLEN=KLENCH
1810           TZFMH%COMMENT=HCOMMENT
1811 #ifdef MNH_NCWRIT
1812                IF ( DEF_NC .AND. LLFIFM ) THEN
1813           CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(KFIELD),KFIELD,TZFMH,IRESP)
1814                END IF
1815                IF ( LNETCDF .AND. NC_WRITE ) THEN
1816           CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,WFIELD, &
1817           & .TRUE.,TZRECLIST,KLENCH,HCOMMENT)
1818                END IF
1819 #else
1820           IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(KFIELD),KFIELD,TZFMH,IRESP)
1821           IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,KFIELD,TZFMH,IRESP)
1822 #endif
1823        ELSE
1824           IF (ISP == TZFD%OWNER)  THEN
1825              CALL ALLOCBUFFER_ll(IFIELDP,KFIELD,HDIR,GALLOC)
1826           ELSE
1827              ALLOCATE(IFIELDP(0))
1828              GALLOC = .TRUE.
1829           END IF
1830           !
1831           IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
1832              CALL GATHER_XXFIELD(HDIR,KFIELD,IFIELDP,TZFD%OWNER,TZFD%COMM)
1833           END IF
1834           !
1835           IF (ISP == TZFD%OWNER)  THEN
1836              TZFMH%GRID=KGRID
1837              TZFMH%COMLEN=KLENCH
1838              TZFMH%COMMENT=HCOMMENT
1839 #ifdef MNH_NCWRIT
1840                IF ( DEF_NC .AND. LLFIFM ) THEN
1841              CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELDP),IFIELDP,TZFMH&
1842                   & ,IRESP)
1843                END IF
1844                IF ( LNETCDF .AND. NC_WRITE ) THEN
1845           CALL NC_WRIT_ll(HRECFM,HFILEM,KGRID,TABDIM,WFIELD, &
1846           .TRUE.,TZRECLIST,&
1847                    & KLENCH,HCOMMENT)
1848                END IF
1849 #else
1850              IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELDP),IFIELDP,TZFMH&
1851                   & ,IRESP)
1852              IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,IFIELDP,TZFMH,IRESP)
1853 #endif
1854           END IF
1855           !
1856           CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
1857        END IF
1858     ELSE 
1859        IRESP = -61
1860     END IF
1861     !----------------------------------------------------------------
1862     IF (IRESP.NE.0) THEN
1863        CALL FM_WRIT_ERR("FMWRITN1_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH&
1864             & ,IRESP)
1865     END IF
1866     IF (GALLOC) DEALLOCATE(IFIELDP)
1867     KRESP = IRESP
1868   END SUBROUTINE FMWRITN1_ll
1869
1870   SUBROUTINE FMWRITN2_ll(HFILEM,HRECFM,HFIPRI,HDIR,KFIELD,KGRID,&
1871        KLENCH,HCOMMENT,KRESP)
1872     USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT,LPACK,L1D,L2D
1873     USE MODD_PARAMETERS_ll,ONLY : JPHEXT
1874     USE MODD_FM
1875     USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
1876     USE MODE_ALLOCBUFFER_ll
1877     USE MODE_GATHER_ll
1878     !
1879 !!!! MOD SB
1880 #ifdef MNH_NCWRIT
1881     USE MODD_NCOUT
1882     USE MODE_UTIL
1883 #endif
1884 !!!! MOD SB
1885     !
1886     !*      0.1   Declarations of arguments
1887     !
1888     CHARACTER(LEN=*),             INTENT(IN) ::HFILEM   ! FM-file name
1889     CHARACTER(LEN=*),             INTENT(IN) ::HRECFM   ! name of the article to write
1890     CHARACTER(LEN=*),             INTENT(IN) ::HFIPRI   ! output file for error messages
1891     CHARACTER(LEN=*),             INTENT(IN) ::HDIR     ! field form
1892     INTEGER,DIMENSION(:,:),TARGET,INTENT(IN) ::KFIELD ! array containing the data field
1893     INTEGER,                      INTENT(IN) ::KGRID    ! C-grid indicator (u,v,w,T)
1894     INTEGER,                      INTENT(IN) ::KLENCH   ! length of comment string
1895     CHARACTER(LEN=*),             INTENT(IN) ::HCOMMENT ! comment string
1896     INTEGER,                      INTENT(OUT)::KRESP    ! return-code 
1897     !
1898     !*      0.2   Declarations of local variables
1899     !
1900     CHARACTER(LEN=JPFINL)                    :: YFNLFI
1901     INTEGER                                  :: IERR
1902     TYPE(FD_ll), POINTER                     :: TZFD
1903     INTEGER                                  :: IRESP
1904     INTEGER,DIMENSION(:,:),POINTER           :: IFIELDP
1905     TYPE(FMHEADER)                           :: TZFMH
1906     LOGICAL                                  :: GALLOC
1907
1908     !
1909     !*      1.1   THE NAME OF LFIFM
1910     !
1911     IRESP = 0
1912     GALLOC = .FALSE.
1913     YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
1914     !print * , ' Writing Article N2 ' , HRECFM
1915     !
1916     TZFD=>GETFD(YFNLFI)
1917 !    IF (ASSOCIATED(TZFD) .OR. .not.LLFIFM) THEN
1918     IF (ASSOCIATED(TZFD)) THEN
1919        IF (GSMONOPROC) THEN ! sequential execution
1920           TZFMH%GRID=KGRID
1921           TZFMH%COMLEN=KLENCH
1922           TZFMH%COMMENT=HCOMMENT
1923           !    IF (LPACK .AND. L1D .AND. HDIR=='XY') THEN 
1924           IF (LPACK .AND. L1D .AND. SIZE(KFIELD,1)==2*JPHEXT+1 .AND. SIZE(KFIELD,2)==2*JPHEXT+1) THEN 
1925              IFIELDP=>KFIELD(2:2,2:2)
1926 #ifdef MNH_NCWRIT
1927                IF ( DEF_NC .AND. LLFIFM ) THEN
1928              CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELDP),IFIELDP,TZFMH,IRESP)
1929                END IF
1930 #else
1931              IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELDP),IFIELDP,TZFMH,IRESP)
1932              IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,IFIELDP,TZFMH,IRESP)
1933 #endif
1934              !    ELSE IF (LPACK .AND. L2D .AND. HDIR=='XY') THEN
1935           ELSEIF (LPACK .AND. L2D .AND. SIZE(KFIELD,2)==2*JPHEXT+1) THEN
1936              IFIELDP=>KFIELD(:,2:2)
1937 #ifdef MNH_NCWRIT
1938                IF ( DEF_NC .AND. LLFIFM ) THEN
1939              CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELDP),IFIELDP,TZFMH,IRESP)
1940                END IF
1941 #else
1942              IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELDP),IFIELDP,TZFMH,IRESP)
1943              IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,IFIELDP,TZFMH,IRESP)
1944 #endif
1945           ELSE
1946 #ifdef MNH_NCWRIT
1947                IF ( DEF_NC .AND. LLFIFM ) THEN
1948              CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(KFIELD),KFIELD,TZFMH,IRESP)
1949                END IF
1950 #else
1951              IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(KFIELD),KFIELD,TZFMH,IRESP)
1952              IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,KFIELD,TZFMH,IRESP)
1953 #endif
1954           END IF
1955        ELSE
1956           IF (ISP == TZFD%OWNER)  THEN
1957              CALL ALLOCBUFFER_ll(IFIELDP,KFIELD,HDIR,GALLOC)
1958           ELSE
1959              ALLOCATE(IFIELDP(0,0))
1960              GALLOC = .TRUE.
1961           END IF
1962           !
1963           IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
1964              CALL GATHER_XXFIELD(HDIR,KFIELD,IFIELDP,TZFD%OWNER,TZFD%COMM)
1965           ELSEIF (HDIR == 'XY') THEN
1966              IF (LPACK .AND. L2D) THEN
1967                 CALL GATHER_XXFIELD('XX',KFIELD(:,2),IFIELDP(:,1),TZFD%OWNER,TZFD%COMM)
1968              ELSE
1969                 CALL GATHER_XYFIELD(KFIELD,IFIELDP,TZFD%OWNER,TZFD%COMM)
1970              END IF
1971           END IF
1972           !
1973           IF (ISP == TZFD%OWNER)  THEN
1974              TZFMH%GRID=KGRID
1975              TZFMH%COMLEN=KLENCH
1976              TZFMH%COMMENT=HCOMMENT
1977 #ifdef MNH_NCWRIT
1978                IF ( DEF_NC .AND. LLFIFM ) THEN
1979              CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELDP),IFIELDP,TZFMH&
1980                   & ,IRESP)
1981                 END IF
1982 #else
1983              IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELDP),IFIELDP,TZFMH&
1984                   & ,IRESP)
1985              IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,IFIELDP,TZFMH,IRESP)
1986 #endif
1987           END IF
1988           !
1989           CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
1990        END IF
1991
1992     ELSE
1993        IRESP = -61
1994     END IF
1995     !----------------------------------------------------------------
1996     IF (IRESP.NE.0) THEN
1997        CALL FM_WRIT_ERR("FMWRITN2_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH,IRESP)
1998     END IF
1999     IF (GALLOC) DEALLOCATE(IFIELDP)
2000     KRESP = IRESP
2001   END SUBROUTINE FMWRITN2_ll
2002
2003
2004   SUBROUTINE FMWRITL0_ll(HFILEM,HRECFM,HFIPRI,HDIR,OFIELD,KGRID,&
2005        KLENCH,HCOMMENT,KRESP)
2006     USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
2007     USE MODD_FM
2008     USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
2009
2010 !!!! MOD SB
2011 #ifdef MNH_NCWRIT
2012     USE MODD_NCOUT
2013     USE MODE_UTIL
2014 #endif
2015 !!!! MOD SB
2016     !
2017     !*      0.    DECLARATIONS
2018     !             ------------
2019     !
2020     !
2021     !*      0.1   Declarations of arguments
2022     !
2023     CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
2024     CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
2025     CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
2026     CHARACTER(LEN=*), INTENT(IN) ::HDIR   ! field form
2027     LOGICAL,          INTENT(IN) ::OFIELD ! array containing the data field
2028     INTEGER,          INTENT(IN)::KGRID  ! C-grid indicator (u,v,w,T)
2029     INTEGER,          INTENT(IN)::KLENCH ! length of comment string
2030     CHARACTER(LEN=*), INTENT(IN)::HCOMMENT ! comment string
2031     INTEGER,          INTENT(OUT)::KRESP    ! return-code
2032     !
2033     !*      0.2   Declarations of local variables
2034     !
2035     INTEGER                      :: IFIELD
2036     CHARACTER(LEN=JPFINL)        :: YFNLFI
2037     INTEGER                      :: IERR
2038     TYPE(FD_ll), POINTER         :: TZFD
2039     INTEGER                      :: IRESP
2040     TYPE(FMHEADER)               :: TZFMH
2041
2042     !----------------------------------------------------------------
2043     !
2044     !*      1.1   THE NAME OF LFIFM
2045     !
2046     IRESP = 0
2047     YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
2048     !print * , ' Writing Article L0 ' , HRECFM
2049     IF (OFIELD) THEN
2050        IFIELD=1
2051     ELSE
2052        IFIELD=0
2053     END IF
2054     !----------------------------------------------------------------
2055     TZFD=>GETFD(YFNLFI)
2056 !    IF (ASSOCIATED(TZFD) .OR. .not.LLFIFM) THEN
2057     IF (ASSOCIATED(TZFD)) THEN
2058        IF (GSMONOPROC) THEN ! sequential execution
2059           TZFMH%GRID=KGRID
2060           TZFMH%COMLEN=KLENCH
2061           TZFMH%COMMENT=HCOMMENT
2062 #ifdef MNH_NCWRIT
2063                IF ( DEF_NC .AND. LLFIFM ) THEN
2064           CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,1,IFIELD,TZFMH,IRESP)
2065                END IF
2066 #else
2067           IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,1,IFIELD,TZFMH,IRESP)
2068           IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,IFIELD,TZFMH,IRESP)
2069 #endif 
2070        ELSE
2071           IF (ISP == TZFD%OWNER)  THEN
2072              TZFMH%GRID=KGRID
2073              TZFMH%COMLEN=KLENCH
2074              TZFMH%COMMENT=HCOMMENT
2075 #ifdef MNH_NCWRIT
2076                IF ( DEF_NC .AND. LLFIFM ) THEN
2077              CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,1,IFIELD,TZFMH,IRESP)
2078                END IF
2079 #else
2080              IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,1,IFIELD,TZFMH,IRESP)
2081              IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,IFIELD,TZFMH,IRESP)
2082 #endif
2083           END IF
2084           CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
2085        END IF
2086     ELSE
2087        IRESP = -61
2088     END IF
2089     !----------------------------------------------------------------
2090     IF (IRESP.NE.0) THEN
2091        CALL FM_WRIT_ERR("FMWRITL0_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH&
2092             & ,IRESP)
2093     END IF
2094     KRESP = IRESP
2095   END SUBROUTINE FMWRITL0_ll
2096
2097   SUBROUTINE FMWRITL1_ll(HFILEM,HRECFM,HFIPRI,HDIR,OFIELD,KGRID,&
2098        KLENCH,HCOMMENT,KRESP)
2099     USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
2100     USE MODD_FM
2101     USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
2102
2103     !*      0.    DECLARATIONS
2104     !             ------------
2105 !!!! MOD SB
2106 #ifdef MNH_NCWRIT
2107     USE MODD_NCOUT
2108     USE MODE_UTIL
2109 #endif
2110 !!!! MOD SB
2111     !
2112     !*      0.1   Declarations of arguments
2113     !
2114     CHARACTER(LEN=*),    INTENT(IN) ::HFILEM ! FM-file name
2115     CHARACTER(LEN=*),    INTENT(IN) ::HRECFM ! name of the article to read
2116     CHARACTER(LEN=*),    INTENT(IN) ::HFIPRI ! output file for error messages
2117     CHARACTER(LEN=*),    INTENT(IN) ::HDIR   ! field form
2118     LOGICAL,DIMENSION(:),INTENT(IN) ::OFIELD ! array containing the data field
2119     INTEGER,             INTENT(IN)::KGRID  ! C-grid indicator (u,v,w,T)
2120     INTEGER,             INTENT(IN)::KLENCH ! length of comment string
2121     CHARACTER(LEN=*),    INTENT(IN)::HCOMMENT ! comment string
2122     INTEGER,             INTENT(OUT)::KRESP    ! return-code
2123     !
2124     !*      0.2   Declarations of local variables
2125     !
2126     INTEGER, DIMENSION(SIZE(OFIELD)) :: IFIELD
2127     CHARACTER(LEN=JPFINL)            :: YFNLFI
2128     INTEGER                          :: IERR
2129     TYPE(FD_ll), POINTER             :: TZFD
2130     INTEGER                          :: IRESP
2131     TYPE(FMHEADER)                   :: TZFMH
2132
2133     !----------------------------------------------------------------
2134     !
2135     !*      1.1   THE NAME OF LFIFM
2136     !
2137     IRESP = 0
2138     YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
2139     !print * , ' Writing Article L1 ' , HRECFM
2140     WHERE (OFIELD)
2141        IFIELD=1
2142     ELSEWHERE
2143        IFIELD=0
2144     END WHERE
2145     !----------------------------------------------------------------
2146     TZFD=>GETFD(YFNLFI)
2147 !    IF (ASSOCIATED(TZFD) .OR. .not.LLFIFM) THEN
2148     IF (ASSOCIATED(TZFD)) THEN
2149        IF (GSMONOPROC) THEN ! sequential execution
2150           TZFMH%GRID=KGRID
2151           TZFMH%COMLEN=KLENCH
2152           TZFMH%COMMENT=HCOMMENT
2153 #ifdef MNH_NCWRIT
2154                IF ( DEF_NC .AND. LLFIFM ) THEN
2155           CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELD),IFIELD,TZFMH,IRESP)
2156                END IF
2157 #else
2158           IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELD),IFIELD,TZFMH,IRESP)
2159           IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,IFIELD,TZFMH,IRESP)
2160 #endif
2161        ELSE
2162           IF (ISP == TZFD%OWNER)  THEN
2163              TZFMH%GRID=KGRID
2164              TZFMH%COMLEN=KLENCH
2165              TZFMH%COMMENT=HCOMMENT
2166 #ifdef MNH_NCWRIT
2167                IF ( DEF_NC .AND. LLFIFM ) THEN
2168              CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELD),IFIELD,TZFMH,IRESP)
2169                END IF
2170 #else
2171              IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELD),IFIELD,TZFMH,IRESP)
2172              IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,IFIELD,TZFMH,IRESP)
2173 #endif
2174           END IF
2175           !
2176           CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
2177        END IF
2178     ELSE
2179        IRESP = -61
2180     END IF
2181     !----------------------------------------------------------------
2182     IF (IRESP.NE.0) THEN
2183        CALL FM_WRIT_ERR("FMWRITL1_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH&
2184             & ,IRESP)
2185     END IF
2186     KRESP = IRESP
2187   END SUBROUTINE FMWRITL1_ll
2188
2189   SUBROUTINE FMWRITC0_ll(HFILEM,HRECFM,HFIPRI,HDIR,HFIELD,KGRID,&
2190        KLENCH,HCOMMENT,KRESP)
2191     USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
2192     USE MODD_FM
2193     USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
2194     !
2195     !*      0.    DECLARATIONS
2196     !             ------------
2197     !
2198 !!!! MOD SB
2199 #ifdef MNH_NCWRIT
2200     USE MODD_NCOUT
2201     USE MODE_UTIL
2202 #endif
2203 !!! MOD SB
2204     !
2205     !*      0.1   Declarations of arguments
2206     !
2207     CHARACTER(LEN=*),  INTENT(IN) ::HFILEM ! FM-file name
2208     CHARACTER(LEN=*),  INTENT(IN) ::HRECFM ! name of the article to read
2209     CHARACTER(LEN=*),  INTENT(IN) ::HFIPRI ! output file for error messages
2210     CHARACTER(LEN=*),  INTENT(IN) ::HDIR   ! field form
2211     CHARACTER(LEN=*),  INTENT(IN) ::HFIELD ! array containing the data field
2212     INTEGER,           INTENT(IN)::KGRID  ! C-grid indicator (u,v,w,T)
2213     INTEGER,           INTENT(IN)::KLENCH ! length of comment string
2214     CHARACTER(LEN=*),  INTENT(IN)::HCOMMENT ! comment string
2215     INTEGER,           INTENT(OUT)::KRESP    ! return-code
2216     !
2217     !*      0.2   Declarations of local variables
2218     !
2219     INTEGER                          :: JLOOP
2220     INTEGER,DIMENSION(:),ALLOCATABLE :: IFIELD
2221     INTEGER                          :: ILENG
2222     CHARACTER(LEN=JPFINL)            :: YFNLFI
2223     INTEGER                          :: IERR
2224     TYPE(FD_ll), POINTER             :: TZFD
2225     INTEGER                          :: IRESP
2226     TYPE(FMHEADER)                   :: TZFMH
2227 #ifdef MNH_NCWRIT
2228     TYPE(workfield), DIMENSION(:), POINTER   :: TZRECLIST
2229     INTEGER,DIMENSION(6)                     :: TABDIM
2230 #endif
2231
2232     !----------------------------------------------------------------
2233     !*      1.1   THE NAME OF LFIFM
2234     !
2235     IRESP = 0
2236     YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
2237     !print * , ' Writing Article C0 ' , HRECFM
2238     ILENG=LEN(HFIELD)
2239 #ifdef MNH_NCWRIT
2240     TABDIM(:)=1
2241     TABDIM(1)=ILENG
2242 #endif
2243     !
2244     IF (ILENG==0) THEN
2245        ILENG=1
2246        ALLOCATE(IFIELD(1))
2247        IFIELD(1)=IACHAR(' ')
2248     ELSE
2249        ALLOCATE(IFIELD(ILENG))
2250        DO JLOOP=1,ILENG
2251           IFIELD(JLOOP)=IACHAR(HFIELD(JLOOP:JLOOP))
2252        END DO
2253     END IF
2254     !----------------------------------------------------------------
2255     TZFD=>GETFD(YFNLFI)
2256     IF (ASSOCIATED(TZFD)) THEN
2257        IF (GSMONOPROC) THEN  ! sequential execution
2258           TZFMH%GRID=KGRID
2259           TZFMH%COMLEN=KLENCH
2260           TZFMH%COMMENT=HCOMMENT
2261 #ifdef MNH_NCWRIT
2262                IF ( DEF_NC .AND. LLFIFM ) THEN
2263           CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,ILENG,IFIELD,TZFMH,KRESP)
2264                END IF
2265 #else
2266           IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,ILENG,IFIELD,TZFMH,IRESP)
2267           IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,HFIELD,TZFMH,IRESP)
2268 #endif
2269        ELSE
2270           IF (ISP == TZFD%OWNER)  THEN
2271              TZFMH%GRID=KGRID
2272              TZFMH%COMLEN=KLENCH
2273              TZFMH%COMMENT=HCOMMENT
2274 #ifdef MNH_NCWRIT
2275                IF ( DEF_NC .AND. LLFIFM ) THEN
2276              CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,ILENG,IFIELD,TZFMH,KRESP)
2277                END IF
2278 #else
2279              IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,ILENG,IFIELD,TZFMH,IRESP)
2280              IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,HFIELD,TZFMH,IRESP)
2281 #endif
2282           END IF
2283           !
2284           CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
2285        END IF
2286     ELSE 
2287        IRESP = -61
2288     END IF
2289     !----------------------------------------------------------------
2290     IF (IRESP.NE.0) THEN
2291        CALL FM_WRIT_ERR("FMWRITC0_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH&
2292             & ,IRESP)
2293     END IF
2294     IF (ALLOCATED(IFIELD)) DEALLOCATE(IFIELD)
2295     KRESP = IRESP
2296   END SUBROUTINE FMWRITC0_ll
2297
2298   SUBROUTINE FMWRITC1_ll(HFILEM,HRECFM,HFIPRI,HDIR,HFIELD,KGRID,&
2299        KLENCH,HCOMMENT,KRESP)
2300     USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
2301     USE MODD_FM
2302     USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
2303     !
2304     !*      0.    DECLARATIONS
2305     !             ------------
2306     !
2307     !
2308     !*      0.1   Declarations of arguments
2309     !
2310     CHARACTER(LEN=*),             INTENT(IN) ::HFILEM ! FM-file name
2311     CHARACTER(LEN=*),             INTENT(IN) ::HRECFM ! name of the article to read
2312     CHARACTER(LEN=*),             INTENT(IN) ::HFIPRI ! output file for error messages
2313     CHARACTER(LEN=*),             INTENT(IN) ::HDIR   ! field form
2314     CHARACTER(LEN=*),DIMENSION(:),INTENT(IN) ::HFIELD ! array containing the data field
2315     INTEGER,                      INTENT(IN) ::KGRID  ! C-grid indicator (u,v,w,T)
2316     INTEGER,                      INTENT(IN) ::KLENCH ! length of comment string
2317     CHARACTER(LEN=*),             INTENT(IN) ::HCOMMENT ! comment string
2318     INTEGER,                      INTENT(OUT)::KRESP    ! return-code
2319     !
2320     !*      0.2   Declarations of local variables
2321     !
2322     INTEGER                          :: J,JJ
2323     INTEGER                          :: ILE, IP
2324     INTEGER,DIMENSION(:),ALLOCATABLE :: IFIELD
2325     INTEGER                          :: ILENG
2326     CHARACTER(LEN=JPFINL)            :: YFNLFI
2327     INTEGER                          :: IERR
2328     TYPE(FD_ll), POINTER             :: TZFD
2329     INTEGER                          :: IRESP
2330     TYPE(FMHEADER)                   :: TZFMH
2331     !----------------------------------------------------------------
2332     !*      1.1   THE NAME OF LFIFM
2333     !
2334     IRESP = 0
2335     YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
2336     !print * , ' Writing Article C1 ' , HRECFM
2337     ILE=LEN(HFIELD)
2338     IP=SIZE(HFIELD)
2339     ILENG=ILE*IP
2340     !
2341     IF (ILENG==0) THEN
2342        IP=1
2343        ILE=1
2344        ILENG=1
2345        ALLOCATE(IFIELD(1))
2346        IFIELD(1)=IACHAR(' ')
2347     ELSE
2348        ALLOCATE(IFIELD(ILENG))
2349        DO JJ=1,IP
2350           DO J=1,ILE
2351              IFIELD(ILE*(JJ-1)+J)=IACHAR(HFIELD(JJ)(J:J))
2352           END DO
2353        END DO
2354     END IF
2355     !----------------------------------------------------------------
2356     TZFD=>GETFD(YFNLFI)
2357     IF (ASSOCIATED(TZFD)) THEN
2358        IF (GSMONOPROC) THEN  ! sequential execution
2359           TZFMH%GRID=KGRID
2360           TZFMH%COMLEN=KLENCH
2361           TZFMH%COMMENT=HCOMMENT
2362           IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,ILENG,IFIELD,TZFMH,IRESP)
2363           IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,HFIELD,TZFMH,IRESP)
2364        ELSE
2365           IF (ISP == TZFD%OWNER)  THEN
2366              TZFMH%GRID=KGRID
2367              TZFMH%COMLEN=KLENCH
2368              TZFMH%COMMENT=HCOMMENT
2369              IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,ILENG,IFIELD,TZFMH,IRESP)
2370              IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,HFIELD,TZFMH,IRESP)
2371           END IF
2372           !
2373           CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
2374        END IF
2375     ELSE 
2376        IRESP = -61
2377     END IF
2378     !----------------------------------------------------------------
2379     IF (IRESP.NE.0) THEN
2380        CALL FM_WRIT_ERR("FMWRITC1_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH&
2381             & ,IRESP)
2382     END IF
2383     IF (ALLOCATED(IFIELD)) DEALLOCATE(IFIELD)
2384     KRESP = IRESP
2385   END SUBROUTINE FMWRITC1_ll
2386
2387   SUBROUTINE FMWRITT0_ll(HFILEM,HRECFM,HFIPRI,HDIR,TFIELD,KGRID,&
2388        KLENCH,HCOMMENT,KRESP)
2389     USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
2390     USE MODD_TYPE_DATE
2391     USE MODD_FM
2392     USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
2393     !
2394 !!!! MOD SB
2395 #ifdef MNH_NCWRIT
2396     USE MODD_NCOUT
2397     USE MODE_UTIL
2398 #endif
2399 !!!! MOD SB
2400     !*      0.1   Declarations of arguments
2401     !
2402     CHARACTER(LEN=*),    INTENT(IN) ::HFILEM ! FM-file name
2403     CHARACTER(LEN=*),    INTENT(IN) ::HRECFM ! name of the article to read
2404     CHARACTER(LEN=*),    INTENT(IN) ::HFIPRI ! output file for error messages
2405     CHARACTER(LEN=*),    INTENT(IN) ::HDIR   ! field form
2406     TYPE (DATE_TIME),    INTENT(IN) ::TFIELD ! array containing the data field
2407     INTEGER,             INTENT(IN) ::KGRID  ! C-grid indicator (u,v,w,T)
2408     INTEGER,             INTENT(IN) ::KLENCH ! length of comment string
2409     CHARACTER(LEN=*),    INTENT(IN) ::HCOMMENT ! comment string
2410     INTEGER,             INTENT(OUT)::KRESP    ! return-code
2411     !--------------------------------------------------------------------
2412     !
2413     !*      0.2   Declarations of local variables
2414     !
2415     CHARACTER(LEN=JPFINL)        :: YFNLFI
2416     INTEGER                      :: IERR
2417     TYPE(FD_ll), POINTER         :: TZFD
2418     INTEGER                      :: IRESP
2419     TYPE(FMHEADER)               :: TZFMH
2420     INTEGER, DIMENSION(3)        :: ITDATE    ! date array
2421     !
2422     !-------------------------------------------------------------------------------
2423     IRESP = 0
2424     YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
2425     !print * , ' Writing Article T0 ' , HRECFM
2426     ITDATE(1)=TFIELD%TDATE%YEAR
2427     ITDATE(2)=TFIELD%TDATE%MONTH
2428     ITDATE(3)=TFIELD%TDATE%DAY
2429     !-------------------------------------------------------------------------------
2430     TZFD=>GETFD(YFNLFI)
2431 !    IF (ASSOCIATED(TZFD) .OR. .not.LLFIFM) THEN
2432     IF (ASSOCIATED(TZFD)) THEN
2433        IF (GSMONOPROC) THEN ! sequential execution
2434           TZFMH%GRID=KGRID
2435           TZFMH%COMMENT='YYYYMMDD'
2436           TZFMH%COMLEN=LEN_TRIM(TZFMH%COMMENT)
2437 #ifdef MNH_NCWRIT
2438                IF ( DEF_NC .AND. LLFIFM ) THEN
2439           CALL FM_WRIT_ll(TZFD%FLU,TRIM(HRECFM)//'%TDATE',.FALSE.,3,ITDATE&
2440                & ,TZFMH,IRESP)
2441                END IF
2442 #else
2443           IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,TRIM(HRECFM)//'%TDATE',.FALSE.,3,ITDATE&
2444                & ,TZFMH,IRESP)
2445           IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,TRIM(HRECFM)//'%TDATE',HDIR,ITDATE,TZFMH,IRESP)
2446 #endif
2447           TZFMH%COMMENT='SECONDS'
2448           TZFMH%COMLEN=LEN_TRIM(TZFMH%COMMENT)
2449 #ifdef MNH_NCWRIT
2450                IF ( DEF_NC .AND. LLFIFM ) THEN
2451           CALL FM_WRIT_ll(TZFD%FLU,TRIM(HRECFM)//'%TIME',.TRUE.,1,TFIELD%TIME&
2452                & ,TZFMH,IRESP)
2453                END IF
2454 #else
2455           IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,TRIM(HRECFM)//'%TIME',.TRUE.,1,TFIELD%TIME&
2456                & ,TZFMH,IRESP)
2457           IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,TRIM(HRECFM)//'%TIME',HDIR,TFIELD%TIME,TZFMH,IRESP)
2458 #endif
2459        ELSE
2460           IF (ISP == TZFD%OWNER)  THEN
2461              TZFMH%GRID=KGRID
2462              TZFMH%COMMENT='YYYYMMDD'
2463              TZFMH%COMLEN=LEN_TRIM(TZFMH%COMMENT)
2464 #ifdef MNH_NCWRIT
2465                IF ( DEF_NC .AND. LLFIFM ) THEN
2466              CALL FM_WRIT_ll(TZFD%FLU,TRIM(HRECFM)//'%TDATE',.FALSE.,3,ITDATE&
2467                   & ,TZFMH,IRESP)
2468                END IF
2469 #else
2470              IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,TRIM(HRECFM)//'%TDATE',.FALSE.,3,ITDATE&
2471                   & ,TZFMH,IRESP)
2472              IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,TRIM(HRECFM)//'%TDATE',HDIR,ITDATE,TZFMH,IRESP)
2473 #endif
2474              TZFMH%COMMENT='SECONDS'
2475              TZFMH%COMLEN=LEN_TRIM(TZFMH%COMMENT)
2476 #ifdef MNH_NCWRIT
2477                IF ( DEF_NC .AND. LLFIFM ) THEN
2478              CALL FM_WRIT_ll(TZFD%FLU,TRIM(HRECFM)//'%TIME',.TRUE.,1,TFIELD%TIME&
2479                   & ,TZFMH,IRESP)
2480                END IF
2481 #else
2482
2483              IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,TRIM(HRECFM)//'%TIME',.TRUE.,1,TFIELD%TIME&
2484                   & ,TZFMH,IRESP)
2485              IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,TRIM(HRECFM)//'%TIME',HDIR,TFIELD%TIME,TZFMH,IRESP)
2486 #endif
2487           END IF
2488           !
2489           CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
2490        END IF
2491     ELSE 
2492        IRESP = -61
2493     END IF
2494     !----------------------------------------------------------------
2495     IF (IRESP.NE.0) THEN
2496        CALL FM_WRIT_ERR("FMWRITT0_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH&
2497             & ,IRESP)
2498     END IF
2499     KRESP = IRESP
2500   END SUBROUTINE FMWRITT0_ll
2501
2502   SUBROUTINE FMWRIT_LB(HFILEM,HRECFM,HFIPRI,HLBTYPE,PLB,KRIM,KL3D,&
2503        & KGRID,KLENCH,HCOMMENT,KRESP)
2504     USE MODD_IO_ll,        ONLY : ISP,ISNPROC,GSMONOPROC,LIOCDF4,LLFIOUT,LPACK,L2D
2505     USE MODD_PARAMETERS_ll,ONLY : JPHEXT
2506     USE MODD_FM
2507     USE MODE_DISTRIB_LB
2508     USE MODE_TOOLS_ll,     ONLY : GET_GLOBALDIMS_ll
2509     USE MODE_FD_ll,        ONLY : GETFD,JPFINL,FD_LL
2510     !
2511 !!!! MOD SB
2512 #ifdef MNH_NCWRIT
2513     USE MODD_NCOUT
2514     USE MODE_UTIL
2515 #endif
2516 !!!! MOD SB
2517     USE MODD_VAR_ll, ONLY : MNH_STATUSES_IGNORE
2518     !
2519     !*      0.1   Declarations of arguments
2520     !
2521     CHARACTER(LEN=*),       INTENT(IN) ::HFILEM ! file name
2522     CHARACTER(LEN=*),       INTENT(IN) ::HRECFM ! name of the article to be written
2523     CHARACTER(LEN=*),       INTENT(IN) ::HFIPRI ! file for prints in FM
2524     CHARACTER(LEN=*),       INTENT(IN) ::HLBTYPE! 'LBX','LBXU','LBY' or 'LBYV'
2525     REAL,DIMENSION(:,:,:),TARGET,INTENT(IN) ::PLB ! array containing the LB field
2526     INTEGER,                INTENT(IN) ::KRIM  ! size of the LB area
2527     INTEGER,                INTENT(IN) ::KL3D  ! size of the LB array in FM
2528     INTEGER,                INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
2529     INTEGER,                INTENT(IN) ::KLENCH ! length of comment string
2530     CHARACTER(LEN=*),       INTENT(IN) ::HCOMMENT ! comment string
2531     INTEGER,                INTENT(OUT)::KRESP  ! return-code
2532     !
2533     !*      0.2   Declarations of local variables
2534     !
2535     CHARACTER(LEN=JPFINL)                    :: YFNLFI
2536     INTEGER                                  :: IERR
2537     TYPE(FD_ll), POINTER                     :: TZFD
2538     INTEGER                                  :: IRESP
2539     REAL,DIMENSION(:,:,:),ALLOCATABLE,TARGET :: Z3D
2540     REAL,DIMENSION(:,:,:), POINTER           :: TX3DP
2541     TYPE(FMHEADER)                           :: TZFMH
2542     INTEGER                                  :: IIMAX_ll,IJMAX_ll
2543     INTEGER                                  :: JI
2544     INTEGER :: IIB,IIE,IJB,IJE
2545     INTEGER, DIMENSION(MPI_STATUS_SIZE) :: STATUS
2546     INTEGER,ALLOCATABLE,DIMENSION(:)    :: REQ_TAB
2547     INTEGER                           :: NB_REQ,IKU
2548     TYPE TX_3DP
2549        REAL,DIMENSION(:,:,:), POINTER    :: X
2550     END TYPE TX_3DP
2551     TYPE(TX_3DP),ALLOCATABLE,DIMENSION(:) :: T_TX3DP
2552     !
2553     !*      1.1   THE NAME OF LFIFM
2554     !
2555     IRESP = 0
2556     YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
2557     !print * , ' Writing Article LB ' , HRECFM
2558     IF (KL3D /= 2*(KRIM+JPHEXT)) THEN
2559        IRESP = -30
2560        GOTO 1000
2561     END IF
2562     !
2563     TZFD=>GETFD(YFNLFI)
2564 !    IF (ASSOCIATED(TZFD) .OR. .not.LLFIFM) THEN
2565     IF (ASSOCIATED(TZFD)) THEN
2566        IF (GSMONOPROC) THEN  ! sequential execution
2567           TZFMH%GRID=KGRID
2568           TZFMH%COMLEN=KLENCH
2569           TZFMH%COMMENT=HCOMMENT
2570           IF (LPACK .AND. L2D) THEN
2571              TX3DP=>PLB(:,JPHEXT+1:JPHEXT+1,:)
2572 #ifdef MNH_NCWRIT
2573                IF ( DEF_NC .AND. LLFIFM ) THEN
2574              CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(TX3DP),TX3DP,TZFMH,IRESP)
2575                END IF
2576 #else
2577              IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(TX3DP),TX3DP,TZFMH,IRESP)
2578              IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,'XY',TX3DP,TZFMH,IRESP)
2579 #endif
2580           ELSE
2581 #ifdef MNH_NCWRIT
2582                IF ( DEF_NC .AND. LLFIFM ) THEN
2583              CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PLB),PLB,TZFMH,IRESP)
2584                END IF
2585 #else
2586              IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PLB),PLB,TZFMH,IRESP)
2587              IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,'XY',PLB,TZFMH,IRESP)
2588 #endif
2589           END IF
2590        ELSE
2591           IF (ISP == TZFD%OWNER)  THEN
2592              ! I/O proc case
2593              CALL GET_GLOBALDIMS_ll(IIMAX_ll,IJMAX_ll)
2594              IF (HLBTYPE == 'LBX' .OR. HLBTYPE == 'LBXU') THEN 
2595                 ALLOCATE(Z3D((KRIM+JPHEXT)*2,IJMAX_ll+2*JPHEXT,SIZE(PLB,3)))
2596              ELSE ! HLBTYPE == 'LBY' .OR. HLBTYPE == 'LBYV' 
2597                 ALLOCATE(Z3D(IIMAX_ll+2*JPHEXT,(KRIM+JPHEXT)*2,SIZE(PLB,3)))
2598              END IF
2599              DO JI = 1,ISNPROC
2600                 CALL GET_DISTRIB_LB(HLBTYPE,JI,'FM','WRITE',KRIM,IIB,IIE,IJB,IJE)
2601                 IF (IIB /= 0) THEN
2602                    TX3DP=>Z3D(IIB:IIE,IJB:IJE,:)
2603                    IF (ISP /= JI) THEN
2604                       CALL MPI_RECV(TX3DP,SIZE(TX3DP),MPI_FLOAT,JI-1,99,TZFD%COMM,STATUS,IERR) 
2605                    ELSE
2606                       CALL GET_DISTRIB_LB(HLBTYPE,JI,'LOC','WRITE',KRIM,IIB,IIE,IJB,IJE)
2607                       TX3DP = PLB(IIB:IIE,IJB:IJE,:)
2608                    END IF
2609                 END IF
2610              END DO
2611              TZFMH%GRID=KGRID
2612              TZFMH%COMLEN=KLENCH
2613              TZFMH%COMMENT=HCOMMENT
2614              IF (LPACK .AND. L2D) THEN
2615                 TX3DP=>Z3D(:,2:2,:)
2616              ELSE
2617                 TX3DP=>Z3D
2618              END IF
2619 #ifdef MNH_NCWRIT
2620                IF ( DEF_NC .AND. LLFIFM ) THEN
2621              CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(TX3DP),TX3DP,TZFMH,IRESP)
2622                END IF
2623 #else
2624              IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(TX3DP),TX3DP,TZFMH,IRESP)
2625              IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,'XY',TX3DP,TZFMH,IRESP)
2626 #endif
2627           ELSE
2628              NB_REQ=0
2629              ALLOCATE(REQ_TAB(1))
2630              ALLOCATE(T_TX3DP(1))
2631              IKU = SIZE(PLB,3)
2632              ! Other processors
2633              CALL GET_DISTRIB_LB(HLBTYPE,ISP,'LOC','WRITE',KRIM,IIB,IIE,IJB,IJE)
2634              IF (IIB /= 0) THEN
2635                 TX3DP=>PLB(IIB:IIE,IJB:IJE,:)
2636                 NB_REQ = NB_REQ + 1
2637                 ALLOCATE(T_TX3DP(NB_REQ)%X(IIB:IIE,IJB:IJE,IKU))  
2638                 T_TX3DP(NB_REQ)%X=PLB(IIB:IIE,IJB:IJE,:)
2639                 CALL MPI_ISEND(T_TX3DP(NB_REQ)%X,SIZE(TX3DP),MPI_FLOAT,TZFD%OWNER-1,99,TZFD%COMM,REQ_TAB(NB_REQ),IERR)
2640                 !CALL MPI_BSEND(TX3DP,SIZE(TX3DP),MPI_FLOAT,TZFD%OWNER-1,99,TZFD%COMM,IERR)
2641              END IF
2642              IF (NB_REQ .GT.0 ) THEN
2643                 CALL MPI_WAITALL(NB_REQ,REQ_TAB,MNH_STATUSES_IGNORE,IERR)
2644                 DEALLOCATE(T_TX3DP(1)%X) 
2645              END IF
2646              DEALLOCATE(T_TX3DP,REQ_TAB)
2647           END IF
2648           !
2649           CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD&
2650                & %COMM,IERR)
2651        END IF !(GSMONOPROC)
2652     ELSE
2653        IRESP = -61
2654     END IF
2655     !----------------------------------------------------------------
2656 1000 CONTINUE
2657     IF (IRESP.NE.0) THEN
2658        CALL FM_WRIT_ERR("FMWRIT_LB",HFILEM,HFIPRI,HRECFM,HLBTYPE,KGRID,KLENCH,IRESP)
2659     END IF
2660     !
2661     IF (ALLOCATED(Z3D)) DEALLOCATE(Z3D)
2662     KRESP = IRESP
2663   END SUBROUTINE FMWRIT_LB
2664
2665   SUBROUTINE FMWRITBOXX2_ll(HFILEM,HRECFM,HFIPRI,HBUDGET,PFIELD,KGRID,&
2666        HCOMMENT,KXOBOX,KXEBOX,KYOBOX,KYEBOX,KRESP)
2667     USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
2668     USE MODD_FM
2669     USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
2670     USE MODE_GATHER_ll
2671     !
2672 !!!! MOD SB
2673 #ifdef MNH_NCWRIT
2674     USE MODD_NCOUT
2675     USE MODE_UTIL
2676 #endif
2677 !!!! MOD SB
2678     !
2679     !*      0.1   Declarations of arguments
2680     !
2681     CHARACTER(LEN=*),            INTENT(IN) ::HFILEM   ! FM-file name
2682     CHARACTER(LEN=*),            INTENT(IN) ::HRECFM   ! name of the article to write
2683     CHARACTER(LEN=*),            INTENT(IN) ::HFIPRI   ! output file for error messages
2684     CHARACTER(LEN=*),            INTENT(IN) ::HBUDGET  ! 'BUDGET' (budget)  or 'OTHER' (MesoNH field)
2685     REAL,DIMENSION(:,:),TARGET,  INTENT(IN) ::PFIELD   ! array containing the data field
2686     INTEGER,                     INTENT(IN) ::KGRID    ! C-grid indicator (u,v,w,T)
2687     CHARACTER(LEN=*),            INTENT(IN) ::HCOMMENT ! comment string
2688     INTEGER,                     INTENT(IN) ::KXOBOX   ! 
2689     INTEGER,                     INTENT(IN) ::KXEBOX   ! Global coordinates of the box
2690     INTEGER,                     INTENT(IN) ::KYOBOX   ! 
2691     INTEGER,                     INTENT(IN) ::KYEBOX   ! 
2692     INTEGER,                     INTENT(OUT)::KRESP    ! return-code 
2693     !
2694     !*      0.2   Declarations of local variables
2695     !
2696     CHARACTER(LEN=JPFINL)            :: YFNLFI
2697     INTEGER                          :: IERR
2698     TYPE(FD_ll), POINTER             :: TZFD
2699     INTEGER                          :: IRESP
2700     REAL,DIMENSION(:,:),POINTER      :: ZFIELDP
2701     TYPE(FMHEADER)                   :: TZFMH
2702     LOGICAL                          :: GALLOC
2703
2704     !
2705     !*      1.1   THE NAME OF LFIFM
2706     !
2707     IRESP = 0
2708     GALLOC = .FALSE.
2709     YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
2710     !print * , ' Writing Article BOXX2 ' , HRECFM
2711     !------------------------------------------------------------------
2712     TZFD=>GETFD(YFNLFI)
2713 !    IF (ASSOCIATED(TZFD) .OR. .not.LLFIFM) THEN
2714     IF (ASSOCIATED(TZFD)) THEN
2715        IF (GSMONOPROC) THEN ! sequential execution
2716           TZFMH%GRID    = KGRID
2717           TZFMH%COMLEN  = LEN_TRIM(HCOMMENT)
2718           TZFMH%COMMENT = HCOMMENT
2719           IF (HBUDGET /= 'BUDGET') THEN
2720              ! take the sub-section of PFIELD defined by the box
2721              ZFIELDP=>PFIELD(KXOBOX:KXEBOX,KYOBOX:KYEBOX)
2722           ELSE
2723              ! take the field as a budget
2724              ZFIELDP=>PFIELD
2725           END IF
2726 #ifdef MNH_NCWRIT
2727                IF ( DEF_NC .AND. LLFIFM ) THEN
2728           CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
2729                END IF
2730 #else
2731           IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
2732           IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,'XY',ZFIELDP,TZFMH,IRESP)
2733 #endif
2734        ELSE ! multiprocessor execution
2735           IF (ISP == TZFD%OWNER)  THEN
2736              ! Allocate the box
2737              ALLOCATE(ZFIELDP(KXEBOX-KXOBOX+1,KYEBOX-KYOBOX+1))
2738              GALLOC = .TRUE.
2739           ELSE
2740              ALLOCATE(ZFIELDP(0,0))
2741              GALLOC = .TRUE.
2742           END IF
2743           !
2744           CALL GATHER_XYFIELD(PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM,&
2745                & KXOBOX,KXEBOX,KYOBOX,KYEBOX,HBUDGET)
2746           !
2747           IF (ISP == TZFD%OWNER) THEN
2748              TZFMH%GRID    = KGRID
2749              TZFMH%COMLEN  = LEN_TRIM(HCOMMENT)
2750              TZFMH%COMMENT = HCOMMENT
2751 #ifdef MNH_NCWRIT
2752                IF ( DEF_NC .AND. LLFIFM ) THEN
2753              CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
2754                   & ,IRESP)
2755                END IF
2756 #else
2757              IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
2758                   & ,IRESP)
2759              IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,'XY',ZFIELDP,TZFMH,IRESP)
2760 #endif
2761           END IF
2762           !
2763           CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD&
2764                & %COMM,IERR)
2765        END IF ! multiprocessor execution
2766     ELSE
2767        IRESP = -61
2768     END IF
2769     !----------------------------------------------------------------
2770     IF (IRESP.NE.0) THEN
2771        CALL FM_WRIT_ERR("FMWRITBOXX2_ll",HFILEM,HFIPRI,HRECFM,'XY',KGRID,LEN(HCOMMENT),IRESP)
2772     END IF
2773     IF (GALLOC) DEALLOCATE(ZFIELDP)
2774     KRESP = IRESP
2775   END SUBROUTINE FMWRITBOXX2_ll
2776
2777   SUBROUTINE FMWRITBOXX3_ll(HFILEM,HRECFM,HFIPRI,HBUDGET,PFIELD,KGRID,&
2778        HCOMMENT,KXOBOX,KXEBOX,KYOBOX,KYEBOX,KRESP)
2779     USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
2780     USE MODD_FM
2781     USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
2782     USE MODE_GATHER_ll
2783     !
2784 !!!! MOD SB
2785 #ifdef MNH_NCWRIT
2786     USE MODD_NCOUT
2787     USE MODE_UTIL
2788 #endif
2789 !!!! MOD SB
2790     !
2791     !*      0.1   Declarations of arguments
2792     !
2793     CHARACTER(LEN=*),            INTENT(IN) ::HFILEM   ! FM-file name
2794     CHARACTER(LEN=*),            INTENT(IN) ::HRECFM   ! name of the article to write
2795     CHARACTER(LEN=*),            INTENT(IN) ::HFIPRI   ! output file for error messages
2796     CHARACTER(LEN=*),            INTENT(IN) ::HBUDGET  ! 'BUDGET' (budget)  or 'OTHER' (MesoNH field)
2797     REAL,DIMENSION(:,:,:),TARGET,INTENT(IN) ::PFIELD   ! array containing the data field
2798     INTEGER,                     INTENT(IN) ::KGRID    ! C-grid indicator (u,v,w,T)
2799     CHARACTER(LEN=*),            INTENT(IN) ::HCOMMENT ! comment string
2800     INTEGER,                     INTENT(IN) ::KXOBOX   ! 
2801     INTEGER,                     INTENT(IN) ::KXEBOX   ! Global coordinates of the box
2802     INTEGER,                     INTENT(IN) ::KYOBOX   ! 
2803     INTEGER,                     INTENT(IN) ::KYEBOX   ! 
2804     INTEGER,                     INTENT(OUT)::KRESP    ! return-code 
2805     !
2806     !*      0.2   Declarations of local variables
2807     !
2808     CHARACTER(LEN=JPFINL)               :: YFNLFI
2809     INTEGER                             :: IERR
2810     TYPE(FD_ll), POINTER                :: TZFD
2811     INTEGER                             :: IRESP
2812     REAL,DIMENSION(:,:,:),POINTER       :: ZFIELDP
2813     TYPE(FMHEADER)                      :: TZFMH
2814     LOGICAL                             :: GALLOC
2815
2816     !
2817     !*      1.1   THE NAME OF LFIFM
2818     !
2819     IRESP = 0
2820     GALLOC = .FALSE.
2821     YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
2822     !print * , ' Writing Article BOXX3 ' , HRECFM
2823     !------------------------------------------------------------------
2824     TZFD=>GETFD(YFNLFI)
2825 !    IF (ASSOCIATED(TZFD) .OR. .not.LLFIFM) THEN
2826     IF (ASSOCIATED(TZFD)) THEN
2827        IF (GSMONOPROC) THEN ! sequential execution
2828           TZFMH%GRID    = KGRID
2829           TZFMH%COMLEN  = LEN_TRIM(HCOMMENT)
2830           TZFMH%COMMENT = HCOMMENT
2831           IF (HBUDGET /= 'BUDGET') THEN
2832              ! take the sub-section of PFIELD defined by the box
2833              ZFIELDP=>PFIELD(KXOBOX:KXEBOX,KYOBOX:KYEBOX,:)
2834           ELSE
2835              ! take the field as a budget
2836              ZFIELDP=>PFIELD
2837           END IF
2838 #ifdef MNH_NCWRIT
2839                IF ( DEF_NC .AND. LLFIFM ) THEN
2840           CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
2841                END IF
2842 #else
2843           IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
2844           IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,'XY',ZFIELDP,TZFMH,IRESP)
2845 #endif
2846        ELSE ! multiprocessor execution
2847           IF (ISP == TZFD%OWNER)  THEN
2848              ! Allocate the box
2849              ALLOCATE(ZFIELDP(KXEBOX-KXOBOX+1,KYEBOX-KYOBOX+1,SIZE(PFIELD,3)))
2850              GALLOC = .TRUE.
2851           ELSE
2852              ALLOCATE(ZFIELDP(0,0,0))
2853              GALLOC = .TRUE.
2854           END IF
2855           !
2856           CALL GATHER_XYFIELD(PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM,&
2857                & KXOBOX,KXEBOX,KYOBOX,KYEBOX,HBUDGET)
2858           !
2859           IF (ISP == TZFD%OWNER)  THEN
2860              TZFMH%GRID    = KGRID
2861              TZFMH%COMLEN  = LEN_TRIM(HCOMMENT)
2862              TZFMH%COMMENT = HCOMMENT
2863 #ifdef MNH_NCWRIT
2864                IF ( DEF_NC .AND. LLFIFM ) THEN
2865              CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
2866                   & ,IRESP)
2867                END IF
2868 #else
2869              IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
2870                   & ,IRESP)
2871              IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,'XY',ZFIELDP,TZFMH,IRESP)
2872 #endif
2873           END IF
2874           !
2875           CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD&
2876                & %COMM,IERR)
2877        END IF ! multiprocessor execution
2878     ELSE
2879        IRESP = -61
2880     END IF
2881     !----------------------------------------------------------------
2882     IF (IRESP.NE.0) THEN
2883        CALL FM_WRIT_ERR("FMWRITBOXX3_ll",HFILEM,HFIPRI,HRECFM,'XY',KGRID,LEN(HCOMMENT),IRESP)
2884     END IF
2885     IF (GALLOC) DEALLOCATE(ZFIELDP)
2886     KRESP = IRESP
2887   END SUBROUTINE FMWRITBOXX3_ll
2888
2889   SUBROUTINE FMWRITBOXX4_ll(HFILEM,HRECFM,HFIPRI,HBUDGET,PFIELD,KGRID,&
2890        HCOMMENT,KXOBOX,KXEBOX,KYOBOX,KYEBOX,KRESP)
2891     USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
2892     USE MODD_FM
2893     USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
2894     USE MODE_GATHER_ll
2895     !
2896 !!!! MOD SB
2897 #ifdef MNH_NCWRIT
2898     USE MODD_NCOUT
2899     USE MODE_UTIL
2900 #endif
2901 !!!! MOD SB
2902     !
2903     !*      0.1   Declarations of arguments
2904     !
2905     CHARACTER(LEN=*),              INTENT(IN) ::HFILEM   ! FM-file name
2906     CHARACTER(LEN=*),              INTENT(IN) ::HRECFM   ! name of the article to write
2907     CHARACTER(LEN=*),              INTENT(IN) ::HFIPRI   ! output file for error messages
2908     CHARACTER(LEN=*),              INTENT(IN) ::HBUDGET  ! 'BUDGET' (budget)  or 'OTHER' (MesoNH field)
2909     REAL,DIMENSION(:,:,:,:),TARGET,INTENT(IN) ::PFIELD   ! array containing the data field
2910     INTEGER,                       INTENT(IN) ::KGRID    ! C-grid indicator (u,v,w,T)
2911     CHARACTER(LEN=*),              INTENT(IN) ::HCOMMENT ! comment string
2912     INTEGER,                       INTENT(IN) ::KXOBOX   ! 
2913     INTEGER,                       INTENT(IN) ::KXEBOX   ! Global coordinates of the box
2914     INTEGER,                       INTENT(IN) ::KYOBOX   ! 
2915     INTEGER,                       INTENT(IN) ::KYEBOX   ! 
2916     INTEGER,                       INTENT(OUT)::KRESP    ! return-code 
2917     !
2918     !*      0.2   Declarations of local variables
2919     !
2920     CHARACTER(LEN=JPFINL)               :: YFNLFI
2921     INTEGER                             :: IERR
2922     TYPE(FD_ll), POINTER                :: TZFD
2923     INTEGER                             :: IRESP
2924     REAL,DIMENSION(:,:,:,:),POINTER     :: ZFIELDP
2925     TYPE(FMHEADER)                      :: TZFMH
2926     LOGICAL                             :: GALLOC
2927
2928     !
2929     !*      1.1   THE NAME OF LFIFM
2930     !
2931     IRESP = 0
2932     GALLOC = .FALSE.
2933     YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
2934     !print * , ' Writing Article BOXX4 ' , HRECFM
2935     !------------------------------------------------------------------
2936     TZFD=>GETFD(YFNLFI)
2937 !    IF (ASSOCIATED(TZFD) .OR. .not.LLFIFM) THEN
2938     IF (ASSOCIATED(TZFD)) THEN
2939        IF (GSMONOPROC) THEN ! sequential execution
2940           TZFMH%GRID    = KGRID
2941           TZFMH%COMLEN  = LEN_TRIM(HCOMMENT)
2942           TZFMH%COMMENT = HCOMMENT
2943           IF (HBUDGET /= 'BUDGET') THEN
2944              ! take the sub-section of PFIELD defined by the box
2945              ZFIELDP=>PFIELD(KXOBOX:KXEBOX,KYOBOX:KYEBOX,:,:)
2946           ELSE
2947              ! take the field as a budget
2948              ZFIELDP=>PFIELD
2949           END IF
2950 #ifdef MNH_NCWRIT
2951                IF ( DEF_NC .AND. LLFIFM ) THEN
2952           CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
2953                END IF
2954 #else
2955           IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
2956           IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,'XY',ZFIELDP,TZFMH,IRESP)
2957 #endif
2958        ELSE ! multiprocessor execution
2959           IF (ISP == TZFD%OWNER)  THEN
2960              ! Allocate the box
2961              ALLOCATE(ZFIELDP(KXEBOX-KXOBOX+1,KYEBOX-KYOBOX+1,SIZE(PFIELD,3),SIZE(PFIELD,4)))
2962              GALLOC = .TRUE.
2963           ELSE
2964              ALLOCATE(ZFIELDP(0,0,0,0))
2965              GALLOC = .TRUE.
2966           END IF
2967           !
2968           CALL GATHER_XYFIELD(PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM,&
2969                & KXOBOX,KXEBOX,KYOBOX,KYEBOX,HBUDGET)
2970           !
2971           IF (ISP == TZFD%OWNER)  THEN
2972              TZFMH%GRID    = KGRID
2973              TZFMH%COMLEN  = LEN_TRIM(HCOMMENT)
2974              TZFMH%COMMENT = HCOMMENT
2975 #ifdef MNH_NCWRIT
2976                IF ( DEF_NC .AND. LLFIFM ) THEN
2977              CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
2978                   & ,IRESP)
2979                END IF
2980 #else
2981              IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
2982                   & ,IRESP)
2983              IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,'XY',ZFIELDP,TZFMH,IRESP)
2984 #endif
2985           END IF
2986           !
2987           CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD&
2988                & %COMM,IERR)
2989        END IF ! multiprocessor execution
2990     ELSE
2991        IRESP = -61
2992     END IF
2993     !----------------------------------------------------------------
2994     IF (IRESP.NE.0) THEN
2995        CALL FM_WRIT_ERR("FMWRITBOXX4_ll",HFILEM,HFIPRI,HRECFM,'XY',KGRID,LEN(HCOMMENT),IRESP)
2996     END IF
2997     IF (GALLOC) DEALLOCATE(ZFIELDP)
2998     KRESP = IRESP
2999   END SUBROUTINE FMWRITBOXX4_ll
3000
3001   SUBROUTINE FMWRITBOXX5_ll(HFILEM,HRECFM,HFIPRI,HBUDGET,PFIELD,KGRID,&
3002        HCOMMENT,KXOBOX,KXEBOX,KYOBOX,KYEBOX,KRESP)
3003     USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
3004     USE MODD_FM
3005     USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
3006     USE MODE_GATHER_ll
3007     !
3008 !!!! MOD SB
3009 #ifdef MNH_NCWRIT
3010     USE MODD_NCOUT
3011     USE MODE_UTIL
3012 #endif
3013 !!!! MOD SB
3014     !
3015     !*      0.1   Declarations of arguments
3016     !
3017     CHARACTER(LEN=*),              INTENT(IN) ::HFILEM   ! FM-file name
3018     CHARACTER(LEN=*),              INTENT(IN) ::HRECFM   ! name of the article to write
3019     CHARACTER(LEN=*),              INTENT(IN) ::HFIPRI   ! output file for error messages
3020     CHARACTER(LEN=*),              INTENT(IN) ::HBUDGET  ! 'BUDGET' (budget)  or 'OTHER' (MesoNH field)
3021     REAL,DIMENSION(:,:,:,:,:),TARGET,INTENT(IN) ::PFIELD   ! array containing the data field
3022     INTEGER,                       INTENT(IN) ::KGRID    ! C-grid indicator (u,v,w,T)
3023     CHARACTER(LEN=*),              INTENT(IN) ::HCOMMENT ! comment string
3024     INTEGER,                       INTENT(IN) ::KXOBOX   ! 
3025     INTEGER,                       INTENT(IN) ::KXEBOX   ! Global coordinates of the box
3026     INTEGER,                       INTENT(IN) ::KYOBOX   ! 
3027     INTEGER,                       INTENT(IN) ::KYEBOX   ! 
3028     INTEGER,                       INTENT(OUT)::KRESP    ! return-code 
3029     !
3030     !*      0.2   Declarations of local variables
3031     !
3032     CHARACTER(LEN=JPFINL)               :: YFNLFI
3033     INTEGER                             :: IERR
3034     TYPE(FD_ll), POINTER                :: TZFD
3035     INTEGER                             :: IRESP
3036     REAL,DIMENSION(:,:,:,:,:),POINTER   :: ZFIELDP
3037     TYPE(FMHEADER)                      :: TZFMH
3038     LOGICAL                             :: GALLOC
3039
3040     !
3041     !*      1.1   THE NAME OF LFIFM
3042     !
3043     IRESP = 0