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

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

Parent Directory Parent Directory | Revision Log Revision Log

Revision 144 - (hide 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 guez 144 SUBROUTINE initfluxsto(tstep, t_ops, t_wrt, 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 guez 3
19 guez 31 ! Sortie:
20     ! fileid: ID du fichier netcdf cree
21     ! filevid:ID du fichier netcdf pour la grille v
22 guez 3
23 guez 31 ! L. Fairhead, 03/99
24 guez 3
25 guez 92 USE comconst
26     use conf_gcm_m
27     USE dimens_m
28     USE disvert_m
29 guez 139 use dynetat0_m, only: day_ref, annee_ref, rlonu, rlatu, rlonv, rlatv
30 guez 61 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 guez 92 USE nr_util, ONLY : pi
37 guez 31 USE paramet_m
38 guez 129 USE temps, ONLY : itau_dyn
39 guez 92 use ymds2ju_m, only: ymds2ju
40 guez 3
41 guez 31 IMPLICIT NONE
42 guez 3
43 guez 31 ! Arguments
44     REAL, INTENT (IN) :: tstep
45     REAL t_ops, t_wrt
46     INTEGER fileid, filevid, filedid
47     REAL nivd(1)
48 guez 3
49 guez 31 ! Variables locales
50     REAL zjulian
51 guez 108 CHARACTER(len=3) str
52     CHARACTER(len=10) ctrac
53 guez 31 REAL rlong(iip1, jjp1), rlat(iip1, jjp1)
54     INTEGER uhoriid, vhoriid, thoriid, zvertiid, dhoriid, dvertiid
55 guez 83 INTEGER ii, jj, l
56 guez 31 LOGICAL ok_sync
57 guez 3
58 guez 31 !---------------------------------------------------------
59 guez 3
60 guez 31 ! Initialisations
61     str = 'q '
62     ctrac = 'traceur '
63     ok_sync = .TRUE.
64 guez 3
65 guez 31 ! Appel a histbeg: creation du fichier netcdf et initialisations diverses
66 guez 3
67 guez 129 CALL ymds2ju(annee_ref, 1, day_ref, 0.0, zjulian)
68 guez 3
69 guez 31 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 guez 3
76 guez 31 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 guez 83 CALL histvert(fileid, 'sig_s', 'Niveaux sigma', 'sigma_level', &
111     (/(real(l), l = 1, llm)/), zvertiid)
112 guez 31 ! Pour le fichier V
113 guez 83 CALL histvert(filevid, 'sig_s', 'Niveaux sigma', 'sigma_level', &
114     (/(real(l), l = 1, llm)/), zvertiid)
115 guez 31 ! pour le fichier def
116     nivd(1) = 1
117 guez 67 CALL histvert(filedid, 'sig_s', 'Niveaux sigma', 'sigma_level', nivd, &
118 guez 31 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