Commit 2b3059935d2a0cf134788e27ea3018277b711d1b

Authored by caveenj
1 parent cbf68cea
Exists in master

Correction d'un bogue de calcul d'indices par l'ajout d'un test permettant

de s'assurer que les limites min-max des axes du tableau de sortie soient
respectees avant d'y ajouter une valeur.
Showing 2 changed files with 50 additions and 15 deletions   Show diff stats
@@ -13,16 +13,20 @@ @@ -13,16 +13,20 @@
13 # 13 #
14 # include platform specific macro definitions 14 # include platform specific macro definitions
15 # 15 #
16 -HOSTTYPE = solaris 16 +#HOSTTYPE = solaris
  17 +HOSTTYPE = i486-linux
17 18
18 -#MY_EXTFCNS = /home/caveenj/projets/ferret_compnc/external_fcns 19 +MY_EXTFCNS = /home/caveenj/projets/ferret_compnc/ferret_ef
19 20
20 # 21 #
21 # Pour le developpement, adapter la valeur de FER_LOCAL_EXTFCNS 22 # Pour le developpement, adapter la valeur de FER_LOCAL_EXTFCNS
22 #selon vos besoins 23 #selon vos besoins
23 # 24 #
24 25
25 -#FER_LOCAL_EXTFCNS = $(MY_EXTFCNS) 26 +FER_LOCAL_EXTFCNS = $(MY_EXTFCNS)
  27 +
  28 +FFLAGS_DEBUG = -g
  29 +CFLAGS_DEBUG = -g
26 30
27 include ../ef_utility/platform_specific_flags.mk.$(HOSTTYPE) 31 include ../ef_utility/platform_specific_flags.mk.$(HOSTTYPE)
28 32
@@ -9,6 +9,10 @@ @@ -9,6 +9,10 @@
9 * Decompresse un champ de points mouilles et 9 * Decompresse un champ de points mouilles et
10 * reconstruit le champ 3D correspondant 10 * reconstruit le champ 3D correspondant
11 * 11 *
  12 +* $Id: nc_rar.F,v 1.3 2007-02-14 14:43:34 caveenj Exp $
  13 +*
  14 +* $Log: not supported by cvs2svn $
  15 +*
12 * 16 *
13 * 17 *
14 * In this subroutine we provide information about 18 * In this subroutine we provide information about
@@ -219,8 +223,10 @@ @@ -219,8 +223,10 @@
219 * 223 *
220 * Le tableau XAX est un tableau de travail qui contiendra 224 * Le tableau XAX est un tableau de travail qui contiendra
221 * les coordonnnes des points sur le vecteur comprime (pts mouilles) 225 * les coordonnnes des points sur le vecteur comprime (pts mouilles)
222 -*  
223 - real*8 xax(wrk1lox:wrk1hix,wrk1loy:wrk1hiy,wrk1loz:wrk1hiz, 226 +* On divise la dimension wrk1hix par 2 car dans la fonction
  227 +* d'allocation d'espace de travail, on a alloue deux fois
  228 +* plus d'espace pour tenir compte du fait que xax est real*8
  229 + real*8 xax(wrk1lox:wrk1hix/2,wrk1loy:wrk1hiy,wrk1loz:wrk1hiz,
224 $ wrk1lot:wrk1hit) 230 $ wrk1lot:wrk1hit)
225 231
226 * After initialization, the 'res_' arrays contain indexing information 232 * After initialization, the 'res_' arrays contain indexing information
@@ -245,6 +251,7 @@ @@ -245,6 +251,7 @@
245 251
246 integer dimxy,dimx,indx,indy,indz,indice 252 integer dimxy,dimx,indx,indy,indz,indice
247 253
  254 +
248 CALL ef_get_res_subscripts(id, res_lo_ss, res_hi_ss, res_incr) 255 CALL ef_get_res_subscripts(id, res_lo_ss, res_hi_ss, res_incr)
249 CALL ef_get_arg_subscripts(id, arg_lo_ss, arg_hi_ss, arg_incr) 256 CALL ef_get_arg_subscripts(id, arg_lo_ss, arg_hi_ss, arg_incr)
250 CALL ef_get_bad_flags(id, bad_flag, bad_flag_result) 257 CALL ef_get_bad_flags(id, bad_flag, bad_flag_result)
@@ -258,8 +265,19 @@ @@ -258,8 +265,19 @@
258 $ ARG2),arg_hi_ss(X_AXIS,ARG2),xax) 265 $ ARG2),arg_hi_ss(X_AXIS,ARG2),xax)
259 266
260 267
  268 +#if defined DEBUG
  269 + write(6,*)'res_lo_ss(X_AXIS), res_hi_ss(X_AXIS)',
  270 + & res_lo_ss(X_AXIS), res_hi_ss(X_AXIS)
