summaryrefslogtreecommitdiff
path: root/Dragon/src/CLMGET.f
blob: 237400e3d5a4a394588d540b5434e35c67f85531 (plain)
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
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
*DECK CLMGET
      SUBROUTINE CLMGET(IPRINT,NBMIX,NBISO,ISONRF,ISOMIX,
     >                  NCLM  ,IDCLM,IACT ,DENRD )
*
*-----------------------------------------------------------------------
*
*Purpose:
* Read CLM module options.
*
*Copyright:
* Copyright (C) 2022 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
* IPRINT  print index,
* NBMIX   maximum number of mixtures.
* NBISO   maximum number of isotopes.
* ISONRF  reference names of isotopes.
* ISOMIX  mixture associated with each isotope.
*
*Parameters: output
* NCLM    number of liquid mixtures to combine.
* IDCLM   liquid mixtures indices to combine.
* IACT    isotope identifier (IACT(1,ISO)) for mixture considered,
*         reference isotope (IACT(2,ISO)) 
*         and action on each isotope for which concentration 
*         is modified with: IACT(3,ISO)=0 no change; 
*         IACT(3,ISO)=-1 for ADDI ABS; IACT(3,ISO)=1 for ADDI REL;
*         IACT(3,ISO)=-2 for SETI ABS; IACT(3,ISO)=2 for SETI REL.
* DENRD   isotope concentration or relative concentration.
*
*Comments:
* Input data is of the form:
*    [ EDIT iprint ]
*    MIXCLM (IDCLM(ii),ii=1,NCLM) 
*    [ { ADDI | SETI } { ABS | REL } (isot(ii) dens(ii),ii=1,niso)] 
*-----------------------------------------------------------------------
*
      IMPLICIT         NONE
      INTEGER          IPRINT,NBMIX,NBISO,ISONRF(3,NBISO),ISOMIX(NBISO),
     >                 NCLM,IDCLM(NBMIX),IACT(3,NBISO)
      REAL             DENRD(NBISO)
      INTEGER          IOUT
      CHARACTER        NAMSBR*6
      PARAMETER       (IOUT=6,NAMSBR='CLMGET')
*----
*  REDGET variables
*----
      INTEGER          ITYPLU,INTLIR
      CHARACTER        CARLIR*8
      REAL             REALIR
      DOUBLE PRECISION DBLLIR
*----
*  LOCAL variables
*----
      INTEGER          IMIX,ISO,JSO,JACT,KSO,INAM(2)
*----
*  INITIALIZE MIXMER
*----
      IDCLM(:NBMIX)=0
      IACT(:3,:NBISO)=0
      DENRD(:NBISO)=0.0
*----
*  READ OPTION NAME
*----
 10   CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
 20   IF(ITYPLU.EQ.10) GO TO 100
      IF(ITYPLU.NE.3) CALL XABORT(NAMSBR//': READ ERROR - '//
     >'Character variable expacted')
      IF(CARLIR.EQ.';') GO TO 100
      IF(CARLIR.EQ.'EDIT') THEN
        CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
        IF(ITYPLU.NE.1) CALL XABORT(NAMSBR//': READ ERROR -'//
     >  'Integer variable expacted')
        IPRINT=INTLIR
      ELSE IF(CARLIR.EQ.'MIXCLM') THEN
        NCLM=0
        DO IMIX=1,NBMIX
          CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
          IF(ITYPLU.NE.1) THEN
            DO ISO=1,NBISO
              WRITE(IOUT,'(2A4,2(5X,I10))') ISONRF(1,ISO),ISONRF(2,ISO),
     >        IACT(1,ISO),IACT(2,ISO)
            ENDDO
            GO TO 20
          ENDIF
          NCLM=NCLM+1
          IF(INTLIR .LE. 0 .OR. INTLIR .GT. NBMIX) CALL XABORT(NAMSBR//
     >    ': READ ERROR - Mixture < 0 or > NBMIX')
          IDCLM(NCLM)=INTLIR
*----
*  Associate isotopes mixture number to first mixture to process
*---- 
          IF(NCLM.EQ.1) THEN
            DO ISO=1,NBISO
              IF(ISOMIX(ISO).EQ.INTLIR) THEN
                IACT(1,ISO)=NCLM
              ENDIF
            ENDDO
          ELSE
*----
*  Test additional mixture number for coherent isotopic contents
*---- 
            DO ISO=1,NBISO
              IF(ISOMIX(ISO).EQ.INTLIR) THEN
                DO JSO=1,NBISO
                  IF(IACT(1,JSO).EQ.1) THEN
                    IF(ISONRF(1,ISO).EQ.ISONRF(1,JSO) .AND.
     >                 ISONRF(2,ISO).EQ.ISONRF(2,JSO)) THEN
                      IACT(1,ISO)=NCLM
                      IACT(2,ISO)=JSO
                      GO TO 110
                    ENDIF
                  ENDIF
                ENDDO
                CALL XABORT(NAMSBR//
     >          ': Mixtures do not have the same isotopic contents')
 110            CONTINUE
              ENDIF
            ENDDO
          ENDIF
        ENDDO
      ELSE IF(CARLIR.EQ.'ADDI' .OR. CARLIR.EQ.'SETI') THEN
        JACT=1
        IF(CARLIR.EQ.'SETI') JACT=2
        CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
        IF(ITYPLU.EQ.3) THEN
          IF(CARLIR.EQ.'ABS') THEN
            JACT=-JACT
          ELSE IF (CARLIR.NE.'REL') THEN
            CALL XABORT(NAMSBR//
     >    ': READ ERROR - Invalid ADDI or SETI option.'//
     >    ' Only REL or ABS valid')
          ENDIF
        ELSE
          CALL XABORT(NAMSBR//
     >    ': READ ERROR - No ADDI or SETI option provided')
        ENDIF
*----
*  Read all isotopes for SETI and ADDI.
*----
        DO ISO=1,NBISO
          KSO=0
          CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
          IF(ITYPLU.EQ.3) THEN
*----
* Test if valid isotopes associated to MIXCLM
*---- 
            READ(CARLIR,'(2A4)') INAM(1),INAM(2)
            DO JSO=1,NBISO
*----
*  Only need to check first mixture
*----
              IF(IACT(1,JSO).EQ.1) THEN
                IF(INAM(1).EQ.ISONRF(1,JSO) .AND.
     >             INAM(2).EQ.ISONRF(2,JSO)) THEN
                  IACT(3,JSO)=JACT
                  KSO=JSO
                  GO TO 120
                ENDIF
              ENDIF
            ENDDO
            GO TO 20
          ELSE
            CALL XABORT(NAMSBR//
     >    ': READ ERROR - Invalid isotope name')
          ENDIF 
 120      CONTINUE
          CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
          IF(ITYPLU.EQ.2) THEN
            DENRD(KSO)=REALIR            
          ELSE
            CALL XABORT(NAMSBR//
     >    ': READ ERROR - Invalid isotopic density (REL or ABS)')
          ENDIF 
        ENDDO
      ELSE
        CALL XABORT(NAMSBR//': READ ERROR - '//
     >  'Illegal keyword')
      ENDIF
      GO TO 10
 100  CONTINUE
*----
*  RETURN
*----
*----
*  Print if required
*----
      DO ISO=1,NBISO
        WRITE(IOUT,'(2A4,3(5X,I5),1P,E20.9)') 
     >        ISONRF(1,ISO),ISONRF(2,ISO),
     >        IACT(1,ISO),IACT(2,ISO),IACT(3,ISO),DENRD(ISO)
      ENDDO
      RETURN
      END