correction_depth_3d.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\telemac3d\correction_depth_3d.f
00002 !
00106                      SUBROUTINE CORRECTION_DEPTH_3D
00107 !                    ******************************
00108 !
00109      &(W2D,W3D,GLOSEG,DIMGLO)
00110 !
00111 !***********************************************************************
00112 ! TELEMAC3D   V6P2                                   21/08/2010
00113 !***********************************************************************
00114 !
00115 !
00116 !
00117 !
00118 !
00119 !
00120 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00121 !| DIMGLO         |-->| FIRST DIMENSION OF GLOSEG
00122 !| GLOSEG         |-->| FIRST AND SECOND POINT OF SEGMENTS
00123 !| W2D            |<->| WORK ARRAY IN 2D
00124 !| W3D            |<->| WORK ARRAY IN 3D
00125 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00126 !
00127       USE BIEF
00128       USE INTERFACE_TELEMAC3D,
00129      &                     EX_CORRECTION_DEPTH_3D => CORRECTION_DEPTH_3D
00130       USE DECLARATIONS_TELEMAC
00131       USE DECLARATIONS_TELEMAC3D
00132 !
00133       IMPLICIT NONE
00134       INTEGER LNG,LU
00135       COMMON/INFO/LNG,LU
00136       INTEGER IOPT, ISEG, ISEG3D
00137 !
00138 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00139 !
00140       INTEGER, INTENT(IN)             :: DIMGLO
00141       INTEGER, INTENT(IN)             :: GLOSEG(DIMGLO,2)
00142       DOUBLE PRECISION, INTENT(INOUT) :: W2D(NELEM2,3),W3D(NELEM3,6)
00143 !
00144 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00145 !
00146       CHARACTER(LEN=16) :: FORMUL
00147       INTEGER I
00148       DOUBLE PRECISION, POINTER, DIMENSION(:) :: SAVEZ
00149 !
00150 !-----------------------------------------------------------------------
00151 !
00152       IF(OPTBAN.EQ.1) THEN
00153 !
00154         IF(OPT_HNEG.EQ.2) THEN
00155 !
00156 !         FOR THE TIME BEING, FLODEL IS A WORKING ARRAY, HENCE
00157 !         YAFLODEL=.FALSE.; TO USE FLODEL IN TEL4DEL WOULD REQUIRE
00158 !         TRANSFORMING IT INTO 3D.
00159 !
00160           FORMUL = 'VGRADP 2     HOR'
00161           SAVEZ     =>MESH3D%Z%R
00162           MESH3D%Z%R=>ZPROP%R
00163 !
00164 !         HERE T3_01 IS NOT REALLY USED, WE USE THE NON ASSEMBLED
00165 !         FORM MESH3D%W, WHICH IS HERE ALSO W3D, HENCE LEGO=.FALSE.
00166 !
00167           CALL VECTOR(T3_01,'=',FORMUL,IELM3,-1.D0,DM1,GRAZCO,GRAZCO,
00168      &                UCONV,VCONV,VCONV,MESH3D,MSK,MASKEL,LEGO=.FALSE.)
00169 !
00170           MESH3D%Z%R=>SAVEZ
00171 !
00172 !         CALCULATES 3D FLODEL (NOTE JMH: THIS WILL BE REDONE IN FLUX3D
00173 !                                         OPTIMISATION MAYBE POSSIBLE  )
00174           IOPT=2
00175           CALL FLUX_EF_VF_3D(FLODEL%R,MESH2D%W%R,MESH3D%W%R,
00176      &                       MESH2D%NSEG,MESH3D%NSEG,MESH2D%NELEM,
00177      &                       MESH3D%NELEM,MESH2D,.TRUE.,IOPT,1,
00178      &                       IELM3,NPLAN,MESH3D%IKLE%I,MESH3D%NELMAX,
00179      &                       MESH3D%KNOLG%I)
00180 !
00181 !         CALCULATES 2D FLODEL (PUT IN FIRST PLANE OF 3D FLODEL)
00182 !
00183 !         IT IS DIFFERENT FROM THE METHOD CONSISTING OF SUMMING THE
00184 !         FLUXES ON THE VERTICAL FIRST AND THEN CALLING FLUX_EF_VF
00185 !
00186           IF(IELM3.EQ.41) THEN
00187 !
00188             DO ISEG = 1,MESH2D%NSEG
00189               DO I = 2,NPLAN
00190                 ISEG3D = ISEG + (I-1)*MESH2D%NSEG
00191                 FLODEL%R(ISEG) = FLODEL%R(ISEG) + FLODEL%R(ISEG3D)
00192               ENDDO
00193             ENDDO
00194 !
00195           ELSEIF(IELM3.EQ.51) THEN
00196 !
00197 !           NOTHING TO DO, THIS WAS DONE IN FLUX_EF_VF_3D
00198 !
00199           ELSE
00200            WRITE(LU,*) 'CORRECTION_DEPTH_3D: UNKNOWN ELEMENT:',IELM3
00201            CALL PLANTE(1)
00202            STOP
00203           ENDIF
00204 !
00205           CALL POSITIVE_DEPTHS(T2_01,T2_02,T2_03,T2_04,H,HN,
00206      &                         MESH2D,FLODEL,.FALSE.,
00207      &                         FLBOR,DT,UNSV2D,NPOIN2,
00208      &                         GLOSEG(1:DIMGLO,1),
00209      &                         GLOSEG(1:DIMGLO,2),
00210      &                         MESH2D%NBOR%I,NPTFR2,
00211      &                         SMH,.TRUE.,2,
00212 !                                   YASMH OPTSOU
00213 !                              SMH IN PROJECTED FORM IN T3D
00214      &                         FLULIM%R,LIHBOR%I,HBOR%R,KENT,INFOGR,
00215      &                         MESH2D%W%R,NAMECODE,2,MAXADV)
00216 !                                                  2 HARDCODED OPTION
00217 !                                                  FOR POSITIVE DEPTH ALGORITHM
00218 !                                                  INDEPENDENT OF SEGMENT
00219 !                                                  NUMBERING
00220 !
00221         ELSEIF(OPT_HNEG.EQ.1) THEN
00222 !
00223 !         CONSERVATIVE SMOOTHING OF NEGATIVE DEPTHS
00224 !
00225 !         1) PUTS NEGATIVE VALUES IN T2_01 AND REMOVES THEM FROM H
00226 !
00227           CALL OS( 'X=-(Y,C)' , X=T2_01 , Y=H     , C=0.D0 )
00228           CALL OS( 'X=X-Y   ' , X=H     , Y=T2_01 )
00229 !
00230 !         2) SMOOTHES NEGATIVE VALUES (TWO LOOPS HERE)
00231 !            AND MASKS TO NOT AFFECT THE TIDAL FLATS
00232 !
00233           IF(OPTBAN.EQ.1) THEN
00234             CALL FILTER(T2_01,.TRUE.,T2_02,T2_03,
00235      &                  MAT2D%ADR(1)%P,'MATMAS          ',
00236      &                  1.D0,SVIDE,SVIDE,SVIDE,SVIDE,SVIDE,SVIDE,
00237      &                  MESH2D,MSK,MASKEL,2)
00238           ENDIF
00239 !
00240 !         3) PUTS BACK IN H THE SMOOTHED NEGATIVE VALUES
00241 !
00242           CALL OS( 'X=X+Y   ' , X=H , Y=T2_01 )
00243 !
00244         ENDIF
00245 !
00246       ENDIF
00247 !
00248 ! CLIPS H AND COMPUTES Z
00249 !
00250       IF(OPTBAN.EQ.2) THEN
00251         CALL CLIP(H,HMIN,.TRUE., 1.D6, .FALSE., 0)
00252       ENDIF
00253 !
00254 !-----------------------------------------------------------------------
00255 !
00256       RETURN
00257       END

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