/[lmdze]/trunk/bibio/initfluxsto.f
ViewVC logotype

Contents of /trunk/bibio/initfluxsto.f

Parent Directory Parent Directory | Revision Log Revision Log

Revision 104 - (show annotations)
Thu Sep 4 10:05:52 2014 UTC (9 years, 8 months ago) by guez
File size: 6231 byte(s) 
Removed procedure sortvarc0. Called sortvarc with an additional
argument resetvarc instead. (Following LMDZ.) Moved current time
computations and some printing statements from sortvarc to
caldyn. Could then remove arguments itau and time_0 of sortvarc, and
could remove "use dynetat0". Better to keep "dynetat0.f" as a gcm-only
file.

Moved some variables from module ener to module sortvarc.

Split file "mathelp.f" into single-procedure files.

Removed unused argument nadv of adaptdt. Removed dimension arguments
of bernoui.

Removed unused argument nisurf of interfoce_lim. Changed the size of
argument lmt_sst of interfoce_lim from klon to knon. Removed case when
newlmt is false.

dynredem1 is called only once in each run, either ce0l or gcm. So
variable nb in call to nf95_put_var was always 1. Removed variable nb.

Removed dimension arguments of calcul_fluxs. Removed unused arguments
precip_rain, precip_snow, snow of calcul_fluxs. Changed the size of
all the arrays in calcul_fluxs from klon to knon.

Removed dimension arguments of fonte_neige. Changed the size of all
the arrays in fonte_neige from klon to knon.

