/[lmdze]/trunk/dyn3d/Guide/Read_reanalyse/pres2lev.f
ViewVC logotype

Diff of /trunk/dyn3d/Guide/Read_reanalyse/pres2lev.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

trunk/libf/dyn3d/pres2lev.f revision 3 by guez, Wed Feb 27 13:16:39 2008 UTC trunk/dyn3d/Guide/Read_reanalyse/pres2lev.f revision 254 by guez, Mon Feb 5 10:39:38 2018 UTC
# Line 1  Line 1 
1  !  module pres2lev_m
2  ! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/pres2lev.F,v 1.1.1.1 2004/05/19 12:53:07 lmdzadmin Exp $  
3  !    IMPLICIT NONE
4  c******************************************************  
5        SUBROUTINE   pres2lev(varo,varn,lmo,lmn,po,pn,  contains
6       &                      ni,nj)  
7  c    SUBROUTINE pres2lev(varo, varn, po, pn)
8  c interpolation lineaire pour passer  
9  c a une nouvelle discretisation verticale pour      ! From LMDZ4/libf/dyn3d/pres2lev.F, version 1.1.1.1 2004/05/19 12:53:07
10  c les variables de GCM  
11  c Francois Forget (01/1995)      ! Interpolation lin\'eaire pour passer \`a une nouvelle
12  c      ! discr\'etisation verticale pour les variables de GCM.
13  c MOdif remy roca 12/97 pour passer de pres2sig  
14  c**********************************************************      ! Francois Forget (January 1995)
15    
16        IMPLICIT NONE      REAL, intent(in):: varo(:, :, :) ! (ni, nj, lmo) var in the old grid
17        REAL, intent(out):: varn(:, :, :) ! (ni, nj, lmn)! var in the new grid
18  c   Declarations:  
19  c ==============      REAL, intent(in):: po(:) ! (lmo)
20  c      ! pressure levels, old  (in monotonic order), in hPa
21  c  ARGUMENTS  
22  c  """""""""      REAL, intent(in):: pn(:, :, :) ! (ni, nj, lmn) pressure levels, new, in Pa
23    
24         INTEGER lmo ! dimensions ancienne couches (input)      ! Local:
25         INTEGER lmn ! dimensions nouvelle couches (input)      INTEGER lmn ! dimensions nouvelle couches
26         INTEGER lmomx ! dimensions ancienne couches (input)      INTEGER ni, nj
27         INTEGER lmnmx ! dimensions nouvelle couches (input)      INTEGER lmo ! dimensions ancienne couches
28        INTEGER i, j
29         parameter(lmomx=10000,lmnmx=10000)      REAL zvaro(size(po))
30        real zpo(size(po)) ! pressure levels, old, in descending order, in hPa
31          real po(lmo)! niveau de pression en millibars      INTEGER ln, lo
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)      lmo = size(po)
36        ni = size(varn, 1)
37         REAL varo(ni,nj,lmo) ! var dans l'ancienne grille (input)      nj = size(varn, 2)
38         REAL varn(ni,nj,lmn) ! var dans la nouvelle grille (output)      lmn = size(varn, 3)
39    
40         real zvaro(lmomx),zpo(lmomx)      DO i = 1, ni
41           DO j = 1, nj
42  c Autres variables            if (po(1) < po(2)) then
43  c """"""""""""""""               ! Inversion de l'ordre des niveaux verticaux :
44         INTEGER n, ln ,lo               zpo = po(lmo:1:- 1)
45         REAL coef               zvaro = varo(i, j, lmo:1:- 1)
46              else
47  c run               zpo = po
48  c ====               zvaro = varo(i, j, :)
49          do i=1,ni            end if
50          do j=1,nj  
51  c a chaque point de grille correspond un nouveau sigma old            DO ln = 1, lmn
52  c qui vaut pres(l)/ps(i,j)               IF (pn(i, j, ln) >= zpo(1)) THEN
53             do lo=1,lmo                  varn(i, j, ln) = zvaro(1)
54                zpo(lo)=po(lmo+1-lo)               ELSE IF (pn(i, j, ln) <= zpo(lmo)) THEN
55                zvaro(lo)=varo(i,j,lmo+1-lo)                  varn(i, j, ln) = zvaro(lmo)
56             enddo               ELSE
57                            DO lo = 1, lmo - 1
58             do ln=1,lmn                     IF ((pn(i, j, ln) <= zpo(lo)) &
59                if (pn(i,j,ln).ge.zpo(1))then                          .AND. (pn(i, j, ln) > zpo(lo + 1))) THEN
60                   varn(i,j,ln) =  zvaro(1)                        varn(i, j, ln) = zvaro(lo) + (pn(i, j, ln) - zpo(lo)) &
61                else if (pn(i,j,ln).le.zpo(lmo)) then                             / (zpo(lo + 1) - zpo(lo)) * (zvaro(lo + 1) &
62                   varn(i,j,ln) =  zvaro(lmo)                             - zvaro(lo))
63                else                     END IF
64                   do lo=1,lmo-1                  END DO
65                      if ( (pn(i,j,ln).le.zpo(lo)).and.               END IF
66       &                 (pn(i,j,ln).gt.zpo(lo+1)) )then            END DO
67                         coef=(pn(i,j,ln)-zpo(lo))         END DO
68       &                 /(zpo(lo+1)-zpo(lo))      END DO
69                         varn(i,j,ln)=zvaro(lo)  
70       &                 +coef*(zvaro(lo+1)-zvaro(lo))    END SUBROUTINE pres2lev
71  c       print*,'pn(',ln,')=',pn(i,j,ln),varn(i,j,ln)  
72                      end if  end module pres2lev_m
                  enddo            
               endif  
            enddo  
   
         enddo  
         enddo  
       return  
       end      
Legend:
Removed from v.3  
changed lines
  Added in v.254
  ViewVC Help
Powered by ViewVC 1.1.21