19 USE yomhook
,ONLY : lhook, dr_hook
20 USE parkind1
,ONLY : jprb
55 TYPE (lola),
INTENT(IN) :: pt_reel
56 TYPE (lola),
INTENT(IN) :: pt_pole
57 REAL,
INTENT(IN) :: pcodil
58 REAL(KIND=JPRB) :: zhook_handle
60 IF (lhook) CALL dr_hook(
'MODE_GEO_GAUSS:GAUSS_TR_S',0,zhook_handle)
62 IF (lhook) CALL dr_hook(
'MODE_GEO_GAUSS:GAUSS_TR_S',1,zhook_handle)
66 FUNCTION gauss_tr_v (PT_REEL,PT_POLE,PCODIL) RESULT (PT_G)
67 TYPE (lola
),
DIMENSION(:),
INTENT(IN) :: pt_reel
68 TYPE (lola
),
INTENT(IN) :: pt_pole
69 REAL,
INTENT(IN) :: pcodil
70 TYPE (lola
),
DIMENSION(SIZE(PT_REEL)) :: pt_g
71 REAL(KIND=JPRB) :: zhook_handle
73 IF (lhook) CALL dr_hook(
'MODE_GEO_GAUSS:GAUSS_TR_V',0,zhook_handle)
75 IF (lhook) CALL dr_hook(
'MODE_GEO_GAUSS:GAUSS_TR_V',1,zhook_handle)
79 TYPE(lola
) function
gauss_rt_s (pt_g,pt_pole,pcodil) result (pt_reel)
80 TYPE (lola
),
INTENT(IN) :: pt_g
81 TYPE (lola
),
INTENT(IN) :: pt_pole
82 REAL,
INTENT(IN) :: pcodil
83 REAL(KIND=JPRB) :: zhook_handle
85 IF (lhook) CALL dr_hook(
'MODE_GEO_GAUSS:GAUSS_RT_S',0,zhook_handle)
87 IF (lhook) CALL dr_hook(
'MODE_GEO_GAUSS:GAUSS_RT_S',1,zhook_handle)
91 FUNCTION gauss_rt_v (PT_G,PT_POLE,PCODIL) RESULT (PT_REEL)
92 TYPE (lola
),
DIMENSION(:),
INTENT(IN) :: pt_g
93 TYPE (lola
),
INTENT(IN) :: pt_pole
94 REAL,
INTENT(IN) :: pcodil
95 TYPE (lola
),
DIMENSION(SIZE(PT_G)) :: pt_reel
96 REAL(KIND=JPRB) :: zhook_handle
98 IF (lhook) CALL dr_hook(
'MODE_GEO_GAUSS:GAUSS_RT_V',0,zhook_handle)
100 IF (lhook) CALL dr_hook(
'MODE_GEO_GAUSS:GAUSS_RT_V',1,zhook_handle)
104 TYPE(lola
) function
rotate_g_s (pt_tr,pt_pole) result (pt_reel)
106 TYPE (lola),
INTENT(IN) :: pt_tr
107 TYPE (lola),
INTENT(IN) :: pt_pole
109 REAL(KIND=JPRB) :: zsin, zcos
110 REAL(KIND=JPRB) :: zhook_handle
112 IF (lhook) CALL dr_hook(
'MODE_GEO_GAUSS:ROTATE_G_S',0,zhook_handle)
113 pt_reel%LAT =
p_asin(sin(pt_pole%LAT)*sin(pt_tr%LAT)+cos(pt_pole%LAT)*cos(pt_tr%LAT)*cos(pt_tr%LON))
115 IF (cos(pt_reel%LAT) /= 0.0)
THEN
116 zsin = -1.0*cos(pt_tr%LAT)*sin(pt_tr%LON)/cos(pt_reel%LAT)
117 zcos = (cos(pt_pole%LAT)*sin(pt_tr%LAT)-sin(pt_pole%LAT)*cos(pt_tr%LAT)*cos(pt_tr%LON))/cos(pt_reel%LAT)
122 IF (lhook) CALL dr_hook(
'MODE_GEO_GAUSS:ROTATE_G_S',1,zhook_handle)
128 TYPE (lola),
DIMENSION(:),
INTENT(IN) :: pt_tr
129 TYPE (lola),
INTENT(IN) :: pt_pole
130 TYPE (lola),
DIMENSION(SIZE(PT_TR)) :: pt_reel
132 REAL(KIND=JPRB),
DIMENSION(SIZE(PT_TR)) :: zsin, zcos
133 REAL(KIND=JPRB) :: zhook_handle
135 IF (lhook) CALL dr_hook(
'MODE_GEO_GAUSS:ROTATE_G_V',0,zhook_handle)
136 pt_reel%LAT =
p_asin(sin(pt_pole%LAT)*sin(pt_tr%LAT)+cos(pt_pole%LAT)*cos(pt_tr%LAT)*cos(pt_tr%LON))
139 WHERE (cos(pt_reel%LAT) /= 0.0)
140 zsin = -1.0*cos(pt_tr%LAT)*sin(pt_tr%LON)/cos(pt_reel%LAT)
141 zcos = (cos(pt_pole%LAT)*sin(pt_tr%LAT)-sin(pt_pole%LAT)*cos(pt_tr%LAT)*cos(pt_tr%LON))/cos(pt_reel%LAT)
144 IF (lhook) CALL dr_hook(
'MODE_GEO_GAUSS:ROTATE_G_V',1,zhook_handle)
155 TYPE (lola),
INTENT(IN) :: pt_reel
156 TYPE (lola),
INTENT(IN) :: pt_pole
158 REAL(KIND=JPRB) :: zsin, zcos
159 REAL(KIND=JPRB) :: zhook_handle
161 IF (lhook) CALL dr_hook(
'MODE_GEO_GAUSS:ANTI_ROTATE_G_S',0,zhook_handle)
162 pt_tr%LAT =
p_asin(sin(pt_pole%LAT)*sin(pt_reel%LAT)+cos(pt_pole%LAT)*cos(pt_reel%LAT)*cos(pt_reel%LON-pt_pole%LON))
164 IF (cos(pt_tr%LAT) /= 0.0)
THEN
165 zsin = -1.0*cos(pt_reel%LAT)*sin(pt_reel%LON-pt_pole%LON)/cos(pt_tr%LAT)
166 zcos = (cos(pt_pole%LAT)*sin(pt_reel%LAT)-sin(pt_pole%LAT)*cos(pt_reel%LAT)*cos(pt_reel%LON-pt_pole%LON))/cos(pt_tr%LAT)
171 IF (lhook) CALL dr_hook(
'MODE_GEO_GAUSS:ANTI_ROTATE_G_S',1,zhook_handle)
176 TYPE (lola),
DIMENSION(:),
INTENT(IN) :: pt_reel
177 TYPE (lola),
INTENT(IN) :: pt_pole
178 TYPE (lola),
DIMENSION(SIZE(PT_REEL)) :: pt_tr
180 REAL(KIND=JPRB),
DIMENSION(SIZE(PT_REEL)) :: zsin, zcos
181 REAL(KIND=JPRB) :: zhook_handle
183 IF (lhook) CALL dr_hook(
'MODE_GEO_GAUSS:ANTI_ROTATE_G_V',0,zhook_handle)
184 pt_tr%LAT =
p_asin(sin(pt_pole%LAT)*sin(pt_reel%LAT)+cos(pt_pole%LAT)*cos(pt_reel%LAT)*cos(pt_reel%LON-pt_pole%LON))
187 WHERE (cos(pt_tr%LAT) /= 0.0)
188 zsin = -1.0*cos(pt_reel%LAT)*sin(pt_reel%LON-pt_pole%LON)/cos(pt_tr%LAT)
189 zcos = (cos(pt_pole%LAT)*sin(pt_reel%LAT)-sin(pt_pole%LAT)*cos(pt_reel%LAT)*cos(pt_reel%LON-pt_pole%LON))/cos(pt_tr%LAT)
192 IF (lhook) CALL dr_hook(
'MODE_GEO_GAUSS:ANTI_ROTATE_G_V',1,zhook_handle)
202 TYPE (lola),
INTENT(IN) :: pt_coord
203 REAL,
INTENT(IN) :: pcodil
205 REAL(KIND=JPRB) :: zpc2, zsin, zcos
206 REAL(KIND=JPRB) :: zhook_handle
208 IF (lhook) CALL dr_hook(
'MODE_GEO_GAUSS:ETIR_S',0,zhook_handle)
209 pt_et%LON = pt_coord%LON
211 zsin = ((1.0-zpc2)+(1.0+zpc2)*sin(pt_coord%LAT))/((1.0+zpc2)+(1.0-zpc2)*sin(pt_coord%LAT))
212 zcos = 2.0*pcodil*cos(pt_coord%LAT)/((1.0+zpc2)+(1.0-zpc2)*sin(pt_coord%LAT))
215 IF (lhook) CALL dr_hook(
'MODE_GEO_GAUSS:ETIR_S',1,zhook_handle)
219 FUNCTION etir_v (PT_COORD,PCODIL) RESULT (PT_ET)
221 TYPE (lola),
DIMENSION(:),
INTENT(IN) :: pt_coord
222 REAL,
INTENT(IN) :: pcodil
223 TYPE (lola),
DIMENSION(SIZE(PT_COORD)) :: pt_et
225 REAL(KIND=JPRB),
DIMENSION(SIZE(PT_COORD)) :: zpc2, zsin, zcos
226 REAL(KIND=JPRB) :: zhook_handle
228 IF (lhook) CALL dr_hook(
'MODE_GEO_GAUSS:ETIR_V',0,zhook_handle)
229 pt_et%LON = pt_coord%LON
231 zsin = ((1.0-zpc2)+(1.0+zpc2)*sin(pt_coord%LAT))/((1.0+zpc2)+(1.0-zpc2)*sin(pt_coord%LAT))
232 zcos = 2.0*pcodil*cos(pt_coord%LAT)/((1.0+zpc2)+(1.0-zpc2)*sin(pt_coord%LAT))
235 IF (lhook) CALL dr_hook(
'MODE_GEO_GAUSS:ETIR_V',1,zhook_handle)
241 TYPE (lola),
INTENT(IN) :: pt_coord
242 REAL,
INTENT(IN) :: pcodil
244 REAL(KIND=JPRB) :: zpc2, zsin, zcos
245 REAL(KIND=JPRB) :: zhook_handle
247 IF (lhook) CALL dr_hook(
'MODE_GEO_GAUSS:RETRE_S',0,zhook_handle)
248 pt_re%LON = pt_coord%LON
250 zsin = (-1.0*(1.0-zpc2)+(1.0+zpc2)*sin(pt_coord%LAT))/((1.0+zpc2)-(1.0-zpc2)*sin(pt_coord%LAT))
251 zcos = 2.0*pcodil*cos(pt_coord%LAT)/((1.0+zpc2)-(1.0-zpc2)*sin(pt_coord%LAT))
254 IF (lhook) CALL dr_hook(
'MODE_GEO_GAUSS:RETRE_S',1,zhook_handle)
258 FUNCTION retre_v (PT_COORD,PCODIL) RESULT (PT_RE)
260 TYPE (lola),
DIMENSION(:),
INTENT(IN) :: pt_coord
261 REAL,
INTENT(IN) :: pcodil
262 TYPE (lola),
DIMENSION(SIZE(PT_COORD)) :: pt_re
264 REAL(KIND=JPRB),
DIMENSION(SIZE(PT_COORD)) :: zpc2, zsin, zcos
265 REAL(KIND=JPRB) :: zhook_handle
267 IF (lhook) CALL dr_hook(
'MODE_GEO_GAUSS:RETRE_V',0,zhook_handle)
268 pt_re%LON = pt_coord%LON
270 zsin = (-1.0*(1.0-zpc2)+(1.0+zpc2)*sin(pt_coord%LAT))/((1.0+zpc2)-(1.0-zpc2)*sin(pt_coord%LAT))
271 zcos = 2.0*pcodil*cos(pt_coord%LAT)/((1.0+zpc2)-(1.0-zpc2)*sin(pt_coord%LAT))
274 IF (lhook) CALL dr_hook(
'MODE_GEO_GAUSS:RETRE_V',1,zhook_handle)
282 REAL FUNCTION map_fac_s (POLE,PCODIL,PT_COORD) RESULT (PMF)
283 TYPE (lola),
INTENT(IN) :: pole, pt_coord
284 REAL,
INTENT(IN) :: pcodil
286 REAL(KIND=JPRB) :: zpc2
287 REAL(KIND=JPRB) :: zhook_handle
288 IF (lhook) CALL dr_hook(
'MODE_GEO_GAUSS:MAP_FAC_S',0,zhook_handle)
290 pmf = (2.0*pcodil)/((1+zpc2)+(1-zpc2)* &
291 (sin(pt_coord%LAT)*sin(pole%LAT)+cos(pt_coord%LAT)*cos(pole%LAT)*cos(pt_coord%LON-pole%LON)))
292 IF (lhook) CALL dr_hook(
'MODE_GEO_GAUSS:MAP_FAC_S',1,zhook_handle)
297 TYPE (lola),
INTENT(IN) :: pole
298 TYPE (lola),
DIMENSION(:),
INTENT(IN) :: pt_coord
299 REAL,
INTENT(IN) :: pcodil
300 REAL,
DIMENSION(SIZE(PT_COORD)) :: pmf
302 REAL(KIND=JPRB),
DIMENSION(SIZE(PT_COORD)) :: zpc2
303 REAL(KIND=JPRB) :: zhook_handle
305 IF (lhook) CALL dr_hook(
'MODE_GEO_GAUSS:MAP_FAC_V',0,zhook_handle)
307 pmf = (2.0*pcodil)/((1+zpc2)+(1-zpc2)* &
308 (sin(pt_coord%LAT)*sin(pole%LAT)+cos(pt_coord%LAT)*cos(pole%LAT)*cos(pt_coord%LON-pole%LON)))
309 IF (lhook) CALL dr_hook(
'MODE_GEO_GAUSS:MAP_FAC_V',1,zhook_handle)
TYPE(LOLA) function retre_s(PT_COORD, PCODIL)
real function, dimension(size(pt_coord)) map_fac_v(POLE, PCODIL, PT_COORD)
TYPE(LOLA) function gauss_tr_s(PT_REEL, PT_POLE, PCODIL)
type(lola) function, dimension(size(pt_coord)) retre_v(PT_COORD, PCODIL)
TYPE(LOLA) function rotate_g_s(PT_TR, PT_POLE)
REAL function map_fac_s(POLE, PCODIL, PT_COORD)
TYPE(LOLA) function anti_rotate_g_s(PT_REEL, PT_POLE)
type(lola) function, dimension(size(pt_reel)) gauss_tr_v(PT_REEL, PT_POLE, PCODIL)
type(lola) function, dimension(size(pt_tr)) rotate_g_v(PT_TR, PT_POLE)
type(lola) function, dimension(size(pt_reel)) anti_rotate_g_v(PT_REEL, PT_POLE)
TYPE(LOLA) function gauss_rt_s(PT_G, PT_POLE, PCODIL)
type(lola) function, dimension(size(pt_g)) gauss_rt_v(PT_G, PT_POLE, PCODIL)
TYPE(LOLA) function etir_s(PT_COORD, PCODIL)
type(lola) function, dimension(size(pt_coord)) etir_v(PT_COORD, PCODIL)