Juan 24/05/2017: add MPPDB_CHECK on SURFEX routine for reprod check with MNH_PARALLEL key
[MNH-git_open_source-lfs.git] / src / SURFEX / zoom_pgd_isba.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_ISBA(HPROGRAM,HINIFILE,HINIFILETYPE,HFILE,HFILETYPE,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 !!    B. Decharme      2008  XWDRAIN
38 !!    M.Tomasini    17/04/12  Add interpolation for ISBA variables (MODD_DATA_ISBA_n)
39 !     M.Moge        05/02/15  MPPDB_CHECK
40 !----------------------------------------------------------------------------
41 !
42 !*    0.     DECLARATION
43 !            -----------
44 !
45 USE MODD_SURF_PAR, ONLY : XUNDEF
46 USE MODD_DATA_COVER_PAR, ONLY : JPCOVER
47 USE MODD_ISBA_n,         ONLY : NPATCH, NGROUND_LAYER, CISBA,            &
48                                   CPEDOTF, XCOVER, LCOVER, XZS,          &
49                                   XZ0EFFJPDIR, CPHOTO, NNBIOMASS,        &
50                                   XSAND, XCLAY, XRUNOFFB, XWDRAIN,       &
51                                   LECOCLIMAP, LTR_ML, XSOILGRID
52 USE MODD_ISBA_GRID_n,    ONLY : CGRID, XGRID_PAR, XLAT, XLON, XMESH_SIZE
53 USE MODD_ISBA_PAR,    ONLY : XOPTIMGRID
54 USE MODD_PREP,           ONLY : CINGRID_TYPE, CINTERP_TYPE
55 !
56 USE MODI_GET_LUOUT
57 USE MODI_OPEN_AUX_IO_SURF
58 USE MODI_READ_SURF
59 USE MODI_CLOSE_AUX_IO_SURF
60 USE MODI_GET_SURF_SIZE_n
61 USE MODI_PACK_PGD
62 USE MODI_ZOOM_PGD_ISBA_FULL
63 USE MODI_GET_AOS_n
64 USE MODI_GET_SSO_n
65 USE MODI_PACK_PGD_ISBA
66 !
67 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
68 USE PARKIND1  ,ONLY : JPRB
69 !
70 #ifdef MNH_PARALLEL
71 USE MODE_MPPDB
72 !
73 #endif
74 IMPLICIT NONE
75 !
76 !*    0.1    Declaration of dummy arguments
77 !            ------------------------------
78 !
79  CHARACTER(LEN=6),     INTENT(IN)  :: HPROGRAM    ! program calling
80  CHARACTER(LEN=28),    INTENT(IN)  :: HINIFILE    ! input atmospheric file name
81  CHARACTER(LEN=6),     INTENT(IN)  :: HINIFILETYPE! input atmospheric file type
82  CHARACTER(LEN=28),    INTENT(IN)  :: HFILE       ! output file name
83  CHARACTER(LEN=6),     INTENT(IN)  :: HFILETYPE   ! output file type
84 LOGICAL,              INTENT(IN)  :: OECOCLIMAP  ! flag to use ecoclimap
85 !
86 !
87 !*    0.2    Declaration of local variables
88 !            ------------------------------
89 !
90 INTEGER :: IVERSION, IBUGFIX
91 INTEGER :: IRESP
92 INTEGER :: ILUOUT
93 INTEGER :: IL      ! total 1D dimension (output grid, total surface)
94 INTEGER :: ILU     ! total 1D dimension (output grid, ISBA points only)
95 REAL, DIMENSION(:), ALLOCATABLE   :: ZAOSIP    ! A/S i+ on all surface points
96 REAL, DIMENSION(:), ALLOCATABLE   :: ZAOSIM    ! A/S i- on all surface points
97 REAL, DIMENSION(:), ALLOCATABLE   :: ZAOSJP    ! A/S j+ on all surface points
98 REAL, DIMENSION(:), ALLOCATABLE   :: ZAOSJM    ! A/S j- on all surface points
99 REAL, DIMENSION(:), ALLOCATABLE   :: ZHO2IP    ! h/2 i+ on all surface points
100 REAL, DIMENSION(:), ALLOCATABLE   :: ZHO2IM    ! h/2 i- on all surface points
101 REAL, DIMENSION(:), ALLOCATABLE   :: ZHO2JP    ! h/2 j+ on all surface points
102 REAL, DIMENSION(:), ALLOCATABLE   :: ZHO2JM    ! h/2 j- on all surface points
103 REAL, DIMENSION(:), ALLOCATABLE   :: ZSSO_SLOPE! subgrid slope on all surface points
104 REAL(KIND=JPRB) :: ZHOOK_HANDLE
105 !------------------------------------------------------------------------------
106 IF (LHOOK) CALL DR_HOOK('ZOOM_PGD_ISBA',0,ZHOOK_HANDLE)
107  CALL GET_LUOUT(HPROGRAM,ILUOUT)
108 !
109 !*      1.     Preparation of IO for reading in the file
110 !              -----------------------------------------
111 !
112 !* Note that all points are read, even those without physical meaning.
113 !  These points will not be used during the horizontal interpolation step.
114 !  Their value must be defined as XUNDEF.
115 !
116  CALL OPEN_AUX_IO_SURF(HINIFILE,HINIFILETYPE,'FULL  ')
117 !
118  CALL READ_SURF(HINIFILETYPE,'VERSION',IVERSION,IRESP)
119  CALL READ_SURF(HINIFILETYPE,'BUG',IBUGFIX,IRESP) 
120  CALL READ_SURF(HINIFILETYPE,'PATCH_NUMBER',NPATCH,IRESP)
121  CALL READ_SURF(HINIFILETYPE,'GROUND_LAYER',NGROUND_LAYER,IRESP)
122  CALL READ_SURF(HINIFILETYPE,'ISBA',CISBA,IRESP)
123 IF (IVERSION >= 7) THEN
124   CALL READ_SURF(HINIFILETYPE,'PEDOTF',CPEDOTF,IRESP)
125 ELSE
126   CPEDOTF = 'CH78'
127 ENDIF
128  CALL READ_SURF(HINIFILETYPE,'PHOTO',CPHOTO,IRESP)
129 !
130 IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=2) THEN
131   !
132   CALL READ_SURF(HINIFILETYPE,'TR_ML',LTR_ML,IRESP)
133   !
134 ELSE 
135   LTR_ML = .FALSE.
136 ENDIF
137 !
138 IF(CISBA=='DIF') THEN
139   ALLOCATE(XSOILGRID(NGROUND_LAYER))
140   XSOILGRID=XUNDEF
141   IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=2) THEN
142     CALL READ_SURF(HINIFILETYPE,'SOILGRID',XSOILGRID,IRESP,HDIR='-')
143   ELSE
144     XSOILGRID(1:NGROUND_LAYER)=XOPTIMGRID(1:NGROUND_LAYER)
145   ENDIF
146 ELSE
147   ALLOCATE(XSOILGRID(0))
148 ENDIF
149 !
150 !* number of biomass pools
151 !
152 IF (IVERSION>=6) THEN
153   CALL READ_SURF(HPROGRAM,'NBIOMASS',NNBIOMASS,IRESP)
154 ELSE
155   SELECT CASE (CPHOTO)
156     CASE ('AGS','LAI','AST','LST')
157       NNBIOMASS = 1
158     CASE ('NIT')
159       NNBIOMASS = 3
160     CASE ('NCB')
161       NNBIOMASS = 6
162   END SELECT
163 ENDIF
164 !
165  CALL CLOSE_AUX_IO_SURF(HINIFILE,HINIFILETYPE)
166 !
167 !------------------------------------------------------------------------------
168 LECOCLIMAP = OECOCLIMAP
169 !
170 !-------------------------------------------------------------------------------
171 !
172 !*    7.      Number of points and packing of general fields
173 !             ----------------------------------------------
174 !
175 !
176  CALL GET_SURF_SIZE_n('NATURE',ILU)
177 !
178 ALLOCATE(LCOVER     (JPCOVER))
179 ALLOCATE(XCOVER     (ILU,JPCOVER))
180 ALLOCATE(XZS        (ILU))
181 ALLOCATE(XLAT       (ILU))
182 ALLOCATE(XLON       (ILU))
183 ALLOCATE(XMESH_SIZE (ILU))
184 ALLOCATE(XZ0EFFJPDIR(ILU))
185 !
186  CALL PACK_PGD(HPROGRAM, 'NATURE',                    &
187                 CGRID,  XGRID_PAR,                     &
188                 LCOVER, XCOVER, XZS,                   &
189                 XLAT, XLON, XMESH_SIZE, XZ0EFFJPDIR    )  
190 #ifdef MNH_PARALLEL
191  CALL MPPDB_CHECK_SURFEX3D(XCOVER,"ZOOM_PGD_ISBA:XCOVER",PRECISION,ILUOUT,'NATURE',JPCOVER)
192  CALL MPPDB_CHECK_SURFEX2D(XLAT,"ZOOM_PGD_ISBA:XLAT",PRECISION,ILUOUT,'NATURE')
193  CALL MPPDB_CHECK_SURFEX2D(XLON,"ZOOM_PGD_ISBA:XLON",PRECISION,ILUOUT,'NATURE')
194  CALL MPPDB_CHECK_SURFEX2D(XMESH_SIZE,"ZOOM_PGD_ISBA:XMESH_SIZE",PRECISION,ILUOUT,'NATURE')
195  CALL MPPDB_CHECK_SURFEX2D(XZ0EFFJPDIR,"ZOOM_PGD_ISBA:XZ0EFFJPDIR",PRECISION,ILUOUT,'NATURE')
196 #endif
197 !
198 !------------------------------------------------------------------------------
199 !
200 !*      3.     Reading of sand, clay, runoffb, wdrain and interpolations
201 !              --------------------------------------------------
202 !
203 ALLOCATE(XSAND(ILU,NGROUND_LAYER))
204 ALLOCATE(XCLAY(ILU,NGROUND_LAYER))
205 ALLOCATE(XRUNOFFB(ILU))
206 ALLOCATE(XWDRAIN (ILU))
207  CALL ZOOM_PGD_ISBA_FULL(HPROGRAM,HINIFILE,HINIFILETYPE)
208 #ifdef MNH_PARALLEL
209  CALL MPPDB_CHECK_SURFEX3D(XSAND,"ZOOM_PGD_ISBA:XSAND",PRECISION,ILUOUT,'NATURE',NGROUND_LAYER)
210  CALL MPPDB_CHECK_SURFEX3D(XCLAY,"ZOOM_PGD_ISBA:XCLAY",PRECISION,ILUOUT,'NATURE',NGROUND_LAYER)
211  CALL MPPDB_CHECK_SURFEX2D(XRUNOFFB,"ZOOM_PGD_ISBA:XRUNOFFB",PRECISION,ILUOUT,'NATURE')
212  CALL MPPDB_CHECK_SURFEX2D(XWDRAIN,"ZOOM_PGD_ISBA:XWDRAIN",PRECISION,ILUOUT,'NATURE')
213 #endif
214 !
215 !-------------------------------------------------------------------------------
216 !
217 !*    8.      Packing of ISBA specific fields
218 !             -------------------------------
219 !
220  CALL GET_SURF_SIZE_n('FULL  ',IL)
221 !
222 ALLOCATE(ZAOSIP(IL))
223 ALLOCATE(ZAOSIM(IL))
224 ALLOCATE(ZAOSJP(IL))
225 ALLOCATE(ZAOSJM(IL))
226 ALLOCATE(ZHO2IP(IL))
227 ALLOCATE(ZHO2IM(IL))
228 ALLOCATE(ZHO2JP(IL))
229 ALLOCATE(ZHO2JM(IL))
230 ALLOCATE(ZSSO_SLOPE(IL))
231
232  CALL GET_AOS_n(HPROGRAM,IL,ZAOSIP,ZAOSIM,ZAOSJP,ZAOSJM,ZHO2IP,ZHO2IM,ZHO2JP,ZHO2JM)
233  CALL GET_SSO_n(HPROGRAM,IL,ZSSO_SLOPE)
234
235  CALL PACK_PGD_ISBA(HPROGRAM,                                    &
236                      ZAOSIP, ZAOSIM, ZAOSJP, ZAOSJM,              &
237                      ZHO2IP, ZHO2IM, ZHO2JP, ZHO2JM,              &
238                      ZSSO_SLOPE                                   )  
239 #ifdef MNH_PARALLEL
240  CALL MPPDB_CHECK_SURFEX2D(ZAOSIP,"ZOOM_PGD_ISBA:ZAOSIP",PRECISION,ILUOUT)
241  CALL MPPDB_CHECK_SURFEX2D(ZAOSIM,"ZOOM_PGD_ISBA:ZAOSIM",PRECISION,ILUOUT)
242  CALL MPPDB_CHECK_SURFEX2D(ZAOSJP,"ZOOM_PGD_ISBA:ZAOSJP",PRECISION,ILUOUT)
243  CALL MPPDB_CHECK_SURFEX2D(ZAOSJM,"ZOOM_PGD_ISBA:ZAOSJM",PRECISION,ILUOUT)
244  CALL MPPDB_CHECK_SURFEX2D(ZHO2IP,"ZOOM_PGD_ISBA:ZHO2IP",PRECISION,ILUOUT)
245  CALL MPPDB_CHECK_SURFEX2D(ZHO2IM,"ZOOM_PGD_ISBA:ZHO2IM",PRECISION,ILUOUT)
246  CALL MPPDB_CHECK_SURFEX2D(ZHO2JP,"ZOOM_PGD_ISBA:ZHO2JP",PRECISION,ILUOUT)
247  CALL MPPDB_CHECK_SURFEX2D(ZHO2JM,"ZOOM_PGD_ISBA:ZHO2JM",PRECISION,ILUOUT)
248  CALL MPPDB_CHECK_SURFEX2D(ZSSO_SLOPE,"ZOOM_PGD_ISBA:ZSSO_SLOPE",PRECISION,ILUOUT)
249 #endif
250 !
251 DEALLOCATE(ZAOSIP)
252 DEALLOCATE(ZAOSIM)
253 DEALLOCATE(ZAOSJP)
254 DEALLOCATE(ZAOSJM)
255 DEALLOCATE(ZHO2IP)
256 DEALLOCATE(ZHO2IM)
257 DEALLOCATE(ZHO2JP)
258 DEALLOCATE(ZHO2JM)
259 DEALLOCATE(ZSSO_SLOPE)
260 IF (LHOOK) CALL DR_HOOK('ZOOM_PGD_ISBA',1,ZHOOK_HANDLE)
261 !-------------------------------------------------------------------------------
262 !
263 END SUBROUTINE ZOOM_PGD_ISBA