LMDZ
writedynav.F90
Go to the documentation of this file.
1 ! $Id: writedynav.F90 2239 2015-03-23 07:27:30Z emillour $
2 
3 subroutine writedynav(time, vcov, ucov, teta, ppk, phi, q, masse, ps, phis)
4 
5 #ifdef CPP_IOIPSL
6  USE ioipsl
7 #endif
8  USE infotrac, ONLY : nqtot, ttext
10 
11  implicit none
12 
13  ! Ecriture du fichier histoire au format IOIPSL
14 
15  ! Appels succesifs des routines: histwrite
16 
17  ! Entree:
18  ! time: temps de l'ecriture
19  ! vcov: vents v covariants
20  ! ucov: vents u covariants
21  ! teta: temperature potentielle
22  ! phi : geopotentiel instantane
23  ! q : traceurs
24  ! masse: masse
25  ! ps :pression au sol
26  ! phis : geopotentiel au sol
27 
28  ! L. Fairhead, LMD, 03/99
29 
30  ! Declarations
31  include "dimensions.h"
32  include "paramet.h"
33  include "comconst.h"
34  include "comvert.h"
35  include "comgeom.h"
36  include "temps.h"
37  include "ener.h"
38  include "logic.h"
39  include "description.h"
40  include "serre.h"
41  include "iniprint.h"
42 
43  ! Arguments
44 
45  REAL vcov(ip1jm, llm), ucov(ip1jmp1, llm)
46  REAL teta(ip1jmp1*llm), phi(ip1jmp1, llm), ppk(ip1jmp1*llm)
47  REAL ps(ip1jmp1), masse(ip1jmp1, llm)
48  REAL phis(ip1jmp1)
49  REAL q(ip1jmp1, llm, nqtot)
50  integer time
51 
52 #ifdef CPP_IOIPSL
53  ! This routine needs IOIPSL to work
54  ! Variables locales
55 
56  integer ndex2d(ip1jmp1), ndexu(ip1jmp1*llm), ndexv(ip1jm*llm)
57  INTEGER iq, ii, ll
58  real tm(ip1jmp1*llm)
59  REAL vnat(ip1jm, llm), unat(ip1jmp1, llm)
60  logical ok_sync
61  integer itau_w
62 
63  !-----------------------------------------------------------------
64 
65  ! Initialisations
66 
67  ndexu = 0
68  ndexv = 0
69  ndex2d = 0
70  ok_sync = .true.
71  tm = 999.999
72  vnat = 999.999
73  unat = 999.999
74  itau_w = itau_dyn + time
75 
76  ! Passage aux composantes naturelles du vent
77  call covnat(llm, ucov, vcov, unat, vnat)
78 
79  ! Appels a histwrite pour l'ecriture des variables a sauvegarder
80 
81  ! Vents U
82 
83  call histwrite(histuaveid, 'u', itau_w, unat, &
84  iip1*jjp1*llm, ndexu)
85 
86  ! Vents V
87 
88  call histwrite(histvaveid, 'v', itau_w, vnat, &
89  iip1*jjm*llm, ndexv)
90 
91  ! Temperature potentielle moyennee
92 
93  call histwrite(histaveid, 'theta', itau_w, teta, &
94  iip1*jjp1*llm, ndexu)
95 
96  ! Temperature moyennee
97 
98  do ii = 1, ijp1llm
99  tm(ii) = teta(ii) * ppk(ii)/cpp
100  enddo
101  call histwrite(histaveid, 'temp', itau_w, tm, &
102  iip1*jjp1*llm, ndexu)
103 
104  ! Geopotentiel
105 
106  call histwrite(histaveid, 'phi', itau_w, phi, &
107  iip1*jjp1*llm, ndexu)
108 
109  ! Traceurs
110 
111  ! DO iq=1, nqtot
112  ! call histwrite(histaveid, ttext(iq), itau_w, q(:, :, iq), &
113  ! iip1*jjp1*llm, ndexu)
114  ! enddo
115 
116  ! Masse
117 
118  call histwrite(histaveid, 'masse', itau_w, masse, &
119  iip1*jjp1*llm, ndexu)
120 
121  ! Pression au sol
122 
123  call histwrite(histaveid, 'ps', itau_w, ps, iip1*jjp1, ndex2d)
124 
125  ! Geopotentiel au sol
126 
127  ! call histwrite(histaveid, 'phis', itau_w, phis, iip1*jjp1, ndex2d)
128 
129  if (ok_sync) then
130  call histsync(histaveid)
131  call histsync(histvaveid)
132  call histsync(histuaveid)
133  ENDIF
134 
135 #else
136  write(lunout, *) "writedynav: Warning this routine should not be", &
137  " used without ioipsl"
138 #endif
139  ! of #ifdef CPP_IOIPSL
140 
141 end subroutine writedynav
!$Id && itau_dyn
Definition: temps.h:15
character(len=23), dimension(:), allocatable, save ttext
Definition: infotrac.F90:19
!$Header llmm1 INTEGER ip1jmp1
Definition: paramet.h:14
!$Id Turb_fcg_gcssold get_uvd hqturb_gcssold endif!large scale llm day day1 day day1 *dt_toga endif!time annee_ref dt_toga u_toga vq_toga w_prof vq_prof llm day day1 day day1 *dt_dice endif!time annee_ref dt_dice swup_dice vg_dice omega_dice tg_prof vg_profd w_profd omega_profd!do llm!print llm l llm
integer, save nqtot
Definition: infotrac.F90:6
!$Header llmm1 INTEGER ip1jm
Definition: paramet.h:14
!$Header jjp1
Definition: paramet.h:14
!$Id mode_top_bound COMMON comconstr cpp
Definition: comconst.h:7
subroutine writedynav(time, vcov, ucov, teta, ppk, phi, q, masse, ps, phis)
Definition: writedynav.F90:4
!$Id itapm1 ENDIF!IM on interpole les champs sur les niveaux STD de pression!IM a chaque pas de temps de la physique c!positionnement de l argument logique a false c!pour ne pas recalculer deux fois la meme chose!c!a cet effet un appel a plevel_new a ete deplace c!a la fin de la serie d appels c!la boucle DO nlevSTD a ete internalisee c!dans d ou la creation de cette routine c c!CALL ulevSTD CALL &zphi philevSTD CALL &zx_rh rhlevSTD!DO klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon du jour ou toutes les read_climoz CALL true
subroutine covnat(klevel, ucov, vcov, unat, vnat)
Definition: covnat.F:5
!$Header!gestion des impressions de sorties et de débogage la sortie standard prt_level COMMON comprint lunout
Definition: iniprint.h:7