fc2k_database_transport.F90

Go to the documentation of this file.

  SUBROUTINE database_transport(USER, MACHINE, VERSION, SHOT, RUN, INTERPOL, TIME, COREPROF, CORETRANSP_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_coretransp),  POINTER :: coretransp_out(:)    
    TYPE (type_coretransp),  POINTER :: coretransp_db(:)    
    TYPE (type_coretransp),  POINTER :: coretransp_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_coretransp_cpo(nslice,      nrho1, nnucl1, nion1,  nimp1,  nzimp1, nneut1, ntype1, ncomp1, coretransp_out)
    call deallocate_cpo(coretransp_out(1)%COMPOSITIONS)
    CALL copy_cpo(coreprof(1)%COMPOSITIONS, coretransp_out(1)%COMPOSITIONS)
    coretransp_out(1)%VALUES(1)%rho_tor   = coreprof(1)%rho_tor



! +++ Retrieve CPO from the data base:
    cpopath                     = 'coretransp' 
    ALLOCATE                      (coretransp_db(1))

#ifdef UAL
    CALL euitm_open_env(treename, shot, run, idx, user, machine, version)
    CALL euitm_get_slice(idx, cpopath, coretransp_db(1), time, interpol)
#else
    WRITE (6,*) 'ERROR>>> NO CORETRANSP CPO IN THE DATABASE FOR SELECTED SHOT:', shot, run
    CALL allocate_coretransp_cpo(nslice,      nrho1, nnucl1, nion1,  nimp1,  nzimp1, nneut1, ntype1, ncomp1, coretransp_db)
    call deallocate_cpo(coretransp_db(1)%COMPOSITIONS)
    CALL copy_cpo(coreprof(1)%COMPOSITIONS, coretransp_db(1)%COMPOSITIONS)
    coretransp_db(1)%VALUES(1)%rho_tor   = coreprof(1)%rho_tor
#endif



! +++ OUTPUT TRANSPORT CPO:
    nrho2                       = SIZE (coretransp_db(1)%VALUES(1)%rho_tor, dim=1)
  
    IF (rho_interpol.NE.0) &
       coretransp_db(1)%VALUES(1)%rho_tor =   coretransp_db(1)%VALUES(1)%rho_tor            &
                                            / coretransp_db(1)%VALUES(1)%rho_tor(nrho2)     &
                                            * coretransp_out(1)%VALUES(1)%rho_tor(nrho1) 
 


! +++ Check:
    IF (SIZE(coretransp_db(1)%VALUES).GT.1) THEN
       ALLOCATE                   (coretransp_tmp(1))
       ALLOCATE                   (coretransp_tmp(1)%VALUES(1))
       CALL copy_cpo(coretransp_db(1)%VALUES(1), coretransp_tmp(1)%VALUES(1))
       CALL deallocate_cpo(coretransp_db(1)%VALUES)
       ALLOCATE                   (coretransp_db(1)%VALUES(1))
       CALL copy_cpo(coretransp_tmp(1)%VALUES(1), coretransp_db(1)%VALUES(1))       
    END IF


! +++ Interpolate CPO:
    CALL interpolate_transp(coretransp_db(1), coretransp_out(1), 0)



! +++ ADD IDENTIFIER TO OUTPUT CPO VALUES(1):
    ALLOCATE            (coretransp_out(1)%VALUES(1)%transportid%id(1))
    ALLOCATE            (coretransp_out(1)%VALUES(1)%transportid%description(1))
    coretransp_out(1)%VALUES(1)%transportid%id          = 'database'
    coretransp_out(1)%VALUES(1)%transportid%flag        = 10
    coretransp_out(1)%VALUES(1)%transportid%description = 'Transport specified by a database entry'
     


    CALL deallocate_cpo(coretransp_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_transport
! + + + + + + + + + + + + + + + + + + + + + + + + + + + +  
! + + + + + + + + + + + + + + + + + + + + + + + + + + + +