wsgg_case.F [SRC] [CPP] [JOB] [SCAN]
SEQCODE / MODELSOURCES/MODEL [=]



   1 | include(dom.inc)
   2 | 
   3 |        SUBROUTINE WSGG_CASE(all_k_abs,w,Lb,celldata,ncells,nfcelt,Tf,ALb&
   4 |      &            ,ALo,WSGG_W,alpha,k_wsgg,all_WVNB,all_DWVNB,nfacemax, &
   5 |      &            nkabs)
   6 | 
   7 |        IMPLICIT NONE
   8 | 
   9 |        include 'dom_constants.h'
  10 | 
  11 |        DOM_INT :: i_bande,j_gas,jk_gas,nkabs
  12 |        DOM_INT :: ncells,nfacemax,ielt
  13 |        DOM_REAL :: blae,planck
  14 |        DOM_REAL,DIMENSION(ncells)              :: Lb, K_SOOT
  15 |        DOM_REAL,DIMENSION(ncells)              :: WSGG_KSOOT,nfcelt
  16 |        DOM_REAL,DIMENSION(ncells,nfacemax)     :: Tf
  17 |        DOM_REAL,DIMENSION(ncells,ngg)          :: ALb, WSGG_W
  18 |        DOM_REAL,DIMENSION(ncells,nfacemax,ngg) :: ALo
  19 |        DOM_REAL,DIMENSION(ncells,8)            :: celldata
  20 |        DOM_REAL,DIMENSION(ncells,ngg)          :: all_k_abs
  21 |        DOM_REAL,DIMENSION(n_SNBmax)            :: all_WVNB,all_DWVNB,F
  22 |        DOM_REAL                                :: WVNB_SI,DWVNB_SI
  23 |        DOM_REAL,DIMENSION(ngg)                 :: k_wsgg
  24 |        DOM_REAL,DIMENSION(ngg,6)               :: alpha
  25 |        DOM_REAL,DIMENSION(nkabs)               :: w
  26 | 
  27 |        all_k_abs=0.0
  28 | 
  29 |        DO ielt=1,ncells
  30 | 
  31 | !      ---------------------------------!
  32 | !      MEAN SOOT ABSORPTION CALCULATION !
  33 | !      ---------------------------------!
  34 |          WSGG_KSOOT(ielt)=0.
  35 | 
  36 |          DO i_bande=1,n_SNBmax
  37 | 
  38 |           WVNB_SI = 100.*all_WVNB(i_bande)
  39 |           DWVNB_SI= 100.*all_DWVNB(i_bande)
  40 | 
  41 |           F(i_bande)=blae(WVNB_SI,celldata(ielt,1))/(pi*Lb(ielt))*      &
  42 |      &               DWVNB_SI
  43 | 
  44 |           K_SOOT(ielt)=WVNB_SI*5.5*celldata(ielt,8)
  45 | 
  46 |           WSGG_KSOOT(ielt)=WSGG_KSOOT(ielt)+F(i_bande)*K_SOOT(ielt)
  47 | 
  48 |          ENDDO
  49 | 
  50 | !      -----------------------------------------------------------------!
  51 | !      CALCULATION OF THE MEAN K FOR EACH GRAY GAS (j_gas)              !
  52 | !      AND CALCULATION OF THE WEIGHT OF EACH GAZ BY A TEMPE. POLYNOMIAL !
  53 | !      -----------------------------------------------------------------!
  54 | 
  55 |          DO j_gas=1,ngg
  56 | 
  57 |            WSGG_W(ielt,j_gas)     = alpha(j_gas,1)
  58 | 
  59 |            DO jk_gas=1,5
  60 | 
  61 |              WSGG_W(ielt,j_gas)     = WSGG_W(ielt,j_gas)+               &
  62 |      &       alpha(j_gas,jk_gas+1)*celldata(ielt,1)**jk_gas
  63 | 
  64 |            ENDDO
  65 | 
  66 |            all_k_abs(ielt,j_gas) = k_wsgg(j_gas)*celldata(ielt,3)*      &
  67 |      &     celldata(ielt,2)+WSGG_KSOOT(ielt)/WSGG_W(ielt,j_gas)
  68 | 
  69 |            ALb(ielt,j_gas)   = WSGG_W(ielt,j_gas)*Lb(ielt)
  70 |            ALo(ielt,:,j_gas) = planck(Tf(ielt,:))*WSGG_W(ielt,j_gas)
  71 | 
  72 |          ENDDO
  73 | 
  74 |        ENDDO
  75 | 
  76 |        END SUBROUTINE WSGG_CASE


wsgg_case.F could be called by:
deri_kappa.F [SOURCES/SCHEMES] - 53
Makefile [SEQCODE] - 77
Makefile [SOURCES] - 157
prissma.F [SEQCODE/MAIN] - 239
slave.F [SOURCES/MAIN/SLAVE] - 200