61 CHARACTER(CHRLEN) :: RCSIdentString = &
62 '$RCSfile: RFLU_ModDifferentiationCells.F90,v $ $Revision: 1.12 $'
110 INTEGER,
INTENT(IN) :: ibegvar,iendvar,ibeggrad,iendgrad
111 REAL(RFREAL),
DIMENSION(:,:),
POINTER :: var
112 REAL(RFREAL),
DIMENSION(:,:,:),
POINTER :: grad
113 TYPE(t_region
),
POINTER :: pregion
119 LOGICAL :: icgincludeflag
120 INTEGER :: errorflag,fndir,fndirend,icg,icg2,igrad,isl,ivar,nmembsmax, &
122 REAL(RFREAL),
DIMENSION(:),
ALLOCATABLE :: locs,wts
124 TYPE(t_grid),
POINTER :: pgrid
130 global => pregion%global
133 'RFLU_ModDifferentiationCells.F90' )
136 CALL fprofiler_begins(
"RFLU::ComputeGradCells_1D")
139 IF ( (iendvar - ibegvar) /= (iendgrad - ibeggrad) )
THEN
140 CALL
errorstop(global,err_grad_mismatch,__line__)
147 pgrid => pregion%grid
149 nmembsmax = pgrid%c2csInfo%nCellMembsMax
152 icgincludeflag = .true.
154 SELECT CASE ( pregion%mixtInput%dimens )
162 CALL
errorstop(global,err_reached_default,__line__)
169 ALLOCATE(wts(0:nmembsmax),stat=errorflag)
170 global%error = errorflag
171 IF ( global%error /= err_none )
THEN
172 CALL
errorstop(global,err_allocate,__line__,
'wts')
175 ALLOCATE(locs(0:nmembsmax),stat=errorflag)
176 global%error = errorflag
177 IF ( global%error /= err_none )
THEN
178 CALL
errorstop(global,err_allocate,__line__,
'locs')
189 IF ( icgincludeflag .EQV. .true. )
THEN
190 DO icg = 1,pgrid%nCellsTot
191 DO igrad = ibeggrad,iendgrad
192 grad(xcoord,igrad,icg) = 0.0_rfreal
193 grad(ycoord,igrad,icg) = 0.0_rfreal
194 grad(zcoord,igrad,icg) = 0.0_rfreal
197 DO fndir = xcoord,fndirend
198 nmembs = pgrid%c2cs1D(fndir,icg)%nCellMembs
200 locs(0) = pgrid%cofg(fndir,icg)
203 icg2 = pgrid%c2cs1D(fndir,icg)%cellMembs(isl)
205 locs(isl) = pgrid%cofg(fndir,icg2)
209 pgrid%cofg(fndir,icg),wts(0:nmembs))
213 DO ivar = ibegvar,iendvar
214 grad(fndir,igrad,icg) = wts(0)*var(ivar,icg)
217 icg2 = pgrid%c2cs1D(fndir,icg)%cellMembs(isl)
219 grad(fndir,igrad,icg) = grad(fndir,igrad,icg) &
220 + wts(isl)*var(ivar,icg2)
233 DO icg = 1,pgrid%nCellsTot
234 DO igrad = ibeggrad,iendgrad
235 grad(xcoord,igrad,icg) = 0.0_rfreal
236 grad(ycoord,igrad,icg) = 0.0_rfreal
237 grad(zcoord,igrad,icg) = 0.0_rfreal
240 DO fndir = xcoord,fndirend
241 nmembs = pgrid%c2cs1D(fndir,icg)%nCellMembs
244 icg2 = pgrid%c2cs1D(fndir,icg)%cellMembs(isl)
246 locs(isl) = pgrid%cofg(fndir,icg2)
250 pgrid%cofg(fndir,icg),wts(1:nmembs))
254 DO ivar = ibegvar,iendvar
256 icg2 = pgrid%c2cs1D(fndir,icg)%cellMembs(isl)
258 grad(fndir,igrad,icg) = grad(fndir,igrad,icg) &
259 + wts(isl)*var(ivar,icg2)
272 DEALLOCATE(wts,stat=errorflag)
273 global%error = errorflag
274 IF ( global%error /= err_none )
THEN
275 CALL
errorstop(global,err_deallocate,__line__,
'wts')
278 DEALLOCATE(locs,stat=errorflag)
279 global%error = errorflag
280 IF ( global%error /= err_none )
THEN
281 CALL
errorstop(global,err_deallocate,__line__,
'locs')
289 CALL fprofiler_ends(
"RFLU::ComputeGradCells_1D")
344 INTEGER,
INTENT(IN) :: ibegvar,iendvar,ibeggrad,iendgrad
345 REAL(RFREAL),
DIMENSION(:,:),
POINTER :: var
346 REAL(RFREAL),
DIMENSION(:,:,:),
POINTER :: grad
347 TYPE(t_region
),
POINTER :: pregion
353 INTEGER :: errorflag,icg,icg2,igrad,isl,ivar
354 REAL(RFREAL) :: c11,c12,c22,dvar,
dx,
dy,r11,r12,r22,
term,term1,term2,wx,wy
355 REAL(RFREAL) :: cofg(xcoord:ycoord)
357 TYPE(t_grid),
POINTER :: pgrid
363 global => pregion%global
366 'RFLU_ModDifferentiationCells.F90' )
369 CALL fprofiler_begins(
"RFLU::ComputeGradCells_2D")
372 IF ( (iendvar - ibegvar) /= (iendgrad - ibeggrad) )
THEN
373 CALL
errorstop(global,err_grad_mismatch,__line__)
380 pgrid => pregion%grid
396 DO icg = 1,pgrid%nCellsTot
397 r11 = pgrid%c2cs(icg)%xyzMoms(xyz_mom_11)
398 r12 = pgrid%c2cs(icg)%xyzMoms(xyz_mom_12)
399 r22 = pgrid%c2cs(icg)%xyzMoms(xyz_mom_22)
406 cofg(xcoord) = pgrid%cofg(xcoord,icg)
407 cofg(ycoord) = pgrid%cofg(ycoord,icg)
409 DO igrad = ibeggrad,iendgrad
410 grad(xcoord,igrad,icg) = 0.0_rfreal
411 grad(ycoord,igrad,icg) = 0.0_rfreal
412 grad(zcoord,igrad,icg) = 0.0_rfreal
415 DO isl = 1,pgrid%c2cs(icg)%nCellMembs
416 icg2 = pgrid%c2cs(icg)%cellMembs(isl)
418 dx = pgrid%cofg(xcoord,icg2) - cofg(xcoord)
419 dy = pgrid%cofg(ycoord,icg2) - cofg(ycoord)
426 term1 = c11*c11*(
dx)
427 term2 = c22*c22*(
dy + c12*
dx)
429 wx =
term*(term1 + c12*term2)
434 DO ivar = ibegvar,iendvar
435 dvar = var(ivar,icg2) - var(ivar,icg)
437 grad(xcoord,igrad,icg) = grad(xcoord,igrad,icg) + wx*dvar
438 grad(ycoord,igrad,icg) = grad(ycoord,igrad,icg) + wy*dvar
461 CALL fprofiler_ends(
"RFLU::ComputeGradCells_2D")
516 INTEGER,
INTENT(IN) :: ibegvar,iendvar,ibeggrad,iendgrad
517 REAL(RFREAL),
DIMENSION(:,:),
POINTER :: var
518 REAL(RFREAL),
DIMENSION(:,:,:),
POINTER :: grad
519 TYPE(t_region
),
POINTER :: pregion
525 INTEGER :: errorflag,icg,icg2,igrad,isl,ivar
526 REAL(RFREAL) :: c11,c12,c13,c22,c23,c33,dvar,
dx,
dy,
dz,r11,r12,r13,r22, &
527 r23,r33,
term,term1,term2,term3,wx,wy,wz
528 REAL(RFREAL) :: cofg(xcoord:zcoord)
530 TYPE(t_grid),
POINTER :: pgrid
536 global => pregion%global
539 'RFLU_ModDifferentiationCells.F90' )
542 CALL fprofiler_begins(
"RFLU::ComputeGradCells_3D")
545 IF ( (iendvar - ibegvar) /= (iendgrad - ibeggrad) )
THEN
546 CALL
errorstop(global,err_grad_mismatch,__line__)
553 pgrid => pregion%grid
570 DO icg = 1,pgrid%nCellsTot
571 r11 = pgrid%c2cs(icg)%xyzMoms(xyz_mom_11)
572 r12 = pgrid%c2cs(icg)%xyzMoms(xyz_mom_12)
573 r22 = pgrid%c2cs(icg)%xyzMoms(xyz_mom_22)
574 r13 = pgrid%c2cs(icg)%xyzMoms(xyz_mom_13)
575 r23 = pgrid%c2cs(icg)%xyzMoms(xyz_mom_23)
576 r33 = pgrid%c2cs(icg)%xyzMoms(xyz_mom_33)
583 c13 = -(c11*r13 + c12*c22*r23)
587 cofg(xcoord) = pgrid%cofg(xcoord,icg)
588 cofg(ycoord) = pgrid%cofg(ycoord,icg)
589 cofg(zcoord) = pgrid%cofg(zcoord,icg)
591 DO igrad = ibeggrad,iendgrad
592 grad(xcoord,igrad,icg) = 0.0_rfreal
593 grad(ycoord,igrad,icg) = 0.0_rfreal
594 grad(zcoord,igrad,icg) = 0.0_rfreal
597 DO isl = 1,pgrid%c2cs(icg)%nCellMembs
598 icg2 = pgrid%c2cs(icg)%cellMembs(isl)
600 dx = pgrid%cofg(xcoord,icg2) - cofg(xcoord)
601 dy = pgrid%cofg(ycoord,icg2) - cofg(ycoord)
602 dz = pgrid%cofg(zcoord,icg2) - cofg(zcoord)
610 term1 = c11*c11*(
dx)
611 term2 = c22*c22*(
dy + c12*
dx)
612 term3 = c33*c33*(
dz + c23*
dy + c13*
dx)
614 wx =
term*(term1 + c12*term2 + c13*term3)
615 wy =
term*( term2 + c23*term3)
620 DO ivar = ibegvar,iendvar
621 dvar = var(ivar,icg2) - var(ivar,icg)
623 grad(xcoord,igrad,icg) = grad(xcoord,igrad,icg) + wx*dvar
624 grad(ycoord,igrad,icg) = grad(ycoord,igrad,icg) + wy*dvar
625 grad(zcoord,igrad,icg) = grad(zcoord,igrad,icg) + wz*dvar
650 CALL fprofiler_ends(
"RFLU::ComputeGradCells_3D")
706 INTEGER :: ibegvar,iendvar,ibeggrad,iendgrad
707 REAL(RFREAL),
DIMENSION(:,:),
POINTER :: var
708 REAL(RFREAL),
DIMENSION(:,:,:),
POINTER :: grad
709 TYPE(t_region
),
POINTER :: pregion
715 INTEGER :: endisl,errorflag,icg,icg2,icg3,icg4,igrad,isl,ivar
716 REAL(RFREAL) :: c11,c1111,c12,c22,c2222,dvar,dvar3,dvar4,
dx,dx_icg,
dy, &
717 dy_icg,r11,r12,r22,
term,term1,term2,wtx,wty
719 TYPE(t_grid),
POINTER :: pgrid
725 global => pregion%global
728 'RFLU_ModDifferentiationCells.F90' )
731 CALL fprofiler_begins(
"RFLU::ComputeGradCellsFast_2D")
734 IF ( (iendvar - ibegvar) /= (iendgrad - ibeggrad) )
THEN
735 CALL
errorstop(global,err_grad_mismatch,__line__)
742 pgrid => pregion%grid
758 DO icg = 1,pgrid%nCellsTot
759 r11 = pgrid%c2cs(icg)%xyzMoms(xyz_mom_11)
760 r12 = pgrid%c2cs(icg)%xyzMoms(xyz_mom_12)
761 r22 = pgrid%c2cs(icg)%xyzMoms(xyz_mom_22)
768 endisl = pgrid%c2cs(icg)%nCellMembs
770 DO igrad = ibeggrad,iendgrad
771 grad(xcoord,igrad,icg) = 0.0_rfreal
772 grad(ycoord,igrad,icg) = 0.0_rfreal
773 grad(zcoord,igrad,icg) = 0.0_rfreal
776 icg3 = pgrid%c2cs(icg)%cellMembs(1)
777 icg4 = pgrid%c2cs(icg)%cellMembs(2)
779 dx_icg = pgrid%cofg(xcoord,icg)
780 dy_icg = pgrid%cofg(ycoord,icg)
782 dvar3 = var(ibegvar,icg3) - var(ibegvar,icg)
783 dvar4 = var(ibegvar,icg4) - var(ibegvar,icg)
791 icg4 = pgrid%c2cs(icg)%cellMembs(isl+2)
795 dvar4 = var(ibegvar,icg4) - var(ibegvar,icg)
797 dx = pgrid%cofg(xcoord,icg2) - dx_icg
798 dy = pgrid%cofg(ycoord,icg2) - dy_icg
806 term2 = c2222*(
dy + c12*
dx)
808 wtx =
term*(term1 + c12*term2)
813 grad(xcoord,igrad,icg) = grad(xcoord,igrad,icg) + wtx*dvar
814 grad(ycoord,igrad,icg) = grad(ycoord,igrad,icg) + wty*dvar
818 DO ivar = ibegvar+1,iendvar
819 dvar = var(ivar,icg2) - var(ivar,icg)
821 grad(xcoord,igrad,icg) = grad(xcoord,igrad,icg) + wtx*dvar
822 grad(ycoord,igrad,icg) = grad(ycoord,igrad,icg) + wty*dvar
828 DO isl = endisl-1,endisl
835 dx = pgrid%cofg(xcoord,icg2) - dx_icg
836 dy = pgrid%cofg(ycoord,icg2) - dy_icg
844 term2 = c2222*(
dy + c12*
dx)
846 wtx =
term*(term1 + c12*term2)
851 grad(xcoord,igrad,icg) = grad(xcoord,igrad,icg) + wtx*dvar
852 grad(ycoord,igrad,icg) = grad(ycoord,igrad,icg) + wty*dvar
856 DO ivar = ibegvar+1,iendvar
857 dvar = var(ivar,icg2) - var(ivar,icg)
859 grad(xcoord,igrad,icg) = grad(xcoord,igrad,icg) + wtx*dvar
860 grad(ycoord,igrad,icg) = grad(ycoord,igrad,icg) + wty*dvar
883 CALL fprofiler_ends(
"RFLU::ComputeGradCellsFast_2D")
938 INTEGER :: ibegvar,iendvar,ibeggrad,iendgrad
939 REAL(RFREAL),
DIMENSION(:,:),
POINTER :: var
940 REAL(RFREAL),
DIMENSION(:,:,:),
POINTER :: grad
941 TYPE(t_region
),
POINTER :: pregion
947 INTEGER :: endisl,errorflag,icg,icg2,icg3,icg4,igrad,isl,ivar
948 REAL(RFREAL) :: c11,c1111,c12,c13,c22,c2222,c23,c33,c3333,dvar,dvar3, &
949 dvar4,
dx,dx_icg,
dy,dy_icg,
dz,dz_icg,r11,r12,r13,r22, &
950 r23,r33,
term,term1,term2,term3,wtx,wty,wtz
952 TYPE(t_grid),
POINTER :: pgrid
958 global => pregion%global
961 'RFLU_ModDifferentiationCells.F90' )
964 CALL fprofiler_begins(
"RFLU::ComputeGradCellsFast_3D")
967 IF ( (iendvar - ibegvar) /= (iendgrad - ibeggrad) )
THEN
968 CALL
errorstop(global,err_grad_mismatch,__line__)
975 pgrid => pregion%grid
992 DO icg = 1,pgrid%nCellsTot
993 r11 = pgrid%c2cs(icg)%xyzMoms(xyz_mom_11)
994 r12 = pgrid%c2cs(icg)%xyzMoms(xyz_mom_12)
995 r22 = pgrid%c2cs(icg)%xyzMoms(xyz_mom_22)
996 r13 = pgrid%c2cs(icg)%xyzMoms(xyz_mom_13)
997 r23 = pgrid%c2cs(icg)%xyzMoms(xyz_mom_23)
998 r33 = pgrid%c2cs(icg)%xyzMoms(xyz_mom_33)
1000 c11 = 1.0_rfreal/r11
1001 c22 = 1.0_rfreal/r22
1002 c33 = 1.0_rfreal/r33
1005 c13 = -(c11*r13 + c12*c22*r23)
1009 endisl = pgrid%c2cs(icg)%nCellMembs
1011 DO igrad = ibeggrad,iendgrad
1012 grad(xcoord,igrad,icg) = 0.0_rfreal
1013 grad(ycoord,igrad,icg) = 0.0_rfreal
1014 grad(zcoord,igrad,icg) = 0.0_rfreal
1017 icg3 = pgrid%c2cs(icg)%cellMembs(1)
1018 icg4 = pgrid%c2cs(icg)%cellMembs(2)
1020 dx_icg = pgrid%cofg(xcoord,icg)
1021 dy_icg = pgrid%cofg(ycoord,icg)
1022 dz_icg = pgrid%cofg(zcoord,icg)
1024 dvar3 = var(ibegvar,icg3) - var(ibegvar,icg)
1025 dvar4 = var(ibegvar,icg4) - var(ibegvar,icg)
1034 icg4 = pgrid%c2cs(icg)%cellMembs(isl+2)
1038 dvar4 = var(ibegvar,icg4) - var(ibegvar,icg)
1040 dx = pgrid%cofg(xcoord,icg2) - dx_icg
1041 dy = pgrid%cofg(ycoord,icg2) - dy_icg
1042 dz = pgrid%cofg(zcoord,icg2) - dz_icg
1051 term2 = c2222*(
dy + c12*
dx)
1052 term3 = c3333*(
dz + c23*
dy + c13*
dx)
1054 wtx =
term*(term1 + c12*term2 + c13*term3)
1055 wty =
term*( term2 + c23*term3)
1060 grad(xcoord,igrad,icg) = grad(xcoord,igrad,icg) + wtx*dvar
1061 grad(ycoord,igrad,icg) = grad(ycoord,igrad,icg) + wty*dvar
1062 grad(zcoord,igrad,icg) = grad(zcoord,igrad,icg) + wtz*dvar
1066 DO ivar = ibegvar+1,iendvar
1067 dvar = var(ivar,icg2) - var(ivar,icg)
1069 grad(xcoord,igrad,icg) = grad(xcoord,igrad,icg) + wtx*dvar
1070 grad(ycoord,igrad,icg) = grad(ycoord,igrad,icg) + wty*dvar
1071 grad(zcoord,igrad,icg) = grad(zcoord,igrad,icg) + wtz*dvar
1077 DO isl = endisl-1,endisl
1084 dx = pgrid%cofg(xcoord,icg2) - dx_icg
1085 dy = pgrid%cofg(ycoord,icg2) - dy_icg
1086 dz = pgrid%cofg(zcoord,icg2) - dz_icg
1095 term2 = c2222*(
dy + c12*
dx)
1096 term3 = c3333*(
dz + c23*
dy + c13*
dx)
1098 wtx =
term*(term1 + c12*term2 + c13*term3)
1099 wty =
term*( term2 + c23*term3)
1104 grad(xcoord,igrad,icg) = grad(xcoord,igrad,icg) + wtx*dvar
1105 grad(ycoord,igrad,icg) = grad(ycoord,igrad,icg) + wty*dvar
1106 grad(zcoord,igrad,icg) = grad(zcoord,igrad,icg) + wtz*dvar
1110 DO ivar = ibegvar+1,iendvar
1111 dvar = var(ivar,icg2) - var(ivar,icg)
1113 grad(xcoord,igrad,icg) = grad(xcoord,igrad,icg) + wtx*dvar
1114 grad(ycoord,igrad,icg) = grad(ycoord,igrad,icg) + wty*dvar
1115 grad(zcoord,igrad,icg) = grad(zcoord,igrad,icg) + wtz*dvar
1140 CALL fprofiler_ends(
"RFLU::ComputeGradCellsFast_3D")
1182 iendgrad,varinfo,var,grad)
1196 INTEGER,
INTENT(IN) :: ibegvar,iendvar,ibeggrad,iendgrad
1197 INTEGER,
INTENT(IN) :: varinfo(ibegvar:iendvar)
1198 REAL(RFREAL),
DIMENSION(:,:),
POINTER :: var
1199 REAL(RFREAL),
DIMENSION(:,:,:),
POINTER :: grad
1200 TYPE(t_region
),
POINTER :: pregion
1206 INTEGER :: errorflag,icg,icg2,icl,icol,ifg,ifl,igrad,ipatch,isl,irow,ivar, &
1207 ncols,nconstr,nrows,scount
1208 INTEGER,
DIMENSION(:),
ALLOCATABLE :: constrtype
1209 REAL(RFREAL) :: cwt,dvar,
dx,
dy,
dz,
term,varc,gx,gy,gz
1210 REAL(RFREAL) :: cofg(xcoord:zcoord)
1211 REAL(RFREAL) :: colmax(4)
1212 REAL(RFREAL),
DIMENSION(:,:),
ALLOCATABLE ::
a,
ainv
1214 TYPE(t_grid),
POINTER :: pgrid
1215 TYPE(t_patch),
POINTER :: ppatch
1221 global => pregion%global
1224 'RFLU_ModDifferentiationCells.F90')
1227 CALL fprofiler_begins(
"RFLU::ComputeGradCellsConstr")
1230 IF ( (iendvar - ibegvar) /= (iendgrad - ibeggrad) )
THEN
1231 CALL
errorstop(global,err_grad_mismatch,__line__)
1238 pgrid => pregion%grid
1240 cwt = pregion%mixtInput%cReconstCellsWeight
1246 DO icl = 1,pgrid%nCellsConstr
1247 icg = pgrid%icgConstr(icl)
1253 DO igrad = ibeggrad,iendgrad
1254 grad(xcoord,igrad,icg) = 0.0_rfreal
1255 grad(ycoord,igrad,icg) = 0.0_rfreal
1256 grad(zcoord,igrad,icg) = 0.0_rfreal
1259 cofg(xcoord) = pgrid%cofg(xcoord,icg)
1260 cofg(ycoord) = pgrid%cofg(ycoord,icg)
1261 cofg(zcoord) = pgrid%cofg(zcoord,icg)
1263 ALLOCATE(constrtype(pgrid%c2cs(icg)%nBFaceMembs),stat=errorflag)
1264 global%error = errorflag
1265 IF ( global%error /= err_none )
THEN
1266 CALL
errorstop(global,err_allocate,__line__,
'constrType')
1275 DO ivar = ibegvar,iendvar
1283 DO isl = 1,pgrid%c2cs(icg)%nBFaceMembs
1284 ipatch = pgrid%c2cs(icg)%bFaceMembs(1,isl)
1285 ifl = pgrid%c2cs(icg)%bFaceMembs(2,isl)
1287 ppatch => pregion%patches(ipatch)
1291 IF ( constrtype(isl) == constr_type_dirichlet )
THEN
1292 nconstr = nconstr + 1
1294 constrtype(isl) = constr_type_none
1306 IF ( nconstr > 0 )
THEN
1310 nrows = pgrid%c2cs(icg)%nCellMembs + nconstr
1311 ncols = pregion%mixtInput%dimens
1313 ALLOCATE(
a(nrows,ncols),stat=errorflag)
1314 global%error = errorflag
1315 IF ( global%error /= err_none )
THEN
1316 CALL
errorstop(global,err_allocate,__line__,
'a')
1319 ALLOCATE(
ainv(ncols,nrows),stat=errorflag)
1320 global%error = errorflag
1321 IF ( global%error /= err_none )
THEN
1322 CALL
errorstop(global,err_allocate,__line__,
'aInv')
1327 SELECT CASE ( pregion%mixtInput%dimens )
1332 DO isl = 1,pgrid%c2cs(icg)%nCellMembs
1333 icg2 = pgrid%c2cs(icg)%cellMembs(isl)
1335 dx = pgrid%cofg(xcoord,icg2) - cofg(xcoord)
1336 dy = pgrid%cofg(ycoord,icg2) - cofg(ycoord)
1344 irow = pgrid%c2cs(icg)%nCellMembs
1346 DO isl = 1,pgrid%c2cs(icg)%nBFaceMembs
1347 IF ( constrtype(isl) == constr_type_dirichlet )
THEN
1348 ipatch = pgrid%c2cs(icg)%bFaceMembs(1,isl)
1349 ifl = pgrid%c2cs(icg)%bFaceMembs(2,isl)
1351 ppatch => pregion%patches(ipatch)
1353 dx = ppatch%fc(xcoord,ifl) - cofg(xcoord)
1354 dy = ppatch%fc(ycoord,ifl) - cofg(ycoord)
1368 DO isl = 1,pgrid%c2cs(icg)%nCellMembs
1369 icg2 = pgrid%c2cs(icg)%cellMembs(isl)
1371 dx = pgrid%cofg(xcoord,icg2) - cofg(xcoord)
1372 dy = pgrid%cofg(ycoord,icg2) - cofg(ycoord)
1373 dz = pgrid%cofg(zcoord,icg2) - cofg(zcoord)
1382 irow = pgrid%c2cs(icg)%nCellMembs
1384 DO isl = 1,pgrid%c2cs(icg)%nBFaceMembs
1385 IF ( constrtype(isl) == constr_type_dirichlet )
THEN
1386 ipatch = pgrid%c2cs(icg)%bFaceMembs(1,isl)
1387 ifl = pgrid%c2cs(icg)%bFaceMembs(2,isl)
1389 ppatch => pregion%patches(ipatch)
1391 dx = ppatch%fc(xcoord,ifl) - cofg(xcoord)
1392 dy = ppatch%fc(ycoord,ifl) - cofg(ycoord)
1393 dz = ppatch%fc(zcoord,ifl) - cofg(zcoord)
1405 CALL
errorstop(global,err_reached_default,__line__)
1411 colmax(icol) = -huge(1.0_rfreal)
1414 colmax(icol) =
max(colmax(icol),abs(
a(irow,icol)))
1418 a(irow,icol) =
a(irow,icol)/colmax(icol)
1426 ainv(icol,irow) =
ainv(icol,irow)/colmax(icol)
1431 IF ( scount /= 0 )
THEN
1432 WRITE(*,*)
'ERROR - Singular matrix in RFLU_ComputeGradCellsConstr!'
1439 SELECT CASE ( pregion%mixtInput%dimens )
1447 DO isl = 1,pgrid%c2cs(icg)%nCellMembs
1448 icg2 = pgrid%c2cs(icg)%cellMembs(isl)
1450 dx = pgrid%cofg(xcoord,icg2) - cofg(xcoord)
1451 dy = pgrid%cofg(ycoord,icg2) - cofg(ycoord)
1455 dvar = var(ivar,icg2) - var(ivar,icg)
1461 irow = pgrid%c2cs(icg)%nCellMembs
1463 DO isl = 1,pgrid%c2cs(icg)%nBFaceMembs
1464 IF ( constrtype(isl) == constr_type_dirichlet )
THEN
1465 ipatch = pgrid%c2cs(icg)%bFaceMembs(1,isl)
1466 ifl = pgrid%c2cs(icg)%bFaceMembs(2,isl)
1468 ppatch => pregion%patches(ipatch)
1470 dx = ppatch%fc(xcoord,ifl) - cofg(xcoord)
1471 dy = ppatch%fc(ycoord,ifl) - cofg(ycoord)
1476 dvar = varc - var(ivar,icg)
1485 grad(xcoord,igrad,icg) = gx
1486 grad(ycoord,igrad,icg) = gy
1487 grad(zcoord,igrad,icg) = 0.0_rfreal
1496 DO isl = 1,pgrid%c2cs(icg)%nCellMembs
1497 icg2 = pgrid%c2cs(icg)%cellMembs(isl)
1499 dx = pgrid%cofg(xcoord,icg2) - cofg(xcoord)
1500 dy = pgrid%cofg(ycoord,icg2) - cofg(ycoord)
1501 dz = pgrid%cofg(zcoord,icg2) - cofg(zcoord)
1505 dvar = var(ivar,icg2) - var(ivar,icg)
1512 irow = pgrid%c2cs(icg)%nCellMembs
1514 DO isl = 1,pgrid%c2cs(icg)%nBFaceMembs
1515 IF ( constrtype(isl) == constr_type_dirichlet )
THEN
1516 ipatch = pgrid%c2cs(icg)%bFaceMembs(1,isl)
1517 ifl = pgrid%c2cs(icg)%bFaceMembs(2,isl)
1519 ppatch => pregion%patches(ipatch)
1521 dx = ppatch%fc(xcoord,ifl) - cofg(xcoord)
1522 dy = ppatch%fc(ycoord,ifl) - cofg(ycoord)
1523 dz = ppatch%fc(zcoord,ifl) - cofg(zcoord)
1528 dvar = varc - var(ivar,icg)
1538 grad(xcoord,igrad,icg) = gx
1539 grad(ycoord,igrad,icg) = gy
1540 grad(zcoord,igrad,icg) = gz
1542 CALL
errorstop(global,err_reached_default,__line__)
1547 DEALLOCATE(
a,stat=errorflag)
1548 global%error = errorflag
1549 IF ( global%error /= err_none )
THEN
1550 CALL
errorstop(global,err_deallocate,__line__,
'a')
1553 DEALLOCATE(
ainv,stat=errorflag)
1554 global%error = errorflag
1555 IF ( global%error /= err_none )
THEN
1556 CALL
errorstop(global,err_deallocate,__line__,
'aInv')
1563 DEALLOCATE(constrtype,stat=errorflag)
1564 global%error = errorflag
1565 IF ( global%error /= err_none )
THEN
1566 CALL
errorstop(global,err_deallocate,__line__,
'constrType')
1575 CALL fprofiler_ends(
"RFLU::ComputeGradCellsConstr")
1613 iendgrad,varinfo,var,grad)
1625 INTEGER,
INTENT(IN) :: ibegvar,iendvar,ibeggrad,iendgrad
1626 INTEGER,
INTENT(IN) :: varinfo(ibegvar:iendvar)
1627 REAL(RFREAL),
DIMENSION(:,:),
POINTER :: var
1628 REAL(RFREAL),
DIMENSION(:,:,:),
POINTER :: grad
1629 TYPE(t_region
),
POINTER :: pregion
1636 TYPE(t_grid),
POINTER :: pgrid
1642 global => pregion%global
1645 'RFLU_ModDifferentiationCells.F90' )
1651 SELECT CASE ( pregion%mixtInput%stencilDimensCells )
1661 IF ( pregion%grid%nCellsConstr > 0 )
THEN
1663 iendgrad,varinfo,var,grad)
1671 IF ( pregion%grid%nCellsConstr > 0 )
THEN
1673 iendgrad,varinfo,var,grad)
1676 CALL
errorstop(global,err_reached_default,__line__)
subroutine, public rflu_computewtsx2c_1d(global, m, nMembs, x, z, w)
subroutine rflu_computegradcellsfast_3d(pRegion, iBegVar, iEndVar, iBegGrad, iEndGrad, var, grad)
Vector_n max(const Array_n_const &v1, const Array_n_const &v2)
subroutine ainv(ajac, ajacin, det, ndim)
Size order() const
Degree of the element. 1 for linear and 2 for quadratic.
subroutine rflu_invertmatrixsvd(global, nRows, nCols, a, aInv, sCount)
subroutine registerfunction(global, funName, fileName)
subroutine rflu_computegradcells_3d(pRegion, iBegVar, iEndVar, iBegGrad, iEndGrad, var, grad)
subroutine rflu_computegradcells_1d(pRegion, iBegVar, iEndVar, iBegGrad, iEndGrad, var, grad)
subroutine rflu_computegradcells_2d(pRegion, iBegVar, iEndVar, iBegGrad, iEndGrad, var, grad)
INTEGER function, public rflu_getconstrtype(pRegion, pPatch, var, ifl)
subroutine rflu_computegradcellsconstr(pRegion, iBegVar, iEndVar, iBegGrad, iEndGrad, varInfo, var, grad)
real(rfreal) function, public rflu_getconstrvalue(pRegion, pPatch, var, ifl)
subroutine, public rflu_computegradcellswrapper(pRegion, iBegVar, iEndVar, iBegGrad, iEndGrad, varInfo, var, grad)
subroutine errorstop(global, errorCode, errorLine, addMessage)
subroutine deregisterfunction(global)
subroutine rflu_computegradcellsfast_2d(pRegion, iBegVar, iEndVar, iBegGrad, iEndGrad, var, grad)