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

Annotation of /trunk/dyn3d/fluxstokenc.f90

Parent Directory Parent Directory | Revision Log Revision Log

Revision 68 - (hide annotations)
Wed Nov 14 16:59:30 2012 UTC (11 years, 6 months ago) by guez
Original Path: trunk/libf/dyn3d/fluxstokenc.f90
File size: 3059 byte(s) 
Split "flincom.f90" into "flinclo.f90", "flinfindcood.f90",
"flininfo.f90" and "flinopen_nozoom.f90", in directory
"IOIPSL/Flincom".

Renamed "etat0_lim" to "ce0l", as in LMDZ.

Split "readsulfate.f" into "readsulfate.f90", "readsulfate_preind.f90"
and "getso4fromfile.f90".

In etat0, renamed variable q3d to q, as in "dynredem1". Replaced calls
to Flicom procedures by calls to NetCDF95.

In leapfrog, added call to writehist.

Extracted ASCII art from "grid_noro" into a file
"grid_noro.txt". Transformed explicit-shape local arrays into
automatic arrays, so that test on values of iim and jjm is no longer
needed. Test on weight:
          IF (weight(ii, jj) /= 0.) THEN
is useless. There is already a test before:
    if (any(weight == 0.)) stop "zero weight in grid_noro"

In "aeropt", replaced duplicated lines with different values of inu by
a loop on inu.

Removed arguments of "conf_phys". Corresponding variables are now
defined in "physiq", in a namelist. In "conf_phys", read a namelist
instead of using getin.
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 guez 68 REAL masse(ip1jmp1, llm)
15     real, intent(in):: phi(ip1jmp1, llm)
16 guez 44 real, intent(in):: teta(ip1jmp1, llm)
17 guez 31 REAL phis(ip1jmp1)
18 guez 28 REAL, intent(in):: time_step
19 guez 31 INTEGER, INTENT (IN) :: itau
20 guez 3
21 guez 31 ! Variables local to the procedure:
22 guez 3
23 guez 31 REAL, SAVE:: pbaruc(ip1jmp1, llm), pbarvc(ip1jm, llm)
24     REAL, SAVE:: massem(ip1jmp1, llm)
25     real, SAVE:: tetac(ip1jmp1, llm), phic(ip1jmp1, llm)
26 guez 3
27 guez 31 REAL pbarug(ip1jmp1, llm), pbarvg(iip1, jjm, llm), wg(ip1jmp1, llm)
28 guez 28 REAL tst(1), ist(1), istp(1)
29 guez 31 INTEGER ij, l
30     INTEGER, save:: fluxid, fluxvid
31     integer fluxdid
32 guez 3
33 guez 28 !-------------------------------------------------------------
34 guez 3
35 guez 32 IF (itau == 0) THEN
36 guez 31 CALL initfluxsto(time_step, istdyn*time_step, istdyn*time_step, nqmx, &
37     fluxid, fluxvid, fluxdid)
38     CALL histwrite(fluxid, 'phis', 1, phis)
39     CALL histwrite(fluxid, 'aire', 1, aire)
40 guez 28 tst(1) = time_step
41 guez 31 CALL histwrite(fluxdid, 'dtvr', 1, tst)
42 guez 28 ist(1) = istdyn
43 guez 31 CALL histwrite(fluxdid, 'istdyn', 1, ist)
44 guez 28 istp(1) = istphy
45 guez 31 CALL histwrite(fluxdid, 'istphy', 1, istp)
46 guez 3
47 guez 31 CALL initial0(ijp1llm, phic)
48     CALL initial0(ijp1llm, tetac)
49     CALL initial0(ijp1llm, pbaruc)
50     CALL initial0(ijmllm, pbarvc)
51 guez 28 END IF
52 guez 3
53 guez 28 ! accumulation des flux de masse horizontaux
54     DO l = 1, llm
55     DO ij = 1, ip1jmp1
56 guez 31 pbaruc(ij, l) = pbaruc(ij, l) + pbaru(ij, l)
57     tetac(ij, l) = tetac(ij, l) + teta(ij, l)
58     phic(ij, l) = phic(ij, l) + phi(ij, l)
59 guez 28 END DO
60     DO ij = 1, ip1jm
61 guez 31 pbarvc(ij, l) = pbarvc(ij, l) + pbarv(ij, l)
62 guez 28 END DO
63     END DO
64 guez 3
65 guez 28 ! selection de la masse instantannee des mailles avant le transport.
66 guez 31 IF (itau == 0) THEN
67     CALL scopy(ip1jmp1*llm, masse, 1, massem, 1)
68 guez 28 END IF
69 guez 3
70 guez 32 IF (mod(itau + 1, istdyn) == 0) THEN
71     ! on advecte a ce pas de temps
72 guez 28 ! normalisation
73     DO l = 1, llm
74     DO ij = 1, ip1jmp1
75 guez 31 pbaruc(ij, l) = pbaruc(ij, l)/float(istdyn)
76     tetac(ij, l) = tetac(ij, l)/float(istdyn)
77     phic(ij, l) = phic(ij, l)/float(istdyn)
78 guez 28 END DO
79     DO ij = 1, ip1jm
80 guez 31 pbarvc(ij, l) = pbarvc(ij, l)/float(istdyn)
81 guez 28 END DO
82     END DO
83 guez 3
84 guez 28 ! traitement des flux de masse avant advection.
85     ! 1. calcul de w
86     ! 2. groupement des mailles pres du pole.
87    
88 guez 31 CALL groupe(massem, pbaruc, pbarvc, pbarug, pbarvg, wg)
89 guez 28
90 guez 31 CALL histwrite(fluxid, 'masse', itau, massem)
91     CALL histwrite(fluxid, 'pbaru', itau, pbarug)
92     CALL histwrite(fluxvid, 'pbarv', itau, pbarvg)
93     CALL histwrite(fluxid, 'w', itau, wg)
94     CALL histwrite(fluxid, 'teta', itau, tetac)
95     CALL histwrite(fluxid, 'phi', itau, phic)
96     END IF
97 guez 28
98     END SUBROUTINE fluxstokenc
  ViewVC Help
Powered by ViewVC 1.1.21