← Back to branch summary

~ubuntu-branches/ubuntu/precise/code-saturne/precise

« back to all changes in this revision

Viewing changes to src/base/ecrhis.f90

  • Committer: Package Import Robot
  • Author(s): Sylvestre Ledru
  • Date: 2011-11-24 00:00:08 UTC
  • mfrom: (6.1.9 sid)
  • Revision ID: package-import@ubuntu.com-20111124000008-2vo99e38267942q5
Tags: 2.1.0-3
Install a missing file

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/base/ecrhis.f90
1
1
!-------------------------------------------------------------------------------
2
2
 
3
 
!     This file is part of the Code_Saturne Kernel, element of the
4
 
!     Code_Saturne CFD tool.
5
 
 
6
 
!     Copyright (C) 1998-2009 EDF S.A., France
7
 
 
8
 
!     contact: saturne-support@edf.fr
9
 
 
10
 
!     The Code_Saturne Kernel is free software; you can redistribute it
11
 
!     and/or modify it under the terms of the GNU General Public License
12
 
!     as published by the Free Software Foundation; either version 2 of
13
 
!     the License, or (at your option) any later version.
14
 
 
15
 
!     The Code_Saturne Kernel is distributed in the hope that it will be
16
 
!     useful, but WITHOUT ANY WARRANTY; without even the implied warranty
17
 
!     of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18
 
!     GNU General Public License for more details.
19
 
 
20
 
!     You should have received a copy of the GNU General Public License
21
 
!     along with the Code_Saturne Kernel; if not, write to the
22
 
!     Free Software Foundation, Inc.,
23
 
!     51 Franklin St, Fifth Floor,
24
 
!     Boston, MA  02110-1301  USA
 
3
! This file is part of Code_Saturne, a general-purpose CFD tool.
 
4
!
 
5
! Copyright (C) 1998-2011 EDF S.A.
 
6
!
 
7
! This program is free software; you can redistribute it and/or modify it under
 
8
! the terms of the GNU General Public License as published by the Free Software
 
9
! Foundation; either version 2 of the License, or (at your option) any later
 
10
! version.
 
11
!
 
12
! This program is distributed in the hope that it will be useful, but WITHOUT
 
13
! ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
 
14
! FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
 
15
! details.
 
16
!
 
17
! You should have received a copy of the GNU General Public License along with
 
18
! this program; if not, write to the Free Software Foundation, Inc., 51 Franklin
 
19
! Street, Fifth Floor, Boston, MA 02110-1301, USA.
25
20
 
26
21
!-------------------------------------------------------------------------------
27
22
 
28
23
subroutine ecrhis &
29
24
!================
30
25
 
31
 
 ( idbia0 , idbra0 , ndim   , ncelet , ncel ,                     &
32
 
   nideve , nrdeve , nituse , nrtuse , modhis ,                   &
33
 
   idevel , ituser , ia     ,                                     &
34
 
   xyzcen , rdevel , rtuser , ra )
 
26
 ( ndim   , ncelet , ncel , modhis , xyzcen , ra )
35
27
 
36
28
!===============================================================================
37
 
!  FONCTION  :
38
 
!  ---------
 
29
! Purpose:
 
30
! -------
39
31
 
40
 
! ROUTINE D'ECRITURE DES HISTORIQUES
 
32
! Write plot data
41
33
 
42
34
!-------------------------------------------------------------------------------
43
35
! Arguments
44
36
!__________________.____._____.________________________________________________.
45
37
! name             !type!mode ! role                                           !
46
38
!__________________!____!_____!________________________________________________!
47
 
! idbia0           ! i  ! <-- ! number of first free position in ia            !
48
 
! idbra0           ! i  ! <-- ! number of first free position in ra            !
49
39
! ndim             ! i  ! <-- ! spatial dimension                              !
50
40
! ncelet           ! i  ! <-- ! number of extended (real + ghost) cells        !
51
41
! ncel             ! i  ! <-- ! number of cells                                !
52
 
! nideve, nrdeve   ! i  ! <-- ! sizes of idevel and rdevel arrays              !
53
 
! nituse, nrtuse   ! i  ! <-- ! sizes of ituser and rtuser arrays              !
54
 
! modhis           ! e  ! <-- ! indicateur valant 0,1 ou 2                     !
55
 
