/[lmdze]/trunk/libf/dyn3d/advect.f
ViewVC logotype

Contents of /trunk/libf/dyn3d/advect.f

Parent Directory Parent Directory | Revision Log Revision Log

Revision 12 - (show annotations)
Mon Jul 21 16:05:07 2008 UTC (15 years, 10 months ago) by guez
File size: 4747 byte(s) 
-- Minor modification of input/output:

Created procedure "read_logic". Variables of module "logic" are read
by "read_logic" instead of "conf_gcm". Variable "offline" of module
"conf_gcm" is read from namelist instead of "*.def".

Deleted arguments "dtime", "co2_ppm_etat0", "solaire_etat0",
"tabcntr0" and local variables "radpas", "tab_cntrl" of
"phyetat0". "phyetat0" does not read "controle" in "startphy.nc" any
longer. "phyetat0" now reads global attribute "itau_phy" from
"startphy.nc". "phyredem" does not create variable "controle" in
"startphy.nc" any longer. "phyredem" now writes global attribute
"itau_phy" of "startphy.nc". Deleted argument "tabcntr0" of
"printflag". Removed diagnostic messages written by "printflag" for
comparison of the variable "controle" of "startphy.nc" and the
variables read from "*.def" or namelist input.

-- Removing unwanted functionality:

Removed variable "lunout" from module "iniprint", replaced everywhere
by standard output.

Removed case "ocean == 'couple'" in "clmain", "interfsurf_hq" and
"physiq". Removed procedure "interfoce_cpl".

-- Should not change anything at run time:

Automated creation of graphs in documentation. More documentation on
input files.

Converted Fortran files to free format: "phyredem.f90", "printflag.f90".

Split module "clesphy" into "clesphys" and "clesphys2".

Removed variables "conser", "leapf", "forward", "apphys", "apdiss" and
"statcl" from module "logic". Added arguments "conser" to "advect",
"leapf" to "integrd". Added local variables "forward", "leapf",
"apphys", "conser", "apdiss" in "leapfrog".

Added intent attributes.

Deleted arguments "dtime" of "phyredem", "pdtime" of "flxdtdq", "sh"
of "phytrac", "dt" of "yamada".

