summaryrefslogtreecommitdiff
path: root/Donjon/src/MCCMOD.f
blob: c61c85b2452819bad4f5bc6c8a2b89d688377c6e (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
*DECK MCCMOD
      SUBROUTINE MCCMOD(IMPX,IPMAP,NPARAM,NCH,NB,REC1,VAL,MODTYPE)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Modification of the data stored in the PARAM folder of a fuel map
*
*Copyright:
* Copyright (C) 2012 Ecole Polytechnique de Montreal.
*
*Author(s): 
* M. Cordiez
*
*Parameters: input
* IMPX    printing index (=0 for no print).
* IPMAP   pointer of the fuel map
* NPARAM  number of parameters in the PARAM folder
* NCH     number of fuel channels
* NB      number of fuel bundles per channel
* REC1    record to be updated
* VAL    uniform value (real) that is to be set to REC1
* MODTYPE type of modification (0: new uniform value, 2: value added)
*
*-----------------------------------------------------------------------
*
      USE GANLIB
*----
*  SUBROUTINE ARGUMENTS
*----
      INTEGER IMPX,NPARAM,NCH,NB,MODTYPE
      REAL VAL
      CHARACTER REC1*40
      TYPE(C_PTR) IPMAP
*----
*  LOCAL VARIABLES
*----
      INTEGER VALSIZE,PTYPE
      CHARACTER PNAME*12
      REAL, ALLOCATABLE, DIMENSION(:) :: VALMOD
      TYPE(C_PTR) JPMAP,KPMAP
*----
*  RECOVERY OF L_MAP PARAMETERS
*----
      JPMAP=LCMGID(IPMAP,'PARAM')
      DO IPAR=1,NPARAM,1
        KPMAP=LCMGIL(JPMAP,IPAR)
        CALL LCMGTC(KPMAP,'P-NAME',12,PNAME)
        CALL LCMGET(KPMAP,'P-TYPE',PTYPE)
        IF(PNAME.EQ.REC1) THEN
          IF(IMPX.GE.3) CALL LCMLIB(KPMAP)
          EXIT
        ENDIF
      ENDDO

* Checking of the type (local or global) of REC1
      IF((PTYPE.NE.1).AND.(PTYPE.NE.2)) THEN
        CALL XABORT('@MCCMOD: '//PNAME//'IS NEITHER LOCAL NOR GLOBAL'
     >         //'AND THAT IS IMPOSSIBLE.') 
      ENDIF
      IF(PTYPE.EQ.1) THEN
        IF(IMPX.GE.1) WRITE(6,210) 'PARAMETER ',PNAME,' IS GLOBAL'
        VALSIZE=1
        ALLOCATE(VALMOD(VALSIZE))
      ELSE
        IF(IMPX.GE.1) WRITE(6,210) 'PARAMETER ',PNAME,' IS LOCAL'
        VALSIZE=NCH*NB
        ALLOCATE(VALMOD(VALSIZE))
      ENDIF

* Modification of REC1
      IF(MODTYPE.EQ.0) THEN
        VALMOD=VAL
      ELSE IF(MODTYPE.EQ.1) THEN
        CALL LCMGET(KPMAP,'P-VALUE',VALMOD)
        VALMOD=VALMOD+VAL
      ENDIF

      CALL LCMPUT(KPMAP,'P-VALUE',VALSIZE,2,VALMOD)

      IF((MODTYPE.EQ.0).AND.(IMPX.GT.0)) THEN
        WRITE(6,220) 'EVERY VALUE OF THE RECORD ',REC1,' HAS BEEN '
     >             //'SET TO ',VAL,'.'
      ELSE IF((MODTYPE.EQ.1).AND.(IMPX.GT.0)) THEN
        WRITE(6,220) 'EVERY VALUE OF THE RECORD ',REC1,' HAS BEEN '
     >             //'INCREASED OF ',VAL,'.'
      ENDIF

* Array deallocation
      DEALLOCATE(VALMOD)

      RETURN

  210 FORMAT(1X,A,A6,A/)
  220 FORMAT(1X,A,A6,A,F7.2,A/)
      END