source: LMDZ5/branches/IPSLCM5A2.1_ISO/libf/dyn3dpar/writedynav_p.F @ 3770

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

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