bcecb839c8ed356e02a2633fc2f0821b602641c8
[MNH-git_open_source-lfs.git] / src / SURFEX / prep_grid_gauss.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_GAUSS(HFILETYPE,HINTERP_TYPE,KNI)
7 !     ##########################################################################
8 !
9 !!****  *PREP_GRID_GAUSS* - 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_GAUSS, ONLY : XILA1, XILO1, XILA2, XILO2, NINLA, NINLO, NILEN, LROTPOLE, XCOEF, XLAP, XLOP
44 !
45 !
46 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
47 USE PARKIND1  ,ONLY : JPRB
48 !
49 IMPLICIT NONE
50 !
51 !* 0.1. Declaration of arguments
52 !       ------------------------
53 !
54  CHARACTER(LEN=6),  INTENT(IN)    :: HFILETYPE    ! file type
55  CHARACTER(LEN=6),  INTENT(OUT)   :: HINTERP_TYPE ! Grid type
56 INTEGER,           INTENT(OUT)   :: KNI          ! number of points
57 !
58 !* 0.2 Declaration of local variables
59 !      ------------------------------
60 !
61  CHARACTER(LEN=12) :: YRECFM    ! Name of the article to be read
62 INTEGER           :: IRESP
63 !
64 !
65 INTEGER           :: JL        ! loop counter
66 REAL, DIMENSION(:), ALLOCATABLE :: ZW ! work array
67 !
68 INTEGER :: INLATI  ! number of pseudo-latitudes
69 REAL    :: ZLAPO   ! latitude of the rotated pole  (deg)
70 REAL    :: ZLOPO   ! longitude of the rotated pole (deg)
71 REAL    :: ZCODIL  ! stretching factor (must be greater than or equal to 1)
72 INTEGER, DIMENSION(:), ALLOCATABLE :: INLOPA ! number of pseudo-longitudes on each
73 REAL(KIND=JPRB) :: ZHOOK_HANDLE
74                                              ! pseudo-latitude circle
75
76 !-----------------------------------------------------------------------
77 !
78 !*   1 Projection
79 !      ----------
80 !
81 IF (LHOOK) CALL DR_HOOK('PREP_GRID_GAUSS',0,ZHOOK_HANDLE)
82 YRECFM = 'LAPO'
83  CALL READ_SURF(HFILETYPE,YRECFM,ZLAPO,IRESP)
84 YRECFM = 'LOPO'
85  CALL READ_SURF(HFILETYPE,YRECFM,ZLOPO,IRESP)
86 YRECFM = 'CODIL'
87  CALL READ_SURF(HFILETYPE,YRECFM,ZCODIL,IRESP)
88 !
89 !-----------------------------------------------------------------------
90 !
91 !*   2 Grid
92 !      ----
93 !
94 YRECFM = 'NLATI'
95  CALL READ_SURF(HFILETYPE,YRECFM,INLATI,IRESP)
96 !
97 IF (ALLOCATED(INLOPA)) DEALLOCATE(INLOPA)
98 ALLOCATE(INLOPA(INLATI))
99 YRECFM = 'NLOPA'
100  CALL READ_SURF(HFILETYPE,YRECFM,INLOPA,IRESP)
101 !
102 KNI = SUM(INLOPA)
103 !
104 !-----------------------------------------------------------------------
105 !
106 !*   3 Computes additional quantities used in interpolation
107 !      ----------------------------------------------------
108 !
109 NINLA = INLATI
110 NINLO = INLOPA
111 NILEN = KNI
112 LROTPOLE = .TRUE.
113 XLOP = ZLOPO
114 XLAP = ZLAPO
115 XCOEF=ZCODIL
116 !
117 XILA1=90.*(1.-0.5/INLATI)
118 XILO1=0.
119 XILA2=-90.*(1.-0.5/INLATI)
120 XILO2=360.*(INLOPA(1)-1.)/INLOPA(1)
121 !
122 !-----------------------------------------------------------------------
123 HINTERP_TYPE = 'HORIBL'
124 IF (LHOOK) CALL DR_HOOK('PREP_GRID_GAUSS',1,ZHOOK_HANDLE)
125 !-----------------------------------------------------------------------
126 !
127 END SUBROUTINE PREP_GRID_GAUSS