Changed the size of arguments tsurf and tsurf_new of interfsurf_hq
from klon to knon. Changed the size of argument ptsrf of soil from
klon to knon.
1 SUBROUTINE initfluxsto(tstep, t_ops, t_wrt, nq, fileid, filevid, filedid)
2
3 ! From bibio/initfluxsto.F, v 1.1.1.1 2004/05/19 12:53:05
4
5 ! Routine d'initialisation des ecritures des fichiers histoires LMDZ
6 ! au format IOIPSL
7 ! Appels succesifs des routines: histbeg
8 ! histhori
9 ! histver
10 ! histdef
11 ! histend
12
13 ! Entree:
14 ! day0, anne0: date de reference
15 ! tstep: duree du pas de temps en seconde
16 ! t_ops: frequence de l'operation pour IOIPSL
17 ! t_wrt: frequence d'ecriture sur le fichier
18 ! nq: nombre de traceurs
19
20 ! Sortie:
21 ! fileid: ID du fichier netcdf cree
22 ! filevid:ID du fichier netcdf pour la grille v
23
24 ! L. Fairhead, 03/99
25
26 USE comconst
27 USE comgeom
28 use conf_gcm_m
29 USE dimens_m
30 USE disvert_m
31 USE histbeg_totreg_m, ONLY : histbeg_totreg
32 USE histdef_m, ONLY : histdef
33 USE histend_m, ONLY : histend
34 use histhori_regular_m, only: histhori_regular
35 use histsync_m, only: histsync
36 USE histvert_m, ONLY : histvert
37 USE nr_util, ONLY : pi
38 USE paramet_m
39 USE serre
40 USE temps, ONLY : annee_ref, day_ref, itau_dyn
41 use ymds2ju_m, only: ymds2ju
42
43 IMPLICIT NONE
44
45 ! Arguments
46 INTEGER itau
47 REAL, INTENT (IN) :: tstep
48 REAL t_ops, t_wrt
49 INTEGER fileid, filevid, filedid
50 INTEGER nq, ndex(1)
51 REAL nivd(1)
52
53 ! Variables locales
54 REAL zjulian
55 CHARACTER*3 str
56 CHARACTER*10 ctrac
57 INTEGER iq
58 REAL rlong(iip1, jjp1), rlat(iip1, jjp1)
59 INTEGER uhoriid, vhoriid, thoriid, zvertiid, dhoriid, dvertiid
60 INTEGER ii, jj, l
61 INTEGER zan, idayref
62 LOGICAL ok_sync
63
64 !---------------------------------------------------------
65
66 ! Initialisations
67 str = 'q '
68 ctrac = 'traceur '
69 ok_sync = .TRUE.
70
71 ! Appel a histbeg: creation du fichier netcdf et initialisations diverses
72
73 zan = annee_ref
74 idayref = day_ref
75 CALL ymds2ju(zan, 1, idayref, 0.0, zjulian)
76
77 DO jj = 1, jjp1
78 DO ii = 1, iip1
79 rlong(ii, jj) = rlonu(ii)*180./pi
80 rlat(ii, jj) = rlatu(jj)*180./pi
81 END DO
82 END DO
83
84 CALL histbeg_totreg('fluxstoke', rlong(:, 1), rlat(1, :), 1, iip1, 1, jjp1, &
85 itau_dyn, zjulian, tstep, uhoriid, fileid)
86
87 ! Creation du fichier histoire pour la grille en V (oblige pour l'instant,
88 ! IOIPSL ne permet pas de grilles avec des nombres de point differents dans
89 ! un meme fichier)
90
91 DO jj = 1, jjm
92 DO ii = 1, iip1
93 rlong(ii, jj) = rlonv(ii)*180./pi
94 rlat(ii, jj) = rlatv(jj)*180./pi
95 END DO
96 END DO
97
98 CALL histbeg_totreg('fluxstokev.nc', rlong(:, 1), rlat(1, :jjm), 1, iip1, &
99 1, jjm, itau_dyn, zjulian, tstep, vhoriid, filevid)
100
101 CALL histbeg_totreg('defstoke.nc', (/1./), (/1./), 1, 1, 1, 1, itau_dyn, &
102 zjulian, tstep, dhoriid, filedid)
103
104 ! Appel a histhori pour rajouter les autres grilles horizontales
105
106 DO jj = 1, jjp1
107 DO ii = 1, iip1
108 rlong(ii, jj) = rlonv(ii)*180./pi
109 rlat(ii, jj) = rlatu(jj)*180./pi
110 END DO
111 END DO
112
113 CALL histhori_regular(fileid, iip1, rlong, jjp1, rlat, 'scalar', &
114 'Grille points scalaires', thoriid)
115
116 ! Appel a histvert pour la grille verticale
117
118 CALL histvert(fileid, 'sig_s', 'Niveaux sigma', 'sigma_level', &
119 (/(real(l), l = 1, llm)/), zvertiid)
120 ! Pour le fichier V
121 CALL histvert(filevid, 'sig_s', 'Niveaux sigma', 'sigma_level', &
122 (/(real(l), l = 1, llm)/), zvertiid)
123 ! pour le fichier def
124 nivd(1) = 1
125 CALL histvert(filedid, 'sig_s', 'Niveaux sigma', 'sigma_level', nivd, &
126 dvertiid)
127
128 ! Appels a histdef pour la definition des variables a sauvegarder
129 CALL histdef(fileid, 'phis', 'Surface geop. height', '-', iip1, jjp1, &
130 thoriid, 1, 1, 1, -99, 'once', t_ops, t_wrt)
131 CALL histdef(fileid, 'aire', 'Grid area', '-', iip1, jjp1, thoriid, 1, 1, &
132 1, -99, 'once', t_ops, t_wrt)
133 CALL histdef(filedid, 'dtvr', 'tps dyn', 's', 1, 1, dhoriid, 1, 1, 1, -99, &
134 'once', t_ops, t_wrt)
135 CALL histdef(filedid, 'istdyn', 'tps stock', 's', 1, 1, dhoriid, 1, 1, 1, &
136 -99, 'once', t_ops, t_wrt)
137 CALL histdef(filedid, 'istphy', 'tps stock phy', 's', 1, 1, dhoriid, 1, 1, &
138 1, -99, 'once', t_ops, t_wrt)
139 CALL histdef(fileid, 'masse', 'Masse', 'kg', iip1, jjp1, thoriid, llm, 1, &
140 llm, zvertiid, 'inst(X)', t_ops, t_wrt)
141 CALL histdef(fileid, 'pbaru', 'flx de masse zonal', 'kg m/s', iip1, jjp1, &
142 uhoriid, llm, 1, llm, zvertiid, 'inst(X)', t_ops, t_wrt)
143 CALL histdef(filevid, 'pbarv', 'flx de masse mer', 'kg m/s', iip1, jjm, &
144 vhoriid, llm, 1, llm, zvertiid, 'inst(X)', t_ops, t_wrt)
145 CALL histdef(fileid, 'w', 'flx de masse vert', 'kg m/s', iip1, jjp1, &
146 thoriid, llm, 1, llm, zvertiid, 'inst(X)', t_ops, t_wrt)
147 CALL histdef(fileid, 'teta', 'temperature potentielle', '-', iip1, jjp1, &
148 thoriid, llm, 1, llm, zvertiid, 'inst(X)', t_ops, t_wrt)
149 CALL histdef(fileid, 'phi', 'geopotentiel instantane', '-', iip1, jjp1, &
150 thoriid, llm, 1, llm, zvertiid, 'inst(X)', t_ops, t_wrt)
151
152 CALL histend(fileid)
153 CALL histend(filevid)
154 CALL histend(filedid)
155 IF (ok_sync) THEN
156 CALL histsync(fileid)
157 CALL histsync(filevid)
158 CALL histsync(filedid)
159 END IF
160
161 END SUBROUTINE initfluxsto
  ViewVC Help
Powered by ViewVC 1.1.21