Philippe 07/03/2019: IO bugfix: io_set_mnhversion must be called by all the processes
[MNH-git_open_source-lfs.git] / src / SURFEX / zoom_pgd_isba.F90
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 ZOOM_PGD_ISBA (CHI, MSF, DTCO, DTV, IG, IO, S, K, ISS, UG, U, USS, GCP, &
7                                 HPROGRAM,HINIFILE,HINIFILETYPE,HFILE,HFILETYPE,OECOCLIMAP)
8 !     ###########################################################
9
10 !!
11 !!    PURPOSE
12 !!    -------
13 !!   This program prepares the physiographic data fields.
14 !!
15 !!    METHOD
16 !!    ------
17 !!   
18 !!    EXTERNAL
19 !!    --------
20 !!
21 !!
22 !!    IMPLICIT ARGUMENTS
23 !!    ------------------
24 !!
25 !!
26 !!    REFERENCE
27 !!    ---------
28 !!
29 !!    AUTHOR
30 !!    ------
31 !!
32 !!    V. Masson                   Meteo-France
33 !!
34 !!    MODIFICATION
35 !!    ------------
36 !!
37 !!    Original     13/10/03
38 !!    B. Decharme      2008  XWDRAIN
39 !!    M.Tomasini    17/04/12  Add interpolation for ISBA variables (MODD_DATA_ISBA_n)
40 !----------------------------------------------------------------------------
41 !
42 !*    0.     DECLARATION
43 !            -----------
44 !
45 USE MODD_CH_ISBA_n, ONLY : CH_ISBA_t
46 USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
47 USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
48 USE MODD_SFX_GRID_n, ONLY : GRID_t
49 USE MODD_SSO_n, ONLY : SSO_t
50 USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t
51 USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
52 USE MODD_ISBA_n, ONLY : ISBA_S_t, ISBA_K_t
53 USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
54 USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
55 USE MODD_SSO_n, ONLY : SSO_t
56 USE MODD_MEGAN_SURF_FIELDS_n, ONLY : MEGAN_SURF_FIELDS_t
57 !
58 USE MODD_SURF_PAR, ONLY : XUNDEF
59 USE MODD_DATA_COVER_PAR, ONLY : JPCOVER
60 USE MODD_ISBA_PAR,    ONLY : XOPTIMGRID
61 USE MODD_PREP,           ONLY : CINGRID_TYPE, CINTERP_TYPE
62 !
63 USE MODI_GET_LUOUT
64 USE MODI_OPEN_AUX_IO_SURF
65 USE MODI_READ_SURF
66 USE MODI_CLOSE_AUX_IO_SURF
67 USE MODI_GET_SURF_SIZE_n
68 USE MODI_PACK_PGD
69 USE MODI_ZOOM_PGD_ISBA_FULL
70 USE MODI_GET_AOS_n
71 USE MODI_GET_SSO_n
72 USE MODI_PACK_PGD_ISBA
73 !
74 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
75 USE PARKIND1  ,ONLY : JPRB
76 !
77 #ifdef MNH_PARALLEL
78 USE MODE_MPPDB
79 !
80 #endif
81 IMPLICIT NONE
82 !
83 !*    0.1    Declaration of dummy arguments
84 !            ------------------------------
85 !
86 !
87 TYPE(CH_ISBA_t), INTENT(INOUT) :: CHI
88 TYPE(MEGAN_SURF_FIELDS_t), INTENT(INOUT) :: MSF
89 TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
90 TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTV
91 TYPE(GRID_t), INTENT(INOUT) :: IG
92 TYPE(SSO_t), INTENT(INOUT) :: ISS
93 TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
94 TYPE(ISBA_S_t), INTENT(INOUT) :: S
95 TYPE(ISBA_K_t), INTENT(INOUT) :: K
96 TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
97 TYPE(SURF_ATM_t), INTENT(INOUT) :: U
98 TYPE(SSO_t), INTENT(INOUT) :: USS
99 TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
100 !
101  CHARACTER(LEN=6),     INTENT(IN)  :: HPROGRAM    ! program calling
102  CHARACTER(LEN=28),    INTENT(IN)  :: HINIFILE    ! input atmospheric file name
103  CHARACTER(LEN=6),     INTENT(IN)  :: HINIFILETYPE! input atmospheric file type
104  CHARACTER(LEN=28),    INTENT(IN)  :: HFILE       ! output file name
105  CHARACTER(LEN=6),     INTENT(IN)  :: HFILETYPE   ! output file type
106 LOGICAL,              INTENT(IN)  :: OECOCLIMAP  ! flag to use ecoclimap
107 !
108 !
109 !*    0.2    Declaration of local variables
110 !            ------------------------------
111 !
112 INTEGER                           :: ISIZE_LMEB_PATCH
113 INTEGER :: IVERSION, IBUGFIX
114 INTEGER :: IRESP
115 INTEGER :: ILUOUT
116 INTEGER :: IL      ! total 1D dimension (output grid, total surface)
117 INTEGER :: ILU     ! total 1D dimension (output grid, ISBA points only)
118 REAL, DIMENSION(:), ALLOCATABLE   :: ZAOSIP    ! A/S i+ on all surface points
119 REAL, DIMENSION(:), ALLOCATABLE   :: ZAOSIM    ! A/S i- on all surface points
120 REAL, DIMENSION(:), ALLOCATABLE   :: ZAOSJP    ! A/S j+ on all surface points
121 REAL, DIMENSION(:), ALLOCATABLE   :: ZAOSJM    ! A/S j- on all surface points
122 REAL, DIMENSION(:), ALLOCATABLE   :: ZHO2IP    ! h/2 i+ on all surface points
123 REAL, DIMENSION(:), ALLOCATABLE   :: ZHO2IM    ! h/2 i- on all surface points
124 REAL, DIMENSION(:), ALLOCATABLE   :: ZHO2JP    ! h/2 j+ on all surface points
125 REAL, DIMENSION(:), ALLOCATABLE   :: ZHO2JM    ! h/2 j- on all surface points
126 REAL, DIMENSION(:), ALLOCATABLE   :: ZSSO_SLOPE! subgrid slope on all surface points
127 REAL(KIND=JPRB) :: ZHOOK_HANDLE
128 !------------------------------------------------------------------------------
129 IF (LHOOK) CALL DR_HOOK('ZOOM_PGD_ISBA',0,ZHOOK_HANDLE)
130  CALL GET_LUOUT(HPROGRAM,ILUOUT)
131 !
132 !*      1.     Preparation of IO for reading in the file
133 !              -----------------------------------------
134 !
135 !* Note that all points are read, even those without physical meaning.
136 !  These points will not be used during the horizontal interpolation step.
137 !  Their value must be defined as XUNDEF.
138 !
139  CALL OPEN_AUX_IO_SURF(HINIFILE,HINIFILETYPE,'FULL  ')
140 !
141  CALL READ_SURF(HINIFILETYPE,'VERSION',IVERSION,IRESP)
142  CALL READ_SURF(HINIFILETYPE,'BUG',IBUGFIX,IRESP) 
143  CALL READ_SURF(HINIFILETYPE,'PATCH_NUMBER',IO%NPATCH,IRESP)
144 !
145 ALLOCATE(IO%LMEB_PATCH(IO%NPATCH))
146 !
147 IF (IVERSION>=8) THEN
148   !
149   CALL READ_SURF(HINIFILETYPE,'MEB_PATCH',IO%LMEB_PATCH(:),IRESP,HDIR='-')
150   ISIZE_LMEB_PATCH = COUNT(IO%LMEB_PATCH(:))
151   !
152   IF (ISIZE_LMEB_PATCH>0)THEN
153     CALL READ_SURF(HINIFILETYPE,'FORC_MEASURE',IO%LFORC_MEASURE,IRESP)
154     CALL READ_SURF(HINIFILETYPE,'MEB_LITTER',IO%LMEB_LITTER,IRESP)
155     CALL READ_SURF(HINIFILETYPE,'MEB_GNDRES',IO%LMEB_GNDRES,IRESP)
156   ELSE      
157     IO%LFORC_MEASURE = .FALSE.
158     IO%LMEB_LITTER   = .FALSE.
159     IO%LMEB_GNDRES   = .FALSE.    
160   ENDIF
161   !
162 ELSE
163   IO%LMEB_PATCH(:)= .FALSE.
164   IO%LFORC_MEASURE= .FALSE.
165   IO%LMEB_LITTER  = .FALSE.
166   IO%LMEB_GNDRES  = .FALSE.
167 ENDIF
168 !
169 !
170  CALL READ_SURF(HINIFILETYPE,'GROUND_LAYER',IO%NGROUND_LAYER,IRESP)
171  CALL READ_SURF(HINIFILETYPE,'ISBA',IO%CISBA,IRESP)
172 IF (IVERSION >= 7) THEN
173   CALL READ_SURF(HINIFILETYPE,'PEDOTF',IO%CPEDOTF,IRESP)
174 ELSE
175   IO%CPEDOTF = 'CH78'
176 ENDIF
177  CALL READ_SURF(HINIFILETYPE,'PHOTO',IO%CPHOTO,IRESP)
178 !
179 IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=2) THEN
180   !
181   CALL READ_SURF(HINIFILETYPE,'TR_ML',IO%LTR_ML,IRESP)
182   !
183 ELSE 
184   IO%LTR_ML = .FALSE.
185 ENDIF
186 !
187 IF(IO%CISBA=='DIF') THEN
188   ALLOCATE(IO%XSOILGRID(IO%NGROUND_LAYER))
189   IO%XSOILGRID=XUNDEF
190   IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=2) THEN
191     CALL READ_SURF(HINIFILETYPE,'SOILGRID',IO%XSOILGRID,IRESP,HDIR='-')
192   ELSE
193     IO%XSOILGRID(1:IO%NGROUND_LAYER)=XOPTIMGRID(1:IO%NGROUND_LAYER)
194   ENDIF
195 ELSE
196   ALLOCATE(IO%XSOILGRID(0))
197 ENDIF
198 !
199 !* number of biomass pools
200 !
201 IF (IVERSION>=6) THEN
202   CALL READ_SURF(HPROGRAM,'NBIOMASS',IO%NNBIOMASS,IRESP)
203 ELSE
204   SELECT CASE (IO%CPHOTO)
205     CASE ('AST')
206       IO%NNBIOMASS = 1
207     CASE ('NIT')
208       IO%NNBIOMASS = 3
209     CASE ('NCB')
210       IO%NNBIOMASS = 6
211   END SELECT
212 ENDIF
213 !
214  CALL CLOSE_AUX_IO_SURF(HINIFILE,HINIFILETYPE)
215 !
216 !------------------------------------------------------------------------------
217 IO%LECOCLIMAP = OECOCLIMAP
218 !
219 MSF%NMEGAN_NBR = 0
220 !
221 !-------------------------------------------------------------------------------
222 !
223 !*    7.      Number of points and packing of general fields
224 !             ----------------------------------------------
225 !
226 !
227  CALL GET_SURF_SIZE_n(DTCO, U,'NATURE',ILU)
228 !
229 ALLOCATE(S%LCOVER     (JPCOVER))
230 ALLOCATE(S%XZS        (ILU))
231 ALLOCATE(IG%XLAT       (ILU))
232 ALLOCATE(IG%XLON       (ILU))
233 ALLOCATE(IG%XMESH_SIZE (ILU))
234 ALLOCATE(ISS%XZ0EFFJPDIR(ILU))
235 !
236  CALL PACK_PGD(DTCO, U,  HPROGRAM, 'NATURE', IG, S%LCOVER, S%XCOVER, S%XZS  )  
237 !
238 #ifdef MNH_PARALLEL
239  CALL MPPDB_CHECK_SURFEX3D(S%XCOVER,"ZOOM_PGD_ISBA:XCOVER",PRECISION,ILUOUT,'NATURE',SIZE(S%XCOVER,2))
240  CALL MPPDB_CHECK_SURFEX2D(IG%XLAT,"ZOOM_PGD_ISBA:XLAT",PRECISION,ILUOUT,'NATURE')
241  CALL MPPDB_CHECK_SURFEX2D(IG%XLON,"ZOOM_PGD_ISBA:XLON",PRECISION,ILUOUT,'NATURE')
242  CALL MPPDB_CHECK_SURFEX2D(IG%XMESH_SIZE,"ZOOM_PGD_ISBA:XMESH_SIZE",PRECISION,ILUOUT,'NATURE')
243  CALL MPPDB_CHECK_SURFEX2D(ISS%XZ0EFFJPDIR,"ZOOM_PGD_ISBA:XZ0EFFJPDIR",PRECISION,ILUOUT,'NATURE') 
244 #endif
245 !------------------------------------------------------------------------------
246 !
247 !*      3.     Reading of sand, clay, runoffb, wdrain and interpolations
248 !              --------------------------------------------------
249 !
250 ALLOCATE(K%XSAND(ILU,IO%NGROUND_LAYER))
251 ALLOCATE(K%XCLAY(ILU,IO%NGROUND_LAYER))
252 ALLOCATE(K%XRUNOFFB(ILU))
253 ALLOCATE(K%XWDRAIN (ILU))
254  CALL ZOOM_PGD_ISBA_FULL(CHI, DTCO, DTV, IG, IO, S, K, UG, U, GCP, &
255                          HPROGRAM,HINIFILE,HINIFILETYPE)
256 !
257 #ifdef MNH_PARALLEL
258  CALL MPPDB_CHECK_SURFEX3D(K%XSAND,"ZOOM_PGD_ISBA:XSAND",PRECISION,ILUOUT,'NATURE',IO%NGROUND_LAYER)
259  CALL MPPDB_CHECK_SURFEX3D(K%XCLAY,"ZOOM_PGD_ISBA:XCLAY",PRECISION,ILUOUT,'NATURE',IO%NGROUND_LAYER)
260  CALL MPPDB_CHECK_SURFEX2D(K%XRUNOFFB,"ZOOM_PGD_ISBA:XRUNOFFB",PRECISION,ILUOUT,'NATURE')
261  CALL MPPDB_CHECK_SURFEX2D(K%XWDRAIN,"ZOOM_PGD_ISBA:XWDRAIN",PRECISION,ILUOUT,'NATURE')
262 #endif
263 !-------------------------------------------------------------------------------
264 !
265 !*    8.      Packing of ISBA specific fields
266 !             -------------------------------
267 !
268  CALL GET_SURF_SIZE_n(DTCO, U, 'FULL  ',IL)
269 !
270 ALLOCATE(ZAOSIP(IL))
271 ALLOCATE(ZAOSIM(IL))
272 ALLOCATE(ZAOSJP(IL))
273 ALLOCATE(ZAOSJM(IL))
274 ALLOCATE(ZHO2IP(IL))
275 ALLOCATE(ZHO2IM(IL))
276 ALLOCATE(ZHO2JP(IL))
277 ALLOCATE(ZHO2JM(IL))
278 ALLOCATE(ZSSO_SLOPE(IL))
279
280  CALL GET_AOS_n(USS,HPROGRAM,IL,ZAOSIP,ZAOSIM,ZAOSJP,ZAOSJM,ZHO2IP,ZHO2IM,ZHO2JP,ZHO2JM)
281  CALL GET_SSO_n(USS,HPROGRAM,IL,ZSSO_SLOPE)
282
283  CALL PACK_PGD_ISBA(DTCO, IG%NDIM, ISS, U, HPROGRAM,              &
284                      ZAOSIP, ZAOSIM, ZAOSJP, ZAOSJM,              &
285                      ZHO2IP, ZHO2IM, ZHO2JP, ZHO2JM,              &
286                      ZSSO_SLOPE                                   )  
287 !
288 #ifdef MNH_PARALLEL
289  CALL MPPDB_CHECK_SURFEX2D(ZAOSIP,"ZOOM_PGD_ISBA:ZAOSIP",PRECISION,ILUOUT)
290  CALL MPPDB_CHECK_SURFEX2D(ZAOSIM,"ZOOM_PGD_ISBA:ZAOSIM",PRECISION,ILUOUT)
291  CALL MPPDB_CHECK_SURFEX2D(ZAOSJP,"ZOOM_PGD_ISBA:ZAOSJP",PRECISION,ILUOUT)
292  CALL MPPDB_CHECK_SURFEX2D(ZAOSJM,"ZOOM_PGD_ISBA:ZAOSJM",PRECISION,ILUOUT)
293  CALL MPPDB_CHECK_SURFEX2D(ZHO2IP,"ZOOM_PGD_ISBA:ZHO2IP",PRECISION,ILUOUT)
294  CALL MPPDB_CHECK_SURFEX2D(ZHO2IM,"ZOOM_PGD_ISBA:ZHO2IM",PRECISION,ILUOUT)
295  CALL MPPDB_CHECK_SURFEX2D(ZHO2JP,"ZOOM_PGD_ISBA:ZHO2JP",PRECISION,ILUOUT)
296  CALL MPPDB_CHECK_SURFEX2D(ZHO2JM,"ZOOM_PGD_ISBA:ZHO2JM",PRECISION,ILUOUT)
297  CALL MPPDB_CHECK_SURFEX2D(ZSSO_SLOPE,"ZOOM_PGD_ISBA:ZSSO_SLOPE",PRECISION,ILUOUT)
298 #endif
299 !
300 DEALLOCATE(ZAOSIP)
301 DEALLOCATE(ZAOSIM)
302 DEALLOCATE(ZAOSJP)
303 DEALLOCATE(ZAOSJM)
304 DEALLOCATE(ZHO2IP)
305 DEALLOCATE(ZHO2IM)
306 DEALLOCATE(ZHO2JP)
307 DEALLOCATE(ZHO2JM)
308 DEALLOCATE(ZSSO_SLOPE)
309 IF (LHOOK) CALL DR_HOOK('ZOOM_PGD_ISBA',1,ZHOOK_HANDLE)
310 !-------------------------------------------------------------------------------
311 !
312 END SUBROUTINE ZOOM_PGD_ISBA