sd_fabcad.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\sd_fabcad.f
00002 !
00070                      SUBROUTINE SD_FABCAD
00071 !                    ********************
00072 !
00073      &(NPBLK,NSEGBLK,IN,IP,ISEGIP,
00074      & INDTRI,ISTRI,INX,IPX,ACTRI,XA1,XA2,DA,AC)
00075 !
00076 !***********************************************************************
00077 ! BIEF   V6P2                                   21/07/2011
00078 !***********************************************************************
00079 !
00080 !
00081 !
00082 !
00083 !
00084 !
00085 !
00086 !
00087 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00088 !| AC             |<--|COMPACT STORED MATRIX WITH DIAGONAL
00089 !| ACTRI          |---|REAL WORKING STORAGE
00090 !| DA             |-->|MATRIX DIAGONAL COEFFICIENTS
00091 !| (IN,IP)        |-->|STRUCTURE WITHOUT THE DIAGONAL
00092 !| INDTRI         |---|INTEGER WORKING STORAGE
00093 !| (INX,IPX)      |<--|STRUCTURE WITH THE DIAGONAL
00094 !| ISEGIP         |-->|INVERSE TABLE OF CONNECTIVITY: POINT ---> SEGMENT
00095 !| ISTRI          |---|INTEGER WORKING STORAGE
00096 !| NPBLK          |-->| SIZE OF MATRIX DIAGONAL
00097 !| NSEGBLK        |-->| NUMBER OF SEGMENTS IN ORIGINAL MATRIX
00098 !| XA1            |-->| OFF-DIAGONAL TERM OF MATRIX A
00099 !| XA2            |-->| OFF-DIAGONAL TERM OF MATRIX A
00100 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00101 !
00102       USE BIEF, EX_SD_FABCAD => SD_FABCAD
00103 !
00104       IMPLICIT NONE
00105       INTEGER LNG,LU
00106       COMMON/INFO/LNG,LU
00107 !
00108 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00109 !
00110       INTEGER, INTENT(IN)             :: NPBLK,NSEGBLK
00111       INTEGER, INTENT(IN)             :: IN(NPBLK+1),IP(NSEGBLK*2)
00112       INTEGER, INTENT(IN)             :: ISEGIP(NSEGBLK*2)
00113       INTEGER, INTENT(INOUT)          :: INDTRI(NPBLK)
00114       INTEGER, INTENT(INOUT)          :: ISTRI(NPBLK)
00115       INTEGER, INTENT(INOUT)          :: INX(NPBLK+1)
00116       INTEGER, INTENT(INOUT)          :: IPX(NSEGBLK*2+NPBLK)
00117       DOUBLE PRECISION, INTENT(INOUT) :: ACTRI(NPBLK)
00118       DOUBLE PRECISION, INTENT(IN)    :: XA1(NSEGBLK),XA2(NSEGBLK)
00119       DOUBLE PRECISION, INTENT(IN)    :: DA(NPBLK)
00120       DOUBLE PRECISION, INTENT(INOUT) :: AC(NSEGBLK*2+NPBLK)
00121 !
00122 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00123 !
00124       INTEGER I,J,J1,J2,JN,ISEG,ND
00125 !
00126 !-----------------------------------------------------------------------
00127 !
00128 !---> COMPACT STORAGE WITH THE DIAGONAL ADDED : (XADJ, ADJNCY) = (INX,IPX)
00129 !
00130       DO I = 1, NPBLK+1
00131         INX(I) = IN(I)+I-1
00132       ENDDO
00133 !
00134 !     J2 WILL BE THE ADDRESS IN AC
00135       J2=0
00136       DO I = 1, NPBLK
00137         IPX(INX(I)) = I
00138 !       DIAGONAL AS FIRST COEFFICIENT OF THE LIST
00139         J2=J2+1
00140 !       NOTE: HERE J2=INX(I)
00141         AC(INX(I)) = DA(I)
00142 !       LOOP ON MATRIX COEFFICIENTS OF POINT I
00143 !       EXCLUDING DIAGONAL TERMS AT ADDRESS INX(I)
00144         DO J1 = INX(I)+1, INX(I+1)-1
00145 !         BACK TO ADDRESS WITHOUT THE DIAGONAL
00146           JN = J1-I
00147           J = IP(JN)
00148           J2=J2+1
00149           ISEG = ISEGIP(JN)
00150           IPX(J2) = J
00151           IF(ISEG.LT.0) THEN
00152             AC(J2) = XA1(-ISEG)
00153           ELSEIF(ISEG.GT.0) THEN
00154             AC(J2) = XA2(ISEG)
00155           ENDIF
00156         ENDDO
00157       ENDDO
00158       DO I = 1, NPBLK
00159         ND = INX(I+1)-INX(I)
00160         DO J = 1,ND
00161           ISTRI(J) = IPX(INX(I)+J-1)
00162           ACTRI(J) = AC(INX(I)+J-1)
00163         ENDDO
00164         CALL SD_STRTRI(ISTRI,ND,INDTRI)
00165         DO J = 1,ND
00166           J1 = INDTRI(J)
00167           IPX(INX(I)+J-1) = ISTRI(J1)
00168           AC(INX(I)+J-1) = ACTRI(J1)
00169         ENDDO
00170       ENDDO
00171 !
00172 !-----------------------------------------------------------------------
00173 !
00174       RETURN
00175       END

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