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

Annotation of /trunk/bibio/initfluxsto.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 76 - (hide annotations)
Fri Nov 15 18:45:49 2013 UTC (10 years, 6 months ago) by guez
Original Path: trunk/bibio/initfluxsto.f90
File size: 6187 byte(s)
Moved everything out of libf.
1 guez 31 SUBROUTINE initfluxsto(tstep, t_ops, t_wrt, nq, fileid, filevid, filedid)
2 guez 3
3 guez 31 ! From bibio/initfluxsto.F, v 1.1.1.1 2004/05/19 12:53:05
4 guez 3
5 guez 31 ! 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 guez 3
13 guez 31 ! 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 guez 3
20 guez 31 ! Sortie:
21     ! fileid: ID du fichier netcdf cree
22     ! filevid:ID du fichier netcdf pour la grille v
23 guez 3
24 guez 31 ! L. Fairhead, 03/99
25 guez 3
26 guez 31 USE calendar
27 guez 61 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 guez 31 USE dimens_m
34     USE paramet_m
35     USE comconst
36 guez 66 USE disvert_m
37 guez 57 use conf_gcm_m
38 guez 31 USE comgeom
39     USE serre
40     USE temps, ONLY : annee_ref, day_ref, itau_dyn
41     USE ener
42 guez 39 USE nr_util, ONLY : pi
43 guez 3
44 guez 31 IMPLICIT NONE
45 guez 3
46 guez 31 ! 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 guez 3
54 guez 31 ! 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 guez 3
65 guez 31 !---------------------------------------------------------
66 guez 3
67 guez 31 ! Initialisations
68     str = 'q '
69     ctrac = 'traceur '
70     ok_sync = .TRUE.
71 guez 3
72 guez 31 ! Appel a histbeg: creation du fichier netcdf et initialisations diverses
73 guez 3
74 guez 31 zan = annee_ref
75     idayref = day_ref
76     CALL ymds2ju(zan, 1, idayref, 0.0, zjulian)
77 guez 3
78 guez 31 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 guez 3
85 guez 31 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 guez 67 CALL histvert(fileid, 'sig_s', 'Niveaux sigma', 'sigma_level', nivsigs, &
120     zvertiid)
121 guez 31 ! Pour le fichier V
122 guez 67 CALL histvert(filevid, 'sig_s', 'Niveaux sigma', 'sigma_level', nivsigs, &
123     zvertiid)
124 guez 31 ! pour le fichier def
125     nivd(1) = 1
126 guez 67 CALL histvert(filedid, 'sig_s', 'Niveaux sigma', 'sigma_level', nivd, &
127 guez 31 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