source: LMDZ4/branches/LMDZ4-dev-20091210/libf/bibio/writedynav.F @ 1671

Last change on this file since 1671 was 1186, checked in by Ehouarn Millour, 15 years ago

Cleanup around IOIPSL, so that LMDZ dynamics may be used without IOIPSL.

  • moved ersatz IOIPSL routines (ioipsl_* , taken from IOIPSLv2_1_8, so that 'getin' function may be used even if not using the IOIPSL library) from dyn3d/dyn3dpar to bibio.
  • enclosed 'use ioipsl' instruction with #ifdef CPP_IOIPSL cpp keys.

EM

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.5 KB
Line 
1!
2! $Id: writedynav.F 1186 2009-06-18 09:20:44Z emillour $
3!
4      subroutine writedynav( histid, time, vcov,
5     ,                          ucov,teta,ppk,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      time: temps de l'ecriture
21C      vcov: vents v covariants
22C      ucov: vents u covariants
23C      teta: temperature potentielle
24C      phi : geopotentiel instantane
25C      q   : traceurs
26C      masse: masse
27C      ps   :pression au sol
28C      phis : geopotentiel au sol
29C     
30C
31C   Sortie:
32C      fileid: ID du fichier netcdf cree
33C
34C   L. Fairhead, LMD, 03/99
35C
36C =====================================================================
37C
38C   Declarations
39#include "dimensions.h"
40#include "paramet.h"
41#include "comconst.h"
42#include "comvert.h"
43#include "comgeom.h"
44#include "temps.h"
45#include "ener.h"
46#include "logic.h"
47#include "description.h"
48#include "serre.h"
49#include "iniprint.h"
50
51C
52C   Arguments
53C
54
55      INTEGER histid
56      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm)
57      REAL teta(ip1jmp1*llm),phi(ip1jmp1,llm),ppk(ip1jmp1*llm)                 
58      REAL ps(ip1jmp1),masse(ip1jmp1,llm)                   
59      REAL phis(ip1jmp1)                 
60      REAL q(ip1jmp1,llm,nqtot)
61      integer time
62
63
64#ifdef CPP_IOIPSL
65! This routine needs IOIPSL to work
66C   Variables locales
67C
68      integer ndex2d(iip1*jjp1),ndex3d(iip1*jjp1*llm),iq, ii, ll
69      real us(ip1jmp1*llm), vs(ip1jmp1*llm)
70      real tm(ip1jmp1*llm)
71      REAL vnat(ip1jm,llm),unat(ip1jmp1,llm)
72      logical ok_sync
73      integer itau_w
74C
75C  Initialisations
76C
77      ndex3d = 0
78      ndex2d = 0
79      ok_sync = .TRUE.
80      us = 999.999
81      vs = 999.999
82      tm = 999.999
83      vnat = 999.999
84      unat = 999.999
85      itau_w = itau_dyn + time
86
87C Passage aux composantes naturelles du vent
88      call covnat(llm, ucov, vcov, unat, vnat)
89
90C
91C  Appels a histwrite pour l'ecriture des variables a sauvegarder
92C
93C  Vents U scalaire
94C
95      call gr_u_scal(llm, unat, us)
96      call histwrite(histid, 'u', itau_w, us,
97     .               iip1*jjp1*llm, ndex3d)
98C
99C  Vents V scalaire
100C
101      call gr_v_scal(llm, vnat, vs)
102      call histwrite(histid, 'v', itau_w, vs,
103     .               iip1*jjp1*llm, ndex3d)
104C
105C  Temperature potentielle moyennee
106C
107      call histwrite(histid, 'theta', itau_w, teta,
108     .                iip1*jjp1*llm, ndex3d)
109C
110C  Temperature moyennee
111C
112      do ii = 1, ijp1llm
113        tm(ii) = teta(ii) * ppk(ii)/cpp
114      enddo
115      call histwrite(histid, 'temp', itau_w, tm,
116     .                iip1*jjp1*llm, ndex3d)
117C
118C  Geopotentiel
119C
120      call histwrite(histid, 'phi', itau_w, phi,
121     .                iip1*jjp1*llm, ndex3d)
122C
123C  Traceurs
124C
125        DO iq=1,nqtot
126          call histwrite(histid, ttext(iq), itau_w, q(:,:,iq),
127     .                   iip1*jjp1*llm, ndex3d)
128        enddo
129C
130C  Masse
131C
132       call histwrite(histid, 'masse', itau_w, masse, iip1*jjp1, ndex2d)
133C
134C  Pression au sol
135C
136       call histwrite(histid, 'ps', itau_w, ps, iip1*jjp1, ndex2d)
137C
138C  Geopotentiel au sol
139C
140       call histwrite(histid, 'phis', itau_w, phis, iip1*jjp1, ndex2d)
141C
142C  Fin
143C
144      if (ok_sync) call histsync(histid)
145
146#else
147! tell the user this routine should be run with ioipsl
148      write(lunout,*)"writedynav: Warning this routine should not be",
149     &               " used without ioipsl"
150#endif
151! of #ifdef CPP_IOIPSL
152      return
153      end
Note: See TracBrowser for help on using the repository browser.