Guide/Read_reanalyse/pres2lev.f

module pres2lev_m

  IMPLICIT NONE

contains

  SUBROUTINE pres2lev(varo, varn, po, pn)

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

    ! Interpolation lin\'eaire pour passer \`a une nouvelle
    ! discr\'etisation verticale pour les variables de GCM.

    ! Francois Forget (January 1995)

    REAL, intent(in):: varo(:, :, :) ! (ni, nj, lmo) var in the old grid
    REAL, intent(out):: varn(:, :, :) ! (ni, nj, lmn)! var in the new grid

    REAL, intent(in):: po(:) ! (lmo) 
    ! pressure levels, old  (in monotonic order), in hPa

    REAL, intent(in):: pn(:, :, :) ! (ni, nj, lmn) pressure levels, new, in Pa

    ! Local:
    INTEGER lmn ! dimensions nouvelle couches
    INTEGER ni, nj
    INTEGER lmo ! dimensions ancienne couches
    INTEGER i, j
    REAL zvaro(size(po))
    real zpo(size(po)) ! pressure levels, old, in descending order, in hPa
    INTEGER ln, lo

    !--------------------------------------------------------------

    lmo = size(po)
    ni = size(varn, 1)
    nj = size(varn, 2)
    lmn = size(varn, 3)

    DO i = 1, ni
       DO j = 1, nj
          if (po(1) < po(2)) then
             ! Inversion de l'ordre des niveaux verticaux :
             zpo = po(lmo:1:- 1)
             zvaro = varo(i, j, lmo:1:- 1)
          else
             zpo = po
             zvaro = varo(i, j, :)
          end if

          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
                      varn(i, j, ln) = zvaro(lo) + (pn(i, j, ln) - zpo(lo)) &
                           / (zpo(lo + 1) - zpo(lo)) * (zvaro(lo + 1) &
                           - zvaro(lo))
                   END IF
                END DO
             END IF
          END DO
       END DO
    END DO

  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	173	SUBROUTINE pres2lev(varo, varn, po, pn)
8	guez	3
9	guez	173	! From LMDZ4/libf/dyn3d/pres2lev.F, version 1.1.1.1 2004/05/19 12:53:07
10	guez	3
11	guez	173	! Interpolation lin\'eaire pour passer \`a une nouvelle
12			! discr\'etisation verticale pour les variables de GCM.
13	guez	3
14	guez	173	! Francois Forget (January 1995)
15	guez	3
16	guez	173	REAL, intent(in):: varo(:, :, :) ! (ni, nj, lmo) var in the old grid
17			REAL, intent(out):: varn(:, :, :) ! (ni, nj, lmn)! var in the new grid
18	guez	3
19	guez	173	REAL, intent(in):: po(:) ! (lmo)
20			! pressure levels, old (in monotonic order), in hPa
21	guez	3
22	guez	173	REAL, intent(in):: pn(:, :, :) ! (ni, nj, lmn) pressure levels, new, in Pa
23	guez	3
24	guez	173	! Local:
25			INTEGER lmn ! dimensions nouvelle couches
26	guez	171	INTEGER ni, nj
27	guez	173	INTEGER lmo ! dimensions ancienne couches
28			INTEGER i, j
29			REAL zvaro(size(po))
30			real zpo(size(po)) ! pressure levels, old, in descending order, in hPa
31			INTEGER ln, lo
32	guez	81
33	guez	173	!--------------------------------------------------------------
34	guez	81
35	guez	173	lmo = size(po)
36			ni = size(varn, 1)
37			nj = size(varn, 2)
38			lmn = size(varn, 3)
39	guez	81
40	guez	171	DO i = 1, ni
41			DO j = 1, nj
42	guez	173	if (po(1) < po(2)) then
43			! Inversion de l'ordre des niveaux verticaux :
44			zpo = po(lmo:1:- 1)
45			zvaro = varo(i, j, lmo:1:- 1)
46			else
47			zpo = po
48			zvaro = varo(i, j, :)
49			end if
50	guez	81
51	guez	171	DO ln = 1, lmn
52	guez	173	IF (pn(i, j, ln) >= zpo(1)) THEN
53	guez	171	varn(i, j, ln) = zvaro(1)
54	guez	173	ELSE IF (pn(i, j, ln) <= zpo(lmo)) THEN
55	guez	171	varn(i, j, ln) = zvaro(lmo)
56			ELSE
57			DO lo = 1, lmo - 1
58	guez	173	IF ((pn(i, j, ln) <= zpo(lo)) &
59			.AND. (pn(i, j, ln) > zpo(lo + 1))) THEN
60			varn(i, j, ln) = zvaro(lo) + (pn(i, j, ln) - zpo(lo)) &
61			/ (zpo(lo + 1) - zpo(lo)) * (zvaro(lo + 1) &
62			- zvaro(lo))
63	guez	171	END IF
64			END DO
65			END IF
66			END DO
67			END DO
68	guez	81	END DO
69	guez	173
70	guez	171	END SUBROUTINE pres2lev
71
72			end module pres2lev_m