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

Annotation of /trunk/dyn3d/fluxstokenc.f

Parent Directory Parent Directory | Revision Log Revision Log

Revision 32 - (hide annotations)
Tue Apr 6 17:52:58 2010 UTC (14 years, 2 months ago) by guez
Original Path: trunk/libf/dyn3d/fluxstokenc.f90
File size: 3019 byte(s) 
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 guez 31 SUBROUTINE fluxstokenc(pbaru, pbarv, masse, teta, phi, phis, time_step, itau)
2 guez 3
3 guez 31 ! Author: F. Hourdin
4 guez 3
5 guez 31 USE histwrite_m, ONLY : histwrite
6     USE dimens_m, ONLY : jjm, llm, nqmx
7     USE paramet_m, ONLY : iip1, ijmllm, ijp1llm, ip1jm, ip1jmp1, jjp1
8     USE comgeom, ONLY : aire
9     USE tracstoke, ONLY : istdyn, istphy
10 guez 3
11 guez 28 IMPLICIT NONE
12 guez 3
13 guez 31 REAL pbaru(ip1jmp1, llm), pbarv(ip1jm, llm)
14     REAL masse(ip1jmp1, llm), teta(ip1jmp1, llm), phi(ip1jmp1, llm)
15     REAL phis(ip1jmp1)
16 guez 28 REAL, intent(in):: time_step
17 guez 31 INTEGER, INTENT (IN) :: itau
18 guez 3
19 guez 31 ! Variables local to the procedure:
20 guez 3
21 guez 31 REAL, SAVE:: pbaruc(ip1jmp1, llm), pbarvc(ip1jm, llm)
22     REAL, SAVE:: massem(ip1jmp1, llm)
23     real, SAVE:: tetac(ip1jmp1, llm), phic(ip1jmp1, llm)
24 guez 3
25 guez 31 REAL pbarug(ip1jmp1, llm), pbarvg(iip1, jjm, llm), wg(ip1jmp1, llm)
26 guez 28 REAL tst(1), ist(1), istp(1)
27 guez 31 INTEGER ij, l
28     INTEGER, save:: fluxid, fluxvid
29     integer fluxdid
30 guez 3
31 guez 28 !-------------------------------------------------------------
32 guez 3
33 guez 32 IF (itau == 0) THEN
34 guez 31 CALL initfluxsto(time_step, istdyn*time_step, istdyn*time_step, nqmx, &
35     fluxid, fluxvid, fluxdid)
36     CALL histwrite(fluxid, 'phis', 1, phis)
37     CALL histwrite(fluxid, 'aire', 1, aire)
38 guez 28 tst(1) = time_step
39 guez 31 CALL histwrite(fluxdid, 'dtvr', 1, tst)
40 guez 28 ist(1) = istdyn
41 guez 31 CALL histwrite(fluxdid, 'istdyn', 1, ist)
42 guez 28 istp(1) = istphy
43 guez 31 CALL histwrite(fluxdid, 'istphy', 1, istp)
44 guez 3
45 guez 31 CALL initial0(ijp1llm, phic)
46     CALL initial0(ijp1llm, tetac)
47     CALL initial0(ijp1llm, pbaruc)
48     CALL initial0(ijmllm, pbarvc)
49 guez 28 END IF
50 guez 3
51 guez 28 ! accumulation des flux de masse horizontaux
52     DO l = 1, llm
53     DO ij = 1, ip1jmp1
54 guez 31 pbaruc(ij, l) = pbaruc(ij, l) + pbaru(ij, l)
55     tetac(ij, l) = tetac(ij, l) + teta(ij, l)
56     phic(ij, l) = phic(ij, l) + phi(ij, l)
57 guez 28 END DO
58     DO ij = 1, ip1jm
59 guez 31 pbarvc(ij, l) = pbarvc(ij, l) + pbarv(ij, l)
60 guez 28 END DO
61     END DO
62 guez 3
63 guez 28 ! selection de la masse instantannee des mailles avant le transport.
64 guez 31 IF (itau == 0) THEN
65     CALL scopy(ip1jmp1*llm, masse, 1, massem, 1)
66 guez 28 END IF
67 guez 3
68 guez 32 IF (mod(itau + 1, istdyn) == 0) THEN
69     ! on advecte a ce pas de temps
70 guez 28 ! normalisation
71     DO l = 1, llm
72     DO ij = 1, ip1jmp1
73 guez 31 pbaruc(ij, l) = pbaruc(ij, l)/float(istdyn)
74     tetac(ij, l) = tetac(ij, l)/float(istdyn)
75     phic(ij, l) = phic(ij, l)/float(istdyn)
76 guez 28 END DO
77     DO ij = 1, ip1jm
78 guez 31 pbarvc(ij, l) = pbarvc(ij, l)/float(istdyn)
79 guez 28 END DO
80     END DO
81 guez 3
82 guez 28 ! traitement des flux de masse avant advection.
83     ! 1. calcul de w
84     ! 2. groupement des mailles pres du pole.
85    
86 guez 31 CALL groupe(massem, pbaruc, pbarvc, pbarug, pbarvg, wg)
87 guez 28
88 guez 31 CALL histwrite(fluxid, 'masse', itau, massem)
89     CALL histwrite(fluxid, 'pbaru', itau, pbarug)
90     CALL histwrite(fluxvid, 'pbarv', itau, pbarvg)
91     CALL histwrite(fluxid, 'w', itau, wg)
92     CALL histwrite(fluxid, 'teta', itau, tetac)
93     CALL histwrite(fluxid, 'phi', itau, phic)
94     END IF
95 guez 28
96     END SUBROUTINE fluxstokenc
  ViewVC Help
Powered by ViewVC 1.1.21