GCC Code Coverage Report

Directory: ./
File: dyn3d_common/writedynav.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 0 22 0.0%
Branches: 0 12 0.0%
Line Branch Exec Source
1 ! $Id: writedynav.F90 2622 2016-09-04 06:12:02Z emillour $
2
3 ✗ subroutine writedynav(time, vcov, ucov, teta, ppk, phi, q, masse, ps, phis)
4
5 USE ioipsl
6 USE infotrac, ONLY : nqtot, ttext
7 use com_io_dyn_mod, only : histaveid, histvaveid, histuaveid
8 USE comconst_mod, ONLY: cpp
9 USE temps_mod, ONLY: itau_dyn
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 "comgeom.h"
34 include "description.h"
35 include "iniprint.h"
36
37 ! Arguments
38
39 REAL vcov(ip1jm, llm), ucov(ip1jmp1, llm)
40 REAL teta(ip1jmp1*llm), phi(ip1jmp1, llm), ppk(ip1jmp1*llm)
41 REAL ps(ip1jmp1), masse(ip1jmp1, llm)
42 REAL phis(ip1jmp1)
43 REAL q(ip1jmp1, llm, nqtot)
44 integer time
45
46 ! This routine needs IOIPSL to work
47 ! Variables locales
48
49 integer ndex2d(ip1jmp1), ndexu(ip1jmp1*llm), ndexv(ip1jm*llm)
50 INTEGER iq, ii, ll
51 real tm(ip1jmp1*llm)
52 REAL vnat(ip1jm, llm), unat(ip1jmp1, llm)
53 logical ok_sync
54 integer itau_w
55
56 !-----------------------------------------------------------------
57
58 ! Initialisations
59
60 ✗ ndexu = 0
61 ✗ ndexv = 0
62 ✗ ndex2d = 0
63 ok_sync = .TRUE.
64 ✗ tm = 999.999
65 ✗ vnat = 999.999
66 ✗ unat = 999.999
67 ✗ itau_w = itau_dyn + time
68
69 ! Passage aux composantes naturelles du vent
70 ✗ call covnat(llm, ucov, vcov, unat, vnat)
71
72 ! Appels a histwrite pour l'ecriture des variables a sauvegarder
73
74 ! Vents U
75
76 call histwrite(histuaveid, 'u', itau_w, unat, &
77 ✗ iip1*jjp1*llm, ndexu)
78
79 ! Vents V
80
81 call histwrite(histvaveid, 'v', itau_w, vnat, &
82 ✗ iip1*jjm*llm, ndexv)
83
84 ! Temperature potentielle moyennee
85
86 call histwrite(histaveid, 'theta', itau_w, teta, &
87 ✗ iip1*jjp1*llm, ndexu)
88
89 ! Temperature moyennee
90
91 ✗ do ii = 1, ijp1llm
92 ✗ tm(ii) = teta(ii) * ppk(ii)/cpp
93 enddo
94 call histwrite(histaveid, 'temp', itau_w, tm, &
95 ✗ iip1*jjp1*llm, ndexu)
96
97 ! Geopotentiel
98
99 call histwrite(histaveid, 'phi', itau_w, phi, &
100 ✗ iip1*jjp1*llm, ndexu)
101
102 ! Traceurs
103
104 ! DO iq=1, nqtot
105 ! call histwrite(histaveid, ttext(iq), itau_w, q(:, :, iq), &
106 ! iip1*jjp1*llm, ndexu)
107 ! enddo
108
109 ! Masse
110
111 call histwrite(histaveid, 'masse', itau_w, masse, &
112 ✗ iip1*jjp1*llm, ndexu)
113
114 ! Pression au sol
115
116 ✗ call histwrite(histaveid, 'ps', itau_w, ps, iip1*jjp1, ndex2d)
117
118 ! Geopotentiel au sol
119
120 ! call histwrite(histaveid, 'phis', itau_w, phis, iip1*jjp1, ndex2d)
121
122 if (ok_sync) then
123 ✗ call histsync(histaveid)
124 ✗ call histsync(histvaveid)
125 ✗ call histsync(histuaveid)
126 ENDIF
127
128 ! of #ifdef 1
129
130 ✗ end subroutine writedynav
131