source: LMDZ5/trunk/libf/dyn3dpar/writehist_p.F @ 1823

Last change on this file since 1823 was 1823, checked in by Ehouarn Millour, 11 years ago

Remplacement de parallel.F90 (en conflit avec orchidée) par parallel_lmdz.F90.
UG
.........................................
Renaming parallel.F90 (conflicting with orchidée) into parallel_lmdz.F90.
UG

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