fc2k_database_profiles3.f90

Go to the documentation of this file.

     SUBROUTINE database_profiles3(COREPROF_DB, COREPROF, COREPROF_OUT, RHO_INTERPOL,stretch_and_cut)
!dy same as version2 but with stretch_and_cut possibility

    USE allocate_deallocate
    USE deallocate_structures

    USE itm_constants
    USE euitm_routines
    USE euitm_schemas
    USE interpolate_cpo
    USE copy_structures
    use, INTRINSIC :: ieee_arithmetic

    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
    integer       :: stretch_and_cut

    CHARACTER(len=10)                :: cpopath
!   values for the fix of zero/negative density/temperature
    REAL (R8), parameter             :: temperature_floor = 10.0e0_r8 ! [eV]  sets ... 
    REAL (R8), parameter             :: density_floor = 1.0e6_r8      ! [m-3] sets ...
 
 


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



!dy add option for stretch_:and _cut
if (stretch_and_cut.eq.0) then

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


  if (associated(coreprof_db)) then
    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))

end if !stretch_and_cut
!dy


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


! find and fix potential problems in profiles data (later move this to a general
! subroutine)
    where(coreprof_out(1)%te%value.lt.temperature_floor .or. ieee_is_nan(coreprof_out(1)%te%value))    &
          coreprof_out(1)%te%value = temperature_floor
    where(coreprof_out(1)%ne%value.lt.density_floor .or. ieee_is_nan(coreprof_out(1)%ne%value))        & 
          coreprof_out(1)%ne%value = density_floor

    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)

       where(coreprof_out(1)%ti%value(:, iion1).lt.temperature_floor .or. ieee_is_nan(coreprof_out(1)%ti%value(:,iion1)))  &
            coreprof_out(1)%ti%value(:, iion1) = temperature_floor
       where(coreprof_out(1)%ni%value(:, iion1).lt.density_floor     .or. ieee_is_nan(coreprof_out(1)%ni%value(:,iion1)))  & 
            coreprof_out(1)%ni%value(:, iion1) = density_floor

    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

!dy always get the rotation if it is is given on input
   IF (ASSOCIATED(coreprof(1)%profiles1d%wtor%value)) then
      do iion1=1,nion1
        coreprof_out(1)%profiles1d%wtor%value(:,iion1)=coreprof(1)%profiles1d%wtor%value(:,iion1)
      enddo
   end if

!dy

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




    RETURN


  END SUBROUTINE database_profiles3
! + + + + + + + + + + + + + + + + + + + + + + + + + + + +  
! + + + + + + + + + + + + + + + + + + + + + + + + + + + +