SURFEX v8.1
General documentation of Surfex
eggmrt.F90
Go to the documentation of this file.
1 MODULE eggmrt
2 
3 ! Version 2009.0317 by JD GRIL
4 
5 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! DOC !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
6 
7 ! Tilt and Rotate routines and reverse (see Pierre Benard Document.)
8 
9 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
10 ! Author : Jean-Daniel GRIL , CNRM/GMAP/COOPE , October 19, 2004
11 ! Modifs : JD Gril : March 2009 : Optimisation of vectirization
12 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
13 
14 ! ******************* Definition of parameters **********************************
15 
16 ! Include Kinds
17 ! -------------
18 USE parkind1 ,ONLY : jprb
19 USE yomhook ,ONLY : lhook, dr_hook
20 
21 ! ******************* Loading module ********************************************
22 
23 USE eggangles, ONLY : lola, cosin_to_angle, p_asin
24 
25 IMPLICIT NONE
26 
27 ! ******************* Definition of type ****************************************
28 
29 ! ******************* Definition of Interface ***********************************
30 
31 INTERFACE tilt
32  MODULE PROCEDURE tilt_v, tilt_s
33 END INTERFACE
34 
35 INTERFACE rotate
36  MODULE PROCEDURE rotate_v, rotate_s
37 END INTERFACE
38 
39 INTERFACE anti_tilt
40  MODULE PROCEDURE anti_tilt_v, anti_tilt_s
41 END INTERFACE
42 
43 INTERFACE anti_rotate
44  MODULE PROCEDURE anti_rotate_v, anti_rotate_s
45 END INTERFACE
46 
47 INTERFACE merotil
48  MODULE PROCEDURE merotil_v, merotil_s
49 END INTERFACE
50 
51 INTERFACE metilrot
52  MODULE PROCEDURE metilrot_v, metilrot_s
53 END INTERFACE
54 
55 CONTAINS
56 
57 ! =================== FUNCTIONS =================================================
58 
59 ! ******************* Specifics functions ***************************************
60 ! -------------------------------------------------------------------------------
61 ! Function to TILT Scalar
62 ! -------------------------------------------------------------------------------
63 TYPE(lola) function tilt_s(ref_coord,pt_coord2) result (pt_coord1)
64 type(lola), INTENT(IN) :: ref_coord, pt_coord2
65 
66 REAL(KIND=JPRB) :: ZHOOK_HANDLE
67 
68 IF (lhook) CALL dr_hook('EGGMRT:TILT_S',0,zhook_handle)
69 pt_coord1%LAT = p_asin(cos(ref_coord%LON)*sin(pt_coord2%LAT)-sin(ref_coord%LON)* &
70  & cos(pt_coord2%LAT)*sin(pt_coord2%LON))
71 IF (cos(pt_coord1%LAT) /= 0.0_jprb) THEN
72  pt_coord1%LON = cosin_to_angle((cos(pt_coord2%LAT)*cos(pt_coord2%LON))/cos(pt_coord1%LAT), &
73  & (sin(ref_coord%LON)*sin(pt_coord2%LAT)+cos(ref_coord%LON)* &
74  & cos(pt_coord2%LAT)*sin(pt_coord2%LON))/cos(pt_coord1%LAT))
75 ELSE
76  pt_coord1%LON = 0.0_jprb
77 ENDIF
78 IF (lhook) CALL dr_hook('EGGMRT:TILT_S',1,zhook_handle)
79 END FUNCTION tilt_s
80 ! -------------------------------------------------------------------------------
81 ! Function to TILT Vector
82 ! -------------------------------------------------------------------------------
83 FUNCTION tilt_v(REF_COORD,PT_COORD2) RESULT (PT_COORD1)
84 type(lola), INTENT(IN) :: ref_coord
85 type(lola), DIMENSION(:),INTENT(IN) :: pt_coord2
86 type(lola), DIMENSION(SIZE(PT_COORD2)) :: pt_coord1
87 
88 REAL(KIND=JPRB) :: ZHOOK_HANDLE
89 
90 IF (lhook) CALL dr_hook('EGGMRT:TILT_V',0,zhook_handle)
91 
92 pt_coord1(:)%LAT = p_asin(cos(ref_coord%LON)*sin(pt_coord2(:)%LAT)-sin(ref_coord%LON)* &
93  & cos(pt_coord2(:)%LAT)*sin(pt_coord2(:)%LON))
94 WHERE (cos(pt_coord1(:)%LAT) /= 0.0_jprb)
95  pt_coord1(:)%LON = cosin_to_angle((cos(pt_coord2(:)%LAT)*cos(pt_coord2(:)%LON))/cos(pt_coord1(:)%LAT), &
96  & (sin(ref_coord%LON)*sin(pt_coord2(:)%LAT)+cos(ref_coord%LON)* &
97  & cos(pt_coord2(:)%LAT)*sin(pt_coord2(:)%LON))/cos(pt_coord1(:)%LAT))
98 ELSEWHERE
99  pt_coord1(:)%LON = 0.0_jprb
100 ENDWHERE
101 
102 IF (lhook) CALL dr_hook('EGGMRT:TILT_V',1,zhook_handle)
103 END FUNCTION tilt_v
104 
105 ! -------------------------------------------------------------------------------
106 ! Function to ROTATE Scalar
107 ! -------------------------------------------------------------------------------
108 TYPE(lola) FUNCTION ROTATE_S(center_coord,pt_coord1) RESULT (pt_coord)
109 type(lola), INTENT(IN) :: center_coord, pt_coord1
110 
111 REAL(KIND=JPRB) :: ZHOOK_HANDLE
112 
113 IF (lhook) CALL dr_hook('EGGMRT:ROTATE_S',0,zhook_handle)
114 pt_coord%LAT = p_asin(cos(center_coord%LAT)*sin(pt_coord1%LAT)+sin(center_coord%LAT)* &
115  & cos(pt_coord1%LAT)*cos(pt_coord1%LON))
116 
117 IF (cos(pt_coord%LAT) /= 0.0_jprb) THEN
118  pt_coord%LON = cosin_to_angle((-sin(center_coord%LAT)*sin(pt_coord1%LAT)+ &
119  & cos(center_coord%LAT)*cos(pt_coord1%LAT)*cos(pt_coord1%LON))/cos(pt_coord%LAT), &
120  & (cos(pt_coord1%LAT)*sin(pt_coord1%LON))/cos(pt_coord%LAT))+center_coord%LON
121 ELSE
122  pt_coord%LON = 0.0_jprb
123 ENDIF
124 IF (lhook) CALL dr_hook('EGGMRT:ROTATE_S',1,zhook_handle)
125 END FUNCTION rotate_s
126 ! -------------------------------------------------------------------------------
127 ! Function to ROTATE Vector
128 ! -------------------------------------------------------------------------------
129 FUNCTION rotate_v(CENTER_COORD,PT_COORD1) RESULT (PT_COORD)
130 type(lola), INTENT(IN) :: center_coord
131 type(lola), DIMENSION(:),INTENT(IN) :: pt_coord1
132 type(lola), DIMENSION(SIZE(PT_COORD1)) :: pt_coord
133 
134 REAL(KIND=JPRB) :: ZHOOK_HANDLE
135 
136 IF (lhook) CALL dr_hook('EGGMRT:ROTATE_V',0,zhook_handle)
137 pt_coord(:)%LAT = p_asin(cos(center_coord%LAT)*sin(pt_coord1(:)%LAT)+sin(center_coord%LAT)* &
138  & cos(pt_coord1(:)%LAT)*cos(pt_coord1(:)%LON))
139 
140 WHERE (cos(pt_coord(:)%LAT) /= 0.0_jprb)
141  pt_coord(:)%LON = cosin_to_angle((-sin(center_coord%LAT)*sin(pt_coord1(:)%LAT)+ &
142  & cos(center_coord%LAT)*cos(pt_coord1(:)%LAT)*cos(pt_coord1(:)%LON))/cos(pt_coord(:)%LAT), &
143  & (cos(pt_coord1(:)%LAT)*sin(pt_coord1(:)%LON))/cos(pt_coord(:)%LAT))+center_coord%LON
144 ELSEWHERE
145  pt_coord(:)%LON = 0.0_jprb
146 ENDWHERE
147 IF (lhook) CALL dr_hook('EGGMRT:ROTATE_V',1,zhook_handle)
148 END FUNCTION rotate_v
149 ! -------------------------------------------------------------------------------
150 ! Function to ROTATE & TILT Scalar
151 ! -------------------------------------------------------------------------------
152 TYPE(lola) FUNCTION MEROTIL_S(ref_coord,center_coord,pt_coord2) RESULT (pt_coord)
153 type(lola), INTENT(IN) :: ref_coord, center_coord, pt_coord2
154 
155 REAL(KIND=JPRB) :: ZHOOK_HANDLE
156 
157 IF (lhook) CALL dr_hook('EGGMRT:MEROTIL_S',0,zhook_handle)
158 pt_coord=rotate(center_coord,tilt(ref_coord,pt_coord2))
159 IF (lhook) CALL dr_hook('EGGMRT:MEROTIL_S',1,zhook_handle)
160 END FUNCTION merotil_s
161 ! -------------------------------------------------------------------------------
162 ! Function to ROTATE & TILT Vector
163 ! -------------------------------------------------------------------------------
164 FUNCTION merotil_v(REF_COORD,CENTER_COORD,PT_COORD2) RESULT (PT_COORD)
165 type(lola), INTENT(IN) :: ref_coord, center_coord
166 type(lola), DIMENSION(:),INTENT(IN) :: pt_coord2
167 type(lola), DIMENSION(SIZE(PT_COORD2)) :: pt_coord
168 
169 REAL(KIND=JPRB) :: ZHOOK_HANDLE
170 
171 IF (lhook) CALL dr_hook('EGGMRT:MEROTIL_V',0,zhook_handle)
172 pt_coord(:)=rotate(center_coord,tilt(ref_coord,pt_coord2(:)))
173 IF (lhook) CALL dr_hook('EGGMRT:MEROTIL_V',1,zhook_handle)
174 END FUNCTION merotil_v
175 ! -------------------------------------------------------------------------------
176 ! -------------------------------------------------------------------------------
177 ! Function to ANTI_TILT Scalar
178 ! -------------------------------------------------------------------------------
179 TYPE(lola) FUNCTION ANTI_TILT_S(ref_coord,pt_coord1) RESULT (pt_coord2)
180 type(lola), INTENT(IN) :: ref_coord, pt_coord1
181 
182 type(lola) :: anti_ref_coord
183 REAL(KIND=JPRB) :: ZHOOK_HANDLE
184 
185 IF (lhook) CALL dr_hook('EGGMRT:ANTI_TILT_S',0,zhook_handle)
186 anti_ref_coord%LAT = ref_coord%LAT
187 anti_ref_coord%LON = -(1.0_jprb)*ref_coord%LON
188 pt_coord2 = tilt(anti_ref_coord,pt_coord1)
189 IF (lhook) CALL dr_hook('EGGMRT:ANTI_TILT_S',1,zhook_handle)
190 END FUNCTION anti_tilt_s
191 ! -------------------------------------------------------------------------------
192 ! Function to ANTI_TILT Vector
193 ! -------------------------------------------------------------------------------
194 FUNCTION anti_tilt_v(REF_COORD,PT_COORD1) RESULT (PT_COORD2)
195 type(lola), INTENT(IN) :: ref_coord
196 type(lola), DIMENSION(:),INTENT(IN) :: pt_coord1
197 type(lola), DIMENSION(SIZE(PT_COORD1)) :: pt_coord2
198 
199 type(lola) :: anti_ref_coord
200 REAL(KIND=JPRB) :: ZHOOK_HANDLE
201 
202 IF (lhook) CALL dr_hook('EGGMRT:ANTI_TILT_V',0,zhook_handle)
203 anti_ref_coord%LAT = ref_coord%LAT
204 anti_ref_coord%LON = -(1.0_jprb)*ref_coord%LON
205 pt_coord2(:) = tilt(anti_ref_coord,pt_coord1(:))
206 IF (lhook) CALL dr_hook('EGGMRT:ANTI_TILT_V',1,zhook_handle)
207 END FUNCTION anti_tilt_v
208 ! -------------------------------------------------------------------------------
209 ! Function to ANTI_ROTATE Scalar
210 ! -------------------------------------------------------------------------------
211 TYPE(lola) FUNCTION ANTI_ROTATE_S(center_coord,pt_coord) RESULT (pt_coord1)
212 type(lola), INTENT(IN) :: center_coord, pt_coord
213 
214 type(lola) :: anti_center_coord, anti_pt_coord
215 REAL(KIND=JPRB) :: ZHOOK_HANDLE
216 
217 IF (lhook) CALL dr_hook('EGGMRT:ANTI_ROTATE_S',0,zhook_handle)
218 anti_center_coord%LAT = -(1.0_jprb)*center_coord%LAT
219 anti_center_coord%LON = center_coord%LON
220 anti_pt_coord%LAT = pt_coord%LAT
221 anti_pt_coord%LON = pt_coord%LON-center_coord%LON
222 pt_coord1 = rotate(anti_center_coord,anti_pt_coord)
223 pt_coord1%LON = pt_coord1%LON-center_coord%LON
224 IF (lhook) CALL dr_hook('EGGMRT:ANTI_ROTATE_S',1,zhook_handle)
225 END FUNCTION anti_rotate_s
226 ! -------------------------------------------------------------------------------
227 ! Function to ANTI_ROTATE Vector
228 ! -------------------------------------------------------------------------------
229 FUNCTION anti_rotate_v(CENTER_COORD,PT_COORD) RESULT (PT_COORD1)
230 type(lola), INTENT(IN) :: center_coord
231 type(lola), DIMENSION(:),INTENT(IN) :: pt_coord
232 type(lola), DIMENSION(SIZE(PT_COORD)) :: pt_coord1
233 
234 type(lola) :: anti_center_coord
235 type(lola), DIMENSION(SIZE(PT_COORD)) :: anti_pt_coord
236 REAL(KIND=JPRB) :: ZHOOK_HANDLE
237 
238 IF (lhook) CALL dr_hook('EGGMRT:ANTI_ROTATE_V',0,zhook_handle)
239 anti_center_coord%LAT = -(1.0_jprb)*center_coord%LAT
240 anti_center_coord%LON = center_coord%LON
241 anti_pt_coord(:)%LAT = pt_coord(:)%LAT
242 anti_pt_coord(:)%LON = pt_coord(:)%LON-center_coord%LON
243 pt_coord1(:) = rotate(anti_center_coord,anti_pt_coord(:))
244 pt_coord1(:)%LON = pt_coord1(:)%LON-center_coord%LON
245 IF (lhook) CALL dr_hook('EGGMRT:ANTI_ROTATE_V',1,zhook_handle)
246 END FUNCTION anti_rotate_v
247 ! -------------------------------------------------------------------------------
248 ! Function to ANTI_ROTATE & ANTI_TILT Scalar
249 ! -------------------------------------------------------------------------------
250 TYPE(lola) FUNCTION METILROT_S(ref_coord,center_coord,pt_coord) RESULT (pt_coord2)
251 type(lola), INTENT(IN) :: ref_coord, center_coord, pt_coord
252 
253 REAL(KIND=JPRB) :: ZHOOK_HANDLE
254 
255 IF (lhook) CALL dr_hook('EGGMRT:METILROT_S',0,zhook_handle)
256 pt_coord2=anti_tilt(ref_coord,anti_rotate(center_coord,pt_coord))
257 IF (lhook) CALL dr_hook('EGGMRT:METILROT_S',1,zhook_handle)
258 END FUNCTION metilrot_s
259 ! -------------------------------------------------------------------------------
260 ! Function to ANTI_ROTATE & ANTI_TILT Vector
261 ! -------------------------------------------------------------------------------
262 FUNCTION metilrot_v(REF_COORD,CENTER_COORD,PT_COORD) RESULT (PT_COORD2)
263 type(lola), INTENT(IN) :: ref_coord, center_coord
264 type(lola), DIMENSION(:),INTENT(IN) :: pt_coord
265 type(lola), DIMENSION(SIZE(PT_COORD)) :: pt_coord2
266 
267 REAL(KIND=JPRB) :: ZHOOK_HANDLE
268 
269 IF (lhook) CALL dr_hook('EGGMRT:METILROT_V',0,zhook_handle)
270 pt_coord2(:)=anti_tilt(ref_coord,anti_rotate(center_coord,pt_coord(:)))
271 IF (lhook) CALL dr_hook('EGGMRT:METILROT_V',1,zhook_handle)
272 END FUNCTION metilrot_v
273 ! -------------------------------------------------------------------------------
274 END MODULE eggmrt
eggmrt::anti_rotate_s
type(lola) function anti_rotate_s(CENTER_COORD, PT_COORD)
Definition: eggmrt.F90:212
eggmrt::merotil_v
type(lola) function, dimension(size(pt_coord2)) merotil_v(REF_COORD, CENTER_COORD, PT_COORD2)
Definition: eggmrt.F90:165
eggmrt::anti_rotate_v
type(lola) function, dimension(size(pt_coord)) anti_rotate_v(CENTER_COORD, PT_COORD)
Definition: eggmrt.F90:230
eggmrt::rotate_s
type(lola) function rotate_s(CENTER_COORD, PT_COORD1)
Definition: eggmrt.F90:109
yomhook::dr_hook
Definition: yomhook.F90:20
eggmrt::anti_tilt
Definition: eggmrt.F90:39
eggangles::p_asin
Definition: eggangles.F90:103
eggangles::cosin_to_angle
Definition: eggangles.F90:100
parkind1::jprb
integer, parameter jprb
Definition: parkind1.F90:32
eggmrt::tilt_s
type(lola) function tilt_s(REF_COORD, PT_COORD2)
Definition: eggmrt.F90:64
eggmrt
Definition: eggmrt.F90:1
eggmrt::metilrot_s
type(lola) function metilrot_s(REF_COORD, CENTER_COORD, PT_COORD)
Definition: eggmrt.F90:251
eggmrt::metilrot_v
type(lola) function, dimension(size(pt_coord)) metilrot_v(REF_COORD, CENTER_COORD, PT_COORD)
Definition: eggmrt.F90:263
eggmrt::anti_tilt_v
type(lola) function, dimension(size(pt_coord1)) anti_tilt_v(REF_COORD, PT_COORD1)
Definition: eggmrt.F90:195
eggmrt::rotate_v
type(lola) function, dimension(size(pt_coord1)) rotate_v(CENTER_COORD, PT_COORD1)
Definition: eggmrt.F90:130
yomhook::lhook
logical lhook
Definition: yomhook.F90:15
eggmrt::merotil_s
type(lola) function merotil_s(REF_COORD, CENTER_COORD, PT_COORD2)
Definition: eggmrt.F90:153
eggmrt::anti_tilt_s
type(lola) function anti_tilt_s(REF_COORD, PT_COORD1)
Definition: eggmrt.F90:180
eggmrt::anti_rotate
Definition: eggmrt.F90:43
eggmrt::tilt_v
type(lola) function, dimension(size(pt_coord2)) tilt_v(REF_COORD, PT_COORD2)
Definition: eggmrt.F90:84
Generated on Tue Jan 16 2018 16:23:21 for SURFEX v8.1 by   doxygen 1.8.13