/[lmdze]/trunk/libf/bibio/initfluxsto.f90
ViewVC logotype

Contents of /trunk/libf/bibio/initfluxsto.f90

Parent Directory Parent Directory | Revision Log Revision Log


Revision 67 - (show annotations)
Tue Oct 2 15:50:56 2012 UTC (11 years, 7 months ago) by guez
File size: 6187 byte(s)
Cleaning.
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 calendar
27 USE histbeg_totreg_m, ONLY : histbeg_totreg
28 USE histdef_m, ONLY : histdef
29 USE histend_m, ONLY : histend
30 use histhori_regular_m, only: histhori_regular
31 use histsync_m, only: histsync
32 USE histvert_m, ONLY : histvert
33 USE dimens_m
34 USE paramet_m
35 USE comconst
36 USE disvert_m
37 use conf_gcm_m
38 USE comgeom
39 USE serre
40 USE temps, ONLY : annee_ref, day_ref, itau_dyn
41 USE ener
42 USE nr_util, ONLY : pi
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*3 str
57 CHARACTER*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
62 INTEGER zan, idayref
63 LOGICAL ok_sync
64
65 !---------------------------------------------------------
66
67 ! Initialisations
68 str = 'q '
69 ctrac = 'traceur '
70 ok_sync = .TRUE.
71
72 ! Appel a histbeg: creation du fichier netcdf et initialisations diverses
73
74 zan = annee_ref
75 idayref = day_ref
76 CALL ymds2ju(zan, 1, idayref, 0.0, zjulian)
77
78 DO jj = 1, jjp1
79 DO ii = 1, iip1
80 rlong(ii, jj) = rlonu(ii)*180./pi
81 rlat(ii, jj) = rlatu(jj)*180./pi
82 END DO
83 END DO
84
85 CALL histbeg_totreg('fluxstoke', rlong(:, 1), rlat(1, :), 1, iip1, 1, jjp1, &
86 itau_dyn, zjulian, tstep, uhoriid, fileid)
87
88 ! Creation du fichier histoire pour la grille en V (oblige pour l'instant,
89 ! IOIPSL ne permet pas de grilles avec des nombres de point differents dans
90 ! un meme fichier)
91
92 DO jj = 1, jjm
93 DO ii = 1, iip1
94 rlong(ii, jj) = rlonv(ii)*180./pi
95 rlat(ii, jj) = rlatv(jj)*180./pi
96 END DO
97 END DO
98
99 CALL histbeg_totreg('fluxstokev.nc', rlong(:, 1), rlat(1, :jjm), 1, iip1, &
100 1, jjm, itau_dyn, zjulian, tstep, vhoriid, filevid)
101
102 CALL histbeg_totreg('defstoke.nc', (/1./), (/1./), 1, 1, 1, 1, itau_dyn, &
103 zjulian, tstep, dhoriid, filedid)
104
105 ! Appel a histhori pour rajouter les autres grilles horizontales
106
107 DO jj = 1, jjp1
108 DO ii = 1, iip1
109 rlong(ii, jj) = rlonv(ii)*180./pi
110 rlat(ii, jj) = rlatu(jj)*180./pi
111 END DO
112 END DO
113
114 CALL histhori_regular(fileid, iip1, rlong, jjp1, rlat, 'scalar', &
115 'Grille points scalaires', thoriid)
116
117 ! Appel a histvert pour la grille verticale
118
119 CALL histvert(fileid, 'sig_s', 'Niveaux sigma', 'sigma_level', nivsigs, &
120 zvertiid)
121 ! Pour le fichier V
122 CALL histvert(filevid, 'sig_s', 'Niveaux sigma', 'sigma_level', nivsigs, &
123 zvertiid)
124 ! pour le fichier def
125 nivd(1) = 1
126 CALL histvert(filedid, 'sig_s', 'Niveaux sigma', 'sigma_level', nivd, &
127 dvertiid)
128
129 ! Appels a histdef pour la definition des variables a sauvegarder
130 CALL histdef(fileid, 'phis', 'Surface geop. height', '-', iip1, jjp1, &
131 thoriid, 1, 1, 1, -99, 'once', t_ops, t_wrt)
132 CALL histdef(fileid, 'aire', 'Grid area', '-', iip1, jjp1, thoriid, 1, 1, &
133 1, -99, 'once', t_ops, t_wrt)
134 CALL histdef(filedid, 'dtvr', 'tps dyn', 's', 1, 1, dhoriid, 1, 1, 1, -99, &
135 'once', t_ops, t_wrt)
136 CALL histdef(filedid, 'istdyn', 'tps stock', 's', 1, 1, dhoriid, 1, 1, 1, &
137 -99, 'once', t_ops, t_wrt)
138 CALL histdef(filedid, 'istphy', 'tps stock phy', 's', 1, 1, dhoriid, 1, 1, &
139 1, -99, 'once', t_ops, t_wrt)
140 CALL histdef(fileid, 'masse', 'Masse', 'kg', iip1, jjp1, thoriid, llm, 1, &
141 llm, zvertiid, 'inst(X)', t_ops, t_wrt)
142 CALL histdef(fileid, 'pbaru', 'flx de masse zonal', 'kg m/s', iip1, jjp1, &
143 uhoriid, llm, 1, llm, zvertiid, 'inst(X)', t_ops, t_wrt)
144 CALL histdef(filevid, 'pbarv', 'flx de masse mer', 'kg m/s', iip1, jjm, &
145 vhoriid, llm, 1, llm, zvertiid, 'inst(X)', t_ops, t_wrt)
146 CALL histdef(fileid, 'w', 'flx de masse vert', 'kg m/s', iip1, jjp1, &
147 thoriid, llm, 1, llm, zvertiid, 'inst(X)', t_ops, t_wrt)
148 CALL histdef(fileid, 'teta', 'temperature potentielle', '-', iip1, jjp1, &
149 thoriid, llm, 1, llm, zvertiid, 'inst(X)', t_ops, t_wrt)
150 CALL histdef(fileid, 'phi', 'geopotentiel instantane', '-', iip1, jjp1, &
151 thoriid, llm, 1, llm, zvertiid, 'inst(X)', t_ops, t_wrt)
152
153 CALL histend(fileid)
154 CALL histend(filevid)
155 CALL histend(filedid)
156 IF (ok_sync) THEN
157 CALL histsync(fileid)
158 CALL histsync(filevid)
159 CALL histsync(filedid)
160 END IF
161
162 END SUBROUTINE initfluxsto

  ViewVC Help
Powered by ViewVC 1.1.21