source: trunk/WRF.COMMON/WRFV2/mars_lmd/libf/phymars/calldrag_noro.F @ 3428

Last change on this file since 3428 was 11, checked in by aslmd, 14 years ago

spiga@svn-planeto:ajoute le modele meso-echelle martien

File size: 5.3 KB
Line 
1      SUBROUTINE calldrag_noro(ngrid,nlayer,ptimestep,
2     &                 pplay,pplev,pt,pu,pv,pdtgw,pdugw,pdvgw)
3
4
5
6                                                   
7       IMPLICIT NONE
8c=======================================================================
9c   subject:
10c   --------
11c   Subroutine designed to call SUBROUTINE drag_noro
12c   Interface for sub-grid scale orographic scheme
13c   The purpose of this subroutine is
14c      1) Make some initial calculation at first call
15c      2) Split the calculation in several sub-grid
16c        ("sub-domain") to save memory and
17c        be able run on a workstation at high resolution
18c        The sub-grid size is defined in dimradmars.h
19c
20c   author:   
21c   ------
22c           Christophe Hourdin/ Francois Forget
23c
24c   input:
25c   -----
26c   ngrid                 number of gridpoint of horizontal grid
27c   nlayer                Number of layer
28c   ptimestep             Physical timestep (s)
29c   pplay(ngrid,nlayer)    pressure (Pa) in the middle of each layer
30c   pplev(ngrid,nlayer+1)  pressure (Pa) at boundaries of each layer
31c   pt(ngrid,nlayer)       atmospheric temperature  (K)
32c   pu(ngrid,nlayer)       zonal wind (m s-1)
33c   pv(ngrid,nlayer)       meridional wind (m s-1)
34c
35c   output:
36c   -------
37c   pdtgw(ngrid,nlayer)    Temperature trend (K.s-1)
38c   pdugw(ngrid,nlayer)    zonal wind trend  (m.s-2)
39c   pdvgw(ngrid,nlayer)    meridional wind trend  (m.s-2)
40c
41c
42c
43c
44c
45c=======================================================================
46c
47c    0.  Declarations :
48c    ------------------
49c
50#include "dimensions.h"
51#include "dimphys.h"
52#include "dimradmars.h"
53#include "surfdat.h"
54
55c-----------------------------------------------------------------------
56c    Input/Output
57c    ------------
58      INTEGER ngrid,nlayer 
59
60      real ptimestep
61
62      REAL pplev(ngrid,nlayer+1),pplay(ngrid,nlayer)
63      REAL pt(ngrid,nlayer), pu(ngrid,nlayer),pv(ngrid,nlayer)
64      REAL pdtgw(ngrid,nlayer), pdugw(ngrid,nlayer),pdvgw(ngrid,nlayer)
65
66
67c
68c    Local variables :
69c    -----------------
70
71      REAL sigtest(nlayermx+1)
72      INTEGER igwd,igwdim,itest(ngridmx)
73
74      INTEGER ndomain
75      parameter (ndomain = (ngridmx-1) / ndomainsz + 1)
76
77      INTEGER l,ig
78      INTEGER jd,ig0,nd
79
80      REAL zulow(ngridmx),zvlow(ngridmx)
81      REAL zustr(ngridmx),zvstr(ngridmx)
82
83
84      REAL zplev(ndomainsz,nlayermx+1)
85      REAL zplay(ndomainsz,nlayermx)
86      REAL zt(ndomainsz,nlayermx)
87      REAL zu(ndomainsz,nlayermx)
88      REAL zv(ndomainsz,nlayermx)
89      INTEGER zidx(ndomainsz)
90      REAL zzdtgw(ndomainsz,nlayermx)
91      REAL zzdugw(ndomainsz,nlayermx)
92      REAL zzdvgw(ndomainsz,nlayermx)
93
94      logical ll
95
96
97c   local saved variables
98c   ---------------------
99
100      LOGICAL firstcall
101      DATA firstcall/.true./
102      SAVE firstcall
103
104
105c----------------------------------------------------------------------
106
107c     Initialisation
108c     --------------
109
110      IF (firstcall) THEN
111         do l=1,nlayermx+1
112           sigtest(l)=pplev(1,l)/pplev(1,1)
113         enddo
114         call sugwd(nlayermx,sigtest)
115
116         if (ngridmx .EQ. 1) then
117           if (ndomainsz .NE. 1) then
118             print*
119             print*,'ATTENTION !!!'
120             print*,'pour tourner en 1D, meme pour drag_noro '
121             print*,'fixer ndomainsz=1 dans phymars/dimradmars.h'
122             print*
123             call exit(1)
124           endif
125         endif
126
127         firstcall=.false.
128      END IF
129
130
131c     Starting loop on sub-domain
132c     ----------------------------
133
134      DO jd=1,ndomain
135        ig0=(jd-1)*ndomainsz
136        if (jd.eq.ndomain) then
137          nd=ngridmx-ig0
138        else
139          nd=ndomainsz
140        endif
141
142c    selection des points pour lesquels le shema est actif:
143
144        igwd=0
145        DO ig=ig0+1,ig0+nd
146          itest(ig)=0
147          ll=zstd(ig).gt.50.0
148          IF(ll) then
149            itest(ig)=1
150            igwd=igwd+1
151            zidx(igwd)=ig - ig0
152          ENDIF
153        ENDDO
154        IGWDIM=MAX(1,IGWD)
155
156c       Spliting input variable in sub-domain input variables
157c       ---------------------------------------------------
158
159        do l=1,nlayer+1
160          do ig = 1,nd
161           zplev(ig,l) = pplev(ig0+ig,l)
162          enddo
163        enddo
164
165        do l=1,nlayer
166          do ig = 1,nd
167            zplay(ig,l) = pplay(ig0+ig,l)
168            zt(ig,l) = pt(ig0+ig,l)
169            zu(ig,l) = pu(ig0+ig,l)
170            zv(ig,l) = pv(ig0+ig,l)
171          enddo
172        enddo
173
174
175c       Calling gravity wave and subgrid scale topo parameterization
176c       -------------------------------------------------------------
177
178        call drag_noro (nd,nlayer,ptimestep,zplay,zplev,
179     e            zstd(ig0+1),zsig(ig0+1),zgam(ig0+1),zthe(ig0+1),
180     e            igwd,igwdim,zidx,itest(ig0+1),
181     e            zt, zu, zv,
182     s            zulow(ig0+1),zvlow(ig0+1),zustr(ig0+1),zvstr(ig0+1),
183     s            zzdtgw,zzdugw,zzdvgw)
184
185
186c       Un-spliting output variable from sub-domain input variables
187c       ------------------------------------------------------------
188c       (and devide by ptimestep -> true tendancies)
189
190        do l=1,nlayer
191         do ig = 1,nd
192          pdtgw(ig0+ig,l) = zzdtgw(ig,l)/ptimestep
193          pdugw(ig0+ig,l) = zzdugw(ig,l)/ptimestep
194          pdvgw(ig0+ig,l) = zzdvgw(ig,l)/ptimestep
195         enddo
196        enddo
197
198      ENDDO         !   (boucle jd=1, ndomain)
199
200
201      return
202      end
203
Note: See TracBrowser for help on using the repository browser.