source: LMDZ4/trunk/libf/dyn3dpar/writehist_p.F @ 1195

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

Réintegration dans le tronc des modifications issues de la branche LMDZ-dev
comprises entre la révision 1074 et 1145
Validation: une simulation de 1 jour en séquentiel sur PC donne les mêmes
résultats entre la trunk et la dev
LF

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.1 KB
RevLine 
[763]1!
2! $Header$
3!
[1146]4      subroutine writehist_p( histid, histvid, time, vcov,
[763]5     ,                          ucov,teta,phi,q,masse,ps,phis)
6
7      USE ioipsl
8      USE parallel
9      USE misc_mod
[1146]10      USE infotrac
[763]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
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
63
64C   Variables locales
65C
66      integer iq, ii, ll
67      integer ndexu(ip1jmp1*llm),ndexv(ip1jm*llm),ndex2d(ip1jmp1)
68      logical ok_sync
69      integer itau_w
70      integer :: ijb,ije,jjn
71C
72C  Initialisations
73C
74      if (adjust) return
75     
76   
77      ndexu = 0
78      ndexv = 0
79      ndex2d = 0
80      ok_sync =.TRUE.
81      itau_w = itau_dyn + time
82C
83C  Appels a histwrite pour l'ecriture des variables a sauvegarder
84C
85C  Vents U
86C
87      ijb=ij_begin
88      ije=ij_end
89      jjn=jj_nb
90         
[1000]91      call histwrite(histid, 'ucov', itau_w, ucov(ijb:ije,:),
[763]92     .               iip1*jjn*llm, ndexu)
93
94C
95C  Vents V
96C
[1000]97      if (pole_sud) ije=ij_end-iip1
[763]98      if (pole_sud) jjn=jj_nb-1
99     
100      call histwrite(histvid, 'vcov', itau_w, vcov(ijb:ije,:),
101     .               iip1*jjn*llm, ndexv)
102
103C
104C  Temperature potentielle
105C
106      ijb=ij_begin
107      ije=ij_end
108      jjn=jj_nb
109
110      call histwrite(histid, 'teta', itau_w, teta(ijb:ije,:),
111     .                iip1*jjn*llm, ndexu)
112C
113C  Geopotentiel
114C
115      call histwrite(histid, 'phi', itau_w, phi(ijb:ije,:),
116     .                iip1*jjn*llm, ndexu)
117C
118C  Traceurs
119C
[1146]120        DO iq=1,nqtot
[763]121          call histwrite(histid, ttext(iq), itau_w, q(ijb:ije,:,iq),
122     .                   iip1*jjn*llm, ndexu)
123        enddo
124C
125C  Masse
126C
127      call histwrite(histid, 'masse', itau_w, masse(ijb:ije,1),
128     .               iip1*jjn, ndex2d)
129C
130C  Pression au sol
131C
132      call histwrite(histid, 'ps', itau_w, ps(ijb:ije),
133     .               iip1*jjn, ndex2d)
134C
135C  Geopotentiel au sol
136C
137      call histwrite(histid, 'phis', itau_w, phis(ijb:ije),
138     .               iip1*jjn, ndex2d)
139C
140C  Fin
141C
142      if (ok_sync) then
143        call histsync(histid)
144        call histsync(histvid)
145      endif
146      return
147      end
Note: See TracBrowser for help on using the repository browser.