!                  !    !     ! 1,2 = ecriture intermediaire, finale           !
56
 
! idevel(nideve)   ! ia ! <-> ! integer work array for temporary development   !
57
 
! ituser(nituse)   ! ia ! <-> ! user-reserved integer work array               !
58
 
! ia(*)            ! ia ! --- ! main integer work array                        !
59
 
! xyzcen           ! tr ! <-- ! point associes aux volumes de control          !
60
 
! (ndim,ncelet)    !    !     !                                                !
61
 
! rdevel(nrdeve)   ! ra ! <-> ! real work array for temporary development      !
62
 
! rtuser(nrtuse)   ! ra ! <-> ! user-reserved real work array                  !
63
 
! ra               ! tr !  -- ! tableau des reels                              !
 
42
! modhis           ! i  ! <-- ! 0 or 1: initialize/output; 2: finalize         !
 
43
! xyzcen           ! ra ! <-- ! cell centers                                   !
 
44
!  (ndim, ncelet)  !    !     !                                                !
 
45
! ra(*)            ! ra ! <-- ! main real work array                           !
64
46
!__________________!____!_____!________________________________________________!
65
47
 
66
 
!     TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU)
67
 
!            L (LOGIQUE)   .. ET TYPES COMPOSES (EX : TR TABLEAU REEL)
68
 
!     MODE : <-- donnee, --> resultat, <-> Donnee modifiee
69
 
!            --- tableau de travail
 
48
!     Type: i (integer), r (real), s (string), a (array), l (logical),
 
49
!           and composite types (ex: ra real array)
 
50
!     mode: <-- input, --> output, <-> modifies data, --- work array
 
51
!===============================================================================
 
52
 
 
53
!===============================================================================
 
54
! Module files
 
55
!===============================================================================
 
56
 
 
57
use paramx
 
58
use numvar
 
59
use entsor
 
60
use cstnum
 
61
use optcal
 
62
use parall
 
63
 
70
64
!===============================================================================
71
65
 
72
66
implicit none
73
67
 
74
 
!===============================================================================
75
 
! Common blocks
76
 
!===============================================================================
77
 
 
78
 
include "paramx.h"
79
 
include "numvar.h"
80
 
include "entsor.h"
81
 
include "cstnum.h"
82
 
include "optcal.h"
83
 
include "parall.h"
84
 
 
85
 
!===============================================================================
86
 
 
87
68
! Arguments
88
69
 
89
 
integer          idbia0, idbra0
90
70
integer          ndim, ncelet, ncel
91
 
integer          nideve , nrdeve , nituse , nrtuse
92
71
integer          modhis
93
 
integer          idevel(nideve), ituser(nituse), ia(*)
94
 
double precision xyzcen(ndim,ncelet)
95
 
double precision rdevel(nrdeve), rtuser(nrtuse), ra(*)
 
72
double precision xyzcen(ndim, ncelet)
 
73
double precision, dimension(*), target :: ra
96
74
 
97
75
! Local variables
98
76
 
99
 
character        nomfic*300, nenvar*300
100
 
integer          ii, ii1, ii2, lpos, inam1, inam2, lng
101
 
integer          icap,ncap,ipp,ira,ipp2,nbpdte, jtcabs
102
 
integer          idivdt, ixmsdt, idebia, idebra, ifinra, iel
 
77
character        nompre*300, nomhis*300
 
78
integer          tplnum, ii, ii1, ii2, lpre, lnom, lng
 
79
integer          icap, ncap, ipp, ira, ipp2, jtcabs
 
80
integer          idivdt, ixmsdt, iel
103
81
integer          nbcap(nvppmx)
104
 
double precision xtcabs,xyztmp(3)
 
82
double precision xtcabs
105
83
double precision varcap(ncaptm)
106
84
 
107
 
! NOMBRE DE PASSAGES DANS LA ROUTINE
108
 
 
109
 
integer          ipass
110
 
data             ipass /0/
111
 
save             ipass
 
85
integer, dimension(:), allocatable :: lsttmp
 
86
double precision, dimension(:), allocatable, target :: momtmp
 
87
double precision, dimension(:,:), allocatable :: xyztmp
 
88
 
 
89
double precision, dimension(:), pointer :: varptr => null()
 
90
 
 
91
! Time plot number shift (in case multiple routines define plots)
 
