cflpsi.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\cflpsi.f
00002 !
00057                      SUBROUTINE CFLPSI
00058 !                    *****************
00059 !
00060      &(SYGMA,U,V,DT,IELM,MESH,MSK,MASKEL)
00061 !
00062 !***********************************************************************
00063 ! BIEF   V7P0                                   21/08/2010
00064 !***********************************************************************
00065 !
00066 !
00067 !
00068 !
00069 !
00070 !
00071 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00072 !| DT             |-->| TIME STEP.
00073 !| IELM           |-->| TYPE OF ELEMENT.
00074 !| MASKEL         |-->| MASKING OF ELEMENTS
00075 !|                |   | =1. : NORMAL   =0. : MASKED ELEMENT
00076 !| MESH           |-->| MESH STRUCTURE
00077 !| MSK            |-->| IF YES, THERE IS MASKED ELEMENTS.
00078 !| SYGMA          |<--| COURANT NUMBER.
00079 !| U              |-->| VELOCITY ALONG X.
00080 !| V              |-->| VELOCITY ALONG Y.
00081 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00082 !
00083       USE BIEF, EX_CFLPSI => CFLPSI
00084 !
00085       IMPLICIT NONE
00086       INTEGER LNG,LU
00087       COMMON/INFO/LNG,LU
00088 !
00089 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00090 !
00091       TYPE(BIEF_OBJ)  , INTENT(INOUT) :: SYGMA
00092       TYPE(BIEF_OBJ)  , INTENT(IN)    :: U,V,MASKEL
00093       DOUBLE PRECISION, INTENT(IN)    :: DT
00094       INTEGER         , INTENT(IN)    :: IELM
00095       TYPE(BIEF_MESH) , INTENT(INOUT) :: MESH
00096       LOGICAL         , INTENT(IN)    :: MSK
00097 !
00098 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00099 !
00100 !     MASS OF THE BASES IN BIEF WORKING ARRAY
00101 !
00102       CALL VECTOR(MESH%T,'=','MASBAS          ',
00103      &            IELM,1.D0,U,U,U,U,U,U,MESH,MSK,MASKEL)
00104 !
00105       IF(NCSIZE.GT.1) CALL PARCOM(MESH%T,2,MESH)
00106 !
00107       CALL CPSTVC(MESH%T,SYGMA)
00108 !
00109 !-----------------------------------------------------------------------
00110 !
00111 !     P1 TRIANGLES
00112 !
00113       IF(IELM.EQ.11) THEN
00114 !
00115         CALL CFLP11(U%R,V%R,MESH%XEL%R,MESH%YEL%R,
00116      &              MESH%IKLE%I,MESH%NELEM,MESH%NELMAX,MESH%W%R)
00117 !
00118 !-----------------------------------------------------------------------
00119 !
00120 !     QUASI-BUBBLE TRIANGLES
00121 !
00122       ELSEIF(IELM.EQ.12) THEN
00123 !
00124         CALL CFLP12(U%R,V%R,MESH%XEL%R,MESH%YEL%R,
00125      &              MESH%IKLE%I,MESH%NELEM,MESH%NELMAX,MESH%W%R)
00126 !
00127 !-----------------------------------------------------------------------
00128 !
00129       ELSE
00130 !
00131         IF(LNG.EQ.1) WRITE(LU,100) IELM
00132         IF(LNG.EQ.2) WRITE(LU,101) IELM
00133 100     FORMAT(1X,'CFLPSI : IELM = ',1I6,'  CAS NON PREVU.')
00134 101     FORMAT(1X,'CFLPSI: IELM = ',1I6,' CASE NOT IMPLEMENTED.')
00135         CALL PLANTE(1)
00136         STOP
00137 !
00138       ENDIF
00139 !
00140 ! ASSEMBLES THE LIJ
00141 !
00142       CALL ASSVEC(SYGMA%R,MESH%IKLE%I,BIEF_NBPTS(IELM,MESH),
00143      &            MESH%NELEM,MESH%NELMAX,IELM,
00144      &            MESH%W%R,.TRUE.,MESH%LV,MSK,MASKEL%R,
00145      &            BIEF_NBPEL(IELM,MESH))
00146       IF(NCSIZE.GT.1) CALL PARCOM(SYGMA,2,MESH)
00147 !
00148 !-----------------------------------------------------------------------
00149 !
00150 ! FINAL RESULT, DIVIDES BY THE MASS OF THE BASES
00151 !
00152       CALL OS( 'X=CY/Z  ' , SYGMA , SYGMA , MESH%T , DT ,2,0.D0,1.D-6)
00153 !
00154 !-----------------------------------------------------------------------
00155 !
00156       RETURN
00157       END

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