/[lmdze]/trunk/dyn3d/tourabs.f
ViewVC logotype

Annotation of /trunk/dyn3d/tourabs.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 64 - (hide annotations)
Wed Aug 29 14:47:17 2012 UTC (11 years, 9 months ago) by guez
Original Path: trunk/libf/dyn3d/tourabs.f
File size: 2520 byte(s)
Removed variable lstardis in module comdissnew and procedures gradiv
and nxgrarot. lstardir had to be true. gradiv and nxgrarot were called
if lstardis was false. Removed argument iter of procedure
filtreg. iter had to be 1. gradiv and nxgrarot called filtreg with
iter == 2.

Moved procedure flxsetup into module yoecumf. Module yoecumf is only
used in program units of directory Conflx, moved it there.

1 guez 3 SUBROUTINE tourabs ( ntetaSTD,vcov, ucov, vorabs )
2    
3     c=======================================================================
4     c
5     c Modif: I. Musat (28/10/04)
6     c -------
7     c adaptation du code tourpot.F pour le calcul de la vorticite absolue
8     c cf. P. Le Van
9     c
10     c Objet:
11     c ------
12     c
13     c *******************************************************************
14     c ............. calcul de la vorticite absolue .................
15     c *******************************************************************
16     c
17     c ntetaSTD, vcov,ucov sont des argum. d'entree pour le s-pg .
18     c vorabs est un argum.de sortie pour le s-pg .
19     c
20     c=======================================================================
21    
22     use dimens_m
23     use paramet_m
24     use comconst
25 guez 57 use conf_gcm_m
26 guez 3 use comgeom
27 guez 27 use filtreg_m, only: filtreg
28 guez 39 USE nr_util, ONLY : pi
29 guez 27
30 guez 3 IMPLICIT NONE
31     c
32     INTEGER ntetaSTD
33     REAL vcov( ip1jm,ntetaSTD ), ucov( ip1jmp1,ntetaSTD )
34     REAL vorabs( ip1jm,ntetaSTD )
35     c
36     c variables locales
37     INTEGER l, ij, i, j
38     REAL rot( ip1jm,ntetaSTD )
39    
40    
41    
42     c ... vorabs = ( Filtre( d(vcov)/dx - d(ucov)/dy ) + fext ) ..
43    
44    
45    
46     c ........ Calcul du rotationnel du vent V puis filtrage ........
47    
48     DO 5 l = 1,ntetaSTD
49    
50     DO 2 i = 1, iip1
51     DO 2 j = 1, jjm
52     c
53     ij=i+(j-1)*iip1
54     IF(ij.LE.ip1jm - 1) THEN
55     c
56     IF(cv(ij).EQ.0..OR.cv(ij+1).EQ.0..OR.
57     $ cu(ij).EQ.0..OR.cu(ij+iip1).EQ.0.) THEN
58     rot( ij,l ) = 0.
59     continue
60     ELSE
61     rot( ij,l ) = (vcov(ij+1,l)/cv(ij+1)-vcov(ij,l)/cv(ij))/
62     $ (2.*pi*RAD*cos(rlatv(j)))*float(iim)
63     $ +(ucov(ij+iip1,l)/cu(ij+iip1)-ucov(ij,l)/cu(ij))/
64     $ (pi*RAD)*(float(jjm)-1.)
65     c
66     ENDIF
67     ENDIF !(ij.LE.ip1jm - 1) THEN
68     2 CONTINUE
69    
70     c .... correction pour rot( iip1,j,l ) .....
71     c .... rot(iip1,j,l) = rot(1,j,l) .....
72    
73     CDIR$ IVDEP
74    
75     DO 3 ij = iip1, ip1jm, iip1
76     rot( ij,l ) = rot( ij -iim, l )
77     3 CONTINUE
78    
79     5 CONTINUE
80    
81    
82 guez 64 CALL filtreg( rot, jjm, ntetaSTD, 2, 1, .FALSE.)
83 guez 3
84    
85     DO 10 l = 1, ntetaSTD
86    
87     DO 6 ij = 1, ip1jm - 1
88     vorabs( ij,l ) = ( rot(ij,l) + fext(ij)*unsairez(ij) )
89     6 CONTINUE
90    
91     c ..... correction pour vorabs( iip1,j,l) .....
92     c .... vorabs(iip1,j,l)= vorabs(1,j,l) ....
93     CDIR$ IVDEP
94     DO 8 ij = iip1, ip1jm, iip1
95     vorabs( ij,l ) = vorabs( ij -iim,l )
96     8 CONTINUE
97    
98     10 CONTINUE
99    
100     RETURN
101     END

  ViewVC Help
Powered by ViewVC 1.1.21