chgdis.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\chgdis.f
00002 !
00064                      SUBROUTINE CHGDIS
00065 !                    *****************
00066 !
00067      &(X,OLDELT,NEWELT,MESH)
00068 !
00069 !***********************************************************************
00070 ! BIEF   V6P1                                   16/03/2011
00071 !***********************************************************************
00072 !
00073 !
00074 !
00075 !
00076 !
00077 !
00078 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00079 !| MESH           |-->| MESH STRUCTURE
00080 !| NEWELT         |-->| NEW TYPE FOR X
00081 !| OLDELT         |-->| OLD TYPE OF X
00082 !| X              |<--| VECTOR TO BE MODIFIED
00083 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00084 !
00085       USE BIEF, EX_CHGDIS => CHGDIS
00086 !
00087       IMPLICIT NONE
00088       INTEGER LNG,LU
00089       COMMON/INFO/LNG,LU
00090 !
00091 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00092 !
00093       TYPE(BIEF_OBJ), INTENT(INOUT) :: X
00094       INTEGER, INTENT(IN)           :: NEWELT
00095       INTEGER, INTENT(INOUT)        :: OLDELT
00096       TYPE(BIEF_MESH), INTENT(IN)   :: MESH
00097 !
00098 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00099 !
00100       INTEGER NEWDIM1
00101 !
00102 !-----------------------------------------------------------------------
00103 !
00104       NEWDIM1 = BIEF_NBPTS(NEWELT,MESH)
00105 !
00106       IF(NEWDIM1.GT.X%MAXDIM1) THEN
00107         IF(LNG.EQ.1) WRITE(LU,200) X%NAME
00108         IF(LNG.EQ.2) WRITE(LU,201) X%NAME
00109 200     FORMAT(1X,'CHGDIS (BIEF) : EXTENSION IMPOSSIBLE POUR ',A6)
00110 201     FORMAT(1X,'CHGDIS (BIEF) : EXTENSION IMPOSSIBLE FOR ',A6)
00111         CALL PLANTE(1)
00112         STOP
00113       ENDIF
00114 !
00115 !-----------------------------------------------------------------------
00116 !
00117       IF(OLDELT.EQ.11.AND.NEWELT.EQ.12) THEN
00118 !
00119         CALL CG1112(X%R,NEWDIM1,X%DIM2,
00120      &              MESH%IKLE%I,MESH%NELEM,MESH%NELMAX)
00121 !
00122       ELSEIF(OLDELT.EQ.11.AND.NEWELT.EQ.13) THEN
00123 !
00124         CALL CG1113(X%R,NEWDIM1,X%DIM2,
00125      &              MESH%IKLE%I,MESH%NELEM,MESH%NELMAX)
00126 !
00127       ELSEIF((OLDELT.EQ.12.OR.OLDELT.EQ.13).AND.NEWELT.EQ.11) THEN
00128 !
00129 !       DOES NOTHING (QUASI-BUBBLE OR QUADRATIC VALUES JUST LOST)
00130 !
00131       ELSE
00132 !
00133         IF(LNG.EQ.1) WRITE(LU,10) OLDELT,NEWELT
00134         IF(LNG.EQ.2) WRITE(LU,11) OLDELT,NEWELT
00135 10      FORMAT(1X,'CHGDIS : CAS NON PREVU :'    ,I6,' ',I6)
00136 11      FORMAT(1X,'CHGDIS: CASE NOT IMPLEMENTED:',I6,' ',I6)
00137         WRITE(LU,*) 'STRUCTURE X = ',X%NAME
00138         CALL PLANTE(1)
00139         STOP
00140 !
00141       ENDIF
00142 !
00143       X%DIM1 = NEWDIM1
00144 !     THIS MAY BE A HIDDEN MODIFICATION OF OLDELT, IF X%ELM IS SENT AS
00145 !     OLDELT, HENCE THE INTENT(INOUT) FOR OLDELT.
00146       X%ELM  = NEWELT
00147 !
00148 !-----------------------------------------------------------------------
00149 !
00150       RETURN
00151       END

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