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