GCC Code Coverage Report
Directory: ./ Exec Total Coverage
File: dyn3d_common/writehist.F Lines: 0 16 0.0 %
Date: 2023-06-30 12:51:15 Branches: 0 0 - %

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