parcom.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\parcom.f
00002 !
00074                      SUBROUTINE PARCOM
00075 !                    *****************
00076 !
00077      &( X , ICOM , MESH )
00078 !
00079 !***********************************************************************
00080 ! BIEF   V6P2                                   21/08/2010
00081 !***********************************************************************
00082 !
00083 !
00084 !
00085 !
00086 !
00087 !
00088 !
00089 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00090 !| ICOM           |-->| COMMUNICATION MODE
00091 !|                |   | = 1 : VALUE WITH MAXIMUM ABSOLUTE VALUE TAKEN
00092 !|                |   | = 2 : CONTRIBUTIONS ADDED
00093 !|                |   | = 3 : MAXIMUM CONTRIBUTION RETAINED
00094 !|                |   | = 4 : MINIMUM CONTRIBUTION RETAINED
00095 !| MESH           |-->| MESH STRUCTURE
00096 !| X              |<->| VECTOR OR BLOCK OF VECTORS
00097 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00098 !
00099       USE BIEF, EX_PARCOM => PARCOM
00100 !
00101       IMPLICIT NONE
00102       INTEGER LNG,LU
00103       COMMON/INFO/LNG,LU
00104 !
00105 !-----------------------------------------------------------------------
00106 !
00107       INTEGER, INTENT(IN) :: ICOM
00108 !
00109 !     STRUCTURES: VECTORS OR BLOCKS
00110 !
00111       TYPE(BIEF_MESH), INTENT(INOUT)   :: MESH
00112       TYPE(BIEF_OBJ), INTENT(INOUT) :: X
00113 !
00114 !-----------------------------------------------------------------------
00115 !
00116       TYPE(BIEF_OBJ), POINTER  :: X2,X3
00117       INTEGER NPOIN,NPLAN,IAN,NP11,NSEG
00118 !
00119 !***********************************************************************
00120 !
00121 !  OF NO USE IF A SUB-DOMAIN IS DISCONNECTED FROM THE OTHERS
00122 !
00123       IF(NPTIR.EQ.0) RETURN
00124 !
00125 !-----------------------------------------------------------------------
00126 !
00127       NPOIN = MESH%NPOIN
00128       NPLAN = 1
00129       IF(MESH%DIM.EQ.3) THEN
00130         NPOIN = BIEF_NBPTS(11,MESH)
00131         NPLAN = MESH%NPOIN/NPOIN
00132       ENDIF
00133 !
00134 !-----------------------------------------------------------------------
00135 !
00136       IF(X%TYPE.EQ.2) THEN
00137 !
00138 !     VECTOR STRUCTURE
00139 !
00140       IAN = 1
00141       CALL PARCOM2(X%R,X%R,X%R,NPOIN,NPLAN,ICOM,IAN,MESH)
00142 !
00143       IF(X%ELM.EQ.13) THEN
00144         NP11=BIEF_NBPTS(11,MESH)
00145         NSEG=MESH%NSEG
00146         CALL PARCOM2_SEG(X%R(NP11+1:NP11+NSEG),
00147      &                   X%R(NP11+1:NP11+NSEG),
00148      &                   X%R(NP11+1:NP11+NSEG),
00149      &                   NSEG,1,ICOM,IAN,MESH,1,11)
00150       ENDIF
00151 !
00152       ELSEIF(X%TYPE.EQ.4) THEN
00153 !
00154 !     BLOCK STRUCTURE
00155 !
00156 !     BEWARE: NUMBER LIMITED TO 3 |||||||||||||||||||||||||
00157       IAN = X%N
00158       IF(IAN.EQ.1) THEN
00159         X2 => X%ADR(1)%P
00160         X3 => X%ADR(1)%P
00161       ELSEIF(IAN.EQ.2) THEN
00162         X2 => X%ADR(2)%P
00163         X3 => X%ADR(2)%P
00164       ELSEIF(IAN.EQ.3) THEN
00165         X2 => X%ADR(2)%P
00166         X3 => X%ADR(3)%P
00167       ELSE
00168         IF(LNG.EQ.1) WRITE(LU,*) 'PARCOM PREVU JUSQU''A 3 VECTEURS'
00169         IF(LNG.EQ.2) WRITE(LU,*) 'PARCOM: NO MORE THAN 3 VECTORS'
00170         CALL PLANTE(1)
00171         STOP
00172       ENDIF
00173 !
00174       CALL PARCOM2(X%ADR(1)%P%R,X2%R,X3%R,NPOIN,NPLAN,ICOM,IAN,MESH)
00175 !
00176 !     PROVISIONNALY 1 BY 1, COULD BE OPTIMISED
00177 !
00178       IF(X%ADR(1)%P%ELM.EQ.13) THEN
00179         NP11=BIEF_NBPTS(11,MESH)
00180         NSEG=MESH%NSEG
00181         CALL PARCOM2_SEG(X%ADR(1)%P%R(NP11+1:NP11+NSEG),
00182      &                   X%ADR(1)%P%R(NP11+1:NP11+NSEG),
00183      &                   X%ADR(1)%P%R(NP11+1:NP11+NSEG),
00184 !    *                   NSEG,1,ICOM,IAN,MESH)
00185      &                   NSEG,1,ICOM,1  ,MESH,1,11)
00186       ENDIF
00187       IF(IAN.GE.2.AND.X2%ELM.EQ.13) THEN
00188         NP11=BIEF_NBPTS(11,MESH)
00189         NSEG=MESH%NSEG
00190         CALL PARCOM2_SEG(X2%R(NP11+1:NP11+NSEG),
00191      &                   X2%R(NP11+1:NP11+NSEG),
00192      &                   X2%R(NP11+1:NP11+NSEG),
00193 !    *                   NSEG,1,ICOM,IAN,MESH)
00194      &                   NSEG,1,ICOM,1  ,MESH,1,11)
00195       ENDIF
00196       IF(IAN.EQ.3.AND.X3%ELM.EQ.13) THEN
00197         NP11=BIEF_NBPTS(11,MESH)
00198         NSEG=MESH%NSEG
00199         CALL PARCOM2_SEG(X3%R(NP11+1:NP11+NSEG),
00200      &                   X3%R(NP11+1:NP11+NSEG),
00201      &                   X3%R(NP11+1:NP11+NSEG),
00202 !    *                   NSEG,1,ICOM,IAN,MESH)
00203      &                   NSEG,1,ICOM,1  ,MESH,1,11)
00204       ENDIF
00205 !
00206       ELSE
00207 !
00208 !     ERROR ON THE STRUCTURE
00209 !
00210       IF (LNG.EQ.1) WRITE(LU,50) X%NAME,X%TYPE
00211       IF (LNG.EQ.1) WRITE(LU,53)
00212 50    FORMAT(1X,'PARCOM (BIEF) : NOM DE X : ',A6,'  TYPE : ',1I6)
00213 53    FORMAT(1X,'                CAS NON PREVU')
00214       IF (LNG.EQ.2) WRITE(LU,51) X%NAME,X%TYPE
00215       IF (LNG.EQ.2) WRITE(LU,54)
00216 51    FORMAT(1X,'PARCOM (BIEF): NAME OF X: ',A6,'  TYPE : ',1I6)
00217 54    FORMAT(1X,'               UNEXPECTED CASE')
00218       CALL PLANTE(1)
00219       STOP
00220 !
00221       ENDIF
00222 !
00223 !-----------------------------------------------------------------------
00224 !
00225       RETURN
00226       END

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