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

Last change on this file since 5100 was 5099, checked in by abarral, 4 months ago

Replace most uses of CPP_DUST by the corresponding logical defined in lmdz_cppkeys_wrapper.F90
Convert several files from .F to .f90 to allow Dust to compile w/o rrtm/ecrad
Create lmdz_yoerad.f90
(lint) Remove "!" on otherwise empty line

  • 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 5099 2024-07-22 19:29:09Z 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.