fct_q2.f90 File Reference

Go to the source code of this file.

Functions/Subroutines
subroutine	fct_q2

Function/Subroutine Documentation

fct_q2()

subroutine fct_q2

(

)

Definition at line 45 of file fct_q2.f90.

!#  if defined (1)

!==============================================================================|
   USE all_vars
   USE mod_utils
   USE bcs
   USE mod_obcs
   IMPLICIT NONE
   REAL(SP):: Q2MAX,Q2MIN
   INTEGER :: I,J,K
!==============================================================================|

   IF(heating_type == 'body') return
   
   IF(dbg_set(dbg_sbr)) write(ipt,*) "Start: fct_q2"


nodes:DO i=1,m

     IF(iobcn > 0)THEN
       DO j=1,iobcn
         IF(i == i_obc_n(j)) cycle nodes
       END DO
     END IF     
 
     IF(numqbc > 0)THEN
       DO j=1,numqbc
         IF(river_inflow_location == 'node')THEN
       IF(i == inodeq(j)) cycle nodes
     END IF  
         IF(river_inflow_location == 'edge')THEN
       IF(i == n_icellq(j,1) .OR. i == n_icellq(j,2)) cycle nodes
     END IF  
       END DO
     END IF
     DO k=2,kbm1
       q2max = maxval(q2(nbsn(i,1:ntsn(i)),k))
       q2min = minval(q2(nbsn(i,1:ntsn(i)),k))

       IF(k == 2)THEN
         q2max = max(q2max,(q2(i,k)*dzz(i,k)+q2(i,k+1)*dzz(i,k-1))/  &
                 (dzz(i,k)+dzz(i,k-1)))
         q2min = min(q2min,(q2(i,k)*dzz(i,k)+q2(i,k+1)*dzz(i,k-1))/  &
                 (dzz(i,k)+dzz(i,k-1)))
       ELSE IF(k == kbm1)THEN
         q2max = max(q2max,(q2(i,k)*dzz(i,k-2)+q2(i,k-1)*dzz(i,k-1))/  &
                 (dzz(i,k-1)+dzz(i,k-2)))
         q2min = min(q2min,(q2(i,k)*dzz(i,k-2)+q2(i,k-1)*dzz(i,k-1))/  &
                 (dzz(i,k-1)+dzz(i,k-2)))
       ELSE
         q2max = max(q2max,(q2(i,k)*dzz(i,k-2)+q2(i,k-1)*dzz(i,k-1))/  &
                 (dzz(i,k-1)+dzz(i,k-2)),                              &
                 (q2(i,k)*dzz(i,k)+q2(i,k+1)*dzz(i,k-1))/              &
                 (dzz(i,k)+dzz(i,k-1)))  
         q2min = min(q2min,(q2(i,k)*dzz(i,k-2)+q2(i,k-1)*dzz(i,k-1))/  &
                 (dzz(i,k-1)+dzz(i,k-2)),                              &
                 (q2(i,k)*dzz(i,k)+q2(i,k+1)*dzz(i,k-1))/              &
                 (dzz(i,k)+dzz(i,k-1)))
       END IF

       IF(q2min-q2f(i,k) > 0.0_sp)q2f(i,k) = q2min
       IF(q2f(i,k)-q2max > 0.0_sp)q2f(i,k) = q2max

     END DO

   END DO nodes

   IF(dbg_set(dbg_sbr)) write(ipt,*) "End: fct_q2"

Here is the call graph for this function:

Here is the caller graph for this function: