source: LMDZ6/branches/Amaury_dev/libf/dyn3d_common/ugeostr.F90 @ 5122

Last change on this file since 5122 was 5117, checked in by abarral, 4 months ago

rename modules properly lmdz_*
move some unused files to obsolete/
(lint) uppercase fortran keywords

  • 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 5117 2024-07-24 14:23:34Z 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)))<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.