fc2k_database_profiles2.F90

Go to the documentation of this file.

     SUBROUTINE database_profiles2(COREPROF_DB, COREPROF, COREPROF_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:
   

    TYPE (type_coreprof),    POINTER :: coreprof(:)  
    TYPE (type_coreprof),    POINTER :: coreprof_out(:)    
    TYPE (type_coreprof),    POINTER :: coreprof_db(:)    

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




    INTEGER                          :: interpol           !interpolation index
    INTEGER                          :: rho_interpol

    CHARACTER(len=10)                :: cpopath
 
 


! +++ 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_coreprof_cpo(nslice,      nrho1, nnucl1, nion1,  nimp1,  nzimp1, nneut1, ntype1, ncomp1, coreprof_out)
    CALL copy_cpo(coreprof(1), coreprof_out(1))
    coreprof_out(1)%rho_tor     =  coreprof(1)%rho_tor



! +++ Retrieve CPO from the data base:
    cpopath                     = 'COREPROF' 


#ifdef UAL
    write(6,*) ' profiles are read from the database'
#else
    WRITE (6,*) 'ERROR>>> NO COREPROF CPO IN THE DATABASE FOR SELECTED SHOT:'
    CALL allocate_coreprof_cpo(nslice,      nrho1, nnucl1, nion1,  nimp1,  nzimp1, nneut1, ntype1, ncomp1, coreprof_db)
    call deallocate_cpo(coreprof_db(1)%COMPOSITIONS)
    CALL copy_cpo(coreprof(1)%COMPOSITIONS, coreprof_db(1)%COMPOSITIONS)
    coreprof_db(1)%rho_tor      =  coreprof(1)%rho_tor
#endif



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


! +++ Interpolate CPO:
    CALL interpolate_prof(coreprof_db(1), coreprof(1))




! +++ Copy profiles:
    IF (coreprof_out(1)%psi%flag .EQ. 1)                                &
        coreprof_out(1)%psi%value              = coreprof(1)%psi%value
    IF (coreprof_out(1)%ne%flag  .EQ. 1)                                &
        coreprof_out(1)%ne%value               = coreprof(1)%ne%value
    IF (coreprof_out(1)%te%flag  .EQ. 1)                                &
        coreprof_out(1)%te%value               = coreprof(1)%te%value

    DO iion1 = 1, nion1

       IF (coreprof_out(1)%ni%flag(iion1)   .EQ. 1)                                &
           coreprof_out(1)%ni%value(:,iion1)   = coreprof(1)%ni%value(:,iion1)
       IF (coreprof_out(1)%ti%flag(iion1)   .EQ. 1)                                &
           coreprof_out(1)%ti%value(:,iion1)   = coreprof(1)%ti%value(:,iion1)
       IF (coreprof_out(1)%vtor%flag(iion1) .EQ. 1)                                &
           coreprof_out(1)%vtor%value(:,iion1) = coreprof(1)%vtor%value(:,iion1)

    END DO

    IF (coreprof_out(1)%ne%flag  .EQ. 3)       THEN
        coreprof_out(1)%ne%boundary%value(1)      = coreprof(1)%ne%value(nrho1)
        coreprof_out(1)%ne%boundary%value(2)      = 0.0_r8
        coreprof_out(1)%ne%boundary%value(3)      = 0.0_r8
        coreprof_out(1)%ne%boundary%type          = 1
    END IF
    IF (coreprof_out(1)%te%flag  .EQ. 3)       THEN
        coreprof_out(1)%te%boundary%value(1)      = coreprof(1)%te%value(nrho1)
        coreprof_out(1)%te%boundary%value(2)      = 0.0_r8
        coreprof_out(1)%te%boundary%value(3)      = 0.0_r8
        coreprof_out(1)%te%boundary%type          = 1
    END IF

    DO iion1 = 1, nion1

       IF (coreprof_out(1)%ni%flag(iion1)   .EQ. 3) THEN
          coreprof_out(1)%ni%boundary%value(1,iion1)       = coreprof(1)%ni%value(nrho1,iion1)
           coreprof_out(1)%ni%boundary%value(2,iion1)      = 0.0_r8
           coreprof_out(1)%ni%boundary%value(3,iion1)      = 0.0_r8
           coreprof_out(1)%ni%boundary%type(iion1)         = 1

       END IF
       IF (coreprof_out(1)%ti%flag(iion1)   .EQ. 3) THEN
           coreprof_out(1)%ti%boundary%value(1,iion1)      = coreprof(1)%ti%value(nrho1,iion1)
           coreprof_out(1)%ti%boundary%value(2,iion1)      = 0.0_r8
           coreprof_out(1)%ti%boundary%value(3,iion1)      = 0.0_r8
           coreprof_out(1)%ti%boundary%type(iion1)         = 1

       END IF
       IF (coreprof_out(1)%vtor%flag(iion1) .EQ. 3) THEN
           coreprof_out(1)%vtor%boundary%value(1,iion1)    = coreprof(1)%vtor%value(nrho1,iion1)
           coreprof_out(1)%vtor%boundary%value(2,iion1)    = 0.0_r8
           coreprof_out(1)%vtor%boundary%value(3,iion1)    = 0.0_r8
           coreprof_out(1)%vtor%boundary%type(iion1)       = 1

       END IF

    END DO

    


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




    RETURN


  END SUBROUTINE database_profiles2
! + + + + + + + + + + + + + + + + + + + + + + + + + + + +  
! + + + + + + + + + + + + + + + + + + + + + + + + + + + +