V3FIT
boundary_T.f
1 !*******************************************************************************
2 ! File boundary_T.f
3 ! Contains module boundary_T
4 ! Defines derived-types: boundary_desc
5 ! A type of Geometric - Boundary signal
6 !
7 !*******************************************************************************
8 ! MODULE ip_T
9 ! (ip Type Definition, for the V3FIT code)
10 ! SECTION I. VARIABLE DECLARATIONS
11 ! SECTION II. DERIVED-TYPE DECLARATIONS
12 ! SECTION III. INTERFACE BLOCKS
13 ! SECTION IV. CONSTRUCTION SUBROUTINES
14 ! SECTION V. DESTRUCTION SUBROUTINES
15 ! SECTION VI. ASSIGNMENT SUBROUTINES
16 ! SECTION VII. OUTPUT SUBROUTINES
17 ! SECTION VIII. PRIVATE ROUTINES USED IN ip_T
18 !
19 ! SECTION XVI. COMMENTS FOR DIFFERENT REVISIONS
20 !*******************************************************************************
21  MODULE boundary_t
22  USE safe_open_mod
23 
24 !*******************************************************************************
25 ! SECTION I. VARIABLE DECLARATIONS
26 !*******************************************************************************
27 
28  IMPLICIT NONE
29 
30 !*******************************************************************************
31 ! SECTION II. DERIVED-TYPE DECLARATIONS
32 ! boundary Description:
33 ! boundary_desc
34 ! Type of geometric specified by % d_type = 'boundary'.
35 !
36 !*******************************************************************************
37 !-------------------------------------------------------------------------------
38 !-------------------------------------------------------------------------------
39 ! Declare type boundary_desc
40 ! n_index - Toroidal coefficient index.
41 ! m_index - Poloidal coefficient index.
42 ! coefficient - Coefficient name. This should be either rbc or zbs for
43 ! symmetric cases or rbs or zbc for asymmetric cases.
44 !-------------------------------------------------------------------------------
46  INTEGER :: n_index
47  INTEGER :: m_index
48  CHARACTER(LEN=3) :: coefficientName
49  END TYPE
50 
51 !*******************************************************************************
52 ! SECTION III. INTERFACE BLOCKS
53 !*******************************************************************************
54 
55  CONTAINS
56 !*******************************************************************************
57 ! SECTION IV. CONSTRUCTION SUBROUTINES
58 !*******************************************************************************
59 !-------------------------------------------------------------------------------
60 ! Construct a boundary_desc
61 !
62 ! For d_type = 'boundary' (boundary signal)
63 !-------------------------------------------------------------------------------
64  SUBROUTINE boundary_desc_construct(this, coefficientName, &
65  & n_index, m_index)
66 
67  IMPLICIT NONE
68 
69 !-------------------------------------------------------------------------------
70 ! Argument Declarations
71 !-------------------------------------------------------------------------------
72  TYPE (boundary_desc), INTENT(inout) :: this
73  INTEGER, INTENT(in) :: n_index
74  INTEGER, INTENT(in) :: m_index
75  CHARACTER(LEN=3), INTENT(in) :: coefficientName
76 
77 !-------------------------------------------------------------------------------
78 ! Start of executable code
79 !-------------------------------------------------------------------------------
80  this % n_index = n_index
81  this % m_index = m_index
82  this % coefficientName = coefficientname
83 
84  END SUBROUTINE boundary_desc_construct
85 
86 !*******************************************************************************
87 ! SECTION V. DESTRUCTION SUBROUTINES
88 !*******************************************************************************
89 !-------------------------------------------------------------------------------
90 ! Destroy an boundary_desc
91 !
92 ! ARGUMENT
93 ! this - an boundary_desc
94 !-------------------------------------------------------------------------------
95  SUBROUTINE boundary_desc_destroy(this)
96 
97  TYPE (boundary_desc),INTENT(inout) :: this
98 
99  this % n_index = 0
100  this % m_index = 0
101  this % coefficientName = ' '
102 
103  END SUBROUTINE boundary_desc_destroy
104 
105 !*******************************************************************************
106 ! SECTION VI. ASSIGNMENT SUBROUTINES
107 !
108 ! These are not needed because the intrinsic assignments work
109 !*******************************************************************************
110 
111 !*******************************************************************************
112 ! SECTION VII. OUTPUT SUBROUTINES
113 !*******************************************************************************
114 !-------------------------------------------------------------------------------
115 ! Write out the contents of a boundary_desc
116 ! if iou and filaname are present - write to file
117 ! if iou and filename are not present - write to stdout (screen)
118 !
119 ! THIS NEEDS MODIFYING TO BE ABLE TO APPEND RECORDS AND NOT OVERWRITE FILES
120 !-------------------------------------------------------------------------------
121 
122  SUBROUTINE boundary_desc_write(this,iounit,filename)
123  IMPLICIT NONE
124 !-------------------------------------------------------------------------------
125 ! Arguments
126 ! this - boundary
127 ! iou - output io unit number
128 ! filename - output file name
129 !-------------------------------------------------------------------------------
130 
131  TYPE (boundary_desc),INTENT(in) :: this
132  INTEGER, OPTIONAL,INTENT(in) :: iounit
133  CHARACTER*300,OPTIONAL,INTENT(in) :: filename
134 !-------------------------------------------------------------------------------
135 ! Local Variables
136 ! iou - iounit to use
137 ! istat - status of file opening
138 !-------------------------------------------------------------------------------
139  INTEGER :: iou = 6
140  INTEGER :: istat = 0 !status of safe_open call
141 
142  IF (PRESENT(iounit).AND.PRESENT(filename)) THEN
143  iou=iounit
144  CALL safe_open(iou,istat,filename,'replace','formatted')
145  WRITE(iou,*) 'n_index - ', this % n_index
146  WRITE(iou,*) 'm_index - ', this % m_index
147  WRITE(iou,*) 'coefficientName - ', this % coefficientName
148  ELSE
149  WRITE(*,*) 'n_index - ', this % n_index
150  WRITE(*,*) 'm_index - ', this % m_index
151  WRITE(*,*) 'coefficientName - ', this % coefficientName
152  END IF
153 
154  END SUBROUTINE boundary_desc_write
155 !*******************************************************************************
156 ! SECTION XVI. COMMENTS FOR DIFFERENT REVISIONS
157 !*******************************************************************************
158 
159  END MODULE boundary_t
boundary_t::boundary_desc
Definition: boundary_T.f:45