/[lmdze]/trunk/libf/phylmd/Orography/sugwd.f90
ViewVC logotype

Diff of /trunk/libf/phylmd/Orography/sugwd.f90

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 23 by guez, Mon Dec 14 15:25:16 2009 UTC revision 54 by guez, Tue Dec 6 15:07:04 2011 UTC
# Line 1  Line 1 
1      SUBROUTINE sugwd(nlon,nlev,paprs,pplay)  module sugwd_m
2    
3  !**** *SUGWD* INITIALIZE COMMON YOEGWD CONTROLLING GRAVITY WAVE DRAG    IMPLICIT NONE
4    
5  !     PURPOSE.  contains
 !     --------  
 !           INITIALIZE YOEGWD, THE COMMON THAT CONTROLS THE  
 !           GRAVITY WAVE DRAG PARAMETRIZATION.  
6    
7  !**   INTERFACE.    SUBROUTINE sugwd(paprs, pplay)
 !     ----------  
 !        CALL *SUGWD* FROM *SUPHEC*  
 !              -----        ------  
8    
9  !        EXPLICIT ARGUMENTS :      ! Initialize yoegwd, the common that controls the gravity wave
10  !        --------------------      ! drag parametrization.
 !        PSIG        : VERTICAL COORDINATE TABLE  
 !        NLEV        : NUMBER OF MODEL LEVELS  
11    
12  !        IMPLICIT ARGUMENTS :      ! REFERENCE.
13  !        --------------------      ! ECMWF Research Department documentation of the IFS
 !        COMMON YOEGWD  
14    
15  !     METHOD.      ! AUTHOR.
16  !     -------      ! MARTIN MILLER *ECMWF*
 !        SEE DOCUMENTATION  
17    
18  !     EXTERNALS.      ! ORIGINAL : 90-01-01
 !     ----------  
 !        NONE  
19    
20  !     REFERENCE.      USE yoegwd, ONLY : gfrcrit, ghmax, gkdrag, gklift, gkwake, grahilo, &
21  !     ----------           grcrit, gsigcr, gssec, gtsec, gvcrit, gvsec, nktopg, nstra
22  !        ECMWF Research Department documentation of the IFS      use nr_util, only: assert_eq
23    
24  !     AUTHOR.      REAL, INTENT(IN):: paprs(:, :) ! (nlon, nlev+1)
25  !     -------      REAL, INTENT(IN):: pplay(:, :) ! (nlon, nlev)
 !        MARTIN MILLER             *ECMWF*  
26    
27  !     MODIFICATIONS.      ! Local:
28  !     --------------      INTEGER nlon, nlev
29  !        ORIGINAL : 90-01-01      integer jk
30  !     ------------------------------------------------------------------      REAL zpr, zstra, zsigt, zpm1r
       USE yoegwd  
       IMPLICIT NONE  
31    
32  !     -----------------------------------------------------------------      !------------------------------------------------------------
 !      ----------------------------------------------------------------  
33    
34        INTEGER nlon, nlev, jk      print *, "Call sequence information: sugwd"
35        REAL, INTENT (IN) :: paprs(nlon,nlev+1)      nlon = assert_eq(size(paprs, 1), size(pplay, 1), "sugwd nlon")
36        REAL, INTENT (IN) :: pplay(nlon,nlev)      nlev = assert_eq(size(paprs, 2) - 1, size(pplay, 2), "sugwd nlon")
       REAL zpr, zstra, zsigt, zpm1r  
37    
38  !*       1.    SET THE VALUES OF THE PARAMETERS      ! 1. SET THE VALUES OF THE PARAMETERS
 !              --------------------------------  
39    
40  100   CONTINUE      ghmax = 10000.
41    
42        PRINT *, ' DANS SUGWD NLEV=', nlev      zpr = 100000.
43        ghmax = 10000.      zstra = 0.1
44        zsigt = 0.94
45    
46        zpr = 100000.      DO jk = 1, nlev
47        zstra = 0.1         zpm1r = pplay(nlon / 2, jk) / paprs(nlon / 2, 1)
48        zsigt = 0.94         IF (zpm1r >= zsigt) nktopg = jk
49  !old  ZPR=80000.         IF (zpm1r >= zstra) nstra = jk
50  !old  ZSIGT=0.85      end DO
51    
52        DO 110 jk = 1, nlev      ! inversion car dans orodrag on compte les niveaux a l'envers
53          zpm1r = pplay(nlon/2,jk)/paprs(nlon/2,1)      nktopg = nlev - nktopg + 1
54          IF (zpm1r>=zsigt) THEN      nstra = nlev - nstra
55            nktopg = jk      PRINT *, 'nktopg=', nktopg
56          END IF      PRINT *, 'nstra=', nstra
         zpm1r = pplay(nlon/2,jk)/paprs(nlon/2,1)  
         IF (zpm1r>=zstra) THEN  
           nstra = jk  
         END IF  
 110   CONTINUE  
57    
58  !  inversion car dans orodrag on compte les niveaux a l'envers      gsigcr = 0.8
       nktopg = nlev - nktopg + 1  
       nstra = nlev - nstra  
       PRINT *, ' DANS SUGWD nktopg=', nktopg  
       PRINT *, ' DANS SUGWD nstra=', nstra  
59    
60        gsigcr = 0.80      gkdrag = 0.2
61        grahilo = 1.
62        grcrit = 0.01
63        gfrcrit = 1.
64        gkwake = 0.5
65    
66        gkdrag = 0.2      gklift = 0.5
67        grahilo = 1.      gvcrit = 0.
       grcrit = 0.01  
       gfrcrit = 1.0  
       gkwake = 0.50  
68    
69        gklift = 0.50      ! 2. SET VALUES OF SECURITY PARAMETERS
70        gvcrit = 0.0      gvsec = 0.1
71        gssec = 1E-12
72        gtsec = 1E-7
73    
74      END SUBROUTINE sugwd
75    
76  !      ----------------------------------------------------------------  end module sugwd_m
   
 !*       2.    SET VALUES OF SECURITY PARAMETERS  
 !              ---------------------------------  
   
 200   CONTINUE  
   
       gvsec = 0.10  
       gssec = 1.E-12  
   
       gtsec = 1.E-07  
   
 !      ----------------------------------------------------------------  
   
       RETURN  
     END  
Legend:
Removed from v.23  
changed lines
  Added in v.54
  ViewVC Help
Powered by ViewVC 1.1.21