--- trunk/libf/dyn3d/pres2lev.f	2008/02/27 13:16:39	3
+++ trunk/dyn3d/Guide/Read_reanalyse/pres2lev.f	2018/02/05 10:39:38	254
@@ -1,80 +1,72 @@
-!
-! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/pres2lev.F,v 1.1.1.1 2004/05/19 12:53:07 lmdzadmin Exp $
-!
-c******************************************************
-      SUBROUTINE   pres2lev(varo,varn,lmo,lmn,po,pn,
-     &                      ni,nj)
-c
-c interpolation lineaire pour passer
-c a une nouvelle discretisation verticale pour
-c les variables de GCM
-c Francois Forget (01/1995)
-c 
-c MOdif remy roca 12/97 pour passer de pres2sig
-c**********************************************************
-
-      IMPLICIT NONE
-
-c   Declarations:
-c ==============
-c
-c  ARGUMENTS
-c  """""""""
-
-       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)
-
-c Autres variables
-c """"""""""""""""
-       INTEGER n, ln ,lo 
-       REAL coef
-
-c run
-c ====
-        do i=1,ni
-        do j=1,nj
-c a chaque point de grille correspond un nouveau sigma old
-c 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)
-           enddo
-        
-           do ln=1,lmn
-              if (pn(i,j,ln).ge.zpo(1))then
-                 varn(i,j,ln) =  zvaro(1)
-              else if (pn(i,j,ln).le.zpo(lmo)) then
-                 varn(i,j,ln) =  zvaro(lmo)
-              else
-                 do lo=1,lmo-1 
-                    if ( (pn(i,j,ln).le.zpo(lo)).and.
-     &                 (pn(i,j,ln).gt.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))
-c       print*,'pn(',ln,')=',pn(i,j,ln),varn(i,j,ln)
-                    end if
-                 enddo           
-              endif
-           enddo
-
-        enddo
-        enddo
-      return
-      end    
+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