m_med.F

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\m_med.F
00002 !
00172                   MODULE M_MED
00173 !                 ************
00174 !
00175 !***********************************************************************
00176 ! BIEF  V5P8                                                 2008
00177 !***********************************************************************
00178 !
00179 !
00180 !
00181 !
00182 !
00183 !
00184 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00185 !|               |-->|
00186 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00187 !
00188 
00189       IMPLICIT NONE
00190       ! PLACE PUBLIC DECLARATIONS HERE ...
00191 
00192       PUBLIC OPEN_FILE_MED
00193       PUBLIC CLOSE_FILE_MED
00194       PUBLIC WRITE_MESH_MED
00195       PUBLIC CREATE_DATASET_MED
00196       PUBLIC WRITE_DATA_MED
00197       PUBLIC SUITE_MED
00198 
00199 !-----------------------------------------------------------------------
00200 !   DEFINITIONS OF VARIABLES 'MED'
00201 !-----------------------------------------------------------------------
00202 ! FD:
00203 ! IFDEF NOT RECOMMENDED HERE.
00204 ! WE PREFER WRITE EXPLICITLY THESE PARAMETERS HEREAFTER.
00205 ! IT AVOID US TO ADD AN OPTION IN THE CONFIGURATION FILE...
00206 ! (THOUGH WE HAVE TO MODIFY EVERY TIME THE SOURCE CODE)
00207 !
00208 !#if defined(HAVE_MED)
00209 !      INCLUDE 'med.hf'
00210 !#endif
00211 
00212 ! START OF 'med.hf' MED-V3.0.4
00213       INTEGER MED_ACC_RDONLY,MED_ACC_RDWR,MED_ACC_RDEXT
00214       INTEGER MED_ACC_CREAT,MED_ACC_UNDEF
00215       PARAMETER (MED_ACC_RDONLY=0,MED_ACC_RDWR=1)
00216       PARAMETER (MED_ACC_RDEXT=2,MED_ACC_CREAT=3,MED_ACC_UNDEF=4)
00217 
00218       INTEGER MED_UNSTRUCTURED_MESH, MED_STRUCTURED_MESH
00219       INTEGER MED_UNDEF_MESH_TYPE
00220       PARAMETER (MED_UNSTRUCTURED_MESH=0,MED_STRUCTURED_MESH=1)
00221       PARAMETER (MED_UNDEF_MESH_TYPE=-1)
00222 
00223       INTEGER MED_CARTESIAN, MED_CYLINDRICAL, MED_SPHERICAL
00224       INTEGER MED_UNDEF_AXIS_TYPE
00225       PARAMETER(MED_CARTESIAN=0, MED_CYLINDRICAL=1, MED_SPHERICAL=2)
00226       PARAMETER(MED_UNDEF_AXIS_TYPE=-1)
00227       INTEGER MED_CARTESIAN_GRID, MED_POLAR_GRID
00228       INTEGER MED_CURVILINEAR_GRID, MED_UNDEF_GRID_TYPE
00229       PARAMETER (MED_CARTESIAN_GRID=0, MED_POLAR_GRID=1)
00230       PARAMETER  (MED_CURVILINEAR_GRID=2, MED_UNDEF_GRID_TYPE=-1)
00231 
00232       INTEGER MED_SORT_DTIT,MED_SORT_ITDT,MED_SORT_UNDEF
00233       PARAMETER (MED_SORT_DTIT=0,MED_SORT_ITDT=1,MED_SORT_UNDEF=-1)
00234 
00235       INTEGER MED_COMMENT_SIZE,MED_NAME_SIZE,MED_SNAME_SIZE
00236       INTEGER MED_LNAME_SIZE
00237       PARAMETER (MED_COMMENT_SIZE=200,MED_NAME_SIZE=64)
00238       PARAMETER (MED_SNAME_SIZE=16, MED_LNAME_SIZE=80)
00239 
00240       INTEGER MED_NO_IT, MED_NO_DT
00241       PARAMETER (MED_NO_IT=-1, MED_NO_DT = -1)
00242       DOUBLE PRECISION, PARAMETER ::  MED_UNDEF_DT = 0.0
00243 
00244       INTEGER MED_UNDEF_INTERLACE,MED_FULL_INTERLACE
00245       INTEGER MED_NO_INTERLACE
00246       PARAMETER (MED_UNDEF_INTERLACE=-1,MED_FULL_INTERLACE=0)
00247       PARAMETER (MED_NO_INTERLACE=1)
00248 
00249       INTEGER MED_CELL, MED_DESCENDING_FACE
00250       INTEGER MED_DESCENDING_EDGE,MED_NODE
00251       INTEGER MED_NODE_ELEMENT, MED_STRUCT_ELEMENT
00252       INTEGER MED_ALL_ENTITY_TYPE,MED_UNDEF_ENTITY_TYPE
00253       INTEGER MED_N_ENTITY_TYPES
00254       PARAMETER (MED_N_ENTITY_TYPES=6)
00255       PARAMETER (MED_CELL=0, MED_DESCENDING_FACE=1)
00256       PARAMETER (MED_DESCENDING_EDGE=2,MED_NODE=3)
00257       PARAMETER (MED_NODE_ELEMENT=4, MED_STRUCT_ELEMENT=5)
00258       PARAMETER (MED_ALL_ENTITY_TYPE=6,MED_UNDEF_ENTITY_TYPE=-1)
00259 
00260       INTEGER MED_POINT1,MED_SEG2,MED_SEG3,MED_SEG4,MED_TRIA3
00261       INTEGER MED_QUAD4,MED_TRIA6,MED_TRIA7,MED_QUAD8,MED_QUAD9
00262       INTEGER MED_TETRA4,MED_PYRA5,MED_PENTA6,MED_HEXA8,MED_TETRA10
00263       INTEGER MED_OCTA12,MED_PYRA13,MED_PENTA15,MED_HEXA20,MED_HEXA27
00264       INTEGER MED_POLYGON,MED_POLYHEDRON, MED_STRUCT_GEO_INTERNAL
00265       INTEGER MED_STRUCT_GEO_SUP_INTERNAL,MED_NONE
00266       INTEGER MED_GEO_ALL,MED_ALL_GEOTYPE
00267       INTEGER MED_NO_GEOTYPE,MED_UNDEF_GEOTYPE
00268       PARAMETER(MED_POINT1=001)
00269       PARAMETER(MED_SEG2=102)
00270       PARAMETER(MED_SEG3=103)
00271       PARAMETER(MED_SEG4=104)
00272       PARAMETER(MED_TRIA3=203)
00273       PARAMETER(MED_QUAD4=204)
00274       PARAMETER(MED_TRIA6=206)
00275       PARAMETER(MED_TRIA7=207)
00276       PARAMETER(MED_QUAD8=208)
00277       PARAMETER(MED_QUAD9=209)
00278       PARAMETER(MED_TETRA4=304)
00279       PARAMETER(MED_PYRA5=305)
00280       PARAMETER(MED_PENTA6=306)
00281       PARAMETER(MED_HEXA8=308)
00282       PARAMETER(MED_TETRA10=310)
00283       PARAMETER(MED_OCTA12=312)
00284       PARAMETER(MED_PYRA13=313)
00285       PARAMETER(MED_PENTA15=315)
00286       PARAMETER(MED_HEXA20=320)
00287       PARAMETER(MED_HEXA27=327)
00288       PARAMETER(MED_POLYGON=400)
00289       PARAMETER(MED_POLYHEDRON=500)
00290       PARAMETER(MED_STRUCT_GEO_INTERNAL=600)
00291       PARAMETER(MED_STRUCT_GEO_SUP_INTERNAL=700)
00292       PARAMETER(MED_NONE=0)
00293       PARAMETER(MED_GEO_ALL=-1)
00294       PARAMETER(MED_ALL_GEOTYPE=-1)
00295       PARAMETER(MED_NO_GEOTYPE=0)
00296       PARAMETER(MED_UNDEF_GEOTYPE=0)
00297 
00298       INTEGER  MED_N_CELL_GEO,MED_N_CELL_FIXED_GEO
00299       INTEGER  MED_N_CELL_GEO_FIXED_CON
00300       INTEGER  MED_N_FACE_GEO,MED_N_FACE_FIXED_GEO
00301       INTEGER  MED_N_FACE_GEO_FIXED_CON
00302       INTEGER  MED_N_EDGE_TYPES,MED_N_EDGE_FIXED_GEO
00303       INTEGER  MED_N_EDGE_GEO_FIXED_CON
00304       INTEGER  MED_N_NODE_GEO,MED_N_NODE_FIXED_GEO
00305       INTEGER  MED_N_NODE_GEO_FIXED_CON
00306       PARAMETER(MED_N_CELL_GEO=23)
00307       PARAMETER(MED_N_CELL_FIXED_GEO=22)
00308       PARAMETER(MED_N_CELL_GEO_FIXED_CON=20)
00309       PARAMETER(MED_N_FACE_GEO=7)
00310       PARAMETER(MED_N_FACE_FIXED_GEO=7)
00311       PARAMETER(MED_N_FACE_GEO_FIXED_CON=6)
00312       PARAMETER(MED_N_EDGE_TYPES=3)
00313       PARAMETER(MED_N_EDGE_FIXED_GEO=3)
00314       PARAMETER(MED_N_EDGE_GEO_FIXED_CON=3)
00315       PARAMETER(MED_N_NODE_GEO=1)
00316       PARAMETER(MED_N_NODE_FIXED_GEO=1)
00317       PARAMETER(MED_N_NODE_GEO_FIXED_CON=1)
00318 
00319       INTEGER MED_COORDINATE, MED_CONNECTIVITY
00320       INTEGER MED_NAME, MED_NUMBER
00321       INTEGER MED_FAMILY_NUMBER
00322       INTEGER MED_COORDINATE_AXIS1, MED_COORDINATE_AXIS2
00323       INTEGER MED_COORDINATE_AXIS3, MED_INDEX_FACE, MED_INDEX_NODE
00324       INTEGER MED_GLOBAL_NUMBER, MED_VARIABLE_ATTRIBUTE
00325       INTEGER MED_COORDINATE_TRSF, MED_UNDEF_DATATYPE
00326       PARAMETER(MED_COORDINATE=0, MED_CONNECTIVITY=1, MED_NAME=2)
00327       PARAMETER(MED_NUMBER=3, MED_FAMILY_NUMBER=4)
00328       PARAMETER(MED_COORDINATE_AXIS1=5, MED_COORDINATE_AXIS2=6)
00329       PARAMETER(MED_COORDINATE_AXIS3=7,MED_INDEX_FACE=8)
00330       PARAMETER(MED_INDEX_NODE=9,MED_GLOBAL_NUMBER=10)
00331       PARAMETER(MED_VARIABLE_ATTRIBUTE=11,MED_COORDINATE_TRSF=12)
00332       PARAMETER(MED_UNDEF_DATATYPE=-1)
00333 
00334       INTEGER MED_NODAL, MED_DESCENDING, MED_UNDEF_CONNECTIVITY_MODE
00335       INTEGER MED_NO_CMODE
00336       PARAMETER(MED_NODAL=0,MED_DESCENDING=1)
00337       PARAMETER(MED_UNDEF_CONNECTIVITY_MODE=-1)
00338       PARAMETER(MED_NO_CMODE=-1)
00339 
00340       INTEGER MED_FALSE, MED_TRUE
00341       PARAMETER(MED_FALSE=0,MED_TRUE=1)
00342 
00343       INTEGER MED_UNDEF_PFLMODE,MED_GLOBAL_PFLMODE,MED_COMPACT_PFLMODE
00344       INTEGER MED_UNDEF_STMODE,MED_GLOBAL_STMODE,MED_COMPACT_STMODE
00345       CHARACTER*64 MED_GAUSS_ELNO,MED_IPOINT_ELNO
00346       PARAMETER(MED_GAUSS_ELNO='MED_GAUSS_ELNO')
00347       PARAMETER(MED_IPOINT_ELNO='MED_GAUSS_ELNO')
00348       PARAMETER(MED_UNDEF_PFLMODE=0,MED_GLOBAL_PFLMODE=1)
00349       PARAMETER(MED_COMPACT_PFLMODE=2)
00350       PARAMETER(MED_UNDEF_STMODE=0,MED_GLOBAL_STMODE=1)
00351       PARAMETER(MED_COMPACT_STMODE=2)
00352       CHARACTER*64 MED_NO_NAME,MED_NO_MESHNAME,MED_NO_MESH
00353       CHARACTER*64 MED_NO_MESH_SUPPORT, MED_NO_LOCALIZATION
00354       CHARACTER*64 MED_NO_INTERPOLATION, MED_NO_PROFILE
00355       CHARACTER*64 MED_ALLENTITIES_PROFILE
00356       CHARACTER*80 MED_NO_GROUP
00357       PARAMETER(MED_NO_NAME='',MED_NO_MESHNAME='',MED_NO_MESH='')
00358       PARAMETER(MED_NO_MESH_SUPPORT='', MED_NO_LOCALIZATION='')
00359       PARAMETER(MED_NO_INTERPOLATION='', MED_NO_PROFILE='')
00360       PARAMETER(MED_ALLENTITIES_PROFILE='')
00361       PARAMETER(MED_NO_GROUP='')
00362 
00363       INTEGER MED_ALL_CONSTITUENT
00364       PARAMETER(MED_ALL_CONSTITUENT=0)
00365 
00366       INTEGER MED_UNDEF_SIZE,MED_NO_PROFILE_SIZE
00367       PARAMETER(MED_UNDEF_SIZE=0,MED_NO_PROFILE_SIZE=0)
00368 
00369       INTEGER MED_MESH,MED_FIELD,MED_LIBRARY,MED_FILE
00370       INTEGER MED_MESH_SUPPORT,MED_ELSTRUCT,MED_FAMILY
00371       INTEGER MED_EQUIVALENCE, MED_GROUP, MED_JOINT
00372       INTEGER MED_LOCALIZATION, MED_PROFILE,MED_FILTER,MED_INTERPOLATION
00373       INTEGER MED_NUMERICAL_DATA,MED_LINK,MED_CLASS_UNDEF,MED_CLASS_ALL
00374       PARAMETER(MED_MESH=0,MED_FIELD=1,MED_LIBRARY=2,MED_FILE=3)
00375       PARAMETER(MED_MESH_SUPPORT=4,MED_ELSTRUCT=5,MED_FAMILY=6)
00376       PARAMETER(MED_LOCALIZATION=7,MED_PROFILE=8,MED_FILTER=9)
00377       PARAMETER(MED_INTERPOLATION=10, MED_NUMERICAL_DATA=11)
00378       PARAMETER(MED_LINK=13, MED_CLASS_UNDEF=-1, MED_CLASS_ALL=-2)
00379 
00380       INTEGER MED_INT32, MED_INT64,MED_FLOAT64,MED_INT
00381       PARAMETER (MED_INT32=24, MED_INT64=26,MED_FLOAT64=6,MED_INT=28)
00382 
00383       INTEGER MED_ATT_FLOAT64,MED_ATT_INT,MED_ATT_NAME
00384       INTEGER MED_ATT_UNDEF
00385       PARAMETER(MED_ATT_FLOAT64=MED_FLOAT64)
00386       PARAMETER(MED_ATT_INT=MED_INT)
00387       PARAMETER(MED_ATT_NAME=30)
00388       PARAMETER(MED_ATT_UNDEF=0)
00389 
00390       CHARACTER*64 MED_PARTICLE_NAME, MED_BALL_NAME, MED_BEAM_NAME
00391       CHARACTER*64 MED_PARTICLE_LABEL,MED_BALL_DIAMETER
00392       CHARACTER*64 MED_BEAM_THICKNESS
00393       PARAMETER(MED_PARTICLE_NAME='MED_PARTICLE')
00394       PARAMETER(MED_BALL_NAME='MED_BALL')
00395       PARAMETER(MED_BEAM_NAME='MED_BEAM')
00396       PARAMETER(MED_PARTICLE_LABEL='MED_PARTICLE_LABEL')
00397       PARAMETER(MED_BALL_DIAMETER='MED_BALL_DIAMETER')
00398       PARAMETER(MED_BEAM_THICKNESS='MED_BEAM_THICKNESS')
00399 ! END OF 'med.hf'
00400 
00401 !
00402       INTEGER :: LOCAL_TIMESTEP_2D = 1
00403       INTEGER :: LOCAL_TIMESTEP_3D = 1
00404 
00405       CONTAINS
00406 !                    *************************
00407                      SUBROUTINE MED_CHECK_CRET
00408 !                    *************************
00409      &(CRET,TEXT)
00410 !
00411 !***********************************************************************
00412 ! BIEF   V6P1                                   21/08/2010
00413 !***********************************************************************
00414 !
00415 !
00416 !
00417 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00418 !| CRET           |-->| 10 INTEGERS, SEE SELAFIN FILE STANDARD
00419 !| TEXT           |-->| NUMBER OF NODES PER ELEMENT
00420 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00421       IMPLICIT NONE
00422       INTEGER LNG,LU
00423       COMMON/INFO/LNG,LU
00424 !
00425 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00426 !
00427       INTEGER,          INTENT(IN) :: CRET
00428       CHARACTER(LEN=6), INTENT(IN) :: TEXT
00429 !
00430 !-----------------------------------------------------------------------
00431 !
00432 
00433       IF(CRET.LT.0) THEN
00434         IF(LNG.EQ.1) WRITE(LU,*) 'ERREUR MED : ',TEXT
00435         IF(LNG.EQ.2 )WRITE(LU,*) 'ERROR MED : ',TEXT
00436         CALL PLANTE(1)
00437         STOP
00438       ENDIF
00439 
00440 !-----------------------------------------------------------------------
00441 
00442       RETURN
00443       END SUBROUTINE MED_CHECK_CRET
00444 !
00445 !                    ************************
00446                      SUBROUTINE OPEN_FILE_MED
00447 !                    ************************
00448      &(MEDNAME,IDFILE,OPENMODE)
00449 !
00450 !***********************************************************************
00451 ! BIEF   V6P1                                   21/08/2010
00452 !***********************************************************************
00453 !
00454 !
00455 !
00456 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00457 !| IDFILE         |<->| MED FILE DESCRIPTOR
00458 !| MEDNAME        |-->| NAME OF THE MED FILE
00459 !| OPENMODE       |-->| OPENING MODE (READ/READWRITE/WRITE)
00460 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00461       IMPLICIT NONE
00462       INTEGER LNG,LU
00463       COMMON/INFO/LNG,LU
00464 !
00465 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00466 !
00467 ! ARGUMENTS :
00468       INTEGER, INTENT(INOUT)       :: IDFILE
00469       CHARACTER(LEN=*), INTENT(IN) :: MEDNAME
00470       CHARACTER(LEN=9),INTENT(IN)  :: OPENMODE
00471 !
00472 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00473 !
00474 #if defined(HAVE_MED)
00475       INTEGER :: CRET ! RETURN CODE OF THE CALLED MED LIBRARY FUNCTION
00476       INTEGER :: MED_MODE ! MED OPENING MODE
00477 !
00478 !-----------------------------------------------------------------------
00479 !
00480 !     CHECK THE MODE. POSSIBLE MODES ARE READONLY, WRITEONLY OR
00481 !     READWRITE. OTHER MODES ARE INVALID.
00482 
00483       SELECT CASE(OPENMODE)
00484         CASE('READ     ')
00485           MED_MODE = MED_ACC_RDONLY
00486         CASE('READWRITE')
00487           MED_MODE = MED_ACC_RDWR
00488         CASE('WRITE    ')
00489           MED_MODE = MED_ACC_CREAT
00490         CASE DEFAULT
00491           IF(LNG.EQ.1) THEN
00492             WRITE(LU,*)'ACTION ERRONEE DANS OPEN_FILE_MED :',OPENMODE
00493           ENDIF
00494           IF(LNG.EQ.2) THEN
00495             WRITE(LU,*)'BAD ACTION IN OPEN_FILE_MED:',OPENMODE
00496           ENDIF
00497           CALL PLANTE(1)
00498           STOP
00499       END SELECT
00500 
00501 ! OPEN THE MED FILE AND CHECK RETURN CODE.
00502       CALL MFIOPE(IDFILE,MEDNAME,MED_MODE,CRET)
00503       CALL MED_CHECK_CRET(CRET,'EFOUVR')
00504 !
00505 #else
00506 !
00507 ! MED LIBRARY IS NOT AVAILABLE
00508 ! OR -DHAVE_MED HAS NOT BEEN SET IN CONFIG FILE
00509       WRITE(LU,*) 'ERROR : TRYING TO CALL MED FUNCTION WITHOUT ',
00510      &            'MED LIBRARY INSTALLED'
00511       CALL PLANTE(0)
00512 !
00513 #endif
00514 !
00515 !-----------------------------------------------------------------------
00516 !
00517       END SUBROUTINE OPEN_FILE_MED
00518 !
00519 !                    *************************
00520                      SUBROUTINE CLOSE_FILE_MED
00521 !                    *************************
00522      &(IDFILE)
00523 !
00524 !***********************************************************************
00525 ! BIEF   V6P1                                   21/08/2010
00526 !***********************************************************************
00527 !
00528 !
00529 !
00530 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00531 !| IDFILE         |-->| MED FILE DESCRIPTOR
00532 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00533       IMPLICIT NONE
00534       INTEGER LNG,LU
00535       COMMON/INFO/LNG,LU
00536 !
00537 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00538       INTEGER, INTENT(IN)  :: IDFILE
00539 !
00540 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00541 !
00542 #if defined(HAVE_MED)
00543       INTEGER :: CRET
00544 !
00545 !-----------------------------------------------------------------------
00546 !
00547       CALL MFICLO(IDFILE,CRET)
00548       CALL MED_CHECK_CRET(CRET,'EFFERM')
00549 !
00550 #else
00551 !
00552 ! MED LIBRARY IS NOT AVAILABLE
00553 ! OR -DHAVE_MED HAS NOT BEEN SET IN CONFIG FILE
00554       WRITE(LU,*) 'ERROR : TRYING TO CALL MED FUNCTION WITHOUT ',
00555      &            'MED LIBRARY INSTALLED'
00556       CALL PLANTE(0)
00557 !
00558 #endif
00559 !
00560 !-----------------------------------------------------------------------
00561 !
00562       RETURN
00563       END SUBROUTINE CLOSE_FILE_MED
00564 !
00565 !                    *************************
00566                      SUBROUTINE WRITE_MESH_MED
00567 !                    *************************
00568      &(RES_FILE,MESH,X_ORIG,Y_ORIG)
00569 !
00570 !***********************************************************************
00571 ! BIEF   V6P1                                   21/08/2010
00572 !***********************************************************************
00573 !
00574 !
00575 !
00576 !
00577 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00578 !| RES_FILE       |-->| MED FILE DESCRIPTOR
00579 !| MESH           |-->| BIEF'S MESH OBJECT
00580 !| X_ORIG         |-->| VALUE OF THE X ORIGINAL POINT
00581 !| Y_ORIG         |-->| VALUE OF THE X ORIGINAL POINT
00582 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00583 !
00584       USE BIEF
00585 !
00586       IMPLICIT NONE
00587       INTEGER LNG,LU
00588       COMMON/INFO/LNG,LU
00589 !
00590 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00591 !
00592       INTEGER        , INTENT(IN)  :: RES_FILE
00593       TYPE(BIEF_MESH), INTENT(IN)  :: MESH
00594       DOUBLE PRECISION,INTENT(IN)  :: X_ORIG
00595       DOUBLE PRECISION,INTENT(IN)  :: Y_ORIG
00596 !
00597 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00598 !
00599 #if defined(HAVE_MED)
00600       DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: COOR
00601       CHARACTER(LEN=64) :: MESHNAME ! NAME OF THE MESH
00602       CHARACTER(LEN=200) :: DESC ! DESCRIPTION ASSOCIATED TO THE MESH
00603       CHARACTER(LEN=16), DIMENSION(:), ALLOCATABLE :: COORD_NAME
00604       CHARACTER(LEN=16), DIMENSION(:), ALLOCATABLE :: COORD_UNIT
00605       CHARACTER(LEN=16) :: DTUNIT
00606       INTEGER :: CRET
00607       INTEGER :: I
00608       INTEGER :: TYP_MED
00609       CHARACTER*16, ALLOCATABLE :: ELEMNAME(:)
00610 ! NUMBER AND NAME FOR A FAMILLY
00611       INTEGER           :: NUMFAM
00612       CHARACTER(LEN=32) :: NOMFAM
00613       DOUBLE PRECISION :: DT
00614 !
00615 !-----------------------------------------------------------------------
00616 !
00617       ! WRITE THE FILE DESCRIPTION
00618       DESC = 'BIEF_MESH'
00619       CALL MFICOW(RES_FILE,DESC,CRET)
00620       CALL MED_CHECK_CRET(CRET,'MFICOW')
00621 
00622       ! BUILD THE MESH COORDINATES INFO
00623       ! WRITE THE COORDINATES NAME AND UNIT
00624       ALLOCATE(COORD_NAME(MESH%DIM),COORD_UNIT(MESH%DIM))
00625       COORD_NAME(1) = 'X'
00626       CALL BLANC2_(COORD_NAME(1))
00627       COORD_UNIT(1) = 'M'
00628       CALL BLANC2_(COORD_UNIT(1))
00629       COORD_NAME(2) = 'Y'
00630       CALL BLANC2_(COORD_NAME(2))
00631       COORD_UNIT(2) = 'M'
00632       CALL BLANC2_(COORD_UNIT(2))
00633       IF(MESH%DIM .EQ. 3 ) THEN
00634         COORD_NAME(3) = 'Z'
00635         CALL BLANC2_(COORD_NAME(3))
00636         COORD_UNIT(3) = 'M'
00637         CALL BLANC2_(COORD_UNIT(3))
00638       ENDIF
00639       ! THE NAME OF THE MESH IS SET TO MESH
00640       MESHNAME = 'MESH' // CHAR(0)
00641       DESC = 'NO_DESCRIPTION'//CHAR(0)
00642       DTUNIT = 'S'//CHAR(0)
00643 
00644       CALL MMHCRE(RES_FILE,MESHNAME,MESH%DIM,MESH%DIM,
00645      &            MED_UNSTRUCTURED_MESH,DESC,DTUNIT,
00646      &            MED_SORT_DTIT,MED_CARTESIAN,COORD_NAME,
00647      &            COORD_UNIT,CRET)
00648       CALL MED_CHECK_CRET(CRET,'MMHCRE')
00649 
00650       ! BUILDING THE COORDIANTES VALUE TABLES
00651       ALLOCATE(COOR(MESH%NPOIN*MESH%DIM))
00652       DO I = 1,MESH%NPOIN
00653         COOR(I) = MESH%X%R(I)+X_ORIG
00654         COOR(I+MESH%NPOIN) = MESH%Y%R(I)+Y_ORIG
00655       ENDDO
00656       IF (MESH%DIM .EQ. 3 ) THEN
00657         DO I = 1, MESH%NPOIN
00658           COOR(I+2*MESH%NPOIN) = MESH%Z%R(I)
00659         ENDDO
00660       ENDIF
00661       DT = 0.0
00662       CALL MMHCOW(RES_FILE,         ! FILE UNIT
00663      &            MESHNAME,         ! TITLE OF THE MESH
00664      &            MED_NO_DT,        ! NO TIME STEP
00665      &            MED_NO_IT,        ! NO ITERATION
00666      &            DT,               ! NO TIME STEP VALUE
00667      &            MED_NO_INTERLACE, ! STORAGE MODE FOR THE COORDINATES
00668      &            MESH%NPOIN,       ! NUMBER OF NODES
00669      &            COOR,             ! TABLE OF THE COORDIANTES
00670      &            CRET)             ! RETURN CODE
00671 
00672       CALL MED_CHECK_CRET(CRET,'MMHCOW')
00673 
00674       ! THE TYPE OF THE ELEMENTS : GET THE MED ELEMENT TYPE
00675       IF(MESH%TYPELM.EQ.10) THEN
00676         TYP_MED = MED_TRIA3
00677       ELSEIF(MESH%TYPELM.EQ.20) THEN
00678         TYP_MED = MED_QUAD4
00679       ELSEIF(MESH%TYPELM.EQ.30) THEN
00680         TYP_MED = MED_TETRA4
00681       ELSEIF(MESH%TYPELM.EQ.40) THEN
00682         TYP_MED = MED_PENTA6
00683       ELSE
00684         WRITE(6,*) 'ERROR : ELEMENT TYPE UNKNOWN!'
00685         CALL PLANTE(1)
00686         STOP
00687       ENDIF
00688       ! WE NEED TO ALLOCATE THE TABLE FOR ELEMENTS NAME BECAUSE IT IS
00689       ! READ EVEN IF THE BOOLENA IS SET TO FALSE
00690       ALLOCATE(ELEMNAME(MESH%NELEM))
00691       ! WRITE THE CONNECTIVITY INTO THE MED DATA FILE :
00692       CALL MMHELW(RES_FILE,         ! FILE UNIT
00693      &            MESHNAME,         ! TITLE OF THE MESH
00694      &            MED_NO_DT,        ! NO TIME STEP
00695      &            MED_NO_IT,        ! NO ITERATION
00696      &            DT,               ! NO TIMESTEP VALUE
00697      &            MED_CELL,         ! GEOMETRY TYPE
00698      &            TYP_MED,          ! ENTITY TYPE
00699      &            MED_NODAL,        ! CONNECTIVITY TYPE
00700      &            MED_NO_INTERLACE, ! STORAGE MODE FOR THE CONNECTIVITY
00701      &            MESH%NELEM,       ! NUMBER OF ELEMENTS
00702      &            MESH%IKLE%I,      ! CONNECTIVITY TABLE
00703      &            MED_FALSE,        ! NO NAME OF THE ELEMENT
00704      &            ELEMNAME,         ! NAME OF THE ELEMENT
00705      &            MED_FALSE,        ! NO NUMBER OF ELEMENT
00706      &            I,                ! NUMBER OF ELEMENT
00707      &            MED_FALSE,        ! NO FAMILY NUMBER
00708      &            I,                ! FAMILY NUMBER
00709      &            CRET)
00710       CALL MED_CHECK_CRET(CRET,'MMHELW')
00711       DEALLOCATE(ELEMNAME)
00712 
00713       ! We need a default familly called ZERO FAMILY
00714       NUMFAM = 0
00715       NOMFAM="FAMILLE_ZERO"//CHAR(0)
00716       CALL MFACRE(RES_FILE,MESHNAME,NOMFAM,NUMFAM,0,' ',CRET)
00717       CALL MED_CHECK_CRET(CRET,'MFACRE')
00718 !
00719 #else
00720 !
00721       WRITE(LU,*) 'ERROR : TRYING TO CALL MED FUNCTION WITHOUT ',
00722      &            'MED LIBRARY INSTALLED'
00723       CALL PLANTE(0)
00724 !
00725 #endif
00726 !
00727 !-----------------------------------------------------------------------
00728 !
00729       RETURN
00730       END SUBROUTINE WRITE_MESH_MED
00731 !
00732 !                       *****************************
00733                         SUBROUTINE CREATE_DATASET_MED
00734 !                       *****************************
00735 !
00736      &(RES_FILE,TITLE,NVAR,NOMVAR,OUTVAR)
00737 !
00738 !***********************************************************************
00739 ! BIEF   V6P1                                   21/08/2010
00740 !***********************************************************************
00741 !
00742 !
00743 !
00744 !
00745 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00746 !| RES_FILE       |-->| MED FILE DESCRIPTOR
00747 !| TITLE          |-->| TITRE DU MAILLAGE
00748 !| NAR            |-->| NUMBER OF VARIABLES TO BE PUT IN THE FILE
00749 !| NOMVAR         |-->| NAME OF VARIABLES
00750 !| OUTVAR         |-->| VARIABLES TO BE PUT IN THE FILE
00751 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00752 !
00753       IMPLICIT NONE
00754       INTEGER LNG,LU
00755       COMMON/INFO/LNG,LU
00756 !
00757 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00758 !
00759       INTEGER                          , INTENT(IN) :: RES_FILE
00760       CHARACTER(LEN=72)                , INTENT(IN) :: TITLE
00761       INTEGER                          , INTENT(IN) :: NVAR
00762       CHARACTER(LEN=32),DIMENSION(NVAR), INTENT(IN) :: NOMVAR
00763       LOGICAL          ,DIMENSION(NVAR), INTENT(IN) :: OUTVAR
00764 !
00765 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00766 !
00767 #if defined(HAVE_MED)
00768       INTEGER :: DIMVEC ! DIMENSION OF VECTOR
00769       INTEGER           :: NCOMP
00770       INTEGER           :: CRET
00771       CHARACTER(LEN=64) :: FIELD_NAME,MESHNAME
00772       CHARACTER(LEN=16) :: COMP_NAME,COMP_UNIT,DTUNIT
00773       CHARACTER(LEN=32) :: NOMVAR2
00774       INTEGER           :: TYP_MED
00775       INTEGER           :: IVAR
00776       INTEGER           :: COMP_NUM
00777       LOGICAL           :: ISVECTOR
00778       CHARACTER(LEN=16),DIMENSION(:),ALLOCATABLE :: NAME2
00779       CHARACTER(LEN=16),DIMENSION(:),ALLOCATABLE :: VUNIT2
00780       CHARACTER(LEN=16),DIMENSION(:),ALLOCATABLE :: VAR_NAME
00781       CHARACTER(LEN=16),DIMENSION(:),ALLOCATABLE :: VAR_UNIT
00782 !LOCAL DECLARATION
00783       INTEGER           :: NB_VAR
00784 !
00785 !-----------------------------------------------------------------------
00786 !
00787       ! Set the mesh name
00788       MESHNAME = 'MESH'//CHAR(0)
00789       ! Set the tine unit
00790       DTUNIT='S'//CHAR(0)
00791       DIMVEC = 1
00792       ! Define the size of the vector variables
00793       DO IVAR=1,NVAR
00794         IF (.NOT.OUTVAR(IVAR)) CYCLE
00795         NOMVAR2   = NOMVAR(IVAR)
00796         CALL BLANC2_(NOMVAR2)
00797         CALL IFVECTOR_(NOMVAR2,COMP_NUM,ISVECTOR)
00798         DIMVEC = MAX(DIMVEC,COMP_NUM)
00799       ENDDO
00800       NB_VAR=0
00801       ! Loop on all the variables
00802       DO IVAR = 1, NVAR
00803         ! If the variable is not to print keep looping
00804         IF (.NOT.OUTVAR(IVAR)) CYCLE
00805         NB_VAR=NB_VAR+1
00806         ! Identify the name and the unit of the variable
00807         NOMVAR2   = NOMVAR(IVAR)
00808         CALL BLANC2_(NOMVAR2)
00809         FIELD_NAME = NOMVAR2(1:16)//CHAR(0)
00810         COMP_NAME = NOMVAR2(1:16)//CHAR(0)
00811         COMP_UNIT = NOMVAR2(17:32)//CHAR(0)
00812         NCOMP     = 1
00813         TYP_MED   = MED_FLOAT64
00814         ! Check if the varaible is the componant of a vector
00815         CALL IFVECTOR_(FIELD_NAME,COMP_NUM,ISVECTOR)
00816         ! If we have a vector set the nuber of component to DIMVEC
00817         ! else set the componant number to 1
00818         IF (ISVECTOR) THEN
00819           NCOMP = DIMVEC
00820         ELSE
00821           COMP_NUM = 1
00822         ENDIF
00823         ! If first time we meet the variable (multiple time for vector)
00824         IF (COMP_NUM.EQ.1) THEN
00825           ALLOCATE(VAR_NAME(NCOMP),VAR_UNIT(NCOMP))
00826         ENDIF
00827         ! Add name and unit to the variable table
00828         VAR_NAME(COMP_NUM) = COMP_NAME
00829         VAR_UNIT(COMP_NUM) = COMP_UNIT
00830         ! If the variable is a scalar or if we are on the last componant
00831         ! of a vector we create a new field
00832         IF ((ISVECTOR.AND.COMP_NUM==DIMVEC).OR.(.NOT.ISVECTOR)) THEN
00833           CALL MFDCRE(RES_FILE,   ! FILE UNIT
00834      &                FIELD_NAME, ! NAME OF THE DATA FIELD
00835      &                TYP_MED,    ! TYPE (REAL,INTEGER)
00836      &                NCOMP,      ! NUMBER OF COMPONENT
00837      &                VAR_NAME,   ! NAME OF THE COMPONENT
00838      &                VAR_UNIT,   ! UNITS OF THE COMPONENT
00839      &                DTUNIT,        ! UNIT OF THE TIME
00840      &                MESHNAME,   ! NAME OF THE MESH
00841      &                CRET)       ! RETURN CODE
00842           CALL MED_CHECK_CRET(CRET,'MFDCRE')
00843           DEALLOCATE(VAR_NAME,VAR_UNIT)
00844         ENDIF
00845       ENDDO
00846 
00847 ! Geeting reading to write scalar grid for deformed mesh
00848       IF (DIMVEC==3) THEN
00849           ALLOCATE(NAME2((3+NB_VAR)),VUNIT2((3+NB_VAR)))
00850           NOMVAR2   = 'MODIF FIELD'
00851           CALL BLANC2_(NOMVAR2)
00852           FIELD_NAME = NOMVAR2(1:16)//CHAR(0)
00853           NAME2(1)    = 'X'
00854           VUNIT2(1)   = 'M'
00855           NAME2(2)    = 'Y'
00856           VUNIT2(2)   = 'M'
00857           NAME2(3)    = 'Z'
00858           VUNIT2(3)   = 'M'
00859           NB_VAR=0
00860           DO IVAR = 1, NVAR
00861               IF (.NOT.OUTVAR(IVAR)) CYCLE
00862               NB_VAR=NB_VAR+1
00863               NOMVAR2   = NOMVAR(IVAR)
00864               CALL BLANC2_(NOMVAR2)
00865               NAME2(3+NB_VAR) =NOMVAR2(1:16)
00866               VUNIT2(3+NB_VAR) = NOMVAR2(17:32)
00867           ENDDO
00868           NCOMP      = 3+NB_VAR
00869 
00870           CALL MFDCRE(RES_FILE,    ! FILE UNIT
00871      &                FIELD_NAME,  ! NAME OF THE DATA FIELD
00872      &                TYP_MED,     ! TYPE (REAL,INTEGER)
00873      &                NCOMP,       ! NUMBER OF COMPONENT
00874      &                NAME2,       ! NAME OF THE COMPONENT
00875      &                VUNIT2,      ! UNITS OF THE COMPONENT
00876      &                DTUNIT,      ! UNIT OF THE TIME
00877      &                MESHNAME,    ! NAME OF THE MESH
00878      &                CRET)        ! RETURN CODE
00879         CALL MED_CHECK_CRET(CRET,'MFDCRE')
00880         DEALLOCATE(NAME2,VUNIT2)
00881       ENDIF
00882 
00883 #else
00884 !
00885 ! MED LIBRARY IS NOT AVAILABLE
00886 ! OR -DHAVE_MED HAS NOT BEEN SET IN CONFIG FILE
00887       WRITE(LU,*) 'ERROR : TRYING TO CALL MED FUNCTION WITHOUT ',
00888      &            'MED LIBRARY INSTALLED'
00889       CALL PLANTE(1)
00890 !
00891 #endif
00892 !
00893 !-----------------------------------------------------------------------
00894 !
00895       RETURN
00896       END SUBROUTINE CREATE_DATASET_MED
00897 !
00898 !                       *************************
00899                         SUBROUTINE WRITE_DATA_MED
00900 !                       *************************
00901 !
00902      &(RES_FILE,NVARS,TIME,TIMESTEP,NOMVAR,OUTVAR,BVARSOR)
00903 !
00904 !***********************************************************************
00905 ! BIEF   V6P1                                   21/08/2010
00906 !***********************************************************************
00907 !
00908 !
00909 !
00910 !
00911 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00912 !| RES_FILE       |-->| MED FILE DESCRIPTOR
00913 !| NVARS          |-->| NUMBER OF VARIABLES
00914 !| TIME           |-->| TIME FOR WHICH THE DATA ARE WRITTEN
00915 !| TIMESTEP       |-->| TIME STEP FOR WHICH THE DATA ARE WRITTEN
00916 !| NOMVAR         |-->| TABLE CONTAING THE NAME OF EACH VARIABLES
00917 !| OUTVAR         |-->| TABLE SAYING IF A VARIABLE IS TO BE PRINTED
00918 !| BVARSOR        |-->| VALUES FOR EACH VARIABLES
00919 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00920 !
00921       USE BIEF
00922       USE DECLARATIONS_TELEMAC, ONLY : NNAMECODE
00923 !
00924       IMPLICIT NONE
00925       INTEGER LNG,LU
00926       COMMON/INFO/LNG,LU
00927 !
00928 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00929 !
00930       INTEGER          ,INTENT(IN)                   :: RES_FILE
00931       INTEGER          ,INTENT(IN)                   :: NVARS
00932       DOUBLE PRECISION ,INTENT(IN)                   :: TIME
00933       INTEGER          ,INTENT(IN)                   :: TIMESTEP
00934       CHARACTER(LEN=32),DIMENSION(NVARS), INTENT(IN) :: NOMVAR
00935       LOGICAL          ,DIMENSION(NVARS), INTENT(IN) :: OUTVAR
00936       TYPE(BIEF_OBJ)   ,INTENT(IN)                   :: BVARSOR
00937 !
00938 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00939 !
00940 #if defined(HAVE_MED)
00941       INTEGER :: CRET     ! RETURN CODE
00942       INTEGER :: IVAR     ! VARIABLE ID TO OUTPUT
00943       INTEGER :: NDATA    ! NUMBER OF DATA POINTS TO WRITE
00944       INTEGER :: TYP_MED  ! TYPE OF THE ELEMENT
00945       INTEGER :: TYP_DISC ! TYPE OF DISCRETISATION
00946 !
00947       INTEGER :: DIMMESH ! DIMENSION OF THE MESH
00948       CHARACTER(LEN=64) :: MESHNAME ! NAME OF THE ASSOCIATED MESH
00949 
00950       CHARACTER(LEN=64) :: FIELD_NAME ! NAME OF THE MED FIELD
00951       CHARACTER(LEN=32) :: NOMVAR2   ! MED NAME OF THE VARIABLE
00952 !
00953       INTEGER         , DIMENSION(:), ALLOCATABLE :: IDATAVAR
00954       DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: DATAVAR
00955       DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE,SAVE :: DEF_MAP
00956       INTEGER           :: COMP_NUM
00957       LOGICAL           :: ISVECTOR
00958       INTEGER           ::  LME,TIMESTEP2
00959       INTEGER           :: NB_VAR,I
00960 !
00961 !-----------------------------------------------------------------------
00962 !
00963       ! Setting the meshname
00964       MESHNAME = 'MESH'//CHAR(0)
00965       ! Get the mesh dimension
00966       CALL MMHNAN(RES_FILE,MESHNAME,DIMMESH,CRET)
00967       CALL MED_CHECK_CRET(CRET,'MMHNAN')
00968       ! The timestep are to be counted consecutively from 1
00969       ! We use the local variable local_timestep_2d to recount the timestep
00970       ! The variable is defined at the beginning of the module
00971       ! This way the value is global and is increased each time the
00972       ! function is called
00973       ! The function is called twice in 3D
00974       ! Defining which timstep to use
00975       IF(NNAMECODE(1).EQ.'TELEMAC3D') THEN
00976         TIMESTEP2 = LOCAL_TIMESTEP_3D
00977         LOCAL_TIMESTEP_3D = LOCAL_TIMESTEP_3D + 1
00978       ELSE IF (NNAMECODE(1).EQ.'TELEMAC2D') THEN
00979         TIMESTEP2 = LOCAL_TIMESTEP_2D
00980         LOCAL_TIMESTEP_2D = LOCAL_TIMESTEP_2D + 1
00981       ELSE IF(NNAMECODE(1).EQ.'ESTEL3D') THEN
00982         TIMESTEP2 = LOCAL_TIMESTEP_3D
00983         LOCAL_TIMESTEP_3D = LOCAL_TIMESTEP_3D + 1
00984       ENDIF
00985 
00986       ! PUISQU'IL Y A DES VALEURS SUR VECTEURS LIBRE ...
00987       ! ON DETERMINE LE TYPE DE VARIABLE QU'UNE SEULE FOIS ET CROISE LES
00988       ! DOIGTS (DANS TELEMAC2D, L'ENERGIE TURBULENTE A UN ELM DE -1000
00989       ! BIZARREMENT ...
00990 
00991       IVAR=0
00992       I=1
00993       DO WHILE(IVAR == 0)
00994         IF(BVARSOR%ADR(I)%P%ELM.GT.0) IVAR=I
00995         I=I+1
00996       ENDDO
00997       IF(BVARSOR%ADR(IVAR)%P%ELM/10 .EQ. 1 ) THEN
00998         TYP_MED = MED_TRIA3
00999       ELSEIF(BVARSOR%ADR(IVAR)%P%ELM/10 .EQ. 2 ) THEN
01000         TYP_MED = MED_QUAD4
01001       ELSEIF(BVARSOR%ADR(IVAR)%P%ELM/10 .EQ. 3 ) THEN
01002         TYP_MED = MED_TETRA4
01003       ELSEIF(BVARSOR%ADR(IVAR)%P%ELM/10 .EQ. 4 ) THEN
01004         TYP_MED = MED_PENTA6
01005       ELSE
01006         WRITE(LU,*)'ERROR ON ELEMENT TYPE!',BVARSOR%ADR(IVAR)%P%ELM
01007         CALL PLANTE(1)
01008         STOP
01009       ENDIF
01010       IVAR=0
01011       I=1
01012 
01013 
01014       IVAR=1
01015       NB_VAR = 0
01016       ! Loop on all the variables
01017       DO IVAR = 1 , NVARS
01018         ! If the variable is not printed we keep looping
01019         IF (.NOT. OUTVAR(IVAR)) CYCLE
01020         TYP_DISC = MED_NODE
01021         LME = BVARSOR%ADR(IVAR)%P%ELM
01022         IF ((LME.GT.0) .AND. ((LME-(LME/10)*10)==0))
01023      &                            TYP_DISC = MED_CELL
01024         ! Defining the varaible name
01025         NB_VAR = NB_VAR+1
01026         NOMVAR2   = NOMVAR(IVAR)
01027         CALL BLANC2_(NOMVAR2)
01028         FIELD_NAME = NOMVAR2(1:16)//CHAR(0)
01029         NDATA   =  BVARSOR%ADR(IVAR)%P%DIM1
01030         ! Check if the varaible is part of a vector
01031         CALL IFVECTOR_(FIELD_NAME(1:32),COMP_NUM,ISVECTOR)
01032         ! we allocate the result tables only on the first componant
01033         IF (COMP_NUM == 1) ALLOCATE(DATAVAR(DIMMESH*NDATA))
01034         IF (COMP_NUM == 1) ALLOCATE(IDATAVAR(DIMMESH*NDATA))
01035         ! Filling the tables for real/integer values
01036         IF (BVARSOR%ADR(IVAR)%P%NAT == 1) THEN         !REAL
01037           IF (ISVECTOR)THEN
01038             DATAVAR((COMP_NUM-1)*NDATA+1:(COMP_NUM)*NDATA)=
01039      &                            BVARSOR%ADR(IVAR)%P%R(1:NDATA)
01040           ELSE
01041             ALLOCATE(DATAVAR(1:NDATA))
01042             ALLOCATE(IDATAVAR(1:NDATA))
01043             DATAVAR(1:NDATA)=BVARSOR%ADR(IVAR)%P%R(1:NDATA)
01044           ENDIF
01045         ELSEIF (BVARSOR%ADR(IVAR)%P%NAT == 2) THEN    ! INTEGER
01046           IF (ISVECTOR)THEN
01047             IDATAVAR((COMP_NUM-1)*NDATA+1:(COMP_NUM)*NDATA)=
01048      &                          BVARSOR%ADR(IVAR)%P%I(1:NDATA)
01049           ELSE
01050             ALLOCATE(DATAVAR(1:NDATA))
01051             ALLOCATE(IDATAVAR(1:NDATA))
01052             IDATAVAR(1:NDATA) = BVARSOR%ADR(IVAR)%P%I(1:NDATA)
01053             DATAVAR(1:NDATA) = DBLE(IDATAVAR(1:NDATA))
01054           ENDIF
01055         ENDIF
01056 
01057         ! If we are on the last componant of a vector
01058         ! or if the varaible is a scalar
01059         ! we write the data on the med file
01060         IF ((COMP_NUM==DIMMESH).OR.(.NOT.ISVECTOR)) THEN
01061           CALL MFDRVW(RES_FILE,            ! FILE UNIT
01062      &                FIELD_NAME,          ! NAME OF THE FIELD
01063      &                TIMESTEP2,      ! TIME STEP (INTEGER)
01064      &                MED_NO_IT,           ! NO ITERATION
01065      &                TIME,                ! TIME STEP (REAL)
01066      &                MED_NODE,            ! GEOMETRY TYPE
01067      &                MED_NONE,            ! ELEMENT TYPE
01068      &                MED_NO_INTERLACE,    ! STORAGE MODE
01069      &                MED_ALL_CONSTITUENT, ! COMPONENT TO WRITE
01070      &                NDATA,               ! NUMBER OF VALUES
01071      &                DATAVAR,             ! VALUES TABLE
01072      &                CRET)                ! RETURN CODE
01073           CALL MED_CHECK_CRET(CRET,'MFDRVW')
01074           DEALLOCATE(DATAVAR)
01075           DEALLOCATE(IDATAVAR)
01076         ENDIF
01077 
01078       END DO ! LOOP OVER ENTRIES IN BVARSOR
01079 
01080 !On rajoute la possibilite en 3D d'ecrire un champ de scalaire pour la
01081 !deformation du maillage
01082 !les 3 premieres composantes correspondnant au vecteur deformation du
01083 !maillage (pas de deformation = (0,0,0)
01084 !les autres composantes correspondnant aux différents champs ecrit dans
01085 ! le fichier med il s'agit d une surdefintion qui peut etre couteuse en
01086 !espace memoire suivant le nombre de variable et le type de cas de calcu
01087 ! This function is also called for the 2d mesh in telemac3d
01088       IF (NNAMECODE(1) == 'TELEMAC3D               '
01089      & .AND. DIMMESH.EQ.3)THEN
01090           NOMVAR2   = 'MODIF FIELD'
01091           CALL BLANC2_(NOMVAR2)
01092           FIELD_NAME = NOMVAR2(1:16)//CHAR(0)
01093           NDATA   =  BVARSOR%ADR(1)%P%DIM1
01094           IF (TIMESTEP==0) ALLOCATE(DEF_MAP(1:NDATA*3))
01095           IF (TIMESTEP==0) DEF_MAP(1:2*NDATA)        = 0.0D0
01096           IF (TIMESTEP==0) DEF_MAP(2*NDATA+1:3*NDATA)=
01097      &                                BVARSOR%ADR(1)%P%R(1:NDATA)
01098           ALLOCATE(DATAVAR(1:NDATA*(3+NB_VAR)))
01099           DATAVAR(2*NDATA+1:3*NDATA)= BVARSOR%ADR(1)%P%R(1:NDATA)-
01100      &            DEF_MAP(2*NDATA+1:3*NDATA)
01101           DATAVAR(1:2*NDATA)        = 0.0D0
01102           NB_VAR=0
01103           DO IVAR = 1, NVARS
01104               IF (.NOT. OUTVAR(IVAR)) CYCLE
01105               NB_VAR=NB_VAR+1
01106               DATAVAR((2+NB_VAR)*NDATA+1:(3+NB_VAR)*NDATA)=
01107      &                                BVARSOR%ADR(IVAR)%P%R(1:NDATA)
01108           ENDDO
01109 
01110           CALL MFDRVW(RES_FILE,            ! FILE UNIT
01111      &                FIELD_NAME,          ! NAME OF THE FIELD
01112      &                TIMESTEP2,           ! TIME STEP (INTEGER)
01113      &                MED_NO_IT,           ! NO ITERATION
01114      &                TIME,                ! TIME STEP (REAL)
01115      &                MED_NODE,            ! GEOMETRY TYPE
01116      &                MED_NONE,            ! ELEMENT TYPE
01117      &                MED_NO_INTERLACE,    ! STORAGE MODE
01118      &                MED_ALL_CONSTITUENT, ! COMPONENT TO WRITE
01119      &                NDATA,               ! NUMBER OF VALUES
01120      &                DATAVAR,             ! VALUES TABLE
01121      &                CRET)                ! RETURN CODE
01122           CALL MED_CHECK_CRET(CRET,'MFDRVW')
01123           DEALLOCATE(DATAVAR)
01124       ENDIF
01125 !
01126 #else
01127 !
01128 ! MED LIBRARY IS NOT AVAILABLE
01129 ! OR -DHAVE_MED HAS NOT BEEN SET IN CONFIG FILE
01130       WRITE(LU,*) 'ERROR : TRYING TO CALL MED FUNCTION WITHOUT ',
01131      &            'MED LIBRARY INSTALLED'
01132       CALL PLANTE(0)
01133 !
01134 #endif
01135 !
01136 !-----------------------------------------------------------------------
01137 !
01138       RETURN
01139       END SUBROUTINE WRITE_DATA_MED
01140 !
01141 !                       ********************
01142                         SUBROUTINE SUITE_MED
01143 !                       ********************
01144 !
01145      &(VARSOR,CLAND,NUMDEB,
01146      & RES_FILE,STD,HIST,NHIST,NPOIN,AT,TEXTPR,VARCLA,NVARCL,
01147      & TROUVE,ALIRE,LISTIN,FIN,MAXVAR,NPLAN,DT,NDT)
01148 !
01149 !***********************************************************************
01150 ! BIEF   V6P1                                   21/08/2010
01151 !***********************************************************************
01152 !
01153 !
01154 !
01155 !
01156 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
01157 !| VARSOR         |<--| BLOC DES TABLEAUX CONTENANT LES VARIABLES
01158 !| CLAND          |<--| BLOC DES VARIABLES CLANDESTI-NES
01159 !| NUMDEB         |<->| FIN = .TRUE. NUMERO DU DERNIER ENREGISTREMENT
01160 !|                |   | FIN = .FALSE. : NUMERO DE L'ENREGISTREMENT
01161 !|                |   |                 QUE L'ON VEUT LIRE.
01162 !| RES_FILE       |-->| NUMERO DE CANAL DU FICHIER
01163 !| STD            |-->| BINAIRE DU FICHIER : STD, IBM OU I3E
01164 !| HIST           |-->| TABLEAU DE VALEURS MISES DANS L'ENREGISTREMENT
01165 !|                |   | DU TEMPS.
01166 !| NHIST          |-->| NOMBRE DE VALEURS DANS LE TABLEAU HIST.
01167 !| NPOIN          |-->| NOMBRE DE POINTS DANS LE MAILLAGE
01168 !| AT             |-->| TEMPS
01169 !| TEXTPR         |-->| NOMS ET UNITES DES VARIABLES.
01170 !| VARCLA         |-->| TABLEAU OU L'ON RANGE LES VARIABLES
01171 !|                |   | CLANDESTIINES.
01172 !| NVARCL         |-->| NOMBRE DE VARIABLES CLANDESTI-NES.
01173 !| TROUVE         |<--| INDIQUE (TROUVE(K)=1) LES VARIABLES TROUVEES
01174 !|                |   | DANS LE FICHIER.
01175 !|                |   | DE K =  1 A 26 VARIABLES NORMALES
01176 !|                |   | DE K = 27 A 36 VARIABLES CLANDESTI-NES.
01177 !| ALIRE          |-->| VARIABLES QU'IL FAUT LIRE (POUR LES AUTRES ON
01178 !|                |   | SAUTE L'ENREGISTREMENT CORRESPONDANT)
01179 !|                |   | LES VARIABLES CLANDESTI-NES SONT LUES
01180 !|                |   | SYSTEMATIQUEMENT.
01181 !| LISTIN         |-->| SI OUI, IMPRESSION D'INFORMATIONS SUR LISTING
01182 !| FIN            |-->| VOIR LE TROISIEME ARGUMENT NUMDEB
01183 !| MAXVAR         |-->| DIMENSION DES TABLEAUX DES VARIABLES : ALIRE, ETC
01184 !| NPLAN          |-->| DIMENSION DES TABLEAUX DES VARIABLES : ALIRE, ETC
01185 !| DT             |-->| DIMENSION DES TABLEAUX DES VARIABLES : ALIRE, ETC
01186 !| NDT            |-->| DIMENSION DES TABLEAUX DES VARIABLES : ALIRE, ETC
01187 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
01188 !
01189       USE BIEF
01190 !
01191       IMPLICIT NONE
01192       INTEGER LNG,LU
01193       COMMON/INFO/LNG,LU
01194 !
01195 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
01196 !
01197       TYPE(BIEF_OBJ), INTENT(INOUT) :: VARSOR,CLAND
01198       INTEGER, INTENT(IN), OPTIONAL :: NPLAN
01199       INTEGER, INTENT(IN)           :: NHIST,NVARCL,MAXVAR,RES_FILE
01200       DOUBLE PRECISION, INTENT(INOUT), OPTIONAL :: DT
01201       INTEGER, INTENT(INOUT), OPTIONAL :: NDT
01202       INTEGER                       :: NUMDEB,NPOIN,TROUVE(MAXVAR)
01203       INTEGER                       :: ALIRE(MAXVAR)
01204       CHARACTER(LEN=*)              :: STD
01205       CHARACTER(LEN=32)             :: TEXTPR(MAXVAR),VARCLA(NVARCL)
01206       DOUBLE PRECISION              :: HIST(*),AT
01207       LOGICAL                       :: FIN,LISTIN
01208 !
01209 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
01210 !
01211 #if defined(HAVE_MED)
01212       INTEGER :: CRET    ! RETURN CODE
01213       INTEGER :: IVAR    ! VARIABLE ID TO OUTPUT
01214       INTEGER :: NDATA   ! NUMBER OF DATA POINTS TO WRITE
01215       INTEGER :: TYP_MED ! NUMBER OF COMPONENTS
01216 !
01217       CHARACTER(LEN=64) :: MESHNAME ! NAME OF THE ASSOCIATED MESH
01218       CHARACTER(LEN=64) :: FIELD_NAME ! NAME OF THE MED FIELD
01219       CHARACTER(LEN=32) :: NOMVAR2   ! MED NAME OF THE VARIABLE
01220 !
01221       DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: DATAVAR
01222       INTEGER :: NTIME
01223 !     DUMMY OUTPUT ARGUMENT NEED FOR CALCUL
01224       INTEGER           :: I,NUMDT,TYP,NCOMP
01225       CHARACTER(LEN=64) :: CHA,MESHNAME2
01226       CHARACTER(LEN=16), ALLOCATABLE :: COMP(:), UNIT(:)
01227       CHARACTER(LEN=16) :: DTUNIT
01228       LOGICAL :: ISVECTOR
01229       INTEGER :: COMP_NUM,DIMVEC,NFIELD,IDUM
01230 !
01231 !-----------------------------------------------------------------------
01232 !
01233       IVAR=0
01234       I=1
01235       ! Finding the
01236       DO WHILE(IVAR == 0)
01237         IF ((VARSOR%ADR(I)%P%ELM.GT.0)) IVAR=I
01238         I=I+1
01239       ENDDO
01240       IF(VARSOR%ADR(IVAR)%P%ELM/10 .EQ. 1 ) THEN
01241         TYP_MED = MED_TRIA3
01242       ELSEIF ( VARSOR%ADR(IVAR)%P%ELM/10 .EQ. 2 ) THEN
01243         TYP_MED = MED_QUAD4
01244       ELSEIF ( VARSOR%ADR(IVAR)%P%ELM/10 .EQ. 3 ) THEN
01245         TYP_MED = MED_TETRA4
01246       ELSEIF ( VARSOR%ADR(IVAR)%P%ELM/10 .EQ. 4 ) THEN
01247         TYP_MED = MED_PENTA6
01248       ELSE
01249         WRITE(LU,*) 'ERROR ON ELEMENT TYPE!',VARSOR%ADR(IVAR)%P%ELM
01250         CALL PLANTE(1)
01251         STOP
01252       ENDIF
01253       IVAR=0
01254       I=1
01255       DO WHILE(IVAR == 0)
01256         IF (ALIRE(I)==1) IVAR=I
01257         I=I+1
01258       ENDDO
01259       ! Build the field anme associated wit the varaible
01260       NOMVAR2   = TEXTPR(IVAR)
01261       CALL BLANC2_(NOMVAR2)
01262       FIELD_NAME = NOMVAR2(1:16)//CHAR(0)
01263       CALL IFVECTOR_(FIELD_NAME,COMP_NUM,ISVECTOR)
01264       ! Get the number of componant in the field
01265       CALL MFDNCN(RES_FILE,FIELD_NAME,NCOMP,CRET)
01266       CALL MED_CHECK_CRET(CRET,'MFDNFC')
01267       ! Get the number of time step in the field
01268       ALLOCATE(UNIT(NCOMP),COMP(NCOMP))
01269       CALL MFDFIN(RES_FILE,FIELD_NAME,MESHNAME,IDUM,TYP,COMP,UNIT
01270      &            ,DTUNIT,NTIME,CRET)
01271       CALL MED_CHECK_CRET(CRET,'MFDFIN')
01272       DEALLOCATE(COMP,UNIT)
01273       ! Get the time associated to the last time step
01274       CALL MFDCSI(RES_FILE,FIELD_NAME,NTIME,IDUM,IDUM,
01275      &           DT,CRET)
01276       CALL MED_CHECK_CRET(CRET,'MFDCSI')
01277       NUMDEB = NTIME
01278       AT = DT
01279       NUMDT = NTIME
01280       ! Search for the name of the field CHA and compare to the reading
01281       ! list => TROUVE = 1
01282       ! Get the number of fields
01283       CALL MFDNFD(RES_FILE,NFIELD,CRET)
01284       CALL MED_CHECK_CRET(CRET,'MFDNFD')
01285       TROUVE = 0
01286       DIMVEC = 1
01287       ! Loop on each field
01288       DO I=1,NFIELD
01289         ! Get the number fo componant of the field I
01290         CALL MFDNFC(RES_FILE,I,NCOMP,CRET)
01291         CALL MED_CHECK_CRET(CRET,'MFDNFC')
01292         ! get the name of the field I
01293         ALLOCATE(UNIT(NCOMP),COMP(NCOMP))
01294         CALL MFDFDI(RES_FILE,I,CHA,MESHNAME2,IDUM,IDUM,COMP,
01295      &              UNIT,DTUNIT,IDUM,CRET)
01296         CALL MED_CHECK_CRET(CRET,'MFDFDI')
01297         DEALLOCATE(COMP,UNIT)
01298         ! Identify the varaible associated with the field I
01299         DO IVAR = 1,MAXVAR
01300           NOMVAR2   = TEXTPR(IVAR)
01301           CALL BLANC2_(NOMVAR2)
01302           CALL IFVECTOR_(NOMVAR2,COMP_NUM,ISVECTOR)
01303           DIMVEC = MAX(DIMVEC,COMP_NUM)
01304           IF (NOMVAR2(1:16) == CHA(1:16)) TROUVE(IVAR)=1
01305         ENDDO
01306       ENDDO
01307       ! Get the table value for the last time step for each 'found'
01308       DO IVAR = 1, MAXVAR
01309         IF (TROUVE(IVAR)/=1) CYCLE
01310         IF (ALIRE(IVAR)==1) THEN
01311           NOMVAR2   = TEXTPR(IVAR)
01312           CALL BLANC2_(NOMVAR2)
01313           FIELD_NAME = NOMVAR2(1:16)//CHAR(0)
01314           CALL IFVECTOR_(FIELD_NAME,COMP_NUM,ISVECTOR)
01315           NDATA   =  VARSOR%ADR(IVAR)%P%DIM1
01316           IF(ISVECTOR) THEN
01317             ALLOCATE(DATAVAR(DIMVEC*NDATA))
01318           ELSE
01319             ALLOCATE(DATAVAR(NDATA))
01320           ENDIF
01321           WRITE(LU,*) 'FIELD_NAME : ',FIELD_NAME
01322           WRITE(LU,*) 'NUMDT : ',NUMDT
01323           WRITE(LU,*) 'DT : ',DT
01324           WRITE(LU,*) 'ISVECTOR : ',ISVECTOR
01325           WRITE(LU,*) 'NDATA : ',NDATA
01326           WRITE(LU,*) 'DIMVEC : ',DIMVEC
01327 
01328           CALL MFDRVR(RES_FILE,           ! FILE UNIT
01329      &                FIELD_NAME,         ! FIELD NAME
01330      &                NUMDT,              ! TIME STEP (INTEGER)
01331      &                MED_NO_IT,          ! NO ITERATION
01332      &                MED_NODE,           ! GEOMETRY TYPE
01333      &                MED_NONE,           ! NO ENTITY TYPE
01334      &                MED_NO_INTERLACE,   ! STORGAE MODE
01335      &                MED_ALL_CONSTITUENT,! COMPONENT
01336      &                DATAVAR,            ! RESULT TABLE
01337      &                CRET)               ! RETURN CODE
01338           CALL MED_CHECK_CRET(CRET,'EFCHAL')
01339           NDATA   =  VARSOR%ADR(IVAR)%P%DIM1
01340           IF (.NOT.ISVECTOR) VARSOR%ADR(IVAR)%P%R = DATAVAR
01341           IF (ISVECTOR) VARSOR%ADR(IVAR)%P%R(1:NDATA) =
01342      &                DATAVAR((COMP_NUM-1)*NDATA+1:(COMP_NUM)*NDATA)
01343           DEALLOCATE(DATAVAR)
01344         ELSE
01345           IF(LISTIN.AND.LNG.EQ.1) WRITE(LU,75) TEXTPR(IVAR)
01346           IF(LISTIN.AND.LNG.EQ.2) WRITE(LU,76) TEXTPR(IVAR)
01347 75        FORMAT(/,1X,'LA VARIABLE : ',A32,/,1X,
01348      &              'EST DANS LE FICHIER MAIS ELLE N''EST PAS LUE')
01349 76        FORMAT(/,1X,'VARIABLE : ',A32,/,1X,
01350      &              'IS IN THE FILE BUT WILL NOT BE READ')
01351         ENDIF
01352       END DO ! LOOP OVER ENTRIES IN VARSOR
01353 !
01354 !-----------------------------------------------------------------------
01355 !
01356 !  IMPRESSIONS :
01357 !
01358       IF(LISTIN.AND.LNG.EQ.1) WRITE(LU,300) MESHNAME
01359       IF(LISTIN.AND.LNG.EQ.2) WRITE(LU,301) MESHNAME
01360 300   FORMAT(1X,//,1X,'TITRE DU CAS PRECEDENT: ',A72,/)
01361 301   FORMAT(1X,//,1X,'TITLE OF PREVIOUS COMPUTATION: ',A72,/)
01362 !
01363       DO IVAR=1,MAXVAR
01364         IF ((TROUVE(IVAR) ==1).AND.(ALIRE(IVAR) == 1)) THEN
01365         IF(LISTIN.AND.LNG.EQ.1) WRITE(LU,11)
01366      &    TEXTPR(IVAR)(1:16),TEXTPR(IVAR)(17:32)
01367         IF(LISTIN.AND.LNG.EQ.2) WRITE(LU,111)
01368      &    TEXTPR(IVAR)(1:16),TEXTPR(IVAR)(17:32)
01369         ENDIF
01370 11      FORMAT(1X,'NOM: ' ,A16,'  UNITE: ',A16)
01371 111     FORMAT(1X,'NAME: ',A16,'  UNIT: ' ,A16)
01372       ENDDO
01373 
01374       IF(LISTIN.AND.LNG.EQ.1) WRITE(LU,130) NUMDEB
01375       IF(LISTIN.AND.LNG.EQ.2) WRITE(LU,131) NUMDEB
01376 130   FORMAT(/,1X,'SUITE_MED : LECTURE A L''ENREGISTREMENT ',1I5)
01377 131   FORMAT(/,1X,'SUITE_MED : READ OF RECORD ',1I5)
01378 
01379       IF(LISTIN.AND.LNG.EQ.1) WRITE(LU,140) AT
01380       IF(LISTIN.AND.LNG.EQ.2) WRITE(LU,141) AT
01381 140   FORMAT(//,1X,'TEMPS DE L''ENREGISTREMENT : ',G16.7,' S')
01382 141   FORMAT(//,1X,'TIME OF RECORD: ',G16.7,' S')
01383 
01384       IF(PRESENT(NDT)) NDT=NUMDT
01385 
01386 #else
01387 !
01388 ! MED LIBRARY IS NOT AVAILABLE
01389 ! OR -DHAVE_MED HAS NOT BEEN SET IN CONFIG FILE
01390       WRITE(LU,*) 'ERROR : TRYING TO CALL MED FUNCTION WITHOUT ',
01391      &            'MED LIBRARY INSTALLED'
01392       CALL PLANTE(-1)
01393 !
01394 #endif
01395 !
01396 !-----------------------------------------------------------------------
01397 !
01398       RETURN
01399       END SUBROUTINE SUITE_MED
01400 !
01401 !                       ******************
01402                         SUBROUTINE BLANC2_
01403 !                       ******************
01404 !
01405      &(STRING)
01406 !
01407 !***********************************************************************
01408 ! BIEF   V6P1                                   21/08/2010
01409 !***********************************************************************
01410 !
01411 !
01412 !
01413 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
01414 !| STRING         |<->| THE STRING TO CONVERT
01415 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
01416       CHARACTER*(*), INTENT(INOUT) :: STRING
01417 !
01418 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
01419 !
01420       INTEGER :: J
01421 !
01422 !-----------------------------------------------------------------------
01423 !
01424       DO J = 1,LEN(STRING)
01425         IF (STRING(J:J) .EQ. ' ') THEN
01426           STRING(J:J) = '_'
01427         ENDIF
01428       ENDDO
01429 !
01430 !-----------------------------------------------------------------------
01431 !
01432       RETURN
01433       END SUBROUTINE BLANC2_
01434 !
01435 !                       ********************
01436                         SUBROUTINE IFVECTOR_
01437 !                       ********************
01438 !
01439      &(STRING,COMP_NUM,ISVECTOR)
01440 !
01441 !***********************************************************************
01442 ! BIEF   V6P1                                   21/08/2010
01443 !***********************************************************************
01444 !
01445 !
01446 !
01447 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
01448 !| STRING         |<->| THE NAME OF THE VARIABLE TO TEST
01449 !| COMP_NUM       |<--| direction of vector
01450 !| ISVECTOR       |<--| TRUE, it's a vector
01451 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
01452       CHARACTER(LEN=32), INTENT(INOUT) :: STRING
01453       INTEGER, INTENT(OUT)             :: COMP_NUM
01454       LOGICAL, INTENT(OUT)             :: ISVECTOR
01455 !
01456 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
01457 !
01458       INTEGER :: J
01459 !
01460 !-----------------------------------------------------------------------
01461 !
01462       ISVECTOR = .FALSE.
01463       COMP_NUM = 0
01464 
01465       IF (STRING(1:6)/='COTE_Z') THEN
01466       DO J = 2,31
01467         IF (STRING(J-1:J+1) .EQ. '_U_') THEN
01468           STRING(J:J) = '*'
01469           COMP_NUM = 1
01470           ISVECTOR = .TRUE.
01471         ELSEIF (STRING(J-1:J+1) .EQ. '_V_') THEN
01472           STRING(J:J) = '*'
01473           COMP_NUM = 2
01474           ISVECTOR = .TRUE.
01475         ELSEIF (STRING(J-1:J+1) .EQ. '_W_') THEN
01476           STRING(J:J) = '*'
01477           COMP_NUM = 3
01478           ISVECTOR = .TRUE.
01479         ELSEIF (STRING(J-1:J+1) .EQ. '_X_') THEN
01480           STRING(J:J) = '*'
01481           COMP_NUM = 1
01482           ISVECTOR = .TRUE.
01483         ELSEIF (STRING(J-1:J+1) .EQ. '_Y_') THEN
01484           STRING(J:J) = '*'
01485           COMP_NUM = 2
01486           ISVECTOR = .TRUE.
01487         ELSEIF (STRING(J-1:J+1) .EQ. '_Z_') THEN
01488           STRING(J:J) = '*'
01489           COMP_NUM = 3
01490           ISVECTOR = .TRUE.
01491         ELSEIF (STRING(J-1:J+1) .EQ. 'QX_') THEN
01492           STRING(J-1:J) = 'Q*'
01493           COMP_NUM = 1
01494           ISVECTOR = .TRUE.
01495         ELSEIF (STRING(J-1:J+1) .EQ. 'QY_') THEN
01496           STRING(J-1:J) = 'Q*'
01497           COMP_NUM = 2
01498           ISVECTOR = .TRUE.
01499         ELSEIF (STRING(J-1:J+1) .EQ. 'QZ_') THEN
01500           STRING(J-1:J) = 'Q*'
01501           COMP_NUM = 3
01502           ISVECTOR = .TRUE.
01503         ELSEIF (STRING(J-1:J+1) .EQ. 'U0_') THEN
01504           STRING(J-1:J) = '*0'
01505           COMP_NUM = 1
01506           ISVECTOR = .TRUE.
01507         ELSEIF (STRING(J-1:J+1) .EQ. 'V0_') THEN
01508           STRING(J-1:J) = '*0'
01509           COMP_NUM = 2
01510           ISVECTOR = .TRUE.
01511         ELSEIF (STRING(J-1:J+1) .EQ. 'W0_') THEN
01512           STRING(J-1:J) = '*0'
01513           COMP_NUM = 3
01514           ISVECTOR = .TRUE.
01515         ENDIF
01516       ENDDO
01517       ENDIF
01518 !
01519       RETURN
01520       END SUBROUTINE IFVECTOR_
01521 
01522 !
01523 !-----------------------------------------------------------------------
01524 !
01525       END MODULE M_MED

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