92
 
 
93
integer  nptpl
 
94
data     nptpl /0/
 
95
save     nptpl
 
96
 
 
97
! Number of passes in this routine
 
98
 
 
99
integer  ipass
 
100
data     ipass /0/
 
101
save     ipass
112
102
 
113
103
!===============================================================================
114
 
! 0. INITIALISATIONS LOCALES
 
104
! 0. Local initializations
115
105
!===============================================================================
116
106
 
117
107
ipass = ipass + 1
118
108
 
119
 
idebia = idbia0
120
 
idebra = idbra0
 
109
!--> If no probe data has been output or there are no probes, return
 
110
if ((ipass.eq.1 .and. modhis.eq.2) .or. ncapt.eq.0) return
121
111
 
122
 
!--> Il n'y a pas eu d'historiques ou s'il n'y a pas de capteur
123
 
if((ipass.eq.1.and.modhis.eq.2) .or. ncapt.eq.0) return
 
112
if (ipass.eq.1) then
 
113
  call tplnbr(nptpl)
 
114
  !==========
 
115
endif
124
116
 
125
117
!===============================================================================
126
 
! 1. RECHERCHE DES NOEUDS PROCHES -> NODCAP
 
118
! 1. Search for neighboring nodes -> nodcap
127
119
!===============================================================================
128
120
 
129
121
if (ipass.eq.1) then
130
122
 
131
123
  do ii = 1, ncapt
132
 
    call findpt                                                   &
 
124
    call findpt                                                        &
133
125
    !==========
134
 
   ( ncelet, ncel, xyzcen ,                                       &
135
 
     xyzcap(1,ii), xyzcap(2,ii), xyzcap(3,ii),                    &
136
 
     nodcap(ii), ndrcap(ii))
 
126
    (ncelet, ncel, xyzcen,                                             &
 
127
     xyzcap(1,ii), xyzcap(2,ii), xyzcap(3,ii), nodcap(ii), ndrcap(ii))
137
128
  enddo
138
129
 
139
130
endif
140
131
 
141
132
!===============================================================================
142
 
! 2. OUVERTURE DU FICHIER DE STOCKAGE hist.tmp
 
133
! 2. Initialize output
143
134
!===============================================================================
144
135
 
145
 
if(ipass.eq.1 .and. irangp.le.0) then
146
 
  nomfic = ' '
147
 
  nomfic = emphis
148
 
  call verlon (nomfic,ii1,ii2,lpos)
 
136
! Create directory if required
 
137
if (ipass.eq.1 .and. irangp.le.0) then
 
138
  call csmkdr(emphis, len(emphis))
149
139
  !==========
150
 
 
151
 
  nomfic(ii2+1:ii2+8) = 'hist.tmp'
152
 
  ii2 = ii2+8
153
 
  open (unit=imphis(1), file=nomfic(ii1:ii2), &
154
 
        status='unknown', form='unformatted', &
155
 
        access='sequential')
156
 
endif
157
 
 
158
 
!===============================================================================
159
 
! 3. ECRITURE DES RESULTATS dans le FICHIER DE STOCKAGE
160
 
!===============================================================================
161
 
 
162
 
if(modhis.eq.0.or.modhis.eq.1) then
163
 
 
164
 
  do ipp = 2, nvppmx
165
 
    if(ihisvr(ipp,1).ne.0) then
 
140
endif
 
141
 
 
142
if (ipass.eq.1) then
 
143
 
 
144
  ! Number of probes per variable
 
145
  do ipp = 2, nvppmx
 
146
    nbcap(ipp) = ihisvr(ipp,1)
 
147
    if (nbcap(ipp).lt.0) nbcap(ipp) = ncapt
 
148
  enddo
 
149
 
 
150
  allocate(lsttmp(ncapt))
 
151
  allocate(xyztmp(3, ncapt))
 
152
 
 
153
  ! Initialize one output per variable
 
154
 
 
155
  do ipp = 2, nvppmx
 
156
 
 
157
    if (ihisvr(ipp,1) .gt. 0) then
 
158
      do ii=1, ihisvr(ipp,1)
 
159
        lsttmp(ii) = ihisvr(ipp,ii+1)
 
160
        if (irangp.lt.0 .or. irangp.eq.ndrcap(ihisvr(ipp, ii+1))) then
 
