trunk/phylmd/tetalevel.f90

! ================================================================
! ================================================================
SUBROUTINE tetalevel(ilon, ilev, lnew, pgcm, pres, qgcm, qpres)
  ! ================================================================
  ! ================================================================

  USE dimens_m
  USE paramet_m
  USE dimphy
  IMPLICIT NONE


  ! ================================================================

  ! Interpoler des champs 3-D u, v et g du modele a un niveau de
  ! pression donnee (pres)

  ! INPUT:  ilon ----- nombre de points
  ! ilev ----- nombre de couches
  ! lnew ----- true si on doit reinitialiser les poids
  ! pgcm ----- pressions modeles
  ! pres ----- pression vers laquelle on interpolle
  ! Qgcm ----- champ GCM
  ! Qpres ---- champ interpolle au niveau pres

  ! ================================================================

  ! arguments :
  ! -----------

  INTEGER ilon, ilev
  LOGICAL lnew

  REAL pgcm(ilon, ilev)
  REAL, INTENT (IN) :: qgcm(ilon, ilev)
  REAL pres
  REAL qpres(ilon)

  ! local :
  ! -------


  INTEGER lt(ip1jmp1), lb(ip1jmp1)
  REAL ptop, pbot, aist(ip1jmp1), aisb(ip1jmp1)
  SAVE lt, lb, ptop, pbot, aist, aisb

  INTEGER i, k

  ! PRINT*,'tetalevel pres=',pres
  ! =====================================================================
  IF (lnew) THEN
    ! on réinitialise les réindicages et les poids
    ! =====================================================================


    ! Chercher les 2 couches les plus proches du niveau a obtenir

    ! Eventuellement, faire l'extrapolation a partir des deux couches
    ! les plus basses ou les deux couches les plus hautes:
    DO i = 1, ilon
      ! IM      IF ( ABS(pres-pgcm(i,ilev) ) .LT.
      IF (abs(pres-pgcm(i,ilev))>abs(pres-pgcm(i,1))) THEN
        lt(i) = ilev ! 2
        lb(i) = ilev - 1 ! 1
      ELSE
        lt(i) = 2
        lb(i) = 1
      END IF
      ! IM   PRINT*,'i, ABS(pres-pgcm),ABS(pres-pgcm)',
      ! IM  .i, ABS(pres-pgcm(i,ilev)),ABS(pres-pgcm(i,1))
    END DO
    DO k = 1, ilev - 1
      DO i = 1, ilon
        pbot = pgcm(i, k)
        ptop = pgcm(i, k+1)
        ! IM         IF (ptop.LE.pres .AND. pbot.GE.pres) THEN
        IF (ptop>=pres .AND. pbot<=pres) THEN
          lt(i) = k + 1
          lb(i) = k
        END IF
      END DO
    END DO

    ! Interpolation lineaire:

    DO i = 1, ilon
      ! interpolation en logarithme de pression:

      ! ...   Modif . P. Le Van    ( 20/01/98) ....
      ! Modif Frédéric Hourdin (3/01/02)

      ! IF(pgcm(i,lb(i)).NE.0.OR.
      ! $     pgcm(i,lt(i)).NE.0.) THEN

      ! PRINT*,'i,lb,lt,2pgcm,pres',i,lb(i),
      ! .  lt(i),pgcm(i,lb(i)),pgcm(i,lt(i)),pres

      aist(i) = log(pgcm(i,lb(i))/pres)/log(pgcm(i,lb(i))/pgcm(i,lt(i)))
      aisb(i) = log(pres/pgcm(i,lt(i)))/log(pgcm(i,lb(i))/pgcm(i,lt(i)))
    END DO


  END IF ! lnew

  ! ======================================================================
  ! inteprollation
  ! ======================================================================

  DO i = 1, ilon
    qpres(i) = qgcm(i, lb(i))*aisb(i) + qgcm(i, lt(i))*aist(i)
  END DO

  ! Je mets les vents a zero quand je rencontre une montagne
  DO i = 1, ilon
    ! IM      if (pgcm(i,1).LT.pres) THEN
    IF (pgcm(i,1)>pres) THEN
      ! Qpres(i)=1e33
      qpres(i) = 1E+20
      ! IM         PRINT*,'i,pgcm(i,1),pres =',i,pgcm(i,1),pres
    END IF
  END DO


  RETURN
END SUBROUTINE tetalevel
1	! ================================================================
2	! ================================================================
3	SUBROUTINE tetalevel(ilon, ilev, lnew, pgcm, pres, qgcm, qpres)
4	! ================================================================
5	! ================================================================
6
7	USE dimens_m
8	USE paramet_m
9	USE dimphy
10	IMPLICIT NONE
11
12
13	! ================================================================
14
15	! Interpoler des champs 3-D u, v et g du modele a un niveau de
16	! pression donnee (pres)
17
18	! INPUT: ilon ----- nombre de points
19	! ilev ----- nombre de couches
20	! lnew ----- true si on doit reinitialiser les poids
21	! pgcm ----- pressions modeles
22	! pres ----- pression vers laquelle on interpolle
23	! Qgcm ----- champ GCM
24	! Qpres ---- champ interpolle au niveau pres
25
26	! ================================================================
27
28	! arguments :
29	! -----------
30
31	INTEGER ilon, ilev
32	LOGICAL lnew
33
34	REAL pgcm(ilon, ilev)
35	REAL, INTENT (IN) :: qgcm(ilon, ilev)
36	REAL pres
37	REAL qpres(ilon)
38
39	! local :
40	! -------
41
42
43	INTEGER lt(ip1jmp1), lb(ip1jmp1)
44	REAL ptop, pbot, aist(ip1jmp1), aisb(ip1jmp1)
45	SAVE lt, lb, ptop, pbot, aist, aisb
46
47	INTEGER i, k
48
49	! PRINT*,'tetalevel pres=',pres
50	! =====================================================================
51	IF (lnew) THEN
52	! on réinitialise les réindicages et les poids
53	! =====================================================================
54
55
56	! Chercher les 2 couches les plus proches du niveau a obtenir
57
58	! Eventuellement, faire l'extrapolation a partir des deux couches
59	! les plus basses ou les deux couches les plus hautes:
60	DO i = 1, ilon
61	! IM IF ( ABS(pres-pgcm(i,ilev) ) .LT.
62	IF (abs(pres-pgcm(i,ilev))>abs(pres-pgcm(i,1))) THEN
63	lt(i) = ilev ! 2
64	lb(i) = ilev - 1 ! 1
65	ELSE
66	lt(i) = 2
67	lb(i) = 1
68	END IF
69	! IM PRINT*,'i, ABS(pres-pgcm),ABS(pres-pgcm)',
70	! IM .i, ABS(pres-pgcm(i,ilev)),ABS(pres-pgcm(i,1))
71	END DO
72	DO k = 1, ilev - 1
73	DO i = 1, ilon
74	pbot = pgcm(i, k)
75	ptop = pgcm(i, k+1)
76	! IM IF (ptop.LE.pres .AND. pbot.GE.pres) THEN
77	IF (ptop>=pres .AND. pbot<=pres) THEN
78	lt(i) = k + 1
79	lb(i) = k
80	END IF
81	END DO
82	END DO
83
84	! Interpolation lineaire:
85
86	DO i = 1, ilon
87	! interpolation en logarithme de pression:
88
89	! ... Modif . P. Le Van ( 20/01/98) ....
90	! Modif Frédéric Hourdin (3/01/02)
91
92	! IF(pgcm(i,lb(i)).NE.0.OR.
93	! $ pgcm(i,lt(i)).NE.0.) THEN
94
95	! PRINT*,'i,lb,lt,2pgcm,pres',i,lb(i),
96	! . lt(i),pgcm(i,lb(i)),pgcm(i,lt(i)),pres
97
98	aist(i) = log(pgcm(i,lb(i))/pres)/log(pgcm(i,lb(i))/pgcm(i,lt(i)))
99	aisb(i) = log(pres/pgcm(i,lt(i)))/log(pgcm(i,lb(i))/pgcm(i,lt(i)))
100	END DO
101
102
103	END IF ! lnew
104
105	! ======================================================================
106	! inteprollation
107	! ======================================================================
108
109	DO i = 1, ilon
110	qpres(i) = qgcm(i, lb(i))aisb(i) + qgcm(i, lt(i))aist(i)
111	END DO
112
113	! Je mets les vents a zero quand je rencontre une montagne
114	DO i = 1, ilon
115	! IM if (pgcm(i,1).LT.pres) THEN
116	IF (pgcm(i,1)>pres) THEN
117	! Qpres(i)=1e33
118	qpres(i) = 1E+20
119	! IM PRINT*,'i,pgcm(i,1),pres =',i,pgcm(i,1),pres
120	END IF
121	END DO
122
123
124	RETURN
125	END SUBROUTINE tetalevel