precd1.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\precd1.f
00002 !
00068                      SUBROUTINE PRECD1
00069 !                    *****************
00070 !
00071      &(X,A,B,D,MESH,PRECON,PREXSM,DIADON)
00072 !
00073 !***********************************************************************
00074 ! BIEF   V6P1                                   21/08/2010
00075 !***********************************************************************
00076 !
00077 !
00078 !
00079 !
00080 !
00081 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00082 !| A              |-->| BLOCK OF MATRICES
00083 !| B              |-->| BLOCK OF RIGHT-HAND SIZES
00084 !| D              |<--| BLOCK OF DIAGONALS
00085 !| DIADON         |-->| .TRUE. : DIAGONALS ARE GIVEN
00086 !| MESH           |-->| MESH STRUCTURE
00087 !| PRECON         |-->| CHOICE OF PRECONDITIONING
00088 !| PREXSM         |-->| .TRUE. : PRECONDITIONING X AND B
00089 !| X              |<->| BLOCK OF UNKNOWN VECTORS IN THE SYSTEM
00090 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00091 !
00092       USE BIEF, EX_PRECD1 => PRECD1
00093 !
00094       IMPLICIT NONE
00095       INTEGER LNG,LU
00096       COMMON/INFO/LNG,LU
00097 !
00098 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00099 !
00100       INTEGER, INTENT(IN) :: PRECON
00101 !
00102       LOGICAL, INTENT(IN) :: PREXSM,DIADON
00103 !
00104 !-----------------------------------------------------------------------
00105 !
00106 !  VECTOR STRUCTURES
00107 !
00108       TYPE(BIEF_OBJ), INTENT(INOUT) :: X,B,D
00109 !
00110 !-----------------------------------------------------------------------
00111 !
00112 !  MATRIX STRUCTURES
00113 !
00114       TYPE(BIEF_OBJ), INTENT(INOUT) :: A
00115 !
00116 !-----------------------------------------------------------------------
00117 !
00118 !  MESH STRUCTURE
00119 !
00120       TYPE(BIEF_MESH), INTENT(INOUT) :: MESH
00121 !
00122 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00123 !
00124       DOUBLE PRECISION C
00125 !
00126 !-----------------------------------------------------------------------
00127 !
00128 !  PREPARES THE DIAGONALS:
00129 !
00130       IF(.NOT.DIADON) THEN
00131 !
00132 !  COMPUTES THE SQUARE ROOTS OF THE ABSOLUTE VALUES OR OF THE VALUES
00133 !
00134         IF(PRECON.EQ.5) THEN
00135           CALL OS( 'X=ABS(Y)' , X=D , Y=A%D )
00136         ELSE
00137           CALL OS( 'X=Y     ' , X=D , Y=A%D )
00138         ENDIF
00139 !
00140 !  PARALLEL MODE: COMPLETE DIAGONAL BEFORE TAKING THE SQUARE ROOT
00141 !
00142         IF(NCSIZE.GT.1) THEN
00143           CALL PARCOM(D,2,MESH)
00144         ENDIF
00145 !
00146         CALL OS( 'X=SQR(Y)' , X=D , Y=D )
00147 !
00148 !-----------------------------------------------------------------------
00149 !                                         -1
00150 !  CHANGE OF VARIABLES (D ACTUALLY HOLDS D  )
00151 !
00152         IF(PREXSM) CALL OS( 'X=XY    ' , X , D , D , C )
00153 !
00154 !-----------------------------------------------------------------------
00155 !
00156 !  COMPUTES THE INVERSE OF THE SQUARE ROOTS OF THE DIAGONALS
00157 !  THIS GIVES BACK TRUE D AND NOT D INVERTED
00158 !
00159         CALL OS( 'X=1/Y   ' , D , D , D , C , 2 , 1.D0 , 1.D-10 )
00160 !
00161       ELSE
00162 !
00163 !  CASE WHERE D IS GIVEN, CHANGE OF VARIABLES
00164 !  CHANGE OF VARIABLE (D REALLY HOLDS D)
00165 !
00166         IF(PREXSM) THEN
00167           CALL OS( 'X=Y/Z   ' , X=X , Y=X , Z=D )
00168         ENDIF
00169 !
00170       ENDIF
00171 !
00172 !=======================================================================
00173 ! PRECONDITIONING OF A:
00174 !=======================================================================
00175 !
00176       CALL OM( 'M=DMD   ' , A , A , D , C , MESH )
00177 !     IF PRECON = 2 OR 3
00178       IF((2*(PRECON/2).EQ.PRECON.OR.3*(PRECON/3).EQ.PRECON).AND.
00179      &                                                 .NOT.DIADON) THEN
00180 !       VALID ONLY WITH ONE SINGLE DOMAIN
00181         IF(NCSIZE.LE.1.OR.NPTIR.EQ.0) A%TYPDIA='I'
00182       ENDIF
00183 !
00184 !=======================================================================
00185 !
00186 ! PRECONDITIONING OF THE SECOND MEMBER
00187 !
00188       IF(PREXSM) CALL OS( 'X=XY    ' , X=B , Y=D )
00189 !
00190 !=======================================================================
00191 !
00192       RETURN
00193       END

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