161
          xyztmp(1, ii) = xyzcen(1, nodcap(ihisvr(ipp, ii+1)))
 
162
          xyztmp(2, ii) = xyzcen(2, nodcap(ihisvr(ipp, ii+1)))
 
163
          xyztmp(3, ii) = xyzcen(3, nodcap(ihisvr(ipp, ii+1)))
 
164
        endif
 
165
        if (irangp.ge.0) then
 
166
          lng = 3
 
167
          call parbcr(ndrcap(ihisvr(ipp,ii+1)), lng , xyztmp(1, ii))
 
168
          !==========
 
169
        endif
 
170
      enddo
 
171
    else
 
172
      do ii = 1, nbcap(ipp)
 
173
        lsttmp(ii) = ii
 
174
        if (irangp.lt.0 .or. irangp.eq.ndrcap(ii)) then
 
175
          xyztmp(1, ii) = xyzcen(1, nodcap(ii))
 
176
          xyztmp(2, ii) = xyzcen(2, nodcap(ii))
 
177
          xyztmp(3, ii) = xyzcen(3, nodcap(ii))
 
178
        endif
 
179
        if (irangp.ge.0) then
 
180
          lng = 3
 
181
          call parbcr(ndrcap(ii), lng , xyztmp(1, ii))
 
182
          !==========
 
183
        endif
 
184
      enddo
 
185
    endif
 
186
 
 
187
    if (nbcap(ipp) .gt. 0) then
 
188
 
 
189
      if (irangp.le.0) then
 
190
 
 
191
        ! plot prefix
 
192
        nompre = ' '
 
193
        call verlon(emphis, ii1, ii2, lpre)
 
194
        !==========
 
195
        nompre(1:lpre) = emphis(ii1:ii2)
 
196
        call verlon(prehis, ii1, ii2, lnom)
 
197
        !==========
 
198
        nompre(lpre+1:lpre+lnom) = prehis(ii1:ii2)
 
199
        call verlon(nompre, ii1, ii2, lpre)
 
200
        !==========
 
201
 
 
202
        ! plot name
 
203
        nomhis = ' '
 
204
        call verlon(nomvar(ipp), ii1, ii2, lnom)
 
205
        !==========
 
206
        nomhis(1:lnom) = nomvar(ipp)(ii1:ii2)
 
207
 
 
208
        tplnum = nptpl + ipp
 
209
        call tppini(tplnum, nomhis, nompre, tplfmt, idtvar, nthsav, tplflw, &
 
210
        !==========
 
211
                    nbcap(ipp), lsttmp(1), xyzcap(1,1), lnom, lpre)
 
212
 
 
213
      endif ! (irangp.le.0)
 
214
 
 
215
    endif
 
216
 
 
217
  enddo
 
218
 
 
219
  deallocate(lsttmp)
 
220
  deallocate(xyztmp)
 
221
 
 
222
endif
 
223
 
 
224
!===============================================================================
 
225
! 3. Output results
 
226
!===============================================================================
 
227
 
 
228
if (modhis.eq.0 .or. modhis.eq.1) then
 
229
 
 
230
  do ipp = 2, nvppmx
 
231
    if (ihisvr(ipp,1).ne.0) then
166
232
      ira = abs(ipp2ra(ipp))
167
233
 
168
 
!     Pour les moments, il faut eventuellement diviser par le temps cumule
 
234
      ! For moments, we must divide by the cumulative time
169
235
      idivdt = ippmom(ipp)
170
 
      if(idivdt.eq.0) then
171
 
        ixmsdt = ira
 
236
      if (idivdt.eq.0) then
 
237
        varptr => ra(ira:ira+ncel)
172
238
      else
173
 
        ixmsdt = idebra
174
 
        ifinra = ixmsdt + ncel
175
 
        call rasize ('ecrhis', ifinra)
176
 
        !==========
177
 
      endif
178
 
      if(idivdt.gt.0) then
179
 
        do iel = 1, ncel
180
 
          ra(ixmsdt+iel-1) = ra(ira+iel-1)/ max(ra(idivdt+iel-1),epzero)
181
 
        enddo
182
 
      elseif(idivdt.lt.0) then
183
 
        do iel = 1, ncel
184
 
          ra(ixmsdt+iel-1) = ra(ira+iel-1)/ max(dtcmom(-idivdt),epzero)
