source: LMDZ5/trunk/libf/dyn3dpar/writedynav_p.F @ 2597

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

Cleanup in the dynamics: get rid of comconst.h, make it a module comconst_mod.
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.8 KB
Line 
1!
2! $Id: writedynav_p.F 2597 2016-07-22 06:44:47Z emillour $
3!
4      subroutine writedynav_p( histid, time, vcov,
5     ,                          ucov,teta,ppk,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 comconst_mod, ONLY: cpp
15      implicit none
16
17C
18C   Ecriture du fichier histoire au format IOIPSL
19C
20C   Appels succesifs des routines: histwrite
21C
22C   Entree:
23C      histid: ID du fichier histoire
24C      time: temps de l'ecriture
25C      vcov: vents v covariants
26C      ucov: vents u covariants
27C      teta: temperature potentielle
28C      phi : geopotentiel instantane
29C      q   : traceurs
30C      masse: masse
31C      ps   :pression au sol
32C      phis : geopotentiel au sol
33C     
34C
35C   Sortie:
36C      fileid: ID du fichier netcdf cree
37C
38C   L. Fairhead, LMD, 03/99
39C
40C =====================================================================
41C
42C   Declarations
43#include "dimensions.h"
44#include "paramet.h"
45#include "comvert.h"
46#include "comgeom.h"
47#include "temps.h"
48#include "ener.h"
49#include "logic.h"
50#include "description.h"
51#include "serre.h"
52#include "iniprint.h"
53
54C
55C   Arguments
56C
57
58      INTEGER histid
59      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm)
60      REAL teta(ip1jmp1,llm),phi(ip1jmp1,llm),ppk(ip1jmp1,llm)                 
61      REAL ps(ip1jmp1),masse(ip1jmp1,llm)                   
62      REAL phis(ip1jmp1)                 
63      REAL q(ip1jmp1,llm,nqtot)
64      integer time
65
66
67#ifdef CPP_IOIPSL
68! This routine needs IOIPSL
69C   Variables locales
70C
71      integer ndex2d(iip1*jjp1),ndex3d(iip1*jjp1*llm),iq, ii, ll
72      real us(ip1jmp1,llm), vs(ip1jmp1,llm)
73      real tm(ip1jmp1,llm)
74      REAL vnat(ip1jm,llm),unat(ip1jmp1,llm)
75      logical ok_sync
76      integer itau_w
77      integer :: ijb,ije,jjn
78C
79C  Initialisations
80C
81      if (adjust) return
82     
83      ndex3d = 0
84      ndex2d = 0
85      ok_sync = .TRUE.
86      us = 999.999
87      vs = 999.999
88      tm = 999.999
89      vnat = 999.999
90      unat = 999.999
91      itau_w = itau_dyn + time
92
93C Passage aux composantes naturelles du vent
94      call covnat_p(llm, ucov, vcov, unat, vnat)
95
96C
97C  Appels a histwrite pour l'ecriture des variables a sauvegarder
98C
99C  Vents U scalaire
100C
101      call gr_u_scal_p(llm, unat, us)
102     
103      ijb=ij_begin
104      ije=ij_end
105      jjn=jj_nb
106     
107      call histwrite(histid, 'u', itau_w, us(ijb:ije,:),
108     .               iip1*jjn*llm, ndex3d)
109C
110C  Vents V scalaire
111C
112     
113      call gr_v_scal_p(llm, vnat, vs)
114      call histwrite(histid, 'v', itau_w, vs(ijb:ije,:),
115     .               iip1*jjn*llm, ndex3d)
116C
117C  Temperature potentielle moyennee
118C
119     
120      call histwrite(histid, 'theta', itau_w, teta(ijb:ije,:),
121     .                iip1*jjn*llm, ndex3d)
122C
123C  Temperature moyennee
124C
125      do ll=1,llm
126        do ii = ijb, ije
127          tm(ii,ll) = teta(ii,ll) * ppk(ii,ll)/cpp
128        enddo
129      enddo
130     
131      call histwrite(histid, 'temp', itau_w, tm(ijb:ije,:),
132     .                iip1*jjn*llm, ndex3d)
133C
134C  Geopotentiel
135C
136      call histwrite(histid, 'phi', itau_w, phi(ijb:ije,:),
137     .                iip1*jjn*llm, ndex3d)
138C
139C  Traceurs
140C
141        DO iq=1,nqtot
142          call histwrite(histid, ttext(iq), itau_w, q(ijb:ije,:,iq),
143     .                   iip1*jjn*llm, ndex3d)
144        enddo
145C
146C  Masse
147C
148       call histwrite(histid, 'masse', itau_w, masse(ijb:ije,1),
149     .                iip1*jjn, ndex2d)
150C
151C  Pression au sol
152C
153       call histwrite(histid, 'ps', itau_w, ps(ijb:ije),
154     .                 iip1*jjn, ndex2d)
155C
156C  Geopotentiel au sol
157C
158       call histwrite(histid, 'phis', itau_w, phis(ijb:ije),
159     .                 iip1*jjn, ndex2d)
160C
161C  Fin
162C
163      if (ok_sync) call histsync(histid)
164#else
165      write(lunout,*)'writedynav_p: Needs IOIPSL to function'
166#endif
167! #endif of #ifdef CPP_IOIPSL
168      return
169      end
Note: See TracBrowser for help on using the repository browser.