source: LMDZ4/trunk/libf/dyn3d/pres2lev.F @ 1351

Last change on this file since 1351 was 1279, checked in by Laurent Fairhead, 15 years ago

Merged LMDZ4-dev branch changes r1241:1278 into the trunk
Running trunk and LMDZ4-dev in LMDZOR configuration on local
machine (sequential) and SX8 (4-proc) yields identical results
(restart and restartphy are identical binarily)
Log history from r1241 to r1278 is available by switching to
source:LMDZ4/branches/LMDZ4-dev-20091210

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 2.4 KB
Line 
1! $Id: pres2lev.F 1279 2009-12-10 09:02:56Z musat $
2!
3c******************************************************
4      SUBROUTINE   pres2lev(varo,varn,lmo,lmn,po,pn,
5     %                      ni,nj,ok_invertp)
6c
7c interpolation lineaire pour passer
8c a une nouvelle discretisation verticale pour
9c les variables de GCM
10c Francois Forget (01/1995)
11c MOdif remy roca 12/97 pour passer de pres2sig
12c Modif F.Codron 07/08 po en 3D
13c**********************************************************
14
15      IMPLICIT NONE
16
17c   Declarations:
18c ==============
19c
20c  ARGUMENTS
21c  """""""""
22       LOGICAL, INTENT(IN) :: ok_invertp
23       INTEGER, INTENT(IN) :: lmo ! dimensions ancienne couches
24       INTEGER, INTENT(IN) :: lmn ! dimensions nouvelle couches
25       INTEGER lmomx ! dimensions ancienne couches
26       INTEGER lmnmx ! dimensions nouvelle couches
27
28       parameter(lmomx=10000,lmnmx=10000)
29
30        real, INTENT(IN) :: po(ni,nj,lmo) ! niveau de pression ancienne grille
31        real, INTENT(IN) :: pn(ni,nj,lmn) ! niveau de pression nouvelle grille
32
33       INTEGER, INTENT(IN) :: ni,nj ! nombre de point horizontale
34
35       REAL, INTENT(IN)  :: varo(ni,nj,lmo) ! var dans l'ancienne grille
36       REAL, INTENT(OUT) :: varn(ni,nj,lmn) ! var dans la nouvelle grille
37
38       real zvaro(lmomx),zpo(lmomx)
39
40c Autres variables
41c """"""""""""""""
42       INTEGER n, ln ,lo, i, j, Nhoriz
43       REAL coef
44
45c run
46c ====
47        do i=1,ni
48        do j=1,nj
49! Inversion de l'ordre des niveaux verticaux
50          IF (ok_invertp) THEN
51           do lo=1,lmo
52              zpo(lo)=po(i,j,lmo+1-lo)
53              zvaro(lo)=varo(i,j,lmo+1-lo)
54           enddo
55          ELSE
56           do lo=1,lmo
57              zpo(lo)=po(i,j,lo)
58              zvaro(lo)=varo(i,j,lo)
59           enddo
60          ENDIF
61
62           do ln=1,lmn
63              if (pn(i,j,ln).ge.zpo(1))then
64                 varn(i,j,ln) =  zvaro(1)
65              else if (pn(i,j,ln).le.zpo(lmo)) then
66                 varn(i,j,ln) =  zvaro(lmo)
67              else
68                 do lo=1,lmo-1
69                    if ( (pn(i,j,ln).le.zpo(lo)).and.
70     &                 (pn(i,j,ln).gt.zpo(lo+1)) )then
71                       coef=(pn(i,j,ln)-zpo(lo))
72     &                 /(zpo(lo+1)-zpo(lo))
73                       varn(i,j,ln)=zvaro(lo)
74     &                 +coef*(zvaro(lo+1)-zvaro(lo))
75c       print*,'pn(',ln,')=',pn(i,j,ln),varn(i,j,ln)
76                    end if
77                 enddo           
78              endif
79           enddo
80
81        enddo
82        enddo
83      return
84      end   
Note: See TracBrowser for help on using the repository browser.