/[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

trunk/dyn3d/Read_reanalyse/reanalyse2nat.f revision 88 by guez, Tue Mar 11 15:09:02 2014 UTC trunk/Sources/dyn3d/Guide/Read_reanalyse/reanalyse2nat.f revision 178 by guez, Fri Mar 11 18:47:26 2016 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: 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 massdair_m, only: massdair      use massbar_m, only: massbar
19        USE paramet_m, ONLY: iip1, jjp1, llmp1
20        use pres2lev_m, only: pres2lev
21    
22        logical, intent(in):: invert_y
23        real, intent(in):: psi(:, :) ! (iip1, jjp1)
24    
25      integer nlevnc      real, intent(in):: unc(:, :, :) ! (iip1, jjp1, :)
26      real, intent(in):: psi(iip1, jjp1)      real, intent(in):: vnc(:, :, :) ! (iip1, jjm, :)
27      real unc(iip1, jjp1, nlevnc), vnc(iip1, jjm, nlevnc)      real, intent(in):: tnc(:, :, :) ! (iip1, jjp1, :)
28      real tnc(iip1, jjp1, nlevnc)      real, intent(in):: qnc(:, :, :) ! (iip1, jjp1, :)
29      real qnc(iip1, jjp1, nlevnc)      real, intent(in):: pl(:)
30      real pl(nlevnc)  
31      real u(iip1, jjp1, llm), v(iip1, jjm, llm)      real, intent(out):: u(:, :, :) ! (iip1, jjp1, llm)
32      real t(iip1, jjp1, llm), q(iip1, jjp1, llm)      real, intent(out):: v(:, :, :) ! (iip1, jjm, llm)
33      real masse(iip1, jjp1, llm)      real, intent(out):: t(:, :, :), q(:, :, :) ! (iip1, jjp1, llm)
34      real pk(iip1, jjp1, llm)      real, intent(out):: pk(:, :, :) ! (iip1, jjp1, llm)
35    
36      ! Local:      ! Local:
37    
# Line 41  contains Line 45  contains
45    
46      real p(iip1, jjp1, llmp1)      real p(iip1, jjp1, llmp1)
47      real pks(iip1, jjp1)      real pks(iip1, jjp1)
     real pkf(iip1, jjp1, llm)  
48      real pls(iip1, jjp1, llm)      real pls(iip1, jjp1, llm)
49      real prefkap, unskap      real unskap
50    
51      integer i, j, l      integer i, j, l
52    
# Line 51  contains Line 54  contains
54    
55      ! calcul de la pression au milieu des couches      ! calcul de la pression au milieu des couches
56      forall (l = 1: llm + 1) p(:, :, l) = ap(l) + bp(l) * psi      forall (l = 1: llm + 1) p(:, :, l) = ap(l) + bp(l) * psi
57      call massdair(p, masse)      CALL exner_hyb(psi, p, pks, pk)
     CALL exner_hyb(psi, p, pks, pk, pkf)  
58    
59      ! Calcul de pls, pression au milieu des couches, en Pascals      ! Calcul de pls, pression au milieu des couches, en Pascals
60      unskap=1./kappa      unskap=1./kappa
     prefkap = preff ** kappa  
61      DO l = 1, llm      DO l = 1, llm
62         DO j=1, jjp1         DO j=1, jjp1
63            DO i =1, iip1            DO i =1, iip1
# Line 91  contains Line 92  contains
92         enddo         enddo
93      enddo      enddo
94    
95      call pres2lev(unc, zu, nlevnc, llm, pl, plunc, iip1, jjp1)      call pres2lev(unc, zu, pl, plunc)
96      call pres2lev(vnc, zv, nlevnc, llm, pl, plvnc, iip1, jjm )      call pres2lev(vnc, zv, pl, plvnc )
97      call pres2lev(tnc, zt, nlevnc, llm, pl, plsnc, iip1, jjp1)      call pres2lev(tnc, zt, pl, plsnc)
98      call pres2lev(qnc, zq, nlevnc, llm, pl, plsnc, iip1, jjp1)      call pres2lev(qnc, zq, pl, plsnc)
99    
100      ! Inversion Nord/Sud      if (invert_y) then
101      do l=1, llm         ! Inversion Nord/Sud
102         do j=1, jjp1         u=zu(:, jjp1:1:-1, :)
103            do i=1, iim         v=zv(:, jjm:1:-1, :)
104               u(i, j, l)=zu(i, jjp1+1-j, l)         t=zt(:, jjp1:1:-1, :)
105               t(i, j, l)=zt(i, jjp1+1-j, l)         q=zq(:, jjp1:1:-1, :)
106               q(i, j, l)=zq(i, jjp1+1-j, l)      else
107            enddo         u = zu
108            u(iip1, j, l)=u(1, j, l)         v = zv
109            t(iip1, j, l)=t(1, j, l)         t = zt
110            q(iip1, j, l)=q(1, j, l)         q = zq
111         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  
112    
113    end subroutine reanalyse2nat    end subroutine reanalyse2nat
114    
Legend:
Removed from v.88  
changed lines
  Added in v.178
  ViewVC Help
Powered by ViewVC 1.1.21