fct_q2l.f90 File Reference

Go to the source code of this file.

Functions/Subroutines
subroutine	fct_q2l

Function/Subroutine Documentation

fct_q2l()

subroutine fct_q2l

(

)

Definition at line 45 of file fct_q2l.f90.

!#  if defined (1)

!==============================================================================|
   USE all_vars
   USE bcs
   USE mod_utils
   USE mod_obcs
   IMPLICIT NONE
   REAL(SP):: Q2LMAX,Q2LMIN
   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
       q2lmax = maxval(q2l(nbsn(i,1:ntsn(i)),k))
       q2lmin = minval(q2l(nbsn(i,1:ntsn(i)),k))

       IF(k == 2)THEN
         q2lmax = max(q2lmax,(q2l(i,k)*dzz(i,k)+q2l(i,k+1)*dzz(i,k-1))/  &
                  (dzz(i,k)+dzz(i,k-1)))
         q2lmin = min(q2lmin,(q2l(i,k)*dzz(i,k)+q2l(i,k+1)*dzz(i,k-1))/  &
                  (dzz(i,k)+dzz(i,k-1)))
       ELSE IF(k == kbm1)THEN
         q2lmax = max(q2lmax,(q2l(i,k)*dzz(i,k-2)+q2l(i,k-1)*dzz(i,k-1))/  &
                  (dzz(i,k-1)+dzz(i,k-2)))
         q2lmin = min(q2lmin,(q2l(i,k)*dzz(i,k-2)+q2l(i,k-1)*dzz(i,k-1))/  &
                  (dzz(i,k-1)+dzz(i,k-2)))
       ELSE
         q2lmax = max(q2lmax,(q2l(i,k)*dzz(i,k-2)+q2l(i,k-1)*dzz(i,k-1))/  &         
                  (dzz(i,k-1)+dzz(i,k-2)),                                 &
                  (q2l(i,k)*dzz(i,k)+q2l(i,k+1)*dzz(i,k-1))/               &
                  (dzz(i,k)+dzz(i,k-1)))
         q2lmin = min(q2lmin,(q2l(i,k)*dzz(i,k-2)+q2l(i,k-1)*dzz(i,k-1))/  &
                  (dzz(i,k-1)+dzz(i,k-2)),                                 &
                  (q2l(i,k)*dzz(i,k)+q2l(i,k+1)*dzz(i,k-1))/               &
                  (dzz(i,k)+dzz(i,k-1)))
       END IF

       IF(q2lmin-q2lf(i,k) > 0.0_sp)q2lf(i,k) = q2lmin
       IF(q2lf(i,k)-q2lmax > 0.0_sp)q2lf(i,k) = q2lmax

     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: