The TELEMAC-MASCARET system  trunk
cpstvc.f
Go to the documentation of this file.
1 ! *****************
2  SUBROUTINE cpstvc
3 ! *****************
4 !
5  &( x , y )
6 !
7 !***********************************************************************
8 ! BIEF V7P1
9 !***********************************************************************
10 !
11 !brief COPIES A VECTOR STRUCTURE ONTO ANOTHER.
12 !
13 !history J-M HERVOUET (LNH)
14 !+ 01/03/1995
15 !+ V5P1
16 !+ First version.
17 !
18 !history N.DURAND (HRW), S.E.BOURBAN (HRW)
19 !+ 13/07/2010
20 !+ V6P0
21 !+ Translation of French comments within the FORTRAN sources into
22 !+ English comments
23 !
24 !history N.DURAND (HRW), S.E.BOURBAN (HRW)
25 !+ 21/08/2010
26 !+ V6P0
27 !+ Creation of DOXYGEN tags for automated documentation and
28 !+ cross-referencing of the FORTRAN sources
29 !
30 !history J-M HERVOUET (LNHE)
31 !+ 22/05/2013
32 !+ V6P3
33 !+ STATUS now also considered.
34 !
35 !history J-M HERVOUET (EDF LAB, LNHE)
36 !+ 26/06/2015
37 !+ V7P1
38 !+ More accurate messages.
39 !
40 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
41 !| X |-->| STRUCTURE TO BE COPIED
42 !| Y |<--| STRUCTURE THAT RECEIVES X ATTRIBUTES
43 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
44 !
45  USE bief, ex_cpstvc => cpstvc
46 !
48  IMPLICIT NONE
49 !
50 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
51 !
52  TYPE(bief_obj), INTENT(IN) :: X
53  TYPE(bief_obj), INTENT(INOUT) :: Y
54 !
55 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
56 !
57  INTEGER SIZEX,SIZEY
58 !
59 !-----------------------------------------------------------------------
60 ! TREATS ONLY VECTORS HERE :
61 !-----------------------------------------------------------------------
62 !
63  IF(y%TYPE.NE.2.OR.x%TYPE.NE.2) THEN
64  WRITE(lu,201) x%NAME,x%TYPE,y%NAME,y%TYPE
65  201 FORMAT(1x,'CPSTVC : FORBIDDEN CASE FOR X AND Y:',/,1x,
66  & 'X=',a6,' TYPE :',1i6 ,/,1x,
67  & 'Y=',a6,' TYPE :',1i6)
68  CALL plante(1)
69  stop
70  ENDIF
71 !
72  sizex = x%DIM1*x%DIM2
73  sizey = y%MAXDIM1*y%MAXDIM2
74 !
75  IF(sizex.GT.sizey) THEN
76  WRITE(lu,301) x%NAME,sizex,y%NAME,sizey
77  301 FORMAT(1x,'CPSTVC : FORBIDDEN CASE FOR X AND Y:',/,1x,
78  & 'X=',a6,' SIZE :',1i8,/,1x,
79  & 'Y=',a6,' MAXIMUM SIZE:',1i8)
80  CALL plante(1)
81  stop
82  ENDIF
83 !
84 ! DISCRETISATION
85  IF(y%ELM.NE.x%ELM.AND.y%STATUS.EQ.1) THEN
86  WRITE(lu,401) x%NAME,y%NAME
87 401 FORMAT(1x,'CPSTVC : COPY OF ',a6,' FORBIDDEN ON ',a6,
88  & ' BECAUSE ITS STATUS IS 1')
89  CALL plante(1)
90  stop
91  ELSE
92  y%ELM = x%ELM
93  ENDIF
94 ! FIRST VECTOR DIMENSION
95  y%DIM1 = x%DIM1
96 ! SECOND VECTOR DIMENSION
97  y%DIM2 = x%DIM2
98 ! CASE OF DISCONTINUOUS VECTORS
99  y%DIMDISC = x%DIMDISC
100 !
101 ! A VECTOR WITH PREVIOUS STATUS 0 NOW DEFINED ON A MESH
102 ! IT IS DECLARED AS STATUS 2 (DISCRETISATION THAT CAN BE CHANGED)
103 !
104  IF(y%STATUS.EQ.0.AND.(x%STATUS.EQ.1.OR.x%STATUS.EQ.2)) THEN
105  y%STATUS=2
106  ENDIF
107 !
108 !-----------------------------------------------------------------------
109 !
110  RETURN
111  END
112 
subroutine cpstvc(X, Y)
Definition: cpstvc.f:7
Definition: bief.f:3