SURFEX v8.1
General documentation of Surfex
read_lcover.F90
Go to the documentation of this file.
1 !SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
2 !SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
3 !SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
4 !SFX_LIC for details. version 1.
5 ! #########
6  SUBROUTINE read_lcover (HPROGRAM,OCOVER)
7 ! ################################
8 !
9 !!**** *READ_LCOVER* - routine to read a file for
10 !! physiographic data file of model _n
11 !!
12 !! PURPOSE
13 !! -------
14 !! The purpose of this routine is to initialise the list of covers
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 !! V. Masson *Meteo France*
35 !!
36 !! MODIFICATIONS
37 !! -------------
38 !! Original 10/2008
39 !! M. Moge 02/2015 parallelization for mésonh
40 !-------------------------------------------------------------------------------
41 !
42 !* 0. DECLARATIONS
43 ! ------------
44 !
45 !
46 !
47 !
48 USE modd_data_cover_par, ONLY : jpcover
49 !
51 USE modi_old_name
52 !
53 USE yomhook ,ONLY : lhook, dr_hook
54 USE parkind1 ,ONLY : jprb
55 !
56 IMPLICIT NONE
57 !
58 #ifdef MNH_PARALLEL
59 #ifndef NOMPI
60 include "mpif.h"
61 #endif
62 #endif
63 !
64 !* 0.1 Declarations of arguments
65 ! -------------------------
66 !
67 !
68 !
69  CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
70 LOGICAL, DIMENSION(JPCOVER) :: OCOVER ! list of covers
71 !
72 !* 0.2 Declarations of local variables
73 ! -------------------------------
74 !
75 LOGICAL, DIMENSION(:), ALLOCATABLE :: GCOVER ! cover list in the file
76  CHARACTER(LEN=12) :: YRECFM ! Name of the article to be read
77 INTEGER :: IVERSION ! version of surfex file being read
78 INTEGER :: IRESP ! Error code after redding
79 #ifdef MNH_PARALLEL
80 INTEGER :: IINFO
81 #endif
82 !
83 REAL(KIND=JPRB) :: ZHOOK_HANDLE
84 !-------------------------------------------------------------------------------
85 !
86 !
87 !* ascendant compatibility
88 IF (lhook) CALL dr_hook('READ_LCOVER',0,zhook_handle)
89 yrecfm='VERSION'
90  CALL read_surf(hprogram,yrecfm,iversion,iresp)
91 IF (iversion<=3) THEN
92  ALLOCATE(gcover(255))
93 ELSE
94  ALLOCATE(gcover(jpcover))
95 END IF
96  CALL old_name(hprogram,'COVER_LIST ',yrecfm)
97  CALL read_surf(hprogram,yrecfm,gcover(:),iresp,hdir='-')
98 !
99 ocover=.false.
100 ocover(:SIZE(gcover))=gcover(:)
101 !
102 #ifdef MNH_PARALLEL
103 #ifndef NOMPI
104  CALL mpi_allreduce(gcover, ocover, SIZE(gcover),mpi_logical, mpi_lor, mpi_comm_world, iinfo)
105 #endif
106 #endif
107 !
108 DEALLOCATE(gcover)
109 IF (lhook) CALL dr_hook('READ_LCOVER',1,zhook_handle)
110 !
111 !-------------------------------------------------------------------------------
112 !
113 END SUBROUTINE read_lcover
subroutine old_name(HPROGRAM, HRECIN, HRECOUT, HDIR)
Definition: old_name.F90:7
integer, parameter jprb
Definition: parkind1.F90:32
subroutine read_lcover(HPROGRAM, OCOVER)
Definition: read_lcover.F90:7
logical lhook
Definition: yomhook.F90:15