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

Annotation of /trunk/dyn3d/integrd.f

Parent Directory Parent Directory | Revision Log Revision Log

Revision 12 - (hide annotations)
Mon Jul 21 16:05:07 2008 UTC (15 years, 10 months ago) by guez
Original Path: trunk/libf/dyn3d/integrd.f
File size: 5267 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 guez 3 !
2     ! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/integrd.F,v 1.1.1.1 2004/05/19 12:53:05 lmdzadmin Exp $
3     !
4     SUBROUTINE integrd
5     $ ( nq,vcovm1,ucovm1,tetam1,psm1,massem1,
6 guez 12 $ dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps,masse,phis,finvmaold,
7     $ leapf )
8 guez 3
9     use dimens_m
10     use paramet_m
11     use comconst
12     use comvert
13     use logic
14     use comgeom
15     use serre
16     use temps
17     use advtrac_m
18     use pression_m, only: pression
19    
20     IMPLICIT NONE
21    
22    
23     c=======================================================================
24     c
25     c Auteur: P. Le Van
26     c -------
27     c
28     c objet:
29     c ------
30     c
31     c Incrementation des tendances dynamiques
32     c
33     c=======================================================================
34     c-----------------------------------------------------------------------
35     c Declarations:
36     c -------------
37    
38    
39     c Arguments:
40     c ----------
41    
42     INTEGER nq
43    
44     REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm)
45     REAL q(ip1jmp1,llm,nq)
46     REAL ps(ip1jmp1),masse(ip1jmp1,llm),phis(ip1jmp1)
47    
48     REAL vcovm1(ip1jm,llm),ucovm1(ip1jmp1,llm)
49     REAL tetam1(ip1jmp1,llm),psm1(ip1jmp1),massem1(ip1jmp1,llm)
50    
51     REAL dv(ip1jm,llm),du(ip1jmp1,llm)
52     REAL dteta(ip1jmp1,llm),dp(ip1jmp1)
53     REAL dq(ip1jmp1,llm,nq), finvmaold(ip1jmp1,llm)
54 guez 12 logical, intent(in):: leapf
55 guez 3
56     c Local:
57     c ------
58    
59     REAL vscr( ip1jm ),uscr( ip1jmp1 ),hscr( ip1jmp1 ),pscr(ip1jmp1)
60     REAL massescr( ip1jmp1,llm ), finvmasse(ip1jmp1,llm)
61     REAL p(ip1jmp1,llmp1)
62     REAL tpn,tps,tppn(iim),tpps(iim)
63     REAL qpn,qps,qppn(iim),qpps(iim)
64     REAL deltap( ip1jmp1,llm )
65    
66     INTEGER l,ij,iq
67    
68     REAL SSUM
69    
70     c-----------------------------------------------------------------------
71    
72     DO l = 1,llm
73     DO ij = 1,iip1
74     ucov( ij , l) = 0.
75     ucov( ij +ip1jm, l) = 0.
76     uscr( ij ) = 0.
77     uscr( ij +ip1jm ) = 0.
78     ENDDO
79     ENDDO
80    
81    
82     c ............ integration de ps ..............
83    
84     CALL SCOPY(ip1jmp1*llm, masse, 1, massescr, 1)
85    
86     DO 2 ij = 1,ip1jmp1
87     pscr (ij) = ps(ij)
88     ps (ij) = psm1(ij) + dt * dp(ij)
89     2 CONTINUE
90     c
91     DO ij = 1,ip1jmp1
92     IF( ps(ij).LT.0. ) THEN
93     PRINT *,' Au point ij = ',ij, ' , pression sol neg. ', ps(ij)
94     STOP 'integrd'
95     ENDIF
96     ENDDO
97     c
98     DO ij = 1, iim
99     tppn(ij) = aire( ij ) * ps( ij )
100     tpps(ij) = aire(ij+ip1jm) * ps(ij+ip1jm)
101     ENDDO
102     tpn = SSUM(iim,tppn,1)/apoln
103     tps = SSUM(iim,tpps,1)/apols
104     DO ij = 1, iip1
105     ps( ij ) = tpn
106     ps(ij+ip1jm) = tps
107     ENDDO
108     c
109     c ... Calcul de la nouvelle masse d'air au dernier temps integre t+1 ...
110     c
111     CALL pression ( ip1jmp1, ap, bp, ps, p )
112     CALL massdair ( p , masse )
113    
114     CALL SCOPY( ijp1llm , masse, 1, finvmasse, 1 )
115     CALL filtreg( finvmasse, jjp1, llm, -2, 2, .TRUE., 1 )
116     c
117    
118     c ............ integration de ucov, vcov, h ..............
119    
120     DO 10 l = 1,llm
121    
122     DO 4 ij = iip2,ip1jm
123     uscr( ij ) = ucov( ij,l )
124     ucov( ij,l ) = ucovm1( ij,l ) + dt * du( ij,l )
125     4 CONTINUE
126    
127     DO 5 ij = 1,ip1jm
128     vscr( ij ) = vcov( ij,l )
129     vcov( ij,l ) = vcovm1( ij,l ) + dt * dv( ij,l )
130     5 CONTINUE
131    
132     DO 6 ij = 1,ip1jmp1
133     hscr( ij ) = teta(ij,l)
134     teta ( ij,l ) = tetam1(ij,l) * massem1(ij,l) / masse(ij,l)
135     $ + dt * dteta(ij,l) / masse(ij,l)
136     6 CONTINUE
137    
138     c .... Calcul de la valeur moyenne, unique aux poles pour teta ......
139     c
140     c
141     DO ij = 1, iim
142     tppn(ij) = aire( ij ) * teta( ij ,l)
143     tpps(ij) = aire(ij+ip1jm) * teta(ij+ip1jm,l)
144     ENDDO
145     tpn = SSUM(iim,tppn,1)/apoln
146     tps = SSUM(iim,tpps,1)/apols
147    
148     DO ij = 1, iip1
149     teta( ij ,l) = tpn
150     teta(ij+ip1jm,l) = tps
151     ENDDO
152     c
153    
154     IF(leapf) THEN
155     CALL SCOPY ( ip1jmp1, uscr(1), 1, ucovm1(1, l), 1 )
156     CALL SCOPY ( ip1jm, vscr(1), 1, vcovm1(1, l), 1 )
157     CALL SCOPY ( ip1jmp1, hscr(1), 1, tetam1(1, l), 1 )
158     END IF
159    
160     10 CONTINUE
161    
162     DO l = 1, llm
163     DO ij = 1, ip1jmp1
164     deltap(ij,l) = p(ij,l) - p(ij,l+1)
165     ENDDO
166     ENDDO
167    
168     CALL qminimum( q, nq, deltap )
169     c
170     c ..... Calcul de la valeur moyenne, unique aux poles pour q .....
171     c
172    
173     DO iq = 1, nq
174     DO l = 1, llm
175    
176     DO ij = 1, iim
177     qppn(ij) = aire( ij ) * q( ij ,l,iq)
178     qpps(ij) = aire(ij+ip1jm) * q(ij+ip1jm,l,iq)
179     ENDDO
180     qpn = SSUM(iim,qppn,1)/apoln
181     qps = SSUM(iim,qpps,1)/apols
182    
183     DO ij = 1, iip1
184     q( ij ,l,iq) = qpn
185     q(ij+ip1jm,l,iq) = qps
186     ENDDO
187    
188     ENDDO
189     ENDDO
190    
191    
192     CALL SCOPY( ijp1llm , finvmasse, 1, finvmaold, 1 )
193     c
194     c
195     c ..... FIN de l'integration de q .......
196    
197     15 continue
198    
199     c .................................................................
200    
201    
202     IF( leapf ) THEN
203     CALL SCOPY ( ip1jmp1 , pscr , 1, psm1 , 1 )
204     CALL SCOPY ( ip1jmp1*llm, massescr, 1, massem1, 1 )
205     END IF
206    
207     RETURN
208     END
  ViewVC Help
Powered by ViewVC 1.1.21