GCC Code Coverage Report


Directory: ./
File: dyn3d_common/ugeostr.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 0 25 0.0%
Branches: 0 16 0.0%

Line Branch Exec Source
1 !
2 ! $Id: ugeostr.F90 2597 2016-07-22 06:44:47Z emillour $
3 !
4 subroutine 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))).lt.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
69 end subroutine ugeostr
70