← Back to branch summary

~airpollution/fluidity/fluidity_airpollution

« back to all changes in this revision

Viewing changes to libadaptivity/adapt3d/src/qlyout.F

  • Committer: ziyouzhj
  • Date: 2013-12-09 16:51:29 UTC
  • Revision ID: ziyouzhj@gmail.com-20131209165129-ucoetc3u0atyy05c
airpolution

Show diffs side-by-side

added added

removed removed

Lines of Context:
libadaptivity/adapt3d/src/qlyout.F
 
1
C Copyright (C) 2006 Imperial College London and others.
 
2
C 
 
3
C Please see the AUTHORS file in the main source directory for a full list
 
4
C of copyright holders.
 
5
C 
 
6
C Adrian Umpleby
 
7
C Applied Modelling and Computation Group
 
8
C Department of Earth Science and Engineering
 
9
C Imperial College London
 
10
C 
 
11
C adrian@Imperial.ac.uk
 
12
C 
 
13
C This library is free software; you can redistribute it and/or
 
14
C modify it under the terms of the GNU Lesser General Public
 
15
C License as published by the Free Software Foundation; either
 
16
C version 2.1 of the License.
 
17
C 
 
18
C This library is distributed in the hope that it will be useful,
 
19
C but WITHOUT ANY WARRANTY; without even the implied warranty of
 
20
C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 
21
C Lesser General Public License for more details.
 
22
C 
 
23
C You should have received a copy of the GNU Lesser General Public
 
24
C License along with this library; if not, write to the Free Software
 
25
C Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307
 
26
C USA
 
27
      SUBROUTINE QLYOUT( BIGLST, NODLST, MSHNAM, LENFIL, COUNT )
 
28
C-----------------------------------------------------------------------
 
29
C
 
30
C
 
31
C
 
32
C-----------------------------------------------------------------------
 
33
      IMPLICIT NONE
 
34
C
 
35
      INTEGER LENFIL, COUNT
 
36
C
 
37
      CHARACTER*120 MSHNAM
 
38
C
 
39
      INCLUDE 'blknew.i'
 
40
C
 
41
      INCLUDE 'blkbig.i'
 
42
C
 
43
      INTEGER I, J, K, IBAS, QLYFL1, QLYFL2, QLYFL3
 
44
C
 
45
      LOGICAL DMPQLY, RSPNSE
 
46
C
 
47
      CHARACTER CNTCHR*3, NUMLST*10
 
48
C
 
49
      QLYFL1 = 19
 
50
      QLYFL2 = 20
 
51
      QLYFL3 = 21
 
52
C
 
53
      NUMLST = '0123456789'
 
54
C
 
55
      IBAS = COUNT
 
56
      I = MOD(IBAS,10)
 
57
      IBAS = ( IBAS - I )/10
 
58
      J = MOD(IBAS,10)
 
59
      IBAS = ( IBAS - J )/10
 
60
      K = MOD(IBAS,10)
 
61
      IBAS = ( IBAS - K )/10
 
62
      I = I + 1
 
63
      J = J + 1
 
64
      K = K + 1
 
65
      CNTCHR = NUMLST(K:K)//NUMLST(J:J)//NUMLST(I:I)
 
66
C
 
67
      DMPQLY = RSPNSE( 'Do you want to dump the histograms?' ,35 )
 
68
C
 
69
      IF( DMPQLY ) THEN
 
70
C
 
71
         MSHNAM = MSHNAM(1:LENFIL)//'.'//CNTCHR//'.hsted'
 
72
         OPEN( UNIT = QLYFL1, FILE = MSHNAM(1:LENFIL+10),
 
73
     :         STATUS = 'UNKNOWN', FORM = 'FORMATTED' )
 
74
C
 
75
         MSHNAM = MSHNAM(1:LENFIL)//'.'//CNTCHR//'.hstel'
 
76
         OPEN( UNIT = QLYFL2, FILE = MSHNAM(1:LENFIL+10),
 
77
     :         STATUS = 'UNKNOWN', FORM = 'FORMATTED' )
 
78
C
 
79
         MSHNAM = MSHNAM(1:LENFIL)//'.'//CNTCHR//'.hstfn'
 
80
         OPEN( UNIT = QLYFL3, FILE = MSHNAM(1:LENFIL+10),
 
81
     :         STATUS = 'UNKNOWN', FORM = 'FORMATTED' )
 
82
C
 
83
         CALL SHWHST( BIGLST, NODLST, QLYFL1, QLYFL2, QLYFL3 )
 
84
C
 
85
         CLOSE( QLYFL1 )
 
86
         CLOSE( QLYFL2 )
 
87
         CLOSE( QLYFL3 )
 
88
C
 
89
         PRINT*,'EDGE SIZES WRITTEN TO FILE ',
 
90
     :          MSHNAM(1:LENFIL+8),'ed'
 
91
C
 
92
         PRINT*,'IN-SPHERE RADII WRITTEN TO FILE ',
 
93
     :          MSHNAM(1:LENFIL+8),'el'
 
94
C
 
95
         PRINT*,'ELEMENT FUNCTIONALS WRITTEN TO FILE ',
 
96
     :          MSHNAM(1:LENFIL+8),'fn'
 
97
C
 
98
      END IF
 
99
C
 
100
      MSHNAM = MSHNAM(1:LENFIL)
 
101
C
 
102
      RETURN
 
103
      END
 
104
C