← Back to branch summary

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

« back to all changes in this revision

Viewing changes to src/base/cs_post_f2c.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/cs_post_f2c.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
25
 
 
26
 
!-------------------------------------------------------------------------------
27
 
 
28
 
subroutine pstcwr &
29
 
!=================
30
 
 
31
 
 ( numgep , nomcas , nomrep , nomfmt , optfmt ,                   &
32
 
   indmod , ntchr )
33
 
 
34
 
!===============================================================================
35
 
! FONCTION :
36
 
! --------
37
 
 
38
 
! CREATION D'UN "WRITER" A PARTIR DES DONNEES FOURNIES PAR LA
39
 
! COUCHE FORTRAN : ENCAPSULATION COUCHE C POUR LA TRANSMISSION
40
 
! DES LONGUEURS DES CHAINES DE CARACTERES
41
 
 
42
 
! UN WRITER CORRESPOND AU CHOIX D'UN NOM DE CAS, DE REPERTOIRE,
43
 
! ET DE FORMAT, AINSI QU'UN INDICATEUR PRECISANT SI LES MAILLAGES
44
 
! ASSOCIES DOIVENT DEPENDRE OU NON DU TEMPS, ET LA FREQUENCE
45
 
! DE SORTIE PAR DEFAUT POUR LES VARIABLES ASSOCIEES
46
 
 
47
 
!-------------------------------------------------------------------------------
48
 
! Arguments
49
 
!__________________.____._____.________________________________________________.
50
 
! name             !type!mode ! role                                           !
51
 
!__________________!____!_____!________________________________________________!
52
 
! numgep           ! e  ! <-- ! identificateur du gestionnaire                 !
53
 
!                  !    !     ! (< 0 pour gestionnaire reserve,                !
54
 
!                  !    !     !  > 0 pour gestionnaire utilisateur)            !
55
 
! nomcas           ! a  ! <-- ! nom du cas associe                             !
56
 
! nomrep           ! a  ! <-- ! nom du repertoire associe                      !
57
 
! nomfmt           ! a  ! <-- ! nom de format associe                          !
58
 
! optfmt           ! e  ! <-- ! options associees au format                    !
59
 
! indmod           ! e  ! <-- ! 0 : maillages figes                            !
60
 
!                  !    !     ! 1 : maillages deformables                      !
61
 
!                  !    !     ! 2 : maillages modifiables                      !
62
 
! ntchr            ! e  ! <-- ! frequence de sortie par defaut                 !
63
 
!__________________!____!_____!________________________________________________!
64
 
 
65
 
!     TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU)
66
 
!            L (LOGIQUE)   .. ET TYPES COMPOSES (EX : TR TABLEAU REEL)
67
 
!     MODE : <-- donnee, --> resultat, <-> Donnee modifiee
68
 
!            --- tableau de travail
69
 
!===============================================================================
70
 
 
71
 
implicit none
72
 
 
73
 
!===============================================================================
74
 
 
75
 
!===============================================================================
76
 
! Common blocks
77
 
!===============================================================================
78
 
 
79
 
!===============================================================================
80
 
 
81
 
! Arguments
82
 
 
83
 
character*32     nomcas , nomfmt
84
 
character*96     nomrep , optfmt
85
 
integer          numgep , indmod , ntchr
86
 
 
87
 
! Local variables
88
 
 
89
 
integer          lnmcas , lnmrep , lnmfmt , lopfmt
90
 
 
91
 
!===============================================================================
92
 
 
93
 
lnmcas = len(nomcas)
94
 
lnmrep = len(nomrep)
95
 
lnmfmt = len(nomfmt)
96
 
lopfmt = len(optfmt)
97
 
 
98
 
call pstcw1 (numgep, nomcas, nomrep, nomfmt, optfmt,              &
99
 
!==========
100
 
             lnmcas, lnmrep, lnmfmt, lopfmt,                      &
101
 
             indmod, ntchr)
102
 
 
103
 
return
104
 
 
105
 
end subroutine
106
 
subroutine pstcma &
107
 
!=================
108
 
 
109
 
 ( nummai , nommai ,                                              &
110
 
   nbrcel , nbrfac , nbrfbr , lstcel , lstfac , lstfbr )
111
 
 
112
 
!===============================================================================
113
 
! FONCTION :
114
 
! --------
115
 
 
116
 
! CREATION D'UN MAILLAGE DE POST TRAITEMENT A PARTIR DES DONNEES
117
 
