derive.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\derive.f
00002 !
00121                      SUBROUTINE DERIVE
00122 !                    *****************
00123 !
00124      &(U,V,W,DT,AT,X,Y,Z,IKLE,IFABOR,LT,IELM,IELMU,NDP,NPOIN,NPOIN2,
00125      & NELEM,NELMAX,SURDET,XFLOT,YFLOT,ZFLOT,
00126      & SHPFLO,SHZFLO,TAGFLO,ELTFLO,ETAFLO,
00127      & NFLOT,NFLOT_MAX,FLOPRD,MESH,UL,
00128      & ISUB,DX,DY,DZ,ELTBUF,SHPBUF,SHZBUF,SIZEBUF,STOCHA,VISC,
00129      & AALGAE,DALGAE,RALGAE,EALGAE,ALGTYP,AK,EP,H)
00130 !
00131 !***********************************************************************
00132 ! BIEF   V6P3                                   21/08/2010
00133 !***********************************************************************
00134 !
00135 !
00136 !
00137 !
00138 !
00139 !
00140 !
00141 !
00142 !
00143 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00144 !| DT             |-->| TIME STEP (I.E. TIME INTERVAL).
00145 !| DX             |<->| WORK ARRAY (DISPLACEMENTS ALONG X)
00146 !| DY             |<->| WORK ARRAY (DISPLACEMENTS ALONG Y)
00147 !| DZ             |<->| WORK ARRAY (DISPLACEMENTS ALONG Z)
00148 !| ELTBUF         |<->| WORK ARRAY
00149 !| ELTFLO         |<->| NUMBERS OF ELEMENTS WHERE ARE THE FLOATS
00150 !| ETAFLO         |<->| LEVELS WHERE ARE THE FLOATS
00151 !| FLOPRD         |-->| NUMBER OF TIME STEPS BETWEEB TWO RECORDS
00152 !|                |   | FOR FLOATS POSITIONS.
00153 !| IELM           |-->| TYPE OF ELEMENT.
00154 !| IELMU          |-->| TYPE OF ELEMENT FOR VELOCITIES.
00155 !| IFABOR         |-->| ELEMENTS BEHIND THE EDGES OF ANOTHER ELEMENT
00156 !|                |   | IF IFABOR NEGATIVE OR 0, THE EDGE IS A
00157 !|                |   | LIQUID OR PERIODIC BOUNDARY
00158 !| IKLE           |-->| CONNECTIVITY TABLE.
00159 !| ISUB           |<->| ARRIVAL SUB-DOMAIN OF PARTICLES.
00160 !| LT             |-->| TIME STEP NUMBER.
00161 !| MESH           |<->| MESH STRUCTURE.
00162 !| NDP            |-->| NUMBER OF POINTS PER ELEMENT
00163 !| NELEM          |-->| NUMBER OF ELEMENTS
00164 !| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS IN 2D
00165 !| NFLOT          |<->| NUMBER OF FLOATS.
00166 !| NFLOT_MAX      |<->| MAXIMUM NUMBER OF FLOATS.
00167 !| NPOIN          |-->| NUMBER OF POINTS
00168 !| NPOIN2         |-->| NUMBER OF POINTS IN 2D MESH
00169 !| SHPBUF         |<->| WORK ARRAY
00170 !| SHPFLO         |<->| BARYCENTRIC COORDINATES OF FLOATS IN THEIR
00171 !|                |   | ELEMENTS.
00172 !| SHZBUF         |<->| WORK ARRAY
00173 !| SHZFLO         |<->| BARYCENTRIC COORDINATE ON VERTICAL
00174 !| SIZEBUF        |-->| DILMENSION OF SOME WORK ARRAYS
00175 !| SURDET         |-->| 1/DETERMINANT, USED IN ISOPARAMETRIC
00176 !|                |   | TRANSFORMATION.
00177 !| TAGFLO         |-->| TAGS OF FLOATS
00178 !| U              |-->| X-COMPONENT OF VELOCITY
00179 !| UL             |-->| LOGICAL UNIT OF OUTPUT FILE
00180 !| V              |-->| Y-COMPONENT OF VELOCITY
00181 !| W              |-->| Z-COMPONENT OF VELOCITY
00182 !| X              |-->| ABSCISSAE OF POINTS IN THE MESH
00183 !| Y              |-->| ORDINATES OF POINTS IN THE MESH
00184 !| Z              |-->| ELEVATIONS OF POINTS IN THE MESH
00185 !| XFLOT          |<->| ABSCISSAE OF FLOATS
00186 !| YFLOT          |<->| ORDINATES OF FLOATS
00187 !| ZFLOT          |<->| ELEVATIONS OF FLOATS
00188 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00189 !
00190       USE BIEF, EX_DERIVE => DERIVE
00191       USE STREAMLINE
00192       USE ALGAE_TRANSP
00193 !
00194       IMPLICIT NONE
00195       INTEGER LNG,LU
00196       COMMON/INFO/LNG,LU
00197 !
00198 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00199 !
00200       INTEGER         , INTENT(IN)    :: NPOIN,LT,IELM,IELMU,NDP,NELEM
00201       INTEGER         , INTENT(IN)    :: FLOPRD,NELMAX,UL,SIZEBUF,NPOIN2
00202       INTEGER         , INTENT(IN)    :: NFLOT_MAX,STOCHA
00203       INTEGER         , INTENT(INOUT) :: NFLOT
00204       DOUBLE PRECISION, INTENT(IN)    :: DT,AT
00205       DOUBLE PRECISION, INTENT(IN)    :: U(NPOIN),V(NPOIN),W(NPOIN)
00206       DOUBLE PRECISION, INTENT(IN)    :: X(NPOIN),Y(NPOIN),Z(NPOIN)
00207       INTEGER         , INTENT(IN)    :: IKLE(NELMAX,NDP)
00208       INTEGER         , INTENT(IN)    :: IFABOR(NELMAX,NDP)
00209       DOUBLE PRECISION, INTENT(IN)    :: SURDET(NELEM)
00210       DOUBLE PRECISION, INTENT(INOUT) :: XFLOT(NFLOT_MAX),DX(NFLOT_MAX)
00211       DOUBLE PRECISION, INTENT(INOUT) :: YFLOT(NFLOT_MAX),DY(NFLOT_MAX)
00212       DOUBLE PRECISION, INTENT(INOUT) :: ZFLOT(NFLOT_MAX),DZ(NFLOT_MAX)
00213       INTEGER         , INTENT(INOUT) :: TAGFLO(NFLOT_MAX)
00214       INTEGER         , INTENT(INOUT) :: ELTFLO(NFLOT_MAX)
00215       INTEGER         , INTENT(INOUT) :: ETAFLO(NFLOT_MAX)
00216       INTEGER         , INTENT(INOUT) :: ELTBUF(SIZEBUF)
00217       INTEGER         , INTENT(INOUT) :: ISUB(NFLOT_MAX)
00218       DOUBLE PRECISION, INTENT(INOUT) :: SHPFLO(NDP,NFLOT_MAX)
00219       DOUBLE PRECISION, INTENT(INOUT) :: SHZFLO(NFLOT_MAX)
00220       DOUBLE PRECISION, INTENT(INOUT) :: SHPBUF(NDP,SIZEBUF)
00221       DOUBLE PRECISION, INTENT(INOUT) :: SHZBUF(SIZEBUF)
00222       TYPE(BIEF_OBJ)  , INTENT(IN)    :: VISC
00223       TYPE(BIEF_MESH) , INTENT(INOUT) :: MESH
00224       LOGICAL         , OPTIONAL, INTENT(IN) :: AALGAE
00225       DOUBLE PRECISION, OPTIONAL, INTENT(IN) :: AK(NPOIN),EP(NPOIN)
00226       DOUBLE PRECISION, OPTIONAL, INTENT(IN) :: H(NPOIN)
00227       DOUBLE PRECISION, OPTIONAL, INTENT(IN) :: DALGAE,RALGAE,EALGAE
00228       INTEGER         , OPTIONAL, INTENT(IN) :: ALGTYP
00229 !
00230 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00231 !
00232       INTEGER IFLOT,FRE(1),FREBUF(1),IPROC,NFLOTG,NPLAN,ELT
00233       INTEGER N1,N2,N3,N4,N5,N6,NOMB,SENS
00234 !
00235       DOUBLE PRECISION ZSTAR(1)
00236 !
00237       CHARACTER(LEN=32) TEXTE(3)
00238       CHARACTER(LEN=72) LIGNE
00239 !
00240       LOGICAL YESITIS
00241 !
00242       TYPE(BIEF_OBJ) :: SVOID
00243 !
00244       INTEGER  P_ISUM
00245       EXTERNAL P_ISUM
00246 !
00247       CHARACTER(LEN=11) EXTENS
00248       EXTERNAL          EXTENS
00249 !
00250       LOGICAL DEJA
00251       DATA    DEJA/.FALSE./
00252 !
00253 !     DEFINE VARIABLES THAT ARE USED IN ALGAE TRANSPORT
00254 !     THESE ARE NECESSARY IF NFLOT_MAX IS TOO LARGE
00255 !
00256       LOGICAL INIT_ALG
00257       DATA    INIT_ALG/.TRUE./
00258       LOGICAL ALGAE
00259       INTEGER SIZEBUF2
00260       DOUBLE PRECISION,DIMENSION(:)  ,ALLOCATABLE::BUFF_1D
00261       DOUBLE PRECISION,DIMENSION(:,:),ALLOCATABLE::BUFF_2D
00262 !
00263       SAVE
00264 !
00265 !-----------------------------------------------------------------------
00266 !
00267 !     CHECKING ARGUMENTS FOR ALGAE
00268 !
00269       IF(PRESENT(AALGAE)) THEN
00270         ALGAE=AALGAE
00271       ELSE
00272         ALGAE=.FALSE.
00273       ENDIF
00274       IF(ALGAE) THEN
00275         IF(.NOT.PRESENT(AK).OR.
00276      &     .NOT.PRESENT(EP).OR.
00277      &     .NOT.PRESENT(H).OR.
00278      &     .NOT.PRESENT(DALGAE).OR.
00279      &     .NOT.PRESENT(RALGAE).OR.
00280      &     .NOT.PRESENT(EALGAE).OR.
00281      &     .NOT.PRESENT(ALGTYP)) THEN
00282           WRITE(LU,*) 'DERIVE: MISSING ARGUMENTS FOR ALGAE'
00283           CALL PLANTE(1)
00284           STOP
00285         ENDIF
00286       ENDIF
00287 !
00288 !-----------------------------------------------------------------------
00289 !
00290 !     PARAMETERISING THE CALL TO SCARACT
00291 !
00292 !     NUMBER OF PLANES
00293       NPLAN=NPOIN/NPOIN2
00294 !     NO VARIABLE TO INTERPOLATE AT THE FOOT OF CHARACTERISTICS
00295       NOMB=0
00296 !     FORWARD TRACKING
00297       SENS=1
00298 !
00299       IF(IELM.NE.11.AND.IELM.NE.41) THEN
00300         IF(LNG.EQ.1) WRITE(LU,123) IELM
00301         IF(LNG.EQ.2) WRITE(LU,124) IELM
00302 123     FORMAT(1X,'DERIVE : TYPE D''ELEMENT NON PREVU : ',1I6)
00303 124     FORMAT(1X,'DERIVE : UNEXPECTED TYPE OF ELEMENT: ',1I6)
00304         CALL PLANTE(1)
00305         STOP
00306       ENDIF
00307 !
00308 !-----------------------------------------------------------------------
00309 !
00310 !     INITIALISING SVOID AND HEADER OF A TECPLOT FILE
00311 !
00312       IF(.NOT.DEJA) THEN
00313 !
00314 !       THOUGH NOMB = 0, THESE COMPONENTS WILL BE USED IN SCARACT
00315 !
00316         SVOID%TYPE=2
00317         SVOID%DIM1=1
00318         ALLOCATE(SVOID%R(1))
00319 !
00320 !       HEADER OF TECPLOT FILE
00321 !
00322         IF(IPID.EQ.0) THEN
00323           TEXTE(1)='X                               '
00324           TEXTE(2)='Y                               '
00325           IF(LNG.EQ.1) THEN
00326             TEXTE(3)='COTE Z          M               '
00327           ELSE
00328             TEXTE(3)='ELEVATION Z     M               '
00329           ENDIF
00330           IF(LNG.EQ.1) THEN
00331             WRITE(UL,100) 'TITLE = "FICHIER DES FLOTTEURS"'
00332           ELSE
00333             WRITE(UL,100) 'TITLE = "DROGUES FILE"'
00334           ENDIF
00335           IF(IELM.EQ.11) THEN
00336             WRITE(UL,100) 'VARIABLES = "LABELS","'//
00337      &                     TEXTE(1)//'","'//TEXTE(2)//'","COLOUR"'
00338           ELSEIF(IELM.EQ.41) THEN
00339             WRITE(UL,100) 'VARIABLES = "LABELS","'//
00340      &      TEXTE(1)//'","'//TEXTE(2)//'","'//TEXTE(3)//'","COLOUR"'
00341           ENDIF
00342         ENDIF
00343         DEJA=.TRUE.
00344 100     FORMAT(A)
00345       ENDIF
00346 !
00347       SVOID%ELM=IELM
00348 !
00349 !-----------------------------------------------------------------------
00350 !
00351 !     TRAJECTORIES COMPUTED FOR ALL POINTS
00352 !
00353 !     ALLOCATE THE ALGAE VARIABLES IF NEEDED
00354 !
00355       IF(ALGAE.AND.INIT_ALG) THEN
00356         INIT_ALG=.FALSE.
00357 !       VERIFY THAT THE BUFFER SIZE IS BIG ENOUGH FOR PARTICLE TRANSPORT
00358         IF(NFLOT_MAX.GT.SIZEBUF)THEN
00359           SIZEBUF2=NFLOT_MAX
00360           ALLOCATE(BUFF_1D(SIZEBUF2))
00361           ALLOCATE(BUFF_2D(NDP,SIZEBUF2))
00362         ENDIF
00363       ENDIF
00364 !
00365       IF(ALGAE) THEN
00366         IF(LT.EQ.MAX(1,ALGAE_START)) THEN
00367           IF(IELMU.EQ.11) THEN
00368             CALL INTERP_ALGAE(NFLOT,NFLOT_MAX,SHPFLO,SHZFLO,ELTFLO,
00369      &          U_X_AV_0%R,U_Y_AV_0%R,U_Z_AV_0%R,K_AV_0%R,EPS_AV_0%R,
00370      &          H_FLU%R,NPOIN,IELM,NDP,NPLAN,NELMAX,IKLE,SHZBUF,IELMU,
00371      &          NPOIN,U,V,W,AK,EP,H)
00372             CALL INTERP_ALGAE(NFLOT,NFLOT_MAX,SHPFLO,SHZFLO,ELTFLO,
00373      &          U_X_AV%R,U_Y_AV%R,U_Z_AV%R,K_AV%R,EPS_AV%R,
00374      &          H_FLU%R,NPOIN,IELM,NDP,NPLAN,NELMAX,IKLE,SHZBUF,IELMU,
00375      &          NPOIN,U,V,W,AK,EP,H)
00376           ELSEIF(IELMU.EQ.12) THEN
00377             CALL INTERP_ALGAE(NFLOT,NFLOT_MAX,SHPFLO,SHZFLO,ELTFLO,
00378      &          U_X_AV_0%R,U_Y_AV_0%R,U_Z_AV_0%R,K_AV_0%R,EPS_AV_0%R,
00379      &          H_FLU%R,NPOIN,IELM,NDP,NPLAN,NELMAX,IKLE,SHZBUF,IELMU,
00380      &          NPOIN+NELMAX,U,V,W,AK,EP,H)
00381             CALL INTERP_ALGAE(NFLOT,NFLOT_MAX,SHPFLO,SHZFLO,ELTFLO,
00382      &          U_X_AV%R,U_Y_AV%R,U_Z_AV%R,K_AV%R,EPS_AV%R,
00383      &          H_FLU%R,NPOIN,IELM,NDP,NPLAN,NELMAX,IKLE,SHZBUF,IELMU,
00384      &          NPOIN+NELMAX,U,V,W,AK,EP,H)
00385           ENDIF
00386         ENDIF
00387       ENDIF
00388 !
00389 ! -----------------
00390 ! IF ALGAE IS .TRUE., THEN USE ALGAE TRANSPORT
00391 ! OTHERWISE THIS IS A NORMAL DROGUE TRANSPORT
00392 ! -----------------
00393 !
00394       IF(ALGAE)THEN
00395 !
00396 ! FILL I_A_GL, WHICH WILL BE USED TO VERIFY THAT THE ALGAE INFO IS SENT IN
00397 ! THE SAME FASHION AS THE PARTICLE POSITIONS
00398 !
00399         DO IFLOT=1,NFLOT
00400           I_A_GL%I(IFLOT)=TAGFLO(IFLOT)
00401         END DO
00402 !
00403         IF(IELMU.EQ.11)THEN
00404           CALL INTERP_ALGAE(NFLOT,NFLOT_MAX,SHPFLO,SHZFLO,ELTFLO,
00405      &          U_X_AV%R,U_Y_AV%R,U_Z_AV%R,K_AV%R,EPS_AV%R,
00406      &          H_FLU%R,NPOIN,IELM,NDP,NPLAN,NELMAX,IKLE,SHZBUF,IELMU,
00407      &          NPOIN,U,V,W,AK,EP,H)
00408         ELSEIF(IELMU.EQ.12)THEN
00409           CALL INTERP_ALGAE(NFLOT,NFLOT_MAX,SHPFLO,SHZFLO,ELTFLO,
00410      &          U_X_AV%R,U_Y_AV%R,U_Z_AV%R,K_AV%R,EPS_AV%R,
00411      &          H_FLU%R,NPOIN,IELM,NDP,NPLAN,NELMAX,IKLE,SHZBUF,IELMU,
00412      &          NPOIN+NELMAX,U,V,W,AK,EP,H)
00413         END IF
00414 !
00415         CALL DISP_ALGAE(NFLOT_MAX,NFLOT,MESH%DIM,DT,ALGAE_START,
00416      &                 U_X_AV_0%R,U_Y_AV_0%R,U_Z_AV_0%R,K_AV_0%R,
00417      &                 EPS_AV_0%R,H_FLU%R,U_X_AV%R,U_Y_AV%R,U_Z_AV%R,
00418      &                 U_X_0%R,U_Y_0%R,U_Z_0%R,V_X_0%R,V_Y_0%R,V_Z_0%R,
00419      &                 DX,DY,DZ,ELTFLO,U_X%R,U_Y%R,U_Z%R,V_X%R,V_Y%R,
00420      &                 V_Z%R,XFLOT,YFLOT,ZFLOT,LT,DALGAE,RALGAE,EALGAE,
00421      &                 ALGTYP)
00422 !
00423 ! FIND THE ELEMENT AND SUBDOMAIN AFTER THE TRANSPORT (WITH A VERIFICATION
00424 ! IF SIZEBUF.LT.NFLOT_MAX)
00425 !
00426         IF(NFLOT_MAX.GT.SIZEBUF)THEN
00427           CALL SCARACT(SVOID,SVOID,U,V,W,W,X,Y,ZSTAR,ZSTAR,
00428      &             XFLOT,YFLOT,
00429      &             ZFLOT,ZFLOT,
00430      &             DX,DY,
00431      &             DZ,DZ,Z,
00432      &             SHPFLO,SHZFLO,SHZFLO,
00433      &             SURDET,DT,IKLE,IFABOR,ELTFLO,ETAFLO,
00434      &             FRE,ELTBUF,ISUB,IELM,IELMU,
00435      &             NELEM,NELMAX,
00436      &             NOMB,NPOIN,NPOIN2,NDP,NPLAN,1,MESH,NFLOT,NPOIN2,SENS,
00437      &             BUFF_2D,BUFF_1D,BUFF_1D,FREBUF,SIZEBUF2,
00438      &             AALG=ALGAE,APOST=.TRUE.)
00439         ELSE
00440           CALL SCARACT(SVOID,SVOID,U,V,W,W,X,Y,ZSTAR,ZSTAR,
00441      &             XFLOT,YFLOT,
00442      &             ZFLOT,ZFLOT,
00443      &             DX,DY,
00444      &             DZ,DZ,Z,
00445      &             SHPFLO,SHZFLO,SHZFLO,
00446      &             SURDET,DT,IKLE,IFABOR,ELTFLO,ETAFLO,
00447      &             FRE,ELTBUF,ISUB,IELM,IELMU,
00448      &             NELEM,NELMAX,
00449      &             NOMB,NPOIN,NPOIN2,NDP,NPLAN,1,MESH,NFLOT,NPOIN2,SENS,
00450      &             SHPBUF,SHZBUF,SHZBUF,FREBUF,SIZEBUF,
00451      &             AALG=ALGAE,APOST=.TRUE.)
00452         ENDIF
00453       ELSE
00454         CALL SCARACT(SVOID,SVOID,U,V,W,W,X,Y,ZSTAR,ZSTAR,
00455      &             XFLOT,YFLOT,ZFLOT,ZFLOT,
00456      &             DX,DY,DZ,DZ,Z,SHPFLO,SHZFLO,SHZFLO,SURDET,DT,
00457      &             IKLE,IFABOR,ELTFLO,ETAFLO,
00458      &             FRE,ELTBUF,ISUB,IELM,IELMU,NELEM,NELMAX,
00459      &             NOMB,NPOIN,NPOIN2,NDP,NPLAN,1,MESH,NFLOT,NPOIN2,SENS,
00460      &             SHPBUF,SHZBUF,SHZBUF,FREBUF,SIZEBUF,
00461      &             APOST=.TRUE.,ASTOCHA=STOCHA,AVISC=VISC)
00462 !                  APOST=.TRUE. OTHERWISE ISUB IS NOT FILLED
00463       ENDIF
00464 !
00465 !-----------------------------------------------------------------------
00466 !
00467       IF(NCSIZE.GT.1.AND.NFLOT.GT.0) THEN
00468 !
00469 !       IN // XFLOT AND YFLOT MAY HAVE BEEN DESTROYED BY SCARACT
00470 !       BECAUSE RE-USED FOR GENERATIONS OF LOST PARTICLES
00471 !       THEY ARE REDONE HERE FOR PARTICLES WHICH ARE STILL IN THE
00472 !       SUB-DOMAIN
00473 !
00474         IF(IELM.EQ.11) THEN
00475           DO IFLOT=1,NFLOT
00476             IF(ISUB(IFLOT).EQ.IPID) THEN
00477               ELT=ELTFLO(IFLOT)
00478               IF(ELT.GT.0) THEN
00479                 N1=IKLE(ELT,1)
00480                 N2=IKLE(ELT,2)
00481                 N3=IKLE(ELT,3)
00482                 XFLOT(IFLOT)=SHPFLO(1,IFLOT)*X(N1)
00483      &                      +SHPFLO(2,IFLOT)*X(N2)
00484      &                      +SHPFLO(3,IFLOT)*X(N3)
00485                 YFLOT(IFLOT)=SHPFLO(1,IFLOT)*Y(N1)
00486      &                      +SHPFLO(2,IFLOT)*Y(N2)
00487      &                      +SHPFLO(3,IFLOT)*Y(N3)
00488               ENDIF
00489             ENDIF
00490           ENDDO
00491         ELSEIF(IELM.EQ.41) THEN
00492           DO IFLOT=1,NFLOT
00493             IF(ISUB(IFLOT).EQ.IPID) THEN
00494               ELT=ELTFLO(IFLOT)
00495               IF(ELT.GT.0) THEN
00496                 N1=IKLE(ELT,1)+NPOIN2*(ETAFLO(IFLOT)-1)
00497                 N2=IKLE(ELT,2)+NPOIN2*(ETAFLO(IFLOT)-1)
00498                 N3=IKLE(ELT,3)+NPOIN2*(ETAFLO(IFLOT)-1)
00499                 N4=IKLE(ELT,1)+NPOIN2* ETAFLO(IFLOT)
00500                 N5=IKLE(ELT,2)+NPOIN2* ETAFLO(IFLOT)
00501                 N6=IKLE(ELT,3)+NPOIN2* ETAFLO(IFLOT)
00502                 XFLOT(IFLOT)=SHPFLO(1,IFLOT)*X(N1)
00503      &                      +SHPFLO(2,IFLOT)*X(N2)
00504      &                      +SHPFLO(3,IFLOT)*X(N3)
00505                 YFLOT(IFLOT)=SHPFLO(1,IFLOT)*Y(N1)
00506      &                      +SHPFLO(2,IFLOT)*Y(N2)
00507      &                      +SHPFLO(3,IFLOT)*Y(N3)
00508                 ZFLOT(IFLOT)=(Z(N1)*SHPFLO(1,IFLOT)
00509      &                      +Z(N2)*SHPFLO(2,IFLOT)
00510      &                      +Z(N3)*SHPFLO(3,IFLOT))*(1.D0-SHZFLO(IFLOT))
00511      &                      +(Z(N4)*SHPFLO(1,IFLOT)
00512      &                      +Z(N5)*SHPFLO(2,IFLOT)
00513      &                      +Z(N6)*SHPFLO(3,IFLOT))*SHZFLO(IFLOT)
00514               ENDIF
00515             ENDIF
00516           ENDDO
00517         ENDIF
00518 !
00519       ENDIF
00520 !
00521 !     SEND THE ALGAE INFORMATION IF IT IS NECESSARY
00522 !
00523       IF(NCSIZE.GT.1.AND.ALGAE) THEN
00524         CALL SEND_INFO_ALG(XFLOT,YFLOT,ZFLOT,SHPFLO,SHZFLO,ELTFLO,
00525      &                 ETAFLO,ISUB,I_A_GL%I,ELTBUF,NDP,NFLOT,NFLOT_MAX,
00526      &                 MESH,NPLAN,U_X_AV%R,U_Y_AV%R,U_Z_AV%R,K_AV%R,
00527      &                 EPS_AV%R,H_FLU%R,U_X%R,U_Y%R,U_Z%R,V_X%R,V_Y%R,
00528      &                 V_Z%R,NWIN,MESH%DIM,PSI)
00529       ENDIF
00530 !
00531 !     SENDING THE PARTICLES THAT MIGRATED TO ANOTHER SUB-DOMAIN
00532 !
00533       IF(NCSIZE.GT.1) THEN
00534         IF(ALGAE) THEN
00535           CALL SEND_PARTICLES(XFLOT,YFLOT,ZFLOT,SHPFLO,SHZFLO,ELTFLO,
00536      &                        ETAFLO,ISUB,TAGFLO,NDP,NFLOT,NFLOT_MAX,
00537      &                        MESH,NPLAN,DX=DX,DY=DY,DZ=DZ)
00538         ELSE
00539           CALL SEND_PARTICLES(XFLOT,YFLOT,ZFLOT,SHPFLO,SHZFLO,ELTFLO,
00540      &                        ETAFLO,ISUB,TAGFLO,NDP,NFLOT,NFLOT_MAX,
00541      &                        MESH,NPLAN)
00542         ENDIF
00543       ENDIF
00544 !
00545 !-----------------------------------------------------------------------
00546 !
00547 !     CASE OF LOST FLOATS (EXITED OR NOW REMOVED AFTER BEING SENT TO
00548 !                          ANOTHER SUB-DOMAIN)
00549 !
00550       IFLOT=1
00551       IF(NCSIZE.GT.1) THEN
00552 !
00553 !       IN // MODE
00554 !
00555 11      CONTINUE
00556 !       LOST OR MIGRATED FLOATS
00557         IF(NFLOT.GT.0.AND.NCSIZE.GT.1) THEN
00558           IF(ELTFLO(IFLOT).LE.0.OR.ISUB(IFLOT).NE.IPID) THEN
00559 !
00560 !           REMOVE ALGAE INFORMATION FROM A SUB DOMAIN IF IT IS NECESSARY
00561 !
00562             IF(ALGAE) THEN
00563               CALL DEL_INFO_ALG(TAGFLO(IFLOT),NFLOT,NFLOT_MAX,
00564      &                   MESH%TYPELM,I_A_GL%I,ELTBUF,V_X%R,V_Y%R,V_Z%R,
00565      &                   U_X%R,U_Y%R,U_Z%R,U_X_AV%R,U_Y_AV%R,U_Z_AV%R,
00566      &                   K_AV%R,EPS_AV%R,H_FLU%R,NWIN,MESH%DIM,PSI)
00567             ENDIF
00568 !
00569             IF(ALGAE) THEN
00570               CALL DEL_PARTICLE(TAGFLO(IFLOT),NFLOT,NFLOT_MAX,XFLOT,
00571      &                          YFLOT,ZFLOT,TAGFLO,SHPFLO,SHZFLO,ELTFLO,
00572      &                          ETAFLO,MESH%TYPELM,
00573      &                          DX=DX,DY=DY,DZ=DZ,ISUB=ISUB)
00574             ELSE
00575               CALL DEL_PARTICLE(TAGFLO(IFLOT),NFLOT,NFLOT_MAX,XFLOT,
00576      &                          YFLOT,ZFLOT,TAGFLO,SHPFLO,SHZFLO,ELTFLO,
00577      &                          ETAFLO,MESH%TYPELM,
00578      &                          ISUB=ISUB)
00579             ENDIF
00580 !
00581 !           THE SAME IFLOT IS NOW A NEW PARTICLE AND MUST BE CHECKED AGAIN!
00582             IF(IFLOT.LE.NFLOT) GO TO 11
00583           ENDIF
00584 !
00585           IF(ALGAE)THEN
00586 !           UPDATE DX_A,DY_A,DZ_A
00587             DX_A%R(IFLOT)=DX(IFLOT)
00588             DY_A%R(IFLOT)=DY(IFLOT)
00589             DZ_A%R(IFLOT)=DZ(IFLOT)
00590           ENDIF
00591 !
00592           IFLOT=IFLOT+1
00593           IF(IFLOT.LE.NFLOT) GO TO 11
00594         ENDIF
00595 !
00596       ELSE
00597 !
00598 !       IN SCALAR MODE
00599 !
00600 10      CONTINUE
00601 !       LOST FLOATS ONLY
00602         IF(NFLOT.GT.0) THEN
00603           IF(ELTFLO(IFLOT).LE.0) THEN
00604 !
00605 !           REMOVE INFORMATION FROM A SUB DOMAIN IF NECESSARY
00606 !
00607             IF(ALGAE) THEN
00608               CALL DEL_INFO_ALG(TAGFLO(IFLOT),NFLOT,NFLOT_MAX,
00609      &                   MESH%TYPELM,I_A_GL%I,ELTBUF,V_X%R,V_Y%R,V_Z%R,
00610      &                   U_X%R,U_Y%R,U_Z%R,U_X_AV%R,U_Y_AV%R,U_Z_AV%R,
00611      &                   K_AV%R,EPS_AV%R,H_FLU%R,NWIN,MESH%DIM,PSI)
00612               CALL DEL_PARTICLE(TAGFLO(IFLOT),NFLOT,NFLOT_MAX,XFLOT,
00613      &                    YFLOT,ZFLOT,TAGFLO,SHPFLO,SHZFLO,ELTFLO,
00614      &                    ETAFLO,MESH%TYPELM,DX=DX,DY=DY,DZ=DZ)
00615             ELSE
00616               CALL DEL_PARTICLE(TAGFLO(IFLOT),NFLOT,NFLOT_MAX,XFLOT,
00617      &                    YFLOT,ZFLOT,TAGFLO,SHPFLO,SHZFLO,ELTFLO,
00618      &                    ETAFLO,MESH%TYPELM)
00619             ENDIF
00620 !
00621 !           THE SAME IFLOT IS NOW A NEW PARTICLE AND MUST BE CHECKED AGAIN!
00622             IF(IFLOT.LE.NFLOT) GO TO 10
00623           ENDIF
00624 !
00625           IF(ALGAE)THEN
00626 !           UPDATE DX_A,DY_A,DZ_A
00627             DX_A%R(IFLOT)=DX(IFLOT)
00628             DY_A%R(IFLOT)=DY(IFLOT)
00629             DZ_A%R(IFLOT)=DZ(IFLOT)
00630           ENDIF
00631 !
00632           IFLOT=IFLOT+1
00633           IF(IFLOT.LE.NFLOT) GO TO 10
00634         ENDIF
00635 !
00636       ENDIF
00637 !
00638 !-----------------------------------------------------------------------
00639 !
00640 !     TECPLOT FILE
00641 !
00642       IF(NCSIZE.GT.1) THEN
00643 !
00644 !       WAITING ALL PROCESSORS (SO THAT NFLOT IS UPDATED FOR ALL
00645 !                               BEFORE CALLING P_ISUM)
00646 !
00647         CALL P_SYNC
00648 !
00649 !       PARALLEL VERSION
00650 !
00651         NFLOTG=P_ISUM(NFLOT)
00652         IF(NFLOTG.GT.0.AND.(LT.EQ.1.OR.(LT/FLOPRD)*FLOPRD.EQ.LT)) THEN
00653 !
00654 !         1) EVERY PROCESSOR WRITES ITS OWN DATA IN A FILE WITH EXTENSION
00655 !
00656           IF(NFLOT.GT.0) THEN
00657             OPEN(99,FILE=EXTENS(NCSIZE,IPID+1),
00658      &           FORM='FORMATTED',STATUS='NEW')
00659             IF(IELM.EQ.11) THEN
00660               DO IFLOT=1,NFLOT
00661                 WRITE(99,300) TAGFLO(IFLOT),XFLOT(IFLOT),
00662      &                        YFLOT(IFLOT),1
00663               ENDDO
00664             ELSE
00665               DO IFLOT=1,NFLOT
00666                 WRITE(99,301) TAGFLO(IFLOT),XFLOT(IFLOT),
00667      &                        YFLOT(IFLOT),ZFLOT(IFLOT),1
00668               ENDDO
00669             ENDIF
00670             CLOSE(99)
00671           ENDIF
00672 !
00673 !         2) WAITING ALL PROCESSORS
00674 !
00675           CALL P_SYNC
00676 !
00677 !         3) PROCESSOR 0 READS ALL EXISTING FILES AND MERGES
00678 !            THEM IN THE FINAL FILE
00679 !
00680           IF(IPID.EQ.0) THEN
00681             WRITE(UL,200) 'ZONE DATAPACKING=POINT, T="G_',AT,
00682      &        ' SECONDS"',', I=',NFLOTG,', SOLUTIONTIME=',AT
00683             DO IPROC=1,NCSIZE
00684               INQUIRE(FILE=EXTENS(NCSIZE,IPROC),EXIST=YESITIS)
00685               IF(YESITIS) THEN
00686                 OPEN(99,FILE=EXTENS(NCSIZE,IPROC),
00687      &               FORM='FORMATTED',STATUS='OLD')
00688 22              CONTINUE
00689                 READ(99,100,ERR=23,END=23) LIGNE
00690                 WRITE(UL,*) LIGNE
00691                 GO TO 22
00692 23              CONTINUE
00693                 CLOSE(99,STATUS='DELETE')
00694               ENDIF
00695             ENDDO
00696           ENDIF
00697 !
00698         ENDIF
00699 !
00700       ELSE
00701 !
00702 !       SCALAR VERSION
00703 !
00704         IF(NFLOT.GT.0.AND.(LT.EQ.1.OR.(LT/FLOPRD)*FLOPRD.EQ.LT)) THEN
00705           WRITE(UL,200) 'ZONE DATAPACKING=POINT, T="G_',AT,
00706      &                  ' SECONDS"',', I=',NFLOT,', SOLUTIONTIME=',AT
00707           IF(IELM.EQ.11) THEN
00708             DO IFLOT=1,NFLOT
00709               WRITE(UL,300) TAGFLO(IFLOT),XFLOT(IFLOT),YFLOT(IFLOT),1
00710             ENDDO
00711           ELSE
00712             DO IFLOT=1,NFLOT
00713               WRITE(UL,301) TAGFLO(IFLOT),XFLOT(IFLOT),
00714      &                      YFLOT(IFLOT),ZFLOT(IFLOT),1
00715             ENDDO
00716           ENDIF
00717 200       FORMAT(A,F12.4,A,A,I4,A,F12.4)
00718 300       FORMAT(I6,',',F16.8,',',F16.8,',',I2)
00719 301       FORMAT(I6,',',F16.8,',',F16.8,',',F16.8,',',I2)
00720         ENDIF
00721 !
00722       ENDIF
00723 !
00724 !-----------------------------------------------------------------------
00725 !
00726       RETURN
00727       END SUBROUTINE DERIVE

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