propag_adj.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\telemac2d\propag_adj.f
00002 !
00087                      SUBROUTINE PROPAG_ADJ
00088 !                    *********************
00089 !
00090      &(UCONV,VCONV,CONVV,H0,PATMOS,ATMOS,
00091      & HPROP,UN,VN,HN,UTILD,VTILD,HTILD,DH,DU,DV,DHN,VISC,VISC_S,FU,FV,
00092      & SMH,MESH,ZF,AM1,AM2,AM3,BM1,BM2,CM1,CM2,TM1,A23,A32,MBOR,
00093      & CV1,CV2,CV3,W1,UBOR,VBOR,AUBOR,HBOR,DIRBOR,
00094      & TE1,TE2,TE3,TE4,TE5,T1,T2,T3,T4,T5,T6,T7,T8,T9,T10,T11,
00095      & LIMPRO,MASK,GRAV,ROEAU,CF,DIFVIT,IORDRH,IORDRU,LT,AT,DT,
00096      & TETAH,TETAHC,TETAU,TETAD,
00097      & AGGLOC,AGGLOU,KDIR,INFOGR,KFROT,ICONVF,
00098      & PRIVE,ISOUSI,BILMAS,MASSES,YASMH,OPTBAN,CORCON,
00099      & OPTSUP,MSK,MASKEL,MASKPT,RO,ROVAR,
00100      & MAT,RHS,UNK,TB,S,BD,PRECCU,SOLSYS,CFLMAX,OPDVIT,OPTSOU,
00101      & NFRLIQ,SLVPRO,EQUA,VERTIC,
00102      & ADJO,UD,VD,HD,U,V,H,UU,VV,HH,UIT1,VIT1,HIT1,PP,QQ,RR,
00103      & TAM1,TAM2,TAM3,TBM1,TBM2,TCM1,
00104      & TCM2,MATADJ,UNKADJ,ALPHA1,ALPHA2,ALPHA3,ADJDIR,ESTIME,OPTCOST,
00105      & NIT,NVARRES,VARSOR,
00106      & NRES,NREF,ALIRE,TROUVE,MAXVAR,VARCL,VARCLA,
00107      & TEXTE,TEXREF,TEXRES,W,OUTINI,CHESTR,KARMAN,NDEF,
00108      & ITURB,LISRUG,LINDNER,SB,DP,SP,CHBORD,CFBOR,HFROT,UNSV2D)
00109 !
00110 !***********************************************************************
00111 ! TELEMAC2D   V6P1                                   21/08/2010
00112 !***********************************************************************
00113 !
00114 !
00115 !
00116 !
00117 !
00118 !
00119 !
00120 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00121 !| A23            |<->| MATRIX
00122 !| A32            |<->| MATRIX
00123 !| ADJDIR         |<--| DIRICHLET CONDITIONS FOR ADJOINT VARIABLES
00124 !| ADJO           |-->| IF YES : ADJOINT MODE
00125 !| AGGLOC         |-->| KEYWORD: 'MASS-LUMPING ON H'
00126 !| AGGLOU         |-->| KEYWORD: 'MASS-LUMPING ON VELOCITY'
00127 !| ALIRE          |<--| INTEGER ARRAY STATING WHICH VARIABLES MUST BE READ
00128 !| ALPHA1         |<--| WEIGHT FUNCTION FOR COMPUTING THE COST FUNCTION
00129 !| ALPHA2         |<--| WEIGHT FUNCTION FOR COMPUTING THE COST FUNCTION
00130 !| ALPHA3         |<--| WEIGHT FUNCTION FOR COMPUTING THE COST FUNCTION
00131 !| AM1            |<->| MATRIX APPLYING TO H
00132 !| AM2            |<->| MATRIX APPLYING TO U
00133 !| AM3            |<->| MATRIX APPLYING TO V
00134 !| AT             |-->| TIME IN SECONDS
00135 !| ATMOS          |-->| IF YES, ATMOSPHERIC PRESSURE IN PATMOS
00136 !| AUBOR          |<--| LAW OF FRICTION ON BOUNDARIES
00137 !|                |   | NUT*DU/DN=AUBOR*U+BUBOR
00138 !| BD             |---| ??????  NOT USED
00139 !| BILMAS         |-->| LOGICAL TRIGGERING A MASS BALANCE INFORMATION
00140 !| BM2            |<->| MATRIX
00141 !| CF             |<--| ADIMENSIONAL FRICTION COEFFICIENT
00142 !| CFBOR          |<--| ADIMENSIONAL FRICTION COEFFICIENT ON BOUNDARY
00143 !| CFLMAX         |<--| MAXIMUM CFL NUMBER (OBSERVED IN CURRENT TIME STEP)
00144 !| CHBORD         |<--| FRICTION COEFFICIENT ON BOUNDARY
00145 !| CHESTR         |-->| FRICTION COEFFICIENT ON BOTTOM
00146 !| CM1            |<->| MATRIX
00147 !| CM2            |<->| MATRIX
00148 !| CONVV          |-->| ARRAY OF LOGICAL GIVING THE VARIABLES TO BE
00149 !|                |   | ADVECTED
00150 !|                |   | CONVV(1):U,V CONVV(2):H
00151 !| CORCON         |-->| CONTINUITY CORRECTION ON POINTS WITH
00152 !|                |   | IMPOSED DEPTH (COMPATIBLE FLUX IS COMPUTED)
00153 !| CV1            |<->| RIGHT-HAND SIDE OF LINEAR SYSTEM
00154 !| CV2            |<->| RIGHT-HAND SIDE OF LINEAR SYSTEM
00155 !| CV3            |<->| RIGHT-HAND SIDE OF LINEAR SYSTEM
00156 !| DH             |<--| H(N+1)-H(N)
00157 !| DHN            |<--| H(N)-H(N-1)
00158 !| DIFVIT         |-->| IF YES, DIFFUSION OF VELOCITY
00159 !| DIRBOR         |<--| BLOCK WITH DIRICHLET BOUNDARY CONDITIONS
00160 !| DP             |-->| DIAMETER OF ROUGHNESS ELEMENT
00161 !| DT             |-->| TIME STEP
00162 !| DU             |<--| U(N+1)-U(N)
00163 !| DV             |<--| V(N+1)-V(N)
00164 !| EQUA           |-->| KEYWORD: 'EQUATIONS'
00165 !| ESTIME         |---| ???? NOT USED ()
00166 !| FU             |<->| SOURCE TERMS ON VELOCITY U
00167 !| FV             |<->| SOURCE TERMS ON VELOCITY V
00168 !| GRAV           |-->| GRAVITY
00169 !| H0             |-->| REFERENCE DEPTH
00170 !| HBOR           |<--| PRESCRIBED BOUNDARY CONDITION ON DEPTH
00171 !| HD             |---| ????? NOT USED
00172 !| HFROT          |-->| KEYWORD: 'DEPTH IN FRICTION TERMS'
00173 !| HH             |<--| ADJOINT H
00174 !| HIT1           |-->| DIRECT H AT TIME IT+1
00175 !| HN             |-->| DEPTH AT TIME T(N)
00176 !| HPROP          |-->| HAUTEUR DE PROPAGATION
00177 !| HTILD          |-->| DEPTH AFTER ADVECTION
00178 !| ICONVF         |-->| TYPE OF ADVECTION: 4 INTEGERS
00179 !|                |   | ICONVF(1) : U AND V
00180 !|                |   | ICONVF(2) : H (MANDATORY VALUE = 5)
00181 !|                |   | ICONVF(3) : TRACERS
00182 !|                |   | ICONVF(4) : K AND EPSILON
00183 !| INFOGR         |-->| IF YES, INFORMATION ON GRADIENT
00184 !| IORDRH         |-->| ORDER OF INITIAL GUESS OF H
00185 !| IORDRU         |-->| ORDER OF INITIAL GUESS OF U
00186 !| ISOUSI         |-->| NUMBER OF SUB-ITERATION IN THE TIME-STEP
00187 !| KDIR           |-->| CONVENTION FOR DIRICHLET POINT
00188 !| KFROT          |-->| KEYWORD: 'LAW OF BOTTOM FRICTION'
00189 !| LIMPRO         |-->| BOUNDARY CONDITIONS FOR H, U V PER POINTS
00190 !|                |   | AND SEGMENTS
00191 !| LINDNER        |-->| IF YES, THERE IS NON-SUBMERGED VEGETATION FRICTION
00192 !| LISRUG         |-->| TURBULENCE REGIME (1: SMOOTH 2: ROUGH)
00193 !| LT             |-->| ITERATION NUMBER
00194 !| MASK           |-->| BLOCK OF MASKS FOR SEGMENTS :
00195 !|                |   | MASK(MSK1): 1. IF KDIR ON U 0. ELSE
00196 !|                |   | MASK(MSK2): 1. IF KDIR ON V 0. ELSE
00197 !|                |   | MASK(MSK3): 1. IF KDDL ON U 0. ELSE
00198 !|                |   | MASK(MSK4): 1. IF KDDL ON V 0. ELSE
00199 !|                |   | MASK(MSK6): 1. IF KNEU ON V 0. ELSE
00200 !|                |   | MASK(MSK7): 1. IF KOND 0. ELSE
00201 !|                |   | MASK(MSK9): 1. IF KDIR ON H (POINT)
00202 !| MASKEL         |-->| MASKING OF ELEMENTS
00203 !|                |   | =1. : NORMAL   =0. : MASKED ELEMENT
00204 !| MASKPT         |-->| MASKING PER POINT.
00205 !|                |   | =1. : NORMAL   =0. : MASKED
00206 !| MASSES         |-->| MASS OF WATER ADDED BY SOURCE TERM
00207 !| MAT            |<--| BLOCK OF MATRICES
00208 !| MATADJ         |<--| BLOCK OF MATRICES FOR ADJOINT SYSTEM
00209 !| MAXVAR         |-->| MAXIMUM NUMBER OF VARIABLES
00210 !| MBOR           |<--| BOUNDARY MATRIX
00211 !| MESH           |-->| MESH STRUCTURE
00212 !| MSK            |-->| IF YES, THERE IS MASKED ELEMENTS.
00213 !| NDEF           |-->| DEFAULT MANNING
00214 !| NFRLIQ         |-->| NUMBER OF LIQUID BOUNDARIES
00215 !| NIT            |-->| TOTAL NUMBER OF ITERATIONS
00216 !| NREF           |-->| LOGICAL UNIT OF REFERENCE FILE
00217 !| NRES           |-->| LOGICAL UNIT OF RESULTS FILE
00218 !| NVARRES        |<--| NUMBER OF VARIABLES IN RESULTS FILE
00219 !| OPDVIT         |-->| OPTION FOR DIFFUSION OF VELOCITIES
00220 !| OPTBAN         |-->| KEYWORD: 'OPTION FOR THE TREATMENT OF TIDAL FLATS'
00221 !| OPTCOST        |-->| OPTION FOR COMPUTING THE COST FUNCTION
00222 !| OPTSOU         |-->| KEYWORD: 'TYPE OF SOURCES'
00223 !| OPTSUP         |-->| KEYWORD: 'SUPG OPTION'
00224 !| OUTINI         |-->| IF YES, INITIAL CONDITIONS ARE IN THE RESULTS FILE
00225 !| PATMOS         |-->| ATMOSPHERIC PRESSURE
00226 !| PP             |<--| ADJOINT H
00227 !| PRECCU         |-->| KEYWORD: 'C-U PRECONDITIONING'
00228 !| PRIVE          |-->| BLOCK OF WORK BIEF_OBJ STRUCTURES
00229 !| QQ             |<--| ADJOINT U
00230 !| RHS            |<->| BLOCK OF PRIVATE BIEF_OBJ STRUCTURES
00231 !| RO             |-->| WATER DENSITY IF VARIABLE
00232 !| ROEAU          |-->| WATER DENSITY
00233 !| ROVAR          |-->| IF YES, VARIABLE WATER DENSITY.
00234 !| RR             |<--| ADJOINT R
00235 !| S              |-->| VOID STRUCTURE
00236 !| SB             |---| NOT USED !!!!!!!!!!!!!!!!!!!!!!
00237 !| SLVPRO         |-->| SOLVER STRUCTURE FOR PROPAGATION
00238 !| SMH            |-->| SOURCE TERM IN CONTINUITY EQUATION
00239 !| SOLSYS         |-->| KEYWORD: 'TREATMENT OF THE LINEAR SYSTEM'
00240 !| SP             |-->| SPACING OF ROUGHNESS ELEMENT
00241 !| T1             |<->| WORK BIEF_OBJ STRUCTURE
00242 !| T2             |<->| WORK BIEF_OBJ STRUCTURE
00243 !| T3             |<->| WORK BIEF_OBJ STRUCTURE
00244 !| T4             |<->| WORK BIEF_OBJ STRUCTURE
00245 !| T5             |<->| WORK BIEF_OBJ STRUCTURE
00246 !| T6             |<->| WORK BIEF_OBJ STRUCTURE
00247 !| T7             |<->| WORK BIEF_OBJ STRUCTURE
00248 !| T8             |<->| WORK BIEF_OBJ STRUCTURE
00249 !| T9             |<->| WORK BIEF_OBJ STRUCTURE
00250 !| T10            |<->| WORK BIEF_OBJ STRUCTURE
00251 !| TAM1           |<->| MATRIX FOR ADJOINT SYSTEM
00252 !| TAM2           |<->| MATRIX FOR ADJOINT SYSTEM
00253 !| TAM3           |<->| MATRIX FOR ADJOINT SYSTEM
00254 !| TB             |<->| BLOCK WITH T1,T2,...
00255 !| TBM1           |<->| MATRIX FOR ADJOINT SYSTEM
00256 !| TBM2           |<->| MATRIX FOR ADJOINT SYSTEM
00257 !| TCM1           |<->| MATRIX FOR ADJOINT SYSTEM
00258 !| TCM2           |<->| MATRIX FOR ADJOINT SYSTEM
00259 !| TE1            |<->| WORK BIEF_OBJ STRUCTURE FOR ELEMENTS
00260 !| TE2            |<->| WORK BIEF_OBJ STRUCTURE FOR ELEMENTS
00261 !| TE3            |<->| WORK BIEF_OBJ STRUCTURE FOR ELEMENTS
00262 !| TE4            |<->| WORK BIEF_OBJ STRUCTURE FOR ELEMENTS
00263 !| TE5            |<->| WORK BIEF_OBJ STRUCTURE FOR ELEMENTS
00264 !| TETAD          |-->| IMPLICITATION ON DIFFUSION
00265 !| TETAH          |-->| IMPLICITATION OF H IN U EQUATION
00266 !| TETAHC         |-->| IMPLICITATION OF H IN CONTINUITY
00267 !| TETAU          |-->| IMPLICITATION OF U AND
00268 !| TEXREF         |<--| NAMES AND UNITS OF VARIABLES IN REFERENCE FILE
00269 !| TEXRES         |<--| NAMES AND UNITS OF VARIABLES IN RESULTS FILE
00270 !| TEXTE          |<--| WORK STRINGS, LIKE TEXREF
00271 !| TM1            |<->| MATRIX
00272 !| TROUVE         |<--| INTEGER ARRAY SAYING IF A VARIABLE HAS BEEN FOUND
00273 !| UBOR           |<--| PRESCRIBED BOUNDARY CONDITION ON VELOCITY U
00274 !| VBOR           |<--| PRESCRIBED BOUNDARY CONDITION ON VELOCITY V
00275 !| UCONV          |-->| X-COMPONENT OF ADVECTION VELOCITY FIELD
00276 !| VCONV          |-->| Y-COMPONENT OF ADVECTION VELOCITY FIELD
00277 !| UD             |---| ???? NOT USED
00278 !| UIT1           |<--| DIRECT U AT TIME IT+1
00279 !| UN             |<->| X-COMPONENT OF VELOCITY AT TIME T(N)
00280 !| VN             |<->| Y-COMPONENT OF VELOCITY AT TIME T(N)
00281 !| UNK            |<->| BLOCK OF UNKNOWNS OF DIRECT SYSTEM
00282 !| UNKADJ         |<->| BLOCK OF UNKNOWNS OF ADJOINT SYSTEM
00283 !| UNSV2D         |-->| INVERSE OF INTEGRALS OF TEST FUNCTIONS
00284 !| UTILD          |-->| VELOCITY U IF ADVECTED BY CHARACTERISTICS
00285 !| UU             |<--| ADJOINT U
00286 !| VARCL          |<->| BLOCK OF CLANDESTINE VARIABLES
00287 !| VARCLA         |-->| NAMES OF CLANDESTINE VARIABLES
00288 !| VARSOR         |<->| BLOCK OF VARIABLES IN RESULT FILE
00289 !| VD             |---| ???? NOT USED
00290 !| VERTIC         |-->| IF YES, THERE ARE VERTICAL STRUCTURES
00291 !| VISC           |-->| VISCOSITY COEFFICIENTS ALONG X,Y AND Z .
00292 !|                |   | IF P0 : PER ELEMENT
00293 !|                |   | IF P1 : PERR POINT
00294 !| VISC_S         |<->| WORK ARRAY FOR SAVING VISC
00295 !| VIT1           |<--| DIRECT V AT TIME IT+1
00296 !| VTILD          |-->| VELOCITY V AFTER ADVECTION
00297 !| VV             |<->| ADJOINT V
00298 !| W              |<--| REAL WORK ARRAY
00299 !| W1             |<->| WORK ARRAY
00300 !| YASMH          |-->| IF YES, SMH TAKEN INTO ACCOUNT
00301 !| ZF             |-->| ELEVATION OF BOTTOM
00302 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00303 !
00304       USE BIEF
00305       USE INTERFACE_TELEMAC2D, EX_PROPAG_ADJ => PROPAG_ADJ
00306       USE DECLARATIONS_TELEMAC2D, ONLY : KFROTL
00307 !
00308       IMPLICIT NONE
00309       INTEGER LNG,LU
00310       COMMON/INFO/LNG,LU
00311 !
00312 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00313 !
00314       INTEGER, INTENT(IN) :: LT,OPTSUP(4),KDIR,KFROT,ICONVF(4)
00315       INTEGER, INTENT(IN) :: IORDRH,IORDRU,ISOUSI,OPTBAN,OPTSOU,SOLSYS
00316       INTEGER, INTENT(IN) :: OPDVIT,NFRLIQ,LISRUG,ITURB,OPTCOST
00317       INTEGER, INTENT(IN)    :: NIT,NRES,NREF,MAXVAR,HFROT
00318       INTEGER, INTENT(INOUT) :: NVARRES,TROUVE(*),ALIRE(*)
00319       LOGICAL, INTENT(IN)    :: BILMAS,ATMOS,DIFVIT,INFOGR,CONVV(4),MSK
00320       LOGICAL, INTENT(IN)    :: YASMH,ROVAR,PRECCU,VERTIC,ADJO,CORCON
00321       LOGICAL, INTENT(IN)    :: OUTINI,LINDNER
00322       DOUBLE PRECISION, INTENT(IN)    :: TETAU,TETAD,TETAH,AGGLOC,AGGLOU
00323       DOUBLE PRECISION, INTENT(IN)    :: TETAHC,AT,DT,GRAV,ROEAU,CFLMAX
00324       DOUBLE PRECISION, INTENT(IN)    :: KARMAN,NDEF,DP,SP
00325       DOUBLE PRECISION, INTENT(INOUT) :: MASSES,SB
00326       TYPE(SLVCFG), INTENT(INOUT)     :: SLVPRO
00327       CHARACTER(LEN=20), INTENT(IN)   :: EQUA
00328       TYPE(BIEF_OBJ), INTENT(IN)      :: UCONV,VCONV,SMH,UN,VN,HN
00329       TYPE(BIEF_OBJ), INTENT(INOUT)   :: RO
00330       TYPE(BIEF_OBJ), INTENT(IN)      :: UTILD,VTILD,PATMOS,CF,UNSV2D
00331       TYPE(BIEF_OBJ), INTENT(INOUT)   :: U,V,H,CV1,CV2,CV3,PRIVE,DH,DHN
00332       TYPE(BIEF_OBJ), INTENT(INOUT)   :: DU,DV,FU,FV,VISC,VISC_S,HTILD
00333       TYPE(BIEF_OBJ), INTENT(INOUT)   :: UBOR,VBOR,HBOR,AUBOR
00334       TYPE(BIEF_OBJ), INTENT(IN)      :: MASKEL,MASKPT,ZF
00335       TYPE(BIEF_OBJ), INTENT(IN)      :: HPROP,H0,LIMPRO
00336       TYPE(BIEF_OBJ), INTENT(INOUT)   :: T1,T2,T3,T4,T5,T6,T7,T8,T9,T10
00337       TYPE(BIEF_OBJ), INTENT(INOUT)   :: T11
00338       TYPE(BIEF_OBJ), INTENT(INOUT)   :: TE1,TE2,TE3,TE4,TE5
00339 !     STRUCTURES OF MATRICES
00340       TYPE(BIEF_OBJ), INTENT(INOUT)   :: TAM1,TAM2,TAM3,TBM1
00341       TYPE(BIEF_OBJ), INTENT(INOUT)   :: TBM2,TCM1,TCM2
00342       TYPE(BIEF_OBJ), INTENT(INOUT)   :: AM1,AM2,AM3,BM1,BM2,CM1,CM2,TM1
00343       TYPE(BIEF_OBJ), INTENT(INOUT)   :: A23,A32,MBOR
00344 !
00345       TYPE(BIEF_OBJ),  INTENT(INOUT)  :: MASK,MAT,RHS,UNK,TB,BD,DIRBOR
00346       TYPE(BIEF_MESH), INTENT(INOUT)  :: MESH
00347       TYPE(BIEF_OBJ),  INTENT(INOUT)  :: CHESTR
00348       TYPE (BIEF_OBJ), INTENT(INOUT)  :: HD,UD,VD,ALPHA1,ALPHA2,ALPHA3
00349       TYPE (BIEF_OBJ), INTENT(INOUT)  :: HH,UU,VV,UIT1,VIT1,HIT1
00350       TYPE (BIEF_OBJ), INTENT(INOUT)  :: PP,QQ,RR,CHBORD,CFBOR
00351       TYPE(BIEF_OBJ),  INTENT(INOUT)  :: W1
00352       TYPE(BIEF_OBJ), INTENT(IN)      :: S
00353       REAL,  INTENT(INOUT)            :: W(*)
00354       TYPE(BIEF_OBJ),  INTENT(INOUT)  :: VARSOR
00355       TYPE(BIEF_OBJ),  INTENT(INOUT)  :: MATADJ,UNKADJ,ADJDIR,VARCL
00356       CHARACTER(LEN=72), INTENT(IN)   :: ESTIME
00357       CHARACTER(LEN=32), INTENT(INOUT):: VARCLA(10),TEXTE(*)
00358       CHARACTER(LEN=32), INTENT(INOUT):: TEXREF(*),TEXRES(*)
00359 !
00360 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00361 !
00362       INTEGER ITER,I,IELMU,IELMH
00363       INTEGER UDIR,UDDL,VDIR,VDDL
00364 !
00365       DOUBLE PRECISION C,AT1,HIST(1)
00366 !
00367       CHARACTER*16 FORMULE
00368 !
00369 !-----------------------------------------------------------------------
00370 !
00371 ! FH-FRDATA
00372       DOUBLE PRECISION, PARAMETER :: VK = 1.D-6
00373 ! FH-FRDATA
00374 !-----------------------------------------------------------------------
00375 !
00376       IELMH=HH%ELM
00377       IELMU=UU%ELM
00378 !
00379 !  ADDRESSES OF THE ARRAYS IN THE MASKING BLOCK: MASK
00380 !
00381       UDIR = 1
00382       VDIR = 2
00383       UDDL = 3
00384       VDDL = 4
00385 !
00386 !-----------------------------------------------------------------------
00387 !
00388       IF(SOLSYS.NE.1) THEN
00389         IF(LNG.EQ.1) THEN
00390           WRITE(LU,*) 'TRAITEMENT DU SYSTEME LINEAIRE : ',SOLSYS
00391           WRITE(LU,*) 'CAS NON PREVU EN MODE ESTIMATION'
00392         ENDIF
00393         IF(LNG.EQ.2) THEN
00394           WRITE(LU,*) 'TREATMENT OF THE LINEAR SYSTEM : ',SOLSYS
00395           WRITE(LU,*) 'UNEXPECTED CASE IN ESTIMATION MODE'
00396         ENDIF
00397         CALL PLANTE(1)
00398         STOP
00399       ENDIF
00400 !
00401 !-----------------------------------------------------------------------
00402 !
00403 !     COMPUTES MATRIX FOR ADJOINT SYSTEM
00404 !
00405       CALL OM( 'M=TN    ' , TAM1, AM1, S, C, MESH )
00406       CALL OM( 'M=TN    ' , TAM2, AM2, S, C, MESH )
00407       CALL OM( 'M=TN    ' , TAM3, AM3, S, C, MESH )
00408       CALL OM( 'M=TN    ' , TBM1, BM1, S, C, MESH )
00409       CALL OM( 'M=TN    ' , TBM2, BM2, S, C, MESH )
00410       CALL OM( 'M=TN    ' , TCM1, CM1, S, C, MESH )
00411       CALL OM( 'M=TN    ' , TCM2, CM2, S, C, MESH )
00412 !
00413 !=======================================================================
00414 !
00415 !     COMPUTES RIGHT HAND SIDES FOR ADJOINT SYSTEM
00416 !
00417 !=======================================================================
00418 !
00419 !     NB: HIT1, UIT1, VIT1 ARE DIRECT VARIABLES AT TIME IT+1
00420 !         HH  , UU  , VV   ARE DIRECT VARIABLES AT TIME IT
00421 !         HN  , UN  , VN   ARE DIRECT VARIABLES AT TIME IT-1
00422 !
00423 !
00424 !           IT    IT    IT
00425 !  TERMS 2 W   ( X   - M   ) OR EQUIVALENT DEPENDING ON THE COST FUNCTION
00426 !           IP    IP    IP
00427 !
00428 !     INITIALISES CV1, CV2 AND CV3
00429 !     IN STEADY STATE MODE, WEIGHTS ALPHA1, ALPHA2 AND ALPHA3 ARE
00430 !     INITIALISED BY A CALL TO "MESURES" IN HOMERE_T2D_ADJ, IN THE LOOP
00431 !     FOR THE COMPUTATION OF THE COST FUNCTION. THEN THEY ARE CANCELLED
00432 !     AT THE END OF THIS ROUTINE
00433 !
00434       CALL COST_FUNCTION(C,OPTCOST,'RHS')
00435 !
00436 !-----------------------------------------------------------------------
00437 !
00438 !  PREPARES FRICTION TERMS AND VECTOR T1 EQUAL TO 0
00439 !
00440 !     T10 = MASS MATRIX LUMPED / COS(SLOPE)
00441       CALL SLOPES(TE3,ZF,MESH)
00442       CALL VECTOR(T10,'=','MASBAS          ',IELMU,1.D0,T2,
00443      &                T2,T2,T2,T2,T2,MESH,.TRUE.,TE3)
00444 !     FU IN T11 (AND FV=FU)
00445 !
00446 !     T2 WILL HOLD CF AT ITERATION IT+1
00447 !
00448       CALL CPSTVC(CF,T2)
00449 !
00450 !FH-FRDATA
00451 !     CALL COEFRO(T2,HH,UU,VV,KARMAN,KFROT,CHESTR,GRAV,MESH,T1)
00452       CALL FRICTION_UNIF(MESH,HH,UU,VV,CHESTR,S,KFROT,KFROTL,0,LISRUG,
00453      &                   .FALSE.,SB,NDEF,DP,SP,VK,KARMAN,GRAV,
00454      &                   T1,T2,CHBORD,T2,CFBOR)
00455 !FH-FRDATA
00456 !
00457       CALL FRICTI(T11,T3,T4,T5,UU,VV,HH,T2,MESH,T6,T7,VERTIC,UNSV2D,
00458      &            MSK,MASKEL,HFROT)
00459 !     CALL FRICTI(T11,T3,T4,T5,UU,VV,HH,CF,MESH,T6,VERTIC)
00460 !
00461 !     FINAL FU OF PHD IN T11
00462       CALL OS('X=XY    ', T11 , T10 , T10 , C )
00463 !
00464 !     T1 : 0 VECTOR
00465       CALL CPSTVC(HH,T1)
00466       CALL OS('X=C     ' , T1 , T1 , T1 , 0.D0)
00467 !
00468 !-----------------------------------------------------------------------
00469 !
00470 !  COMPUTES CV1 : CV1 = CV1 + T11+T12+T13+T14+T15+T16+T17
00471 !
00472 !-----------------------------------------------------------------------
00473 !  TERM T11 (3 PARTS)
00474 !-----------------------------------------------------------------------
00475 !
00476 !  T11_1 : M/DT  * H
00477 !                   ADJ
00478 !     TERM 1B OF AL
00479       CALL MATRIX(AM1,'M=N     ','MATMAS          ',IELMH,IELMH,
00480      &            1.D0/DT,T1,T1,T1,T1,T1,T1,MESH,MSK,MASKEL)
00481       CALL MATVEC('X=X+AY  ', CV1 , AM1 , PP , C , MESH)
00482 !
00483 !  T11_2 : ADVECTION
00484 !
00485 !  T11_3 :
00486 !
00487 !     8B OF AL
00488 !     CALL MATRIX(BM1,'M=N     ','MATGRF         X',IELMH,IELMH,
00489 !    *           (TETAU-1.D0),UU,T1,T1,T1,T1,T1,MESH,MSK,MASKEL)
00490 !     CALL MATVEC('X=X+AY  ', CV1 , BM1 , PN , C , MESH)
00491 !     9B OF AL
00492 !     CALL MATRIX(BM2,'M=N     ','MATGRF         Y',IELMH,IELMH,
00493 !    *           (TETAU-1.D0),VV,T1,T1,T1,T1,T1,MESH,MSK,MASKEL)
00494 !     CALL MATVEC('X=X+AY  ', CV1 , BM2 , PN , C , MESH)
00495 !
00496 !     CORRECTED VERSION JMH: NOW ICONVF(2) IS ALWAYS 5
00497 !
00498 !     IF(ICONVF(2).EQ.5.OR.ICONVF(2).EQ.8) THEN
00499         FORMULE='MATFGR          '
00500 !     ELSE
00501 !       FORMULE='MATGRF          '
00502 !     ENDIF
00503 !
00504       FORMULE(16:16)='X'
00505       CALL MATRIX(BM1,'M=N     ',FORMULE,IELMH,IELMU,
00506      &           (TETAU-1.D0),PP,T1,T1,T1,T1,T1,MESH,MSK,MASKEL)
00507       CALL MATVEC('X=X+AY  ', CV1 , BM1 , UU , C , MESH)
00508       FORMULE(16:16)='Y'
00509       CALL MATRIX(BM2,'M=N     ',FORMULE,IELMH,IELMU,
00510      &           (TETAU-1.D0),PP,T1,T1,T1,T1,T1,MESH,MSK,MASKEL)
00511       CALL MATVEC('X=X+AY  ', CV1 , BM2 , VV , C , MESH)
00512 !
00513 !                           H
00514 !  T11_4 : BOUNDARY TERM TB1
00515 !                           ADJ
00516 !
00517 !     JMH : I HAVE -1.D0 INSTEAD OF TETAU-1.D0, BUT THEN HE SUBTRACTS TETAU ??
00518 !           SAME THING EXCEPT FOR INCIDENT WAVE ???
00519       CALL VECTOR(T2,'=','FLUBDF          ',IELBOR(IELMH,1),
00520      &            TETAU-1.D0,PP,T1,T1,UU,VV,T1,MESH,.TRUE.,
00521      &            MASK%ADR(8)%P)
00522       CALL OSDB('X=X+Y   ' , CV1 , T2 , T2 , C , MESH)
00523 !     DIRICHLET ON VELOCITY :
00524       CALL VECTOR(T2,'=','FLUBDF          ',IELBOR(IELMH,1),
00525      &            -TETAU,PP,T1,T1,UU,VV,T1,MESH,
00526      &            .TRUE.,MASK%ADR(UDIR)%P)
00527       CALL OSDB('X=X+Y   ' , CV1 , T2 , T2 , C , MESH)
00528 !     FREE FLOW ON VELOCITY :
00529       CALL VECTOR(T2,'=','FLUBDF          ',IELBOR(IELMH,1),
00530      &            -TETAU,PP,T1,T1,UU,VV,T1,MESH,
00531      &            .TRUE.,MASK%ADR(UDDL)%P)
00532       CALL OSDB('X=X+Y   ' , CV1 , T2 , T2 , C , MESH)
00533 !
00534 !-----------------------------------------------------------------------
00535 !  TERM T12
00536 !-----------------------------------------------------------------------
00537 !
00538 !     TERM 2B OF AL
00539       CALL MATVEC('X=X+CAY ',CV1,TCM1,QQ,(TETAH-1.D0)/TETAH,MESH)
00540 !
00541 !-----------------------------------------------------------------------
00542 !  TERM T13
00543 !-----------------------------------------------------------------------
00544 !
00545 !     TERM 3B OF AL
00546       CALL MATVEC('X=X+CAY ',CV1,TCM2,RR,(TETAH-1.D0)/TETAH,MESH)
00547 !
00548 !-----------------------------------------------------------------------
00549 !  TERM T14
00550 !-----------------------------------------------------------------------
00551 !
00552 !     TERM 1C OF AL
00553 !     VERSION EB+AL, NOTE JMH : DON'T AGREE
00554 !     CALL MATRIX(BM1,'M=N     ','MATGRF         X',IELMH,IELMH,
00555 !    *            -TETAU,UN,T1,T1,T1,T1,T1,MESH,MSK,MASKEL)
00556 !     CALL MATVEC('X=X+AY  ', CV1 , BM1 , PN , C , MESH)
00557 !
00558 !     VERSION JMH+CC
00559 !                        START OF FORMULATION MADE FOR T11_3
00560       FORMULE(16:16)='X'
00561       CALL MATRIX(BM1,'M=N     ',FORMULE,IELMH,IELMU,
00562      &            -TETAU,PP,T1,T1,T1,T1,T1,MESH,MSK,MASKEL)
00563       CALL MATVEC('X=X+AY  ', CV1 , BM1 , UIT1 , C , MESH)
00564 !
00565 !-----------------------------------------------------------------------
00566 !  TERM T15 + T17
00567 !-----------------------------------------------------------------------
00568 !
00569 !          IT+1   IT+1    IT+1    IT+1
00570 !     T3= U    * Q     + V     * R
00571 !
00572       CALL OS('X=YZ    ', T3 , UIT1 , QQ , C )
00573       CALL OS('X=X+YZ  ', T3 , VIT1 , RR , C )
00574 !
00575 !     T4=-(4/3)/H OR -1/H
00576       CALL OS('X=1/Y   ', T4 , HH , HH , C ,2,0.D0,1.D-6)
00577       IF(KFROT.EQ.3) THEN
00578         CALL OS('X=CX    ', T4 , T4 , T4 , -4.D0/3.D0)
00579       ELSEIF(KFROT.EQ.2) THEN
00580         CALL OS('X=CX    ', T4 , T4 , T4 , -1.D0     )
00581       ELSE
00582         IF(LNG.EQ.1) WRITE(LU,*) 'LOI NON TRAITEE POUR L''ESTIMATION'
00583         IF(LNG.EQ.2) WRITE(LU,*) 'WRONG FRICTION LAW FOR ESTIMATION'
00584         CALL PLANTE(1)
00585         STOP
00586       ENDIF
00587       CALL OS('X=XY    ', T4 , T11 , T11 , C )
00588 !     AND IF T3 IS QUASI-BUBBLE?
00589       CALL OS('X=X+YZ  ', CV1 , T4 , T3  , C )
00590 !
00591 !-----------------------------------------------------------------------
00592 !  TERM T16
00593 !-----------------------------------------------------------------------
00594 !
00595 !     TERM 2C OF AL
00596 !     VERSION EB+AL, NOTE JMH : DON'T AGREE
00597 !     CALL MATRIX(BM2,'M=N     ','MATGRF         Y',IELMH,IELMH,
00598 !    *            -TETAU,VN,T1,T1,T1,T1,T1,MESH,MSK,MASKEL)
00599 !     CALL MATVEC('X=X+AY  ', CV1 , BM2 , PN , C , MESH)
00600 !     VERSION JMH+CC
00601 !                        START OF FORMULATION MADE FOR T11_3
00602       FORMULE(16:16)='Y'
00603       CALL MATRIX(BM2,'M=N     ',FORMULE,IELMH,IELMU,
00604      &            -TETAU,PP,T1,T1,T1,T1,T1,MESH,MSK,MASKEL)
00605       CALL MATVEC('X=X+AY  ', CV1 , BM2 , VIT1 , C , MESH)
00606 !
00607 !-----------------------------------------------------------------------
00608 !
00609 !  COMPUTES CV2 AND CV3 :
00610 !
00611 !-----------------------------------------------------------------------
00612 !  TERM  T21
00613 !-----------------------------------------------------------------------
00614 !
00615 !  T21_1 : ADVECTION
00616 !
00617 !  T21_2 : (5B OF EB+AL)
00618 !
00619       FORMULE(16:16)='X'
00620       CALL MATRIX(BM1,'M=N     ',FORMULE,IELMH,IELMU,
00621      &            1.D0,HH,T1,T1,T1,T1,T1,MESH,MSK,MASKEL)
00622       CALL MATVEC('X=X+CTAY',CV2,BM1,PP,TETAU-1.D0,MESH)
00623 ! OLD PROGRAMMING (TBM1 FROM HN AT AN INCORRECT TIMESTEP)
00624 !     CALL MATVEC('X=X+CAY ',CV2,TBM1,PP,(TETAU-1.D0)/TETAU,MESH)
00625 !
00626 !                           U
00627 !  T21_3 : BOUNDARY TERM TB1
00628 !                           ADJ
00629 !
00630 !     JMH : I HAVE 1.D0 INSTEAD OF TETAU-1.D0
00631       CALL VECTOR(T2,'=','FLUBDF          ',IELBOR(IELMH,1),
00632      &            TETAU-1.D0,PP,T1,T1,HH,T1,T1,MESH,.TRUE.,
00633      &            MASK%ADR(8)%P)
00634       CALL OSDB('X=X+Y   ' , CV2 , T2 , T2 , C , MESH)
00635 !     DIRICHLET ON VELOCITY U:
00636       CALL VECTOR(T2,'=','FLUBDF          ',IELBOR(IELMH,1),
00637      &            -TETAU,PP,T1,T1,HH,T1,T1,MESH,
00638      &            .TRUE.,MASK%ADR(UDIR)%P)
00639       CALL OSDB('X=X+Y   ' , CV2 , T2 , T2 , C , MESH)
00640 !     FREE FLOW ON U:
00641       CALL VECTOR(T2,'=','FLUBDF          ',IELBOR(IELMH,1),
00642      &            -TETAU,PP,T1,T1,HH,T1,T1,MESH,
00643      &            .TRUE.,MASK%ADR(UDDL)%P)
00644       CALL OSDB('X=X+Y   ' , CV2 , T2 , T2 , C , MESH)
00645 !
00646 !-----------------------------------------------------------------------
00647 ! TERM  T31
00648 !-----------------------------------------------------------------------
00649 !
00650 !  T31_1 : ADVECTION
00651 !
00652 !  T31_2 : (7B OF EB+AL)
00653 !
00654       FORMULE(16:16)='Y'
00655       CALL MATRIX(BM2,'M=N     ',FORMULE,IELMH,IELMU,
00656      &            1.D0,HH,T1,T1,T1,T1,T1,MESH,MSK,MASKEL)
00657       CALL MATVEC('X=X+CTAY',CV3,BM2,PP,TETAU-1.D0,MESH)
00658 ! OLD PROGRAMMING (TBM2 FROM HN AT AN INCORRECT TIMESTEP)
00659 !     CALL MATVEC('X=X+CAY ',CV3,TBM2,PP,(TETAU-1.D0)/TETAU,MESH)
00660 !
00661 !                           V
00662 !  T31_3 : BOUNDARY TERM TB1
00663 !                           ADJ
00664 !
00665 !     JMH : I HAVE 1.D0 INSTEAD OF TETAU-1.D0
00666       CALL VECTOR(T4,'=','FLUBDF          ',IELBOR(IELMH,1),
00667      &            TETAU-1.D0,PP,T1,T1,T1,HH,T1,MESH,.TRUE.,
00668      &            MASK%ADR(8)%P)
00669       CALL OSDB('X=X+Y   ' , CV3 , T4 , T4 , C , MESH)
00670 !     DIRICHLET ON VELOCITY V:
00671       CALL VECTOR(T4,'=','FLUBDF          ',IELBOR(IELMH,1),
00672      &            -TETAU,PP,T1,T1,T1,HH,T1,MESH,
00673      &            .TRUE.,MASK%ADR(VDIR)%P)
00674       CALL OSDB('X=X+Y   ' , CV3 , T4 , T4 , C , MESH)
00675 !     FREE FLOW ON V:
00676       CALL VECTOR(T4,'=','FLUBDF          ',IELBOR(IELMH,1),
00677      &            -TETAU,PP,T1,T1,T1,HH,T1,MESH,
00678      &            .TRUE.,MASK%ADR(VDDL)%P)
00679       CALL OSDB('X=X+Y   ' , CV3 , T4 , T4 , C , MESH)
00680 !
00681 !-----------------------------------------------------------------------
00682 ! TERM  T22 (2 PARTS)
00683 !-----------------------------------------------------------------------
00684 !
00685 !     TERM 4B OF AL       T
00686 !     AM2 IS MASS/DT AT TIME IT+1
00687       CALL MATRIX(AM2,'M=N     ','MATMAS          ',IELMU,IELMU,
00688      &            1.D0/DT,T1,T1,T1,T1,T1,T1,MESH,MSK,MASKEL)
00689       CALL MATVEC('X=X+AY  ', CV2 , AM2 , QQ , C , MESH)
00690 !
00691 !     MISSES AN ADVECTION TERM
00692 !
00693 !
00694 !-----------------------------------------------------------------------
00695 ! TERM  T32 (2 PARTS)
00696 !-----------------------------------------------------------------------
00697 !
00698 !     TERM 6B OF AL
00699 !     AM2 IS MASS/DT AT TIME IT+1
00700       CALL MATVEC('X=X+AY  ', CV3 , AM2 , RR , C , MESH)
00701 !
00702 !     MISSES AN ADVECTION TERM
00703 !
00704 !-----------------------------------------------------------------------
00705 ! TERMS  T23 AND T33
00706 !-----------------------------------------------------------------------
00707 !
00708 !   ADVECTION : NOT YET IMPLEMENTED
00709 !
00710 !-----------------------------------------------------------------------
00711 ! TERM  T24+T25 AND T34+T35
00712 !-----------------------------------------------------------------------
00713 !
00714 !     T5=U/(U^2+V^2)  C     T6=V/(U^2+V^2)
00715       CALL OS('X=YZ    ', T7 , UU , UU , C    )
00716       CALL OS('X=X+YZ  ', T7 , VV , VV , C    )
00717       CALL OS('X=+(Y,C)', T7 , T7 , T7 , 1.D-6)
00718       CALL OS('X=Y/Z   ', T5 , UU , T7 , C    )
00719       CALL OS('X=Y/Z   ', T6 , VV , T7 , C    )
00720 !
00721 !     ADD TERMS TO CV2, CV3
00722 !
00723 !     T3=U*Q+V*R (ALREADY DONE)
00724       CALL OS('X=XY    ', T5 , T11 , T11 , C )
00725       CALL OS('X=XY    ', T6 , T11 , T11 , C )
00726       CALL OS('X=X+YZ  ', CV2 , T5 , T3  , C )
00727       CALL OS('X=X+YZ  ', CV3 , T6 , T3  , C )
00728 !
00729 !=======================================================================
00730 !
00731 !     END OF COMPUTATION OF RIGHT HAND SIDE FOR ADJOINT SYSTEM
00732 !
00733 !=======================================================================
00734 !
00735 !
00736 !     DIRICHLET CONDITIONS FOR ADJOINT VARIABLES
00737       CALL OS ('X=C     ',ADJDIR,ADJDIR,ADJDIR,0.D0)
00738       CALL DIRICH(UNKADJ,MATADJ,RHS,ADJDIR,LIMPRO%I,
00739      &            TB,MESH,KDIR,MSK,MASKPT)
00740 !
00741       CALL SOLVE(UNKADJ,MATADJ,RHS,TB,SLVPRO,INFOGR,MESH,TM1)
00742 !
00743 !     CONTRIBUTION TO COST FUNCTION
00744 !
00745       CALL COST_FUNCTION(C,OPTCOST,'GRD')
00746 !
00747 !     PREPARES NEXT TIMESTEP
00748 !
00749       CALL OS( 'X=Y     ' , HIT1 , HH  , HH  , C )
00750       CALL OS( 'X=Y     ' , UIT1 , UU  , UU  , C )
00751       CALL OS( 'X=Y     ' , VIT1 , VV  , VV  , C )
00752 !
00753       IF(     INCLU2(ESTIME,'PERMANENT')
00754      &    .OR.INCLU2(ESTIME,'STEADY'   )  ) THEN
00755 !
00756 !       STEADY STATE : DOES NOT UPDATE DATA AND RESULTS,
00757 !                      ONLY LAST TIMESTEP CONSIDERED
00758 !
00759 !       CALL OS( 'X=C     ' , ALPHA1 , ALPHA1 , ALPHA1 , 0.D0 )
00760 !       CALL OS( 'X=C     ' , ALPHA2 , ALPHA2 , ALPHA2 , 0.D0 )
00761 !       CALL OS( 'X=C     ' , ALPHA3 , ALPHA3 , ALPHA3 , 0.D0 )
00762 !       U AND V MODIFIED BY BORD, RESET HERE (H USEFUL ??)
00763         CALL OS( 'X=Y     ' , H , HN  , HN  , C )
00764         CALL OS( 'X=Y     ' , U , UN  , UN  , C )
00765         CALL OS( 'X=Y     ' , V , VN  , VN  , C )
00766 !
00767       ELSE
00768 !
00769 !       UNSTEADY STATE : UPDATES DATA AND RESULTS
00770 !
00771         IF(LT.LT.NIT) THEN
00772 !
00773 !         HIT,.., HH,.. IN INITIAL CONDITIONS, SEE PROPIN_ADJ
00774           CALL OS( 'X=Y     ' , HH , HN  , HN  , C )
00775           CALL OS( 'X=Y     ' , UU , UN  , UN  , C )
00776           CALL OS( 'X=Y     ' , VV , VN  , VN  , C )
00777 !
00778 !         READS TELEMAC2D RESULTS (RESULTS FILE - UNIT NRES)
00779 !         SEE ALSO CONDIN_ADJ
00780 !
00781           DO I=1,2*(NVARRES+1)
00782             BACKSPACE NRES
00783           ENDDO
00784           CALL LITENR(VARSOR,VARCL,NRES,'STD',
00785      &         HIST,0,MESH%NPOIN,AT1,TEXTE,
00786      &         TEXRES,NVARRES,VARCLA,0,TROUVE,ALIRE,W,.FALSE.,MAXVAR)
00787 !
00788 !         READS THE MEASUREMENTS (REFERENCE FILE - UNIT NREF)
00789 !
00790           ITER=NIT-LT
00791           IF(OUTINI) ITER=ITER+1
00792           CALL MESURES(ITER,AT-DT)
00793 !
00794         ENDIF
00795       ENDIF
00796 !
00797 !-----------------------------------------------------------------------
00798 !
00799       RETURN
00800       END

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