source: LMDZ4/trunk/libf/dyn3d/ugeostr.F @ 1167

Last change on this file since 1167 was 524, checked in by lmdzadmin, 20 years ago

Initial revision

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 1.5 KB
RevLine 
[524]1!
2! $Header$
3!
4      subroutine ugeostr(phi,ucov)
5
6
7c  Calcul du vent covariant geostrophique a partir du champs de
8c  geopotentiel en supposant que le vent au sol est nul.
9
10      implicit none
11
12#include "dimensions.h"
13#include "paramet.h"
14#include "comconst.h"
15#include "comgeom2.h"
16
17      real ucov(iip1,jjp1,llm),phi(iip1,jjp1,llm)
18      real um(jjm,llm),fact,u(iip1,jjm,llm)
19      integer i,j,l
20
21      real zlat
22
23      DO j=1,jjm
24
25         if (abs(sin(rlatv(j))).lt.1.e-4) then
26             zlat=1.e-4
27         else
28             zlat=rlatv(j)
29         endif
30         fact=cos(zlat)
31         fact=fact*fact
32         fact=fact*fact
33         fact=fact*fact
34         fact=(1.-fact)/
35     s    (2.*omeg*sin(zlat)*(rlatu(j+1)-rlatu(j)))
36         fact=-fact/rad
37         DO l=1,llm
38            DO i=1,iim
39               u(i,j,l)=fact*(phi(i,j+1,l)-phi(i,j,l))
40               um(j,l)=um(j,l)+u(i,j,l)/float(iim)
41            ENDDO
42         ENDDO
43      ENDDO
44      call dump2d(jjp1,llm,um,'Vent-u geostrophique')
45
46c
47c-----------------------------------------------------------------------
48c   calcul des champ de vent:
49c   -------------------------
50
51      DO 301 l=1,llm
52         DO 302 i=1,iip1
53            ucov(i,1,l)=0.
54            ucov(i,jjp1,l)=0.
55302      CONTINUE
56         DO 304 j=2,jjm
57            DO 305 i=1,iim
58               ucov(i,j,l) = 0.5*(u(i,j,l)+u(i,j-1,l))*cu(i,j)
59305         CONTINUE
60            ucov(iip1,j,l)=ucov(1,j,l)
61304      CONTINUE
62301   CONTINUE
63
64      print*,301
65
66      return
67      end
Note: See TracBrowser for help on using the repository browser.