tab_case.F [SRC] [CPP] [JOB] [SCAN]
SEQCODE / MODELSOURCES/MODEL [=]
TOOLS/RAY/SRC [=]



   1 | include(dom.inc)
   2 | 
   3 |       SUBROUTINE TAB_CASE(celldata,kabs,wquad,allkabs,DY,nY,DT,nT,nquad,&
   4 |      &                   ntcells)
   5 | 
   6 |       DOM_INT :: nY,nT,nquad,ntcells
   7 |       DOM_REAL:: DY,DT
   8 |       DOM_INT :: iq,icell,i
   9 |       DOM_REAL, DIMENSION(ntcells,8)         :: celldata
  10 |       DOM_INT,  DIMENSION(8,ntcells)         :: bornes
  11 |       DOM_REAL, DIMENSION(nquad,ntcells)     :: kabs
  12 |       DOM_REAL, DIMENSION(nY,nY,nY,nT,nquad) :: allkabs
  13 |       DOM_REAL, DIMENSION(16,ntcells)        :: d
  14 |       DOM_REAL, DIMENSION(ntcells)           :: norm
  15 | 
  16 |       DOM_REAL, PARAMETER                :: x_min=0.0
  17 |       DOM_REAL, PARAMETER                :: x_max=1.0
  18 |       DOM_REAL, dimension(nquad)         :: x_pts,wquad
  19 | 
  20 |       CALL gauleg(x_min,x_max,x_pts,wquad,nquad)
  21 | 
  22 |       bornes(1,:) =   int((celldata(:,1)-400.d0)/DT)+1
  23 |       bornes(3:5,:) = int(celldata(:,3:5)/DY)+1
  24 | 
  25 |       DO icell=1,ntcells
  26 | 
  27 |         IF( modulo(celldata(icell,1)-400.d0,DT).eq.0.) THEN
  28 |           bornes(2,icell) = bornes(1,icell)
  29 |         ELSE
  30 |           bornes(2,icell) = bornes(1,icell)+1
  31 |         ENDIF
  32 | 
  33 |         DO i=0,2
  34 |         IF( modulo(celldata(icell,3+i),DY).eq.0.) THEN
  35 |           bornes(6+i,icell) = bornes(3+i,icell)
  36 |         ELSE
  37 |           bornes(6+i,icell) = bornes(3+i,icell)+1
  38 |         ENDIF
  39 | 
  40 |         ENDDO
  41 | 
  42 |       ENDDO
  43 | 
  44 | !ATTENTION A CELLDATA DANS LE MAUVAIS ORDRE !!!!!
  45 | !     d(1,:) = sqrt(
  46 | !    &(celldata(1,:)-bornes(1,:))**2.d0 +
  47 | !    &(celldata(3,:)-bornes(3,:))**2.d0 +
  48 | !    &(celldata(4,:)-bornes(4,:))**2.d0 +
  49 | !    &(celldata(5,:)-bornes(5,:))**2.d0 )
  50 | !
  51 | !     d(2,:) = sqrt(
  52 | !    &(celldata(1,:)-bornes(2,:))**2.d0 +
  53 | !    &(celldata(3,:)-bornes(3,:))**2.d0 +
  54 | !    &(celldata(4,:)-bornes(4,:))**2.d0 +
  55 | !    &(celldata(5,:)-bornes(5,:))**2.d0 )
  56 | !
  57 | !     d(3,:) = sqrt(
  58 | !    &(celldata(1,:)-bornes(1,:))**2.d0 +
  59 | !    &(celldata(3,:)-bornes(6,:))**2.d0 +
  60 | !    &(celldata(4,:)-bornes(4,:))**2.d0 +
  61 | !    &(celldata(5,:)-bornes(5,:))**2.d0 )
  62 | !
  63 | !     d(4,:) = sqrt(
  64 | !    &(celldata(1,:)-bornes(2,:))**2.d0 +
  65 | !    &(celldata(3,:)-bornes(6,:))**2.d0 +
  66 | !    &(celldata(4,:)-bornes(4,:))**2.d0 +
  67 | !    &(celldata(5,:)-bornes(5,:))**2.d0 )
  68 | !
  69 | !     d(5,:) = sqrt(
  70 | !    &(celldata(1,:)-bornes(1,:))**2.d0 +
  71 | !    &(celldata(3,:)-bornes(3,:))**2.d0 +
  72 | !    &(celldata(4,:)-bornes(7,:))**2.d0 +
  73 | !    &(celldata(5,:)-bornes(5,:))**2.d0 )
  74 | !
  75 | !     d(6,:) = sqrt(
  76 | !    &(celldata(1,:)-bornes(2,:))**2.d0 +
  77 | !    &(celldata(3,:)-bornes(3,:))**2.d0 +
  78 | !    &(celldata(4,:)-bornes(7,:))**2.d0 +
  79 | !    &(celldata(5,:)-bornes(5,:))**2.d0 )
  80 | !
  81 | !     d(7,:) = sqrt(
  82 | !    &(celldata(1,:)-bornes(1,:))**2.d0 +
  83 | !    &(celldata(3,:)-bornes(6,:))**2.d0 +
  84 | !    &(celldata(4,:)-bornes(7,:))**2.d0 +
  85 | !    &(celldata(5,:)-bornes(5,:))**2.d0 )
  86 | !
  87 | !     d(8,:) = sqrt(
  88 | !    &(celldata(1,:)-bornes(2,:))**2.d0 +
  89 | !    &(celldata(3,:)-bornes(6,:))**2.d0 +
  90 | !    &(celldata(4,:)-bornes(7,:))**2.d0 +
  91 | !    &(celldata(5,:)-bornes(5,:))**2.d0 )
  92 | !
  93 | !     d(9,:) = sqrt(
  94 | !    &(celldata(1,:)-bornes(1,:))**2.d0 +
  95 | !    &(celldata(3,:)-bornes(3,:))**2.d0 +
  96 | !    &(celldata(4,:)-bornes(4,:))**2.d0 +
  97 | !    &(celldata(5,:)-bornes(8,:))**2.d0 )
  98 | !
  99 | !     d(10,:) = sqrt(
 100 | !    &(celldata(1,:)-bornes(2,:))**2.d0 +
 101 | !    &(celldata(3,:)-bornes(3,:))**2.d0 +
 102 | !    &(celldata(4,:)-bornes(4,:))**2.d0 +
 103 | !    &(celldata(5,:)-bornes(8,:))**2.d0 )
 104 | !
 105 | !     d(11,:) = sqrt(
 106 | !    &(celldata(1,:)-bornes(1,:))**2.d0 +
 107 | !    &(celldata(3,:)-bornes(6,:))**2.d0 +
 108 | !    &(celldata(4,:)-bornes(4,:))**2.d0 +
 109 | !    &(celldata(5,:)-bornes(8,:))**2.d0 )
 110 | !
 111 | !     d(12,:) = sqrt(
 112 | !    &(celldata(1,:)-bornes(2,:))**2.d0 +
 113 | !    &(celldata(3,:)-bornes(6,:))**2.d0 +
 114 | !    &(celldata(4,:)-bornes(4,:))**2.d0 +
 115 | !    &(celldata(5,:)-bornes(8,:))**2.d0 )
 116 | !
 117 | !     d(13,:) = sqrt(
 118 | !    &(celldata(1,:)-bornes(1,:))**2.d0 +
 119 | !    &(celldata(3,:)-bornes(3,:))**2.d0 +
 120 | !    &(celldata(4,:)-bornes(7,:))**2.d0 +
 121 | !    &(celldata(5,:)-bornes(8,:))**2.d0 )
 122 | !
 123 | !     d(14,:) = sqrt(
 124 | !    &(celldata(1,:)-bornes(2,:))**2.d0 +
 125 | !    &(celldata(3,:)-bornes(3,:))**2.d0 +
 126 | !    &(celldata(4,:)-bornes(7,:))**2.d0 +
 127 | !    &(celldata(5,:)-bornes(8,:))**2.d0 )
 128 | !
 129 | !     d(15,:) = sqrt(
 130 | !    &(celldata(1,:)-bornes(1,:))**2.d0 +
 131 | !    &(celldata(3,:)-bornes(6,:))**2.d0 +
 132 | !    &(celldata(4,:)-bornes(7,:))**2.d0 +
 133 | !    &(celldata(5,:)-bornes(8,:))**2.d0 )
 134 | !
 135 | !     d(16,:) = sqrt(
 136 | !    &(celldata(1,:)-bornes(2,:))**2.d0 +
 137 | !    &(celldata(3,:)-bornes(6,:))**2.d0 +
 138 | !    &(celldata(4,:)-bornes(7,:))**2.d0 +
 139 | !    &(celldata(5,:)-bornes(8,:))**2.d0 )
 140 | !
 141 | !      norm =0
 142 | !      DO i=1,16
 143 | !        norm(:) = norm(:) + 1/d(i,:)
 144 | !      ENDDO
 145 | 
 146 |       d(:,:) = 16.d0
 147 |       norm   = 1.d0
 148 | 
 149 |       DO icell = 1,ntcells
 150 |         DO iq=1,nquad
 151 |           kabs(iq,icell) =
 152 |      &    allkabs(bornes(3,icell),bornes(4,icell),bornes(5,icell),
 153 |      &    bornes(1,icell),iq)/d(1,icell) +
 154 |      &    allkabs(bornes(3,icell),bornes(4,icell),bornes(5,icell),
 155 |      &    bornes(2,icell),iq)/d(2,icell) +
 156 |      &    allkabs(bornes(6,icell),bornes(4,icell),bornes(5,icell),
 157 |      &    bornes(1,icell),iq)/d(3,icell) +
 158 |      &    allkabs(bornes(6,icell),bornes(4,icell),bornes(5,icell),
 159 |      &    bornes(2,icell),iq)/d(4,icell) +
 160 |      &    allkabs(bornes(3,icell),bornes(7,icell),bornes(5,icell),
 161 |      &    bornes(1,icell),iq)/d(5,icell) +
 162 |      &    allkabs(bornes(3,icell),bornes(7,icell),bornes(5,icell),
 163 |      &    bornes(2,icell),iq)/d(6,icell) +
 164 |      &    allkabs(bornes(6,icell),bornes(7,icell),bornes(5,icell),
 165 |      &    bornes(1,icell),iq)/d(7,icell) +
 166 |      &    allkabs(bornes(6,icell),bornes(7,icell),bornes(5,icell),
 167 |      &    bornes(2,icell),iq)/d(8,icell) +
 168 |      &    allkabs(bornes(3,icell),bornes(4,icell),bornes(8,icell),
 169 |      &    bornes(1,icell),iq)/d(9,icell) +
 170 |      &    allkabs(bornes(3,icell),bornes(4,icell),bornes(8,icell),
 171 |      &    bornes(2,icell),iq)/d(10,icell) +
 172 |      &    allkabs(bornes(6,icell),bornes(4,icell),bornes(8,icell),
 173 |      &    bornes(1,icell),iq)/d(11,icell) +
 174 |      &    allkabs(bornes(6,icell),bornes(4,icell),bornes(8,icell),
 175 |      &    bornes(2,icell),iq)/d(12,icell) +
 176 |      &    allkabs(bornes(3,icell),bornes(7,icell),bornes(8,icell),
 177 |      &    bornes(1,icell),iq)/d(13,icell) +
 178 |      &    allkabs(bornes(3,icell),bornes(7,icell),bornes(8,icell),
 179 |      &    bornes(2,icell),iq)/d(14,icell) +
 180 |      &    allkabs(bornes(6,icell),bornes(7,icell),bornes(8,icell),
 181 |      &    bornes(1,icell),iq)/d(15,icell) +
 182 |      &    allkabs(bornes(6,icell),bornes(7,icell),bornes(8,icell),
 183 |      &    bornes(2,icell),iq)/d(16,icell)
 184 |         ENDDO
 185 |         kabs(:,icell) = kabs(:,icell)/norm(icell)
 186 |       ENDDO
 187 | 
 188 |       END SUBROUTINE TAB_CASE