source: LMDZ5/branches/testing/libf/dyn3dpar/writehist_p.F @ 3961

Last change on this file since 3961 was 2641, checked in by Laurent Fairhead, 8 years ago

Merged trunk changes r2593:2640 into testing branch

  • 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
RevLine 
[763]1!
[1279]2! $Id: writehist_p.F 2641 2016-09-29 21:26:46Z acozic $
[763]3!
[1146]4      subroutine writehist_p( histid, histvid, time, vcov,
[763]5     ,                          ucov,teta,phi,q,masse,ps,phis)
6
[1279]7#ifdef CPP_IOIPSL
8! This routine needs IOIPSL
[763]9      USE ioipsl
[1279]10#endif
[1864]11      USE parallel_lmdz
[763]12      USE misc_mod
[1146]13      USE infotrac
[2641]14      USE temps_mod, ONLY: itau_dyn
15     
[763]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"
[1279]49#include "iniprint.h"
[763]50
51C
52C   Arguments
53C
54
[1146]55      INTEGER histid, histvid
[763]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)                 
[1146]60      REAL q(ip1jmp1,llm,nqtot)
[763]61      integer time
62
[1279]63#ifdef CPP_IOIPSL
64! This routine needs IOIPSL
[763]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         
[1000]92      call histwrite(histid, 'ucov', itau_w, ucov(ijb:ije,:),
[763]93     .               iip1*jjn*llm, ndexu)
94
95C
96C  Vents V
97C
[1000]98      if (pole_sud) ije=ij_end-iip1
[763]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
[1146]121        DO iq=1,nqtot
[763]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
[1279]147#else
148      write(lunout,*)'writehist_p: Needs IOIPSL to function'
149#endif
150! #endif of #ifdef CPP_IOIPSL
[763]151      return
152      end
Note: See TracBrowser for help on using the repository browser.