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

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

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

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