dessed.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\telemac3d\dessed.f
00002 !
00086                      SUBROUTINE DESSED
00087 !                    *****************
00088 !
00089      & (NPF,IVIDE,EPAI,HDEP,CONC,TEMP,ZR,NPOIN2,NPFMAX,NCOUCH,
00090      &  NIT,GRAPRD,LT,DTC,TASSE,GIBSON,NRSED,TITCAS,BIRSED,GRADEB)
00091 !
00092 !***********************************************************************
00093 ! TELEMAC3D   V7P0                                   21/08/2010
00094 !***********************************************************************
00095 !
00096 !
00097 !
00098 !
00099 !
00100 !
00101 !
00102 !
00103 !
00104 !
00105 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00106 !| BIRSED         |-->| BINARY OF FILE OF SEDIMENT TRANSPORT RESULTS
00107 !| CONC           |<--| CONCENTRATION OF MUD BED LAYER
00108 !|                |   | (MULTILAYER MODEL)
00109 !| DTC            |-->| TIME STEP FOR CONSOLIDATION PHENOMENON
00110 !| EPAI           |<--| THICKNESS OF SOLID FRACTION OF THE BED LAYER
00111 !| GIBSON         |-->| GIBSON SETTLING MODEL
00112 !| GRADEB         |-->| FIRST TIME STEP TO WRITE RESULTS
00113 !| GRAPRD         |-->| KEYWORD 'GRAPHIC PRINTOUT PERIOD'
00114 !| HDEP           |<--| THICKNESS OF FRESH DEPOSIT (FLUID MUD LAYER)
00115 !| IVIDE          |<--| VOID INDEX OF MESH POINTS
00116 !| LT             |-->| CURRENT TIME STEP NUMBER
00117 !| NCOUCH         |-->| NUMBER OF LAYERS DISCRETISING THE MUD BED
00118 !|                |   | (MULTILAYER CONSOLIDATION MODEL)
00119 !| NDP            |-->| NUMBER OF POINTS PER ELEMENT
00120 !| NIT            |-->| NUMBER OF TIME STEP
00121 !| NPF            |<--| NUMBER OF POINTS WITHIN THE BED ALONG THE VERTICAL
00122 !| NPFMAX         |-->| MAXIMUM NUMBER OF HORIZONTAL PLANES DISCRETISING
00123 !|                |   | WITHIN THE MUDDY BED (GIBSON MODEL)
00124 !| NPOIN2         |-->| NUMBER OF POINTS IN 2D
00125 !| NRSED          |-->| NUMBER OF LOGICAL UNIT OF RESULT FILE
00126 !| TASSE          |-->| MULTILAYER SETTLING MODEL LOGICAL
00127 !| TEMP           |<--| TIME COUNTER FOR CONSOLIDATION MODEL
00128 !|                |   | (MULTILAYER MODEL)
00129 !| TITCAS         |-->| TITLE OF TEST CASE
00130 !| ZR             |<--| ELEVATION OF RIDIG BED
00131 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00132 !
00133       USE BIEF, ONLY: NCSIZE,NPTIR
00134       USE DECLARATIONS_TELEMAC3D, ONLY: MESH2D,RHOS
00135 !
00136       IMPLICIT NONE
00137 !
00138       INTEGER LNG,LU
00139       COMMON/INFO/LNG,LU
00140 !
00141       INTEGER ERR, I, IPLAN,JPLAN, IPOIN, IELEM
00142       INTEGER NPLAN,NPOIN3,NELEM3,NELEM2,NPTFR2,NDP
00143       CHARACTER*80 TITSEL
00144       DOUBLE PRECISION UNITCONV, ECOUCH,ZPLAN
00145 !
00146       INTEGER, ALLOCATABLE :: IPOBO(:),IKLES(:)       ! THESE WILL BE 3D
00147       DOUBLE PRECISION, ALLOCATABLE :: WSEB(:)
00148 !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
00149 !#####< SEB-changes
00150 !
00151       INTEGER, INTENT(IN)          :: NPOIN2, NPFMAX, NRSED
00152       INTEGER, INTENT(IN)          :: LT, NIT , NCOUCH
00153       INTEGER, INTENT(IN)          :: GRAPRD, GRADEB
00154       INTEGER, INTENT(IN)          :: NPF(NPOIN2)
00155 !#####> SEB-CHANGES
00156 !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
00157       DOUBLE PRECISION, INTENT(IN) :: EPAI(NPOIN2,NCOUCH)
00158       DOUBLE PRECISION, INTENT(IN) :: IVIDE(NPOIN2,NCOUCH+1)
00159       DOUBLE PRECISION, INTENT(IN) :: HDEP(NPOIN2), ZR(NPOIN2)
00160       DOUBLE PRECISION, INTENT(IN) :: CONC(NPOIN2,NCOUCH)
00161       DOUBLE PRECISION, INTENT(IN) ::  TEMP(NCOUCH,NPOIN2)
00162 !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
00163 !#####< SEB-changes
00164       DOUBLE PRECISION, INTENT(IN) :: DTC
00165       LOGICAL, INTENT(IN)          :: TASSE,GIBSON
00166       CHARACTER(LEN=72), INTENT(IN):: TITCAS
00167       CHARACTER(LEN=3), INTENT(IN) :: BIRSED
00168 !
00169       DOUBLE PRECISION XB(2)
00170       INTEGER IB(10), ISTAT
00171       CHARACTER(LEN=2) CB
00172 !
00173 !----------------------------------------------------------------------
00174 !
00175       IF((LT/GRAPRD)*GRAPRD.NE.LT) RETURN
00176 !
00177       IF(LT.LT.GRADEB) RETURN
00178 !
00179       IF(LT.EQ.0) THEN
00180 !
00181       REWIND NRSED
00182 !
00183 !#####> SEB-CHANGES
00184 !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
00185         NELEM2 = MESH2D%NELEM
00186         NPTFR2 = MESH2D%NPTFR
00187 !       LEC/ECR 1: NAME OF GEOMETRY FILE
00188         TITSEL = TITCAS // 'SERAPHIN'
00189         CALL ECRI2(XB,IB,TITSEL,80,'CH',NRSED,BIRSED,ISTAT)
00190 !
00191 !       LEC/ECR 2: NUMBER OF 1 AND 2 DISCRETISATION FUNCTIONS
00192         IF(TASSE) THEN
00193           IB(1)=4
00194           IB(2)=0
00195         ELSEIF (GIBSON) THEN
00196           IB(1)=4
00197           IB(2)=0
00198         ELSE
00199           IF(LNG.EQ.1) WRITE(LU,*) "OPTION DE CONSOLIDATION NON PREVUE"
00200           IF(LNG.EQ.2) WRITE(LU,*) "UNKNOWN CONSOLIDATION OPTION"
00201           CALL PLANTE(1)
00202           STOP
00203         ENDIF
00204         CALL ECRI2(XB,IB,CB,2,'I ',NRSED,BIRSED,ISTAT)
00205 !
00206 !   LEC/ECR 3: NAMES AND UNITS OF THE VARIABLES
00207         IF(TASSE) THEN
00208           TITSEL(1:32) = 'ELEVATION Z     M               '
00209           CALL ECRI2(XB,IB,TITSEL(1:32),32,'CH',NRSED,BIRSED,ISTAT)
00210           TITSEL(1:32) = 'EPAISSEUR VRAIE M               '
00211           CALL ECRI2(XB,IB,TITSEL(1:32),32,'CH',NRSED,BIRSED,ISTAT)
00212           TITSEL(1:32) = 'CONC. VASE      KG/M3           '
00213           CALL ECRI2(XB,IB,TITSEL(1:32),32,'CH',NRSED,BIRSED,ISTAT)
00214           TITSEL(1:32) = 'COMPTEUR TEMPS  S               '
00215           CALL ECRI2(XB,IB,TITSEL(1:32),32,'CH',NRSED,BIRSED,ISTAT)
00216         ELSEIF(GIBSON) THEN
00217           TITSEL(1:32) = 'ELEVATION Z     M               '
00218           CALL ECRI2(XB,IB,TITSEL(1:32),32,'CH',NRSED,BIRSED,ISTAT)
00219           TITSEL(1:32) = 'EPAISSEUR VRAIE M               '
00220           CALL ECRI2(XB,IB,TITSEL(1:32),32,'CH',NRSED,BIRSED,ISTAT)
00221           TITSEL(1:32) = 'DENSITE VRAIE   KG/M3           '
00222           CALL ECRI2(XB,IB,TITSEL(1:32),32,'CH',NRSED,BIRSED,ISTAT)
00223           TITSEL(1:32) = 'LAYER IPF                       '
00224           CALL ECRI2(XB,IB,TITSEL(1:32),32,'CH',NRSED,BIRSED,ISTAT)
00225         ENDIF
00226 !
00227 !   LEC/ECR 4: LIST OF 10 INTEGER PARAMETERS (AND DATE)
00228         IB(1) = 1
00229         DO I = 2,10
00230           IB(I) = 0
00231         ENDDO
00232         IF (TASSE) THEN
00233           IB(7) = NCOUCH
00234         ELSEIF (GIBSON) THEN
00235           IB(7) = NPFMAX
00236         ENDIF
00237         NPLAN = IB(7)
00238         IF(NCSIZE.GT.1) THEN       ! CAN YOU MAKE SURE THESE ARE 3D
00239           IB(8) = NPTFR2*NPLAN    ! 3D -> TO BE CALCULATED FROM 2D
00240           IB(9) = NPTIR           ! CAN THIS ONLY BE 2D ?
00241         ENDIF
00242 !        IF(DATE(1)+DATE(2)+DATE(3)+TIME(1)+TIME(2)+TIME(3).NE.0) THEN
00243 !           IB(10) = 1
00244 !        ENDIF
00245         CALL ECRI2(XB,IB,CB,10,'I ',NRSED,BIRSED,ISTAT)
00246 !
00247 !   DATE
00248 !       IF(IB(10).EQ.1) THEN
00249 !          IB(1)=DATE(1)
00250 !          IB(2)=DATE(2)
00251 !          IB(3)=DATE(3)
00252 !          IB(4)=TIME(1)
00253 !          IB(5)=TIME(2)
00254 !          IB(6)=TIME(3)
00255 !          CALL ECRI2(XB,IB,CB,6,'I ',NRSED,BIRSED,ISTAT)
00256 !       ENDIF
00257 !
00258 !   LEC/ECR 5: 4 INTEGERS
00259         IB(1) = NELEM2*(NPLAN-1)    ! 3D -> TO BE CALCULATED FROM 2D
00260         NELEM3 = IB(1)
00261         IB(2) = NPOIN2*NPLAN        ! 3D -> TO BE CALCULATED FROM 2D
00262         NPOIN3 = IB(2)
00263         IB(3) = 6                   ! PARTICULAR CASE OF PRISMS NDP=6
00264         NDP = IB(3)
00265         IB(4) = 1
00266         CALL ECRI2(XB,IB,CB,4,'I ',NRSED,BIRSED,ISTAT)
00267 !
00268 !   LEC/ECR 6: IKLE
00269 !   BUILDS 3D LAYERED PRISMATIC MESH OUT OF 2D IMPRINT
00270         ALLOCATE(IKLES(NELEM3*NDP),STAT=ERR)  ! PARTICULAR CASE OF PRISMS
00271         CALL CHECK_ALLOCATE(ERR, 'IKLES')
00272         DO IPLAN = 1,NPLAN-1
00273           DO IELEM = 1,NELEM2
00274             I = ((IPLAN-1)*NELEM2+IELEM-1)*NDP
00275             IKLES(I+1)=MESH2D%IKLE%I(IELEM)+(IPLAN-1)*NPOIN2
00276             IKLES(I+2)=MESH2D%IKLE%I(IELEM+NELEM2)+(IPLAN-1)*NPOIN2
00277             IKLES(I+3)=MESH2D%IKLE%I(IELEM+2*NELEM2)+(IPLAN-1)*NPOIN2
00278             IKLES(I+4)=MESH2D%IKLE%I(IELEM)+IPLAN*NPOIN2
00279             IKLES(I+5)=MESH2D%IKLE%I(IELEM+NELEM2)+IPLAN*NPOIN2
00280             IKLES(I+6)=MESH2D%IKLE%I(IELEM+2*NELEM2)+IPLAN*NPOIN2
00281           ENDDO
00282         ENDDO
00283         CALL ECRI2(XB,IKLES,CB,NELEM3*NDP,'I ',NRSED,BIRSED,ISTAT)
00284         DEALLOCATE(IKLES)
00285 !
00286 !   LEC/ECR 7: IPOBO (CASE OF FILES WITHOUT PARALLELISM)
00287 !
00288         IF( IB(8).EQ.0.AND.IB(9).EQ.0 ) THEN
00289           ALLOCATE(IPOBO(NPLAN*NPOIN2),STAT=ERR)
00290           CALL CHECK_ALLOCATE(ERR, 'IPOBO')
00291           DO IPOIN = 1,NPLAN*NPOIN2            ! THIS IS INDEED 3D
00292             IPOBO(IPOIN) = 0
00293           ENDDO
00294           DO IPLAN = 1,NPLAN
00295             DO IPOIN = 1,NPTFR2
00296               IPOBO(MESH2D%NBOR%I(IPOIN)+(IPLAN-1)*NPOIN2) =
00297      &        IPOIN+(IPLAN-1)*NPTFR2
00298             ENDDO
00299           ENDDO
00300           CALL ECRI2(XB,IPOBO,CB,NPLAN*NPOIN2,'I ',NRSED,BIRSED,ISTAT)
00301           DEALLOCATE(IPOBO)
00302         ENDIF
00303 !   LEC/ECR 7.1: KNOLG (ONLY IN THE EVENT OF PARALLEL MODE)
00304         IF(IB(8).NE.0.OR.IB(9).NE.0) THEN
00305           ALLOCATE(IPOBO(NPLAN*NPOIN2),STAT=ERR)
00306           CALL CHECK_ALLOCATE(ERR, 'IPOBO')
00307           DO IPOIN = 1,NPLAN*NPOIN2            ! THIS IS INDEED 3D
00308             IPOBO(IPOIN) = 0
00309           ENDDO
00310           DO IPLAN = 1,NPLAN
00311             DO IPOIN = 1,NPOIN2
00312               IPOBO(IPOIN+(IPLAN-1)*NPOIN2) =
00313      &           MESH2D%KNOLG%I(IPOIN)+(IPLAN-1)*NPOIN2
00314             ENDDO
00315           ENDDO
00316           CALL ECRI2(XB,IPOBO,CB,NPOIN3,'I ',NRSED,BIRSED,ISTAT)
00317         ENDIF
00318 !
00319 !   LEC/ECR 8 AND 9: X AND Y COORDINATES OF THE MESH NODES
00320 !
00321         ALLOCATE(WSEB(NPLAN*NPOIN2),STAT=ERR)
00322         CALL CHECK_ALLOCATE(ERR,'FONSTR:WSEB')
00323         DO IPOIN = 1, NPOIN2
00324           DO IPLAN = 1,NPLAN
00325             WSEB(IPOIN+(IPLAN-1)*NPOIN2) = MESH2D%X%R(IPOIN)
00326           ENDDO
00327         ENDDO
00328         CALL ECRI2(WSEB,IB,CB,NPOIN3,'R4',NRSED,BIRSED,ISTAT)
00329         DO IPOIN = 1, NPOIN2
00330           DO IPLAN = 1,NPLAN
00331             WSEB(IPOIN+(IPLAN-1)*NPOIN2) = MESH2D%Y%R(IPOIN)
00332           ENDDO
00333         ENDDO
00334         CALL ECRI2(WSEB,IB,CB,NPOIN3,'R4',NRSED,BIRSED,ISTAT)
00335         DEALLOCATE(WSEB)
00336 !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
00337 !#####< SEB-changes
00338       ENDIF
00339 !
00340 ! A TRICK TO WRITE ONE NUMBER
00341 !
00342       XB(1) = DTC
00343       CALL ECRI2(XB,IB,CB,1,'R4',NRSED,BIRSED,ISTAT)
00344 !
00345       IF (TASSE) THEN
00346 !
00347 !#####> SEB-CHANGES
00348 !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
00349 !  /!\ THIS PART SHOULD BE ENTIRELY REVISITED ...
00350         UNITCONV = 1.D0                     ! VARIABLES CAN BE ENLARGED
00351         ALLOCATE(WSEB(NCOUCH*NPOIN2),STAT=ERR)
00352         CALL CHECK_ALLOCATE(ERR,'FONSTR:WSEB')
00353 ! THIS IS THE Z FOR THE LAYERING -
00354         DO IPOIN = 1, NPOIN2
00356         ENDDO
00357         DO IPLAN = 2,NCOUCH
00358           DO IPOIN = 1, NPOIN2
00361            ENDDO
00362         ENDDO
00363         CALL ECRI2(WSEB,IB,CB,NCOUCH*NPOIN2,'R4',NRSED,BIRSED,ISTAT)
00364 !
00365         DO IPOIN = 1, (NCOUCH-1)*NPOIN2
00367         ENDDO
00368 !       DO IPOIN = 1, NPOIN2
00369 !         WSEB(IPOIN+(NCOUCH-1)*NPOIN2) = HDEP(IPOIN) * UNITCONV
00370 !       ENDDO
00371         CALL ECRI2(WSEB,IB,CB,NCOUCH*NPOIN2,'R4',NRSED,BIRSED,ISTAT)
00372 !       CALL ECRI2(EPAI,IB,CB,NCOUCH*NPOIN2,'R4',NRSED,BIRSED,ISTAT)
00373 !!
00374         DO IPLAN = 1,NCOUCH
00375           DO IPOIN = 1, NPOIN2
00377           ENDDO
00378         ENDDO
00379         CALL ECRI2(WSEB,IB,CB,NCOUCH*NPOIN2,'R4',NRSED,BIRSED,ISTAT)
00380 !       CALL ECRI2(CONC,IB,CB,NCOUCH,'R4',NRSED,BIRSED,ISTAT)
00381 !#####< SEB-changes
00382 !
00383         CALL ECRI2(TEMP,IB,CB,NCOUCH*NPOIN2,'R4',NRSED,BIRSED,ISTAT)
00384 !#####> SEB-CHANGES
00385         DEALLOCATE(WSEB)
00386 !#####< SEB-changes
00387 !
00388       ELSEIF (GIBSON) THEN
00389 !
00390 !#####> SEB-CHANGES
00391 !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
00392 !
00393 ! ASSUMPTIONS - Z-LEVELS:
00394 !  * B KENUE'S BOTTOM Z-LEVEL IS ZR (1), TOP Z-LEVEL IS ZF (NPFMAX)
00395 !  * SEDI3D'S NON-EMPTY LAYERS ARE B KENUE'S LAYERS UNDER ZF
00396 !  * B KENUE'S PLANES FROM 1 TO NPFMAX-NPF ARE EMPTY (EPAI=0) AND
00397 !      CORRESPOND TO SEDI3D'S PLANES FROM NPF+2 TO NPFMAX
00398 !  * ALL EMPTY PLANES (EXCEPT FOR HDEP) ARE SET TO COINCIDENT WITH ZR
00399 !      (ROCK BOTTOM), WHILE SEDI3D'S 1ST PLANE IS ZR
00400 !  * B KENUE'S NON-EMPTY TOP PLANES FROM NPFMAX-NPF+1 TO NPFMAX-1
00401 !      CORRESPOND TO SEDI3D'S PLANES FROM 2 TO NPF IN THE SAME ORDER
00402 !  * B KENUE'S VERY TOP PLANE AT NPFMAX CORRESPONDS TO
00403 !      SEDI3D'S NPF+1-TH PLANE, WHICH IS ALSO HDEP - EVEN IF EMPTY !
00404 !
00405 ! ASSUMPTIONS - VARIABLE THICKNESS:
00406 !  * B KENUE'S THICKNESS BETWEEN TWO PLANES IS STORED ON THE UPPER PLANE
00407 !      WHICH IS CONTRARY TO SEDI3D'S CONVENTION
00408 !  * B KENUE'S NPFMAX-TH THICKNESS STORES HDEP
00409 !  * FOR STORAGE PURPOSES, B KENUE'S 1ST PLANE HOLDS THE NPF
00410 !
00411         UNITCONV = 1.D0                     ! VARIABLES CAN BE ENLARGED
00412         ALLOCATE(WSEB(NPFMAX*NPOIN2),STAT=ERR)
00413         IF(ERR.NE.0) THEN
00414           IF(LNG.EQ.1) WRITE(LU,*) 'FONSTR : MAUVAISE ALLOCATION DE W'
00415           IF(LNG.EQ.2) WRITE(LU,*) 'FONSTR: WRONG ALLOCATION OF W'
00416           STOP
00417         ENDIF
00419         DO IPOIN = 1, NPOIN2
00420            JPLAN = 0
00421            ZPLAN = ZR(IPOIN)
00422            DO IPLAN = 1,NPFMAX-NPF(IPOIN)
00423              JPLAN = JPLAN + 1
00424              WSEB(IPOIN+(JPLAN-1)*NPOIN2) = ZPLAN
00425            ENDDO
00426            DO IPLAN = 1,NPF(IPOIN)-1
00427              JPLAN = JPLAN + 1
00428              ECOUCH=(IVIDE(IPLAN,IPOIN)+IVIDE(IPLAN+1,IPOIN))/2.D0
00429              ZPLAN = ZPLAN +
00430      &             ( 1.D0+ECOUCH ) * EPAI(IPOIN,IPLAN)
00431              WSEB(IPOIN+(JPLAN-1)*NPOIN2) = ZPLAN
00432            ENDDO
00433            WSEB(IPOIN+(NPFMAX-1)*NPOIN2) = ZPLAN +
00434      &              HDEP(IPOIN)
00435         ENDDO
00436         CALL ECRI2(WSEB,IB,CB,NPFMAX*NPOIN2,'R4',NRSED,BIRSED,ISTAT)
00438         DO IPOIN = 1, NPOIN2
00439           JPLAN = 0
00440           DO IPLAN = 1,NPFMAX-NPF(IPOIN)
00441             JPLAN = JPLAN + 1
00442             WSEB(IPOIN+(JPLAN-1)*NPOIN2) = 0.D0
00443           ENDDO
00444           DO IPLAN = 1,NPF(IPOIN)-1
00445             JPLAN = JPLAN + 1
00446             ECOUCH=(IVIDE(IPLAN,IPOIN)+IVIDE(IPLAN+1,IPOIN))/2.D0
00447             WSEB(IPOIN+(JPLAN-1)*NPOIN2) =
00448      &          (1.D0+ECOUCH)*EPAI(IPOIN,IPLAN)*UNITCONV
00449           ENDDO
00450           WSEB(IPOIN+(NPFMAX-1)*NPOIN2) = HDEP(IPOIN) *UNITCONV
00451           WSEB(IPOIN) = 1.D0 * NPF(IPOIN) ! RESET THIS ONE ! OR NOT ?
00452         ENDDO
00453         CALL ECRI2(WSEB,IB,CB,NPFMAX*NPOIN2,'R4',NRSED,BIRSED,ISTAT)
00455         DO IPOIN = 1, NPOIN2
00456           JPLAN = NPFMAX
00457           DO IPLAN = NPF(IPOIN),1,-1
00458             WSEB(IPOIN+(JPLAN-1)*NPOIN2) =
00459      &                 RHOS/(1.D0+IVIDE(IPLAN,IPOIN))
00460             JPLAN = JPLAN - 1
00461           ENDDO
00462           DO IPLAN = NPFMAX,NPF(IPOIN)+1,-1
00463             WSEB(IPOIN+(JPLAN-1)*NPOIN2) = 0.D0
00464             JPLAN = JPLAN - 1
00465           ENDDO
00466         ENDDO
00467         CALL ECRI2(WSEB,IB,CB,NPFMAX*NPOIN2,'R4',NRSED,BIRSED,ISTAT)
00469         DO IPOIN = 1, NPOIN2
00470           DO IPLAN = 1,NPFMAX-1
00471             WSEB(IPOIN+(IPLAN-1)*NPOIN2) = IPLAN
00472           ENDDO
00473         ENDDO
00474         CALL ECRI2(WSEB,IB,CB,NPFMAX*NPOIN2,'R4',NRSED,BIRSED,ISTAT)
00475 !       CALL ECRI2(IVIDE,IB,CB,NPFMAX*NPOIN2,'R4',NRSED,BIRSED,ISTAT)
00476 !       CALL ECRI2(XB,NPF,CB,NPOIN2,'I',NRSED,BIRSED,ISTAT)
00477 !       CALL ECRI2(EPAI,IB,CB,(NPFMAX-1)*NPOIN2,'R4',NRSED,BIRSED,ISTAT)
00478         DEALLOCATE(WSEB)
00479 !#####< SEB-changes
00480 !
00481       ENDIF
00482 !
00483 !     CALL ECRI2(HDEP,IB,CB,NPOIN2,'R4',NRSED,BIRSED,ISTAT)
00484 !
00485 !     CALL ECRI2(ZR,IB,CB,NPOIN2,'R4',NRSED,BIRSED,ISTAT)
00486 !
00487 !----------------------------------------------------------------------
00488 !
00489       RETURN
00490       END

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