! FOURNIES PAR LA COUCHE FORTRAN : ENCAPSULATION COUCHE C
118
 
! POUR LA TRANSMISSION DES LONGUEURS DES CHAINES DE CARACTERES
119
 
 
120
 
! LES LISTES DE CELLULES OU FACES A EXTRAIRE SONT TRIEES EN SORTIE,
121
 
! QU'ELLES LE SOIENT DEJA EN ENTREE OU NON.
122
 
 
123
 
! LA LISTE DES CELLULES ASSOCIEES N'EST NECESSAIRE QUE SI LE NOMBRE
124
 
! DE CELLULES A EXTRAIRE EST STRICTEMENT SUPERIEUR A 0 ET INFERIEUR
125
 
! AU NOMBRE DE CELLULES DU MAILLAGE.
126
 
 
127
 
! LES LISTES DE FACES NE SONT PRISES EN COMPTE QUE SI LE NOMBRE DE
128
 
! CELLULES A EXTRAIRE EST NUL ; SI LE NOMBRE DE FACES DE BORD A
129
 
! EXTRAIRE EST EGAL AU NOMBRE DE FACES DE BORD DU MAILLAGE GLOBAL,
130
 
! ET LE NOMBRE DE FACES INTERNES A EXTRAIRE EST NUL, ALORS ON
131
 
! EXTRAIT PAR DEFAUT LE MAILLAGE DE BORD, ET LA LISTE DES FACES DE
132
 
! BORD ASSOCIEES N'EST DONC PAS NECESSAIRE.
133
 
 
134
 
!-------------------------------------------------------------------------------
135
 
! Arguments
136
 
!__________________.____._____.________________________________________________.
137
 
! name             !type!mode ! role                                           !
138
 
!__________________!____!_____!________________________________________________!
139
 
! nummai           ! e  ! <-- ! identificateur du maillage                     !
140
 
!                  !    !     ! (< 0 pour maillage reserve,   ,                !
141
 
!                  !    !     !  > 0 pour maillage utilisateur)                !
142
 
! nommai           ! a  ! <-- ! nom du maillage associe                        !
143
 
! nbrcel           ! e  ! <-- ! nombre de cellules associees                   !
144
 
! nbrfac           ! e  ! <-- ! nombre de faces internes associees             !
145
 
! nbrfbr           ! e  ! <-- ! nombre de faces de bord associees              !
146
 
! lstcel           ! e  ! <-- ! liste des cellules associees                   !
147
 
!                  ! e  !     ! (inutile si nbrcel >= ncel)                    !
148
 
! lstfac           ! e  ! <-- ! liste des faces internes associees             !
149
 
! lstfbr           ! e  ! <-- ! liste des faces de bord associees              !
150
 
!                  ! e  !     ! (inutile si    nbrfbr = nfabor                 !
151
 
!                  ! e  !     !             et nbrfac = 0     )                !
152
 
!__________________!____!_____!________________________________________________!
153
 
 
154
 
!     TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU)
155
 
!            L (LOGIQUE)   .. ET TYPES COMPOSES (EX : TR TABLEAU REEL)
156
 
!     MODE : <-- donnee, --> resultat, <-> Donnee modifiee
157
 
!            --- tableau de travail
158
 
!===============================================================================
159
 
 
160
 
implicit none
161
 
 
162
 
!===============================================================================
163
 
 
164
 
!===============================================================================
165
 
! Common blocks
166
 
!===============================================================================
167
 
 
168
 
!===============================================================================
169
 
 
170
 
! Arguments
171
 
 
172
 
character*32     nommai
173
 
integer          nummai, nbrcel, nbrfac, nbrfbr
174
 
 
175
 
integer          lstcel(nbrcel), lstfac(nbrfac), lstfbr(nbrfbr)
176
 
 
177
 
! Local variables
178
 
 
179
 
integer          lnmmai
180
 
 
181
 
!===============================================================================
182
 
 
183
 
lnmmai = len(nommai)
184
 
 
185
 
call pstcm1 (nummai, nommai, lnmmai,                              &
186
 
!==========
187
 
             nbrcel, nbrfac, nbrfbr, lstcel, lstfac, lstfbr)
188
 
 
189
 
return
190
 
 
191
 
end subroutine
 
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.
 
20
 
 
21
!-------------------------------------------------------------------------------
 
22
 
192
23
subroutine psteva &
193
24
!================
194
25
 
196
27
   varcel , varfac , varfbo )
197
28
 
198
29
!===============================================================================
199
 
! FONCTION :
 
