source: LMDZ5/branches/LMDZ5V2.0-dev/libf/dyn3dpar/ugeostr.F90 @ 5353

Last change on this file since 5353 was 1474, checked in by lguez, 14 years ago

Conversion to free source form for "ugeostr". Removed strange "print
*, 301" at the end of "ugeostr".

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 1.4 KB
RevLine 
[630]1!
[1279]2! $Id: ugeostr.F90 1474 2011-01-14 11:04:45Z ymeurdesoif $
[630]3!
[1474]4subroutine ugeostr(phi,ucov)
[630]5
[1474]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.
[630]12
[1474]13  implicit none
[630]14
[1474]15  include "dimensions.h"
16  include "paramet.h"
17  include "comconst.h"
18  include "comgeom2.h"
[630]19
[1474]20  real ucov(iip1,jjp1,llm),phi(iip1,jjp1,llm)
21  real um(jjm,llm),fact,u(iip1,jjm,llm)
22  integer i,j,l
[630]23
[1474]24  real zlat
[630]25
[1474]26  um(:,:)=0 ! initialize um()
[630]27
[1474]28  DO j=1,jjm
[1279]29
[1474]30     if (abs(sin(rlatv(j))).lt.1.e-4) then
31        zlat=1.e-4
32     else
33        zlat=rlatv(j)
34     endif
35     fact=cos(zlat)
36     fact=fact*fact
37     fact=fact*fact
38     fact=fact*fact
39     fact=(1.-fact)/ &
40          (2.*omeg*sin(zlat)*(rlatu(j+1)-rlatu(j)))
41     fact=-fact/rad
42     DO l=1,llm
43        DO i=1,iim
44           u(i,j,l)=fact*(phi(i,j+1,l)-phi(i,j,l))
45           um(j,l)=um(j,l)+u(i,j,l)/REAL(iim)
46        ENDDO
47     ENDDO
48  ENDDO
49  call dump2d(jjm,llm,um,'Vent-u geostrophique')
[630]50
[1474]51  !   calcul des champ de vent:
[630]52
[1474]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
[630]65
[1474]66  print *, 301
[630]67
[1474]68end subroutine ugeostr
Note: See TracBrowser for help on using the repository browser.