<p><b>duda</b> 2010-10-13 14:25:17 -0600 (Wed, 13 Oct 2010)</p><p>BRANCH COMMIT<br>
<br>
Bring atmos_physics branch up-to-date with respect to atmos_nonhydrostatic branch.<br>
<br>
<br>
A namelist.input.nhyd_atmos_squall<br>
M graphics/matlab/MapDataToDx.m<br>
M graphics/matlab/MapGridToDx.m<br>
A graphics/ncl/cells_hex.ncl<br>
A graphics/ncl/cells_nhyd_sphere.ncl<br>
A graphics/ncl/cells_nhyd_sph1.ncl<br>
A graphics/ncl/xz_plane.ncl<br>
M namelist.input.hyd_atmos<br>
M namelist.input.sw<br>
M src/core_hyd_atmos/mpas_interface.F<br>
M src/core_hyd_atmos/module_advection.F<br>
M src/core_hyd_atmos/module_test_cases.F<br>
M src/core_hyd_atmos/Registry<br>
M src/core_hyd_atmos/module_time_integration.F<br>
M src/core_sw/module_global_diagnostics.F<br>
M src/core_sw/mpas_interface.F<br>
M src/core_sw/module_test_cases.F<br>
M src/core_sw/Registry<br>
M src/core_sw/module_time_integration.F<br>
M src/registry/registry_types.h<br>
M src/registry/gen_inc.c<br>
M src/registry/gen_inc.h<br>
M src/registry/parse.c<br>
M src/core_physics/module_driver_microphysics.F<br>
M src/core_physics/module_physics_driver.F<br>
M src/core_physics/module_physics_init.F<br>
M src/core_physics/module_physics_interface_hyd.F<br>
M src/core_physics/module_physics_sfclayer.F<br>
M src/core_physics/module_physics_manager.F<br>
M src/core_physics/module_physics_todynamics.F<br>
M src/core_physics/module_pbl.F<br>
M src/core_physics/module_driver_convection_deep.F<br>
M src/core_physics/module_physics_control.F<br>
M src/core_physics/module_physics_interface_nhyd.F<br>
M src/driver/module_subdriver.F<br>
M src/core_nhyd_atmos/mpas_interface.F<br>
M src/core_nhyd_atmos/module_advection.F<br>
M src/core_nhyd_atmos/module_test_cases.F<br>
M src/core_nhyd_atmos/Registry<br>
M src/core_nhyd_atmos/module_time_integration.F<br>
M src/core_ocean/module_global_diagnostics.F<br>
M src/core_ocean/mpas_interface.F<br>
M src/core_ocean/module_test_cases.F<br>
M src/core_ocean/Registry<br>
M src/core_ocean/module_time_integration.F<br>
M src/framework/module_io_input.F<br>
M src/framework/module_io_output.F<br>
M src/framework/module_grid_types.F<br>
M src/operators/module_RBF_interpolation.F<br>
M src/operators/module_vector_reconstruction.F<br>
M Makefile<br>
M namelist.input.ocean<br>
A namelist.input.nhyd_atmos_mtn_wave<br>
A namelist.input.nhyd_atmos_jw<br>
A namelist.input.nhyd_atmos<br>
</p><hr noshade><pre><font color="gray">Modified: branches/atmos_physics/Makefile
===================================================================
--- branches/atmos_physics/Makefile 2010-10-13 18:01:28 UTC (rev 548)
+++ branches/atmos_physics/Makefile 2010-10-13 20:25:17 UTC (rev 549)
@@ -1,18 +1,10 @@
#MODEL_FORMULATION = -DNCAR_FORMULATION
MODEL_FORMULATION = -DLANL_FORMULATION
-ifeq ($(CORE),hyd_atmos)
-EXPAND_LEVELS = -DEXPAND_LEVELS=26
-endif
-
-ifeq ($(CORE),nhyd_atmos)
-EXPAND_LEVELS = -DEXPAND_LEVELS=26
-endif
-
FILE_OFFSET = -DOFFSET64BIT
-PHYSICS = -DDO_PHYSICS
-#PHYSICS =
+#PHYSICS = -DDO_PHYSICS
+PHYSICS =
#########################
# Section for Zoltan TPL
@@ -41,7 +33,7 @@
"CFLAGS = -g" \
"LDFLAGS = -g -C" \
"CORE = $(CORE)" \
- "CPPFLAGS = -DRKIND=8 $(MODEL_FORMULATION) $(EXPAND_LEVELS) -D_MPI $(PHYSICS) $(FILE_OFFSET) $(ZOLTAN_DEFINE)" )
+ "CPPFLAGS = -DRKIND=8 $(MODEL_FORMULATION) -D_MPI $(PHYSICS) $(FILE_OFFSET) $(ZOLTAN_DEFINE)" )
ftn:
( make all \
@@ -53,7 +45,7 @@
"CFLAGS = -fast" \
"LDFLAGS = " \
"CORE = $(CORE)" \
- "CPPFLAGS = -DRKIND=8 $(MODEL_FORMULATION) $(EXPAND_LEVELS) -D_MPI -DUNDERSCORE $(PHYSICS) $(FILE_OFFSET) $(ZOLTAN_DEFINE)" )
+ "CPPFLAGS = -DRKIND=8 $(MODEL_FORMULATION) -D_MPI -DUNDERSCORE $(PHYSICS) $(FILE_OFFSET) $(ZOLTAN_DEFINE)" )
pgi:
( make all \
@@ -65,7 +57,7 @@
"CFLAGS = -O3" \
"LDFLAGS = -O3" \
"CORE = $(CORE)" \
- "CPPFLAGS = -DRKIND=8 $(MODEL_FORMULATION) $(EXPAND_LEVELS) -D_MPI -DUNDERSCORE $(PHYSICS) $(FILE_OFFSET) $(ZOLTAN_DEFINE)" )
+ "CPPFLAGS = -DRKIND=8 $(MODEL_FORMULATION) -D_MPI -DUNDERSCORE $(PHYSICS) $(FILE_OFFSET) $(ZOLTAN_DEFINE)" )
pgi-llnl:
( make all \
@@ -77,7 +69,7 @@
"CFLAGS = -fast" \
"LDFLAGS = " \
"CORE = $(CORE)" \
- "CPPFLAGS = -DRKIND=8 $(MODEL_FORMULATION) $(EXPAND_LEVELS) -D_MPI -DUNDERSCORE $(PHYSICS) $(FILE_OFFSET) $(ZOLTAN_DEFINE)" )
+ "CPPFLAGS = -DRKIND=8 $(MODEL_FORMULATION) -D_MPI -DUNDERSCORE $(PHYSICS) $(FILE_OFFSET) $(ZOLTAN_DEFINE)" )
pgi-serial:
( make all \
@@ -89,7 +81,7 @@
"CFLAGS = -O0 -g" \
"LDFLAGS = -O0 -g -Mbounds -Mchkptr" \
"CORE = $(CORE)" \
- "CPPFLAGS = -DRKIND=8 $(MODEL_FORMULATION) $(EXPAND_LEVELS) -DUNDERSCORE $(PHYSICS) $(FILE_OFFSET) $(ZOLTAN_DEFINE)" )
+ "CPPFLAGS = -DRKIND=8 $(MODEL_FORMULATION) -DUNDERSCORE $(PHYSICS) $(FILE_OFFSET) $(ZOLTAN_DEFINE)" )
ifort:
( make all \
@@ -101,7 +93,7 @@
"CFLAGS = -O3 -m64" \
"LDFLAGS = -O3" \
"CORE = $(CORE)" \
- "CPPFLAGS = -DRKIND=8 $(MODEL_FORMULATION) $(EXPAND_LEVELS) -D_MPI -DUNDERSCORE $(PHYSICS) -m64 $(FILE_OFFSET) $(ZOLTAN_DEFINE)" )
+ "CPPFLAGS = -DRKIND=8 $(MODEL_FORMULATION) -D_MPI -DUNDERSCORE $(PHYSICS) -m64 $(FILE_OFFSET) $(ZOLTAN_DEFINE)" )
gfortran:
( make all \
@@ -113,7 +105,7 @@
"CFLAGS = -O3 -m64" \
"LDFLAGS = -O3 -m64" \
"CORE = $(CORE)" \
- "CPPFLAGS = -DRKIND=8 $(MODEL_FORMULATION) $(EXPAND_LEVELS) -D_MPI -DUNDERSCORE $(PHYSICS) -m64 $(FILE_OFFSET) $(ZOLTAN_DEFINE)" )
+ "CPPFLAGS = -DRKIND=8 $(MODEL_FORMULATION) -D_MPI -DUNDERSCORE $(PHYSICS) -m64 $(FILE_OFFSET) $(ZOLTAN_DEFINE)" )
g95:
( make all \
@@ -125,7 +117,7 @@
"CFLAGS = -O3" \
"LDFLAGS = -O3" \
"CORE = $(CORE)" \
- "CPPFLAGS = -DRKIND=8 $(MODEL_FORMULATION) $(EXPAND_LEVELS) -D_MPI -DUNDERSCORE $(PHYSICS) $(FILE_OFFSET) $(ZOLTAN_DEFINE)" )
+ "CPPFLAGS = -DRKIND=8 $(MODEL_FORMULATION) -D_MPI -DUNDERSCORE $(PHYSICS) $(FILE_OFFSET) $(ZOLTAN_DEFINE)" )
g95-serial:
( make all \
@@ -137,7 +129,7 @@
"CFLAGS = -O3" \
"LDFLAGS = -O3" \
"CORE = $(CORE)" \
- "CPPFLAGS = -DRKIND=8 $(MODEL_FORMULATION) $(EXPAND_LEVELS) -DUNDERSCORE $(PHYSICS) $(FILE_OFFSET) $(ZOLTAN_DEFINE)" )
+ "CPPFLAGS = -DRKIND=8 $(MODEL_FORMULATION) -DUNDERSCORE $(PHYSICS) $(FILE_OFFSET) $(ZOLTAN_DEFINE)" )
CPPINCLUDES = -I../inc -I$(NETCDF)/include
Modified: branches/atmos_physics/graphics/matlab/MapDataToDx.m
===================================================================
--- branches/atmos_physics/graphics/matlab/MapDataToDx.m 2010-10-13 18:01:28 UTC (rev 548)
+++ branches/atmos_physics/graphics/matlab/MapDataToDx.m 2010-10-13 20:25:17 UTC (rev 549)
@@ -6,53 +6,46 @@
eps = 1.0e-12
-ncid = netcdf.open('../output.nc','nc_nowrite')
+ncid = netcdf.open('output.nc','nc_nowrite')
-doThickness = 1;
-doKE = 1;
-doVorticity = 1;
+doThickness = 0;
+doKE = 0;
+doVorticity = 0;
doVelocity = 1;
+%%%%%
+% CHECK THAT THE DIMENSION ORDER (AND NUMBER) AGREES WITH OUR OUTPUT.NC
+%%%%%
+
+[TimeName, TimeLength] = netcdf.inqDim(ncid,0);
[nCellsName, nCellsLength] = netcdf.inqDim(ncid,1);
[nEdgesName, nEdgesLength] = netcdf.inqDim(ncid,2);
[nVerticesName, nVerticesLength] = netcdf.inqDim(ncid,5);
-[nVertLevelsName, nVertLevelsLength] = netcdf.inqDim(ncid,8);
-[nTracersName, nTracersLength] = netcdf.inqDim(ncid,9);
-[TimeName, TimeLength] = netcdf.inqDim(ncid,0);
+[nVertLevelsName, nVertLevelsLength] = netcdf.inqDim(ncid,9);
+[nTracersName, nTracersLength] = netcdf.inqDim(ncid,10);
+TimeLength
+nCellsLength
+nEdgesLength
+nVerticesLength
+nVertLevelsLength
+nTracersLength
+
+
+if (doThickness == 1)
+
thicknessID = netcdf.inqVarID(ncid,'h');
work = netcdf.getVar(ncid,thicknessID);
[thicknessName,xtype,dimids,natts] = netcdf.inqVar(ncid,thicknessID);
thickness=work;
-keID = netcdf.inqVarID(ncid,'ke');
-work = netcdf.getVar(ncid,keID);
-[keName,xtype,dimids,natts] = netcdf.inqVar(ncid,keID);
-ke=work;
-
-vorticityID = netcdf.inqVarID(ncid,'vorticity');
-work = netcdf.getVar(ncid,vorticityID);
-[vorticityName,xtype,dimids,natts] = netcdf.inqVar(ncid,vorticityID);
-vorticity=work;
-
-uID = netcdf.inqVarID(ncid,'u');
-work = netcdf.getVar(ncid,uID);
-[uName,xtype,dimids,natts] = netcdf.inqVar(ncid,uID);
-u=work;
-
-vID = netcdf.inqVarID(ncid,'v');
-work = netcdf.getVar(ncid,vID);
-[vName,xtype,dimids,natts] = netcdf.inqVar(ncid,vID);
-v=work;
-
-
-if (doThickness == 1)
-system('rm -f ../dx/h.*.*.data')
+system('rm -f ./dx/h.*.*.data')
for iLevel=1:nVertLevelsLength
for iTime=0:TimeLength-1
- stringTime = int2str(iTime)
- stringVert = int2str(iLevel)
- FileName = strcat('../dx/', thicknessName, '.', ...
+ iTime
+ stringTime = int2str(iTime);
+ stringVert = int2str(iLevel);
+ FileName = strcat('./dx/', thicknessName, '.', ...
stringVert, '.', stringTime, '.', 'data')
for iCell=1:nCellsLength
data = thickness(iLevel,iCell,iTime+1);
@@ -65,12 +58,18 @@
end
if (doKE == 1)
-system('rm -f ../dx/ke.*.*.data')
+
+keID = netcdf.inqVarID(ncid,'ke');
+work = netcdf.getVar(ncid,keID);
+[keName,xtype,dimids,natts] = netcdf.inqVar(ncid,keID);
+ke=work;
+
+system('rm -f ./dx/ke.*.*.data')
for iLevel=1:nVertLevelsLength
for iTime=0:TimeLength-1
- stringTime = int2str(iTime)
- stringVert = int2str(iLevel)
- FileName = strcat('../dx/', keName, '.', ...
+ stringTime = int2str(iTime);
+ stringVert = int2str(iLevel);
+ FileName = strcat('./dx/', keName, '.', ...
stringVert, '.', stringTime, '.', 'data')
for iCell=1:nCellsLength
data = ke(iLevel,iCell,iTime+1);
@@ -83,12 +82,18 @@
end
if (doVorticity == 1)
-system('rm -f ../dx/vorticity.*.*.data')
+
+vorticityID = netcdf.inqVarID(ncid,'vorticity');
+work = netcdf.getVar(ncid,vorticityID);
+[vorticityName,xtype,dimids,natts] = netcdf.inqVar(ncid,vorticityID);
+vorticity=work;
+
+system('rm -f ./dx/vorticity.*.*.data')
for iLevel=1:nVertLevelsLength
for iTime=0:TimeLength-1
- stringTime = int2str(iTime)
- stringVert = int2str(iLevel)
- FileName = strcat('../dx/', vorticityName, '.', ...
+ stringTime = int2str(iTime);
+ stringVert = int2str(iLevel);
+ FileName = strcat('./dx/', vorticityName, '.', ...
stringVert, '.', stringTime, '.', 'data')
for iVertex=1:nVerticesLength
data = vorticity(iLevel,iVertex,iTime+1);
@@ -101,39 +106,40 @@
end
if (doVelocity == 1)
-system('rm -f ../dx/u.*.*.data')
-for iLevel=1:nVertLevelsLength
-for iTime=0:TimeLength-1
- stringTime = int2str(iTime)
- stringVert = int2str(iLevel)
- FileName = strcat('../dx/', uName, '.', ...
- stringVert, '.', stringTime, '.', 'data')
- for iEdge=1:nEdgesLength
- data = u(iLevel,iEdge,iTime+1);
- if abs(data) < eps, data=0;, end;
- dlmwrite(FileName, data, ...
- 'precision', '%18.10e', '-append')
- end
-end
-end
-end
-if (doVelocity == 1)
-system('rm -f ../dx/v.*.*.data')
+uID = netcdf.inqVarID(ncid,'uReconstructX');
+work = netcdf.getVar(ncid,uID);
+[uName,xtype,dimids,natts] = netcdf.inqVar(ncid,uID);
+u=work;
+
+vID = netcdf.inqVarID(ncid,'uReconstructY');
+work = netcdf.getVar(ncid,vID);
+[vName,xtype,dimids,natts] = netcdf.inqVar(ncid,vID);
+v=work;
+
+wID = netcdf.inqVarID(ncid,'uReconstructZ');
+work = netcdf.getVar(ncid,wID);
+[wName,xtype,dimids,natts] = netcdf.inqVar(ncid,wID);
+w=work;
+
+system('rm -f ./dx/velocity.*.*.data')
for iLevel=1:nVertLevelsLength
for iTime=0:TimeLength-1
- stringTime = int2str(iTime)
- stringVert = int2str(iLevel)
- FileName = strcat('../dx/', vName, '.', ...
+ stringTime = int2str(iTime);
+ stringVert = int2str(iLevel);
+ FileName = strcat('./dx/', 'velocity', '.', ...
stringVert, '.', stringTime, '.', 'data')
- for iEdge=1:nEdgesLength
- data = v(iLevel,iEdge,iTime+1);
- if abs(data) < eps, data=0;, end;
- dlmwrite(FileName, data, ...
+ for iCell=1:nCellsLength
+ r(1) = u(iLevel,iCell,iTime+1);
+ r(2) = v(iLevel,iCell,iTime+1);
+ r(3) = w(iLevel,iCell,iTime+1);
+ dlmwrite(FileName, r(1), ...
'precision', '%18.10e', '-append')
+ dlmwrite(FileName, r(2), ...
+ 'precision', '%18.10e', '-append')
+ dlmwrite(FileName, r(3), ...
+ 'precision', '%18.10e', '-append')
end
end
end
-end
-
-
+end
\ No newline at end of file
Modified: branches/atmos_physics/graphics/matlab/MapGridToDx.m
===================================================================
--- branches/atmos_physics/graphics/matlab/MapGridToDx.m 2010-10-13 18:01:28 UTC (rev 548)
+++ branches/atmos_physics/graphics/matlab/MapGridToDx.m 2010-10-13 20:25:17 UTC (rev 549)
@@ -6,18 +6,18 @@
clear all
% begin periodic parameters
-doPeriodic = 1
-dc = 1000.0
-nx = 200
-ny = 200
+doPeriodic = 0;
+dc = 1000.0;
+nx = 200;
+ny = 200;
% end periodic parameters
doWrite = 1
-doVor = 0
-doTri = 0
-doEdge = 1
+doVor = 1
+doTri = 1
+doVector = 1
-ncid = netcdf.open('../grid.nc','nc_nowrite');
+ncid = netcdf.open('grid.nc','nc_nowrite');
if (doVor == 1)
@@ -47,19 +47,19 @@
nCells=work(1)
if (doWrite == 1)
- system('rm -f ../dx/vor.position.data');
- system('rm -f ../dx/vor.edge.data');
- system('rm -f ../dx/vor.loop.data');
- system('rm -f ../dx/vor.face.data');
- system('rm -f ../dx/vor.area.data');
+ system('rm -f ./dx/vor.position.data');
+ system('rm -f ./dx/vor.edge.data');
+ system('rm -f ./dx/vor.loop.data');
+ system('rm -f ./dx/vor.face.data');
+ system('rm -f ./dx/vor.area.data');
iloop=0;
iedge=0;
for i=1:nCells
- dlmwrite('../dx/vor.face.data', i-1, '-append');
- dlmwrite('../dx/vor.area.data', areaCell(i), ...
+ dlmwrite('./dx/vor.face.data', i-1, '-append');
+ dlmwrite('./dx/vor.area.data', areaCell(i), ...
'precision', '%18.10e', '-append');
- dlmwrite('../dx/vor.loop.data', iloop, ...
+ dlmwrite('./dx/vor.loop.data', iloop, ...
'precision', '%10i', '-append');
edge(1:nEdgesOnCell(i)) = iedge;
@@ -85,11 +85,11 @@
end;
for j=1:nEdgesOnCell(i)
- dlmwrite('../dx/vor.position.data', x(:,j), 'delimiter', '\t', ...
+ dlmwrite('./dx/vor.position.data', x(:,j), 'delimiter', '\t', ...
'precision', '%18.10e', '-append');
edge(j) = iedge + j - 1;
end;
- dlmwrite('../dx/vor.edge.data', edge(1:nEdgesOnCell(i)), ...
+ dlmwrite('./dx/vor.edge.data', edge(1:nEdgesOnCell(i)), ...
'delimiter', '\t', 'precision', '%10i', '-append')
iloop = iloop + nEdgesOnCell(i);
iedge = iedge + nEdgesOnCell(i);
@@ -126,19 +126,19 @@
nVertices = work(:,2)
if (doWrite == 1)
- system('rm -f ../dx/tri.position.data');
- system('rm -f ../dx/tri.edge.data');
- system('rm -f ../dx/tri.loop.data');
- system('rm -f ../dx/tri.face.data');
- system('rm -f ../dx/tri.area.data');
+ system('rm -f ./dx/tri.position.data');
+ system('rm -f ./dx/tri.edge.data');
+ system('rm -f ./dx/tri.loop.data');
+ system('rm -f ./dx/tri.face.data');
+ system('rm -f ./dx/tri.area.data');
iloop=0;
iedge=0;
for i=1:nVertices
- dlmwrite('../dx/tri.face.data', i-1, '-append');
- dlmwrite('../dx/tri.area.data', areaTriangle(i), ...
+ dlmwrite('./dx/tri.face.data', i-1, '-append');
+ dlmwrite('./dx/tri.area.data', areaTriangle(i), ...
'precision', '%18.10e', '-append');
- dlmwrite('../dx/tri.loop.data', iloop, ...
+ dlmwrite('./dx/tri.loop.data', iloop, ...
'precision', '%10i', '-append');
edge(1:3) = iedge;
for j=1:nCellsOnVertex
@@ -163,11 +163,11 @@
end;
for j=1:nCellsOnVertex;
- dlmwrite('../dx/tri.position.data', x(:,j), 'delimiter', '\t', ...
+ dlmwrite('./dx/tri.position.data', x(:,j), 'delimiter', '\t', ...
'precision', '%18.10e', '-append')
edge(j) = iedge + j - 1;
end;
- dlmwrite('../dx/tri.edge.data', edge(1:3), ...
+ dlmwrite('./dx/tri.edge.data', edge(1:3), ...
'delimiter', '\t', 'precision', '%10i', '-append')
iloop = iloop + 3;
iedge = iedge + 3;
@@ -177,26 +177,17 @@
end;
-if (doEdge == 1)
+if (doVector == 1)
if (doWrite == 1)
- system('rm -f ../dx/edge.position.data');
- system('rm -f ../dx/normal.data');
- system('rm -f ../dx/tangent.data');
+ system('rm -f ./dx/vector.position.data');
+ system('rm -f ./dx/vector.data');
end;
- [nEdgesName, nEdgesLength] = netcdf.inqDim(ncid,1);
- xE_id = netcdf.inqVarID(ncid,'xEdge');
- yE_id = netcdf.inqVarID(ncid,'yEdge');
- zE_id = netcdf.inqVarID(ncid,'zEdge');
- nCellsOnEdge = 2;
- nEdges = nEdgesLength;
- cellsOnEdge_id = netcdf.inqVarID(ncid, 'cellsOnEdge');
-
- xE=netcdf.getVar(ncid, xE_id);
- yE=netcdf.getVar(ncid, yE_id);
- zE=netcdf.getVar(ncid, zE_id);
- cellsOnEdge=netcdf.getVar(ncid, cellsOnEdge_id);
+ nEdgesOnCell_id = netcdf.inqVarID(ncid,'nEdgesOnCell');
+ nEdgesOnCell=netcdf.getVar(ncid, nEdgesOnCell_id);
+ work=size(nEdgesOnCell(:,1));
+ nCells=work(1)
xC_id = netcdf.inqVarID(ncid,'xCell');
yC_id = netcdf.inqVarID(ncid,'yCell');
@@ -206,53 +197,45 @@
yC=netcdf.getVar(ncid, yC_id);
zC=netcdf.getVar(ncid, zC_id);
- for i=1:nEdges
-
- j1 = cellsOnEdge(1,i);
- j2 = cellsOnEdge(2,i);
- iCell1 = min(j1,j2);
- iCell2 = max(j1,j2);
+ xP = 0.0;
+ yP = 0.0;
+ zP = 1.0;
+
+ for i=1:nCells
- x(1) = xC(iCell2)-xC(iCell1);
- x(2) = yC(iCell2)-yC(iCell1);
- x(3) = zC(iCell2)-zC(iCell1);
+ a(1) = xC(i);
+ a(2) = yC(i);
+ a(3) = zC(i);
- normal = x ./ sqrt(x(1)^2 + x(2)^2 + x(3)^2);
+ b(1) = xP;
+ b(2) = yP;
+ b(3) = zP;
- x(1) = xE(i); x(2) = yE(i); x(3) = zE(i);
- tangent(1) = x(2).*normal(3) - x(3).*normal(2);
- tangent(2) = x(3).*normal(1) - x(1).*normal(3);
- tangent(3) = x(1).*normal(2) - x(2).*normal(1);
+ c(1) = a(2)*b(3) - a(3)*b(2);
+ c(2) = a(3)*b(1) - a(1)*b(3);
+ c(3) = a(1)*b(2) - a(2)*b(1);
+
-
if (doWrite == 1)
- dlmwrite('../dx/edge.position.data', xE(i), ...
+ dlmwrite('./dx/vector.position.data', xC(i), ...
'precision', '%18.10e', '-append')
- dlmwrite('../dx/edge.position.data', yE(i), ...
+ dlmwrite('./dx/vector.position.data', yC(i), ...
'precision', '%18.10e', '-append')
- dlmwrite('../dx/edge.position.data', zE(i), ...
+ dlmwrite('./dx/vector.position.data', zC(i), ...
'precision', '%18.10e', '-append')
-
- dlmwrite('../dx/normal.data', normal(1), ...
+
+ dlmwrite('./dx/vector.data', c(1), ...
'precision', '%18.10e', '-append')
- dlmwrite('../dx/normal.data', normal(2), ...
+ dlmwrite('./dx/vector.data', c(2), ...
'precision', '%18.10e', '-append')
- dlmwrite('../dx/normal.data', normal(3), ...
+ dlmwrite('./dx/vector.data', c(3), ...
'precision', '%18.10e', '-append')
- dlmwrite('../dx/tangent.data', tangent(1), ...
- 'precision', '%18.10e', '-append')
-
- dlmwrite('../dx/tangent.data', tangent(2), ...
- 'precision', '%18.10e', '-append')
-
- dlmwrite('../dx/tangent.data', tangent(3), ...
- 'precision', '%18.10e', '-append')
end;
Added: branches/atmos_physics/graphics/ncl/cells_hex.ncl
===================================================================
--- branches/atmos_physics/graphics/ncl/cells_hex.ncl (rev 0)
+++ branches/atmos_physics/graphics/ncl/cells_hex.ncl 2010-10-13 20:25:17 UTC (rev 549)
@@ -0,0 +1,171 @@
+load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/gsn_code.ncl"
+load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/contributed.ncl"
+
+begin
+
+ plotfield = "w"
+ level = 5
+ winds = True
+ nrows = 100
+ ncols = 100
+ maxedges = 6
+
+ wks = gsn_open_wks("pdf","cells")
+ gsn_define_colormap(wks,"wh-bl-gr-ye-re")
+
+ f = addfile("output.nc","r")
+
+ xCell = f->xCell(:)
+ yCell = f->yCell(:)
+ zCell = f->zCell(:)
+ xEdge = f->xEdge(:)
+ yEdge = f->yEdge(:)
+ zEdge = f->zEdge(:)
+ xVertex = f->xVertex(:)
+ yVertex = f->yVertex(:)
+ zVertex = f->zVertex(:)
+ verticesOnCell = f->verticesOnCell(:,:)
+ edgesOnCell = f->edgesOnCell(:,:)
+ edgesOnEdge = f->edgesOnEdge(:,:)
+ verticesOnEdge = f->verticesOnEdge(:,:)
+ cellsOnEdge = f->cellsOnEdge(:,:)
+ cellsOnVertex = f->cellsOnVertex(:,:)
+ edgesOnVertex = f->edgesOnVertex(:,:)
+
+ res = True
+
+ t = stringtointeger(getenv("T"))
+
+ xpoly = new((/maxedges/), "double")
+ ypoly = new((/maxedges/), "double")
+
+ xcb = new((/4/), "float")
+ ycb = new((/4/), "float")
+
+ pres = True
+ pres@gsnFrame = False
+ pres@xyLineColor = "Background"
+ plot = gsn_xy(wks,xCell,yCell,pres)
+
+ if (plotfield .eq. "tracer") then
+ fld = f->tracers(t,:,0,0)
+ minfld = min(fld)
+ maxfld = max(fld)
+ end if
+ if (plotfield .eq. "w") then
+ fld = f->w(t,:,level)
+ minfld = min(fld)
+ maxfld = max(fld)
+ end if
+ if (plotfield .eq. "t") then
+ fld = f->theta(t,:,level)
+ minfld = min(fld)
+ maxfld = max(fld)
+ end if
+ if (plotfield .eq. "qr") then
+ fld = f->qr(t,:,level)
+ minfld = min(fld)
+ maxfld = max(fld)
+ end if
+ if (plotfield .eq. "ke") then
+ fld = f->ke(t,:,0)
+ minfld = min(fld)
+ maxfld = max(fld)
+ end if
+ if (plotfield .eq. "vorticity") then
+ fld = f->vorticity(t,:,0)
+ minfld = min(fld)
+ maxfld = max(fld)
+ end if
+ scalefac = 198.0/(maxfld - minfld)
+
+ if (plotfield .eq. "vorticity") then
+ do iRow=1,nrows-2
+ do iCol=1,ncols-2
+ iCell = iRow*ncols+iCol
+ do iVertex=2*iCell,2*iCell+1
+ do i=0,2
+ xpoly(i) = xCell(cellsOnVertex(iVertex,i)-1)
+ ypoly(i) = yCell(cellsOnVertex(iVertex,i)-1)
+ res@gsFillColor = doubletointeger((fld(iVertex)-minfld)*scalefac)+2
+ end do
+ gsn_polygon(wks,plot,xpoly,ypoly,res);
+ end do
+ end do
+ end do
+ end if
+
+ if (plotfield .eq. "h" .or. plotfield .eq. "ke" .or. plotfield .eq. "t" .or. plotfield .eq. "w" .or. plotfield .eq. "qr") then
+ do iRow=1,nrows-2
+ do iCol=0,ncols-2
+ iCell = iRow*ncols+iCol
+ do i=0,5
+ xpoly(i) = xVertex(verticesOnCell(iCell,i)-1)
+ ypoly(i) = yVertex(verticesOnCell(iCell,i)-1)
+ res@gsFillColor = doubletointeger((fld(iCell)-minfld)*scalefac)+2
+ end do
+ gsn_polygon(wks,plot,xpoly,ypoly,res);
+ end do
+ end do
+ end if
+
+ if (winds) then
+ u = 2.*f->u(t,:,level)
+ v = 2.*f->v(t,:,level)
+ alpha = f->angleEdge(:)
+ esizes = dimsizes(u)
+ u_earth = new(dimsizes(u),float)
+ v_earth = new(dimsizes(u),float)
+ xwind = new(dimsizes(u),float)
+ ywind = new(dimsizes(u),float)
+ do i=0,esizes(0)-1
+ u_earth(i) = doubletofloat(u(i)*cos(alpha(i)) - v(i)*sin(alpha(i)))
+ v_earth(i) = doubletofloat(u(i)*sin(alpha(i)) + v(i)*cos(alpha(i)))
+ xwind(i) = doubletofloat(xEdge(i))
+ ywind(i) = doubletofloat(yEdge(i))
+ end do
+
+ wmsetp("VCH",0.0010)
+ wmsetp("VRN",0.010)
+ wmsetp("VRS",100.0)
+ wmsetp("VCW",0.10)
+
+ wmvect(wks, xwind, ywind, u_earth, v_earth)
+ end if
+
+ ;
+ ; Draw label bar
+ ;
+ tres = True
+ tres@txAngleF = 90.0
+ tres@txFontHeightF = 0.015
+ do i=2,200
+ xcb(0) = 0.1 + i*0.8/198
+ ycb(0) = 0.1
+
+ xcb(1) = 0.1 + (i+1)*0.8/198
+ ycb(1) = 0.1
+
+ xcb(2) = 0.1 + (i+1)*0.8/198
+ ycb(2) = 0.15
+
+ xcb(3) = 0.1 + i*0.8/198
+ ycb(3) = 0.15
+
+ res@gsFillColor = i
+
+ gsn_polygon_ndc(wks,xcb,ycb,res);
+
+ j = (i-2) % 20
+ if ((j .eq. 0) .or. (i .eq. 200)) then
+ ff = minfld + (i-2) / scalefac
+ label = sprintf("%7.3g", ff)
+ gsn_text_ndc(wks, label, xcb(0), 0.05, tres)
+ end if
+
+ end do
+
+ frame(wks)
+
+end
+
Added: branches/atmos_physics/graphics/ncl/cells_nhyd_sph1.ncl
===================================================================
--- branches/atmos_physics/graphics/ncl/cells_nhyd_sph1.ncl (rev 0)
+++ branches/atmos_physics/graphics/ncl/cells_nhyd_sph1.ncl 2010-10-13 20:25:17 UTC (rev 549)
@@ -0,0 +1,207 @@
+load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/gsn_code.ncl"
+load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/gsn_csm.ncl"
+
+begin
+
+ ;
+ ; Which field to plot
+ ;
+ plotfield = "h"
+; plotfield = "ke"
+; plotfield = "vorticity"
+
+ ;
+ ; Whether to plot wind vectors
+ ;
+; winds = True
+ winds = False
+
+ ;
+ ; Whether to do color-filled plot (filled=True) or
+ ; to plot contours of height field (filled=False)
+ ;
+ filled = True
+; filled = False
+
+ ;
+ ; The (lat,lon) the plot is to be centered over
+ ;
+ cenLat = 90.0
+ cenLon = 180.0
+
+ ;
+ ; Projection to use for plot
+ ;
+ projection = "Orthographic"
+; projection = "CylindricalEquidistant"
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+ r2d = 57.2957795 ; radians to degrees
+
+ maxedges = 7
+
+; wks_type = "pdf"
+; wks_type@wkOrientation = "landscape"
+; wks = gsn_open_wks(wks_type,"cells")
+
+ wks = gsn_open_wks("pdf","cells")
+; wks = gsn_open_wks("x11","cells")
+ gsn_define_colormap(wks,"gui_default")
+
+ f = addfile("output.nc","r")
+
+ lonCell = f->lonCell(:) * r2d
+ latCell = f->latCell(:) * r2d
+ lonVertex = f->lonVertex(:) * r2d
+ latVertex = f->latVertex(:) * r2d
+ lonEdge = f->lonEdge(:) * r2d
+ latEdge = f->latEdge(:) * r2d
+ verticesOnCell = f->verticesOnCell(:,:)
+ alpha = f->angleEdge(:)
+
+ res = True
+ res@gsnMaximize = True
+ res@gsnSpreadColors = True
+
+ if (plotfield .eq. "h" .or. plotfield .eq. "ke") then
+ res@sfXArray = lonCell
+ res@sfYArray = latCell
+ end if
+ if (plotfield .eq. "vorticity") then
+ res@sfXArray = lonVertex
+ res@sfYArray = latVertex
+ end if
+
+ res@cnFillMode = "AreaFill"
+
+ if (filled) then
+ res@cnFillOn = True
+; res@cnLinesOn = False
+; res@cnRasterModeOn = True
+; res@cnLinesOn = False
+ res@cnLinesOn = True
+ res@cnLineLabelsOn = False
+ else
+ res@cnFillOn = False
+ res@cnLinesOn = True
+ res@cnLineLabelsOn = True
+ end if
+
+; res@cnLevelSelectionMode = 2
+; res@cnLevels = (/950.,960.,970.,980.,990.,1000.,1010.,1020./)
+ res@cnLevelSelectionMode = 3
+ res@cnLevelSpacingF = 2.
+ res@cnMinLevelValF = 940.
+ res@cnMaxLevelValF = 1020.
+ res@cnInfoLabelOn = True
+
+ res@lbLabelAutoStride = True
+ res@lbBoxLinesOn = False
+
+ res@mpProjection = projection
+ res@mpDataBaseVersion = "MediumRes"
+ res@mpCenterLatF = cenLat
+ res@mpCenterLonF = cenLon
+ res@mpGridAndLimbOn = True
+; res@mpGridAndLimbDrawOrder = "PreDraw"
+ res@mpGridLineColor = "Background"
+ res@mpOutlineOn = False
+ res@mpFillOn = False
+ res@mpPerimOn = False
+ res@gsnFrame = False
+
+
+ t = stringtointeger(getenv("T"))
+ if (plotfield .eq. "h") then
+; h = f->h(t,:,0)
+; hs = f->h_s(:)
+; fld = h + hs
+; h = f->ww(t,:,5)
+; h = (f->surface_pressure(t,:) + 219.4)/100.
+; h = f->geopotential(t,:,18)
+; h = f->theta(t,:,25)-f->theta(0,:,25)
+; h = f->theta(t,:,0)-f->theta_base(:,0)
+; h = f->surface_pressure(t,:)/100.
+; h = (f->surface_pressure(t,:)-f->surface_pressure(0,:))/100.
+; h = f->pressure(t,:,0)/100.
+; fld = h
+
+ cf1 = 2.
+ cf2 = -1.5
+ cf3 = .5
+
+; cf1 = 1.
+; cf2 = 0.
+; cf3 = 0.
+
+ pfirst = f->pressure(t,:,0)+f->pressure_base(:,0)
+ psecond = f->pressure(t,:,1)+f->pressure_base(:,1)
+ pthird = f->pressure(t,:,2)+f->pressure_base(:,2)
+; fld = (cf1*pfirst + cf2*psecond + cf3*pthird)/100.
+
+ rhofirst = f->rho(t,:,0)
+ rhosecond = f->rho(t,:,1)
+ qvfirst = f->qv(t,:,0)
+ qvsecond = f->qv(t,:,1)
+ rdzw = f->rdzw
+
+ gravity = 9.80616
+ fld = (pfirst + (0.5*gravity/rdzw(0))*(1.25*rhofirst*(1.+qvfirst) - 0.25*rhosecond*(1.+qvsecond)))/100.
+
+; psurf = (ppb(1,i)+pp(1,i)) + .5*dzw(1)*gravity &
+; *(1.25*(rr(1,i)+rb(1,i))*(1.+qv(1,i)) &
+; -.25*(rr(2,i)+rb(2,i))*(1.+qv(2,i)))
+
+
+; fld = f->pressure(t,:,25)+f->pressure_base(:,25)
+
+; fld = f->kdiff(t,:,0)
+
+; zg = f->zgrid
+; csizes = dimsizes(pfirst)
+; fld = pfirst
+; do i=0,csizes(0)-1
+; zoff = (zg(i,1)-zg(i,0))/(zg(i,2)-zg(i,0))
+; fld(i) = ((1.+zoff)*pfirst(i) + -zoff*psecond(i))/100.
+; end do
+;
+ end if
+ if (plotfield .eq. "ke") then
+ fld = f->ke(t,:,18)
+ end if
+ if (plotfield .eq. "vorticity") then
+ fld = f->vorticity(t,:,1)
+ end if
+ res@cnLineDashPattern = 0
+ map = gsn_csm_contour_map(wks,fld,res)
+
+ if (winds) then
+ u = f->u(t,:,25) - f->u(0,:,25)
+ v = f->v(t,:,25) - f->v(0,:,25)
+ esizes = dimsizes(u)
+ u_earth = new(dimsizes(u),float)
+ v_earth = new(dimsizes(u),float)
+ lat_edge = new(dimsizes(u),float)
+ lon_edge = new(dimsizes(u),float)
+ do i=0,esizes(0)-1
+ u_earth(i) = doubletofloat(u(i)*cos(alpha(i)) - v(i)*sin(alpha(i)))
+ v_earth(i) = doubletofloat(u(i)*sin(alpha(i)) + v(i)*cos(alpha(i)))
+ lat_edge(i) = doubletofloat(latEdge(i))
+ lon_edge(i) = doubletofloat(lonEdge(i))
+ end do
+
+ wmsetp("VCH",0.0010)
+ wmsetp("VRN",0.010)
+ wmsetp("VRS",100.0)
+ wmsetp("VCW",0.10)
+
+ wmvectmap(wks, lat_edge, lon_edge, u_earth, v_earth)
+ end if
+
+ frame(wks)
+
+end
+
Added: branches/atmos_physics/graphics/ncl/cells_nhyd_sphere.ncl
===================================================================
--- branches/atmos_physics/graphics/ncl/cells_nhyd_sphere.ncl (rev 0)
+++ branches/atmos_physics/graphics/ncl/cells_nhyd_sphere.ncl 2010-10-13 20:25:17 UTC (rev 549)
@@ -0,0 +1,215 @@
+load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/gsn_code.ncl"
+load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/gsn_csm.ncl"
+
+begin
+
+ ;
+ ; Which field to plot
+ ;
+ plotfield = "h"
+; plotfield = "ke"
+; plotfield = "vorticity"
+
+ ;
+ ; Whether to plot wind vectors
+ ;
+; winds = True
+ winds = False
+
+ ;
+ ; Whether to do color-filled plot (filled=True) or
+ ; to plot contours of height field (filled=False)
+ ;
+ filled = True
+; filled = False
+
+ ;
+ ; The (lat,lon) the plot is to be centered over
+ ;
+ cenLat = 90.0
+ cenLon = 180.0
+
+ ;
+ ; Projection to use for plot
+ ;
+ projection = "Orthographic"
+; projection = "CylindricalEquidistant"
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+ r2d = 57.2957795 ; radians to degrees
+
+ maxedges = 7
+
+; wks_type = "pdf"
+; wks_type@wkOrientation = "landscape"
+; wks = gsn_open_wks(wks_type,"cells")
+
+ wks = gsn_open_wks("pdf","cells")
+; wks = gsn_open_wks("x11","cells")
+ gsn_define_colormap(wks,"gui_default")
+
+ f = addfile("output.nc","r")
+
+ lonCell = f->lonCell(:) * r2d
+ latCell = f->latCell(:) * r2d
+ lonVertex = f->lonVertex(:) * r2d
+ latVertex = f->latVertex(:) * r2d
+ lonEdge = f->lonEdge(:) * r2d
+ latEdge = f->latEdge(:) * r2d
+ verticesOnCell = f->verticesOnCell(:,:)
+ alpha = f->angleEdge(:)
+
+ res = True
+ res@gsnMaximize = True
+ res@gsnSpreadColors = True
+
+ if (plotfield .eq. "h" .or. plotfield .eq. "ke") then
+ res@sfXArray = lonCell
+ res@sfYArray = latCell
+ end if
+ if (plotfield .eq. "vorticity") then
+ res@sfXArray = lonVertex
+ res@sfYArray = latVertex
+ end if
+
+ res@cnFillMode = "AreaFill"
+
+ if (filled) then
+ res@cnFillOn = True
+; res@cnLinesOn = False
+; res@cnRasterModeOn = True
+ res@cnLinesOn = True
+ res@cnLineLabelsOn = False
+ else
+ res@cnFillOn = False
+ res@cnLinesOn = True
+ res@cnLineLabelsOn = True
+ end if
+
+; res@cnLevelSpacingF = 10.0
+ res@cnInfoLabelOn = True
+
+ res@lbLabelAutoStride = True
+ res@lbBoxLinesOn = False
+
+ res@mpProjection = projection
+ res@mpDataBaseVersion = "MediumRes"
+ res@mpCenterLatF = cenLat
+ res@mpCenterLonF = cenLon
+
+ res@mpMinLatF = 0.
+ res@mpMaxLatF = 90.
+
+ res@mpGridAndLimbOn = True
+; res@mpGridAndLimbDrawOrder = "PreDraw"
+ res@mpGridLineColor = "Background"
+ res@mpOutlineOn = False
+ res@mpFillOn = False
+ res@mpPerimOn = False
+ res@gsnFrame = False
+
+ res@cnLevelSelectionMode = 2
+ res@cnLevels = (/950.,960.,970.,980.,990.,1000.,1010.,1020./)
+; res@cnLevels = (/962.,966.,970.,974.,978.,982.,986.,990.,994.,998.,1002.,1006.,1010.,1014./)
+; res@cnLevels = (/952.,956.,960.,964.,968.,972.,976.,980.,984.,988.,992.,996.,1000.,1004.,1008.,1012.,1016.,1020./)
+
+; res@cnMinLevelValF=
+; res@cnMaxLevelValF=
+; res@cnLevelSpacingF=
+
+
+ t = stringtointeger(getenv("T"))
+ if (plotfield .eq. "h") then
+; h = f->h(t,:,0)
+; hs = f->h_s(:)
+; fld = h + hs
+; h = f->ww(t,:,5)
+; h = (f->surface_pressure(t,:) + 219.4)/100.
+; h = f->geopotential(t,:,18)
+; h = f->theta(t,:,25)-f->theta(0,:,25)
+; h = f->theta(t,:,0)-f->theta_base(:,0)
+; h = f->surface_pressure(t,:)/100.
+; h = (f->surface_pressure(t,:)-f->surface_pressure(0,:))/100.
+; h = f->pressure(t,:,0)/100.
+; fld = h
+
+ cf1 = 2.
+ cf2 = -1.5
+ cf3 = .5
+
+; cf1 = 1.
+; cf2 = 0.
+; cf3 = 0.
+
+ pfirst = f->pressure(t,:,0)+f->pressure_base(:,0)
+ psecond = f->pressure(t,:,1)+f->pressure_base(:,1)
+ pthird = f->pressure(t,:,2)+f->pressure_base(:,2)
+ fld = (cf1*pfirst + cf2*psecond + cf3*pthird)/100.
+
+ rhofirst = f->rho(t,:,0)
+ rhosecond = f->rho(t,:,1)
+ qvfirst = f->qv(t,:,0)
+ qvsecond = f->qv(t,:,1)
+ rdzw = f->rdzw
+
+ gravity = 9.80616
+ fld = (pfirst + (0.5*gravity/rdzw(0))*(1.25*rhofirst*(1.+qvfirst) - 0.25*rhosecond*(1.+qvsecond)))/100.
+
+; psurf = (ppb(1,i)+pp(1,i)) + .5*dzw(1)*gravity &
+; *(1.25*(rr(1,i)+rb(1,i))*(1.+qv(1,i)) &
+; -.25*(rr(2,i)+rb(2,i))*(1.+qv(2,i)))
+
+
+; fld = f->pressure(t,:,25)+f->pressure_base(:,25)
+
+; zg = f->zgrid
+; csizes = dimsizes(pfirst)
+; fld = pfirst
+; do i=0,csizes(0)-1
+; zoff = (zg(i,1)-zg(i,0))/(zg(i,2)-zg(i,0))
+; fld(i) = ((1.+zoff)*pfirst(i) + -zoff*psecond(i))/100.
+; end do
+;
+
+; fld = f->theta(t,:,0)
+
+ end if
+ if (plotfield .eq. "ke") then
+ fld = f->ke(t,:,18)
+ end if
+ if (plotfield .eq. "vorticity") then
+ fld = f->vorticity(t,:,2)
+ end if
+ res@cnLineDashPattern = 0
+ map = gsn_csm_contour_map(wks,fld,res)
+
+ if (winds) then
+ u = f->u(t,:,25) - f->u(0,:,25)
+ v = f->v(t,:,25) - f->v(0,:,25)
+ esizes = dimsizes(u)
+ u_earth = new(dimsizes(u),float)
+ v_earth = new(dimsizes(u),float)
+ lat_edge = new(dimsizes(u),float)
+ lon_edge = new(dimsizes(u),float)
+ do i=0,esizes(0)-1
+ u_earth(i) = doubletofloat(u(i)*cos(alpha(i)) - v(i)*sin(alpha(i)))
+ v_earth(i) = doubletofloat(u(i)*sin(alpha(i)) + v(i)*cos(alpha(i)))
+ lat_edge(i) = doubletofloat(latEdge(i))
+ lon_edge(i) = doubletofloat(lonEdge(i))
+ end do
+
+ wmsetp("VCH",0.0010)
+ wmsetp("VRN",0.010)
+ wmsetp("VRS",100.0)
+ wmsetp("VCW",0.10)
+
+ wmvectmap(wks, lat_edge, lon_edge, u_earth, v_earth)
+ end if
+
+ frame(wks)
+
+end
+
Added: branches/atmos_physics/graphics/ncl/xz_plane.ncl
===================================================================
--- branches/atmos_physics/graphics/ncl/xz_plane.ncl (rev 0)
+++ branches/atmos_physics/graphics/ncl/xz_plane.ncl 2010-10-13 20:25:17 UTC (rev 549)
@@ -0,0 +1,161 @@
+load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/gsn_code.ncl"
+load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/gsn_csm.ncl"
+load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/contributed.ncl"
+
+begin
+ r2d = 57.2957795 ; radians to degrees
+ pi = 3.14159265
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ ; Set the field to be plotted in the section labeled SET FIELD HERE
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+ ;
+ ; Whether to plot horizontal wind vectors
+ ;
+ horiz_winds = True
+; horiz_winds = False
+
+ ;
+ ; Whether to do color-filled plot (filled=True) or
+ ; to plot contours of height field (filled=False)
+ ;
+; filled = True
+ filled = False
+
+ ;
+ ; The number of rows and columns in the data set
+ ;
+ nrows = 4
+ ncols = 200
+
+ ;
+ ; The row number (between 1 and nrows) to plot
+ ;
+ irow = 1
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+ wks = gsn_open_wks("pdf","xsec")
+ gsn_define_colormap(wks,"gui_default")
+
+ f = addfile("output.nc","r")
+
+ lonCell = f->lonCell(:) * r2d
+ latCell = f->latCell(:) * r2d
+ xCell = f->xCell(:)
+ yCell = f->yCell(:)
+ zCell = f->zCell(:)
+ lonVertex = f->lonVertex(:) * r2d
+ latVertex = f->latVertex(:) * r2d
+ xVertex = f->xVertex(:)
+ yVertex = f->yVertex(:)
+ zVertex = f->zVertex(:)
+ lonEdge = f->lonEdge(:) * r2d
+ latEdge = f->latEdge(:) * r2d
+ xEdge = f->xEdge(:)
+ yEdge = f->yEdge(:)
+ zEdge = f->zEdge(:)
+ verticesOnCell = f->verticesOnCell(:,:)
+ edgesOnCell = f->edgesOnCell(:,:)
+ nCellsOnCell = f->nEdgesOnCell(:)
+ cellsOnCell = f->cellsOnCell(:,:)
+ alpha = f->angleEdge(:)
+
+ dims = dimsizes(latCell)
+ nCells = dims(0)
+
+ nsec = ncols
+
+ xsec_id = new((/nsec/),integer)
+ xsec_edge_id = new((/nsec+1/),integer)
+
+ do i=0,nsec-1
+ xsec_id(i) = i + ncols * (irow-1)
+ xsec_edge_id(i) = 3 * (xsec_id(i))
+ end do
+ xsec_edge_id(nsec) = xsec_edge_id(nsec-1) + 3
+
+ res = True
+ res@gsnMaximize = True
+ res@gsnSpreadColors = True
+
+ res@cnFillMode = "AreaFill"
+
+ if (filled) then
+ res@cnFillOn = True
+ res@cnLinesOn = False
+ res@cnLineLabelsOn = False
+ else
+ res@cnFillOn = False
+ res@cnLinesOn = True
+ res@cnLineLabelsOn = True
+ end if
+
+; res@cnLevelSpacingF = 50.0
+ res@cnInfoLabelOn = True
+
+ res@lbLabelAutoStride = True
+ res@lbBoxLinesOn = False
+
+ res@gsnFrame = False
+
+
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ ;; BEGIN SET FIELD HERE
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ t = stringtointeger(getenv("T"))
+
+ fld = f->tx(t,:,:)
+ ldims = dimsizes(fld)
+ nVertLevels = ldims(1)
+
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ ;; END SET FIELD HERE
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+ res@cnLineDashPattern = 0
+
+ ; Extract field from along cross section into plotting array
+ arr = new((/nVertLevels,nsec/),float)
+ do i=0,nsec-1
+ do j=0,nVertLevels-1
+ arr(j,i) = doubletofloat(fld(xsec_id(i),j))
+ end do
+ end do
+
+ map = gsn_csm_contour(wks,arr,res)
+
+ if (horiz_winds) then
+ u = f->u(t,:,:)
+ v = f->v(t,:,:)
+ esizes = dimsizes(u)
+ u_earth = new((/nVertLevels,nsec/),float)
+ v_earth = new((/nVertLevels,nsec/),float)
+ x_edge = new((/nVertLevels,nsec/),float)
+ y_edge = new((/nVertLevels,nsec/),float)
+ do i=0,nsec-1
+ do j=0,nVertLevels-1
+ u_earth(j,i) = doubletofloat(u(xsec_edge_id(i),j)*cos(alpha(xsec_edge_id(i))) - v(xsec_edge_id(i),j)*sin(alpha(xsec_edge_id(i))))
+ v_earth(j,i) = doubletofloat(u(xsec_edge_id(i),j)*sin(alpha(xsec_edge_id(i))) + v(xsec_edge_id(i),j)*cos(alpha(xsec_edge_id(i))))
+ x_edge(j,i) = i
+ y_edge(j,i) = j
+ end do
+ end do
+
+ wmsetp("VCH",0.0010)
+ wmsetp("VRN",0.010)
+ wmsetp("VRS",100.0)
+ wmsetp("VCW",0.10)
+
+ wmvect(wks, x_edge, y_edge, u_earth, v_earth)
+ end if
+
+ frame(wks)
+
+end
+
Modified: branches/atmos_physics/namelist.input.hyd_atmos
===================================================================
--- branches/atmos_physics/namelist.input.hyd_atmos 2010-10-13 18:01:28 UTC (rev 548)
+++ branches/atmos_physics/namelist.input.hyd_atmos 2010-10-13 20:25:17 UTC (rev 549)
@@ -16,6 +16,10 @@
config_mp_physics = 0
/
+&dimensions
+ config_nvertlevels = 26
+/
+
&io
config_input_name = 'grid.nc'
config_output_name = 'output.nc'
@@ -27,8 +31,8 @@
config_do_restart = .false.
config_restart_time = 1036800.0
/
+
&physics
config_n_physics = 01
config_n_microp = 20
/
-
Added: branches/atmos_physics/namelist.input.nhyd_atmos
===================================================================
--- branches/atmos_physics/namelist.input.nhyd_atmos (rev 0)
+++ branches/atmos_physics/namelist.input.nhyd_atmos 2010-10-13 20:25:17 UTC (rev 549)
@@ -0,0 +1,39 @@
+&nhyd_model
+ config_test_case = 2
+ config_time_integration = 'SRK3'
+ config_dt = 1800
+ config_ntimesteps = 480
+ config_output_interval = 48
+ config_number_of_sub_steps = 6
+ config_h_mom_eddy_visc2 = 0000.
+ config_h_mom_eddy_visc4 = 0.
+ config_v_mom_eddy_visc2 = 00.0
+ config_h_theta_eddy_visc2 = 0000.
+ config_h_theta_eddy_visc4 = 00.
+ config_v_theta_eddy_visc2 = 00.0
+ config_theta_adv_order = 2
+ config_scalar_adv_order = 2
+ config_positive_definite = .false.
+ config_monotonic = .false.
+ config_epssm = 0.1
+ config_smdiv = 0.1
+/
+
+&dimensions
+ config_nvertlevels = 26
+/
+
+&io
+ config_input_name = 'grid.nc'
+ config_output_name = 'output.nc'
+ config_restart_name = 'restart.nc'
+/
+
+&restart
+ config_restart_interval = 3000
+ config_do_restart = .false.
+ config_restart_time = 1036800.0
+/
+
+&physics
+/
Added: branches/atmos_physics/namelist.input.nhyd_atmos_jw
===================================================================
--- branches/atmos_physics/namelist.input.nhyd_atmos_jw (rev 0)
+++ branches/atmos_physics/namelist.input.nhyd_atmos_jw 2010-10-13 20:25:17 UTC (rev 549)
@@ -0,0 +1,47 @@
+&nhyd_model
+ config_test_case = 2
+ config_time_integration = 'SRK3'
+ config_dt = 450
+ config_ntimesteps = 1920
+ config_output_interval = 192
+ config_number_of_sub_steps = 6
+ config_h_mom_eddy_visc2 = 0.0e+04
+ config_h_mom_eddy_visc4 = 0.
+ config_v_mom_eddy_visc2 = 00.0
+ config_h_theta_eddy_visc2 = 0.0e+04
+ config_h_theta_eddy_visc4 = 00.
+ config_v_theta_eddy_visc2 = 00.0
+ config_horiz_mixing = '2d_smagorinsky'
+ config_len_disp = 60000.
+ config_u_vadv_order = 3
+ config_w_vadv_order = 3
+ config_theta_vadv_order = 3
+ config_scalar_vadv_order = 3
+ config_theta_adv_order = 3
+ config_scalar_adv_order = 3
+ config_scalar_advection = .false.
+ config_positive_definite = .false.
+ config_coef_3rd_order = 1.0
+ config_monotonic = .false.
+ config_epssm = 0.1
+ config_smdiv = 0.1
+/
+
+&dimensions
+ config_nvertlevels = 26
+/
+
+&io
+ config_input_name = 'grid.nc'
+ config_output_name = 'output.nc'
+ config_restart_name = 'restart.nc'
+/
+
+&restart
+ config_restart_interval = 3000
+ config_do_restart = .false.
+ config_restart_time = 1036800.0
+/
+
+&physics
+/
Added: branches/atmos_physics/namelist.input.nhyd_atmos_mtn_wave
===================================================================
--- branches/atmos_physics/namelist.input.nhyd_atmos_mtn_wave (rev 0)
+++ branches/atmos_physics/namelist.input.nhyd_atmos_mtn_wave 2010-10-13 20:25:17 UTC (rev 549)
@@ -0,0 +1,42 @@
+&nhyd_model
+ config_test_case = 6
+ config_time_integration = 'SRK3'
+ config_dt = 6.
+ config_ntimesteps = 3000
+ config_output_interval = 100
+ config_number_of_sub_steps = 6
+ config_h_mom_eddy_visc2 = 10.
+ config_h_mom_eddy_visc4 = 0.
+ config_v_mom_eddy_visc2 = 10.
+ config_h_theta_eddy_visc2 = 10.
+ config_h_theta_eddy_visc4 = 0.
+ config_v_theta_eddy_visc2 = 10.
+ config_theta_adv_order = 3
+ config_w_adv_order = 3
+ config_scalar_advection = .false.
+ config_positive_definite = .false.
+ config_monotonic = .false.
+ config_mix_full = .false.
+ config_horiz_mixing = '2d_fixed'
+ config_coef_3rd_order = 0.25
+ config_epssm = 0.2
+/
+
+&dimensions
+ config_nvertlevels = 26
+/
+
+&io
+ config_input_name = 'grid.nc'
+ config_output_name = 'output.nc'
+ config_restart_name = 'restart.nc'
+/
+
+&restart
+ config_restart_interval = 3000
+ config_do_restart = .false.
+ config_restart_time = 1036800.0
+/
+
+&physics
+/
Added: branches/atmos_physics/namelist.input.nhyd_atmos_squall
===================================================================
--- branches/atmos_physics/namelist.input.nhyd_atmos_squall (rev 0)
+++ branches/atmos_physics/namelist.input.nhyd_atmos_squall 2010-10-13 20:25:17 UTC (rev 549)
@@ -0,0 +1,37 @@
+&nhyd_model
+ config_test_case = 4
+ config_time_integration = 'SRK3'
+ config_dt = 6.
+ config_ntimesteps = 600
+ config_output_interval = 100
+ config_number_of_sub_steps = 6
+ config_h_mom_eddy_visc2 = 500.
+ config_h_mom_eddy_visc4 = 0.
+ config_v_mom_eddy_visc2 = 500.0
+ config_h_theta_eddy_visc2 = 500.
+ config_h_theta_eddy_visc4 = 00.
+ config_v_theta_eddy_visc2 = 500.0
+ config_theta_adv_order = 2
+ config_scalar_adv_order = 2
+ config_positive_definite = .false.
+ config_monotonic = .false.
+/
+
+&dimensions
+ config_nvertlevels = 26
+/
+
+&io
+ config_input_name = 'grid.nc'
+ config_output_name = 'output.nc'
+ config_restart_name = 'restart.nc'
+/
+
+&restart
+ config_restart_interval = 3000
+ config_do_restart = .false.
+ config_restart_time = 1036800.0
+/
+
+&physics
+/
Modified: branches/atmos_physics/namelist.input.ocean
===================================================================
--- branches/atmos_physics/namelist.input.ocean 2010-10-13 18:01:28 UTC (rev 548)
+++ branches/atmos_physics/namelist.input.ocean 2010-10-13 20:25:17 UTC (rev 549)
@@ -1,11 +1,10 @@
&sw_model
config_test_case = 0
config_time_integration = 'RK4'
- config_dt = 60.0
- config_ntimesteps = 1440000
- config_output_interval = 14400
- config_stats_interval = 1440
- config_visc = 1.0e5
+ config_dt = 90.0
+ config_ntimesteps = 1920000
+ config_output_interval = 19200
+ config_stats_interval = 1920
/
&io
@@ -17,29 +16,32 @@
&restart
config_restart_interval = 115200
config_do_restart = .false.
- config_restart_time = 1036800.0
+ config_restart_time = 31104000
/
&grid
- config_vert_grid_type = 'zlevel'
- config_rho0 = 1028
+ config_vert_grid_type = 'isopycnal'
+ config_rho0 = 1015
/
&hmix
- config_hor_diffusion = 1.0e4
+ config_h_mom_eddy_visc2 = 0.0
+ config_h_mom_eddy_visc4 = 5.0e8
+ config_h_tracer_eddy_diff2 = 10.0
+ config_h_tracer_eddy_diff4 = 0.0
/
&vmix
- config_vert_visc_type = 'tanh'
- config_vert_diff_type = 'tanh'
+ config_vert_visc_type = 'const'
+ config_vert_diff_type = 'const'
config_vmixTanhViscMax = 2.5e-1
config_vmixTanhViscMin = 1.0e-4
config_vmixTanhDiffMax = 2.5e-2
config_vmixTanhDiffMin = 1.0e-5
config_vmixTanhZMid = -100
config_vmixTanhZWidth = 100
- config_vert_viscosity = 2.5e-4
- config_vert_diffusion = 2.5e-5
+ config_vert_viscosity = 1.0e-4
+ config_vert_diffusion = 1.0e-4
/
&advection
- config_hor_tracer_adv = 'upwind'
- config_vert_tracer_adv = 'upwind'
+ config_hor_tracer_adv = 'centered'
+ config_vert_tracer_adv = 'centered'
/
Modified: branches/atmos_physics/namelist.input.sw
===================================================================
--- branches/atmos_physics/namelist.input.sw 2010-10-13 18:01:28 UTC (rev 548)
+++ branches/atmos_physics/namelist.input.sw 2010-10-13 20:25:17 UTC (rev 549)
@@ -4,6 +4,7 @@
config_dt = 172.8
config_ntimesteps = 7500
config_output_interval = 500
+ config_stats_interval = 0
config_visc = 0.0
/
Modified: branches/atmos_physics/src/core_hyd_atmos/Registry
===================================================================
--- branches/atmos_physics/src/core_hyd_atmos/Registry 2010-10-13 18:01:28 UTC (rev 548)
+++ branches/atmos_physics/src/core_hyd_atmos/Registry 2010-10-13 20:25:17 UTC (rev 549)
@@ -18,6 +18,7 @@
namelist logical sw_model config_positive_definite false
namelist logical sw_model config_monotonic true
namelist integer sw_model config_mp_physics 0
+namelist integer dimensions config_nvertlevels 26
namelist character io config_input_name grid.nc
namelist character io config_output_name output.nc
namelist character io config_restart_name restart.nc
@@ -38,144 +39,159 @@
dim FIFTEEN 15
dim TWENTYONE 21
dim R3 3
-dim nVertLevels nVertLevels
+#dim nVertLevels nVertLevels
+dim nVertLevels namelist:config_nvertlevels
#dim nTracers nTracers
dim nVertLevelsP1 nVertLevels+1
#
-# var type name_in_file ( dims ) iro- name_in_code super-array array_class
+# var persistence type name_in_file ( dims ) time_levs iro- name_in_code struct super-array array_class
#
-var real xtime ( Time ) ro xtime - -
+var persistent real xtime ( Time ) 2 ro xtime state - -
-var real latCell ( nCells ) iro latCell - -
-var real lonCell ( nCells ) iro lonCell - -
-var real xCell ( nCells ) iro xCell - -
-var real yCell ( nCells ) iro yCell - -
-var real zCell ( nCells ) iro zCell - -
-var integer indexToCellID ( nCells ) iro indexToCellID - -
+var persistent real latCell ( nCells ) 0 iro latCell mesh - -
+var persistent real lonCell ( nCells ) 0 iro lonCell mesh - -
+var persistent real xCell ( nCells ) 0 iro xCell mesh - -
+var persistent real yCell ( nCells ) 0 iro yCell mesh - -
+var persistent real zCell ( nCells ) 0 iro zCell mesh - -
+var persistent integer indexToCellID ( nCells ) 0 iro indexToCellID mesh - -
-var real latEdge ( nEdges ) iro latEdge - -
-var real lonEdge ( nEdges ) iro lonEdge - -
-var real xEdge ( nEdges ) iro xEdge - -
-var real yEdge ( nEdges ) iro yEdge - -
-var real zEdge ( nEdges ) iro zEdge - -
-var integer indexToEdgeID ( nEdges ) iro indexToEdgeID - -
+var persistent real latEdge ( nEdges ) 0 iro latEdge mesh - -
+var persistent real lonEdge ( nEdges ) 0 iro lonEdge mesh - -
+var persistent real xEdge ( nEdges ) 0 iro xEdge mesh - -
+var persistent real yEdge ( nEdges ) 0 iro yEdge mesh - -
+var persistent real zEdge ( nEdges ) 0 iro zEdge mesh - -
+var persistent integer indexToEdgeID ( nEdges ) 0 iro indexToEdgeID mesh - -
-var real latVertex ( nVertices ) iro latVertex - -
-var real lonVertex ( nVertices ) iro lonVertex - -
-var real xVertex ( nVertices ) iro xVertex - -
-var real yVertex ( nVertices ) iro yVertex - -
-var real zVertex ( nVertices ) iro zVertex - -
-var integer indexToVertexID ( nVertices ) iro indexToVertexID - -
+var persistent real latVertex ( nVertices ) 0 iro latVertex mesh - -
+var persistent real lonVertex ( nVertices ) 0 iro lonVertex mesh - -
+var persistent real xVertex ( nVertices ) 0 iro xVertex mesh - -
+var persistent real yVertex ( nVertices ) 0 iro yVertex mesh - -
+var persistent real zVertex ( nVertices ) 0 iro zVertex mesh - -
+var persistent integer indexToVertexID ( nVertices ) 0 iro indexToVertexID mesh - -
-var integer cellsOnEdge ( TWO nEdges ) iro cellsOnEdge - -
-var integer nEdgesOnCell ( nCells ) iro nEdgesOnCell - -
-var integer nEdgesOnEdge ( nEdges ) iro nEdgesOnEdge - -
-var integer edgesOnCell ( maxEdges nCells ) iro edgesOnCell - -
-var integer edgesOnEdge ( maxEdges2 nEdges ) iro edgesOnEdge - -
+var persistent integer cellsOnEdge ( TWO nEdges ) 0 iro cellsOnEdge mesh - -
+var persistent integer nEdgesOnCell ( nCells ) 0 iro nEdgesOnCell mesh - -
+var persistent integer nEdgesOnEdge ( nEdges ) 0 iro nEdgesOnEdge mesh - -
+var persistent integer edgesOnCell ( maxEdges nCells ) 0 iro edgesOnCell mesh - -
+var persistent integer edgesOnEdge ( maxEdges2 nEdges ) 0 iro edgesOnEdge mesh - -
-var real weightsOnEdge ( maxEdges2 nEdges ) iro weightsOnEdge - -
-var real dvEdge ( nEdges ) iro dvEdge - -
-var real dcEdge ( nEdges ) iro dcEdge - -
-var real angleEdge ( nEdges ) iro angleEdge - -
-var real areaCell ( nCells ) iro areaCell - -
-var real areaTriangle ( nVertices ) iro areaTriangle - -
+var persistent real weightsOnEdge ( maxEdges2 nEdges ) 0 iro weightsOnEdge mesh - -
+var persistent real dvEdge ( nEdges ) 0 iro dvEdge mesh - -
+var persistent real dcEdge ( nEdges ) 0 iro dcEdge mesh - -
+var persistent real angleEdge ( nEdges ) 0 iro angleEdge mesh - -
+var persistent real areaCell ( nCells ) 0 iro areaCell mesh - -
+var persistent real areaTriangle ( nVertices ) 0 iro areaTriangle mesh - -
-var real edgeNormalVectors ( R3 nEdges ) o edgeNormalVectors - -
-var real localVerticalUnitVectors ( R3 nCells ) o localVerticalUnitVectors - -
-var real cellTangentPlane ( R3 TWO nEdges ) o cellTangentPlane - -
+var persistent real edgeNormalVectors ( R3 nEdges ) 0 o edgeNormalVectors mesh - -
+var persistent real localVerticalUnitVectors ( R3 nCells ) 0 o localVerticalUnitVectors mesh - -
+var persistent real cellTangentPlane ( R3 TWO nEdges ) 0 o cellTangentPlane mesh - -
-var integer cellsOnCell ( maxEdges nCells ) iro cellsOnCell - -
-var integer verticesOnCell ( maxEdges nCells ) iro verticesOnCell - -
-var integer verticesOnEdge ( TWO nEdges ) iro verticesOnEdge - -
-var integer edgesOnVertex ( vertexDegree nVertices ) iro edgesOnVertex - -
-var integer cellsOnVertex ( vertexDegree nVertices ) iro cellsOnVertex - -
-var real kiteAreasOnVertex ( vertexDegree nVertices ) iro kiteAreasOnVertex - -
-var real fEdge ( nEdges ) iro fEdge - -
-var real fVertex ( nVertices ) iro fVertex - -
-var real h_s ( nCells ) iro h_s - -
+var persistent integer cellsOnCell ( maxEdges nCells ) 0 iro cellsOnCell mesh - -
+var persistent integer verticesOnCell ( maxEdges nCells ) 0 iro verticesOnCell mesh - -
+var persistent integer verticesOnEdge ( TWO nEdges ) 0 iro verticesOnEdge mesh - -
+var persistent integer edgesOnVertex ( vertexDegree nVertices ) 0 iro edgesOnVertex mesh - -
+var persistent integer cellsOnVertex ( vertexDegree nVertices ) 0 iro cellsOnVertex mesh - -
+var persistent real kiteAreasOnVertex ( vertexDegree nVertices ) 0 iro kiteAreasOnVertex mesh - -
+var persistent real fEdge ( nEdges ) 0 iro fEdge mesh - -
+var persistent real fVertex ( nVertices ) 0 iro fVertex mesh - -
+var persistent real h_s ( nCells ) 0 iro h_s mesh - -
# description of the vertical grid structure
-var real rdnu ( nVertLevels ) iro rdnu - -
-var real rdnw ( nVertLevels ) iro rdnw - -
-var real fnm ( nVertLevels ) iro fnm - -
-var real fnp ( nVertLevels ) iro fnp - -
-var real dbn ( nVertLevels ) iro dbn - -
-var real dnu ( nVertLevels ) iro dnu - -
-var real dnw ( nVertLevels ) iro dnw - -
+var persistent real rdnu ( nVertLevels ) 0 iro rdnu mesh - -
+var persistent real rdnw ( nVertLevels ) 0 iro rdnw mesh - -
+var persistent real fnm ( nVertLevels ) 0 iro fnm mesh - -
+var persistent real fnp ( nVertLevels ) 0 iro fnp mesh - -
+var persistent real dbn ( nVertLevels ) 0 iro dbn mesh - -
+var persistent real dnu ( nVertLevels ) 0 iro dnu mesh - -
+var persistent real dnw ( nVertLevels ) 0 iro dnw mesh - -
# Prognostic variables: read from input, saved in restart, and written to output
-var real u ( nVertLevels nEdges Time ) iro u - -
-var real theta ( nVertLevels nCells Time ) iro theta - -
-var real surface_pressure ( nCells Time ) iro surface_pressure - -
-var real qv ( nVertLevels nCells Time ) iro qv scalars moist
-var real qc ( nVertLevels nCells Time ) iro qc scalars moist
-var real qr ( nVertLevels nCells Time ) iro qr scalars moist
-var real qi ( nVertLevels nCells Time ) iro qi scalars moist
-var real qs ( nVertLevels nCells Time ) iro qs scalars moist
-var real qg ( nVertLevels nCells Time ) iro qg scalars moist
-var real qnr ( nVertLevels nCells Time ) iro qnr scalars number
-var real qni ( nVertLevels nCells Time ) iro qni scalars number
-var real h_diabatic ( nVertLevels nCells Time ) ro h_diabatic - -
-#var real tracers ( nTracers nVertLevels nCells Time ) iro tracers - -
+var persistent real u ( nVertLevels nEdges Time ) 2 iro u state - -
+var persistent real theta ( nVertLevels nCells Time ) 2 iro theta state - -
+var persistent real surface_pressure ( nCells Time ) 2 iro surface_pressure state - -
+var persistent real qv ( nVertLevels nCells Time ) 2 iro qv state scalars moist
+var persistent real qc ( nVertLevels nCells Time ) 2 iro qc state scalars moist
+var persistent real qr ( nVertLevels nCells Time ) 2 iro qr state scalars moist
+var persistent real qi ( nVertLevels nCells Time ) 2 iro qi state scalars moist
+var persistent real qs ( nVertLevels nCells Time ) 2 iro qs state scalars moist
+var persistent real qg ( nVertLevels nCells Time ) 2 iro qg state scalars moist
+var persistent real qnr ( nVertLevels nCells Time ) 2 iro qnr state scalars number
+var persistent real qni ( nVertLevels nCells Time ) 2 iro qni state scalars number
+var persistent real h_diabatic ( nVertLevels nCells Time ) 2 ro h_diabatic state - -
+#var persistent real tracers ( nTracers nVertLevels nCells Time ) 2 iro tracers state - -
# state variables diagnosed from prognostic state
-var real h ( nVertLevels nCells Time ) ro h - -
-var real ww ( nVertLevelsP1 nCells Time ) ro ww - -
-var real w ( nVertLevelsP1 nCells Time ) ro w - -
-var real pressure ( nVertLevelsP1 nCells Time ) ro pressure - -
-var real geopotential ( nVertLevelsP1 nCells Time ) ro geopotential - -
-var real alpha ( nVertLevels nCells Time ) iro alpha - -
+var persistent real h ( nVertLevels nCells Time ) 2 ro h state - -
+var persistent real ww ( nVertLevelsP1 nCells Time ) 2 ro ww state - -
+var persistent real w ( nVertLevelsP1 nCells Time ) 2 ro w state - -
+var persistent real pressure ( nVertLevelsP1 nCells Time ) 2 ro pressure state - -
+var persistent real geopotential ( nVertLevelsP1 nCells Time ) 2 ro geopotential state - -
+var persistent real alpha ( nVertLevels nCells Time ) 2 iro alpha state - -
# Diagnostic fields: only written to output
-var real v ( nVertLevels nEdges Time ) o v - -
-var real divergence ( nVertLevels nCells Time ) o divergence - -
-var real vorticity ( nVertLevels nVertices Time ) o vorticity - -
-var real pv_edge ( nVertLevels nEdges Time ) o pv_edge - -
-var real h_edge ( nVertLevels nEdges Time ) o h_edge - -
-var real ke ( nVertLevels nCells Time ) o ke - -
-var real pv_vertex ( nVertLevels nVertices Time ) o pv_vertex - -
-var real pv_cell ( nVertLevels nCells Time ) o pv_cell - -
-var real uReconstructX ( nVertLevels nCells Time ) o uReconstructX - -
-var real uReconstructY ( nVertLevels nCells Time ) o uReconstructY - -
-var real uReconstructZ ( nVertLevels nCells Time ) o uReconstructZ - -
-var real uReconstructZonal ( nVertLevels nCells Time ) o uReconstructZonal - -
-var real uReconstructMeridional ( nVertLevels nCells Time ) o uReconstructMeridional - -
+var persistent real v ( nVertLevels nEdges Time ) 2 o v state - -
+var persistent real divergence ( nVertLevels nCells Time ) 2 o divergence state - -
+var persistent real vorticity ( nVertLevels nVertices Time ) 2 o vorticity state - -
+var persistent real pv_edge ( nVertLevels nEdges Time ) 2 o pv_edge state - -
+var persistent real h_edge ( nVertLevels nEdges Time ) 2 o h_edge state - -
+var persistent real ke ( nVertLevels nCells Time ) 2 o ke state - -
+var persistent real pv_vertex ( nVertLevels nVertices Time ) 2 o pv_vertex state - -
+var persistent real pv_cell ( nVertLevels nCells Time ) 2 o pv_cell state - -
+var persistent real uReconstructX ( nVertLevels nCells Time ) 1 o uReconstructX diag - -
+var persistent real uReconstructY ( nVertLevels nCells Time ) 1 o uReconstructY diag - -
+var persistent real uReconstructZ ( nVertLevels nCells Time ) 1 o uReconstructZ diag - -
+var persistent real uReconstructZonal ( nVertLevels nCells Time ) 1 o uReconstructZonal diag - -
+var persistent real uReconstructMeridional ( nVertLevels nCells Time ) 1 o uReconstructMeridional diag - -
+# Tendency variables
+var persistent real tend_h ( nVertLevels nCells Time ) 1 - h tend - -
+var persistent real tend_u ( nVertLevels nEdges Time ) 1 - u tend - -
+var persistent real tend_vh ( nVertLevels nEdges Time ) 1 - vh tend - -
+var persistent real tend_theta ( nVertLevels nCells Time ) 1 - theta tend - -
+var persistent real tend_qv ( nVertLevels nCells Time ) 1 - qv tend scalars moist
+var persistent real tend_qc ( nVertLevels nCells Time ) 1 - qc tend scalars moist
+var persistent real tend_qr ( nVertLevels nCells Time ) 1 - qr tend scalars moist
+var persistent real tend_qi ( nVertLevels nCells Time ) 1 - qi tend scalars moist
+var persistent real tend_qs ( nVertLevels nCells Time ) 1 - qs tend scalars moist
+var persistent real tend_qg ( nVertLevels nCells Time ) 1 - qg tend scalars moist
+var persistent real tend_qnr ( nVertLevels nCells Time ) 1 - qnr tend scalars number
+var persistent real tend_qni ( nVertLevels nCells Time ) 1 - qni tend scalars number
+
# Other diagnostic variables: neither read nor written to any files
-var real vh ( nVertLevels nEdges Time ) - vh - -
-var real circulation ( nVertLevels nVertices Time ) - circulation - -
-var real gradPVt ( nVertLevels nEdges Time ) - gradPVt - -
-var real gradPVn ( nVertLevels nEdges Time ) - gradPVn - -
+var persistent real vh ( nVertLevels nEdges Time ) 2 - vh state - -
+var persistent real circulation ( nVertLevels nVertices Time ) 2 - circulation state - -
+var persistent real gradPVt ( nVertLevels nEdges Time ) 2 - gradPVt state - -
+var persistent real gradPVn ( nVertLevels nEdges Time ) 2 - gradPVn state - -
-var real uhAvg ( nVertLevels nEdges ) - uhAvg - -
-var real wwAvg ( nVertLevelsP1 nCells ) - wwAvg - -
-var real qtot ( nVertLevels nCells ) - qtot - -
-var real cqu ( nVertLevels nEdges ) - cqu - -
-var real dpsdt ( nCells ) - dpsdt - -
+var persistent real uhAvg ( nVertLevels nEdges ) 0 - uhAvg mesh - -
+var persistent real wwAvg ( nVertLevelsP1 nCells ) 0 - wwAvg mesh - -
+var persistent real qtot ( nVertLevels nCells ) 0 - qtot mesh - -
+var persistent real cqu ( nVertLevels nEdges ) 0 - cqu mesh - -
+var persistent real dpsdt ( nCells ) 0 - dpsdt mesh - -
-var real u_old ( nVertLevels nEdges ) - u_old - -
-var real ww_old ( nVertLevelsP1 nCells ) - ww_old - -
-var real theta_old ( nVertLevels nCells ) - theta_old - -
-var real h_edge_old ( nVertLevels nEdges ) - h_edge_old - -
-var real h_old ( nVertLevels nCells ) - h_old - -
-var real pressure_old ( nVertLevelsP1 nCells ) - pressure_old - -
-var real qv_old ( nVertLevels nCells ) - qv_old scalars_old moist_old
-var real qc_old ( nVertLevels nCells ) - qc_old scalars_old moist_old
-var real qr_old ( nVertLevels nCells ) - qr_old scalars_old moist_old
-var real qi_old ( nVertLevels nCells ) - qi_old scalars_old moist_old
-var real qs_old ( nVertLevels nCells ) - qs_old scalars_old moist_old
-var real qg_old ( nVertLevels nCells ) - qg_old scalars_old moist_old
-var real qnr_old ( nVertLevels nCells Time ) - qnr_old scalars_old number_old
-var real qni_old ( nVertLevels nCells Time ) - qni_old scalars_old number_old
-#var real tracers_old ( nTracers nVertLevels nCells ) - tracers_old - -
+var persistent real u_old ( nVertLevels nEdges ) 0 - u_old mesh - -
+var persistent real ww_old ( nVertLevelsP1 nCells ) 0 - ww_old mesh - -
+var persistent real theta_old ( nVertLevels nCells ) 0 - theta_old mesh - -
+var persistent real h_edge_old ( nVertLevels nEdges ) 0 - h_edge_old mesh - -
+var persistent real h_old ( nVertLevels nCells ) 0 - h_old mesh - -
+var persistent real pressure_old ( nVertLevelsP1 nCells ) 0 - pressure_old mesh - -
+var persistent real qv_old ( nVertLevels nCells ) 0 - qv_old mesh scalars_old moist_old
+var persistent real qc_old ( nVertLevels nCells ) 0 - qc_old mesh scalars_old moist_old
+var persistent real qr_old ( nVertLevels nCells ) 0 - qr_old mesh scalars_old moist_old
+var persistent real qi_old ( nVertLevels nCells ) 0 - qi_old mesh scalars_old moist_old
+var persistent real qs_old ( nVertLevels nCells ) 0 - qs_old mesh scalars_old moist_old
+var persistent real qg_old ( nVertLevels nCells ) 0 - qg_old mesh scalars_old moist_old
+var persistent real qnr_old ( nVertLevels nCells ) 0 - qnr_old mesh scalars_old number_old
+var persistent real qni_old ( nVertLevels nCells ) 0 - qni_old mesh scalars_old number_old
+#var persistent real tracers_old ( nTracers nVertLevels nCells ) 0 - tracers_old mesh - -
# Space needed for advection
-var real deriv_two ( FIFTEEN TWO nEdges ) o deriv_two - -
-var integer advCells ( TWENTYONE nCells ) - advCells - -
+var persistent real deriv_two ( FIFTEEN TWO nEdges ) 0 o deriv_two mesh - -
+var persistent integer advCells ( TWENTYONE nCells ) 0 - advCells mesh - -
# Arrays required for reconstruction of velocity field
-var real coeffs_reconstruct ( R3 maxEdges nCells ) - coeffs_reconstruct - -
+var persistent real coeffs_reconstruct ( R3 maxEdges nCells ) 0 - coeffs_reconstruct mesh - -
#==================================================================================================
# DECLARATIONS OF ALL PHYSICS VARIABLES (will need to be moved to a Physics Registry shared by the
@@ -207,12 +223,12 @@
# qi_col : vertically-integrated cloud ice mixing ratio (kg/m2)
# qs_col " vertically-integrated snow mixing ratio (kg/m2)
-var real qv_col ( nCells Time ) o qv_col - -
-var real qc_col ( nCells Time ) o qc_col - -
-var real qr_col ( nCells Time ) o qr_col - -
-var real qi_col ( nCells Time ) o qi_col - -
-var real qs_col ( nCells Time ) o qs_col - -
-var real qg_col ( nCells Time ) o qg_col - -
+var persistent real qv_col ( nCells Time ) 2 o qv_col state - -
+var persistent real qc_col ( nCells Time ) 2 o qc_col state - -
+var persistent real qr_col ( nCells Time ) 2 o qr_col state - -
+var persistent real qi_col ( nCells Time ) 2 o qi_col state - -
+var persistent real qs_col ( nCells Time ) 2 o qs_col state - -
+var persistent real qg_col ( nCells Time ) 2 o qg_col state - -
#--------------------------------------------------------------------------------------------------
#... PARAMETERIZATION OF CLOUD MICROPHYSICS:
@@ -226,13 +242,13 @@
# graupelncv: time-step grid-scale precipitation of graupel (mm)
# sr : time-step ratio of frozen versus total grid-scale precipitation (-)
-var real rainnc ( nCells Time ) ro rainnc - -
-var real rainncv ( nCells Time ) ro rainncv - -
-var real snownc ( nCells Time ) ro snownc - -
-var real snowncv ( nCells Time ) ro snowncv - -
-var real graupelnc ( nCells Time ) ro graupelnc - -
-var real graupelncv ( nCells Time ) ro graupelncv - -
-var real sr ( nCells Time ) o sr - -
+var persistent real rainnc ( nCells Time ) 2 ro rainnc state - -
+var persistent real rainncv ( nCells Time ) 2 ro rainncv state - -
+var persistent real snownc ( nCells Time ) 2 ro snownc state - -
+var persistent real snowncv ( nCells Time ) 2 ro snowncv state - -
+var persistent real graupelnc ( nCells Time ) 2 ro graupelnc state - -
+var persistent real graupelncv ( nCells Time ) 2 ro graupelncv state - -
+var persistent real sr ( nCells Time ) 2 o sr state - -
#--------------------------------------------------------------------------------------------------
#... PARAMETERIZATION OF CONVECTION:
@@ -251,22 +267,22 @@
# rqscuten : tendency of snow mixing ratio due to cumulus convection (kg/kg s-1)
# wavg : average vertical velocity (KF scheme only) (m s-1)
-var real nca ( nCells Time ) ro nca - -
-var real cubot ( nCells Time ) ro cubot - -
-var real cutop ( nCells Time ) ro cutop - -
+var persistent real nca ( nCells Time ) 2 ro nca state - -
+var persistent real cubot ( nCells Time ) 2 ro cubot state - -
+var persistent real cutop ( nCells Time ) 2 ro cutop state - -
# PRECIPITATION:
-var real rainc ( nCells Time ) ro rainc - -
-var real raincv ( nCells Time ) ro raincv - -
+var persistent real rainc ( nCells Time ) 2 ro rainc state - -
+var persistent real raincv ( nCells Time ) 2 ro raincv state - -
# TENDENCIES:
-var real rthcuten ( nVertLevels nCells Time ) ro rthcuten - -
-var real rqvcuten ( nVertLevels nCells Time ) ro rqvcuten - -
-var real rqccuten ( nVertLevels nCells Time ) ro rqccuten - -
-var real rqrcuten ( nVertLevels nCells Time ) ro rqrcuten - -
-var real rqicuten ( nVertLevels nCells Time ) ro rqicuten - -
-var real rqscuten ( nVertLevels nCells Time ) ro rqscuten - -
-var real w0avg ( nVertLevels nCells Time ) ro w0avg - -
+var persistent real rthcuten ( nVertLevels nCells Time ) 2 ro rthcuten state - -
+var persistent real rqvcuten ( nVertLevels nCells Time ) 2 ro rqvcuten state - -
+var persistent real rqccuten ( nVertLevels nCells Time ) 2 ro rqccuten state - -
+var persistent real rqrcuten ( nVertLevels nCells Time ) 2 ro rqrcuten state - -
+var persistent real rqicuten ( nVertLevels nCells Time ) 2 ro rqicuten state - -
+var persistent real rqscuten ( nVertLevels nCells Time ) 2 ro rqscuten state - -
+var persistent real w0avg ( nVertLevels nCells Time ) 2 ro w0avg state - -
#--------------------------------------------------------------------------------------------------
#... PARAMETERIZATION OF PLANETARY BOUNDARY LAYER PROCESSES:
@@ -278,12 +294,12 @@
# rqiblten : tendency of cloud ice mixing ratio due to pbl processes (kg/kg s-1)
# TENDENCIES:
-var real rublten ( nVertLevels nCells Time ) ro rublten - -
-var real rvblten ( nVertLevels nCells Time ) ro rvblten - -
-var real rthblten ( nVertLevels nCells Time ) ro rthblten - -
-var real rqvblten ( nVertLevels nCells Time ) ro rqvblten - -
-var real rqcblten ( nVertLevels nCells Time ) ro rqcblten - -
-var real rqiblten ( nVertLevels nCells Time ) ro rqiblten - -
+var persistent real rublten ( nVertLevels nCells Time ) 2 ro rublten state - -
+var persistent real rvblten ( nVertLevels nCells Time ) 2 ro rvblten state - -
+var persistent real rthblten ( nVertLevels nCells Time ) 2 ro rthblten state - -
+var persistent real rqvblten ( nVertLevels nCells Time ) 2 ro rqvblten state - -
+var persistent real rqcblten ( nVertLevels nCells Time ) 2 ro rqcblten state - -
+var persistent real rqiblten ( nVertLevels nCells Time ) 2 ro rqiblten state - -
#--------------------------------------------------------------------------------------------------
#... PARAMETERIZATION OF SURFACE LAYER PROCESSES:
@@ -311,26 +327,26 @@
# xland :land mask (1 for land; 2 for water) [-]
# znt :time-varying roughness length [m]
-var real flhc ( nCells Time ) r flhc - -
-var real flqc ( nCells Time ) r flqc - -
-var real hfx ( nCells Time ) r hfx - -
-var real lh ( nCells Time ) r lh - -
-var real mavail ( nCells Time ) r mavail - -
-var real mol ( nCells Time ) r mol - -
-var real pblh ( nCells Time ) r pblh - -
-var real q2 ( nCells Time ) r q2 - -
-var real qfx ( nCells Time ) r qfx - -
-var real qsfc ( nCells Time ) r qsfc - -
-var real regime ( nCells Time ) r regime - -
-var real rmol ( nCells Time ) r rmol - -
-var real t2 ( nCells Time ) r t2 - -
-var real tsk ( nCells Time ) r tsk - -
-var real th2 ( nCells Time ) r th2 - -
-var real u10 ( nCells Time ) r u10 - -
-var real ust ( nCells Time ) r ust - -
-var real ustm ( nCells Time ) r ustm - -
-var real v10 ( nCells Time ) r v10 - -
-var real xland ( nCells Time ) r xland - -
-var real znt ( nCells Time ) r znt - -
+var persistent real flhc ( nCells Time ) 2 r flhc state - -
+var persistent real flqc ( nCells Time ) 2 r flqc state - -
+var persistent real hfx ( nCells Time ) 2 r hfx state - -
+var persistent real lh ( nCells Time ) 2 r lh state - -
+var persistent real mavail ( nCells Time ) 2 r mavail state - -
+var persistent real mol ( nCells Time ) 2 r mol state - -
+var persistent real pblh ( nCells Time ) 2 r pblh state - -
+var persistent real q2 ( nCells Time ) 2 r q2 state - -
+var persistent real qfx ( nCells Time ) 2 r qfx state - -
+var persistent real qsfc ( nCells Time ) 2 r qsfc state - -
+var persistent real regime ( nCells Time ) 2 r regime state - -
+var persistent real rmol ( nCells Time ) 2 r rmol state - -
+var persistent real t2 ( nCells Time ) 2 r t2 state - -
+var persistent real tsk ( nCells Time ) 2 r tsk state - -
+var persistent real th2 ( nCells Time ) 2 r th2 state - -
+var persistent real u10 ( nCells Time ) 2 r u10 state - -
+var persistent real ust ( nCells Time ) 2 r ust state - -
+var persistent real ustm ( nCells Time ) 2 r ustm state - -
+var persistent real v10 ( nCells Time ) 2 r v10 state - -
+var persistent real xland ( nCells Time ) 2 r xland state - -
+var persistent real znt ( nCells Time ) 2 r znt state - -
#==================================================================================================
Modified: branches/atmos_physics/src/core_hyd_atmos/module_advection.F
===================================================================
--- branches/atmos_physics/src/core_hyd_atmos/module_advection.F 2010-10-13 18:01:28 UTC (rev 548)
+++ branches/atmos_physics/src/core_hyd_atmos/module_advection.F 2010-10-13 20:25:17 UTC (rev 549)
@@ -17,7 +17,7 @@
!
implicit none
- type (grid_meta), intent(in) :: grid
+ type (mesh_type), intent(in) :: grid
real (kind=RKIND), dimension(:,:,:), pointer :: deriv_two
integer, dimension(:,:), pointer :: advCells
Modified: branches/atmos_physics/src/core_hyd_atmos/module_test_cases.F
===================================================================
--- branches/atmos_physics/src/core_hyd_atmos/module_test_cases.F 2010-10-13 18:01:28 UTC (rev 548)
+++ branches/atmos_physics/src/core_hyd_atmos/module_test_cases.F 2010-10-13 20:25:17 UTC (rev 549)
@@ -35,9 +35,9 @@
if (config_test_case == 3) write(0,*) ' normal-mode perturbation included '
block_ptr => domain % blocklist
do while (associated(block_ptr))
- call hyd_test_case_1(block_ptr % mesh, block_ptr % time_levs(1) % state, config_test_case)
+ call hyd_test_case_1(block_ptr % mesh, block_ptr % state % time_levs(1) % state, config_test_case)
do i=2,nTimeLevs
- call copy_state(block_ptr % time_levs(1) % state, block_ptr % time_levs(i) % state)
+ call copy_state(block_ptr % state % time_levs(i) % state, block_ptr % state % time_levs(1) % state)
end do
block_ptr => block_ptr % next
@@ -59,8 +59,8 @@
implicit none
- type (grid_meta), intent(inout) :: grid
- type (grid_state), intent(inout) :: state
+ type (mesh_type), intent(inout) :: grid
+ type (state_type), intent(inout) :: state
integer, intent(in) :: test_case
real (kind=RKIND), parameter :: u0 = 35.0
@@ -78,7 +78,7 @@
real (kind=RKIND), dimension(:,:), pointer :: pressure, theta, alpha, geopotential, h
real (kind=RKIND), dimension(:,:,:), pointer :: scalars
- integer :: iCell, iEdge, vtx1, vtx2, ivtx, k, nz, nz1
+ integer :: iCell, iEdge, vtx1, vtx2, ivtx, k, nz, nz1, index_qv
real (kind=RKIND) :: u, v, flux, fluxk, lat1, lat2, eta_v, r_pert, u_pert, lat_pert, lon_pert, r
real (kind=RKIND) :: ptop, p0, phi
@@ -129,6 +129,8 @@
grid % areaCell % array = grid % areaCell % array * a**2.0
grid % areaTriangle % array = grid % areaTriangle % array * a**2.0
grid % kiteAreasOnVertex % array = grid % kiteAreasOnVertex % array * a**2.0
+
+ index_qv = state % index_qv
nz1 = grid % nVertLevels
nz = nz1 + 1
Modified: branches/atmos_physics/src/core_hyd_atmos/module_time_integration.F
===================================================================
--- branches/atmos_physics/src/core_hyd_atmos/module_time_integration.F 2010-10-13 18:01:28 UTC (rev 548)
+++ branches/atmos_physics/src/core_hyd_atmos/module_time_integration.F 2010-10-13 20:25:17 UTC (rev 549)
@@ -42,7 +42,7 @@
block => domain % blocklist
do while (associated(block))
- block % time_levs(2) % state % xtime % scalar = block % time_levs(1) % state % xtime % scalar + dt
+ block % state % time_levs(2) % state % xtime % scalar = block % state % time_levs(1) % state % xtime % scalar + dt
block => block % next
end do
@@ -71,7 +71,6 @@
integer :: iCell, k
type (block_type), pointer :: block
- integer, parameter :: TEND = 1
integer :: rk_step, number_of_sub_steps
integer :: iScalar
@@ -107,7 +106,7 @@
block => domain % blocklist
do while (associated(block))
- call copy_state( block % time_levs(1) % state, block % time_levs(2) % state )
+ call copy_state( block % state % time_levs(2) % state, block % state % time_levs(1) % state )
block => block % next
end do
@@ -128,26 +127,26 @@
call dmpar_exch_halo_field2dReal(domain % dminfo, block % mesh % cqu % array(:,:), &
block % mesh % nVertLevels, block % mesh % nEdges, &
block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % time_levs(2) % state % h % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % h % array(:,:), &
block % mesh % nVertLevels, block % mesh % nCells, &
block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % time_levs(2) % state % pressure % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % pressure % array(:,:), &
block % mesh % nVertLevels+1, block % mesh % nCells, &
block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % time_levs(2) % state % geopotential % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % geopotential % array(:,:), &
block % mesh % nVertLevels+1, block % mesh % nCells, &
block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % time_levs(2) % state % alpha % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % alpha % array(:,:), &
block % mesh % nVertLevels, block % mesh % nCells, &
block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % time_levs(2) % state % pv_edge % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % pv_edge % array(:,:), &
block % mesh % nVertLevels, block % mesh % nEdges, &
block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
if (config_h_mom_eddy_visc4 > 0.0) then
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % time_levs(2) % state % divergence % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % divergence % array(:,:), &
block % mesh % nVertLevels, block % mesh % nCells, &
block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % time_levs(2) % state % vorticity % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % vorticity % array(:,:), &
block % mesh % nVertLevels, block % mesh % nVertices, &
block % parinfo % verticesToSend, block % parinfo % verticesToRecv)
end if
@@ -158,20 +157,20 @@
block => domain % blocklist
do while (associated(block))
- call compute_dyn_tend( block % intermediate_step(TEND), block % time_levs(2) % state, block % mesh )
+ call compute_dyn_tend( block % tend, block % state % time_levs(2) % state, block % mesh )
block => block % next
end do
-
+
if(debug) write(0,*) ' returned from dyn_tend '
!#ifdef DO_PHYSICS
! if (debug) write(0,*) ' add physics tendencies '
! block => domain % blocklist
! do while (associated(block))
-! call physics_addtend( block % intermediate_step(TEND), block % time_levs(2) % state, &
-! block % time_levs(2) % state % h % array, block % mesh )
-! call dmpar_exch_halo_field3dReal(domain % dminfo, block % intermediate_step(TEND) % scalars % array(:,:,:), &
-! num_scalars, block % mesh % nVertLevels, block % mesh % nCells, &
+! call physics_addtend( block % tend, block % state % time_levs(2) % state, &
+! block % state % time_levs(2) % state % h % array, block % mesh )
+! call dmpar_exch_halo_field3dReal(domain % dminfo, block % tend % scalars % array(:,:,:), &
+! block % state % time_levs(2) % state % num_scalars, block % mesh % nVertLevels, block % mesh % nCells, &
! block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
! block => block % next
! end do
@@ -183,12 +182,12 @@
!
block => domain % blocklist
do while (associated(block))
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % intermediate_step(TEND) % u % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % tend % u % array(:,:), &
block % mesh % nVertLevels, block % mesh % nEdges, &
block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % intermediate_step(TEND) % theta % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % tend % theta % array(:,:), &
block % mesh % nVertLevels, block % mesh % nCells, &
- block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
+ block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
block => block % next
end do
@@ -202,9 +201,9 @@
! from the previous RK step are needed to compute new scalar tendencies in advance_scalars.
! A cleaner way of preserving scalars should be added in future.
!
- block % mesh % scalars_old % array(:,:,:) = block % time_levs(2) % state % scalars % array(:,:,:)
- call copy_state( block % time_levs(1) % state, block % time_levs(2) % state )
- block % time_levs(2) % state % scalars % array(:,:,:) = block % mesh % scalars_old % array(:,:,:)
+ block % mesh % scalars_old % array(:,:,:) = block % state % time_levs(2) % state % scalars % array(:,:,:)
+ call copy_state( block % state % time_levs(2) % state, block % state % time_levs(1) % state )
+ block % state % time_levs(2) % state % scalars % array(:,:,:) = block % mesh % scalars_old % array(:,:,:)
block => block % next
end do
@@ -216,8 +215,8 @@
block => domain % blocklist
do while (associated(block))
- call advance_dynamics( block % intermediate_step(TEND), block % time_levs(2) % state, &
- block % mesh,small_step, number_sub_steps(rk_step), &
+ call advance_dynamics( block % tend, block % state % time_levs(2) % state, &
+ block % mesh, small_step, number_sub_steps(rk_step), &
rk_sub_timestep(rk_step), rk_step )
block => block % next
end do
@@ -230,10 +229,10 @@
!
block => domain % blocklist
do while (associated(block))
-!! call dmpar_exch_halo_field2dReal(domain % dminfo, block % time_levs(2) % state % u % array(:,:), &
+!! call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % u % array(:,:), &
!! block % mesh % nVertLevels, block % mesh % nEdges, &
!! block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % time_levs(2) % state % h_edge % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % h_edge % array(:,:), &
block % mesh % nVertLevels, block % mesh % nEdges, &
block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
!! call dmpar_exch_halo_field2dReal(domain % dminfo, block % mesh % uhAvg % array(:,:), &
@@ -242,34 +241,34 @@
!! call dmpar_exch_halo_field2dReal(domain % dminfo, block % mesh % wwAvg % array(:,:), &
!! block % mesh % nVertLevels+1, block % mesh % nCells, &
!! block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % time_levs(2) % state % theta % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % theta % array(:,:), &
block % mesh % nVertLevels, block % mesh % nCells, &
block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
-!! call dmpar_exch_halo_field2dReal(domain % dminfo, block % time_levs(2) % state % h % array(:,:), &
+!! call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % h % array(:,:), &
!! block % mesh % nVertLevels, block % mesh % nCells, &
!! block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
-!! call dmpar_exch_halo_field2dReal(domain % dminfo, block % intermediate_step(TEND) % h % array(:,:), &
+!! call dmpar_exch_halo_field2dReal(domain % dminfo, block % tend % h % array(:,:), &
!! block % mesh % nVertLevels, block % mesh % nCells, &
!! block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
call dmpar_exch_halo_field1dReal(domain % dminfo, block % mesh % dpsdt % array(:), &
block % mesh % nCells, &
block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
- call dmpar_exch_halo_field1dReal(domain % dminfo, block % time_levs(2) % state % surface_pressure % array(:), &
+ call dmpar_exch_halo_field1dReal(domain % dminfo, block % state % time_levs(2) % state % surface_pressure % array(:), &
block % mesh % nCells, &
block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % time_levs(2) % state % alpha % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % alpha % array(:,:), &
block % mesh % nVertLevels, block % mesh % nCells, &
block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % time_levs(2) % state % ww % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % ww % array(:,:), &
block % mesh % nVertLevels+1, block % mesh % nCells, &
block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % time_levs(2) % state % pressure % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % pressure % array(:,:), &
block % mesh % nVertLevels+1, block % mesh % nCells, &
block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
!! call dmpar_exch_halo_field2dReal(domain % dminfo, block % mesh % pressure_old % array(:,:), &
!! block % mesh % nVertLevels+1, block % mesh % nCells, &
!! block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % time_levs(2) % state % geopotential % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % geopotential % array(:,:), &
block % mesh % nVertLevels+1, block % mesh % nCells, &
block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
block => block % next
@@ -279,6 +278,7 @@
if(debug) write(0,*) ' advance scalars '
+
! --- advance scalars with time integrated mass fluxes
block => domain % blocklist
@@ -289,28 +289,25 @@
! so we keep the advance_scalars routine as well
!
if (rk_step < 3 .or. (.not. config_monotonic .and. .not. config_positive_definite)) then
-
- call advance_scalars( block % intermediate_step(TEND), &
- block % time_levs(1) % state, block % time_levs(2) % state, &
+ call advance_scalars( block % tend, &
+ block % state % time_levs(1) % state, block % state % time_levs(2) % state, &
block % mesh, rk_timestep(rk_step) )
else
-
- call advance_scalars_mono( block % intermediate_step(TEND), &
- block % time_levs(1) % state, block % time_levs(2) % state, &
- block % mesh, rk_timestep(rk_step), rk_step, 3, &
+ call advance_scalars_mono( block % tend, &
+ block % state % time_levs(1) % state, block % state % time_levs(2) % state, &
+ block % mesh, rk_timestep(rk_step), rk_step, 3, &
domain % dminfo, block % parinfo % cellsToSend, block % parinfo % cellsToRecv )
end if
-
block => block % next
end do
block => domain % blocklist
do while (associated(block))
- call dmpar_exch_halo_field3dReal(domain % dminfo, block % intermediate_step(TEND) % scalars % array(:,:,:), &
- num_scalars, block % mesh % nVertLevels, block % mesh % nCells, &
+ call dmpar_exch_halo_field3dReal(domain % dminfo, block % tend % scalars % array(:,:,:), &
+ block % tend % num_scalars, block % mesh % nVertLevels, block % mesh % nCells, &
block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
- call dmpar_exch_halo_field3dReal(domain % dminfo, block % time_levs(2) % state % scalars % array(:,:,:), &
- num_scalars, block % mesh % nVertLevels, block % mesh % nCells, &
+ call dmpar_exch_halo_field3dReal(domain % dminfo, block % state % time_levs(2) % state % scalars % array(:,:,:), &
+ block % tend % num_scalars, block % mesh % nVertLevels, block % mesh % nCells, &
block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
block => block % next
end do
@@ -322,9 +319,9 @@
block => domain % blocklist
do while (associated(block))
- call compute_solver_constants( block % time_levs(2) % state, block % mesh )
- call compute_state_diagnostics( block % time_levs(2) % state, block % mesh )
- call compute_solve_diagnostics( dt, block % time_levs(2) % state, block % mesh )
+ call compute_solver_constants( block % state % time_levs(2) % state, block % mesh )
+ call compute_state_diagnostics( block % state % time_levs(2) % state, block % mesh )
+ call compute_solve_diagnostics( dt, block % state % time_levs(2) % state, block % mesh )
block => block % next
end do
@@ -343,8 +340,8 @@
!
block => domain % blocklist
do while (associated(block))
- call reconstruct(block % time_levs(2) % state, block % mesh)
- call compute_w(block % time_levs(2) % state, block % time_levs(1) % state, block % mesh, dt)
+ call reconstruct(block % state % time_levs(2) % state, block % diag, block % mesh)
+ call compute_w(block % state % time_levs(2) % state, block % state % time_levs(1) % state, block % mesh, dt)
block => block % next
end do
@@ -354,22 +351,21 @@
domain_mass = 0.
scalar_mass = 0.
block => domain % blocklist
- scalar_min = block % time_levs(2) % state % scalars % array (2,1,1)
- scalar_max = block % time_levs(2) % state % scalars % array (2,1,1)
+ scalar_min = block % state % time_levs(2) % state % scalars % array (2,1,1)
+ scalar_max = block % state % time_levs(2) % state % scalars % array (2,1,1)
do while(associated(block))
do iCell = 1, block % mesh % nCellsSolve
- domain_mass = domain_mass + block % time_levs(2) % state % surface_pressure % array (iCell) * &
+ domain_mass = domain_mass + block % state % time_levs(2) % state % surface_pressure % array (iCell) * &
block % mesh % areaCell % array (iCell) &
- - block % time_levs(2) % state % pressure % array (block % mesh % nVertLevels + 1, 1) * &
+ - block % state % time_levs(2) % state % pressure % array (block % mesh % nVertLevels + 1, 1) * &
block % mesh % areaCell % array (iCell)
-
do k=1, block % mesh % nVertLevelsSolve
- scalar_mass = scalar_mass - block % time_levs(2) % state % scalars % array (2,k,iCell) * &
- block % time_levs(2) % state % h % array (k,iCell) * &
+ scalar_mass = scalar_mass - block % state % time_levs(2) % state % scalars % array (2,k,iCell) * &
+ block % state % time_levs(2) % state % h % array (k,iCell) * &
block % mesh % dnw % array (k) * &
block % mesh % areaCell % array (iCell)
- scalar_min = min(scalar_min,block % time_levs(2) % state % scalars % array (2,k,iCell))
- scalar_max = max(scalar_max,block % time_levs(2) % state % scalars % array (2,k,iCell))
+ scalar_min = min(scalar_min,block % state % time_levs(2) % state % scalars % array (2,k,iCell))
+ scalar_max = max(scalar_max,block % state % time_levs(2) % state % scalars % array (2,k,iCell))
end do
end do
block => block % next
@@ -390,15 +386,15 @@
!call microphysics schemes:
if(config_microp_scheme .ne. 'off') &
- call microphysics_driver ( block % time_levs(2) % state, block % mesh, itimestep )
+ call microphysics_driver ( block % state % time_levs(2) % state, block % mesh, itimestep )
- do iScalar = 1, num_scalars
+ do iScalar = 1, block % state % time_levs(2) % state % num_scalars
scalar_min = 0.
scalar_max = 0.
do iCell = 1, block % mesh % nCellsSolve
do k = 1, block % mesh % nVertLevels
- scalar_min = min(scalar_min, block % time_levs(2) % state % scalars % array(iScalar,k,iCell))
- scalar_max = max(scalar_max, block % time_levs(2) % state % scalars % array(iScalar,k,iCell))
+ scalar_min = min(scalar_min, block % state % time_levs(2) % state % scalars % array(iScalar,k,iCell))
+ scalar_max = max(scalar_max, block % state % time_levs(2) % state % scalars % array(iScalar,k,iCell))
enddo
enddo
write(0,*) ' min, max scalar ',iScalar, scalar_min, scalar_max
@@ -426,8 +422,8 @@
implicit none
- type (grid_state), intent(in) :: s
- type (grid_meta), intent(inout) :: grid
+ type (state_type), intent(in) :: s
+ type (mesh_type), intent(inout) :: grid
integer :: iEdge, iCell, k, cell1, cell2, iq
@@ -440,11 +436,11 @@
grid % qtot % array = 0.
grid % cqu % array = 1.
- if (num_scalars > 0) then
+ if (s % num_scalars > 0) then
do iCell = 1, nCells
do k = 1, nVertLevels
- do iq = moist_start, moist_end
+ do iq = s % moist_start, s % moist_end
grid % qtot % array(k,iCell) = grid % qtot % array(k,iCell) + s % scalars % array (iq, k, iCell)
end do
end do
@@ -478,8 +474,8 @@
implicit none
- type (grid_state), intent(inout) :: s
- type (grid_meta), intent(inout) :: grid
+ type (state_type), intent(inout) :: s
+ type (mesh_type), intent(inout) :: grid
real (kind=RKIND), dimension(:,:,:), pointer :: scalar
real (kind=RKIND), dimension(:,:), pointer :: h, pressure, qtot, alpha, geopotential, theta
@@ -569,9 +565,9 @@
implicit none
- type (grid_state), intent(inout) :: tend
- type (grid_state), intent(in) :: s
- type (grid_meta), intent(in) :: grid
+ type (tend_type), intent(inout) :: tend
+ type (state_type), intent(in) :: s
+ type (mesh_type), intent(in) :: grid
integer :: iEdge, iCell, iVertex, k, cell1, cell2, vertex1, vertex2, eoe, i, j
real (kind=RKIND) :: flux, vorticity_abs, h_vertex, workpv, q, upstream_bias
@@ -608,7 +604,6 @@
pv_edge => s % pv_edge % array
geopotential => s % geopotential % array
theta => s % theta % array
- h_diabatic => s % h_diabatic % array
weightsOnEdge => grid % weightsOnEdge % array
cellsOnEdge => grid % cellsOnEdge % array
@@ -625,6 +620,7 @@
vh => tend % vh % array
tend_u => tend % u % array
tend_theta => tend % theta % array
+ h_diabatic => s % h_diabatic % array
ww => s % ww % array
rdnu => grid % rdnu % array
@@ -865,6 +861,8 @@
!----------- rhs for theta
tend_theta(:,:) = 0.
+
+
!
! horizontal mixing for theta - we could combine this with advection directly (i.e. as a turbulent flux),
! but here we can also code in hyperdiffusion if we wish (2nd order at present)
@@ -1070,9 +1068,9 @@
implicit none
- type (grid_state), intent(in) :: tend
- type (grid_state), intent(inout) :: s
- type (grid_meta), intent(in) :: grid
+ type (tend_type), intent(in) :: tend
+ type (state_type), intent(inout) :: s
+ type (mesh_type), intent(in) :: grid
real (kind=RKIND), intent(in) :: dt
integer, intent(in) :: small_step, number_small_steps, rk_step
@@ -1335,13 +1333,13 @@
implicit none
- type (grid_state), intent(in) :: tend
- type (grid_state), intent(in) :: s_old
- type (grid_state), intent(out) :: s_new
- type (grid_meta), intent(in) :: grid
+ type (tend_type), intent(in) :: tend
+ type (state_type), intent(in) :: s_old
+ type (state_type), intent(inout) :: s_new
+ type (mesh_type), intent(in) :: grid
real (kind=RKIND) :: dt
- integer :: i, iCell, iEdge, k, iScalar, cell1, cell2
+ integer :: i, iCell, iEdge, k, iScalar, cell1, cell2, num_scalars
real (kind=RKIND) :: flux, scalar_edge, d2fdx2_cell1, d2fdx2_cell2
real (kind=RKIND), dimension(:,:,:), pointer :: scalar_old, scalar_new, scalar_tend
@@ -1350,12 +1348,14 @@
real (kind=RKIND), dimension(:), pointer :: dvEdge, dcEdge, areaCell
integer, dimension(:,:), pointer :: cellsOnEdge
- real (kind=RKIND), dimension( num_scalars, grid % nVertLevels + 1 ) :: wdtn
+ real (kind=RKIND), dimension( s_old % num_scalars, grid % nVertLevels + 1 ) :: wdtn
integer :: nVertLevels
real (kind=RKIND), dimension(:), pointer :: fnm, fnp, rdnw
real (kind=RKIND) :: coef_3rd_order
+ num_scalars = s_old % num_scalars
+
coef_3rd_order = 0.
if (config_scalar_adv_order == 3) coef_3rd_order = 1.0
if (config_scalar_adv_order == 3 .and. config_monotonic) coef_3rd_order = 0.25
@@ -1380,6 +1380,7 @@
nVertLevels = grid % nVertLevels
scalar_tend = 0. ! testing purposes - we have no sources or sinks
+
!
! Runge Kutta integration, so we compute fluxes from scalar_new values, update starts form scalar_old
!
@@ -1521,16 +1522,16 @@
implicit none
- type (grid_state), intent(in) :: tend
- type (grid_state), intent(in) :: s_old
- type (grid_state), intent(out) :: s_new
- type (grid_meta), intent(in) :: grid
+ type (tend_type), intent(in) :: tend
+ type (state_type), intent(in) :: s_old
+ type (state_type), intent(inout) :: s_new
+ type (mesh_type), intent(in) :: grid
integer, intent(in) :: rk_step, rk_order
real (kind=RKIND), intent(in) :: dt
type (dm_info), intent(in) :: dminfo
type (exchange_list), pointer :: cellsToSend, cellsToRecv
- integer :: i, iCell, iEdge, k, iScalar, cell_upwind, cell1, cell2
+ integer :: i, iCell, iEdge, k, iScalar, cell_upwind, cell1, cell2, num_scalars
real (kind=RKIND) :: flux, scalar_edge, d2fdx2_cell1, d2fdx2_cell2
real (kind=RKIND) :: fdir, flux_upwind, h_flux_upwind, s_upwind
@@ -1540,10 +1541,10 @@
real (kind=RKIND), dimension(:), pointer :: dvEdge, dcEdge, areaCell
integer, dimension(:,:), pointer :: cellsOnEdge
- real (kind=RKIND), dimension( num_scalars, grid % nEdges+1) :: h_flux
- real (kind=RKIND), dimension( num_scalars, grid % nCells+1, 2 ) :: v_flux, v_flux_upwind, s_update
- real (kind=RKIND), dimension( num_scalars, grid % nCells+1, 2 ) :: scale_out, scale_in
- real (kind=RKIND), dimension( num_scalars ) :: s_max, s_min, s_max_update, s_min_update
+ real (kind=RKIND), dimension( s_old % num_scalars, grid % nEdges+1) :: h_flux
+ real (kind=RKIND), dimension( s_old % num_scalars, grid % nCells+1, 2 ) :: v_flux, v_flux_upwind, s_update
+ real (kind=RKIND), dimension( s_old % num_scalars, grid % nCells+1, 2 ) :: scale_out, scale_in
+ real (kind=RKIND), dimension( s_old % num_scalars ) :: s_max, s_min, s_max_update, s_min_update
integer :: nVertLevels, km0, km1, ktmp, kcp1, kcm1
@@ -1551,6 +1552,8 @@
real (kind=RKIND), parameter :: eps=1.e-20
real (kind=RKIND) :: coef_3rd_order
+ num_scalars = s_old % num_scalars
+
scalar_old => s_old % scalars % array
scalar_new => s_new % scalars % array
deriv_two => grid % deriv_two % array
@@ -1853,8 +1856,8 @@
implicit none
real (kind=RKIND), intent(in) :: dt
- type (grid_state), intent(inout) :: s
- type (grid_meta), intent(in) :: grid
+ type (state_type), intent(inout) :: s
+ type (mesh_type), intent(in) :: grid
integer :: iEdge, iCell, iVertex, k, cell1, cell2, vertex1, vertex2, eoe, i, j, cov
@@ -2104,9 +2107,9 @@
implicit none
- type (grid_state), intent(inout) :: s_new
- type (grid_state), intent(in) :: s_old
- type (grid_meta), intent(inout) :: grid
+ type (state_type), intent(inout) :: s_new
+ type (state_type), intent(in) :: s_old
+ type (mesh_type), intent(inout) :: grid
real (kind=RKIND), intent(in) :: dt
Modified: branches/atmos_physics/src/core_hyd_atmos/mpas_interface.F
===================================================================
--- branches/atmos_physics/src/core_hyd_atmos/mpas_interface.F 2010-10-13 18:01:28 UTC (rev 548)
+++ branches/atmos_physics/src/core_hyd_atmos/mpas_interface.F 2010-10-13 20:25:17 UTC (rev 549)
@@ -28,16 +28,16 @@
implicit none
type (block_type), intent(inout) :: block
- type (grid_meta), intent(inout) :: mesh
+ type (mesh_type), intent(inout) :: mesh
real (kind=RKIND), intent(in) :: dt
- call compute_solver_constants(block % time_levs(1) % state, mesh)
- call compute_state_diagnostics(block % time_levs(1) % state, mesh)
- call compute_solve_diagnostics(dt, block % time_levs(1) % state, mesh)
+ call compute_solver_constants(block % state % time_levs(1) % state, mesh)
+ call compute_state_diagnostics(block % state % time_levs(1) % state, mesh)
+ call compute_solve_diagnostics(dt, block % state % time_levs(1) % state, mesh)
call initialize_advection_rk(mesh)
call rbfInterp_initialize(mesh)
call init_reconstruct(mesh)
- call reconstruct(block % time_levs(1) % state, mesh)
+ call reconstruct(block % state % time_levs(1) % state, block % diag, mesh)
#ifdef DO_PHYSICS
!check that all the physics options are correctly defined and that at least one physics
@@ -46,9 +46,9 @@
!proceed with initialization of physics parameterization if moist_physics is set to true:
if(moist_physics) then
- call physics_registry_init(config_do_restart, mesh, block % time_levs(1) % state)
+ call physics_registry_init(config_do_restart, mesh, block % state % time_levs(1) % state)
call physics_wrf_interface(mesh)
- call physics_init(mesh, block % time_levs(1) % state)
+ call physics_init(mesh, block % state % time_levs(1) % state)
endif
#endif
Modified: branches/atmos_physics/src/core_nhyd_atmos/Registry
===================================================================
--- branches/atmos_physics/src/core_nhyd_atmos/Registry 2010-10-13 18:01:28 UTC (rev 548)
+++ branches/atmos_physics/src/core_nhyd_atmos/Registry 2010-10-13 20:25:17 UTC (rev 549)
@@ -30,7 +30,7 @@
namelist integer nhyd_model config_mp_physics 0.
namelist real nhyd_model config_epssm 0.1
namelist real nhyd_model config_smdiv 0.1
-
+namelist integer dimensions config_nvertlevels 26
namelist character io config_input_name grid.nc
namelist character io config_output_name output.nc
namelist character io config_restart_name restart.nc
@@ -52,201 +52,206 @@
dim FIFTEEN 15
dim TWENTYONE 21
dim R3 3
-dim nVertLevels nVertLevels
+dim nVertLevels namelist:config_nvertlevels
dim nVertLevelsP1 nVertLevels+1
#
# var type name_in_file ( dims ) iro- name_in_code super-array array_class
#
-var real xtime ( Time ) ro xtime - -
+var persistent real xtime ( Time ) 2 ro xtime state - -
# horizontal grid structure
-var real latCell ( nCells ) iro latCell - -
-var real lonCell ( nCells ) iro lonCell - -
-var real xCell ( nCells ) iro xCell - -
-var real yCell ( nCells ) iro yCell - -
-var real zCell ( nCells ) iro zCell - -
-var integer indexToCellID ( nCells ) iro indexToCellID - -
+var persistent real latCell ( nCells ) 0 iro latCell mesh - -
+var persistent real lonCell ( nCells ) 0 iro lonCell mesh - -
+var persistent real xCell ( nCells ) 0 iro xCell mesh - -
+var persistent real yCell ( nCells ) 0 iro yCell mesh - -
+var persistent real zCell ( nCells ) 0 iro zCell mesh - -
+var persistent integer indexToCellID ( nCells ) 0 iro indexToCellID mesh - -
-var real latEdge ( nEdges ) iro latEdge - -
-var real lonEdge ( nEdges ) iro lonEdge - -
-var real xEdge ( nEdges ) iro xEdge - -
-var real yEdge ( nEdges ) iro yEdge - -
-var real zEdge ( nEdges ) iro zEdge - -
-var integer indexToEdgeID ( nEdges ) iro indexToEdgeID - -
+var persistent real latEdge ( nEdges ) 0 iro latEdge mesh - -
+var persistent real lonEdge ( nEdges ) 0 iro lonEdge mesh - -
+var persistent real xEdge ( nEdges ) 0 iro xEdge mesh - -
+var persistent real yEdge ( nEdges ) 0 iro yEdge mesh - -
+var persistent real zEdge ( nEdges ) 0 iro zEdge mesh - -
+var persistent integer indexToEdgeID ( nEdges ) 0 iro indexToEdgeID mesh - -
-var real latVertex ( nVertices ) iro latVertex - -
-var real lonVertex ( nVertices ) iro lonVertex - -
-var real xVertex ( nVertices ) iro xVertex - -
-var real yVertex ( nVertices ) iro yVertex - -
-var real zVertex ( nVertices ) iro zVertex - -
-var integer indexToVertexID ( nVertices ) iro indexToVertexID - -
+var persistent real latVertex ( nVertices ) 0 iro latVertex mesh - -
+var persistent real lonVertex ( nVertices ) 0 iro lonVertex mesh - -
+var persistent real xVertex ( nVertices ) 0 iro xVertex mesh - -
+var persistent real yVertex ( nVertices ) 0 iro yVertex mesh - -
+var persistent real zVertex ( nVertices ) 0 iro zVertex mesh - -
+var persistent integer indexToVertexID ( nVertices ) 0 iro indexToVertexID mesh - -
-var integer cellsOnEdge ( TWO nEdges ) iro cellsOnEdge - -
-var integer nEdgesOnCell ( nCells ) iro nEdgesOnCell - -
-var integer nEdgesOnEdge ( nEdges ) iro nEdgesOnEdge - -
-var integer edgesOnCell ( maxEdges nCells ) iro edgesOnCell - -
-var integer edgesOnEdge ( maxEdges2 nEdges ) iro edgesOnEdge - -
+var persistent integer cellsOnEdge ( TWO nEdges ) 0 iro cellsOnEdge mesh - -
+var persistent integer nEdgesOnCell ( nCells ) 0 iro nEdgesOnCell mesh - -
+var persistent integer nEdgesOnEdge ( nEdges ) 0 iro nEdgesOnEdge mesh - -
+var persistent integer edgesOnCell ( maxEdges nCells ) 0 iro edgesOnCell mesh - -
+var persistent integer edgesOnEdge ( maxEdges2 nEdges ) 0 iro edgesOnEdge mesh - -
-var real weightsOnEdge ( maxEdges2 nEdges ) iro weightsOnEdge - -
-var real dvEdge ( nEdges ) iro dvEdge - -
-var real dcEdge ( nEdges ) iro dcEdge - -
-var real angleEdge ( nEdges ) iro angleEdge - -
-var real areaCell ( nCells ) iro areaCell - -
-var real areaTriangle ( nVertices ) iro areaTriangle - -
+var persistent real weightsOnEdge ( maxEdges2 nEdges ) 0 iro weightsOnEdge mesh - -
+var persistent real dvEdge ( nEdges ) 0 iro dvEdge mesh - -
+var persistent real dcEdge ( nEdges ) 0 iro dcEdge mesh - -
+var persistent real angleEdge ( nEdges ) 0 iro angleEdge mesh - -
+var persistent real areaCell ( nCells ) 0 iro areaCell mesh - -
+var persistent real areaTriangle ( nVertices ) 0 iro areaTriangle mesh - -
-var real edgeNormalVectors ( R3 nEdges ) o edgeNormalVectors - -
-var real localVerticalUnitVectors ( R3 nCells ) o localVerticalUnitVectors - -
-var real cellTangentPlane ( R3 TWO nEdges ) o cellTangentPlane - -
+var persistent real edgeNormalVectors ( R3 nEdges ) 0 o edgeNormalVectors mesh - -
+var persistent real localVerticalUnitVectors ( R3 nCells ) 0 o localVerticalUnitVectors mesh - -
+var persistent real cellTangentPlane ( R3 TWO nEdges ) 0 o cellTangentPlane mesh - -
-var integer cellsOnCell ( maxEdges nCells ) iro cellsOnCell - -
-var integer verticesOnCell ( maxEdges nCells ) iro verticesOnCell - -
-var integer verticesOnEdge ( TWO nEdges ) iro verticesOnEdge - -
-var integer edgesOnVertex ( vertexDegree nVertices ) iro edgesOnVertex - -
-var integer cellsOnVertex ( vertexDegree nVertices ) iro cellsOnVertex - -
-var real kiteAreasOnVertex ( vertexDegree nVertices ) iro kiteAreasOnVertex - -
-var real fEdge ( nEdges ) iro fEdge - -
-var real fVertex ( nVertices ) iro fVertex - -
-var real h_s ( nCells ) iro h_s - -
+var persistent integer cellsOnCell ( maxEdges nCells ) 0 iro cellsOnCell mesh - -
+var persistent integer verticesOnCell ( maxEdges nCells ) 0 iro verticesOnCell mesh - -
+var persistent integer verticesOnEdge ( TWO nEdges ) 0 iro verticesOnEdge mesh - -
+var persistent integer edgesOnVertex ( vertexDegree nVertices ) 0 iro edgesOnVertex mesh - -
+var persistent integer cellsOnVertex ( vertexDegree nVertices ) 0 iro cellsOnVertex mesh - -
+var persistent real kiteAreasOnVertex ( vertexDegree nVertices ) 0 iro kiteAreasOnVertex mesh - -
+var persistent real fEdge ( nEdges ) 0 iro fEdge mesh - -
+var persistent real fVertex ( nVertices ) 0 iro fVertex mesh - -
+var persistent real h_s ( nCells ) 0 iro h_s mesh - -
# some solver scalar coefficients
# coefficients for vertical extrapolation to the surface
-var real cf1 ( ) iro cf1 - -
-var real cf2 ( ) iro cf2 - -
-var real cf3 ( ) iro cf3 - -
+var persistent real cf1 ( ) 0 iro cf1 mesh - -
+var persistent real cf2 ( ) 0 iro cf2 mesh - -
+var persistent real cf3 ( ) 0 iro cf3 mesh - -
# description of the vertical grid structure
-var real hx ( nVertLevelsP1 nCells ) iro hx - -
-var real zgrid ( nVertLevelsP1 nCells ) iro zgrid - -
-var real rdzw ( nVertLevels ) iro rdzw - -
-var real dzu ( nVertLevels ) iro dzu - -
-var real rdzu ( nVertLevels ) iro rdzu - -
-var real fzm ( nVertLevels ) iro fzm - -
-var real fzp ( nVertLevels ) iro fzp - -
-var real zx ( nVertLevelsP1 nEdges ) iro zx - -
-var real zz ( nVertLevelsP1 nCells ) iro zz - -
-var real zf ( nVertLevelsP1 TWO nEdges ) iro zf - -
-var real zf3 ( nVertLevelsP1 TWO nEdges ) iro zf3 - -
-var real zb ( nVertLevelsP1 TWO nEdges ) iro zb - -
-var real zb3 ( nVertLevelsP1 TWO nEdges ) iro zb3 - -
+var persistent real hx ( nVertLevelsP1 nCells ) 0 iro hx mesh - -
+var persistent real zgrid ( nVertLevelsP1 nCells ) 0 iro zgrid mesh - -
+var persistent real rdzw ( nVertLevels ) 0 iro rdzw mesh - -
+var persistent real dzu ( nVertLevels ) 0 iro dzu mesh - -
+var persistent real rdzu ( nVertLevels ) 0 iro rdzu mesh - -
+var persistent real fzm ( nVertLevels ) 0 iro fzm mesh - -
+var persistent real fzp ( nVertLevels ) 0 iro fzp mesh - -
+var persistent real zx ( nVertLevelsP1 nEdges ) 0 iro zx mesh - -
+var persistent real zz ( nVertLevelsP1 nCells ) 0 iro zz mesh - -
+var persistent real zf ( nVertLevelsP1 TWO nEdges ) 0 iro zf mesh - -
+var persistent real zf3 ( nVertLevelsP1 TWO nEdges ) 0 iro zf3 mesh - -
+var persistent real zb ( nVertLevelsP1 TWO nEdges ) 0 iro zb mesh - -
+var persistent real zb3 ( nVertLevelsP1 TWO nEdges ) 0 iro zb3 mesh - -
# coefficients for the vertical tridiagonal solve
# Note: these could be local but...
-var real cofrz ( nVertLevels ) - cofrz - -
-var real cofwr ( nVertLevels nCells ) - cofwr - -
-var real cofwz ( nVertLevels nCells ) - cofwz - -
-var real coftz ( nVertLevelsP1 nCells ) - coftz - -
-var real cofwt ( nVertLevels nCells ) - cofwt - -
-var real a_tri ( nVertLevels nCells ) - a_tri - -
-var real alpha_tri ( nVertLevels nCells ) - alpha_tri - -
-var real gamma_tri ( nVertLevels nCells ) - gamma_tri - -
+var persistent real cofrz ( nVertLevels ) 0 - cofrz mesh - -
+var persistent real cofwr ( nVertLevels nCells ) 0 - cofwr mesh - -
+var persistent real cofwz ( nVertLevels nCells ) 0 - cofwz mesh - -
+var persistent real coftz ( nVertLevelsP1 nCells ) 0 - coftz mesh - -
+var persistent real cofwt ( nVertLevels nCells ) 0 - cofwt mesh - -
+var persistent real a_tri ( nVertLevels nCells ) 0 - a_tri mesh - -
+var persistent real alpha_tri ( nVertLevels nCells ) 0 - alpha_tri mesh - -
+var persistent real gamma_tri ( nVertLevels nCells ) 0 - gamma_tri mesh - -
# W-Rayleigh-damping coefficient
-var real dss ( nVertLevels nCells ) ir dss - -
+var persistent real dss ( nVertLevels nCells ) 0 ir dss mesh - -
# Prognostic variables: read from input, saved in restart, and written to output
-var real u ( nVertLevels nEdges Time ) iro u - -
-var real w ( nVertLevelsP1 nCells Time ) iro w - -
-var real rho ( nVertLevels nCells Time ) iro rho - -
-var real rho_p ( nVertLevels nCells Time ) iro rho_p - -
-var real theta ( nVertLevels nCells Time ) iro theta - -
-var real rh ( nVertLevels nCells Time ) iro rh - -
-var real qv ( nVertLevels nCells Time ) iro qv scalars moist
-var real qc ( nVertLevels nCells Time ) iro qc scalars moist
-var real qr ( nVertLevels nCells Time ) iro qr scalars moist
-var real qi ( nVertLevels nCells Time ) iro qi scalars moist
-var real qs ( nVertLevels nCells Time ) iro qs scalars moist
-var real qg ( nVertLevels nCells Time ) iro qg scalars moist
-var real qnr ( nVertLevels nCells Time ) iro qnr scalars number
-var real qni ( nVertLevels nCells Time ) iro qni scalars number
+var persistent real u ( nVertLevels nEdges Time ) 2 iro u state - -
+var persistent real w ( nVertLevelsP1 nCells Time ) 2 iro w state - -
+var persistent real rho ( nVertLevels nCells Time ) 2 iro rho state - -
+var persistent real rho_p ( nVertLevels nCells Time ) 2 iro rho_p state - -
+var persistent real theta ( nVertLevels nCells Time ) 2 iro theta state - -
+var persistent real rh ( nVertLevels nCells Time ) 2 iro rh state - -
+var persistent real qv ( nVertLevels nCells Time ) 2 iro qv state scalars moist
+var persistent real qc ( nVertLevels nCells Time ) 2 iro qc state scalars moist
+var persistent real qr ( nVertLevels nCells Time ) 2 iro qr state scalars moist
+var persistent real qi ( nVertLevels nCells Time ) 2 iro qi state scalars moist
+var persistent real qs ( nVertLevels nCells Time ) 2 iro qs state scalars moist
+var persistent real qg ( nVertLevels nCells Time ) 2 iro qg state scalars moist
+var persistent real qnr ( nVertLevels nCells Time ) 2 iro qnr state scalars number
+var persistent real qni ( nVertLevels nCells Time ) 2 iro qni state scalars number
-#var real tracers ( nTracers nVertLevels nCells Time ) iro tracers - -
+# Tendency variables
+var persistent real tend_u ( nVertLevels nEdges Time ) 1 - u tend - -
+var persistent real tend_w ( nVertLevelsP1 nCells Time ) 1 - w tend - -
+var persistent real tend_rho ( nVertLevels nCells Time ) 1 - rho tend - -
+var persistent real tend_theta ( nVertLevels nCells Time ) 1 - theta tend - -
+var persistent real tend_qv ( nVertLevels nCells Time ) 1 - qv tend scalars moist
+var persistent real tend_qc ( nVertLevels nCells Time ) 1 - qc tend scalars moist
+var persistent real tend_qr ( nVertLevels nCells Time ) 1 - qr tend scalars moist
# state variables diagnosed from prognostic state
-# var real ww ( nVertLevelsP1 nCells Time ) ro ww - -
-var real pressure ( nVertLevels nCells Time ) ro pressure - -
-# var real pp ( nVertLevelsP1 nCells Time ) - pp - -
+var persistent real pressure ( nVertLevels nCells Time ) 2 ro pressure state - -
-var real u_init ( nVertLevels ) iro u_init - -
-var real t_init ( nVertLevels nCells ) iro t_init - -
-var real qv_init ( nVertLevels ) iro qv_init - -
+var persistent real u_init ( nVertLevels ) 0 iro u_init mesh - -
+var persistent real t_init ( nVertLevels nCells ) 0 iro t_init mesh - -
+var persistent real qv_init ( nVertLevels ) 0 iro qv_init mesh - -
# Diagnostic fields: only written to output
-var real v ( nVertLevels nEdges Time ) o v - -
-var real divergence ( nVertLevels nCells Time ) o divergence - -
-var real vorticity ( nVertLevels nVertices Time ) o vorticity - -
-var real pv_edge ( nVertLevels nEdges Time ) o pv_edge - -
-var real rho_edge ( nVertLevels nEdges Time ) o rho_edge - -
-var real ke ( nVertLevels nCells Time ) o ke - -
-var real pv_vertex ( nVertLevels nVertices Time ) o pv_vertex - -
-var real pv_cell ( nVertLevels nCells Time ) o pv_cell - -
-var real uReconstructX ( nVertLevels nCells Time ) o uReconstructX - -
-var real uReconstructY ( nVertLevels nCells Time ) o uReconstructY - -
-var real uReconstructZ ( nVertLevels nCells Time ) o uReconstructZ - -
-var real uReconstructZonal ( nVertLevels nCells Time ) o uReconstructZonal - -
-var real uReconstructMeridional ( nVertLevels nCells Time ) o uReconstructMeridional - -
+var persistent real v ( nVertLevels nEdges Time ) 1 o v diag - -
+var persistent real divergence ( nVertLevels nCells Time ) 1 o divergence diag - -
+var persistent real vorticity ( nVertLevels nVertices Time ) 1 o vorticity diag - -
+var persistent real pv_edge ( nVertLevels nEdges Time ) 1 o pv_edge diag - -
+var persistent real rho_edge ( nVertLevels nEdges Time ) 1 o rho_edge diag - -
+var persistent real ke ( nVertLevels nCells Time ) 1 o ke diag - -
+var persistent real pv_vertex ( nVertLevels nVertices Time ) 1 o pv_vertex diag - -
+var persistent real pv_cell ( nVertLevels nCells Time ) 1 o pv_cell diag - -
+var persistent real uReconstructX ( nVertLevels nCells Time ) 1 o uReconstructX diag - -
+var persistent real uReconstructY ( nVertLevels nCells Time ) 1 o uReconstructY diag - -
+var persistent real uReconstructZ ( nVertLevels nCells Time ) 1 o uReconstructZ diag - -
+var persistent real uReconstructZonal ( nVertLevels nCells Time ) 1 o uReconstructZonal diag - -
+var persistent real uReconstructMeridional ( nVertLevels nCells Time ) 1 o uReconstructMeridional diag - -
# Other diagnostic variables: neither read nor written to any files
-var real rv ( nVertLevels nEdges Time ) - rv - -
-var real circulation ( nVertLevels nVertices Time ) - circulation - -
-var real gradPVt ( nVertLevels nEdges Time ) - gradPVt - -
-var real gradPVn ( nVertLevels nEdges Time ) - gradPVn - -
-var real h_divergence ( nVertLevels nCells ) o h_divergence - -
+var persistent real rv ( nVertLevels nEdges Time ) 1 - rv diag - -
+var persistent real circulation ( nVertLevels nVertices Time ) 1 - circulation diag - -
+var persistent real gradPVt ( nVertLevels nEdges Time ) 1 - gradPVt diag - -
+var persistent real gradPVn ( nVertLevels nEdges Time ) 1 - gradPVn diag - -
+var persistent real h_divergence ( nVertLevels nCells ) 0 o h_divergence mesh - -
-var real exner ( nVertLevels nCells ) - exner - -
-var real exner_base ( nVertLevels nCells ) or exner_base - -
-var real rtheta_base ( nVertLevels nCells ) or rtheta_base - -
-var real pressure_base ( nVertLevels nCells ) or pressure_base - -
-var real rho_base ( nVertLevels nCells ) or rho_base - -
-var real theta_base ( nVertLevels nCells ) or theta_base - -
+var persistent real exner ( nVertLevels nCells ) 0 - exner mesh - -
+var persistent real exner_base ( nVertLevels nCells ) 0 or exner_base mesh - -
+var persistent real rtheta_base ( nVertLevels nCells ) 0 or rtheta_base mesh - -
+var persistent real pressure_base ( nVertLevels nCells ) 0 or pressure_base mesh - -
+var persistent real rho_base ( nVertLevels nCells ) 0 or rho_base mesh - -
+var persistent real theta_base ( nVertLevels nCells ) 0 or theta_base mesh - -
-var real ruAvg ( nVertLevels nEdges ) - ruAvg - -
-var real wwAvg ( nVertLevelsP1 nCells ) - wwAvg - -
-var real qtot ( nVertLevels nCells ) - qtot - -
-var real cqu ( nVertLevels nEdges ) - cqu - -
-var real cqw ( nVertLevels nCells ) - cqw - -
-var real rt_diabatic_tend ( nVertLevels nCells ) - rt_diabatic_tend - -
+var persistent real ruAvg ( nVertLevels nEdges ) 0 - ruAvg mesh - -
+var persistent real wwAvg ( nVertLevelsP1 nCells ) 0 - wwAvg mesh - -
+var persistent real qtot ( nVertLevels nCells ) 0 - qtot mesh - -
+var persistent real cqu ( nVertLevels nEdges ) 0 - cqu mesh - -
+var persistent real cqw ( nVertLevels nCells ) 0 - cqw mesh - -
+var persistent real rt_diabatic_tend ( nVertLevels nCells ) 0 - rt_diabatic_tend mesh - -
# coupled variables needed by the solver, but not output...
-var real ru ( nVertLevels nEdges ) - ru - -
-var real ru_p ( nVertLevels nEdges ) - ru_p - -
-var real ru_save ( nVertLevels nEdges ) - ru_save - -
+var persistent real ru ( nVertLevels nEdges ) 0 - ru mesh - -
+var persistent real ru_p ( nVertLevels nEdges ) 0 - ru_p mesh - -
+var persistent real ru_save ( nVertLevels nEdges ) 0 - ru_save mesh - -
-var real rw ( nVertLevelsP1 nCells ) - rw - -
-var real rw_p ( nVertLevelsP1 nCells ) - rw_p - -
-var real rw_save ( nVertLevelsP1 nCells ) - rw_save - -
+var persistent real rw ( nVertLevelsP1 nCells ) 0 - rw mesh - -
+var persistent real rw_p ( nVertLevelsP1 nCells ) 0 - rw_p mesh - -
+var persistent real rw_save ( nVertLevelsP1 nCells ) 0 - rw_save mesh - -
-var real rtheta_p ( nVertLevels nCells ) - rtheta_p - -
-var real rtheta_pp ( nVertLevels nCells ) - rtheta_pp - -
-var real rtheta_p_save ( nVertLevels nCells ) - rtheta_p_save - -
-var real rtheta_pp_old ( nVertLevels nCells ) - rtheta_pp_old - -
+var persistent real rtheta_p ( nVertLevels nCells ) 0 - rtheta_p mesh - -
+var persistent real rtheta_pp ( nVertLevels nCells ) 0 - rtheta_pp mesh - -
+var persistent real rtheta_p_save ( nVertLevels nCells ) 0 - rtheta_p_save mesh - -
+var persistent real rtheta_pp_old ( nVertLevels nCells ) 0 - rtheta_pp_old mesh - -
-var real rho_pp ( nVertLevels nCells ) - rho_pp - -
-var real rho_p_save ( nVertLevels nCells ) - rho_p_save - -
+var persistent real rho_pp ( nVertLevels nCells ) 0 - rho_pp mesh - -
+var persistent real rho_p_save ( nVertLevels nCells ) 0 - rho_p_save mesh - -
-var real qv_old ( nVertLevels nCells ) - rqv scalars_old moist_old
-var real qc_old ( nVertLevels nCells ) - rqc scalars_old moist_old
-var real qr_old ( nVertLevels nCells ) - rqr scalars_old moist_old
+var persistent real qv_old ( nVertLevels nCells ) 0 - rqv mesh scalars_old moist_old
+var persistent real qc_old ( nVertLevels nCells ) 0 - rqc mesh scalars_old moist_old
+var persistent real qr_old ( nVertLevels nCells ) 0 - rqr mesh scalars_old moist_old
# Space needed for advection
-var real deriv_two ( FIFTEEN TWO nEdges ) o deriv_two - -
-var integer advCells ( TWENTYONE nCells ) - advCells - -
+var persistent real deriv_two ( FIFTEEN TWO nEdges ) 0 o deriv_two mesh - -
+var persistent integer advCells ( TWENTYONE nCells ) 0 - advCells mesh - -
# Space needed for deformation calculation weights
-var real defc_a ( maxEdges nCells ) - defc_a - -
-var real defc_b ( maxEdges nCells ) - defc_b - -
-var real kdiff ( nVertLevels nCells Time ) - kdiff - -
+var persistent real defc_a ( maxEdges nCells ) 0 - defc_a mesh - -
+var persistent real defc_b ( maxEdges nCells ) 0 - defc_b mesh - -
+var persistent real kdiff ( nVertLevels nCells Time ) 2 - kdiff diag - -
# Arrays required for reconstruction of velocity field
-var real coeffs_reconstruct ( R3 maxEdges nCells ) - coeffs_reconstruct - -
+var persistent real coeffs_reconstruct ( R3 maxEdges nCells ) 0 - coeffs_reconstruct mesh - -
#==================================================================================================
# DECLARATIONS OF ALL PHYSICS VARIABLES (will need to be moved to a Physics Registry shared by the
@@ -278,12 +283,12 @@
# qi_col : vertically-integrated cloud ice mixing ratio (kg/m2)
# qs_col " vertically-integrated snow mixing ratio (kg/m2)
-var real qv_col ( nCells Time ) o qv_col - -
-var real qc_col ( nCells Time ) o qc_col - -
-var real qr_col ( nCells Time ) o qr_col - -
-var real qi_col ( nCells Time ) o qi_col - -
-var real qs_col ( nCells Time ) o qs_col - -
-var real qg_col ( nCells Time ) o qg_col - -
+var persistent real qv_col ( nCells Time ) 2 o qv_col state - -
+var persistent real qc_col ( nCells Time ) 2 o qc_col state - -
+var persistent real qr_col ( nCells Time ) 2 o qr_col state - -
+var persistent real qi_col ( nCells Time ) 2 o qi_col state - -
+var persistent real qs_col ( nCells Time ) 2 o qs_col state - -
+var persistent real qg_col ( nCells Time ) 2 o qg_col state - -
#--------------------------------------------------------------------------------------------------
#... PARAMETERIZATION OF CLOUD MICROPHYSICS:
@@ -297,13 +302,13 @@
# graupelncv: time-step grid-scale precipitation of graupel (mm)
# sr : time-step ratio of frozen versus total grid-scale precipitation (-)
-var real rainnc ( nCells Time ) ro rainnc - -
-var real rainncv ( nCells Time ) ro rainncv - -
-var real snownc ( nCells Time ) ro snownc - -
-var real snowncv ( nCells Time ) ro snowncv - -
-var real graupelnc ( nCells Time ) ro graupelnc - -
-var real graupelncv ( nCells Time ) ro graupelncv - -
-var real sr ( nCells Time ) o sr - -
+var persistent real rainnc ( nCells Time ) 2 ro rainnc state - -
+var persistent real rainncv ( nCells Time ) 2 ro rainncv state - -
+var persistent real snownc ( nCells Time ) 2 ro snownc state - -
+var persistent real snowncv ( nCells Time ) 2 ro snowncv state - -
+var persistent real graupelnc ( nCells Time ) 2 ro graupelnc state - -
+var persistent real graupelncv ( nCells Time ) 2 ro graupelncv state - -
+var persistent real sr ( nCells Time ) 2 o sr state - -
#--------------------------------------------------------------------------------------------------
#... PARAMETERIZATION OF CONVECTION:
@@ -322,22 +327,22 @@
# rqscuten : tendency of snow mixing ratio due to cumulus convection (kg/kg s-1)
# wavg : average vertical velocity (KF scheme only) (m s-1)
-var real nca ( nCells Time ) ro nca - -
-var real cubot ( nCells Time ) ro cubot - -
-var real cutop ( nCells Time ) ro cutop - -
+var persistent real nca ( nCells Time ) 2 ro nca state - -
+var persistent real cubot ( nCells Time ) 2 ro cubot state - -
+var persistent real cutop ( nCells Time ) 2 ro cutop state - -
# PRECIPITATION:
-var real rainc ( nCells Time ) ro rainc - -
-var real raincv ( nCells Time ) ro raincv - -
+var persistent real rainc ( nCells Time ) 2 ro rainc state - -
+var persistent real raincv ( nCells Time ) 2 ro raincv state - -
# TENDENCIES:
-var real rthcuten ( nVertLevels nCells Time ) ro rthcuten - -
-var real rqvcuten ( nVertLevels nCells Time ) ro rqvcuten - -
-var real rqccuten ( nVertLevels nCells Time ) ro rqccuten - -
-var real rqrcuten ( nVertLevels nCells Time ) ro rqrcuten - -
-var real rqicuten ( nVertLevels nCells Time ) ro rqicuten - -
-var real rqscuten ( nVertLevels nCells Time ) ro rqscuten - -
-var real w0avg ( nVertLevels nCells Time ) ro w0avg - -
+var persistent real rthcuten ( nVertLevels nCells Time ) 2 ro rthcuten state - -
+var persistent real rqvcuten ( nVertLevels nCells Time ) 2 ro rqvcuten state - -
+var persistent real rqccuten ( nVertLevels nCells Time ) 2 ro rqccuten state - -
+var persistent real rqrcuten ( nVertLevels nCells Time ) 2 ro rqrcuten state - -
+var persistent real rqicuten ( nVertLevels nCells Time ) 2 ro rqicuten state - -
+var persistent real rqscuten ( nVertLevels nCells Time ) 2 ro rqscuten state - -
+var persistent real w0avg ( nVertLevels nCells Time ) 2 ro w0avg state - -
#--------------------------------------------------------------------------------------------------
#... PARAMETERIZATION OF PLANETARY BOUNDARY LAYER PROCESSES:
@@ -349,12 +354,12 @@
# rqiblten : tendency of cloud ice mixing ratio due to pbl processes (kg/kg s-1)
# TENDENCIES:
-var real rublten ( nVertLevels nCells Time ) ro rublten - -
-var real rvblten ( nVertLevels nCells Time ) ro rvblten - -
-var real rthblten ( nVertLevels nCells Time ) ro rthblten - -
-var real rqvblten ( nVertLevels nCells Time ) ro rqvblten - -
-var real rqcblten ( nVertLevels nCells Time ) ro rqcblten - -
-var real rqiblten ( nVertLevels nCells Time ) ro rqiblten - -
+var persistent real rublten ( nVertLevels nCells Time ) 2 ro rublten state - -
+var persistent real rvblten ( nVertLevels nCells Time ) 2 ro rvblten state - -
+var persistent real rthblten ( nVertLevels nCells Time ) 2 ro rthblten state - -
+var persistent real rqvblten ( nVertLevels nCells Time ) 2 ro rqvblten state - -
+var persistent real rqcblten ( nVertLevels nCells Time ) 2 ro rqcblten state - -
+var persistent real rqiblten ( nVertLevels nCells Time ) 2 ro rqiblten state - -
#--------------------------------------------------------------------------------------------------
#... PARAMETERIZATION OF SURFACE LAYER PROCESSES:
@@ -382,26 +387,26 @@
# xland :land mask (1 for land; 2 for water) [-]
# znt :time-varying roughness length [m]
-var real flhc ( nCells Time ) r flhc - -
-var real flqc ( nCells Time ) r flqc - -
-var real hfx ( nCells Time ) r hfx - -
-var real lh ( nCells Time ) r lh - -
-var real mavail ( nCells Time ) r mavail - -
-var real mol ( nCells Time ) r mol - -
-var real pblh ( nCells Time ) r pblh - -
-var real q2 ( nCells Time ) r q2 - -
-var real qfx ( nCells Time ) r qfx - -
-var real qsfc ( nCells Time ) r qsfc - -
-var real regime ( nCells Time ) r regime - -
-var real rmol ( nCells Time ) r rmol - -
-var real t2 ( nCells Time ) r t2 - -
-var real tsk ( nCells Time ) r tsk - -
-var real th2 ( nCells Time ) r th2 - -
-var real u10 ( nCells Time ) r u10 - -
-var real ust ( nCells Time ) r ust - -
-var real ustm ( nCells Time ) r ustm - -
-var real v10 ( nCells Time ) r v10 - -
-var real xland ( nCells Time ) r xland - -
-var real znt ( nCells Time ) r znt - -
+var persistent real flhc ( nCells Time ) 2 r flhc state - -
+var persistent real flqc ( nCells Time ) 2 r flqc state - -
+var persistent real hfx ( nCells Time ) 2 r hfx state - -
+var persistent real lh ( nCells Time ) 2 r lh state - -
+var persistent real mavail ( nCells Time ) 2 r mavail state - -
+var persistent real mol ( nCells Time ) 2 r mol state - -
+var persistent real pblh ( nCells Time ) 2 r pblh state - -
+var persistent real q2 ( nCells Time ) 2 r q2 state - -
+var persistent real qfx ( nCells Time ) 2 r qfx state - -
+var persistent real qsfc ( nCells Time ) 2 r qsfc state - -
+var persistent real regime ( nCells Time ) 2 r regime state - -
+var persistent real rmol ( nCells Time ) 2 r rmol state - -
+var persistent real t2 ( nCells Time ) 2 r t2 state - -
+var persistent real tsk ( nCells Time ) 2 r tsk state - -
+var persistent real th2 ( nCells Time ) 2 r th2 state - -
+var persistent real u10 ( nCells Time ) 2 r u10 state - -
+var persistent real ust ( nCells Time ) 2 r ust state - -
+var persistent real ustm ( nCells Time ) 2 r ustm state - -
+var persistent real v10 ( nCells Time ) 2 r v10 state - -
+var persistent real xland ( nCells Time ) 2 r xland state - -
+var persistent real znt ( nCells Time ) 2 r znt state - -
#==================================================================================================
Modified: branches/atmos_physics/src/core_nhyd_atmos/module_advection.F
===================================================================
--- branches/atmos_physics/src/core_nhyd_atmos/module_advection.F 2010-10-13 18:01:28 UTC (rev 548)
+++ branches/atmos_physics/src/core_nhyd_atmos/module_advection.F 2010-10-13 20:25:17 UTC (rev 549)
@@ -17,7 +17,7 @@
!
implicit none
- type (grid_meta), intent(in) :: grid
+ type (mesh_type), intent(in) :: grid
real (kind=RKIND), dimension(:,:,:), pointer :: deriv_two
integer, dimension(:,:), pointer :: advCells
@@ -750,7 +750,7 @@
!
implicit none
- type (grid_meta), intent(in) :: grid
+ type (mesh_type), intent(in) :: grid
real (kind=RKIND), dimension(:,:), pointer :: defc_a, defc_b
integer, dimension(:,:), pointer :: cellsOnEdge, edgesOnCell
Modified: branches/atmos_physics/src/core_nhyd_atmos/module_test_cases.F
===================================================================
--- branches/atmos_physics/src/core_nhyd_atmos/module_test_cases.F 2010-10-13 18:01:28 UTC (rev 548)
+++ branches/atmos_physics/src/core_nhyd_atmos/module_test_cases.F 2010-10-13 20:25:17 UTC (rev 549)
@@ -38,10 +38,10 @@
block_ptr => domain % blocklist
do while (associated(block_ptr))
write(0,*) ' calling test case setup '
- call nhyd_test_case_jw(block_ptr % mesh, block_ptr % time_levs(1) % state, config_test_case)
+ call nhyd_test_case_jw(block_ptr % mesh, block_ptr % state % time_levs(1) % state, block_ptr % diag, config_test_case)
write(0,*) ' returned from test case setup '
do i=2,nTimeLevs
- call copy_state(block_ptr % time_levs(1) % state, block_ptr % time_levs(i) % state)
+ call copy_state(block_ptr % state % time_levs(i) % state, block_ptr % state % time_levs(1) % state)
end do
block_ptr => block_ptr % next
@@ -55,10 +55,10 @@
block_ptr => domain % blocklist
do while (associated(block_ptr))
write(0,*) ' calling test case setup '
- call nhyd_test_case_squall_line(domain % dminfo, block_ptr % mesh, block_ptr % time_levs(1) % state, config_test_case)
+ call nhyd_test_case_squall_line(domain % dminfo, block_ptr % mesh, block_ptr % state % time_levs(1) % state, block_ptr % diag, config_test_case)
write(0,*) ' returned from test case setup '
do i=2,nTimeLevs
- call copy_state(block_ptr % time_levs(1) % state, block_ptr % time_levs(i) % state)
+ call copy_state(block_ptr % state % time_levs(i) % state, block_ptr % state % time_levs(1) % state)
end do
block_ptr => block_ptr % next
@@ -70,10 +70,10 @@
block_ptr => domain % blocklist
do while (associated(block_ptr))
write(0,*) ' calling test case setup '
- call nhyd_test_case_mtn_wave(block_ptr % mesh, block_ptr % time_levs(1) % state, config_test_case)
+ call nhyd_test_case_mtn_wave(block_ptr % mesh, block_ptr % state % time_levs(1) % state, block_ptr % diag, config_test_case)
write(0,*) ' returned from test case setup '
do i=2,nTimeLevs
- call copy_state(block_ptr % time_levs(1) % state, block_ptr % time_levs(i) % state)
+ call copy_state(block_ptr % state % time_levs(i) % state, block_ptr % state % time_levs(1) % state)
end do
block_ptr => block_ptr % next
@@ -90,15 +90,16 @@
!----------------------------------------------------------------------------------------------------------
- subroutine nhyd_test_case_jw(grid, state, test_case)
+ subroutine nhyd_test_case_jw(grid, state, diag, test_case)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Setup baroclinic wave test case from Jablonowski and Williamson 2008 (QJRMS)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
implicit none
- type (grid_meta), intent(inout) :: grid
- type (grid_state), intent(inout) :: state
+ type (mesh_type), intent(inout) :: grid
+ type (state_type), intent(inout) :: state
+ type (diag_type), intent(inout) :: diag
integer, intent(in) :: test_case
real (kind=RKIND), parameter :: u0 = 35.0
@@ -122,6 +123,8 @@
integer :: iCell, iCell1, iCell2 , iEdge, vtx1, vtx2, ivtx, i, k, nz, nz1, itr, itrp, cell1, cell2, nCellsSolve
+ integer :: index_qv
+
!This is temporary variable here. It just need when calculate tangential velocity v.
integer :: eoe, j
integer, dimension(:), pointer :: nEdgesOnEdge
@@ -225,6 +228,8 @@
call initialize_advection_rk(grid)
call initialize_deformation_weights(grid)
+ index_qv = state % index_qv
+
rh(:,:) = 0.
scalars(:,:,:) = 0.
@@ -774,13 +779,13 @@
!
! Compute mass fluxes tangential to each edge (i.e., through the faces of dual grid cells)
!
- state % v % array(:,:) = 0.0
+ diag % v % array(:,:) = 0.0
do iEdge = 1, grid%nEdges
do i=1,nEdgesOnEdge(iEdge)
eoe = edgesOnEdge(i,iEdge)
if (eoe > 0) then
do k = 1, grid%nVertLevels
- state % v % array(k,iEdge) = state % v %array(k,iEdge) + weightsOnEdge(i,iEdge) * state % u % array(k, eoe)
+ diag % v % array(k,iEdge) = diag % v %array(k,iEdge) + weightsOnEdge(i,iEdge) * state % u % array(k, eoe)
end do
end if
end do
@@ -795,7 +800,6 @@
write(0,*) ' i, psurf, lat ',i,psurf,grid%latCell%array(i)*180./3.1415828
enddo
-! stop
end subroutine nhyd_test_case_jw
@@ -851,7 +855,7 @@
!----------------------------------------------------------------------------------------------------------
- subroutine nhyd_test_case_squall_line(dminfo, grid, state, test_case)
+ subroutine nhyd_test_case_squall_line(dminfo, grid, state, diag, test_case)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Setup squall line and supercell test case
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -859,8 +863,9 @@
implicit none
type (dm_info), intent(in) :: dminfo
- type (grid_meta), intent(inout) :: grid
- type (grid_state), intent(inout) :: state
+ type (mesh_type), intent(inout) :: grid
+ type (state_type), intent(inout) :: state
+ type (diag_type), intent(inout) :: diag
integer, intent(in) :: test_case
real (kind=RKIND), dimension(:), pointer :: rdzw, dzu, rdzu, fzm, fzp
@@ -875,6 +880,7 @@
real, dimension(:,:), pointer :: weightsOnEdge
integer :: iCell, iCell1, iCell2 , iEdge, vtx1, vtx2, ivtx, i, k, nz, nz1, itr, cell1, cell2, nCellsSolve
+ integer :: index_qv
real (kind=RKIND), dimension(grid % nVertLevels + 1 ) :: znu, znw, znwc, znwv
real (kind=RKIND), dimension(grid % nVertLevels + 1 ) :: znuc, znuv
@@ -954,6 +960,8 @@
scalars => state % scalars % array
+ index_qv = state % index_qv
+
scalars(:,:,:) = 0.
call initialize_advection_rk(grid)
@@ -1214,7 +1222,7 @@
write(0,*) ' base state sounding '
write(0,*) ' k, pb, rb, tb, rtb, t, rr, p, qvb'
do k=1,grid%nVertLevels
- write (0,'i2,8(2x,f19.15)') k,pb(k,1),rb(k,1),tb(k,1),rtb(k,1),t(k,1),rr(k,1),p(k,1),qvb(k)
+ write (0,'(i2,8(2x,f19.15))') k,pb(k,1),rb(k,1),tb(k,1),rtb(k,1),t(k,1),rr(k,1),p(k,1),qvb(k)
end do
!
@@ -1352,13 +1360,13 @@
!
! Compute mass fluxes tangential to each edge (i.e., through the faces of dual grid cells)
!
- state % v % array(:,:) = 0.0
+ diag % v % array(:,:) = 0.0
do iEdge = 1, grid%nEdges
do i=1,nEdgesOnEdge(iEdge)
eoe = edgesOnEdge(i,iEdge)
if (eoe > 0) then
do k = 1, grid%nVertLevels
- state % v % array(k,iEdge) = state % v %array(k,iEdge) + weightsOnEdge(i,iEdge) * state % u % array(k, eoe)
+ diag % v % array(k,iEdge) = diag % v %array(k,iEdge) + weightsOnEdge(i,iEdge) * state % u % array(k, eoe)
end do
end if
end do
@@ -1375,15 +1383,16 @@
!----------------------------------------------------------------------------------------------------------
- subroutine nhyd_test_case_mtn_wave(grid, state, test_case)
+ subroutine nhyd_test_case_mtn_wave(grid, state, diag, test_case)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Setup baroclinic wave test case from Jablonowski and Williamson 2008 (QJRMS)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
implicit none
- type (grid_meta), intent(inout) :: grid
- type (grid_state), intent(inout) :: state
+ type (mesh_type), intent(inout) :: grid
+ type (state_type), intent(inout) :: state
+ type (diag_type), intent(inout) :: diag
integer, intent(in) :: test_case
real (kind=RKIND), parameter :: t0=288., hm=250.
@@ -1401,6 +1410,7 @@
real, dimension(:,:), pointer :: weightsOnEdge
integer :: iCell, iCell1, iCell2 , iEdge, vtx1, vtx2, ivtx, i, k, nz, nz1, itr, itrp, cell1, cell2, nCellsSolve
+ integer :: index_qv
real (kind=RKIND) :: ptop, pitop, ptopb, p0, flux, d2fdx2_cell1, d2fdx2_cell2
@@ -1493,6 +1503,8 @@
scalars => state % scalars % array
+ index_qv = state % index_qv
+
scalars(:,:,:) = 0.
call initialize_advection_rk(grid)
@@ -1759,7 +1771,7 @@
write(0,*) ' ***** base state sounding ***** '
write(0,*) 'k pb p rb rtb rr tb t'
do k=1,grid%nVertLevels
- write(0,'i2,7(2x,f14.9)') k,pb(k,1),p(k,1),rb(k,1),rtb(k,1),rr(k,1),tb(k,1),t(k,1)
+ write(0,'(i2,7(2x,f14.9))') k,pb(k,1),p(k,1),rb(k,1),rtb(k,1),rr(k,1),tb(k,1),t(k,1)
end do
scalars(index_qv,:,:) = 0.
@@ -1817,7 +1829,7 @@
write(0,*) ' *** sounding for the simulation ***'
write(0,*) ' z theta pres qv rho_m u rr'
do k=1,nz1
- write(6,'8(f14.9,2x)') .5*(zgrid(k,1)+zgrid(k+1,1))/1000., &
+ write(6,'(8(f14.9,2x))') .5*(zgrid(k,1)+zgrid(k+1,1))/1000., &
t(k,1)/(1.+1.61*scalars(index_qv,k,1)), &
.01*p0*p(k,1)**(1./rcp), &
1000.*scalars(index_qv,k,1), &
@@ -1943,13 +1955,13 @@
!
! Compute mass fluxes tangential to each edge (i.e., through the faces of dual grid cells)
!
- state % v % array(:,:) = 0.0
+ diag % v % array(:,:) = 0.0
do iEdge = 1, grid%nEdges
do i=1,nEdgesOnEdge(iEdge)
eoe = edgesOnEdge(i,iEdge)
if (eoe > 0) then
do k = 1, grid%nVertLevels
- state % v % array(k,iEdge) = state % v %array(k,iEdge) + weightsOnEdge(i,iEdge) * state % u % array(k, eoe)
+ diag % v % array(k,iEdge) = diag % v %array(k,iEdge) + weightsOnEdge(i,iEdge) * state % u % array(k, eoe)
end do
end if
end do
Modified: branches/atmos_physics/src/core_nhyd_atmos/module_time_integration.F
===================================================================
--- branches/atmos_physics/src/core_nhyd_atmos/module_time_integration.F 2010-10-13 18:01:28 UTC (rev 548)
+++ branches/atmos_physics/src/core_nhyd_atmos/module_time_integration.F 2010-10-13 20:25:17 UTC (rev 549)
@@ -42,7 +42,7 @@
block => domain % blocklist
do while (associated(block))
- block % time_levs(2) % state % xtime % scalar = block % time_levs(1) % state % xtime % scalar + dt
+ block % state % time_levs(2) % state % xtime % scalar = block % state % time_levs(1) % state % xtime % scalar + dt
block => block % next
end do
@@ -71,7 +71,6 @@
integer :: iCell, k, iEdge
type (block_type), pointer :: block
- integer, parameter :: TEND = 1
integer :: rk_step, number_of_sub_steps
integer :: iScalar
@@ -84,6 +83,7 @@
! logical, parameter :: do_microphysics = .true.
logical, parameter :: do_microphysics = .false.
+ integer :: index_qc
real (kind=RKIND) :: domain_mass, scalar_mass, scalar_min, scalar_max
real (kind=RKIND) :: global_domain_mass, global_scalar_mass, global_scalar_min, global_scalar_max
@@ -109,27 +109,27 @@
block => domain % blocklist
do while (associated(block))
! theta
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % time_levs(1) % state % theta % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(1) % state % theta % array(:,:), &
block % mesh % nVertLevels, block % mesh % nCells, &
block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
! scalars
- call dmpar_exch_halo_field3dReal(domain % dminfo, block % time_levs(1) % state % scalars % array(:,:,:), &
- num_scalars, block % mesh % nVertLevels, block % mesh % nCells, &
+ call dmpar_exch_halo_field3dReal(domain % dminfo, block % state % time_levs(1) % state % scalars % array(:,:,:), &
+ block % state % time_levs(1) % state % num_scalars, block % mesh % nVertLevels, block % mesh % nCells, &
block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
! pressure
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % time_levs(1) % state % pressure % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(1) % state % pressure % array(:,:), &
block % mesh % nVertLevels, block % mesh % nCells, &
block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
! vorticity
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % time_levs(1) % state % vorticity % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % diag % vorticity % array(:,:), &
block % mesh % nVertLevels, block % mesh % nVertices, &
block % parinfo % verticesToSend, block % parinfo % verticesToRecv)
! divergence
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % time_levs(1) % state % divergence % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % diag % divergence % array(:,:), &
block % mesh % nVertLevels, block % mesh % nCells, &
block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
! pv_edge
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % time_levs(1) % state % pv_edge % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % diag % pv_edge % array(:,:), &
block % mesh % nVertLevels, block % mesh % nEdges, &
block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
! rtheta_p
@@ -147,7 +147,7 @@
do while (associated(block))
! We are setting values in the halo here, so no communications are needed.
! Alternatively, we could just set owned cells and edge values and communicate after this block loop.
- call rk_integration_setup( block % time_levs(2) % state, block % time_levs(1) % state, block % mesh )
+ call rk_integration_setup( block % state % time_levs(2) % state, block % state % time_levs(1) % state, block % mesh )
block => block % next
end do
@@ -164,7 +164,7 @@
! The coefficients are set for owned cells (cqw) and for all edges of owned cells,
! thus no communications should be needed after this call.
! We could consider combining this and the next block loop.
- call compute_moist_coefficients( block % time_levs(2) % state, block % mesh )
+ call compute_moist_coefficients( block % state % time_levs(2) % state, block % mesh )
block => block % next
end do
@@ -172,7 +172,7 @@
if (debug) write(0,*) ' compute_dyn_tend '
block => domain % blocklist
do while (associated(block))
- call compute_dyn_tend( block % intermediate_step(TEND), block % time_levs(2) % state, block % mesh )
+ call compute_dyn_tend( block % tend, block % state % time_levs(2) % state, block % diag, block % mesh )
block => block % next
end do
if (debug) write(0,*) ' finished compute_dyn_tend '
@@ -182,8 +182,8 @@
! if (debug) write(0,*) ' add physics tendencies '
! block => domain % blocklist
! do while (associated(block))
-! call physics_addtend( block % intermediate_step(TEND), block % time_levs(2) % state, &
-! block % time_levs(2) % state % rho % array(:,:), block % mesh )
+! call physics_addtend( block % tend, block % state % time_levs(2) % state, &
+! block % state % time_levs(2) % state % rho % array(:,:), block % mesh )
! block => block % next
! end do
! if (debug) write(0,*) ' finished add physics tendencies '
@@ -195,16 +195,16 @@
!***********************************
block => domain % blocklist
do while (associated(block))
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % intermediate_step(TEND) % u % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % tend % u % array(:,:), &
block % mesh % nVertLevels, block % mesh % nEdges, &
block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % intermediate_step(TEND) % theta % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % tend % theta % array(:,:), &
block % mesh % nVertLevels, block % mesh % nCells, &
block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % intermediate_step(TEND) % rho % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % tend % rho % array(:,:), &
block % mesh % nVertLevels, block % mesh % nCells, &
block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % intermediate_step(TEND) % w % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % tend % w % array(:,:), &
block % mesh % nVertLevels+1, block % mesh % nCells, &
block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
block => block % next
@@ -212,9 +212,9 @@
block => domain % blocklist
do while (associated(block))
- call set_smlstep_pert_variables( block % time_levs(1) % state, block % time_levs(2) % state, &
- block % intermediate_step(TEND), block % mesh )
- call compute_vert_imp_coefs( block % time_levs(2) % state, block % mesh, rk_sub_timestep(rk_step) )
+ call set_smlstep_pert_variables( block % state % time_levs(1) % state, block % state % time_levs(2) % state, &
+ block % tend, block % mesh )
+ call compute_vert_imp_coefs( block % state % time_levs(2) % state, block % mesh, rk_sub_timestep(rk_step) )
block => block % next
end do
@@ -224,7 +224,7 @@
block => domain % blocklist
do while (associated(block))
- call advance_acoustic_step( block % time_levs(2) % state, block % intermediate_step(TEND), &
+ call advance_acoustic_step( block % state % time_levs(2) % state, block % tend, &
block % mesh, rk_sub_timestep(rk_step) )
block => block % next
end do
@@ -259,10 +259,10 @@
block => domain % blocklist
do while (associated(block))
- call recover_large_step_variables( block % time_levs(2) % state, &
+ call recover_large_step_variables( block % state % time_levs(2) % state, &
block % mesh, rk_timestep(rk_step), &
number_sub_steps(rk_step), rk_step )
-
+
block => block % next
end do
@@ -279,12 +279,14 @@
! so we keep the advance_scalars routine as well
!
if (rk_step < 3 .or. (.not. config_monotonic .and. .not. config_positive_definite)) then
- call advance_scalars( block % intermediate_step(TEND), &
- block % time_levs(1) % state, block % time_levs(2) % state, &
+ call advance_scalars( block % tend, &
+ block % state % time_levs(1) % state, block % state % time_levs(2) % state, &
+ block % diag, &
block % mesh, rk_timestep(rk_step) )
else
- call advance_scalars_mono( block % intermediate_step(TEND), &
- block % time_levs(1) % state, block % time_levs(2) % state, &
+ call advance_scalars_mono( block % tend, &
+ block % state % time_levs(1) % state, block % state % time_levs(2) % state, &
+ block % diag, &
block % mesh, rk_timestep(rk_step), rk_step, 3, &
domain % dminfo, block % parinfo % cellsToSend, block % parinfo % cellsToRecv )
end if
@@ -294,11 +296,11 @@
block => domain % blocklist
do while (associated(block))
! For now, we do scalar halo updates later on...
-! call dmpar_exch_halo_field3dReal(domain % dminfo, block % intermediate_step(TEND) % scalars % array(:,:,:), &
-! num_scalars, block % mesh % nVertLevels, block % mesh % nCells, &
+! call dmpar_exch_halo_field3dReal(domain % dminfo, block % tend % scalars % array(:,:,:), &
+! block % tend % num_scalars, block % mesh % nVertLevels, block % mesh % nCells, &
! block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
-! call dmpar_exch_halo_field3dReal(domain % dminfo, block % time_levs(2) % state % scalars % array(:,:,:), &
-! num_scalars, block % mesh % nVertLevels, block % mesh % nCells, &
+! call dmpar_exch_halo_field3dReal(domain % dminfo, block % state % time_levs(2) % state % scalars % array(:,:,:), &
+! block % state % time_levs(2) % state % num_scalars, block % mesh % nVertLevels, block % mesh % nCells, &
! block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
block => block % next
end do
@@ -311,7 +313,7 @@
block => domain % blocklist
do while (associated(block))
- call compute_solve_diagnostics( dt, block % time_levs(2) % state, block % mesh )
+ call compute_solve_diagnostics( dt, block % state % time_levs(2) % state, block % diag, block % mesh )
block => block % next
end do
@@ -324,50 +326,50 @@
do while (associated(block))
! NB: if any of these cause differences, better to uncomment the version after qd_kessler?
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % time_levs(2) % state % u % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % u % array(:,:), &
block % mesh % nVertLevels, block % mesh % nEdges, &
block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % time_levs(2) % state % theta % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % theta % array(:,:), &
block % mesh % nVertLevels, block % mesh % nCells, &
block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % time_levs(2) % state % pressure % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % pressure % array(:,:), &
block % mesh % nVertLevels, block % mesh % nCells, &
block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % time_levs(2) % state % rho % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % rho % array(:,:), &
block % mesh % nVertLevels, block % mesh % nCells, &
block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % time_levs(2) % state % rho_p % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % rho_p % array(:,:), &
block % mesh % nVertLevels, block % mesh % nCells, &
block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % time_levs(2) % state % w % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % w % array(:,:), &
block % mesh % nVertLevels+1, block % mesh % nCells, &
block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % time_levs(2) % state % vorticity % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % diag % vorticity % array(:,:), &
block % mesh % nVertLevels, block % mesh % nVertices, &
block % parinfo % verticesToSend, block % parinfo % verticesToRecv)
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % time_levs(2) % state % pv_vertex % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % diag % pv_vertex % array(:,:), &
block % mesh % nVertLevels, block % mesh % nVertices, &
block % parinfo % verticesToSend, block % parinfo % verticesToRecv)
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % time_levs(2) % state % pv_cell % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % diag % pv_cell % array(:,:), &
block % mesh % nVertLevels, block % mesh % nCells, &
block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % time_levs(2) % state % divergence % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % diag % divergence % array(:,:), &
block % mesh % nVertLevels, block % mesh % nCells, &
block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % time_levs(2) % state % ke % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % diag % ke % array(:,:), &
block % mesh % nVertLevels, block % mesh % nCells, &
block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % time_levs(2) % state % v % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % diag % v % array(:,:), &
block % mesh % nVertLevels, block % mesh % nEdges, &
block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % time_levs(2) % state % pv_edge % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % diag % pv_edge % array(:,:), &
block % mesh % nVertLevels, block % mesh % nEdges, &
block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % time_levs(2) % state % rho_edge % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % diag % rho_edge % array(:,:), &
block % mesh % nVertLevels, block % mesh % nEdges, &
block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
- call dmpar_exch_halo_field3dReal(domain % dminfo, block % time_levs(2) % state % scalars % array(:,:,:), &
- num_scalars, block % mesh % nVertLevels, block % mesh % nCells, &
+ call dmpar_exch_halo_field3dReal(domain % dminfo, block % state % time_levs(2) % state % scalars % array(:,:,:), &
+ block % state % time_levs(2) % state % num_scalars, block % mesh % nVertLevels, block % mesh % nCells, &
block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
block => block % next
end do
@@ -377,7 +379,7 @@
!... compute full velocity vectors at cell centers:
block => domain % blocklist
do while (associated(block))
- call reconstruct(block % time_levs(2) % state, block % mesh)
+ call reconstruct(block % state % time_levs(2) % state, block % diag, block % mesh)
block => block % next
end do
@@ -387,12 +389,12 @@
do while(associated(block))
!simply set to zero negative mixing ratios of different water species (for now):
- where ( block % time_levs(2) % state % scalars % array(:,:,:) .lt. 0.) &
- block % time_levs(2) % state % scalars % array(:,:,:) = 0.
+ where ( block % state % time_levs(2) % state % scalars % array(:,:,:) .lt. 0.) &
+ block % state % time_levs(2) % state % scalars % array(:,:,:) = 0.
!call microphysics schemes:
if(config_microp_scheme .ne. 'off') &
- call microphysics_driver ( block % time_levs(2) % state, block % mesh, itimestep )
+ call microphysics_driver ( block % state % time_levs(2) % state, block % mesh, itimestep )
block => block % next
end do
@@ -401,7 +403,7 @@
! if(do_microphysics) then
! block => domain % blocklist
! do while (associated(block))
-! call qd_kessler( block % time_levs(1) % state, block % time_levs(2) % state, block % mesh, dt )
+! call qd_kessler( block % state % time_levs(1) % state, block % state % time_levs(2) % state, block % mesh, dt )
! block => block % next
! end do
! end if
@@ -414,17 +416,17 @@
call dmpar_exch_halo_field2dReal(domain % dminfo, block % mesh % exner % array(:,:), &
block % mesh % nVertLevels, block % mesh % nCells, &
block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % time_levs(2) % state % theta % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % theta % array(:,:), &
block % mesh % nVertLevels, block % mesh % nCells, &
block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % time_levs(2) % state % pressure % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % pressure % array(:,:), &
block % mesh % nVertLevels, block % mesh % nCells, &
block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
call dmpar_exch_halo_field2dReal(domain % dminfo, block % mesh % rt_diabatic_tend % array(:,:), &
block % mesh % nVertLevels, block % mesh % nCells, &
block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
- call dmpar_exch_halo_field3dReal(domain % dminfo, block % time_levs(2) % state % scalars % array(:,:,:), &
- num_scalars, block % mesh % nVertLevels, block % mesh % nCells, &
+ call dmpar_exch_halo_field3dReal(domain % dminfo, block % state % time_levs(2) % state % scalars % array(:,:,:), &
+ block % state % time_levs(2) % state % num_scalars, block % mesh % nVertLevels, block % mesh % nCells, &
block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
block => block % next
end do
@@ -436,8 +438,8 @@
scalar_max = 0.
do iCell = 1, block % mesh % nCellsSolve
do k = 1, block % mesh % nVertLevels
- scalar_min = min(scalar_min, block % time_levs(2) % state % w % array(k,iCell))
- scalar_max = max(scalar_max, block % time_levs(2) % state % w % array(k,iCell))
+ scalar_min = min(scalar_min, block % state % time_levs(2) % state % w % array(k,iCell))
+ scalar_max = max(scalar_max, block % state % time_levs(2) % state % w % array(k,iCell))
enddo
enddo
write(0,*) ' min, max w ',scalar_min, scalar_max
@@ -446,23 +448,23 @@
scalar_max = 0.
do iEdge = 1, block % mesh % nEdgesSolve
do k = 1, block % mesh % nVertLevels
- scalar_min = min(scalar_min, block % time_levs(2) % state % u % array(k,iEdge))
- scalar_max = max(scalar_max, block % time_levs(2) % state % u % array(k,iEdge))
+ scalar_min = min(scalar_min, block % state % time_levs(2) % state % u % array(k,iEdge))
+ scalar_max = max(scalar_max, block % state % time_levs(2) % state % u % array(k,iEdge))
enddo
enddo
write(0,*) ' min, max u ',scalar_min, scalar_max
- do iScalar = 1, num_scalars
+ do iScalar = 1, block % state % time_levs(2) % state % num_scalars
scalar_min = 0.
scalar_max = 0.
do iCell = 1, block % mesh % nCellsSolve
do k = 1, block % mesh % nVertLevels
- scalar_min = min(scalar_min, block % time_levs(2) % state % scalars % array(iScalar,k,iCell))
- scalar_max = max(scalar_max, block % time_levs(2) % state % scalars % array(iScalar,k,iCell))
+ scalar_min = min(scalar_min, block % state % time_levs(2) % state % scalars % array(iScalar,k,iCell))
+ scalar_max = max(scalar_max, block % state % time_levs(2) % state % scalars % array(iScalar,k,iCell))
enddo
enddo
write(0,*) ' min, max scalar ',iScalar, scalar_min, scalar_max
- enddo
+ end do
block => block % next
end do
@@ -476,8 +478,8 @@
subroutine rk_integration_setup( s_old, s_new, grid )
implicit none
- type (grid_state) :: s_new, s_old
- type (grid_meta) :: grid
+ type (state_type) :: s_new, s_old
+ type (mesh_type) :: grid
integer :: iCell, k
grid % ru_save % array = grid % ru % array
@@ -491,17 +493,8 @@
s_old % rho_p % array = s_new % rho_p % array
s_old % rho % array = s_new % rho % array
s_old % pressure % array = s_new % pressure % array
-
s_old % scalars % array = s_new % scalars % array
- s_old % rho_edge % array = s_new % rho_edge % array
- s_old % v % array = s_new % v % array
- s_old % circulation % array = s_new % circulation % array
- s_old % vorticity % array = s_new % vorticity % array
- s_old % divergence % array = s_new % divergence % array
- s_old % ke % array = s_new % ke % array
- s_old % pv_edge % array = s_new % pv_edge % array
-
end subroutine rk_integration_setup
!-----
@@ -509,8 +502,8 @@
subroutine compute_moist_coefficients( state, grid )
implicit none
- type (grid_state) :: state
- type (grid_meta) :: grid
+ type (state_type) :: state
+ type (mesh_type) :: grid
integer :: iEdge, iCell, k, cell1, cell2, iq
integer :: nCells, nEdges, nVertLevels, nCellsSolve
@@ -524,7 +517,7 @@
do iCell = 1, nCellsSolve
do k = 2, nVertLevels
qtot = 0.
- do iq = moist_start, moist_end
+ do iq = state % moist_start, state % moist_end
qtot = qtot + 0.5 * (state % scalars % array (iq, k, iCell) + state % scalars % array (iq, k-1, iCell))
end do
grid % cqw % array(k,iCell) = 1./(1.+qtot)
@@ -537,7 +530,7 @@
if (cell1 <= nCellsSolve .or. cell2 <= nCellsSolve) then
do k = 1, nVertLevels
qtot = 0.
- do iq = moist_start, moist_end
+ do iq = state % moist_start, state % moist_end
qtot = qtot + 0.5 * ( state % scalars % array (iq, k, cell1) + state % scalars % array (iq, k, cell2) )
end do
grid % cqu % array(k,iEdge) = 1./( 1. + qtot)
@@ -561,8 +554,8 @@
implicit none
- type (grid_state), intent(in) :: s
- type (grid_meta), intent(inout) :: grid
+ type (state_type), intent(in) :: s
+ type (mesh_type), intent(inout) :: grid
real (kind=RKIND), intent(in) :: dts
integer :: i, k, iq
@@ -631,7 +624,7 @@
do k=1,nVertLevels
qtot = 0.
- do iq = moist_start, moist_end
+ do iq = s % moist_start, s % moist_end
qtot = qtot + s % scalars % array (iq, k, i)
end do
@@ -666,15 +659,16 @@
end do ! loop over cells
- end subroutine compute_vert_imp_coefs
+ end subroutine compute_vert_imp_coefs
!------------------------
- subroutine set_smlstep_pert_variables( s_old, s_new, tend, grid )
+ subroutine set_smlstep_pert_variables( s_old, s_new, tend, grid )
implicit none
- type (grid_state) :: s_new, s_old, tend
- type (grid_meta) :: grid
+ type (state_type) :: s_new, s_old
+ type (tend_type) :: tend
+ type (mesh_type) :: grid
integer :: iCell, iEdge, k, cell1, cell2
integer, dimension(:,:), pointer :: cellsOnEdge
real, dimension(:,:,:), pointer :: zf, zf3
@@ -728,16 +722,17 @@
grid % ruAvg % array = 0.
grid % wwAvg % array = 0.
- end subroutine set_smlstep_pert_variables
+ end subroutine set_smlstep_pert_variables
!-------------------------------
- subroutine advance_acoustic_step( s, tend, grid, dts )
+ subroutine advance_acoustic_step( s, tend, grid, dts )
implicit none
- type (grid_state) :: s, tend
- type (grid_meta) :: grid
+ type (state_type) :: s
+ type (tend_type) :: tend
+ type (mesh_type) :: grid
real (kind=RKIND), intent(in) :: dts
real (kind=RKIND), dimension(:,:), pointer :: rho, theta, ru_p, rw_p, rtheta_pp, &
@@ -949,8 +944,8 @@
subroutine recover_large_step_variables( s, grid, dt, ns, rk_step )
implicit none
- type (grid_state) :: s
- type (grid_meta) :: grid
+ type (state_type) :: s
+ type (mesh_type) :: grid
integer, intent(in) :: ns, rk_step
real (kind=RKIND), intent(in) :: dt
@@ -1153,7 +1148,7 @@
!---------------------------------------------------------------------------------------
- subroutine advance_scalars( tend, s_old, s_new, grid, dt)
+ subroutine advance_scalars( tend, s_old, s_new, diag, grid, dt)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! Input: s - current model state
@@ -1164,10 +1159,11 @@
implicit none
- type (grid_state), intent(in) :: tend
- type (grid_state), intent(in) :: s_old
- type (grid_state), intent(out) :: s_new
- type (grid_meta), intent(in) :: grid
+ type (tend_type), intent(in) :: tend
+ type (state_type), intent(in) :: s_old
+ type (state_type), intent(inout) :: s_new
+ type (diag_type), intent(in) :: diag
+ type (mesh_type), intent(in) :: grid
real (kind=RKIND) :: dt
integer :: i, iCell, iEdge, k, iScalar, cell1, cell2
@@ -1179,7 +1175,7 @@
real (kind=RKIND), dimension(:), pointer :: dvEdge, dcEdge, areaCell, qv_init
integer, dimension(:,:), pointer :: cellsOnEdge
- real (kind=RKIND), dimension( num_scalars, grid % nVertLevels + 1 ) :: wdtn
+ real (kind=RKIND), dimension( s_old % num_scalars, grid % nVertLevels + 1 ) :: wdtn
integer :: nVertLevels
real (kind=RKIND), dimension(:), pointer :: fnm, fnp, rdnw
@@ -1205,7 +1201,7 @@
scalar_old => s_old % scalars % array
scalar_new => s_new % scalars % array
- kdiff => s_new % kdiff % array
+ kdiff => diag % kdiff % array
deriv_two => grid % deriv_two % array
!**** uhAvg => grid % uhAvg % array
uhAvg => grid % ruAvg % array
@@ -1231,7 +1227,7 @@
h_theta_eddy_visc2 = config_h_theta_eddy_visc2
v_theta_eddy_visc2 = config_v_theta_eddy_visc2
- rho_edge => s_new % rho_edge % array
+ rho_edge => diag % rho_edge % array
rho => s_new % rho % array
qv_init => grid % qv_init % array
zgrid => grid % zgrid % array
@@ -1251,7 +1247,7 @@
cell2 = cellsOnEdge(2,iEdge)
if (cell1 > 0 .and. cell2 > 0) then
do k=1,grid % nVertLevels
- do iScalar=1,num_scalars
+ do iScalar=1,s_old % num_scalars
scalar_edge = 0.5 * (scalar_new(iScalar,k,cell1) + scalar_new(iScalar,k,cell2))
flux = uhAvg(k,iEdge) * dvEdge(iEdge) * scalar_edge
scalar_tend(iScalar,k,cell1) = scalar_tend(iScalar,k,cell1) - flux/areaCell(cell1)
@@ -1270,7 +1266,7 @@
do k=1,grid % nVertLevels
- do iScalar=1,num_scalars
+ do iScalar=1,s_old % num_scalars
d2fdx2_cell1 = deriv_two(1,1,iEdge) * scalar_new(iScalar,k,cell1)
d2fdx2_cell2 = deriv_two(1,2,iEdge) * scalar_new(iScalar,k,cell2)
do i=1, grid % nEdgesOnCell % array (cell1)
@@ -1313,7 +1309,7 @@
do k=1,grid % nVertLevels
- do iScalar=1,num_scalars
+ do iScalar=1,s_old % num_scalars
d2fdx2_cell1 = deriv_two(1,1,iEdge) * scalar_new(iScalar,k,cell1)
d2fdx2_cell2 = deriv_two(1,2,iEdge) * scalar_new(iScalar,k,cell2)
do i=1, grid % nEdgesOnCell % array (cell1)
@@ -1350,7 +1346,7 @@
if (cell1 > 0 .and. cell2 > 0) then
do k=1,grid % nVertLevels
- do iScalar=1,num_scalars
+ do iScalar=1,s_old % num_scalars
scalar_turb_flux = h_theta_eddy_visc2*prandtl* &
(scalar_new(iScalar,k,cell2) - scalar_new(iScalar,k,cell1))/dcEdge(iEdge)
flux = dvEdge (iEdge) * rho_edge(k,iEdge) * scalar_turb_flux
@@ -1370,7 +1366,7 @@
if (cell1 > 0 .and. cell2 > 0) then
do k=1,grid % nVertLevels
- do iScalar=1,num_scalars
+ do iScalar=1,s_old % num_scalars
scalar_turb_flux = 0.5*(kdiff(k,cell1)+kdiff(k,cell2))*prandtl* &
(scalar_new(iScalar,k,cell2) - scalar_new(iScalar,k,cell1))/dcEdge(iEdge)
flux = dvEdge (iEdge) * rho_edge(k,iEdge) * scalar_turb_flux
@@ -1399,7 +1395,7 @@
z0 = 0.5*(z2+z3)
zp = 0.5*(z3+z4)
- do iScalar=1,num_scalars
+ do iScalar=1,s_old % num_scalars
scalar_tend(iScalar,k,iCell) = scalar_tend(iScalar,k,iCell) + v_theta_eddy_visc2*prandtl*rho(k,iCell)*(&
(scalar_new(iScalar,k+1,iCell)-scalar_new(iScalar,k ,iCell))/(zp-z0) &
-(scalar_new(iScalar,k ,iCell)-scalar_new(iScalar,k-1,iCell))/(z0-zm) )/(0.5*(zp-zm))
@@ -1407,7 +1403,7 @@
end do
if ( .not. config_mix_full) then
- iScalar = index_qv
+ iScalar = s_new % index_qv
do k=2,nVertLevels-1
z1 = zgrid(k-1,iCell)
z2 = zgrid(k ,iCell)
@@ -1437,18 +1433,18 @@
wdtn(:,1) = 0.
if (config_scalar_vadv_order == 2) then
do k = 2, nVertLevels
- do iScalar=1,num_scalars
+ do iScalar=1,s_old % num_scalars
wdtn(iScalar,k) = wwAvg(k,iCell)*(fnm(k)*scalar_new(iScalar,k,iCell)+fnp(k)*scalar_new(iScalar,k-1,iCell))
end do
end do
else
k = 2
- do iScalar=1,num_scalars
+ do iScalar=1,s_old % num_scalars
wdtn(iScalar,k) = wwAvg(k,iCell)*(fnm(k)*scalar_new(iScalar,k,iCell)+fnp(k)*scalar_new(iScalar,k-1,iCell))
enddo
if ( config_scalar_vadv_order == 3 ) then
do k=3,nVertLevels-1
- do iScalar=1,num_scalars
+ do iScalar=1,s_old % num_scalars
wdtn(iScalar,k) = flux3( scalar_new(iScalar,k-2,iCell),scalar_new(iScalar,k-1,iCell), &
scalar_new(iScalar,k ,iCell),scalar_new(iScalar,k+1,iCell), &
wwAvg(k,iCell), coef_3rd_order )
@@ -1456,14 +1452,14 @@
end do
else if ( config_scalar_vadv_order == 4 ) then
do k=3,nVertLevels-1
- do iScalar=1,num_scalars
+ do iScalar=1,s_old % num_scalars
wdtn(iScalar,k) = flux4( scalar_new(iScalar,k-2,iCell),scalar_new(iScalar,k-1,iCell), &
scalar_new(iScalar,k ,iCell),scalar_new(iScalar,k+1,iCell), wwAvg(k,iCell) )
end do
end do
end if
k = nVertLevels
- do iScalar=1,num_scalars
+ do iScalar=1,s_old % num_scalars
wdtn(iScalar,k) = wwAvg(k,iCell)*(fnm(k)*scalar_new(iScalar,k,iCell)+fnp(k)*scalar_new(iScalar,k-1,iCell))
enddo
@@ -1471,7 +1467,7 @@
wdtn(:,nVertLevels+1) = 0.
do k=1,grid % nVertLevelsSolve
- do iScalar=1,num_scalars
+ do iScalar=1,s_old % num_scalars
scalar_new(iScalar,k,iCell) = ( scalar_old(iScalar,k,iCell)*h_old(k,iCell) &
+ dt*( scalar_tend(iScalar,k,iCell) -rdnw(k)*(wdtn(iScalar,k+1)-wdtn(iScalar,k)) ) )/h_new(k,iCell)
@@ -1482,7 +1478,7 @@
end subroutine advance_scalars
- subroutine advance_scalars_mono( tend, s_old, s_new, grid, dt, rk_step, rk_order, dminfo, cellsToSend, cellsToRecv)
+ subroutine advance_scalars_mono( tend, s_old, s_new, diag, grid, dt, rk_step, rk_order, dminfo, cellsToSend, cellsToRecv)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! Input: s - current model state
@@ -1493,10 +1489,11 @@
implicit none
- type (grid_state), intent(in) :: tend
- type (grid_state), intent(in) :: s_old
- type (grid_state), intent(out) :: s_new
- type (grid_meta), intent(in) :: grid
+ type (tend_type), intent(in) :: tend
+ type (state_type), intent(in) :: s_old
+ type (state_type), intent(inout) :: s_new
+ type (diag_type), intent(in) :: diag
+ type (mesh_type), intent(in) :: grid
integer, intent(in) :: rk_step, rk_order
real (kind=RKIND), intent(in) :: dt
type (dm_info), intent(in) :: dminfo
@@ -1512,10 +1509,10 @@
real (kind=RKIND), dimension(:), pointer :: dvEdge, dcEdge, areaCell
integer, dimension(:,:), pointer :: cellsOnEdge
- real (kind=RKIND), dimension( num_scalars, grid % nEdges+1) :: h_flux
- real (kind=RKIND), dimension( num_scalars, grid % nCells+1, 2 ) :: v_flux, v_flux_upwind, s_update
- real (kind=RKIND), dimension( num_scalars, grid % nCells+1, 2 ) :: scale_out, scale_in
- real (kind=RKIND), dimension( num_scalars ) :: s_max, s_min, s_max_update, s_min_update
+ real (kind=RKIND), dimension( s_old % num_scalars, grid % nEdges+1) :: h_flux
+ real (kind=RKIND), dimension( s_old % num_scalars, grid % nCells+1, 2 ) :: v_flux, v_flux_upwind, s_update
+ real (kind=RKIND), dimension( s_old % num_scalars, grid % nCells+1, 2 ) :: scale_out, scale_in
+ real (kind=RKIND), dimension( s_old % num_scalars ) :: s_max, s_min, s_max_update, s_min_update
integer :: nVertLevels, km0, km1, ktmp, kcp1, kcm1
@@ -1590,18 +1587,18 @@
if (k < grid % nVertLevels) then
if ((config_scalar_vadv_order == 2) .or. (k==1) .or. (k==grid % nVertLevels)) then
- do iScalar=1,num_scalars
+ do iScalar=1,s_old % num_scalars
v_flux(iScalar,iCell,km0) = dt * wwAvg(k+1,iCell) * &
(fnm(k+1) * scalar_new(iScalar,k+1,iCell) + fnp(k+1) * scalar_new(iScalar,k,iCell))
end do
else if (config_scalar_vadv_order == 3) then
- do iScalar=1,num_scalars
+ do iScalar=1,s_old % num_scalars
v_flux(iScalar,iCell,km0) = dt * flux3( scalar_new(iScalar,k-1,iCell),scalar_new(iScalar,k ,iCell), &
scalar_new(iScalar,k+1,iCell),scalar_new(iScalar,k+2,iCell), &
wwAvg(k+1,iCell), coef_3rd_order )
end do
else if (config_scalar_vadv_order == 4) then
- do iScalar=1,num_scalars
+ do iScalar=1,s_old % num_scalars
v_flux(iScalar,iCell,km0) = dt * flux4( scalar_new(iScalar,k-1,iCell),scalar_new(iScalar,k ,iCell), &
scalar_new(iScalar,k+1,iCell),scalar_new(iScalar,k+2,iCell), wwAvg(k+1,iCell) )
end do
@@ -1610,7 +1607,7 @@
cell_upwind = k
if (wwAvg(k+1,iCell) >= 0) cell_upwind = k+1
- do iScalar=1,num_scalars
+ do iScalar=1,s_old % num_scalars
v_flux_upwind(iScalar,iCell,km0) = dt * wwAvg(k+1,iCell) * scalar_old(iScalar,cell_upwind,iCell)
v_flux(iScalar,iCell,km0) = v_flux(iScalar,iCell,km0) - v_flux_upwind(iScalar,iCell,km0)
! v_flux(iScalar,iCell,km0) = 0. ! use only upwind - for testing
@@ -1620,7 +1617,7 @@
else
- do iScalar=1,num_scalars
+ do iScalar=1,s_old % num_scalars
v_flux(iScalar,iCell,km0) = 0.
v_flux_upwind(iScalar,iCell,km0) = 0.
s_update(iScalar,iCell,km0) = scalar_old(iScalar,k,iCell) * h_old(k,iCell) &
@@ -1640,7 +1637,7 @@
if (cell1 > 0 .and. cell2 > 0) then
cell_upwind = cell2
if (uhAvg(k,iEdge) >= 0) cell_upwind = cell1
- do iScalar=1,num_scalars
+ do iScalar=1,s_old % num_scalars
scalar_edge = 0.5 * (scalar_new(iScalar,k,cell1) + scalar_new(iScalar,k,cell2))
h_flux(iScalar,iEdge) = dt * uhAvg(k,iEdge) * dvEdge(iEdge) * scalar_edge
h_flux_upwind = dt * uhAvg(k,iEdge) * dvEdge(iEdge) * scalar_old(iScalar,k,cell_upwind)
@@ -1660,7 +1657,7 @@
if (cell1 > 0 .and. cell2 > 0) then
cell_upwind = cell2
if (uhAvg(k,iEdge) >= 0) cell_upwind = cell1
- do iScalar=1,num_scalars
+ do iScalar=1,s_old % num_scalars
d2fdx2_cell1 = deriv_two(1,1,iEdge) * scalar_new(iScalar,k,cell1)
d2fdx2_cell2 = deriv_two(1,2,iEdge) * scalar_new(iScalar,k,cell2)
@@ -1708,7 +1705,7 @@
do iCell=1,grid % nCells
- do iScalar=1,num_scalars
+ do iScalar=1,s_old % num_scalars
s_max(iScalar) = max(scalar_old(iScalar,k,iCell), scalar_old(iScalar,kcp1,iCell), scalar_old(iScalar,kcm1,iCell))
s_min(iScalar) = min(scalar_old(iScalar,k,iCell), scalar_old(iScalar,kcp1,iCell), scalar_old(iScalar,kcm1,iCell))
@@ -1725,7 +1722,7 @@
do i = 1, grid % nEdgesOnCell % array(iCell) ! go around the edges of each cell
if (grid % cellsOnCell % array(i,iCell) > 0) then
- do iScalar=1,num_scalars
+ do iScalar=1,s_old % num_scalars
s_max(iScalar) = max(scalar_old(iScalar,k,grid % cellsOnCell % array(i,iCell)), s_max(iScalar))
s_min(iScalar) = min(scalar_old(iScalar,k,grid % cellsOnCell % array(i,iCell)), s_min(iScalar))
@@ -1747,7 +1744,7 @@
if( config_positive_definite ) s_min(:) = 0.
- do iScalar=1,num_scalars
+ do iScalar=1,s_old % num_scalars
scale_out (iScalar,iCell,km0) = 1.
scale_in (iScalar,iCell,km0) = 1.
s_max_update (iScalar) = s_max_update (iScalar) / h_new (k,iCell)
@@ -1763,16 +1760,16 @@
call dmpar_exch_halo_field2dReal(dminfo, scale_out(:,:,1), &
- num_scalars, grid % nCells, &
+ s_old % num_scalars, grid % nCells, &
cellsToSend, cellsToRecv)
call dmpar_exch_halo_field2dReal(dminfo, scale_out(:,:,2), &
- num_scalars, grid % nCells, &
+ s_old % num_scalars, grid % nCells, &
cellsToSend, cellsToRecv)
call dmpar_exch_halo_field2dReal(dminfo, scale_in(:,:,1), &
- num_scalars, grid % nCells, &
+ s_old % num_scalars, grid % nCells, &
cellsToSend, cellsToRecv)
call dmpar_exch_halo_field2dReal(dminfo, scale_in(:,:,2), &
- num_scalars, grid % nCells, &
+ s_old % num_scalars, grid % nCells, &
cellsToSend, cellsToRecv)
! rescale the horizontal fluxes
@@ -1781,7 +1778,7 @@
cell1 = grid % cellsOnEdge % array(1,iEdge)
cell2 = grid % cellsOnEdge % array(2,iEdge)
if (cell1 > 0 .and. cell2 > 0) then
- do iScalar=1,num_scalars
+ do iScalar=1,s_old % num_scalars
flux = h_flux(iScalar,iEdge)
if (flux > 0) then
flux = flux * min(scale_out(iScalar,cell1,km0), scale_in(iScalar,cell2,km0))
@@ -1796,7 +1793,7 @@
! rescale the vertical flux
do iCell=1,grid % nCells
- do iScalar=1,num_scalars
+ do iScalar=1,s_old % num_scalars
flux = v_flux(iScalar,iCell,km1)
if (flux > 0) then
flux = flux * min(scale_out(iScalar,iCell,km0), scale_in(iScalar,iCell,km1))
@@ -1816,7 +1813,7 @@
do iCell=1,grid % nCells
! add in upper vertical flux that was just renormalized
- do iScalar=1,num_scalars
+ do iScalar=1,s_old % num_scalars
s_update(iScalar,iCell,km0) = s_update(iScalar,iCell,km0) + rdnw(k) * v_flux(iScalar,iCell,km1)
if (k > 1) s_update(iScalar,iCell,km1) = s_update(iScalar,iCell,km1) - rdnw(k-1)*v_flux(iScalar,iCell,km1)
end do
@@ -1826,7 +1823,7 @@
cell1 = cellsOnEdge(1,iEdge)
cell2 = cellsOnEdge(2,iEdge)
if (cell1 > 0 .and. cell2 > 0) then
- do iScalar=1,num_scalars
+ do iScalar=1,s_old % num_scalars
s_update(iScalar,cell1,km0) = s_update(iScalar,cell1,km0) - &
h_flux(iScalar,iEdge) / grid % areaCell % array(cell1)
s_update(iScalar,cell2,km0) = s_update(iScalar,cell2,km0) + &
@@ -1838,13 +1835,13 @@
! decouple from mass
if (k > 1) then
do iCell=1,grid % nCells
- do iScalar=1,num_scalars
+ do iScalar=1,s_old % num_scalars
s_update(iScalar,iCell,km1) = s_update(iScalar,iCell,km1) / h_new(k-1,iCell)
end do
end do
do iCell=1,grid % nCells
- do iScalar=1,num_scalars
+ do iScalar=1,s_old % num_scalars
scalar_new(iScalar,k-1,iCell) = s_update(iScalar,iCell,km1)
end do
end do
@@ -1857,7 +1854,7 @@
end do
do iCell=1,grid % nCells
- do iScalar=1,num_scalars
+ do iScalar=1,s_old % num_scalars
scalar_new(iScalar,grid % nVertLevels,iCell) = s_update(iScalar,iCell,km1) / h_new(grid%nVertLevels,iCell)
end do
end do
@@ -1866,7 +1863,7 @@
!----
- subroutine compute_dyn_tend(tend, s, grid)
+ subroutine compute_dyn_tend(tend, s, diag, grid)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Compute height and normal wind tendencies, as well as diagnostic variables
!
@@ -1880,9 +1877,10 @@
implicit none
- type (grid_state), intent(inout) :: tend
- type (grid_state), intent(in) :: s
- type (grid_meta), intent(in) :: grid
+ type (tend_type), intent(inout) :: tend
+ type (state_type), intent(in) :: s
+ type (diag_type), intent(in) :: diag
+ type (mesh_type), intent(in) :: grid
integer :: iEdge, iCell, iVertex, k, cell1, cell2, vertex1, vertex2, eoe, i, j, iq
real (kind=RKIND) :: flux, vorticity_abs, rho_vertex, workpv, q, upstream_bias
@@ -1940,21 +1938,21 @@
coef_3rd_order = config_coef_3rd_order
rho => s % rho % array
- rho_edge => s % rho_edge % array
+ rho_edge => diag % rho_edge % array
rb => grid % rho_base % array
rr => s % rho_p % array
u => s % u % array
- v => s % v % array
- kdiff => s % kdiff % array
+ v => diag % v % array
+ kdiff => diag % kdiff % array
ru => grid % ru % array
w => s % w % array
rw => grid % rw % array
theta => s % theta % array
- circulation => s % circulation % array
- divergence => s % divergence % array
- vorticity => s % vorticity % array
- ke => s % ke % array
- pv_edge => s % pv_edge % array
+ circulation => diag % circulation % array
+ divergence => diag % divergence % array
+ vorticity => diag % vorticity % array
+ ke => diag % ke % array
+ pv_edge => diag % pv_edge % array
pp => s % pressure % array
pressure_b => grid % pressure_base % array
h_divergence => grid % h_divergence % array
@@ -2044,7 +2042,7 @@
h_divergence(k,iCell) = divergence_ru(k,iCell)
tend_rho(k,iCell) = -divergence_ru(k,iCell)-rdzw(k)*(rw(k+1,iCell)-rw(k,iCell))
- do iq = moist_start, moist_end
+ do iq = s % moist_start, s % moist_end
qtot(k,iCell) = qtot(k,iCell) + s % scalars % array (iq, k, iCell)
end do
@@ -2977,7 +2975,7 @@
!-------
- subroutine compute_solve_diagnostics(dt, s, grid)
+ subroutine compute_solve_diagnostics(dt, s, diag, grid)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Compute diagnostic fields used in the tendency computations
!
@@ -2989,8 +2987,9 @@
implicit none
real (kind=RKIND), intent(in) :: dt
- type (grid_state), intent(inout) :: s
- type (grid_meta), intent(in) :: grid
+ type (state_type), intent(inout) :: s
+ type (diag_type), intent(inout) :: diag
+ type (mesh_type), intent(in) :: grid
integer :: iEdge, iCell, iVertex, k, cell1, cell2, vertex1, vertex2, eoe, i, j, cov
@@ -3005,23 +3004,20 @@
integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge
-! h => s % h % array
h => s % rho % array
u => s % u % array
- v => s % v % array
- vh => s % rv % array
- h_edge => s % rho_edge % array
-! tend_h => s % h % array
-! tend_u => s % u % array
- circulation => s % circulation % array
- vorticity => s % vorticity % array
- divergence => s % divergence % array
- ke => s % ke % array
- pv_edge => s % pv_edge % array
- pv_vertex => s % pv_vertex % array
- pv_cell => s % pv_cell % array
- gradPVn => s % gradPVn % array
- gradPVt => s % gradPVt % array
+ v => diag % v % array
+ vh => diag % rv % array
+ h_edge => diag % rho_edge % array
+ circulation => diag % circulation % array
+ vorticity => diag % vorticity % array
+ divergence => diag % divergence % array
+ ke => diag % ke % array
+ pv_edge => diag % pv_edge % array
+ pv_vertex => diag % pv_vertex % array
+ pv_cell => diag % pv_cell % array
+ gradPVn => diag % gradPVn % array
+ gradPVt => diag % gradPVt % array
weightsOnEdge => grid % weightsOnEdge % array
kiteAreasOnVertex => grid % kiteAreasOnVertex % array
@@ -3257,8 +3253,8 @@
implicit none
- type (grid_state), intent(inout) :: state
- type (grid_meta), intent(inout) :: grid
+ type (state_type), intent(inout) :: state
+ type (mesh_type), intent(inout) :: grid
integer :: k,iEdge,i,iCell1,iCell2
@@ -3276,71 +3272,71 @@
subroutine qd_kessler( state_old, state_new, grid, dt )
- implicit none
+ implicit none
+
+ type (state_type), intent(inout) :: state_old, state_new
+ type (mesh_type), intent(inout) :: grid
+ real (kind=RKIND), intent(in) :: dt
- type (grid_state), intent(inout) :: state_old, state_new
- type (grid_meta), intent(inout) :: grid
- real (kind=RKIND), intent(in) :: dt
+ real (kind=RKIND), dimension( grid % nVertLevels ) :: t, rho, p, dzu, qv, qc, qr, qc1, qr1
+
+ integer :: k,iEdge,i,iCell,nz1
+ real (kind=RKIND) :: p0,rcv
+
+
+ write(0,*) ' in qd_kessler '
+
+ p0 = 1.e+05
+ rcv = rgas/(cp-rgas)
+ nz1 = grid % nVertLevels
+
+ do iCell = 1, grid % nCellsSolve
+
+ do k = 1, grid % nVertLevels
+
+ grid % rt_diabatic_tend % array(k,iCell) = state_new % theta % array(k,iCell)
+
+ t(k) = state_new % theta % array(k,iCell)/(1. + 1.61*state_new % scalars % array(state_new % index_qv,k,iCell))
+ rho(k) = grid % zz % array(k,iCell)*state_new % rho % array(k,iCell)
+ p(k) = grid % exner % array(k,iCell)
+ qv(k) = max(0.,state_new % scalars % array(state_new % index_qv,k,iCell))
+ qc(k) = max(0.,state_new % scalars % array(state_new % index_qc,k,iCell))
+ qr(k) = max(0.,state_new % scalars % array(state_new % index_qr,k,iCell))
+ qc1(k) = max(0.,state_old % scalars % array(state_old % index_qc,k,iCell))
+ qr1(k) = max(0.,state_old % scalars % array(state_old % index_qr,k,iCell))
+ dzu(k) = grid % dzu % array(k)
+
+ end do
+
+ call kessler( t,qv,qc,qc1,qr,qr1,rho,p,dt,dzu,nz1, 1)
+
+ do k = 1, grid % nVertLevels
+
+ state_new % theta % array(k,iCell) = t(k)*(1.+1.61*qv(k))
+ grid % rt_diabatic_tend % array(k,iCell) = state_new % rho % array(k,iCell) * &
+ (state_new % theta % array(k,iCell) - grid % rt_diabatic_tend % array(k,iCell))/dt
+ grid % rtheta_p % array(k,iCell) = state_new % rho % array(k,iCell) * state_new % theta % array(k,iCell) &
+ - grid % rtheta_base % array(k,iCell)
+ state_new % scalars % array(state_new % index_qv,k,iCell) = qv(k)
+ state_new % scalars % array(state_new % index_qc,k,iCell) = qc(k)
+ state_new % scalars % array(state_new % index_qr,k,iCell) = qr(k)
+
+ grid % exner % array(k,iCell) = &
+ ( grid % zz % array(k,iCell)*(rgas/p0) * ( &
+ grid % rtheta_p % array(k,iCell) &
+ + grid % rtheta_base % array(k,iCell) ) )**rcv
+
+ state_new % pressure % array(k,iCell) = &
+ grid % zz % array(k,iCell) * rgas * ( &
+ grid % exner % array(k,iCell)*grid % rtheta_p % array(k,iCell) &
+ +grid % rtheta_base % array(k,iCell) * &
+ (grid % exner % array(k,iCell) - grid % exner_base % array(k,iCell)) )
+ end do
+
+ end do
+
+ write(0,*) ' exiting qd_kessler '
- real (kind=RKIND), dimension( grid % nVertLevels ) :: t, rho, p, dzu, qv, qc, qr, qc1, qr1
-
- integer :: k,iEdge,i,iCell,nz1
- real (kind=RKIND) :: p0,rcv
-
-
- write(0,*) ' in qd_kessler '
-
- p0 = 1.e+05
- rcv = rgas/(cp-rgas)
- nz1 = grid % nVertLevels
-
- do iCell = 1, grid % nCellsSolve
-
- do k = 1, grid % nVertLevels
-
- grid % rt_diabatic_tend % array(k,iCell) = state_new % theta % array(k,iCell)
-
- t(k) = state_new % theta % array(k,iCell)/(1. + 1.61*state_new % scalars % array(index_qv,k,iCell))
- rho(k) = grid % zz % array(k,iCell)*state_new % rho % array(k,iCell)
- p(k) = grid % exner % array(k,iCell)
- qv(k) = max(0.,state_new % scalars % array(index_qv,k,iCell))
- qc(k) = max(0.,state_new % scalars % array(index_qc,k,iCell))
- qr(k) = max(0.,state_new % scalars % array(index_qr,k,iCell))
- qc1(k) = max(0.,state_old % scalars % array(index_qc,k,iCell))
- qr1(k) = max(0.,state_old % scalars % array(index_qr,k,iCell))
- dzu(k) = grid % dzu % array(k)
-
- end do
-
- call kessler( t,qv,qc,qc1,qr,qr1,rho,p,dt,dzu,nz1, 1)
-
- do k = 1, grid % nVertLevels
-
- state_new % theta % array(k,iCell) = t(k)*(1.+1.61*qv(k))
- grid % rt_diabatic_tend % array(k,iCell) = &
- (state_new % theta % array(k,iCell) - grid % rt_diabatic_tend % array(k,iCell))/dt
- grid % rtheta_p % array(k,iCell) = state_new % rho % array(k,iCell) * state_new % theta % array(k,iCell) &
- - grid % rtheta_base % array(k,iCell)
- state_new % scalars % array(index_qv,k,iCell) = qv(k)
- state_new % scalars % array(index_qc,k,iCell) = qc(k)
- state_new % scalars % array(index_qr,k,iCell) = qr(k)
-
- grid % exner % array(k,iCell) = &
- ( grid % zz % array(k,iCell)*(rgas/p0) * ( &
- grid % rtheta_p % array(k,iCell) &
- + grid % rtheta_base % array(k,iCell) ) )**rcv
-
- state_new % pressure % array(k,iCell) = &
- grid % zz % array(k,iCell) * rgas * ( &
- grid % exner % array(k,iCell)*grid % rtheta_p % array(k,iCell) &
- +grid % rtheta_base % array(k,iCell) * &
- (grid % exner % array(k,iCell) - grid % exner_base % array(k,iCell)) )
- end do
-
- end do
-
- write(0,*) ' exiting qd_kessler '
-
end subroutine qd_kessler
!-----------------------------------------------------------------------
Modified: branches/atmos_physics/src/core_nhyd_atmos/mpas_interface.F
===================================================================
--- branches/atmos_physics/src/core_nhyd_atmos/mpas_interface.F 2010-10-13 18:01:28 UTC (rev 548)
+++ branches/atmos_physics/src/core_nhyd_atmos/mpas_interface.F 2010-10-13 20:25:17 UTC (rev 549)
@@ -7,6 +7,12 @@
type (domain_type), intent(inout) :: domain
+!
+! Note: initialize_advection_rk() and initialize_deformation_weights()
+! are called from within setup_nhyd_test_case(); after initialization
+! is migrated to a separate program/processing step, we can uncomment
+! calls to these routines in in mpas_init() if necessary
+!
call setup_nhyd_test_case(domain)
end subroutine mpas_setup_test_case
@@ -15,7 +21,7 @@
subroutine mpas_init(block, mesh, dt)
use grid_types
- use advection
+! use advection
use time_integration
use vector_reconstruction
#ifdef DO_PHYSICS
@@ -27,19 +33,23 @@
implicit none
type (block_type), intent(inout) :: block
- type (grid_meta), intent(inout) :: mesh
+ type (mesh_type), intent(inout) :: mesh
real (kind=RKIND), intent(in) :: dt
-! call compute_solver_constants(block % time_levs(1) % state, mesh)
-! call compute_state_diagnostics(block % time_levs(1) % state, mesh)
- call init_coupled_diagnostics( block % time_levs(1) % state, mesh)
- call compute_solve_diagnostics(dt, block % time_levs(1) % state, mesh) ! ok for nonhydrostatic model
- call initialize_advection_rk(mesh)
+ call init_coupled_diagnostics( block % state % time_levs(1) % state, mesh)
+ call compute_solve_diagnostics(dt, block % state % time_levs(1) % state, block % diag, mesh)
+
call rbfInterp_initialize(mesh)
call init_reconstruct(mesh)
- call reconstruct(block % time_levs(1) % state, mesh)
- call initialize_deformation_weights(mesh)
+ call reconstruct(block % state % time_levs(1) % state, block % diag, mesh)
+!
+! Note: The following initialization calls have been moved to mpas_setup_test_case()
+! since values computed by these routines are needed to produce initial fields
+!
+! call initialize_advection_rk(mesh)
+! call initialize_deformation_weights(mesh)
+
#ifdef DO_PHYSICS
!check that all the physics options are correctly defined and that at least one physics
!parameterization is called (using the logical moist_physics):
@@ -48,9 +58,9 @@
!proceed with initialization of physics parameterization if moist_physics is set to true:
if(moist_physics) then
!initialization of all physics variables in registry:
- call physics_registry_init(config_do_restart, mesh, block % time_levs(1) % state)
+ call physics_registry_init(config_do_restart, mesh, block % state % time_levs(1) % state)
call physics_wrf_interface(mesh)
- call physics_init(mesh, block % time_levs(1) % state)
+ call physics_init(mesh, block % state % time_levs(1) % state)
endif
#endif
Modified: branches/atmos_physics/src/core_ocean/Registry
===================================================================
--- branches/atmos_physics/src/core_ocean/Registry 2010-10-13 18:01:28 UTC (rev 548)
+++ branches/atmos_physics/src/core_ocean/Registry 2010-10-13 20:25:17 UTC (rev 549)
@@ -7,7 +7,6 @@
namelist integer sw_model config_ntimesteps 7500
namelist integer sw_model config_output_interval 500
namelist integer sw_model config_stats_interval 100
-namelist real sw_model config_visc 0.0
namelist character io config_input_name grid.nc
namelist character io config_output_name output.nc
namelist character io config_restart_name restart.nc
@@ -16,7 +15,10 @@
namelist real restart config_restart_time 172800.0
namelist character grid config_vert_grid_type isopycnal
namelist real grid config_rho0 1028
-namelist real hmix config_hor_diffusion 2000.0
+namelist real hmix config_h_mom_eddy_visc2 0.0
+namelist real hmix config_h_mom_eddy_visc4 0.0
+namelist real hmix config_h_tracer_eddy_diff2 0.0
+namelist real hmix config_h_tracer_eddy_diff4 0.0
namelist character vmix config_vert_visc_type const
namelist character vmix config_vert_diff_type const
namelist real vmix config_vert_viscosity 2.5e-4
@@ -30,7 +32,6 @@
namelist character advection config_hor_tracer_adv 'centered'
namelist character advection config_vert_tracer_adv 'centered'
-
#
# dim type name_in_file name_in_code
#
@@ -46,122 +47,131 @@
dim nVertLevelsP1 nVertLevels+1
#
-# var type name_in_file ( dims ) iro- name_in_code super-array array_class
+# var persistence type name_in_file ( dims ) time_levs iro- name_in_code struct super-array array_class
#
-var real xtime ( Time ) ro xtime - -
+var persistent real xtime ( Time ) 2 ro xtime state - -
-var real latCell ( nCells ) iro latCell - -
-var real lonCell ( nCells ) iro lonCell - -
-var real xCell ( nCells ) iro xCell - -
-var real yCell ( nCells ) iro yCell - -
-var real zCell ( nCells ) iro zCell - -
-var integer indexToCellID ( nCells ) iro indexToCellID - -
+var persistent real latCell ( nCells ) 0 iro latCell mesh - -
+var persistent real lonCell ( nCells ) 0 iro lonCell mesh - -
+var persistent real xCell ( nCells ) 0 iro xCell mesh - -
+var persistent real yCell ( nCells ) 0 iro yCell mesh - -
+var persistent real zCell ( nCells ) 0 iro zCell mesh - -
+var persistent integer indexToCellID ( nCells ) 0 iro indexToCellID mesh - -
-var real latEdge ( nEdges ) iro latEdge - -
-var real lonEdge ( nEdges ) iro lonEdge - -
-var real xEdge ( nEdges ) iro xEdge - -
-var real yEdge ( nEdges ) iro yEdge - -
-var real zEdge ( nEdges ) iro zEdge - -
-var integer indexToEdgeID ( nEdges ) iro indexToEdgeID - -
+var persistent real latEdge ( nEdges ) 0 iro latEdge mesh - -
+var persistent real lonEdge ( nEdges ) 0 iro lonEdge mesh - -
+var persistent real xEdge ( nEdges ) 0 iro xEdge mesh - -
+var persistent real yEdge ( nEdges ) 0 iro yEdge mesh - -
+var persistent real zEdge ( nEdges ) 0 iro zEdge mesh - -
+var persistent integer indexToEdgeID ( nEdges ) 0 iro indexToEdgeID mesh - -
-var real latVertex ( nVertices ) iro latVertex - -
-var real lonVertex ( nVertices ) iro lonVertex - -
-var real xVertex ( nVertices ) iro xVertex - -
-var real yVertex ( nVertices ) iro yVertex - -
-var real zVertex ( nVertices ) iro zVertex - -
-var integer indexToVertexID ( nVertices ) iro indexToVertexID - -
+var persistent real latVertex ( nVertices ) 0 iro latVertex mesh - -
+var persistent real lonVertex ( nVertices ) 0 iro lonVertex mesh - -
+var persistent real xVertex ( nVertices ) 0 iro xVertex mesh - -
+var persistent real yVertex ( nVertices ) 0 iro yVertex mesh - -
+var persistent real zVertex ( nVertices ) 0 iro zVertex mesh - -
+var persistent integer indexToVertexID ( nVertices ) 0 iro indexToVertexID mesh - -
-var integer cellsOnEdge ( TWO nEdges ) iro cellsOnEdge - -
-var integer nEdgesOnCell ( nCells ) iro nEdgesOnCell - -
-var integer nEdgesOnEdge ( nEdges ) iro nEdgesOnEdge - -
-var integer edgesOnCell ( maxEdges nCells ) iro edgesOnCell - -
-var integer edgesOnEdge ( maxEdges2 nEdges ) iro edgesOnEdge - -
+var persistent integer cellsOnEdge ( TWO nEdges ) 0 iro cellsOnEdge mesh - -
+var persistent integer nEdgesOnCell ( nCells ) 0 iro nEdgesOnCell mesh - -
+var persistent integer nEdgesOnEdge ( nEdges ) 0 iro nEdgesOnEdge mesh - -
+var persistent integer edgesOnCell ( maxEdges nCells ) 0 iro edgesOnCell mesh - -
+var persistent integer edgesOnEdge ( maxEdges2 nEdges ) 0 iro edgesOnEdge mesh - -
-var real weightsOnEdge ( maxEdges2 nEdges ) iro weightsOnEdge - -
-var real dvEdge ( nEdges ) iro dvEdge - -
-var real dcEdge ( nEdges ) iro dcEdge - -
-var real angleEdge ( nEdges ) iro angleEdge - -
-var real areaCell ( nCells ) iro areaCell - -
-var real areaTriangle ( nVertices ) iro areaTriangle - -
+var persistent real weightsOnEdge ( maxEdges2 nEdges ) 0 iro weightsOnEdge mesh - -
+var persistent real dvEdge ( nEdges ) 0 iro dvEdge mesh - -
+var persistent real dcEdge ( nEdges ) 0 iro dcEdge mesh - -
+var persistent real angleEdge ( nEdges ) 0 iro angleEdge mesh - -
+var persistent real areaCell ( nCells ) 0 iro areaCell mesh - -
+var persistent real areaTriangle ( nVertices ) 0 iro areaTriangle mesh - -
-var real edgeNormalVectors ( R3 nEdges ) o edgeNormalVectors - -
-var real localVerticalUnitVectors ( R3 nCells ) o localVerticalUnitVectors - -
-var real cellTangentPlane ( R3 TWO nEdges ) o cellTangentPlane - -
+var persistent real edgeNormalVectors ( R3 nEdges ) 0 o edgeNormalVectors mesh - -
+var persistent real localVerticalUnitVectors ( R3 nCells ) 0 o localVerticalUnitVectors mesh - -
+var persistent real cellTangentPlane ( R3 TWO nEdges ) 0 o cellTangentPlane mesh - -
-var integer cellsOnCell ( maxEdges nCells ) iro cellsOnCell - -
-var integer verticesOnCell ( maxEdges nCells ) iro verticesOnCell - -
-var integer verticesOnEdge ( TWO nEdges ) iro verticesOnEdge - -
-var integer edgesOnVertex ( vertexDegree nVertices ) iro edgesOnVertex - -
-var integer cellsOnVertex ( vertexDegree nVertices ) iro cellsOnVertex - -
-var real kiteAreasOnVertex ( vertexDegree nVertices ) iro kiteAreasOnVertex - -
-var real fEdge ( nEdges ) iro fEdge - -
-var real fVertex ( nVertices ) iro fVertex - -
-var real h_s ( nCells ) iro h_s - -
+var persistent integer cellsOnCell ( maxEdges nCells ) 0 iro cellsOnCell mesh - -
+var persistent integer verticesOnCell ( maxEdges nCells ) 0 iro verticesOnCell mesh - -
+var persistent integer verticesOnEdge ( TWO nEdges ) 0 iro verticesOnEdge mesh - -
+var persistent integer edgesOnVertex ( vertexDegree nVertices ) 0 iro edgesOnVertex mesh - -
+var persistent integer cellsOnVertex ( vertexDegree nVertices ) 0 iro cellsOnVertex mesh - -
+var persistent real kiteAreasOnVertex ( vertexDegree nVertices ) 0 iro kiteAreasOnVertex mesh - -
+var persistent real fEdge ( nEdges ) 0 iro fEdge mesh - -
+var persistent real fVertex ( nVertices ) 0 iro fVertex mesh - -
+var persistent real h_s ( nCells ) 0 iro h_s mesh - -
# Arrays required for reconstruction of velocity field
-var real coeffs_reconstruct ( R3 maxEdges nCells ) - coeffs_reconstruct - -
+var persistent real coeffs_reconstruct ( R3 maxEdges nCells ) 0 - coeffs_reconstruct mesh - -
# Arrays for z-level version of mpas-ocean
-var integer maxLevelsCell ( nCells ) iro kmaxCell - -
-var integer maxLevelsEdge ( nEdges ) iro kmaxEdge - -
-var real hZLevel ( nVertLevels ) iro hZLevel - -
-var real zMidZLevel ( nVertLevels ) iro zMidZLevel - -
-var real zTopZLevel ( nVertLevelsP1 ) iro zTopZLevel - -
+var persistent integer maxLevelsCell ( nCells ) 0 iro kmaxCell mesh - -
+var persistent integer maxLevelsEdge ( nEdges ) 0 iro kmaxEdge mesh - -
+var persistent real hZLevel ( nVertLevels ) 0 iro hZLevel mesh - -
+var persistent real zMidZLevel ( nVertLevels ) 0 iro zMidZLevel mesh - -
+var persistent real zTopZLevel ( nVertLevelsP1 ) 0 iro zTopZLevel mesh - -
# Boundary conditions: read from input, saved in restart and written to output
-var integer boundaryEdge ( nVertLevels nEdges ) iro boundaryEdge - -
-var integer boundaryVertex ( nVertLevels nVertices ) iro boundaryVertex - -
-var real u_src ( nVertLevels nEdges ) iro u_src - -
+var persistent integer boundaryEdge ( nVertLevels nEdges ) 0 iro boundaryEdge mesh - -
+var persistent integer boundaryVertex ( nVertLevels nVertices ) 0 iro boundaryVertex mesh - -
+var persistent real u_src ( nVertLevels nEdges ) 0 iro u_src mesh - -
# Prognostic variables: read from input, saved in restart, and written to output
-var real u ( nVertLevels nEdges Time ) iro u - -
-var real h ( nVertLevels nCells Time ) iro h - -
-var real rho ( nVertLevels nCells Time ) iro rho - -
-var real temperature ( nVertLevels nCells Time ) iro temperature tracers dynamics
-var real salinity ( nVertLevels nCells Time ) iro salinity tracers dynamics
-var real tracer1 ( nVertLevels nCells Time ) iro tracer1 tracers testing
-var real tracer2 ( nVertLevels nCells Time ) iro tracer2 tracers testing
+var persistent real u ( nVertLevels nEdges Time ) 2 iro u state - -
+var persistent real h ( nVertLevels nCells Time ) 2 iro h state - -
+var persistent real rho ( nVertLevels nCells Time ) 2 iro rho state - -
+var persistent real temperature ( nVertLevels nCells Time ) 2 iro temperature state tracers dynamics
+var persistent real salinity ( nVertLevels nCells Time ) 2 iro salinity state tracers dynamics
+var persistent real tracer1 ( nVertLevels nCells Time ) 2 iro tracer1 state tracers testing
+var persistent real tracer2 ( nVertLevels nCells Time ) 2 iro tracer2 state tracers testing
+# Tendency variables: neither read nor written to any files
+var persistent real tend_u ( nVertLevels nEdges Time ) 1 - u tend - -
+var persistent real tend_h ( nVertLevels nCells Time ) 1 - h tend - -
+var persistent real tend_temperature ( nVertLevels nCells Time ) 1 - temperature tend tracers dynamics
+var persistent real tend_salinity ( nVertLevels nCells Time ) 1 - salinity tend tracers dynamics
+var persistent real tend_tracer1 ( nVertLevels nCells Time ) 1 - tracer1 tend tracers testing
+var persistent real tend_tracer2 ( nVertLevels nCells Time ) 1 - tracer2 tend tracers testing
+
# Diagnostic fields: only written to output
-var real v ( nVertLevels nEdges Time ) o v - -
-var real divergence ( nVertLevels nCells Time ) o divergence - -
-var real vorticity ( nVertLevels nVertices Time ) o vorticity - -
-var real pv_edge ( nVertLevels nEdges Time ) o pv_edge - -
-var real h_edge ( nVertLevels nEdges Time ) o h_edge - -
-var real ke ( nVertLevels nCells Time ) o ke - -
-var real ke_edge ( nVertLevels nEdges Time ) o ke_edge - -
-var real pv_vertex ( nVertLevels nVertices Time ) o pv_vertex - -
-var real pv_cell ( nVertLevels nCells Time ) o pv_cell - -
-var real uReconstructX ( nVertLevels nCells Time ) o uReconstructX - -
-var real uReconstructY ( nVertLevels nCells Time ) o uReconstructY - -
-var real uReconstructZ ( nVertLevels nCells Time ) o uReconstructZ - -
-var real uReconstructZonal ( nVertLevels nCells Time ) o uReconstructZonal - -
-var real uReconstructMeridional ( nVertLevels nCells Time ) o uReconstructMeridional - -
-var real zMid ( nVertLevels nCells Time ) o zMid - -
-var real zTop ( nVertLevelsP1 nCells Time ) o zTop - -
-var real zMidEdge ( nVertLevels nEdges Time ) o zMidEdge - -
-var real zTopEdge ( nVertLevelsP1 nEdges Time ) o zTopEdge - -
-var real p ( nVertLevels nCells Time ) o p - -
-var real pTop ( nVertLevelsP1 nCells Time ) o pTop - -
-var real pZLevel ( nVertLevels nCells Time ) o pZLevel - -
-var real MontPot ( nVertLevels nCells Time ) o MontPot - -
-var real wTop ( nVertLevelsP1 nCells Time ) o wTop - -
-var real ssh ( nCells Time ) o ssh - -
+var persistent real v ( nVertLevels nEdges Time ) 2 o v state - -
+var persistent real divergence ( nVertLevels nCells Time ) 2 o divergence state - -
+var persistent real vorticity ( nVertLevels nVertices Time ) 2 o vorticity state - -
+var persistent real pv_edge ( nVertLevels nEdges Time ) 2 o pv_edge state - -
+var persistent real h_edge ( nVertLevels nEdges Time ) 2 o h_edge state - -
+var persistent real h_vertex ( nVertLevels nVertices Time ) 2 o h_vertex state - -
+var persistent real ke ( nVertLevels nCells Time ) 2 o ke state - -
+var persistent real ke_edge ( nVertLevels nEdges Time ) 2 o ke_edge state - -
+var persistent real pv_vertex ( nVertLevels nVertices Time ) 2 o pv_vertex state - -
+var persistent real pv_cell ( nVertLevels nCells Time ) 2 o pv_cell state - -
+var persistent real uReconstructX ( nVertLevels nCells Time ) 1 o uReconstructX diag - -
+var persistent real uReconstructY ( nVertLevels nCells Time ) 1 o uReconstructY diag - -
+var persistent real uReconstructZ ( nVertLevels nCells Time ) 1 o uReconstructZ diag - -
+var persistent real uReconstructZonal ( nVertLevels nCells Time ) 1 o uReconstructZonal diag - -
+var persistent real uReconstructMeridional ( nVertLevels nCells Time ) 1 o uReconstructMeridional diag - -
+var persistent real zMid ( nVertLevels nCells Time ) 2 o zMid state - -
+var persistent real zTop ( nVertLevelsP1 nCells Time ) 2 o zTop state - -
+var persistent real zMidEdge ( nVertLevels nEdges Time ) 2 o zMidEdge state - -
+var persistent real zTopEdge ( nVertLevelsP1 nEdges Time ) 2 o zTopEdge state - -
+var persistent real p ( nVertLevels nCells Time ) 2 o p state - -
+var persistent real pTop ( nVertLevelsP1 nCells Time ) 2 o pTop state - -
+var persistent real pZLevel ( nVertLevels nCells Time ) 2 o pZLevel state - -
+var persistent real MontPot ( nVertLevels nCells Time ) 2 o MontPot state - -
+var persistent real wTop ( nVertLevelsP1 nCells Time ) 2 o wTop state - -
+var persistent real ssh ( nCells Time ) 2 o ssh state - -
# Other diagnostic variables: neither read nor written to any files
-var real vh ( nVertLevels nEdges Time ) - vh - -
-var real circulation ( nVertLevels nVertices Time ) - circulation - -
-var real gradPVt ( nVertLevels nEdges Time ) - gradPVt - -
-var real gradPVn ( nVertLevels nEdges Time ) - gradPVn - -
+var persistent real vh ( nVertLevels nEdges Time ) 2 - vh state - -
+var persistent real circulation ( nVertLevels nVertices Time ) 2 - circulation state - -
+var persistent real gradPVt ( nVertLevels nEdges Time ) 2 - gradPVt state - -
+var persistent real gradPVn ( nVertLevels nEdges Time ) 2 - gradPVn state - -
# xsad 10-02-05:
# Globally reduced diagnostic variables: only written to output
-var real areaCellGlobal ( Time ) o areaCellGlobal - -
-var real areaEdgeGlobal ( Time ) o areaEdgeGlobal - -
-var real areaTriangleGlobal ( Time ) o areaTriangleGlobal - -
+var persistent real areaCellGlobal ( Time ) 2 o areaCellGlobal state - -
+var persistent real areaEdgeGlobal ( Time ) 2 o areaEdgeGlobal state - -
+var persistent real areaTriangleGlobal ( Time ) 2 o areaTriangleGlobal state - -
-var real volumeCellGlobal ( Time ) o volumeCellGlobal - -
-var real volumeEdgeGlobal ( Time ) o volumeEdgeGlobal - -
-var real CFLNumberGlobal ( Time ) o CFLNumberGlobal - -
+var persistent real volumeCellGlobal ( Time ) 2 o volumeCellGlobal state - -
+var persistent real volumeEdgeGlobal ( Time ) 2 o volumeEdgeGlobal state - -
+var persistent real CFLNumberGlobal ( Time ) 2 o CFLNumberGlobal state - -
# xsad 10-02-05 end
Modified: branches/atmos_physics/src/core_ocean/module_global_diagnostics.F
===================================================================
--- branches/atmos_physics/src/core_ocean/module_global_diagnostics.F 2010-10-13 18:01:28 UTC (rev 548)
+++ branches/atmos_physics/src/core_ocean/module_global_diagnostics.F 2010-10-13 20:25:17 UTC (rev 549)
@@ -27,8 +27,8 @@
implicit none
type (dm_info), intent(in) :: dminfo
- type (grid_state), intent(inout) :: state
- type (grid_meta), intent(in) :: grid
+ type (state_type), intent(inout) :: state
+ type (mesh_type), intent(in) :: grid
integer, intent(in) :: timeIndex
real (kind=RKIND), intent(in) :: dt
@@ -43,7 +43,7 @@
real (kind=RKIND) :: volumeCellGlobal, volumeEdgeGlobal, CFLNumberGlobal
real (kind=RKIND) :: localCFL, localSum
integer :: elementIndex, variableIndex, nVariables, nSums, nMaxes, nMins
- integer :: timeLevel,k,i
+ integer :: timeLevel,k,i, num_tracers
integer, parameter :: kMaxVariables = 1024 ! this must be a little more than double the number of variables to be reduced
@@ -51,6 +51,8 @@
integer :: fileID
+ num_tracers = state % num_tracers
+
nVertLevels = grid % nVertLevels
nCellsSolve = grid % nCellsSolve
nEdgesSolve = grid % nEdgesSolve
Modified: branches/atmos_physics/src/core_ocean/module_test_cases.F
===================================================================
--- branches/atmos_physics/src/core_ocean/module_test_cases.F 2010-10-13 18:01:28 UTC (rev 548)
+++ branches/atmos_physics/src/core_ocean/module_test_cases.F 2010-10-13 20:25:17 UTC (rev 549)
@@ -28,10 +28,10 @@
! mrp 100507: for diagnostic output
integer :: iTracer
real (kind=RKIND), dimension(:), pointer :: xCell,yCell, &
- hZLevel, zMidZLevel, zTopZLevel
+ hZLevel, zMidZLevel, zTopZLevel, latCell,LonCell
real (kind=RKIND), dimension(:,:), pointer :: h, u, u_src, rho
real (kind=RKIND), dimension(:,:,:), pointer :: tracers
- real (kind=RKIND) :: delta_rho
+ real (kind=RKIND) :: delta_rho, pi, latCenter, lonCenter, dist
integer :: nCells, nEdges, nVertices, nVertLevels
! mrp 100507 end: for diagnostic output
@@ -44,7 +44,7 @@
block_ptr => domain % blocklist
do while (associated(block_ptr))
- call sw_test_case_1(block_ptr % mesh, block_ptr % time_levs(1) % state)
+ call sw_test_case_1(block_ptr % mesh, block_ptr % state % time_levs(1) % state)
block_ptr => block_ptr % next
end do
@@ -54,7 +54,7 @@
block_ptr => domain % blocklist
do while (associated(block_ptr))
- call sw_test_case_2(block_ptr % mesh, block_ptr % time_levs(1) % state)
+ call sw_test_case_2(block_ptr % mesh, block_ptr % state % time_levs(1) % state)
block_ptr => block_ptr % next
end do
@@ -64,7 +64,7 @@
block_ptr => domain % blocklist
do while (associated(block_ptr))
- call sw_test_case_5(block_ptr % mesh, block_ptr % time_levs(1) % state)
+ call sw_test_case_5(block_ptr % mesh, block_ptr % state % time_levs(1) % state)
block_ptr => block_ptr % next
end do
@@ -74,7 +74,7 @@
block_ptr => domain % blocklist
do while (associated(block_ptr))
- call sw_test_case_6(block_ptr % mesh, block_ptr % time_levs(1) % state)
+ call sw_test_case_6(block_ptr % mesh, block_ptr % state % time_levs(1) % state)
block_ptr => block_ptr % next
end do
@@ -89,8 +89,8 @@
do while (associated(block_ptr))
do i=2,nTimeLevs
- call copy_state(block_ptr % time_levs(1) % state, &
- block_ptr % time_levs(i) % state)
+ call copy_state(block_ptr % state % time_levs(i) % state, &
+ block_ptr % state % time_levs(1) % state)
end do
block_ptr => block_ptr % next
@@ -99,13 +99,15 @@
! Initialize z-level grid variables from h, read in from input file.
block_ptr => domain % blocklist
do while (associated(block_ptr))
- h => block_ptr % time_levs(1) % state % h % array
- u => block_ptr % time_levs(1) % state % u % array
- rho => block_ptr % time_levs(1) % state % rho % array
- tracers => block_ptr % time_levs(1) % state % tracers % array
+ h => block_ptr % state % time_levs(1) % state % h % array
+ u => block_ptr % state % time_levs(1) % state % u % array
+ rho => block_ptr % state % time_levs(1) % state % rho % array
+ tracers => block_ptr % state % time_levs(1) % state % tracers % array
u_src => block_ptr % mesh % u_src % array
xCell => block_ptr % mesh % xCell % array
yCell => block_ptr % mesh % yCell % array
+ latCell => block_ptr % mesh % latCell % array
+ lonCell => block_ptr % mesh % lonCell % array
hZLevel => block_ptr % mesh % hZLevel % array
zMidZLevel => block_ptr % mesh % zMidZLevel % array
@@ -116,6 +118,13 @@
nVertices = block_ptr % mesh % nVertices
nVertLevels = block_ptr % mesh % nVertLevels
+ pi=3.1415
+ ! Tracer blob in Central Pacific, away from boundaries:
+ !latCenter=pi/16; lonCenter=9./8.*pi
+
+ ! Tracer blob in Central Pacific, near boundaries:
+ latCenter=pi*2./16; lonCenter=13./16.*pi
+
if (config_vert_grid_type.eq.'zlevel') then
! These should eventually be in an input file. For now
! I just read them in from h(:,1).
@@ -138,22 +147,30 @@
! Set tracers, if not done in grid.nc file
!tracers = 0.0
do iCell = 1,nCells
+ dist = sqrt( (latCell(iCell)-latCenter)**2 + (lonCell(iCell)-lonCenter)**2)
do iLevel = 1,nVertLevels
! for 20 layer test
- ! tracers(index_temperature,iLevel,iCell) = 5.0 ! temperature
- ! tracers(index_salinity,iLevel,iCell) = 1.4 + iLevel*0.6 ! salinity
+ ! tracers(block_ptr % state % time_levs(1) % state % index_temperature,iLevel,iCell) = 5.0 ! temperature
+ ! tracers(block_ptr % state % time_levs(1) % state % index_salinity,iLevel,iCell) = 1.4 + iLevel*0.6 ! salinity
! for x3, 25 layer test
- tracers(index_temperature,iLevel,iCell) = 10.0 ! temperature
- tracers(index_salinity,iLevel,iCell) = 1.4 + iLevel*0.6 ! salinity
+ !tracers(block_ptr % state % time_levs(1) % state % index_temperature,iLevel,iCell) = 10.0 ! temperature
+ !tracers(block_ptr % state % time_levs(1) % state % index_salinity,iLevel,iCell) = 1.4 + iLevel*0.6 ! salinity
- tracers(index_tracer1,iLevel,iCell) = 1.0
- tracers(index_tracer2,iLevel,iCell) = &
- (yCell(iCell)/4000.e3 + xCell(iCell)/2500.e3 )/2.0
+ ! tracers(block_ptr % state % time_levs(1) % state % index_tracer1,iLevel,iCell) = 1.0
+ ! tracers(block_ptr % state % time_levs(1) % state % index_tracer2,iLevel,iCell) = &
+ ! (yCell(iCell)/4000.e3 + xCell(iCell)/2500.e3 )/2.0
+ ! Tracer blob
+ !if (dist.lt.pi/16) then
+ ! tracers(block_ptr % state % time_levs(1) % state % index_tracer1,iLevel,iCell) = 1.0
+ !!else
+ ! tracers(block_ptr % state % time_levs(1) % state % index_tracer1,iLevel,iCell) = 0.0
+ !endif
+
rho(iLevel,iCell) = 1000.0*( 1.0 &
- - 2.5e-4*tracers(index_temperature,iLevel,iCell) &
- + 7.6e-4*tracers(index_salinity,iLevel,iCell))
+ - 2.5e-4*tracers(block_ptr % state % time_levs(1) % state % index_temperature,iLevel,iCell) &
+ + 7.6e-4*tracers(block_ptr % state % time_levs(1) % state % index_salinity,iLevel,iCell))
enddo
enddo
@@ -177,7 +194,7 @@
enddo
print '(10a)', 'itracer ilevel min tracer max tracer'
- do iTracer=1,num_tracers
+ do iTracer=1,block_ptr % state % time_levs(1) % state % num_tracers
do iLevel = 1,nVertLevels
print '(2i5,20es12.4)', iTracer,ilevel, &
minval(tracers(itracer,iLevel,1:nCells)), maxval(tracers(itracer,iLevel,1:nCells))
@@ -202,8 +219,8 @@
implicit none
- type (grid_meta), intent(inout) :: grid
- type (grid_state), intent(inout) :: state
+ type (mesh_type), intent(inout) :: grid
+ type (state_type), intent(inout) :: state
real (kind=RKIND), parameter :: u0 = 2.0 * pii * a / (12.0 * 86400.0)
real (kind=RKIND), parameter :: h0 = 1000.0
@@ -278,8 +295,8 @@
implicit none
- type (grid_meta), intent(inout) :: grid
- type (grid_state), intent(inout) :: state
+ type (mesh_type), intent(inout) :: grid
+ type (state_type), intent(inout) :: state
real (kind=RKIND), parameter :: u0 = 2.0 * pii * a / (12.0 * 86400.0)
real (kind=RKIND), parameter :: gh0 = 29400.0
@@ -369,8 +386,8 @@
implicit none
- type (grid_meta), intent(inout) :: grid
- type (grid_state), intent(inout) :: state
+ type (mesh_type), intent(inout) :: grid
+ type (state_type), intent(inout) :: state
real (kind=RKIND), parameter :: u0 = 20.
real (kind=RKIND), parameter :: gh0 = 5960.0*gravity
@@ -491,8 +508,8 @@
implicit none
- type (grid_meta), intent(inout) :: grid
- type (grid_state), intent(inout) :: state
+ type (mesh_type), intent(inout) :: grid
+ type (state_type), intent(inout) :: state
real (kind=RKIND), parameter :: h0 = 8000.0
real (kind=RKIND), parameter :: w = 7.848e-6
Modified: branches/atmos_physics/src/core_ocean/module_time_integration.F
===================================================================
--- branches/atmos_physics/src/core_ocean/module_time_integration.F 2010-10-13 18:01:28 UTC (rev 548)
+++ branches/atmos_physics/src/core_ocean/module_time_integration.F 2010-10-13 20:25:17 UTC (rev 549)
@@ -37,10 +37,10 @@
block => domain % blocklist
do while (associated(block))
- block % time_levs(2) % state % xtime % scalar &
- = block % time_levs(1) % state % xtime % scalar + dt
+ block % state % time_levs(2) % state % xtime % scalar &
+ = block % state % time_levs(1) % state % xtime % scalar + dt
- if (isNaN(sum(block % time_levs(2) % state % u % array))) then
+ if (isNaN(sum(block % state % time_levs(2) % state % u % array))) then
write(0,*) 'Abort: NaN detected'
call dmpar_abort(dminfo)
endif
@@ -69,13 +69,16 @@
integer :: iCell, k, i
type (block_type), pointer :: block
+ type (state_type) :: provis
- integer, parameter :: PROVIS = 1
- integer, parameter :: TEND = 2
integer :: rk_step
real (kind=RKIND), dimension(4) :: rk_weights, rk_substep_weights
+ block => domain % blocklist
+ call allocate_state(provis, &
+ block % mesh % nCells, block % mesh % nEdges, block % mesh % maxEdges, block % mesh % maxEdges2, &
+ block % mesh % nVertices, block % mesh % vertexDegree, block % mesh % nVertLevels )
!
! Initialize time_levs(2) with state at current time
@@ -86,16 +89,16 @@
block => domain % blocklist
do while (associated(block))
- block % time_levs(2) % state % u % array(:,:) = block % time_levs(1) % state % u % array(:,:)
- block % time_levs(2) % state % h % array(:,:) = block % time_levs(1) % state % h % array(:,:)
+ block % state % time_levs(2) % state % u % array(:,:) = block % state % time_levs(1) % state % u % array(:,:)
+ block % state % time_levs(2) % state % h % array(:,:) = block % state % time_levs(1) % state % h % array(:,:)
do iCell=1,block % mesh % nCells ! couple tracers to h
do k=1,block % mesh % nVertLevels
- block % time_levs(2) % state % tracers % array(:,k,iCell) = block % time_levs(1) % state % tracers % array(:,k,iCell) &
- * block % time_levs(1) % state % h % array(k,iCell)
+ block % state % time_levs(2) % state % tracers % array(:,k,iCell) = block % state % time_levs(1) % state % tracers % array(:,k,iCell) &
+ * block % state % time_levs(1) % state % h % array(k,iCell)
end do
end do
- call copy_state(block % time_levs(1) % state, block % intermediate_step(PROVIS))
+ call copy_state(provis, block % state % time_levs(1) % state)
block => block % next
end do
@@ -119,9 +122,19 @@
block => domain % blocklist
do while (associated(block))
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % intermediate_step(PROVIS) % pv_edge % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, provis % pv_edge % array(:,:), &
block % mesh % nVertLevels, block % mesh % nEdges, &
block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
+
+ if (config_h_mom_eddy_visc4 > 0.0) then
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % divergence % array(:,:), &
+ block % mesh % nVertLevels, block % mesh % nCells, &
+ block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % vorticity % array(:,:), &
+ block % mesh % nVertLevels, block % mesh % nVertices, &
+ block % parinfo % verticesToSend, block % parinfo % verticesToRecv)
+ end if
+
block => block % next
end do
@@ -129,9 +142,9 @@
block => domain % blocklist
do while (associated(block))
- call compute_tend(block % intermediate_step(TEND), block % intermediate_step(PROVIS), block % mesh)
- call compute_scalar_tend(block % intermediate_step(TEND), block % intermediate_step(PROVIS), block % mesh)
- call enforce_boundaryEdge(block % intermediate_step(TEND), block % mesh)
+ call compute_tend(block % tend, provis, block % mesh)
+ call compute_scalar_tend(block % tend, provis, block % mesh)
+ call enforce_boundaryEdge(block % tend, block % mesh)
block => block % next
end do
@@ -139,14 +152,14 @@
block => domain % blocklist
do while (associated(block))
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % intermediate_step(TEND) % u % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % tend % u % array(:,:), &
block % mesh % nVertLevels, block % mesh % nEdges, &
block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % intermediate_step(TEND) % h % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % tend % h % array(:,:), &
block % mesh % nVertLevels, block % mesh % nCells, &
block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
- call dmpar_exch_halo_field3dReal(domain % dminfo, block % intermediate_step(TEND) % tracers % array(:,:,:), &
- num_tracers, block % mesh % nVertLevels, block % mesh % nCells, &
+ call dmpar_exch_halo_field3dReal(domain % dminfo, block % tend % tracers % array(:,:,:), &
+ block % tend % num_tracers, block % mesh % nVertLevels, block % mesh % nCells, &
block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
block => block % next
end do
@@ -157,24 +170,24 @@
block => domain % blocklist
do while (associated(block))
- block % intermediate_step(PROVIS) % u % array(:,:) = block % time_levs(1) % state % u % array(:,:) &
- + rk_substep_weights(rk_step) * block % intermediate_step(TEND) % u % array(:,:)
- block % intermediate_step(PROVIS) % h % array(:,:) = block % time_levs(1) % state % h % array(:,:) &
- + rk_substep_weights(rk_step) * block % intermediate_step(TEND) % h % array(:,:)
+ provis % u % array(:,:) = block % state % time_levs(1) % state % u % array(:,:) &
+ + rk_substep_weights(rk_step) * block % tend % u % array(:,:)
+ provis % h % array(:,:) = block % state % time_levs(1) % state % h % array(:,:) &
+ + rk_substep_weights(rk_step) * block % tend % h % array(:,:)
do iCell=1,block % mesh % nCells
do k=1,block % mesh % nVertLevels
- block % intermediate_step(PROVIS) % tracers % array(:,k,iCell) = ( &
- block % time_levs(1) % state % h % array(k,iCell) * &
- block % time_levs(1) % state % tracers % array(:,k,iCell) &
- + rk_substep_weights(rk_step) * block % intermediate_step(TEND) % tracers % array(:,k,iCell) &
- ) / block % intermediate_step(PROVIS) % h % array(k,iCell)
+ provis % tracers % array(:,k,iCell) = ( &
+ block % state % time_levs(1) % state % h % array(k,iCell) * &
+ block % state % time_levs(1) % state % tracers % array(:,k,iCell) &
+ + rk_substep_weights(rk_step) * block % tend % tracers % array(:,k,iCell) &
+ ) / provis % h % array(k,iCell)
end do
end do
if (config_test_case == 1) then ! For case 1, wind field should be fixed
- block % intermediate_step(PROVIS) % u % array(:,:) = block % time_levs(1) % state % u % array(:,:)
+ provis % u % array(:,:) = block % state % time_levs(1) % state % u % array(:,:)
end if
- call compute_solve_diagnostics(dt, block % intermediate_step(PROVIS), block % mesh)
+ call compute_solve_diagnostics(dt, provis, block % mesh)
block => block % next
end do
end if
@@ -185,16 +198,16 @@
block => domain % blocklist
do while (associated(block))
- block % time_levs(2) % state % u % array(:,:) = block % time_levs(2) % state % u % array(:,:) &
- + rk_weights(rk_step) * block % intermediate_step(TEND) % u % array(:,:)
- block % time_levs(2) % state % h % array(:,:) = block % time_levs(2) % state % h % array(:,:) &
- + rk_weights(rk_step) * block % intermediate_step(TEND) % h % array(:,:)
+ block % state % time_levs(2) % state % u % array(:,:) = block % state % time_levs(2) % state % u % array(:,:) &
+ + rk_weights(rk_step) * block % tend % u % array(:,:)
+ block % state % time_levs(2) % state % h % array(:,:) = block % state % time_levs(2) % state % h % array(:,:) &
+ + rk_weights(rk_step) * block % tend % h % array(:,:)
do iCell=1,block % mesh % nCells
do k=1,block % mesh % nVertLevels
- block % time_levs(2) % state % tracers % array(:,k,iCell) = &
- block % time_levs(2) % state % tracers % array(:,k,iCell) &
- + rk_weights(rk_step) * block % intermediate_step(TEND) % tracers % array(:,k,iCell)
+ block % state % time_levs(2) % state % tracers % array(:,k,iCell) = &
+ block % state % time_levs(2) % state % tracers % array(:,k,iCell) &
+ + rk_weights(rk_step) * block % tend % tracers % array(:,k,iCell)
end do
end do
@@ -213,23 +226,25 @@
do while (associated(block))
do iCell=1,block % mesh % nCells
do k=1,block % mesh % nVertLevels
- block % time_levs(2) % state % tracers % array(:,k,iCell) = &
- block % time_levs(2) % state % tracers % array(:,k,iCell) &
- / block % time_levs(2) % state % h % array(k,iCell)
+ block % state % time_levs(2) % state % tracers % array(:,k,iCell) = &
+ block % state % time_levs(2) % state % tracers % array(:,k,iCell) &
+ / block % state % time_levs(2) % state % h % array(k,iCell)
end do
end do
if (config_test_case == 1) then ! For case 1, wind field should be fixed
- block % time_levs(2) % state % u % array(:,:) = block % time_levs(1) % state % u % array(:,:)
+ block % state % time_levs(2) % state % u % array(:,:) = block % state % time_levs(1) % state % u % array(:,:)
end if
- call compute_solve_diagnostics(dt, block % time_levs(2) % state, block % mesh)
+ call compute_solve_diagnostics(dt, block % state % time_levs(2) % state, block % mesh)
- call reconstruct(block % time_levs(2) % state, block % mesh)
+ call reconstruct(block % state % time_levs(2) % state, block % diag, block % mesh)
block => block % next
end do
+ call deallocate_state(provis)
+
end subroutine rk4
@@ -245,15 +260,16 @@
implicit none
- type (grid_state), intent(inout) :: tend
- type (grid_state), intent(in) :: s
- type (grid_meta), intent(in) :: grid
+ type (tend_type), intent(inout) :: tend
+ type (state_type), intent(in) :: s
+ type (mesh_type), intent(in) :: grid
integer :: iEdge, iCell, iVertex, k, cell1, cell2, vertex1, vertex2, eoe, i, j
integer :: nCells, nEdges, nVertices, nVertLevels
+ real (kind=RKIND) :: h_mom_eddy_visc2, h_mom_eddy_visc4
real (kind=RKIND) :: flux, vorticity_abs, h_vertex, workpv, q, &
- upstream_bias, wTopEdge, rho0Inv
+ upstream_bias, wTopEdge, rho0Inv, r
real (kind=RKIND), dimension(:), pointer :: &
h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle, &
zMidZLevel, zTopZLevel
@@ -270,6 +286,11 @@
real (kind=RKIND) :: u_diffusion
real (kind=RKIND), dimension(:), allocatable:: fluxVertTop,w_dudzTopEdge, vertViscTop
+ real (kind=RKIND), allocatable, dimension(:,:) :: delsq_divergence
+ real (kind=RKIND), allocatable, dimension(:,:) :: delsq_u
+ real (kind=RKIND), allocatable, dimension(:,:) :: delsq_circulation, delsq_vorticity
+
+
real (kind=RKIND), dimension(:,:), pointer :: u_src
real (kind=RKIND), parameter :: rho_ref = 1000.0
@@ -319,6 +340,9 @@
u_src => grid % u_src % array
+ h_mom_eddy_visc2 = config_h_mom_eddy_visc2
+ h_mom_eddy_visc4 = config_h_mom_eddy_visc4
+
!
! height tendency: horizontal advection term -</font>
<font color="gray">abla\cdot ( hu)
!
@@ -370,12 +394,16 @@
endif ! coordinate type
!
+ ! velocity tendency: start accumulating tendency terms
+ !
+ tend_u(:,:) = 0.0
+
+ !
! velocity tendency: vertical advection term -w du/dz
!
allocate(w_dudzTopEdge(nVertLevels+1))
w_dudzTopEdge(1) = 0.0
w_dudzTopEdge(nVertLevels+1) = 0.0
- tend_u(:,:) = 0.0
if (config_vert_grid_type.eq.'zlevel') then
do iEdge=1,grid % nEdgesSolve
cell1 = cellsOnEdge(1,iEdge)
@@ -424,23 +452,138 @@
endif
!
- ! velocity tendency: -q(h u^\perp) - </font>
<font color="red">abla K
- ! +</font>
<font color="black">u_h(</font>
<font color="black">abla \delta + {\bf k}\times </font>
<font color="blue">abla \xi)
+ ! velocity tendency: del2 dissipation, </font>
<font color="black">u_2 </font>
<font color="blue">abla^2 u
+ ! computed as </font>
<font color="black">u( </font>
<font color="black">abla divergence + k \times </font>
<font color="red">abla vorticity )
+ ! strictly only valid for h_mom_eddy_visc2 == constant
!
- ! Compute diffusion, computed as </font>
<font color="black">abla divergence - k \times </font>
<font color="red">abla vorticity
- ! only valid for visc == constant
- do iEdge=1,grid % nEdgesSolve
+ if ( h_mom_eddy_visc2 > 0.0 ) then
+ do iEdge=1,grid % nEdgesSolve
+ cell1 = cellsOnEdge(1,iEdge)
+ cell2 = cellsOnEdge(2,iEdge)
+ vertex1 = verticesOnEdge(1,iEdge)
+ vertex2 = verticesOnEdge(2,iEdge)
+
+ do k=1,nVertLevels
+
+ ! Here -( vorticity(k,vertex2) - vorticity(k,vertex1) ) / dvEdge(iEdge)
+ ! is - </font>
<font color="blue">abla vorticity pointing from vertex 2 to vertex 1, or equivalently
+ ! + k \times </font>
<font color="blue">abla vorticity pointing from cell1 to cell2.
+
+ u_diffusion = ( divergence(k,cell2) - divergence(k,cell1) ) / dcEdge(iEdge) &
+ -( vorticity(k,vertex2) - vorticity(k,vertex1) ) / dvEdge(iEdge)
+ u_diffusion = h_mom_eddy_visc2 * u_diffusion
+
+ tend_u(k,iEdge) = tend_u(k,iEdge) + u_diffusion
+
+ end do
+ end do
+ end if
+
+ !
+ ! velocity tendency: del4 dissipation, -</font>
<font color="black">u_4 </font>
<font color="blue">abla^4 u
+ ! computed as </font>
<font color="black">abla^2 u = </font>
<font color="black">abla divergence + k \times </font>
<font color="blue">abla vorticity
+ ! applied recursively.
+ ! strictly only valid for h_mom_eddy_visc4 == constant
+ !
+ if ( h_mom_eddy_visc4 > 0.0 ) then
+
+ allocate(delsq_divergence(nVertLevels, nCells+1))
+ allocate(delsq_u(nVertLevels, nEdges+1))
+ allocate(delsq_circulation(nVertLevels, nVertices+1))
+ allocate(delsq_vorticity(nVertLevels, nVertices+1))
+
+ delsq_u(:,:) = 0.0
+
+ ! Compute </font>
<font color="black">abla^2 u = </font>
<font color="black">abla divergence + k \times </font>
<font color="blue">abla vorticity
+ do iEdge=1,grid % nEdges
+ cell1 = cellsOnEdge(1,iEdge)
+ cell2 = cellsOnEdge(2,iEdge)
+ vertex1 = verticesOnEdge(1,iEdge)
+ vertex2 = verticesOnEdge(2,iEdge)
+
+ do k=1,nVertLevels
+
+ u_diffusion = ( divergence(k,cell2) - divergence(k,cell1) ) / dcEdge(iEdge) &
+ -( vorticity(k,vertex2) - vorticity(k,vertex1)) / dvEdge(iEdge)
+
+ delsq_u(k,iEdge) = delsq_u(k,iEdge) + u_diffusion
+
+ end do
+ end do
+
+ ! vorticity using </font>
<font color="blue">abla^2 u
+ delsq_circulation(:,:) = 0.0
+ do iEdge=1,nEdges
+ vertex1 = verticesOnEdge(1,iEdge)
+ vertex2 = verticesOnEdge(2,iEdge)
+ do k=1,nVertLevels
+ delsq_circulation(k,vertex1) = delsq_circulation(k,vertex1) &
+ - dcEdge(iEdge) * delsq_u(k,iEdge)
+ delsq_circulation(k,vertex2) = delsq_circulation(k,vertex2) &
+ + dcEdge(iEdge) * delsq_u(k,iEdge)
+ end do
+ end do
+ do iVertex=1,nVertices
+ r = 1.0 / areaTriangle(iVertex)
+ do k=1,nVertLevels
+ delsq_vorticity(k,iVertex) = delsq_circulation(k,iVertex) * r
+ end do
+ end do
+
+ ! Divergence using </font>
<font color="blue">abla^2 u
+ delsq_divergence(:,:) = 0.0
+ do iEdge=1,nEdges
+ cell1 = cellsOnEdge(1,iEdge)
+ cell2 = cellsOnEdge(2,iEdge)
+ do k=1,nVertLevels
+ delsq_divergence(k,cell1) = delsq_divergence(k,cell1) &
+ + delsq_u(k,iEdge)*dvEdge(iEdge)
+ delsq_divergence(k,cell2) = delsq_divergence(k,cell2) &
+ - delsq_u(k,iEdge)*dvEdge(iEdge)
+ end do
+ end do
+ do iCell = 1,nCells
+ r = 1.0 / areaCell(iCell)
+ do k = 1,nVertLevels
+ delsq_divergence(k,iCell) = delsq_divergence(k,iCell) * r
+ end do
+ end do
+
+ ! Compute - \kappa </font>
<font color="blue">abla^4 u
+ ! as </font>
<font color="black">abla div(</font>
<font color="black">abla^2 u) + k \times </font>
<font color="black">abla ( k \cross curl(</font>
<font color="gray">abla^2 u) )
+ do iEdge=1,grid % nEdgesSolve
+ cell1 = cellsOnEdge(1,iEdge)
+ cell2 = cellsOnEdge(2,iEdge)
+ vertex1 = verticesOnEdge(1,iEdge)
+ vertex2 = verticesOnEdge(2,iEdge)
+
+ do k=1,nVertLevels
+
+ u_diffusion = ( delsq_divergence(k,cell2) &
+ - delsq_divergence(k,cell1) ) / dcEdge(iEdge) &
+ -( delsq_vorticity(k,vertex2) &
+ - delsq_vorticity(k,vertex1) ) / dvEdge(iEdge)
+
+ tend_u(k,iEdge) = tend_u(k,iEdge) - h_mom_eddy_visc4 * u_diffusion
+ end do
+ end do
+
+ deallocate(delsq_divergence)
+ deallocate(delsq_u)
+ deallocate(delsq_circulation)
+ deallocate(delsq_vorticity)
+
+ end if
+
+ !
+ ! velocity tendency: nonlinear Coriolis term and grad of kinetic energy
+ !
+ do iEdge=1,grid % nEdgesSolve
cell1 = cellsOnEdge(1,iEdge)
cell2 = cellsOnEdge(2,iEdge)
- vertex1 = verticesOnEdge(1,iEdge)
- vertex2 = verticesOnEdge(2,iEdge)
do k=1,nVertLevels
- u_diffusion = ( divergence(k,cell2) - divergence(k,cell1) ) / dcEdge(iEdge) &
- -(vorticity(k,vertex2) - vorticity(k,vertex1) ) / dvEdge(iEdge)
- u_diffusion = config_visc * u_diffusion
-
q = 0.0
do j = 1,nEdgesOnEdge(iEdge)
eoe = edgesOnEdge(j,iEdge)
@@ -449,7 +592,6 @@
end do
tend_u(k,iEdge) = tend_u(k,iEdge) &
+ q &
- + u_diffusion &
- ( ke(k,cell2) - ke(k,cell1) ) / dcEdge(iEdge)
end do
@@ -471,13 +613,6 @@
- 1.0e-3*u(nVertLevels,iEdge) &
*sqrt(2.0*ke_edge(nVertLevels,iEdge))
- ! mrp 100603 The following method is more straight forward,
- ! that the above method of computing ke_edge, but I have
- ! not verified that v is working correctly yet.
- !tend_u(nVertLevels,iEdge) = tend_u(nVertLevels,iEdge) &
- ! - 1.0e-3*u(nVertLevels,iEdge) &
- ! *sqrt(u(nVertLevels,iEdge)**2 + v(nVertLevels,iEdge)**2)
-
! old bottom drag, just linear friction
! du/dt = u/tau where tau=100 days.
!tend_u(nVertLevels,iEdge) = tend_u(nVertLevels,iEdge) &
@@ -540,12 +675,13 @@
implicit none
- type (grid_state), intent(inout) :: tend
- type (grid_state), intent(in) :: s
- type (grid_meta), intent(in) :: grid
+ type (tend_type), intent(inout) :: tend
+ type (state_type), intent(in) :: s
+ type (mesh_type), intent(in) :: grid
integer :: iCell, iEdge, k, iTracer, cell1, cell2, upwindCell,&
nEdges, nCells, nVertLevels
+ real (kind=RKIND) :: h_tracer_eddy_diff2, h_tracer_eddy_diff4, invAreaCell1, invAreaCell2, tracer_turb_flux
real (kind=RKIND) :: flux, tracer_edge, r
real (kind=RKIND) :: dist
real (kind=RKIND), dimension(:), pointer :: &
@@ -554,14 +690,15 @@
u,h,wTop, h_edge, zMid, zTop
real (kind=RKIND), dimension(:,:,:), pointer :: &
tracers, tend_tr
+ integer, dimension(:,:), pointer :: boundaryEdge
type (dm_info) :: dminfo
integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge
integer, dimension(:,:), pointer :: cellsOnEdge
real (kind=RKIND), dimension(:), pointer :: &
zTopZLevel
- real (kind=RKIND), dimension(:,:), allocatable:: fluxVertTop, tracerTop
- real (kind=RKIND), dimension(:,:,:), allocatable::tr_flux, tr_div
+ real (kind=RKIND), dimension(:,:), allocatable:: fluxVertTop, tracerTop, boundaryMask
+ real (kind=RKIND), dimension(:,:,:), allocatable::tr_flux, tr_div, delsq_tracer
real (kind=RKIND), dimension(:), allocatable:: vertDiffTop
@@ -580,11 +717,16 @@
dvEdge => grid % dvEdge % array
dcEdge => grid % dcEdge % array
zTopZLevel => grid % zTopZLevel % array
+ boundaryEdge => grid % boundaryEdge % array
nEdges = grid % nEdges
nCells = grid % nCells
nVertLevels = grid % nVertLevels
+
+ h_tracer_eddy_diff2 = config_h_tracer_eddy_diff2
+ h_tracer_eddy_diff4 = config_h_tracer_eddy_diff4
+
!
! tracer tendency: horizontal advection term -div( h \phi u)
!
@@ -596,7 +738,7 @@
cell2 = cellsOnEdge(2,iEdge)
if (cell1 <= nCells .and. cell2 <= nCells) then
do k=1,nVertLevels
- do iTracer=1,num_tracers
+ do iTracer=1,s % num_tracers
tracer_edge = 0.5 * ( tracers(iTracer,k,cell1) &
+ tracers(iTracer,k,cell2))
flux = u(k,iEdge) * dvEdge(iEdge) * h_edge(k,iEdge) &
@@ -620,7 +762,7 @@
else
upwindCell = cell2
endif
- do iTracer=1,num_tracers
+ do iTracer=1,s % num_tracers
flux = u(k,iEdge) * dvEdge(iEdge) * h_edge(k,iEdge) &
* tracers(iTracer,k,upwindCell)
tend_tr(iTracer,k,cell1) = tend_tr(iTracer,k,cell1) - flux
@@ -633,7 +775,7 @@
endif
do iCell=1,grid % nCellsSolve
do k=1,grid % nVertLevelsSolve
- do iTracer=1,num_tracers
+ do iTracer=1,s % num_tracers
tend_tr(iTracer,k,iCell) = tend_tr(iTracer,k,iCell) / areaCell(iCell)
end do
end do
@@ -642,14 +784,14 @@
!
! tracer tendency: vertical advection term -d/dz( h \phi w)
!
- allocate(tracerTop(num_tracers,nVertLevels+1))
+ allocate(tracerTop(s % num_tracers,nVertLevels+1))
tracerTop(:,1)=0.0
tracerTop(:,nVertLevels+1)=0.0
do iCell=1,grid % nCellsSolve
if (config_vert_tracer_adv.eq.'centered') then
do k=2,nVertLevels
- do iTracer=1,num_tracers
+ do iTracer=1,s % num_tracers
tracerTop(iTracer,k) = ( tracers(iTracer,k-1,iCell) &
+tracers(iTracer,k ,iCell))/2.0
end do
@@ -662,7 +804,7 @@
else
upwindCell = k-1
endif
- do iTracer=1,num_tracers
+ do iTracer=1,s % num_tracers
tracerTop(iTracer,k) = tracers(iTracer,upwindCell,iCell)
end do
end do
@@ -670,7 +812,7 @@
endif
do k=1,nVertLevels
- do iTracer=1,num_tracers
+ do iTracer=1,s % num_tracers
tend_tr(iTracer,k,iCell) = tend_tr(iTracer,k,iCell) &
- ( wTop(k ,iCell)*tracerTop(iTracer,k ) &
- wTop(k+1,iCell)*tracerTop(iTracer,k+1))
@@ -681,61 +823,118 @@
deallocate(tracerTop)
!
- ! tracer tendency: horizontal tracer diffusion
- ! div(h \kappa_h </font>
<font color="blue">abla\phi )
+ ! tracer tendency: del2 horizontal tracer diffusion, div(h \kappa_2 </font>
<font color="red">abla \phi)
!
- ! first compute \kappa_h </font>
<font color="red">abla\phi at horizontal edges.
- allocate(tr_flux(num_tracers,nVertLevels,nEdges))
- tr_flux(:,:,:) = 0.0
- do iEdge=1,nEdges
- cell1 = cellsOnEdge(1,iEdge)
- cell2 = cellsOnEdge(2,iEdge)
- if (cell1 <= nCells .and. cell2 <= nCells) then
- do k=1,nVertLevels
- do iTracer=1,num_tracers
- tr_flux(iTracer,k,iEdge) = h_edge(k,iEdge)*config_hor_diffusion * &
- (Tracers(iTracer,k,cell2) - Tracers(iTracer,k,cell1))/dcEdge(iEdge)
+ if ( h_tracer_eddy_diff2 > 0.0 ) then
+
+ !
+ ! compute a boundary mask to enforce insulating boundary conditions in the horizontal
+ !
+ allocate(boundaryMask(nVertLevels, nEdges+1))
+ boundaryMask = 1.0
+ where(boundaryEdge.eq.1) boundaryMask=0.0
+
+ do iEdge=1,grid % nEdges
+ cell1 = grid % cellsOnEdge % array(1,iEdge)
+ cell2 = grid % cellsOnEdge % array(2,iEdge)
+ invAreaCell1 = 1.0/areaCell(cell1)
+ invAreaCell2 = 1.0/areaCell(cell2)
+
+ do k=1,grid % nVertLevels
+ do iTracer=1,s % num_tracers
+ ! \kappa_2 </font>
<font color="blue">abla \phi on edge
+ tracer_turb_flux = h_tracer_eddy_diff2 &
+ *( tracers(iTracer,k,cell2) &
+ - tracers(iTracer,k,cell1))/dcEdge(iEdge)
+
+ ! div(h \kappa_2 </font>
<font color="blue">abla \phi) at cell center
+ flux = dvEdge (iEdge) * h_edge(k,iEdge) &
+ * tracer_turb_flux * boundaryMask(k, iEdge)
+ tend_tr(iTracer,k,cell1) = tend_tr(iTracer,k,cell1) + flux * invAreaCell1
+ tend_tr(iTracer,k,cell2) = tend_tr(iTracer,k,cell2) - flux * invAreaCell2
+ end do
+ end do
+
+ end do
+
+ deallocate(boundaryMask)
+
+ end if
+
+ !
+ ! tracer tendency: del4 horizontal tracer diffusion, &
+ ! div(h \kappa_4 </font>
<font color="black">abla [div(h </font>
<font color="blue">abla \phi)])
+ !
+ if ( h_tracer_eddy_diff4 > 0.0 ) then
+
+ !
+ ! compute a boundary mask to enforce insulating boundary conditions in the horizontal
+ !
+ allocate(boundaryMask(nVertLevels, nEdges+1))
+ boundaryMask = 1.0
+ where(boundaryEdge.eq.1) boundaryMask=0.0
+
+ allocate(delsq_tracer(s % num_tracers,nVertLevels, nCells+1))
+
+ delsq_tracer(:,:,:) = 0.
+
+ ! first del2: div(h </font>
<font color="blue">abla \phi) at cell center
+ do iEdge=1,grid % nEdges
+ cell1 = grid % cellsOnEdge % array(1,iEdge)
+ cell2 = grid % cellsOnEdge % array(2,iEdge)
+
+ do k=1,grid % nVertLevels
+ do iTracer=1,s % num_tracers
+ delsq_tracer(iTracer,k,cell1) = delsq_tracer(iTracer,k,cell1) &
+ + dvEdge(iEdge)*h_edge(k,iEdge) &
+ *(tracers(iTracer,k,cell2) - tracers(iTracer,k,cell1)) &
+ /dcEdge(iEdge) * boundaryMask(k,iEdge)
+ delsq_tracer(iTracer,k,cell2) = delsq_tracer(iTracer,k,cell2) &
+ - dvEdge(iEdge)*h_edge(k,iEdge) &
+ *(tracers(iTracer,k,cell2) - tracers(iTracer,k,cell1)) &
+ /dcEdge(iEdge) * boundaryMask(k,iEdge)
+ end do
+ end do
+
+ end do
+
+ do iCell = 1, nCells
+ r = 1.0 / areaCell(iCell)
+ do k=1,nVertLevels
+ do iTracer=1,s % num_tracers
+ delsq_tracer(iTracer,k,iCell) = delsq_tracer(iTracer,k,iCell) * r
+ end do
+ end do
+ end do
+
+ ! second del2: div(h </font>
<font color="red">abla [delsq_tracer]) at cell center
+ do iEdge=1,grid % nEdges
+ cell1 = grid % cellsOnEdge % array(1,iEdge)
+ cell2 = grid % cellsOnEdge % array(2,iEdge)
+ invAreaCell1 = 1.0 / areaCell(cell1)
+ invAreaCell2 = 1.0 / areaCell(cell2)
+
+ do k=1,grid % nVertLevels
+ do iTracer=1,s % num_tracers
+ tracer_turb_flux = h_tracer_eddy_diff4 &
+ *( delsq_tracer(iTracer,k,cell2) &
+ - delsq_tracer(iTracer,k,cell1))/dcEdge(iEdge)
+ flux = dvEdge (iEdge) * tracer_turb_flux
+
+ tend_tr(iTracer,k,cell1) = tend_tr(iTracer,k,cell1) &
+ - flux * invAreaCell1 * boundaryMask(k,iEdge)
+ tend_tr(iTracer,k,cell2) = tend_tr(iTracer,k,cell2) &
+ + flux * invAreaCell2 * boundaryMask(k,iEdge)
+
+ end do
enddo
- enddo
- endif
- enddo
- ! Compute the divergence, div(h \kappa_h </font>
<font color="red">abla\phi) at cell centers
- allocate(tr_div(num_tracers,nVertLevels,nCells))
- tr_div(:,:,:) = 0.0
- do iEdge=1,nEdges
- cell1 = cellsOnEdge(1,iEdge)
- cell2 = cellsOnEdge(2,iEdge)
- if (cell1 <= nCells) then
- do k=1,nVertLevels
- do iTracer=1,num_tracers
- tr_div(iTracer,k,cell1) = tr_div(iTracer,k,cell1) &
- + tr_flux(iTracer,k,iEdge)*dvEdge(iEdge)
- enddo
- enddo
- endif
- if (cell2 <= nCells) then
- do k=1,nVertLevels
- do iTracer=1,num_tracers
- tr_div(iTracer,k,cell2) = tr_div(iTracer,k,cell2) &
- - tr_flux(iTracer,k,iEdge)*dvEdge(iEdge)
- enddo
- enddo
- end if
- end do
+ end do
- ! add div(h \kappa_h </font>
<font color="gray">abla\phi ) to tracer tendency
- do iCell = 1,nCells
- r = 1.0 / areaCell(iCell)
- do k = 1,nVertLevels
- do iTracer=1,num_tracers
- tend_tr(iTracer,k,iCell) = tend_tr(iTracer,k,iCell) &
- + tr_div(iTracer,k,iCell)*r
- enddo
- enddo
- enddo
- deallocate(tr_flux, tr_div)
+ deallocate(delsq_tracer)
+ end if
+
!
! tracer tendency: vertical diffusion h d/dz( \kappa_v d\phi/dz)
!
@@ -760,12 +959,12 @@
call dmpar_abort(dminfo)
endif
- allocate(fluxVertTop(num_tracers,nVertLevels+1))
+ allocate(fluxVertTop(s % num_tracers,nVertLevels+1))
fluxVertTop(:,1) = 0.0
fluxVertTop(:,nVertLevels+1) = 0.0
do iCell=1,grid % nCellsSolve
do k=2,nVertLevels
- do iTracer=1,num_tracers
+ do iTracer=1,s % num_tracers
! compute \kappa_v d\phi/dz
fluxVertTop(iTracer,k) = vertDiffTop(k) &
* (tracers(iTracer,k-1,iCell) - tracers(iTracer,k,iCell) )&
@@ -775,7 +974,7 @@
do k=1,nVertLevels
dist = zTop(k,iCell) - zTop(k+1,iCell)
- do iTracer=1,num_tracers
+ do iTracer=1,s % num_tracers
tend_tr(iTracer,k,iCell) = tend_tr(iTracer,k,iCell) &
+ h(k,iCell)*(fluxVertTop(iTracer,k) - fluxVertTop(iTracer,k+1))/dist
enddo
@@ -788,7 +987,7 @@
! print some diagnostics - for debugging
! print *, 'after vertical mixing',&
! 'iTracer,k, minval(tend_tr(itracer,k,:)), maxval(tend_tr(itracer,k,:))'
-! do iTracer=1,num_tracers
+! do iTracer=1,s % num_tracers
! do k = 1,nVertLevels
! print '(2i5,20es12.4)', iTracer,k, &
! minval(tend_tr(itracer,k,:)), maxval(tend_tr(itracer,k,:))
@@ -811,8 +1010,8 @@
implicit none
real (kind=RKIND), intent(in) :: dt
- type (grid_state), intent(inout) :: s
- type (grid_meta), intent(in) :: grid
+ type (state_type), intent(inout) :: s
+ type (mesh_type), intent(in) :: grid
integer :: iEdge, iCell, iVertex, k, cell1, cell2, vertex1, vertex2, eoe, i, j, cov
@@ -1128,8 +1327,8 @@
do k=1,nVertLevels
! Linear equation of state, for the time being
rho(k,iCell) = 1000.0*( 1.0 &
- - 2.5e-4*tracers(index_temperature,k,iCell) &
- + 7.6e-4*tracers(index_salinity,k,iCell))
+ - 2.5e-4*tracers(s % index_temperature,k,iCell) &
+ + 7.6e-4*tracers(s % index_salinity,k,iCell))
end do
end do
endif
@@ -1194,8 +1393,9 @@
pZLevel(1,iCell) = rho(1,iCell)*gravity &
* (h(1,iCell)-0.5*hZLevel(1))
do k=2,nVertLevels
- delta_p = rho(k,iCell)*gravity*hZLevel(k)
- pZLevel(k,iCell) = pZLevel(k-1,iCell) + 0.5*delta_p
+ pZLevel(k,iCell) = pZLevel(k-1,iCell) &
+ + 0.5*gravity*( rho(k-1,iCell)*hZLevel(k-1) &
+ + rho(k ,iCell)*hZLevel(k ))
end do
end do
@@ -1263,8 +1463,8 @@
implicit none
- type (grid_state), intent(inout) :: tend
- type (grid_meta), intent(in) :: grid
+ type (tend_type), intent(inout) :: tend
+ type (mesh_type), intent(in) :: grid
integer, dimension(:,:), pointer :: boundaryEdge
real (kind=RKIND), dimension(:,:), pointer :: tend_u
Modified: branches/atmos_physics/src/core_ocean/mpas_interface.F
===================================================================
--- branches/atmos_physics/src/core_ocean/mpas_interface.F 2010-10-13 18:01:28 UTC (rev 548)
+++ branches/atmos_physics/src/core_ocean/mpas_interface.F 2010-10-13 20:25:17 UTC (rev 549)
@@ -22,21 +22,21 @@
implicit none
type (block_type), intent(inout) :: block
- type (grid_meta), intent(inout) :: mesh
+ type (mesh_type), intent(inout) :: mesh
real (kind=RKIND), intent(in) :: dt
- call compute_solve_diagnostics(dt, block % time_levs(1) % state, mesh)
+ call compute_solve_diagnostics(dt, block % state % time_levs(1) % state, mesh)
call rbfInterp_initialize(mesh)
call init_reconstruct(mesh)
- call reconstruct(block % time_levs(1) % state, mesh)
+ call reconstruct(block % state % time_levs(1) % state, block % diag, mesh)
! mrp 100316 In order for this to work, we need to pass domain % dminfo as an
! input arguement into mpas_init. Ask about that later. For now, there will be
! no initial statistics write.
! call timer_start("global diagnostics")
-! call computeGlobalDiagnostics(domain % dminfo, block % time_levs(1) % state, mesh, 0, dt)
+! call computeGlobalDiagnostics(domain % dminfo, block % state % time_levs(1) % state, mesh, 0, dt)
! call timer_stop("global diagnostics")
! call output_state_init(output_obj, domain, "OUTPUT")
! call write_output_frame(output_obj, domain)
@@ -83,7 +83,7 @@
call timer_start("global diagnostics")
call computeGlobalDiagnostics(domain % dminfo, &
- block_ptr % time_levs(2) % state, block_ptr % mesh, &
+ block_ptr % state % time_levs(2) % state, block_ptr % mesh, &
itimestep, dt)
call timer_stop("global diagnostics")
end if
Modified: branches/atmos_physics/src/core_physics/module_driver_convection_deep.F
===================================================================
--- branches/atmos_physics/src/core_physics/module_driver_convection_deep.F 2010-10-13 18:01:28 UTC (rev 548)
+++ branches/atmos_physics/src/core_physics/module_driver_convection_deep.F 2010-10-13 20:25:17 UTC (rev 549)
@@ -129,9 +129,11 @@
end subroutine convection_deep_deallocate
!=============================================================================================
- subroutine convection_deep_init
+ subroutine convection_deep_init(s)
!=============================================================================================
+ type (state_type), intent(in) :: s
+
!local variables and arrays:
!---------------------------
logical:: allowed_to_read
@@ -146,9 +148,9 @@
write(0,*) '--- begin kain-fritsch initialization:'
allowed_to_read = .false.
- p_first_scalar = moist_start + 1
- p_qi = index_qi
- p_qs = index_qs
+ p_first_scalar = s % moist_start + 1
+ p_qi = s % index_qi
+ p_qs = s % index_qs
f_qv = .false.
f_qc = .false.
@@ -181,8 +183,8 @@
!input and output arguments:
!---------------------------
integer,intent(in):: itimestep
- type(grid_meta),intent(in):: mesh
- type(grid_state),intent(inout):: state
+ type(mesh_type),intent(in):: mesh
+ type(state_type),intent(inout):: state
!local variables and arrays:
!---------------------------
@@ -297,7 +299,7 @@
subroutine convection_from_MPAS(state)
!=============================================================================================
!input arguments:
- type(grid_state),intent(in):: state
+ type(state_type),intent(in):: state
!---------------------------------------------------------------------------------------------
@@ -351,7 +353,7 @@
subroutine convection_to_MPAS(state)
!=============================================================================================
!inout arguments:
- type(grid_state),intent(inout):: state
+ type(state_type),intent(inout):: state
!---------------------------------------------------------------------------------------------
Modified: branches/atmos_physics/src/core_physics/module_driver_microphysics.F
===================================================================
--- branches/atmos_physics/src/core_physics/module_driver_microphysics.F 2010-10-13 18:01:28 UTC (rev 548)
+++ branches/atmos_physics/src/core_physics/module_driver_microphysics.F 2010-10-13 20:25:17 UTC (rev 549)
@@ -121,12 +121,12 @@
!input arguments:
!----------------
- type(grid_meta),intent(in):: grid
+ type(mesh_type),intent(in):: grid
integer,intent(in):: itimestep
!inout arguments:
!----------------
- type(grid_state),intent(inout):: state
+ type(state_type),intent(inout):: state
!local variables and arrays:
!---------------------------
@@ -242,10 +242,10 @@
!=============================================================================================
!input variables:
- type(grid_meta) ,intent(in):: grid
+ type(mesh_type) ,intent(in):: grid
!output variables:
- type(grid_state),intent(out):: state
+ type(state_type),intent(out):: state
!local variables:
integer:: i,icell,j
@@ -297,7 +297,7 @@
!=============================================================================================
!output variables:
- type(grid_state),intent(inout):: state
+ type(state_type),intent(inout):: state
!local variables:
integer:: i,j
Modified: branches/atmos_physics/src/core_physics/module_pbl.F
===================================================================
--- branches/atmos_physics/src/core_physics/module_pbl.F 2010-10-13 18:01:28 UTC (rev 548)
+++ branches/atmos_physics/src/core_physics/module_pbl.F 2010-10-13 20:25:17 UTC (rev 549)
@@ -51,8 +51,8 @@
!input and output arguments:
!---------------------------
integer,intent(in):: itimestep
- type(grid_meta),intent(in):: grid
- type(grid_state),intent(out):: vars
+ type(mesh_type),intent(in):: grid
+ type(state_type),intent(out):: vars
!---------------------------------------------------------------------------------------------
write(0,*) '--- enter pbl driver:'
Modified: branches/atmos_physics/src/core_physics/module_physics_control.F
===================================================================
--- branches/atmos_physics/src/core_physics/module_physics_control.F 2010-10-13 18:01:28 UTC (rev 548)
+++ branches/atmos_physics/src/core_physics/module_physics_control.F 2010-10-13 20:25:17 UTC (rev 549)
@@ -138,8 +138,8 @@
!input and output arguments:
!---------------------------
logical,intent(in):: config_do_restart
- type(grid_meta),intent(in):: grid
- type(grid_state),intent(inout):: s
+ type(mesh_type),intent(in):: grid
+ type(state_type),intent(inout):: s
!local variables:
integer:: k,icell
Modified: branches/atmos_physics/src/core_physics/module_physics_driver.F
===================================================================
--- branches/atmos_physics/src/core_physics/module_physics_driver.F 2010-10-13 18:01:28 UTC (rev 548)
+++ branches/atmos_physics/src/core_physics/module_physics_driver.F 2010-10-13 20:25:17 UTC (rev 549)
@@ -49,29 +49,29 @@
do while(associated(block))
!compute relative humidity:
- !call compute_relhum(block%mesh,block%time_levs(1)%state)
+ !call compute_relhum(block%mesh,block%state%time_levs(1)%state)
!physics prep step:
#ifdef non_hydrostatic_core
- call MPAS_to_physics(block%mesh,block%time_levs(1)%state)
+ call MPAS_to_physics(block%mesh,block%state%time_levs(1)%state,block%diag)
#elif hydrostatic_core
- call MPAS_to_physics(block%time_levs(1)%state)
+ call MPAS_to_physics(block%state%time_levs(1)%state,block%diag)
#endif
!call to convection:
if(config_conv_deep_scheme .ne. 'off') &
- call convection_deep_driver(itimestep,block%mesh,block%time_levs(1)%state)
+ call convection_deep_driver(itimestep,block%mesh,block%state%time_levs(1)%state)
!call to pbl schemes:
! if(config_pbl_scheme .ne. 'off') &
-! call pbl_driver(itimestep,block%mesh,block%time_levs(1)%state)
+! call pbl_driver(itimestep,block%mesh,block%state%time_levs(1)%state)
!add all physics tendencies:
!call physics_add_tendencies
!move physics time_levs(1) to time_levs(2):
#ifdef non_hydrostatic_core
- call nhyd_copy_state_physics(block%time_levs(1)%state,block%time_levs(2)%state)
+ call nhyd_copy_state_physics(block%state%time_levs(1)%state,block%state%time_levs(2)%state)
#endif
block => block % next
Modified: branches/atmos_physics/src/core_physics/module_physics_init.F
===================================================================
--- branches/atmos_physics/src/core_physics/module_physics_init.F 2010-10-13 18:01:28 UTC (rev 548)
+++ branches/atmos_physics/src/core_physics/module_physics_init.F 2010-10-13 20:25:17 UTC (rev 549)
@@ -22,14 +22,14 @@
!input and output arguments:
!---------------------------
- type(grid_meta),intent(in):: mesh
- type(grid_state),intent(inout):: s
+ type(mesh_type),intent(in):: mesh
+ type(state_type),intent(inout):: s
!=============================================================================================
!initialization of parameterized deep convective processes:
if(config_conv_deep_scheme .ne. 'off') then
- call convection_deep_init
+ call convection_deep_init(s)
endif
!initialization of cloud microphysics processes:
Modified: branches/atmos_physics/src/core_physics/module_physics_interface_hyd.F
===================================================================
--- branches/atmos_physics/src/core_physics/module_physics_interface_hyd.F 2010-10-13 18:01:28 UTC (rev 548)
+++ branches/atmos_physics/src/core_physics/module_physics_interface_hyd.F 2010-10-13 20:25:17 UTC (rev 549)
@@ -20,11 +20,12 @@
contains
!=============================================================================================
- subroutine MPAS_to_physics(state)
+ subroutine MPAS_to_physics(state,diag)
!=============================================================================================
!input variables:
- type(grid_state),intent(in):: state
+ type(state_type),intent(in):: state
+ type(diag_type),intent(in):: diag
!local variables:
real(kind=RKIND):: tm
@@ -33,13 +34,13 @@
!initialization:
w => state % w % array
- u => state % uReconstructZonal % array
- v => state % uReconstructMeridional % array
+ u => diag % uReconstructZonal % array
+ v => diag % uReconstructMeridional % array
geopotential => state % geopotential % array
pressure => state % pressure % array
theta => state % theta % array
- qv => state % scalars % array(index_qv,:,:)
+ qv => state % scalars % array(state%index_qv,:,:)
do j = jts, jte
do k = kts, kte
@@ -76,7 +77,7 @@
!=============================================================================================
!input variables:
- type(grid_state),intent(in):: state
+ type(state_type),intent(in):: state
!---------------------------------------------------------------------------------------------
@@ -99,12 +100,12 @@
pi_p(i,k,j) = (pres_p(i,k,j)/p0)**(R_d/cp)
t_p(i,k,j) = th_p(i,k,j)*pi_p(i,k,j)
-! qv_p(i,k,j) = max(0.,state % scalars % array(index_qv,k,i))
-! qc_p(i,k,j) = max(0.,state % scalars % array(index_qc,k,i))
-! qr_p(i,k,j) = max(0.,state % scalars % array(index_qr,k,i))
- qv_p(i,k,j) = state % scalars % array(index_qv,k,i)
- qc_p(i,k,j) = state % scalars % array(index_qc,k,i)
- qr_p(i,k,j) = state % scalars % array(index_qr,k,i)
+! qv_p(i,k,j) = max(0.,state % scalars % array(state%index_qv,k,i))
+! qc_p(i,k,j) = max(0.,state % scalars % array(state%index_qc,k,i))
+! qr_p(i,k,j) = max(0.,state % scalars % array(state%index_qr,k,i))
+ qv_p(i,k,j) = state % scalars % array(state%index_qv,k,i)
+ qc_p(i,k,j) = state % scalars % array(state%index_qc,k,i)
+ qr_p(i,k,j) = state % scalars % array(state%index_qr,k,i)
enddo
enddo
enddo
@@ -118,18 +119,18 @@
do k = kts, kte
do i = its, ite
!mass mixing ratios:
-! qi_p(i,k,j) = max(0.,state % scalars % array(index_qi,k,i))
-! qs_p(i,k,j) = max(0.,state % scalars % array(index_qs,k,i))
-! qg_p(i,k,j) = max(0.,state % scalars % array(index_qg,k,i))
- qi_p(i,k,j) = state % scalars % array(index_qi,k,i)
- qs_p(i,k,j) = state % scalars % array(index_qs,k,i)
- qg_p(i,k,j) = state % scalars % array(index_qg,k,i)
+! qi_p(i,k,j) = max(0.,state % scalars % array(state%index_qi,k,i))
+! qs_p(i,k,j) = max(0.,state % scalars % array(state%index_qs,k,i))
+! qg_p(i,k,j) = max(0.,state % scalars % array(state%index_qg,k,i))
+ qi_p(i,k,j) = state % scalars % array(state%index_qi,k,i)
+ qs_p(i,k,j) = state % scalars % array(state%index_qs,k,i)
+ qg_p(i,k,j) = state % scalars % array(state%index_qg,k,i)
!number concentrations:
-! qnr_p(i,k,j) = max(0., state % scalars % array(index_qnr,k,i))
-! qni_p(i,k,j) = max(0., state % scalars % array(index_qni,k,i))
- qnr_p(i,k,j) = state % scalars % array(index_qnr,k,i)
- qni_p(i,k,j) = state % scalars % array(index_qni,k,i)
+! qnr_p(i,k,j) = max(0., state % scalars % array(state%index_qnr,k,i))
+! qni_p(i,k,j) = max(0., state % scalars % array(state%index_qni,k,i))
+ qnr_p(i,k,j) = state % scalars % array(state%index_qnr,k,i)
+ qni_p(i,k,j) = state % scalars % array(state%index_qni,k,i)
enddo
enddo
enddo
@@ -150,7 +151,7 @@
!=============================================================================================
!output variables:
- type(grid_state),intent(out):: state
+ type(state_type),intent(out):: state
!---------------------------------------------------------------------------------------------
@@ -165,9 +166,9 @@
do i = its, ite
t_p(i,k,j) = th_p(i,k,j) * pi_p(i,k,j)
state % theta % array(k,i) = th_p(i,k,j)
- state % scalars % array(index_qv,k,i) = qv_p(i,k,j)
- state % scalars % array(index_qc,k,i) = qc_p(i,k,j)
- state % scalars % array(index_qr,k,i) = qr_p(i,k,j)
+ state % scalars % array(state%index_qv,k,i) = qv_p(i,k,j)
+ state % scalars % array(state%index_qc,k,i) = qc_p(i,k,j)
+ state % scalars % array(state%index_qr,k,i) = qr_p(i,k,j)
state % h_diabatic % array(k,i) = (state % theta % array(k,i) &
- state % h_diabatic % array(k,i)) / dt_dyn
@@ -184,13 +185,13 @@
do k = kts, kte
do i = its, ite
!mass mixing ratios:
- state % scalars % array(index_qi,k,i) = qi_p(i,k,j)
- state % scalars % array(index_qs,k,i) = qs_p(i,k,j)
- state % scalars % array(index_qg,k,i) = qg_p(i,k,j)
+ state % scalars % array(state%index_qi,k,i) = qi_p(i,k,j)
+ state % scalars % array(state%index_qs,k,i) = qs_p(i,k,j)
+ state % scalars % array(state%index_qg,k,i) = qg_p(i,k,j)
!number concentrations:
- state % scalars % array(index_qnr,k,i) = qnr_p(i,k,j)
- state % scalars % array(index_qni,k,i) = qni_p(i,k,j)
+ state % scalars % array(state%index_qnr,k,i) = qnr_p(i,k,j)
+ state % scalars % array(state%index_qni,k,i) = qni_p(i,k,j)
enddo
enddo
enddo
Modified: branches/atmos_physics/src/core_physics/module_physics_interface_nhyd.F
===================================================================
--- branches/atmos_physics/src/core_physics/module_physics_interface_nhyd.F 2010-10-13 18:01:28 UTC (rev 548)
+++ branches/atmos_physics/src/core_physics/module_physics_interface_nhyd.F 2010-10-13 20:25:17 UTC (rev 549)
@@ -22,9 +22,9 @@
!=============================================================================================
!input variables:
- type(grid_state),intent(in):: src
+ type(state_type),intent(in):: src
!inout variables:
- type(grid_state),intent(inout):: dest
+ type(state_type),intent(inout):: dest
!---------------------------------------------------------------------------------------------
@@ -85,12 +85,13 @@
end subroutine nhyd_copy_state_physics
!=============================================================================================
- subroutine MPAS_to_physics(grid,vars)
+ subroutine MPAS_to_physics(grid,vars,diag)
!=============================================================================================
!input variables:
- type(grid_meta) ,intent(in):: grid
- type(grid_state),intent(in):: vars
+ type(mesh_type) ,intent(in):: grid
+ type(state_type),intent(in):: vars
+ type(diag_type) ,intent(in):: diag
!local variables:
integer:: i,k,j
@@ -115,11 +116,11 @@
rho => vars % rho % array
theta => vars % theta % array
pressure => vars % pressure % array
- qv => vars % scalars % array(index_qv,:,:)
+ qv => vars % scalars % array(vars%index_qv,:,:)
w => vars % w % array
- u => vars % uReconstructZonal % array
- v => vars % uReconstructMeridional % array
+ u => diag % uReconstructZonal % array
+ v => diag % uReconstructMeridional % array
!copy sounding variables from the geodesic grid to the wrf-physics grid:
do j = jts, jtf
@@ -139,7 +140,7 @@
dz_p(i,k,j) = zgrid(k+1,i)-zgrid(k,i)
- qv_p(i,k,j) = max(0.,vars % scalars % array(index_qv,k,i))
+ qv_p(i,k,j) = max(0.,vars % scalars % array(vars%index_qv,k,i))
enddo
enddo
@@ -156,8 +157,8 @@
!=============================================================================================
!input variables:
- type(grid_meta) ,intent(in):: grid
- type(grid_state),intent(in):: vars
+ type(mesh_type) ,intent(in):: grid
+ type(state_type),intent(in):: vars
!local variables:
integer:: i,k,j
@@ -190,7 +191,7 @@
rh => vars % rh % array
pressure => vars % pressure % array
- qv => vars % scalars % array(index_qv,:,:)
+ qv => vars % scalars % array(vars%index_qv,:,:)
!copy sounding variables from the geodesic grid to the wrf-physics grid:
do j = jts, jtf
@@ -205,9 +206,9 @@
z_p(i,k,j) = 0.5*(zgrid(k+1,i) + zgrid(k,i))
dz_p(i,k,j) = zgrid(k+1,i) - zgrid(k,i)
- qv_p(i,k,j) = max(0.,vars % scalars % array(index_qv,k,i))
- qc_p(i,k,j) = max(0.,vars % scalars % array(index_qc,k,i))
- qr_p(i,k,j) = max(0.,vars % scalars % array(index_qr,k,i))
+ qv_p(i,k,j) = max(0.,vars % scalars % array(vars%index_qv,k,i))
+ qc_p(i,k,j) = max(0.,vars % scalars % array(vars%index_qc,k,i))
+ qr_p(i,k,j) = max(0.,vars % scalars % array(vars%index_qr,k,i))
enddo
enddo
enddo
@@ -231,13 +232,13 @@
do i = its, itf
!mass mixing ratios:
- qi_p(i,k,j) = max(0.,vars % scalars % array(index_qi,k,i))
- qs_p(i,k,j) = max(0.,vars % scalars % array(index_qs,k,i))
- qg_p(i,k,j) = max(0.,vars % scalars % array(index_qg,k,i))
+ qi_p(i,k,j) = max(0.,vars % scalars % array(vars%index_qi,k,i))
+ qs_p(i,k,j) = max(0.,vars % scalars % array(vars%index_qs,k,i))
+ qg_p(i,k,j) = max(0.,vars % scalars % array(vars%index_qg,k,i))
!number concentrations:
- qnr_p(i,k,j) = max(0., vars % scalars % array(index_qnr,k,i))
- qni_p(i,k,j) = max(0., vars % scalars % array(index_qni,k,i))
+ qnr_p(i,k,j) = max(0., vars % scalars % array(vars%index_qnr,k,i))
+ qni_p(i,k,j) = max(0., vars % scalars % array(vars%index_qni,k,i))
enddo
enddo
@@ -314,10 +315,10 @@
!input variables:
integer,intent(in):: itimestep
- type(grid_meta),intent(in):: grid
+ type(mesh_type),intent(in):: grid
!output variables:
- type(grid_state),intent(out):: vars
+ type(state_type),intent(out):: vars
real(kind=RKIND):: min_theta,min_thp,min_tp
real(kind=RKIND):: max_theta,max_thp,max_tp
@@ -373,9 +374,9 @@
+ (exner(k,i)-exner_b(k,i))*rtheta_b(k,i))
!mass mixing ratios:
- vars % scalars % array(index_qv,k,i) = qv_p(i,k,j)
- vars % scalars % array(index_qc,k,i) = qc_p(i,k,j)
- vars % scalars % array(index_qr,k,i) = qr_p(i,k,j)
+ vars % scalars % array(vars%index_qv,k,i) = qv_p(i,k,j)
+ vars % scalars % array(vars%index_qc,k,i) = qc_p(i,k,j)
+ vars % scalars % array(vars%index_qr,k,i) = qr_p(i,k,j)
enddo
enddo
@@ -392,13 +393,13 @@
do i = its, itf
!mass mixing ratios:
- vars % scalars % array(index_qi,k,i) = qi_p(i,k,j)
- vars % scalars % array(index_qs,k,i) = qs_p(i,k,j)
- vars % scalars % array(index_qg,k,i) = qg_p(i,k,j)
+ vars % scalars % array(vars%index_qi,k,i) = qi_p(i,k,j)
+ vars % scalars % array(vars%index_qs,k,i) = qs_p(i,k,j)
+ vars % scalars % array(vars%index_qg,k,i) = qg_p(i,k,j)
!number concentrations:
- vars % scalars % array(index_qnr,k,i) = qnr_p(i,k,j)
- vars % scalars % array(index_qni,k,i) = qni_p(i,k,j)
+ vars % scalars % array(vars%index_qnr,k,i) = qnr_p(i,k,j)
+ vars % scalars % array(vars%index_qni,k,i) = qni_p(i,k,j)
enddo
enddo
@@ -432,36 +433,36 @@
min_tp = minval(t_p(:,:,:))
write(0,*) ' max_tp = ',max_tp ,' min_tp = ',min_tp
- max_qv = maxval(vars%scalars%array(index_qv,:,:))
- min_qv = minval(vars%scalars%array(index_qv,:,:))
+ max_qv = maxval(vars%scalars%array(vars%index_qv,:,:))
+ min_qv = minval(vars%scalars%array(vars%index_qv,:,:))
write(0,*) ' max_qv = ',max_qv,' min_qv = ',min_qv
- max_qc = maxval(vars%scalars%array(index_qc,:,:))
- min_qc = minval(vars%scalars%array(index_qc,:,:))
+ max_qc = maxval(vars%scalars%array(vars%index_qc,:,:))
+ min_qc = minval(vars%scalars%array(vars%index_qc,:,:))
write(0,*) ' max_qc = ',max_qc,' min_qc = ',min_qc
- max_qr = maxval(vars%scalars%array(index_qr,:,:))
- min_qr = minval(vars%scalars%array(index_qr,:,:))
+ max_qr = maxval(vars%scalars%array(vars%index_qr,:,:))
+ min_qr = minval(vars%scalars%array(vars%index_qr,:,:))
write(0,*) ' max_qr = ',max_qr,' min_qr = ',min_qr
- max_qi = maxval(vars%scalars%array(index_qi,:,:))
- min_qi = minval(vars%scalars%array(index_qi,:,:))
+ max_qi = maxval(vars%scalars%array(vars%index_qi,:,:))
+ min_qi = minval(vars%scalars%array(vars%index_qi,:,:))
write(0,*) ' max_qi = ',max_qi,' min_qi = ',min_qi
- max_qs = maxval(vars%scalars%array(index_qs,:,:))
- min_qs = minval(vars%scalars%array(index_qs,:,:))
+ max_qs = maxval(vars%scalars%array(vars%index_qs,:,:))
+ min_qs = minval(vars%scalars%array(vars%index_qs,:,:))
write(0,*) ' max_qs = ',max_qs,' min_qs = ',min_qs
- max_qg = maxval(vars%scalars%array(index_qg,:,:))
- min_qg = minval(vars%scalars%array(index_qg,:,:))
+ max_qg = maxval(vars%scalars%array(vars%index_qg,:,:))
+ min_qg = minval(vars%scalars%array(vars%index_qg,:,:))
write(0,*) ' max_qg = ',max_qg,' min_qg = ',min_qg
- max_qnr = maxval(vars%scalars%array(index_qnr,:,:))
- min_qnr = minval(vars%scalars%array(index_qnr,:,:))
+ max_qnr = maxval(vars%scalars%array(vars%index_qnr,:,:))
+ min_qnr = minval(vars%scalars%array(vars%index_qnr,:,:))
write(0,*) ' max_qnr = ',max_qnr,' min_qnr = ',min_qnr
- max_qni = maxval(vars%scalars%array(index_qni,:,:))
- min_qni = minval(vars%scalars%array(index_qni,:,:))
+ max_qni = maxval(vars%scalars%array(vars%index_qni,:,:))
+ min_qni = minval(vars%scalars%array(vars%index_qni,:,:))
write(0,*) ' max_qni = ',max_qni,' min_qni = ',min_qni
!formats:
@@ -473,8 +474,8 @@
subroutine compute_relhum(grid,vars)
!--------------------------------------------------------------------------------------------------
- type(grid_state),intent(in) :: vars
- type(grid_meta),intent(in) :: grid
+ type(state_type),intent(in) :: vars
+ type(mesh_type),intent(in) :: grid
real,dimension(:,:),pointer :: theta,pressure
real,dimension(:,:),pointer :: pressure_b,exner
@@ -489,7 +490,7 @@
theta => vars % theta % array
pressure => vars % pressure % array
rh => vars % rh % array
- qv => vars % scalars % array(index_qv,:,:)
+ qv => vars % scalars % array(vars%index_qv,:,:)
do iCell = 1, grid % nCells
do k = 1, grid % nVertLevels
Modified: branches/atmos_physics/src/core_physics/module_physics_manager.F
===================================================================
--- branches/atmos_physics/src/core_physics/module_physics_manager.F 2010-10-13 18:01:28 UTC (rev 548)
+++ branches/atmos_physics/src/core_physics/module_physics_manager.F 2010-10-13 20:25:17 UTC (rev 549)
@@ -41,7 +41,7 @@
!input arguments:
!----------------
- type(grid_meta),intent(in):: mesh
+ type(mesh_type),intent(in):: mesh
!=============================================================================================
write(0,*)
Modified: branches/atmos_physics/src/core_physics/module_physics_sfclayer.F
===================================================================
--- branches/atmos_physics/src/core_physics/module_physics_sfclayer.F 2010-10-13 18:01:28 UTC (rev 548)
+++ branches/atmos_physics/src/core_physics/module_physics_sfclayer.F 2010-10-13 20:25:17 UTC (rev 549)
@@ -87,7 +87,7 @@
!=============================================================================================
!input arguments:
- type(grid_state),intent(in):: s
+ type(state_type),intent(in):: s
!---------------------------------------------------------------------------------------------
Modified: branches/atmos_physics/src/core_physics/module_physics_todynamics.F
===================================================================
--- branches/atmos_physics/src/core_physics/module_physics_todynamics.F 2010-10-13 18:01:28 UTC (rev 548)
+++ branches/atmos_physics/src/core_physics/module_physics_todynamics.F 2010-10-13 20:25:17 UTC (rev 549)
@@ -15,14 +15,14 @@
!input variables:
!----------------
- type(grid_meta),intent(in):: grid
- type(grid_state),intent(in):: vars
+ type(mesh_type),intent(in):: grid
+ type(state_type),intent(in):: vars
real(kind=RKIND),intent(in),dimension(grid%nVertLevels,grid%nCells):: mass
!inout variables:
!----------------
- type(grid_state),intent(inout):: tend
+ type(tend_type),intent(inout):: tend
!local variables:
!----------------
@@ -57,18 +57,18 @@
do i = 1, nCellsSolve
do k = 1, nVertLevels
tend_theta(k,i)=tend_theta(k,i)+rthcuten(k,i)*mass(k,i)
- tend_scalars(index_qv,k,i)=tend_scalars(index_qv,k,i)+rqvcuten(k,i)*mass(k,i)
- tend_scalars(index_qc,k,i)=tend_scalars(index_qc,k,i)+rqccuten(k,i)*mass(k,i)
- tend_scalars(index_qr,k,i)=tend_scalars(index_qr,k,i)+rqrcuten(k,i)*mass(k,i)
- tend_scalars(index_qi,k,i)=tend_scalars(index_qi,k,i)+rqicuten(k,i)*mass(k,i)
- tend_scalars(index_qs,k,i)=tend_scalars(index_qs,k,i)+rqscuten(k,i)*mass(k,i)
+ tend_scalars(vars%index_qv,k,i)=tend_scalars(vars%index_qv,k,i)+rqvcuten(k,i)*mass(k,i)
+ tend_scalars(vars%index_qc,k,i)=tend_scalars(vars%index_qc,k,i)+rqccuten(k,i)*mass(k,i)
+ tend_scalars(vars%index_qr,k,i)=tend_scalars(vars%index_qr,k,i)+rqrcuten(k,i)*mass(k,i)
+ tend_scalars(vars%index_qi,k,i)=tend_scalars(vars%index_qi,k,i)+rqicuten(k,i)*mass(k,i)
+ tend_scalars(vars%index_qs,k,i)=tend_scalars(vars%index_qs,k,i)+rqscuten(k,i)*mass(k,i)
! write(0,201) i,k,tend_theta(k,i), &
-! tend_scalars(index_qv,k,i), &
-! tend_scalars(index_qc,k,i), &
-! tend_scalars(index_qr,k,i), &
-! tend_scalars(index_qi,k,i), &
-! tend_scalars(index_qs,k,i), &
-! tend_scalars(index_qg,k,i)
+! tend_scalars(vars%index_qv,k,i), &
+! tend_scalars(vars%index_qc,k,i), &
+! tend_scalars(vars%index_qr,k,i), &
+! tend_scalars(vars%index_qi,k,i), &
+! tend_scalars(vars%index_qs,k,i), &
+! tend_scalars(vars%index_qg,k,i)
enddo
enddo
Modified: branches/atmos_physics/src/core_sw/Registry
===================================================================
--- branches/atmos_physics/src/core_sw/Registry 2010-10-13 18:01:28 UTC (rev 548)
+++ branches/atmos_physics/src/core_sw/Registry 2010-10-13 20:25:17 UTC (rev 549)
@@ -30,90 +30,95 @@
dim nTracers nTracers
#
-# var type name_in_file ( dims ) iro- name_in_code super-array array_class
+# var persistence type name_in_file ( dims ) time_levs iro- name_in_code struct super-array array_class
#
-var real xtime ( Time ) ro xtime - -
+var persistent real xtime ( Time ) 2 ro xtime state - -
-var real latCell ( nCells ) iro latCell - -
-var real lonCell ( nCells ) iro lonCell - -
-var real xCell ( nCells ) iro xCell - -
-var real yCell ( nCells ) iro yCell - -
-var real zCell ( nCells ) iro zCell - -
-var integer indexToCellID ( nCells ) iro indexToCellID - -
+var persistent real latCell ( nCells ) 0 iro latCell mesh - -
+var persistent real lonCell ( nCells ) 0 iro lonCell mesh - -
+var persistent real xCell ( nCells ) 0 iro xCell mesh - -
+var persistent real yCell ( nCells ) 0 iro yCell mesh - -
+var persistent real zCell ( nCells ) 0 iro zCell mesh - -
+var persistent integer indexToCellID ( nCells ) 0 iro indexToCellID mesh - -
-var real latEdge ( nEdges ) iro latEdge - -
-var real lonEdge ( nEdges ) iro lonEdge - -
-var real xEdge ( nEdges ) iro xEdge - -
-var real yEdge ( nEdges ) iro yEdge - -
-var real zEdge ( nEdges ) iro zEdge - -
-var integer indexToEdgeID ( nEdges ) iro indexToEdgeID - -
+var persistent real latEdge ( nEdges ) 0 iro latEdge mesh - -
+var persistent real lonEdge ( nEdges ) 0 iro lonEdge mesh - -
+var persistent real xEdge ( nEdges ) 0 iro xEdge mesh - -
+var persistent real yEdge ( nEdges ) 0 iro yEdge mesh - -
+var persistent real zEdge ( nEdges ) 0 iro zEdge mesh - -
+var persistent integer indexToEdgeID ( nEdges ) 0 iro indexToEdgeID mesh - -
-var real latVertex ( nVertices ) iro latVertex - -
-var real lonVertex ( nVertices ) iro lonVertex - -
-var real xVertex ( nVertices ) iro xVertex - -
-var real yVertex ( nVertices ) iro yVertex - -
-var real zVertex ( nVertices ) iro zVertex - -
-var integer indexToVertexID ( nVertices ) iro indexToVertexID - -
+var persistent real latVertex ( nVertices ) 0 iro latVertex mesh - -
+var persistent real lonVertex ( nVertices ) 0 iro lonVertex mesh - -
+var persistent real xVertex ( nVertices ) 0 iro xVertex mesh - -
+var persistent real yVertex ( nVertices ) 0 iro yVertex mesh - -
+var persistent real zVertex ( nVertices ) 0 iro zVertex mesh - -
+var persistent integer indexToVertexID ( nVertices ) 0 iro indexToVertexID mesh - -
-var integer cellsOnEdge ( TWO nEdges ) iro cellsOnEdge - -
-var integer nEdgesOnCell ( nCells ) iro nEdgesOnCell - -
-var integer nEdgesOnEdge ( nEdges ) iro nEdgesOnEdge - -
-var integer edgesOnCell ( maxEdges nCells ) iro edgesOnCell - -
-var integer edgesOnEdge ( maxEdges2 nEdges ) iro edgesOnEdge - -
+var persistent integer cellsOnEdge ( TWO nEdges ) 0 iro cellsOnEdge mesh - -
+var persistent integer nEdgesOnCell ( nCells ) 0 iro nEdgesOnCell mesh - -
+var persistent integer nEdgesOnEdge ( nEdges ) 0 iro nEdgesOnEdge mesh - -
+var persistent integer edgesOnCell ( maxEdges nCells ) 0 iro edgesOnCell mesh - -
+var persistent integer edgesOnEdge ( maxEdges2 nEdges ) 0 iro edgesOnEdge mesh - -
-var real weightsOnEdge ( maxEdges2 nEdges ) iro weightsOnEdge - -
-var real dvEdge ( nEdges ) iro dvEdge - -
-var real dcEdge ( nEdges ) iro dcEdge - -
-var real angleEdge ( nEdges ) iro angleEdge - -
-var real areaCell ( nCells ) iro areaCell - -
-var real areaTriangle ( nVertices ) iro areaTriangle - -
+var persistent real weightsOnEdge ( maxEdges2 nEdges ) 0 iro weightsOnEdge mesh - -
+var persistent real dvEdge ( nEdges ) 0 iro dvEdge mesh - -
+var persistent real dcEdge ( nEdges ) 0 iro dcEdge mesh - -
+var persistent real angleEdge ( nEdges ) 0 iro angleEdge mesh - -
+var persistent real areaCell ( nCells ) 0 iro areaCell mesh - -
+var persistent real areaTriangle ( nVertices ) 0 iro areaTriangle mesh - -
-var real edgeNormalVectors ( R3 nEdges ) o edgeNormalVectors - -
-var real localVerticalUnitVectors ( R3 nCells ) o localVerticalUnitVectors - -
-var real cellTangentPlane ( R3 TWO nEdges ) o cellTangentPlane - -
+var persistent real edgeNormalVectors ( R3 nEdges ) 0 o edgeNormalVectors mesh - -
+var persistent real localVerticalUnitVectors ( R3 nCells ) 0 o localVerticalUnitVectors mesh - -
+var persistent real cellTangentPlane ( R3 TWO nEdges ) 0 o cellTangentPlane mesh - -
-var integer cellsOnCell ( maxEdges nCells ) iro cellsOnCell - -
-var integer verticesOnCell ( maxEdges nCells ) iro verticesOnCell - -
-var integer verticesOnEdge ( TWO nEdges ) iro verticesOnEdge - -
-var integer edgesOnVertex ( vertexDegree nVertices ) iro edgesOnVertex - -
-var integer cellsOnVertex ( vertexDegree nVertices ) iro cellsOnVertex - -
-var real kiteAreasOnVertex ( vertexDegree nVertices ) iro kiteAreasOnVertex - -
-var real fEdge ( nEdges ) iro fEdge - -
-var real fVertex ( nVertices ) iro fVertex - -
-var real fCell ( nCells ) iro fCell - -
-var real h_s ( nCells ) iro h_s - -
+var persistent integer cellsOnCell ( maxEdges nCells ) 0 iro cellsOnCell mesh - -
+var persistent integer verticesOnCell ( maxEdges nCells ) 0 iro verticesOnCell mesh - -
+var persistent integer verticesOnEdge ( TWO nEdges ) 0 iro verticesOnEdge mesh - -
+var persistent integer edgesOnVertex ( vertexDegree nVertices ) 0 iro edgesOnVertex mesh - -
+var persistent integer cellsOnVertex ( vertexDegree nVertices ) 0 iro cellsOnVertex mesh - -
+var persistent real kiteAreasOnVertex ( vertexDegree nVertices ) 0 iro kiteAreasOnVertex mesh - -
+var persistent real fEdge ( nEdges ) 0 iro fEdge mesh - -
+var persistent real fVertex ( nVertices ) 0 iro fVertex mesh - -
+var persistent real fCell ( nCells ) 0 iro fCell mesh - -
+var persistent real h_s ( nCells ) 0 iro h_s mesh - -
# Arrays required for reconstruction of velocity field
-var real coeffs_reconstruct ( R3 maxEdges nCells ) - coeffs_reconstruct - -
+var persistent real coeffs_reconstruct ( R3 maxEdges nCells ) 0 - coeffs_reconstruct mesh - -
# Boundary conditions: read from input, saved in restart and written to output
-var integer boundaryEdge ( nVertLevels nEdges ) iro boundaryEdge - -
-var integer boundaryVertex ( nVertLevels nVertices ) iro boundaryVertex - -
+var persistent integer boundaryEdge ( nVertLevels nEdges ) 0 iro boundaryEdge mesh - -
+var persistent integer boundaryVertex ( nVertLevels nVertices ) 0 iro boundaryVertex mesh - -
# Prognostic variables: read from input, saved in restart, and written to output
-var real u ( nVertLevels nEdges Time ) iro u - -
-var real h ( nVertLevels nCells Time ) iro h - -
-var real tracers ( nTracers nVertLevels nCells Time ) iro tracers - -
+var persistent real u ( nVertLevels nEdges Time ) 2 iro u state - -
+var persistent real h ( nVertLevels nCells Time ) 2 iro h state - -
+var persistent real tracers ( nTracers nVertLevels nCells Time ) 2 iro tracers state - -
+# Tendency variables
+var persistent real tend_u ( nVertLevels nEdges Time ) 1 - u tend - -
+var persistent real tend_h ( nVertLevels nCells Time ) 1 - h tend - -
+var persistent real tend_tracers ( nTracers nVertLevels nCells Time ) 1 - tracers tend - -
+
# Diagnostic fields: only written to output
-var real v ( nVertLevels nEdges Time ) o v - -
-var real divergence ( nVertLevels nCells Time ) o divergence - -
-var real vorticity ( nVertLevels nVertices Time ) o vorticity - -
-var real vorticity_cell ( nVertLevels nCells Time ) o vorticity_cell - -
-var real pv_edge ( nVertLevels nEdges Time ) o pv_edge - -
-var real h_edge ( nVertLevels nEdges Time ) o h_edge - -
-var real ke ( nVertLevels nCells Time ) o ke - -
-var real pv_vertex ( nVertLevels nVertices Time ) o pv_vertex - -
-var real pv_cell ( nVertLevels nCells Time ) o pv_cell - -
-var real uReconstructX ( nVertLevels nCells Time ) o uReconstructX - -
-var real uReconstructY ( nVertLevels nCells Time ) o uReconstructY - -
-var real uReconstructZ ( nVertLevels nCells Time ) o uReconstructZ - -
-var real uReconstructZonal ( nVertLevels nCells Time ) o uReconstructZonal - -
-var real uReconstructMeridional ( nVertLevels nCells Time ) o uReconstructMeridional - -
+var persistent real v ( nVertLevels nEdges Time ) 2 o v state - -
+var persistent real divergence ( nVertLevels nCells Time ) 2 o divergence state - -
+var persistent real vorticity ( nVertLevels nVertices Time ) 2 o vorticity state - -
+var persistent real vorticity_cell ( nVertLevels nCells Time ) 2 o vorticity_cell state - -
+var persistent real pv_edge ( nVertLevels nEdges Time ) 2 o pv_edge state - -
+var persistent real h_edge ( nVertLevels nEdges Time ) 2 o h_edge state - -
+var persistent real ke ( nVertLevels nCells Time ) 2 o ke state - -
+var persistent real pv_vertex ( nVertLevels nVertices Time ) 2 o pv_vertex state - -
+var persistent real pv_cell ( nVertLevels nCells Time ) 2 o pv_cell state - -
+var persistent real uReconstructX ( nVertLevels nCells Time ) 1 o uReconstructX diag - -
+var persistent real uReconstructY ( nVertLevels nCells Time ) 1 o uReconstructY diag - -
+var persistent real uReconstructZ ( nVertLevels nCells Time ) 1 o uReconstructZ diag - -
+var persistent real uReconstructZonal ( nVertLevels nCells Time ) 1 o uReconstructZonal diag - -
+var persistent real uReconstructMeridional ( nVertLevels nCells Time ) 1 o uReconstructMeridional diag - -
# Other diagnostic variables: neither read nor written to any files
-var real vh ( nVertLevels nEdges Time ) - vh - -
-var real circulation ( nVertLevels nVertices Time ) - circulation - -
-var real gradPVt ( nVertLevels nEdges Time ) - gradPVt - -
-var real gradPVn ( nVertLevels nEdges Time ) - gradPVn - -
-var real h_vertex ( nVertLevels nVertices Time ) - h_vertex - -
+var persistent real vh ( nVertLevels nEdges Time ) 2 - vh state - -
+var persistent real circulation ( nVertLevels nVertices Time ) 2 - circulation state - -
+var persistent real gradPVt ( nVertLevels nEdges Time ) 2 - gradPVt state - -
+var persistent real gradPVn ( nVertLevels nEdges Time ) 2 - gradPVn state - -
+var persistent real h_vertex ( nVertLevels nVertices Time ) 2 - h_vertex state - -
Modified: branches/atmos_physics/src/core_sw/module_global_diagnostics.F
===================================================================
--- branches/atmos_physics/src/core_sw/module_global_diagnostics.F 2010-10-13 18:01:28 UTC (rev 548)
+++ branches/atmos_physics/src/core_sw/module_global_diagnostics.F 2010-10-13 20:25:17 UTC (rev 549)
@@ -28,7 +28,7 @@
! 1. Define the array to integrate, and the variable for the value above.
! 2. Allocate the array with the correct dimensions.
! 3. Fill the array with the data to be integrated.
- ! eg. G_h = Sum(h dA)/Sum(dA), See below for array filling
+ ! eg. GlobalFluidThickness = Sum(h dA)/Sum(dA), See below for array filling
! 4. Call Function to compute Global Stat that you want.
! 5. Finish computing the global stat/integral
! 6. Write out your global stat to the file
@@ -37,8 +37,8 @@
implicit none
type (dm_info), intent(in) :: dminfo
- type (grid_state), intent(inout) :: state
- type (grid_meta), intent(in) :: grid
+ type (state_type), intent(inout) :: state
+ type (mesh_type), intent(in) :: grid
integer, intent(in) :: timeIndex
real (kind=RKIND), intent(in) :: dt
@@ -46,26 +46,36 @@
integer :: nCells
! Step 1
- ! 1. Define the array to integrate, and the variable for the value above.
- real (kind=RKIND) :: areaCellGlobal, areaEdgeGlobal, areaTriangleGlobal
- real (kind=RKIND), dimension(:), pointer :: areaCell, dcEdge, dvEdge, areaTriangle, areaEdge, h_s
- real (kind=RKIND), dimension(:,:), pointer :: h, u, v, h_edge, pv_edge, pv_vertex, pv_cell, h_vertex
+ ! 1. Define the array to integrate, and the variable for the value to be stored in after the integration
+ real (kind=RKIND), dimension(:), pointer :: areaCell, dcEdge, dvEdge, areaTriangle, h_s, fCell, fEdge
+ real (kind=RKIND), dimension(:,:), pointer :: h, u, v, h_edge, pv_edge, pv_vertex, pv_cell, h_vertex, weightsOnEdge
- real (kind=RKIND), dimension(:), allocatable :: eres, h_ref
- real (kind=RKIND), dimension(:,:), allocatable :: pe_vertex, u2, h2, hb, pv_temp, pve_bot, h_top, h_bot, cor_energy, sshr, ke_sink, pe_sink
real (kind=RKIND), dimension(:,:,:), pointer :: tracers
- real (kind=RKIND) :: global_temp, gh, gpv, gpe, ge, ger, e_cor, sshr_val, h_ref_val, ke_sink_val, pe_sink_val, ke
+ real (kind=RKIND), dimension(:), allocatable :: volumeWeightedPotentialEnergyReservoir, averageThickness
+ real (kind=RKIND), dimension(:), allocatable :: potentialEnstrophyReservior, areaEdge, h_s_edge
+
+ real (kind=RKIND), dimension(:,:), allocatable :: cellVolume, cellArea, volumeWeightedPotentialVorticity
+ real (kind=RKIND), dimension(:,:), allocatable :: volumeWeightedPotentialEnstrophy, vertexVolume, volumeWeightedKineticEnergy
+ real (kind=RKIND), dimension(:,:), allocatable :: volumeWeightedPotentialEnergy, volumeWeightedPotentialEnergyTopography
+ real (kind=RKIND), dimension(:,:), allocatable :: keTend_CoriolisForce, keTend_PressureGradient
+ real (kind=RKIND), dimension(:,:), allocatable ::peTend_DivThickness, refAreaWeightedSurfaceHeight, refAreaWeightedSurfaceHeight_edge
+
+ real (kind=RKIND) :: sumCellVolume, sumCellArea, sumVertexVolume, sumrefAreaWeightedSurfaceHeight
+
+ real (kind=RKIND) :: globalFluidThickness, globalPotentialVorticity, globalPotentialEnstrophy, globalEnergy
+ real (kind=RKIND) :: globalCoriolisEnergyTendency, globalKEPETendency, globalPotentialEnstrophyReservoir
+ real (kind=RKIND) :: globalKineticEnergy, globalPotentialEnergy, globalPotentialEnergyReservoir
+ real (kind=RKIND) :: globalKineticEnergyTendency, globalPotentialEnergyTendency
+ real (kind=RKIND) :: global_temp, workpv, q
real (kind=RKIND) :: volumeCellGlobal, volumeEdgeGlobal, CFLNumberGlobal
+
integer :: elementIndex, variableIndex, nVariables, nSums, nMaxes, nMins
- integer :: timeLevel,k,i
+ integer :: timeLevel, eoe, iLevel, iCell, iEdge, iVertex
+ integer :: fileID, iCell1, iCell2, j
- integer, dimension(:,:), pointer :: cellsOnEdge, edgesOnCell
-
- integer, parameter :: kMaxVariables = 1024 ! this must be a little more than double the number of variables to be reduced
- real (kind=RKIND), dimension(kMaxVariables) :: sums, mins, maxes, averages, verticalSumMins, verticalSumMaxes, reductions
-
- integer :: fileID, iCell1, iCell2, iEdge
+ integer, dimension(:,:), pointer :: cellsOnEdge, edgesOnCell, edgesOnEdge
+ integer, dimension(:), pointer :: nEdgesOnEdge
cellsOnEdge => grid % cellsOnEdge % array
edgesOnCell => grid % edgesOnCell % array
@@ -81,8 +91,14 @@
dcEdge => grid % dcEdge % array
dvEdge => grid % dvEdge % array
areaTriangle => grid % areaTriangle % array
+ fCell => grid % fCell % array
+ fEdge => grid % fEdge % array
+ edgesOnEdge => grid % edgesOnEdge % array
+ nEdgesOnEdge => grid % nEdgesOnEdge % array
+
allocate(areaEdge(1:nEdgesSolve))
areaEdge = dcEdge(1:nEdgesSolve)*dvEdge(1:nEdgesSolve)
+ weightsOnEdge => grid % weightsOnEdge % array
h => state % h % array
u => state % u % array
@@ -96,114 +112,171 @@
! Step 2
! 2. Allocate the array with the correct dimensions.
- allocate(h_top(nVertLevels,nCellsSolve))
- allocate(h_bot(nVertLevels,nCellsSolve))
- allocate(h2(nVertLevels,nCellsSolve))
- allocate(hb(nVertLevels,nCellsSolve))
- allocate(sshr(nVertLevels,nCellsSolve))
+ allocate(cellVolume(nVertLevels,nCellsSolve))
+ allocate(cellArea(nVertLevels,nCellsSolve))
+ allocate(refAreaWeightedSurfaceHeight(nVertLevels,nCellsSolve))
+ allocate(refAreaWeightedSurfaceHeight_edge(nVertLevels,nEdgesSolve))
+ allocate(volumeWeightedPotentialVorticity(nVertLevels,nVerticesSolve))
+ allocate(volumeWeightedPotentialEnstrophy(nVertLevels,nVerticesSolve))
+ allocate(potentialEnstrophyReservior(nCellsSolve))
+ allocate(vertexVolume(nVertLevels,nVerticesSolve))
+ allocate(volumeWeightedKineticEnergy(nVertLevels,nEdgesSolve))
+ allocate(volumeWeightedPotentialEnergy(nVertLevels,nCellsSolve))
+ allocate(volumeWeightedPotentialEnergyTopography(nVertLevels,nCellsSolve))
+ allocate(volumeWeightedPotentialEnergyReservoir(nCellsSolve))
+ allocate(keTend_CoriolisForce(nVertLevels,nEdgesSolve))
+ allocate(keTend_PressureGradient(nVertLevels,nEdgesSolve))
+ allocate(peTend_DivThickness(nVertLevels,nCells))
- allocate(h_ref(nCellsSolve))
+ allocate(averageThickness(nCellsSolve))
- allocate(pv_temp(nVertLevels,nVerticesSolve))
- allocate(pe_vertex(nVertLevels,nVerticesSolve))
- allocate(pve_bot(nVertLevels,nVerticesSolve))
+ allocate(h_s_edge(nEdgesSOlve))
- allocate(u2(nVertLevels,nEdgesSolve))
- allocate(cor_energy(nVertLevels,nEdgesSolve))
- allocate(ke_sink(nVertLevels,nEdgesSolve))
- allocate(pe_sink(nVertLevels,nCells))
+ cellVolume = 0
+ refAreaWeightedSurfaceHeight = 0
+ refAreaWeightedSurfaceHeight_edge = 0
+ vertexVolume = 0
+ cellArea = 0
+ averageThickness = 0
+ volumeWeightedPotentialVorticity = 0
+ volumeWeightedPotentialEnstrophy = 0
+ volumeWeightedKineticEnergy = 0
+ volumeWeightedPotentialEnergy = 0
+ volumeWeightedPotentialEnergyTopography = 0
+ volumeWeightedPotentialEnergyReservoir = 0
+ keTend_PressureGradient = 0
+ peTend_DivThickness = 0
+ keTend_CoriolisForce = 0
+ h_s_edge = 0
- allocate(eres(nCellsSolve))
-
- pe_sink = 0
-
! Build Arrays for Global Integrals
! Step 3
! 3. Fill the array with the data to be integrated.
- ! eg. G_h = Sum(h dA)/Sum(dA), See below for array filling
- do i = 1,nVertLevels
- ! G_h Top = Sum(h dA)
- h_top(i,:) = h(i,1:nCellsSolve)*areaCell(1:nCellsSolve)
- ! G_h Bot = Sum(dA)
- h_bot(i,:) = areaCell(1:nCellsSolve)
- pv_temp(i,:) = pv_vertex(i,1:nVerticesSolve)*h_vertex(i,1:nVerticesSolve)*areaTriangle(1:nVerticesSolve)
- pe_vertex(i,:) = pv_vertex(i,1:nVerticesSolve)*pv_vertex(i,1:nVerticesSolve)*h_vertex(i,1:nVerticesSolve)*areaTriangle(1:nVerticesSolve)
- pve_bot(i,:) = h_vertex(i,1:nVerticesSolve)*areaTriangle(1:nVerticesSolve)
- u2(i,:) = u(i,1:nEdgesSolve)*u(i,1:nEdgesSolve)*h_edge(i,1:nEdgesSolve)*areaEdge(1:nEdgesSolve)*0.5
- h2(i,:) = gravity*h(i,1:nCellsSolve)*h(i,1:nCellsSolve)*areaCell(1:nCellsSolve)*0.5
- hb(i,:) = gravity*h(i,1:nCellsSolve)*h_s(1:nCellsSolve)*areaCell(1:nCellsSolve)
- cor_energy(i,:) = h_edge(i,1:nEdgesSolve)*u(i,1:nEdgesSolve)*pv_edge(i,1:nEdgesSolve)*areaEdge(1:nEdgesSolve)
- sshr(i,:) = areaCell(1:nCellsSolve)*(h(i,1:nCellsSolve)+h_s(1:nCellsSolve))
+ ! eg. GlobalFluidThickness = Sum(h dA)/Sum(dA), See below for array filling
+ do iLevel = 1,nVertLevels
+ ! eg. GlobalFluidThickness top (Sum( h dA)) = Sum(cellVolume)
+ cellVolume(iLevel,:) = h(iLevel,1:nCellsSolve)*areaCell(1:nCellsSolve)
+ ! eg. GlobalFluidThickness bot (Sum(dA)) = Sum(cellArea)
+ cellArea(iLevel,:) = areaCell(1:nCellsSolve)
+ volumeWeightedPotentialVorticity(iLevel,:) = pv_vertex(iLevel,1:nVerticesSolve) &
+ *h_vertex(iLevel,1:nVerticesSolve)*areaTriangle(1:nVerticesSolve)
+ volumeWeightedPotentialEnstrophy(iLevel,:) = pv_vertex(iLevel,1:nVerticesSolve) &
+ *pv_vertex(iLevel,1:nVerticesSolve)*h_vertex(iLevel,1:nVerticesSolve)*areaTriangle(1:nVerticesSolve)
+ vertexVolume(iLevel,:) = h_vertex(iLevel,1:nVerticesSolve)*areaTriangle(1:nVerticesSolve)
+ volumeWeightedKineticEnergy(iLevel,:) = u(iLevel,1:nEdgesSolve)*u(iLevel,1:nEdgesSolve) &
+ *h_edge(iLevel,1:nEdgesSolve)*areaEdge(1:nEdgesSolve)*0.5
+ volumeWeightedPotentialEnergy(iLevel,:) = gravity*h(iLevel,1:nCellsSolve)*h(iLevel,1:nCellsSolve)*areaCell(1:nCellsSolve)*0.5
+ volumeWeightedPotentialEnergyTopography(iLevel,:) = gravity*h(iLevel,1:nCellsSolve)*h_s(1:nCellsSolve)*areaCell(1:nCellsSolve)
+ refAreaWeightedSurfaceHeight(iLevel,:) = areaCell(1:nCellsSolve)*(h(iLevel,1:nCellsSolve)+h_s(1:nCellsSolve))
- do k = 1,nEdgesSolve
- iCell1 = cellsOnEdge(k,1)
- iCell2 = cellsOnEdge(k,2)
- ke_sink(i,k) = areaEdge(k)*h_edge(i,k)*u(i,k)*gravity*(h(i,iCell2)+h_s(iCell2) - h(i,iCell1)-h_s(iCell1))/dcEdge(k)
- pe_sink(i,iCell1) = pe_sink(i,iCell1) + h_edge(i,k)*u(i,k)*dvEdge(k)
- pe_sink(i,iCell2) = pe_sink(i,iCell2) - h_edge(i,k)*u(i,k)*dvEdge(k)
+ do iEdge = 1,nEdgesSolve
+ q = 0.0
+ do j = 1,nEdgesOnEdge(iEdge)
+ eoe = edgesOnEdge(j,iEdge)
+ workpv = 0.5 * (pv_edge(iLevel,iEdge) + pv_edge(iLevel,eoe))
+ q = q + weightsOnEdge(j,iEdge) * u(iLevel,eoe) * workpv * h_edge(iLevel,eoe)
+ end do
+ keTend_CoriolisForce(iLevel,iEdge) = h_edge(iLevel,iEdge) * u(iLevel,iEdge) * q * areaEdge(iEdge)
+
+ iCell1 = cellsOnEdge(iEdge,1)
+ iCell2 = cellsOnEdge(iEdge,2)
+
+ refAreaWeightedSurfaceHeight_edge(iLevel,iEdge) = areaEdge(iEdge)*(h_edge(iLevel,iEdge) + 0.5*(h_s(iCell1) + h_s(iCell2)))
+
+ keTend_PressureGradient(iLevel,iEdge) = areaEdge(iEdge)*h_edge(iLevel,iEdge)*u(iLevel,iEdge) &
+ *gravity*(h(iLevel,iCell2)+h_s(iCell2) - h(iLevel,iCell1)-h_s(iCell1))/dcEdge(iEdge)
+ peTend_DivThickness(iLevel,iCell1) = peTend_DivThickness(iLevel,iCell1) &
+ + h_edge(iLevel,iEdge)*u(iLevel,iEdge)*dvEdge(iEdge)
+ peTend_DivThickness(iLevel,iCell2) = peTend_DivThickness(iLevel,iCell2) &
+ - h_edge(iLevel,iEdge)*u(iLevel,iEdge)*dvEdge(iEdge)
end do
- pe_sink(i,:) = pe_sink(i,1:nCellsSolve)*gravity*(h(i,1:nCellsSolve)+h_s(1:nCellsSolve))
+
+ peTend_DivThickness(iLevel,:) = peTend_DivThickness(iLevel,1:nCells)*gravity &
+ *(h(iLevel,1:nCells)+h_s(1:nCells))
end do
+ do iEdge = 1,nEdgesSolve
+ iCell1 = cellsOnEdge(iEdge,1)
+ iCell2 = cellsOnEdge(iEdge,2)
+
+ h_s_edge(iEdge) = 0.5*(h_s(iCell1) + h_s(iCell2))
+ end do
+
! Step 4
! 4. Call Function to compute Global Stat that you want.
- ! KE and PE Sink Terms
- call computeGlobalSum(dminfo, nVertLevels, nEdgesSolve, ke_sink, ke_sink_val)
- call computeGlobalSum(dminfo, nVertLevels, nCellsSolve, pe_sink, pe_sink_val)
+ ! Computing Kinetic and Potential Energy Tendency Terms
+ call computeGlobalSum(dminfo, nVertLevels, nEdgesSolve, keTend_PressureGradient, globalKineticEnergyTendency)
+ call computeGlobalSum(dminfo, nVertLevels, nCells, peTend_DivThickness, globalPotentialEnergyTendency)
- call computeGlobalSum(dminfo, 1, nCellsSolve, h_ref, h_ref_val)
+ ! Computing top and bottom of global mass integral
+ call computeGlobalSum(dminfo, nVertLevels, nCellsSolve, cellVolume, sumCellVolume)
+ call computeGlobalSum(dminfo, nVertLevels, nCellsSolve, cellArea, sumCellArea)
- ! Global Area Average of h
- call computeGlobalSum(dminfo, nVertLevels, nCellsSolve, h_top, gh)
- call computeGlobalSum(dminfo, nVertLevels, nCellsSolve, h_bot, global_temp)
+ globalKineticEnergyTendency = globalKineticEnergyTendency / sumCellVolume
+ globalPotentialEnergyTendency = globalPotentialEnergyTendency / sumCellVolume
! Step 5
! 5. Finish computing the global stat/integral
- gh = gh/global_temp
+ globalFluidThickness = sumCellVolume/sumCellArea
- ! Mean SSH for PE Res
- call computeGlobalSum(dminfo, nVertLevels, nCellsSolve, sshr, sshr_val)
+ ! Compute Average Sea Surface Height for Potential Energy and Enstrophy
+ ! Reservoir computations
+ call computeGlobalSum(dminfo, nVertLevels, nCellsSolve, refAreaWeightedSurfaceHeight, sumrefAreaWeightedSurfaceHeight)
- h_ref(:) = (sshr_val/global_temp)-h_s(1:nCellsSolve)
+ averageThickness(:) = (sumrefAreaWeightedSurfaceHeight/sumCellArea)-h_s(1:nCellsSolve)
+ ! Compute Volume Weighted Averages of Potential Vorticity and Potential Enstrophy
+ call computeGlobalSum(dminfo, nVertLevels, nVerticesSolve, volumeWeightedPotentialVorticity, globalPotentialVorticity)
+ call computeGlobalSum(dminfo, nVertLevels, nVerticesSolve, volumeWeightedPotentialEnstrophy, globalPotentialEnstrophy)
+ call computeGlobalSum(dminfo, nVertLevels, nVerticesSolve, vertexVolume, sumVertexVolume)
- ! Gloabl Area-Thickness Average of pv and pe
- call computeGlobalSum(dminfo, nVertLevels, nVerticesSolve, pv_temp, gpv)
- call computeGlobalSum(dminfo, nVertLevels, nVerticesSolve, pe_vertex, gpe)
- call computeGlobalSum(dminfo, nVertLevels, nVerticesSolve, pve_bot, global_temp)
+ globalPotentialVorticity = globalPotentialVorticity/sumVertexVolume
+ globalPotentialEnstrophy = globalPotentialEnstrophy/sumVertexVolume
- gpv = gpv/global_temp
- gpe = gpe/global_temp
+ ! Compte Potential Enstrophy Reservior
+ potentialEnstrophyReservior(:) = areaCell(:)*fCell(:)*fCell(:)/averageThickness
+ call computeGlobalSum(dminfo, 1, nCellsSolve, potentialEnstrophyReservior, globalPotentialEnstrophyReservoir)
+ globalPotentialEnstrophyReservoir = globalPotentialEnstrophyReservoir/sumCellVolume
- ! Global Integral of Total Energy with subtracting reference res
- call computeGlobalSum(dminfo, nVertLevels, nEdgesSolve, u2, ke)
- call computeGlobalSum(dminfo, nVertLevels, nCellsSolve, h2, global_temp)
- ge = ke + global_temp
- call computeGlobalSum(dminfo, nVertLevels, nCellsSolve, hb, global_temp)
- ge = ge + global_temp
+ globalPotentialEnstrophy = globalPotentialEnstrophy - globalPotentialEnstrophyReservoir
- eres(1:nCellsSolve) = areaCell(1:nCellsSolve)*h_ref*h_ref*gravity*0.5
- call computeGlobalSum(dminfo, nVertLevels, nCellsSolve, eres, global_temp)
- ger = global_temp
- eres(1:nCellsSolve) = areaCell(1:nCellsSolve)*h_ref*h_s(1:nCellsSolve)*gravity
- call computeGlobalSum(dminfo, nVertLevels, nCellsSolve, eres, global_temp)
- ger = ger + global_temp
- ge = ge - ger
+ ! Compute Kinetic and Potential Energy terms to be combined into total energy
+ call computeGlobalSum(dminfo, nVertLevels, nEdgesSolve, volumeWeightedKineticEnergy, globalKineticEnergy)
+ call computeGlobalSum(dminfo, nVertLevels, nCellsSolve, volumeWeightedPotentialEnergy, globalPotentialEnergy)
+ call computeGlobalSum(dminfo, nVertLevels, nCellsSolve, volumeWeightedPotentialEnergyTopography, global_temp)
- ! Global Integral of spurious Coriolis energy for Time to KE doubling
- call computeGlobalSum(dminfo, nVertLevels, nEdgesSolve, cor_energy, e_cor)
+ globalKineticEnergy = globalKineticEnergy/sumCellVolume
+ globalPotentialEnergy = (globalPotentialEnergy + global_temp)/sumCellVolume
+ ! Compute Potential energy reservoir to be subtracted from potential energy term
+ volumeWeightedPotentialEnergyReservoir(1:nCellsSolve) = areaCell(1:nCellsSolve)*averageThickness*averageThickness*gravity*0.5
+ call computeGlobalSum(dminfo, nVertLevels, nCellsSolve, volumeWeightedPotentialEnergyReservoir, globalPotentialEnergyReservoir)
+ volumeWeightedPotentialEnergyReservoir(1:nCellsSolve) = areaCell(1:nCellsSolve)*averageThickness*h_s(1:nCellsSolve)*gravity
+ call computeGlobalSum(dminfo, nVertLevels, nCellsSolve, volumeWeightedPotentialEnergyReservoir, global_temp)
+
+ globalPotentialEnergyReservoir = (globalPotentialEnergyReservoir + global_temp)/sumCellVolume
+
+ globalPotentialEnergy = globalPotentialEnergy - globalPotentialEnergyReservoir
+ globalEnergy = globalKineticEnergy + globalPotentialEnergy
+
+ ! Compute Coriolis energy tendency term
+ call computeGlobalSum(dminfo, nVertLevels, nEdgesSolve, keTend_CoriolisForce, globalCoriolisEnergyTendency)
+ globalCoriolisEnergyTendency = globalCoriolisEnergyTendency/sumCellVolume
+
! Step 6
! 6. Write out your global stat to the file
if (dminfo % my_proc_id == IO_NODE) then
fileID = getFreeUnit()
+
if (timeIndex/config_stats_interval == 1) then
open(fileID, file='GlobalIntegrals.txt',STATUS='unknown')
else
- open(fileID, file='GlobalIntegrals.txt',ACCESS='append')
+ open(fileID, file='GlobalIntegrals.txt',POSITION='append')
endif
- write(fileID,'(100es24.16)') gh, gpv, gpe, ge, e_cor, abs(ke/e_cor), ke_sink_val+pe_sink_val,abs(ke/(ke_sink_val+pe_sink_val))
+ write(fileID,'(1i, 100es24.16)') timeIndex, timeIndex*dt, globalFluidThickness, globalPotentialVorticity, globalPotentialEnstrophy, &
+ globalEnergy, globalCoriolisEnergyTendency, globalKineticEnergyTendency+globalPotentialEnergyTendency, &
+ globalKineticEnergy, globalPotentialEnergy
close(fileID)
end if
Modified: branches/atmos_physics/src/core_sw/module_test_cases.F
===================================================================
--- branches/atmos_physics/src/core_sw/module_test_cases.F 2010-10-13 18:01:28 UTC (rev 548)
+++ branches/atmos_physics/src/core_sw/module_test_cases.F 2010-10-13 20:25:17 UTC (rev 549)
@@ -33,9 +33,9 @@
block_ptr => domain % blocklist
do while (associated(block_ptr))
- call sw_test_case_1(block_ptr % mesh, block_ptr % time_levs(1) % state)
+ call sw_test_case_1(block_ptr % mesh, block_ptr % state % time_levs(1) % state)
do i=2,nTimeLevs
- call copy_state(block_ptr % time_levs(1) % state, block_ptr % time_levs(i) % state)
+ call copy_state(block_ptr % state % time_levs(i) % state, block_ptr % state % time_levs(1) % state)
end do
block_ptr => block_ptr % next
@@ -47,9 +47,9 @@
block_ptr => domain % blocklist
do while (associated(block_ptr))
- call sw_test_case_2(block_ptr % mesh, block_ptr % time_levs(1) % state)
+ call sw_test_case_2(block_ptr % mesh, block_ptr % state % time_levs(1) % state)
do i=2,nTimeLevs
- call copy_state(block_ptr % time_levs(1) % state, block_ptr % time_levs(i) % state)
+ call copy_state(block_ptr % state % time_levs(i) % state, block_ptr % state % time_levs(1) % state)
end do
block_ptr => block_ptr % next
@@ -61,9 +61,9 @@
block_ptr => domain % blocklist
do while (associated(block_ptr))
- call sw_test_case_5(block_ptr % mesh, block_ptr % time_levs(1) % state)
+ call sw_test_case_5(block_ptr % mesh, block_ptr % state % time_levs(1) % state)
do i=2,nTimeLevs
- call copy_state(block_ptr % time_levs(1) % state, block_ptr % time_levs(i) % state)
+ call copy_state(block_ptr % state % time_levs(i) % state, block_ptr % state % time_levs(1) % state)
end do
block_ptr => block_ptr % next
@@ -75,9 +75,9 @@
block_ptr => domain % blocklist
do while (associated(block_ptr))
- call sw_test_case_6(block_ptr % mesh, block_ptr % time_levs(1) % state)
+ call sw_test_case_6(block_ptr % mesh, block_ptr % state % time_levs(1) % state)
do i=2,nTimeLevs
- call copy_state(block_ptr % time_levs(1) % state, block_ptr % time_levs(i) % state)
+ call copy_state(block_ptr % state % time_levs(i) % state, block_ptr % state % time_levs(1) % state)
end do
block_ptr => block_ptr % next
@@ -102,8 +102,8 @@
implicit none
- type (grid_meta), intent(inout) :: grid
- type (grid_state), intent(inout) :: state
+ type (mesh_type), intent(inout) :: grid
+ type (state_type), intent(inout) :: state
real (kind=RKIND), parameter :: u0 = 2.0 * pii * a / (12.0 * 86400.0)
real (kind=RKIND), parameter :: h0 = 1000.0
@@ -148,9 +148,6 @@
psiVertex(grid%verticesOnEdge%array(2,iEdge)) - &
psiVertex(grid%verticesOnEdge%array(1,iEdge)) &
) / grid%dvEdge%array(iEdge)
-#ifdef EXPAND_LEVELS
- state % u % array(2:EXPAND_LEVELS, iEdge) = state % u % array(1,iEdge)
-#endif
end do
deallocate(psiVertex)
@@ -164,9 +161,6 @@
else
state % h % array(1,iCell) = 0.0
end if
-#ifdef EXPAND_LEVELS
- state % h % array(2:EXPAND_LEVELS, iCell) = state % h % array(1,iCell)
-#endif
end do
end subroutine sw_test_case_1
@@ -184,8 +178,8 @@
implicit none
- type (grid_meta), intent(inout) :: grid
- type (grid_state), intent(inout) :: state
+ type (mesh_type), intent(inout) :: grid
+ type (state_type), intent(inout) :: state
real (kind=RKIND), parameter :: u0 = 2.0 * pii * a / (12.0 * 86400.0)
real (kind=RKIND), parameter :: gh0 = 29400.0
@@ -230,9 +224,6 @@
psiVertex(grid%verticesOnEdge%array(2,iEdge)) - &
psiVertex(grid%verticesOnEdge%array(1,iEdge)) &
) / grid%dvEdge%array(iEdge)
-#ifdef EXPAND_LEVELS
- state % u % array(2:EXPAND_LEVELS, iEdge) = state % u % array(1,iEdge)
-#endif
end do
deallocate(psiVertex)
@@ -262,9 +253,6 @@
)**2.0 &
) / &
gravity
-#ifdef EXPAND_LEVELS
- state % h % array(2:EXPAND_LEVELS, iCell) = state % h % array(1,iCell)
-#endif
end do
end subroutine sw_test_case_2
@@ -281,8 +269,8 @@
implicit none
- type (grid_meta), intent(inout) :: grid
- type (grid_state), intent(inout) :: state
+ type (mesh_type), intent(inout) :: grid
+ type (state_type), intent(inout) :: state
real (kind=RKIND), parameter :: u0 = 20.
real (kind=RKIND), parameter :: gh0 = 5960.0*gravity
@@ -330,9 +318,6 @@
psiVertex(grid%verticesOnEdge%array(2,iEdge)) - &
psiVertex(grid%verticesOnEdge%array(1,iEdge)) &
) / grid%dvEdge%array(iEdge)
-#ifdef EXPAND_LEVELS
- state % u % array(2:EXPAND_LEVELS, iEdge) = state % u % array(1,iEdge)
-#endif
end do
deallocate(psiVertex)
@@ -389,9 +374,6 @@
) / &
gravity
state % h % array(1,iCell) = state % h % array(1,iCell) - grid % h_s % array(iCell)
-#ifdef EXPAND_LEVELS
- state % h % array(2:EXPAND_LEVELS, iCell) = state % h % array(1,iCell)
-#endif
end do
end subroutine sw_test_case_5
@@ -408,8 +390,8 @@
implicit none
- type (grid_meta), intent(inout) :: grid
- type (grid_state), intent(inout) :: state
+ type (mesh_type), intent(inout) :: grid
+ type (state_type), intent(inout) :: state
real (kind=RKIND), parameter :: h0 = 8000.0
real (kind=RKIND), parameter :: w = 7.848e-6
@@ -453,9 +435,6 @@
psiVertex(grid%verticesOnEdge%array(2,iEdge)) - &
psiVertex(grid%verticesOnEdge%array(1,iEdge)) &
) / grid%dvEdge%array(iEdge)
-#ifdef EXPAND_LEVELS
- state % u % array(2:EXPAND_LEVELS, iEdge) = state % u % array(1,iEdge)
-#endif
end do
deallocate(psiVertex)
@@ -467,9 +446,6 @@
a*a*BB(grid%latCell%array(iCell)) * cos(R*grid%lonCell%array(iCell)) + &
a*a*CC(grid%latCell%array(iCell)) * cos(2.0*R*grid%lonCell%array(iCell)) &
) / gravity
-#ifdef EXPAND_LEVELS
- state % h % array(2:EXPAND_LEVELS, iCell) = state % h % array(1,iCell)
-#endif
end do
end subroutine sw_test_case_6
Modified: branches/atmos_physics/src/core_sw/module_time_integration.F
===================================================================
--- branches/atmos_physics/src/core_sw/module_time_integration.F 2010-10-13 18:01:28 UTC (rev 548)
+++ branches/atmos_physics/src/core_sw/module_time_integration.F 2010-10-13 20:25:17 UTC (rev 549)
@@ -37,7 +37,7 @@
block => domain % blocklist
do while (associated(block))
- block % time_levs(2) % state % xtime % scalar = block % time_levs(1) % state % xtime % scalar + dt
+ block % state % time_levs(2) % state % xtime % scalar = block % state % time_levs(1) % state % xtime % scalar + dt
block => block % next
end do
@@ -62,13 +62,17 @@
integer :: iCell, k
type (block_type), pointer :: block
+ type (state_type) :: provis
- integer, parameter :: PROVIS = 1
- integer, parameter :: TEND = 2
integer :: rk_step
real (kind=RKIND), dimension(4) :: rk_weights, rk_substep_weights
+ block => domain % blocklist
+ call allocate_state(provis, &
+ block % mesh % nCells, block % mesh % nEdges, block % mesh % maxEdges, block % mesh % maxEdges2, &
+ block % mesh % nVertices, block % mesh % vertexDegree, block % mesh % nVertLevels, &
+ block % mesh % nTracers)
!
! Initialize time_levs(2) with state at current time
@@ -79,16 +83,16 @@
block => domain % blocklist
do while (associated(block))
- block % time_levs(2) % state % u % array(:,:) = block % time_levs(1) % state % u % array(:,:)
- block % time_levs(2) % state % h % array(:,:) = block % time_levs(1) % state % h % array(:,:)
+ block % state % time_levs(2) % state % u % array(:,:) = block % state % time_levs(1) % state % u % array(:,:)
+ block % state % time_levs(2) % state % h % array(:,:) = block % state % time_levs(1) % state % h % array(:,:)
do iCell=1,block % mesh % nCells ! couple tracers to h
do k=1,block % mesh % nVertLevels
- block % time_levs(2) % state % tracers % array(:,k,iCell) = block % time_levs(1) % state % tracers % array(:,k,iCell) &
- * block % time_levs(1) % state % h % array(k,iCell)
+ block % state % time_levs(2) % state % tracers % array(:,k,iCell) = block % state % time_levs(1) % state % tracers % array(:,k,iCell) &
+ * block % state % time_levs(1) % state % h % array(k,iCell)
end do
end do
- call copy_state(block % time_levs(1) % state, block % intermediate_step(PROVIS))
+ call copy_state(provis, block % state % time_levs(1) % state)
block => block % next
end do
@@ -113,7 +117,7 @@
block => domain % blocklist
do while (associated(block))
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % intermediate_step(PROVIS) % pv_edge % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, provis % pv_edge % array(:,:), &
block % mesh % nVertLevels, block % mesh % nEdges, &
block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
block => block % next
@@ -123,9 +127,9 @@
block => domain % blocklist
do while (associated(block))
- call compute_tend(block % intermediate_step(TEND), block % intermediate_step(PROVIS), block % mesh)
- call compute_scalar_tend(block % intermediate_step(TEND), block % intermediate_step(PROVIS), block % mesh)
- call enforce_boundaryEdge(block % intermediate_step(TEND), block % mesh)
+ call compute_tend(block % tend, provis, block % mesh)
+ call compute_scalar_tend(block % tend, provis, block % mesh)
+ call enforce_boundaryEdge(block % tend, block % mesh)
block => block % next
end do
@@ -133,13 +137,13 @@
block => domain % blocklist
do while (associated(block))
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % intermediate_step(TEND) % u % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % tend % u % array(:,:), &
block % mesh % nVertLevels, block % mesh % nEdges, &
block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % intermediate_step(TEND) % h % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % tend % h % array(:,:), &
block % mesh % nVertLevels, block % mesh % nCells, &
block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
- call dmpar_exch_halo_field3dReal(domain % dminfo, block % intermediate_step(TEND) % tracers % array(:,:,:), &
+ call dmpar_exch_halo_field3dReal(domain % dminfo, block % tend % tracers % array(:,:,:), &
block % mesh % nTracers, block % mesh % nVertLevels, block % mesh % nCells, &
block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
block => block % next
@@ -150,23 +154,23 @@
if (rk_step < 4) then
block => domain % blocklist
do while (associated(block))
- block % intermediate_step(PROVIS) % u % array(:,:) = block % time_levs(1) % state % u % array(:,:) &
- + rk_substep_weights(rk_step) * block % intermediate_step(TEND) % u % array(:,:)
- block % intermediate_step(PROVIS) % h % array(:,:) = block % time_levs(1) % state % h % array(:,:) &
- + rk_substep_weights(rk_step) * block % intermediate_step(TEND) % h % array(:,:)
+ provis % u % array(:,:) = block % state % time_levs(1) % state % u % array(:,:) &
+ + rk_substep_weights(rk_step) * block % tend % u % array(:,:)
+ provis % h % array(:,:) = block % state % time_levs(1) % state % h % array(:,:) &
+ + rk_substep_weights(rk_step) * block % tend % h % array(:,:)
do iCell=1,block % mesh % nCells
do k=1,block % mesh % nVertLevels
- block % intermediate_step(PROVIS) % tracers % array(:,k,iCell) = ( &
- block % time_levs(1) % state % h % array(k,iCell) * &
- block % time_levs(1) % state % tracers % array(:,k,iCell) &
- + rk_substep_weights(rk_step) * block % intermediate_step(TEND) % tracers % array(:,k,iCell) &
- ) / block % intermediate_step(PROVIS) % h % array(k,iCell)
+ provis % tracers % array(:,k,iCell) = ( &
+ block % state % time_levs(1) % state % h % array(k,iCell) * &
+ block % state % time_levs(1) % state % tracers % array(:,k,iCell) &
+ + rk_substep_weights(rk_step) * block % tend % tracers % array(:,k,iCell) &
+ ) / provis % h % array(k,iCell)
end do
end do
if (config_test_case == 1) then ! For case 1, wind field should be fixed
- block % intermediate_step(PROVIS) % u % array(:,:) = block % time_levs(1) % state % u % array(:,:)
+ provis % u % array(:,:) = block % state % time_levs(1) % state % u % array(:,:)
end if
- call compute_solve_diagnostics(dt, block % intermediate_step(PROVIS), block % mesh)
+ call compute_solve_diagnostics(dt, provis, block % mesh)
block => block % next
end do
end if
@@ -175,15 +179,15 @@
block => domain % blocklist
do while (associated(block))
- block % time_levs(2) % state % u % array(:,:) = block % time_levs(2) % state % u % array(:,:) &
- + rk_weights(rk_step) * block % intermediate_step(TEND) % u % array(:,:)
- block % time_levs(2) % state % h % array(:,:) = block % time_levs(2) % state % h % array(:,:) &
- + rk_weights(rk_step) * block % intermediate_step(TEND) % h % array(:,:)
+ block % state % time_levs(2) % state % u % array(:,:) = block % state % time_levs(2) % state % u % array(:,:) &
+ + rk_weights(rk_step) * block % tend % u % array(:,:)
+ block % state % time_levs(2) % state % h % array(:,:) = block % state % time_levs(2) % state % h % array(:,:) &
+ + rk_weights(rk_step) * block % tend % h % array(:,:)
do iCell=1,block % mesh % nCells
do k=1,block % mesh % nVertLevels
- block % time_levs(2) % state % tracers % array(:,k,iCell) = &
- block % time_levs(2) % state % tracers % array(:,k,iCell) &
- + rk_weights(rk_step) * block % intermediate_step(TEND) % tracers % array(:,k,iCell)
+ block % state % time_levs(2) % state % tracers % array(:,k,iCell) = &
+ block % state % time_levs(2) % state % tracers % array(:,k,iCell) &
+ + rk_weights(rk_step) * block % tend % tracers % array(:,k,iCell)
end do
end do
block => block % next
@@ -202,23 +206,25 @@
do while (associated(block))
do iCell=1,block % mesh % nCells
do k=1,block % mesh % nVertLevels
- block % time_levs(2) % state % tracers % array(:,k,iCell) = &
- block % time_levs(2) % state % tracers % array(:,k,iCell) &
- / block % time_levs(2) % state % h % array(k,iCell)
+ block % state % time_levs(2) % state % tracers % array(:,k,iCell) = &
+ block % state % time_levs(2) % state % tracers % array(:,k,iCell) &
+ / block % state % time_levs(2) % state % h % array(k,iCell)
end do
end do
if (config_test_case == 1) then ! For case 1, wind field should be fixed
- block % time_levs(2) % state % u % array(:,:) = block % time_levs(1) % state % u % array(:,:)
+ block % state % time_levs(2) % state % u % array(:,:) = block % state % time_levs(1) % state % u % array(:,:)
end if
- call compute_solve_diagnostics(dt, block % time_levs(2) % state, block % mesh)
+ call compute_solve_diagnostics(dt, block % state % time_levs(2) % state, block % mesh)
- call reconstruct(block % time_levs(2) % state, block % mesh)
+ call reconstruct(block % state % time_levs(2) % state, block % diag, block % mesh)
block => block % next
end do
+ call deallocate_state(provis)
+
end subroutine rk4
@@ -234,9 +240,9 @@
implicit none
- type (grid_state), intent(inout) :: tend
- type (grid_state), intent(in) :: s
- type (grid_meta), intent(in) :: grid
+ type (tend_type), intent(inout) :: tend
+ type (state_type), intent(in) :: s
+ type (mesh_type), intent(in) :: grid
integer :: iEdge, iCell, iVertex, k, cell1, cell2, vertex1, vertex2, eoe, i, j
real (kind=RKIND) :: flux, vorticity_abs, workpv, q, upstream_bias
@@ -394,9 +400,9 @@
implicit none
- type (grid_state), intent(inout) :: tend
- type (grid_state), intent(in) :: s
- type (grid_meta), intent(in) :: grid
+ type (tend_type), intent(inout) :: tend
+ type (state_type), intent(in) :: s
+ type (mesh_type), intent(in) :: grid
integer :: iCell, iEdge, k, iTracer, cell1, cell2
real (kind=RKIND) :: flux, tracer_edge
@@ -440,8 +446,8 @@
implicit none
real (kind=RKIND), intent(in) :: dt
- type (grid_state), intent(inout) :: s
- type (grid_meta), intent(in) :: grid
+ type (state_type), intent(inout) :: s
+ type (mesh_type), intent(in) :: grid
integer :: iEdge, iCell, iVertex, k, cell1, cell2, vertex1, vertex2, eoe, i, j, cov
@@ -753,8 +759,8 @@
implicit none
- type (grid_state), intent(inout) :: tend
- type (grid_meta), intent(in) :: grid
+ type (tend_type), intent(inout) :: tend
+ type (mesh_type), intent(in) :: grid
integer, dimension(:,:), pointer :: boundaryEdge
real (kind=RKIND), dimension(:,:), pointer :: tend_u
Modified: branches/atmos_physics/src/core_sw/mpas_interface.F
===================================================================
--- branches/atmos_physics/src/core_sw/mpas_interface.F 2010-10-13 18:01:28 UTC (rev 548)
+++ branches/atmos_physics/src/core_sw/mpas_interface.F 2010-10-13 20:25:17 UTC (rev 549)
@@ -22,14 +22,14 @@
implicit none
type (block_type), intent(inout) :: block
- type (grid_meta), intent(inout) :: mesh
+ type (mesh_type), intent(inout) :: mesh
real (kind=RKIND), intent(in) :: dt
- call compute_solve_diagnostics(dt, block % time_levs(1) % state, mesh)
+ call compute_solve_diagnostics(dt, block % state % time_levs(1) % state, mesh)
call rbfInterp_initialize(mesh)
call init_reconstruct(mesh)
- call reconstruct(block % time_levs(1) % state, mesh)
+ call reconstruct(block % state % time_levs(1) % state, block % diag, mesh)
end subroutine mpas_init
@@ -64,18 +64,20 @@
call timestep(domain, dt)
- if (mod(itimestep, config_stats_interval) == 0) then
- block_ptr => domain % blocklist
- if(associated(block_ptr % next)) then
- write(0,*) 'Error: computeGlobalDiagnostics assumes ',&
- 'that there is only one block per processor.'
+ if(config_stats_interval .gt. 0) then
+ if(mod(itimestep, config_stats_interval) == 0) then
+ block_ptr => domain % blocklist
+ if(associated(block_ptr % next)) then
+ write(0,*) 'Error: computeGlobalDiagnostics assumes ',&
+ 'that there is only one block per processor.'
+ end if
+
+ call timer_start("global_diagnostics")
+ call computeGlobalDiagnostics(domain % dminfo, &
+ block_ptr % state % time_levs(2) % state, block_ptr % mesh, &
+ itimestep, dt)
+ call timer_stop("global_diagnostics")
end if
-
- call timer_start("global_diagnostics")
- call computeGlobalDiagnostics(domain % dminfo, &
- block_ptr % time_levs(2) % state, block_ptr % mesh, &
- itimestep, dt)
- call timer_stop("global_diagnostics")
end if
end subroutine mpas_timestep
Modified: branches/atmos_physics/src/driver/module_subdriver.F
===================================================================
--- branches/atmos_physics/src/driver/module_subdriver.F 2010-10-13 18:01:28 UTC (rev 548)
+++ branches/atmos_physics/src/driver/module_subdriver.F 2010-10-13 20:25:17 UTC (rev 549)
@@ -13,7 +13,7 @@
subroutine mpas_init(block, mesh, dt)
use grid_types
type (block_type), intent(inout) :: block
- type (grid_meta), intent(inout) :: mesh
+ type (mesh_type), intent(inout) :: mesh
real (kind=RKIND), intent(in) :: dt
end subroutine mpas_init
@@ -59,7 +59,7 @@
block_ptr => domain % blocklist
do while (associated(block_ptr))
call mpas_init(block_ptr, block_ptr % mesh, dt)
- if (.not. config_do_restart) block_ptr % time_levs(1) % state % xtime % scalar = 0.0
+ if (.not. config_do_restart) block_ptr % state % time_levs(1) % state % xtime % scalar = 0.0
block_ptr => block_ptr % next
end do
@@ -79,7 +79,7 @@
call timer_stop("time integration")
! Move time level 2 fields back into time level 1 for next time step
- call shift_time_levels(domain)
+ call shift_time_levels_state(domain % blocklist % state)
if (mod(itimestep, config_output_interval) == 0) then
call write_output_frame(output_obj, domain)
@@ -116,7 +116,7 @@
block_ptr => domain % blocklist
do while (associated(block_ptr))
- call compute_output_diagnostics(block_ptr % time_levs(1) % state, block_ptr % mesh)
+ call compute_output_diagnostics(block_ptr % state % time_levs(1) % state, block_ptr % mesh)
block_ptr => block_ptr % next
end do
@@ -138,8 +138,8 @@
implicit none
- type (grid_state), intent(inout) :: state
- type (grid_meta), intent(in) :: grid
+ type (state_type), intent(inout) :: state
+ type (mesh_type), intent(in) :: grid
integer :: i, eoe
integer :: iEdge, k
Modified: branches/atmos_physics/src/framework/module_grid_types.F
===================================================================
--- branches/atmos_physics/src/framework/module_grid_types.F 2010-10-13 18:01:28 UTC (rev 548)
+++ branches/atmos_physics/src/framework/module_grid_types.F 2010-10-13 20:25:17 UTC (rev 549)
@@ -4,8 +4,7 @@
integer, parameter :: nTimeLevs = 2
-#include "super_array_indices.inc"
-
+
! Derived type describing info for doing I/O specific to a field
type io_info
character (len=1024) :: fieldName
@@ -66,7 +65,7 @@
! Derived type for storing grid meta-data
- type grid_meta
+ type mesh_type
#include "field_dimensions.inc"
@@ -75,21 +74,12 @@
#include "time_invariant_fields.inc"
- end type grid_meta
+ end type mesh_type
- ! Derived type for storing model state
- type grid_state
+#include "variable_groups.inc"
-#include "time_varying_fields.inc"
- end type grid_state
-
- type grid_state_ptr
- type (grid_state), pointer :: state
- end type grid_state_ptr
-
-
! Type for storing (possibly architecture specific) information concerning to parallelism
type parallel_info
type (exchange_list), pointer :: cellsToSend ! List of types describing which cells to send to other blocks
@@ -105,11 +95,8 @@
type block_type
integer :: storageFactor ! Additional storage used by time integration scheme
- type (grid_meta), pointer :: mesh
- type (grid_state_ptr), pointer, dimension(:) :: time_levs
+#include "block_group_members.inc"
- type (grid_state), allocatable, dimension(:) :: intermediate_step
-
type (domain_type), pointer :: domain
type (parallel_info), pointer :: parinfo
@@ -170,60 +157,21 @@
nullify(b % prev)
nullify(b % next)
- allocate(b % time_levs(nTimeLevs))
-
- allocate(b % mesh)
- call allocate_grid_meta(b % mesh, &
-#include "dim_dummy_args.inc"
- )
-
- do i=1,nTimeLevs
- allocate(b % time_levs(i) % state)
- call allocate_grid_state(b % time_levs(i) % state, b)
- end do
-
key = 'STORAGE_FACTOR'
call mpas_query(key, b % storageFactor)
- ! Allocate storage for intermediate steps used by time integration scheme
- allocate(b % intermediate_step(b % storageFactor))
- do i=1,b % storageFactor
- call allocate_grid_state(b % intermediate_step(i), b)
- end do
-
allocate(b % parinfo)
b % domain => dom
+#include "block_allocs.inc"
+
end subroutine allocate_block
- subroutine allocate_grid_meta(g, &
-#include "dim_dummy_args.inc"
- )
+#include "group_alloc_routines.inc"
- implicit none
- type (grid_meta), intent(inout) :: g
-#include "dim_dummy_decls.inc"
-
-#include "grid_meta_allocs.inc"
-
- end subroutine allocate_grid_meta
-
-
- subroutine allocate_grid_state(s, b)
-
- implicit none
-
- type (grid_state), intent(inout) :: s
- type (block_type), pointer :: b
-
-#include "grid_state_allocs.inc"
-
- end subroutine allocate_grid_state
-
-
subroutine deallocate_domain(dom)
implicit none
@@ -251,78 +199,19 @@
integer :: i
- call deallocate_grid_meta(b % mesh)
- deallocate(b % mesh)
- do i=1,nTimeLevs
- call deallocate_grid_state(b % time_levs(i) % state)
- deallocate(b % time_levs(i) % state)
- end do
- deallocate(b % time_levs)
- do i=1,b % storageFactor
- call deallocate_grid_state(b % intermediate_step(i))
- end do
- deallocate(b % intermediate_step)
deallocate(b % parinfo)
+#include "block_deallocs.inc"
+
end subroutine deallocate_block
- subroutine deallocate_grid_meta(g)
+#include "group_dealloc_routines.inc"
- implicit none
- type (grid_meta), intent(inout) :: g
+#include "group_copy_routines.inc"
-#include "grid_meta_deallocs.inc"
- end subroutine deallocate_grid_meta
+#include "group_shift_level_routines.inc"
-
- subroutine deallocate_grid_state(s)
-
- implicit none
-
- type (grid_state), intent(inout) :: s
-
-#include "grid_state_deallocs.inc"
-
- end subroutine deallocate_grid_state
-
-
- subroutine copy_state(src, dest)
-
- implicit none
-
- type (grid_state), intent(in) :: src
- type (grid_state), intent(inout) :: dest
-
-#include "copy_state.inc"
-
- end subroutine copy_state
-
-
- subroutine shift_time_levels(domain)
-
- implicit none
-
- type (domain_type), intent(inout) :: domain
-
- integer :: i
- type (block_type), pointer :: block_ptr
- type (grid_state), pointer :: sptr
-
- block_ptr => domain % blocklist
- do while (associated(block_ptr))
-
- sptr => block_ptr % time_levs(1) % state
- do i=1,nTimeLevs-1
- block_ptr % time_levs(i) % state => block_ptr % time_levs(i+1) % state
- end do
- block_ptr % time_levs(nTimeLevs) % state => sptr
-
- block_ptr => block_ptr % next
- end do
-
- end subroutine shift_time_levels
-
end module grid_types
Modified: branches/atmos_physics/src/framework/module_io_input.F
===================================================================
--- branches/atmos_physics/src/framework/module_io_input.F 2010-10-13 18:01:28 UTC (rev 548)
+++ branches/atmos_physics/src/framework/module_io_input.F 2010-10-13 20:25:17 UTC (rev 549)
@@ -1094,13 +1094,6 @@
#include "netcdf_read_ids.inc"
-#ifdef EXPAND_LEVELS
- if (.not. config_do_restart) then
- input_obj % rdLocalnVertLevels = EXPAND_LEVELS
- write(0,*) 'Expanding nVertLevels to ',input_obj % rdLocalnVertLevels,' by duplicating the first level.'
- end if
-#endif
-
end subroutine io_input_init
Modified: branches/atmos_physics/src/framework/module_io_output.F
===================================================================
--- branches/atmos_physics/src/framework/module_io_output.F 2010-10-13 18:01:28 UTC (rev 548)
+++ branches/atmos_physics/src/framework/module_io_output.F 2010-10-13 20:25:17 UTC (rev 549)
@@ -338,7 +338,7 @@
type (io_output_object), intent(inout) :: output_obj
type (dm_info), intent(in) :: dminfo
- type (grid_meta), intent(in) :: mesh
+ type (mesh_type), intent(in) :: mesh
#include "dim_dummy_decls.inc"
integer :: nferr
Modified: branches/atmos_physics/src/operators/module_RBF_interpolation.F
===================================================================
--- branches/atmos_physics/src/operators/module_RBF_interpolation.F 2010-10-13 18:01:28 UTC (rev 548)
+++ branches/atmos_physics/src/operators/module_RBF_interpolation.F 2010-10-13 20:25:17 UTC (rev 549)
@@ -112,7 +112,7 @@
implicit none
- type (grid_meta), intent(inout) :: grid
+ type (mesh_type), intent(inout) :: grid
integer :: nCells, nEdges
integer, dimension(:,:), pointer :: cellsOnEdge, edgesOnCell
Modified: branches/atmos_physics/src/operators/module_vector_reconstruction.F
===================================================================
--- branches/atmos_physics/src/operators/module_vector_reconstruction.F 2010-10-13 18:01:28 UTC (rev 548)
+++ branches/atmos_physics/src/operators/module_vector_reconstruction.F 2010-10-13 20:25:17 UTC (rev 549)
@@ -23,7 +23,7 @@
implicit none
- type (grid_meta), intent(inout) :: grid
+ type (mesh_type), intent(inout) :: grid
! temporary arrays needed in the (to be constructed) init procedure
integer :: nCellsSolve
@@ -112,7 +112,7 @@
end subroutine init_reconstruct
- subroutine reconstruct(state, grid)
+ subroutine reconstruct(state, diag, grid)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Purpose: reconstruct vector field at cell centers based on radial basis functions
!
@@ -123,8 +123,9 @@
implicit none
- type (grid_state), intent(inout) :: state
- type (grid_meta), intent(in) :: grid
+ type (state_type), intent(in) :: state
+ type (diag_type), intent(inout) :: diag
+ type (mesh_type), intent(in) :: grid
! temporary arrays needed in the compute procedure
integer :: nCellsSolve
@@ -151,14 +152,14 @@
nEdgesOnCell=> grid % nEdgesOnCell % array
nCellsSolve = grid % nCellsSolve
u => state % u % array
- uReconstructX => state % uReconstructX % array
- uReconstructY => state % uReconstructY % array
- uReconstructZ => state % uReconstructZ % array
+ uReconstructX => diag % uReconstructX % array
+ uReconstructY => diag % uReconstructY % array
+ uReconstructZ => diag % uReconstructZ % array
latCell => grid % latCell % array
lonCell => grid % lonCell % array
- uReconstructZonal => state % uReconstructZonal % array
- uReconstructMeridional => state % uReconstructMeridional % array
+ uReconstructZonal => diag % uReconstructZonal % array
+ uReconstructMeridional => diag % uReconstructMeridional % array
on_a_sphere = grid % on_a_sphere
! init the intent(out)
Modified: branches/atmos_physics/src/registry/gen_inc.c
===================================================================
--- branches/atmos_physics/src/registry/gen_inc.c 2010-10-13 18:01:28 UTC (rev 548)
+++ branches/atmos_physics/src/registry/gen_inc.c 2010-10-13 20:25:17 UTC (rev 549)
@@ -150,12 +150,15 @@
}
-void gen_field_defs(struct variable * vars, struct dimension * dims)
+void gen_field_defs(struct group_list * groups, struct variable * vars, struct dimension * dims)
{
struct variable * var_ptr;
struct variable * var_ptr2;
+ struct variable_list * var_list_ptr;
+ struct variable_list * var_list_ptr2;
struct dimension * dim_ptr;
struct dimension_list * dimlist_ptr;
+ struct group_list * group_ptr;
FILE * fd;
char super_array[1024];
char array_class[1024];
@@ -163,59 +166,7 @@
int class_start, class_end;
int vtype;
- /*
- * Generate indices for super arrays
- */
- fd = fopen("super_array_indices.inc", "w");
- var_ptr = vars;
- memcpy(super_array, var_ptr->super_array, 1024);
- i = 1;
- while (var_ptr) {
- if (strncmp(super_array, var_ptr->super_array, 1024) != 0) {
- memcpy(super_array, var_ptr->super_array, 1024);
- i = 1;
- }
- if (strncmp(var_ptr->array_class, "-", 1024) != 0) fortprintf(fd, " integer :: index_%s = %i</font>
<font color="red">", var_ptr->name_in_code, i++);
- var_ptr = var_ptr->next;
- }
- var_ptr = vars;
- memcpy(super_array, var_ptr->super_array, 1024);
- memcpy(array_class, var_ptr->array_class, 1024);
- class_start = 1;
- class_end = 1;
- i = 1;
- while (var_ptr) {
- if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
- if (strncmp(super_array, var_ptr->super_array, 1024) != 0) {
- if (strncmp(super_array, "-", 1024) != 0) fortprintf(fd, " integer :: %s_end = %i</font>
<font color="red">", array_class, class_end);
- if (strncmp(super_array, "-", 1024) != 0) fortprintf(fd, " integer :: num_%s = %i</font>
<font color="red">", super_array, i);
- class_start = 1;
- class_end = 1;
- i = 1;
- memcpy(super_array, var_ptr->super_array, 1024);
- memcpy(array_class, var_ptr->array_class, 1024);
- fortprintf(fd, " integer :: %s_start = %i</font>
<font color="red">", array_class, class_start);
- }
- else if (strncmp(array_class, var_ptr->array_class, 1024) != 0) {
- fortprintf(fd, " integer :: %s_end = %i</font>
<font color="red">", array_class, class_end);
- class_start = class_end+1;
- class_end = class_start;
- memcpy(array_class, var_ptr->array_class, 1024);
- fortprintf(fd, " integer :: %s_start = %i</font>
<font color="red">", array_class, class_start);
- i++;
- }
- else {
- class_end++;
- i++;
- }
- }
- var_ptr = var_ptr->next;
- }
- if (strncmp(super_array, "-", 1024) != 0) fortprintf(fd, " integer :: %s_end = %i</font>
<font color="red">", array_class, class_end);
- if (strncmp(super_array, "-", 1024) != 0) fortprintf(fd, " integer :: num_%s = %i</font>
<font color="gray">", super_array, i);
- fclose(fd);
-
/*
* Generate declarations of dimensions
*/
@@ -311,101 +262,295 @@
/*
- * Generate declarations of time-invariant fields
+ * Generate declarations of mesh group
*/
fd = fopen("time_invariant_fields.inc", "w");
- var_ptr = vars;
- while (var_ptr) {
- if (var_ptr->timedim == 0) {
- if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
- memcpy(super_array, var_ptr->super_array, 1024);
- memcpy(array_class, var_ptr->array_class, 1024);
- vtype = var_ptr->vtype;
- while (var_ptr && strncmp(super_array, var_ptr->super_array, 1024) == 0) {
- var_ptr2 = var_ptr;
- var_ptr = var_ptr->next;
+ group_ptr = groups;
+ while (group_ptr) {
+
+ if (!strncmp(group_ptr->name, "mesh", 1024)) {
+
+ var_list_ptr = group_ptr->vlist;
+ memcpy(super_array, var_list_ptr->var->super_array, 1024);
+ i = 1;
+ while (var_list_ptr) {
+ if (strncmp(super_array, var_list_ptr->var->super_array, 1024) != 0) {
+ memcpy(super_array, var_list_ptr->var->super_array, 1024);
+ i = 1;
+ }
+ if (strncmp(var_list_ptr->var->array_class, "-", 1024) != 0) fortprintf(fd, " integer :: index_%s = %i</font>
<font color="blue">", var_list_ptr->var->name_in_code, i++);
+ var_list_ptr = var_list_ptr->next;
+ }
+
+ var_list_ptr = group_ptr->vlist;
+ memcpy(super_array, var_list_ptr->var->super_array, 1024);
+ memcpy(array_class, var_list_ptr->var->array_class, 1024);
+ class_start = 1;
+ class_end = 1;
+ i = 1;
+ while (var_list_ptr) {
+ if (strncmp(var_list_ptr->var->super_array, "-", 1024) != 0) {
+ if (strncmp(super_array, var_list_ptr->var->super_array, 1024) != 0) {
+ if (strncmp(super_array, "-", 1024) != 0) fortprintf(fd, " integer :: %s_end = %i</font>
<font color="blue">", array_class, class_end);
+ if (strncmp(super_array, "-", 1024) != 0) fortprintf(fd, " integer :: num_%s = %i</font>
<font color="blue">", super_array, i);
+ class_start = 1;
+ class_end = 1;
+ i = 1;
+ memcpy(super_array, var_list_ptr->var->super_array, 1024);
+ memcpy(array_class, var_list_ptr->var->array_class, 1024);
+ fortprintf(fd, " integer :: %s_start = %i</font>
<font color="blue">", array_class, class_start);
+ }
+ else if (strncmp(array_class, var_list_ptr->var->array_class, 1024) != 0) {
+ fortprintf(fd, " integer :: %s_end = %i</font>
<font color="blue">", array_class, class_end);
+ class_start = class_end+1;
+ class_end = class_start;
+ memcpy(array_class, var_list_ptr->var->array_class, 1024);
+ fortprintf(fd, " integer :: %s_start = %i</font>
<font color="red">", array_class, class_start);
+ i++;
+ }
+ else {
+ class_end++;
+ i++;
+ }
}
- if (vtype == INTEGER) fortprintf(fd, " type (field%idInteger), pointer :: %s</font>
<font color="red">", (var_ptr2->ndims)+1, var_ptr2->super_array);
- if (vtype == REAL) fortprintf(fd, " type (field%idReal), pointer :: %s</font>
<font color="red">", (var_ptr2->ndims)+1, var_ptr2->super_array);
+ var_list_ptr = var_list_ptr->next;
}
- else {
- if (var_ptr->vtype == INTEGER) fortprintf(fd, " type (field%idInteger), pointer :: %s</font>
<font color="red">", var_ptr->ndims, var_ptr->name_in_code);
- if (var_ptr->vtype == REAL) fortprintf(fd, " type (field%idReal), pointer :: %s</font>
<font color="red">", var_ptr->ndims, var_ptr->name_in_code);
- var_ptr = var_ptr->next;
+ if (strncmp(super_array, "-", 1024) != 0) fortprintf(fd, " integer :: %s_end = %i</font>
<font color="blue">", array_class, class_end);
+ if (strncmp(super_array, "-", 1024) != 0) fortprintf(fd, " integer :: num_%s = %i</font>
<font color="blue">", super_array, i);
+
+ var_list_ptr = group_ptr->vlist;
+ while (var_list_ptr) {
+ var_ptr = var_list_ptr->var;
+ if (!strncmp(var_ptr->super_array, "-", 1024)) {
+ if (var_ptr->vtype == INTEGER) fortprintf(fd, " type (field%idInteger), pointer :: %s</font>
<font color="blue">", var_ptr->ndims, var_ptr->name_in_code);
+ if (var_ptr->vtype == REAL) fortprintf(fd, " type (field%idReal), pointer :: %s</font>
<font color="blue">", var_ptr->ndims, var_ptr->name_in_code);
+ }
+ else {
+ if (var_ptr->vtype == INTEGER) fortprintf(fd, " type (field%idInteger), pointer :: %s</font>
<font color="blue">", var_ptr->ndims+1, var_ptr->super_array);
+ if (var_ptr->vtype == REAL) fortprintf(fd, " type (field%idReal), pointer :: %s</font>
<font color="red">", var_ptr->ndims+1, var_ptr->super_array);
+ while (var_list_ptr->next && !strncmp(var_list_ptr->next->var->super_array, var_list_ptr->var->super_array, 1024)) var_list_ptr = var_list_ptr->next;
+ }
+ var_list_ptr = var_list_ptr->next;
}
+ break;
}
- else
- var_ptr = var_ptr->next;
+ group_ptr = group_ptr->next;
}
fclose(fd);
/*
- * Generate declarations of time-invariant fields
+ * Generate declarations of non-mesh groups
*/
- fd = fopen("time_varying_fields.inc", "w");
- var_ptr = vars;
- while (var_ptr) {
- if (var_ptr->timedim == 1) {
- if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
- memcpy(super_array, var_ptr->super_array, 1024);
- memcpy(array_class, var_ptr->array_class, 1024);
- vtype = var_ptr->vtype;
- while (var_ptr && strncmp(super_array, var_ptr->super_array, 1024) == 0) {
- var_ptr2 = var_ptr;
- var_ptr = var_ptr->next;
+ fd = fopen("variable_groups.inc", "w");
+
+ group_ptr = groups;
+ while (group_ptr) {
+ if (strncmp(group_ptr->name, "mesh", 1024)) {
+ fortprintf(fd, " type %s_type</font>
<font color="blue">", group_ptr->name);
+
+ var_list_ptr = group_ptr->vlist;
+ memcpy(super_array, var_list_ptr->var->super_array, 1024);
+ i = 1;
+ while (var_list_ptr) {
+ if (strncmp(super_array, var_list_ptr->var->super_array, 1024) != 0) {
+ memcpy(super_array, var_list_ptr->var->super_array, 1024);
+ i = 1;
+ }
+ if (strncmp(var_list_ptr->var->array_class, "-", 1024) != 0) fortprintf(fd, " integer :: index_%s = %i</font>
<font color="blue">", var_list_ptr->var->name_in_code, i++);
+ var_list_ptr = var_list_ptr->next;
+ }
+
+ var_list_ptr = group_ptr->vlist;
+ sprintf(super_array, "-");
+ sprintf(array_class, "-");
+ class_start = 1;
+ class_end = 1;
+ i = 1;
+
+ while (var_list_ptr) {
+
+ /* Is the current variable in a super array? */
+ if (strncmp(var_list_ptr->var->super_array, "-", 1024) != 0) {
+
+ /* Have we hit the beginning of a new super array? */
+ if (strncmp(super_array, var_list_ptr->var->super_array, 1024) != 0) {
+ /* Finish off the previous super array? */
+ if (strncmp(super_array, "-", 1024) != 0) {
+ fortprintf(fd, " integer :: %s_end = %i</font>
<font color="blue">", array_class, class_end);
+ fortprintf(fd, " integer :: num_%s = %i</font>
<font color="blue">", super_array, i);
+ }
+ class_start = 1;
+ class_end = 1;
+ i = 1;
+ memcpy(super_array, var_list_ptr->var->super_array, 1024);
+ memcpy(array_class, var_list_ptr->var->array_class, 1024);
+ fortprintf(fd, " integer :: %s_start = %i</font>
<font color="blue">", array_class, class_start);
+ }
+ /* Or have we hit the beginning of a new array class? */
+ else if (strncmp(array_class, var_list_ptr->var->array_class, 1024) != 0) {
+ fortprintf(fd, " integer :: %s_end = %i</font>
<font color="blue">", array_class, class_end);
+ class_start = class_end+1;
+ class_end = class_start;
+ memcpy(array_class, var_list_ptr->var->array_class, 1024);
+ fortprintf(fd, " integer :: %s_start = %i</font>
<font color="red">", array_class, class_start);
+ i++;
+ }
+ else {
+ class_end++;
+ i++;
+ }
+
}
- if (vtype == INTEGER) fortprintf(fd, " type (field%idInteger), pointer :: %s</font>
<font color="red">", (var_ptr2->ndims)+1, var_ptr2->super_array);
- if (vtype == REAL) fortprintf(fd, " type (field%idReal), pointer :: %s</font>
<font color="red">", (var_ptr2->ndims)+1, var_ptr2->super_array);
+ var_list_ptr = var_list_ptr->next;
+
}
- else {
- if (var_ptr->vtype == INTEGER) fortprintf(fd, " type (field%idInteger), pointer :: %s</font>
<font color="red">", var_ptr->ndims, var_ptr->name_in_code);
- if (var_ptr->vtype == REAL) fortprintf(fd, " type (field%idReal), pointer :: %s</font>
<font color="red">", var_ptr->ndims, var_ptr->name_in_code);
- var_ptr = var_ptr->next;
+ if (strncmp(super_array, "-", 1024) != 0) fortprintf(fd, " integer :: %s_end = %i</font>
<font color="blue">", array_class, class_end);
+ if (strncmp(super_array, "-", 1024) != 0) fortprintf(fd, " integer :: num_%s = %i</font>
<font color="blue">", super_array, i);
+
+ var_list_ptr = group_ptr->vlist;
+ while (var_list_ptr) {
+ var_ptr = var_list_ptr->var;
+ if (!strncmp(var_ptr->super_array, "-", 1024)) {
+ if (var_ptr->vtype == INTEGER) fortprintf(fd, " type (field%idInteger), pointer :: %s</font>
<font color="blue">", var_ptr->ndims, var_ptr->name_in_code);
+ if (var_ptr->vtype == REAL) fortprintf(fd, " type (field%idReal), pointer :: %s</font>
<font color="blue">", var_ptr->ndims, var_ptr->name_in_code);
+ }
+ else {
+ if (var_ptr->vtype == INTEGER) fortprintf(fd, " type (field%idInteger), pointer :: %s</font>
<font color="blue">", var_ptr->ndims+1, var_ptr->super_array);
+ if (var_ptr->vtype == REAL) fortprintf(fd, " type (field%idReal), pointer :: %s</font>
<font color="blue">", var_ptr->ndims+1, var_ptr->super_array);
+ while (var_list_ptr->next && !strncmp(var_list_ptr->next->var->super_array, var_list_ptr->var->super_array, 1024)) var_list_ptr = var_list_ptr->next;
+ }
+ var_list_ptr = var_list_ptr->next;
}
+
+ fortprintf(fd, " end type %s_type</font>
<font color="black"></font>
<font color="black"></font>
<font color="blue">", group_ptr->name);
+
+ if (group_ptr->vlist->var->ntime_levs > 1) {
+ fortprintf(fd, " type %s_pointer_type</font>
<font color="blue">", group_ptr->name);
+ fortprintf(fd, " type (%s_type), pointer :: %s </font>
<font color="blue">", group_ptr->name, group_ptr->name);
+ fortprintf(fd, " end type %s_pointer_type</font>
<font color="black"></font>
<font color="black"></font>
<font color="blue">", group_ptr->name);
+
+ fortprintf(fd, " type %s_multilevel_type</font>
<font color="blue">", group_ptr->name);
+ fortprintf(fd, " integer :: nTimeLevels</font>
<font color="blue">");
+ fortprintf(fd, " type (%s_pointer_type), dimension(:), pointer :: time_levs</font>
<font color="blue">", group_ptr->name);
+ fortprintf(fd, " end type %s_multilevel_type</font>
<font color="black"></font>
<font color="black"></font>
<font color="red">", group_ptr->name);
+ }
+
}
- else
- var_ptr = var_ptr->next;
+ group_ptr = group_ptr->next;
}
fclose(fd);
-
/*
- * Generate grid metadata allocations
+ * Generate instantiations of variable groups in block_type
*/
- fd = fopen("grid_meta_allocs.inc", "w");
+ fd = fopen("block_group_members.inc", "w");
- dim_ptr = dims;
- while (dim_ptr) {
- if (dim_ptr->constant_value < 0 && !dim_ptr->namelist_defined && !is_derived_dim(dim_ptr->name_in_code)) fortprintf(fd, " g %% %s = %s</font>
<font color="red">", dim_ptr->name_in_code, dim_ptr->name_in_code);
- if (dim_ptr->constant_value < 0 && dim_ptr->namelist_defined && !is_derived_dim(dim_ptr->name_in_code)) fortprintf(fd, " g %% %s = %s</font>
<font color="red">", dim_ptr->name_in_file, dim_ptr->name_in_file);
- dim_ptr = dim_ptr->next;
+ group_ptr = groups;
+ while (group_ptr) {
+ if (group_ptr->vlist->var->ntime_levs > 1)
+ fortprintf(fd, " type (%s_multilevel_type), pointer :: %s</font>
<font color="blue">", group_ptr->name, group_ptr->name);
+ else
+ fortprintf(fd, " type (%s_type), pointer :: %s</font>
<font color="red">", group_ptr->name, group_ptr->name);
+ group_ptr = group_ptr->next;
}
- fortprintf(fd, "</font>
<font color="red">");
- var_ptr = vars;
- while (var_ptr) {
- if (var_ptr->timedim == 0) {
+ fclose(fd);
+
+
+ /* To be included in allocate_block */
+ fd = fopen("block_allocs.inc", "w");
+ group_ptr = groups;
+ while (group_ptr) {
+ fortprintf(fd, " allocate(b %% %s)</font>
<font color="blue">", group_ptr->name);
+ if (group_ptr->vlist->var->ntime_levs > 1) {
+ fortprintf(fd, " b %% %s %% nTimeLevels = %i</font>
<font color="blue">", group_ptr->name, group_ptr->vlist->var->ntime_levs);
+ fortprintf(fd, " allocate(b %% %s %% time_levs(%i))</font>
<font color="blue">", group_ptr->name, group_ptr->vlist->var->ntime_levs);
+ fortprintf(fd, " do i=1,b %% %s %% nTimeLevels</font>
<font color="blue">", group_ptr->name);
+ fortprintf(fd, " allocate(b %% %s %% time_levs(i) %% %s)</font>
<font color="blue">", group_ptr->name, group_ptr->name);
+ fortprintf(fd, " call allocate_%s(b %% %s %% time_levs(i) %% %s, &</font>
<font color="blue">", group_ptr->name, group_ptr->name, group_ptr->name);
+ fortprintf(fd, "#include \"dim_dummy_args.inc\"</font>
<font color="blue">");
+ fortprintf(fd, " )</font>
<font color="blue">");
+ fortprintf(fd, " end do</font>
<font color="black"></font>
<font color="blue">");
+ }
+ else {
+ fortprintf(fd, " call allocate_%s(b %% %s, &</font>
<font color="blue">", group_ptr->name, group_ptr->name);
+ fortprintf(fd, "#include \"dim_dummy_args.inc\"</font>
<font color="blue">");
+ fortprintf(fd, " )</font>
<font color="black"></font>
<font color="blue">");
+ }
+ group_ptr = group_ptr->next;
+ }
+ fclose(fd);
+
+
+ /* To be included in deallocate_block */
+ fd = fopen("block_deallocs.inc", "w");
+ group_ptr = groups;
+ while (group_ptr) {
+ if (group_ptr->vlist->var->ntime_levs > 1) {
+ fortprintf(fd, " do i=1,b %% %s %% nTimeLevels</font>
<font color="blue">", group_ptr->name);
+ fortprintf(fd, " call deallocate_%s(b %% %s %% time_levs(i) %% %s)</font>
<font color="blue">", group_ptr->name, group_ptr->name, group_ptr->name);
+ fortprintf(fd, " deallocate(b %% %s %% time_levs(i) %% %s)</font>
<font color="blue">", group_ptr->name, group_ptr->name);
+ fortprintf(fd, " end do</font>
<font color="blue">");
+ fortprintf(fd, " deallocate(b %% %s %% time_levs)</font>
<font color="blue">", group_ptr->name);
+ }
+ else {
+ fortprintf(fd, " call deallocate_%s(b %% %s)</font>
<font color="blue">", group_ptr->name, group_ptr->name);
+ }
+ fortprintf(fd, " deallocate(b %% %s)</font>
<font color="black"></font>
<font color="blue">", group_ptr->name);
+ group_ptr = group_ptr->next;
+ }
+ fclose(fd);
+
+ /* Definitions of allocate subroutines */
+ fd = fopen("group_alloc_routines.inc", "w");
+ group_ptr = groups;
+ while (group_ptr) {
+ fortprintf(fd, " subroutine allocate_%s(%s, &</font>
<font color="blue">", group_ptr->name, group_ptr->name);
+ fortprintf(fd, "#include \"dim_dummy_args.inc\"</font>
<font color="blue">");
+ fortprintf(fd, " )</font>
<font color="blue">");
+ fortprintf(fd, "</font>
<font color="blue">");
+ fortprintf(fd, " implicit none</font>
<font color="blue">");
+ fortprintf(fd, "</font>
<font color="blue">");
+ fortprintf(fd, " type (%s_type), intent(inout) :: %s</font>
<font color="blue">", group_ptr->name, group_ptr->name);
+ fortprintf(fd, "#include \"dim_dummy_decls.inc\"</font>
<font color="blue">");
+ fortprintf(fd, "</font>
<font color="blue">");
+
+ if (!strncmp(group_ptr->name, "mesh", 1024)) {
+ dim_ptr = dims;
+ while (dim_ptr) {
+ if (dim_ptr->constant_value < 0 && !dim_ptr->namelist_defined && !is_derived_dim(dim_ptr->name_in_code)) fortprintf(fd, " %s %% %s = %s</font>
<font color="blue">", group_ptr->name, dim_ptr->name_in_code, dim_ptr->name_in_code);
+ if (dim_ptr->constant_value < 0 && dim_ptr->namelist_defined && !is_derived_dim(dim_ptr->name_in_code)) fortprintf(fd, " %s %% %s = %s</font>
<font color="blue">", group_ptr->name, dim_ptr->name_in_file, dim_ptr->name_in_file);
+ dim_ptr = dim_ptr->next;
+ }
+ fortprintf(fd, "</font>
<font color="red">");
+ }
+
+
+ var_list_ptr = group_ptr->vlist;
+ while (var_list_ptr) {
+ var_ptr = var_list_ptr->var;
if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
memcpy(super_array, var_ptr->super_array, 1024);
memcpy(array_class, var_ptr->array_class, 1024);
- vtype = var_ptr->vtype;
i = 0;
- while (var_ptr && strncmp(super_array, var_ptr->super_array, 1024) == 0) {
+ while (var_list_ptr && strncmp(super_array, var_list_ptr->var->super_array, 1024) == 0) {
i++;
- var_ptr2 = var_ptr;
- var_ptr = var_ptr->next;
+ var_list_ptr2 = var_list_ptr;
+ var_list_ptr = var_list_ptr->next;
}
- fortprintf(fd, " allocate(g %% %s)</font>
<font color="red">", var_ptr2->super_array);
- fortprintf(fd, " allocate(g %% %s %% ioinfo)</font>
<font color="red">", var_ptr2->super_array);
- fortprintf(fd, " allocate(g %% %s %% array(%i, ", var_ptr2->super_array, i);
+ var_ptr2 = var_list_ptr2->var;
+ fortprintf(fd, " allocate(%s %% %s)</font>
<font color="blue">", group_ptr->name, var_ptr2->super_array);
+ fortprintf(fd, " allocate(%s %% %s %% ioinfo)</font>
<font color="gray">", group_ptr->name, var_ptr2->super_array);
+ fortprintf(fd, " allocate(%s %% %s %% array(%i, ", group_ptr->name, var_ptr2->super_array, i);
dimlist_ptr = var_ptr2->dimlist;
if (!strncmp(dimlist_ptr->dim->name_in_file, "nCells", 1024) ||
!strncmp(dimlist_ptr->dim->name_in_file, "nEdges", 1024) ||
!strncmp(dimlist_ptr->dim->name_in_file, "nVertices", 1024))
- fortprintf(fd, "%s + 1", dimlist_ptr->dim->name_in_code);
+ if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, "%s + 1", dimlist_ptr->dim->name_in_code);
+ else fortprintf(fd, "%s + 1", dimlist_ptr->dim->name_in_file);
else
if (dimlist_ptr->dim->namelist_defined) fortprintf(fd, "%s", dimlist_ptr->dim->name_in_file);
else fortprintf(fd, "%s", dimlist_ptr->dim->name_in_code);
@@ -414,41 +559,43 @@
if (!strncmp(dimlist_ptr->dim->name_in_file, "nCells", 1024) ||
!strncmp(dimlist_ptr->dim->name_in_file, "nEdges", 1024) ||
!strncmp(dimlist_ptr->dim->name_in_file, "nVertices", 1024))
- fortprintf(fd, ", %s + 1", dimlist_ptr->dim->name_in_code);
+ if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, ", %s + 1", dimlist_ptr->dim->name_in_code);
+ else fortprintf(fd, ", %s + 1", dimlist_ptr->dim->name_in_file);
else
if (dimlist_ptr->dim->namelist_defined) fortprintf(fd, ", %s", dimlist_ptr->dim->name_in_file);
else fortprintf(fd, ", %s", dimlist_ptr->dim->name_in_code);
dimlist_ptr = dimlist_ptr->next;
}
fortprintf(fd, "))</font>
<font color="red">");
- fortprintf(fd, " g %% %s %% array = 0</font>
<font color="blue">", var_ptr2->super_array ); /* initialize field to zero */
+ fortprintf(fd, " %s %% %s %% array = 0</font>
<font color="red">", group_ptr->name, var_ptr2->super_array ); /* initialize field to zero */
if (var_ptr2->iostreams & INPUT0)
- fortprintf(fd, " g %% %s %% ioinfo %% input = .true.</font>
<font color="blue">", var_ptr2->super_array);
+ fortprintf(fd, " %s %% %s %% ioinfo %% input = .true.</font>
<font color="red">", group_ptr->name, var_ptr2->super_array);
else
- fortprintf(fd, " g %% %s %% ioinfo %% input = .false.</font>
<font color="blue">", var_ptr2->super_array);
+ fortprintf(fd, " %s %% %s %% ioinfo %% input = .false.</font>
<font color="red">", group_ptr->name, var_ptr2->super_array);
if (var_ptr2->iostreams & RESTART0)
- fortprintf(fd, " g %% %s %% ioinfo %% restart = .true.</font>
<font color="blue">", var_ptr2->super_array);
+ fortprintf(fd, " %s %% %s %% ioinfo %% restart = .true.</font>
<font color="red">", group_ptr->name, var_ptr2->super_array);
else
- fortprintf(fd, " g %% %s %% ioinfo %% restart = .false.</font>
<font color="blue">", var_ptr2->super_array);
+ fortprintf(fd, " %s %% %s %% ioinfo %% restart = .false.</font>
<font color="red">", group_ptr->name, var_ptr2->super_array);
if (var_ptr2->iostreams & OUTPUT0)
- fortprintf(fd, " g %% %s %% ioinfo %% output = .true.</font>
<font color="blue">", var_ptr2->super_array);
+ fortprintf(fd, " %s %% %s %% ioinfo %% output = .true.</font>
<font color="red">", group_ptr->name, var_ptr2->super_array);
else
- fortprintf(fd, " g %% %s %% ioinfo %% output = .false.</font>
<font color="blue">", var_ptr2->super_array);
+ fortprintf(fd, " %s %% %s %% ioinfo %% output = .false.</font>
<font color="black">", group_ptr->name, var_ptr2->super_array);
fortprintf(fd, "</font>
<font color="red">");
}
else {
- fortprintf(fd, " allocate(g %% %s)</font>
<font color="red">", var_ptr->name_in_code);
- fortprintf(fd, " allocate(g %% %s %% ioinfo)</font>
<font color="blue">", var_ptr->name_in_code);
+ fortprintf(fd, " allocate(%s %% %s)</font>
<font color="blue">", group_ptr->name, var_ptr->name_in_code);
+ fortprintf(fd, " allocate(%s %% %s %% ioinfo)</font>
<font color="gray">", group_ptr->name, var_ptr->name_in_code);
if (var_ptr->ndims > 0) {
- fortprintf(fd, " allocate(g %% %s %% array(", var_ptr->name_in_code);
+ fortprintf(fd, " allocate(%s %% %s %% array(", group_ptr->name, var_ptr->name_in_code);
dimlist_ptr = var_ptr->dimlist;
if (!strncmp(dimlist_ptr->dim->name_in_file, "nCells", 1024) ||
!strncmp(dimlist_ptr->dim->name_in_file, "nEdges", 1024) ||
!strncmp(dimlist_ptr->dim->name_in_file, "nVertices", 1024))
- fortprintf(fd, "%s + 1", dimlist_ptr->dim->name_in_code);
+ if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, "%s + 1", dimlist_ptr->dim->name_in_code);
+ else fortprintf(fd, "%s + 1", dimlist_ptr->dim->name_in_file);
else
if (dimlist_ptr->dim->namelist_defined) fortprintf(fd, "%s", dimlist_ptr->dim->name_in_file);
else fortprintf(fd, "%s", dimlist_ptr->dim->name_in_code);
@@ -457,313 +604,112 @@
if (!strncmp(dimlist_ptr->dim->name_in_file, "nCells", 1024) ||
!strncmp(dimlist_ptr->dim->name_in_file, "nEdges", 1024) ||
!strncmp(dimlist_ptr->dim->name_in_file, "nVertices", 1024))
- fortprintf(fd, ", %s + 1", dimlist_ptr->dim->name_in_code);
+ if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, ", %s + 1", dimlist_ptr->dim->name_in_code);
+ else fortprintf(fd, ", %s + 1", dimlist_ptr->dim->name_in_file);
else
if (dimlist_ptr->dim->namelist_defined) fortprintf(fd, ", %s", dimlist_ptr->dim->name_in_file);
else fortprintf(fd, ", %s", dimlist_ptr->dim->name_in_code);
dimlist_ptr = dimlist_ptr->next;
}
fortprintf(fd, "))</font>
<font color="red">");
- fortprintf(fd, " g %% %s %% array = 0</font>
<font color="blue">", var_ptr->name_in_code ); /* initialize field to zero */
+ fortprintf(fd, " %s %% %s %% array = 0</font>
<font color="red">", group_ptr->name, var_ptr->name_in_code ); /* initialize field to zero */
}
if (var_ptr->iostreams & INPUT0)
- fortprintf(fd, " g %% %s %% ioinfo %% input = .true.</font>
<font color="blue">", var_ptr->name_in_code);
+ fortprintf(fd, " %s %% %s %% ioinfo %% input = .true.</font>
<font color="red">", group_ptr->name, var_ptr->name_in_code);
else
- fortprintf(fd, " g %% %s %% ioinfo %% input = .false.</font>
<font color="blue">", var_ptr->name_in_code);
+ fortprintf(fd, " %s %% %s %% ioinfo %% input = .false.</font>
<font color="red">", group_ptr->name, var_ptr->name_in_code);
if (var_ptr->iostreams & RESTART0)
- fortprintf(fd, " g %% %s %% ioinfo %% restart = .true.</font>
<font color="blue">", var_ptr->name_in_code);
+ fortprintf(fd, " %s %% %s %% ioinfo %% restart = .true.</font>
<font color="red">", group_ptr->name, var_ptr->name_in_code);
else
- fortprintf(fd, " g %% %s %% ioinfo %% restart = .false.</font>
<font color="blue">", var_ptr->name_in_code);
+ fortprintf(fd, " %s %% %s %% ioinfo %% restart = .false.</font>
<font color="red">", group_ptr->name, var_ptr->name_in_code);
if (var_ptr->iostreams & OUTPUT0)
- fortprintf(fd, " g %% %s %% ioinfo %% output = .true.</font>
<font color="blue">", var_ptr->name_in_code);
+ fortprintf(fd, " %s %% %s %% ioinfo %% output = .true.</font>
<font color="red">", group_ptr->name, var_ptr->name_in_code);
else
- fortprintf(fd, " g %% %s %% ioinfo %% output = .false.</font>
<font color="blue">", var_ptr->name_in_code);
+ fortprintf(fd, " %s %% %s %% ioinfo %% output = .false.</font>
<font color="black">", group_ptr->name, var_ptr->name_in_code);
fortprintf(fd, "</font>
<font color="red">");
- var_ptr = var_ptr->next;
+ var_list_ptr = var_list_ptr->next;
}
}
- else
- var_ptr = var_ptr->next;
- }
+ fortprintf(fd, " end subroutine allocate_%s</font>
<font color="black"></font>
<font color="black"></font>
<font color="blue">", group_ptr->name);
+ group_ptr = group_ptr->next;
+ }
fclose(fd);
+
+ /* Definitions of deallocate subroutines */
+ fd = fopen("group_dealloc_routines.inc", "w");
+ group_ptr = groups;
+ while (group_ptr) {
+ fortprintf(fd, " subroutine deallocate_%s(%s)</font>
<font color="blue">", group_ptr->name, group_ptr->name);
+ fortprintf(fd, "</font>
<font color="blue">");
+ fortprintf(fd, " implicit none</font>
<font color="blue">");
+ fortprintf(fd, "</font>
<font color="blue">");
+ fortprintf(fd, " type (%s_type), intent(inout) :: %s</font>
<font color="blue">", group_ptr->name, group_ptr->name);
+ fortprintf(fd, "</font>
<font color="red">");
-
- /*
- * Generate grid metadata deallocations
- */
- fd = fopen("grid_meta_deallocs.inc", "w");
-
- var_ptr = vars;
- while (var_ptr) {
- if (var_ptr->timedim == 0) {
+ var_list_ptr = group_ptr->vlist;
+ while (var_list_ptr) {
+ var_ptr = var_list_ptr->var;
if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
memcpy(super_array, var_ptr->super_array, 1024);
memcpy(array_class, var_ptr->array_class, 1024);
- vtype = var_ptr->vtype;
i = 0;
- while (var_ptr && strncmp(super_array, var_ptr->super_array, 1024) == 0) {
+ while (var_list_ptr && strncmp(super_array, var_list_ptr->var->super_array, 1024) == 0) {
i++;
- var_ptr2 = var_ptr;
- var_ptr = var_ptr->next;
+ var_list_ptr2 = var_list_ptr;
+ var_list_ptr = var_list_ptr->next;
}
- fortprintf(fd, " deallocate(g %% %s %% array)</font>
<font color="red">", var_ptr2->super_array);
- fortprintf(fd, " deallocate(g %% %s %% ioinfo)</font>
<font color="red">", var_ptr2->super_array);
- fortprintf(fd, " deallocate(g %% %s)</font>
<font color="black"></font>
<font color="blue">", var_ptr2->super_array);
+ fortprintf(fd, " deallocate(%s %% %s %% array)</font>
<font color="blue">", group_ptr->name, var_list_ptr2->var->super_array);
+ fortprintf(fd, " deallocate(%s %% %s %% ioinfo)</font>
<font color="blue">", group_ptr->name, var_list_ptr2->var->super_array);
+ fortprintf(fd, " deallocate(%s %% %s)</font>
<font color="black"></font>
<font color="red">", group_ptr->name, var_list_ptr2->var->super_array);
}
else {
if (var_ptr->ndims > 0) {
- fortprintf(fd, " deallocate(g %% %s %% array)</font>
<font color="red">", var_ptr->name_in_code);
- fortprintf(fd, " deallocate(g %% %s %% ioinfo)</font>
<font color="red">", var_ptr->name_in_code);
- fortprintf(fd, " deallocate(g %% %s)</font>
<font color="black"></font>
<font color="blue">", var_ptr->name_in_code);
+ fortprintf(fd, " deallocate(%s %% %s %% array)</font>
<font color="blue">", group_ptr->name, var_ptr->name_in_code);
+ fortprintf(fd, " deallocate(%s %% %s %% ioinfo)</font>
<font color="blue">", group_ptr->name, var_ptr->name_in_code);
+ fortprintf(fd, " deallocate(%s %% %s)</font>
<font color="black"></font>
<font color="red">", group_ptr->name, var_ptr->name_in_code);
}
else {
- fortprintf(fd, " deallocate(g %% %s %% ioinfo)</font>
<font color="red">", var_ptr->name_in_code);
- fortprintf(fd, " deallocate(g %% %s)</font>
<font color="black"></font>
<font color="blue">", var_ptr->name_in_code);
+ fortprintf(fd, " deallocate(%s %% %s %% ioinfo)</font>
<font color="blue">", group_ptr->name, var_ptr->name_in_code);
+ fortprintf(fd, " deallocate(%s %% %s)</font>
<font color="black"></font>
<font color="red">", group_ptr->name, var_ptr->name_in_code);
}
- var_ptr = var_ptr->next;
+ var_list_ptr = var_list_ptr->next;
}
}
- else
- var_ptr = var_ptr->next;
- }
- fclose(fd);
-
-
- /*
- * Generate grid state allocations
- */
- fd = fopen("grid_state_allocs.inc", "w");
-
- var_ptr = vars;
- while (var_ptr) {
- if (var_ptr->timedim == 1 && var_ptr->ndims > 0) {
- if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
- memcpy(super_array, var_ptr->super_array, 1024);
- memcpy(array_class, var_ptr->array_class, 1024);
- vtype = var_ptr->vtype;
- i = 0;
- while (var_ptr && strncmp(super_array, var_ptr->super_array, 1024) == 0) {
- i++;
- var_ptr2 = var_ptr;
- var_ptr = var_ptr->next;
- }
- fortprintf(fd, " allocate(s %% %s)</font>
<font color="red">", var_ptr2->super_array);
- fortprintf(fd, " allocate(s %% %s %% ioinfo)</font>
<font color="red">", var_ptr2->super_array);
- fortprintf(fd, " allocate(s %% %s %% array(%i, ", var_ptr2->super_array, i);
- dimlist_ptr = var_ptr2->dimlist;
- if (!strncmp(dimlist_ptr->dim->name_in_file, "nCells", 1024) ||
- !strncmp(dimlist_ptr->dim->name_in_file, "nEdges", 1024) ||
- !strncmp(dimlist_ptr->dim->name_in_file, "nVertices", 1024))
- fortprintf(fd, "b %% mesh %% %s + 1", dimlist_ptr->dim->name_in_code);
- else
- if (dimlist_ptr->dim->namelist_defined) fortprintf(fd, "b %% mesh %% %s", dimlist_ptr->dim->name_in_file);
- else fortprintf(fd, "b %% mesh %% %s", dimlist_ptr->dim->name_in_code);
- dimlist_ptr = dimlist_ptr->next;
- while (dimlist_ptr) {
- if (!strncmp(dimlist_ptr->dim->name_in_file, "nCells", 1024) ||
- !strncmp(dimlist_ptr->dim->name_in_file, "nEdges", 1024) ||
- !strncmp(dimlist_ptr->dim->name_in_file, "nVertices", 1024))
- fortprintf(fd, ", b %% mesh %% %s + 1", dimlist_ptr->dim->name_in_code);
- else
- if (dimlist_ptr->dim->namelist_defined) fortprintf(fd, ", b %% mesh %% %s", dimlist_ptr->dim->name_in_file);
- else fortprintf(fd, ", b %% mesh %% %s", dimlist_ptr->dim->name_in_code);
- dimlist_ptr = dimlist_ptr->next;
- }
- fortprintf(fd, "))</font>
<font color="red">");
- fortprintf(fd, " s %% %s %% block => b</font>
<font color="red">", var_ptr2->super_array);
-
- if (var_ptr2->iostreams & INPUT0)
- fortprintf(fd, " s %% %s %% ioinfo %% input = .true.</font>
<font color="red">", var_ptr2->super_array);
- else
- fortprintf(fd, " s %% %s %% ioinfo %% input = .false.</font>
<font color="red">", var_ptr2->super_array);
-
- if (var_ptr2->iostreams & RESTART0)
- fortprintf(fd, " s %% %s %% ioinfo %% restart = .true.</font>
<font color="red">", var_ptr2->super_array);
- else
- fortprintf(fd, " s %% %s %% ioinfo %% restart = .false.</font>
<font color="red">", var_ptr2->super_array);
-
- if (var_ptr2->iostreams & OUTPUT0)
- fortprintf(fd, " s %% %s %% ioinfo %% output = .true.</font>
<font color="red">", var_ptr2->super_array);
- else
- fortprintf(fd, " s %% %s %% ioinfo %% output = .false.</font>
<font color="red">", var_ptr2->super_array);
- fortprintf(fd, "</font>
<font color="red">");
- }
- else {
- fortprintf(fd, " allocate(s %% %s)</font>
<font color="red">", var_ptr->name_in_code);
- fortprintf(fd, " allocate(s %% %s %% ioinfo)</font>
<font color="red">", var_ptr->name_in_code);
- fortprintf(fd, " allocate(s %% %s %% array(", var_ptr->name_in_code);
- dimlist_ptr = var_ptr->dimlist;
- if (dimlist_ptr->dim->constant_value < 0) {
- if (!strncmp(dimlist_ptr->dim->name_in_file, "nCells", 1024) ||
- !strncmp(dimlist_ptr->dim->name_in_file, "nEdges", 1024) ||
- !strncmp(dimlist_ptr->dim->name_in_file, "nVertices", 1024))
- fortprintf(fd, "b %% mesh %% %s + 1", dimlist_ptr->dim->name_in_code);
- else
- if (dimlist_ptr->dim->namelist_defined) fortprintf(fd, "b %% mesh %% %s", dimlist_ptr->dim->name_in_file);
- else fortprintf(fd, "b %% mesh %% %s", dimlist_ptr->dim->name_in_code);
- }
- else {
- fortprintf(fd, "%i", dimlist_ptr->dim->constant_value);
- }
- dimlist_ptr = dimlist_ptr->next;
- while (dimlist_ptr) {
- if (dimlist_ptr->dim->constant_value < 0) {
- if (!strncmp(dimlist_ptr->dim->name_in_file, "nCells", 1024) ||
- !strncmp(dimlist_ptr->dim->name_in_file, "nEdges", 1024) ||
- !strncmp(dimlist_ptr->dim->name_in_file, "nVertices", 1024))
- fortprintf(fd, ", b %% mesh %% %s + 1", dimlist_ptr->dim->name_in_code);
- else
- if (dimlist_ptr->dim->namelist_defined) fortprintf(fd, ", b %% mesh %% %s", dimlist_ptr->dim->name_in_file);
- else fortprintf(fd, ", b %% mesh %% %s", dimlist_ptr->dim->name_in_code);
- }
- else {
- fortprintf(fd, ", %i", dimlist_ptr->dim->constant_value);
- }
- dimlist_ptr = dimlist_ptr->next;
- }
- fortprintf(fd, "))</font>
<font color="red">");
- fortprintf(fd, " s %% %s %% block => b</font>
<font color="red">", var_ptr->name_in_code);
-
- if (var_ptr->iostreams & INPUT0)
- fortprintf(fd, " s %% %s %% ioinfo %% input = .true.</font>
<font color="red">", var_ptr->name_in_code);
- else
- fortprintf(fd, " s %% %s %% ioinfo %% input = .false.</font>
<font color="red">", var_ptr->name_in_code);
-
- if (var_ptr->iostreams & RESTART0)
- fortprintf(fd, " s %% %s %% ioinfo %% restart = .true.</font>
<font color="red">", var_ptr->name_in_code);
- else
- fortprintf(fd, " s %% %s %% ioinfo %% restart = .false.</font>
<font color="red">", var_ptr->name_in_code);
-
- if (var_ptr->iostreams & OUTPUT0)
- fortprintf(fd, " s %% %s %% ioinfo %% output = .true.</font>
<font color="red">", var_ptr->name_in_code);
- else
- fortprintf(fd, " s %% %s %% ioinfo %% output = .false.</font>
<font color="red">", var_ptr->name_in_code);
- fortprintf(fd, "</font>
<font color="red">");
- var_ptr = var_ptr->next;
- }
- }
- else if (var_ptr->timedim == 1) {
- if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
- memcpy(super_array, var_ptr->super_array, 1024);
- memcpy(array_class, var_ptr->array_class, 1024);
- vtype = var_ptr->vtype;
- i = 0;
- while (var_ptr && strncmp(super_array, var_ptr->super_array, 1024) == 0) {
- i++;
- var_ptr2 = var_ptr;
- var_ptr = var_ptr->next;
- }
- fortprintf(fd, " allocate(s %% %s)</font>
<font color="red">", var_ptr2->super_array);
- fortprintf(fd, " allocate(s %% %s %% ioinfo)</font>
<font color="red">", var_ptr2->super_array);
- fortprintf(fd, " allocate(s %% %s %% array(%i)", var_ptr->name_in_code, i);
- fortprintf(fd, " s %% %s %% block => b</font>
<font color="red">", var_ptr2->super_array);
-
- if (var_ptr2->iostreams & INPUT0)
- fortprintf(fd, " s %% %s %% ioinfo %% input = .true.</font>
<font color="red">", var_ptr2->super_array);
- else
- fortprintf(fd, " s %% %s %% ioinfo %% input = .false.</font>
<font color="red">", var_ptr2->super_array);
-
- if (var_ptr2->iostreams & RESTART0)
- fortprintf(fd, " s %% %s %% ioinfo %% restart = .true.</font>
<font color="red">", var_ptr2->super_array);
- else
- fortprintf(fd, " s %% %s %% ioinfo %% restart = .false.</font>
<font color="red">", var_ptr2->super_array);
-
- if (var_ptr2->iostreams & OUTPUT0)
- fortprintf(fd, " s %% %s %% ioinfo %% output = .true.</font>
<font color="red">", var_ptr2->super_array);
- else
- fortprintf(fd, " s %% %s %% ioinfo %% output = .false.</font>
<font color="red">", var_ptr2->super_array);
- fortprintf(fd, "</font>
<font color="red">");
- }
- else {
- fortprintf(fd, " allocate(s %% %s)</font>
<font color="red">", var_ptr->name_in_code);
- fortprintf(fd, " allocate(s %% %s %% ioinfo)</font>
<font color="red">", var_ptr->name_in_code);
- fortprintf(fd, " s %% %s %% block => b</font>
<font color="red">", var_ptr->name_in_code);
-
- if (var_ptr->iostreams & INPUT0)
- fortprintf(fd, " s %% %s %% ioinfo %% input = .true.</font>
<font color="red">", var_ptr->name_in_code);
- else
- fortprintf(fd, " s %% %s %% ioinfo %% input = .false.</font>
<font color="red">", var_ptr->name_in_code);
-
- if (var_ptr->iostreams & RESTART0)
- fortprintf(fd, " s %% %s %% ioinfo %% restart = .true.</font>
<font color="red">", var_ptr->name_in_code);
- else
- fortprintf(fd, " s %% %s %% ioinfo %% restart = .false.</font>
<font color="red">", var_ptr->name_in_code);
-
- if (var_ptr->iostreams & OUTPUT0)
- fortprintf(fd, " s %% %s %% ioinfo %% output = .true.</font>
<font color="red">", var_ptr->name_in_code);
- else
- fortprintf(fd, " s %% %s %% ioinfo %% output = .false.</font>
<font color="red">", var_ptr->name_in_code);
- fortprintf(fd, "</font>
<font color="red">");
- var_ptr = var_ptr->next;
- }
- }
- else
- var_ptr = var_ptr->next;
+ fortprintf(fd, " end subroutine deallocate_%s</font>
<font color="black"></font>
<font color="black"></font>
<font color="red">", group_ptr->name);
+ group_ptr = group_ptr->next;
}
-
fclose(fd);
-
- /*
- * Generate grid state deallocations
- */
- fd = fopen("grid_state_deallocs.inc", "w");
-
- var_ptr = vars;
- while (var_ptr) {
- if (var_ptr->timedim == 1) {
+ /* Definitions of copy subroutines */
+ fd = fopen("group_copy_routines.inc", "w");
+ group_ptr = groups;
+ while (group_ptr) {
+ fortprintf(fd, " subroutine copy_%s(dest, src)</font>
<font color="blue">", group_ptr->name);
+ fortprintf(fd, "</font>
<font color="blue">");
+ fortprintf(fd, " implicit none</font>
<font color="blue">");
+ fortprintf(fd, "</font>
<font color="blue">");
+ fortprintf(fd, " type (%s_type), intent(in) :: src</font>
<font color="blue">", group_ptr->name);
+ fortprintf(fd, " type (%s_type), intent(inout) :: dest</font>
<font color="blue">", group_ptr->name);
+ fortprintf(fd, "</font>
<font color="red">");
+ var_list_ptr = group_ptr->vlist;
+ while (var_list_ptr) {
+ var_ptr = var_list_ptr->var;
if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
memcpy(super_array, var_ptr->super_array, 1024);
memcpy(array_class, var_ptr->array_class, 1024);
- vtype = var_ptr->vtype;
i = 0;
- while (var_ptr && strncmp(super_array, var_ptr->super_array, 1024) == 0) {
+ while (var_list_ptr && strncmp(super_array, var_list_ptr->var->super_array, 1024) == 0) {
i++;
- var_ptr2 = var_ptr;
- var_ptr = var_ptr->next;
+ var_list_ptr2 = var_list_ptr;
+ var_list_ptr = var_list_ptr->next;
}
- fortprintf(fd, " deallocate(s %% %s %% array)</font>
<font color="red">", var_ptr2->super_array);
- fortprintf(fd, " deallocate(s %% %s %% ioinfo)</font>
<font color="red">", var_ptr2->super_array);
- fortprintf(fd, " deallocate(s %% %s)</font>
<font color="black"></font>
<font color="red">", var_ptr2->super_array);
- }
- else {
- if (var_ptr->ndims > 0) fortprintf(fd, " deallocate(s %% %s %% array)</font>
<font color="red">", var_ptr->name_in_code);
- fortprintf(fd, " deallocate(s %% %s %% ioinfo)</font>
<font color="red">", var_ptr->name_in_code);
- fortprintf(fd, " deallocate(s %% %s)</font>
<font color="black"></font>
<font color="red">", var_ptr->name_in_code);
- var_ptr = var_ptr->next;
- }
- }
- else
- var_ptr = var_ptr->next;
- }
-
- fclose(fd);
-
-
- /*
- * Generate copies of state arrays
- */
- fd = fopen("copy_state.inc", "w");
-
- var_ptr = vars;
- while (var_ptr) {
- if (var_ptr->timedim == 1) {
- if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
- memcpy(super_array, var_ptr->super_array, 1024);
- memcpy(array_class, var_ptr->array_class, 1024);
- vtype = var_ptr->vtype;
- i = 0;
- while (var_ptr && strncmp(super_array, var_ptr->super_array, 1024) == 0) {
- i++;
- var_ptr2 = var_ptr;
- var_ptr = var_ptr->next;
- }
+ var_ptr2 = var_list_ptr2->var;
if (var_ptr2->ndims > 0)
fortprintf(fd, " dest %% %s %% array = src %% %s %% array</font>
<font color="gray">", var_ptr2->super_array, var_ptr2->super_array);
else
@@ -774,30 +720,59 @@
fortprintf(fd, " dest %% %s %% array = src %% %s %% array</font>
<font color="black">", var_ptr->name_in_code, var_ptr->name_in_code);
else
fortprintf(fd, " dest %% %s %% scalar = src %% %s %% scalar</font>
<font color="red">", var_ptr->name_in_code, var_ptr->name_in_code);
- var_ptr = var_ptr->next;
+ var_list_ptr = var_list_ptr->next;
}
}
- else
- var_ptr = var_ptr->next;
+ fortprintf(fd, "</font>
<font color="blue">");
+ fortprintf(fd, " end subroutine copy_%s</font>
<font color="black"></font>
<font color="black"></font>
<font color="blue">", group_ptr->name);
+ group_ptr = group_ptr->next;
}
+ fclose(fd);
+ /* Definitions of shift_time_level subroutines */
+ fd = fopen("group_shift_level_routines.inc", "w");
+ group_ptr = groups;
+ while (group_ptr) {
+ if (group_ptr->vlist->var->ntime_levs > 1) {
+ fortprintf(fd, " subroutine shift_time_levels_%s(%s)</font>
<font color="blue">", group_ptr->name, group_ptr->name);
+ fortprintf(fd, "</font>
<font color="blue">");
+ fortprintf(fd, " implicit none</font>
<font color="blue">");
+ fortprintf(fd, "</font>
<font color="blue">");
+ fortprintf(fd, " type (%s_multilevel_type), intent(inout) :: %s</font>
<font color="blue">", group_ptr->name, group_ptr->name);
+ fortprintf(fd, "</font>
<font color="blue">");
+ fortprintf(fd, " integer :: i</font>
<font color="blue">");
+ fortprintf(fd, " type (%s_type), pointer :: sptr</font>
<font color="blue">", group_ptr->name);
+ fortprintf(fd, "</font>
<font color="blue">");
+ fortprintf(fd, " sptr => %s %% time_levs(1) %% %s</font>
<font color="blue">", group_ptr->name, group_ptr->name);
+ fortprintf(fd, " do i=1,%s %% nTimeLevels-1</font>
<font color="blue">", group_ptr->name);
+ fortprintf(fd, " %s %% time_levs(i) %% %s => %s %% time_levs(i+1) %% %s</font>
<font color="blue">", group_ptr->name, group_ptr->name, group_ptr->name, group_ptr->name);
+ fortprintf(fd, " end do</font>
<font color="blue">");
+ fortprintf(fd, " %s %% time_levs(%s %% nTimeLevels) %% %s => sptr</font>
<font color="blue">", group_ptr->name, group_ptr->name, group_ptr->name);
+ fortprintf(fd, "</font>
<font color="blue">");
+ fortprintf(fd, " end subroutine shift_time_levels_%s</font>
<font color="black"></font>
<font color="black"></font>
<font color="gray">", group_ptr->name);
+ }
+ group_ptr = group_ptr->next;
+ }
fclose(fd);
+
}
-void gen_reads(struct variable * vars, struct dimension * dims)
+void gen_reads(struct group_list * groups, struct variable * vars, struct dimension * dims)
{
struct variable * var_ptr;
+ struct variable_list * var_list_ptr;
struct dimension * dim_ptr;
struct dimension_list * dimlist_ptr, * lastdim;
+ struct group_list * group_ptr;
struct dtable * dictionary;
FILE * fd;
char vtype[5];
char fname[32];
+ char struct_deref[1024];
char * cp1, * cp2;
int i, j;
int ivtype;
- int has_vert_dim, vert_dim;
/*
@@ -835,124 +810,64 @@
*/
fd = fopen("io_input_fields.inc", "w");
- var_ptr = vars;
- while (var_ptr) {
- i = 1;
- dimlist_ptr = var_ptr->dimlist;
- if (var_ptr->vtype == INTEGER) sprintf(vtype, "int");
- else if (var_ptr->vtype == REAL) sprintf(vtype, "real");
+ group_ptr = groups;
+ while (group_ptr) {
+ var_list_ptr = group_ptr->vlist;
+ while (var_list_ptr) {
+ var_ptr = var_list_ptr->var;
- if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
- if (var_ptr->timedim) {
- fortprintf(fd, " if ((block %% time_levs(1) %% state %% %s %% ioinfo %% input .and. .not. config_do_restart) .or. &</font>
<font color="red">", var_ptr->super_array);
- fortprintf(fd, " (block %% time_levs(1) %% state %% %s %% ioinfo %% restart .and. config_do_restart)) then</font>
<font color="red">", var_ptr->super_array);
- }
- else {
- fortprintf(fd, " if ((block %% mesh %% %s %% ioinfo %% input .and. .not. config_do_restart) .or. &</font>
<font color="red">", var_ptr->super_array);
- fortprintf(fd, " (block %% mesh %% %s %% ioinfo %% restart .and. config_do_restart)) then</font>
<font color="red">", var_ptr->super_array);
- }
- }
- else {
- if (var_ptr->timedim) {
- fortprintf(fd, " if ((block %% time_levs(1) %% state %% %s %% ioinfo %% input .and. .not. config_do_restart) .or. &</font>
<font color="red">", var_ptr->name_in_code);
- fortprintf(fd, " (block %% time_levs(1) %% state %% %s %% ioinfo %% restart .and. config_do_restart)) then</font>
<font color="red">", var_ptr->name_in_code);
- }
- else {
- fortprintf(fd, " if ((block %% mesh %% %s %% ioinfo %% input .and. .not. config_do_restart) .or. &</font>
<font color="red">", var_ptr->name_in_code);
- fortprintf(fd, " (block %% mesh %% %s %% ioinfo %% restart .and. config_do_restart)) then</font>
<font color="red">", var_ptr->name_in_code);
- }
- }
- vert_dim = 0;
- while (dimlist_ptr) {
- if (i < var_ptr->ndims) {
- has_vert_dim = !strcmp( "nVertLevels", dimlist_ptr->dim->name_in_code);
- fortprintf(fd, " %s%id %% ioinfo %% start(%i) = 1</font>
<font color="red">", vtype, var_ptr->ndims, i);
- if (has_vert_dim) {
- vert_dim = i;
- fortprintf(fd, "#ifdef EXPAND_LEVELS</font>
<font color="red">");
- fortprintf(fd, " if (.not. config_do_restart) then</font>
<font color="red">");
- fortprintf(fd, " %s%id %% ioinfo %% count(%i) = 1</font>
<font color="red">", vtype, var_ptr->ndims, i);
- fortprintf(fd, " else</font>
<font color="red">");
- fortprintf(fd, "#endif</font>
<font color="red">");
- }
- if (dimlist_ptr->dim->constant_value < 0)
- if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, " %s%id %% ioinfo %% count(%i) = block %% mesh %% %s</font>
<font color="red">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_code);
- else fortprintf(fd, " %s%id %% ioinfo %% count(%i) = block %% mesh %% %s</font>
<font color="red">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_file);
- else
- fortprintf(fd, " %s%id %% ioinfo %% count(%i) = %s</font>
<font color="red">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_code);
- if (has_vert_dim) {
- fortprintf(fd, "#ifdef EXPAND_LEVELS</font>
<font color="red">");
- fortprintf(fd, " end if</font>
<font color="red">");
- fortprintf(fd, "#endif</font>
<font color="red">");
- }
- }
- else {
- if (is_derived_dim(dimlist_ptr->dim->name_in_code)) {
- split_derived_dim_string(dimlist_ptr->dim->name_in_code, &cp1, &cp2);
- fortprintf(fd, " %s%id %% ioinfo %% start(%i) = read%sStart</font>
<font color="red">", vtype, var_ptr->ndims, i, cp1);
- fortprintf(fd, " %s%id %% ioinfo %% count(%i) = read%sCount%s</font>
<font color="red">", vtype, var_ptr->ndims, i, cp1, cp2);
- free(cp1);
- free(cp2);
- }
- else {
- fortprintf(fd, " %s%id %% ioinfo %% start(%i) = read%sStart</font>
<font color="red">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_code+1);
- fortprintf(fd, " %s%id %% ioinfo %% count(%i) = read%sCount</font>
<font color="red">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_code+1);
- }
- }
- dimlist_ptr = dimlist_ptr->next;
- i++;
- }
+ if (group_ptr->vlist->var->ntime_levs > 1)
+ snprintf(struct_deref, 1024, "block %% %s %% time_levs(1) %% %s", group_ptr->name, group_ptr->name);
+ else
+ snprintf(struct_deref, 1024, "block %% %s", group_ptr->name);
- if (var_ptr->ndims > 0) {
- fortprintf(fd, " allocate(%s%id %% array(", vtype, var_ptr->ndims);
i = 1;
dimlist_ptr = var_ptr->dimlist;
+ if (var_ptr->vtype == INTEGER) sprintf(vtype, "int");
+ else if (var_ptr->vtype == REAL) sprintf(vtype, "real");
- if (i < var_ptr->ndims) {
- if (dimlist_ptr->dim->constant_value < 0)
- if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, "block %% mesh %% %s", dimlist_ptr->dim->name_in_code);
- else fortprintf(fd, "block %% mesh %% %s", dimlist_ptr->dim->name_in_file);
- else
- fortprintf(fd, "%s", dimlist_ptr->dim->name_in_code);
+ if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
+ fortprintf(fd, " if ((%s %% %s %% ioinfo %% input .and. .not. config_do_restart) .or. &</font>
<font color="blue">", struct_deref, var_ptr->super_array);
+ fortprintf(fd, " (%s %% %s %% ioinfo %% restart .and. config_do_restart)) then</font>
<font color="red">", struct_deref, var_ptr->super_array);
}
else {
- if (is_derived_dim(dimlist_ptr->dim->name_in_code)) {
- split_derived_dim_string(dimlist_ptr->dim->name_in_code, &cp1, &cp2);
- fortprintf(fd, "read%sCount%s", cp1, cp2);
- free(cp1);
- free(cp2);
- }
- else
- fortprintf(fd, "read%sCount", dimlist_ptr->dim->name_in_code+1);
+ fortprintf(fd, " if ((%s %% %s %% ioinfo %% input .and. .not. config_do_restart) .or. &</font>
<font color="blue">", struct_deref, var_ptr->name_in_code);
+ fortprintf(fd, " (%s %% %s %% ioinfo %% restart .and. config_do_restart)) then</font>
<font color="red">", struct_deref, var_ptr->name_in_code);
}
-
- dimlist_ptr = dimlist_ptr->next;
- i++;
while (dimlist_ptr) {
- if (i < var_ptr->ndims) {
- if (dimlist_ptr->dim->constant_value < 0)
- if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, ", block %% mesh %% %s", dimlist_ptr->dim->name_in_code);
- else fortprintf(fd, ", block %% mesh %% %s", dimlist_ptr->dim->name_in_file);
- else
- fortprintf(fd, ", %s", dimlist_ptr->dim->name_in_code);
- }
- else {
- if (is_derived_dim(dimlist_ptr->dim->name_in_code)) {
- split_derived_dim_string(dimlist_ptr->dim->name_in_code, &cp1, &cp2);
- fortprintf(fd, ", read%sCount%s", cp1, cp2);
- free(cp1);
- free(cp2);
+ if (i < var_ptr->ndims) {
+ fortprintf(fd, " %s%id %% ioinfo %% start(%i) = 1</font>
<font color="blue">", vtype, var_ptr->ndims, i);
+ if (dimlist_ptr->dim->constant_value < 0)
+ if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, " %s%id %% ioinfo %% count(%i) = block %% mesh %% %s</font>
<font color="blue">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_code);
+ else fortprintf(fd, " %s%id %% ioinfo %% count(%i) = block %% mesh %% %s</font>
<font color="blue">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_file);
+ else
+ fortprintf(fd, " %s%id %% ioinfo %% count(%i) = %s</font>
<font color="red">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_code);
}
- else
- fortprintf(fd, ", read%sCount", dimlist_ptr->dim->name_in_code+1);
- }
+ else {
+ if (is_derived_dim(dimlist_ptr->dim->name_in_code)) {
+ split_derived_dim_string(dimlist_ptr->dim->name_in_code, &cp1, &cp2);
+ fortprintf(fd, " %s%id %% ioinfo %% start(%i) = read%sStart</font>
<font color="blue">", vtype, var_ptr->ndims, i, cp1);
+ fortprintf(fd, " %s%id %% ioinfo %% count(%i) = read%sCount%s</font>
<font color="blue">", vtype, var_ptr->ndims, i, cp1, cp2);
+ free(cp1);
+ free(cp2);
+ }
+ else {
+ if (dimlist_ptr->dim->namelist_defined) {
+ fortprintf(fd, " %s%id %% ioinfo %% start(%i) = read%sStart</font>
<font color="blue">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_file+1);
+ fortprintf(fd, " %s%id %% ioinfo %% count(%i) = read%sCount</font>
<font color="blue">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_file+1);
+ }
+ else {
+ fortprintf(fd, " %s%id %% ioinfo %% start(%i) = read%sStart</font>
<font color="blue">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_code+1);
+ fortprintf(fd, " %s%id %% ioinfo %% count(%i) = read%sCount</font>
<font color="red">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_code+1);
+ }
+ }
+ }
dimlist_ptr = dimlist_ptr->next;
i++;
}
- fortprintf(fd, "))</font>
<font color="black"></font>
<font color="gray">");
-
- if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
- fortprintf(fd, " allocate(super_%s%id(", vtype, var_ptr->ndims);
+
+ if (var_ptr->ndims > 0) {
+ fortprintf(fd, " allocate(%s%id %% array(", vtype, var_ptr->ndims);
i = 1;
dimlist_ptr = var_ptr->dimlist;
@@ -963,166 +878,193 @@
else
fortprintf(fd, "%s", dimlist_ptr->dim->name_in_code);
}
+ else {
+ if (is_derived_dim(dimlist_ptr->dim->name_in_code)) {
+ split_derived_dim_string(dimlist_ptr->dim->name_in_code, &cp1, &cp2);
+ fortprintf(fd, "read%sCount%s", cp1, cp2);
+ free(cp1);
+ free(cp2);
+ }
+ else
+ if (dimlist_ptr->dim->namelist_defined) fortprintf(fd, "read%sCount", dimlist_ptr->dim->name_in_file+1);
+ else fortprintf(fd, "read%sCount", dimlist_ptr->dim->name_in_code+1);
+ }
+
dimlist_ptr = dimlist_ptr->next;
i++;
while (dimlist_ptr) {
- if (dimlist_ptr->dim->constant_value < 0)
- if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, ", block %% mesh %% %s", dimlist_ptr->dim->name_in_code);
- else fortprintf(fd, ", block %% mesh %% %s", dimlist_ptr->dim->name_in_file);
- else
- fortprintf(fd, ", %s", dimlist_ptr->dim->name_in_code);
+ if (i < var_ptr->ndims) {
+ if (dimlist_ptr->dim->constant_value < 0)
+ if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, ", block %% mesh %% %s", dimlist_ptr->dim->name_in_code);
+ else fortprintf(fd, ", block %% mesh %% %s", dimlist_ptr->dim->name_in_file);
+ else
+ fortprintf(fd, ", %s", dimlist_ptr->dim->name_in_code);
+ }
+ else {
+ if (is_derived_dim(dimlist_ptr->dim->name_in_code)) {
+ split_derived_dim_string(dimlist_ptr->dim->name_in_code, &cp1, &cp2);
+ fortprintf(fd, ", read%sCount%s", cp1, cp2);
+ free(cp1);
+ free(cp2);
+ }
+ else
+ if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, ", read%sCount", dimlist_ptr->dim->name_in_code+1);
+ else fortprintf(fd, ", read%sCount", dimlist_ptr->dim->name_in_file+1);
+ }
dimlist_ptr = dimlist_ptr->next;
i++;
}
fortprintf(fd, "))</font>
<font color="black"></font>
<font color="red">");
- }
- }
-
- fortprintf(fd, " %s%id %% ioinfo %% fieldName = \'%s\'</font>
<font color="red">", vtype, var_ptr->ndims, var_ptr->name_in_file);
- if (var_ptr->timedim)
- fortprintf(fd, " call io_input_field_time(input_obj, %s%id)</font>
<font color="red">", vtype, var_ptr->ndims);
- else
- fortprintf(fd, " call io_input_field(input_obj, %s%id)</font>
<font color="red">", vtype, var_ptr->ndims);
-
- if (vert_dim > 0) {
- fortprintf(fd, "#ifdef EXPAND_LEVELS</font>
<font color="red">");
- fortprintf(fd, " if (.not. config_do_restart) then</font>
<font color="red">");
- fortprintf(fd, " do k=2,EXPAND_LEVELS</font>
<font color="red">");
- fortprintf(fd, " %s%id %% array(", vtype, var_ptr->ndims);
- for (i=1; i<=var_ptr->ndims; i++) {
- if (i > 1) fortprintf(fd, ",");
- fortprintf(fd, "%s", i == vert_dim ? "k" : ":");
- }
- fortprintf(fd, ") = %s%id %% array(", vtype, var_ptr->ndims);
- for (i=1; i<=var_ptr->ndims; i++) {
- if (i > 1) fortprintf(fd, ",");
- fortprintf(fd, "%s", i == vert_dim ? "1" : ":");
- }
- fortprintf(fd, ")</font>
<font color="red">");
- fortprintf(fd, " end do</font>
<font color="red">");
- fortprintf(fd, " end if</font>
<font color="red">");
- fortprintf(fd, "#endif</font>
<font color="red">");
- }
-
- if (var_ptr->ndims > 0) {
- fortprintf(fd, " call dmpar_alltoall_field(dminfo, &</font>
<font color="red">");
- if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
- if (var_ptr->timedim)
- fortprintf(fd, " %s%id %% array, super_%s%id, &</font>
<font color="red">", vtype, var_ptr->ndims, vtype, var_ptr->ndims);
- else
- fortprintf(fd, " %s%id %% array, super_%s%id, &</font>
<font color="red">", vtype, var_ptr->ndims, vtype, var_ptr->ndims);
- }
- else {
- if (var_ptr->timedim)
- fortprintf(fd, " %s%id %% array, block %% time_levs(1) %% state %% %s %% array, &</font>
<font color="red">", vtype, var_ptr->ndims, var_ptr->name_in_code);
- else
- fortprintf(fd, " %s%id %% array, block %% mesh %% %s %% array, &</font>
<font color="red">", vtype, var_ptr->ndims, var_ptr->name_in_code);
- }
- i = 1;
- dimlist_ptr = var_ptr->dimlist;
+ if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
+ fortprintf(fd, " allocate(super_%s%id(", vtype, var_ptr->ndims);
+ i = 1;
+ dimlist_ptr = var_ptr->dimlist;
- if (i < var_ptr->ndims)
- if (dimlist_ptr->dim->constant_value < 0)
- if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, " block %% mesh %% %s", dimlist_ptr->dim->name_in_code);
- else fortprintf(fd, " block %% mesh %% %s", dimlist_ptr->dim->name_in_file);
- else
- fortprintf(fd, " %s", dimlist_ptr->dim->name_in_code);
- else {
- lastdim = dimlist_ptr;
- if (is_derived_dim(dimlist_ptr->dim->name_in_code)) {
- split_derived_dim_string(dimlist_ptr->dim->name_in_code, &cp1, &cp2);
- fortprintf(fd, " read%sCount%s", cp1, cp2);
- free(cp1);
- free(cp2);
+ if (i < var_ptr->ndims) {
+ if (dimlist_ptr->dim->constant_value < 0)
+ if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, "block %% mesh %% %s", dimlist_ptr->dim->name_in_code);
+ else fortprintf(fd, "block %% mesh %% %s", dimlist_ptr->dim->name_in_file);
+ else
+ if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, "%s", dimlist_ptr->dim->name_in_code);
+ else fortprintf(fd, "%s", dimlist_ptr->dim->name_in_file);
+ }
+ dimlist_ptr = dimlist_ptr->next;
+ i++;
+ while (dimlist_ptr) {
+ if (dimlist_ptr->dim->constant_value < 0)
+ if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, ", block %% mesh %% %s", dimlist_ptr->dim->name_in_code);
+ else fortprintf(fd, ", block %% mesh %% %s", dimlist_ptr->dim->name_in_file);
+ else
+ if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, ", %s", dimlist_ptr->dim->name_in_code);
+ else fortprintf(fd, ", %s", dimlist_ptr->dim->name_in_file);
+
+ dimlist_ptr = dimlist_ptr->next;
+ i++;
+ }
+ fortprintf(fd, "))</font>
<font color="black"></font>
<font color="red">");
}
- else
- fortprintf(fd, " read%sCount", dimlist_ptr->dim->name_in_code+1);
}
-
- dimlist_ptr = dimlist_ptr->next;
- i++;
- while (dimlist_ptr) {
+
+ fortprintf(fd, " %s%id %% ioinfo %% fieldName = \'%s\'</font>
<font color="blue">", vtype, var_ptr->ndims, var_ptr->name_in_file);
+ if (var_ptr->timedim)
+ fortprintf(fd, " call io_input_field_time(input_obj, %s%id)</font>
<font color="blue">", vtype, var_ptr->ndims);
+ else
+ fortprintf(fd, " call io_input_field(input_obj, %s%id)</font>
<font color="blue">", vtype, var_ptr->ndims);
+
+ if (var_ptr->ndims > 0) {
+ fortprintf(fd, " call dmpar_alltoall_field(dminfo, &</font>
<font color="blue">");
+ if (strncmp(var_ptr->super_array, "-", 1024) != 0)
+ fortprintf(fd, " %s%id %% array, super_%s%id, &</font>
<font color="blue">", vtype, var_ptr->ndims, vtype, var_ptr->ndims);
+ else
+ fortprintf(fd, " %s%id %% array, %s %% %s %% array, &</font>
<font color="red">", vtype, var_ptr->ndims, struct_deref, var_ptr->name_in_code);
+
+ i = 1;
+ dimlist_ptr = var_ptr->dimlist;
+
if (i < var_ptr->ndims)
if (dimlist_ptr->dim->constant_value < 0)
- if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, ", block %% mesh %% %s", dimlist_ptr->dim->name_in_code);
- else fortprintf(fd, ", block %% mesh %% %s", dimlist_ptr->dim->name_in_file);
+ if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, " block %% mesh %% %s", dimlist_ptr->dim->name_in_code);
+ else fortprintf(fd, " block %% mesh %% %s", dimlist_ptr->dim->name_in_file);
else
- fortprintf(fd, ", %s", dimlist_ptr->dim->name_in_code);
+ fortprintf(fd, " %s", dimlist_ptr->dim->name_in_code);
else {
lastdim = dimlist_ptr;
if (is_derived_dim(dimlist_ptr->dim->name_in_code)) {
split_derived_dim_string(dimlist_ptr->dim->name_in_code, &cp1, &cp2);
- fortprintf(fd, ", read%sCount%s", cp1, cp2);
+ fortprintf(fd, " read%sCount%s", cp1, cp2);
free(cp1);
free(cp2);
}
else
- fortprintf(fd, ", read%sCount", dimlist_ptr->dim->name_in_code+1);
+ if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, " read%sCount", dimlist_ptr->dim->name_in_code+1);
+ else fortprintf(fd, " read%sCount", dimlist_ptr->dim->name_in_file+1);
}
+
dimlist_ptr = dimlist_ptr->next;
i++;
- }
- fortprintf(fd, ", block %% mesh %% %s, &</font>
<font color="red">", lastdim->dim->name_in_code);
-
- if (is_derived_dim(lastdim->dim->name_in_code)) {
- fortprintf(fd, " send%sList, recv%sList)</font>
<font color="red">", lastdim->dim->name_in_file+1, lastdim->dim->name_in_file+1);
- }
- else
- fortprintf(fd, " send%sList, recv%sList)</font>
<font color="red">", lastdim->dim->name_in_code+1, lastdim->dim->name_in_code+1);
-
-
- /* Copy from super_ array to field */
- if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
- i = 1;
- dimlist_ptr = var_ptr->dimlist;
- while (i <= var_ptr->ndims) {
- if (dimlist_ptr->dim->constant_value < 0)
- if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, " do i%i=1,block %% mesh %% %s</font>
<font color="red">", i, dimlist_ptr->dim->name_in_code);
- else fortprintf(fd, " do i%i=1,block %% mesh %% %s</font>
<font color="red">", i, dimlist_ptr->dim->name_in_file);
- else
- fortprintf(fd, " do i%i=1,%s</font>
<font color="red">", i, dimlist_ptr->dim->name_in_code);
-
- i++;
+ while (dimlist_ptr) {
+ if (i < var_ptr->ndims)
+ if (dimlist_ptr->dim->constant_value < 0)
+ if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, ", block %% mesh %% %s", dimlist_ptr->dim->name_in_code);
+ else fortprintf(fd, ", block %% mesh %% %s", dimlist_ptr->dim->name_in_file);
+ else
+ fortprintf(fd, ", %s", dimlist_ptr->dim->name_in_code);
+ else {
+ lastdim = dimlist_ptr;
+ if (is_derived_dim(dimlist_ptr->dim->name_in_code)) {
+ split_derived_dim_string(dimlist_ptr->dim->name_in_code, &cp1, &cp2);
+ fortprintf(fd, ", read%sCount%s", cp1, cp2);
+ free(cp1);
+ free(cp2);
+ }
+ else
+ if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, ", read%sCount", dimlist_ptr->dim->name_in_code+1);
+ else fortprintf(fd, ", read%sCount", dimlist_ptr->dim->name_in_file+1);
+ }
dimlist_ptr = dimlist_ptr->next;
+ i++;
}
-
- if (var_ptr->timedim)
- fortprintf(fd, " block %% time_levs(1) %% state %% %s %% array(index_%s,", var_ptr->super_array, var_ptr->name_in_code);
+ if (!lastdim->dim->namelist_defined) fortprintf(fd, ", block %% mesh %% %s, &</font>
<font color="blue">", lastdim->dim->name_in_code);
+ else fortprintf(fd, ", block %% mesh %% %s, &</font>
<font color="blue">", lastdim->dim->name_in_file);
+
+ if (is_derived_dim(lastdim->dim->name_in_code))
+ fortprintf(fd, " send%sList, recv%sList)</font>
<font color="red">", lastdim->dim->name_in_file+1, lastdim->dim->name_in_file+1);
else
- fortprintf(fd, " block %% mesh %% %s %% array(index_%s,", var_ptr->super_array, var_ptr->name_in_code);
- for(i=1; i<=var_ptr->ndims; i++) {
- fortprintf(fd, "i%i",i);
- if (i < var_ptr->ndims) fortprintf(fd, ",");
- }
- fortprintf(fd, ") = super_%s%id(", vtype, var_ptr->ndims);
- for(i=1; i<=var_ptr->ndims; i++) {
- fortprintf(fd, "i%i",i);
- if (i < var_ptr->ndims) fortprintf(fd, ",");
- }
- fortprintf(fd, ")</font>
<font color="blue">");
+ if (lastdim->dim->namelist_defined)
+ fortprintf(fd, " send%sList, recv%sList)</font>
<font color="blue">", lastdim->dim->name_in_file+1, lastdim->dim->name_in_file+1);
+ else
+ fortprintf(fd, " send%sList, recv%sList)</font>
<font color="red">", lastdim->dim->name_in_code+1, lastdim->dim->name_in_code+1);
- i = 1;
- while (i <= var_ptr->ndims) {
- fortprintf(fd, " end do</font>
<font color="red">");
- i++;
+
+ /* Copy from super_ array to field */
+ if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
+ i = 1;
+ dimlist_ptr = var_ptr->dimlist;
+ while (i <= var_ptr->ndims) {
+ if (dimlist_ptr->dim->constant_value < 0)
+ if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, " do i%i=1,block %% mesh %% %s</font>
<font color="blue">", i, dimlist_ptr->dim->name_in_code);
+ else fortprintf(fd, " do i%i=1,block %% mesh %% %s</font>
<font color="blue">", i, dimlist_ptr->dim->name_in_file);
+ else
+ fortprintf(fd, " do i%i=1,%s</font>
<font color="blue">", i, dimlist_ptr->dim->name_in_code);
+
+ i++;
+ dimlist_ptr = dimlist_ptr->next;
+ }
+
+ fortprintf(fd, " %s %% %s %% array(%s %% index_%s,", struct_deref, var_ptr->super_array, struct_deref, var_ptr->name_in_code);
+
+ for(i=1; i<=var_ptr->ndims; i++) {
+ fortprintf(fd, "i%i",i);
+ if (i < var_ptr->ndims) fortprintf(fd, ",");
+ }
+ fortprintf(fd, ") = super_%s%id(", vtype, var_ptr->ndims);
+ for(i=1; i<=var_ptr->ndims; i++) {
+ fortprintf(fd, "i%i",i);
+ if (i < var_ptr->ndims) fortprintf(fd, ",");
+ }
+ fortprintf(fd, ")</font>
<font color="blue">");
+
+ i = 1;
+ while (i <= var_ptr->ndims) {
+ fortprintf(fd, " end do</font>
<font color="blue">");
+ i++;
+ }
}
+
+ fortprintf(fd, " deallocate(%s%id %% array)</font>
<font color="blue">", vtype, var_ptr->ndims);
+ if (strncmp(var_ptr->super_array, "-", 1024) != 0)
+ fortprintf(fd, " deallocate(super_%s%id)</font>
<font color="red">", vtype, var_ptr->ndims);
}
-
- fortprintf(fd, " deallocate(%s%id %% array)</font>
<font color="red">", vtype, var_ptr->ndims);
- if (strncmp(var_ptr->super_array, "-", 1024) != 0)
- fortprintf(fd, " deallocate(super_%s%id)</font>
<font color="blue">", vtype, var_ptr->ndims);
+ else {
+ fortprintf(fd, " %s %% %s %% scalar = %s%id %% scalar</font>
<font color="blue">", struct_deref, var_ptr->name_in_code, vtype, var_ptr->ndims);
+ }
+
+ fortprintf(fd, " end if</font>
<font color="black"></font>
<font color="red">");
+
+ var_list_ptr = var_list_ptr->next;
}
- else {
- if (var_ptr->timedim)
- fortprintf(fd, " block %% time_levs(1) %% state %% %s %% scalar = %s%id %% scalar</font>
<font color="red">", var_ptr->name_in_code, vtype, var_ptr->ndims);
- else
- fortprintf(fd, " block %% mesh %% %s %% scalar = %s%id %% scalar</font>
<font color="red">", var_ptr->name_in_code, vtype, var_ptr->ndims);
- }
-
- fortprintf(fd, " end if</font>
<font color="black"></font>
<font color="gray">");
-
- var_ptr = var_ptr->next;
+ group_ptr = group_ptr->next;
}
fclose(fd);
@@ -1262,16 +1204,19 @@
}
-void gen_writes(struct variable * vars, struct dimension * dims, struct namelist * namelists)
+void gen_writes(struct group_list * groups, struct variable * vars, struct dimension * dims, struct namelist * namelists)
{
struct variable * var_ptr;
+ struct variable_list * var_list_ptr;
struct dimension * dim_ptr;
struct dimension_list * dimlist_ptr, * lastdim;
+ struct group_list * group_ptr;
struct dtable * dictionary;
struct namelist * nl;
FILE * fd;
char vtype[5];
char fname[32];
+ char struct_deref[1024];
char * cp1, * cp2;
int i, j;
int ivtype;
@@ -1418,226 +1363,224 @@
*/
fd = fopen("io_output_fields.inc", "w");
- var_ptr = vars;
- while (var_ptr) {
- i = 1;
- dimlist_ptr = var_ptr->dimlist;
- if (var_ptr->vtype == INTEGER) sprintf(vtype, "int");
- else if (var_ptr->vtype == REAL) sprintf(vtype, "real");
+ group_ptr = groups;
+ while (group_ptr) {
+ var_list_ptr = group_ptr->vlist;
+ while (var_list_ptr) {
+ var_ptr = var_list_ptr->var;
- if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
- if (var_ptr->timedim) {
- fortprintf(fd, " if ((domain %% blocklist %% time_levs(1) %% state %% %s %% ioinfo %% output .and. output_obj %% stream == OUTPUT) .or. &</font>
<font color="red">", var_ptr->super_array);
- fortprintf(fd, " (domain %% blocklist %% time_levs(1) %% state %% %s %% ioinfo %% restart .and. output_obj %% stream == RESTART)) then</font>
<font color="red">", var_ptr->super_array);
- }
- else {
- fortprintf(fd, " if ((domain %% blocklist %% mesh %% %s %% ioinfo %% output .and. output_obj %% stream == OUTPUT) .or. &</font>
<font color="red">", var_ptr->super_array);
- fortprintf(fd, " (domain %% blocklist %% mesh %% %s %% ioinfo %% restart .and. output_obj %% stream == RESTART)) then</font>
<font color="red">", var_ptr->super_array);
- }
- }
- else {
- if (var_ptr->timedim) {
- fortprintf(fd, " if ((domain %% blocklist %% time_levs(1) %% state %% %s %% ioinfo %% output .and. output_obj %% stream == OUTPUT) .or. &</font>
<font color="red">", var_ptr->name_in_code);
- fortprintf(fd, " (domain %% blocklist %% time_levs(1) %% state %% %s %% ioinfo %% restart .and. output_obj %% stream == RESTART)) then</font>
<font color="red">", var_ptr->name_in_code);
- }
- else {
- fortprintf(fd, " if ((domain %% blocklist %% mesh %% %s %% ioinfo %% output .and. output_obj %% stream == OUTPUT) .or. &</font>
<font color="red">", var_ptr->name_in_code);
- fortprintf(fd, " (domain %% blocklist %% mesh %% %s %% ioinfo %% restart .and. output_obj %% stream == RESTART)) then</font>
<font color="red">", var_ptr->name_in_code);
- }
- }
-
- if (var_ptr->ndims > 0) {
- while (dimlist_ptr) {
- if (i < var_ptr->ndims) {
- fortprintf(fd, " %s%id %% ioinfo %% start(%i) = 1</font>
<font color="red">", vtype, var_ptr->ndims, i);
- if (dimlist_ptr->dim->constant_value < 0)
- if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, " %s%id %% ioinfo %% count(%i) = domain %% blocklist %% mesh %% %s</font>
<font color="red">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_code);
- else fortprintf(fd, " %s%id %% ioinfo %% count(%i) = domain %% blocklist %% mesh %% %s</font>
<font color="red">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_file);
- else
- fortprintf(fd, " %s%id %% ioinfo %% count(%i) = %s</font>
<font color="red">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_code);
- }
- else {
- fortprintf(fd, " %s%id %% ioinfo %% start(%i) = 1</font>
<font color="red">", vtype, var_ptr->ndims, i);
- if (is_derived_dim(dimlist_ptr->dim->name_in_code)) {
- split_derived_dim_string(dimlist_ptr->dim->name_in_code, &cp1, &cp2);
- fortprintf(fd, " %s%id %% ioinfo %% count(%i) = n%sGlobal%s</font>
<font color="red">", vtype, var_ptr->ndims, i, cp1, cp2);
- free(cp1);
- free(cp2);
- }
- else
- fortprintf(fd, " %s%id %% ioinfo %% count(%i) = %sGlobal</font>
<font color="red">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_code);
- }
- dimlist_ptr = dimlist_ptr->next;
- i++;
- }
-
- fortprintf(fd, " allocate(%s%id %% array(", vtype, var_ptr->ndims);
+ if (group_ptr->vlist->var->ntime_levs > 1)
+ snprintf(struct_deref, 1024, "domain %% blocklist %% %s %% time_levs(1) %% %s", group_ptr->name, group_ptr->name);
+ else
+ snprintf(struct_deref, 1024, "domain %% blocklist %% %s", group_ptr->name);
+
i = 1;
dimlist_ptr = var_ptr->dimlist;
+ if (var_ptr->vtype == INTEGER) sprintf(vtype, "int");
+ else if (var_ptr->vtype == REAL) sprintf(vtype, "real");
- if (i < var_ptr->ndims)
- if (dimlist_ptr->dim->constant_value < 0)
- if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, "domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_code);
- else fortprintf(fd, "domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_file);
- else
- fortprintf(fd, "%s", dimlist_ptr->dim->name_in_code);
+ if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
+ fortprintf(fd, " if ((%s %% %s %% ioinfo %% output .and. output_obj %% stream == OUTPUT) .or. &</font>
<font color="blue">", struct_deref, var_ptr->super_array);
+ fortprintf(fd, " (%s %% %s %% ioinfo %% restart .and. output_obj %% stream == RESTART)) then</font>
<font color="red">", struct_deref, var_ptr->super_array);
+ }
else {
- if (is_derived_dim(dimlist_ptr->dim->name_in_code)) {
- split_derived_dim_string(dimlist_ptr->dim->name_in_code, &cp1, &cp2);
- fortprintf(fd, "n%sGlobal%s", cp1, cp2);
- free(cp1);
- free(cp2);
- }
- else
- fortprintf(fd, "%sGlobal", dimlist_ptr->dim->name_in_code);
- lastdim = dimlist_ptr;
+ fortprintf(fd, " if ((%s %% %s %% ioinfo %% output .and. output_obj %% stream == OUTPUT) .or. &</font>
<font color="blue">", struct_deref, var_ptr->name_in_code);
+ fortprintf(fd, " (%s %% %s %% ioinfo %% restart .and. output_obj %% stream == RESTART)) then</font>
<font color="red">", struct_deref, var_ptr->name_in_code);
}
- dimlist_ptr = dimlist_ptr->next;
- i++;
- while (dimlist_ptr) {
+
+ if (var_ptr->ndims > 0) {
+ while (dimlist_ptr) {
+ if (i < var_ptr->ndims) {
+ fortprintf(fd, " %s%id %% ioinfo %% start(%i) = 1</font>
<font color="blue">", vtype, var_ptr->ndims, i);
+ if (dimlist_ptr->dim->constant_value < 0)
+ if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, " %s%id %% ioinfo %% count(%i) = domain %% blocklist %% mesh %% %s</font>
<font color="blue">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_code);
+ else fortprintf(fd, " %s%id %% ioinfo %% count(%i) = domain %% blocklist %% mesh %% %s</font>
<font color="blue">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_file);
+ else
+ fortprintf(fd, " %s%id %% ioinfo %% count(%i) = %s</font>
<font color="blue">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_code);
+ }
+ else {
+ fortprintf(fd, " %s%id %% ioinfo %% start(%i) = 1</font>
<font color="blue">", vtype, var_ptr->ndims, i);
+ if (is_derived_dim(dimlist_ptr->dim->name_in_code)) {
+ split_derived_dim_string(dimlist_ptr->dim->name_in_code, &cp1, &cp2);
+ fortprintf(fd, " %s%id %% ioinfo %% count(%i) = n%sGlobal%s</font>
<font color="blue">", vtype, var_ptr->ndims, i, cp1, cp2);
+ free(cp1);
+ free(cp2);
+ }
+ else
+ if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, " %s%id %% ioinfo %% count(%i) = %sGlobal</font>
<font color="blue">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_code);
+ else fortprintf(fd, " %s%id %% ioinfo %% count(%i) = %sGlobal</font>
<font color="red">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_file);
+ }
+ dimlist_ptr = dimlist_ptr->next;
+ i++;
+ }
+
+ fortprintf(fd, " allocate(%s%id %% array(", vtype, var_ptr->ndims);
+ i = 1;
+ dimlist_ptr = var_ptr->dimlist;
+
if (i < var_ptr->ndims)
if (dimlist_ptr->dim->constant_value < 0)
- if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, ", domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_code);
- else fortprintf(fd, ", domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_file);
+ if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, "domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_code);
+ else fortprintf(fd, "domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_file);
else
- fortprintf(fd, ", %s", dimlist_ptr->dim->name_in_code);
+ fortprintf(fd, "%s", dimlist_ptr->dim->name_in_code);
else {
if (is_derived_dim(dimlist_ptr->dim->name_in_code)) {
split_derived_dim_string(dimlist_ptr->dim->name_in_code, &cp1, &cp2);
- fortprintf(fd, ", n%sGlobal%s", cp1, cp2);
+ fortprintf(fd, "n%sGlobal%s", cp1, cp2);
free(cp1);
free(cp2);
}
else
- fortprintf(fd, ", %sGlobal", dimlist_ptr->dim->name_in_code);
+ if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, "%sGlobal", dimlist_ptr->dim->name_in_code);
+ else fortprintf(fd, "%sGlobal", dimlist_ptr->dim->name_in_file);
lastdim = dimlist_ptr;
}
dimlist_ptr = dimlist_ptr->next;
i++;
- }
- fortprintf(fd, "))</font>
<font color="black"></font>
<font color="red">");
-
- if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
- if (var_ptr->ndims > 0) {
- fortprintf(fd, " allocate(super_%s%id(", vtype, var_ptr->ndims);
+ while (dimlist_ptr) {
+ if (i < var_ptr->ndims)
+ if (dimlist_ptr->dim->constant_value < 0)
+ if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, ", domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_code);
+ else fortprintf(fd, ", domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_file);
+ else
+ fortprintf(fd, ", %s", dimlist_ptr->dim->name_in_code);
+ else {
+ if (is_derived_dim(dimlist_ptr->dim->name_in_code)) {
+ split_derived_dim_string(dimlist_ptr->dim->name_in_code, &cp1, &cp2);
+ fortprintf(fd, ", n%sGlobal%s", cp1, cp2);
+ free(cp1);
+ free(cp2);
+ }
+ else
+ if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, ", %sGlobal", dimlist_ptr->dim->name_in_code);
+ else fortprintf(fd, ", %sGlobal", dimlist_ptr->dim->name_in_file);
+ lastdim = dimlist_ptr;
+ }
+ dimlist_ptr = dimlist_ptr->next;
+ i++;
+ }
+ fortprintf(fd, "))</font>
<font color="black"></font>
<font color="blue">");
+
+ if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
+ if (var_ptr->ndims > 0) {
+ fortprintf(fd, " allocate(super_%s%id(", vtype, var_ptr->ndims);
+ i = 1;
+ dimlist_ptr = var_ptr->dimlist;
+ while (dimlist_ptr) {
+ if (dimlist_ptr->dim->constant_value < 0)
+ if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, "domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_code);
+ else fortprintf(fd, "domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_file);
+ else
+ fortprintf(fd, "%s", dimlist_ptr->dim->name_in_code);
+
+ if (i < var_ptr->ndims) fortprintf(fd, ", ");
+
+ dimlist_ptr = dimlist_ptr->next;
+ i++;
+ }
+ fortprintf(fd, "))</font>
<font color="black"></font>
<font color="red">");
+ }
+
+ /* Copy from field to super_ array */
i = 1;
dimlist_ptr = var_ptr->dimlist;
- while (dimlist_ptr) {
+ while (i <= var_ptr->ndims) {
if (dimlist_ptr->dim->constant_value < 0)
- if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, "domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_code);
- else fortprintf(fd, "domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_file);
+ if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, " do i%i=1,domain %% blocklist %% mesh %% %s</font>
<font color="blue">", i, dimlist_ptr->dim->name_in_code);
+ else fortprintf(fd, " do i%i=1,domain %% blocklist %% mesh %% %s</font>
<font color="red">", i, dimlist_ptr->dim->name_in_file);
else
- fortprintf(fd, "%s", dimlist_ptr->dim->name_in_code);
+ fortprintf(fd, " do i%i=1,%s</font>
<font color="red">", i, dimlist_ptr->dim->name_in_code);
- if (i < var_ptr->ndims) fortprintf(fd, ", ");
-
+ i++;
dimlist_ptr = dimlist_ptr->next;
+ }
+
+ fortprintf(fd, " super_%s%id(", vtype, var_ptr->ndims);
+ for(i=1; i<=var_ptr->ndims; i++) {
+ fortprintf(fd, "i%i",i);
+ if (i < var_ptr->ndims) fortprintf(fd, ",");
+ }
+ fortprintf(fd, ") = %s %% %s %% array(", struct_deref, var_ptr->super_array);
+ fortprintf(fd, "%s %% index_%s", struct_deref, var_ptr->name_in_code);
+ for(i=1; i<=var_ptr->ndims; i++) {
+ fortprintf(fd, ",i%i",i);
+ }
+ fortprintf(fd, ")</font>
<font color="blue">");
+
+ i = 1;
+ while (i <= var_ptr->ndims) {
+ fortprintf(fd, " end do</font>
<font color="red">");
i++;
}
- fortprintf(fd, "))</font>
<font color="black"></font>
<font color="red">");
}
-
- /* Copy from field to super_ array */
+
+ fortprintf(fd, " %s%id %% ioinfo %% fieldName = \'%s\'</font>
<font color="blue">", vtype, var_ptr->ndims, var_ptr->name_in_file);
+ fortprintf(fd, " call dmpar_alltoall_field(domain %% dminfo, &</font>
<font color="blue">");
+ if (strncmp(var_ptr->super_array, "-", 1024) != 0)
+ fortprintf(fd, " super_%s%id, %s%id %% array, &</font>
<font color="blue">", vtype, var_ptr->ndims, vtype, var_ptr->ndims);
+ else
+ fortprintf(fd, " %s %% %s %% array, %s%id %% array, &</font>
<font color="red">", struct_deref, var_ptr->name_in_code, vtype, var_ptr->ndims);
+
i = 1;
dimlist_ptr = var_ptr->dimlist;
- while (i <= var_ptr->ndims) {
+
+ if (dimlist_ptr->dim->constant_value < 0)
+ if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, " domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_code);
+ else fortprintf(fd, " domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_file);
+ else
+ fortprintf(fd, " %s", dimlist_ptr->dim->name_in_code);
+
+ dimlist_ptr = dimlist_ptr->next;
+ i++;
+ while (dimlist_ptr) {
if (dimlist_ptr->dim->constant_value < 0)
- if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, " do i%i=1,domain %% blocklist %% mesh %% %s</font>
<font color="red">", i, dimlist_ptr->dim->name_in_code);
- else fortprintf(fd, " do i%i=1,domain %% blocklist %% mesh %% %s</font>
<font color="red">", i, dimlist_ptr->dim->name_in_file);
+ if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, ", domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_code);
+ else fortprintf(fd, ", domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_file);
else
- fortprintf(fd, " do i%i=1,%s</font>
<font color="red">", i, dimlist_ptr->dim->name_in_code);
-
- i++;
+ fortprintf(fd, ", %s", dimlist_ptr->dim->name_in_code);
+
dimlist_ptr = dimlist_ptr->next;
- }
-
- fortprintf(fd, " super_%s%id(", vtype, var_ptr->ndims);
- for(i=1; i<=var_ptr->ndims; i++) {
- fortprintf(fd, "i%i",i);
- if (i < var_ptr->ndims) fortprintf(fd, ",");
- }
- if (var_ptr->timedim)
- fortprintf(fd, ") = domain %% blocklist %% time_levs(1) %% state %% %s %% array(", var_ptr->super_array);
- else
- fortprintf(fd, ") = domain %% blocklist %% mesh %% %s %% array(", var_ptr->super_array);
- fortprintf(fd, "index_%s", var_ptr->name_in_code);
- for(i=1; i<=var_ptr->ndims; i++) {
- fortprintf(fd, ",i%i",i);
- }
- fortprintf(fd, ")</font>
<font color="red">");
-
- i = 1;
- while (i <= var_ptr->ndims) {
- fortprintf(fd, " end do</font>
<font color="blue">");
i++;
+ }
+
+ if (is_derived_dim(lastdim->dim->name_in_code)) {
+ split_derived_dim_string(lastdim->dim->name_in_code, &cp1, &cp2);
+ fortprintf(fd, ", n%sGlobal%s, &</font>
<font color="blue">", cp1, cp2);
+ fortprintf(fd, " output_obj %% send%sList, output_obj %% recv%sList)</font>
<font color="blue">", lastdim->dim->name_in_file+1, lastdim->dim->name_in_file+1);
+ free(cp1);
+ free(cp2);
}
+ else {
+ if (!lastdim->dim->namelist_defined) {
+ fortprintf(fd, ", %sGlobal, &</font>
<font color="blue">", lastdim->dim->name_in_code);
+ fortprintf(fd, " output_obj %% send%sList, output_obj %% recv%sList)</font>
<font color="blue">", lastdim->dim->name_in_code+1, lastdim->dim->name_in_code+1);
+ }
+ else {
+ fortprintf(fd, ", %sGlobal, &</font>
<font color="blue">", lastdim->dim->name_in_file);
+ fortprintf(fd, " output_obj %% send%sList, output_obj %% recv%sList)</font>
<font color="red">", lastdim->dim->name_in_file+1, lastdim->dim->name_in_file+1);
+ }
+ }
}
-
- fortprintf(fd, " %s%id %% ioinfo %% fieldName = \'%s\'</font>
<font color="red">", vtype, var_ptr->ndims, var_ptr->name_in_file);
- fortprintf(fd, " call dmpar_alltoall_field(domain %% dminfo, &</font>
<font color="red">");
- if (strncmp(var_ptr->super_array, "-", 1024) != 0)
- fortprintf(fd, " super_%s%id, %s%id %% array, &</font>
<font color="red">", vtype, var_ptr->ndims, vtype, var_ptr->ndims);
else {
- if (var_ptr->timedim)
- fortprintf(fd, " domain %% blocklist %% time_levs(1) %% state %% %s %% array, %s%id %% array, &</font>
<font color="red">", var_ptr->name_in_code, vtype, var_ptr->ndims);
- else
- fortprintf(fd, " domain %% blocklist %% mesh %% %s %% array, %s%id %% array, &</font>
<font color="blue">", var_ptr->name_in_code, vtype, var_ptr->ndims);
+ fortprintf(fd, " %s%id %% ioinfo %% fieldName = \'%s\'</font>
<font color="blue">", vtype, var_ptr->ndims, var_ptr->name_in_file);
+ fortprintf(fd, " %s%id %% scalar = %s %% %s %% scalar</font>
<font color="red">", vtype, var_ptr->ndims, struct_deref, var_ptr->name_in_code);
}
- i = 1;
- dimlist_ptr = var_ptr->dimlist;
-
- if (dimlist_ptr->dim->constant_value < 0)
- if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, " domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_code);
- else fortprintf(fd, " domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_file);
+ if (var_ptr->timedim)
+ fortprintf(fd, " if (domain %% dminfo %% my_proc_id == IO_NODE) call io_output_field_time(output_obj, %s%id)</font>
<font color="red">", vtype, var_ptr->ndims);
else
- fortprintf(fd, " %s", dimlist_ptr->dim->name_in_code);
-
- dimlist_ptr = dimlist_ptr->next;
- i++;
- while (dimlist_ptr) {
- if (dimlist_ptr->dim->constant_value < 0)
- if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, ", domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_code);
- else fortprintf(fd, ", domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_file);
- else
- fortprintf(fd, ", %s", dimlist_ptr->dim->name_in_code);
-
- dimlist_ptr = dimlist_ptr->next;
- i++;
- }
-
- if (is_derived_dim(lastdim->dim->name_in_code)) {
- split_derived_dim_string(lastdim->dim->name_in_code, &cp1, &cp2);
- fortprintf(fd, ", n%sGlobal%s, &</font>
<font color="red">", cp1, cp2);
- fortprintf(fd, " output_obj %% send%sList, output_obj %% recv%sList)</font>
<font color="red">", lastdim->dim->name_in_file+1, lastdim->dim->name_in_file+1);
- free(cp1);
- free(cp2);
+ fortprintf(fd, " if (domain %% dminfo %% my_proc_id == IO_NODE) call io_output_field(output_obj, %s%id)</font>
<font color="blue">", vtype, var_ptr->ndims);
+ if (var_ptr->ndims > 0) {
+ fortprintf(fd, " deallocate(%s%id %% array)</font>
<font color="blue">", vtype, var_ptr->ndims);
+ if (strncmp(var_ptr->super_array, "-", 1024) != 0)
+ fortprintf(fd, " deallocate(super_%s%id)</font>
<font color="red">", vtype, var_ptr->ndims);
}
- else {
- fortprintf(fd, ", %sGlobal, &</font>
<font color="red">", lastdim->dim->name_in_code);
- fortprintf(fd, " output_obj %% send%sList, output_obj %% recv%sList)</font>
<font color="red">", lastdim->dim->name_in_code+1, lastdim->dim->name_in_code+1);
- }
+ fortprintf(fd, " end if</font>
<font color="black"></font>
<font color="red">");
+
+ var_list_ptr = var_list_ptr->next;
}
- else {
- fortprintf(fd, " %s%id %% ioinfo %% fieldName = \'%s\'</font>
<font color="red">", vtype, var_ptr->ndims, var_ptr->name_in_file);
- if (var_ptr->timedim)
- fortprintf(fd, " %s%id %% scalar = domain %% blocklist %% time_levs(1) %% state %% %s %% scalar</font>
<font color="red">", vtype, var_ptr->ndims, var_ptr->name_in_code);
- else
- fortprintf(fd, " %s%id %% scalar = domain %% blocklist %% mesh %% %s %% scalar</font>
<font color="red">", vtype, var_ptr->ndims, var_ptr->name_in_code);
- }
-
- if (var_ptr->timedim)
- fortprintf(fd, " if (domain %% dminfo %% my_proc_id == IO_NODE) call io_output_field_time(output_obj, %s%id)</font>
<font color="red">", vtype, var_ptr->ndims);
- else
- fortprintf(fd, " if (domain %% dminfo %% my_proc_id == IO_NODE) call io_output_field(output_obj, %s%id)</font>
<font color="red">", vtype, var_ptr->ndims);
- if (var_ptr->ndims > 0) {
- fortprintf(fd, " deallocate(%s%id %% array)</font>
<font color="red">", vtype, var_ptr->ndims);
- if (strncmp(var_ptr->super_array, "-", 1024) != 0)
- fortprintf(fd, " deallocate(super_%s%id)</font>
<font color="red">", vtype, var_ptr->ndims);
- }
- fortprintf(fd, " end if</font>
<font color="black"></font>
<font color="gray">");
-
- var_ptr = var_ptr->next;
+ group_ptr = group_ptr->next;
}
fclose(fd);
@@ -1680,7 +1623,7 @@
/*
- * Generate code to write 0d, 1d, 2d, 3d real time-varying fields
+ * Generate code to write 0d, 1d, 2d, 3d time-varying fields
*/
for(j=0; j<2; j++) {
for(i=0; i<=3; i++) {
Modified: branches/atmos_physics/src/registry/gen_inc.h
===================================================================
--- branches/atmos_physics/src/registry/gen_inc.h 2010-10-13 18:01:28 UTC (rev 548)
+++ branches/atmos_physics/src/registry/gen_inc.h 2010-10-13 20:25:17 UTC (rev 549)
@@ -1,4 +1,4 @@
void gen_namelists(struct namelist *);
-void gen_field_defs(struct variable *, struct dimension *);
-void gen_reads(struct variable *, struct dimension *);
-void gen_writes(struct variable *, struct dimension *, struct namelist *);
+void gen_field_defs(struct group_list * groups, struct variable *, struct dimension *);
+void gen_reads(struct group_list * groups, struct variable *, struct dimension *);
+void gen_writes(struct group_list * groups, struct variable *, struct dimension *, struct namelist *);
Modified: branches/atmos_physics/src/registry/parse.c
===================================================================
--- branches/atmos_physics/src/registry/parse.c 2010-10-13 18:01:28 UTC (rev 548)
+++ branches/atmos_physics/src/registry/parse.c 2010-10-13 20:25:17 UTC (rev 549)
@@ -4,10 +4,11 @@
#include "registry_types.h"
#include "gen_inc.h"
-int parse_reg(FILE *, struct namelist **, struct dimension **, struct variable **);
+int parse_reg(FILE *, struct namelist **, struct dimension **, struct variable **, struct group_list **);
int getword(FILE *, char *);
int is_integer_constant(char *);
void sort_vars(struct variable *);
+void sort_group_vars(struct group_list *);
int main(int argc, char ** argv)
{
@@ -15,6 +16,7 @@
struct namelist * nls;
struct dimension * dims;
struct variable * vars;
+ struct group_list * groups;
if (argc != 2) {
fprintf(stderr,"</font>
<font color="black">Usage: %s filename</font>
<font color="black"></font>
<font color="gray">", argv[0]);
@@ -25,7 +27,7 @@
nls = NULL;
dims = NULL;
vars = NULL;
- if (parse_reg(regfile, &nls, &dims, &vars)) {
+ if (parse_reg(regfile, &nls, &dims, &vars, &groups)) {
return 1;
}
}
@@ -35,17 +37,18 @@
}
sort_vars(vars);
+ sort_group_vars(groups);
gen_namelists(nls);
- gen_field_defs(vars, dims);
- gen_reads(vars, dims);
- gen_writes(vars, dims, nls);
+ gen_field_defs(groups, vars, dims);
+ gen_reads(groups, vars, dims);
+ gen_writes(groups, vars, dims, nls);
return 0;
}
-int parse_reg(FILE * regfile, struct namelist ** nls, struct dimension ** dims, struct variable ** vars)
+int parse_reg(FILE * regfile, struct namelist ** nls, struct dimension ** dims, struct variable ** vars, struct group_list ** groups)
{
char word[1024];
struct namelist * nls_ptr;
@@ -54,13 +57,17 @@
struct variable * var_ptr;
struct dimension_list * dimlist_ptr;
struct dimension * dimlist_cursor;
+ struct group_list * grouplist_ptr;
+ struct variable_list * vlist_cursor;
NEW_NAMELIST(nls_ptr)
NEW_DIMENSION(dim_ptr)
NEW_VARIABLE(var_ptr)
+ NEW_GROUP_LIST(grouplist_ptr);
*nls = nls_ptr;
*dims = dim_ptr;
*vars = var_ptr;
+ *groups = grouplist_ptr;
while(getword(regfile, word) != EOF) {
if (strncmp(word, "namelist", 1024) == 0) {
@@ -130,7 +137,16 @@
var_ptr->timedim = 0;
var_ptr->iostreams = 0;
+ /*
+ * persistence
+ */
getword(regfile, word);
+ if (strncmp(word, "persistent", 1024) == 0)
+ var_ptr->persistence = PERSISTENT;
+ else if (strncmp(word, "scratch", 1024) == 0)
+ var_ptr->persistence = SCRATCH;
+
+ getword(regfile, word);
if (strncmp(word, "real", 1024) == 0)
var_ptr->vtype = REAL;
else if (strncmp(word, "integer", 1024) == 0)
@@ -168,14 +184,50 @@
getword(regfile, word);
}
- /* Read I/O info */
+ /*
+ * time_dim
+ */
getword(regfile, word);
+ var_ptr->ntime_levs = atoi(word);
+
+ /*
+ * I/O info
+ */
+ getword(regfile, word);
if (strchr(word, (int)'i')) var_ptr->iostreams |= INPUT0;
if (strchr(word, (int)'r')) var_ptr->iostreams |= RESTART0;
if (strchr(word, (int)'o')) var_ptr->iostreams |= OUTPUT0;
getword(regfile, var_ptr->name_in_code);
+ /*
+ * struct
+ */
+ getword(regfile, var_ptr->struct_group);
+ grouplist_ptr = *groups;
+ grouplist_ptr = grouplist_ptr->next;
+ while (grouplist_ptr && strncmp(var_ptr->struct_group, grouplist_ptr->name, 1024)) {
+ grouplist_ptr = grouplist_ptr->next;
+ }
+ if (!grouplist_ptr) {
+ grouplist_ptr = *groups;
+ while(grouplist_ptr->next) grouplist_ptr = grouplist_ptr->next;
+ NEW_GROUP_LIST(grouplist_ptr->next);
+ grouplist_ptr = grouplist_ptr->next;
+ memcpy(grouplist_ptr->name, var_ptr->struct_group, (size_t)1024);
+ NEW_VARIABLE_LIST(grouplist_ptr->vlist);
+ grouplist_ptr->vlist->var = var_ptr;
+ }
+ else {
+ vlist_cursor = grouplist_ptr->vlist;
+ while (vlist_cursor->next) vlist_cursor = vlist_cursor->next;
+ NEW_VARIABLE_LIST(vlist_cursor->next);
+ vlist_cursor->next->prev = vlist_cursor;
+ vlist_cursor = vlist_cursor->next;
+ vlist_cursor->var = var_ptr;
+ }
+
+
getword(regfile, var_ptr->super_array);
getword(regfile, var_ptr->array_class);
@@ -203,6 +255,10 @@
if ((*vars)->next) *vars = (*vars)->next;
if (var_ptr) free(var_ptr);
+ grouplist_ptr = *groups;
+ if ((*groups)->next) *groups = (*groups)->next;
+ if (grouplist_ptr) free(grouplist_ptr);
+
return 0;
}
@@ -252,7 +308,7 @@
var_ptr = vars;
-/*
+/* Attempt at sorting first on super-array, then on class in the same loop
while (var_ptr) {
memcpy(super_array, var_ptr->super_array, 1024);
memcpy(array_class, var_ptr->array_class, 1024);
@@ -321,3 +377,68 @@
var_ptr = var_ptr->next;
}
}
+
+
+void sort_group_vars(struct group_list * groups)
+{
+ struct variable_list * var_list;
+ struct variable_list * var_ptr;
+ struct variable_list * var_ptr2;
+ struct variable_list * var_ptr2_prev;
+ struct group_list * group_ptr;
+ char super_array[1024];
+ char array_class[1024];
+
+ group_ptr = groups;
+
+ while (group_ptr) {
+
+ var_ptr = group_ptr->vlist;
+
+ while (var_ptr) {
+ memcpy(super_array, var_ptr->var->super_array, 1024);
+ var_ptr2_prev = var_ptr;
+ var_ptr2 = var_ptr->next;
+ if (var_ptr2 && strncmp(super_array, var_ptr2->var->super_array, 1024) != 0) {
+ while (var_ptr2) {
+ if (strncmp(super_array, var_ptr2->var->super_array, 1024) == 0) {
+ var_ptr2_prev->next = var_ptr2->next;
+ var_ptr2->next = var_ptr->next;
+ var_ptr->next = var_ptr2;
+ var_ptr2 = var_ptr2_prev->next;
+ }
+ else {
+ var_ptr2_prev = var_ptr2_prev->next;
+ var_ptr2 = var_ptr2->next;
+ }
+ }
+ }
+ var_ptr = var_ptr->next;
+ }
+
+ var_ptr = group_ptr->vlist;
+
+ while (var_ptr) {
+ memcpy(array_class, var_ptr->var->array_class, 1024);
+ var_ptr2_prev = var_ptr;
+ var_ptr2 = var_ptr->next;
+ if (var_ptr2 && strncmp(array_class, var_ptr2->var->array_class, 1024) != 0) {
+ while (var_ptr2) {
+ if (strncmp(array_class, var_ptr2->var->array_class, 1024) == 0) {
+ var_ptr2_prev->next = var_ptr2->next;
+ var_ptr2->next = var_ptr->next;
+ var_ptr->next = var_ptr2;
+ var_ptr2 = var_ptr2_prev->next;
+ }
+ else {
+ var_ptr2_prev = var_ptr2_prev->next;
+ var_ptr2 = var_ptr2->next;
+ }
+ }
+ }
+ var_ptr = var_ptr->next;
+ }
+
+ group_ptr = group_ptr->next;
+ }
+}
Modified: branches/atmos_physics/src/registry/registry_types.h
===================================================================
--- branches/atmos_physics/src/registry/registry_types.h 2010-10-13 18:01:28 UTC (rev 548)
+++ branches/atmos_physics/src/registry/registry_types.h 2010-10-13 20:25:17 UTC (rev 549)
@@ -3,6 +3,9 @@
#define LOGICAL 2
#define CHARACTER 3
+#define PERSISTENT 0
+#define SCRATCH 1
+
#define INPUT0 0x00000001
#define RESTART0 0x00000002
#define OUTPUT0 0x00000004
@@ -11,6 +14,8 @@
#define NEW_DIMENSION(X) X = (struct dimension *)malloc(sizeof(struct dimension)); X->next = NULL;
#define NEW_DIMENSION_LIST(X) X = (struct dimension_list *)malloc(sizeof(struct dimension_list)); X->dim = NULL; X->prev = NULL; X->next = NULL;
#define NEW_VARIABLE(X) X = (struct variable *)malloc(sizeof(struct variable)); X->dimlist = NULL; X->next = NULL;
+#define NEW_VARIABLE_LIST(X) X = (struct variable_list *)malloc(sizeof(struct variable_list)); X->var = NULL; X->prev = NULL; X->next = NULL;
+#define NEW_GROUP_LIST(X) X = (struct group_list *)malloc(sizeof(struct group_list)); X->vlist = NULL; X->next = NULL;
union default_val {
int ival;
@@ -41,14 +46,29 @@
struct dimension_list * next;
};
+struct variable_list {
+ struct variable * var;
+ struct variable_list * prev;
+ struct variable_list * next;
+};
+
+struct group_list {
+ char name[1024];
+ struct variable_list * vlist;
+ struct group_list * next;
+};
+
struct variable {
char name_in_file[1024];
char name_in_code[1024];
+ char struct_group[1024];
char super_array[1024];
char array_class[1024];
+ int persistence;
int vtype;
int ndims;
int timedim;
+ int ntime_levs;
int iostreams;
struct dimension_list * dimlist;
struct variable * next;
</font>
</pre>