30
! Purpose:
200
31
! --------
201
32
 
202
 
! ECRITURE D'UN CHAMP DE POST TRAITEMENT ASSOCIE AUX CELLULES
203
 
! OU FACES D'UN MAILLAGE A PARTIR DES DONNEES FOURNIES PAR LA
204
 
! COUCHE FORTRAN :
205
 
! ENCAPSULATION COUCHE C POUR LA TRANSMISSION DES LONGUEURS DES
206
 
! CHAINES DE CARACTERES
 
33
! Write a cell of face located field based on data provided by the
 
34
! Fortran layer: encapsulation so as to provide character string lengths.
207
35
 
208
36
!-------------------------------------------------------------------------------
209
37
! Arguments
227
55
! varfbo(*)        ! r  ! <-- ! valeurs aux faces de bord associees            !
228
56
!__________________!____!_____!________________________________________________!
229
57
 
230
 
!     TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU)
231
 
!            L (LOGIQUE)   .. ET TYPES COMPOSES (EX : TR TABLEAU REEL)
232
 
!     MODE : <-- donnee, --> resultat, <-> Donnee modifiee
233
 
!            --- tableau de travail
 
58
!     Type: i (integer), r (real), s (string), a (array), l (logical),
 
59
!           and composite types (ex: ra real array)
 
60
!     mode: <-- input, --> output, <-> modifies data, --- work array
 
61
!===============================================================================
 
62
 
 
63
!===============================================================================
 
64
! Module files
 
65
!===============================================================================
 
66
 
234
67
!===============================================================================
235
68
 
236
69
implicit none
237
70
 
238
 
!===============================================================================
239
 
 
240
 
!===============================================================================
241
 
! Common blocks
242
 
!===============================================================================
243
 
 
244
 
!===============================================================================
245
 
 
246
71
! Arguments
247
72
 
248
73
character*32     nomvar
264
89
return
265
90
 
266
91
end subroutine
 
92
 
267
93
subroutine pstsnv &
268
94
!================
269
95
 
270
96
 ( nomvar , nomva2 , nomva3 )
271
97
 
272
98
!===============================================================================
273
 
! FONCTION :
 
99
! Purpose:
274
100
! --------
275
101
 
276
 
! SUPPRESSION DU CARACTERE X, x, OU 1 D'UNE CHAINE DE CARACTERES
277
 
! FORTRAN SI LES CHAINES COMPAREES SONT IDENTIQUES AU DERNIER
278
 
! CARACTERE PRES, RESPECTIVEMENT Y, y, OU 2 ET Z, z, OU 3
 
102
! Remove character X, x, or 1 from a Fortran character string if the
 
103
! compared strings are identical except for the last character, respectively
 
104
! Y, y, or 2 and Z, z, or 3.
279
105
 
280
106
!-------------------------------------------------------------------------------
281
107
! Arguments
282
108
!__________________.____._____.________________________________________________.
283
109
! name             !type!mode ! role                                           !
284
110
!__________________!____!_____!________________________________________________!
285
 
! nomvar           ! e  ! <-- ! nom de la variable associee                    !
286
 
! nomva2           ! e  ! <-- ! nom de la variable 2 associee                  !
287
 
! nomva3           ! e  ! <-- ! nom de la variable 3 associee                  !
 
111
! nomvar           ! s  ! <-- ! name of the first associated variable          !
 
112
! nomva2           ! s  ! <-- ! name of the second associated variable         !
 
113
! nomva3           ! s  ! <-- ! name of the third associated variable          !
288
114
!__________________!____!_____!________________________________________________!
289
115
 
290
 
!     TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU)
291
 
!            L (LOGIQUE)   .. ET TYPES COMPOSES (EX : TR TABLEAU REEL)
292
 
!     MODE : <-- donnee, --> resultat, <-> Donnee modifiee
293
 
!            --- tableau de travail
 
116
!     Type: i (integer), r (real), s (string), a (array), l (logical),
 
117
!           and composite types (ex: ra real array)
 
118
!     mode: <-- input, --> output, <-> modifies data, --- work array
 
119
!===============================================================================
 
120
 
 
121
!===============================================================================
 
122
! Module files
 
123
!===============================================================================
 
124
 
294
125
!===============================================================================
295
126
 
296
127
implicit none
297
128
 
298
 
!===============================================================================
299
 
 
300
 
!===============================================================================
301
 
! Common blocks
302
 
!===============================================================================
303
 
 
304
 
!===============================================================================
305
 
 
306
129
! Arguments
307
130
 
