b2a8fbfbe57702b05616b24bb9e9ab16ece27533
[MNH-git_open_source-lfs.git] / src / SURFEX / zoom_pgd_cover.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 ZOOM_PGD_COVER(HPROGRAM,HINIFILE,HINIFILETYPE,OECOCLIMAP)
7 !     ###########################################################
8
9 !!
10 !!    PURPOSE
11 !!    -------
12 !!   This program prepares the physiographic data fields.
13 !!
14 !!    METHOD
15 !!    ------
16 !!   
17 !!    EXTERNAL
18 !!    --------
19 !!
20 !!
21 !!    IMPLICIT ARGUMENTS
22 !!    ------------------
23 !!
24 !!
25 !!    REFERENCE
26 !!    ---------
27 !!
28 !!    AUTHOR
29 !!    ------
30 !!
31 !!    V. Masson                   Meteo-France
32 !!
33 !!    MODIFICATION
34 !!    ------------
35 !!
36 !!    Original     13/10/03
37 !     Modification 17/04/12 M.Tomasini All COVER physiographic fields are now 
38 !!                                     interpolated for spawning => 
39 !!                                     ABOR1_SFX if (.NOT.OECOCLIMAP) in comment
40 !     Modification 05/02/15 M.Moge : use NSIZE_FULL instead of SIZE(XLAT) (for clarity)
41 !!      J.Escobar 18/12/2015 : missing interface
42 !----------------------------------------------------------------------------
43 !
44 !*    0.     DECLARATION
45 !            -----------
46 !
47 USE MODD_DATA_COVER_PAR,   ONLY : JPCOVER
48 USE MODD_SURF_ATM_GRID_n,  ONLY : XLAT, XLON, CGRID, XGRID_PAR
49 USE MODD_SURF_ATM_n,       ONLY : XCOVER, LCOVER, XSEA, XWATER, XNATURE, XTOWN, &
50                                     NSIZE_NATURE, NSIZE_SEA, NR_NATURE, NR_SEA, &
51                                     NSIZE_TOWN, NSIZE_WATER,NR_TOWN,NR_WATER,NSIZE_FULL,&
52                                     NDIM_NATURE, NDIM_SEA,                  &
53                                     NDIM_TOWN,NDIM_WATER,NDIM_FULL  
54 USE MODD_PREP,             ONLY : CINGRID_TYPE, CINTERP_TYPE
55 !
56 USE MODI_CONVERT_COVER_FRAC
57 USE MODI_OPEN_AUX_IO_SURF
58 USE MODI_READ_SURF
59 USE MODI_CLOSE_AUX_IO_SURF
60 USE MODI_PREP_GRID_EXTERN
61 USE MODI_HOR_INTERPOL
62 USE MODI_HOR_INTERPOL_1COV
63 USE MODI_PREP_OUTPUT_GRID
64 USE MODI_OLD_NAME
65 USE MODI_SUM_ON_ALL_PROCS
66 USE MODI_GET_LUOUT
67 USE MODI_CLEAN_PREP_OUTPUT_GRID
68 USE MODI_GET_1D_MASK
69 USE MODI_READ_LCOVER
70 USE MODI_READ_SURFX2COV_1COV_MNH
71 !
72 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
73 USE PARKIND1  ,ONLY : JPRB
74 !
75 IMPLICIT NONE
76 !
77 !*    0.1    Declaration of dummy arguments
78 !            ------------------------------
79 !
80  CHARACTER(LEN=6),     INTENT(IN)  :: HPROGRAM    ! program calling
81  CHARACTER(LEN=28),    INTENT(IN)  :: HINIFILE    ! input atmospheric file name
82  CHARACTER(LEN=6),     INTENT(IN)  :: HINIFILETYPE! input atmospheric file type
83 LOGICAL,              INTENT(OUT) :: OECOCLIMAP  ! flag to use ecoclimap
84 !
85 !
86 !*    0.2    Declaration of local variables
87 !            ------------------------------
88 !
89 INTEGER :: IRESP
90 INTEGER :: ILUOUT
91 INTEGER :: INI     ! total 1D dimension (input grid)
92 INTEGER :: IL      ! total 1D dimension (output grid)
93 INTEGER :: JCOVER  ! loop counter
94 INTEGER :: IVERSION       ! surface version
95 #ifdef MNH_PARALLEL
96 REAL, DIMENSION(:), POINTER     :: ZCOVER
97 #else
98 REAL, DIMENSION(:,:), POINTER     :: ZCOVER
99 #endif
100 REAL, DIMENSION(:,:), POINTER :: ZSEA1, ZWATER1, ZNATURE1, ZTOWN1
101 REAL, DIMENSION(:,:), POINTER :: ZSEA2, ZWATER2, ZNATURE2, ZTOWN2
102 REAL, DIMENSION(:),   ALLOCATABLE :: ZSUM
103 CHARACTER(LEN=16) :: YRECFM         ! Name of the article to be read
104 CHARACTER(LEN=100) :: YCOMMENT
105 REAL(KIND=JPRB) :: ZHOOK_HANDLE
106 !------------------------------------------------------------------------------
107 IF (LHOOK) CALL DR_HOOK('ZOOM_PGD_COVER',0,ZHOOK_HANDLE)
108  CALL GET_LUOUT(HPROGRAM,ILUOUT)
109 !
110 !*      1.     Preparation of IO for reading in the file
111 !              -----------------------------------------
112 !
113 !* Note that all points are read, even those without physical meaning.
114 !  These points will not be used during the horizontal interpolation step.
115 !  Their value must be defined as XUNDEF.
116 !
117  CALL OPEN_AUX_IO_SURF(HINIFILE,HINIFILETYPE,'FULL  ')
118 !
119  CALL READ_SURF(HPROGRAM,'ECOCLIMAP',OECOCLIMAP,IRESP)
120 !
121 !------------------------------------------------------------------------------
122 !
123 !*      2.     Reading of grid
124 !              ---------------
125 !
126  CALL PREP_GRID_EXTERN(HINIFILETYPE,ILUOUT,CINGRID_TYPE,CINTERP_TYPE,INI)
127 !
128  CALL PREP_OUTPUT_GRID(ILUOUT,CGRID,XGRID_PAR,XLAT,XLON)
129 !
130 !------------------------------------------------------------------------------
131 !
132 !*      3.     Reading of cover
133 !              ----------------
134 !
135 YRECFM='VERSION'
136 CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP)
137 !
138 ALLOCATE(LCOVER(JPCOVER))
139 ALLOCATE(ZSEA1   (INI,1))
140 ALLOCATE(ZNATURE1(INI,1))
141 ALLOCATE(ZWATER1 (INI,1))
142 ALLOCATE(ZTOWN1  (INI,1))
143 !
144 IF (IVERSION>=7) THEN
145   CALL READ_SURF(HPROGRAM,'FRAC_SEA   ',ZSEA1(:,1),   IRESP,HDIR='A')
146   CALL READ_SURF(HPROGRAM,'FRAC_NATURE',ZNATURE1(:,1),IRESP,HDIR='A')
147   CALL READ_SURF(HPROGRAM,'FRAC_WATER ',ZWATER1(:,1), IRESP,HDIR='A')
148   CALL READ_SURF(HPROGRAM,'FRAC_TOWN  ',ZTOWN1(:,1),  IRESP,HDIR='A')
149   !
150   CALL OLD_NAME(HPROGRAM,'COVER_LIST      ',YRECFM)
151 !  CALL READ_SURF(HPROGRAM,YRECFM,LCOVER(:),IRESP,HDIR='-')
152   CALL READ_LCOVER(HPROGRAM,LCOVER)
153   !
154 #ifdef MNH_PARALLEL
155   ALLOCATE(ZCOVER(INI))
156 #else
157   ALLOCATE(ZCOVER(INI,JPCOVER))
158 #endif
159   !
160 ELSE
161 #ifdef MNH_PARALLEL
162   ! we assume that IVERSION>=7
163 #else
164   CALL OLD_NAME(HPROGRAM,'COVER_LIST      ',YRECFM)
165 !  CALL READ_SURF(HPROGRAM,YRECFM,LCOVER(:),IRESP,HDIR='-')
166   CALL READ_LCOVER(HPROGRAM,LCOVER)
167   !
168   ALLOCATE(ZCOVER(INI,JPCOVER))
169   CALL READ_SURF(HPROGRAM,YRECFM,ZCOVER(:,:),LCOVER,IRESP,HDIR='A')
170   !
171   CALL CONVERT_COVER_FRAC(ZCOVER,ZSEA1(:,1),ZNATURE1(:,1),ZTOWN1(:,1),ZWATER1(:,1))
172 #endif
173 ENDIF
174 !
175 !------------------------------------------------------------------------------
176 !
177 !*      4.     Reading of cover & Interpolations
178 !              --------------
179 !
180 IL = NSIZE_FULL
181 ALLOCATE(XCOVER(IL,JPCOVER))
182 ALLOCATE(ZSUM(IL))
183 ZSUM = 0.
184 !
185 ! on lit les cover une apres l'autre, et on appelle hor_interpol sur chaque cover separement
186 !
187 #ifdef MNH_PARALLEL
188 IF ( HPROGRAM == 'MESONH' ) THEN
189   DO JCOVER=1,JPCOVER
190     IF ( LCOVER( JCOVER ) ) THEN
191       CALL READ_SURFX2COV_1COV_MNH(YRECFM,INI,JCOVER,ZCOVER(:),IRESP,YCOMMENT,'A')
192     ELSE
193       ZCOVER(:) = 0.
194     ENDIF
195     !
196     CALL HOR_INTERPOL_1COV(ILUOUT,ZCOVER,XCOVER(:,JCOVER))
197     !
198     ZSUM(:) = ZSUM(:) + XCOVER(:,JCOVER)
199     !
200   ENDDO
201 ELSE
202   
203 ENDIF
204 #else
205  CALL HOR_INTERPOL(ILUOUT,ZCOVER,XCOVER)
206 #endif
207 !
208 !  Coherence check
209 !
210 DO JCOVER=1,JPCOVER
211   XCOVER(:,JCOVER) = XCOVER(:,JCOVER)/ZSUM(:)
212   IF (ALL(XCOVER(:,JCOVER)==0.)) LCOVER(JCOVER) = .FALSE.
213 END DO
214 !
215 CALL CLOSE_AUX_IO_SURF(HINIFILE,HINIFILETYPE)
216 !
217 !
218 DEALLOCATE(ZCOVER)
219 !
220 ALLOCATE(ZSEA2  (IL,1))
221 ALLOCATE(ZNATURE2(IL,1))
222 ALLOCATE(ZWATER2 (IL,1))
223 ALLOCATE(ZTOWN2  (IL,1))
224 !
225  CALL HOR_INTERPOL(ILUOUT,ZSEA1,ZSEA2)
226  CALL HOR_INTERPOL(ILUOUT,ZNATURE1,ZNATURE2)
227  CALL HOR_INTERPOL(ILUOUT,ZWATER1,ZWATER2)
228  CALL HOR_INTERPOL(ILUOUT,ZTOWN1,ZTOWN2)
229 !
230 DEALLOCATE(ZSEA1)
231 DEALLOCATE(ZNATURE1)
232 DEALLOCATE(ZWATER1)
233 DEALLOCATE(ZTOWN1)
234 !
235 ALLOCATE(XSEA   (IL))
236 ALLOCATE(XNATURE(IL))
237 ALLOCATE(XWATER (IL))
238 ALLOCATE(XTOWN  (IL))
239 !
240 XSEA(:)   = ZSEA2   (:,1)
241 XNATURE(:)= ZNATURE2(:,1)
242 XWATER(:) = ZWATER2 (:,1)
243 XTOWN(:)  = ZTOWN2  (:,1)
244 !
245 DEALLOCATE(ZSEA2)
246 DEALLOCATE(ZNATURE2)
247 DEALLOCATE(ZWATER2)
248 DEALLOCATE(ZTOWN2)
249 !
250  CALL CLEAN_PREP_OUTPUT_GRID
251 !------------------------------------------------------------------------------
252 !
253 !*      6.     Fractions
254 !              ---------
255 !
256 ! When the model runs in multiproc, NSIZE* represents the number of points
257 ! on a proc, and NDIM* the total number of points on all procs.
258 ! The following definition of NDIM* won't be correct any more when the PGD
259 ! runs in multiproc.
260 !
261 NSIZE_NATURE    = COUNT(XNATURE(:) > 0.0)
262 NSIZE_WATER     = COUNT(XWATER (:) > 0.0)
263 NSIZE_SEA       = COUNT(XSEA   (:) > 0.0)
264 NSIZE_TOWN      = COUNT(XTOWN  (:) > 0.0)
265 NSIZE_FULL      = IL
266 !
267 NDIM_NATURE    = SUM_ON_ALL_PROCS(HPROGRAM,CGRID,XNATURE(:) > 0., 'DIM')
268 NDIM_WATER     = SUM_ON_ALL_PROCS(HPROGRAM,CGRID,XWATER (:) > 0., 'DIM')
269 NDIM_SEA       = SUM_ON_ALL_PROCS(HPROGRAM,CGRID,XSEA   (:) > 0., 'DIM')
270 NDIM_TOWN      = SUM_ON_ALL_PROCS(HPROGRAM,CGRID,XTOWN  (:) > 0., 'DIM')
271 ZSUM=1.
272 NDIM_FULL      = SUM_ON_ALL_PROCS(HPROGRAM,CGRID,ZSUM   (:) ==1., 'DIM')
273 DEALLOCATE(ZSUM)
274 !
275 ALLOCATE(NR_NATURE (NSIZE_NATURE))
276 ALLOCATE(NR_TOWN   (NSIZE_TOWN  ))
277 ALLOCATE(NR_WATER  (NSIZE_WATER ))
278 ALLOCATE(NR_SEA    (NSIZE_SEA   ))
279 !
280 IF (NSIZE_SEA   >0)CALL GET_1D_MASK( NSIZE_SEA,    NSIZE_FULL, XSEA   , NR_SEA   )
281 IF (NSIZE_WATER >0)CALL GET_1D_MASK( NSIZE_WATER,  NSIZE_FULL, XWATER , NR_WATER )
282 IF (NSIZE_TOWN  >0)CALL GET_1D_MASK( NSIZE_TOWN,   NSIZE_FULL, XTOWN  , NR_TOWN  )
283 IF (NSIZE_NATURE>0)CALL GET_1D_MASK( NSIZE_NATURE, NSIZE_FULL, XNATURE, NR_NATURE)
284 IF (LHOOK) CALL DR_HOOK('ZOOM_PGD_COVER',1,ZHOOK_HANDLE)
285
286 !_______________________________________________________________________________
287 !
288 END SUBROUTINE ZOOM_PGD_COVER