source: LMDZ4/branches/V3_test/libf/dyn3dpar/writehist_p.F @ 4082

Last change on this file since 4082 was 708, checked in by Laurent Fairhead, 18 years ago

Versions parallèlisées des routines YM
LF

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.2 KB
Line 
1!
2! $Header$
3!
4      subroutine writehist_p( histid, histvid, nq, time, vcov,
5     ,                          ucov,teta,phi,q,masse,ps,phis)
6
7      USE ioipsl
8      USE parallel
9      USE misc_mod
10      implicit none
11
12C
13C   Ecriture du fichier histoire au format IOIPSL
14C
15C   Appels succesifs des routines: histwrite
16C
17C   Entree:
18C      histid: ID du fichier histoire
19C      histvid:ID du fichier histoire pour les vents V (appele a disparaitre)
20C      nqmx: nombre maxi de traceurs
21C      time: temps de l'ecriture
22C      vcov: vents v covariants
23C      ucov: vents u covariants
24C      teta: temperature potentielle
25C      phi : geopotentiel instantane
26C      q   : traceurs
27C      masse: masse
28C      ps   :pression au sol
29C      phis : geopotentiel au sol
30C     
31C
32C   Sortie:
33C      fileid: ID du fichier netcdf cree
34C
35C   L. Fairhead, LMD, 03/99
36C
37C =====================================================================
38C
39C   Declarations
40#include "dimensions.h"
41#include "paramet.h"
42#include "comconst.h"
43#include "comvert.h"
44#include "comgeom.h"
45#include "temps.h"
46#include "ener.h"
47#include "logic.h"
48#include "description.h"
49#include "serre.h"
50#include "advtrac.h"
51
52C
53C   Arguments
54C
55
56      INTEGER histid, nq, histvid
57      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm)
58      REAL teta(ip1jmp1,llm),phi(ip1jmp1,llm)                   
59      REAL ps(ip1jmp1),masse(ip1jmp1,llm)                   
60      REAL phis(ip1jmp1)                 
61      REAL q(ip1jmp1,llm,nq)
62      integer time
63
64
65C   Variables locales
66C
67      integer iq, ii, ll
68      integer ndexu(ip1jmp1*llm),ndexv(ip1jm*llm),ndex2d(ip1jmp1)
69      logical ok_sync
70      integer itau_w
71      integer :: ijb,ije,jjn
72C
73C  Initialisations
74C
75      if (adjust) return
76     
77   
78      ndexu = 0
79      ndexv = 0
80      ndex2d = 0
81      ok_sync =.TRUE.
82      itau_w = itau_dyn + time
83C
84C  Appels a histwrite pour l'ecriture des variables a sauvegarder
85C
86C  Vents U
87C
88      ijb=ij_begin
89      ije=ij_end
90      jjn=jj_nb
91         
92      call histwrite(histid, 'ucov', itau_w, ucov,
93     .               iip1*jjn*llm, ndexu)
94
95C
96C  Vents V
97C
98      if (pole_sud) ije=jj_end-iip1
99      if (pole_sud) jjn=jj_nb-1
100     
101      call histwrite(histvid, 'vcov', itau_w, vcov(ijb:ije,:),
102     .               iip1*jjn*llm, ndexv)
103
104C
105C  Temperature potentielle
106C
107      ijb=ij_begin
108      ije=ij_end
109      jjn=jj_nb
110
111      call histwrite(histid, 'teta', itau_w, teta(ijb:ije,:),
112     .                iip1*jjn*llm, ndexu)
113C
114C  Geopotentiel
115C
116      call histwrite(histid, 'phi', itau_w, phi(ijb:ije,:),
117     .                iip1*jjn*llm, ndexu)
118C
119C  Traceurs
120C
121        DO iq=1,nq
122          call histwrite(histid, ttext(iq), itau_w, q(ijb:ije,:,iq),
123     .                   iip1*jjn*llm, ndexu)
124        enddo
125C
126C  Masse
127C
128      call histwrite(histid, 'masse', itau_w, masse(ijb:ije,1),
129     .               iip1*jjn, ndex2d)
130C
131C  Pression au sol
132C
133      call histwrite(histid, 'ps', itau_w, ps(ijb:ije),
134     .               iip1*jjn, ndex2d)
135C
136C  Geopotentiel au sol
137C
138      call histwrite(histid, 'phis', itau_w, phis(ijb:ije),
139     .               iip1*jjn, ndex2d)
140C
141C  Fin
142C
143      if (ok_sync) then
144        call histsync(histid)
145        call histsync(histvid)
146      endif
147      return
148      end
Note: See TracBrowser for help on using the repository browser.