source: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/initdynav_loc.f90 @ 5106

Last change on this file since 5106 was 5105, checked in by abarral, 4 months ago

Replace 1DUTILS.h by module lmdz_1dutils.f90
Replace 1DConv.h by module lmdz_old_1dconv.f90 (it's only used by old_* files)
Convert *.F to *.f90
Fix gradsdef.h formatting
Remove unnecessary "RETURN" at the end of functions/subroutines

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
File size: 6.8 KB
Line 
1
2! $Id: initdynav_p.F 1279 2009-12-10 09:02:56Z fairhead $
3
4SUBROUTINE initdynav_loc(day0,anne0,tstep,t_ops,t_wrt)
5
6  ! This routine needs IOIPSL
7   USE IOIPSL
8   USE parallel_lmdz
9   use Write_field
10   use misc_mod
11    ! USE infotrac
12   use com_io_dyn_mod, ONLY: histaveid,histvaveid,histuaveid,       &
13         dynhistave_file,dynhistvave_file,dynhistuave_file
14   USE comconst_mod, ONLY: pi
15   USE comvert_mod, ONLY: presnivs
16   USE temps_mod, ONLY: itau_dyn
17
18   implicit none
19
20  !
21  !   Routine d'initialisation des ecritures des fichiers histoires LMDZ
22  !   au format IOIPSL. Initialisation du fichier histoire moyenne.
23  !
24  !   Appels succesifs des routines: histbeg
25  !                              histhori
26  !                              histver
27  !                              histdef
28  !                              histend
29  !
30  !   Entree:
31  !
32  !  day0,anne0: date de reference
33  !  tstep : frequence d'ecriture
34  !  t_ops: frequence de l'operation pour IOIPSL
35  !  t_wrt: frequence d'ecriture sur le fichier
36  !
37  !   Sortie:
38  !  fileid: ID du fichier netcdf cree
39  !
40  !   L. Fairhead, LMD, 03/99
41  !
42  ! =====================================================================
43  !
44  !   Declarations
45  include "dimensions.h"
46  include "paramet.h"
47  include "comgeom.h"
48  include "description.h"
49  include "iniprint.h"
50
51  !   Arguments
52  !
53  integer(kind=4) day0, anne0
54  real :: tstep, t_ops, t_wrt
55
56  ! This routine needs IOIPSL
57  !   Variables locales
58  !
59  integer :: tau0
60  real :: zjulian
61  integer :: iq
62  real :: rlong(iip1,jjp1), rlat(iip1,jjp1)
63  integer :: uhoriid, vhoriid, thoriid
64  integer :: zvertiid,zvertiidv,zvertiidu
65  integer :: ii,jj
66  integer :: zan, dayref
67  integer :: jjb,jje,jjn
68
69  ! definition du domaine d'ecriture pour le rebuild
70
71  INTEGER,DIMENSION(2) :: ddid
72  INTEGER,DIMENSION(2) :: dsg
73  INTEGER,DIMENSION(2) :: dsl
74  INTEGER,DIMENSION(2) :: dpf
75  INTEGER,DIMENSION(2) :: dpl
76  INTEGER,DIMENSION(2) :: dhs
77  INTEGER,DIMENSION(2) :: dhe
78
79  INTEGER :: dynhistave_domain_id
80  INTEGER :: dynhistvave_domain_id
81  INTEGER :: dynhistuave_domain_id
82
83  if (adjust) return
84
85  !
86  !  Initialisations
87  !
88  pi = 4. * atan (1.)
89  !
90  !  Appel a histbeg: creation du fichier netcdf et initialisations diverses
91  !
92
93  zan = anne0
94  dayref = day0
95  CALL ymds2ju(zan, 1, dayref, 0.0, zjulian)
96  tau0 = itau_dyn
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    enddo
103  enddo
104
105
106  ! Creation de 3 fichiers pour les differentes grilles horizontales
107  ! Restriction de IOIPSL: seulement 2 coordonnees dans le meme fichier
108  ! Grille Scalaire
109
110  jjb=jj_begin
111  jje=jj_end
112  jjn=jj_nb
113
114  ddid=(/ 1,2 /)
115  dsg=(/ iip1,jjp1 /)
116  dsl=(/ iip1,jjn /)
117  dpf=(/ 1,jjb /)
118  dpl=(/ iip1,jje /)
119  dhs=(/ 0,0 /)
120  dhe=(/ 0,0 /)
121
122
123  CALL flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, &
124        'box',dynhistave_domain_id)
125
126  CALL histbeg(dynhistave_file,iip1, rlong(:,1), jjn, &
127        rlat(1,jjb:jje), 1, iip1, 1, jjn,tau0, &
128        zjulian, tstep, thoriid, &
129        histaveid,dynhistave_domain_id)
130
131
132  !  Creation du fichier histoire pour les grilles en V et U (oblige pour l'instant,
133  !  IOIPSL ne permet pas de grilles avec des nombres de point differents dans
134  !  un meme fichier)
135  ! Grille V
136
137  jjb=jj_begin
138  jje=jj_end
139  jjn=jj_nb
140  IF (pole_sud) jjn=jjn-1
141  IF (pole_sud) jje=jje-1
142
143  do jj = jjb, jje
144    do ii = 1, iip1
145      rlong(ii,jj) = rlonv(ii) * 180. / pi
146      rlat(ii,jj) = rlatv(jj) * 180. / pi
147    enddo
148  enddo
149
150  ddid=(/ 1,2 /)
151  dsg=(/ iip1,jjm /)
152  dsl=(/ iip1,jjn /)
153  dpf=(/ 1,jjb /)
154  dpl=(/ iip1,jje /)
155  dhs=(/ 0,0 /)
156  dhe=(/ 0,0 /)
157
158
159  CALL flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, &
160        'box',dynhistvave_domain_id)
161
162  CALL histbeg(dynhistvave_file,iip1, rlong(:,1), jjn, &
163        rlat(1,jjb:jje), 1, iip1, 1, jjn,tau0, &
164        zjulian, tstep, vhoriid, &
165        histvaveid,dynhistvave_domain_id)
166
167  ! Grille U
168
169  do jj = 1, jjp1
170    do ii = 1, iip1
171      rlong(ii,jj) = rlonu(ii) * 180. / pi
172      rlat(ii,jj) = rlatu(jj) * 180. / pi
173    enddo
174  enddo
175
176  jjb=jj_begin
177  jje=jj_end
178  jjn=jj_nb
179
180  ddid=(/ 1,2 /)
181  dsg=(/ iip1,jjp1 /)
182  dsl=(/ iip1,jjn /)
183  dpf=(/ 1,jjb /)
184  dpl=(/ iip1,jje /)
185  dhs=(/ 0,0 /)
186  dhe=(/ 0,0 /)
187
188
189  CALL flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, &
190        'box',dynhistuave_domain_id)
191
192  CALL histbeg(dynhistuave_file,iip1, rlong(:,1), jjn, &
193        rlat(1,jjb:jje), 1, iip1, 1, jjn,tau0, &
194        zjulian, tstep, uhoriid, &
195        histuaveid,dynhistuave_domain_id)
196
197
198  !
199  !  Appel a histvert pour la grille verticale
200  !
201  CALL histvert(histaveid,'presnivs','Niveaux Pression&
202        &     approximatifs','mb',llm, presnivs/100., zvertiid,'down')
203  CALL histvert(histuaveid,'presnivs','Niveaux Pression&
204        &     approximatifs','mb',llm, presnivs/100., zvertiidv,'down')
205  CALL histvert(histvaveid,'presnivs','Niveaux Pression&
206        &     approximatifs','mb',llm, presnivs/100., zvertiidu,'down')
207
208  !
209  !  Appels a histdef pour la definition des variables a sauvegarder
210  !
211  !  Vents U
212  !
213  jjn=jj_nb
214  CALL histdef(histuaveid, 'u', 'vent u moyen ', &
215        'm/s', iip1, jjn, uhoriid, llm, 1, llm, zvertiidu, &
216        32, 'ave(X)', t_ops, t_wrt)
217
218  !
219  !  Vents V
220  !
221  if (pole_sud) jjn=jj_nb-1
222  CALL histdef(histvaveid, 'v', 'vent v moyen', &
223        'm/s', iip1, jjn, vhoriid, llm, 1, llm, zvertiidv, &
224        32, 'ave(X)', t_ops, t_wrt)
225
226  !
227  !  Temperature
228  !
229  jjn=jj_nb
230  CALL histdef(histaveid, 'temp', 'temperature moyenne', 'K', &
231        iip1, jjn, thoriid, llm, 1, llm, zvertiid, &
232        32, 'ave(X)', t_ops, t_wrt)
233  !
234  !  Temperature potentielle
235  !
236  CALL histdef(histaveid, 'theta', 'temperature potentielle', 'K', &
237        iip1, jjn, thoriid, llm, 1, llm, zvertiid, &
238        32, 'ave(X)', t_ops, t_wrt)
239
240
241  !
242  !  Geopotentiel
243  !
244  CALL histdef(histaveid, 'phi', 'geopotentiel moyen', '-', &
245        iip1, jjn, thoriid, llm, 1, llm, zvertiid, &
246        32, 'ave(X)', t_ops, t_wrt)
247  !
248  !  Traceurs
249  !
250  !    DO iq=1,nqtot
251  !      CALL histdef(histaveid, tracers(iq)%name,
252  ! .                            tracers(iq)%longName, '-',
253  ! .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,
254  ! .             32, 'ave(X)', t_ops, t_wrt)
255  !    enddo
256  !
257  !  Masse
258  !
259  CALL histdef(histaveid, 'masse', 'masse moyenne', 'kg', &
260        iip1, jjn, thoriid, llm, 1, llm, zvertiid, &
261        32, 'ave(X)', t_ops, t_wrt)
262  !
263  !  Pression au sol
264  !
265  CALL histdef(histaveid, 'ps', 'pression naturelle au sol', 'Pa', &
266        iip1, jjn, thoriid, 1, 1, 1, -99, &
267        32, 'ave(X)', t_ops, t_wrt)
268  !
269  !  Geopotentiel au sol
270  !
271  !  CALL histdef(histaveid, 'phis', 'geopotentiel au sol', '-',
272  ! .             iip1, jjn, thoriid, 1, 1, 1, -99,
273  ! .             32, 'ave(X)', t_ops, t_wrt)
274  !
275  !  Fin
276  !
277  CALL histend(histaveid)
278  CALL histend(histuaveid)
279  CALL histend(histvaveid)
280end subroutine initdynav_loc
Note: See TracBrowser for help on using the repository browser.