1 | c $Header |
---|
2 | c****************************************************** |
---|
3 | SUBROUTINE pres2lev(varo,varn,lmo,lmn,po,pn, |
---|
4 | % ni,nj) |
---|
5 | c |
---|
6 | c interpolation lineaire pour passer |
---|
7 | c a une nouvelle discretisation verticale pour |
---|
8 | c les variables de GCM |
---|
9 | c Francois Forget (01/1995) |
---|
10 | c |
---|
11 | c MOdif remy roca 12/97 pour passer de pres2sig |
---|
12 | c********************************************************** |
---|
13 | |
---|
14 | IMPLICIT NONE |
---|
15 | |
---|
16 | c Declarations: |
---|
17 | c ============== |
---|
18 | c |
---|
19 | c ARGUMENTS |
---|
20 | c """"""""" |
---|
21 | |
---|
22 | INTEGER lmo ! dimensions ancienne couches (input) |
---|
23 | INTEGER lmn ! dimensions nouvelle couches (input) |
---|
24 | INTEGER lmomx ! dimensions ancienne couches (input) |
---|
25 | INTEGER lmnmx ! dimensions nouvelle couches (input) |
---|
26 | |
---|
27 | parameter(lmomx=10000,lmnmx=10000) |
---|
28 | |
---|
29 | real po(lmo)! niveau de pression en millibars |
---|
30 | real pn(ni,nj,lmn) ! niveau de pression en pascals |
---|
31 | |
---|
32 | INTEGER i,j,Nhoriz,ni,nj ! nombre de point horizontale (input) |
---|
33 | |
---|
34 | REAL varo(ni,nj,lmo) ! var dans l'ancienne grille (input) |
---|
35 | REAL varn(ni,nj,lmn) ! var dans la nouvelle grille (output) |
---|
36 | |
---|
37 | real zvaro(lmomx),zpo(lmomx) |
---|
38 | |
---|
39 | c Autres variables |
---|
40 | c """""""""""""""" |
---|
41 | INTEGER n, ln ,lo |
---|
42 | REAL coef |
---|
43 | |
---|
44 | c run |
---|
45 | c ==== |
---|
46 | do i=1,ni |
---|
47 | do j=1,nj |
---|
48 | c a chaque point de grille correspond un nouveau sigma old |
---|
49 | c qui vaut pres(l)/ps(i,j) |
---|
50 | do lo=1,lmo |
---|
51 | zpo(lo)=po(lmo+1-lo) |
---|
52 | zvaro(lo)=varo(i,j,lmo+1-lo) |
---|
53 | enddo |
---|
54 | |
---|
55 | do ln=1,lmn |
---|
56 | if (pn(i,j,ln).ge.zpo(1))then |
---|
57 | varn(i,j,ln) = zvaro(1) |
---|
58 | else if (pn(i,j,ln).le.zpo(lmo)) then |
---|
59 | varn(i,j,ln) = zvaro(lmo) |
---|
60 | else |
---|
61 | do lo=1,lmo-1 |
---|
62 | if ( (pn(i,j,ln).le.zpo(lo)).and. |
---|
63 | & (pn(i,j,ln).gt.zpo(lo+1)) )then |
---|
64 | coef=(pn(i,j,ln)-zpo(lo)) |
---|
65 | & /(zpo(lo+1)-zpo(lo)) |
---|
66 | varn(i,j,ln)=zvaro(lo) |
---|
67 | & +coef*(zvaro(lo+1)-zvaro(lo)) |
---|
68 | c print*,'pn(',ln,')=',pn(i,j,ln),varn(i,j,ln) |
---|
69 | end if |
---|
70 | enddo |
---|
71 | endif |
---|
72 | enddo |
---|
73 | |
---|
74 | enddo |
---|
75 | enddo |
---|
76 | return |
---|
77 | end |
---|