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

Diff of /trunk/dyn3d/pres2lev.f

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

trunk/dyn3d/pres2lev.f revision 76 by guez, Fri Nov 15 18:45:49 2013 UTC trunk/dyn3d/pres2lev.f90 revision 81 by guez, Wed Mar 5 14:38:41 2014 UTC
# Line 1  Line 1 
1  !  
2  ! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/pres2lev.F,v 1.1.1.1 2004/05/19 12:53:07 lmdzadmin Exp $  ! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/pres2lev.F,v 1.1.1.1 2004/05/19
3  !  ! 12:53:07 lmdzadmin Exp $
4  c******************************************************  
5        SUBROUTINE   pres2lev(varo,varn,lmo,lmn,po,pn,  ! ******************************************************
6       &                      ni,nj)  SUBROUTINE pres2lev(varo, varn, lmo, lmn, po, pn, ni, nj)
7  c  
8  c interpolation lineaire pour passer    ! interpolation lineaire pour passer
9  c a une nouvelle discretisation verticale pour    ! a une nouvelle discretisation verticale pour
10  c les variables de GCM    ! les variables de GCM
11  c Francois Forget (01/1995)    ! Francois Forget (01/1995)
12  c  
13  c MOdif remy roca 12/97 pour passer de pres2sig    ! MOdif remy roca 12/97 pour passer de pres2sig
14  c**********************************************************    ! **********************************************************
15    
16        IMPLICIT NONE    IMPLICIT NONE
17    
18  c   Declarations:    ! Declarations:
19  c ==============    ! ==============
20  c  
21  c  ARGUMENTS    ! ARGUMENTS
22  c  """""""""    ! """""""""
23    
24         INTEGER lmo ! dimensions ancienne couches (input)    INTEGER lmo ! dimensions ancienne couches (input)
25         INTEGER lmn ! dimensions nouvelle couches (input)    INTEGER lmn ! dimensions nouvelle couches (input)
26         INTEGER lmomx ! dimensions ancienne couches (input)    INTEGER lmomx ! dimensions ancienne couches (input)
27         INTEGER lmnmx ! dimensions nouvelle couches (input)    INTEGER lmnmx ! dimensions nouvelle couches (input)
28    
29         parameter(lmomx=10000,lmnmx=10000)    PARAMETER (lmomx=10000, lmnmx=10000)
30    
31          real po(lmo)! niveau de pression en millibars    REAL po(lmo) ! niveau de pression en millibars
32          integer ni,nj    INTEGER ni, nj
33          real pn(ni,nj,lmn) ! niveau de pression en pascals    REAL pn(ni, nj, lmn) ! niveau de pression en pascals
34    
35         INTEGER i,j,Nhoriz ! nombre de point horizontale (input)    INTEGER i, j, nhoriz ! nombre de point horizontale (input)
36    
37         REAL varo(ni,nj,lmo) ! var dans l'ancienne grille (input)    REAL varo(ni, nj, lmo) ! var dans l'ancienne grille (input)
38         REAL varn(ni,nj,lmn) ! var dans la nouvelle grille (output)    REAL varn(ni, nj, lmn) ! var dans la nouvelle grille (output)
39    
40         real zvaro(lmomx),zpo(lmomx)    REAL zvaro(lmomx), zpo(lmomx)
41    
42  c Autres variables    ! Autres variables
43  c """"""""""""""""    ! """"""""""""""""
44         INTEGER n, ln ,lo    INTEGER n, ln, lo
45         REAL coef    REAL coef
46    
47  c run    ! run
48  c ====    ! ====
49          do i=1,ni    DO i = 1, ni
50          do j=1,nj      DO j = 1, nj
51  c a chaque point de grille correspond un nouveau sigma old        ! a chaque point de grille correspond un nouveau sigma old
52  c qui vaut pres(l)/ps(i,j)        ! qui vaut pres(l)/ps(i,j)
53             do lo=1,lmo        DO lo = 1, lmo
54                zpo(lo)=po(lmo+1-lo)          zpo(lo) = po(lmo+1-lo)
55                zvaro(lo)=varo(i,j,lmo+1-lo)          zvaro(lo) = varo(i, j, lmo+1-lo)
56             enddo        END DO
57            
58             do ln=1,lmn        DO ln = 1, lmn
59                if (pn(i,j,ln).ge.zpo(1))then          IF (pn(i,j,ln)>=zpo(1)) THEN
60                   varn(i,j,ln) =  zvaro(1)            varn(i, j, ln) = zvaro(1)
61                else if (pn(i,j,ln).le.zpo(lmo)) then          ELSE IF (pn(i,j,ln)<=zpo(lmo)) THEN
62                   varn(i,j,ln) =  zvaro(lmo)            varn(i, j, ln) = zvaro(lmo)
63                else          ELSE
64                   do lo=1,lmo-1            DO lo = 1, lmo - 1
65                      if ( (pn(i,j,ln).le.zpo(lo)).and.              IF ((pn(i,j,ln)<=zpo(lo)) .AND. (pn(i,j,ln)>zpo(lo+1))) THEN
66       &                 (pn(i,j,ln).gt.zpo(lo+1)) )then                coef = (pn(i,j,ln)-zpo(lo))/(zpo(lo+1)-zpo(lo))
67                         coef=(pn(i,j,ln)-zpo(lo))                varn(i, j, ln) = zvaro(lo) + coef*(zvaro(lo+1)-zvaro(lo))
68       &                 /(zpo(lo+1)-zpo(lo))                ! print*,'pn(',ln,')=',pn(i,j,ln),varn(i,j,ln)
69                         varn(i,j,ln)=zvaro(lo)              END IF
70       &                 +coef*(zvaro(lo+1)-zvaro(lo))            END DO
71  c       print*,'pn(',ln,')=',pn(i,j,ln),varn(i,j,ln)          END IF
72                      end if        END DO
73                   enddo            
74                endif      END DO
75             enddo    END DO
76      RETURN
77          enddo  END SUBROUTINE pres2lev
         enddo  
       return  
       end      
Legend:
Removed from v.76  
changed lines
  Added in v.81
  ViewVC Help
Powered by ViewVC 1.1.21