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	module pres2lev_m
2
3	IMPLICIT NONE
4
5	contains
6
7	SUBROUTINE pres2lev(varo, varn, po, pn)
8
9	! From LMDZ4/libf/dyn3d/pres2lev.F, version 1.1.1.1 2004/05/19 12:53:07
10
11	! Interpolation lin\'eaire pour passer \`a une nouvelle
12	! discr\'etisation verticale pour les variables de GCM.
13
14	! Francois Forget (January 1995)
15
16	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
19	REAL, intent(in):: po(:) ! (lmo)
20	! pressure levels, old (in monotonic order), in hPa
21
22	REAL, intent(in):: pn(:, :, :) ! (ni, nj, lmn) pressure levels, new, in Pa
23
24	! Local:
25	INTEGER lmn ! dimensions nouvelle couches
26	INTEGER ni, nj
27	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
33	!--------------------------------------------------------------
34
35	lmo = size(po)
36	ni = size(varn, 1)
37	nj = size(varn, 2)
38	lmn = size(varn, 3)
39
40	DO i = 1, ni
41	DO j = 1, nj
42	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
51	DO ln = 1, lmn
52	IF (pn(i, j, ln) >= zpo(1)) THEN
53	varn(i, j, ln) = zvaro(1)
54	ELSE IF (pn(i, j, ln) <= zpo(lmo)) THEN
55	varn(i, j, ln) = zvaro(lmo)
56	ELSE
57	DO lo = 1, lmo - 1
58	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	END IF
64	END DO
65	END IF
66	END DO
67	END DO
68	END DO
69
70	END SUBROUTINE pres2lev
71
72	end module pres2lev_m