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



   1 | include(dom.inc)
   2 | 
   3 |       SUBROUTINE SNB_CASE(all_k_abs,w,Lb,celldata,ncells,all_WVNB,      &
   4 |      &                    all_DWVNB,KCO,DCO,KC,DC,KH,DH,homosyst,       & 
   5 |      &                    nbands,i_bande,n_SNBmax,nkabs)
   6 | 
   7 |       IMPLICIT NONE
   8 | 
   9 | !     IN
  10 |       DOM_INT                          :: n_SNBmax
  11 |       DOM_INT                          :: nkabs
  12 |       DOM_INT                          :: ncells,nbands
  13 |       CHARACTER*3                      :: homosyst
  14 |       DOM_REAL,DIMENSION(14,n_SNBmax)  :: KCO,DCO,KC,DC,KH,DH
  15 |       DOM_REAL,DIMENSION(n_SNBmax)     :: all_WVNB,all_DWVNB
  16 |       DOM_REAL,DIMENSION(ncells)       :: Lb
  17 |       DOM_REAL,DIMENSION(ncells,8)     :: celldata
  18 | 
  19 | !     OUT
  20 |       DOM_REAL,DIMENSION(nkabs)        :: w
  21 |       DOM_REAL,DIMENSION(ncells,nkabs) :: all_k_abs
  22 | 
  23 | !     LOCAL
  24 |       DOM_REAL,DIMENSION(2,nbands)     :: SNBDATA
  25 |       DOM_REAL,DIMENSION(ncells)       :: WVSOOT
  26 |       DOM_REAL,DIMENSION(nkabs)        :: k_absmel
  27 |       DOM_REAL,DIMENSION(nbands)       :: F
  28 |       DOM_REAL                         :: blae
  29 |       DOM_REAL                         :: WVNB,DWVNB,WVNB_SI,DWVNB_SI
  30 |       DOM_INT                          :: ielt, i
  31 |       DOM_INT                          :: i_bande
  32 |       DOM_INT                          :: ICO,ICO2,IH2O
  33 |       LOGICAL                          :: LICO,LICO2,LIH2O
  34 | 
  35 |       WVNB      = all_WVNB(i_bande)
  36 |       DWVNB     = all_DWVNB(i_bande)
  37 |       WVNB_SI   = 100.*WVNB
  38 |       DWVNB_SI  = 100.*DWVNB 
  39 |       WVSOOT    = WVNB_SI*5.5*celldata(:,8) 
  40 | 
  41 |       all_k_abs = 0.
  42 |       k_absmel  = 0.
  43 |       SNBDATA   = 0.
  44 | 
  45 | !     ----------------------------------------!
  46 | !     Spectral index lecture for each species !
  47 | !     ----------------------------------------!
  48 |    
  49 |       IF (WVNB.le.9300.0) THEN
  50 |         CALL FINDI(LICO,LICO2,LIH2O,ICO,ICO2,IH2O,WVNB,DWVNB)
  51 |       ENDIF
  52 | 
  53 | !     -----------------------!
  54 | !     Non-homogeneous system !
  55 | !     -----------------------!
  56 |       IF (homosyst.eq.'NO') THEN
  57 | 
  58 |         DO ielt=1,ncells
  59 | 
  60 |           IF (WVNB<=9300.0) THEN
  61 | 
  62 |             CALL KBARANDPHI(celldata(ielt,:),LICO,LICO2,LIH2O,ICO,ICO2, &
  63 |      &           IH2O,KCO,KC,KH,DCO,DC,DH,SNBDATA,n_SNBmax)
  64 | 
  65 | !         -----------------------------------------------------!
  66 | !         Band groupment multiplicative factor (=1 for SNB-ck) !
  67 | !         -----------------------------------------------------!
  68 |           DO i = 1, nbands
  69 |             F(i) = 1.
  70 |           ENDDO
  71 |           
  72 |           CALL k_distributeur(F, nbands, SNBDATA, nkabs, k_absmel, w)
  73 | 
  74 |           ENDIF
  75 | 
  76 |           all_k_abs(ielt,:)=k_absmel(:)+WVSOOT(ielt)
  77 | 
  78 |         ENDDO
  79 | 
  80 | !     -------------------!
  81 | !     Homogeneous system !
  82 | !     -------------------!
  83 | 
  84 |       ELSEIF (homosyst.eq.'YES') THEN 
  85 | 
  86 |         IF (WVNB<=9300.0) THEN
  87 |           CALL KBARANDPHI(celldata(1,:),LICO,LICO2,LIH2O,ICO,ICO2,IH2O, &
  88 |      &         KCO,KC,KH,DCO,DC,DH,SNBDATA)
  89 | 
  90 | !         -----------------------------------------------------!
  91 | !         Band groupment multiplicative factor (=1 for SNB-ck) !
  92 | !         -----------------------------------------------------!
  93 |           DO i = 1, nbands
  94 |             F(i) = 1.
  95 |           ENDDO
  96 | 
  97 |           CALL k_distributeur(F, nbands, SNBDATA, nkabs, k_absmel, w)
  98 | 
  99 |         ENDIF
 100 | 
 101 |         DO ielt=1,ncells
 102 |           all_k_abs(ielt,:) = k_absmel(:) + WVSOOT(1)
 103 |         ENDDO
 104 | 
 105 |       ENDIF
 106 | 
 107 |       END SUBROUTINE SNB_CASE
 108 |