1 |
|
|
c |
2 |
|
|
c $Id: interp_horiz.F 1907 2013-11-26 13:10:46Z lguez $ |
3 |
|
|
c |
4 |
|
|
subroutine interp_horiz (varo,varn,imo,jmo,imn,jmn,lm, |
5 |
|
|
& rlonuo,rlatvo,rlonun,rlatvn) |
6 |
|
|
|
7 |
|
|
c=========================================================== |
8 |
|
|
c Interpolation Horizontales des variables d'une grille LMDZ |
9 |
|
|
c (des points SCALAIRES au point SCALAIRES) |
10 |
|
|
c dans une autre grille LMDZ en conservant la quantite |
11 |
|
|
c totale pour les variables intensives (/m2) : ex : Pression au sol |
12 |
|
|
c |
13 |
|
|
c Francois Forget (01/1995) |
14 |
|
|
c=========================================================== |
15 |
|
|
|
16 |
|
|
IMPLICIT NONE |
17 |
|
|
|
18 |
|
|
c Declarations: |
19 |
|
|
c ============== |
20 |
|
|
c |
21 |
|
|
c ARGUMENTS |
22 |
|
|
c """"""""" |
23 |
|
|
|
24 |
|
|
integer imo, jmo ! dimensions ancienne grille (input) |
25 |
|
|
integer imn,jmn ! dimensions nouvelle grille (input) |
26 |
|
|
|
27 |
|
|
real rlonuo(imo+1) ! Latitude et |
28 |
|
|
real rlatvo(jmo) ! longitude des |
29 |
|
|
real rlonun(imn+1) ! bord des |
30 |
|
|
real rlatvn(jmn) ! cases "scalaires" (input) |
31 |
|
|
|
32 |
|
|
integer lm ! dimension verticale (input) |
33 |
|
|
real varo (imo+1, jmo+1,lm) ! var dans l'ancienne grille (input) |
34 |
|
|
real varn (imn+1,jmn+1,lm) ! var dans la nouvelle grille (output) |
35 |
|
|
|
36 |
|
|
c Autres variables |
37 |
|
|
c """""""""""""""" |
38 |
|
|
real airetest(imn+1,jmn+1) |
39 |
|
|
integer ii,jj,l |
40 |
|
|
|
41 |
|
|
real airen (imn+1,jmn+1) ! aire dans la nouvelle grille |
42 |
|
|
c Info sur les ktotal intersection entre les cases new/old grille |
43 |
|
|
integer kllm, k, ktotal |
44 |
|
|
parameter (kllm = 400*200*10) |
45 |
|
|
integer iik(kllm), jjk(kllm),jk(kllm),ik(kllm) |
46 |
|
|
real intersec(kllm) |
47 |
|
|
real R |
48 |
|
|
real totn, tots |
49 |
|
|
|
50 |
|
|
logical firstcall, firsttest, aire_ok |
51 |
|
|
save firsttest |
52 |
|
|
data firsttest /.true./ |
53 |
|
|
data aire_ok /.true./ |
54 |
|
|
|
55 |
|
|
|
56 |
|
|
|
57 |
|
|
|
58 |
|
|
|
59 |
|
|
c initialisation |
60 |
|
|
c -------------- |
61 |
|
|
c Si c'est le premier appel, on prepare l'interpolation |
62 |
|
|
c en calculant pour chaque case autour d'un point scalaire de la |
63 |
|
|
c nouvelle grille, la surface de intersection avec chaque |
64 |
|
|
c case de l'ancienne grille. |
65 |
|
|
|
66 |
|
|
|
67 |
|
|
call iniinterp_horiz (imo,jmo,imn,jmn ,kllm, |
68 |
|
|
& rlonuo,rlatvo,rlonun,rlatvn, |
69 |
|
|
& ktotal,iik,jjk,jk,ik,intersec,airen) |
70 |
|
|
|
71 |
|
|
do l=1,lm |
72 |
|
|
do jj =1 , jmn+1 |
73 |
|
|
do ii=1, imn+1 |
74 |
|
|
varn(ii,jj,l) =0. |
75 |
|
|
end do |
76 |
|
|
end do |
77 |
|
|
end do |
78 |
|
|
|
79 |
|
|
c Interpolation horizontale |
80 |
|
|
c ------------------------- |
81 |
|
|
c boucle sur toute les ktotal intersections entre les cases |
82 |
|
|
c de l'ancienne et la nouvelle grille |
83 |
|
|
c |
84 |
|
|
PRINT *, 'ktotal 1 = ', ktotal |
85 |
|
|
|
86 |
|
|
do k=1,ktotal |
87 |
|
|
do l=1,lm |
88 |
|
|
varn(iik(k),jjk(k),l) = varn(iik(k),jjk(k),l) |
89 |
|
|
& + varo(ik(k), jk(k),l)*intersec(k)/airen(iik(k),jjk(k)) |
90 |
|
|
end do |
91 |
|
|
end do |
92 |
|
|
|
93 |
|
|
c Une seule valeur au pole pour les variables ! : |
94 |
|
|
c ----------------------------------------------- |
95 |
|
|
do l=1, lm |
96 |
|
|
totn =0. |
97 |
|
|
tots =0. |
98 |
|
|
do ii =1, imn+1 |
99 |
|
|
totn = totn + varn(ii,1,l) |
100 |
|
|
tots = tots + varn (ii,jmn+1,l) |
101 |
|
|
end do |
102 |
|
|
do ii =1, imn+1 |
103 |
|
|
varn(ii,1,l) = totn/REAL(imn+1) |
104 |
|
|
varn(ii,jmn+1,l) = tots/REAL(imn+1) |
105 |
|
|
end do |
106 |
|
|
end do |
107 |
|
|
|
108 |
|
|
|
109 |
|
|
c--------------------------------------------------------------- |
110 |
|
|
c TEST TEST TEST TEST TEST TEST TEST TEST TEST TEST |
111 |
|
|
!! if (.not.(firsttest)) goto 99 |
112 |
|
|
!! firsttest = .false. |
113 |
|
|
!! ! write (*,*) 'INTERP. HORIZ. : TEST SUR LES AIRES:' |
114 |
|
|
!! do jj =1 , jmn+1 |
115 |
|
|
!! do ii=1, imn+1 |
116 |
|
|
!! airetest(ii,jj) =0. |
117 |
|
|
!! end do |
118 |
|
|
!! end do |
119 |
|
|
!! PRINT *, 'ktotal = ', ktotal |
120 |
|
|
!! PRINT *, 'jmn+1 =', jmn+1, 'imn+1', imn+1 |
121 |
|
|
!! |
122 |
|
|
!! do k=1,ktotal |
123 |
|
|
!! airetest(iik(k),jjk(k))= airetest(iik(k),jjk(k)) +intersec(k) |
124 |
|
|
!! end DO |
125 |
|
|
!! |
126 |
|
|
!! |
127 |
|
|
!! PRINT *, 'fin boucle' |
128 |
|
|
!! do jj =1 , jmn+1 |
129 |
|
|
!! do ii=1, imn+1 |
130 |
|
|
!! r = airen(ii,jj)/airetest(ii,jj) |
131 |
|
|
!! if ((r.gt.1.001).or.(r.lt.0.999)) then |
132 |
|
|
!! ! write (*,*) '********** PROBLEME D'' AIRES !!!', |
133 |
|
|
!! ! & ' DANS L''INTERPOLATION HORIZONTALE' |
134 |
|
|
!! ! write(*,*)'ii,jj,airen,airetest', |
135 |
|
|
!! ! & ii,jj,airen(ii,jj),airetest(ii,jj) |
136 |
|
|
!! aire_ok = .false. |
137 |
|
|
!! end if |
138 |
|
|
!! end do |
139 |
|
|
!! end do |
140 |
|
|
!! ! if (aire_ok) write(*,*) 'INTERP. HORIZ. : AIRES OK' |
141 |
|
|
!! 99 continue |
142 |
|
|
|
143 |
|
|
c FIN TEST FIN TEST FIN TEST FIN TEST FIN TEST FIN TEST FIN TEST |
144 |
|
|
c--------------------------------------------------------------- |
145 |
|
|
|
146 |
|
|
|
147 |
|
|
|
148 |
|
|
|
149 |
|
|
|
150 |
|
|
|
151 |
|
|
|
152 |
|
|
|
153 |
|
|
return |
154 |
|
|
end |