Deleted local variables "dtime", "co2_ppm_etat0", "solaire_etat0",
"length", "tabcntr0" in "physiq". Replaced all references to "dtime"
by references to "pdtphys".
1 !
2 ! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/advect.F,v 1.1.1.1 2004/05/19 12:53:06 lmdzadmin Exp $
3 !
4 SUBROUTINE advect(ucov,vcov,teta,w,massebx,masseby,du,dv,dteta,
5 $ conser)
6
7 use dimens_m
8 use paramet_m
9 use comconst
10 use comvert
11 use comgeom
12 use ener
13 IMPLICIT NONE
14 c=======================================================================
15 c
16 c Auteurs: P. Le Van , Fr. Hourdin .
17 c -------
18 c
19 c Objet:
20 c ------
21 c
22 c *************************************************************
23 c .... calcul des termes d'advection vertic.pour u,v,teta,q ...
24 c *************************************************************
25 c ces termes sont ajoutes a du,dv,dteta et dq .
26 c Modif F.Forget 03/94 : on retire q de advect
27 c
28 c=======================================================================
29 c-----------------------------------------------------------------------
30 c Declarations:
31 c -------------
32
33
34 c Arguments:
35 c ----------
36
37 REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm)
38 REAL massebx(ip1jmp1,llm),masseby(ip1jm,llm),w(ip1jmp1,llm)
39 REAL dv(ip1jm,llm),du(ip1jmp1,llm),dteta(ip1jmp1,llm)
40 logical, intent(in):: conser
41
42 c Local:
43 c ------
44
45 REAL uav(ip1jmp1,llm),vav(ip1jm,llm),wsur2(ip1jmp1)
46 REAL unsaire2(ip1jmp1), ge(ip1jmp1)
47 REAL deuxjour, ww, gt, uu, vv
48
49 INTEGER ij,l
50
51 REAL SSUM
52
53 c-----------------------------------------------------------------------
54 c 2. Calculs preliminaires:
55 c -------------------------
56
57 IF (conser) THEN
58 deuxjour = 2. * daysec
59
60 DO 1 ij = 1, ip1jmp1
61 unsaire2(ij) = unsaire(ij) * unsaire(ij)
62 1 CONTINUE
63 END IF
64
65
66 c------------------ -yy ----------------------------------------------
67 c . Calcul de u
68
69 DO l=1,llm
70 DO ij = iip2, ip1jmp1
71 uav(ij,l) = 0.25 * ( ucov(ij,l) + ucov(ij-iip1,l) )
72 ENDDO
73 DO ij = iip2, ip1jm
74 uav(ij,l) = uav(ij,l) + uav(ij+iip1,l)
75 ENDDO
76 DO ij = 1, iip1
77 uav(ij ,l) = 0.
78 uav(ip1jm+ij,l) = 0.
79 ENDDO
80 ENDDO
81
82 c------------------ -xx ----------------------------------------------
83 c . Calcul de v
84
85 DO l=1,llm
86 DO ij = 2, ip1jm
87 vav(ij,l) = 0.25 * ( vcov(ij,l) + vcov(ij-1,l) )
88 ENDDO
89 DO ij = 1,ip1jm,iip1
90 vav(ij,l) = vav(ij+iim,l)
91 ENDDO
92 DO ij = 1, ip1jm-1
93 vav(ij,l) = vav(ij,l) + vav(ij+1,l)
94 ENDDO
95 DO ij = 1, ip1jm, iip1
96 vav(ij+iim,l) = vav(ij,l)
97 ENDDO
98 ENDDO
99
100 c-----------------------------------------------------------------------
101
102 c
103 DO 20 l = 1, llmm1
104
105
106 c ...... calcul de - w/2. au niveau l+1 .......
107
108 DO 5 ij = 1, ip1jmp1
109 wsur2( ij ) = - 0.5 * w( ij,l+1 )
110 5 CONTINUE
111
112
113 c ..................... calcul pour du ..................
114
115 DO 6 ij = iip2 ,ip1jm-1
116 ww = wsur2 ( ij ) + wsur2( ij+1 )
117 uu = 0.5 * ( ucov(ij,l) + ucov(ij,l+1) )
118 du(ij,l) = du(ij,l) - ww * ( uu - uav(ij, l ) )/massebx(ij, l )
119 du(ij,l+1)= du(ij,l+1) + ww * ( uu - uav(ij,l+1) )/massebx(ij,l+1)
120 6 CONTINUE
121
122 c ..... correction pour du(iip1,j,l) ........
123 c ..... du(iip1,j,l)= du(1,j,l) .....
124
125 CDIR$ IVDEP
126 DO 7 ij = iip1 +iip1, ip1jm, iip1
127 du( ij, l ) = du( ij -iim, l )
128 du( ij,l+1 ) = du( ij -iim,l+1 )
129 7 CONTINUE
130
131 c ................. calcul pour dv .....................
132
133 DO 8 ij = 1, ip1jm
134 ww = wsur2( ij+iip1 ) + wsur2( ij )
135 vv = 0.5 * ( vcov(ij,l) + vcov(ij,l+1) )
136 dv(ij,l) = dv(ij, l ) - ww * (vv - vav(ij, l ) )/masseby(ij, l )
137 dv(ij,l+1)= dv(ij,l+1) + ww * (vv - vav(ij,l+1) )/masseby(ij,l+1)
138 8 CONTINUE
139
140 c
141
142 c ............................................................
143 c ............... calcul pour dh ...................
144 c ............................................................
145
146 c ---z
147 c calcul de - d( teta * w ) qu'on ajoute a dh
148 c ...............
149
150 DO 15 ij = 1, ip1jmp1
151 ww = wsur2(ij) * (teta(ij,l) + teta(ij,l+1) )
152 dteta(ij, l ) = dteta(ij, l ) - ww
153 dteta(ij,l+1) = dteta(ij,l+1) + ww
154 15 CONTINUE
155
156 IF( conser) THEN
157 DO 17 ij = 1,ip1jmp1
158 ge(ij) = wsur2(ij) * wsur2(ij) * unsaire2(ij)
159 17 CONTINUE
160 gt = SSUM( ip1jmp1,ge,1 )
161 gtot(l) = deuxjour * SQRT( gt/ip1jmp1 )
162 END IF
163
164 20 CONTINUE
165
166 RETURN
167 END
  ViewVC Help
Powered by ViewVC 1.1.21