fc2k_database_transport2.F90

Go to the documentation of this file.

  SUBROUTINE database_transport2(COREPROF, CORETRANSP_DB, CORETRANSP_OUT, RHO_INTERPOL,user_out_outputFlag,user_out_diagnosticInfo)

    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_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                          :: rho_interpol

   !----  Diagnostic info  ----
integer, intent(out)     ::     user_out_outputflag
character(len=:), pointer, intent(out)    ::    user_out_diagnosticinfo
integer nchd
character*255 error_mes


 user_out_outputflag=0

nullify(user_out_diagnosticinfo)

if (.not.associated(coretransp_db(1)%values)) then
  user_out_outputflag=-1
  error_mes='no coretransp present in input,stop'
  nchd=len_trim(error_mes)
  allocate(character(nchd)  :: user_out_diagnosticinfo)
  user_out_diagnosticinfo=error_mes(1:nchd)
! the next one is just to be consistent in parameters'
  allocate(coretransp_out(1))
  !user_out_diagnosticInfo='no coretransp present in input,stop'
  return
end if  
    
 


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





#ifdef UAL
    write(*,*) 'take the transport data from cpo'
#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) 
 

!dy should we in the future copy all values from the database?

! +++ 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 (associated(coretransp_tmp)) call deallocate_cpo(coretransp_tmp)
    IF (ALLOCATED(nzimp1))        DEALLOCATE (nzimp1)
    IF (ALLOCATED(ncomp1))        DEALLOCATE (ncomp1)
    IF (ALLOCATED(ntype1))        DEALLOCATE (ntype1)




    RETURN


  END SUBROUTINE database_transport2
! + + + + + + + + + + + + + + + + + + + + + + + + + + + +  
! + + + + + + + + + + + + + + + + + + + + + + + + + + + +