errmin.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\errmin.f
00002 !
00084                      SUBROUTINE ERRMIN
00085 !                    *****************
00086 !
00087      &(X, A,B , MESH, D,AD,G,R, CFG,INFOGR,AUX)
00088 !
00089 !***********************************************************************
00090 ! BIEF   V6P1                                   21/08/2010
00091 !***********************************************************************
00092 !
00093 !
00094 !
00095 !
00096 !
00097 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00098 !| A              |-->| MATRIX OF THE SYSTEM
00099 !| AD             |<->| WORK ARRAY: MATRICE A MULTIPLIED BY D.
00100 !| AUX            |-->| MATRIX FOR PRECONDITIONING.
00101 !| B              |-->| RIGHT-HAND SIDE OF THE SYSTEM
00102 !| CFG            |-->| STRUCTURE OF SOLVER CONFIGURATION
00103 !| D              |<->| WORK ARRAY: DIRECTION OF DESCENT.
00104 !| G              |<->| DESCENT GRADIENT.
00105 !| INFOGR         |-->| IF YES, PRINT A LOG.
00106 !| MESH           |-->| MESH STRUCTURE.
00107 !| R              |<->| RESIDUAL (MAY BE IN THE SAME MEMORY SPACE AS
00108 !|                |   | GRADIENT DEPENDING ON CONDITIONING)
00109 !| X              |<->| INITIAL VALUE, THEN SOLUTION
00110 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00111 !
00112       USE BIEF, EX_ERRMIN => ERRMIN
00113 !
00114       IMPLICIT NONE
00115       INTEGER LNG,LU
00116       COMMON/INFO/LNG,LU
00117 !
00118 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00119 !
00120       TYPE(SLVCFG), INTENT(INOUT)    :: CFG
00121       TYPE(BIEF_OBJ), INTENT(INOUT)  :: B
00122       TYPE(BIEF_OBJ), INTENT(INOUT)  :: D,AD,G,R,X
00123       TYPE(BIEF_MESH), INTENT(INOUT) :: MESH
00124       TYPE(BIEF_OBJ), INTENT(IN)     :: A
00125       TYPE(BIEF_OBJ), INTENT(INOUT)  :: AUX
00126       LOGICAL, INTENT(IN)            :: INFOGR
00127 !
00128 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00129 !
00130       INTEGER M
00131 !
00132       DOUBLE PRECISION XL,RMRM,TESTL,DD
00133       DOUBLE PRECISION BETA,RO,GMGM,GM1GM1
00134       DOUBLE PRECISION STO2,TGMTGM,C
00135 !
00136       LOGICAL RELAT,PREC,CROUT,GSEB
00137 !
00138 !-----------------------------------------------------------------------
00139 !
00140       INTRINSIC SQRT
00141 !
00142 !-----------------------------------------------------------------------
00143 !
00144 !   INITIALISES
00145 !     STO2 AVOIDS A WARNING WITH CRAY COMPILERS
00146       STO2  =0.D0
00147       CROUT =.FALSE.
00148       IF(7*(CFG%PRECON/7).EQ.CFG%PRECON) CROUT=.TRUE.
00149       GSEB=.FALSE.
00150       IF(11*(CFG%PRECON/11).EQ.CFG%PRECON) GSEB=.TRUE.
00151       PREC=.FALSE.
00152       IF(CROUT.OR.GSEB.OR.13*(CFG%PRECON/13).EQ.CFG%PRECON) PREC=.TRUE.
00153 !
00154 !-----------------------------------------------------------------------
00155 !   INITIALISES
00156 !-----------------------------------------------------------------------
00157 !
00158       M   = 0
00159 !
00160 !  NORMALISES THE SECOND MEMBER TO COMPUTE THE RELATIVE PRECISION:
00161 !
00162       XL = P_DOTS(B,B,MESH)
00163       IF(XL.LT.1.D0) THEN
00164         XL = 1.D0
00165         RELAT = .FALSE.
00166       ELSE
00167         RELAT = .TRUE.
00168       ENDIF
00169 !
00170 ! COMPUTES THE INITIAL RESIDUAL AND POSSIBLY EXITS:
00171 !
00172       CALL MATRBL( 'X=AY    ',R,A,X,  C,MESH)
00173 !
00174       CALL OS( 'X=X-Y   ' , R , B , B , C )
00175       RMRM   = P_DOTS(R,R,MESH)
00176       GMGM   = RMRM
00177 !
00178       IF (RMRM.LT.CFG%EPS**2*XL) GO TO 900
00179 !
00180 !-----------------------------------------------------------------------
00181 ! PRECONDITIONING :
00182 !-----------------------------------------------------------------------
00183 !
00184       IF(PREC) THEN
00185 !
00186 !       COMPUTES C G0 = R
00187         CALL DOWNUP(G, AUX , R , 'D' , MESH)
00188 !
00189 !  C IS HERE CONSIDERED SYMMETRICAL,
00190 !  SHOULD OTHERWISE SOLVE TC GPRIM = G
00191 !
00192 !        T -1
00193 !         C   G   IS PUT IN B
00194         CALL DOWNUP(B , AUX , G , 'T' , MESH)
00195         GMGM   = P_DOTS(G,G,MESH)
00196         STO2   = GMGM
00197 !
00198       ENDIF
00199 !
00200 !-----------------------------------------------------------------------
00201 ! COMPUTES THE DIRECTION OF INITIAL DESCENT:
00202 !-----------------------------------------------------------------------
00203 !
00204       IF(PREC) THEN
00205         CALL MATRBL( 'X=TAY   ',D,A,B,  C,MESH)
00206       ELSE
00207         CALL MATRBL( 'X=TAY   ',D,A,G,  C,MESH)
00208       ENDIF
00209 !
00210       TGMTGM = P_DOTS(D,D,MESH)
00211 !
00212 !-----------------------------------------------------------------------
00213 ! COMPUTES THE INITIAL PRODUCT A D:
00214 !-----------------------------------------------------------------------
00215 !
00216       CALL MATRBL( 'X=AY    ',AD,A,D,  C,MESH)
00217 !
00218 !-----------------------------------------------------------------------
00219 ! COMPUTES INITIAL RO:
00220 !-----------------------------------------------------------------------
00221 !
00222       RO = GMGM/TGMTGM
00223 !
00224 !-----------------------------------------------------------------------
00225 !
00226 ! COMPUTES X1 = X0 - RO  * D
00227 !
00228       CALL OS( 'X=X+CY  ' , X , D , D , -RO )
00229 !
00230 !-----------------------------------------------------------------------
00231 !  ITERATIONS LOOP:
00232 !-----------------------------------------------------------------------
00233 !
00234 2     M  = M  + 1
00235 !
00236 !-----------------------------------------------------------------------
00237 ! COMPUTES THE RESIDUAL : R(M) = R(M-1) - RO(M-1) A D(M-1)
00238 !-----------------------------------------------------------------------
00239 !
00240       CALL OS( 'X=X+CY  ' , R , AD , AD , -RO )
00241 !
00242 !  SOME VALUES WILL CHANGE IN CASE OF PRECONDITIONING
00243 !
00244       GM1GM1 = GMGM
00245       RMRM   = P_DOTS(R,R,MESH)
00246       GMGM   = RMRM
00247 !
00248 ! CHECKS END :
00249 !
00250       IF (RMRM.LE.XL*CFG%EPS**2) GO TO 900
00251 !
00252 !-----------------------------------------------------------------------
00253 ! PRECONDITIONING : SOLVES C G = R
00254 !-----------------------------------------------------------------------
00255 !
00256       IF(PREC) THEN
00257 !
00258 !       SOLVES C G = R
00259         CALL DOWNUP(G, AUX , R , 'D' , MESH)
00260 !
00261         CALL DOWNUP(B , AUX , G , 'T' , MESH)
00262         GM1GM1 = STO2
00263         GMGM = P_DOTS(G,G,MESH)
00264         STO2 = GMGM
00265 !
00266       ENDIF
00267 !
00268 !-----------------------------------------------------------------------
00269 ! COMPUTES D BY RECURRENCE:
00270 !-----------------------------------------------------------------------
00271 !
00272       IF(PREC) THEN
00273 !                                          T  T -1          T -1
00274 !                               AD IS HERE  A  C  G    B IS  C   G
00275         CALL MATRBL( 'X=TAY   ',AD,A,B,  C,MESH)
00276       ELSE
00277 !                               AD IS HERE TAG
00278         CALL MATRBL( 'X=TAY   ',AD,A,G,  C,MESH)
00279       ENDIF
00280 !
00281       BETA = GMGM/GM1GM1
00282 !
00283       CALL OS( 'X=CX    ' , D , D , D , BETA )
00284 !
00285 !                               AD IS HERE TAG
00286       CALL OS( 'X=X+Y   ' , D , AD , AD , C   )
00287 !
00288 !-----------------------------------------------------------------------
00289 ! COMPUTES A D :
00290 !-----------------------------------------------------------------------
00291 !
00292       CALL MATRBL( 'X=AY    ',AD,A,D,  C,MESH)
00293 !
00294 !-----------------------------------------------------------------------
00295 ! COMPUTES RO
00296 !-----------------------------------------------------------------------
00297 !
00298       DD = P_DOTS(D,D,MESH)
00299       RO = GMGM/DD
00300 !
00301 ! COMPUTES X(M) = X(M-1) - RO * D
00302 !
00303       CALL OS( 'X=X+CY  ' , X , D , D , -RO )
00304 !
00305       IF(M.LT.CFG%NITMAX) GO TO 2
00306 !
00307 !-----------------------------------------------------------------------
00308 !
00309 !     IF(INFOGR) THEN
00310         TESTL = SQRT( RMRM / XL )
00311         IF (RELAT) THEN
00312            IF (LNG.EQ.1) WRITE(LU,103) M,TESTL
00313            IF (LNG.EQ.2) WRITE(LU,104) M,TESTL
00314         ELSE
00315            IF (LNG.EQ.1) WRITE(LU,203) M,TESTL
00316            IF (LNG.EQ.2) WRITE(LU,204) M,TESTL
00317         ENDIF
00318 !     ENDIF
00319       GO TO 1000
00320 !
00321 !-----------------------------------------------------------------------
00322 !
00323 900   CONTINUE
00324 !
00325       IF(INFOGR) THEN
00326         TESTL = SQRT( RMRM / XL )
00327         IF (RELAT) THEN
00328            IF (LNG.EQ.1) WRITE(LU,101) M,TESTL
00329            IF (LNG.EQ.2) WRITE(LU,102) M,TESTL
00330         ELSE
00331            IF (LNG.EQ.1) WRITE(LU,201) M,TESTL
00332            IF (LNG.EQ.2) WRITE(LU,202) M,TESTL
00333         ENDIF
00334       ENDIF
00335 !
00336 1000  RETURN
00337 !
00338 !-----------------------------------------------------------------------
00339 !
00340 !   FORMATS
00341 !
00342 101   FORMAT(1X,'ERRMIN (BIEF) : ',
00343      &                     1I8,' ITERATIONS, PRECISION RELATIVE:',G16.7)
00344 102   FORMAT(1X,'ERRMIN (BIEF) : ',
00345      &                     1I8,' ITERATIONS, RELATIVE PRECISION:',G16.7)
00346 201   FORMAT(1X,'ERRMIN (BIEF) : ',
00347      &                     1I8,' ITERATIONS, PRECISION ABSOLUE :',G16.7)
00348 202   FORMAT(1X,'ERRMIN (BIEF) : ',
00349      &                     1I8,' ITERATIONS, ABSOLUTE PRECISION:',G16.7)
00350 103   FORMAT(1X,'ERRMIN (BIEF) : MAX D'' ITERATIONS ATTEINT:',
00351      &                     1I8,' PRECISION RELATIVE:',G16.7)
00352 104   FORMAT(1X,'ERRMIN (BIEF) : EXCEEDING MAXIMUM ITERATIONS:',
00353      &                     1I8,' RELATIVE PRECISION:',G16.7)
00354 203   FORMAT(1X,'ERRMIN (BIEF) : MAX D'' ITERATIONS ATTEINT:',
00355      &                     1I8,' PRECISION ABSOLUE :',G16.7)
00356 204   FORMAT(1X,'ERRMIN (BIEF) : EXCEEDING MAXIMUM ITERATIONS:',
00357      &                     1I8,' ABSOLUTE PRECISON:',G16.7)
00358 !
00359 !-----------------------------------------------------------------------
00360 !
00361       END

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