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

Last change on this file since 4604 was 2622, checked in by Ehouarn Millour, 8 years ago

Some code tidying: turn ener.h into ener_mod.F90
EM

  • 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
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.3 KB
Line 
1!
2! $Id: writehist_p.F 2622 2016-09-04 06:12:02Z ymeurdesoif $
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      USE temps_mod, ONLY: itau_dyn
15     
16      implicit none
17
18C
19C   Ecriture du fichier histoire au format IOIPSL
20C
21C   Appels succesifs des routines: histwrite
22C
23C   Entree:
24C      histid: ID du fichier histoire
25C      histvid:ID du fichier histoire pour les vents V (appele a disparaitre)
26C      time: temps de l'ecriture
27C      vcov: vents v covariants
28C      ucov: vents u covariants
29C      teta: temperature potentielle
30C      phi : geopotentiel instantane
31C      q   : traceurs
32C      masse: masse
33C      ps   :pression au sol
34C      phis : geopotentiel au sol
35C     
36C
37C   Sortie:
38C      fileid: ID du fichier netcdf cree
39C
40C   L. Fairhead, LMD, 03/99
41C
42C =====================================================================
43C
44C   Declarations
45#include "dimensions.h"
46#include "paramet.h"
47#include "comgeom.h"
48#include "description.h"
49#include "iniprint.h"
50
51C
52C   Arguments
53C
54
55      INTEGER histid, histvid
56      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm)
57      REAL teta(ip1jmp1,llm),phi(ip1jmp1,llm)                   
58      REAL ps(ip1jmp1),masse(ip1jmp1,llm)                   
59      REAL phis(ip1jmp1)                 
60      REAL q(ip1jmp1,llm,nqtot)
61      integer time
62
63#ifdef CPP_IOIPSL
64! This routine needs IOIPSL
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(ijb:ije,:),
93     .               iip1*jjn*llm, ndexu)
94
95C
96C  Vents V
97C
98      if (pole_sud) ije=ij_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,nqtot
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#else
148      write(lunout,*)'writehist_p: Needs IOIPSL to function'
149#endif
150! #endif of #ifdef CPP_IOIPSL
151      return
152      end
Note: See TracBrowser for help on using the repository browser.