fc2k_parabolic_prof.f90

Go to the documentation of this file.

! + + + + + + + + + + + + + + + + + + + + + + + + + + + +  
! + + + + + + + + + + + + + + + + + + + + + + + + + + + +   

  SUBROUTINE  fc2k_parabolic_prof  (COREPROF_IN,  EQUILIBRIUM_IN, &
                                    coreprof_out, equilibrium_out, &
                                    output_flag,  diagnostic_info)

!-------------------------------------------------------!
!     This routine puts parabolic                       !
!     profiles of psi, q and jparallel                  !
!                                                       !
!     information received in: COREPROF_IN                 !
!                                                       !
!     information saved in:    COREPROF                 !
!                                                       !
!                                                       !
!-------------------------------------------------------!
!     Source:       ---                                 !
!     Developers:   D.Kalupin                           !
!     Kontacts:     Denis.Kalupin@efda.org              !
!                                                       !
!     Comments:     created for V&V between ETS, JETTO  !
!                   and ASTRA                           !
!                                                       !
!-------------------------------------------------------!


    USE euitm_schemas
    USE copy_structures
    USE equilibrium_work

    IMPLICIT NONE

    CHARACTER(LEN=1024)                    :: out_info
    INTEGER,                   INTENT(OUT) :: output_flag
    CHARACTER(LEN=:), POINTER, INTENT(OUT) :: diagnostic_info

