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

Annotation of /trunk/Sources/dyn3d/fluxstokenc.f

Parent Directory Parent Directory | Revision Log Revision Log

Revision 15 - (hide annotations)
Fri Aug 1 15:24:12 2008 UTC (15 years, 9 months ago) by guez
Original Path: trunk/libf/dyn3d/fluxstokenc.f
File size: 3656 byte(s) 
-- Minor modification of input/output:

Added variable "Sigma_O3_Royer" to "histday.nc". "ecrit_day" is not
modified in "physiq". Removed variables "pyu1", "pyv1", "ftsol1",
"ftsol2", "ftsol3", "ftsol4", "psrf1", "psrf2", "psrf3", "psrf4"
"mfu", "mfd", "en_u", "en_d", "de_d", "de_u", "coefh" from
"histrac.nc".

Variable "raz_date" of module "conf_gcm_m" has logical type instead of
integer type.

-- Should not change any result at run time:

Modified calls to "IOIPSL_Lionel" procedures because the interfaces of
these procedures have been simplified.

Changed name of variable in module "start_init_orog_m": "masque" to
"mask".

Created a module containing procedure "phyredem".

Removed arguments "punjours", "pdayref" and "ptimestep" of procedure
"iniphysiq".

Renamed procedure "gr_phy_write" to "gr_phy_write_2d". Created
procedure "gr_phy_write_3d".

Removed procedures "ini_undefstd", "moy_undefSTD", "calcul_STDlev",
"calcul_divers".
1 guez 3 SUBROUTINE fluxstokenc(pbaru,pbarv,masse,teta,phi,phis,
2     . time_step,itau )
3    
4     USE IOIPSL
5     c
6     c Auteur : F. Hourdin
7     c
8     c
9     ccc .. Modif. P. Le Van ( 20/12/97 ) ...
10     c
11     use dimens_m
12     use paramet_m
13     use comconst
14     use comvert
15     use comgeom
16     use temps
17     use tracstoke
18     IMPLICIT NONE
19     c
20    
21     REAL time_step,t_wrt, t_ops
22     REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm)
23     REAL masse(ip1jmp1,llm),teta(ip1jmp1,llm),phi(ip1jmp1,llm)
24     REAL phis(ip1jmp1)
25    
26     REAL pbaruc(ip1jmp1,llm),pbarvc(ip1jm,llm)
27     REAL massem(ip1jmp1,llm),tetac(ip1jmp1,llm),phic(ip1jmp1,llm)
28    
29     REAL pbarug(ip1jmp1,llm),pbarvg(iip1,jjm,llm),wg(ip1jmp1,llm)
30    
31     REAL pbarvst(iip1,jjp1,llm),zistdyn
32     real dtcum
33    
34     INTEGER iadvtr,ndex(1)
35     integer nscal
36     real tst(1),ist(1),istp(1)
37     INTEGER ij,l,irec,i,j
38     integer, intent(in):: itau
39     INTEGER fluxid, fluxvid,fluxdid
40    
41     SAVE iadvtr, massem,pbaruc,pbarvc,irec
42     SAVE phic,tetac
43     logical first
44     save first
45     data first/.true./
46     DATA iadvtr/0/
47    
48     if(first) then
49    
50     CALL initfluxsto( 'fluxstoke',
51     . time_step,istdyn* time_step,istdyn* time_step,
52     . nqmx, fluxid,fluxvid,fluxdid)
53    
54     ndex(1) = 0
55 guez 15 call histwrite(fluxid, 'phis', 1, phis)
56     call histwrite(fluxid, 'aire', 1, aire)
57 guez 3
58     ndex(1) = 0
59     nscal = 1
60     tst(1) = time_step
61 guez 15 call histwrite(fluxdid, 'dtvr', 1, tst)
62 guez 3 ist(1)=istdyn
63 guez 15 call histwrite(fluxdid, 'istdyn', 1, ist)
64 guez 3 istp(1)= istphy
65 guez 15 call histwrite(fluxdid, 'istphy', 1, istp)
66 guez 3
67     first = .false.
68    
69     endif
70    
71    
72     IF(iadvtr.EQ.0) THEN
73     CALL initial0(ijp1llm,phic)
74     CALL initial0(ijp1llm,tetac)
75     CALL initial0(ijp1llm,pbaruc)
76     CALL initial0(ijmllm,pbarvc)
77     ENDIF
78    
79     c accumulation des flux de masse horizontaux
80     DO l=1,llm
81     DO ij = 1,ip1jmp1
82     pbaruc(ij,l) = pbaruc(ij,l) + pbaru(ij,l)
83     tetac(ij,l) = tetac(ij,l) + teta(ij,l)
84     phic(ij,l) = phic(ij,l) + phi(ij,l)
85     ENDDO
86     DO ij = 1,ip1jm
87     pbarvc(ij,l) = pbarvc(ij,l) + pbarv(ij,l)
88     ENDDO
89     ENDDO
90    
91     c selection de la masse instantannee des mailles avant le transport.
92     IF(iadvtr.EQ.0) THEN
93     CALL SCOPY(ip1jmp1*llm,masse,1,massem,1)
94     ENDIF
95    
96     iadvtr = iadvtr+1
97    
98    
99     c Test pour savoir si on advecte a ce pas de temps
100     IF ( iadvtr.EQ.istdyn ) THEN
101     c normalisation
102     DO l=1,llm
103     DO ij = 1,ip1jmp1
104     pbaruc(ij,l) = pbaruc(ij,l)/float(istdyn)
105     tetac(ij,l) = tetac(ij,l)/float(istdyn)
106     phic(ij,l) = phic(ij,l)/float(istdyn)
107     ENDDO
108     DO ij = 1,ip1jm
109     pbarvc(ij,l) = pbarvc(ij,l)/float(istdyn)
110     ENDDO
111     ENDDO
112    
113     c traitement des flux de masse avant advection.
114     c 1. calcul de w
115     c 2. groupement des mailles pres du pole.
116    
117     CALL groupe( massem, pbaruc,pbarvc, pbarug,pbarvg,wg )
118    
119     do l=1,llm
120     do j=1,jjm
121     do i=1,iip1
122     pbarvst(i,j,l)=pbarvg(i,j,l)
123     enddo
124     enddo
125     do i=1,iip1
126     pbarvst(i,jjp1,l)=0.
127     enddo
128     enddo
129    
130     iadvtr=0
131     Print*,'ITAU auqel on stoke les fluxmasses',itau
132    
133 guez 15 call histwrite(fluxid, 'masse', itau, massem)
134 guez 3
135 guez 15 call histwrite(fluxid, 'pbaru', itau, pbarug)
136 guez 3
137 guez 15 call histwrite(fluxvid, 'pbarv', itau, pbarvg)
138 guez 3
139 guez 15 call histwrite(fluxid, 'w' ,itau, wg)
140 guez 3
141 guez 15 call histwrite(fluxid, 'teta' ,itau, tetac)
142 guez 3
143 guez 15 call histwrite(fluxid, 'phi' ,itau, phic)
144 guez 3
145     C
146    
147     ENDIF ! if iadvtr.EQ.istdyn
148    
149     RETURN
150     END
  ViewVC Help
Powered by ViewVC 1.1.21