GCC Code Coverage Report


Directory: ./
File: dyn3d_common/writehist.f
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 0 16 0.0%
Branches: 0 0 -%

Line Branch Exec Source
1 !
2 ! $Id: writehist.F 2622 2016-09-04 06:12:02Z emillour $
3 !
4 subroutine writehist(time,vcov,ucov,teta,phi,q,masse,ps,phis)
5
6 USE ioipsl
7 USE infotrac, ONLY : nqtot, ttext
8 use com_io_dyn_mod, only : histid,histvid,histuid
9 USE temps_mod, ONLY: itau_dyn
10
11 implicit none
12
13 C
14 C Ecriture du fichier histoire au format IOIPSL
15 C
16 C Appels succesifs des routines: histwrite
17 C
18 C Entree:
19 C time: temps de l'ecriture
20 C vcov: vents v covariants
21 C ucov: vents u covariants
22 C teta: temperature potentielle
23 C phi : geopotentiel instantane
24 C q : traceurs
25 C masse: masse
26 C ps :pression au sol
27 C phis : geopotentiel au sol
28 C
29 C
30 C L. Fairhead, LMD, 03/99
31 C
32 C =====================================================================
33 C
34 C Declarations
35 include "dimensions.h"
36 include "paramet.h"
37 include "comgeom.h"
38 include "description.h"
39 include "iniprint.h"
40
41 C
42 C Arguments
43 C
44
45 REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm)
46 REAL teta(ip1jmp1,llm),phi(ip1jmp1,llm)
47 REAL ps(ip1jmp1),masse(ip1jmp1,llm)
48 REAL phis(ip1jmp1)
49 REAL q(ip1jmp1,llm,nqtot)
50 integer time
51
52
53 ! This routine needs IOIPSL to work
54 C Variables locales
55 C
56 integer iq, ii, ll
57 integer ndexu(ip1jmp1*llm),ndexv(ip1jm*llm),ndex2d(ip1jmp1)
58 logical ok_sync
59 integer itau_w
60 REAL vnat(ip1jm,llm),unat(ip1jmp1,llm)
61
62 C
63 C Initialisations
64 C
65 ndexu = 0
66 ndexv = 0
67 ndex2d = 0
68 ok_sync =.TRUE.
69 itau_w = itau_dyn + time
70 ! Passage aux composantes naturelles du vent
71 call covnat(llm, ucov, vcov, unat, vnat)
72 C
73 C Appels a histwrite pour l'ecriture des variables a sauvegarder
74 C
75 C Vents U
76 C
77 call histwrite(histuid, 'u', itau_w, unat,
78 . iip1*jjp1*llm, ndexu)
79 C
80 C Vents V
81 C
82 call histwrite(histvid, 'v', itau_w, vnat,
83 . iip1*jjm*llm, ndexv)
84
85 C
86 C Temperature potentielle
87 C
88 call histwrite(histid, 'teta', itau_w, teta,
89 . iip1*jjp1*llm, ndexu)
90 C
91 C Geopotentiel
92 C
93 call histwrite(histid, 'phi', itau_w, phi,
94 . iip1*jjp1*llm, ndexu)
95 C
96 C Traceurs
97 C
98 ! DO iq=1,nqtot
99 ! call histwrite(histid, ttext(iq), itau_w, q(:,:,iq),
100 ! . iip1*jjp1*llm, ndexu)
101 ! enddo
102 !C
103 C Masse
104 C
105 call histwrite(histid,'masse',itau_w, masse,iip1*jjp1*llm,ndexu)
106 C
107 C Pression au sol
108 C
109 call histwrite(histid, 'ps', itau_w, ps, iip1*jjp1, ndex2d)
110 C
111 C Geopotentiel au sol
112 C
113 ! call histwrite(histid, 'phis', itau_w, phis, iip1*jjp1, ndex2d)
114 C
115 C Fin
116 C
117 if (ok_sync) then
118 call histsync(histid)
119 call histsync(histvid)
120 call histsync(histuid)
121 endif
122 ! of #ifdef 1
123 return
124 end
125