308
131
character*32     nomvar, nomva2, nomva3
321
144
if ((lnmvar .eq. lnmva2) .and. (lnmvar .eq. lnmva3)) then
322
145
 
323
146
  do 10 ii = lnmvar, 1, -1
324
 
    IF (     NOMVAR(II:II) .NE. ' '                               &
325
 
        .OR. NOMVA2(II:II) .NE. ' '                               &
326
 
        .OR. NOMVA3(II:II) .NE. ' ') THEN
 
147
    if (     nomvar(ii:ii) .ne. ' '                               &
 
148
        .or. nomva2(ii:ii) .ne. ' '                               &
 
149
        .or. nomva3(ii:ii) .ne. ' ') then
327
150
      goto 20
328
151
    endif
329
152
 10     continue
334
157
 
335
158
    jj = ii
336
159
 
337
 
!         On prevoit le cas ou c'est l'avant-dernier caractere
338
 
!         qui change, comme avec VitesX1, VitesX2, ... en
339
 
!         cas de calcul avec plusieurs phases
 
160
    ! Handle the case where the next-to-last character changes, such
 
161
    ! as with VelocityX1, VelocityX2, ... in case of a calculation
 
162
    ! with multiple phases.
340
163
 
341
164
    if (      (ii .gt. 2)                                         &
342
165
        .and. (nomvar(ii:ii) .eq. nomva2(ii:ii))                  &
344
167
      ii = jj-1
345
168
    endif
346
169
 
347
 
!         On supprime le caractere lie a la dimension
 
170
    ! Remove the character related to the spatial axis
348
171
 
349
 
    IF (      NOMVAR(II:II) .EQ. 'X'                              &
350
 
        .AND. NOMVA2(II:II) .EQ. 'Y'                              &
351
 
        .AND. NOMVA3(II:II) .EQ. 'Z') THEN
352
 
      NOMVAR(II:II) = ' '
353
 
    ELSE IF (      NOMVAR(II:II) .EQ. 'x'                         &
354
 
             .AND. NOMVA2(II:II) .EQ. 'y'                         &
355
 
             .AND. NOMVA3(II:II) .EQ. 'z') THEN
356
 
      NOMVAR(II:II) = ' '
357
 
    ELSE IF (      NOMVAR(II:II) .EQ. '1'                         &
358
 
             .AND. NOMVA2(II:II) .EQ. '2'                         &
359
 
             .AND. NOMVA3(II:II) .EQ. '3') THEN
360
 
      NOMVAR(II:II) = ' '
 
172
    if (      nomvar(ii:ii) .eq. 'X'                              &
 
173
        .and. nomva2(ii:ii) .eq. 'Y'                              &
 
174
        .and. nomva3(ii:ii) .eq. 'Z') then
 
175
      nomvar(ii:ii) = ' '
 
176
    else if (      nomvar(ii:ii) .eq. 'x'                         &
 
177
             .and. nomva2(ii:ii) .eq. 'y'                         &
 
178
             .and. nomva3(ii:ii) .eq. 'z') then
 
179
      nomvar(ii:ii) = ' '
 
180
    else if (      nomvar(ii:ii) .eq. 'U'                         &
 
181
             .and. nomva2(ii:ii) .eq. 'V'                         &
 
182
             .and. nomva3(ii:ii) .eq. 'W') then
 
183
      nomvar(ii:ii) = ' '
 
184
    else if (      nomvar(ii:ii) .eq. 'u'                         &
 
185
             .and. nomva2(ii:ii) .eq. 'v'                         &
 
186
             .and. nomva3(ii:ii) .eq. 'w') then
 
187
      nomvar(ii:ii) = ' '
 
188
    else if (      nomvar(ii:ii) .eq. '1'                         &
 
189
             .and. nomva2(ii:ii) .eq. '2'                         &
 
190
             .and. nomva3(ii:ii) .eq. '3') then
 
191
      nomvar(ii:ii) = ' '
361
192
    endif
362
193
 
363
 
!         Si l'on a supprime l'avant-dernier caractere, on
364
 
!         decale le dernier caractere
 
194
    ! If the next-to last character was removed, the last one must be shifted.
365
195
 
366
196
    if (ii .eq. jj+1) then
367
197
      nomvar(ii:ii) = nomvar(jj:jj)
368
 
      NOMVAR(JJ:JJ) = ' '
 
198
      nomvar(jj:jj) = ' '
369
199
    endif
370
200
 
371
201
  endif