Juan 8/12/2016: add management of LEN_HREC in MNH & SURFEX
[MNH-git_open_source-lfs.git] / src / SURFEX / prep_isba_extern.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 PREP_ISBA_EXTERN(HPROGRAM,HSURF,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,KLUOUT,PFIELD)
7 !     #################################################################################
8 !
9 !!****  *PREP_ISBA_EXTERN* - initializes ISBA fields from operational GRIB
10 !!
11 !!    PURPOSE
12 !!    -------
13 !
14 !!**  METHOD
15 !!    ------
16 !!
17 !!    REFERENCE
18 !!    ---------
19 !!      
20 !!
21 !!    AUTHOR
22 !!    ------
23 !!     V. Masson 
24 !!
25 !!    MODIFICATIONS
26 !!    -------------
27 !!      Original    01/2004
28 !!        M.Moge    01/2016  using READ_SURF_FIELD2D for 2D surfex fields reads
29 !!------------------------------------------------------------------
30 !
31
32 !
33 USE MODE_READ_EXTERN
34 !
35 USE MODD_TYPE_DATE_SURF
36 !
37 USE MODI_PREP_GRID_EXTERN
38 USE MODI_READ_SURF
39 USE MODI_INTERP_GRID
40 USE MODI_OPEN_AUX_IO_SURF
41 USE MODI_CLOSE_AUX_IO_SURF
42 !
43 USE MODD_PREP,           ONLY : CINGRID_TYPE, CINTERP_TYPE
44 USE MODD_PREP_ISBA,      ONLY : XGRID_SOIL, XWR_DEF
45 USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE
46 USE MODD_SURF_PAR,       ONLY : XUNDEF
47 !
48 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
49 USE PARKIND1  ,ONLY : JPRB
50 !
51 USE MODI_PUT_ON_ALL_VEGTYPES
52 !
53 USE MODI_READ_SURF_FIELD2D
54 !
55 IMPLICIT NONE
56 !
57 !*      0.1    declarations of arguments
58 !
59  CHARACTER(LEN=6),   INTENT(IN)  :: HPROGRAM  ! program calling surf. schemes
60  CHARACTER(LEN=7),   INTENT(IN)  :: HSURF     ! type of field
61  CHARACTER(LEN=28),  INTENT(IN)  :: HFILE     ! name of file
62  CHARACTER(LEN=6),   INTENT(IN)  :: HFILETYPE ! type of input file
63  CHARACTER(LEN=28),  INTENT(IN)  :: HFILEPGD     ! name of file
64  CHARACTER(LEN=6),   INTENT(IN)  :: HFILEPGDTYPE ! type of input file
65 INTEGER,            INTENT(IN)  :: KLUOUT    ! logical unit of output listing
66 REAL,DIMENSION(:,:,:), POINTER  :: PFIELD    ! field to interpolate horizontally (on final soil grid)
67 !
68 !*      0.2    declarations of local variables
69 !
70  CHARACTER(LEN=LEN_HREC) :: YRECFM         ! Name of the article to be read
71 INTEGER           :: IRESP          ! reading return code
72 INTEGER           :: INI            ! total 1D dimension
73 INTEGER           :: IPATCH         ! number of patch
74 !
75 REAL, DIMENSION(:,:,:), POINTER     :: ZFIELD         ! field read on initial MNH vertical soil grid, all patches
76 REAL, DIMENSION(:,:),   POINTER     :: ZFIELD1        ! field read on initial MNH vertical soil grid, one patch
77 REAL, DIMENSION(:,:,:), POINTER     :: ZD             ! depth of field in the soil
78 REAL, DIMENSION(:,:), POINTER     :: ZD1            ! depth of field in the soil, one patch
79 REAL, DIMENSION(:,:), ALLOCATABLE   :: ZOUT         !
80 INTEGER                             :: JVEGTYPE        ! loop counter for patch
81 REAL(KIND=JPRB) :: ZHOOK_HANDLE
82 !
83 !------------------------------------------------------------------------------
84 !
85 !*      1.     Preparation of IO for reading in the file
86 !              -----------------------------------------
87 !
88 !* Note that all points are read, even those without physical meaning.
89 !  These points will not be used during the horizontal interpolation step.
90 !  Their value must be defined as XUNDEF.
91 !
92 IF (LHOOK) CALL DR_HOOK('PREP_ISBA_EXTERN',0,ZHOOK_HANDLE)
93 !
94 !------------------------------------------------------------------------------
95 !
96 !*      2.     Reading of grid
97 !              ---------------
98 !
99  CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'NATURE')
100 !
101  CALL PREP_GRID_EXTERN(HFILEPGDTYPE,KLUOUT,CINGRID_TYPE,CINTERP_TYPE,INI)
102 !
103 !---------------------------------------------------------------------------------------
104 !
105 !*      3.     Transformation into physical quantity to be interpolated
106 !              --------------------------------------------------------
107 !
108 SELECT CASE(HSURF)
109 !
110 !*     3.      Orography
111 !              ---------
112 !
113   CASE('ZS     ')
114     ALLOCATE(PFIELD(INI,1,1))
115     YRECFM='ZS'
116     CALL READ_SURF(HFILEPGDTYPE,YRECFM,PFIELD(:,1,1),IRESP,HDIR='A')
117     CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
118 !
119 !--------------------------------------------------------------------------
120 !
121 !
122 !*      3.1    Profile of temperature, water or ice in the soil
123 !
124   CASE('TG    ','WG    ','WGI   ')
125      CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
126 !* reading of the profile and its depth definition
127      CALL READ_EXTERN_ISBA(HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,&
128                            KLUOUT,INI,HSURF,HSURF,ZFIELD,ZD)
129
130      ALLOCATE(ZFIELD1(SIZE(ZFIELD,1),SIZE(ZFIELD,2)))
131      ALLOCATE(ZD1(SIZE(ZFIELD,1),SIZE(ZFIELD,2)))
132      ALLOCATE(ZOUT(SIZE(ZFIELD,1),SIZE(XGRID_SOIL)))
133      ALLOCATE(PFIELD(SIZE(ZFIELD,1),SIZE(XGRID_SOIL),SIZE(ZFIELD,3)))
134 !
135      DO JVEGTYPE=1,SIZE(ZFIELD,3)
136         ZFIELD1(:,:)=ZFIELD(:,:,JVEGTYPE)
137         ZD1(:,:)=ZD(:,:,JVEGTYPE)
138         CALL INTERP_GRID(ZD1,ZFIELD1,XGRID_SOIL,ZOUT)
139         PFIELD(:,:,JVEGTYPE)=ZOUT(:,:)
140      END DO
141    
142 !
143      DEALLOCATE(ZFIELD)
144      DEALLOCATE(ZOUT)
145      DEALLOCATE(ZFIELD1)
146      DEALLOCATE(ZD)
147 !
148 !--------------------------------------------------------------------------
149 !
150 !*      3.4    Water content intercepted on leaves, LAI
151 !
152   CASE('WR     ')
153      ALLOCATE(PFIELD(INI,1,NVEGTYPE))
154      !* number of tiles
155      YRECFM='PATCH_NUMBER'
156      CALL READ_SURF(HFILEPGDTYPE,YRECFM,IPATCH,IRESP)
157      CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
158      ALLOCATE(ZFIELD(INI,1,IPATCH))
159      YRECFM = 'WR'
160      CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'NATURE')
161      CALL READ_SURF_FIELD2D(HFILETYPE,ZFIELD(:,1,:),YRECFM,HDIR='A')
162      CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
163      CALL PUT_ON_ALL_VEGTYPES(INI,1,IPATCH,NVEGTYPE,ZFIELD,PFIELD)
164      DEALLOCATE(ZFIELD)
165 !
166   CASE('LAI    ')
167      CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
168      ALLOCATE(PFIELD(INI,1,NVEGTYPE))
169      PFIELD(:,:,:) = XUNDEF
170 !
171 END SELECT
172 !
173 !
174 !---------------------------------------------------------------------------
175 !
176 !*      6.     End of IO
177 !              ---------
178 !
179 IF (LHOOK) CALL DR_HOOK('PREP_ISBA_EXTERN',1,ZHOOK_HANDLE)
180 !
181 !---------------------------------------------------------------------------
182 !---------------------------------------------------------------------------
183 END SUBROUTINE PREP_ISBA_EXTERN