source: LMDZ5/branches/testing/libf/dyn3d_common/ugeostr.F90 @ 5139

Last change on this file since 5139 was 2641, checked in by Laurent Fairhead, 8 years ago

Merged trunk changes r2593:2640 into testing branch

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 1.4 KB
Line 
1!
2! $Id: ugeostr.F90 2641 2016-09-29 21:26:46Z abarral $
3!
4subroutine ugeostr(phi,ucov)
5
6  ! Calcul du vent covariant geostrophique a partir du champ de
7  ! geopotentiel.
8  ! We actually compute: (1 - cos^8 \phi) u_g
9  ! to have a wind going smoothly to 0 at the equator.
10  ! We assume that the surface pressure is uniform so that model
11  ! levels are pressure levels.
12
13  use comconst_mod, only: omeg, rad
14 
15  implicit none
16
17  include "dimensions.h"
18  include "paramet.h"
19  include "comgeom2.h"
20
21  real ucov(iip1,jjp1,llm),phi(iip1,jjp1,llm)
22  real um(jjm,llm),fact,u(iip1,jjm,llm)
23  integer i,j,l
24
25  real zlat
26
27  um(:,:)=0 ! initialize um()
28
29  DO j=1,jjm
30
31     if (abs(sin(rlatv(j))).lt.1.e-4) then
32        zlat=1.e-4
33     else
34        zlat=rlatv(j)
35     endif
36     fact=cos(zlat)
37     fact=fact*fact
38     fact=fact*fact
39     fact=fact*fact
40     fact=(1.-fact)/ &
41          (2.*omeg*sin(zlat)*(rlatu(j+1)-rlatu(j)))
42     fact=-fact/rad
43     DO l=1,llm
44        DO i=1,iim
45           u(i,j,l)=fact*(phi(i,j+1,l)-phi(i,j,l))
46           um(j,l)=um(j,l)+u(i,j,l)/REAL(iim)
47        ENDDO
48     ENDDO
49  ENDDO
50  call dump2d(jjm,llm,um,'Vent-u geostrophique')
51
52  !   calcul des champ de vent:
53
54  DO l=1,llm
55     DO i=1,iip1
56        ucov(i,1,l)=0.
57        ucov(i,jjp1,l)=0.
58     end DO
59     DO  j=2,jjm
60        DO  i=1,iim
61           ucov(i,j,l) = 0.5*(u(i,j,l)+u(i,j-1,l))*cu(i,j)
62        end DO
63        ucov(iip1,j,l)=ucov(1,j,l)
64     end DO
65  end DO
66
67  print *, 301
68
69end subroutine ugeostr
Note: See TracBrowser for help on using the repository browser.