1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
|
*DECK FMTGET
SUBROUTINE FMTGET(IPRINT,NOPT,IOPT)
*
*-----------------------------------------------------------------------
*
*Purpose:
* To read formatting command for the FMT module.
*
*Copyright:
* Copyright (C) 2009 Ecole Polytechnique de Montreal
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
* License as published by the Free Software Foundation; either
* version 2.1 of the License, or (at your option) any later version
*
*Author(s):
* G. Marleau
*
*Parameters: input/output
* IPRINT print level.
* NOPT number of options.
* IOPT processing option.
*
*Comments:
* Input data is of the form:
* [ EDIT iprint ]
* {
* SUS3D { SN | CP } |
* DIRFLX
* BURNUP
* }
*
*----------
*
USE GANLIB
IMPLICIT NONE
*----
* Subroutine arguments
*----
INTEGER IPRINT,NOPT,IOPT(NOPT)
*----
* Local parameters
*----
INTEGER IOUT
CHARACTER NAMSBR*6
PARAMETER (IOUT=6,NAMSBR='FMTGET')
*----
* Variables for input via REDGET
*----
INTEGER ITYPLU,INTLIR
CHARACTER CARLIR*12
REAL REALIR
DOUBLE PRECISION DBLLIR
*----
* Initialize default values for IPRINT
*----
IPRINT=1
*----
* Get data from input file
*----
100 CONTINUE
CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
110 CONTINUE
IF(ITYPLU .EQ. 10) GO TO 105
IF(ITYPLU .NE. 3) CALL XABORT(NAMSBR//
>': Read error -- Character variable expected.')
IF(CARLIR .EQ. ';') THEN
GO TO 105
ELSE IF(CARLIR .EQ. 'EDIT') THEN
CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
IF(ITYPLU .NE. 1) CALL XABORT(NAMSBR//
> ': Read error -- print level expected after EDIT.')
IPRINT=INTLIR
ELSE IF(CARLIR .EQ. 'SUS3D') THEN
IF(IOPT(1) .NE. 0) CALL XABORT(NAMSBR//
> ': Only one formatting option permitted.')
IOPT(1)=1
CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
IF(ITYPLU .NE. 3) CALL XABORT(NAMSBR//
> ': Read error -- Character variable for SUS3D option.')
IOPT(2)=0
IF(CARLIR .EQ. 'CP') THEN
IOPT(2)=1
ELSE IF(CARLIR .EQ. 'SN') THEN
IOPT(2)=0
ELSE
GO TO 110
ENDIF
ELSE IF(CARLIR .EQ. 'DIRFLX') THEN
IF(IOPT(1) .NE. 0) CALL XABORT(NAMSBR//
> ': Only one formatting option permitted.')
IOPT(1)=2
ELSE IF(CARLIR .EQ. 'BURNUP') THEN
IF(IOPT(1) .NE. 0) CALL XABORT(NAMSBR//
> ': Only one formatting option permitted.')
IOPT(1)=3
CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
IF(ITYPLU .NE. 3) CALL XABORT(NAMSBR//
> ': Read error -- Character variable for BURNUP option.')
IOPT(2)=1
IF(CARLIR .EQ. 'PYTHON') THEN
IOPT(2)=2
ELSE IF(CARLIR .EQ. 'MATLAB') THEN
IOPT(2)=1
ELSE IF(CARLIR .EQ. 'ISOP') THEN
IOPT(2)=-IOPT(2)
GO TO 105
ELSE
GO TO 110
ENDIF
ELSE IF(CARLIR .EQ. 'ISOP') THEN
IF(IOPT(1) .NE. 3) CALL XABORT(NAMSBR//
> ': BURNUP option not specified.')
IOPT(2)=-IOPT(2)
GO TO 105
ELSE
CALL XABORT(NAMSBR//': Keyword '//CARLIR//' is invalid.')
ENDIF
GO TO 100
105 CONTINUE
*----
* Processing finished, return
*----
RETURN
END
|
