Juan 8/12/2016: add management of LEN_HREC in MNH & SURFEX
[MNH-git_open_source-lfs.git] / src / SURFEX / prep_grid_conf_proj.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_GRID_CONF_PROJ(HFILETYPE,HINTERP_TYPE,KNI)
7 !     ##########################################################################
8 !
9 !!****  *PREP_GRID_CONF_PROJ* - reads EXTERNALIZED Surface grid.
10 !!
11 !!    PURPOSE
12 !!    -------
13 !!
14 !!**  METHOD
15 !!    ------
16 !!
17 !!    EXTERNAL
18 !!    --------
19 !!
20 !!    IMPLICIT ARGUMENTS
21 !!    ------------------
22 !!
23 !!
24 !!    REFERENCE
25 !!    ---------
26 !!
27 !!
28 !!    AUTHOR
29 !!    ------
30 !!
31 !!      V. Masson
32 !!
33 !!    MODIFICATIONS
34 !!    -------------
35 !!      Original   06/2003
36 !-------------------------------------------------------------------------------
37 !
38 !*      0. DECLARATIONS
39 !          ------------
40 !
41 USE MODI_READ_SURF
42 !
43 USE MODD_GRID_CONF_PROJ, ONLY : XX, XY, NX, NY, XLAT0, XLON0, XLATORI, &
44                                   XLONORI, XRPK, XBETA  
45 !
46 !
47 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
48 USE PARKIND1  ,ONLY : JPRB
49 !
50 IMPLICIT NONE
51 !
52 !* 0.1. Declaration of arguments
53 !       ------------------------
54 !
55  CHARACTER(LEN=6),  INTENT(IN)    :: HFILETYPE    ! file type
56  CHARACTER(LEN=6),  INTENT(OUT)   :: HINTERP_TYPE ! Grid type
57 INTEGER,           INTENT(OUT)   :: KNI          ! number of points
58 !
59 !* 0.2 Declaration of local variables
60 !      ------------------------------
61 !
62  CHARACTER(LEN=LEN_HREC) :: YRECFM    ! Name of the article to be read
63 INTEGER           :: IRESP
64 !
65 !
66 INTEGER           :: JL        ! loop counter
67 REAL, DIMENSION(:), ALLOCATABLE :: ZW ! work array
68 REAL(KIND=JPRB) :: ZHOOK_HANDLE
69 !
70 !-----------------------------------------------------------------------
71 !
72 !*   1 Projection
73 !      ----------
74 !
75 IF (LHOOK) CALL DR_HOOK('PREP_GRID_CONF_PROJ',0,ZHOOK_HANDLE)
76 YRECFM = 'LAT0'
77  CALL READ_SURF(HFILETYPE,YRECFM,XLAT0,IRESP)
78 YRECFM = 'LON0'
79  CALL READ_SURF(HFILETYPE,YRECFM,XLON0,IRESP)
80 YRECFM = 'RPK'
81  CALL READ_SURF(HFILETYPE,YRECFM,XRPK,IRESP)
82 YRECFM = 'BETA'
83  CALL READ_SURF(HFILETYPE,YRECFM,XBETA,IRESP)
84 !
85 !-----------------------------------------------------------------------
86 !
87 !*   2 Grid
88 !      ----
89 !
90 YRECFM = 'LATORI'
91  CALL READ_SURF(HFILETYPE,YRECFM,XLATORI,IRESP)
92 YRECFM = 'LONORI'
93  CALL READ_SURF(HFILETYPE,YRECFM,XLONORI,IRESP)
94 !
95 YRECFM = 'IMAX'
96  CALL READ_SURF(HFILETYPE,YRECFM,NX,IRESP)
97 YRECFM = 'JMAX'
98  CALL READ_SURF(HFILETYPE,YRECFM,NY,IRESP)
99 !
100 KNI = NX * NY
101 !
102 ALLOCATE(ZW(KNI))
103 !
104 IF (ALLOCATED(XX)) DEALLOCATE(XX)
105 ALLOCATE(XX(NX))
106 YRECFM = 'XX'
107  CALL READ_SURF(HFILETYPE,YRECFM,ZW,IRESP,HDIR='A')
108 XX = ZW(1:NX)
109
110
111 IF (ALLOCATED(XY)) DEALLOCATE(XY)
112 ALLOCATE(XY(NY))
113 YRECFM = 'YY'
114  CALL READ_SURF(HFILETYPE,YRECFM,ZW,IRESP,HDIR='A')
115 DO JL=1,KNI
116   IF (MOD(JL,NX)==0) XY(JL/NX) = ZW(JL)
117 END DO
118 DEALLOCATE(ZW)
119 !
120 !-----------------------------------------------------------------------
121 HINTERP_TYPE = 'BILIN '
122 IF (LHOOK) CALL DR_HOOK('PREP_GRID_CONF_PROJ',1,ZHOOK_HANDLE)
123 !-----------------------------------------------------------------------
124 !
125 END SUBROUTINE PREP_GRID_CONF_PROJ