source: trunk/LMDZ.COMMON/libf/dyn3d_common/ugeostr.F90

Last change on this file was 1422, checked in by milmd, 10 years ago

In GENERIC, MARS and COMMON models replace some include files by modules (usefull for decoupling physics with dynamics).

File size: 1.4 KB
Line 
1!
2! $Id: ugeostr.F90 1474 2011-01-14 11:04:45Z lguez $
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
51  !   calcul des champ de vent:
52
53  DO l=1,llm
54     DO i=1,iip1
55        ucov(i,1,l)=0.
56        ucov(i,jjp1,l)=0.
57     end DO
58     DO  j=2,jjm
59        DO  i=1,iim
60           ucov(i,j,l) = 0.5*(u(i,j,l)+u(i,j-1,l))*cu(i,j)
61        end DO
62        ucov(iip1,j,l)=ucov(1,j,l)
63     end DO
64  end DO
65
66  print *, 301
67
68end subroutine ugeostr
Note: See TracBrowser for help on using the repository browser.