SURFEX  V8_0
Surfex V8_0 release
 All Classes Files Functions Variables
prep_grid_lonlat_reg.F90
Go to the documentation of this file.
1 !SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
2 !SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
3 !SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
4 !SFX_LIC for details. version 1.
5 ! #########
6  SUBROUTINE prep_grid_lonlat_reg (&
7  hfiletype,hinterp_type,kni)
8 ! ##########################################################################
9 !
10 !!**** *PREP_GRID_LATLON* - reads EXTERNALIZED Surface grid.
11 !!
12 !! PURPOSE
13 !! -------
14 !!
15 !!** METHOD
16 !! ------
17 !!
18 !! EXTERNAL
19 !! --------
20 !!
21 !! IMPLICIT ARGUMENTS
22 !! ------------------
23 !!
24 !!
25 !! REFERENCE
26 !! ---------
27 !!
28 !!
29 !! AUTHOR
30 !! ------
31 !!
32 !! V. Masson
33 !!
34 !! MODIFICATIONS
35 !! -------------
36 !! Original 06/2003
37 !-------------------------------------------------------------------------------
38 !
39 !* 0. DECLARATIONS
40 ! ------------
41 !
42 !
43 !
44 !
46 !
47 USE modd_grid_latlonregul, ONLY : xilat1,xilon1,xilat2,xilon2,ninlat,ninlon,nilength,xilatarray
48 !
49 USE yomhook ,ONLY : lhook, dr_hook
50 USE parkind1 ,ONLY : jprb
51 !
52 IMPLICIT NONE
53 !
54 !* 0.1. Declaration of arguments
55 ! ------------------------
56 !
57 !
58 !
59  CHARACTER(LEN=6), INTENT(IN) :: hfiletype ! file type
60  CHARACTER(LEN=6), INTENT(OUT) :: hinterp_type ! Grid type
61 INTEGER, INTENT(OUT) :: kni ! number of points
62 !
63 !* 0.2 Declaration of local variables
64 ! ------------------------------
65 !
66  CHARACTER(LEN=12) :: yrecfm ! Name of the article to be read
67 INTEGER :: iresp
68 !
69 INTEGER :: jl ! loop counter
70 INTEGER :: ilon
71 REAL :: zdlat, zdlon
72 REAL(KIND=JPRB) :: zhook_handle
73 !-----------------------------------------------------------------------
74 !
75 !* 1 Projection
76 ! ----------
77 !
78 IF (lhook) CALL dr_hook('PREP_GRID_LONLAT_REG',0,zhook_handle)
79 yrecfm = 'LONMIN'
80  CALL read_surf(&
81  hfiletype,yrecfm,xilon1,iresp)
82 yrecfm = 'LONMAX'
83  CALL read_surf(&
84  hfiletype,yrecfm,xilon2,iresp)
85 yrecfm = 'LATMIN'
86  CALL read_surf(&
87  hfiletype,yrecfm,xilat1,iresp)
88 yrecfm = 'LATMAX'
89  CALL read_surf(&
90  hfiletype,yrecfm,xilat2,iresp)
91 yrecfm = 'NLAT'
92  CALL read_surf(&
93  hfiletype,yrecfm,ninlat,iresp)
94 !
95 IF (ALLOCATED(ninlon)) DEALLOCATE(ninlon)
96 ALLOCATE(ninlon(ninlat))
97 yrecfm = 'NLON'
98  CALL read_surf(&
99  hfiletype,yrecfm,ninlon(1),iresp)
100 IF (ninlat.GT.1) ninlon(2:ninlat) = ninlon(1)
101 !
102 !-----------------------------------------------------------------------
103 !
104 !* 3 Computes additional quantities used in interpolation
105 ! ----------------------------------------------------
106 !
107 nilength = ninlat*ninlon(1)
108 kni = nilength
109 !
110 zdlat = (xilat2-xilat1)/ninlat
111 zdlon = (xilon2-xilon1)/ninlon(1)
112 !
113 xilon1 = xilon1 + zdlon/2.
114 xilon2 = xilon2 - zdlon/2.
115 xilat1 = xilat1 + zdlat/2.
116 xilat2 = xilat2 - zdlat/2.
117 !
118 IF (ALLOCATED(xilatarray)) DEALLOCATE(xilatarray)
119 ALLOCATE(xilatarray(ninlat))
120 !
121 xilatarray(1)=xilat1
122 DO jl = 2,ninlat
123  xilatarray(jl) = xilatarray(jl-1) + zdlat
124 ENDDO
125 !
126 !-----------------------------------------------------------------------
127 IF(kni==1)THEN
128  hinterp_type = 'UNIF'
129 ELSE
130  hinterp_type = 'HORIBL'
131 ENDIF
132 !
133 IF (lhook) CALL dr_hook('PREP_GRID_LONLAT_REG',1,zhook_handle)
134 !-----------------------------------------------------------------------
135 !
136 END SUBROUTINE prep_grid_lonlat_reg
subroutine prep_grid_lonlat_reg(HFILETYPE, HINTERP_TYPE, KNI)