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

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

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

revision 137 by guez, Wed May 6 15:51:03 2015 UTC revision 173 by guez, Tue Oct 6 15:57:02 2015 UTC
# Line 4  module reanalyse2nat_m Line 4  module reanalyse2nat_m
4    
5  contains  contains
6    
7    subroutine reanalyse2nat(nlevnc, psi, unc, vnc, tnc, qnc, pl, u, v, t, q, &    subroutine reanalyse2nat(invert_y, psi, unc, vnc, tnc, qnc, pl, u, v, t, q, &
8         masse, pk)         pk)
9    
10      ! Inversion nord-sud de la grille et interpolation sur les niveaux      ! Inversion nord-sud de la grille et interpolation verticale sur
11      ! verticaux du modèle.      ! les niveaux du modèle.
12    
     USE dimens_m, ONLY: iim, jjm, llm  
     USE paramet_m, ONLY: iip1, jjp1, llmp1  
13      USE comconst, ONLY: cpp, kappa      USE comconst, ONLY: cpp, kappa
     USE disvert_m, ONLY: ap, bp, preff  
14      USE comgeom, ONLY: aireu_2d, airev_2d, aire_2d      USE comgeom, ONLY: aireu_2d, airev_2d, aire_2d
15        USE dimens_m, ONLY: iim, jjm, llm
16        USE disvert_m, ONLY: ap, bp, preff
17      USE exner_hyb_m, ONLY: exner_hyb      USE exner_hyb_m, ONLY: exner_hyb
18      use massbar_m, only: massbar      use massbar_m, only: massbar
19      use massdair_m, only: massdair      use massdair_m, only: massdair
20        USE paramet_m, ONLY: iip1, jjp1, llmp1
21        use pres2lev_m, only: pres2lev
22    
23        logical, intent(in):: invert_y
24        real, intent(in):: psi(:, :) ! (iip1, jjp1)
25    
26      integer nlevnc      real, intent(in):: unc(:, :, :) ! (iip1, jjp1, :)
27      real, intent(in):: psi(iip1, jjp1)      real, intent(in):: vnc(:, :, :) ! (iip1, jjm, :)
28      real unc(iip1, jjp1, nlevnc), vnc(iip1, jjm, nlevnc)      real, intent(in):: tnc(:, :, :) ! (iip1, jjp1, :)
29      real tnc(iip1, jjp1, nlevnc)      real, intent(in):: qnc(:, :, :) ! (iip1, jjp1, :)
30      real qnc(iip1, jjp1, nlevnc)      real, intent(in):: pl(:)
31      real pl(nlevnc)  
32      real u(iip1, jjp1, llm), v(iip1, jjm, llm)      real, intent(out):: u(:, :, :) ! (iip1, jjp1, llm)
33      real t(iip1, jjp1, llm), q(iip1, jjp1, llm)      real, intent(out):: v(:, :, :) ! (iip1, jjm, llm)
34      real masse(iip1, jjp1, llm)      real, intent(out):: t(:, :, :), q(:, :, :) ! (iip1, jjp1, llm)
35      real pk(iip1, jjp1, llm)      real, intent(out):: pk(:, :, :) ! (iip1, jjp1, llm)
36    
37      ! Local:      ! Local:
38    
# Line 51  contains Line 55  contains
55    
56      ! calcul de la pression au milieu des couches      ! calcul de la pression au milieu des couches
57      forall (l = 1: llm + 1) p(:, :, l) = ap(l) + bp(l) * psi      forall (l = 1: llm + 1) p(:, :, l) = ap(l) + bp(l) * psi
     call massdair(p, masse)  
58      CALL exner_hyb(psi, p, pks, pk)      CALL exner_hyb(psi, p, pks, pk)
59    
60      ! Calcul de pls, pression au milieu des couches, en Pascals      ! Calcul de pls, pression au milieu des couches, en Pascals
# Line 91  contains Line 94  contains
94         enddo         enddo
95      enddo      enddo
96    
97      call pres2lev(unc, zu, nlevnc, llm, pl, plunc, iip1, jjp1)      call pres2lev(unc, zu, pl, plunc)
98      call pres2lev(vnc, zv, nlevnc, llm, pl, plvnc, iip1, jjm )      call pres2lev(vnc, zv, pl, plvnc )
99      call pres2lev(tnc, zt, nlevnc, llm, pl, plsnc, iip1, jjp1)      call pres2lev(tnc, zt, pl, plsnc)
100      call pres2lev(qnc, zq, nlevnc, llm, pl, plsnc, iip1, jjp1)      call pres2lev(qnc, zq, pl, plsnc)
101    
102      ! Inversion Nord/Sud      if (invert_y) then
103      do l=1, llm         ! Inversion Nord/Sud
104         do j=1, jjp1         u=zu(:, jjp1:1:-1, :)
105            do i=1, iim         v=zv(:, jjm:1:-1, :)
106               u(i, j, l)=zu(i, jjp1+1-j, l)         t=zt(:, jjp1:1:-1, :)
107               t(i, j, l)=zt(i, jjp1+1-j, l)         q=zq(:, jjp1:1:-1, :)
108               q(i, j, l)=zq(i, jjp1+1-j, l)      else
109            enddo         u = zu
110            u(iip1, j, l)=u(1, j, l)         v = zv
111            t(iip1, j, l)=t(1, j, l)         t = zt
112            q(iip1, j, l)=q(1, j, l)         q = zq
113         enddo      end if
     enddo  
   
     do l=1, llm  
        do j=1, jjm  
           do i=1, iim  
              v(i, j, l)=zv(i, jjm+1-j, l)  
           enddo  
           v(iip1, j, l)=v(1, j, l)  
        enddo  
     enddo  
114    
115    end subroutine reanalyse2nat    end subroutine reanalyse2nat
116    
Legend:
Removed from v.137  
changed lines
  Added in v.173
  ViewVC Help
Powered by ViewVC 1.1.21