Parent Directory | Revision Log
Split "stringop.f90" into single-procedure files. Gathered files in directory "IOIPSL/Stringop". Split "flincom.f90" into "flincom.f90" and "flinget.f90". Removed unused procedures from module "flincom". Removed unused argument "filename" of procedure "flinopen_nozoom". Removed unused files. Split "grid_change.f90" into "grid_change.f90" and "gr_phy_write_3d.f90". Removed unused procedures from modules "calendar", "ioipslmpp", "grid_atob", "gath_cpl" and "getincom". Removed unused procedures in files "ppm3d.f" and "thermcell.f". Split "mathelp.f90" into "mathelp.f90" and "mathop.f90". Removed unused variable "dpres" of module "comvert". Use argument "itau" instead of local variables "iadvtr" and "first" to control algorithm in procedure "fluxstokenc". Removed unused arguments of procedure "integrd". Removed useless computations at the end of procedure "leapfrog". Merged common block "matrfil" into module "parafilt".
1 | ! |
2 | ! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/groupeun.F,v 1.1.1.1 2004/05/19 12:53:07 lmdzadmin Exp $ |
3 | ! |
4 | subroutine groupeun(jjmax,llmax,q) |
5 | use dimens_m |
6 | use paramet_m |
7 | use comconst |
8 | use comgeom |
9 | implicit none |
10 | |
11 | |
12 | integer jjmax,llmax |
13 | real q(iip1,jjmax,llmax) |
14 | |
15 | integer ngroup |
16 | parameter (ngroup=3) |
17 | |
18 | real airen,airecn,qn |
19 | real aires,airecs,qs |
20 | |
21 | integer i,j,l,ig,j1,j2,i0,jd |
22 | |
23 | Champs 3D |
24 | jd=jjp1-jjmax |
25 | do l=1,llm |
26 | j1=1+jd |
27 | j2=2 |
28 | do ig=1,ngroup |
29 | do j=j1-jd,j2-jd |
30 | do i0=1,iim,2**(ngroup-ig+1) |
31 | airen=0. |
32 | airecn=0. |
33 | qn=0. |
34 | aires=0. |
35 | airecs=0. |
36 | qs=0. |
37 | do i=i0,i0+2**(ngroup-ig+1)-1 |
38 | airen=airen+aire_2d(i,j) |
39 | aires=aires+aire_2d(i,jjp1-j+1) |
40 | qn=qn+q(i,j,l) |
41 | qs=qs+q(i,jjp1-j+1-jd,l) |
42 | enddo |
43 | airecn=0. |
44 | airecs=0. |
45 | do i=i0,i0+2**(ngroup-ig+1)-1 |
46 | q(i,j,l)=qn*aire_2d(i,j)/airen |
47 | q(i,jjp1-j+1-jd,l)=qs*aire_2d(i,jjp1-j+1)/aires |
48 | enddo |
49 | enddo |
50 | q(iip1,j,l)=q(1,j,l) |
51 | q(iip1,jjp1-j+1-jd,l)=q(1,jjp1-j+1-jd,l) |
52 | enddo |
53 | j1=j2+1 |
54 | j2=j2+2**ig |
55 | enddo |
56 | enddo |
57 | |
58 | return |
59 | end |
ViewVC Help | |
Powered by ViewVC 1.1.21 |