/[lmdze]/trunk/libf/dyn3d/pres2lev.f
ViewVC logotype

Contents of /trunk/libf/dyn3d/pres2lev.f

Parent Directory Parent Directory | Revision Log Revision Log


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

  ViewVC Help
Powered by ViewVC 1.1.21