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

Last change on this file since 5122 was 5117, checked in by abarral, 5 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
RevLine 
[5099]1
[1279]2! $Id: ugeostr.F90 5117 2024-07-24 14:23:34Z abarral $
[5099]3
[5103]4SUBROUTINE ugeostr(phi,ucov)
[524]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.
[524]12
[5117]13  USE comconst_mod, ONLY: omeg, rad
[2597]14 
[5113]15  IMPLICIT NONE
[524]16
[1474]17  include "dimensions.h"
18  include "paramet.h"
19  include "comgeom2.h"
[524]20
[5117]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
[524]24
[5117]25  REAL zlat
[524]26
[1474]27  um(:,:)=0 ! initialize um()
[524]28
[1474]29  DO j=1,jjm
[1279]30
[5117]31     IF (abs(sin(rlatv(j)))<1.e-4) THEN
[1474]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
[5101]50  CALL dump2d(jjm,llm,um,'Vent-u geostrophique')
[524]51
[1474]52  !   calcul des champ de vent:
[524]53
[1474]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
[524]66
[1474]67  print *, 301
[524]68
[5103]69END SUBROUTINE  ugeostr
Note: See TracBrowser for help on using the repository browser.