fc2k_database_sources2.F90

Go to the documentation of this file.

  SUBROUTINE database_source2(COREPROF, CORESOURCE_DB, CORESOURCE_OUT)

    USE allocate_deallocate
    USE deallocate_structures

    USE itm_constants
    USE euitm_routines
    USE euitm_schemas
    USE interpolate_cpo 
    USE copy_structures

    IMPLICIT NONE


! + + + + + + + + + + + + + + + + + + + + + + + + + + + +  
! +++ CPOs:
    

    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 :: nvalues,ivalues,combvalue

   


! +++ 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



   nvalues=size(coresource_db(1)%values)
   combvalue=-1
   if (nvalues.ge.0) then
! check if combined sources are present 
      do ivalues=1,nvalues
         if (coresource_db(1)%values(ivalues)%sourceid%flag.eq.30) combvalue=ivalues
      enddo
   else
      write(*,*) 'no sources are given on input'
   end if

   IF (combvalue.GT.0) THEN
       write(*,*) 'take combined sources'
       ALLOCATE                   (coresource_tmp(1))
       ALLOCATE                   (coresource_tmp(1)%VALUES(1))
       CALL copy_cpo(coresource_db(1)%VALUES(combvalue), 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))  
   else
       write(*,*) 'take first value'
       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:
! if combined sources are present use them, use 1st value else

    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)
    CALL deallocate_cpo(coresource_tmp)
    IF (ALLOCATED(nzimp1))        DEALLOCATE (nzimp1)
    IF (ALLOCATED(ncomp1))        DEALLOCATE (ncomp1)
    IF (ALLOCATED(ntype1))        DEALLOCATE (ntype1)




    RETURN


  END SUBROUTINE database_source2
! + + + + + + + + + + + + + + + + + + + + + + + + + + + +  
! + + + + + + + + + + + + + + + + + + + + + + + + + + + +