source: LMDZ5/trunk/libf/phylmd/plevel_new.F90 @ 3847

Last change on this file since 3847 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
File size: 4.0 KB
RevLine 
[1090]1
[1992]2! $Header: /home/cvsroot/LMDZ4/libf/phylmd/plevel.F,v 1.1.1.1.10.1 2006/08/17
3! 15:41:51 fairhead Exp $
[1090]4
[1992]5! ================================================================
6! ================================================================
7SUBROUTINE plevel_new(ilon, ilev, klevstd, lnew, pgcm, pres, qgcm, qpres)
8  ! ================================================================
9  ! ================================================================
10  USE netcdf
11  USE dimphy
[2271]12#ifdef CPP_IOIPSL
13  USE phys_state_var_mod, ONLY: missing_val_nf90
14#endif
15#ifdef CPP_XIOS
16  USE wxios, ONLY: missing_val
17#endif
18
[1992]19  IMPLICIT NONE
[1090]20
[1992]21  ! ================================================================
[1090]22
[1992]23  ! Interpoler des champs 3-D u, v et g du modele a un niveau de
24  ! pression donnee (pres)
[1090]25
[1992]26  ! INPUT:  ilon ----- nombre de points
27  ! ilev ----- nombre de couches
28  ! lnew ----- true si on doit reinitialiser les poids
29  ! pgcm ----- pressions modeles
30  ! pres ----- pression vers laquelle on interpolle
31  ! Qgcm ----- champ GCM
32  ! Qpres ---- champ interpolle au niveau pres
[1090]33
[1992]34  ! ================================================================
[1090]35
[1992]36  ! arguments :
37  ! -----------
[1279]38
[1992]39  INTEGER ilon, ilev, klevstd
40  LOGICAL lnew
[1090]41
[1992]42  REAL pgcm(ilon, ilev)
43  REAL qgcm(ilon, ilev)
44  REAL pres(klevstd)
45  REAL qpres(ilon, klevstd)
[1090]46
[1992]47  ! local :
48  ! -------
[1090]49
[1992]50  ! ym      INTEGER lt(klon), lb(klon)
51  ! ym      REAL ptop, pbot, aist(klon), aisb(klon)
[1090]52
[1992]53  ! ym      save lt,lb,ptop,pbot,aist,aisb
54  INTEGER, ALLOCATABLE, SAVE, DIMENSION (:, :) :: lt, lb
55  REAL, ALLOCATABLE, SAVE, DIMENSION (:, :) :: aist, aisb
56  !$OMP THREADPRIVATE(lt,lb,aist,aisb)
57  REAL, SAVE :: ptop, pbot
58  !$OMP THREADPRIVATE(ptop, pbot)
59  LOGICAL, SAVE :: first = .TRUE.
60  INTEGER :: nlev
61  !$OMP THREADPRIVATE(first)
62  INTEGER i, k
63
[2271]64! REAL missing_val
65#ifndef CPP_XIOS
66  REAL :: missing_val
67#endif
[1992]68
[2271]69! missing_val = nf90_fill_real
[1992]70
[2271]71#ifndef CPP_XIOS
72      missing_val=missing_val_nf90
73#endif
74
[1992]75  IF (first) THEN
76    ALLOCATE (lt(klon,klevstd), lb(klon,klevstd))
77    ALLOCATE (aist(klon,klevstd), aisb(klon,klevstd))
78    first = .FALSE.
79  END IF
80
81  ! =====================================================================
82  IF (lnew) THEN
83    ! on reinitialise les reindicages et les poids
84    ! =====================================================================
85
86
87    ! Chercher les 2 couches les plus proches du niveau a obtenir
88
89    ! Eventuellement, faire l'extrapolation a partir des deux couches
90    ! les plus basses ou les deux couches les plus hautes:
91
92
93    DO nlev = 1, klevstd
94      DO i = 1, klon
95        IF (abs(pres(nlev)-pgcm(i,ilev))<abs(pres(nlev)-pgcm(i,1))) THEN
96          lt(i, nlev) = ilev ! 2
97          lb(i, nlev) = ilev - 1 ! 1
98        ELSE
99          lt(i, nlev) = 2
100          lb(i, nlev) = 1
101        END IF
102      END DO
103      DO k = 1, ilev - 1
104        DO i = 1, klon
105          pbot = pgcm(i, k)
106          ptop = pgcm(i, k+1)
107          IF (ptop<=pres(nlev) .AND. pbot>=pres(nlev)) THEN
108            lt(i, nlev) = k + 1
109            lb(i, nlev) = k
110          END IF
111        END DO
112      END DO
113
114      ! Interpolation lineaire:
115      DO i = 1, klon
116        ! interpolation en logarithme de pression:
117
118        ! ...   Modif . P. Le Van    ( 20/01/98) ....
119        ! Modif Frederic Hourdin (3/01/02)
120
121        aist(i, nlev) = log(pgcm(i,lb(i,nlev))/pres(nlev))/log(pgcm(i,lb(i, &
122          nlev))/pgcm(i,lt(i,nlev)))
123        aisb(i, nlev) = log(pres(nlev)/pgcm(i,lt(i,nlev)))/log(pgcm(i,lb(i, &
124          nlev))/pgcm(i,lt(i,nlev)))
125      END DO
126    END DO
127
128  END IF ! lnew
129
130  ! ======================================================================
131  ! inteprollation
132  ! ET je mets les vents a zero quand je rencontre une montagne
133  ! ======================================================================
134
135  DO nlev = 1, klevstd
136    DO i = 1, klon
137      IF (pgcm(i,1)<pres(nlev)) THEN
138        qpres(i, nlev) = missing_val
139      ELSE
140        qpres(i, nlev) = qgcm(i, lb(i,nlev))*aisb(i, nlev) + &
141          qgcm(i, lt(i,nlev))*aist(i, nlev)
142      END IF
143    END DO
144  END DO
145
146
147  RETURN
148END SUBROUTINE plevel_new
Note: See TracBrowser for help on using the repository browser.