fc2k_database_sources.F90

Go to the documentation of this file.

  SUBROUTINE database_source(USER, MACHINE, VERSION, SHOT, RUN, INTERPOL, TIME, COREPROF, CORESOURCE_OUT, RHO_INTERPOL)

    USE allocate_deallocate
    USE deallocate_structures

    USE itm_constants
    USE euitm_routines
    USE euitm_schemas
    USE interpolate_cpo
    USE copy_structures

    IMPLICIT NONE


! + + + + + + + + + + + + + + + + + + + + + + + + + + + +  
! +++ CPOs:
    REAL (R8)                        :: time               !Time
    INTEGER                          :: shot,  run         !shot and run numbers
    INTEGER                          :: idx                !index (internal)

    TYPE (type_coreprof),    POINTER :: coreprof(:)  
    TYPE (type_coresource),  POINTER :: coresource_out(:)    
    TYPE (type_coresource),  POINTER :: coresource_db(:)    
    TYPE (type_coresource),  POINTER :: coresource_tmp(:)

    INTEGER,              PARAMETER  :: nslice = 1             !number of CPO ocurancies in the work flow
    INTEGER                          :: nrho1, nrho2
    INTEGER                          :: nnucl1
    INTEGER                          :: nion1
    INTEGER                          :: nimp1       
    INTEGER,             ALLOCATABLE :: nzimp1(:)
    INTEGER                          :: nneut1
    INTEGER,             ALLOCATABLE :: ncomp1(:)
    INTEGER,             ALLOCATABLE :: ntype1(:)




    INTEGER                          :: interpol           !interpolation index
    INTEGER                          :: rho_interpol

    CHARACTER(len=10)                :: cpopath
    CHARACTER(len=5),     PARAMETER  :: treename = 'euitm'
    CHARACTER(*)                     :: user
    CHARACTER(*)                     :: machine
    CHARACTER(*)                     :: version
 


! +++ allocate and define grid of output CPO:
    nrho1                   = SIZE(coreprof(1)%rho_tor,      dim=1)
    CALL get_comp_dimensions(coreprof(1)%COMPOSITIONS, nnucl1, nion1,  nimp1,  nzimp1, nneut1, ntype1, ncomp1)
    CALL allocate_coresource_cpo(nslice,      nrho1, nnucl1, nion1,  nimp1,  nzimp1, nneut1, ntype1, ncomp1, coresource_out)
    call deallocate_cpo(coresource_out(1)%COMPOSITIONS)
    CALL copy_cpo(coreprof(1)%COMPOSITIONS, coresource_out(1)%COMPOSITIONS)
    coresource_out(1)%VALUES(1)%rho_tor   = coreprof(1)%rho_tor



! +++ Retrieve CPO from the data base:
    cpopath                     = 'coresource' 
    ALLOCATE                      (coresource_db(1))
#ifdef UAL
    CALL euitm_open_env(treename, shot, run, idx, user, machine, version)
    CALL euitm_get_slice(idx, cpopath, coresource_db(1), time, interpol)
#else
    WRITE (6,*) 'ERROR>>> NO CORESOURCE CPO IN THE DATABASE FOR SELECTED SHOT:', shot, run
    CALL allocate_coresource_cpo(nslice,      nrho1, nnucl1, nion1,  nimp1,  nzimp1, nneut1, ntype1, ncomp1, coresource_db)
    call deallocate_cpo(coresource_db(1)%COMPOSITIONS)
    CALL copy_cpo(coreprof(1)%COMPOSITIONS, coresource_db(1)%COMPOSITIONS)
    coresource_db(1)%VALUES(1)%rho_tor   = coreprof(1)%rho_tor
#endif



! +++ OUTPUT SOURCE CPO:
    nrho2                       = SIZE (coresource_db(1)%VALUES(1)%rho_tor, dim=1)
  
    IF (rho_interpol.NE.0) &
       coresource_db(1)%VALUES(1)%rho_tor =   coresource_db(1)%VALUES(1)%rho_tor            &
                                            / coresource_db(1)%VALUES(1)%rho_tor(nrho2)     &
                                            * coresource_out(1)%VALUES(1)%rho_tor(nrho1) 
 
! +++ Check:
    IF (SIZE(coresource_db(1)%VALUES).GT.1) THEN
       ALLOCATE                   (coresource_tmp(1))
       ALLOCATE                   (coresource_tmp(1)%VALUES(1))
       CALL copy_cpo(coresource_db(1)%VALUES(1), coresource_tmp(1)%VALUES(1))
       CALL deallocate_cpo(coresource_db(1)%VALUES)
       ALLOCATE                   (coresource_db(1)%VALUES(1))
       CALL copy_cpo(coresource_tmp(1)%VALUES(1), coresource_db(1)%VALUES(1))       
    END IF


! +++ Interpolate CPO:
    CALL interpolate_source(coresource_db(1), coresource_out(1))



! +++ ADD IDENTIFIER TO OUTPUT CPO VALUES(1):
    ALLOCATE                      (coresource_out(1)%VALUES(1)%sourceid%id(1))
    ALLOCATE                      (coresource_out(1)%VALUES(1)%sourceid%description(1))

    coresource_out(1)%VALUES(1)%sourceid%id          = 'database'
    coresource_out(1)%VALUES(1)%sourceid%flag        = 27
    coresource_out(1)%VALUES(1)%sourceid%description = 'Source from database entry'




    CALL deallocate_cpo(coresource_db)
    IF (ALLOCATED(nzimp1))        DEALLOCATE (nzimp1)
    IF (ALLOCATED(ncomp1))        DEALLOCATE (ncomp1)
    IF (ALLOCATED(ntype1))        DEALLOCATE (ntype1)

#ifdef UAL
    CALL euitm_close(idx, treename, shot, run)
#endif


    RETURN


  END SUBROUTINE database_source
! + + + + + + + + + + + + + + + + + + + + + + + + + + + +  
! + + + + + + + + + + + + + + + + + + + + + + + + + + + +