185
 
        enddo
186
 
!     else
187
 
!       ra(ixmsdt+iel-1) = ra(ira+iel-1)
188
 
!       inutile car on a pose ixmsdt = ira
 
239
        allocate(momtmp(ncel))
 
240
        varptr => momtmp
 
241
        if (idivdt.gt.0) then
 
242
          do iel = 1, ncel
 
243
            momtmp(iel) = ra(ira+iel-1)/max(ra(idivdt+iel-1),epzero)
 
244
          enddo
 
245
        elseif (idivdt.lt.0) then
 
246
          do iel = 1, ncel
 
247
            momtmp(iel) = ra(ira+iel-1)/max(dtcmom(-idivdt),epzero)
 
248
          enddo
 
249
        endif
189
250
      endif
190
251
 
191
 
      if(ihisvr(ipp,1).lt.0) then
 
252
      if (ihisvr(ipp,1).lt.0) then
192
253
        do icap = 1, ncapt
193
254
          if (irangp.lt.0) then
194
 
            varcap(icap) = ra(ixmsdt+nodcap(icap)-1)
 
255
            varcap(icap) = varptr(nodcap(icap))
195
256
          else
196
 
            call parhis(nodcap(icap), ndrcap(icap), ra(ixmsdt), varcap(icap))
 
257
            call parhis(nodcap(icap), ndrcap(icap), varptr, varcap(icap))
197
258
            !==========
198
259
          endif
199
260
        enddo
201
262
      else
202
263
        do icap = 1, ihisvr(ipp,1)
203
264
          if (irangp.lt.0) then
204
 
            varcap(icap) = ra(ixmsdt+nodcap(ihisvr(ipp,icap+1))-1)
 
265
            varcap(icap) = varptr(nodcap(ihisvr(ipp,icap+1)))
205
266
          else
206
267
            call parhis(nodcap(ihisvr(ipp,icap+1)), &
207
268
            !==========
208
269
                        ndrcap(ihisvr(ipp,icap+1)), &
209
 
                        ra(ixmsdt), varcap(icap))
 
270
                        varptr, varcap(icap))
210
271
          endif
211
272
        enddo
212
273
        ncap = ihisvr(ipp,1)
213
274
      endif
214
 
      if (irangp.le.0) then
215
 
        write(imphis(1)) ntcabs, ttcabs, (varcap(icap), icap=1,ncap)
216
 
      endif
217
 
    endif
218
 
  enddo
219
 
 
220
 
endif
221
 
 
222
 
!===============================================================================
223
 
! 4. EN CAS DE SAUVEGARDE INTERMEDIAIRE OU FINALE,
224
 
!    TRANSMISSION DES INFORMATIONS DANS LES DIFFERENTS FICHIERS
225
 
!===============================================================================
226
 
 
227
 
! On sauve aussi au premier passage pour permettre une
228
 
!     verification des le debut du calcul
229
 
 
230
 
if(modhis.eq.1 .or. modhis.eq.2 .or. ipass.eq.1) then
231
 
 
232
 
  ! --> nombre de pas de temps enregistres
233
 
 
234
 
  if(modhis.eq.2) then
235
 
    nbpdte = ipass - 1
236
 
  else
237
 
    nbpdte = ipass
238
 
  endif
239
 
 
240
 
  ! --> nombre de capteur par variable
241
 
  do ipp = 2, nvppmx
242
 
    nbcap(ipp) = ihisvr(ipp,1)
243
 
    if(nbcap(ipp).lt.0) nbcap(ipp) = ncapt
244
 
  enddo
245
 
 
246
 
  ! --> ecriture un fichier par variable
247
 
 
248
 
  do ipp = 2, nvppmx
249
 
    if (ihisvr(ipp,1).ne.0) then
250
 
 
251
 
      if (irangp.le.0) then
252
 
        ! --> nom du fichier
253
 
        nomfic = ' '
254
 
        nomfic = emphis
255
 
        call verlon ( nomfic,ii1,ii2,lpos)
256
 
        !==========
257
 
        nenvar = prehis
258
 
        call verlon(nenvar,inam1,inam2,lpos)
259
 
        !==========
260
 
        call undscr(inam1,inam2,nenvar)
261
 
        !==========
