source: LMDZ6/trunk/libf/dyn3d_common/ugeostr.f90 @ 5281

Last change on this file since 5281 was 5281, checked in by abarral, 4 days ago

Turn comgeom.h comgeom2.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.5 KB
Line 
1!
2! $Id: ugeostr.f90 5281 2024-10-28 10:17:48Z 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 comgeom2_mod_h
14  use comconst_mod, only: omeg, rad
15
16  USE dimensions_mod, ONLY: iim, jjm, llm, ndm
17USE paramet_mod_h, ONLY: iip1, iip2, iip3, jjp1, llmp1, llmp2, llmm1, kftd, ip1jm, ip1jmp1, &
18          ip1jmi1, ijp1llm, ijmllm, mvar, jcfil, jcfllm
19implicit none
20
21
22
23
24  real ucov(iip1,jjp1,llm),phi(iip1,jjp1,llm)
25  real um(jjm,llm),fact,u(iip1,jjm,llm)
26  integer i,j,l
27
28  real zlat
29
30  um(:,:)=0 ! initialize um()
31
32  DO j=1,jjm
33
34     if (abs(sin(rlatv(j))).lt.1.e-4) then
35        zlat=1.e-4
36     else
37        zlat=rlatv(j)
38     endif
39     fact=cos(zlat)
40     fact=fact*fact
41     fact=fact*fact
42     fact=fact*fact
43     fact=(1.-fact)/ &
44          (2.*omeg*sin(zlat)*(rlatu(j+1)-rlatu(j)))
45     fact=-fact/rad
46     DO l=1,llm
47        DO i=1,iim
48           u(i,j,l)=fact*(phi(i,j+1,l)-phi(i,j,l))
49           um(j,l)=um(j,l)+u(i,j,l)/REAL(iim)
50        ENDDO
51     ENDDO
52  ENDDO
53  call dump2d(jjm,llm,um,'Vent-u geostrophique')
54
55  !   calcul des champ de vent:
56
57  DO l=1,llm
58     DO i=1,iip1
59        ucov(i,1,l)=0.
60        ucov(i,jjp1,l)=0.
61     end DO
62     DO  j=2,jjm
63        DO  i=1,iim
64           ucov(i,j,l) = 0.5*(u(i,j,l)+u(i,j-1,l))*cu(i,j)
65        end DO
66        ucov(iip1,j,l)=ucov(1,j,l)
67     end DO
68  end DO
69
70  print *, 301
71
72end subroutine ugeostr
Note: See TracBrowser for help on using the repository browser.