cpstvc.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\cpstvc.f
00002 !
00064                      SUBROUTINE CPSTVC
00065 !                    *****************
00066 !
00067      &( X , Y )
00068 !
00069 !***********************************************************************
00070 ! BIEF   V6P3                                   21/08/2010
00071 !***********************************************************************
00072 !
00073 !
00074 !
00075 !
00076 !
00077 !
00078 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00079 !| X              |-->| STRUCTURE TO BE COPIED
00080 !| Y              |<--| STRUCTURE THAT RECEIVES X ATTRIBUTES
00081 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00082 !
00083       USE BIEF, EX_CPSTVC => CPSTVC
00084 !
00085       IMPLICIT NONE
00086       INTEGER LNG,LU
00087       COMMON/INFO/LNG,LU
00088 !
00089 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00090 !
00091       TYPE(BIEF_OBJ), INTENT(IN)    :: X
00092       TYPE(BIEF_OBJ), INTENT(INOUT) :: Y
00093 !
00094 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00095 !
00096       INTEGER SIZEX,SIZEY
00097 !
00098 !-----------------------------------------------------------------------
00099 !  TREATS ONLY VECTORS HERE :
00100 !-----------------------------------------------------------------------
00101 !
00102       IF(Y%TYPE.NE.2.OR.X%TYPE.NE.2) THEN
00103         IF(LNG.EQ.1) WRITE(LU,200) X%NAME,X%TYPE,Y%NAME,Y%TYPE
00104         IF(LNG.EQ.2) WRITE(LU,201) X%NAME,X%TYPE,Y%NAME,Y%TYPE
00105  200    FORMAT(1X,'CPSTVC : CAS NON PREVU POUR X ET Y :',/,1X,
00106      &            'X=',A6,' TYPE :',1I6                 ,/,1X,
00107      &            'Y=',A6,' TYPE :',1I6)
00108  201    FORMAT(1X,'CPSTVC : FORBIDDEN CASE FOR X AND Y:',/,1X,
00109      &            'X=',A6,' TYPE :',1I6                 ,/,1X,
00110      &            'Y=',A6,' TYPE :',1I6)
00111         CALL PLANTE(1)
00112         STOP
00113       ENDIF
00114 !
00115       SIZEX = X%DIM1*X%DIM2
00116       SIZEY = Y%MAXDIM1*Y%MAXDIM2
00117 !
00118       IF(SIZEX.GT.SIZEY) THEN
00119         IF(LNG.EQ.1) WRITE(LU,300) X%NAME,SIZEX,Y%NAME,SIZEY
00120         IF(LNG.EQ.2) WRITE(LU,301) X%NAME,SIZEX,Y%NAME,SIZEY
00121  300    FORMAT(1X,'CPSTVC : CAS NON PREVU POUR X ET Y:',/,1X,
00122      &            'X=',A6,' TAILLE         :',1I8,/,1X,
00123      &            'Y=',A6,' TAILLE MAXIMUM :',1I8)
00124  301    FORMAT(1X,'CPSTVC : FORBIDDEN CASE FOR X AND Y:',/,1X,
00125      &            'X=',A6,' SIZE        :',1I8,/,1X,
00126      &            'Y=',A6,' MAXIMUM SIZE:',1I8)
00127         CALL PLANTE(1)
00128         STOP
00129       ENDIF
00130 !
00131 !     DISCRETISATION
00132       IF(Y%ELM.NE.X%ELM.AND.Y%STATUS.EQ.1) THEN
00133         IF(LNG.EQ.1) WRITE(LU,400) X%NAME,Y%NAME
00134         IF(LNG.EQ.2) WRITE(LU,401) X%NAME,Y%NAME
00135 400     FORMAT(1X,'CPSTVC : COPIE DE ',A6,' INTERDITE SUR ',A6)
00136 401     FORMAT(1X,'CPSTVC : COPY OF ',A6,' FORBIDDEN ON ',A6)
00137         CALL PLANTE(1)
00138         STOP
00139       ELSE
00140         Y%ELM = X%ELM
00141       ENDIF
00142 !     FIRST VECTOR DIMENSION
00143       Y%DIM1 = X%DIM1
00144 !     SECOND VECTOR DIMENSION
00145       Y%DIM2 = X%DIM2
00146 !     CASE OF DISCONTINUOUS VECTORS
00147       Y%DIMDISC = X%DIMDISC
00148 !
00149 !     A VECTOR WITH PREVIOUS STATUS 0 NOW DEFINED ON A MESH
00150 !     IT IS DECLARED AS STATUS 2 (DISCRETISATION THAT CAN BE CHANGED)
00151 !
00152       IF(Y%STATUS.EQ.0.AND.(X%STATUS.EQ.1.OR.X%STATUS.EQ.2)) THEN
00153         Y%STATUS=2
00154       ENDIF
00155 !
00156 !-----------------------------------------------------------------------
00157 !
00158       RETURN
00159       END

Generated on Fri Aug 31 2013 18:12:58 by S.E.Bourban (HRW) using doxygen 1.7.0