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