fsgrad.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\telemac3d\fsgrad.f
00002 !
00080                      SUBROUTINE FSGRAD
00081 !                    *****************
00082 !
00083      &(GRADZS,ZFLATS,Z,ZF,IELM2H,MESH2D,MSK,MASKEL,UNSV2D,T2_01,
00084      & NPOIN2,OPTBAN,S)
00085 !
00086 !***********************************************************************
00087 ! TELEMAC3D   V7P0                                   31/07/2014
00088 !***********************************************************************
00089 !
00090 !
00091 !
00092 !
00093 !
00094 !
00095 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00096 !| GRADZS         |<->| FREE SURFACE GRADIENT (BLOCK OF 2 COMPONENTS)
00097 !| IELM2H         |-->| TYPE OF ELEMENT
00098 !| MASKEL         |-->| ARRAY OF MASKS, PER ELEMENT
00099 !| MESH2D         |<->| 2D MESH
00100 !| MSK            |-->| IF YES, THERE IS MASKING, MASKEL IS TO BE USED
00101 !| NPOIN2         |-->| NUMBER OF POINTS IN 2D
00102 !| OPTBAN         |-->| OPTION FOR TIDAL FLATS, IF 1, FREE SURFACE
00103 !|                |   | MODIFIED AND PIECE-WISE LINEAR
00104 !| S              |-->| EMPTY BIEF_OBJ STRUCTURE
00105 !| T2_01          |<->| BIEF_OBJ STRUCTURE FOR LOCAL WORK
00106 !| UNSV2D         |-->| INVERSE OF INTEGRAL OF BASES
00107 !| Z              |-->| LAST PLANE OF THE Z COORDINATES OF THE 3D MESH
00108 !|                |   | (SEE CALLS TO FSGRAD), SO THE FREE SURFACE.
00109 !| ZF             |-->| BOTTOM ELEVATION
00110 !| ZFLATS         |<->| PIECE-WISE LINEAR FREE SURFACE
00111 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00112 !
00113       USE BIEF
00114       USE DECLARATIONS_TELEMAC3D, ONLY : ATMOS,RHO0,GRAV,HN,TE3,T2_02,
00115      &                                   PATMOS,NELEM2,SVIDE
00116 !
00117       IMPLICIT NONE
00118       INTEGER LNG,LU
00119       COMMON/INFO/LNG,LU
00120 !
00121 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00122 !
00123       INTEGER, INTENT(IN)                  :: IELM2H,NPOIN2,OPTBAN
00124       DOUBLE PRECISION, TARGET, INTENT(IN) :: Z(NPOIN2)
00125       LOGICAL, INTENT(IN)                  :: MSK
00126       TYPE(BIEF_OBJ), INTENT(INOUT)        :: GRADZS,ZFLATS,T2_01
00127       TYPE(BIEF_OBJ), INTENT(IN)           :: ZF,UNSV2D,S,MASKEL
00128       TYPE(BIEF_MESH), INTENT(INOUT)       :: MESH2D
00129 !
00130 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00131 !
00132       DOUBLE PRECISION, POINTER, DIMENSION(:) :: SAVE_T2_01
00133       DOUBLE PRECISION C
00134       LOGICAL MSKGRA
00135       INTEGER I,IELEM,I1,I2,I3,IAD1,IAD2,IAD3
00136 !
00137 !-----------------------------------------------------------------------
00138 !
00139       IF(OPTBAN.EQ.1) THEN
00140 !
00141 !       COMPUTES THE FREE SURFACE GRADIENT AS IN TELEMAC-2D
00142 !
00143         CALL CRSL11(ZFLATS%R,Z,
00144      &              ZF%R,MESH2D%IKLE%I,MESH2D%NELEM,MESH2D%NELMAX)
00145         CALL VECTOR(GRADZS%ADR(1)%P,'=','GRADF          X',IELM2H,
00146      &              1.D0,ZFLATS,S,S,S,S,S,MESH2D,MSK,MASKEL)
00147         CALL VECTOR(GRADZS%ADR(2)%P,'=','GRADF          Y',IELM2H,
00148      &              1.D0,ZFLATS,S,S,S,S,S,MESH2D,MSK,MASKEL)
00149 !
00150       ELSE
00151 !
00152         SAVE_T2_01=>T2_01%R
00153         T2_01%R   =>Z
00154 !
00155         CALL CPSTVC(ZF,T2_01)
00156 !       THIS COPY IS REPLACED WITH T2_01%R POINTING TO Z
00157 !       CALL OV('X=Y     ',T2_01%R,Z,T2_01%R,0.D0,NPOIN2)
00158         CALL VECTOR(GRADZS%ADR(1)%P,'=','GRADF          X',IELM2H,
00159      &              1.D0,T2_01,S,S,S,S,S,MESH2D,MSK,MASKEL)
00160         CALL VECTOR(GRADZS%ADR(2)%P,'=','GRADF          Y',IELM2H,
00161      &              1.D0,T2_01,S,S,S,S,S,MESH2D,MSK,MASKEL)
00162 !
00163         T2_01%R=>SAVE_T2_01
00164 !
00165       ENDIF
00166 !
00167 !     ADDING THE ATMOSPHERIC PRESSURE GRADIENT
00168 !
00169       IF(ATMOS) THEN
00170         C=1.D0/(RHO0*GRAV)
00171 !       PRESSURE GRADIENTS WILL BE LOCALLY MASKED
00172         IF(MSK.OR.OPTBAN.EQ.1) THEN
00173           MSKGRA = .TRUE.
00174           IF(OPTBAN.EQ.1) THEN
00175             CALL OV('X=Y+Z   ',T2_01%R,HN%R,ZF%R,0.D0,NPOIN2)
00176             CALL DECVRT(TE3,T2_01,ZF,MESH2D)
00177           ENDIF
00178           IF(OPTBAN.EQ.1.AND.MSK) THEN
00179             CALL OV('X=XY    ',TE3%R,MASKEL%R,MASKEL%R,0.D0,NELEM2)
00180           ENDIF
00181           IF(MSK.AND.OPTBAN.NE.1) THEN
00182             CALL OV('X=Y     ',TE3%R,MASKEL%R,MASKEL%R,C,TE3%DIM1)
00183           ENDIF
00184         ELSE
00185           MSKGRA = .FALSE.
00186         ENDIF
00187 !
00188 !       ATMOSPHERIC PRESSURE GRADIENT ADDED TO GRADZS
00189 !
00190         CALL VECTOR(T2_01,'=','GRADF          X',IELM2H,
00191      &              C,PATMOS,SVIDE,SVIDE,SVIDE,SVIDE,SVIDE,
00192      &              MESH2D,MSKGRA,TE3)
00193         CALL VECTOR(T2_02,'=','GRADF          Y',IELM2H,
00194      &              C,PATMOS,SVIDE,SVIDE,SVIDE,SVIDE,SVIDE,
00195      &              MESH2D,MSKGRA,TE3)
00196         DO I=1,NPOIN2
00197           GRADZS%ADR(1)%P%R(I)=GRADZS%ADR(1)%P%R(I)+T2_01%R(I)
00198           GRADZS%ADR(2)%P%R(I)=GRADZS%ADR(2)%P%R(I)+T2_02%R(I)
00199         ENDDO
00200 !
00201 !       ATMOSPHERIC PRESSURE ALSO ADDED TO ZFLATS
00202 !
00203         IF(OPTBAN.EQ.1) THEN
00204           DO IELEM=1,NELEM2
00205             IF(TE3%R(IELEM).GT.0.5D0) THEN
00206               IAD1=IELEM
00207               IAD2=IAD1+NELEM2
00208               IAD3=IAD2+NELEM2
00209               I1=MESH2D%IKLE%I(IAD1)
00210               I2=MESH2D%IKLE%I(IAD2)
00211               I3=MESH2D%IKLE%I(IAD3)
00212               ZFLATS%R(IAD1)=ZFLATS%R(IAD1)+C*PATMOS%R(I1)
00213               ZFLATS%R(IAD2)=ZFLATS%R(IAD2)+C*PATMOS%R(I2)
00214               ZFLATS%R(IAD3)=ZFLATS%R(IAD3)+C*PATMOS%R(I3)
00215             ENDIF
00216           ENDDO
00217         ENDIF
00218 !
00219       ENDIF
00220 !
00221       IF(NCSIZE.GT.1) THEN
00222         CALL PARCOM(GRADZS%ADR(1)%P,2,MESH2D)
00223         CALL PARCOM(GRADZS%ADR(2)%P,2,MESH2D)
00224       ENDIF
00225 !
00226 !     DIVISION BY INTEGRAL OF 2D BASES
00227 !
00228       CALL OS('X=XY    ',X=GRADZS%ADR(1)%P,Y=UNSV2D)
00229       CALL OS('X=XY    ',X=GRADZS%ADR(2)%P,Y=UNSV2D)
00230 !
00231 !-----------------------------------------------------------------------
00232 !
00233       RETURN
00234       END

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