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

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

Parent Directory Parent Directory | Revision Log Revision Log

Revision 144 - (show annotations)
Wed Jun 10 16:46:46 2015 UTC (8 years, 11 months ago) by guez
File size: 6082 byte(s) 
In procedure fxhyp, the convoluted computation of tanh(fa/fb) occurred
three times. Extracted it into a function. Also, the computation of
xmoy and fxm was repeated. So stored the values in arrays instead.

In procedure fxhyp, in the computation of fhyp, there were tests
xtild(i) == 0. and xtild(i) == pi_d. No use to do these tests at each
iteration. We now they are true for i == nmax and i == 2 * nmax,
respectively, and we know they are false for other values of
"i". Similarly, in the computations of ffdx and xxpr, there were the
tests xmoy == 0. and xmoy == pi_d, these could not be true.

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