! +++ CPO derived types:
    TYPE (type_coreprof),    POINTER  :: coreprof_in(:)         !input/output CPO with plasma profiles   
    TYPE (type_coreprof),    POINTER  :: coreprof_out(:)        !input/output CPO with plasma profiles   
    TYPE (type_equilibrium), POINTER  :: equilibrium_in(:)      !input CPO with geometry quantities from previous time
    TYPE (type_equilibrium), POINTER  :: equilibrium_out(:)     !input CPO with geometry quantities from previous time

    nullify( diagnostic_info )

    IF (.NOT. ASSOCIATED (equilibrium_in(1)%profiles_1d%rho_tor) ) THEN
       ALLOCATE (coreprof_out(1))
       ALLOCATE (equilibrium_out(1))
       out_info = 'ERROR in FC2K_PARABOLIC_PROF, EQUILIBRIUM_IN(1)%profiles_1d%rho_tor not associated'
       ALLOCATE( CHARACTER(len=len(trim(adjustl(out_info)))) :: diagnostic_info )
       diagnostic_info = out_info
       write(*,*)diagnostic_info
       output_flag = -1
       RETURN
    END IF

    IF (.NOT. ASSOCIATED (equilibrium_in(1)%profiles_1d%volume) ) THEN
       ALLOCATE (coreprof_out(1))
       ALLOCATE (equilibrium_out(1))
       out_info = 'ERROR in FC2K_PARABOLIC_PROF, EQUILIBRIUM_IN(1)%profiles_1d%volume not associated'
       ALLOCATE( CHARACTER(len=len(trim(adjustl(out_info)))) :: diagnostic_info )
       diagnostic_info = out_info
       write(*,*)diagnostic_info
       output_flag = -2
       RETURN
    END IF

    IF (.NOT. ASSOCIATED (equilibrium_in(1)%profiles_1d%psi) ) THEN
       ALLOCATE (coreprof_out(1))
       ALLOCATE (equilibrium_out(1))
       out_info = 'ERROR in FC2K_PARABOLIC_PROF, EQUILIBRIUM_IN(1)%profiles_1d%psi not associated'
       ALLOCATE( CHARACTER(len=len(trim(adjustl(out_info)))) :: diagnostic_info )
       diagnostic_info = out_info
       output_flag = -3
       RETURN
    END IF

    IF (.NOT. ASSOCIATED (equilibrium_in(1)%profiles_1d%f_dia) ) THEN
       ALLOCATE (coreprof_out(1))
       ALLOCATE (equilibrium_out(1))
       out_info = 'ERROR in FC2K_PARABOLIC_PROF, EQUILIBRIUM_IN(1)%profiles_1d%f_dia not associated'
       ALLOCATE( CHARACTER(len=len(trim(adjustl(out_info)))) :: diagnostic_info )
       diagnostic_info = out_info
       write(*,*)diagnostic_info
       output_flag = -4
       RETURN
    END IF

    IF (.NOT. ASSOCIATED (equilibrium_in(1)%profiles_1d%gm2) ) THEN
       ALLOCATE (coreprof_out(1))
       ALLOCATE (equilibrium_out(1))
       out_info = 'ERROR in FC2K_PARABOLIC_PROF, EQUILIBRIUM_IN(1)%profiles_1d%gm2 not associated'
       ALLOCATE( CHARACTER(len=len(trim(adjustl(out_info)))) :: diagnostic_info )
       diagnostic_info = out_info
       write(*,*)diagnostic_info
       output_flag = -5
       RETURN
    END IF

    IF (.NOT. ASSOCIATED (coreprof_in(1)%rho_tor) ) THEN
       ALLOCATE (coreprof_out(1))
       ALLOCATE (equilibrium_out(1))
       out_info = 'ERROR in FC2K_PARABOLIC_PROF, COREPROF_IN(1)%rho_tor not associated'
       ALLOCATE( CHARACTER(len=len(trim(adjustl(out_info)))) :: diagnostic_info )
       diagnostic_info = out_info
       write(*,*)diagnostic_info
       output_flag = -6
       RETURN
    END IF

    IF (.NOT. ASSOCIATED (coreprof_in(1)%psi%value) ) THEN
       ALLOCATE (coreprof_out(1))
       ALLOCATE (equilibrium_out(1))
       out_info = 'ERROR in FC2K_PARABOLIC_PROF, COREPROF_IN(1)%psi%value not associated'
       ALLOCATE( CHARACTER(len=len(trim(adjustl(out_info)))) :: diagnostic_info )
       diagnostic_info = out_info
       write(*,*)diagnostic_info
       output_flag = -7
       RETURN
    END IF

    IF (.NOT. ASSOCIATED (coreprof_in(1)%profiles1d%q%value) ) THEN
       ALLOCATE (coreprof_out(1))
       ALLOCATE (equilibrium_out(1))
       out_info = 'ERROR in FC2K_PARABOLIC_PROF, COREPROF_IN(1)%profiles1d%q%value not associated'
       ALLOCATE( CHARACTER(len=len(trim(adjustl(out_info)))) :: diagnostic_info )
       diagnostic_info = out_info
       write(*,*)diagnostic_info
       output_flag = -8
       RETURN
    END IF

    IF (.NOT. ASSOCIATED (coreprof_in(1)%profiles1d%jtot%value) ) THEN
       ALLOCATE (coreprof_out(1))
       ALLOCATE (equilibrium_out(1))
       out_info = 'ERROR in FC2K_PARABOLIC_PROF, COREPROF_IN(1)%profiles1d%jtot%value not associated'
       ALLOCATE( CHARACTER(len=len(trim(adjustl(out_info)))) :: diagnostic_info )
       diagnostic_info = out_info
       write(*,*)diagnostic_info
       output_flag = -9
       RETURN
    END IF

    IF (.NOT. ASSOCIATED (coreprof_in(1)%ne%value) ) THEN
       ALLOCATE (coreprof_out(1))
       ALLOCATE (equilibrium_out(1))
       out_info = 'ERROR in FC2K_PARABOLIC_PROF, COREPROF_IN(1)%ne%value not associated'
       ALLOCATE( CHARACTER(len=len(trim(adjustl(out_info)))) :: diagnostic_info )
       diagnostic_info = out_info
       write(*,*)diagnostic_info
       output_flag = -10
       RETURN
    END IF

    IF (.NOT. ASSOCIATED (coreprof_in(1)%ni%value) ) THEN
       ALLOCATE (coreprof_out(1))
       ALLOCATE (equilibrium_out(1))
       out_info = 'ERROR in FC2K_PARABOLIC_PROF, COREPROF_IN(1)%ni%value not associated'
       output_flag = -11
       ALLOCATE( CHARACTER(len=len(trim(adjustl(out_info)))) :: diagnostic_info )
       diagnostic_info = out_info
       write(*,*)diagnostic_info
       RETURN
    END IF

    IF (.NOT. ASSOCIATED (coreprof_in(1)%te%value) ) THEN
       ALLOCATE (coreprof_out(1))
       ALLOCATE (equilibrium_out(1))
       out_info = 'ERROR in FC2K_PARABOLIC_PROF, COREPROF_IN(1)%te%value not associated'
       ALLOCATE( CHARACTER(len=len(trim(adjustl(out_info)))) :: diagnostic_info )
       diagnostic_info = out_info
       write(*,*)diagnostic_info
       output_flag = -12
       RETURN
    END IF

    IF (.NOT. ASSOCIATED (coreprof_in(1)%ti%value) ) THEN
       ALLOCATE (coreprof_out(1))
       ALLOCATE (equilibrium_out(1))
       out_info = 'ERROR in FC2K_PARABOLIC_PROF, COREPROF_IN(1)%ti%value not associated'
       ALLOCATE( CHARACTER(len=len(trim(adjustl(out_info)))) :: diagnostic_info )
       diagnostic_info = out_info
       write(*,*)diagnostic_info
       output_flag = -13
       RETURN
    END IF

 
    CALL parabolic_prof(coreprof_in,  equilibrium_in, &
                          coreprof_out, equilibrium_out)


    RETURN

  END SUBROUTINE fc2k_parabolic_prof

! + + + + + + + + + + + + + + + + + + + + + + + + + + + +  
! + + + + + + + + + + + + + + + + + + + + + + + + + + + +