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

Last change on this file since 5319 was 5160, checked in by abarral, 3 months ago

Put .h into modules

  • 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 5160 2024-08-03 12:56:58Z fairhead $
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  USE lmdz_comgeom2
15 
16USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
17  USE lmdz_paramet
18  IMPLICIT NONE
19
20
21
22
23  REAL ucov(iip1,jjp1,llm),phi(iip1,jjp1,llm)
24  REAL um(jjm,llm),fact,u(iip1,jjm,llm)
25  INTEGER i,j,l
26
27  REAL zlat
28
29  um(:,:)=0 ! initialize um()
30
31  DO j=1,jjm
32
33     IF (abs(sin(rlatv(j)))<1.e-4) THEN
34        zlat=1.e-4
35     else
36        zlat=rlatv(j)
37     endif
38     fact=cos(zlat)
39     fact=fact*fact
40     fact=fact*fact
41     fact=fact*fact
42     fact=(1.-fact)/ &
43          (2.*omeg*sin(zlat)*(rlatu(j+1)-rlatu(j)))
44     fact=-fact/rad
45     DO l=1,llm
46        DO i=1,iim
47           u(i,j,l)=fact*(phi(i,j+1,l)-phi(i,j,l))
48           um(j,l)=um(j,l)+u(i,j,l)/REAL(iim)
49        ENDDO
50     ENDDO
51  ENDDO
52  CALL dump2d(jjm,llm,um,'Vent-u geostrophique')
53
54  !   calcul des champ de vent:
55
56  DO l=1,llm
57     DO i=1,iip1
58        ucov(i,1,l)=0.
59        ucov(i,jjp1,l)=0.
60     end DO
61     DO  j=2,jjm
62        DO  i=1,iim
63           ucov(i,j,l) = 0.5*(u(i,j,l)+u(i,j-1,l))*cu(i,j)
64        end DO
65        ucov(iip1,j,l)=ucov(1,j,l)
66     end DO
67  end DO
68
69  PRINT *, 301
70
71END SUBROUTINE  ugeostr
Note: See TracBrowser for help on using the repository browser.