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

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

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

revision 170 by guez, Wed Apr 29 15:47:56 2015 UTC revision 171 by guez, Tue Sep 29 19:48:59 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 $  
4    
5  ! ******************************************************  contains
 SUBROUTINE pres2lev(varo, varn, lmo, lmn, po, pn, ni, nj)  
6    
7    ! interpolation lineaire pour passer    SUBROUTINE pres2lev(varo, varn, lmo, lmn, po, pn, ni, nj)
   ! a une nouvelle discretisation verticale pour  
   ! les variables de GCM  
   ! Francois Forget (01/1995)  
8    
9    ! MOdif remy roca 12/97 pour passer de pres2sig      ! From LMDZ4/libf/dyn3d/pres2lev.F, v 1.1.1.1 2004/05/19 12:53:07
   ! **********************************************************  
10    
11    IMPLICIT NONE      ! interpolation lineaire pour passer
12        ! a une nouvelle discretisation verticale pour
13        ! les variables de GCM
14        ! Francois Forget (01/1995)
15    
16        ! MOdif remy roca 12/97 pour passer de pres2sig
17    
18        ! Declarations:
19    
20        ! ARGUMENTS
21        ! """""""""
22    
23        INTEGER lmo ! dimensions ancienne couches (input)
24        INTEGER lmn ! dimensions nouvelle couches (input)
25        INTEGER lmomx ! dimensions ancienne couches (input)
26        INTEGER lmnmx ! dimensions nouvelle couches (input)
27    
28        PARAMETER (lmomx=10000, lmnmx=10000)
29    
30    ! Declarations:      REAL po(lmo) ! niveau de pression en millibars
31    ! ==============      INTEGER ni, nj
32        REAL pn(ni, nj, lmn) ! niveau de pression en pascals
33    
34    ! ARGUMENTS      INTEGER i, j ! nombre de point horizontale (input)
   ! """""""""  
35    
36    INTEGER lmo ! dimensions ancienne couches (input)      REAL varo(ni, nj, lmo) ! var dans l'ancienne grille (input)
37    INTEGER lmn ! dimensions nouvelle couches (input)      REAL varn(ni, nj, lmn) ! var dans la nouvelle grille (output)
38    INTEGER lmomx ! dimensions ancienne couches (input)  
39    INTEGER lmnmx ! dimensions nouvelle couches (input)      REAL zvaro(lmomx), zpo(lmomx)
40    
41    PARAMETER (lmomx=10000, lmnmx=10000)      ! Autres variables
42        ! """"""""""""""""
43    REAL po(lmo) ! niveau de pression en millibars      INTEGER ln, lo
44    INTEGER ni, nj      REAL coef
45    REAL pn(ni, nj, lmn) ! niveau de pression en pascals  
46        ! run
47    INTEGER i, j ! nombre de point horizontale (input)  
48        DO i = 1, ni
49    REAL varo(ni, nj, lmo) ! var dans l'ancienne grille (input)         DO j = 1, nj
50    REAL varn(ni, nj, lmn) ! var dans la nouvelle grille (output)            ! a chaque point de grille correspond un nouveau sigma old
51              ! qui vaut pres(l)/ps(i, j)
52    REAL zvaro(lmomx), zpo(lmomx)            DO lo = 1, lmo
53                 zpo(lo) = po(lmo+1-lo)
54    ! Autres variables               zvaro(lo) = varo(i, j, lmo+1-lo)
   ! """"""""""""""""  
   INTEGER ln, lo  
   REAL coef  
   
   ! run  
   ! ====  
   DO i = 1, ni  
     DO j = 1, nj  
       ! a chaque point de grille correspond un nouveau sigma old  
       ! qui vaut pres(l)/ps(i,j)  
       DO lo = 1, lmo  
         zpo(lo) = po(lmo+1-lo)  
         zvaro(lo) = varo(i, j, lmo+1-lo)  
       END DO  
   
       DO ln = 1, lmn  
         IF (pn(i,j,ln)>=zpo(1)) THEN  
           varn(i, j, ln) = zvaro(1)  
         ELSE IF (pn(i,j,ln)<=zpo(lmo)) THEN  
           varn(i, j, ln) = zvaro(lmo)  
         ELSE  
           DO lo = 1, lmo - 1  
             IF ((pn(i,j,ln)<=zpo(lo)) .AND. (pn(i,j,ln)>zpo(lo+1))) THEN  
               coef = (pn(i,j,ln)-zpo(lo))/(zpo(lo+1)-zpo(lo))  
               varn(i, j, ln) = zvaro(lo) + coef*(zvaro(lo+1)-zvaro(lo))  
               ! print*,'pn(',ln,')=',pn(i,j,ln),varn(i,j,ln)  
             END IF  
55            END DO            END DO
         END IF  
       END DO  
56    
57              DO ln = 1, lmn
58                 IF (pn(i, j, ln)>=zpo(1)) THEN
59                    varn(i, j, ln) = zvaro(1)
60                 ELSE IF (pn(i, j, ln)<=zpo(lmo)) THEN
61                    varn(i, j, ln) = zvaro(lmo)
62                 ELSE
63                    DO lo = 1, lmo - 1
64                       IF ((pn(i, j, ln)<=zpo(lo)) .AND. (pn(i, j, ln)>zpo(lo+1))) THEN
65                          coef = (pn(i, j, ln)-zpo(lo))/(zpo(lo+1)-zpo(lo))
66                          varn(i, j, ln) = zvaro(lo) + coef*(zvaro(lo+1)-zvaro(lo))
67                          ! print*, 'pn(', ln, ')=', pn(i, j, ln), varn(i, j, ln)
68                       END IF
69                    END DO
70                 END IF
71              END DO
72    
73           END DO
74      END DO      END DO
75    END DO      RETURN
76    RETURN    END SUBROUTINE pres2lev
77  END SUBROUTINE pres2lev  
78    end module pres2lev_m
Legend:
Removed from v.170  
changed lines
  Added in v.171
  ViewVC Help
Powered by ViewVC 1.1.21