--- trunk/libf/phylmd/Orography/sugwd.f90	2011/10/07 13:11:58	53
+++ trunk/libf/phylmd/Orography/sugwd.f90	2011/12/06 15:07:04	54
@@ -1,113 +1,76 @@
-    SUBROUTINE sugwd(nlon,nlev,paprs,pplay)
+module sugwd_m
 
-!**** *SUGWD* INITIALIZE COMMON YOEGWD CONTROLLING GRAVITY WAVE DRAG
+  IMPLICIT NONE
 
-!     PURPOSE.
-!     --------
-!           INITIALIZE YOEGWD, THE COMMON THAT CONTROLS THE
-!           GRAVITY WAVE DRAG PARAMETRIZATION.
+contains
 
-!**   INTERFACE.
-!     ----------
-!        CALL *SUGWD* FROM *SUPHEC*
-!              -----        ------
+  SUBROUTINE sugwd(paprs, pplay)
 
-!        EXPLICIT ARGUMENTS :
-!        --------------------
-!        PSIG        : VERTICAL COORDINATE TABLE
-!        NLEV        : NUMBER OF MODEL LEVELS
+    ! Initialize yoegwd, the common that controls the gravity wave
+    ! drag parametrization.
 
-!        IMPLICIT ARGUMENTS :
-!        --------------------
-!        COMMON YOEGWD
+    ! REFERENCE.
+    ! ECMWF Research Department documentation of the IFS
 
-!     METHOD.
-!     -------
-!        SEE DOCUMENTATION
+    ! AUTHOR.
+    ! MARTIN MILLER *ECMWF*
 
-!     EXTERNALS.
-!     ----------
-!        NONE
+    ! ORIGINAL : 90-01-01
 
-!     REFERENCE.
-!     ----------
-!        ECMWF Research Department documentation of the IFS
+    USE yoegwd, ONLY : gfrcrit, ghmax, gkdrag, gklift, gkwake, grahilo, &
+         grcrit, gsigcr, gssec, gtsec, gvcrit, gvsec, nktopg, nstra
+    use nr_util, only: assert_eq
 
-!     AUTHOR.
-!     -------
-!        MARTIN MILLER             *ECMWF*
+    REAL, INTENT(IN):: paprs(:, :) ! (nlon, nlev+1)
+    REAL, INTENT(IN):: pplay(:, :) ! (nlon, nlev)
 
-!     MODIFICATIONS.
-!     --------------
-!        ORIGINAL : 90-01-01
-!     ------------------------------------------------------------------
-      USE yoegwd
-      IMPLICIT NONE
+    ! Local:
+    INTEGER nlon, nlev
+    integer jk
+    REAL zpr, zstra, zsigt, zpm1r
 
-!     -----------------------------------------------------------------
-!      ----------------------------------------------------------------
+    !------------------------------------------------------------
 
-      INTEGER nlon, nlev, jk
-      REAL, INTENT (IN) :: paprs(nlon,nlev+1)
-      REAL, INTENT (IN) :: pplay(nlon,nlev)
-      REAL zpr, zstra, zsigt, zpm1r
+    print *, "Call sequence information: sugwd"
+    nlon = assert_eq(size(paprs, 1), size(pplay, 1), "sugwd nlon")
+    nlev = assert_eq(size(paprs, 2) - 1, size(pplay, 2), "sugwd nlon")
 
-!*       1.    SET THE VALUES OF THE PARAMETERS
-!              --------------------------------
+    ! 1. SET THE VALUES OF THE PARAMETERS
 
-100   CONTINUE
+    ghmax = 10000.
 
-      PRINT *, ' DANS SUGWD NLEV=', nlev
-      ghmax = 10000.
+    zpr = 100000.
+    zstra = 0.1
+    zsigt = 0.94
 
-      zpr = 100000.
-      zstra = 0.1
-      zsigt = 0.94
-!old  ZPR=80000.
-!old  ZSIGT=0.85
+    DO jk = 1, nlev
+       zpm1r = pplay(nlon / 2, jk) / paprs(nlon / 2, 1)
+       IF (zpm1r >= zsigt) nktopg = jk
+       IF (zpm1r >= zstra) nstra = jk
+    end DO
 
-      DO 110 jk = 1, nlev
-        zpm1r = pplay(nlon/2,jk)/paprs(nlon/2,1)
-        IF (zpm1r>=zsigt) THEN
-          nktopg = jk
-        END IF
-        zpm1r = pplay(nlon/2,jk)/paprs(nlon/2,1)
-        IF (zpm1r>=zstra) THEN
-          nstra = jk
-        END IF
-110   CONTINUE
+    ! inversion car dans orodrag on compte les niveaux a l'envers
+    nktopg = nlev - nktopg + 1
+    nstra = nlev - nstra
+    PRINT *, 'nktopg=', nktopg
+    PRINT *, 'nstra=', nstra
 
-!  inversion car dans orodrag on compte les niveaux a l'envers
-      nktopg = nlev - nktopg + 1
-      nstra = nlev - nstra
-      PRINT *, ' DANS SUGWD nktopg=', nktopg
-      PRINT *, ' DANS SUGWD nstra=', nstra
+    gsigcr = 0.8
 
-      gsigcr = 0.80
+    gkdrag = 0.2
+    grahilo = 1.
+    grcrit = 0.01
+    gfrcrit = 1.
+    gkwake = 0.5
 
-      gkdrag = 0.2
-      grahilo = 1.
-      grcrit = 0.01
-      gfrcrit = 1.0
-      gkwake = 0.50
+    gklift = 0.5
+    gvcrit = 0.
 
-      gklift = 0.50
-      gvcrit = 0.0
+    ! 2. SET VALUES OF SECURITY PARAMETERS
+    gvsec = 0.1
+    gssec = 1E-12
+    gtsec = 1E-7
 
+  END SUBROUTINE sugwd
 
-!      ----------------------------------------------------------------
-
-!*       2.    SET VALUES OF SECURITY PARAMETERS
-!              ---------------------------------
-
-200   CONTINUE
-
-      gvsec = 0.10
-      gssec = 1.E-12
-
-      gtsec = 1.E-07
-
-!      ----------------------------------------------------------------
-
-      RETURN
-    END
+end module sugwd_m