source: LMDZ6/branches/Amaury_dev/libf/dyn3d/tetaleveli1j1.F90 @ 5218

Last change on this file since 5218 was 5159, checked in by abarral, 5 months ago

Put dimensions.h and paramet.h into modules

  • 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.8 KB
RevLine 
[5103]1!================================================================
2!================================================================
3SUBROUTINE tetaleveli1j1(ilon, ilev, lnew, pgcm, pres, Qgcm, Qpres)
4  !================================================================
5  !================================================================
[644]6
[5103]7  ! FH 2008/05/09 On elimine toutes les clefs physiques dans la dynamique
[5159]8USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
9  USE lmdz_paramet
[5134]10  IMPLICIT NONE
[644]11
12
[5159]13
[5103]14  !================================================================
[5159]15
[5103]16  ! Interpoler des champs 3-D u, v et g du modele a un niveau de
17  ! pression donnee (pres)
[5159]18
[5103]19  ! INPUT:  ilon ----- nombre de points
20  !     ilev ----- nombre de couches
21  !     lnew ----- true si on doit reinitialiser les poids
22  !     pgcm ----- pressions modeles
23  !     pres ----- pression vers laquelle on interpolle
24  !     Qgcm ----- champ GCM
25  !     Qpres ---- champ interpolle au niveau pres
[5159]26
[5103]27  !================================================================
[5159]28
[5103]29  !   arguments :
30  !   -----------
[644]31
[5103]32  INTEGER :: ilon, ilev
[5117]33  LOGICAL :: lnew
[644]34
[5103]35  REAL :: pgcm(ilon, ilev)
36  REAL :: Qgcm(ilon, ilev)
[5116]37  REAL :: pres
[5103]38  REAL :: Qpres(ilon)
[644]39
[5103]40  !   local :
41  !   -------
[644]42
[5103]43  !IM 211004
44  ! INTEGER lt(klon), lb(klon)
45  ! REAL ptop, pbot, aist(klon), aisb(klon)
46  !
[5159]47
48
[5103]49  INTEGER :: lt(ip1jmp1), lb(ip1jmp1)
50  REAL :: ptop, pbot, aist(ip1jmp1), aisb(ip1jmp1)
51  !MI 211004
52  save lt, lb, ptop, pbot, aist, aisb
[644]53
[5103]54  INTEGER :: i, k
[5159]55
[5103]56  ! PRINT*,'tetalevel pres=',pres
57  !=====================================================================
[5117]58  IF (lnew) THEN
[5103]59    !   on réinitialise les réindicages et les poids
60    !=====================================================================
[644]61
62
[5103]63    ! Chercher les 2 couches les plus proches du niveau a obtenir
[5159]64
[5103]65    ! Eventuellement, faire l'extrapolation a partir des deux couches
66    ! les plus basses ou les deux couches les plus hautes:
67    DO i = 1, ilon
68      !IM      IF ( ABS(pres-pgcm(i,ilev) ) .LT.
69      IF (ABS(pres - pgcm(i, ilev)) > &
70              ABS(pres - pgcm(i, 1))) THEN
71        lt(i) = ilev     ! 2
72        lb(i) = ilev - 1   ! 1
73      ELSE
74        lt(i) = 2
75        lb(i) = 1
76      ENDIF
77      !IM   PRINT*,'i, ABS(pres-pgcm),ABS(pres-pgcm)',
78      !IM  .i, ABS(pres-pgcm(i,ilev)),ABS(pres-pgcm(i,1))
79    END DO
80    DO k = 1, ilev - 1
[5086]81      DO i = 1, ilon
[5103]82        pbot = pgcm(i, k)
83        ptop = pgcm(i, k + 1)
84        !IM         IF (ptop.LE.pres .AND. pbot.GE.pres) THEN
85        IF (ptop>=pres .AND. pbot<=pres) THEN
86          lt(i) = k + 1
87          lb(i) = k
88        ENDIF
[5086]89      END DO
[5103]90    END DO
[5159]91
[5103]92    ! Interpolation lineaire:
[5159]93
[5103]94    DO i = 1, ilon
95      ! interpolation en logarithme de pression:
[5159]96
[5103]97      ! ...   Modif . P. Le Van    ( 20/01/98) ....
98      !   Modif Frédéric Hourdin (3/01/02)
[644]99
[5103]100      IF(pgcm(i, lb(i))==0.OR. &
101              pgcm(i, lt(i))==0.) THEN
[5159]102
[5103]103        PRINT*, 'i,lb,lt,2pgcm,pres', i, lb(i), &
104                lt(i), pgcm(i, lb(i)), pgcm(i, lt(i)), pres
[5159]105
[5103]106      ENDIF
[5159]107
[5103]108      aist(i) = LOG(pgcm(i, lb(i)) / pres) &
109              / LOG(pgcm(i, lb(i)) / pgcm(i, lt(i)))
110      aisb(i) = LOG(pres / pgcm(i, lt(i))) &
111              / LOG(pgcm(i, lb(i)) / pgcm(i, lt(i)))
112    enddo
[644]113
[5117]114  ENDIF ! lnew
[644]115
[5103]116  !======================================================================
117  !    inteprollation
118  !======================================================================
[644]119
[5158]120  DO i = 1, ilon
[5103]121    Qpres(i) = Qgcm(i, lb(i)) * aisb(i) + Qgcm(i, lt(i)) * aist(i)
122    !IM      PRINT*,'i,Qgcm,Qpres',i,Qgcm(i,lb(i)),aisb(i),
123    !IM  $   Qgcm(i,lt(i)),aist(i),Qpres(i)
124  enddo
[5159]125
[5103]126  ! Je mets les vents a zero quand je rencontre une montagne
[5158]127  DO i = 1, ilon
[5103]128    !IM      if (pgcm(i,1).LT.pres) THEN
[5117]129    IF (pgcm(i, 1)>pres) THEN
[5103]130      ! Qpres(i)=1e33
131      Qpres(i) = 1e+20
132      !IM         PRINT*,'i,pgcm(i,1),pres =',i,pgcm(i,1),pres
133    endif
134  enddo
[644]135
[5103]136  !
[5105]137
[5103]138END SUBROUTINE tetaleveli1j1
Note: See TracBrowser for help on using the repository browser.