read_sections_sisyphe.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\sisyphe\read_sections_sisyphe.f
00002 !
00081                      SUBROUTINE READ_SECTIONS_SISYPHE
00082 !                    ********************************
00083 !
00084 !
00085 !***********************************************************************
00086 ! SISYPHE   V6P1                                   21/07/2011
00087 !***********************************************************************
00088 !
00089 !
00090 !
00091 !
00092 !
00093 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00094 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00095 !
00096       USE BIEF, ONLY: NCSIZE
00097       USE DECLARATIONS_SISYPHE, ONLY: MESH, CHAIN, NCP, CTRLSC,
00098      &                                SIS_FILES, SISSEC
00099       IMPLICIT NONE
00100       INTEGER LNG,LU
00101       COMMON/INFO/LNG,LU
00102 !
00103       INTEGER :: NSEC, IHOWSEC, I, N, ERR, INP
00104       DOUBLE PRECISION :: XA, YA, DISTB, DISTE, DMINB, DMINE
00105 !
00106 !-----------------------------------------------------------------------
00107 !
00108 !      WRITE(LU,*) '-> ENTERING READ_SECTIONS_SISYPHE'
00109       INP=SIS_FILES(SISSEC)%LU
00110       READ (INP,*) ! THE NECESSARY COMMENT LINE
00111       READ (INP,*) NSEC, IHOWSEC
00112       IF (.NOT.ALLOCATED(CHAIN)) THEN
00113         ALLOCATE (CHAIN(NSEC), STAT=ERR)
00114         IF (ERR/=0) THEN
00115           WRITE(LU,*)
00116      &      'READ_SECTIONS: ERROR BY REALLOCATING CHAIN:',ERR
00117           CALL PLANTE(1)
00118           STOP
00119         ENDIF
00120       ENDIF
00121       SELECT CASE (IHOWSEC)
00122       CASE (:-1) ! SECTION END POINTS PROVIDED AS GLOBAL NODES
00123         DO N=1,NSEC
00124           READ (INP,*) CHAIN(N)%DESCR
00125           READ (INP,*) CHAIN(N)%NPAIR(:)
00126           IF (NCSIZE>1) THEN
00127             CHAIN(N)%XYBEG(:)=0.0D0
00128             CHAIN(N)%XYEND(:)=0.0D0
00129           ELSE
00130             CHAIN(N)%XYBEG(:)= (/MESH%X%R(CHAIN(N)%NPAIR(1)),
00131      &                           MESH%Y%R(CHAIN(N)%NPAIR(1))/)
00132             CHAIN(N)%XYEND(:)= (/MESH%X%R(CHAIN(N)%NPAIR(2)),
00133      &                           MESH%Y%R(CHAIN(N)%NPAIR(2))/)
00134           ENDIF
00135           CHAIN(N)%NSEG=-1
00136           NULLIFY(CHAIN(N)%LISTE)
00137         END DO
00138 !        WRITE(LU,'(A)') ' -> SECTION, TERMINAL COORDINATES:'
00139 !        DO N=1,NSEC
00140 !          WRITE(LU,'(I9,4(1X,1PG13.6))') N,
00141 !     &          CHAIN(N)%XYBEG, CHAIN(N)%XYEND
00142 !        END DO
00143       CASE (0) ! SECTION END POINTS PROVIDED BY COORDINATES
00144         DO N=1,NSEC
00145           READ (INP,*) CHAIN(N)%DESCR
00146           READ (INP,*) CHAIN(N)%XYBEG(:), CHAIN(N)%XYEND(:)
00147           CHAIN(N)%NPAIR(:)=0
00148           CHAIN(N)%NSEG=-1
00149           NULLIFY(CHAIN(N)%LISTE)
00150         END DO
00151         DO N=1,NSEC         ! FIND NEAREST NODES
00152           XA=MESH%X%R(1)
00153           YA=MESH%Y%R(1)
00154           DMINB = SQRT( (CHAIN(N)%XYBEG(1)-XA)**2
00155      &                + (CHAIN(N)%XYBEG(2)-YA)**2 )
00156           DMINE = SQRT( (CHAIN(N)%XYEND(1)-XA)**2
00157      &                + (CHAIN(N)%XYEND(2)-YA)**2 )
00158           CHAIN(N)%NPAIR(1)=1
00159           CHAIN(N)%NPAIR(2)=1
00160           DO I=2,MESH%NPOIN ! COMPUTATIONALLY INTENSIVE
00161             XA=MESH%X%R(I)
00162             YA=MESH%Y%R(I)
00163             DISTB = SQRT( (CHAIN(N)%XYBEG(1)-XA)**2
00164      &                  + (CHAIN(N)%XYBEG(2)-YA)**2 )
00165             DISTE = SQRT( (CHAIN(N)%XYEND(1)-XA)**2
00166      &                 + (CHAIN(N)%XYEND(2)-YA)**2 )
00167             IF ( DISTB < DMINB ) THEN
00168               CHAIN(N)%NPAIR(1)=I
00169               DMINB=DISTB
00170             ENDIF
00171             IF ( DISTE < DMINE ) THEN
00172               CHAIN(N)%NPAIR(2)=I
00173               DMINE=DISTE
00174             ENDIF
00175           END DO
00176 !          WRITE(LU,'(A,3(1X,I9))')
00177 !     &          ' -> SECTION, TERMINAL NODES: ', N, CHAIN(N)%NPAIR(:)
00178         END DO
00179       CASE (1:) ! PARTITIONED, INSTEAD OF END POINTS, READY CHAINS PROVIDED
00180         DO N=1,NSEC
00181           READ (INP,*) CHAIN(N)%DESCR
00182           READ (INP,*) CHAIN(N)%NSEG
00183           IF (CHAIN(N)%NSEG>0) THEN
00184             ALLOCATE (CHAIN(N)%LISTE(CHAIN(N)%NSEG,2), STAT=ERR)
00185             IF (ERR/=0) THEN
00186               WRITE(LU,*) 'READ_SECTIONS: ',
00187      &         ' ERROR BY REALLOCATING CHAIN(N)%LISTE, N, ERR:',N,ERR
00188               CALL PLANTE(1)
00189               STOP
00190             ENDIF
00191             DO I=1,CHAIN(N)%NSEG
00192               READ(INP,*) CHAIN(N)%LISTE(I,:)
00193               CHAIN(N)%NPAIR=-1 ! HM...
00194               CHAIN(N)%XYBEG=0.0D0
00195               CHAIN(N)%XYEND=0.0D0
00196             END DO
00197           ELSE
00198             NULLIFY(CHAIN(N)%LISTE)
00199           ENDIF
00200         END DO
00201       END SELECT
00202 !
00203 !-----------------------------------------------------------------------
00204 !
00205 !      WRITE(LU,*) 'SECTIONS SUMMARY:'
00206 !      WRITE(LU,*) 'NSEC,IHOWSEC: ',NSEC,IHOWSEC
00207 !      SELECT CASE (IHOWSEC)
00208 !      CASE(:0) ! SERIAL CASE, OR "CLASSICAL CASE" IN PARALLEL (DEVEL)
00209 !        DO N=1,NSEC
00210 !          WRITE(LU,*) CHAIN(N)%DESCR
00211 !          WRITE(LU,*) CHAIN(N)%XYBEG(:), CHAIN(N)%XYEND(:)
00212 !          WRITE(LU,*) CHAIN(N)%NPAIR(:)
00213 !        END DO
00214 !      CASE (1:) ! PARTITIONED, READY SEGMENT CHAINS GIVEN
00215 !        DO N=1,NSEC
00216 !          WRITE(LU,*) 'NAME: ', CHAIN(N)%DESCR
00217 !          WRITE(LU,*) 'NSEG: ', CHAIN(N)%NSEG
00218 !          DO I=1,CHAIN(N)%NSEG
00219 !            WRITE(LU,*) CHAIN(N)%LISTE(I,:)
00220 !          END DO
00221 !        END DO
00222 !      END SELECT
00223 !
00224 !-----------------------------------------------------------------------
00225 ! TRANSFER TO THE GLOBAL TELEMAC OR SISYPHE VARIABLES
00226 ! NCP IS 2 * NUMBER OF SECTIONS
00227 ! CTRLSC IS THE LIST OF THE SECTION END NODES
00228 ! CTRLSC HAS TO BE RE-ALLOCATED CAREFULLY
00229 !
00230 !      WRITE (LU,*) 'ARRANGING SECTIONS FOR SISYPHE'
00231 !      WRITE (LU,*) 'SISYPHE NCP WAS: ',NCP
00232       NCP = 2*NSEC
00233       IF (ALLOCATED(CTRLSC)) THEN
00234         DEALLOCATE(CTRLSC, STAT=ERR)
00235         IF (ERR/=0) THEN
00236           WRITE(LU,*)
00237      &    'READ_SECTIONS_SISYPHE: ERROR BY DEALLOCATING CTRLSC:',ERR
00238           CALL PLANTE(1)
00239           STOP
00240         ENDIF
00241       ENDIF
00242       ALLOCATE (CTRLSC(NCP), STAT=ERR)
00243       IF (ERR/=0) THEN
00244         WRITE(LU,*)
00245      &    'READ_SECTIONS_SISYPHE: ERROR BY REALLOCATING CTRLSC:',ERR
00246         CALL PLANTE(1)
00247         STOP
00248       ENDIF
00249       I=1
00250       DO N=1,NSEC
00251         CTRLSC(I)   = CHAIN(N)%NPAIR(1)
00252         CTRLSC(I+1) = CHAIN(N)%NPAIR(2)
00253         I=I+2
00254       END DO
00255 !      WRITE (LU,*) 'NCP@SISYPHE: ',NCP
00256 !      WRITE (LU,*) 'CTRLSC@SISYPHE: ',CTRLSC
00257 !
00258 !-----------------------------------------------------------------------
00259 !
00260 !      WRITE(LU,*) '-> LEAVING READ_SECTIONS_SISYPHE'
00261       RETURN
00262       END SUBROUTINE READ_SECTIONS_SISYPHE

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