ccfde1187b6ca5189711b12798e42bfda207f732
[MNH-git_open_source-lfs.git] / src / SURFEX / write_lcover.F90
1 !SURFEX_LIC Copyright 1994-2014 Meteo-France 
2 !SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C  licence
3 !SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
4 !SURFEX_LIC for details. version 1.
5 !     #########
6       SUBROUTINE WRITE_LCOVER(HPROGRAM,OCOVER)
7 !     ################################
8 !
9 !!****  *READ_LCOVER* - routine to write a file for
10 !!                         physiographic data file of model _n 
11 !!
12 !!    PURPOSE
13 !!    -------
14 !!       The purpose of this routine is to write the list of covers to a file in parallel using MPI
15 !!
16 !!
17 !!**  METHOD
18 !!    ------
19 !!
20 !!    EXTERNAL
21 !!    --------
22 !!      
23 !!
24 !!
25 !!    IMPLICIT ARGUMENTS
26 !!    ------------------
27 !!
28 !!    REFERENCE
29 !!    ---------
30 !!
31 !!
32 !!    AUTHOR
33 !!    ------
34 !!      M. Moge   *LA - CNRS*   
35 !!
36 !!    MODIFICATIONS
37 !!    -------------
38 !!
39 !-------------------------------------------------------------------------------
40 !
41 !*       0.    DECLARATIONS
42 !              ------------
43 !
44 USE MODD_DATA_COVER_PAR, ONLY : JPCOVER
45 !USE MODD_WATFLUX_n,      ONLY : LCOVER
46 !
47 USE MODI_WRITE_SURF
48 !
49 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
50 USE PARKIND1  ,ONLY : JPRB
51 !
52 IMPLICIT NONE
53 !
54 #ifndef NOMPI
55 INCLUDE "mpif.h"
56 #endif
57 !
58 !*       0.1   Declarations of arguments
59 !              -------------------------
60 !
61  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! calling program
62 LOGICAL, DIMENSION(JPCOVER)    :: OCOVER   ! list of covers
63 !
64 !*       0.2   Declarations of local variables
65 !              -------------------------------
66 !
67 INTEGER           :: IRESP          ! Error code after reading
68 CHARACTER(LEN=12) :: YRECFM         ! Name of the article to be read
69 CHARACTER(LEN=100):: YCOMMENT       ! Comment string
70 LOGICAL, DIMENSION(JPCOVER)    :: GCOVER   ! tmp list of covers
71 REAL(KIND=JPRB) :: ZHOOK_HANDLE
72 INTEGER   :: IINFO
73 !-------------------------------------------------------------------------------
74 !
75 !
76 !* ascendant compatibility
77 IF (LHOOK) CALL DR_HOOK('WRITE_LCOVER',0,ZHOOK_HANDLE)
78 #ifndef NOMPI
79 CALL MPI_ALLREDUCE(OCOVER, GCOVER, SIZE(OCOVER),MPI_LOGICAL, MPI_LOR, MPI_COMM_WORLD, IINFO)
80 #endif
81 OCOVER(:)=GCOVER(:)
82 YRECFM='COVER_LIST'
83 YCOMMENT='(LOGICAL LIST)'
84 CALL WRITE_SURF(HPROGRAM,YRECFM,OCOVER(:),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
85 !
86 IF (LHOOK) CALL DR_HOOK('WRITE_LCOVER',1,ZHOOK_HANDLE)
87 !
88 !-------------------------------------------------------------------------------
89 !
90 END SUBROUTINE WRITE_LCOVER