trunk/dyn3d/pres2lev.f


! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/pres2lev.F,v 1.1.1.1 2004/05/19
! 12:53:07 lmdzadmin Exp $

! ******************************************************
SUBROUTINE pres2lev(varo, varn, lmo, lmn, po, pn, ni, nj)

  ! interpolation lineaire pour passer
  ! a une nouvelle discretisation verticale pour
  ! les variables de GCM
  ! Francois Forget (01/1995)

  ! MOdif remy roca 12/97 pour passer de pres2sig
  ! **********************************************************

  IMPLICIT NONE

  ! Declarations:
  ! ==============

  ! ARGUMENTS
  ! """""""""

  INTEGER lmo ! dimensions ancienne couches (input)
  INTEGER lmn ! dimensions nouvelle couches (input)
  INTEGER lmomx ! dimensions ancienne couches (input)
  INTEGER lmnmx ! dimensions nouvelle couches (input)

  PARAMETER (lmomx=10000, lmnmx=10000)

  REAL po(lmo) ! niveau de pression en millibars
  INTEGER ni, nj
  REAL pn(ni, nj, lmn) ! niveau de pression en pascals

  INTEGER i, j, nhoriz ! nombre de point horizontale (input)

  REAL varo(ni, nj, lmo) ! var dans l'ancienne grille (input)
  REAL varn(ni, nj, lmn) ! var dans la nouvelle grille (output)

  REAL zvaro(lmomx), zpo(lmomx)

  ! Autres variables
  ! """"""""""""""""
  INTEGER n, ln, lo
  REAL coef

  ! run
  ! ====
  DO i = 1, ni
    DO j = 1, nj
      ! a chaque point de grille correspond un nouveau sigma old
      ! qui vaut pres(l)/ps(i,j)
      DO lo = 1, lmo
        zpo(lo) = po(lmo+1-lo)
        zvaro(lo) = varo(i, j, lmo+1-lo)
      END DO

      DO ln = 1, lmn
        IF (pn(i,j,ln)>=zpo(1)) THEN
          varn(i, j, ln) = zvaro(1)
        ELSE IF (pn(i,j,ln)<=zpo(lmo)) THEN
          varn(i, j, ln) = zvaro(lmo)
        ELSE
          DO lo = 1, lmo - 1
            IF ((pn(i,j,ln)<=zpo(lo)) .AND. (pn(i,j,ln)>zpo(lo+1))) THEN
              coef = (pn(i,j,ln)-zpo(lo))/(zpo(lo+1)-zpo(lo))
              varn(i, j, ln) = zvaro(lo) + coef*(zvaro(lo+1)-zvaro(lo))
              ! print*,'pn(',ln,')=',pn(i,j,ln),varn(i,j,ln)
            END IF
          END DO
        END IF
      END DO

    END DO
  END DO
  RETURN
END SUBROUTINE pres2lev
1
2	! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/pres2lev.F,v 1.1.1.1 2004/05/19
3	! 12:53:07 lmdzadmin Exp $
4
5	! ******************************************************
6	SUBROUTINE pres2lev(varo, varn, lmo, lmn, po, pn, ni, nj)
7
8	! interpolation lineaire pour passer
9	! a une nouvelle discretisation verticale pour
10	! les variables de GCM
11	! Francois Forget (01/1995)
12
13	! MOdif remy roca 12/97 pour passer de pres2sig
14	! **********************************************************
15
16	IMPLICIT NONE
17
18	! Declarations:
19	! ==============
20
21	! ARGUMENTS
22	! """""""""
23
24	INTEGER lmo ! dimensions ancienne couches (input)
25	INTEGER lmn ! dimensions nouvelle couches (input)
26	INTEGER lmomx ! dimensions ancienne couches (input)
27	INTEGER lmnmx ! dimensions nouvelle couches (input)
28
29	PARAMETER (lmomx=10000, lmnmx=10000)
30
31	REAL po(lmo) ! niveau de pression en millibars
32	INTEGER ni, nj
33	REAL pn(ni, nj, lmn) ! niveau de pression en pascals
34
35	INTEGER i, j, nhoriz ! nombre de point horizontale (input)
36
37	REAL varo(ni, nj, lmo) ! var dans l'ancienne grille (input)
38	REAL varn(ni, nj, lmn) ! var dans la nouvelle grille (output)
39
40	REAL zvaro(lmomx), zpo(lmomx)
41
42	! Autres variables
43	! """"""""""""""""
44	INTEGER n, ln, lo
45	REAL coef
46
47	! run
48	! ====
49	DO i = 1, ni
50	DO j = 1, nj
51	! a chaque point de grille correspond un nouveau sigma old
52	! qui vaut pres(l)/ps(i,j)
53	DO lo = 1, lmo
54	zpo(lo) = po(lmo+1-lo)
55	zvaro(lo) = varo(i, j, lmo+1-lo)
56	END DO
57
58	DO ln = 1, lmn
59	IF (pn(i,j,ln)>=zpo(1)) THEN
60	varn(i, j, ln) = zvaro(1)
61	ELSE IF (pn(i,j,ln)<=zpo(lmo)) THEN
62	varn(i, j, ln) = zvaro(lmo)
63	ELSE
64	DO lo = 1, lmo - 1
65	IF ((pn(i,j,ln)<=zpo(lo)) .AND. (pn(i,j,ln)>zpo(lo+1))) THEN
66	coef = (pn(i,j,ln)-zpo(lo))/(zpo(lo+1)-zpo(lo))
67	varn(i, j, ln) = zvaro(lo) + coef*(zvaro(lo+1)-zvaro(lo))
68	! print*,'pn(',ln,')=',pn(i,j,ln),varn(i,j,ln)
69	END IF
70	END DO
71	END IF
72	END DO
73
74	END DO
75	END DO
76	RETURN
77	END SUBROUTINE pres2lev