Guide/Read_reanalyse/pres2lev.f

module pres2lev_m

  IMPLICIT NONE

contains

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

    ! From LMDZ4/libf/dyn3d/pres2lev.F, v 1.1.1.1 2004/05/19 12:53:07

    ! 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

    ! Declarations:

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

    INTEGER, intent(in):: 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, intent(in):: po(lmo) ! niveau de pression en millibars
    INTEGER ni, nj
    REAL pn(ni, nj, lmn) ! niveau de pression en pascals

    INTEGER i, j ! 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 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

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