source: LMDZ6/branches/Amaury_dev/libf/misc/lmdz_pres2lev.f90 @ 5153

Last change on this file since 5153 was 5117, checked in by abarral, 2 months ago

rename modules properly lmdz_*
move some unused files to obsolete/
(lint) uppercase fortran keywords

File size: 2.3 KB
RevLine 
[1983]1! $Id: pres2lev.F 1179 2009-06-11 14:18:47Z jghattas $
[5099]2
[5117]3MODULE lmdz_pres2lev
4  IMPLICIT NONE; PRIVATE
5  PUBLIC pres2lev
[1983]6
[5117]7CONTAINS
[1983]8
[5117]9  !******************************************************
10  SUBROUTINE pres2lev(varo, varn, lmo, lmn, po, pn, ni, nj, ok_invertp)
[5099]11
[5117]12    ! interpolation lineaire pour passer
13    ! a une nouvelle discretisation verticale pour
14    ! les variables de GCM
15    ! Francois Forget (01/1995)
16    ! MOdif remy roca 12/97 pour passer de pres2sig
17    ! Modif F.Codron 07/08 po en 3D
18    !**********************************************************
[1983]19
[5117]20    IMPLICIT NONE
[1983]21
[5117]22    !   Declarations:
23    ! ==============
[5099]24
[5117]25    !  ARGUMENTS
26    !  """""""""
27    LOGICAL, INTENT(IN) :: ok_invertp
28    INTEGER, INTENT(IN) :: lmo ! dimensions ancienne couches
29    INTEGER, INTENT(IN) :: lmn ! dimensions nouvelle couches
[1983]30
[5117]31    INTEGER, INTENT(IN) :: ni, nj ! nombre de point horizontal
32    REAL, INTENT(IN) :: po(ni * nj, lmo) ! niveau de pression ancienne grille
33    REAL, INTENT(IN) :: pn(ni * nj, lmn) ! niveau de pression nouvelle grille
[1983]34
[5117]35    REAL, INTENT(IN) :: varo(ni * nj, lmo) ! var dans l'ancienne grille
36    REAL, INTENT(OUT) :: varn(ni * nj, lmn) ! var dans la nouvelle grille
[1983]37
[5117]38    REAL :: zvaro(ni * nj, lmo), zpo(ni * nj, lmo)
[1983]39
[5117]40    ! Autres variables
41    ! """"""""""""""""
42    INTEGER :: ln, lo, k
43    REAL :: coef
[1983]44
[5117]45
46    ! Inversion de l'ordre des niveaux verticaux
47    IF (ok_invertp) THEN
48      DO lo = 1, lmo
49        DO k = 1, ni * nj
50          zpo(k, lo) = po(k, lmo + 1 - lo)
51          zvaro(k, lo) = varo(k, lmo + 1 - lo)
52        ENDDO
[1983]53      ENDDO
[5117]54    ELSE
55      DO lo = 1, lmo
56        DO k = 1, ni * nj
57          zpo(k, lo) = po(k, lo)
58          zvaro(k, lo) = varo(k, lo)
59        ENDDO
[1983]60      ENDDO
[5117]61    ENDIF
[1983]62
[5117]63    DO ln = 1, lmn
64      DO lo = 1, lmo - 1
65        DO k = 1, ni * nj
66          IF (pn(k, ln) >= zpo(k, 1)) THEN
67            varn(k, ln) = zvaro(k, 1)
68          ELSE IF (pn(k, ln) <= zpo(k, lmo)) THEN
69            varn(k, ln) = zvaro(k, lmo)
70          ELSE IF (pn(k, ln) <= zpo(k, lo) .AND. pn(k, ln) > zpo(k, lo + 1)) THEN
71            coef = (pn(k, ln) - zpo(k, lo)) / (zpo(k, lo + 1) - zpo(k, lo))
72            varn(k, ln) = zvaro(k, lo) + coef * (zvaro(k, lo + 1) - zvaro(k, lo))
73          ENDIF
74
75        ENDDO
76      ENDDO
[1983]77    ENDDO
78
[5117]79  END SUBROUTINE pres2lev
[1983]80
[5117]81END MODULE lmdz_pres2lev
Note: See TracBrowser for help on using the repository browser.