New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
agrif_extrapolation.f90 in branches/DEV_r1879_FCM/NEMOGCM/TOOLS/NESTING/src – NEMO

source: branches/DEV_r1879_FCM/NEMOGCM/TOOLS/NESTING/src/agrif_extrapolation.f90 @ 2143

Last change on this file since 2143 was 2143, checked in by rblod, 13 years ago

Improvement of FCM branch

  • Property svn:keywords set to Id
File size: 19.7 KB
Line 
1!************************************************************************
2! Fortran 95 OPA Nesting tools                  *
3!                          *
4!     Copyright (C) 2005 Florian Lemarié (Florian.Lemarie@imag.fr)   *
5!                          *
6!************************************************************************
7!
8MODULE agrif_extrapolation
9  !
10  USE agrif_types
11  USE agrif_readwrite 
12  USE io_netcdf 
13  USE agrif_gridsearch 
14 
15  IMPLICIT NONE
16
17CONTAINS
18  !
19  !************************************************************************
20  !                           *
21  ! MODULE  AGRIF_EXTRAPOLATION                 *
22  !                           *
23  !************************************************************************   
24  !     
25  !****************************************************************
26  !     subroutine extrap_detect             *
27  !                        *
28  !     detection on each level of points          *
29  !     where extrapolation is required            *
30  !                        *
31  !****************************************************************         
32  !     
33  !
34  SUBROUTINE extrap_detect(G0,G1,detected,n,posvar) 
35    !     
36    LOGICAL, DIMENSION(:,:) :: detected
37    TYPE(Coordinates) :: G0,G1       
38    CHARACTER(*), OPTIONAL :: posvar
39    INTEGER :: i,j,k,ic,jc,compt,dst_add,n
40    INTEGER, DIMENSION(1) :: i_min,j_min     
41    !                               
42    IF( PRESENT(posvar) .AND. posvar == 'U' ) THEN     
43       CALL get_detected_pts(G0%gphiu,G1%gphiu,G0%glamu,G1%glamu,   &
44            G0%umask(:,:,n),G1%umask(:,:,n),detected(:,:))       
45    ELSE IF( PRESENT(posvar) .AND. posvar == 'V' ) THEN
46       !     
47       CALL get_detected_pts(G0%gphiv,G1%gphiv,G0%glamv,G1%glamv,   &
48            G0%vmask(:,:,n),G1%vmask(:,:,n),detected(:,:))                                 
49    ELSE
50       CALL get_detected_pts(G0%nav_lat,G1%nav_lat,G0%nav_lon,G1%nav_lon,   &
51            G0%tmask(:,:,n),G1%tmask(:,:,n),detected(:,:))       
52    ENDIF
53    !     
54  END SUBROUTINE extrap_detect
55  !     
56  !   
57  !****************************************************************
58  !     end subroutine extrap_detect            *
59  !****************************************************************
60  !     
61  !     
62  !****************************************************************
63  !    subroutine correct_field              *
64  ! correct field on detected points            *
65  !                        *
66  !****************************************************************         
67  !
68  SUBROUTINE correct_field(detected_pts,tabin,tabinkm1,tabinkm2,G0,nav_lev,newmask,k,posvar)
69    !
70    LOGICAL, DIMENSION(:,:) :: detected_pts
71    LOGICAL, DIMENSION(:,:) :: newmask
72    CHARACTER(*),OPTIONAL :: posvar
73    INTEGER :: k
74    !
75    INTEGER :: i,j,ii,jj,nx,ny,n,lbi,ubi,lbj,ubj,kpos,ipos,jpos,r
76    !
77    REAL*8, DIMENSION(:,:,:,:) ::  tabin
78    REAL*8, DIMENSION(:,:,:,:) ::  tabinkm1
79    REAL*8, DIMENSION(:,:,:,:) ::  tabinkm2
80    REAL*8, DIMENSION(:) :: nav_lev
81    REAL*8, DIMENSION(:,:,:), ALLOCATABLE :: mask
82    REAL*8, DIMENSION(:,:), ALLOCATABLE :: lon,lat 
83    REAL*8 :: deriv,deriv_min
84    LOGICAL :: found
85    !     
86    TYPE(Coordinates) :: G0 
87    !
88    ! copy coarse grid mask in newmask
89    !           
90    IF ( PRESENT(posvar) .AND. posvar == 'U' ) THEN
91       WHERE(G0%umask(:,:,k) == 1. )
92          newmask(:,:) = .TRUE.
93       ELSEWHERE
94          newmask(:,:) = .FALSE.
95       END WHERE
96       ALLOCATE(mask(SIZE(G0%umask,1),SIZE(G0%umask,2),SIZE(G0%umask,3)))
97       ALLOCATE(lat(SIZE(G0%umask,1),SIZE(G0%umask,2)))
98       ALLOCATE(lon(SIZE(G0%umask,1),SIZE(G0%umask,2)))
99       mask = G0%umask
100       lat = G0%gphiu 
101       lon = G0%glamu     
102    ELSE IF ( PRESENT(posvar) .AND. posvar == 'V' ) THEN
103       WHERE(G0%vmask(:,:,k) == 1. )
104          newmask(:,:) = .TRUE.
105       ELSEWHERE
106          newmask(:,:) = .FALSE.
107       END WHERE
108       ALLOCATE(mask(SIZE(G0%vmask,1),SIZE(G0%vmask,2),SIZE(G0%vmask,3)))
109       ALLOCATE(lat(SIZE(G0%vmask,1),SIZE(G0%vmask,2)))
110       ALLOCATE(lon(SIZE(G0%vmask,1),SIZE(G0%vmask,2)))
111       mask = G0%vmask       
112       lat = G0%gphiv 
113       lon = G0%glamv
114    ELSE     
115       WHERE(G0%tmask(:,:,k) == 1. )
116          newmask(:,:) = .TRUE.
117       ELSEWHERE
118          newmask(:,:) = .FALSE.
119       END WHERE
120       ALLOCATE(mask(SIZE(G0%tmask,1),SIZE(G0%tmask,2),SIZE(G0%tmask,3)))
121       ALLOCATE(lat(SIZE(G0%tmask,1),SIZE(G0%tmask,2)))
122       ALLOCATE(lon(SIZE(G0%tmask,1),SIZE(G0%tmask,2)))
123       mask = G0%tmask
124       lon = G0%nav_lon
125       lat = G0%nav_lat
126    ENDIF
127    !
128    ! dimensions initialisation
129    !
130    nx = SIZE(tabin,1)
131    ny = SIZE(tabin,2)   
132    !
133    !       
134    DO j = 1,ny   
135       !
136       DO i = 1,nx         
137          !
138          IF( detected_pts(i,j) ) THEN       
139             !
140             r = 0
141             found = .FALSE.
142             deriv_min = 2000000.
143             ipos=0
144             jpos=0
145             !
146             DO WHILE(.NOT. found)
147                !
148                r = r + 1     
149                !       
150                IF(i-r < 1 ) THEN
151                   lbi = 1
152                   ubi = MIN(i+r,nx)
153                ELSE IF(i+r > nx) THEN
154                   lbi = MAX(i-r,1)
155                   ubi = nx
156                ELSE
157                   lbi = i-r
158                   ubi = i+r
159                ENDIF
160                !
161                IF(j-r < 1) THEN
162                   lbj = 1
163                   ubj = MIN(j+r,ny)
164                ELSE IF(j+r > ny) THEN
165                   lbj = MAX(j-r,1)
166                   ubj = ny
167                ELSE
168                   lbj = j-r
169                   ubj = j+r
170                ENDIF
171                !
172                DO jj = lbj,ubj,ubj-lbj
173                   DO ii = lbi,ubi,ubi-lbi
174                      !
175                      deriv = search_pts_h(ii,jj,k,i,j,k,tabin(:,:,1,1),mask,lon,lat) 
176                      !
177                      IF( ABS(deriv) < deriv_min ) THEN                                                   
178                         deriv_min = ABS(deriv)
179                         ipos = ii
180                         jpos = jj
181                         kpos = k
182                      ENDIF
183                      !                           
184                      deriv = search_pts_v(ii,jj,k-1,i,j,k,tabinkm1,tabinkm2,mask,nav_lev,lon,lat)
185                      !
186                      IF( ABS(deriv) < deriv_min ) THEN                                                   
187                         deriv_min = ABS(deriv)
188                         ipos = ii
189                         jpos = jj
190                         kpos = k-1
191                      ENDIF
192                      !                                       
193                   END DO
194                END DO
195                !
196                !                                 
197                IF( deriv_min < 2000000.  ) THEN 
198                   !               
199                   IF(kpos == k)   tabin(i,j,1,1) = tabin(ipos,jpos,1,1)
200                   IF(kpos == k-1) tabin(i,j,1,1) = tabinkm1(ipos,jpos,1,1)   
201                   found = .TRUE.
202                   newmask(i,j) = .TRUE.
203                ELSE IF ((lbi == 1).AND.(ubi == nx).AND.(lbj == 1).AND.(ubj == ny)) THEN
204                   found = .TRUE.
205                   newmask(i,j) = .FALSE.
206                   !
207                ENDIF
208                !
209             END DO !do while
210             !
211          ENDIF
212          !
213       END DO
214       !
215    END DO
216    !
217    DEALLOCATE(mask,lon,lat)
218    !
219  END SUBROUTINE correct_field
220  !     
221  !**************************************************************
222  !    end subroutine correct_field
223  !**************************************************************         
224 
225  SUBROUTINE correct_field_2d(detected_pts,tabin,G0,newmask,posvar)
226    !
227    LOGICAL, DIMENSION(:,:) :: detected_pts
228    LOGICAL, DIMENSION(:,:) :: newmask
229    CHARACTER(*), OPTIONAL :: posvar
230    LOGICAL :: found
231    INTEGER :: k
232    !
233    INTEGER :: i,j,ii,jj,nx,ny,n,lbi,ubi,lbj,ubj,ipos,jpos,r
234    !
235    REAL*8, DIMENSION(:,:,:), ALLOCATABLE :: mask
236    REAL*8, DIMENSION(:,:), ALLOCATABLE :: lon,lat 
237    REAL*8, DIMENSION(:,:,:) ::  tabin
238    REAL*8 :: deriv,deriv_min
239    !     
240    TYPE(Coordinates) :: G0 
241    !
242    ! copy coarse grid mask in newmask
243    !           
244    mask = G0%tmask
245    lon = G0%nav_lon
246    lat = G0%nav_lat     
247    IF ( PRESENT(posvar) .AND. posvar == 'U' ) THEN
248       WHERE(G0%umask(:,:,1) == 1. )
249          newmask(:,:) = .TRUE.
250       ELSEWHERE
251          newmask(:,:) = .FALSE.
252       END WHERE
253       ALLOCATE(mask(SIZE(G0%umask,1),SIZE(G0%umask,2),SIZE(G0%umask,3)))
254       ALLOCATE(lat(SIZE(G0%umask,1),SIZE(G0%umask,2)))
255       ALLOCATE(lon(SIZE(G0%umask,1),SIZE(G0%umask,2)))
256       mask = G0%umask
257       lat = G0%gphiu 
258       lon = G0%glamu     
259    ELSE IF ( PRESENT(posvar) .AND. posvar == 'V' ) THEN
260       WHERE(G0%vmask(:,:,1) == 1. )
261          newmask(:,:) = .TRUE.
262       ELSEWHERE
263          newmask(:,:) = .FALSE.
264       END WHERE
265       ALLOCATE(mask(SIZE(G0%vmask,1),SIZE(G0%vmask,2),SIZE(G0%vmask,3)))
266       ALLOCATE(lat(SIZE(G0%vmask,1),SIZE(G0%vmask,2)))
267       ALLOCATE(lon(SIZE(G0%vmask,1),SIZE(G0%vmask,2)))
268       mask = G0%vmask       
269       lat = G0%gphiv 
270       lon = G0%glamv
271    ELSE     
272       WHERE(G0%tmask(:,:,1) == 1. )
273          newmask(:,:) = .TRUE.
274       ELSEWHERE
275          newmask(:,:) = .FALSE.
276       END WHERE
277       ALLOCATE(mask(SIZE(G0%tmask,1),SIZE(G0%tmask,2),SIZE(G0%tmask,3)))
278       ALLOCATE(lat(SIZE(G0%tmask,1),SIZE(G0%tmask,2)))
279       ALLOCATE(lon(SIZE(G0%tmask,1),SIZE(G0%tmask,2)))
280       mask = G0%tmask
281       lon = G0%nav_lon
282       lat = G0%nav_lat
283    ENDIF
284
285    !
286    ! dimensions initialisation
287    !
288    nx = SIZE(tabin,1)
289    ny = SIZE(tabin,2)   
290    !       
291    DO i = 1,nx         
292       !
293       DO j = 1,ny   
294          !                   
295          !                     
296          IF( detected_pts(i,j) ) THEN       
297             !
298             r = 0 
299             found = .FALSE.
300             deriv_min = 2000000.
301             ipos=0
302             jpos=0
303             !
304             DO WHILE (.NOT. found )
305
306                !
307                r = r + 1 
308                !
309                IF(i-r < 1 ) THEN
310                   lbi = 1
311                   ubi = MIN(i+r,nx)
312                ELSE IF(i+r > nx) THEN
313                   lbi = MAX(i-r,1)
314                   ubi = nx
315                ELSE
316                   lbi = i-r
317                   ubi = i+r
318                ENDIF
319                !
320                IF(j-r < 1) THEN
321                   lbj = 1
322                   ubj = MIN(j+r,ny)
323                ELSE IF(j+r > ny) THEN
324                   lbj = MAX(j-r,1)
325                   ubj = ny
326                ELSE
327                   lbj = j-r
328                   ubj = j+r
329                ENDIF
330                !                                 
331                DO ii = lbi,ubi
332                   DO jj = lbj,ubj
333                      !
334                      deriv = search_pts_h(ii,jj,1,i,j,1,tabin(:,:,1),mask,lon,lat) 
335                      !
336                      IF( ABS(deriv) < deriv_min ) THEN                                                   
337                         deriv_min = ABS(deriv)
338                         ipos = ii
339                         jpos = jj
340                      ENDIF
341                      !                                       
342                   END DO
343                END DO
344                !
345                !                                   
346                IF( deriv_min < 2000000.  ) THEN 
347                   !
348                   found = .TRUE.                                             
349                   tabin(i,j,1) = tabin(ipos,jpos,1) 
350                   newmask(i,j) = .TRUE.
351                   !
352                ENDIF
353                !
354             END DO !do while
355             !
356          ENDIF
357          !
358       END DO
359       !
360    END DO
361    !
362    DEALLOCATE(mask,lon,lat)
363    !
364  END SUBROUTINE correct_field_2d
365  !     
366  !**************************************************************
367  !    function get_dist
368  !**************************************************************         
369  !
370
371  !
372  REAL*8 FUNCTION  get_dist(plat1,plon1,plat2,plon2)
373    !
374    REAL*8 :: plat1,plon1,plat2,plon2
375    REAL*8 :: dist,ra,rad,rpi,lat,lon
376    !     
377    rpi = 3.141592653589793
378    rad = rpi/180.
379    ra  = 6371229.   
380    !     
381    lat = plat2-plat1
382    lon = plon2-plon1
383    !
384    dist = ra * rad * SQRT( (COS(rad*(plat1+plat2)/2.)*lon)**2 + lat**2 )         
385    get_dist = dist
386    RETURN
387    !
388  END FUNCTION get_dist
389
390  !
391  !     
392  !**************************************************************
393  !    end function get_dist
394  !**************************************************************
395  !
396  !     
397  !**************************************************************
398  !    subroutine check_extrap
399  !**************************************************************         
400  !
401
402  !
403  SUBROUTINE check_extrap(Grid,tabin,k)
404    !
405    REAL*8, DIMENSION(:,:,:,:) ::  tabin
406    TYPE(Coordinates) :: Grid 
407    INTEGER :: i,j,k 
408   
409    DO i = 2,SIZE(tabin,1)-1
410       DO j=2,SIZE(tabin,2)-1
411          !                     
412          IF( Grid%tmask(i,j,k) == 1. .AND. tabin(i,j,1,1)==0.) THEN
413             !     
414             WRITE(*,*) 'no masked point with value zero (',i,',',j,',',k,')'
415             !                   
416          ENDIF
417
418       END DO
419    END DO
420    !
421  END SUBROUTINE check_extrap
422
423  !
424  !     
425  !**************************************************************
426  !    end subroutine check_extrap
427  !************************************************************** 
428  !
429  !**************************************************************
430  !    subroutine search_pts_h
431  !**************************************************************
432  !
433  REAL*8 FUNCTION search_pts_h(i,j,k,ipt,jpt,kpt,tabvar,mask,lon,lat)
434    !
435    REAL*8 :: hx,hy,fx,fy
436    REAL*8 :: h_x,h_y
437    REAL*8, DIMENSION(:,:) :: tabvar
438    INTEGER :: i,j,k,ipt,jpt,kpt,nx,ny
439    LOGICAL :: foundx,foundy
440    REAL*8, DIMENSION(:,:,:) :: mask
441    REAL*8, DIMENSION(:,:) :: lon,lat
442    !
443    !
444    foundx = .TRUE.
445    foundy = .TRUE.
446    !     
447    nx = SIZE(tabvar,1)
448    ny = SIZE(tabvar,2)
449    !
450    IF( i==ipt .AND. j==jpt ) THEN   
451       search_pts_h = 2000000.
452       RETURN
453    ENDIF
454    !     
455    IF( mask(i,j,k) == 0. ) THEN   
456       search_pts_h = 2000000.
457       RETURN
458    ENDIF
459    !
460    ! x direction
461    !
462    IF(i+1<=nx .AND. i-1>=1) THEN
463       IF(mask(i+1,j,k)==1. .AND. mask(i-1,j,k)==1.) THEN     
464          hx = get_dist(lat(i+1,j),lon(i+1,j),&
465               lat(i-1,j),lon(i-1,j))
466          fx = (tabvar(i+1,j) - tabvar(i-1,j))/hx
467       ELSE IF(mask(i+1,j,k)==1. .AND. mask(i-1,j,k)==0. .AND. mask(i,j,k)==1.) THEN
468          hx = get_dist(lat(i+1,j),lon(i+1,j),&
469               lat(i,j),lon(i,j))
470          fx = (tabvar(i+1,j) - tabvar(i,j))/hx
471       ELSE IF(mask(i+1,j,k)==0. .AND. mask(i-1,j,k)==1. .AND. mask(i,j,k)==1.) THEN
472          hx = get_dist(lat(i,j),lon(i,j),&
473               lat(i-1,j),lon(i-1,j))
474          fx = (tabvar(i,j) - tabvar(i-1,j))/hx
475       ELSE
476          foundx = .FALSE.                 
477       ENDIF
478       !           
479    ELSE IF(i+1<=nx .AND. i>=1) THEN   
480       !
481       IF(mask(i+1,j,k)==1. .AND. mask(i,j,k)==1.) THEN     
482          hx = get_dist(lat(i+1,j),lon(i+1,j),&
483               lat(i,j),lon(i,j))
484          fx = (tabvar(i+1,j) - tabvar(i,j))/hx
485       ELSE
486          foundx = .FALSE.             
487       ENDIF
488       !   
489    ELSE IF(i<=nx .AND. i-1>=1) THEN   
490       !
491       IF(mask(i,j,k)==1. .AND. mask(i-1,j,k)==1.) THEN     
492          hx = get_dist(lat(i,j),lon(i,j),&
493               lat(i-1,j),lon(i-1,j))
494          fx = (tabvar(i,j) - tabvar(i-1,j))/hx
495       ELSE
496          foundx = .FALSE.           
497       ENDIF
498       !
499    ELSE
500        foundy = .FALSE.             
501    ENDIF
502
503    !
504    ! y direction
505    !
506    IF(j+1<=ny .AND. j-1>=1) THEN     
507       IF( mask(i,j+1,k)==1. .AND. mask(i,j-1,k)==1. ) THEN     
508          hy = get_dist(lat(i,j+1),lon(i,j+1),&
509               lat(i,j-1),lon(i,j-1))                     
510          fy = (tabvar(i,j+1) - tabvar(i,j-1))/hy
511       ELSE IF( mask(i,j+1,k)==1. .AND. mask(i,j-1,k)==0. .AND. mask(i,j,k)==1.) THEN     
512          hy = get_dist(lat(i,j+1),lon(i,j+1),&
513               lat(i,j),lon(i,j))                     
514          fy = (tabvar(i,j+1) - tabvar(i,j))/hy     
515       ELSE IF( mask(i,j+1,k)==0. .AND. mask(i,j-1,k)==1. .AND. mask(i,j,k)==1.) THEN     
516          hy = get_dist(lat(i,j),lon(i,j),&
517               lat(i,j-1),lon(i,j-1))                     
518          fy = (tabvar(i,j) - tabvar(i,j-1))/hy     
519       ELSE
520          foundy = .FALSE.                   
521       ENDIF
522       !           
523    ELSE IF(j+1<=ny .AND. j>=1) THEN   
524       !
525       IF(mask(i,j+1,k)==1. .AND. mask(i,j,k)==1.) THEN     
526          hy = get_dist(lat(i,j+1),lon(i,j+1),&
527               lat(i,j),lon(i,j))
528          fy = (tabvar(i,j+1) - tabvar(i,j))/hy
529       ELSE
530          foundy = .FALSE.           
531       ENDIF
532       !   
533    ELSE IF(j<=ny .AND. j-1>=1) THEN   
534       !
535       IF(mask(i,j,k)==1. .AND. mask(i,j-1,k)==1.) THEN     
536          hy = get_dist(lat(i,j),lon(i,j),&
537               lat(i,j-1),lon(i,j-1))
538          fy = (tabvar(i,j) - tabvar(i,j-1))/hy
539       ELSE
540          foundy = .FALSE.             
541       ENDIF
542       !
543    ELSE
544        foundy = .FALSE.             
545    ENDIF
546    !                   
547    h_x = get_dist(lat(ipt,jpt),lon(ipt,jpt),lat(ipt,jpt),lon(i,j))
548    h_y = get_dist(lat(ipt,jpt),lon(ipt,jpt),lat(i,j),lon(ipt,jpt))
549    !
550    IF(.NOT.foundx .AND. .NOT.foundy)THEN     
551       search_pts_h = 2000000.
552    ELSE IF( foundx .AND. foundy) THEN       
553       search_pts_h = h_x * fx + h_y * fy
554    ELSE IF( .NOT.foundx .AND. foundy .AND. h_y.NE.0.) THEN       
555       search_pts_h = h_y * fy
556    ELSE IF( foundx .AND. .NOT.foundy .AND. h_x.NE.0.) THEN       
557       search_pts_h = h_x * fx
558    ELSE   
559       search_pts_h = 2000000.             
560    ENDIF
561
562    !     
563    RETURN         
564    !
565  END FUNCTION search_pts_h
566  !
567  !**************************************************************
568  !    end subroutine search_pts_h
569  !**************************************************************
570  !
571  !**************************************************************
572  !    subroutine search_pts_v
573  !**************************************************************
574  !
575  REAL*8 FUNCTION search_pts_v(i,j,k,ipt,jpt,kpt,tabvarkm1,tabvarkm2,mask,depth,lon,lat)
576    !
577    REAL*8 :: hz,fz,dz,fh
578    REAL*8, DIMENSION(:) :: depth 
579    REAL*8, DIMENSION(:,:,:,:) :: tabvarkm1,tabvarkm2
580    INTEGER :: i,j,k,ipt,jpt,kpt,nx,ny
581    LOGICAL :: foundz
582    REAL*8, DIMENSION(:,:,:) :: mask
583    REAL*8, DIMENSION(:,:) :: lon,lat
584    !         
585    IF( k <= 2 .OR. mask(i,j,k) == 0.   ) THEN
586       !
587       search_pts_v = 2000000.
588       RETURN
589       !
590    ELSE IF( i==ipt .AND. j==jpt .AND. mask(i,j,k-1) == 1. .AND. mask(i,j,k-2) == 1. ) THEN
591       !
592       dz = depth(k) - depth(k-1)
593       hz = depth(kpt) - depth(k)     
594       search_pts_v = ((tabvarkm2(i,j,1,1) - tabvarkm1(i,j,1,1))/dz)*hz
595       RETURN
596       !
597    ELSE
598       !
599       IF( mask(i,j,k) == 1. .AND. mask(i,j,k-1) == 1. ) THEN
600          !                         
601          dz = depth(k) - depth(k-1)
602          fz = (tabvarkm2(i,j,1,1) - tabvarkm1(i,j,1,1))/dz
603          hz = depth(kpt) - depth(k)
604          !
605       ELSE
606          foundz = .FALSE.
607       ENDIF
608       !             
609       fh = search_pts_h(i,j,k,ipt,jpt,k,tabvarkm1(:,:,1,1),mask,lon,lat)
610       !
611       IF(foundz) THEN
612          search_pts_v = hz * fz + fh
613          RETURN
614       ELSE       
615          search_pts_v = 2000000. 
616          RETURN
617       ENDIF
618       !
619    ENDIF
620    WRITE(*,*) 'cas 2', search_pts_v
621    !     
622    RETURN         
623    !
624  END FUNCTION search_pts_v
625  !
626  !**************************************************************
627  !    end subroutine search_pts_v
628  !**************************************************************
629  !
630  !
631END MODULE agrif_extrapolation
Note: See TracBrowser for help on using the repository browser.