metgra.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\telemac2d\metgra.f
00002 !
00061                      SUBROUTINE METGRA
00062 !                    *****************
00063 !
00064      &(RO,ESTIME,GRADJ,GRADJN,JCOUT1,DESC,NPARAM,OPTID,RSTART,R02,R03)
00065 !
00066 !***********************************************************************
00067 ! TELEMAC2D   V6P1                                   21/08/2010
00068 !***********************************************************************
00069 !
00070 !
00071 !
00072 !
00073 !
00074 !
00075 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00076 !| DESC           |<--| VECTOR USED TO CHANGE THE SET OF STRICKLERS'
00077 !| ESTIME         |---| ?????? NOT USED
00078 !| GRADJ          |-->| GRADIENT OF COST FUNCTION (ITERATION K)
00079 !| GRADJN         |-->| GRADIENT OF COST FUNCTION (ITERATION K-1)
00080 !| JCOUT1         |-->| COST FUNCTION
00081 !| NPARAM         |-->| TOTAL NUMBER OF PARAMETERS TO ESTIMATE
00082 !| OPTID          |-->| METHOD 1=GRADIENT, 2=GRADIENT CONJUGUE, 3=LAGRANGE)
00083 !| R02            |<--| COEFFICIENT IN THE GRADIENT METHOD
00084 !| R03            |<--| COEFFICIENT IN THE GRADIENT METHOD
00085 !| RO             |<->| COEFFICIENT OF THE GRADIENT
00086 !| RSTART         |-->| IF YES, STARTING FROM SCRATCH
00087 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00088 !
00089       USE BIEF
00090 !
00091       IMPLICIT NONE
00092       INTEGER LNG,LU
00093       COMMON/INFO/LNG,LU
00094 !
00095 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00096 !
00097       INTEGER , INTENT(IN)             :: NPARAM,OPTID
00098       CHARACTER(LEN=72)                :: ESTIME
00099       DOUBLE PRECISION , INTENT(IN)    :: JCOUT1
00100       LOGICAL , INTENT(IN)             :: RSTART
00101       TYPE(BIEF_OBJ) , INTENT(IN)      :: GRADJ,GRADJN
00102       TYPE(BIEF_OBJ) , INTENT(INOUT)   :: DESC
00103       DOUBLE PRECISION , INTENT(INOUT) :: R02,R03,RO
00104 !
00105 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00106 !
00107       INTEGER I
00108 !
00109       DOUBLE PRECISION R1,DENOM,GRAD_JN
00110 !
00111 !     COMPUTES THE TRUE GRADIENT (WHICH TAKES THE TRUE NUMBER OF
00112 !                                           PARAMETERS INTO ACCOUNT)
00113       DENOM=0.D0
00114       GRAD_JN=0.D0
00115       DO I = 1,NPARAM
00116         DENOM  = DENOM + GRADJ%R(I)**2
00117         GRAD_JN=GRAD_JN+GRADJN%R(I)**2
00118       ENDDO
00119 !
00120       IF(DENOM.LT.1.D-12) THEN
00121         IF(LNG.EQ.1) WRITE(LU,*) 'METGRA : GRADIENT TROP PETIT, ARRET'
00122         IF(LNG.EQ.2) WRITE(LU,*) 'METGRA: GRADIENT TOO SMALL, STOP'
00123         WRITE(LU,*) 'DENOM = ',DENOM
00124         CALL PLANTE(1)
00125         STOP
00126       ENDIF
00127 !
00128 !-----------------------------------------------------------------------
00129 !     RO = - JCOUT / GRADJ*GRADJ
00130 !-----------------------------------------------------------------------
00131 !
00132       IF(OPTID.EQ.1.OR.OPTID.EQ.3.OR.RSTART) THEN
00133 !
00134         R02 = - JCOUT1 / DENOM
00135         RO = R02
00136         R03=0.5D0*R02
00137 !
00138 !       COMPUTES THE DIRECTION OF INITIAL DESCENT
00139 !
00140         CALL OV('X=Y     ',DESC%R,GRADJ%R,GRADJ%R,0.D0,NPARAM)
00141 !
00142 !-----------------------------------------------------------------------
00143 !
00144       ELSEIF(OPTID.EQ.2) THEN
00145 !
00146         R02 = - JCOUT1 / DENOM
00147 !
00148         R1 = GRAD_JN/DENOM
00149 !
00150 !       COMPUTES THE DIRECTION OF DESCENT
00151 !
00152         CALL OV('X=Y+CZ  ',DESC%R,GRADJ%R,DESC%R,R1,NPARAM)
00153 !
00154         DENOM=0.D0
00155         DO I=1,NPARAM
00156            DENOM=DENOM+GRADJ%R(I)*DESC%R(I)
00157         ENDDO
00158         R03 = - JCOUT1/DENOM
00159         RO =R03
00160 !
00161       ENDIF
00162 !
00163 !-----------------------------------------------------------------------
00164 !
00165       RETURN
00166       END

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