source: LMDZ5/branches/LMDZ6_rc0/libf/phylmd/plevel.F90 @ 3069

Last change on this file since 3069 was 2283, checked in by Laurent Fairhead, 9 years ago

Backport of trunk revisions 2271, 2279, 2280, 2282 into LMDZ6_rc0 branch:

  • modifications for NMC/XIOS
  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.5 KB
Line 
1
2! $Header$
3
4! ================================================================
5! ================================================================
6SUBROUTINE plevel(ilon, ilev, lnew, pgcm, pres, qgcm, qpres)
7  ! ================================================================
8  ! ================================================================
9  USE netcdf
10  USE dimphy
11#ifdef CPP_IOIPSL
12  USE phys_state_var_mod, ONLY: missing_val_nf90
13#endif
14#ifdef CPP_XIOS
15  USE wxios, ONLY: missing_val
16#endif
17  IMPLICIT NONE
18
19  ! ym#include "dimensions.h"
20  ! y#include "dimphy.h"
21
22  ! ================================================================
23
24  ! Interpoler des champs 3-D u, v et g du modele a un niveau de
25  ! pression donnee (pres)
26
27  ! INPUT:  ilon ----- nombre de points
28  ! ilev ----- nombre de couches
29  ! lnew ----- true si on doit reinitialiser les poids
30  ! pgcm ----- pressions modeles
31  ! pres ----- pression vers laquelle on interpolle
32  ! Qgcm ----- champ GCM
33  ! Qpres ---- champ interpolle au niveau pres
34
35  ! ================================================================
36
37  ! arguments :
38  ! -----------
39
40  INTEGER ilon, ilev
41  LOGICAL lnew
42
43  REAL pgcm(ilon, ilev)
44  REAL qgcm(ilon, ilev)
45  REAL pres
46  REAL qpres(ilon)
47
48  ! local :
49  ! -------
50
51  ! ym      INTEGER lt(klon), lb(klon)
52  ! ym      REAL ptop, pbot, aist(klon), aisb(klon)
53
54  ! ym      save lt,lb,ptop,pbot,aist,aisb
55  INTEGER, ALLOCATABLE, SAVE, DIMENSION (:) :: lt, lb
56  REAL, ALLOCATABLE, SAVE, DIMENSION (:) :: aist, aisb
57  !$OMP THREADPRIVATE(lt,lb,aist,aisb)
58  REAL, SAVE :: ptop, pbot
59  !$OMP THREADPRIVATE(ptop, pbot)
60  LOGICAL, SAVE :: first = .TRUE.
61  !$OMP THREADPRIVATE(first)
62  INTEGER i, k
63
64! REAL missing_val
65#ifndef CPP_XIOS
66  REAL :: missing_val
67#endif
68
69! missing_val = nf90_fill_real
70
71#ifndef CPP_XIOS
72      missing_val=missing_val_nf90
73#endif
74
75  IF (first) THEN
76    ALLOCATE (lt(klon), lb(klon), aist(klon), aisb(klon))
77    first = .FALSE.
78  END IF
79
80  ! =====================================================================
81  IF (lnew) THEN
82    ! on r�nitialise les r�ndicages et les poids
83    ! =====================================================================
84
85
86    ! Chercher les 2 couches les plus proches du niveau a obtenir
87
88    ! Eventuellement, faire l'extrapolation a partir des deux couches
89    ! les plus basses ou les deux couches les plus hautes:
90    DO i = 1, klon
91      IF (abs(pres-pgcm(i,ilev))<abs(pres-pgcm(i,1))) THEN
92        lt(i) = ilev ! 2
93        lb(i) = ilev - 1 ! 1
94      ELSE
95        lt(i) = 2
96        lb(i) = 1
97      END IF
98    END DO
99    DO k = 1, ilev - 1
100      DO i = 1, klon
101        pbot = pgcm(i, k)
102        ptop = pgcm(i, k+1)
103        IF (ptop<=pres .AND. pbot>=pres) THEN
104          lt(i) = k + 1
105          lb(i) = k
106        END IF
107      END DO
108    END DO
109
110    ! Interpolation lineaire:
111
112    DO i = 1, klon
113      ! interpolation en logarithme de pression:
114
115      ! ...   Modif . P. Le Van    ( 20/01/98) ....
116      ! Modif Fr��ic Hourdin (3/01/02)
117
118      aist(i) = log(pgcm(i,lb(i))/pres)/log(pgcm(i,lb(i))/pgcm(i,lt(i)))
119      aisb(i) = log(pres/pgcm(i,lt(i)))/log(pgcm(i,lb(i))/pgcm(i,lt(i)))
120    END DO
121
122
123  END IF ! lnew
124
125  ! ======================================================================
126  ! inteprollation
127  ! ======================================================================
128
129  DO i = 1, klon
130    qpres(i) = qgcm(i, lb(i))*aisb(i) + qgcm(i, lt(i))*aist(i)
131  END DO
132
133  ! Je mets les vents a zero quand je rencontre une montagne
134  DO i = 1, klon
135    IF (pgcm(i,1)<pres) THEN
136      qpres(i) = missing_val
137    END IF
138  END DO
139
140
141  RETURN
142END SUBROUTINE plevel
Note: See TracBrowser for help on using the repository browser.