262
 
        nomfic(ii2+1:ii2+lpos) = nenvar(inam1:inam2)
263
 
        call verlon ( nomfic,ii1,ii2,lpos)
264
 
        !==========
265
 
        nenvar = nomvar(ipp)
266
 
        call verlon(nenvar,inam1,inam2,lpos)
267
 
        !==========
268
 
        call undscr(inam1,inam2,nenvar)
269
 
        !==========
270
 
        nomfic(ii2+1:ii2+lpos) = nenvar(inam1:inam2)
271
 
        ii2 = ii2+lpos
272
 
        nomfic(ii2+1:ii2+1) = '.'
273
 
        ii2 = ii2+1
274
 
        nenvar = exthis
275
 
        call verlon(nenvar,inam1,inam2,lpos)
276
 
        !==========
277
 
        call undscr(inam1,inam2,nenvar)
278
 
        !==========
279
 
        nomfic(ii2+1:ii2+lpos) = nenvar(inam1:inam2)
280
 
        ii2 = ii2+lpos
281
 
        ! --> ouverture
282
 
        open (unit=imphis(2), file=nomfic (ii1:ii2), &
283
 
              status='UNKNOWN', form='FORMATTED',    &
284
 
              access='SEQUENTIAL')
285
 
        ! --> entete
286
 
        write(imphis(2),100)
287
 
        write(imphis(2),101)
288
 
        write(imphis(2),102) nomvar(ipp)
289
 
        write(imphis(2),100)
290
 
        write(imphis(2),103)
291
 
        write(imphis(2),104)
292
 
        write(imphis(2),103)
293
 
      endif
294
 
 
295
 
      if(ihisvr(ipp,1).gt.0) then
296
 
        do ii=1,ihisvr(ipp,1)
297
 
          if (irangp.lt.0 .or. irangp.eq.ndrcap(ihisvr(ipp,ii+1))) then
298
 
            xyztmp(1) = xyzcen(1,nodcap(ihisvr(ipp,ii+1)))
299
 
            xyztmp(2) = xyzcen(2,nodcap(ihisvr(ipp,ii+1)))
300
 
            xyztmp(3) = xyzcen(3,nodcap(ihisvr(ipp,ii+1)))
301
 
          endif
302
 
          if (irangp.ge.0) then
303
 
            lng = 3
304
 
            call parbcr(ndrcap(ihisvr(ipp,ii+1)), lng , xyztmp)
305
 
            !==========
306
 
          endif
307
 
          if(irangp.le.0) then
308
 
            write(imphis(2),105) ihisvr(ipp,ii+1),                &
309
 
                                 xyztmp(1), xyztmp(2), xyztmp(3)
310
 
          endif
311
 
        enddo
312
 
      elseif(ihisvr(ipp,1).lt.0) then
313
 
        do ii=1,ncapt
314
 
          if (irangp.lt.0 .or. irangp.eq.ndrcap(ii)) then
315
 
            xyztmp(1) = xyzcen(1,nodcap(ii))
316
 
            xyztmp(2) = xyzcen(2,nodcap(ii))
317
 
            xyztmp(3) = xyzcen(3,nodcap(ii))
318
 
          endif
319
 
          if (irangp.ge.0) then
320
 
            lng = 3
321
 
            call parbcr(ndrcap(ii), lng , xyztmp)
322
 
            !==========
323
 
          endif
324
 
          if(irangp.le.0) then
325
 
            write(imphis(2),105) ii, xyztmp(1), xyztmp(2), xyztmp(3)
326
 
          endif
327
 
        enddo
328
 
      endif
329
 
 
330
 
      if(irangp.le.0) then
331
 
 
332
 
        write(imphis(2),103)
333
 
        write(imphis(2),106) nbpdte
334
 
        write(imphis(2),103)
335
 
 
336
 
        write(imphis(2),103)
337
 
        write(imphis(2),107)
338
 
        write(imphis(2),103)
339
 
 
340
 
        write(imphis(2),100)
341
 
        write(imphis(2),103)
342
 
 
343
 
        write(imphis(2),110) nomvar(ipp)
344
 
        write(imphis(2),111) (icap, icap=1,nbcap(ipp))
345
 
        write(imphis(2),112) ('-', icap=1,nbcap(ipp))
346
 
        write(imphis(2),103)
347
 
 
348
 
        ! --> boucle sur les differents enregistrements et les variables
