fixtemp.F File Reference

#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com08_c.inc"
#include "param_c.inc"
#include "parit_c.inc"
#include "vectorize.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	fixtemp (python, ibft, val, temp, npc, tf, nsensor, sensor_tab, glob_therm, snpc)

Function/Subroutine Documentation

fixtemp()

subroutine fixtemp	(	type(python_)	python,
		integer, dimension(glob_therm%nift,*)	ibft,
			val,
			temp,
		integer, dimension(*)	npc,
			tf,
		integer, intent(in)	nsensor,
		type (sensor_str_), dimension(nsensor), intent(in)	sensor_tab,
		type (glob_therm_), intent(inout)	glob_therm,
		integer, intent(in)	snpc )

Definition at line 38 of file fixtemp.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------  
      USE redef3_mod, only: get_python_funct_id
      USE sensor_mod
      use glob_therm_mod
      USE python_funct_mod
      USE vinter_mixed_mod
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   G l o b a l   P a r a m e t e r s
C-----------------------------------------------
#include      "mvsiz_p.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com01_c.inc"
#include      "com04_c.inc"
#include      "com08_c.inc"
#include      "param_c.inc"
#include      "parit_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      type(python_) :: PYTHON
      type (glob_therm_) ,intent(inout)   :: glob_therm
      INTEGER ,INTENT(IN) :: NSENSOR
      INTEGER NPC(*)
      INTEGER IBFT(GLOB_THERM%NIFT,*)
      my_real :: temp(*),tf(*)
      my_real :: val(glob_therm%LFACTHER,*)
      integer, intent(in) :: SNPC
      TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) ,INTENT(IN) :: SENSOR_TAB
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,N,L,II, NN,ISENS,IC, IDEB, ISMOOTH
      INTEGER ILENC(MVSIZ), IPOSC(MVSIZ), IADC(MVSIZ)
      INTEGER INDEX(MVSIZ)
      my_real fac, facx, startt, stopt, ts
      my_real yc(mvsiz), tsc(mvsiz), dydxc(mvsiz)
      integer :: pyid
      logical :: any_python_func
C-----------------------------------------------
      ideb = 0
      ismooth = 0
C
      DO nn=1,glob_therm%NFXTEMP,nvsiz
        ic = 0
        IF (nsensor > 0) THEN
          DO ii = 1, min(glob_therm%NFXTEMP - ideb,nvsiz)
            n = ii+ideb
            startt = val(1,n)
            stopt  = val(2,n)
C
            isens = ibft(3,n)
            IF (isens == 0)THEN
               ts = tt*glob_therm%THEACCFACT - startt
            ELSE 
               startt = startt + sensor_tab(isens)%TSTART
               stopt  = stopt  + sensor_tab(isens)%TSTART
               ts = tt*glob_therm%THEACCFACT -(startt + sensor_tab(isens)%TSTART)      
            ENDIF       
C
            IF(tt*glob_therm%THEACCFACT < startt) cycle
            IF(tt*glob_therm%THEACCFACT > stopt)  cycle
            facx   = val(3,n)
            i=iabs(ibft(1,n))
            ic = ic + 1
            index(ic)= n
C            TSC(IC) = (TS+DT2)*FACX     
            tsc(ic) = ts*facx     
          ENDDO
        ELSE
C       sans aucun sensor
          DO ii = 1, min(glob_therm%NFXTEMP-ideb,nvsiz)
            n = ii+ideb
            startt = val(1,n)
            stopt  = val(2,n)
            IF (tt*glob_therm%THEACCFACT < startt) cycle
            IF (tt*glob_therm%THEACCFACT > stopt)  cycle
            facx   = val(3,n)
            i=iabs(ibft(1,n))
            ic = ic + 1
            index(ic) = n     
            ts = tt*glob_therm%THEACCFACT - startt
            tsc(ic) = ts*facx          
          ENDDO
        ENDIF
C
        ideb = ideb + min(glob_therm%NFXTEMP-ideb,nvsiz)
C
        any_python_func = .false.
        IF(ncycle == 0)THEN
         DO ii=1,ic
          n = index(ii)
          l = ibft(2,n)
          IF (l > 0) ismooth = npc(2*nfunct+l+1)
          iposc(ii) = 0
          pyid = get_python_funct_id(nfunct,l,npc,snpc)
          if(pyid > 0) then
            iadc(ii)  =-pyid
            ilenc(ii) =-pyid 
            any_python_func = .true.
          else
            iadc(ii)  = npc(l) / 2 + 1
            ilenc(ii) = npc(l+1) / 2 - iadc(ii) - iposc(ii)
          endif
         ENDDO
        ELSE
         DO ii=1,ic
          n = index(ii)
          l = ibft(2,n)
          IF (l > 0) ismooth = npc(2*nfunct+l+1)
          iposc(ii) = ibft(4,n)
          pyid = get_python_funct_id(nfunct,l,npc,snpc)
          if(pyid > 0) then
            iadc(ii)  =-pyid
            ilenc(ii) =-pyid 
            any_python_func = .true.
          else  
            iadc(ii)  = npc(l) / 2 + 1
            ilenc(ii) = npc(l+1) / 2 - iadc(ii) - iposc(ii)
          endif
         ENDDO
        ENDIF
 
        if(any_python_func) then
          call vinter_mixed(python,tf,iadc,iposc,ilenc,ic,tsc,dydxc,yc)
        else
          IF (ismooth == 0) THEN
            CALL vinter(tf,iadc,iposc,ilenc,ic,tsc,dydxc,yc)
          ELSE
            CALL vinter_smooth(tf,iadc,iposc,ilenc,ic,tsc,dydxc,yc)
          ENDIF ! IF (ISMOOTH == 0)
        ENDIF ! if(any_python_func)
C
        IF(ivector == 0) THEN
         DO ii=1,ic
          n = index(ii) 
          ibft(4,n) = iposc(ii)
          fac  = val(4,n)
          yc(ii) = yc(ii) * fac
          i=iabs(ibft(1,n))
          temp(i) = yc(ii)
         ENDDO 
        ELSE
C       partie vectorielle                  
#include "vectorize.inc"
          DO ii=1,ic
           n = index(ii)
           ibft(4,n) = iposc(ii)
           fac  = val(4,n)
           yc(ii) = yc(ii) * fac
           i=iabs(ibft(1,n))
           temp(i) = yc(ii) 
          ENDDO
        ENDIF
C
      ENDDO !NN=1,NFXTEMP
C
      RETURN