mer41.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\mer41.f
00002 !
00068                      SUBROUTINE MER41
00069 !                    ****************
00070 !
00071      &(X, XA1 ,XA2 ,XA3 ,XA4 ,XA5 ,
00072      &    XA6 ,XA7 ,XA8 ,XA9 ,XA10,
00073      &    XA11,XA12,XA13,XA14,XA15,
00074      &    IKLE1,IKLE2,IKLE3,IKLE4,IKLE5,IKLE6,
00075      &    NELEM,NELMAX,NPOIN,LV)
00076 !
00077 !***********************************************************************
00078 ! BIEF   V6P1                                   21/08/2010
00079 !***********************************************************************
00080 !
00081 !
00082 !
00083 !
00084 !
00085 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00086 !| IKLE1          |-->| FIRST POINTS OF PRISMS
00087 !| IKLE2          |-->| SECOND POINTS OF PRISMS
00088 !| IKLE3          |-->| THIRD POINTS OF PRISMS
00089 !| IKLE4          |-->| FOUTH POINTS OF PRISMS
00090 !| IKLE5          |-->| FIFTH POINTS OF PRISMS
00091 !| IKLE6          |-->| SIXTH POINTS OF PRISMS
00092 !| LV             |-->| VECTOR LENGTH OF THE MACHINE
00093 !| NELEM          |-->| NUMBER OF ELEMENTS
00094 !| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS
00095 !| NPOIN          |-->| NUMBER OF POINTS
00096 !| X              |<--| RESULTING VECTOR
00097 !| XA10           |-->| OFF-DIAGONAL TERM
00098 !| XA11           |-->| OFF-DIAGONAL TERM
00099 !| XA12           |-->| OFF-DIAGONAL TERM
00100 !| XA13           |-->| OFF-DIAGONAL TERM
00101 !| XA14           |-->| OFF-DIAGONAL TERM
00102 !| XA15           |-->| OFF-DIAGONAL TERM
00103 !| XA2            |-->| OFF-DIAGONAL TERM
00104 !| XA3            |-->| OFF-DIAGONAL TERM
00105 !| XA4            |-->| OFF-DIAGONAL TERM
00106 !| XA5            |-->| OFF-DIAGONAL TERM
00107 !| XA6            |-->| OFF-DIAGONAL TERM
00108 !| XA7            |-->| OFF-DIAGONAL TERM
00109 !| XA8            |-->| OFF-DIAGONAL TERM
00110 !| XA9            |-->| OFF-DIAGONAL TERM
00111 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00112 !
00113       IMPLICIT NONE
00114       INTEGER LNG,LU
00115       COMMON/INFO/LNG,LU
00116 !
00117 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00118 !
00119       INTEGER, INTENT(IN) :: NPOIN,NELEM,NELMAX,LV
00120       INTEGER, INTENT(IN) :: IKLE1(NELMAX),IKLE2(NELMAX),IKLE3(NELMAX)
00121       INTEGER, INTENT(IN) :: IKLE4(NELMAX),IKLE5(NELMAX),IKLE6(NELMAX)
00122 !
00123       DOUBLE PRECISION, INTENT(INOUT) :: X(NPOIN)
00124       DOUBLE PRECISION, INTENT(IN) :: XA1(NELMAX),XA2(NELMAX)
00125       DOUBLE PRECISION, INTENT(IN) :: XA3(NELMAX)
00126       DOUBLE PRECISION, INTENT(IN) :: XA4(NELMAX),XA5(NELMAX)
00127       DOUBLE PRECISION, INTENT(IN) :: XA6(NELMAX)
00128       DOUBLE PRECISION, INTENT(IN) :: XA7(NELMAX),XA8(NELMAX)
00129       DOUBLE PRECISION, INTENT(IN) :: XA9(NELMAX)
00130       DOUBLE PRECISION, INTENT(IN) :: XA10(NELMAX),XA11(NELMAX)
00131       DOUBLE PRECISION, INTENT(IN) :: XA12(NELMAX)
00132       DOUBLE PRECISION, INTENT(IN) :: XA13(NELMAX),XA14(NELMAX)
00133       DOUBLE PRECISION, INTENT(IN) :: XA15(NELMAX)
00134 !
00135 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00136 !
00137       INTEGER IELEM,IB
00138 !
00139       INTRINSIC MIN
00140 !
00141 !-----------------------------------------------------------------------
00142 !
00143 ! RESUMES INVERSION OF THE LOWER TRIANGULAR MATRICES
00144 !
00145 !-----------------------------------------------------------------------
00146 ! LOOP IN SCALAR MODE (LV=1) OR WITH FORCED VECTORISATION
00147 !-----------------------------------------------------------------------
00148 !
00149       IF(LV.EQ.1) THEN
00150 !
00151 !  SCALAR MODE
00152 !
00153       DO IELEM = 1 , NELEM
00154           X(IKLE1(IELEM))=X(IKLE1(IELEM))+XA5 (IELEM)*X(IKLE6(IELEM))
00155      &                                   +XA4 (IELEM)*X(IKLE5(IELEM))
00156      &                                   +XA3 (IELEM)*X(IKLE4(IELEM))
00157      &                                   +XA2 (IELEM)*X(IKLE3(IELEM))
00158      &                                   +XA1 (IELEM)*X(IKLE2(IELEM))
00159           X(IKLE2(IELEM))=X(IKLE2(IELEM))+XA9 (IELEM)*X(IKLE6(IELEM))
00160      &                                   +XA8 (IELEM)*X(IKLE5(IELEM))
00161      &                                   +XA7 (IELEM)*X(IKLE4(IELEM))
00162      &                                   +XA6 (IELEM)*X(IKLE3(IELEM))
00163           X(IKLE3(IELEM))=X(IKLE3(IELEM))+XA12(IELEM)*X(IKLE6(IELEM))
00164      &                                   +XA11(IELEM)*X(IKLE5(IELEM))
00165      &                                   +XA10(IELEM)*X(IKLE4(IELEM))
00166           X(IKLE4(IELEM))=X(IKLE4(IELEM))+XA14(IELEM)*X(IKLE6(IELEM))
00167      &                                   +XA13(IELEM)*X(IKLE5(IELEM))
00168           X(IKLE5(IELEM))=X(IKLE5(IELEM))+XA15(IELEM)*X(IKLE6(IELEM))
00169       ENDDO ! IELEM
00170 !
00171       ELSE
00172 !
00173 !  VECTOR MODE
00174 !
00175       DO IB = 1,(NELEM+LV-1)/LV
00176 !VOCL LOOP,NOVREC
00177 !DIR$ IVDEP
00178       DO IELEM = 1+(IB-1)*LV , MIN(NELEM,IB*LV)
00179           X(IKLE1(IELEM))=X(IKLE1(IELEM))+XA5 (IELEM)*X(IKLE6(IELEM))
00180      &                                   +XA4 (IELEM)*X(IKLE5(IELEM))
00181      &                                   +XA3 (IELEM)*X(IKLE4(IELEM))
00182      &                                   +XA2 (IELEM)*X(IKLE3(IELEM))
00183      &                                   +XA1 (IELEM)*X(IKLE2(IELEM))
00184           X(IKLE2(IELEM))=X(IKLE2(IELEM))+XA9 (IELEM)*X(IKLE6(IELEM))
00185      &                                   +XA8 (IELEM)*X(IKLE5(IELEM))
00186      &                                   +XA7 (IELEM)*X(IKLE4(IELEM))
00187      &                                   +XA6 (IELEM)*X(IKLE3(IELEM))
00188           X(IKLE3(IELEM))=X(IKLE3(IELEM))+XA12(IELEM)*X(IKLE6(IELEM))
00189      &                                   +XA11(IELEM)*X(IKLE5(IELEM))
00190      &                                   +XA10(IELEM)*X(IKLE4(IELEM))
00191           X(IKLE4(IELEM))=X(IKLE4(IELEM))+XA14(IELEM)*X(IKLE6(IELEM))
00192      &                                   +XA13(IELEM)*X(IKLE5(IELEM))
00193           X(IKLE5(IELEM))=X(IKLE5(IELEM))+XA15(IELEM)*X(IKLE6(IELEM))
00194       ENDDO ! IELEM
00195       ENDDO ! IB
00196 !
00197       ENDIF
00198 !
00199 !-----------------------------------------------------------------------
00200 !
00201       RETURN
00202       END

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