homere_adj_t2d.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\telemac2d\homere_adj_t2d.f
00002 !
00117                      SUBROUTINE HOMERE_ADJ_T2D
00118 !                    *************************
00119 !
00120 !
00121 !***********************************************************************
00122 ! TELEMAC2D   V6P2                                   21/08/2010
00123 !***********************************************************************
00124 !
00125 !
00126 !
00127 !
00128 !
00129 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00130 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00131 !
00132       USE BIEF
00133       USE DECLARATIONS_TELEMAC2D
00134       USE INTERFACE_TELEMAC2D
00135 !
00136       IMPLICIT NONE
00137       INTEGER     LNG,LU
00138       COMMON/INFO/LNG,LU
00139 !
00140 !     TYPE INTEGER:
00141 !
00142       INTEGER I,NPARAM,ITER
00143       INTEGER IH,IU,IV,NVAR
00144       INTEGER TROUVE(MAXVAR+10)
00145       INTEGER NLAGR,ILAGR,NPOINRES
00146 !
00147 !     TYPE REAL:
00148 !
00149       DOUBLE PRECISION ROX,JCOUT,JR,JCOUTN
00150       DOUBLE PRECISION R02,R03
00151       DOUBLE PRECISION C
00152       DOUBLE PRECISION HIST(1)
00153       DOUBLE PRECISION JSTEP0,JCOUT1,JCOUT2,JCOUT3
00154       DOUBLE PRECISION ERRH,ERRU,ERRV,AT1
00155 !
00156 !     TYPE LOGICAL
00157 !
00158       LOGICAL RSTART
00159 !
00160       CHARACTER(LEN=72) :: TITFIC
00161 !
00162 !-----------------------------------------------------------------------
00163 !  VARIABLES TO READ :
00164 !  0 : DISCARD    1 : READ  (SEE SUBROUTINE NOMVAR)
00165 !
00166       INTEGER ALIRRES(MAXVAR)
00167 !
00168 !     ALIRRES READS U,V,H IN TELEMAC RESULTS FILE
00169 !
00170       DATA ALIRRES /1,1,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
00171      &              0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
00172      &              0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
00173      &              0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0/
00174 !
00175 !-----------------------------------------------------------------------
00176 ! 2:  INIT PIT
00177 !-----------------------------------------------------------------------
00178 !
00179 !     PRINTS HEADER LINES TO LISTING
00180 !
00181       WRITE(LU,92)
00182 92    FORMAT(/////,
00183      &14X,'   AAAAA    DDDD       JJ        TTTTTTT  22222  DDDD ',/,
00184      &14X,'   A   A    D   D      JJ           T         2  D   D',/,
00185      &14X,'   AAAAA    D   D      JJ   IIII    T     22222  D   D',/,
00186      &14X,'   A   A    D   D      JJ           T     2      D   D',/,
00187      &14X,'   A   A    DDDD    JJJJJ           T     22222  DDDD ',/,
00188      &14X,'                                                      ',/,
00189      &14X,'               VERSION 6.2   FORTRAN 90               ',/,
00190      &14X,/////)
00191 !
00192 ! ALLOCATES VECTORS, MATRICES AND BLOCKS
00193 !
00194       CALL POINT_ADJ_T2D
00195 !
00196 !     WILL BE DONE AGAIN IN TELEMAC2D, BUT SEEMS NECESSARY HERE
00197 !     TO GET NZONE
00198 !
00199       IF(DEFZON) CALL DEF_ZONES
00200       IF(LNG.EQ.1) WRITE(LU,*) 'NOMBRE DE ZONES : ',NZONE
00201       IF(LNG.EQ.2) WRITE(LU,*) 'NUMBER OF ZONES: ',NZONE
00202       IF(NZONE.GT.NPOIN) THEN
00203         IF(LNG.EQ.2) WRITE(LU,*) 'ERREUR: PLUS DE ZONES QUE DE POINTS'
00204         IF(LNG.EQ.2) WRITE(LU,*) 'ERROR: MORE ZONES THAN POINTS'
00205         CALL PLANTE(1)
00206         STOP
00207       ENDIF
00208 !
00209 !-----------------------------------------------------------------------
00210 !
00211 !     NUMBER OF PARAMETERS TO BE ESTIMATED
00212 !
00213 !     TO MODIFY IF FRICTION + SOMETHING ELSE NEEDS ESTIMATING
00214       NPARAM = NPOIN
00215       IF(NZONE.GT.0) NPARAM = NZONE
00216 !
00217 !-----------------------------------------------------------------------
00218 !
00219 !     INITIALISATIONS AND OPTIONS FOR THE IDENTIFICATION OF PARAMETERS
00220 !
00221 !     INITIALISES SORLEOA AND SORIMPA
00222       DO I=1,MAXVAR
00223         SORLEOA(I)=.FALSE.
00224         SORIMPA(I)=.FALSE.
00225       ENDDO
00226 !
00227       IF(INCLU2(ESTIME,'DEBUG')) THEN
00228 !       CV1, CV2, CV3 (SECOND MEMBERS OF THE ADJOINT SYSTEMS)
00229         SORLEOA(20)=.TRUE.
00230         SORLEOA(21)=.TRUE.
00231         SORLEOA(22)=.TRUE.
00232 !       OUTPUT OF ADJOINT VARIABLES PP, QQ, RR
00233         SORLEOA(23)=.TRUE.
00234         SORLEOA(24)=.TRUE.
00235         SORLEOA(25)=.TRUE.
00236       ELSE
00237 !       OUTPUT OF BOTTOM TOPOGRAPHY (6) AND FRICTION (19)
00238         SORLEOA(6)=.TRUE.
00239         SORLEOA(19)=.TRUE.
00240       ENDIF
00241 !
00242       CALL OS('X=C     ',PRIVE,PRIVE,PRIVE,0.D0)
00243 !
00244 !     IDENTIFICATION METHOD: OPTID = 1 SIMPLE GRADIENT
00245 !                            OPTID = 2 CONJ. GRADIENT
00246 !                            OPTID = 3 LAGRANGE INTERPOLATION FOR RHO
00247 !
00248       WRITE(LU,*) 'OPTID = ',OPTID
00249       IF(OPTID.EQ.0) THEN
00250         WRITE(LU,*) 'PLAN D''EXPERIENCE'
00251       ELSEIF(OPTID.EQ.1) THEN
00252         WRITE(LU,*) 'GRADIENT METHOD'
00253       ELSEIF(OPTID.EQ.2) THEN
00254         WRITE(LU,*) 'CONJUGATE GRADIENT METHOD'
00255       ELSEIF(OPTID.EQ.3) THEN
00256         WRITE(LU,*) 'LAGRANGE INTERPOLATION'
00257       ELSE
00258         WRITE(LU,*) 'WRONG OPTION FOR COMPUTATION OF RHO'
00259         CALL PLANTE(1)
00260         STOP
00261       ENDIF
00262 !
00263       IF(OPTID.EQ.3) THEN
00264         NLAGR=3
00265       ELSE
00266         NLAGR=1
00267       ENDIF
00268 !
00269 !======================================================================
00270 !     INIT ADJOINT
00271 !======================================================================
00272 !
00273       JSTEP0=1.D0
00274       JR=0.D0
00275       JCOUTN = 8000000.D0
00276       NITERA = 0
00277 !
00278       JCOUT=0.D0
00279       RSTART=.TRUE.
00280 !
00281       IF(OPTID.NE.0) THEN
00282         CALL OV('X=C     ',GRADJ%R  , GRADJ%R  , GRADJ%R  ,0.D0,NPARAM)
00283         CALL OV('X=C     ',GRADJN%R , GRADJN%R , GRADJN%R ,0.D0,NPARAM)
00284       ENDIF
00285 !
00286 !======================================================================
00287 !      FILE MANAGEMENT
00288 !======================================================================
00289 !
00290 ! HEADER FOR ASCII OUTPUT (FORMAT SCOPT)
00291 !
00292       IF(T2D_FILES(T2DRFO)%NAME.NE.' ') THEN
00293         WRITE(T2D_FILES(T2DRFO)%LU,300) TITCAS
00294 300     FORMAT('''',A,'''',1I2)
00295         WRITE(T2D_FILES(T2DRFO)%LU,300) 'PARAMETER ESTIMATION'
00296         WRITE(T2D_FILES(T2DRFO)%LU,300) 'IDENTIFICATION OF FRICTION'
00297         WRITE(T2D_FILES(T2DRFO)%LU,300) 'ITERATION'
00298         WRITE(T2D_FILES(T2DRFO)%LU,300) 'COST'
00299         WRITE(T2D_FILES(T2DRFO)%LU,300) 'ERROR ON H (M)'
00300         WRITE(T2D_FILES(T2DRFO)%LU,300) 'ERROR ON U (M/S)'
00301         WRITE(T2D_FILES(T2DRFO)%LU,300) 'ERROR ON V (M/S)'
00302         IF(DEFZON) THEN
00303           DO I=1,NZONE
00304             WRITE(T2D_FILES(T2DRFO)%LU,300) 'FRICTION ZONE ',I
00305           ENDDO
00306         ELSE
00307           WRITE(T2D_FILES(T2DRFO)%LU,300) 'FRICTION POINT 1'
00308         ENDIF
00309       ENDIF
00310 !
00311 ! ****************************************************************************
00312 ! LOOP OF CALIBRATION
00313 ! ****************************************************************************
00314 !
00315 !     INITIAL STRICKLERS ARE SET IN STRCHE
00316 !     (IF NOT MODIFIED ALL VALUES AT FFON)
00317 !
00318 !     LINES BELOW WILL BE REPEATED WHEN NITERA = 1 IN TELEMAC2D (SEE CALL TO FONSTR)
00319 !     THEY ARE KEPT HERE TO INITIALISE SETSTR2
00320 !
00321       CALL OS('X=C     ',X=CHESTR,C=FFON)
00322       CALL STRCHE
00323       CALL INITSTR(CHESTR,SETSTR,ZONE%I,NZONE,NPOIN,T1)
00324       CALL ASSIGNSTR(CHESTR,SETSTR,ZONE%I,NZONE,NPOIN)
00325 !
00326 95    CONTINUE
00327 !
00328 !
00329 !------------------------------------------------------------------------------
00330 !
00331 !     LIST OF TESTS : READS THE COEFFICIENTS
00332 !
00333 !     SKIPS A COMMENTED LINE
00334       IF(OPTID.EQ.0) READ(T2D_FILES(T2DFO1)%LU,*)
00335 500   CONTINUE
00336 !
00337 !------------------------------------------------------------------------------
00338 !
00339 !     NITERA : NUMBER OF ITERATIONS
00340 !
00341       NITERA = NITERA + 1
00342 !
00343       WRITE(LU,*) ' '
00344       WRITE(LU,*) '------------------'
00345       WRITE(LU,*) 'ITERATION : ',NITERA
00346       WRITE(LU,*) '------------------'
00347       WRITE(LU,*) ' '
00348 !
00349 ! TO PRESERVE THE VALUES OF STRICKLERS'.
00350 !
00351       CALL OS( 'X=Y     ' ,X=SETSTR2 , Y=SETSTR )
00352 !
00353 ! READS THE NEW STRICKLERS IN A FILE IF OPTID=0
00354 !
00355       IF(OPTID.EQ.0) THEN
00356         READ(T2D_FILES(T2DFO1)%LU,*,END=999) ITER,
00357      &       (SETSTR%R(I),I=1,NPARAM)
00358         IF(ITER.NE.NITERA) THEN
00359           IF(LNG.EQ.1) WRITE(LU,*) 'PB. DANS LE PLAN D''EXPERIENCE',
00360      &                             ' ITER=',ITER
00361           IF(LNG.EQ.2) WRITE(LU,*)'PB. IN LIST OF TESTS AT ITER=',ITER
00362           CALL PLANTE(1)
00363           STOP
00364         ENDIF
00365         CALL ASSIGNSTR(CHESTR,SETSTR,ZONE%I,NZONE,NPOIN)
00366       ENDIF
00367 !
00368 ! *** LOOP FOR LAGRANGE INTERPOLATION ***
00369 !
00370       DO ILAGR=1,NLAGR
00371 !
00372         IF(OPTID.EQ.3) THEN
00373           WRITE(LU,*) ' '
00374           WRITE(LU,*) '------------------'
00375           IF(LNG.EQ.1) WRITE(LU,*) 'SOUS-ITERATION : ',ILAGR
00376           IF(LNG.EQ.2) WRITE(LU,*) 'SUB-ITERATION : ',ILAGR
00377           WRITE(LU,*) '------------------'
00378           WRITE(LU,*) ' '
00379         ENDIF
00380 !
00381 !-----------------------------------------------------------------------
00382 !
00383         IF(LNG.EQ.1) WRITE(LU,100)
00384         IF(LNG.EQ.2) WRITE(LU,101)
00385         WRITE(LU,102)
00386 100     FORMAT(/////,1X,'LISTING DE TELEMAC-2D ',78('-'))
00387 101     FORMAT(/////,1X,'LISTING OF TELEMAC-2D ',78('-'))
00388 102     FORMAT(/////,
00389      &14X,'TTTTT  EEEEE  L      EEEEE  M   M  AAAAA  CCCCC',/,
00390      &14X,'  T    E      L      E      MM MM  A   A  C    ',/,
00391      &14X,'  T    EEE    L      EEE    M M M  AAAAA  C    ',/,
00392      &14X,'  T    E      L      E      M   M  A   A  C    ',/,
00393      &14X,'  T    EEEEE  LLLLL  EEEEE  M   M  A   A  CCCCC',/,
00394      &14X,'                                               ',/,
00395      &14X,'        2D    VERSION 6.2     FORTRAN 90       ',/,
00396      &14X,'                                               ',/,
00397      &14X,'DIRECT MODE DIRECT MODE DIRECT MODE DIRECT MODE',/,
00398      &14X,/////)
00399 !
00400       ADJO=.FALSE.
00401       CALL TELEMAC2D(PASS= -1,ATDEP=0.D0,NITER=0,CODE='       ')
00402 !
00403 !  /* TEMPORAL LOOP (COMPUTES THE COST FUNCTION) */
00404 !
00405       JCOUT=0.D0
00406 !
00407 ! SKIPS GEOMETRY
00408 !
00409       REWIND T2D_FILES(T2DRES)%LU
00410 !
00411       CALL SKIPGEO(T2D_FILES(T2DRES)%LU,TITFIC,NPOINRES,NVARRES,TEXRES)
00412       IF(NPOINRES.NE.NPOIN) THEN
00413         WRITE(LU,*) 'ERROR: NPOINRES DIFFERENT FROM NPOIN'
00414         WRITE(LU,*) 'NPOINRES = ',NPOINRES
00415         WRITE(LU,*) 'NPOIN    = ',NPOIN
00416         CALL PLANTE(1)
00417         STOP
00418       ENDIF
00419 !
00420 ! SKIPS INITIAL CONDITION
00421 !
00422       IF(OUTINI) THEN
00423         CALL LITENR(VARSOR,VARCL,T2D_FILES(T2DRES)%LU,'STD',HIST,0,
00424      &              NPOIN,AT1,TEXTE,TEXRES,NVARRES,VARCLA,0,TROUVE,
00425      &              ALIRRES,W,.FALSE.,MAXVAR)
00426       ENDIF
00427 !
00428       ERRH=0.D0
00429       ERRU=0.D0
00430       ERRV=0.D0
00431       IH=0
00432       IU=0
00433       IV=0
00434 !
00435       DO LT=1,NIT
00436 !
00437 !     IN STEADY STATE ONLY THE LAST TIMESTEP IS CONSIDERED
00438 !
00439         IF(     INCLU2(ESTIME,'PERMANENT')
00440      &      .OR.INCLU2(ESTIME,'STEADY'   )  ) THEN
00441 !
00442           IF(LT.EQ.1) THEN
00443             REWIND T2D_FILES(T2DRES)%LU
00444             CALL BIEF_SUITE(VARSOR,VARCL,ITER,T2D_FILES(T2DRES)%LU,
00445      &                      T2D_FILES(T2DRES)%FMT,
00446      &                      HIST,0,NPOIN,AT1,TEXTE,VARCLA,
00447      &                      NVARCL,TROUVE,ALIRRES,LISTIN,.TRUE.,MAXVAR)
00448 !           GETTING MEASUREMENTS AND WEIGHTS AT THE SAME TIME.
00449 !           HERE ALPHA1, ALPHA2 AND ALPHA3 ARE ALSO SET.
00450 !           ITER OF LAST RECORD GIVEN BY THE CALL TO SUITE
00451             CALL MESURES(ITER,AT1)
00452           ENDIF
00453 !
00454         ELSE
00455 !
00456 !  READS TELEMAC2D RESULTS (RESULTS FILE - UNIT NRES)
00457 !
00458           ITER=LT
00459           IF(OUTINI) ITER=ITER+1
00460 !
00461           CALL LITENR(VARSOR,VARCL,T2D_FILES(T2DRES)%LU,'STD',HIST,0,
00462      &                NPOIN,AT1,TEXTE,TEXRES,NVARRES,VARCLA,0,TROUVE,
00463      &               ALIRRES,W,.FALSE.,MAXVAR)
00464 !
00465 !         GETTING MEASUREMENTS AND WEIGHTS AT THE SAME TIME
00466 !
00467 !         HERE ALPHA1, ALPHA2 AND ALPHA3 ARE ALSO SET.
00468           CALL MESURES(ITER,AT1)
00469 !
00470         ENDIF
00471 !
00472 !       COMPUTES THE COST FUNCTION :
00473 !
00474         CALL COST_FUNCTION(JCOUT,OPTCOST,'FCT')
00475 !
00476 !       COMPUTES THE DIFFERENCES BETWEEN MEASUREMENTS AND COMPUTED VALUES
00477 !
00478         CALL ERRMAX(H,HD,C,I)
00479         IF(ERRH.LT.C) THEN
00480           ERRH=C
00481           IH=I
00482         ENDIF
00483         CALL ERRMAX(U,UD,C,I)
00484         IF(ERRU.LT.C) THEN
00485           ERRU=C
00486           IU=I
00487         ENDIF
00488         CALL ERRMAX(V,VD,C,I)
00489         IF(ERRV.LT.C) THEN
00490           ERRV=C
00491           IU=I
00492         ENDIF
00493 !
00494 ! END OF TEMPORAL LOOP (COST FUNCTION COMPUTED)
00495 !
00496       ENDDO
00497 !
00498       IF(NITERA.EQ.1.AND.ILAGR.EQ.1) THEN
00499         IF(JCOUT.GT.0.D0) THEN
00500           JSTEP0=JCOUT
00501         ELSE
00502           JSTEP0=1.D0
00503         ENDIF
00504       ENDIF
00505 !
00506       IF(LNG.EQ.1) THEN
00507 !
00508         WRITE(LU,*)'FONCTION COUT =',JCOUT,' VALEUR INITIALE:',JSTEP0
00509         WRITE(LU,*)'ERREUR MAXIMUM SUR H =',ERRH
00510         WRITE(LU,*)'ERREUR MAXIMUM SUR U =',ERRU
00511         WRITE(LU,*)'ERREUR MAXIMUM SUR V =',ERRV
00512 !
00513       ELSEIF(LNG.EQ.2) THEN
00514 !
00515         WRITE(LU,*) 'COST FUNCTION =',JCOUT,' INITIAL VALUE :',JSTEP0
00516         WRITE(LU,*) 'MAX ERROR ON H =',ERRH
00517         WRITE(LU,*) 'MAX ERROR ON U =',ERRU
00518         WRITE(LU,*) 'MAX ERROR ON V =',ERRV
00519 !
00520       ENDIF
00521 !
00522       IF(ILAGR.EQ.1) THEN
00523         JR = JCOUT/JSTEP0
00524         IF(LNG.EQ.1) WRITE(LU,*) 'FONCTION COUT RELATIVE : ',JR
00525         IF(LNG.EQ.2) WRITE(LU,*) 'RELATIVE COST FUNCTION: ',JR
00526         IF(T2D_FILES(T2DRFO)%NAME(1:1).NE.' ') THEN
00527           IF(DEFZON) THEN
00528             WRITE(T2D_FILES(T2DRFO)%LU,*) NITERA,JR,ERRH,ERRU,ERRV,
00529      &                    (SETSTR%R(I),I=1,NZONE)
00530           ELSE
00531             WRITE(T2D_FILES(T2DRFO)%LU,*) NITERA,JR,ERRH,ERRU,ERRV,
00532      &                     SETSTR%R(1)
00533           ENDIF
00534         ENDIF
00535       ENDIF
00536 !
00537 !
00538 !
00539       IF(OPTID.EQ.0) GO TO 500
00540 !
00541 !
00542 !
00543 !  TEST, DECISIONAL STEP & ADJOINT SYSTEM (ONLY FOR ILAGR=1)
00544 !
00545 !  TEST: TWO CRITERIA
00546 !
00547       IF (ILAGR.EQ.1) THEN
00548 !
00549 !     DECISIONAL STEP :
00550 !
00551         IF(      JR.LE.TOLEST(4).OR.
00552      &        (ERRH.LE.TOLEST(1).AND.
00553      &         ERRU.LE.TOLEST(2).AND.
00554      &         ERRV.LE.TOLEST(3))       ) THEN
00555 !
00556           IF(LISTIN) THEN
00557             IF(LNG.EQ.1) WRITE(LU,395) NITERA
00558             IF(LNG.EQ.2) WRITE(LU,396) NITERA
00559           ENDIF
00560 !
00561 395       FORMAT(/,1X,'------------------------------------------',/
00562      &            ,1X,'    SOLUTION TROUVEE EN ',1I3,' ITERATIONS',/
00563      &            ,1X,'------------------------------------------')
00564 396       FORMAT(/,1X,'-----------------------------------------',/
00565      &            ,1X,'    SOLUTION FOUND IN ',1I3,' ITERATIONS',/
00566      &            ,1X,'-----------------------------------------')
00567           WRITE(LU,*) 'GRADIENT OF ZONE 1 : ',GRADJ%R(1)
00568           WRITE(LU,*) 'STRICKLER OF POINT 10 : ',CHESTR%R(10)
00569           GO TO 999
00570 !
00571         ELSEIF (NITERA.GT.MAXEST) THEN
00572 !
00573           IF(LNG.EQ.1) THEN
00574           WRITE(LU,*) 'PAS DE CONVERGENCE EN ',NITERA,' ITERATIONS'
00575           WRITE(LU,*) 'STRICKLER DU POINT 10 : ',CHESTR%R(10)
00576           WRITE(LU,398) MAXEST,JCOUT
00577 398       FORMAT(1X,'SOLUTION NON TROUVEE APRES ',1I6,1X,
00578      &            'ITERATIONS',/,1X,
00579      &            'PRECISION  :',G16.7,1X,'JCOUTN/JCOUT1 :',G16.7)
00580           ELSEIF(LNG.EQ.2) THEN
00581           WRITE(LU,*) 'NO CONVERGENCE AFTER ',NITERA,' ITERATIONS'
00582           WRITE(LU,*) 'STRICKLER OF POINT 10 : ',CHESTR%R(10)
00583           WRITE(LU,399) MAXEST,JCOUT
00584 399       FORMAT(1X,'SOLUTION NOT FOUND AFTER ',1I6,1X,
00585      &            'ITERATIONS',/,1X,
00586      &            'PRECISION  :',G16.7,1X,'JCOUTN/JCOUT1 :',G16.7)
00587           ENDIF
00588           GO TO 999
00589 !
00590         ELSEIF (JCOUT.GT.JCOUTN.AND..NOT.RSTART) THEN
00591 !
00592           IF(LNG.EQ.1) THEN
00593             WRITE(LU,*) 'LA FONCTION COUT AUGMENTE : STOP'
00594             WRITE(LU,*) 'STRICKLER DU POINT 10 : ',CHESTR%R(10)
00595           ELSEIF(LNG.EQ.2) THEN
00596             WRITE(LU,*) 'COST FUNCTION INCREASES : STOP'
00597             WRITE(LU,*) 'STRICKLER OF POINT 10 : ',CHESTR%R(10)
00598           ENDIF
00599 !         GO TO 999
00600 !
00601         ENDIF
00602 !
00603 ! ADJO  INT SYSTEM
00604 !
00605         IF(LNG.EQ.1) WRITE(LU,403)
00606         IF(LNG.EQ.2) WRITE(LU,404)
00607         WRITE(LU,405)
00608 403     FORMAT(/////,1X,'LISTING D" ESTIMATION',82('-'))
00609 404     FORMAT(/////,1X,'LISTING OF ESTIMATION',82('-'))
00610 405     FORMAT(/////,
00611      &14X,'TTTTT  EEEEE  L      EEEEE  M   M  AAAAA  CCCCC',/,
00612      &14X,'  T    E      L      E      MM MM  A   A  C    ',/,
00613      &14X,'  T    EEE    L      EEE    M M M  AAAAA  C    ',/,
00614      &14X,'  T    E      L      E      M   M  A   A  C    ',/,
00615      &14X,'  T    EEEEE  LLLLL  EEEEE  M   M  A   A  CCCCC',/,
00616      &14X,'                                               ',/,
00617      &14X,'        2D    VERSION 6.2     FORTRAN 90       ',/,
00618      &14X,'                                               ',/,
00619      &14X,' ADJOINT MODE ADJOINT MODE ADJOINT MODE ADJOINT',/,
00620      &14X,/////)
00621 !
00622 !       INITIALISES THE GRADIENT WHICH WILL BE COMPUTED
00623 !       BY PROPAG_ADJ
00624 !
00625         CALL OV('X=C     ',GRADJ%R,GRADJ%R,GRADJ%R,0.D0,NPARAM)
00626 !
00627 !       SERIES OF ADJOINT SYSTEMS
00628 !
00629         ADJO=.TRUE.
00630         CALL TELEMAC2D(PASS= -1,ATDEP=0.D0,
00631      &                 NITER=0,CODE='       ')
00632 !
00633         IF(NZONE.GT.0) THEN
00634           DO I=1,NZONE
00635             WRITE(LU,*) 'GRADJ(',I,')= ',GRADJ%R(I)
00636           ENDDO
00637         ENDIF
00638 !
00639 ! END OF: IF (ILAGR.EQ.1)
00640       ENDIF
00641 !
00642 !
00643       IF(ILAGR.EQ.1) THEN
00644 !
00645 !       GRADIENT METHOD: COMPUTES RHO AND DIRECTION
00646 !       JCOUT1 IS JCOUT FOR RHO=0
00647         JCOUT1=JCOUT
00648         CALL METGRA(ROX,ESTIME,GRADJ,GRADJN,JCOUT1,DESC,NPARAM,OPTID,
00649      &              RSTART,R02,R03)
00650         IF(OPTID.EQ.3) THEN
00651           CALL NEWSTR(SETSTR,SETSTR2,DESC,ROX,RSTART,NPARAM,
00652      &                ESTIME,KFROT)
00653           CALL ASSIGNSTR(CHESTR ,SETSTR,ZONE%I,NZONE,NPOIN)
00654         ENDIF
00655       ELSEIF (ILAGR.EQ.2) THEN
00656 ! JCOUT2 IS JCOUT FOR RHO=ROX
00657         JCOUT2=JCOUT
00658         CALL NEWSTR(SETSTR,SETSTR2,DESC,0.5D0*ROX,RSTART,NPARAM,
00659      &              ESTIME,KFROT)
00660         CALL ASSIGNSTR(CHESTR ,SETSTR,ZONE%I,NZONE,NPOIN)
00661       ELSEIF (ILAGR.EQ.3) THEN
00662 ! JCOUT3 IS JCOUT FOR RHO=1/2 ROX
00663         JCOUT3=JCOUT
00664 !
00665       ENDIF
00666 !
00667 ! *** END OF LAGRANGIAN LOOP ***
00668       ENDDO
00669 !
00670 !  CASE OF A NEW ITERATION:
00671 !
00672 !  COMPUTES THE NEW VALUE OF ROX (IF LAGRANGE)
00673       IF(OPTID.EQ.3) CALL INTERPOL(ROX,R02,R03,JCOUT1,JCOUT2,JCOUT3)
00674 !
00675       WRITE(LU,*) 'ITERATION = ',NITERA
00676       WRITE(LU,*) 'STRICKLERS = ',SETSTR%R(1)
00677       WRITE(LU,*) 'J         = ',JCOUT1
00678       WRITE(LU,*) 'JR        = ',JR
00679 !
00680 !  COMPUTES THE NEW SET OF COEFFICIENTS
00681 !
00682       CALL NEWSTR(SETSTR,SETSTR2,DESC,ROX,RSTART,NPARAM,ESTIME,KFROT)
00683       CALL ASSIGNSTR(CHESTR ,SETSTR,ZONE%I,NZONE,NPOIN)
00684 !
00685 !  COST FUNCTION AND GRADIENT AT PREVIOUS ITERATION
00686 !
00687       JCOUTN=JCOUT1
00688       CALL OV( 'X=Y     ' , GRADJN%R , GRADJ%R, GRADJ%R , C , NPARAM )
00689 !
00690       GOTO 95
00691 !
00692 ! ****************************************************************************
00693 !  END OF LOOP OF CALIBRATION
00694 ! ****************************************************************************
00695 !
00696 999   CONTINUE
00697 !
00698 ! PRINTS INFORMATION ABOUT THE LAST ITERATION
00699 !
00700       WRITE(LU,*) 'ITERATION = ',NITERA
00701       WRITE(LU,*) 'STRICKLERS = ',SETSTR%R(1)
00702       WRITE(LU,*) 'J         = ',JCOUT1
00703       WRITE(LU,*) 'JR        = ',JR
00704 !
00705 !-----------------------------------------------------------------------
00706 !
00707 !     WRITES THE RESULTING GEOMETRY FILE, WHICH WILL ALSO HAVE
00708 !     FRICTION (IN DEBUG MODE, PRINTS OUT THE ADJOINT VARIABLES
00709 !     INSTEAD, SEE IN TELEMAC-2D)
00710 !
00711       IF(.NOT.INCLU2(ESTIME,'DEBUG')) THEN
00712 !
00713         CALL ECRGEO(MESH%X%R,MESH%Y%R,MESH%NPOIN,MESH%NBOR%I,
00714      &              T2D_FILES(T2DRBI)%LU,NVAR,TEXTE,VARCLA,NVARCL,
00715      &              TITCAS,SORLEOA,MAXVAR,MESH%IKLE%I,
00716      &              MESH%NELEM,MESH%NPTFR,3,MARDAT,MARTIM,
00717      &              NCSIZE,NPTIR,MESH%KNOLG%I,I3=I_ORIG,I4=J_ORIG)
00718         CALL BIEF_DESIMP('SERAFIN ',VARSOR,
00719      &                   HIST,0,NPOIN,T2D_FILES(T2DRBI)%LU,
00720      &                   'STD',0.D0,0,LISPRD,LEOPRD,
00721      &                   SORLEOA,SORIMPA,MAXVAR,TEXTE,0,0)
00722 !
00723       ENDIF
00724 !
00725 !-----------------------------------------------------------------------
00726 !
00727       RETURN
00728       END

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