source: LMDZ4/branches/LMDZ4V5.0-dev/libf/bibio/writehist.F @ 1356

Last change on this file since 1356 was 1279, checked in by Laurent Fairhead, 15 years ago

Merged LMDZ4-dev branch changes r1241:1278 into the trunk
Running trunk and LMDZ4-dev in LMDZOR configuration on local
machine (sequential) and SX8 (4-proc) yields identical results
(restart and restartphy are identical binarily)
Log history from r1241 to r1278 is available by switching to
source:LMDZ4/branches/LMDZ4-dev-20091210

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.0 KB
Line 
1!
2! $Id: writehist.F 1279 2009-12-10 09:02:56Z musat $
3!
4      subroutine writehist( histid, histvid, time, vcov,
5     ,                          ucov,teta,phi,q,masse,ps,phis)
6
7#ifdef CPP_IOIPSL
8      USE ioipsl
9#endif
10      USE infotrac, ONLY : nqtot, ttext
11      implicit none
12
13C
14C   Ecriture du fichier histoire au format IOIPSL
15C
16C   Appels succesifs des routines: histwrite
17C
18C   Entree:
19C      histid: ID du fichier histoire
20C      histvid:ID du fichier histoire pour les vents V (appele a disparaitre)
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 "iniprint.h"
51
52C
53C   Arguments
54C
55
56      INTEGER histid, 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,nqtot)
62      integer time
63
64
65#ifdef CPP_IOIPSL
66! This routine needs IOIPSL to work
67C   Variables locales
68C
69      integer iq, ii, ll
70      integer ndexu(ip1jmp1*llm),ndexv(ip1jm*llm),ndex2d(ip1jmp1)
71      logical ok_sync
72      integer itau_w
73C
74C  Initialisations
75C
76      ndexu = 0
77      ndexv = 0
78      ndex2d = 0
79      ok_sync =.TRUE.
80      itau_w = itau_dyn + time
81C
82C  Appels a histwrite pour l'ecriture des variables a sauvegarder
83C
84C  Vents U
85C
86      call histwrite(histid, 'ucov', itau_w, ucov,
87     .               iip1*jjp1*llm, ndexu)
88
89C
90C  Vents V
91C
92      call histwrite(histvid, 'vcov', itau_w, vcov,
93     .               iip1*jjm*llm, ndexv)
94
95C
96C  Temperature potentielle
97C
98      call histwrite(histid, 'teta', itau_w, teta,
99     .                iip1*jjp1*llm, ndexu)
100C
101C  Geopotentiel
102C
103      call histwrite(histid, 'phi', itau_w, phi,
104     .                iip1*jjp1*llm, ndexu)
105C
106C  Traceurs
107C
108        DO iq=1,nqtot
109          call histwrite(histid, ttext(iq), itau_w, q(:,:,iq),
110     .                   iip1*jjp1*llm, ndexu)
111        enddo
112C
113C  Masse
114C
115      call histwrite(histid, 'masse', itau_w, masse, iip1*jjp1, ndex2d)
116C
117C  Pression au sol
118C
119      call histwrite(histid, 'ps', itau_w, ps, iip1*jjp1, ndex2d)
120C
121C  Geopotentiel au sol
122C
123      call histwrite(histid, 'phis', itau_w, phis, iip1*jjp1, ndex2d)
124C
125C  Fin
126C
127      if (ok_sync) then
128        call histsync(histid)
129        call histsync(histvid)
130      endif
131#else
132! tell the user this routine should be run with ioipsl
133      write(lunout,*)"writehist: Warning this routine should not be",
134     &               " used without ioipsl"
135#endif
136! of #ifdef CPP_IOIPSL
137      return
138      end
Note: See TracBrowser for help on using the repository browser.