261 271
  272 + write(6,*)'res_lo_ss(Y_AXIS), res_hi_ss(Y_AXIS)',
  273 + & res_lo_ss(Y_AXIS), res_hi_ss(Y_AXIS)
262 274
  275 + write(6,*)'res_lo_ss(Z_AXIS), res_hi_ss(Z_AXIS)',
  276 + & res_lo_ss(Z_AXIS), res_hi_ss(Z_AXIS)
  277 +
  278 + write(6,*)'res_lo_ss(T_AXIS), res_hi_ss(T_AXIS)',
  279 + & res_lo_ss(T_AXIS), res_hi_ss(T_AXIS)
  280 +#endif
263 C 281 C
264 C Initialiser le champ de sortie a des manquants 282 C Initialiser le champ de sortie a des manquants
265 C 283 C
@@ -292,16 +310,14 @@ C @@ -292,16 +310,14 @@ C
292 dimxy = res_hi_ss(X_AXIS)*res_hi_ss(Y_AXIS) 310 dimxy = res_hi_ss(X_AXIS)*res_hi_ss(Y_AXIS)
293 dimx = res_hi_ss(X_AXIS) 311 dimx = res_hi_ss(X_AXIS)
294 312
295 -  
296 * 313 *
297 *Calcul de l'indice de depart j et k du champ compresse 314 *Calcul de l'indice de depart j et k du champ compresse
298 *cet indice demeure constant dans le calcul 315 *cet indice demeure constant dans le calcul
299 -* 316 +* et est probablement = -111 ( i.e., non defini)
300 j2 = arg_lo_ss(Y_AXIS,ARG2) 317 j2 = arg_lo_ss(Y_AXIS,ARG2)
301 k2 = arg_lo_ss(Z_AXIS,ARG2) 318 k2 = arg_lo_ss(Z_AXIS,ARG2)
302 319
303 320
304 -*  
305 * Ici, on boucle sur les coordonnes des points mouilles 321 * Ici, on boucle sur les coordonnes des points mouilles
306 * et on recalcule les coordonnes i,j,k du champ 3D 322 * et on recalcule les coordonnes i,j,k du champ 3D
307 * a partir de la coordonnee 1D 323 * a partir de la coordonnee 1D
@@ -316,17 +332,32 @@ C @@ -316,17 +332,32 @@ C
316 indice = indice - indz*dimxy 332 indice = indice - indz*dimxy
317 indy = (indice - 1)/dimx 333 indy = (indice - 1)/dimx
318 indx = indice - indy*dimx 334 indx = indice - indy*dimx
319 - indz = indz + 1 335 + indz = indz + 1
320 indy = indy + 1 336 indy = indy + 1
321 - l2 = arg_lo_ss(T_AXIS,ARG2) 337 +
  338 +*
  339 +* On s'assure que les indices calcules sont a
  340 +* l'interieur du domaine demande
  341 +*
  342 + if( (indx .ge. res_lo_ss(X_AXIS) .and.
  343 + & indx .le. res_hi_ss(X_AXIS)) .and.
  344 + & (indy .ge. res_lo_ss(Y_AXIS) .and.
  345 + & indy .le. res_hi_ss(Y_AXIS)) .and.
  346 + & (indz .ge. res_lo_ss(Z_AXIS) .and.
  347 + & indz .le. res_hi_ss(Z_AXIS))) then
  348 +
  349 +
322 * 350 *
323 * On repete l'operation pour chaque pas de temps demande 351 * On repete l'operation pour chaque pas de temps demande
324 * 352 *
325 - do l = res_lo_ss(T_AXIS),res_hi_ss(T_AXIS)  
326 - result(indx,indy,indz,l) = arg_2(i2,j2,k2,l2)  
327 - l2 = l2 + arg_incr(T_AXIS,ARG2)  
328 - enddo  
329 - enddo 353 + l2 = arg_lo_ss(T_AXIS,ARG2)
  354 +
  355 + do l = res_lo_ss(T_AXIS),res_hi_ss(T_AXIS)
  356 + result(indx,indy,indz,l) = arg_2(i2,j2,k2,l2)
  357 + l2 = l2 + arg_incr(T_AXIS,ARG2)
  358 + enddo
  359 + endif
  360 + enddo
330 361
331 362
332 363