349
 
        rewind(imphis(1))
350
 
        do ii = 1, nbpdte
351
 
          do ipp2 = 2, nvppmx
352
 
            if(ihisvr(ipp2,1).ne.0) then
353
 
              read(imphis(1)) &
354
 
                jtcabs, xtcabs, (varcap(icap),icap=1,nbcap(ipp2))
355
 
              if(ipp2.eq.ipp)                                     &
356
 
                write(imphis(2),1000)                             &
357
 
                  jtcabs, xtcabs, (varcap(icap),icap=1,nbcap(ipp))
358
 
            endif
359
 
          enddo
360
 
        enddo
361
 
 
362
 
        ! --> fermeture fichier
363
 
        close(imphis(2))
364
 
 
365
 
      endif
366
 
 
367
 
    endif
368
 
  enddo
369
 
 
370
 
endif
371
 
 
372
 
!===============================================================================
373
 
! 5. AFFICHAGES
374
 
!===============================================================================
375
 
 
376
 
#if defined(_CS_LANG_FR)
377
 
 
378
 
 100  format ('# ---------------------------------------------------')
379
 
 101  format ('#      Fichier historique en temps')
380
 
 102  format ('#      Variable    ',A16)
381
 
 103  format ('# ')
382
 
 104  format ('#      Position des capteurs (colonne)')
383
 
 105  format ('# ',I6,')',3(1X,E14.7))
384
 
 106  format ('#      Nombre d''enregistrements :',I7)
385
 
 107  format (                                                         &
386
 
'# Colonne 1       : Numero du pas de temps ',/,                       &
387
 
'#         2       : Temps physique (ou No pas de temps*dtref ',/,     &
388
 
'#                                   en pas de temps non uniforme)',/, &
389
 
'#         3 a 100 : Valeur aux capteurs')
390
 
 
391
 
#else
392
 
 
393
 
 100  format ('# ---------------------------------------------------')
394
 
 101  format ('#      Time monitoring file')
395
 
 102  format ('#      Variable    ',A16)
396
 
 103  format ('# ')
397
 
 104  format ('#      Monitoring point coordinates (column)')
398
 
 105  format ('# ',I6,')',3(1X,E14.7))
399
 
 106  format ('#      Number of records:',I7)
400
 
 107  format (                                                         &
401
 
'# Column 1        : Time step number ',/,                             &
402
 
'#        2        : Physical time (or Nb of time steps*dtref ',/,     &
403
 
'#                                  with non uniform time step)',/,    &
404
 
'#        3 to 100 : Value at monitoring points')
405
 
 
406
 
#endif
407
 
 
408
 
 110  format ('#TITLE: ', A16)
409
 
 111  format ('#COLUMN_TITLES: nt | t ', 100(' | ',I3))
410
 
 112  format ('#COLUMN_UNITS: iter s', 100(1x, A))
411
 
 1000 format ( 1(1x,i7,1x),101(1x,e14.7))
 
275
 
 
276
      if (idivdt.ne.0) then
 
277
        deallocate(momtmp)
 
278
      endif
 
279
 
 
280
      if (irangp.le.0 .and. ncap.gt.0) then
 
281
        tplnum = nptpl + ipp
 
282
        call tplwri(tplnum, tplfmt, ncap, ntcabs, ttcabs, varcap)
 
283
        !==========
 
284
      endif
 
285
    endif
 
286
  enddo
 
287
 
 
288
endif
 
289
 
 
290
!===============================================================================
 
291
! 4. Close output
 
292
!===============================================================================
 
293
 
 
294
if (modhis.eq.2) then
 
295
 
 
296
  do ipp = 2, nvppmx
 
297
    if (ihisvr(ipp,1).lt.0) then
 
298
      ncap = ncapt
 
299
    else
 
300
      ncap = ihisvr(ipp,1)
 
301
    endif
 
302
    if (irangp.le.0 .and. ncap.gt.0) then
 
303
      tplnum = nptpl + ipp
 
304
      call tplend(tplnum, tplfmt)
 
305
      !==========
 
306
    endif
 
307
  enddo
 
308
 
 
309
endif
 
310
 
 
311
!===============================================================================
 
312
! 5. End
 
313
!===============================================================================
412
314
 
413
315
return
414
316
end subroutine