ecrgeo.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\ecrgeo.f
00002 !
00077                      SUBROUTINE ECRGEO
00078 !                    *****************
00079 !
00080      &(X,Y,NPOIN,NBOR,NFIC,NVAR,TEXTE,VARCLA,NVARCL,
00081      & TITRE,SORLEO,NSOR,IKLE,NELEM,NPTFR,NDP,DATE,TIME,
00082      & NCSIZE,NPTIR,KNOLG,NPLAN,I3,I4)
00083 !
00084 !***********************************************************************
00085 ! BIEF   V6P1                                   21/08/2010
00086 !***********************************************************************
00087 !
00088 !
00089 !
00090 !
00091 !
00092 !
00093 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00094 !| DATE           |-->| DATE (3 INTEGERS)
00095 !| I3,I4          |-->| INTEGERS, WILL BE PUT IN FILE IN POSITION 3
00096 !|                |   | AND 4 OF THE ARRAY OF 10 INTEGERS
00097 !| IKLE           |<->| CONNECTIVITY TABLE
00098 !| KNOLG          |-->| GLOBAL NUMBERS OF LOCAL POINTS IN PARALLEL
00099 !| NBOR           |-->| GLOBAL NUMBERS OF BOUNDARY POINTS.
00100 !| NCSIZE         |-->| NUMBER OF PROCESSORS
00101 !| NDP            |<->| NUMBER OF NODES PER ELEMENT
00102 !| NELEM          |<->| NUMBER OF ELEMENTS IN THE MESH
00103 !| NFIC           |-->| LOGICAL UNIT OF FILE TO BE READ
00104 !| NPLAN          |-->| NUMBER OF PLANES (3D MESHES IN PRISMS)
00105 !| NPOIN          |<->| NUMBER OF POINTS IN THE MESH
00106 !| NPTFR          |<->| NUMBER OF BOUNDARY POINTS IN THE MESH
00107 !| NPTIR          |-->| NUMBER OF INTERFACE POINTS IN PARALLEL
00108 !| NSOR           |-->| DIMENSION OF SORLEO AND SORIMP
00109 !| NVAR           |<->| NUMBER OF VARIABLES IN THE MESH
00110 !| NVARCL         |-->| NUMBER OF CLANDESTINE VARIABLES.
00111 !| SORLEO         |-->| SAYS WHICH VARIABLES TO BE WRITTEN IN THE FILE
00112 !|                |   | (ARRAY OF LOGICAL)
00113 !| TEXTE          |<->| NAMES AND UNITS OF VARIABLES.
00114 !| TIME           |-->| TIME (3 INTEGERS)
00115 !| TITRE          |<->| TITLE OF FILE
00116 !| VARCLA         |-->| ARRAY WITH NAMES OF CLANDESTINE VARIABLES
00117 !| X,Y            |<->| MESH COORDINATES.
00118 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00119 !
00120       IMPLICIT NONE
00121       INTEGER LNG,LU
00122       COMMON/INFO/LNG,LU
00123 !
00124 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00125 !
00126       INTEGER, INTENT(IN) :: NPOIN,NFIC,NVARCL,NSOR,NELEM,NPTFR,NDP
00127       INTEGER, INTENT(OUT) :: NVAR
00128       DOUBLE PRECISION, INTENT(IN) :: X(*),Y(*)
00129 !                                    IKLE(NELEM,NDP)
00130       INTEGER, INTENT(IN) :: NBOR(*),IKLE(*)
00131       CHARACTER(LEN=32), INTENT(IN) :: TEXTE(*),VARCLA(NVARCL)
00132 !                                            NSOR      NSOR+NVARCL
00133       CHARACTER(LEN=72), INTENT(IN) :: TITRE
00134       LOGICAL, INTENT(IN) :: SORLEO(*)
00135       INTEGER, INTENT(IN) :: NCSIZE,NPTIR
00136       INTEGER, INTENT(IN) :: TIME(3),DATE(3)
00137       INTEGER, INTENT(IN) :: KNOLG(NPOIN)
00138       INTEGER, INTENT(IN), OPTIONAL :: NPLAN,I3,I4
00139 !
00140 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00141 !
00142       DOUBLE PRECISION XBID(2)
00143 !
00144       INTEGER IB(10),ISTAT,I,IBID(1),IELEM,ERR
00145 !
00146       INTEGER, ALLOCATABLE :: IPOBO(:),IKLES(:)
00147 !
00148       LOGICAL YA_IPOBO,YA_IKLES
00149 !
00150       CHARACTER*2 CBID
00151       CHARACTER*80 TITSEL
00152 !
00153 !-----------------------------------------------------------------------
00154 !
00155       YA_IPOBO = .FALSE.
00156       YA_IKLES = .FALSE.
00157 !
00158 !   GOES TO THE BEGINNING OF THE FILE
00159 !
00160       REWIND NFIC
00161 !
00162 !   LEC/ECR 1   : NAME OF GEOMETRY FILE
00163 !
00164       TITSEL = TITRE // 'SERAPHIN'
00165       CALL ECRI2(XBID,IBID,TITSEL,80,'CH',NFIC,'STD',ISTAT)
00166 !
00167 !   LEC/ECR 2   : NUMBER OF DISCRETISATION FUNCTIONS 1 AND 2
00168 !
00169       IB(1)=0
00170       IB(2)=0
00171       DO I=1,NSOR
00172         IF(SORLEO(I)) IB(1) = IB(1) + 1
00173       ENDDO ! I
00174       CALL ECRI2(XBID,IB,CBID,2,'I ',NFIC,'STD',ISTAT)
00175       NVAR =  IB(1)  +  IB(2)
00176 !
00177 !   LEC/ECR 3 : NAME AND UNIT OF THE VARIABLES
00178 !
00179       IF(NVAR.GE.1) THEN
00180         DO I=1,NSOR
00181           IF(SORLEO(I)) THEN
00182            CALL ECRI2(XBID,IBID,TEXTE(I)(1:32),32,'CH',NFIC,'STD',ISTAT)
00183           ENDIF
00184         ENDDO
00185 !       IF(NVARCL.NE.0) THEN
00186 !         DO I=1,NVARCL
00187 !         CALL ECRI2(XBID,IBID,VARCLA(I)(1:32),32,'CH',NFIC,'STD',ISTAT)
00188 !         ENDDO
00189 !       ENDIF
00190       ENDIF
00191 !
00192 !   LEC/ECR 4   : LIST OF 10 INTEGER PARAMETERS
00193 !
00194         IB(1) = 1
00195         DO I = 2,10
00196           IB(I) = 0
00197         ENDDO ! I
00198 !
00199 !       ORIGIN COORDINATES IN METRES
00200 !
00201         IF(PRESENT(I3)) IB(3)=I3
00202         IF(PRESENT(I4)) IB(4)=I4
00203 !
00204 !       NUMBER OF PLANES IN 3D
00205 !
00206         IF(PRESENT(NPLAN)) IB(7)=NPLAN
00207 !
00208 !PARA   MARKING TO INTRODUCE THE READING OF KNOLG
00209         IF(NCSIZE.GT.1) THEN
00210           IB(8)=NPTFR
00211           IB(9)=NPTIR
00212         ENDIF
00213 !PARA END
00214 !   IS THE DATE PASSED OVER?
00215         IF(DATE(1)+DATE(2)+DATE(3)+TIME(1)+TIME(2)+TIME(3).NE.0) THEN
00216           IB(10) = 1
00217         ENDIF
00218 !   WRITES THE ARRAY OF 10 PARAMETERS
00219         CALL ECRI2(XBID,IB,CBID,10,'I ',NFIC,'STD',ISTAT)
00220 !   PASSES THE DATE
00221         IF(IB(10).EQ.1) THEN
00222           IB(1)=DATE(1)
00223           IB(2)=DATE(2)
00224           IB(3)=DATE(3)
00225           IB(4)=TIME(1)
00226           IB(5)=TIME(2)
00227           IB(6)=TIME(3)
00228           CALL ECRI2(XBID,IB,CBID,6,'I ',NFIC,'STD',ISTAT)
00229         ENDIF
00230 !
00231 !   LEC/ECR 5 : 4 INTEGERS
00232 !
00233       IF(NDP.NE.4) THEN
00234         IB(1) = NELEM
00235       ELSE
00236 !       TETRAHEDRONS REGROUPED INTO PRISMS
00237         IB(1)=NELEM/3
00238       ENDIF
00239       IB(2) = NPOIN
00240       IF(NDP.NE.4) THEN
00241         IB(3) = NDP
00242       ELSE
00243 !       TETRAHEDRONS REGROUPED INTO PRISMS
00244         IB(3) = 6
00245       ENDIF
00246       IB(4) = 1
00247       CALL ECRI2(XBID,IB,CBID,4,'I ',NFIC,'STD',ISTAT)
00248 !
00249 !   LEC/ECR 6 : IKLE
00250 !
00251       IF(NDP.NE.4) THEN
00252         ALLOCATE(IKLES(NELEM*NDP),STAT=ERR)
00253       ELSE
00254 !       TETRAHEDRONS REGROUPED INTO PRISMS
00255         ALLOCATE(IKLES(NELEM*2)  ,STAT=ERR)
00256       ENDIF
00257       CALL CHECK_ALLOCATE(ERR,'IKLES')
00258       YA_IKLES = .TRUE.
00259 !     INVERTS IKLE  IN IKLES FOR SELAFIN
00260       IF(NDP.NE.4) THEN
00261         DO I      = 1,NDP
00262           DO IELEM  = 1,NELEM
00263             IKLES((IELEM-1)*NDP+I) = IKLE((I-1)*NELEM+IELEM)
00264           ENDDO
00265         ENDDO
00266       ELSE
00267 !     TETRAHEDRONS REGROUPED INTO PRISMS
00268         DO IELEM  = 1,NELEM/3
00269           IKLES((IELEM-1)*6+1) = IKLE(      IELEM)
00270           IKLES((IELEM-1)*6+2) = IKLE(NELEM+IELEM)
00271           IKLES((IELEM-1)*6+3) = IKLE(NELEM+IELEM)
00272           IKLES((IELEM-1)*6+4) = IKLE(      IELEM)+NPOIN/NPLAN
00273           IKLES((IELEM-1)*6+5) = IKLE(NELEM+IELEM)+NPOIN/NPLAN
00274           IKLES((IELEM-1)*6+6) = IKLE(NELEM+IELEM)+NPOIN/NPLAN
00275         ENDDO
00276       ENDIF
00277 !
00278       IF(NDP.NE.4) THEN
00279         CALL ECRI2(XBID,IKLES,CBID,NELEM*NDP,'I ',NFIC,'STD',ISTAT)
00280       ELSE
00281 !       TETRAHEDRONS REGROUPED INTO PRISMS
00282         CALL ECRI2(XBID,IKLES,CBID,NELEM*2,'I ',NFIC,'STD',ISTAT)
00283       ENDIF
00284 !
00285 !   LEC/ECR 7 : IPOBO (FILES IN SCALAR MODE)
00286 !
00287       IF(IB(8).EQ.0.AND.IB(9).EQ.0) THEN
00288 !
00289         ALLOCATE(IPOBO(NPOIN),STAT=ERR)
00290         CALL CHECK_ALLOCATE(ERR,'IPOBO')
00291         YA_IPOBO = .TRUE.
00292         DO I=1,NPOIN
00293           IPOBO(I) = 0
00294         ENDDO ! I
00295 !       ONLY LATERAL BOUNDARY POINTS WITH PRISMS
00296         DO I =1,NPTFR
00297           IPOBO(NBOR(I)) = I
00298         ENDDO ! I
00299         CALL ECRI2(XBID,IPOBO,CBID,NPOIN,'I ',NFIC,'STD',ISTAT)
00300 !
00301       ENDIF
00302 !
00303       IF(IB(8).NE.0.OR.IB(9).NE.0) THEN
00304 !
00305 !   LEC/ECR  7.1 KNOLG (PARALLEL MODE ONLY)
00306 !
00307       CALL ECRI2(XBID,KNOLG,CBID,NPOIN,'I ',NFIC,'STD',ISTAT)
00308 !
00309       ENDIF
00310 !
00311 !   LEC/ECR 8 AND 9: X AND Y COORDINATES OF THE MESH POINTS
00312 !
00313       CALL ECRI2(X   ,IBID,CBID,NPOIN,'R4',NFIC,'STD',ISTAT)
00314       CALL ECRI2(Y   ,IBID,CBID,NPOIN,'R4',NFIC,'STD',ISTAT)
00315 !
00316 !-----------------------------------------------------------------------
00317 !
00318       IF(YA_IPOBO) DEALLOCATE(IPOBO)
00319       IF(YA_IKLES) DEALLOCATE(IKLES)
00320 !
00321 !-----------------------------------------------------------------------
00322 !
00323       RETURN
00324       END

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