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

Last change on this file since 3537 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
RevLine 
[1]1!
[66]2! $Id: ugeostr.F90 1474 2011-01-14 11:04:45Z lguez $
[1]3!
[66]4subroutine ugeostr(phi,ucov)
[1]5
[66]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.
[1]12
[1422]13  USE comconst_mod, ONLY: omeg,rad
14
[66]15  implicit none
[1]16
[66]17  include "dimensions.h"
18  include "paramet.h"
19  include "comgeom2.h"
[1]20
[66]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
[1]24
[66]25  real zlat
[1]26
[66]27  um(:,:)=0 ! initialize um()
[1]28
[66]29  DO j=1,jjm
[1]30
[66]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
[1]50
[66]51  !   calcul des champ de vent:
[1]52
[66]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
[1]65
[66]66  print *, 301
[1]67
[66]68end subroutine ugeostr
Note: See TracBrowser for help on using the repository browser.