Juan 8/12/2016: add management of LEN_HREC in MNH & SURFEX
[MNH-git_open_source-lfs.git] / src / SURFEX / prep_flake_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_FLAKE_EXTERN(HPROGRAM,HSURF,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,KLUOUT,PFIELD)
7 !     #################################################################################
8 !
9 USE MODD_TYPE_DATE_SURF
10 !
11 USE MODI_PREP_GRID_EXTERN
12 USE MODI_READ_SURF
13 USE MODI_OPEN_AUX_IO_SURF
14 USE MODI_CLOSE_AUX_IO_SURF
15 USE MODI_ABOR1_SFX
16 USE MODI_GET_LUOUT
17 !
18 USE MODD_PREP,       ONLY : CINGRID_TYPE, CINTERP_TYPE
19 USE MODD_SURF_PAR,   ONLY : XUNDEF
20 !
21 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
22 USE PARKIND1  ,ONLY : JPRB
23 !
24 IMPLICIT NONE
25 !
26 !*      0.1    declarations of arguments
27 !
28  CHARACTER(LEN=6),   INTENT(IN)  :: HPROGRAM  ! program calling surf. schemes
29  CHARACTER(LEN=7),   INTENT(IN)  :: HSURF     ! type of field
30  CHARACTER(LEN=28),  INTENT(IN)  :: HFILE     ! name of file
31  CHARACTER(LEN=6),   INTENT(IN)  :: HFILETYPE ! type of input file
32  CHARACTER(LEN=28),  INTENT(IN)  :: HFILEPGD     ! name of file
33  CHARACTER(LEN=6),   INTENT(IN)  :: HFILEPGDTYPE ! type of input file
34 INTEGER,            INTENT(IN)  :: KLUOUT    ! logical unit of output listing
35 REAL,DIMENSION(:,:), POINTER    :: PFIELD    ! field to interpolate horizontally
36 !
37 !*      0.2    declarations of local variables
38 !
39 !
40  CHARACTER(LEN=LEN_HREC) :: YRECFM         ! Name of the article to be read
41 INTEGER           :: IRESP          ! reading return code
42 INTEGER           :: ILUOUT
43 !
44 INTEGER           :: INI            ! total 1D dimension
45  CHARACTER(LEN=6)  :: YWATER         ! lake scheme
46 INTEGER           :: IDIM_WATER     ! number of water points
47 REAL(KIND=JPRB) :: ZHOOK_HANDLE
48 !
49 !-------------------------------------------------------------------------------------
50 !
51 !*      1.     Preparation of IO for reading in the file
52 !              -----------------------------------------
53 !
54 !* Note that all points are read, even those without physical meaning.
55 !  These points will not be used during the horizontal interpolation step.
56 !  Their value must be defined as XUNDEF.
57 !
58 IF (LHOOK) CALL DR_HOOK('PREP_FLAKE_EXTERN',0,ZHOOK_HANDLE)
59 !
60  CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'WATER ')
61 !
62  CALL READ_SURF(HFILEPGDTYPE,'WATER',YWATER,IRESP)
63 !
64 !-------------------------------------------------------------------------------------
65 !
66 !*      2.     Reading of grid
67 !              ---------------
68 !
69  CALL PREP_GRID_EXTERN(HFILEPGDTYPE,KLUOUT,CINGRID_TYPE,CINTERP_TYPE,INI)
70 !
71  CALL READ_SURF(HFILEPGDTYPE,'DIM_WATER',IDIM_WATER,IRESP)
72 !
73 IF (IDIM_WATER==0) THEN
74   CALL GET_LUOUT(HPROGRAM,ILUOUT)
75   WRITE(ILUOUT,*) ' '
76   WRITE(ILUOUT,*) 'No inland water data available in input file ',HFILE
77   WRITE(ILUOUT,*) 'Please change your input file '
78   WRITE(ILUOUT,*) '             or '
79   WRITE(ILUOUT,*) 'specify inland water temperature XTS_WATER_UNIF'
80   CALL ABOR1_SFX('PREP_FLAKE_EXTERN: No inland water data available in input file')
81 END IF
82 !
83 !---------------------------------------------------------------------------------------
84 SELECT CASE(HSURF)
85 !---------------------------------------------------------------------------------------
86 !
87 !*     3.      Orography
88 !              ---------
89 !
90   CASE('ZS     ')
91     ALLOCATE(PFIELD(INI,1))
92     YRECFM='ZS'
93     CALL READ_SURF(HFILEPGDTYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='A')
94     CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
95 !
96 !*      4.  Sea surface temperature
97 !           -----------------------
98 !
99   CASE('TS     ')
100     ALLOCATE(PFIELD(INI,1))
101     YRECFM='TS_WATER'
102     CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
103     CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'WATER ')
104     CALL READ_SURF(HFILETYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='A')
105     CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
106 !
107 END SELECT
108 !
109 !*      5.  FLake variables
110 !           -----------------------
111 !
112 IF (HSURF/='ZS    ' .AND. HSURF/='TS    ') THEN
113
114   CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
115
116   IF (YWATER=='FLAKE ') THEN
117
118     CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'WATER ')
119
120     SELECT CASE(HSURF)
121
122     CASE('T_SNOW ')
123       ALLOCATE(PFIELD(INI,1))
124       YRECFM='T_SNOW  '  
125       CALL READ_SURF(HFILETYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='A')
126 !
127     CASE('T_ICE  ')
128       ALLOCATE(PFIELD(INI,1))
129       YRECFM='T_ICE   '  
130       CALL READ_SURF(HFILETYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='A')
131 !
132     CASE('T_MNW  ')
133       ALLOCATE(PFIELD(INI,1))
134       YRECFM='T_MNW   '  
135       CALL READ_SURF(HFILETYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='A')
136 !
137     CASE('T_BOT  ')
138       ALLOCATE(PFIELD(INI,1))
139       YRECFM='T_BOT   '  
140       CALL READ_SURF(HFILETYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='A')
141 !
142     CASE('T_B1   ')
143       ALLOCATE(PFIELD(INI,1))
144       YRECFM='T_B1    '  
145       CALL READ_SURF(HFILETYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='A')
146 !
147     CASE('H_SNOW ')
148       ALLOCATE(PFIELD(INI,1))
149       YRECFM='H_SNOW  '  
150       CALL READ_SURF(HFILETYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='A')
151 !
152     CASE('H_ICE  ')
153       ALLOCATE(PFIELD(INI,1))
154       YRECFM='H_ICE   '  
155       CALL READ_SURF(HFILETYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='A')
156 !
157     CASE('H_ML   ')
158       ALLOCATE(PFIELD(INI,1))
159       YRECFM='H_ML    '  
160       CALL READ_SURF(HFILETYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='A')
161 !
162     CASE('H_B1   ')
163       ALLOCATE(PFIELD(INI,1))
164       YRECFM='H_B1    '  
165       CALL READ_SURF(HFILETYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='A')
166 !
167 !---------------------------------------------------------------------------------------
168     END SELECT
169
170     CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
171
172   ELSE
173 !* no Flake field in the input file
174     ALLOCATE(PFIELD(INI,1))
175     PFIELD = XUNDEF
176   END IF
177 END IF
178 !-------------------------------------------------------------------------------------
179 !
180 !*      6.     End of IO
181 !              ---------
182 !
183 IF (LHOOK) CALL DR_HOOK('PREP_FLAKE_EXTERN',1,ZHOOK_HANDLE)
184 !
185 !---------------------------------------------------------------------------------------
186 !
187 END SUBROUTINE PREP_FLAKE_EXTERN