calcot.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\telemac3d\calcot.f
00002 !
00089                      SUBROUTINE CALCOT
00090 !                    *****************
00091 !
00092      &(ZZ,HH)
00093 !
00094 !***********************************************************************
00095 ! TELEMAC3D   V6P1                                   21/08/2010
00096 !***********************************************************************
00097 !
00098 !
00099 !
00100 !
00101 !
00102 !
00103 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00104 !| HH             |-->| WATER DEPTH
00105 !| ZZ             |<->| ELEVATION OF MESH POINTS
00106 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00107 !
00108       USE BIEF
00109       USE DECLARATIONS_TELEMAC
00110       USE DECLARATIONS_TELEMAC3D
00111       USE INTERFACE_TELEMAC3D, EX_CALCOT => CALCOT
00112 !
00113       IMPLICIT NONE
00114       INTEGER LNG,LU
00115       COMMON/INFO/LNG,LU
00116 !
00117 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00118 !
00119       DOUBLE PRECISION, INTENT(IN)    :: HH(NPOIN2)
00120       DOUBLE PRECISION, INTENT(INOUT) :: ZZ(NPOIN2,NPLAN)
00121 !
00122 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00123 !
00124       DOUBLE PRECISION RPLS,RPLI,ZFP,ZSP,DISBOT,DISSUR
00125       DOUBLE PRECISION DISMIN_BOT,DISMIN_SUR,MIN_DZ
00126       INTEGER IPOIN,IPLAN,I1,I2,ITRAC
00127 !
00128 !***********************************************************************
00129 !
00130 !     HARDCODED
00131 !
00132       DISMIN_SUR = 0.2D0
00133       DISMIN_BOT = 0.2D0
00134       MIN_DZ     = 0.D0
00135 !
00136 !     1) IN ALL CASES: FREE SURFACE = BOTTOM+DEPTH
00137 !
00138       IF(OPTBAN.EQ.1.AND.OPT_HNEG.NE.2) THEN
00139         DO IPOIN = 1,NPOIN2
00140           ZZ(IPOIN,NPLAN) = ZZ(IPOIN,1) + MAX(HH(IPOIN),0.D0)
00141         ENDDO
00142       ELSE
00143         DO IPOIN = 1,NPOIN2
00144           ZZ(IPOIN,NPLAN) = ZZ(IPOIN,1) + HH(IPOIN)
00145         ENDDO
00146       ENDIF
00147 !
00148 !-----------------------------------------------------------------------
00149 !
00150 !     HERE IMPLEMENTATION BY USER
00151 !
00152       IF(TRANSF.EQ.0) THEN
00153 !
00154         IF(LNG.EQ.1) WRITE(LU,81)
00155         IF(LNG.EQ.2) WRITE(LU,82)
00156 81      FORMAT('CALCOT: TRANSFORMATION A PROGRAMMER PAR L''UTILISATEUR')
00157 82      FORMAT('CALCOT: TRANSFORMATION TO BE PROGRAMMED BY USER')
00158         CALL PLANTE(1)
00159         STOP
00160 !
00161 !-----------------------------------------------------------------------
00162 !
00163 !     ADAPTIVE MESH REFINEMENT (BY CHRIS CAWTHORN)
00164 !
00165       ELSEIF(TRANSF.EQ.5.AND.AT.GT.1.D-4) THEN
00166 !
00167 !       ITRAC: CHOICE OF TRACER FOR ADAPTIVE MESH
00168         ITRAC=1
00169         CALL AMR_PLAN(ZZ,TA%ADR(ITRAC)%P%R,'A',NPOIN2,NPLAN,
00170      &                MESH2D%NSEG,MESH2D%GLOSEG%I,MESH2D%GLOSEG%DIM1,
00171      &                T3_01%R,T3_02%R,T3_03%R,T3_04%R,T3_05%R,T3_06,
00172      &                T3_06%R,IT1%I,T2_01,T2_01%R,T2_02%R,MESH2D,MESH3D)
00173 !
00174 !-----------------------------------------------------------------------
00175 !
00176 !     NOW ALL OTHER CASES: SEQUENCES OF SIGMA TRANSFORMATIONS
00177 !                          AND PLANES WITH PRESCRIBED ELEVATION
00178 !
00179       ELSEIF(NPLAN.GT.2) THEN
00180 !
00181 !-----------------------------------------------------------------------
00182 !
00183 !       2) SETS THE PLANES WITH PRESCRIBED ELEVATION
00184 !
00185         DO IPLAN=2,NPLAN-1
00186           IF(TRANSF_PLANE%I(IPLAN).EQ.3) THEN
00187 !           IF NOT POSSIBLE BECAUSE OF FREE SURFACE OR BOTTOM, A SECURITY
00188 !           DISTANCE, DISMIN, IS USED. ALL PLANES THAT WOULD CROSS E.G.
00189 !           THE BOTTOM AVOID IT AT A DISTANCE DISMIN*RPLI, SEE RPLI BELOW
00190             RPLS = DBLE(NPLAN-IPLAN) / DBLE(NPLAN)
00191             RPLI = DBLE(IPLAN-    1) / DBLE(NPLAN)
00192             DO IPOIN = 1,NPOIN2
00193               ZFP = ZZ(IPOIN,1)
00194               ZSP = ZZ(IPOIN,NPLAN)
00195               DISBOT = MIN(ZSP-ZFP,DISMIN_BOT)
00196               DISSUR = MIN(ZSP-ZFP,DISMIN_SUR)
00197               ZZ(IPOIN,IPLAN)=MIN(                    ZSP-DISSUR*RPLS,
00198      &                            MAX(ZPLANE%R(IPLAN),ZFP+DISBOT*RPLI))
00199             ENDDO
00200           ENDIF
00201         ENDDO
00202 !
00203 !       3) SETS THE PLANES WITH SIGMA TRANSFORMATION
00204 !
00205         I1=2
00206         DO WHILE(I1.NE.NPLAN)
00207           IF(TRANSF_PLANE%I(I1).EQ.3) THEN
00208             I1=I1+1
00209           ELSE
00210 !           LOOKS FOR SEQUENCES OF SIGMA TRANSFORMATION PLANES
00211             I2=I1
00212             DO WHILE(TRANSF_PLANE%I(I2+1).NE.3.AND.I2+1.NE.NPLAN)
00213               I2=I2+1
00214             ENDDO
00215 !           SIGMA TRANSFORMATION FOR PLANES I1 TO I2
00216 !           BETWEEN ALREADY TREATED PLANES I1-1 AND I2+1
00217             DO IPLAN=I1,I2
00218               IF(TRANSF_PLANE%I(IPLAN).EQ.1) THEN
00219                 ZSTAR%R(IPLAN)=FLOAT(IPLAN-I1+1)/FLOAT(I2-I1+2)
00220 !             ELSE
00221 !               ZSTAR%R(IPLAN) HAS BEEN GIVEN BY USER IN CONDIM
00222               ENDIF
00223               DO IPOIN = 1,NPOIN2
00224                 ZZ(IPOIN,IPLAN) = ZZ(IPOIN,I1-1)
00225      &                          + ZSTAR%R(IPLAN)*(  ZZ(IPOIN,I2+1)
00226      &                                             -ZZ(IPOIN,I1-1) )
00227               ENDDO
00228             ENDDO
00229             I1=I2+1
00230           ENDIF
00231         ENDDO
00232 !
00233 !       4) CHECKS
00234 !
00235         IF(NPLAN.GT.2) THEN
00236           DO IPLAN=2,NPLAN-1
00237             DO IPOIN = 1,NPOIN2
00238               IF(ZZ(IPOIN,IPLAN).LT.ZZ(IPOIN,IPLAN-1)) THEN
00239                 IF(LNG.EQ.1) THEN
00240                   WRITE(LU,*) 'CALCOT : LES PLANS ',IPLAN-1,' ET ',IPLAN
00241                   WRITE(LU,*) '         SE CROISENT AU POINT ',IPOIN
00242                   WRITE(LU,*) '         COTE BASSE : ',ZZ(IPOIN,IPLAN-1)
00243                   WRITE(LU,*) '         COTE HAUTE : ',ZZ(IPOIN,IPLAN)
00244                   WRITE(LU,*) '         DIFFERENCE : ',ZZ(IPOIN,IPLAN)-
00245      &                                                 ZZ(IPOIN,IPLAN-1)
00246                   WRITE(LU,*) '         HAUTEUR    : ',HH(IPOIN)
00247                 ENDIF
00248                  IF(LNG.EQ.2) THEN
00249                   WRITE(LU,*) 'CALCOT: PLANES ',IPLAN-1,' AND ',IPLAN
00250                   WRITE(LU,*) '        INTERCROSS AT POINT ',IPOIN
00251                   WRITE(LU,*) '        LOWER POINT : ',ZZ(IPOIN,IPLAN-1)
00252                   WRITE(LU,*) '        HIGHER POINT: ',ZZ(IPOIN,IPLAN)
00253                   WRITE(LU,*) '        DIFFERENCE  : ',ZZ(IPOIN,IPLAN)-
00254      &                                                 ZZ(IPOIN,IPLAN-1)
00255                   WRITE(LU,*) '        DEPTH       : ',HH(IPOIN)
00256                 ENDIF
00257                 CALL PLANTE(1)
00258                 STOP
00259               ENDIF
00260             ENDDO
00261           ENDDO
00262         ENDIF
00263 !
00264 !       5) A POINT THAT IS TOO CLOSE TO THE LOWER ONE ON A VERTICAL
00265 !          IS PUT ON THE LOWER, I.E. A MINIMUM HEIGHT IS PRESCRIBED
00266 !          IN ELEMENTS, OTHERS ARE FRANKLY SMASHED. THIS IS NOT DONE
00267 !          FOR FREE SURFACE.
00268 !
00269         IF(NPLAN.GT.2.AND.MIN_DZ.GT.0.D0) THEN
00270           DO IPLAN=2,NPLAN-1
00271             DO IPOIN = 1,NPOIN2
00272               IF(ZZ(IPOIN,IPLAN).LT.ZZ(IPOIN,IPLAN-1)+MIN_DZ) THEN
00273                 ZZ(IPOIN,IPLAN)=ZZ(IPOIN,IPLAN-1)
00274               ENDIF
00275             ENDDO
00276           ENDDO
00277         ENDIF
00278 !
00279 !-----------------------------------------------------------------------
00280 !
00281       ENDIF
00282 !
00283 !-----------------------------------------------------------------------
00284 !
00285       RETURN
00286       END

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