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

Contents of /trunk/Sources/bibio/initfluxsto.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 134 - (show annotations)
Wed Apr 29 15:47:56 2015 UTC (9 years ago) by guez
File size: 6209 byte(s)
Sources inside, compilation outside.
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 dynetat0_m, only: day_ref, annee_ref
32 USE histbeg_totreg_m, ONLY : histbeg_totreg
33 USE histdef_m, ONLY : histdef
34 USE histend_m, ONLY : histend
35 use histhori_regular_m, only: histhori_regular
36 use histsync_m, only: histsync
37 USE histvert_m, ONLY : histvert
38 USE nr_util, ONLY : pi
39 USE paramet_m
40 USE serre
41 USE temps, ONLY : itau_dyn
42 use ymds2ju_m, only: ymds2ju
43
44 IMPLICIT NONE
45
46 ! Arguments
47 INTEGER itau
48 REAL, INTENT (IN) :: tstep
49 REAL t_ops, t_wrt
50 INTEGER fileid, filevid, filedid
51 INTEGER nq, ndex(1)
52 REAL nivd(1)
53
54 ! Variables locales
55 REAL zjulian
56 CHARACTER(len=3) str
57 CHARACTER(len=10) ctrac
58 INTEGER iq
59 REAL rlong(iip1, jjp1), rlat(iip1, jjp1)
60 INTEGER uhoriid, vhoriid, thoriid, zvertiid, dhoriid, dvertiid
61 INTEGER ii, jj, l
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 CALL ymds2ju(annee_ref, 1, day_ref, 0.0, zjulian)
74
75 DO jj = 1, jjp1
76 DO ii = 1, iip1
77 rlong(ii, jj) = rlonu(ii)*180./pi
78 rlat(ii, jj) = rlatu(jj)*180./pi
79 END DO
80 END DO
81
82 CALL histbeg_totreg('fluxstoke', rlong(:, 1), rlat(1, :), 1, iip1, 1, jjp1, &
83 itau_dyn, zjulian, tstep, uhoriid, fileid)
84
85 ! Creation du fichier histoire pour la grille en V (oblige pour l'instant,
86 ! IOIPSL ne permet pas de grilles avec des nombres de point differents dans
87 ! un meme fichier)
88
89 DO jj = 1, jjm
90 DO ii = 1, iip1
91 rlong(ii, jj) = rlonv(ii)*180./pi
92 rlat(ii, jj) = rlatv(jj)*180./pi
93 END DO
94 END DO
95
96 CALL histbeg_totreg('fluxstokev.nc', rlong(:, 1), rlat(1, :jjm), 1, iip1, &
97 1, jjm, itau_dyn, zjulian, tstep, vhoriid, filevid)
98
99 CALL histbeg_totreg('defstoke.nc', (/1./), (/1./), 1, 1, 1, 1, itau_dyn, &
100 zjulian, tstep, dhoriid, filedid)
101
102 ! Appel a histhori pour rajouter les autres grilles horizontales
103
104 DO jj = 1, jjp1
105 DO ii = 1, iip1
106 rlong(ii, jj) = rlonv(ii)*180./pi
107 rlat(ii, jj) = rlatu(jj)*180./pi
108 END DO
109 END DO
110
111 CALL histhori_regular(fileid, iip1, rlong, jjp1, rlat, 'scalar', &
112 'Grille points scalaires', thoriid)
113
114 ! Appel a histvert pour la grille verticale
115
116 CALL histvert(fileid, 'sig_s', 'Niveaux sigma', 'sigma_level', &
117 (/(real(l), l = 1, llm)/), zvertiid)
118 ! Pour le fichier V
119 CALL histvert(filevid, 'sig_s', 'Niveaux sigma', 'sigma_level', &
120 (/(real(l), l = 1, llm)/), zvertiid)
121 ! pour le fichier def
122 nivd(1) = 1
123 CALL histvert(filedid, 'sig_s', 'Niveaux sigma', 'sigma_level', nivd, &
124 dvertiid)
125
126 ! Appels a histdef pour la definition des variables a sauvegarder
127 CALL histdef(fileid, 'phis', 'Surface geop. height', '-', iip1, jjp1, &
128 thoriid, 1, 1, 1, -99, 'once', t_ops, t_wrt)
129 CALL histdef(fileid, 'aire', 'Grid area', '-', iip1, jjp1, thoriid, 1, 1, &
130 1, -99, 'once', t_ops, t_wrt)
131 CALL histdef(filedid, 'dtvr', 'tps dyn', 's', 1, 1, dhoriid, 1, 1, 1, -99, &
132 'once', t_ops, t_wrt)
133 CALL histdef(filedid, 'istdyn', 'tps stock', 's', 1, 1, dhoriid, 1, 1, 1, &
134 -99, 'once', t_ops, t_wrt)
135 CALL histdef(filedid, 'istphy', 'tps stock phy', 's', 1, 1, dhoriid, 1, 1, &
136 1, -99, 'once', t_ops, t_wrt)
137 CALL histdef(fileid, 'masse', 'Masse', 'kg', iip1, jjp1, thoriid, llm, 1, &
138 llm, zvertiid, 'inst(X)', t_ops, t_wrt)
139 CALL histdef(fileid, 'pbaru', 'flx de masse zonal', 'kg m/s', iip1, jjp1, &
140 uhoriid, llm, 1, llm, zvertiid, 'inst(X)', t_ops, t_wrt)
141 CALL histdef(filevid, 'pbarv', 'flx de masse mer', 'kg m/s', iip1, jjm, &
142 vhoriid, llm, 1, llm, zvertiid, 'inst(X)', t_ops, t_wrt)
143 CALL histdef(fileid, 'w', 'flx de masse vert', 'kg m/s', iip1, jjp1, &
144 thoriid, llm, 1, llm, zvertiid, 'inst(X)', t_ops, t_wrt)
145 CALL histdef(fileid, 'teta', 'temperature potentielle', '-', iip1, jjp1, &
146 thoriid, llm, 1, llm, zvertiid, 'inst(X)', t_ops, t_wrt)
147 CALL histdef(fileid, 'phi', 'geopotentiel instantane', '-', iip1, jjp1, &
148 thoriid, llm, 1, llm, zvertiid, 'inst(X)', t_ops, t_wrt)
149
150 CALL histend(fileid)
151 CALL histend(filevid)
152 CALL histend(filedid)
153 IF (ok_sync) THEN
154 CALL histsync(fileid)
155 CALL histsync(filevid)
156 CALL histsync(filedid)
157 END IF
158
159 END SUBROUTINE initfluxsto

  ViewVC Help
Powered by ViewVC 1.1.21