source: LMDZ6/trunk/libf/phylmd/plevel.F90 @ 3774

Last change on this file since 3774 was 2346, checked in by Ehouarn Millour, 9 years ago

Physics/dynamics separation:

  • remove all references to dimensions.h from physics. nbp_lon (==iim) , nbp_lat (==jjm+1) and nbp_lev (==llm) from mod_grid_phy_lmdz should be used instead.
  • added module regular_lonlat_mod in phy_common to store information about the global (lon-lat) grid cell boundaries and centers.

EM

  • 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  ! ================================================================
20
21  ! Interpoler des champs 3-D u, v et g du modele a un niveau de
22  ! pression donnee (pres)
23
24  ! INPUT:  ilon ----- nombre de points
25  ! ilev ----- nombre de couches
26  ! lnew ----- true si on doit reinitialiser les poids
27  ! pgcm ----- pressions modeles
28  ! pres ----- pression vers laquelle on interpolle
29  ! Qgcm ----- champ GCM
30  ! Qpres ---- champ interpolle au niveau pres
31
32  ! ================================================================
33
34  ! arguments :
35  ! -----------
36
37  INTEGER ilon, ilev
38  LOGICAL lnew
39
40  REAL pgcm(ilon, ilev)
41  REAL qgcm(ilon, ilev)
42  REAL pres
43  REAL qpres(ilon)
44
45  ! local :
46  ! -------
47
48  ! ym      INTEGER lt(klon), lb(klon)
49  ! ym      REAL ptop, pbot, aist(klon), aisb(klon)
50
51  ! ym      save lt,lb,ptop,pbot,aist,aisb
52  INTEGER, ALLOCATABLE, SAVE, DIMENSION (:) :: lt, lb
53  REAL, ALLOCATABLE, SAVE, DIMENSION (:) :: aist, aisb
54  !$OMP THREADPRIVATE(lt,lb,aist,aisb)
55  REAL, SAVE :: ptop, pbot
56  !$OMP THREADPRIVATE(ptop, pbot)
57  LOGICAL, SAVE :: first = .TRUE.
58  !$OMP THREADPRIVATE(first)
59  INTEGER i, k
60
61! REAL missing_val
62#ifndef CPP_XIOS
63  REAL :: missing_val
64#endif
65
66! missing_val = nf90_fill_real
67
68#ifndef CPP_XIOS
69      missing_val=missing_val_nf90
70#endif
71
72  IF (first) THEN
73    ALLOCATE (lt(klon), lb(klon), aist(klon), aisb(klon))
74    first = .FALSE.
75  END IF
76
77  ! =====================================================================
78  IF (lnew) THEN
79    ! on r�nitialise les r�ndicages et les poids
80    ! =====================================================================
81
82
83    ! Chercher les 2 couches les plus proches du niveau a obtenir
84
85    ! Eventuellement, faire l'extrapolation a partir des deux couches
86    ! les plus basses ou les deux couches les plus hautes:
87    DO i = 1, klon
88      IF (abs(pres-pgcm(i,ilev))<abs(pres-pgcm(i,1))) THEN
89        lt(i) = ilev ! 2
90        lb(i) = ilev - 1 ! 1
91      ELSE
92        lt(i) = 2
93        lb(i) = 1
94      END IF
95    END DO
96    DO k = 1, ilev - 1
97      DO i = 1, klon
98        pbot = pgcm(i, k)
99        ptop = pgcm(i, k+1)
100        IF (ptop<=pres .AND. pbot>=pres) THEN
101          lt(i) = k + 1
102          lb(i) = k
103        END IF
104      END DO
105    END DO
106
107    ! Interpolation lineaire:
108
109    DO i = 1, klon
110      ! interpolation en logarithme de pression:
111
112      ! ...   Modif . P. Le Van    ( 20/01/98) ....
113      ! Modif Fr��ic Hourdin (3/01/02)
114
115      aist(i) = log(pgcm(i,lb(i))/pres)/log(pgcm(i,lb(i))/pgcm(i,lt(i)))
116      aisb(i) = log(pres/pgcm(i,lt(i)))/log(pgcm(i,lb(i))/pgcm(i,lt(i)))
117    END DO
118
119
120  END IF ! lnew
121
122  ! ======================================================================
123  ! inteprollation
124  ! ======================================================================
125
126  DO i = 1, klon
127    qpres(i) = qgcm(i, lb(i))*aisb(i) + qgcm(i, lt(i))*aist(i)
128  END DO
129
130  ! Je mets les vents a zero quand je rencontre une montagne
131  DO i = 1, klon
132    IF (pgcm(i,1)<pres) THEN
133      qpres(i) = missing_val
134    END IF
135  END DO
136
137
138  RETURN
139END SUBROUTINE plevel
Note: See TracBrowser for help on using the repository browser.